9Syntax10.Scn.FntSyntax10b.Scn.Fnt Syntax10i.Scn.Fnt`=IStampElemsAlloc4 Apr 97bqInfoElemsAllocUSyntax10.Scn.Fnt+StampElemsAlloc4 Apr 97bI"Title": Inspector "Author": Christoph Steindl (CS), Martin Rammerstorfer (MR) "Abstract": inspect data structures at run-time "Keywords": meta-information, inspect data structures "Version": 1 "From": 11.04.96 11:06:59 "Until":  "Changes": no changes "Hints": Use Def.Show Inspector.Mod for an explanation of the procedures. =pVersionElemsAllocBeg#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntLLOPM := POPM, OPS := POPS, OPT := POPT, OPB := POPB, OPV := POPV, OPP := POPPLpVersionElemsAllocEnd 8FoldElemsNew#Syntax10.Scn.Fnt DumpLen = 80 * 16; 8:8Syntax10.Scn.FntSyntax10b.Scn.Fnt c8FoldElemsNew_Syntax10.Scn.FntSyntax10b.Scn.Fnt? TypeFreeBlkDesc = RECORD tag*, size*, next*: LONGINT; END;8 8{Syntax10.Scn.FntSyntax10b.Scn.Fnt  w TypeSysBlkDesc = RECORD tagDesc*: X.Tag; size*, m4*: LONGINT; filler*: ARRAY 3 OF LONGINT; tag*: X.Tag; END;8 H8mSyntax10.Scn.FntSyntax10b.Scn.Fnt L TypeArrayBlkDesc = RECORD tag*, last*, reserved*, first*: LONGINT; END;8 8Syntax10.Scn.FntSyntax10b.Scn.Fnt     TypeDescSDesc = RECORD superTag*: X.Tag; tdsize*, m4*: LONGINT; self*: X.Tag; ext*: ARRAY 4 OF SHORTINT; name*: ARRAY 32 OF CHAR; mdesc*: X.Module; END;8Syntax10i.Scn.Fnt9  TypeFreeBlk* = POINTER TO TypeFreeBlkDesc; TypeSysBlk* = POINTER TO TypeSysBlkDesc; TypeArrayBlk* = POINTER TO TypeArrayBlkDesc; TypeDescS* = POINTER TO TypeDescSDesc; Proc = PROCEDURE; (* different sizes under Windows (4) and PowerMac Oberon (8) *) 8a8#Syntax10.Scn.Fnt}} w: Texts.Writer; cmdSystem, cmdStore, cmdStoreD, cmdOpenHex: PopupElems.Elem; lastPtr: S.PTR; fname: ARRAY 128 OF CHAR; 8 MarkElemsAlloc'8#Syntax10.Scn.Fnt++ BEGIN Texts.WriteString(w, s) END String; 8 '8#Syntax10.Scn.Fnt!! BEGIN Texts.WriteLn (w) END Ln; 8 '8#Syntax10.Scn.Fnt++ BEGIN Texts.WriteInt (w, val, 0) END Int; 8 ' 8#Syntax10.Scn.Fnt66 BEGIN Texts.SetFont (w, Fonts.Default) END TDefault; 8 ' 8#Syntax10.Scn.FntII BEGIN Texts.SetFont (w, Fonts.This ("Courier10.Scn.Fnt")) END TCourier; 8 '=8#Syntax10.Scn.Fnt VAR c: PopupElems.Elem; copy: Texts.CopyMsg; BEGIN cmds.handle (cmds, copy); c := copy.e (PopupElems.Elem); Texts.WriteElem (w, c); Texts.Insert (menu.text, menu.text.len, w.buf) END InsertPopup; 8 '48#Syntax10.Scn.Fnt.. VAR cmds: PopupElems.Elem; BEGIN NEW (cmds); COPY (name, cmds.name); cmds.small := TRUE; cmds.menu := TextFrames.Text (""); cmds.handle := PopupElems.Handle; Texts.Delete (cmds.menu, 0, cmds.menu.len); Texts.Append (cmds.menu, w.buf); PopupElems.MeasureMenu (cmds); RETURN cmds END CreatePopup; 8 ' :8mSyntax10.Scn.Fnt8FoldElemsNew#Syntax10.Scn.Fnt((txt: Texts.Text; dummy: MenuViewers.Viewer; x, y, j, kind: INTEGER; r: Ref.Rider; h, size, length, elemSize: LONGINT; type: Types.Type; title: ARRAY 100 OF CHAR; removeChar, hasMod: BOOLEAN; ch: CHAR; menuF: TextFrames.Frame; tdesc: X.Tag; hType: X.TypeS; tdS: TypeDescS; arr: TypeArrayBlk;8148#Syntax10.Scn.Fnt VAR curMod: X.Module; BEGIN curMod := X.GetModules (); WHILE (curMod # NIL) & (curMod # mod) DO curMod := curMod.next END; RETURN curMod = mod END FindModule; 8a8#Syntax10.Scn.Fnt}} VAR typeb: Types.Type; level: INTEGER; BEGIN typeb := type; level := Types.LevelOf (typeb); IF level # 0 THEN WHILE level # 0 DO DEC (level); typeb := Types.BaseOf (typeb, level); String ("Basetype "); Int (level); String (": "); String (typeb.module.name); Texts.Write (w, '.'); String (typeb.name); Ln () END; Ln () END END ShowBaseTypes; 88CSyntax10.Scn.FntRSyntax10i.Scn.Fnt/@ VAR nofMethods, i: INTEGER; tag, p: LONGINT; BEGIN S.GET (S.VAL (LONGINT, type) + 8, tag); nofMethods := SHORT (tag - S.VAL (LONGINT, type) - 48 - 72) DIV SIZE (Proc); String ("Type "); String (type.module.name); Texts.Write (w, '.'); String (type.name); String (" has "); Int (nofMethods); String (" methods"); Ln (); i := 0; WHILE i < nofMethods DO Int (i); String (": "); S.GET (tag - 68 - (i + 1) * SIZE (Proc), p); Ref.OpenProc (p, r); IF p = 0 THEN String ("NIL") ELSIF r.mode # Ref.End THEN String (r.name) ELSE String ("Name of method not available.") (* Entered, if moduleless object has methods *) END; Ln (); INC (i) END; Ln () END ShowMethods; 8#8#Syntax10.Scn.Fnt VAR tag, ptrOff, i: LONGINT; BEGIN S.GET (S.VAL (LONGINT, type) + 8, tag); INC (tag, 4); S.GET (tag, ptrOff); i := 0; IF ptrOff >= 0 THEN String ("Pointer at offset(s):"); Ln; WHILE ptrOff >= 0 DO Int (ptrOff); INC (tag, 4); S.GET (tag, ptrOff); IF ptrOff >= 0 THEN String (", "); INC (i); IF (i MOD 16) = 0 THEN Ln END END END; Ln; Int ((-ptrOff DIV 4) - 1); String (" pointer(s) in this type.") ELSE String ("No pointers in this type.") END; Ln; Ln END ShowPointerOffsets; 8Syntax10b.Scn.Fnt8#Syntax10.Scn.Fnt hasMod := FindModule (S.VAL (X.Module, type.module)); IF hasMod THEN removeChar := TRUE; Ref.OpenPtr (p, r); RefElems.WriteRider (w, r, 0); Ln ELSE String ("Moduleless object."); Ln END; Ln; title := ""; String ("Record of type ")88#Syntax10.Scn.FntQQ hasMod := FindModule (S.VAL (X.Module, type.module)); title := "Typedescriptor of type "; IF hasMod THEN Strings.Append (type.module.name, title) END; Strings.Append (".", title); Strings.Append (type.name, title); hType := S.VAL (X.TypeS, type); String ("Type has a size of "); Int (hType.self.size); String (" bytes."); Ln; String ("extlev = "); tdS := S.VAL (TypeDescS, S.VAL (LONGINT, type) - 4); Int (tdS.ext [0]); Ln; FOR j := 1 TO 3 DO String ("ext"); Int (j); String (" = "); Int (tdS.ext [j]); Ln END; Ln; String ("Typedescriptor has a size of ")8Q8#Syntax10.Scn.Fnt title := "Sysblock or array without pointer"; h := 0; TCourier (); WHILE (h < size) & (h < (DumpLen - 1)) DO IF (h MOD 80) = 79 THEN Ln () END; S.GET (h + S.VAL (LONGINT, p), ch); IF (ORD (ch) < 32) OR (ORD (ch) > 127) THEN ch := '.' END; Texts.Write (w, ch); INC (h) END; TDefault (); Ln (); Ln (); String ("Sysblock or array has a size of ")8H8#Syntax10.Scn.Fnt title := "Array of "; String ("Array (with pointers) has "); Int (length); String (" elements."); Ln; String ("An arrayelement of type ")88#Syntax10.Scn.Fnt@@ Strings.Append (type.module.name, title); Strings.Append(".", title); Strings.Append (type.name, title); String (type.module.name); Texts.Write (w, '.'); String (type.name); String (" has a size of "); IF kind = X.TArrP THEN Int (tdesc.size); String (" bytes."); Ln; String ("Array has a total size of ") END Syntax10i.Scn.Fnt 8Syntax8i.Scn.Fntk VAR  PROCEDURE FindModule (mod: X.Module): BOOLEAN;  PROCEDURE ShowBaseTypes ();  PROCEDURE ShowMethods ();  PROCEDURE ShowPointerOffsets ();  BEGIN IF p = NIL THEN RETURN END; lastPtr := p; removeChar := FALSE; hasMod := TRUE; kind := X.GetObjType (p, tdesc, size); IF (kind = X.TObj) OR (kind = X.TArrP) THEN type := S.VAL (Types.Type, X.TypeOf (p)) ELSIF kind = X.TTypDesc THEN type := S.VAL (Types.Type, tdesc) END; IF kind = X.TArrP THEN arr := S.VAL (TypeArrayBlk, S.VAL (LONGINT, p) - 4); elemSize := S.VAL (LONGINT, S.VAL (SET, tdesc.size + 3) - S.VAL (SET, 3)); length := ((arr.last - arr.first) DIV elemSize) + 1 END; CASE kind OF X.TObj:  | X.TTypDesc:  | X.TSysBl:  | X.TArrP:  | X.TFree: lastPtr := NIL; title := "Free block"; String ("Free block has a size of "); ELSE HALT (99) END; IF (kind = X.TObj) OR (kind = X.TArrP) THEN  Write type  END; Int (size - 4); String (" bytes."); Ln; Ln; IF (kind = X.TTypDesc) OR (kind = X.TObj) THEN IF hasMod THEN ShowBaseTypes () END; ShowMethods (); ShowPointerOffsets () END; String ("Address of this block: "); Int (S.VAL (LONGINT, p)); String (" / Relative address: "); Int (X.AddressAbsToRel (S.VAL (LONGINT, p))); String (" ."); Ln; txt := TextFrames.Text (""); Texts.Append (txt, w.buf); IF removeChar THEN Texts.Delete (txt, 0, 1) END; Oberon.AllocateUserViewer (Oberon.Mouse.X, x, y); menuF := TextFrames.NewMenu (title, ""); InsertPopup (cmdSystem, menuF); InsertPopup (cmdOpenHex, menuF); InsertPopup (cmdStoreD, menuF); InsertPopup (cmdStore, menuF); dummy := MenuViewers.New (menuF, TextFrames.NewText (txt, 0), TextFrames.menuH, x, y) END InspectPointer; 8 ' Yv8#Syntax10.Scn.Fnthh VAR adr: LONGINT; BEGIN In.Open; In.LongInt(adr); InspectPointer(S.VAL(S.PTR, adr)) END InspectPtr; 8 ' H8#Syntax10.Scn.Fnt VAR txt: Texts.Text; r: Texts.Reader; beg, end, time: LONGINT; BEGIN Oberon.GetSelection(txt, beg, end, time); IF time >= 0 THEN Texts.OpenReader(r, txt, beg); Texts.ReadElem(r); IF r.elem # NIL THEN InspectPointer(r.elem) END END END InspectElem; 8 ' E8#Syntax10.Scn.FntAA BEGIN InspectPointer(Oberon.MarkedViewer()) END InspectViewer; 8 '&v8#Syntax10.Scn.Fnthh BEGIN In.Open; In.Name(str); IF ~In.Done THEN In.Open; In.String(str) END ; RETURN In.Done END Par; 8 '<e8#Syntax10.Scn.Fntyy VAR name: ARRAY 256 OF CHAR; BEGIN IF Par(name) THEN InspectPointer(Directories.This(name)) END END InspectDirectory; 8 ' ?8#Syntax10.Scn.Fnt VAR r: Ref.Rider; p: S.PTR; BEGIN Ref.OpenVars("Oberon", r); WHILE (r.mode # Ref.End) & (r.name # "FirstTask") DO r.Next END ; IF r.mode # Ref.End THEN r.ReadPtr(p); InspectPointer(p) END END InspectTasks; 8 '\T8#Syntax10.Scn.Fnt VAR mod: ARRAY 128 OF CHAR; r: Texts.Reader; txt: Texts.Text; p: OPT.Node; modName: OPS.Name; BEGIN IF Par(mod) THEN txt := TextFrames.Text(mod); FoldElems.ExpandAll(txt, 0, FALSE); Texts.OpenReader(r, txt, 0); OPM.Init(r, Oberon.Log); OPS.Init; OPT.Init; OPB.typSize := OPV.TypSize; OPT.OpenScope(0, NIL); OPP.Module(p, modName); InspectPointer(p) END END InspectSyntaxTree; 8 ' W8'Syntax10.Scn.Fntn8FoldElemsNew#Syntax10.Scn.Fntppfile: Files.File; type: Types.Type; tdesc, size, i: LONGINT; kind: INTEGER; writer: Files.Rider; byte: S.BYTE;8>Syntax10b.Scn.FntW VAR  BEGIN IF lastPtr = NIL THEN String ("No data to open"); Ln; RETURN END; kind := X.GetObjType (lastPtr, S.VAL (X.Tag, tdesc), size); type := X.TypeOf (lastPtr); CASE kind OF X.TObj: fname := "" | X.TArrP: fname := "Array." | X.TSysBl: fname := "Sysblock." | X.TFree: fname := "FreeBlock." | X.TTypDesc: fname := "Typedescriptor." ELSE RETURN END; IF kind IN {X.TObj, X.TArrP, X.TTypDesc} THEN Strings.Append (type.module.name, fname); Strings.Append (".", fname); Strings.Append (type.name, fname); Strings.Append (".", fname) END; Strings.Append ("Hex", fname); file := Files.New (fname); IF file = NIL THEN String ('Error open file "'); String (fname); String ('".'); Ln; RETURN END; Files.Set (writer, file, 0); FOR i := 0 TO size - 4 - 1 DO S.GET (S.VAL (LONGINT, lastPtr) + i, byte); Files.Write (writer, byte) END; Files.Register (file) END StoreData; 8 '8#Syntax10.Scn.Fnt VAR res: INTEGER; par: Oberon.ParList; BEGIN StoreData; par := Oberon.Par; par.text := TextFrames.Text (""); par.pos := 0; String (fname); Texts.Append (par.text, w.buf); Oberon.Call ("Hex.Open", par, FALSE, res) END OpenHex; 8s8#Syntax10.Scn.Fntkk BEGIN Texts.OpenWriter (w); String ("System.Close"); Ln; String ("System.Grow"); Ln; String ("System.Copy"); cmdSystem := CreatePopup ("System"); String ("Edit.Store"); cmdStore := CreatePopup ("Store"); String ("Inspector.StoreData"); cmdStoreD := CreatePopup ("Store Data"); String ("Inspector.OpenHex"); cmdOpenHex := CreatePopup ("Open Hex") END Init; 8WMODULE Inspector; (* CS, MR, 11 Apr 96- *) IMPORT S := SYSTEM, Oberon, MenuViewers, Texts, TextFrames, FoldElems, Types, Ref, Directories, Strings, In, RefElems, PopupElems, Fonts, Files, X := Platform, OPM := iOPM, OPS := iOPS, OPT := iOPT, OPB := iOPB, OPV := iOPV, OPP := iOPP; CONST  TYPE  VAR  PROCEDURE String (s: ARRAY OF CHAR);  PROCEDURE Ln ();  PROCEDURE Int (val: LONGINT);  PROCEDURE TDefault;  PROCEDURE TCourier;  PROCEDURE InsertPopup (cmds: PopupElems.Elem; menu: TextFrames.Frame);  PROCEDURE CreatePopup (name: ARRAY OF CHAR): PopupElems.Elem;  PROCEDURE InspectPointer* (p: S.PTR); (** opens a viewer with information about the pointer *)  PROCEDURE InspectPtr*; (** opens a viewer with information about the memory block at the specified address *)  PROCEDURE InspectElem*; (** opens a viewer with information about the selected text element *)  PROCEDURE InspectViewer*; (** opens a viewer with information about the star marked viewer *)  PROCEDURE Par (VAR str: ARRAY OF CHAR): BOOLEAN; PROCEDURE InspectDirectory*; (** opens a viewer with information about the directory *)  PROCEDURE InspectTasks*; (** opens a viewer with information about the running tasks *)  PROCEDURE InspectSyntaxTree*; (** compiles the module and opens a viewer with the syntax tree of the compiled module *)  PROCEDURE StoreData*;  PROCEDURE OpenHex*;  PROCEDURE Init ();  BEGIN Init () END Inspector. InspectElem Inspector.InspectViewer Inspector.InspectDirectory c:\oberon\user Inspector.InspectSyntaxTree ^ Inspector.Mod TextFrames.Mod Halt.Mod