mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 01:42:24 +00:00
303 lines
10 KiB
Modula-2
303 lines
10 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 := Texts0, Console, Args;
|
|
|
|
CONST
|
|
OptionChar = "-";
|
|
(* 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;
|
|
|
|
(* module visibility of objects *)
|
|
internal = 0; external = 1; externalR = 2;
|
|
|
|
(* symbol file items *)
|
|
Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22;
|
|
Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30;
|
|
Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40;
|
|
|
|
VAR
|
|
W: Texts.Writer;
|
|
option: CHAR;
|
|
|
|
PROCEDURE Ws(s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END Ws;
|
|
PROCEDURE Wch(ch: CHAR); BEGIN Texts.Write(W, ch) END Wch;
|
|
PROCEDURE Wi(i: LONGINT); BEGIN Texts.WriteInt(W, i, 0) END Wi;
|
|
PROCEDURE Wln; BEGIN Texts.WriteLn(W) END Wln;
|
|
|
|
PROCEDURE Indent(i: INTEGER);
|
|
BEGIN WHILE i > 0 DO Wch(" "); Wch(" "); 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 Wch("(") END ;
|
|
WHILE par # NIL DO
|
|
IF ~first THEN Ws("; ") ELSE first := FALSE END ;
|
|
IF option = "x" THEN Wi(par^.adr); Wch(" ") END ;
|
|
IF par^.mode = VarPar THEN Ws("VAR ") END ;
|
|
Ws(par^.name); Ws(": "); Wtype(par^.typ);
|
|
par := par^.link
|
|
END ;
|
|
IF paren THEN Wch(")") END ;
|
|
IF res THEN Ws(": "); Wtype(result) END
|
|
END Wsign;
|
|
|
|
PROCEDURE Objects(obj: OPT.Object; mode: SET);
|
|
VAR i: LONGINT; m: INTEGER; s: SET; ext: OPT.ConstExt;
|
|
BEGIN
|
|
IF obj # NIL THEN
|
|
Objects(obj^.left, mode);
|
|
IF obj^.mode IN mode THEN
|
|
CASE obj^.mode OF
|
|
| Con:
|
|
Indent(2); Ws(obj^.name); Ws(" = ");
|
|
CASE obj^.typ^.form OF
|
|
| Bool:
|
|
IF obj^.conval^.intval = 1 THEN Ws("TRUE") ELSE Ws("FALSE") END
|
|
| Char:
|
|
IF (obj^.conval^.intval >= 32) & (obj^.conval^.intval <= 126) THEN
|
|
Wch(22X); Wch(CHR(obj^.conval^.intval)); Wch(22X)
|
|
ELSE
|
|
i := obj^.conval^.intval DIV 16;
|
|
IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END ;
|
|
i := obj^.conval^.intval MOD 16;
|
|
IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END ;
|
|
Wch("X")
|
|
END
|
|
| SInt, Int, LInt:
|
|
Wi(obj^.conval^.intval)
|
|
| Set:
|
|
Wch("{"); i := 0; s := obj^.conval^.setval;
|
|
WHILE i <= MAX(SET) DO
|
|
IF i IN s THEN Wi(i); EXCL(s, i);
|
|
IF s # {} THEN Ws(", ") END
|
|
END ;
|
|
INC(i)
|
|
END ;
|
|
Wch("}")
|
|
| Real:
|
|
Texts.WriteReal(W, SHORT(obj^.conval^.realval), 16)
|
|
| LReal:
|
|
Texts.WriteLongReal(W, obj^.conval^.realval, 23)
|
|
| String:
|
|
Ws(obj^.conval^.ext^)
|
|
| NilTyp:
|
|
Ws("NIL")
|
|
END ;
|
|
Wch(";"); Wln
|
|
| 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 ;
|
|
Wch(";"); Wln
|
|
END
|
|
| Var:
|
|
Indent(2); Ws(obj^.name);
|
|
IF obj^.vis = externalR THEN Ws("-: ") ELSE Ws(": ") END ;
|
|
Wtype(obj^.typ); Wch(";"); Wln
|
|
| XProc, CProc, IProc:
|
|
Indent(1); Ws("PROCEDURE ");
|
|
IF obj^.mode = IProc THEN Wch("+")
|
|
ELSIF obj^.mode = CProc THEN Wch("-")
|
|
END ;
|
|
Ws(obj^.name);
|
|
Wsign(obj^.typ, obj^.link);
|
|
IF obj^.mode = CProc THEN
|
|
ext := obj^.conval^.ext; m := ORD(ext^[0]); i := 1; Ws(' "');
|
|
WHILE i <= m DO Wch(ext^[i]); INC(i) END ;
|
|
Wch('"');
|
|
END ;
|
|
Wch(";"); Wln
|
|
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 = TProc) & ((obj^.name # OPM.HdTProcName) OR (option = "x")) THEN
|
|
Indent(3); Ws("PROCEDURE (");
|
|
IF obj^.name # OPM.HdTProcName THEN
|
|
IF obj^.link^.mode = 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);
|
|
Wch(";");
|
|
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
|
|
Wch("["); Wi(typ^.sysflag); Ws("] ")
|
|
END
|
|
END SysFlag;
|
|
|
|
BEGIN
|
|
CASE typ^.form OF
|
|
| Undef:
|
|
Ws("Undef")
|
|
| Pointer:
|
|
Ws("POINTER "); SysFlag; Ws("TO "); Wtype(typ^.BaseTyp)
|
|
| ProcTyp:
|
|
Ws("PROCEDURE "); SysFlag; Wsign(typ^.BaseTyp, typ^.link)
|
|
| Comp:
|
|
CASE typ^.comp OF
|
|
| Array:
|
|
Ws("ARRAY "); SysFlag; Wi(typ^.n); Ws(" OF "); Wtype(typ^.BaseTyp)
|
|
| DynArr:
|
|
Ws("ARRAY "); SysFlag; Ws("OF "); Wtype(typ^.BaseTyp)
|
|
| Record:
|
|
Ws("RECORD ");SysFlag;
|
|
IF typ^.BaseTyp # NIL THEN Wch("("); Wtype(typ^.BaseTyp); Wch(")") END ;
|
|
Wln; fld := typ^.link;
|
|
WHILE (fld # NIL) & (fld^.mode = Fld) DO
|
|
IF (option = "x") OR (fld^.name[0] # "@") THEN Indent(3);
|
|
IF option = "x" THEN Wi(fld^.adr); Wch(" ") END ;
|
|
Ws(fld^.name);
|
|
IF fld^.vis = externalR THEN Wch("-") END ;
|
|
Ws(": "); Wtype(fld^.typ); Wch(";");
|
|
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
|
|
END
|
|
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); Wch(".")
|
|
ELSIF (typ = OPT.bytetyp) OR (typ = OPT.sysptrtyp) THEN Ws("SYSTEM.")
|
|
ELSIF obj^.vis = internal THEN Wch("#")
|
|
END ;
|
|
Ws(obj^.name)
|
|
ELSE
|
|
IF (option = "x") & (typ^.ref > OPM.MaxStruct) THEN Wch("#"); Wi(typ^.ref - OPM.MaxStruct); Wch(" ") END ;
|
|
Wstruct(typ)
|
|
END
|
|
END Wtype;
|
|
|
|
PROCEDURE WModule(name: OPS.Name; T: Texts.Text);
|
|
VAR i: INTEGER;
|
|
beg, end: LONGINT; first, done: BOOLEAN;
|
|
|
|
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); Wch(";"); Wln; Wln;
|
|
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 Wch(";"); Wln END ;
|
|
CheckHeader;
|
|
Header("CONST"); Objects(OPT.GlbMod[0].right, {Con}); CheckHeader;
|
|
Header("TYPE"); Objects(OPT.GlbMod[0].right, {Typ}); CheckHeader;
|
|
Header("VAR"); Objects(OPT.GlbMod[0].right, {Var}); CheckHeader;
|
|
Objects(OPT.GlbMod[0].right, {XProc, IProc, CProc});
|
|
Wln;
|
|
Ws("END "); Ws(name); Wch("."); 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 ;
|
|
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 T, dummyT: Texts.Text; S, vname, name: OPS.Name; R: Texts.Reader; ch: CHAR;
|
|
s: ARRAY 1024 OF CHAR; i: INTEGER;
|
|
BEGIN
|
|
option := 0X; Args.Get(1, S);
|
|
IF Args.argc > 2 THEN
|
|
IF S[0] = OptionChar THEN option := S[1]; Args.Get(2, S)
|
|
ELSE Args.Get(2, vname); option := vname[1]
|
|
END
|
|
END ;
|
|
IF Args.argc >= 2 THEN
|
|
Ident(S, name);
|
|
NEW(T); Texts.Open(T, "");
|
|
OPT.Init(name, {}); OPT.SelfName := "AvoidErr154"; WModule(name, T); OPT.Close;
|
|
Texts.OpenReader(R, T, 0); Texts.Read(R, ch); i := 0;
|
|
WHILE ~R.eot DO
|
|
IF ch = 0DX THEN s[i] := 0X; i := 0; Console.String(s); Console.Ln
|
|
ELSE s[i] := ch; INC(i)
|
|
END ;
|
|
Texts.Read(R, ch)
|
|
END ;
|
|
s[i] := 0X; Console.String(s)
|
|
END
|
|
END ShowDef;
|
|
|
|
BEGIN
|
|
OPT.typSize := OPV.TypSize; Texts.OpenWriter(W); ShowDef
|
|
END BrowserCmd.
|