mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 00:32:24 +00:00
304 lines
11 KiB
Modula-2
304 lines
11 KiB
Modula-2
MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line version jt 4.4.95 *)
|
|
|
|
IMPORT
|
|
OPM, OPS, OPT, OPV,
|
|
Texts, Strings, Files, Out,
|
|
Oberon, Modules, SYSTEM, Configuration;
|
|
|
|
CONST
|
|
OptionChar = "-";
|
|
|
|
VAR
|
|
W: Texts.Writer;
|
|
option: CHAR;
|
|
|
|
PROCEDURE Ws(s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END Ws;
|
|
PROCEDURE Wc(ch: CHAR); BEGIN Texts.Write(W, ch) END Wc;
|
|
PROCEDURE Wi(i: SYSTEM.INT64); BEGIN Texts.WriteInt(W, i, 0) END Wi;
|
|
PROCEDURE Wln; BEGIN Texts.WriteLn(W) END Wln;
|
|
|
|
PROCEDURE Wh(i: SYSTEM.INT64);
|
|
BEGIN
|
|
IF i >= 16 THEN Wh(i DIV 10H)
|
|
ELSIF i >= 10 THEN Wc("0") END;
|
|
i := i MOD 16;
|
|
IF i < 10 THEN Wc(CHR(i+30H)) ELSE Wc(CHR(i+37H)) END
|
|
END Wh;
|
|
|
|
PROCEDURE Indent(i: INTEGER);
|
|
BEGIN WHILE i > 0 DO Wc(" "); Wc(" "); DEC(i) END
|
|
END Indent;
|
|
|
|
PROCEDURE ^Wtype(typ: OPT.Struct);
|
|
PROCEDURE ^Wstruct(typ: OPT.Struct);
|
|
|
|
PROCEDURE Wsign(result: OPT.Struct; par: OPT.Object);
|
|
VAR paren, res, first: BOOLEAN;
|
|
BEGIN first := TRUE;
|
|
res := (result # NIL) (* hidden mthd *) & (result # OPT.notyp);
|
|
paren := res OR (par # NIL);
|
|
IF paren THEN Wc("(") END;
|
|
WHILE par # NIL DO
|
|
IF ~first THEN Ws("; ") ELSE first := FALSE END;
|
|
IF option = "x" THEN Wi(par^.adr); Wc(" ") END;
|
|
IF par^.mode = OPT.VarPar THEN Ws("VAR ") END;
|
|
Ws(par^.name); Ws(": "); Wtype(par^.typ);
|
|
par := par^.link
|
|
END;
|
|
IF paren THEN Wc(")") END;
|
|
IF res THEN Ws(": "); Wtype(result) END
|
|
END Wsign;
|
|
|
|
PROCEDURE HasForm(obj: OPT.Object; mode: SET): BOOLEAN;
|
|
BEGIN
|
|
RETURN (obj # NIL)
|
|
& ( ((obj.mode IN mode) & (obj.name # ""))
|
|
OR HasForm(obj.left, mode)
|
|
OR HasForm(obj.right, mode));
|
|
END HasForm;
|
|
|
|
PROCEDURE Objects(obj: OPT.Object; mode: SET);
|
|
VAR i: SYSTEM.INT64; m: INTEGER; s: SYSTEM.SET64; ext: OPT.ConstExt;
|
|
BEGIN
|
|
IF obj # NIL THEN
|
|
Objects(obj^.left, mode);
|
|
IF obj^.mode IN mode THEN
|
|
CASE obj^.mode OF
|
|
|OPT.Con: Indent(2); Ws(obj^.name); Ws(" = ");
|
|
CASE obj^.typ^.form OF
|
|
|OPT.Bool: IF obj^.conval^.intval = 1 THEN Ws("TRUE") ELSE Ws("FALSE") END
|
|
|OPT.Char: IF (obj^.conval^.intval >= 32) & (obj^.conval^.intval <= 126) THEN
|
|
Wc(22X); Wc(CHR(obj^.conval^.intval)); Wc(22X)
|
|
ELSE
|
|
i := obj^.conval^.intval DIV 16;
|
|
IF i > 9 THEN Wc(CHR(55 + i)) ELSE Wc(CHR(48 + i)) END;
|
|
i := obj^.conval^.intval MOD 16;
|
|
IF i > 9 THEN Wc(CHR(55 + i)) ELSE Wc(CHR(48 + i)) END;
|
|
Wc("X")
|
|
END
|
|
|OPT.Int: Wi(obj^.conval^.intval)
|
|
|OPT.Set: Wc("{"); i := 0; s := obj^.conval^.setval;
|
|
WHILE i <= MAX(SYSTEM.SET64) DO
|
|
IF i IN s THEN Wi(i); EXCL(s, i);
|
|
IF s # {} THEN Ws(", ") END
|
|
END;
|
|
INC(i)
|
|
END;
|
|
Wc("}")
|
|
|OPT.Real: Texts.WriteReal(W, SHORT(obj^.conval^.realval), 16)
|
|
|OPT.LReal: Texts.WriteLongReal(W, obj^.conval^.realval, 23)
|
|
|OPT.String: Wc('"'); Ws(obj^.conval^.ext^); Wc('"')
|
|
|OPT.NilTyp: Ws("NIL")
|
|
ELSE (* Ignore other forms *)
|
|
END;
|
|
Wc(";"); Wln
|
|
|OPT.Typ: IF obj^.name # "" THEN Indent(2);
|
|
IF obj^.typ^.strobj = obj THEN (* canonical name *)
|
|
Wtype(obj^.typ); Ws(" = "); Wstruct(obj^.typ)
|
|
ELSE (* alias *)
|
|
Ws(obj^.name); Ws(" = "); Wtype(obj^.typ)
|
|
END;
|
|
Wc(";"); Wln
|
|
END
|
|
|OPT.Var: Indent(2); Ws(obj^.name);
|
|
IF obj^.vis = OPT.externalR THEN Ws("-: ") ELSE Ws(": ") END;
|
|
Wtype(obj^.typ); Wc(";"); Wln
|
|
|OPT.XProc,
|
|
OPT.CProc,
|
|
OPT.IProc: Indent(1); Ws("PROCEDURE ");
|
|
IF obj^.mode = OPT.IProc THEN Wc("+")
|
|
ELSIF obj^.mode = OPT.CProc THEN Wc("-")
|
|
END;
|
|
Ws(obj^.name);
|
|
Wsign(obj^.typ, obj^.link);
|
|
IF obj^.mode = OPT.CProc THEN
|
|
ext := obj^.conval^.ext; m := ORD(ext^[0]); i := 1; Ws(' "');
|
|
WHILE i <= m DO Wc(ext^[i]); INC(i) END;
|
|
Wc('"');
|
|
END;
|
|
Wc(";"); Wln
|
|
ELSE (* Ignore other modes *)
|
|
END
|
|
END;
|
|
Objects(obj^.right, mode)
|
|
END
|
|
END Objects;
|
|
|
|
PROCEDURE Wmthd(obj: OPT.Object);
|
|
VAR
|
|
BEGIN
|
|
IF obj # NIL THEN
|
|
Wmthd(obj^.left);
|
|
IF (obj^.mode = OPT.TProc) & ((obj^.name # OPM.HdTProcName) OR (option = "x")) THEN
|
|
Indent(3); Ws("PROCEDURE (");
|
|
IF obj^.name # OPM.HdTProcName THEN
|
|
IF obj^.link^.mode = OPT.VarPar THEN Ws("VAR ") END;
|
|
Ws(obj^.link^.name); Ws(": "); Wtype(obj^.link^.typ)
|
|
END;
|
|
Ws(") "); Ws(obj^.name);
|
|
Wsign(obj^.typ, obj^.link^.link);
|
|
Wc(";");
|
|
IF option = "x" THEN Indent(1);
|
|
Ws("(* methno: "); Wi(obj^.adr DIV 10000H); Ws(" *)")
|
|
END;
|
|
Wln;
|
|
END;
|
|
Wmthd(obj^.right)
|
|
END
|
|
END Wmthd;
|
|
|
|
PROCEDURE Wstruct(typ: OPT.Struct);
|
|
VAR fld: OPT.Object;
|
|
|
|
PROCEDURE SysFlag;
|
|
BEGIN IF typ^.sysflag # 0 THEN Wc("["); Wh(typ^.sysflag); Ws("H] ") END
|
|
END SysFlag;
|
|
|
|
BEGIN
|
|
CASE typ^.form OF
|
|
|OPT.Undef: Ws("Undef")
|
|
|OPT.Pointer: Ws("POINTER "); SysFlag; Ws("TO "); Wtype(typ^.BaseTyp)
|
|
|OPT.ProcTyp: Ws("PROCEDURE "); SysFlag; Wsign(typ^.BaseTyp, typ^.link)
|
|
|OPT.Comp: CASE typ^.comp OF
|
|
|OPT.Array: Ws("ARRAY "); SysFlag; Wi(typ^.n); Ws(" OF "); Wtype(typ^.BaseTyp)
|
|
|OPT.DynArr: Ws("ARRAY "); SysFlag; Ws("OF "); Wtype(typ^.BaseTyp)
|
|
|OPT.Record: Ws("RECORD ");SysFlag;
|
|
IF typ^.BaseTyp # NIL THEN Wc("("); Wtype(typ^.BaseTyp); Wc(")") END;
|
|
Wln; fld := typ^.link;
|
|
WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO
|
|
IF (option = "x") OR (fld^.name[0] # "@") THEN Indent(3);
|
|
IF option = "x" THEN Wi(fld^.adr); Wc(" ") END;
|
|
Ws(fld^.name);
|
|
IF fld^.vis = OPT.externalR THEN Wc("-") END;
|
|
Ws(": "); Wtype(fld^.typ); Wc(";");
|
|
Wln
|
|
END;
|
|
fld := fld^.link
|
|
END;
|
|
Wmthd(typ^.link);
|
|
Indent(2); Ws("END");
|
|
IF option = "x" THEN Indent(1);
|
|
Ws("(* size: "); Wi(typ^.size); Ws(" align: "); Wi(typ^.align);
|
|
Ws(" nofm: "); Wi(typ^.n); Ws(" *)")
|
|
END
|
|
ELSE (* Ignore other comps *)
|
|
END
|
|
ELSE (* Ignore other froms *)
|
|
END
|
|
END Wstruct;
|
|
|
|
PROCEDURE Wtype(typ: OPT.Struct);
|
|
VAR obj: OPT.Object;
|
|
BEGIN
|
|
obj := typ^.strobj;
|
|
IF obj^.name # "" THEN
|
|
IF typ^.mno # 0 THEN Ws(OPT.GlbMod[typ^.mno].name); Wc(".")
|
|
ELSIF (typ = OPT.bytetyp) OR (typ = OPT.sysptrtyp) THEN Ws("SYSTEM.")
|
|
ELSIF obj^.vis = OPT.internal THEN Wc("#")
|
|
END;
|
|
Ws(obj^.name)
|
|
ELSE
|
|
IF (option = "x") & (typ^.ref > OPM.MaxStruct) THEN Wc("#"); Wi(typ^.ref - OPM.MaxStruct); Wc(" ") END;
|
|
Wstruct(typ)
|
|
END
|
|
END Wtype;
|
|
|
|
PROCEDURE WModule(name: OPS.Name; T: Texts.Text);
|
|
VAR
|
|
i: INTEGER;
|
|
beg, end: LONGINT;
|
|
first, done: BOOLEAN;
|
|
obj: OPT.Object;
|
|
|
|
PROCEDURE Header(s: ARRAY OF CHAR);
|
|
BEGIN
|
|
beg := W.buf.len; Indent(1); Ws(s); Wln; end := W.buf.len
|
|
END Header;
|
|
|
|
PROCEDURE CheckHeader;
|
|
VAR len: LONGINT;
|
|
BEGIN
|
|
len := T.len;
|
|
IF end = W.buf.len THEN Texts.Append(T, W.buf); Texts.Delete(T, len+beg, len+end)
|
|
ELSE Wln
|
|
END
|
|
END CheckHeader;
|
|
|
|
BEGIN
|
|
OPT.Import("@notself", name, done);
|
|
IF done THEN
|
|
Ws("DEFINITION "); Ws(name); Wc(";"); Wln;
|
|
|
|
IF OPT.nofGmod > 1 THEN
|
|
Header("IMPORT"); i := 1; first := TRUE;
|
|
WHILE i < OPT.nofGmod DO
|
|
IF first THEN first := FALSE; Indent(2) ELSE Ws(", ") END;
|
|
Ws(OPT.GlbMod[i].name);
|
|
INC(i)
|
|
END;
|
|
IF ~first THEN Wc(";"); Wln END
|
|
END;
|
|
CheckHeader;
|
|
obj := OPT.GlbMod[0].right;
|
|
IF HasForm(obj, {OPT.Con}) THEN Header("CONST"); Objects(obj, {OPT.Con}); CheckHeader END;
|
|
IF HasForm(obj, {OPT.Typ}) THEN Header("TYPE"); Objects(obj, {OPT.Typ}); CheckHeader END;
|
|
IF HasForm(obj, {OPT.Var}) THEN Header("VAR"); Objects(obj, {OPT.Var}); CheckHeader END;
|
|
Objects(obj, {OPT.XProc, OPT.IProc, OPT.CProc}); Wln;
|
|
Ws("END "); Ws(name); Wc("."); Wln; Texts.Append(T, W.buf)
|
|
ELSE
|
|
Texts.WriteString(W, name); Texts.WriteString(W, " -- symbol file not found");
|
|
Texts.WriteLn(W); Texts.Append(T, W.buf)
|
|
END
|
|
END WModule;
|
|
|
|
PROCEDURE Ident(VAR name, first: ARRAY OF CHAR);
|
|
VAR i, j: INTEGER; ch: CHAR;
|
|
BEGIN i := 0;
|
|
WHILE name[i] # 0X DO INC(i) END;
|
|
WHILE (i >= 0) & (name[i] # "/") DO DEC(i) END;
|
|
IF i > 0 THEN name[i] := 0X; Files.SetSearchPath(name) END;
|
|
INC(i); j := 0; ch := name[i];
|
|
WHILE (ch # ".") & (ch # 0X) DO first[j] := ch; INC(i); INC(j); ch := name[i] END;
|
|
first[j] := 0X
|
|
END Ident;
|
|
|
|
PROCEDURE ShowDef*;
|
|
VAR S, vname, name: OPS.Name;
|
|
BEGIN
|
|
option := 0X; Modules.GetArg(1, S);
|
|
IF Modules.ArgCount > 2 THEN
|
|
IF S[0] = OptionChar THEN option := S[1]; Modules.GetArg(2, S)
|
|
ELSE Modules.GetArg(2, vname); option := vname[1]
|
|
END
|
|
END;
|
|
IF Modules.ArgCount >= 2 THEN
|
|
Ident(S, name);
|
|
OPT.Init(name, {}); OPT.SelfName := "AvoidErr154";
|
|
WModule(name, Oberon.Log);
|
|
OPT.Close;
|
|
ELSE
|
|
Ws("showdef - Display module's public interface."); Wln;
|
|
Wln;
|
|
Ws("Usage: showdef module"); Wln;
|
|
Wln;
|
|
Ws("Where <module> is a symbol file name. The .sym may be omitted."); Wln;
|
|
Ws("If no path is provided, and the module does not exist in the current directory,"); Wln;
|
|
Ws("then showdef will also look for the module in the installed libraries."); Wln;
|
|
Texts.Append(Oberon.Log, W.buf)
|
|
END
|
|
END ShowDef;
|
|
|
|
PROCEDURE SetDefaultPath;
|
|
VAR path: ARRAY 256 OF CHAR;
|
|
BEGIN
|
|
path := ".;";
|
|
Strings.Append(Configuration.installdir, path);
|
|
Strings.Append("/2/sym", path);
|
|
Files.SetSearchPath(path)
|
|
END SetDefaultPath;
|
|
|
|
BEGIN
|
|
Texts.OpenWriter(W);
|
|
SetDefaultPath;
|
|
ShowDef
|
|
END BrowserCmd.
|