ðõSyntax10.Scn.Fnt-ªÿÿÿ hÐûHistoryElemsNewHistory*Syntax10.Scn.Fnt!%16: CE: prevents duplicate displayingÈ5Kø—NLØÙ7MODULE Browser; (* MH/JT 1.9.93, CM 07.09.95 *) (* 5.12.94 mh: fixed output of REAL and LONGREAL numbers *) (* 5.12.94 mh: fixed output of record types *) (* 23.9.97 CE: prevents duplicate displaying *) IMPORT OPT := iOPT, OPS := iOPS, OPM := iOPM, Files, MenuViewers, Texts, TextFrames, Oberon, Directories; CONST OptionChar = "\"; LogMsg = "Browser MH/JT 1.9.93"; (* Menu = "System.Close System.Copy System.Grow Edit.Search Edit.Store "; *) (* CM 07.09.95 *) symFileExt = ".Sym"; (*object modes*) Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; (* structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; Comp = 15; (* composite structure forms *) Basic = 1; Array = 2; DynArr = 3; Record = 4; (* visibility of objects *) internal = 0; external = 1; externalR = 2; displayed = 3; (* ce: prevent duplicate displaying *) showAdr = 0; expandTypes = 1; VAR W: Texts.Writer; LogMsgPrinted, first, showObj: BOOLEAN; sysImported: BOOLEAN; syspos: LONGINT; option: SET; (* showAdr, expandTypes *) Hex: ARRAY 17 OF CHAR; (* ---------------------- output ----------------------- *) PROCEDURE Str (s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END Str; PROCEDURE Ch (ch: CHAR); BEGIN Texts.Write(W, ch) END Ch; PROCEDURE Num (i: LONGINT); BEGIN Texts.WriteInt(W, i, 0); END Num; PROCEDURE Ln; BEGIN Texts.WriteLn(W) END Ln; PROCEDURE Indent (i: INTEGER); BEGIN WHILE i > 0 DO Ch(9X); DEC(i) END END Indent; PROCEDURE WriteConstValue (obj: OPT.Object); VAR i: INTEGER; y: LONGINT; s: SET; ch: CHAR; BEGIN y := obj.conval.intval; CASE obj.typ^.form OF | SInt, Int, LInt: Texts.WriteInt(W, y, 0) | Real: Texts.WriteReal(W, SHORT(obj^.conval.realval), 15) | LReal: Texts.WriteLongReal(W, obj^.conval.realval, 23) | Bool: IF y = 0 THEN Str("FALSE") ELSE Str("TRUE") END | Char: IF (y >= 32) & (y <= 126) THEN Ch(22X); Ch(CHR(y)); Ch(22X) ELSE i := SHORT(y DIV 16); IF i > 0 THEN IF i > 9 THEN Ch("0") END ; Ch(Hex[i]) END ; Ch(Hex[y MOD 16]); Ch("X") END | Set: Ch("{"); y := 0; s := obj^.conval^.setval; WHILE y <= MAX(SET) DO IF y IN s THEN Texts.WriteInt(W, y, 0); EXCL(s, y); IF s # {} THEN Str(", ") END END ; INC(y) END ; Ch("}") | NilTyp: Str("NIL") | String: Ch(22X); Str(obj.conval.ext^); Ch(22X) END END WriteConstValue; PROCEDURE ^ WriteType (typ: OPT.Struct; i: INTEGER); PROCEDURE WriteBase (typ: OPT.Struct); VAR base: OPT.Struct; BEGIN base := typ^.BaseTyp; IF (base # NIL) & (ABS(base^.strobj^.vis) > internal) THEN (* ABS because regrouped types have negative visibility value *) Str(" ("); WriteType(typ^.BaseTyp, 0); IF expandTypes IN option THEN WriteBase(typ^.BaseTyp) END ; Ch(")"); END END WriteBase; PROCEDURE WriteFields (VAR obj: OPT.Object; i: INTEGER; recField: BOOLEAN); VAR typ: OPT.Struct; mode: INTEGER; BEGIN typ := obj^.typ; mode := obj^.mode; LOOP IF recField & (showAdr IN option) THEN Ch("["); Num(obj.adr); Str("] ") END ; Str(obj^.name); IF (obj^.vis = externalR) THEN Ch("-") END ; obj := obj^.link; IF (obj = NIL) OR (obj^.mode # mode) OR (obj^.typ # typ) THEN EXIT END ; Str(", "); END ; Str(": "); WriteType(typ, i + 1) END WriteFields; PROCEDURE WriteParams (param: OPT.Object; res: OPT.Struct); BEGIN IF (param # NIL) OR (res # OPT.notyp) THEN Str(" ("); WHILE (param # NIL) DO IF param.mode = VarPar THEN Str("VAR ") END ; IF param.name = "" THEN WriteType(param.typ, 0); param := param.link; IF param # NIL THEN Str(", ") END ELSE WriteFields(param, 0, FALSE); IF param # NIL THEN Str("; ") END END END ; Ch(")"); END ; IF res # OPT.notyp THEN Str(": "); WriteType(res, 0) END END WriteParams; PROCEDURE WriteProc (obj: OPT.Object); VAR param: OPT.Object; i: LONGINT; BEGIN IF (showAdr IN option) & (obj^.mode # CProc) THEN Ch("["); Num(obj^.adr); Str("] ") END ; Str("PROCEDURE "); Str(obj^.name); WriteParams(obj^.link, obj^.typ); Ch(";") END WriteProc; PROCEDURE WriteTProcs (obj: OPT.Object; i: INTEGER); VAR firstpar: OPT.Object; BEGIN IF obj # NIL THEN WriteTProcs(obj.left, i); IF obj^.mode = TProc THEN Indent(i); IF showAdr IN option THEN Ch("["); Num(obj^.adr MOD 10000H); Str(", "); Num(obj^.adr DIV 10000H); Str("] ") END ; Str("PROCEDURE ("); firstpar := obj^.link; IF firstpar^.mode = VarPar THEN Str("VAR ") END ; Str(firstpar^.name); Str(": "); Str(firstpar^.typ^.strobj^.name); Str(") "); Str(obj.name); WriteParams(firstpar^.link, obj^.typ); Ch(";"); Ln; END ; WriteTProcs(obj.right, i); END ; END WriteTProcs; PROCEDURE WriteFieldList (obj: OPT.Object; i: INTEGER); BEGIN WHILE (obj # NIL) & (obj^.mode = Fld) DO IF (obj^.vis # internal) & (obj^.vis # displayed) THEN Indent(i); WriteFields(obj, i, TRUE); Ch(";"); Ln; ELSE obj := obj^.link; END END END WriteFieldList; PROCEDURE WriteInstVars (typ: OPT.Struct; i: INTEGER; extlev: INTEGER); BEGIN IF typ # NIL THEN IF (extlev > 0) & (expandTypes IN option) THEN WriteInstVars(typ^.BaseTyp, i, extlev); Indent(i); Str("(* "); Str(OPT.GlbMod[typ.mno-1].name); Ch("."); Str(typ^.strobj.name); Str(" *)"); Ln END ; WriteFieldList(typ^.link, i); WriteTProcs(typ^.link, i); END END WriteInstVars; PROCEDURE WriteForm (typ: OPT.Struct; i: INTEGER); VAR param, p: OPT.Object; BEGIN IF (typ^.form = Comp) & (typ^.comp = Record) THEN Str("RECORD"); WriteBase(typ); IF showAdr IN option THEN Str(" [size = "); Num( typ^.size); Ch("]") END ; IF typ^.link # NIL (*OR (expandTypes IN option)*) THEN Ln; WriteInstVars(typ, i, typ.extlev); Indent(i - 1) ELSE Ch(" ") END ; Str("END ") ELSIF (typ^.form = Comp) & (typ^.comp = Array) THEN Str("ARRAY "); Texts.WriteInt(W, typ^.n, 0); Str(" OF "); WriteType(typ^.BaseTyp, i) ELSIF (typ^.form = Comp) & (typ^.comp = DynArr) THEN Str("ARRAY OF "); WriteType(typ^.BaseTyp, i) ELSIF typ^.form = Pointer THEN Str("POINTER TO "); WriteType(typ^.BaseTyp, i); ELSIF typ^.form = ProcTyp THEN Str("PROCEDURE"); WriteParams(typ^.link, typ^.BaseTyp) END END WriteForm; PROCEDURE WriteType (typ: OPT.Struct; i: INTEGER); BEGIN IF typ^.strobj # NIL THEN (* named type *) IF (typ = OPT.bytetyp) OR (typ = OPT.sysptrtyp) THEN Str("SYSTEM."); sysImported := TRUE; ELSIF (typ^.mno > 1) OR ((typ^.mno = 1) & showObj) THEN Str(OPT.GlbMod[typ^.mno-1]^.name); Ch("."); END ; Str(typ^.strobj^.name) ELSE (* anonymous type *) WriteForm(typ, i) END END WriteType; PROCEDURE WriteObject (VAR obj: OPT.Object; mode: INTEGER); VAR h: OPT.Object; BEGIN IF mode = Con THEN IF first THEN Indent(1); Str("CONST"); Ln; first := FALSE END ; Indent(2); Str(obj.name); Str(" = "); WriteConstValue(obj); Ch(";"); Ln; ELSIF mode = Var THEN IF first THEN Indent(1); Str("VAR"); Ln; first := FALSE END ; Indent(2); IF showAdr IN option THEN Str(" ["); Num(obj.adr); Str("] "); END ; Str(obj.name); IF obj^.vis = externalR THEN Ch("-") END ; Str(": "); WriteType(obj^.typ, 3); Ch(";"); Ln; ELSIF (mode = Typ) & (ABS(obj^.vis) # displayed) & ((obj^.vis > internal) OR (showObj & (ABS(obj^.vis) > internal))) THEN IF first THEN Indent(1); Str("TYPE"); Ln; first := FALSE END ; Indent(2); IF showObj THEN Str(OPT.GlbMod[-obj.mnolev -1]^.name); Str(".") END ; Str(obj^.name); Str(" = "); IF obj^.typ^.strobj.mnolev # -1 THEN WriteType(obj^.typ, 0) (* alias type *) ELSE WriteForm(obj^.typ, 3); END ; Ch(";"); Ln; IF obj.link # NIL THEN (* group of two types *) h := obj.link; IF ((ABS(h^.vis) > internal) & (ABS(h^.vis) # displayed)) THEN (* ABS because regrouped types have negative visibility value *) h.vis := displayed; Indent(2); IF showObj THEN Str(OPT.GlbMod[-h.mnolev -1]^.name); Str(".") END ; Str(h^.name); Str(" = "); WriteForm(h^.typ, 3); Ch(";"); Ln; END END ELSIF mode IN {XProc, CProc} THEN first := FALSE; Indent(1); WriteProc(obj); Ln; END END WriteObject; PROCEDURE WriteImports; VAR i: INTEGER; BEGIN i := 1; (* assume that OPT.GlbMod[0] is "self" *) first := TRUE; WHILE i < OPT.nofGmod DO IF first THEN Indent(1); Str("IMPORT "); first := FALSE; syspos := W.buf.len ELSE Str(", ") END ; Str(OPT.GlbMod[i]^.name); IF showAdr IN option THEN Str(" ["); Texts.WriteHex(W, OPT.GlbMod[i]^.adr); Ch("]"); END ; INC(i); END ; IF ~first THEN Ch(";"); Ln; Ln END ; END WriteImports; PROCEDURE WriteScope (obj: OPT.Object; mode: INTEGER); PROCEDURE Scope (obj: OPT.Object; mode: INTEGER); BEGIN IF obj # NIL THEN Scope(obj.left, mode); IF obj.mode = mode THEN WriteObject(obj, mode) END ; Scope(obj.right, mode); END ; END Scope; BEGIN first := TRUE; Scope(obj, mode); IF ~first THEN Ln END END WriteScope; PROCEDURE WriteModule (mod: OPS.Name); VAR anchor: OPT.Object; BEGIN anchor := OPT.topScope.right.scope; Str("DEFINITION "); Str(mod); IF showAdr IN option THEN Str(" ["); Texts.WriteHex(W, OPT.GlbMod[0].adr); Ch("]") END ; Ch(";"); Ln; Ln; syspos := W.buf.len; sysImported := FALSE; WriteImports; WriteScope(anchor, Con); WriteScope(anchor, Typ); WriteScope(anchor, Var); WriteScope(anchor, CProc); WriteScope(anchor, XProc); Str("END "); Str(mod); Ch(".") END WriteModule; PROCEDURE DisplayW (name: ARRAY OF CHAR); VAR mV: MenuViewers.Viewer; T: Texts.Text; x, y: INTEGER; BEGIN T := TextFrames.Text(""); Texts.Append(T, W.buf); IF sysImported & ~showObj THEN IF OPT.nofGmod > 1 THEN Str("SYSTEM, ") ELSE Ch(09X); Str("IMPORT SYSTEM;"); Ln; Ln END ; Texts.Insert(T, syspos, W.buf); END ; Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); mV := MenuViewers.New(TextFrames.NewMenu(name,"^Edit.Menu.Text"), TextFrames.NewText(T, 0), TextFrames.menuH, x, y) (* CM 07.09.95 *) END DisplayW; (* ------------------------ symbol file ------------------- *) PROCEDURE Find (name: ARRAY OF CHAR; VAR obj: OPT.Object); BEGIN obj := OPT.topScope.right.scope; LOOP IF obj = NIL THEN RETURN ELSIF name < obj.name THEN obj := obj.left ELSIF name > obj.name THEN obj := obj.right ELSE RETURN END END END Find; PROCEDURE GroupTypes (obj: OPT.Object); VAR typ: OPT.Struct; h: OPT.Object; BEGIN IF obj # NIL THEN GroupTypes(obj.left); IF (obj.mode = Typ) THEN typ := obj^.typ; IF typ.form = Pointer THEN IF typ.BaseTyp.strobj # NIL THEN (* named base type *) Find(typ.BaseTyp.strobj.name, h); IF (h # NIL) & (h.typ.mno = 1) THEN obj.link := h; h.vis := -h.vis; (* prevent normal output of this type *) END ; END ; END END ; GroupTypes(obj.right); END END GroupTypes; PROCEDURE ReadSym (name: OPS.Name); VAR dummy: Texts.Reader; selfname: OPS.Name; BEGIN OPM.Init(dummy, Oberon.Log); OPS.Init; OPT.Init; OPT.OpenScope(0, NIL); selfname := ""; OPT.Import(name, name, selfname); GroupTypes(OPT.topScope.right.scope); END ReadSym; (* ---------------- user interface --------------- *) PROCEDURE Append (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR); VAR i, j: INTEGER; ch: CHAR; BEGIN i := 0; WHILE d[i] # 0X DO INC(i) END ; j := 0; REPEAT ch := s[j]; d[i] := ch; INC(i); INC(j) UNTIL ch = 0X END Append; PROCEDURE GetArgs (VAR S: Texts.Scanner); VAR text: Texts.Text; i, beg, end, time: LONGINT; BEGIN option := {}; Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = OptionChar) THEN Texts.Scan(S); IF S.class=Texts.Name THEN i := 0; WHILE S.s[i] # 0X DO CASE CAP(S.s[i]) OF | "X": INCL(option, expandTypes); | "D": INCL(option, showAdr); ELSE END ; INC(i); END ; Texts.Scan(S); END END ; IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time); IF time>=0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) ELSE S.class := Texts.Inval END ELSIF ~(S.class IN {Texts.Name, Texts.String}) OR (S.line # 0) THEN S.class := Texts.Inval; END ; IF ~LogMsgPrinted THEN Str(LogMsg); Ln; Texts.Append(Oberon.Log, W.buf); LogMsgPrinted := TRUE END ; END GetArgs; PROCEDURE QualIdent (name: ARRAY OF CHAR; VAR first, second: OPS.Name); VAR i, j: INTEGER; BEGIN i := 0; j := 0; WHILE (name[i] # ".") & (name[i] # 0X) DO first[j] := name[i]; IF name[i] = Directories.delimiter THEN j := 0 ELSE INC(j) END ; INC(i); END ; first[j] := 0X; INC(i); j := 0; WHILE name[i] # 0X DO second[j] := name[i]; INC(i); INC(j) END ; second[j] := 0X END QualIdent; PROCEDURE ShowDef*; (** [ "/" ["x"] ["d"] ] **) VAR S: Texts.Scanner; symname, mod, dummy: OPS.Name; f: Files.File; BEGIN GetArgs(S); IF S.class IN {Texts.Name, Texts.String} THEN QualIdent(S.s, mod, dummy); symname := mod; Append(symname, symFileExt); f := Files.Old(symname); IF f = NIL THEN Str(symname); Str(" not found"); Ln; Texts.Append(Oberon.Log, W.buf); RETURN END ; ReadSym(mod); IF OPM.noerr THEN showObj := FALSE; WriteModule(mod); Append(mod, ".Def"); DisplayW(mod) END END END ShowDef; PROCEDURE WriteDef*(VAR t: Texts.Text; name: ARRAY OF CHAR); VAR S: Texts.Scanner; symname, mod, dummy: OPS.Name; f: Files.File; BEGIN QualIdent(name, mod, dummy); symname := mod; Append(symname, symFileExt); f := Files.Old(symname); IF f = NIL THEN RETURN END ; ReadSym(mod); IF OPM.noerr THEN showObj := FALSE; WriteModule(mod); Texts.Append(t, W.buf); END END WriteDef; PROCEDURE ShowObj*; (** [ "/" ["x"] ["d"] ] **) VAR S: Texts.Scanner; symname, mod, objName, qualid: OPS.Name; obj: OPT.Object; f: Files.File; BEGIN GetArgs(S); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, qualid); QualIdent(S.s, mod, objName); symname := mod; Append(symname, symFileExt); f := Files.Old(symname); IF f = NIL THEN Str(symname); Str(" not found"); Ln; Texts.Append(Oberon.Log, W.buf); RETURN END ; ReadSym(mod); IF OPM.noerr THEN Find(objName, obj); IF obj # NIL THEN showObj := TRUE; first := TRUE; WriteObject(obj, obj^.mode); DisplayW(qualid) END END END END ShowObj; BEGIN Hex := "0123456789ABCDEF"; Texts.OpenWriter(W); LogMsgPrinted := FALSE; END Browser.