home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / browser.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  25KB  |  725 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Browser; (* J.Templ 16.8.89/23.04.92 *)
  3.  IMPORT SYSTEM, Files, Texts, MenuViewers, TextFrames, Oberon;
  4.  CONST
  5.   IdBufLeng = 12000;
  6.   IdBufLim = IdBufLeng - 100;
  7.   maxImps = 30;
  8.   SFtag = 0F9X;
  9.   firstStr = 16;
  10.  (*object modes*)
  11.   Var =  1; Ind =  2; Con =  3; Fld = 4; Typ = 5; XProc = 6;
  12.   CProc = 7; IProc = 8; Mod = 9; Head = 10; TProc = 11;
  13.  (*Structure forms*)
  14.   Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  15.   Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  16.   Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
  17.   optionChar = "\";
  18.  TYPE
  19.   Object = POINTER TO ObjDesc;
  20.   Struct = POINTER TO StrDesc;
  21.   ObjDesc = RECORD
  22.    left, right, link: Object;
  23.    typ:  Struct;
  24.    name: INTEGER;
  25.    mode: SHORTINT;
  26.    marked: BOOLEAN;
  27.    a0, a1:  LONGINT; (* a0 gives org in module list *)
  28.    next: Object;   (* next module *)
  29.   END ;
  30.   StrDesc = RECORD
  31.    form, mno, ref, level: SHORTINT;
  32.    n, size, adr: LONGINT; (* adr gives org in type hierarchy *)
  33.    BaseTyp: Struct;
  34.    link, strobj: Object;
  35.    sub, next: Struct (* type hierarchy *)
  36.   END ;
  37.   W: Texts.Writer;
  38.   id: INTEGER;
  39.   err: BOOLEAN;
  40.   universe, topScope: Object;
  41.   undftyp, bytetyp, booltyp, chartyp, sinttyp, inttyp, linttyp,
  42.   realtyp, lrltyp, settyp, stringtyp, niltyp, notyp, sysptrtyp: Struct;
  43.   nofGmod: INTEGER;   (*nof imports*)
  44.   option: CHAR;
  45.   first, showObj: BOOLEAN;
  46.   GlbMod: ARRAY maxImps OF Object;
  47.   IdBuf: ARRAY IdBufLeng OF CHAR;
  48.   types: Struct;
  49.   symFileExt: ARRAY 8 OF CHAR;
  50.   (*needed for detecting import of SYSTEM *)
  51.   syspos: LONGINT;
  52.   impSystem: BOOLEAN; (* insert "SYSTEM, " at imppos or " IMPORT SYSTEM; cr cr" at -imppos *)
  53.  PROCEDURE Ws(s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END Ws;
  54.  PROCEDURE Wch(ch: CHAR); BEGIN Texts.Write(W, ch) END Wch;
  55.  PROCEDURE Wln; BEGIN Texts.WriteLn(W) END Wln;
  56.  PROCEDURE WriteName(obj: Object);
  57.   VAR name: ARRAY 32 OF CHAR; i, n: INTEGER;
  58.  BEGIN n := obj^.name;
  59.   i := -1; REPEAT INC(i); name[i] := IdBuf[n + i] UNTIL name[i] = 0X;
  60.   Ws(name)
  61.  END WriteName;
  62.  PROCEDURE WAdr(obj: Object);
  63.  BEGIN IF option = "X" THEN Texts.WriteInt(W, obj^.a0, 0); Wch(" ") END
  64.  END WAdr;
  65.  PROCEDURE Indent(i: INTEGER);
  66.  BEGIN WHILE i > 0 DO Ws("  "); DEC(i) END
  67.  END Indent;
  68.  PROCEDURE WriteRecords(typ: Struct; i: INTEGER);
  69.  BEGIN
  70.   WHILE typ # NIL DO
  71.    Indent(i);
  72.    WriteName(GlbMod[typ.mno]); Wch("."); WriteName(typ.strobj);
  73.    Wln; WriteRecords(typ^.sub, i + 1);
  74.    typ := typ^.next
  75.   END
  76.  END WriteRecords;
  77.  PROCEDURE WriteModules(m: Object);
  78.  BEGIN
  79.   WHILE m # NIL DO
  80.    m^.a0 := W.buf.len;
  81.    WriteName(m); Wln;
  82.    m := m^.next
  83.   END
  84.  END WriteModules;
  85.  PROCEDURE^ WriteType(typ: Struct; i: INTEGER);
  86.  PROCEDURE WriteBase(typ: Struct);
  87.   VAR base: Struct;
  88.  BEGIN base := typ^.BaseTyp;
  89.   IF (base # NIL) & (base^.strobj^.marked OR (option = "X")) THEN
  90.    Ws(" ("); WriteType(typ^.BaseTyp, 0);
  91.    IF option = "x" THEN WriteBase(typ^.BaseTyp) END ;
  92.    Wch(")")
  93.   END;
  94.  END WriteBase;
  95.  PROCEDURE WriteFields(VAR obj: Object; i: INTEGER);
  96.   VAR typ: Struct; mode: INTEGER;
  97.  BEGIN typ := obj^.typ; mode := obj^.mode;
  98.   LOOP
  99.    WAdr(obj); WriteName(obj);
  100.    IF obj^.marked THEN Wch("-") END ;
  101.    obj := obj^.link;
  102.    IF (obj = NIL) OR (obj^.mode # mode) OR (obj^.typ # typ) THEN EXIT END ;
  103.    Ws(", ")
  104.   END ;
  105.   Ws(": "); WriteType(typ, i + 1)
  106.  END WriteFields;
  107.  PROCEDURE WriteParams(param: Object; res: Struct);
  108.  BEGIN
  109.   IF (param # NIL) OR (res # notyp) THEN
  110.    Ws(" (");
  111.    WHILE (param # NIL) DO
  112.     IF param.mode = Ind THEN Ws("VAR ") END ;
  113.     IF param.name = 0 THEN
  114.      WriteType(param.typ, 0);
  115.      param := param.link;
  116.      IF param # NIL THEN Ws(", ") END
  117.     ELSE
  118.      WriteFields(param, 0);
  119.      IF param # NIL THEN Ws("; ") END
  120.     END
  121.    END ;
  122.    Wch(")");
  123.   END ;
  124.   IF res # notyp THEN Ws(": "); WriteType(res, 0) END
  125.  END WriteParams;
  126.  PROCEDURE WriteFieldList(obj: Object; i: INTEGER);
  127.  BEGIN
  128.   WHILE (obj # NIL) & (obj^.mode = Fld) DO
  129.    Indent(i); WriteFields(obj, i); Wch(";"); Wln
  130.   END ;
  131.   WHILE (obj # NIL) & (obj^.mode = TProc) DO
  132.    Indent(i);
  133.    IF option = "X" THEN Texts.WriteInt(W, obj^.a0 MOD 10000H,1); Wch(" ");
  134.     Texts.WriteInt(W, obj^.a0 DIV 10000H,1); Wch(" ")
  135.    END ;
  136.    Ws("PROCEDURE (");
  137.    IF obj^.right^.mode = Ind THEN Ws("VAR ") END ;
  138.    WAdr(obj^.right);
  139.    WriteName(obj^.right);
  140.    Ws(": ");
  141.    WriteName(obj^.right^.typ^.strobj);
  142.    Ws(") ");
  143.    WriteName(obj);
  144.    WriteParams(obj^.right^.link, obj^.typ);
  145.    Wch(";"); Wln;
  146.    obj := obj^.link
  147.   END
  148.  END WriteFieldList;
  149.  PROCEDURE WriteInstVars(typ: Struct; i: INTEGER);
  150.  BEGIN
  151.   IF typ # NIL THEN
  152.    IF option = "x" THEN WriteInstVars(typ^.BaseTyp, i) END;
  153.    WriteFieldList(typ^.link, i);
  154.   END
  155.  END WriteInstVars;
  156.  PROCEDURE WriteForm(typ: Struct; i: INTEGER);
  157.   VAR param, p: Object;
  158.  BEGIN
  159.   IF typ^.form = Record THEN
  160.    Ws("RECORD"); WriteBase(typ);
  161.    IF option = "X" THEN Wch(" "); Texts.WriteInt(W, typ^.size, 1); Wch(" ") END ;
  162.    IF (typ^.link # NIL) OR (option = "x") THEN Wln; WriteInstVars(typ, i); Indent(i - 1) ELSE Wch(" ") END ;
  163.    Ws("END ")
  164.   ELSIF typ^.form = Array THEN
  165.    Ws("ARRAY "); Texts.WriteInt(W, typ^.n, 0); Ws(" OF "); WriteType(typ^.BaseTyp, i)
  166.   ELSIF typ^.form = DynArr THEN
  167.    Ws("ARRAY OF "); WriteType(typ^.BaseTyp, i)
  168.   ELSIF typ^.form = Pointer THEN
  169.    Ws("POINTER TO "); WriteType(typ^.BaseTyp, i)
  170.   ELSIF typ^.form = ProcTyp THEN
  171.    Ws("PROCEDURE");
  172.    WriteParams(typ^.link, typ^.BaseTyp)
  173.   END
  174.  END WriteForm;
  175.  PROCEDURE WriteType(typ: Struct; i: INTEGER);
  176.  BEGIN
  177.   IF typ^.strobj # NIL THEN
  178.    IF (typ = bytetyp) OR (typ = sysptrtyp) THEN impSystem := TRUE END ;
  179.    IF (typ^.mno > 1) OR ((typ^.mno = 1) & showObj) THEN WriteName(GlbMod[typ^.mno]); Wch(".") END ;
  180.    WriteName(typ^.strobj)
  181.   ELSE WriteForm(typ, i)
  182.   END
  183.  END WriteType;
  184.  PROCEDURE WriteProc(obj: Object);
  185.   VAR param: Object; i: LONGINT;
  186.  BEGIN
  187.   IF (option = "X") & (obj^.mode # CProc) THEN Texts.WriteInt(W, obj^.a0, 2); Indent(1) END ;
  188.   Ws("PROCEDURE "); WriteName(obj);
  189.   WriteParams(obj^.link, obj^.typ);
  190.   IF (option = "X") & (obj^.mode = CProc) THEN Wch(" "); i := 0;
  191.    WHILE i < obj^.a1 DO
  192.     Texts.WriteInt(W, ORD(IdBuf[obj^.a0 + i]), 1); INC(i);
  193.     IF i < obj^.a1 THEN Ws(", ") END
  194.    END ;
  195.   END ;
  196.   Wch(";")
  197.  END WriteProc;
  198.  PROCEDURE WriteVal(obj: Object);
  199.   VAR i: INTEGER; lr: LONGREAL; s: SET; ch: CHAR;
  200.  BEGIN
  201.   CASE obj.typ^.form OF
  202.    SInt, Int, LInt: Texts.WriteInt(W, obj^.a0, 0) |
  203.    Real: Texts.WriteReal(W, SYSTEM.VAL(REAL, obj^.a0), 15) |
  204.    LReal: SYSTEM.MOVE(SYSTEM.ADR(obj^.a0), SYSTEM.ADR(lr), 8); Texts.WriteLongReal(W, lr, 23) |
  205.    Bool: IF obj^.a0 = 0 THEN Ws("FALSE") ELSE Ws("TRUE") END |
  206.    Char: IF (obj^.a0 >= 32) & (obj^.a0 <= 126) THEN
  207.        Wch(22X); Wch(CHR(obj^.a0)); Wch(22X)
  208.       ELSE
  209.        i := SHORT(obj^.a0 DIV 16);
  210.        IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END;
  211.        i := SHORT(obj^.a0 MOD 16);
  212.        IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END;
  213.        Wch("X")
  214.       END |
  215.    Set: Wch("{"); i := 0; s := SYSTEM.VAL(SET, obj^.a0);
  216.       WHILE i <= MAX(SET) DO
  217.        IF i IN s THEN Texts.WriteInt(W, i, 0); EXCL(s, i);
  218.         IF s # {} THEN Ws(", ") END
  219.        END ;
  220.        INC(i)
  221.       END ;
  222.       Wch("}") |
  223.    NilTyp: Ws("NIL") |
  224.    String: i := SHORT(obj^.a0); ch := IdBuf[i]; Wch(22X);
  225.       WHILE ch # 0X DO Wch(ch); INC(i); ch := IdBuf[i] END ;
  226.       Wch(22X)
  227.   END
  228.  END WriteVal;
  229.  PROCEDURE WriteObject(VAR obj: Object; mode: INTEGER);
  230.   VAR typ: Struct;
  231.  BEGIN
  232.   IF mode = Con THEN
  233.    IF first THEN Indent(1); Ws("CONST"); Wln; first := FALSE END;
  234.    Indent(2); WriteName(obj); Ws(" = "); WriteVal(obj); Wch(";");
  235.    Wln
  236.   ELSIF mode = Var THEN
  237.    IF first THEN Indent(1); Ws("VAR"); Wln; first := FALSE END;
  238.    Indent(2);
  239.    LOOP
  240.     WAdr(obj); WriteName(obj); typ := obj^.typ;
  241.     IF obj^.marked THEN Wch("-") END ;
  242.     WHILE (obj^.right # NIL) & (obj^.right^.mode # Var) DO obj := obj^.right END ;
  243.     IF (obj^.right = NIL) OR (obj^.right^.typ # typ) THEN EXIT END ;
  244.     Ws(", "); obj := obj^.right
  245.    END ;
  246.    Ws(": "); WriteType(typ, 3); Wch(";");
  247.    Wln
  248.   ELSIF (mode = Typ) & (obj^.marked) THEN
  249.    IF first THEN Indent(1); Ws("TYPE"); Wln; first := FALSE END;
  250.    Indent(2); WriteName(obj); Ws(" = ");
  251.    IF obj^.typ^.strobj # obj THEN WriteType(obj^.typ, 0) (* alias type *)
  252.    ELSE WriteForm(obj^.typ, 3)
  253.    END ;
  254.    Wch(";"); Wln;
  255.    IF showObj THEN
  256.     IF (obj^.typ^.form = Pointer) & (obj^.typ^.BaseTyp^.strobj # NIL) THEN
  257.      WriteObject(obj^.typ^.BaseTyp^.strobj, obj^.typ^.BaseTyp^.strobj.mode)
  258.     END
  259.    ELSIF (obj^.typ^.form # Pointer) OR (obj^.typ^.BaseTyp^.strobj = NIL) THEN Wln
  260.    END ;
  261.   ELSIF mode IN {XProc, CProc} THEN first := FALSE; Indent(1); WriteProc(obj); Wln
  262.   ELSIF mode = Mod THEN
  263.    IF first THEN Indent(1); Ws("IMPORT "); first := FALSE; syspos := W.buf.len ELSE Ws(", ") END;
  264.    WriteName(obj);
  265.    IF option = "X" THEN Texts.WriteHex(W, obj^.a1) END
  266.   END
  267.  END WriteObject;
  268.  PROCEDURE WriteScope(obj: Object; mode: INTEGER);
  269.  BEGIN
  270.   first := TRUE;
  271.   WHILE obj # NIL DO
  272.    IF (obj.mode = mode) OR ((mode = XProc) & (obj.mode = CProc)) THEN WriteObject(obj, mode) END ;
  273.    obj := obj^.right
  274.   END ;
  275.   IF ~first THEN
  276.    IF mode = Mod THEN Wch(";"); Wln END ;
  277.    Wln
  278.   END
  279.  END WriteScope;
  280.  PROCEDURE ReorderTypes(mod: Object); (* make <pointer, record> pairs *)
  281.   VAR p, q, head, h: Object; typ: Struct;
  282.  BEGIN q := mod^.link;
  283.   NEW(head); head^.right := q;
  284.   WHILE q # NIL DO
  285.    IF (q.mode = Typ) & (q^.typ^.form = Pointer) & (q^.typ^.BaseTyp^.strobj # NIL) THEN
  286.     p := head; typ := q^.typ^.BaseTyp;
  287.     WHILE (p^.right # NIL) & ((p^.right^.mode # Typ) OR (p^.right^.typ # typ)) DO p := p^.right END ;
  288.     IF p^.right # NIL THEN
  289.      h := p^.right; p^.right := h^.right; h^.right := q^.right; q^.right := h
  290.     END
  291.    END ;
  292.    q := q^.right
  293.   END ;
  294.   mod^.link := head^.right
  295.  END ReorderTypes;
  296.  PROCEDURE WriteModule(mod: Object);
  297.  BEGIN
  298.   Ws("DEFINITION "); WriteName(mod);
  299.   IF option = "X" THEN Texts.WriteHex(W, mod^.a1) END ;
  300.   Wch(";"); Wln; Wln;
  301.   syspos := - W.buf.len; impSystem := FALSE;
  302.   WriteScope(mod^.link, Mod);
  303.   WriteScope(mod^.link, Con);
  304.   ReorderTypes(mod); WriteScope(mod^.link, Typ);
  305.   WriteScope(mod^.link, Var);
  306.   WriteScope(mod^.link, XProc);
  307.   Ws("END "); WriteName(mod); Wch(".");
  308.   Wln
  309.  END WriteModule;
  310.  PROCEDURE Diff(i, j: INTEGER): INTEGER;
  311.   VAR d: INTEGER; ch: CHAR;
  312.  BEGIN
  313.   REPEAT ch := IdBuf[i]; d := ORD(ch) - ORD(IdBuf[j]); INC(i); INC(j)
  314.   UNTIL (d # 0) OR (ch = 0X);
  315.   RETURN d
  316.  END Diff;
  317.  PROCEDURE Index(name: ARRAY OF CHAR): INTEGER;
  318.   VAR id0, j: INTEGER; ch: CHAR; (*enter identifier*)
  319.  BEGIN
  320.   id0 := id; j := 0;
  321.   IF id < IdBufLim THEN
  322.    REPEAT ch := name[j]; IdBuf[id] := ch; INC(id); INC(j)
  323.    UNTIL ch = 0X
  324.   ELSE err := TRUE
  325.   END ;
  326.   RETURN id0
  327.  END Index;
  328.  PROCEDURE Insert(name: INTEGER; VAR obj: Object);
  329.   VAR d: INTEGER; ob0, ob1: Object;
  330.  BEGIN
  331.   ob0 := topScope; ob1 := ob0^.right; d := 1;
  332.   LOOP
  333.    IF ob1 # NIL THEN
  334.     d := Diff(name, ob1^.name);
  335.     IF d < 0 THEN ob0 := ob1; ob1 := ob0^.left
  336.     ELSIF d > 0 THEN ob0 := ob1; ob1 := ob0^.right
  337.     ELSE ob1 := NIL (* already defined, cause duplication *)
  338.     END
  339.    ELSE (*insert*) NEW(ob1);
  340.     IF d < 0 THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ;
  341.     ob1^.left := NIL; ob1^.right := NIL; ob1^.name := name;
  342.     ob1^.marked := FALSE; EXIT
  343.    END
  344.   END ;
  345.   obj := ob1
  346.  END Insert;
  347.  PROCEDURE InsertSubClass(base, sub: Struct);
  348.   VAR prev: Struct;
  349.   PROCEDURE Less(typ1, typ2: Struct): BOOLEAN; (* return typ1 < typ2 *)
  350.    VAR i: INTEGER;
  351.   BEGIN
  352.    i := Diff(GlbMod[typ1^.mno]^.name, GlbMod[typ2^.mno]^.name);
  353.    IF i < 0 THEN RETURN TRUE
  354.    ELSIF i = 0 THEN RETURN Diff(typ1^.strobj^.name, typ2^.strobj^.name) < 0
  355.    ELSE RETURN FALSE
  356.    END
  357.   END Less;
  358.  BEGIN
  359.   IF base = NIL THEN base := types END ;
  360.   prev := base^.sub;
  361.   IF (prev = NIL) OR Less(sub, prev) THEN
  362.    sub^.next := base^.sub; base^.sub := sub
  363.   ELSE
  364.    WHILE (prev^.next # NIL) & Less(prev^.next, sub) DO prev := prev^.next END;
  365.    sub^.next := prev^.next; prev^.next := sub
  366.   END
  367.  END InsertSubClass;
  368.  PROCEDURE InsertImport(obj, root: Object; VAR old: Object);
  369.   VAR ob0, ob1: Object; d: INTEGER;
  370.  BEGIN ob0 := root; ob1 := ob0^.right; d := 1;
  371.   LOOP
  372.    IF ob1 # NIL THEN
  373.     d := Diff(obj^.name, ob1^.name);
  374.     IF d = 0 THEN old := ob1; EXIT
  375.     ELSE ob0 := ob1; ob1 := ob1^.right
  376.     END
  377.    ELSE ob1 := obj; ob0^.right := ob1;
  378.     ob1^.left := NIL; ob1^.right := NIL; old := NIL; EXIT
  379.    END
  380.   END
  381.  END InsertImport;
  382.  PROCEDURE Append(VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
  383.   VAR i, j: INTEGER; ch: CHAR;
  384.  BEGIN
  385.   i := 0; WHILE d[i] # 0X DO INC(i) END ;
  386.   j := 0; REPEAT ch := s[j]; d[i] := ch; INC(i); INC(j) UNTIL ch = 0X
  387.  END Append;
  388.  PROCEDURE ReadSym(name: ARRAY OF CHAR; VAR obj: Object);
  389.   VAR i, j, m, s, h, h1, h2, class: INTEGER; k: LONGINT;
  390.     nofLmod, strno, parlev, fldlev: INTEGER;
  391.     old, mod: Object;
  392.     typ: Struct;
  393.     ch: CHAR;
  394.     si: SHORTINT;
  395.     xval: REAL; yval: LONGREAL;
  396.     LocMod:  ARRAY maxImps OF Object;
  397.     struct:  ARRAY 255 OF Struct;
  398.     param, lastpar, fldlist, lastfld: ARRAY 6 OF Object;
  399.     FileName: ARRAY 32 OF CHAR;
  400.     SymFile: Files.File;
  401.     SF: Files.Rider;
  402.   PROCEDURE ReadXInt (VAR k: LONGINT); BEGIN Files.ReadNum(SF, k);  END ReadXInt;
  403.   PROCEDURE ReadLInt (VAR k: LONGINT); BEGIN Files.ReadNum(SF, k) END ReadLInt;
  404.   PROCEDURE ReadInt (VAR k: INTEGER); VAR i: LONGINT; BEGIN Files.ReadNum(SF, i); k := SHORT(i) END ReadInt;
  405.   PROCEDURE ReadId;
  406.    VAR i: INTEGER; ch: CHAR;
  407.   BEGIN i := id;
  408.    REPEAT
  409.     Files.Read(SF, ch); IdBuf[i] := ch; INC(i)
  410.    UNTIL ch = 0X;
  411.    id := i
  412.   END ReadId;
  413.   PROCEDURE Err(s: ARRAY OF CHAR);
  414.   BEGIN
  415.    Ws(name); Ws(" -- "); Ws(s);
  416.    Wln; Texts.Append(Oberon.Log, W.buf)
  417.   END Err;
  418.   PROCEDURE reverseList(p: Object);
  419.    VAR q, r: Object;
  420.   BEGIN q := NIL;
  421.    WHILE p # NIL DO
  422.     r := p^.link; p^.link := q; q := p; p := r
  423.    END
  424.   END reverseList;
  425.   PROCEDURE AppendObj(VAR p: Object; obj: Object);
  426.    VAR r: Object;
  427.   BEGIN
  428.    IF p = NIL THEN p := obj
  429.    ELSE r := p; WHILE r^.link # NIL DO r := r^.link END ;
  430.     r^.link := obj
  431.    END
  432.   END AppendObj;
  433.  BEGIN (* ReadSym *)
  434.   err := TRUE;
  435.   nofLmod := 0; strno := firstStr;
  436.   parlev := 0; fldlev := 0;
  437.   COPY(name, FileName); Append(FileName, symFileExt);
  438.   SymFile := Files.Old(FileName);
  439.   IF SymFile # NIL THEN
  440.    Files.Set(SF, SymFile, 0); Files.Read(SF, ch);
  441.    IF ch = SFtag THEN
  442.     struct[Undef] := undftyp; struct[Byte] := bytetyp;
  443.     struct[Bool] := booltyp;  struct[Char] := chartyp;
  444.     struct[SInt] := sinttyp;  struct[Int] := inttyp;
  445.     struct[LInt] := linttyp;  struct[Real] := realtyp;
  446.     struct[LReal] := lrltyp;  struct[Set] := settyp;
  447.     struct[String] := stringtyp; struct[NilTyp] := niltyp;
  448.     struct[NoTyp] := notyp; struct[Pointer] := sysptrtyp;                (*:*)
  449.     LOOP (*read next item from symbol file*)
  450.      Files.Read(SF, ch); class := ORD(ch);
  451.      IF SF.eof THEN EXIT END ;
  452.      CASE class OF
  453.        0..7, 23, 25: (*object*)                           (*:*)
  454.       NEW(obj); m := 0;
  455.       ReadInt(s); obj^.typ := struct[s];
  456.       CASE class OF
  457.        1: obj^.mode := Con;
  458.           CASE obj^.typ^.form OF
  459.           | 1,2,3: Files.Read(SF, ch); obj^.a0 := ORD(ch)
  460.           | 4: Files.Read(SF, si); obj^.a0 := si
  461.           | 5: ReadXInt(obj^.a0)
  462.           | 6, 9: ReadLInt(obj^.a0)
  463.           | 7: Files.ReadBytes(SF, obj^.a0, 4)
  464.           | 8: Files.ReadBytes(SF, obj^.a0, 4); Files.ReadBytes(SF, obj^.a1, 4)
  465.           | 10: obj^.a0 := id; ReadId
  466.           | 11: (*NIL*)
  467.           END
  468.        |2,3: obj^.mode := Typ; ReadInt(m);
  469.           IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END;
  470.           obj^.marked := class = 2
  471.        |4, 23: obj^.mode := Var; ReadLInt(obj^.a0); obj^.marked := (class = 23)
  472.        |5, 6, 7, 25:                               (*:*)
  473.           h1 := 0; h2 := 0;                       (*:*)
  474.           IF class = 5 THEN obj^.mode := IProc; ReadInt(h1)
  475.           ELSIF class = 6 THEN obj^.mode := XProc; ReadInt(h1)
  476.           ELSIF class = 25 THEN obj^.mode := TProc;
  477.            ReadInt(s); ReadInt(h1); ReadInt(h2);
  478.            typ := struct[s]
  479.           ELSE obj^.mode := CProc; Files.Read(SF, ch); i := ORD(ch);
  480.            obj^.a0 := id; obj^.a1 := i;
  481.            WHILE i > 0 DO Files.Read(SF, IdBuf[id]); INC(id); DEC(i) END
  482.           END ;
  483.           IF class # 7 THEN obj^.a0 := h1 + h2 * 10000H END ;
  484.           reverseList(lastpar[parlev]);
  485.           obj^.link := param[parlev]^.right; DEC(parlev)
  486.       END ;
  487.       obj^.name := id; ReadId;
  488.       IF (class = 6) & (fldlev > 0) THEN InsertImport(obj, fldlist[fldlev], old)
  489.       ELSIF class = 25 THEN obj^.right := obj^.link; obj^.link:= NIL; AppendObj(typ^.link, obj)   (*:*)
  490.       ELSE
  491.        IF IdBuf[obj^.name] # 0X THEN
  492.         InsertImport(obj, LocMod[m], old);
  493.         IF (old # NIL) & (obj^.mode = Typ) THEN struct[s] := old^.typ
  494.         ELSIF (obj^.mode = Typ) & (obj^.typ^.form = Record) & (obj^.typ^.strobj = obj) THEN
  495.          InsertSubClass(typ^.BaseTyp, typ)
  496.         END
  497.        END
  498.       END
  499.      | 8..12: (*structure*)
  500.       NEW(typ); typ^.strobj := NIL; typ^.ref := 0;
  501.       ReadInt(s); typ^.BaseTyp := struct[s];
  502.       ReadInt(s); typ^.mno := SHORT(SHORT(LocMod[s]^.a0));
  503.       CASE class OF
  504.         8: typ^.form := Pointer; typ^.size := 4; typ^.n := 0
  505.       |  9: typ^.form := ProcTyp; typ^.size := 4;
  506.          reverseList(lastpar[parlev]);
  507.          typ^.link := param[parlev]^.right; DEC(parlev)
  508.       | 10: typ^.form := Array; ReadLInt(typ^.size); typ^.n := typ^.size DIV typ^.BaseTyp^.size
  509.       | 11: typ^.form := DynArr; ReadLInt(typ^.size); ReadXInt(typ^.adr)
  510.       | 12: typ^.form := Record;
  511.          ReadLInt(typ^.size);
  512.          reverseList(lastfld[fldlev]);
  513.          typ^.link := fldlist[fldlev]^.right; DEC(fldlev);
  514.          typ^.level := typ^.BaseTyp^.level;
  515.          IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END ;
  516.          ReadXInt(typ^.adr);  (*of descriptor*)
  517.       END ;
  518.       struct[strno] := typ; INC(strno)
  519.      | 13: (*parameter list start*)
  520.       NEW(obj); obj^.mode := Head; obj^.right := NIL;
  521.       IF parlev < 6 THEN INC(parlev); param[parlev] := obj; lastpar[parlev] := NIL
  522.       ELSE RETURN
  523.       END
  524.      | 14, 15: (*parameter*)
  525.       NEW(obj);
  526.       IF class = 14 THEN obj^.mode := Var ELSE obj^.mode := Ind END ;
  527.       ReadInt(s); obj^.typ := struct[s];
  528.       ReadXInt(obj^.a0); obj^.name := id; ReadId;
  529.       InsertImport(obj, param[parlev], old);
  530.       obj^.link := lastpar[parlev]; lastpar[parlev] := obj
  531.      | 16: (*start field list*)
  532.       NEW(obj); obj^.mode := Head; obj^.right := NIL;
  533.       IF fldlev < 5 THEN INC(fldlev); fldlist[fldlev] := obj; lastfld[fldlev] := NIL
  534.       ELSE RETURN
  535.       END
  536.      | 17, 24: (*field, rfield*)
  537.       NEW(obj); obj^.mode := Fld; ReadInt(s);
  538.       obj^.marked := (class = 24);
  539.       obj^.typ := struct[s]; ReadLInt(obj^.a0);
  540.       obj^.name := id; ReadId;
  541.       obj^.link := lastfld[fldlev]; lastfld[fldlev] := obj;
  542.       InsertImport(obj, fldlist[fldlev], old)
  543.      | 18, 19: (*hidden pointer field, hidden procedure field *)
  544.       ReadLInt(k)
  545.      | 20: (*fixup pointer typ*)
  546.       ReadInt(s); typ := struct[s];
  547.       ReadInt(s);
  548.       IF typ^.BaseTyp = undftyp THEN typ^.BaseTyp := struct[s] END
  549.      | 21: (*skip sysflag*)
  550.       ReadInt(s); ReadInt(s)
  551.      | 22: (*module anchor*)
  552.       ReadLInt(k); m := id; ReadId; i := 0;
  553.       WHILE (i < nofGmod) & (Diff(m, GlbMod[i]^.name) # 0) DO
  554.        INC(i)
  555.       END ;
  556.       IF i < nofGmod THEN (*module already present*)
  557.        IF k # GlbMod[i]^.a1 THEN Err("invalid module key"); RETURN END ;
  558.        obj := GlbMod[i]
  559.       ELSE NEW(obj);
  560.        obj^.mode := Head; obj^.name := m;
  561.        obj^.a1 := k; obj^.a0 := nofGmod; obj^.right := NIL;
  562.        IF nofGmod < maxImps THEN GlbMod[nofGmod] := obj; INC(nofGmod)
  563.        ELSE RETURN
  564.        END
  565.       END ;
  566.       IF nofLmod < 20 THEN LocMod[nofLmod] := obj; INC(nofLmod)
  567.       ELSE Err("too many imports"); RETURN
  568.       END ;
  569.       IF nofLmod > 1 THEN NEW(mod); mod^.name := obj^.name; mod^.mode := Mod; mod^.a1 := k;
  570.        InsertImport(mod, LocMod[0], old)
  571.       END
  572.      | 26: (*nofmethods*)
  573.       ReadInt(s); typ := struct[s]; ReadInt(s); typ.n := s
  574.      | 27: (*hidden method*)
  575.       Files.Read(SF, ch); Files.Read(SF, ch); Files.Read(SF, ch);
  576.      ELSE Err("invalid symbol file"); RETURN
  577.      END
  578.     END (*LOOP*) ;
  579.     Insert(Index(name), obj);
  580.     obj^.mode := Mod; obj^.link := LocMod[0]^.right;
  581.     obj^.a0  := LocMod[0]^.a0; obj^.a1  := LocMod[0]^.a1; obj^.typ := notyp;
  582.    ELSE Err("not a symbol file"); RETURN
  583.    END
  584.   ELSE Err("symbol file not found"); RETURN
  585.   END;
  586.   err := FALSE
  587.  END ReadSym;
  588.  PROCEDURE DisplayW(name: ARRAY OF CHAR);
  589.   VAR mV: MenuViewers.Viewer; T: Texts.Text; x, y: INTEGER;
  590.  BEGIN
  591.   T := TextFrames.Text(""); Texts.Append(T, W.buf);
  592.   IF (syspos # 0) & impSystem THEN
  593.    IF syspos > 0 THEN Ws("SYSTEM, ") ELSE Wch(09X); Ws("IMPORT SYSTEM;"); Wln; Wln END;
  594.    Texts.Insert(T, ABS(syspos), W.buf);
  595.    syspos := 0
  596.   END ;
  597.   Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  598.   mV := MenuViewers.New(
  599.    TextFrames.NewMenu(name, "System.Close System.Copy System.Grow Edit.Search Edit.Store "),
  600.    TextFrames.NewText(T, 0),
  601.    TextFrames.menuH, x, y)
  602.  END DisplayW;
  603.  PROCEDURE InitStruct(VAR typ: Struct; f: SHORTINT);
  604.  BEGIN NEW(typ); typ^.form := f; typ^.ref := f; typ^.size := 1
  605.  END InitStruct;
  606.  PROCEDURE Init;
  607.   PROCEDURE EnterTyp(name: ARRAY OF CHAR; form: SHORTINT; size: INTEGER; VAR res: Struct);
  608.    VAR obj: Object; typ: Struct;
  609.   BEGIN Insert(Index(name), obj);
  610.    NEW(typ); obj^.mode := Typ; obj^.typ := typ;
  611.    typ^.form := form; typ^.strobj := obj; typ^.size := size;
  612.    typ^.mno := 0; typ^.ref := form; res := typ
  613.   END EnterTyp;
  614.   PROCEDURE OpenScope(level: INTEGER; owner: Object);
  615.    VAR head: Object;
  616.   BEGIN NEW(head);
  617.    head^.mode := Head; head^.a0 := level; head^.link := owner;
  618.    head^.left := topScope; head^.right := NIL; topScope := head
  619.   END OpenScope;
  620.  BEGIN
  621.   IdBuf[0] := 0X; id := 1; topScope := NIL; OpenScope(0, NIL);
  622.   EnterTyp("CHAR", Char, 1, chartyp);
  623.   EnterTyp("SET", Set, 4, settyp);
  624.   EnterTyp("REAL", Real, 4, realtyp);
  625.   EnterTyp("INTEGER", Int, 2, inttyp);
  626.   EnterTyp("LONGINT",  LInt, 4, linttyp);
  627.   EnterTyp("LONGREAL", LReal, 8, lrltyp);
  628.   EnterTyp("SHORTINT", SInt, 1, sinttyp);
  629.   EnterTyp("BOOLEAN", Bool, 1, booltyp);
  630.   EnterTyp("SYSTEM.BYTE", Byte, 1, bytetyp);
  631.   EnterTyp("SYSTEM.PTR", Pointer, 4, sysptrtyp);                     (*:*)
  632.   universe := topScope; topScope^.right := NIL;
  633.   nofGmod := 1; topScope^.name := 0; GlbMod[0] := topScope; OpenScope(0, NIL);
  634.   NEW(types);
  635.  END Init;
  636.  PROCEDURE GetArgs(VAR S: Texts.Scanner);
  637.   VAR text: Texts.Text; beg, end, time: LONGINT;
  638.  BEGIN
  639.   Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  640.   IF (S.line#0) OR (S.class#Texts.Name) THEN
  641.    Oberon.GetSelection(text, beg, end, time);
  642.    IF time>=0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  643.   END
  644.  END GetArgs;
  645.  PROCEDURE Option(VAR S: Texts.Scanner);
  646.  BEGIN option := 0X;
  647.   Texts.Scan(S);
  648.   IF (S.class=Texts.Char) & (S.c=optionChar) THEN Texts.Scan(S);
  649.    IF S.class=Texts.Name THEN option := S.s[0]; Texts.Scan(S) END
  650.   END
  651.  END Option;
  652.  PROCEDURE QualIdent(VAR name, first, second: ARRAY OF CHAR);
  653.   VAR i, j: INTEGER; ch: CHAR;
  654.  BEGIN
  655.   i:=0; ch:=name[0];
  656.   WHILE (ch#".") & (ch#0X) DO first[i]:=ch; INC(i); ch:=name[i] END;
  657.   first[i]:=0X; INC(i); j:=0; ch:=name[i];
  658.   WHILE ch#0X DO second[j]:=ch; INC(i); INC(j); ch:=name[i] END;
  659.   second[j]:=0X
  660.  END QualIdent;
  661.  PROCEDURE ShowDef*;
  662.   VAR
  663.    S: Texts.Scanner;
  664.    mod, dummy: ARRAY 32 OF CHAR;
  665.    obj: Object;
  666.  BEGIN
  667.   GetArgs(S);
  668.   IF S.class=Texts.Name THEN
  669.    QualIdent(S.s, mod, dummy); Option(S);
  670.    Init;
  671.    ReadSym(mod, obj);
  672.    IF ~err THEN
  673.     showObj := FALSE; WriteModule(obj);
  674.     Append(mod, ".Def"); DisplayW(mod)
  675.    END
  676.   END
  677.  END ShowDef;
  678.  PROCEDURE ShowObj*;
  679.   VAR
  680.    S: Texts.Scanner;
  681.    mod, objName, qualid: ARRAY 32 OF CHAR;
  682.    obj: Object;
  683.  BEGIN
  684.   GetArgs(S);
  685.   IF S.class=Texts.Name THEN
  686.    COPY(S.s, qualid); QualIdent(S.s, mod, objName); Option(S);
  687.    Init;
  688.    ReadSym(mod, obj);
  689.    IF ~err THEN
  690.     obj := obj^.link; id := Index(objName);
  691.     WHILE (obj # NIL) & (Diff(id, obj^.name) # 0) DO obj := obj^.right END ;
  692.     IF obj # NIL THEN
  693.      showObj := TRUE; first := TRUE;
  694.      WriteObject(obj, obj^.mode);
  695.      DisplayW(qualid)
  696.     END
  697.    END
  698.   END
  699.  END ShowObj;
  700.  PROCEDURE ShowTree*;
  701.   VAR
  702.    S: Texts.Scanner;
  703.    modName, dummy: ARRAY 32 OF CHAR;
  704.    obj: Object;
  705.  BEGIN
  706.   GetArgs(S); Init;
  707.   WHILE S.class = Texts.Name DO
  708.    QualIdent(S.s, modName, dummy); Option(S);
  709.    ReadSym(modName, obj); IF err THEN RETURN END
  710.   END ;
  711.   WriteRecords(types^.sub, 1);
  712.   DisplayW("Browser.ShowTree")
  713.  END ShowTree;
  714.  PROCEDURE SetExtension*; (* "sym file extension"*)
  715.   VAR S: Texts.Scanner;
  716.  BEGIN GetArgs(S);
  717.   IF S.class = Texts.String THEN COPY(S.s, symFileExt) END
  718.  END SetExtension;
  719. BEGIN
  720.  Texts.OpenWriter(W);
  721.  InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
  722.  InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp);
  723.  symFileExt := ".Sym"
  724. END Browser.
  725.