OberonCore

   PROCEDURE Test ;
      VAR x, y: INTEGER;
            z: REAL;
   BEGIN
      x := 10; y := 0; z := 1;
      DevLocalWatch.Begin("x y z");
      WHILE x > 0 DO
         DevLocalWatch.Snap;
         z := z * (x + y);
         DEC(x); INC(y)      
      END;
      DevLocalWatch.End
   END Test;

MODULE DevLocalWatch;
(* (C) 2007 Ilya Ermakov
   http://oberoncore.ru *)

   IMPORT Mem, S := SYSTEM, Kernel, Strings, TextModels, TextMappers, TextViews, Views;

   CONST
      (* atomic types signatures *)
      boolean = 1X;
      shortchar = 2X;
      char = 3X;
      byte = 4X;
      shortint = 5X;
      integer = 6X;
      shortreal = 7X;
      real = 8X;
      set = 9X;
      longint = 0AX;
      
      regBP = 5;
      
   TYPE
      Variable = RECORD
         name: ARRAY 256 OF CHAR;
         type: SHORTCHAR;
         offset: INTEGER
      END;
      
      Value = RECORD [union]
         boolean: BOOLEAN;
         shortchar: SHORTCHAR;
         char: CHAR;
         byte: BYTE;
         shortint: SHORTINT;
         integer: INTEGER;
         shortreal: SHORTREAL;
         real: REAL
      END;
      PtrValue = POINTER TO Value;
      
      ValueBlock = POINTER TO RECORD
         next: ValueBlock;
         mem: ARRAY 1024 * SIZE(Value) OF BYTE;
         used: INTEGER
      END;
         
      Snapshot = POINTER TO RECORD
         next: Snapshot;
         values: POINTER TO ARRAY OF PtrValue
      END;
      
   VAR
      stack: INTEGER;                                 (* Stack frame pointer *)
      varMap: POINTER TO ARRAY OF Variable;   (* Map of local variables *)
      valHeap: ValueBlock;                           (* Heap for value elem allocation *)
      history, hisLast: Snapshot;                     (* Loop history *)

   PROCEDURE AddVarToMap (IN name: ARRAY OF CHAR; type: SHORTCHAR; offset: INTEGER);
      VAR n: INTEGER;
   BEGIN
      n := LEN(varMap);
      Mem.SetLength(varMap, n+1);
      varMap[n].name := name$;
      varMap[n].type := type;
      varMap[n].offset := offset
   END AddVarToMap;

   PROCEDURE Begin* (IN varToWatch: ARRAY OF CHAR);
      VAR retAdr: INTEGER;
            mod: Kernel.Module;
            ref, end: INTEGER;
            name: Kernel.Name;
            mode, form: SHORTCHAR;
            desc: Kernel.Type;
            offs, spos: INTEGER;
   BEGIN
      S.GETREG(regBP, stack); (* get frame of current proc *)
      S.GET(stack+4, retAdr);
      S.GET(stack, stack);            (* get frame of target proc *)
      NEW(varMap, 1);
      Mem.SetLength(varMap, 0);
      mod := Kernel.modList;
      WHILE (mod # NIL) & ((retAdr < mod.code) OR (retAdr >= mod.code + mod.csize)) DO
         mod := mod.next
      END;
      ASSERT(mod # NIL, 100);
      DEC(retAdr, mod.code);
      ref := mod.refs;
      REPEAT Kernel.GetRefProc(ref, end, name) UNTIL (end = 0) OR (retAdr < end);
      ASSERT(retAdr < end, 101);
      Kernel.GetRefVar(ref, mode, form, desc, offs, name);
      WHILE mode # 0X DO
         IF (mode = 1X) & (offs < 0) & (form >= boolean) & (form <= longint) THEN (* variable, non parameter, atomic *)
            IF varToWatch # "" THEN
               Strings.Find(varToWatch, name$, 0, spos)
            END;
            IF (varToWatch = "") OR (spos # -1) & ( (spos = 0) OR (varToWatch[spos-1] = " ") )
               & ((varToWatch[spos+LEN(name$)] = " ") OR (varToWatch[spos+LEN(name$)] = 0X)) THEN
               AddVarToMap(name$, form, offs)
            END
         END;
         Kernel.GetRefVar(ref, mode, form, desc, offs, name)
      END;
      NEW(valHeap)      
   END Begin;
   
   PROCEDURE NewVal (): PtrValue;
      VAR blk: ValueBlock;
   BEGIN
      IF valHeap.used = LEN(valHeap.mem) THEN
         NEW(blk);
         blk.next := valHeap;
         valHeap := blk
      END;
      INC(valHeap.used, SIZE(Value));
      RETURN S.VAL(PtrValue, S.ADR(valHeap.mem[valHeap.used - SIZE(Value)]))
   END NewVal;
   
   PROCEDURE Snap*;
      VAR s: Snapshot;
            fp, i: INTEGER;
            val: PtrValue;
   BEGIN
      ASSERT(varMap # NIL, 20); (* Begin has been called before *)
      S.GETREG(regBP, fp); S.GET(fp, fp);
      ASSERT(stack = fp, 21);    (* Begin & Loop called from same procedure *)
      NEW(s);
      NEW(s.values, LEN(varMap));
      FOR i := 0 TO LEN(varMap)-1 DO
         val := NewVal();
         CASE varMap[i].type OF
         | boolean: S.GET(fp + varMap[i].offset, val.boolean)
         | shortchar: S.GET(fp + varMap[i].offset, val.shortchar)
         | char: S.GET(fp + varMap[i].offset, val.char)
         | byte: S.GET(fp + varMap[i].offset, val.byte)
         | shortint: S.GET(fp + varMap[i].offset, val.shortint)
         | integer: S.GET(fp + varMap[i].offset, val.integer)
         | shortreal: S.GET(fp + varMap[i].offset, val.shortreal)
         | real: S.GET(fp + varMap[i].offset, val.real)
         END;
         s.values[i] := val
      END;
      IF hisLast # NIL THEN
         hisLast.next := s;
         hisLast := s
      ELSE
         history := s;
         hisLast := s
      END
   END Snap;
   
   PROCEDURE ^ WriteVal (type: SHORTCHAR; IN val: Value; VAR f: TextMappers.Formatter);
      
   PROCEDURE End*;
      VAR tm: TextModels.Model;
            f: TextMappers.Formatter;
            i: INTEGER;
            s: Snapshot;
            tv: TextViews.View;
   BEGIN
      tm := TextModels.dir.New();
      f.ConnectTo(tm);
      FOR i := 0 TO LEN(varMap) - 1 DO
         f.WriteTab;
         f.WriteString(varMap[i].name)
      END;
      f.WriteLn;
      s := history;
      WHILE s # NIL DO
         FOR i := 0 TO LEN(varMap) - 1 DO
            f.WriteTab;
            WriteVal(varMap[i].type, s.values[i], f)
         END;
         f.WriteLn;
         s := s.next
      END;
      tv := TextViews.dir.New(tm);
      Views.OpenView(tv);
      varMap := NIL;
      valHeap := NIL;
      history := NIL; hisLast := NIL;
      Kernel.Collect
   END End;
   
   PROCEDURE WriteVal (type: SHORTCHAR; IN val: Value; VAR f: TextMappers.Formatter);
   BEGIN
      CASE type OF
      | boolean: f.WriteBool(val.boolean)
      | shortchar: f.WriteChar(val.shortchar)
      | char: f.WriteChar(val.char)
      | byte: f.WriteInt(val.byte)
      | shortint: f.WriteInt(val.shortint)
      | integer: f.WriteInt(val.integer)
      | shortreal: f.WriteReal(val.shortreal)
      | real: f.WriteReal(val.real)
      END
   END WriteVal;

END DevLocalWatch.