home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OC / Compiler.mod next >
Encoding:
Text File  |  1995-01-26  |  62.3 KB  |  2,112 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Compiler.mod $
  4.   Description: Recursive-descent parser
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.15 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:17:17 $
  10.  
  11.   Copyright © 1990-1993, ETH Zuerich
  12.   Copyright © 1993-1995, Frank Copeland
  13.   This module forms part of the OC program
  14.   See OC.doc for conditions of use and distribution
  15.  
  16.   Log entries are at the end of the file.
  17.  
  18. *************************************************************************)
  19.  
  20. <* STANDARD- *> <* MAIN- *>
  21.  
  22. MODULE Compiler;
  23.  
  24. IMPORT
  25.   SYS := SYSTEM, Str := Strings, Oberon, Files,
  26.   OCM, OCS, OCT, OCC, OCI, OCE, OCP, OCH, OCStrings;
  27.  
  28.  
  29. (* --- Exported declarations ------------------------------------------ *)
  30.  
  31. VAR
  32.   newSF * : BOOLEAN;
  33.  
  34.  
  35. (* --- Local declarations --------------------------------------------- *)
  36.  
  37. CONST
  38.  
  39.   NofCases = 128; RecDescSize = 8; AdrSize = OCM.PtrSize;
  40.   ProcSize = OCM.ProcSize; PtrSize = OCM.PtrSize; ParOrg = 2 * AdrSize;
  41.   LParOrg = 3 * AdrSize; XParOrg = 3 * AdrSize; ProcVarSize = 32768;
  42.  
  43.   ModNameLen = 26; (* Max. module name length, imposed by AmigaDOS *)
  44.  
  45. (* Symbols *)
  46.  
  47.   null    = OCS.null;    times  = OCS.times;  slash     = OCS.slash;
  48.   div     = OCS.div;     mod    = OCS.mod;    and       = OCS.and;
  49.   plus    = OCS.plus;    minus  = OCS.minus;  or        = OCS.or;
  50.   eql     = OCS.eql;     neq    = OCS.neq;    lss       = OCS.lss;
  51.   leq     = OCS.leq;     gtr    = OCS.gtr;    geq       = OCS.geq;
  52.   in      = OCS.in;      is     = OCS.is;     arrow     = OCS.arrow;
  53.   period  = OCS.period;  comma  = OCS.comma;  colon     = OCS.colon;
  54.   upto    = OCS.upto;    rparen = OCS.rparen; rbrak     = OCS.rbrak;
  55.   rbrace  = OCS.rbrace;  of     = OCS.of;     then      = OCS.then;
  56.   do      = OCS.do;      to     = OCS.to;     lparen    = OCS.lparen;
  57.   lbrak   = OCS.lbrak;   lbrace = OCS.lbrace; not       = OCS.not;
  58.   becomes = OCS.becomes; number = OCS.number; nil       = OCS.nil;
  59.   string  = OCS.string;  ident  = OCS.ident;  semicolon = OCS.semicolon;
  60.   bar     = OCS.bar;     end    = OCS.end;    else      = OCS.else;
  61.   elsif   = OCS.elsif;   until  = OCS.until;  if        = OCS.if;
  62.   case    = OCS.case;    while  = OCS.while;  repeat    = OCS.repeat;
  63.   loop    = OCS.loop;    with   = OCS.with;   exit      = OCS.exit;
  64.   return  = OCS.return;  array  = OCS.array;  record    = OCS.record;
  65.   pointer = OCS.pointer; begin  = OCS.begin;  const     = OCS.const;
  66.   type    = OCS.type;    var    = OCS.var;    procedure = OCS.procedure;
  67.   import  = OCS.import;  module = OCS.module; eof       = OCS.eof;
  68.   for = OCS.for; by = OCS.by;
  69.  
  70. (* object modes *)
  71.   Var = OCM.Var; Ind = OCM.Ind; Con = OCM.Con; Reg = OCM.Reg;
  72.   Fld = OCM.Fld; Typ = OCM.Typ; LProc = OCM.LProc; XProc = OCM.XProc;
  73.   SProc = OCM.SProc; TProc = OCM.TProc; Mod = OCM.Mod; Abs = OCM.Abs;
  74.   VarArg = OCM.VarArg; M2Proc = OCM.M2Proc; CProc = OCM.CProc;
  75.   AProc = OCM.AProc;
  76.  
  77. (* object modes for language extensions *)
  78.   LibCall = OCM.LibCall;
  79.  
  80.   (* System flags *)
  81.  
  82.   DefaultFlag = OCM.DefaultFlag; OberonFlag = OCM.OberonFlag;
  83.   M2Flag = OCM.M2Flag; CFlag = OCM.CFlag; BCPLFlag = OCM.BCPLFlag;
  84.   AsmFlag = OCM.AsmFlag;
  85.  
  86. (* structure forms *)
  87.   Undef = OCT.Undef; Byte = OCT.Byte; Bool = OCT.Bool; Char = OCT.Char;
  88.   SInt = OCT.SInt; Int = OCT.Int; LInt = OCT.LInt; Real = OCT.Real;
  89.   LReal = OCT.LReal; BSet = OCT.BSet; WSet = OCT.WSet; Set = OCT.Set;
  90.   String = OCT.String; NilTyp = OCT.NilTyp; NoTyp = OCT.NoTyp;
  91.   PtrTyp = OCT.PtrTyp; AdrTyp = OCT.AdrTyp; BPtrTyp = OCT.BPtrTyp;
  92.   Pointer = OCT.Pointer; ProcTyp = OCT.ProcTyp; Array = OCT.Array;
  93.   DynArr = OCT.DynArr; Record = OCT.Record;
  94.  
  95.   intSet    = {SInt, Int, LInt};
  96.   labeltyps = {Char, SInt, Int, LInt};
  97.  
  98.   NumLoopLevels = 16; MaxLoopLevel = NumLoopLevels - 1;
  99.  
  100. VAR
  101.  
  102.   sym, procNo : INTEGER;
  103.   LoopLevel, ExitNo : INTEGER;
  104.   LoopExit : ARRAY NumLoopLevels OF INTEGER;
  105.   defaultFlag : INTEGER;
  106.  
  107. CONST mname = "Compiler";
  108.  
  109. (* --- Procedure declarations ----------------------------------------- *)
  110.  
  111.  
  112. (*------------------------------------*)
  113. PROCEDURE^ Type (VAR typ : OCT.Struct; dynArr : BOOLEAN);
  114. PROCEDURE^ Expression (VAR x : OCT.Item);
  115. PROCEDURE^ Block
  116.   (proc : OCT.Object; VAR dsize : LONGINT; VAR retList : INTEGER);
  117.  
  118. (*------------------------------------*)
  119. PROCEDURE CheckSym (s : INTEGER);
  120.  
  121. BEGIN (* CheckSym *)
  122.   IF sym = s THEN OCS.Get (sym) ELSE OCS.Mark (s) END
  123. END CheckSym;
  124.  
  125. (*------------------------------------*)
  126. PROCEDURE CheckNonStandard ();
  127. BEGIN (* CheckNonStandard *)
  128.   IF OCS.option [OCS.standard] THEN OCS.Mark (915) END
  129. END CheckNonStandard;
  130.  
  131. (*------------------------------------*)
  132. PROCEDURE SysFlag ( VAR flag : INTEGER );
  133. BEGIN (* SysFlag *)
  134.   (* sym = lbrak *)
  135.   OCS.Get (sym); flag := defaultFlag;
  136.   IF (sym = number) & (OCS.numtyp = 2) THEN
  137.     IF (OCS.intval < 0) OR (OCS.intval > AsmFlag) THEN OCS.Mark (353)
  138.     ELSE flag := SHORT (OCS.intval)
  139.     END;
  140.     OCS.Get (sym)
  141.   ELSE
  142.     OCS.Mark (17); WHILE (sym # rbrak) & (sym # eof) DO OCS.Get (sym) END
  143.   END;
  144.   CheckSym (rbrak); CheckNonStandard ()
  145. END SysFlag;
  146.  
  147. (*------------------------------------*)
  148. PROCEDURE qualident (VAR x : OCT.Item; allocDesc : BOOLEAN);
  149.  
  150.   (* CONST pname = "qualident"; *)
  151.  
  152.   VAR mnolev : INTEGER; obj : OCT.Object; desc : OCT.Desc; b : BOOLEAN;
  153.  
  154. BEGIN (* qualident *)
  155.   (* OCM.TraceIn (mname, pname); *)
  156.   (* sym = ident *)
  157.   OCT.Find (obj, mnolev); IF obj = NIL THEN OCS.Mark (0) END; OCS.Get (sym);
  158.   IF (sym = period) & (obj # NIL) & (obj.mode = Mod) THEN
  159.     OCS.Get (sym); mnolev := SHORT (-obj.a0);
  160.     IF sym = ident THEN
  161.       OCT.FindImport (obj, obj); IF obj = NIL THEN OCS.Mark (0) END;
  162.       OCS.Get (sym)
  163.     ELSE
  164.       OCS.Mark (10); obj := NIL
  165.     END;
  166.   END;
  167.   x.lev := mnolev; x.obj := obj;
  168.   IF obj # NIL THEN
  169.     x.mode := obj.mode; x.typ := obj.typ; x.a0 := obj.a0;
  170.     x.a1 := obj.a1; x.a2 := obj.a2; x.label := obj.label;
  171.     x.rdOnly := (mnolev < 0) & (obj.visible = OCT.RdOnly);
  172.     IF
  173.       allocDesc & (x.mode IN {Var, Ind}) & (x.typ # NIL)
  174.       & (x.typ.form = DynArr)
  175.     THEN
  176.       desc := OCT.AllocDesc (); desc.mode := Var; desc.lev := x.lev;
  177.       desc.a0 := x.a0; desc.a1 := 0; desc.a2 := 0; x.desc := desc
  178.     ELSE
  179.       x.desc := NIL
  180.     END
  181.   ELSE
  182.     x.mode := Var; x.typ := OCT.undftyp; x.a0 := 0; x.obj := NIL;
  183.     x.rdOnly := FALSE; x.desc := NIL
  184.   END
  185.   (* ;OCM.TraceOut (mname, pname); *)
  186. END qualident;
  187.  
  188. (*------------------------------------*)
  189. PROCEDURE ConstExpression (VAR x : OCT.Item);
  190.  
  191.   (* CONST pname = "ConstExpression"; *)
  192.  
  193.   CONST ConstTypes = {Undef .. NilTyp, AdrTyp, BPtrTyp, Pointer};
  194.  
  195. BEGIN (* ConstExpression *)
  196.   (* OCM.TraceIn (mname, pname); *)
  197.   Expression (x);
  198.   IF
  199.     (x.mode # Con)
  200.     OR ((x.typ.form = Pointer) & (x.typ.sysflg = OberonFlag))
  201.     OR ~(x.typ.form IN ConstTypes)
  202.   THEN
  203.     OCS.Mark (50); x.mode := Con; x.typ := OCT.inttyp; x.a0 := 1;
  204.   END;
  205.   (* ;OCM.TraceOut (mname, pname); *)
  206. END ConstExpression;
  207.  
  208. (*------------------------------------*)
  209. PROCEDURE NewStr (form : INTEGER) : OCT.Struct;
  210.  
  211.   (* CONST pname = "NewStr"; *)
  212.  
  213.   VAR typ : OCT.Struct;
  214.  
  215. BEGIN (* NewStr *)
  216.   (* OCM.TraceIn (mname, pname); *)
  217.   typ := OCT.AllocStruct ();
  218.   typ.form := form; typ.mno := 0; typ.size := 4; typ.ref := 0;
  219.   typ.BaseTyp := OCT.undftyp; typ.strobj := NIL; typ.link := NIL;
  220.   IF (form = Record) OR (form = Pointer) THEN typ.sysflg := defaultFlag
  221.   ELSE typ.sysflg := OberonFlag
  222.   END;
  223.   (* ;OCM.TraceOut (mname, pname); *)
  224.   RETURN typ
  225. END NewStr;
  226.  
  227. (*------------------------------------*)
  228. PROCEDURE HasTaggedPtr ( typ : OCT.Struct ) : BOOLEAN;
  229.  
  230.   VAR fld : OCT.Object;
  231.  
  232. BEGIN (* HasTaggedPtr *)
  233.   IF typ.sysflg = OberonFlag THEN
  234.     IF typ.form = Pointer THEN RETURN TRUE
  235.     ELSIF typ.form = Array THEN RETURN (HasTaggedPtr (typ.BaseTyp))
  236.     ELSIF typ.form = Record THEN
  237.       IF (typ.BaseTyp # NIL) & HasTaggedPtr (typ.BaseTyp) THEN
  238.         RETURN TRUE
  239.       END;
  240.       fld := typ.link;
  241.       WHILE fld # NIL DO
  242.         IF (fld.name < 0) OR HasTaggedPtr (fld.typ) THEN RETURN TRUE END;
  243.         fld := fld.left
  244.       END
  245.     END
  246.   END;
  247.   RETURN FALSE
  248. END HasTaggedPtr;
  249.  
  250. (*------------------------------------*)
  251. PROCEDURE CheckMark (VAR mk : SHORTINT; readOnly : BOOLEAN);
  252.  
  253.   (* CONST pname = "CheckMark"; *)
  254.  
  255. BEGIN (* CheckMark *)
  256.   (* OCM.TraceIn (mname, pname); *)
  257.   OCS.Get (sym);
  258.   IF sym = times THEN
  259.     IF OCC.level = 0 THEN mk := OCT.Exp
  260.     ELSE mk := OCT.NotExp; OCS.Mark (46)
  261.     END;
  262.     OCS.Get (sym)
  263.   ELSIF sym = minus THEN
  264.     IF (OCC.level = 0) & readOnly THEN mk := OCT.RdOnly
  265.     ELSE mk := OCT.NotExp; OCS.Mark (47)
  266.     END;
  267.     OCS.Get (sym)
  268.   ELSE
  269.     mk := OCT.NotExp
  270.   END
  271.   (* ;OCM.TraceOut (mname, pname); *)
  272. END CheckMark;
  273.  
  274. (*------------------------------------*)
  275. PROCEDURE CheckUndefPointerTypes ();
  276.  
  277.   (* CONST pname = "CheckUndefPointerTypes"; *)
  278.  
  279.   (*------------------------------------*)
  280.   PROCEDURE CheckObj (obj : OCT.Object);
  281.  
  282.   BEGIN (* CheckObj *)
  283.     IF obj # NIL THEN
  284.       IF obj.mode = Undef THEN OCS.Mark (48) END;
  285.       CheckObj (obj.left); CheckObj (obj.right)
  286.     END
  287.   END CheckObj;
  288.  
  289. BEGIN (* CheckUndefPointerTypes *)
  290.   (* OCM.TraceIn (mname, pname); *)
  291.   CheckObj (OCT.topScope.link)
  292.   (* ;OCM.TraceOut (mname, pname); *)
  293. END CheckUndefPointerTypes;
  294.  
  295. (*------------------------------------*)
  296. PROCEDURE CheckForwardProcs ();
  297.  
  298.   (* CONST pname = "CheckForwardProcs"; *)
  299.  
  300.   (*------------------------------------*)
  301.   PROCEDURE CheckObj ( obj : OCT.Object );
  302.  
  303.     (*------------------------------------*)
  304.     PROCEDURE CheckTyp ( typ : OCT.Struct );
  305.       VAR fld : OCT.Object;
  306.     BEGIN (* CheckTyp *)
  307.       IF (typ # NIL) & (typ.form = Record) & (typ.sysflg = OberonFlag) THEN
  308.         fld := typ.link;
  309.         WHILE fld # NIL DO
  310.           IF (fld.mode = TProc) & fld.fwd THEN OCS.Mark (129) END;
  311.           fld := fld.left
  312.         END
  313.       END
  314.     END CheckTyp;
  315.  
  316.   BEGIN (* CheckObj *)
  317.     IF obj # NIL THEN
  318.       IF obj.mode IN {XProc, LProc} THEN
  319.         IF obj.a2 < 0 THEN OCS.Mark (129) END
  320.       ELSIF obj.mode = Typ THEN
  321.         CheckTyp (obj.typ)
  322.       END;
  323.       CheckObj (obj.left); CheckObj (obj.right)
  324.     END
  325.   END CheckObj;
  326.  
  327. BEGIN (* CheckForwardProcs *)
  328.   (* OCM.TraceIn (mname, pname); *)
  329.   CheckObj (OCT.topScope.link)
  330.   (* ;OCM.TraceOut (mname, pname); *)
  331. END CheckForwardProcs;
  332.  
  333. (*------------------------------------*)
  334. PROCEDURE RecordType (VAR typ : OCT.Struct);
  335.  
  336.   CONST pname = "RecordType";
  337.  
  338.   VAR
  339.     adr, size : LONGINT;
  340.     fld, fld0, fld1, fld2 : OCT.Object;
  341.     ftyp : OCT.Struct;
  342.     base : OCT.Item;
  343.  
  344. BEGIN (* RecordType *)
  345.   (* OCM.TraceIn (mname, pname); *)
  346.   typ := NewStr (Record); typ.BaseTyp := NIL; typ.n := 0; adr := 0;
  347.   IF sym = lbrak THEN SysFlag (typ.sysflg) END;
  348.   IF sym = lparen THEN
  349.     OCS.Get (sym); (* record extension *)
  350.     IF sym = ident THEN
  351.       qualident (base, FALSE);
  352.       IF (base.mode = Typ) & (base.typ.form = Record) THEN
  353.         typ.BaseTyp := base.typ; typ.n := base.typ.n + 1;
  354.         adr := base.typ.size
  355.       ELSE OCS.Mark (52)
  356.       END
  357.     ELSE OCS.Mark (10)
  358.     END;
  359.     CheckSym (rparen);
  360.     IF OCT.Tagged (typ) # OCT.Tagged (base.typ) THEN OCS.Mark (354) END
  361.   END;
  362.   OCT.OpenScope (0); fld := NIL; fld1 := OCT.AllocObj(); fld2 := NIL;
  363.   LOOP
  364.     IF sym = ident THEN
  365.       LOOP
  366.         IF sym = ident THEN
  367.           IF typ.BaseTyp # NIL THEN
  368.             OCT.FindField (typ.BaseTyp, fld0);
  369.             IF fld0 # NIL THEN OCS.Mark (1) END
  370.           END;
  371.           OCT.Insert (OCS.name, fld, Fld); CheckMark (fld.visible, TRUE);
  372.           IF (fld # fld2) & (fld.link = NIL) THEN
  373.             IF fld2 = NIL THEN fld1.link := fld; OCT.topScope.right := fld
  374.             ELSE fld2.link := fld
  375.             END;
  376.             fld2 := fld
  377.           END
  378.         ELSE OCS.Mark (10)
  379.         END;
  380.         IF sym = comma THEN OCS.Get (sym)
  381.         ELSIF sym = ident THEN OCS.Mark (19)
  382.         ELSE EXIT
  383.         END
  384.       END; (* LOOP *)
  385.       CheckSym (colon); Type (ftyp, FALSE);
  386.       IF (typ.sysflg # OberonFlag) & HasTaggedPtr (ftyp) THEN
  387.         OCS.Mark (355)
  388.       END;
  389.       size := ftyp.size;
  390.       IF size > 1 THEN
  391.         INC (adr, adr MOD 2); INC (size, size MOD 2) (* word align *)
  392.       END;
  393.       WHILE fld1.link # NIL DO
  394.         fld1 := fld1.link; fld1.typ := ftyp;
  395.         fld1.a0 := adr; INC (adr, size)
  396.       END
  397.     END; (* IF *)
  398.     IF sym = semicolon THEN OCS.Get (sym)
  399.     ELSIF sym = ident THEN OCS.Mark (38)
  400.     ELSE EXIT
  401.     END;
  402.   END; (* LOOP *)
  403.   typ.size := adr + (adr MOD 2); typ.link := OCT.topScope.right;
  404.   CheckUndefPointerTypes ();
  405.   fld0 := OCT.topScope.right;
  406.   WHILE fld0 # NIL DO
  407.     fld1 := fld0.link; fld0.link := NIL;
  408.     fld0.left := fld1; fld0.right := NIL;
  409.     fld0 := fld1
  410.   END;
  411.   OCT.CloseScope ();
  412.   IF typ.sysflg = OberonFlag THEN OCC.AllocTypDesc (typ) END
  413.   (* ;OCM.TraceOut (mname, pname); *)
  414. END RecordType;
  415.  
  416. (*------------------------------------*)
  417. PROCEDURE ArrayType (VAR typ : OCT.Struct; dynArr : BOOLEAN);
  418.  
  419.   (* CONST pname = "ArrayType"; *)
  420.  
  421.   VAR x : OCT.Item; f, n : INTEGER;
  422.  
  423. BEGIN (* ArrayType *)
  424.   (* OCM.TraceIn (mname, pname); *)
  425.   IF sym # of THEN
  426.     typ := NewStr (Array); ConstExpression (x); f := x.typ.form;
  427.     IF f IN intSet THEN
  428.       IF (x.a0 > 0) & (x.a0 <= MAX (INTEGER)) THEN n := SHORT (x.a0)
  429.       ELSE n := 1; OCS.Mark (68)
  430.       END
  431.     ELSE
  432.       OCS.Mark (51); n := 1
  433.     END;
  434.     typ.n := n;
  435.     IF sym = of THEN OCS.Get (sym); Type (typ.BaseTyp, FALSE)
  436.     ELSIF sym = comma THEN OCS.Get (sym); ArrayType (typ.BaseTyp, FALSE)
  437.     ELSE OCS.Mark (34)
  438.     END;
  439.     typ.size := n * typ.BaseTyp.size;
  440.     INC (typ.size, typ.size MOD 2); (* keep word alignment *)
  441.   ELSE
  442.     typ := NewStr (DynArr); OCS.Get (sym); Type (typ.BaseTyp, TRUE);
  443.     IF typ.BaseTyp.form = DynArr THEN
  444.       typ.size := typ.BaseTyp.size + 4; typ.adr := typ.BaseTyp.adr + 4
  445.     ELSE
  446.       typ.size := 8; typ.adr := 4
  447.     END
  448.   END;
  449.   IF (typ.form = DynArr) & ~dynArr THEN
  450.     typ := OCT.undftyp; OCS.Mark (325)
  451.   END
  452.   (* ;OCM.TraceOut (mname, pname); *)
  453. END ArrayType;
  454.  
  455. (*------------------------------------*)
  456. (*
  457.   $  FormalParameters  =  "(" [FPSection {";" FPSection}] ")"
  458.   $    [":" qualident].
  459.   $  FPSection  =  [VAR] ident [RegSpec] {"," ident [RegSpec]}
  460.   $    ":" Type.
  461.   $  RegSpec = "{" ConstExpression "}" [".."].
  462. *)
  463. PROCEDURE FormalParameters (
  464.   VAR resTyp : OCT.Struct; VAR psize : LONGINT; sysflg : INTEGER);
  465.  
  466.   (* CONST pname = "FormalParameters"; *)
  467.   CONST
  468.     D0 = 0; A5 = 13;
  469.  
  470.   VAR
  471.     mode : SHORTINT; gotUpto, regPars : BOOLEAN;
  472.     adr, size : LONGINT; res, reg : OCT.Item;
  473.     par, par1, par2: OCT.Object; typ : OCT.Struct;
  474.     close : INTEGER;
  475.  
  476. BEGIN (* FormalParameters *)
  477.   (* OCM.TraceIn (mname, pname); *)
  478.   adr := 0; gotUpto := FALSE; regPars := (sysflg = AsmFlag);
  479.   (* Make allowance for the receiver of type-bound and libcall procedures *)
  480.   IF OCT.topScope.right # NIL THEN
  481.     par1 := OCT.topScope.right; adr := par1.a0
  482.   ELSE
  483.     par1 := OCT.AllocObj()
  484.   END;
  485.   par2 := par1;
  486.   IF (sym = ident) OR (sym = var) THEN
  487.     LOOP
  488.       IF sym = var THEN OCS.Get (sym); mode := Ind
  489.       ELSE mode := Var
  490.       END;
  491.       LOOP
  492.         IF sym = ident THEN
  493.           OCT.Insert (OCS.name, par, mode); OCS.Get (sym);
  494.           IF OCT.topScope.right = NIL THEN OCT.topScope.right := par END;
  495.           IF (par # par2) & (par.link = NIL) THEN
  496.             par2.link := par;
  497.             IF par1.link = NIL THEN par1.link := par END;
  498.           END;
  499.           par2 := par
  500.         ELSE OCS.Mark (10)
  501.         END;
  502.  
  503.         IF (sym = lbrak) OR (sym = lbrace) THEN (* Register specification *)
  504.           IF sym = lbrak THEN close := rbrak ELSE close := rbrace END;
  505.           OCS.Get (sym); ConstExpression (reg);
  506.           IF reg.typ.form IN intSet THEN
  507.             IF (reg.a0 >= D0) & (reg.a0 <= A5) THEN par.a0 := reg.a0;
  508.             ELSE OCS.Mark (903)
  509.             END
  510.           ELSE OCS.Mark (902)
  511.           END;
  512.           CheckSym (close);
  513.           IF ~regPars THEN OCS.Mark (901); par.mode := Var; par.a0 := 0 END
  514.         ELSIF regPars THEN OCS.Mark (340)
  515.         END;
  516.  
  517.         IF sym = upto THEN
  518.           IF (mode = Var) & (sysflg IN {CFlag, AsmFlag}) THEN
  519.             par.mode := VarArg
  520.           ELSE
  521.             OCS.Mark (336)
  522.           END;
  523.           gotUpto := TRUE; OCS.Get (sym)
  524.         END;
  525.  
  526.         IF sym = comma THEN OCS.Get (sym)
  527.         ELSIF sym = ident THEN OCS.Mark (19)
  528.         ELSIF sym = var THEN OCS.Mark (19); OCS.Get (sym)
  529.         ELSE EXIT
  530.         END;
  531.       END; (* LOOP *)
  532.       CheckSym (colon); Type (typ, TRUE);
  533.       IF (sysflg # OberonFlag) & OCT.Tagged (typ) THEN OCS.Mark (356) END;
  534.     (*IF (mode = VarArg) & (typ.size > PtrSize) THEN OCS.Mark (338) END;*)
  535.  
  536.       IF sysflg = OberonFlag THEN
  537.         IF mode = Ind  THEN (* VAR param *)
  538.           IF (typ.form = Record) & (typ.sysflg = OberonFlag) THEN
  539.             size := RecDescSize
  540.           ELSIF typ.form = DynArr THEN
  541.             size := typ.size
  542.           ELSE
  543.             size := AdrSize
  544.           END
  545.         ELSE
  546.           size := typ.size; IF ODD (size) THEN INC (size) END;
  547.         END;
  548.         WHILE par1.link # NIL DO
  549.           par1 := par1.link; par1.typ := typ;
  550.           DEC (adr, size); par1.a0 := adr
  551.         END;
  552.       ELSE
  553.         WHILE par1.link # NIL DO par1 := par1.link; par1.typ := typ END
  554.       END;
  555.       IF sym = semicolon THEN OCS.Get (sym)
  556.       ELSIF sym = ident THEN OCS.Mark (38)
  557.       ELSE EXIT
  558.       END;
  559.       IF gotUpto THEN OCS.Mark (337) END
  560.     END; (* LOOP *)
  561.   END; (* IF *)
  562.  
  563.   IF sysflg = OberonFlag THEN
  564.     psize := psize - adr;
  565.     IF psize > OCM.ParLimit THEN OCS.Mark (209); psize := 0 END;
  566.     par := OCT.topScope.right;
  567.     WHILE par # NIL DO INC (par.a0, psize); par := par.link END
  568.   END;
  569.  
  570.   CheckSym (rparen);
  571.   IF sym = colon THEN
  572.     OCS.Get (sym); resTyp := OCT.undftyp;
  573.     IF sym = ident THEN
  574.       qualident (res, FALSE);
  575.       IF res.mode = Typ THEN
  576.         IF res.typ.form <= ProcTyp THEN resTyp := res.typ
  577.         ELSE OCS.Mark (54)
  578.         END
  579.       ELSE OCS.Mark (52)
  580.       END
  581.     ELSE OCS.Mark (10)
  582.     END;
  583.   ELSE
  584.     resTyp := OCT.notyp
  585.   END;
  586.   (* ;OCM.TraceOut (mname, pname); *)
  587. END FormalParameters;
  588.  
  589. (*------------------------------------*)
  590. PROCEDURE ProcType (VAR typ : OCT.Struct);
  591.  
  592.   (* CONST pname = "ProcType"; *)
  593.  
  594.   VAR psize : LONGINT;
  595.  
  596. BEGIN (* ProcType *)
  597.   (* OCM.TraceIn (mname, pname); *)
  598.   typ := NewStr (ProcTyp); typ.size := ProcSize;
  599.   IF sym = lparen THEN
  600.     OCS.Get (sym); OCT.OpenScope (OCC.level); psize := ParOrg;
  601.     FormalParameters (typ.BaseTyp, psize, OberonFlag);
  602.     typ.link := OCT.topScope.right; OCT.CloseScope ();
  603.   ELSE
  604.     typ.BaseTyp := OCT.notyp; typ.link := NIL
  605.   END;
  606.   (* ;OCM.TraceOut (mname, pname); *)
  607. END ProcType;
  608.  
  609. (*------------------------------------*)
  610. PROCEDURE SetPtrBase (ptyp, btyp : OCT.Struct);
  611.  
  612.   CONST pname = "SetPtrBase";
  613.  
  614. BEGIN (* SetPtrBase *)
  615.   (* OCM.TraceIn (mname, pname); *)
  616.   IF
  617.     ((btyp.form = Record) & (OCT.Tagged (ptyp) = OCT.Tagged (btyp)))
  618.     OR (btyp.form = Array)
  619.   THEN
  620.     ptyp.BaseTyp := btyp; ptyp.label := OCT.PointerDesc
  621.   ELSIF (btyp.form = DynArr) & (ptyp.sysflg = OberonFlag) THEN
  622.     ptyp.BaseTyp := btyp; ptyp.size := btyp.size;
  623.     OCC.AllocTypDesc (ptyp)
  624.   ELSE
  625.     ptyp.BaseTyp := OCT.undftyp; OCS.Mark (57)
  626.   END
  627.   (* ;OCM.TraceOut (mname, pname); *)
  628. END SetPtrBase;
  629.  
  630. (*------------------------------------*)
  631. (*
  632.   $  type  =  qualident | ArrayType | RecordType | StructType| PointerType |
  633.   $    ProcedureType.
  634. *)
  635. PROCEDURE Type (VAR typ : OCT.Struct; dynArr : BOOLEAN);
  636.  
  637.   (* CONST pname = "Type"; *)
  638.  
  639.   VAR lev : INTEGER; obj : OCT.Object; x : OCT.Item;
  640.  
  641. BEGIN (* Type *)
  642.   (* OCM.TraceIn (mname, pname); *)
  643.   typ := OCT.undftyp;
  644.   IF sym < lparen THEN
  645.     OCS.Mark (12); REPEAT OCS.Get (sym) UNTIL sym >= lparen
  646.   END;
  647.   IF sym = ident THEN
  648.     qualident (x, FALSE);
  649.     IF x.mode = Typ THEN
  650.       typ := x.typ; IF typ = OCT.notyp THEN OCS.Mark (58) END
  651.     ELSE
  652.       OCS.Mark (52)
  653.     END
  654.   ELSIF sym = array THEN
  655.     OCS.Get (sym); ArrayType (typ, TRUE)
  656.   ELSIF sym = record THEN
  657.     OCS.Get (sym); RecordType (typ); CheckSym (end)
  658.   ELSIF (sym = pointer) THEN
  659.     typ := NewStr (Pointer); typ.link := NIL; typ.size := PtrSize;
  660.     OCS.Get (sym); IF sym = lbrak THEN SysFlag (typ.sysflg) END;
  661.     CheckSym (to);
  662.     IF sym = ident THEN
  663.       OCT.Find (obj, lev);
  664.       IF obj = NIL THEN (* forward reference *)
  665.         OCT.Insert (OCS.name, obj, Undef); typ.BaseTyp := OCT.undftyp;
  666.         obj.typ := typ; OCS.Get (sym)
  667.       ELSE
  668.         qualident (x, FALSE);
  669.         IF x.mode = Typ THEN SetPtrBase (typ, x.typ)
  670.         ELSE typ.BaseTyp := OCT.undftyp; OCS.Mark (52)
  671.         END
  672.       END
  673.     ELSE Type (x.typ, TRUE); SetPtrBase (typ, x.typ)
  674.     END
  675.   ELSIF sym = procedure THEN
  676.     OCS.Get (sym); ProcType (typ)
  677.   ELSE
  678.     OCS.Mark (12)
  679.   END;
  680.   IF (typ.form = DynArr) & ~dynArr THEN
  681.     typ := OCT.undftyp; OCS.Mark (325)
  682.   END;
  683.   IF (sym # semicolon) & (sym # rparen) & (sym # end) THEN
  684.     OCS.Mark (15);
  685.     WHILE (sym < ident) OR (else < sym) & (sym < begin) DO
  686.       OCS.Get (sym)
  687.     END
  688.   END
  689.   (* ;OCM.TraceOut (mname, pname); *)
  690. END Type;
  691.  
  692. (*------------------------------------*)
  693. (*
  694.   $  designator  =  qualident
  695.   $    {"." ident | "[" ExpList "]" | "(" qualident ")" | "^" }.
  696.        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  697.   $  ExpList  =  expression {"," expression}.
  698. *)
  699. PROCEDURE selector (VAR x, rcvr : OCT.Item);
  700.  
  701.   (* CONST pname = "selector"; *)
  702.  
  703.   VAR fld : OCT.Object; y : OCT.Item; t : OCT.Struct; f : INTEGER;
  704.  
  705. BEGIN (* selector *)
  706.   (* OCM.TraceIn (mname, pname); *)
  707.   IF x.mode = LibCall THEN
  708.     rcvr.mode := Var; rcvr.lev := x.lev; rcvr.a0 := x.a1; rcvr.a1 := 0;
  709.     rcvr.a2 := 0; rcvr.typ := OCT.lwordtyp; rcvr.rdOnly := TRUE
  710.   ELSE rcvr.mode := Undef
  711.   END;
  712.   LOOP
  713.     IF sym = lbrak THEN
  714.       OCS.Get (sym);
  715.       LOOP
  716.         IF (x.typ # NIL) & (x.typ.form = Pointer) THEN OCE.DeRef (x) END;
  717.         Expression (y); OCE.Index (x, y);
  718.         IF sym = comma THEN OCS.Get (sym) ELSE EXIT END
  719.       END;
  720.       CheckSym (rbrak)
  721.     ELSIF sym = period THEN
  722.       OCS.Get (sym);
  723.       IF sym = ident THEN
  724.         IF x.typ # NIL THEN
  725.           t := x.typ; f := t.form; IF f = Pointer THEN t := t.BaseTyp END;
  726.           IF (t.form = Record) THEN
  727.             OCT.FindField (t, fld);
  728.             IF fld # NIL THEN
  729.               IF fld.mode = Fld THEN
  730.                 IF f = Pointer THEN OCE.DeRef (x) END; OCE.Field (x, fld)
  731.               ELSIF fld.mode = TProc THEN
  732.                 rcvr := x; x.mode := TProc; x.a0 := fld.a0; x.a2 := 0;
  733.                 x.obj := fld; x.typ := fld.typ; x.label := fld.label
  734.               END
  735.             ELSE
  736.               OCS.Mark (83); x.typ := OCT.undftyp; x.mode := Var;
  737.               x.rdOnly := FALSE
  738.             END
  739.           ELSE OCS.Mark (53)
  740.           END;
  741.         ELSE OCS.Mark (52) (* ? *)
  742.         END;
  743.         OCS.Get (sym)
  744.       ELSE OCS.Mark (10)
  745.       END;
  746.     ELSIF sym = arrow THEN
  747.       IF x.mode = TProc THEN
  748.         IF (rcvr.mode IN {Var,Ind}) & (rcvr.a2 < 0) THEN
  749.           OCT.SuperCall (x.obj.name, rcvr.typ, fld);
  750.           IF fld # NIL THEN
  751.             x.a2 := -1; x.obj := fld; x.label := fld.label
  752.           ELSE OCS.Mark (333)
  753.           END
  754.         ELSE OCS.Mark (332)
  755.         END;
  756.         OCS.Get (sym)
  757.       ELSE
  758.         OCS.Get (sym); OCE.DeRef (x)
  759.       END
  760.     ELSIF (sym = lparen) & (x.mode < Typ) & (x.typ.form # ProcTyp) THEN
  761.       OCS.Get (sym);
  762.       IF sym = ident THEN
  763.         qualident (y, FALSE);
  764.         IF y.mode = Typ THEN OCE.TypTest (x, y, FALSE)
  765.         ELSE OCS.Mark (52)
  766.         END
  767.       ELSE
  768.         OCS.Mark (10)
  769.       END;
  770.       CheckSym (rparen)
  771.     ELSE
  772.       EXIT
  773.     END;
  774.   END; (* LOOP *)
  775.   (* ;OCM.TraceOut (mname, pname); *)
  776. END selector;
  777.  
  778. (*------------------------------------*)
  779. PROCEDURE IsParam (obj : OCT.Object) : BOOLEAN;
  780.  
  781. BEGIN (* IsParam *)
  782.   RETURN (obj # NIL) & (obj.mode <= Ind) & (obj.a0 >= 0)
  783. END IsParam;
  784.  
  785. (*------------------------------------*)
  786. PROCEDURE VarArgs
  787.   ( VAR apar : OCT.Item; fpar : OCT.Object;
  788.     VAR stackload : LONGINT; load : BOOLEAN );
  789.  
  790.   VAR x : OCT.Item;
  791.  
  792. BEGIN (* VarArgs *)
  793.   IF sym = comma THEN
  794.     OCS.Get (sym); Expression (x); VarArgs (x, fpar, stackload, FALSE)
  795.   END;
  796.   OCH.VarArgParam (apar, fpar, load); INC (stackload, fpar.typ.size)
  797. END VarArgs;
  798.  
  799. (*------------------------------------*)
  800. PROCEDURE ReverseParam
  801.   ( VAR apar      : OCT.Item;
  802.     VAR fpar      : OCT.Object;
  803.     VAR stackload : LONGINT );
  804.  
  805.   VAR x : OCT.Item; next : OCT.Object;
  806.  
  807. BEGIN (* ReverseParam *)
  808.   IF IsParam (fpar) THEN
  809.     next := fpar.link;
  810.     IF sym = comma THEN
  811.       OCS.Get (sym); Expression (x);
  812.       IF fpar.mode = VarArg THEN VarArgs (x, fpar, stackload, FALSE)
  813.       ELSE ReverseParam (x, next, stackload)
  814.       END;
  815.     END;
  816.     OCH.Param (apar, fpar, CProc); INC (stackload, fpar.typ.size);
  817.     fpar := next
  818.   ELSE
  819.     OCS.Mark (64)
  820.   END
  821. END ReverseParam;
  822.  
  823. (*------------------------------------*)
  824. (*
  825.   $  ActualParameters  =  "(" [ExpList] ")" .
  826.   $  ExpList  =  expression {"," expression}.
  827. *)
  828.  
  829. PROCEDURE ActualParameters
  830.   ( fpar          : OCT.Object;
  831.     mode          : INTEGER;
  832.     VAR stackload : LONGINT );
  833.  
  834.   (* CONST pname = "ActualParameters"; *)
  835.  
  836.   VAR apar : OCT.Item; R : SET;
  837.  
  838. BEGIN (* ActualParameters *)
  839.   (* OCM.TraceIn (mname, pname); *)
  840.   IF sym # rparen THEN
  841.     R := OCC.RegSet;
  842.     IF mode = CProc THEN
  843.       Expression (apar); ReverseParam (apar, fpar, stackload)
  844.     ELSE
  845.       LOOP
  846.         Expression (apar);
  847.         IF IsParam (fpar) THEN
  848.           IF fpar.mode = VarArg THEN VarArgs (apar, fpar, stackload, TRUE)
  849.           ELSE OCH.Param (apar, fpar, mode)
  850.           END;
  851.           fpar := fpar.link
  852.         ELSE
  853.           OCS.Mark (64)
  854.         END;
  855.         IF sym = comma THEN OCS.Get (sym)
  856.         ELSIF (lparen <= sym) & (sym <= ident) THEN OCS.Mark (19)
  857.         ELSE EXIT
  858.         END
  859.       END;
  860.     END; (* IF *)
  861.     OCC.FreeRegs (R);
  862.   END;
  863.   IF IsParam (fpar) THEN OCS.Mark (65) END
  864.   (* ;OCM.TraceOut (mname, pname); *)
  865. END ActualParameters;
  866.  
  867. (*------------------------------------*)
  868. PROCEDURE StandProcCall (VAR x : OCT.Item);
  869.  
  870.   (* CONST pname = "StandProcCall"; *)
  871.  
  872.   VAR y, z : OCT.Item; m, n : INTEGER; R : SET;
  873.  
  874. BEGIN (* StandProcCall *)
  875.   (* OCM.TraceIn (mname, pname); *)
  876.   m := SHORT (x.a0); n := 0; R := {};
  877.   OCP.SaveRegs (m, R);
  878.   IF (sym = lparen) THEN
  879.     OCS.Get (sym);
  880.     IF sym # rparen THEN
  881.       LOOP
  882.         IF m = OCT.pINLINE THEN
  883.           Expression (x); OCP.Inline (x);
  884.         ELSIF n = 0 THEN
  885.           Expression (x); OCP.StPar1 (x, m, R); n := 1
  886.         ELSIF m = OCT.pNEW THEN
  887.           IF n = 1 THEN y.mode := Undef END;
  888.           Expression (z); OCP.NewPar (x, y, z, n); INC (n)
  889.         ELSIF n = 1 THEN
  890.           Expression (y); OCP.StPar2 (x, y, m, R); n := 2;
  891.         ELSIF n = 2 THEN
  892.           Expression (y); OCP.StPar3 (x, y, m, R); n := 3;
  893.         ELSE
  894.           OCS.Mark (64); Expression (y);
  895.         END;
  896.         IF sym = comma THEN
  897.           OCS.Get (sym)
  898.         ELSIF (lparen <= sym) & (sym <= ident) THEN
  899.           OCS.Mark (19)
  900.         ELSE
  901.           EXIT
  902.         END;
  903.       END; (* LOOP *)
  904.       CheckSym (rparen)
  905.     ELSE
  906.       OCS.Get (sym)
  907.     END;
  908.     OCP.StFct (x, m, n, R)
  909.   ELSE
  910.     OCS.Mark (29)
  911.   END;
  912.   (* ;OCM.TraceOut (mname, pname); *)
  913. END StandProcCall;
  914.  
  915. (*------------------------------------*)
  916. (*
  917.   $  element  =  expression [".." expression].
  918. *)
  919. PROCEDURE Element (VAR x : OCT.Item);
  920.  
  921.   (* CONST pname = "Element"; *)
  922.  
  923.   VAR e1, e2 : OCT.Item;
  924.  
  925. BEGIN (* Element *)
  926.   (* OCM.TraceIn (mname, pname); *)
  927.   Expression (e1);
  928.   IF sym = upto THEN
  929.     OCS.Get (sym); Expression (e2); OCE.Set1 (x, e1, e2)
  930.   ELSE
  931.     OCE.Set0 (x, e1)
  932.   END;
  933.   (* ;OCM.TraceOut (mname, pname); *)
  934. END Element;
  935.  
  936. (*------------------------------------*)
  937. (*
  938.   $  set  =  "{" [element {"," element}] "}".
  939. *)
  940. PROCEDURE Sets (VAR x : OCT.Item);
  941.  
  942.   (* CONST pname = "Sets"; *)
  943.  
  944.   VAR y : OCT.Item;
  945.  
  946. BEGIN (* Sets *)
  947.   (* OCM.TraceIn (mname, pname); *)
  948.   x.typ := OCT.settyp; y.typ := OCT.settyp;
  949.   IF sym # rbrace THEN
  950.     Element (x);
  951.     LOOP
  952.       IF sym = comma THEN
  953.         OCS.Get (sym)
  954.       ELSIF (lparen <= sym) & (sym <= ident) THEN
  955.         OCS.Mark (19)
  956.       ELSE
  957.         EXIT
  958.       END;
  959.       Element (y); OCE.Op (plus, x, y, TRUE) (* x := x + y *)
  960.     END; (* LOOP *)
  961.   ELSE
  962.     x.mode := Con; x.a0 := 0
  963.   END;
  964.   CheckSym (rbrace);
  965.   (* ;OCM.TraceOut (mname, pname); *)
  966. END Sets;
  967.  
  968. (*------------------------------------*)
  969. (*
  970.   $  factor  =  number | CharConstant | string | NIL | set |
  971.   $    designator [ActualParameters] | "(" expression ")" | "~" factor.
  972. *)
  973. PROCEDURE Factor (VAR x : OCT.Item);
  974.  
  975.   (* CONST pname = "Factor"; *)
  976.  
  977.   VAR
  978.     fpar : OCT.Object; rcvr : OCT.Item; R, mask : SET;
  979.     stackload : LONGINT;
  980.  
  981. BEGIN (* Factor *)
  982.   (* OCM.TraceIn (mname, pname); *)
  983.   IF sym < lparen THEN
  984.     OCS.Mark (13);
  985.     REPEAT OCS.Get (sym) UNTIL sym >= lparen
  986.   END;
  987.   x.desc := NIL;
  988.   IF sym = ident THEN
  989.     qualident (x, TRUE); selector (x, rcvr);
  990.     IF x.mode = SProc THEN
  991.       StandProcCall (x)
  992.     ELSIF sym = lparen THEN
  993.       OCH.PrepCall (x, fpar, mask);
  994.       IF x.mode = TProc THEN
  995.         OCC.SaveRegisters (R, rcvr, mask); OCH.Receiver (rcvr, x.obj.link)
  996.       ELSE
  997.         OCC.SaveRegisters (R, x, mask);
  998.       END;
  999.       OCS.Get (sym); stackload := 0;
  1000.       ActualParameters (fpar, x.mode, stackload);
  1001.       OCH.Call (x, rcvr, stackload);
  1002.       OCC.RestoreRegisters (R, x);
  1003.       CheckSym (rparen)
  1004.     END;
  1005.   ELSIF sym = number THEN
  1006.     OCS.Get (sym); x.mode := Con;
  1007.     CASE OCS.numtyp OF
  1008.       1 : x.typ := OCT.chartyp; x.a0 := OCS.intval
  1009.       |
  1010.       2 : x.a0 := OCS.intval; OCE.SetIntType (x)
  1011.       |
  1012.       3 : x.typ := OCT.realtyp; OCE.AssReal (x, OCS.realval)
  1013.       |
  1014.       4 : x.typ := OCT.lrltyp; OCE.AssLReal (x, OCS.lrlval)
  1015.       |
  1016.     END; (* CASE OCS.numtyp *)
  1017.   ELSIF sym = string THEN
  1018.     x.typ := OCT.stringtyp; x.mode := Con;
  1019.     OCC.AllocString (OCS.name, OCS.intval, x); OCS.Get (sym);
  1020.     IF ~OCS.option [OCS.standard] THEN
  1021.       WHILE sym = string DO
  1022.         OCC.ConcatString (OCS.name, OCS.intval, x); OCS.Get (sym)
  1023.       END
  1024.     END
  1025.   ELSIF sym = nil THEN
  1026.     OCS.Get (sym); x.typ := OCT.niltyp; x.mode := Con; x.a0 := 0
  1027.   ELSIF sym = lparen THEN
  1028.     OCS.Get (sym); Expression (x); CheckSym (rparen)
  1029.   ELSIF sym = lbrak THEN
  1030.     OCS.Get (sym); OCS.Mark (29); Expression (x); CheckSym (rparen)
  1031.   ELSIF sym = lbrace THEN
  1032.     OCS.Get (sym); Sets (x)
  1033.   ELSIF sym = not THEN
  1034.     OCS.Get (sym); Factor (x); OCE.MOp (not, x)
  1035.   ELSE
  1036.     OCS.Mark (13); OCS.Get (sym); x.typ := OCT.undftyp; x.mode := Var;
  1037.     x.a0 := 0
  1038.   END;
  1039.   (* ;OCM.TraceOut (mname, pname); *)
  1040. END Factor;
  1041.  
  1042. (*------------------------------------*)
  1043. (*
  1044.   $  term  =  factor {MulOperator factor}.
  1045.   $  MulOperator  =  "*" | "/" | DIV | MOD | "&" .
  1046. *)
  1047. PROCEDURE Term (VAR x : OCT.Item);
  1048.  
  1049.   (* CONST pname = "Term"; *)
  1050.  
  1051.   VAR
  1052.     y : OCT.Item; mulop : INTEGER;
  1053.  
  1054. BEGIN (* Term *)
  1055.   (* OCM.TraceIn (mname, pname); *)
  1056.   Factor (x);
  1057.   WHILE (times <= sym) & (sym <= and) DO
  1058.     mulop := sym; OCS.Get (sym);
  1059.     IF mulop = and THEN OCE.MOp (and, x)  END;
  1060.     Factor (y); OCE.Op (mulop, x, y, TRUE);
  1061.   END;
  1062.   (* ;OCM.TraceOut (mname, pname); *)
  1063. END Term;
  1064.  
  1065. (*------------------------------------*)
  1066. (*
  1067.   $  SimpleExpression  =  ["+"|"-"] term {AddOperator term}.
  1068.   $  AddOperator  =  "+" | "-" | OR .
  1069. *)
  1070. PROCEDURE SimpleExpression (VAR x : OCT.Item);
  1071.  
  1072.   (* CONST pname = "SimpleExpression"; *)
  1073.  
  1074.   VAR y : OCT.Item; addop : INTEGER;
  1075.  
  1076. BEGIN (* SimpleExpression *)
  1077.   (* OCM.TraceIn (mname, pname); *)
  1078.   IF sym = minus THEN OCS.Get (sym); Term (x); OCE.MOp (minus, x)
  1079.   ELSIF sym = plus THEN OCS.Get (sym); Term (x); OCE.MOp (plus, x)
  1080.   ELSE Term (x)
  1081.   END;
  1082.   WHILE (plus <= sym) & (sym <= or) DO
  1083.     addop := sym; OCS.Get (sym); IF addop = or THEN OCE.MOp (or, x) END;
  1084.     Term (y); OCE.Op (addop, x, y, TRUE);
  1085.   END;
  1086.   (* ;OCM.TraceOut (mname, pname); *)
  1087. END SimpleExpression;
  1088.  
  1089. (*------------------------------------*)
  1090. (*
  1091.   $  expression  =  SimpleExpression [relation SimpleExpression].
  1092.   $  relation  =  "=" | "#" | "<" | "<=" | ">" | ">=" | IN | IS.
  1093. *)
  1094. PROCEDURE Expression (VAR x : OCT.Item);
  1095.  
  1096.   (* CONST pname = "Expression"; *)
  1097.  
  1098.   VAR
  1099.     y : OCT.Item; relation : INTEGER;
  1100.  
  1101. BEGIN (* Expression *)
  1102.   (* OCM.TraceIn (mname, pname); *)
  1103.   SimpleExpression (x);
  1104.   IF (eql <= sym) & (sym <= geq) THEN
  1105.     relation := sym; OCS.Get (sym);
  1106.     IF x.typ = OCT.booltyp THEN OCE.MOp (relation, x) END;
  1107.     SimpleExpression (y); OCE.Op (relation, x, y, TRUE)
  1108.   ELSIF sym = in THEN
  1109.     OCS.Get (sym); SimpleExpression (y); OCE.In (x, y)
  1110.   ELSIF sym = is THEN
  1111.     IF x.mode >= Typ THEN OCS.Mark (112) END;
  1112.     OCS.Get (sym);
  1113.     IF sym = ident THEN
  1114.       qualident (y, FALSE);
  1115.       IF y.mode = Typ THEN OCE.TypTest (x, y, TRUE) ELSE OCS.Mark (52) END
  1116.     ELSE
  1117.       OCS.Mark (10)
  1118.     END;
  1119.   END;
  1120.   (* ;OCM.TraceOut (mname, pname); *)
  1121. END Expression;
  1122.  
  1123. (*------------------------------------*)
  1124. PROCEDURE Receiver (VAR rtyp : OCT.Struct);
  1125.  
  1126.   (* CONST pname = "Receiver"; *)
  1127.  
  1128.   VAR
  1129.     mode : SHORTINT; mnolev : INTEGER; recvr, obj : OCT.Object;
  1130.     typ : OCT.Struct;
  1131.  
  1132. BEGIN (* Receiver *)
  1133.   (* OCM.TraceIn (mname, pname); *)
  1134.   recvr := NIL; rtyp := OCT.undftyp;
  1135.   IF sym = var THEN mode := Ind; OCS.Get (sym)
  1136.   ELSE mode := Var
  1137.   END;
  1138.   IF sym = ident THEN
  1139.     OCT.Insert (OCS.name, recvr, mode); OCS.Get (sym);
  1140.     OCT.topScope.right := recvr
  1141.   ELSE
  1142.     recvr := OCT.AllocObj (); OCS.Mark (10)
  1143.   END;
  1144.   recvr.typ := OCT.undftyp; recvr.a2 := -1;
  1145.   CheckSym (colon);
  1146.   IF sym = ident THEN
  1147.     OCT.Find (obj, mnolev); IF obj = NIL THEN OCS.Mark (0) END;
  1148.     OCS.Get (sym);
  1149.     IF (sym = period) & (obj # NIL) & (obj.mode = Mod) THEN
  1150.       OCS.Get (sym);
  1151.       IF sym = ident THEN
  1152.         OCT.FindImport (obj, obj); IF obj = NIL THEN OCS.Mark (0) END;
  1153.         OCS.Get (sym)
  1154.       ELSE
  1155.         OCS.Mark (10); obj := NIL
  1156.       END;
  1157.       OCS.Mark (305)
  1158.     END;
  1159.     IF (obj # NIL) & (obj.mode = Typ) THEN
  1160.       typ := obj.typ;
  1161.       IF typ # NIL THEN
  1162.         IF typ.mno < 0 THEN OCS.Mark (305) END;
  1163.         IF
  1164.           (mode = Ind)
  1165.           & ((typ.form # Record) OR (typ.sysflg # OberonFlag))
  1166.         THEN
  1167.           OCS.Mark (307); typ := OCT.undftyp
  1168.         ELSIF (mode = Var) THEN
  1169.           IF typ.form # Pointer THEN OCS.Mark (306); typ := OCT.undftyp END
  1170.         END;
  1171.       ELSE typ := OCT.undftyp
  1172.       END;
  1173.       IF typ.form = Pointer THEN rtyp := typ.BaseTyp ELSE rtyp := typ END;
  1174.       recvr.typ := typ;
  1175.       IF mode = Var THEN recvr.a0 := -AdrSize
  1176.       ELSE recvr.a0 := -RecDescSize
  1177.       END
  1178.     ELSE OCS.Mark (52)
  1179.     END
  1180.   ELSE OCS.Mark (10)
  1181.   END;
  1182.   CheckSym (rparen);
  1183.   (* ;OCM.TraceOut (mname, pname); *)
  1184. END Receiver;
  1185.  
  1186. (*------------------------------------*)
  1187. (*
  1188.   $  ProcedureDeclaration  =  ProcedureHeading ";" ProcedureBody ident.
  1189.   $  ProcedureHeading  =  PROCEDURE ["*"] identdef [FormalParameters].
  1190.   $  ForwardDeclaration  =  PROCEDURE "^" identdef [FormalParameters].
  1191. *)
  1192. PROCEDURE ProcedureDeclaration ();
  1193.  
  1194.   (* CONST pname = "ProcedureDeclaration"; *)
  1195.  
  1196.   VAR
  1197.     proc, proc1, par : OCT.Object;
  1198.     rtyp : OCT.Struct;
  1199.     retList, L1, sysflg, close : INTEGER; mode : SHORTINT;
  1200.     body, forward : BOOLEAN;
  1201.     psize, dsize : LONGINT;
  1202.     x : OCT.Item;
  1203.     label : OCT.Label;
  1204.  
  1205. BEGIN (* ProcedureDeclaration *)
  1206.   (* OCM.TraceIn (mname, pname); *)
  1207.   dsize := 0; proc := NIL; body := TRUE; forward := FALSE; mode := LProc;
  1208.   label := NIL; sysflg := defaultFlag;
  1209.  
  1210.   IF sym # ident THEN
  1211.     IF sym = arrow THEN
  1212.       forward := TRUE; body := FALSE; OCS.Get (sym)
  1213.     ELSIF sym = times THEN
  1214.       CheckNonStandard ();
  1215.       IF OCC.level = 0 THEN mode := XProc ELSE OCS.Mark (46) END;
  1216.       OCS.Get (sym)
  1217.     END;
  1218.     IF sym = lbrak THEN SysFlag (sysflg) END;
  1219.   END;
  1220.  
  1221.   IF sysflg # OberonFlag THEN
  1222.     IF mode = XProc THEN OCS.Mark (119)
  1223.     ELSIF forward THEN OCS.Mark (343)
  1224.     END;
  1225.     IF sysflg = M2Flag THEN mode := M2Proc
  1226.     ELSIF sysflg = CFlag THEN mode := CProc
  1227.     ELSIF sysflg = AsmFlag THEN mode := AProc
  1228.     ELSE OCS.Mark (900); mode := M2Proc
  1229.     END;
  1230.     body := FALSE
  1231.   END;
  1232.  
  1233.   IF sym = lparen THEN (* Type-bound procedure *)
  1234.     OCT.OpenScope (OCC.level + 1); OCS.Get (sym); Receiver (rtyp);
  1235.     IF OCC.level > 0 THEN OCS.Mark (46)
  1236.     ELSIF mode = XProc THEN OCS.Mark (119)
  1237.     ELSIF sysflg # OberonFlag THEN OCS.Mark (344)
  1238.     END;
  1239.     mode := TProc
  1240.   ELSIF sym # ident THEN OCS.Mark (10)
  1241.   END;
  1242.  
  1243.   IF sym = ident THEN
  1244.     IF mode = TProc THEN
  1245.       (*
  1246.         We must be aware of three possibilities for type-bound procedures:
  1247.         - There is a forward declaration for the *same* type
  1248.           (proc1.a1 = rtyp.n) & (proc1.fwd = TRUE);
  1249.         - There is a forward declaration for a *base* type
  1250.           (proc1.a1 # rtyp.n) & (proc1.fwd = TRUE);
  1251.         - It is a redefinition of a procedure from a base type
  1252.           (proc1.a1 # rtyp.n) & (proc1.fwd = FALSE).
  1253.       *)
  1254.       OCT.FindField (rtyp, proc1);
  1255.       IF proc1 # NIL THEN
  1256.         IF proc1.mode # TProc THEN (* Name used for a record field *)
  1257.           OCS.Mark (329); proc1 := NIL
  1258.         ELSIF (proc1.a1 = rtyp.n) & (proc1.fwd = FALSE) THEN
  1259.           (* Procedure already declared *)
  1260.           OCS.Mark (1); proc1 := NIL
  1261.         END
  1262.       END;
  1263.       proc := OCT.AllocObj (); proc.name := OCT.InsertName (OCS.name);
  1264.       CheckMark (proc.visible, FALSE);
  1265.       (* Assign a procedure number *)
  1266.       IF proc1 # NIL THEN proc.a0 := proc1.a0
  1267.       ELSE proc.a0 := -1
  1268.       END;
  1269.       IF proc.a0 < 0 THEN proc.a2 := 1
  1270.       ELSE proc.a2 := 0
  1271.       END;
  1272.       (* Note the type level *)
  1273.       proc.a1 := rtyp.n;
  1274.       (* Prepare to parse the parameters *)
  1275.       INC (OCC.level);
  1276.       IF (proc.visible = OCT.Exp) & ~OCS.pragma [OCS.longVars] THEN
  1277.         (* return address + frame ptr + global var base *)
  1278.         psize := XParOrg
  1279.       ELSE
  1280.         (* return address + frame ptr *)
  1281.         psize := ParOrg
  1282.       END
  1283.     ELSE
  1284.       (* See if there is a forward declaration already *)
  1285.       OCT.Find (proc1, L1); IF L1 # OCC.level THEN proc1 := NIL END;
  1286.       IF (sysflg = OberonFlag) & (proc1 # NIL) & proc1.fwd THEN
  1287.         (* there exists a corresponding forward declaration *)
  1288.         proc := OCT.AllocObj (); CheckMark (proc.visible, FALSE);
  1289.         IF proc.visible = OCT.Exp THEN mode := XProc END;
  1290.       ELSE
  1291.         IF proc1 # NIL THEN OCS.Mark (1); proc1 := NIL END;
  1292.         OCT.Insert (OCS.name, proc, mode); CheckMark (proc.visible, FALSE);
  1293.         IF (proc.visible = OCT.Exp) & (mode = LProc) THEN mode := XProc END;
  1294.         IF (mode = LProc) & (OCC.level > 0) THEN
  1295.           proc.a0 := procNo; INC (procNo)
  1296.         ELSE
  1297.           proc.a0 := 0
  1298.         END
  1299.       END;
  1300.  
  1301.       IF (sym = lbrak) OR (sym = lbrace) THEN
  1302.         (* External name or library call *)
  1303.         IF sym = lbrak THEN close := rbrak ELSE close := rbrace END;
  1304.         IF forward THEN OCS.Mark (343); forward := FALSE END;
  1305.         body := FALSE; OCS.Get (sym);
  1306.         IF sym = string THEN (* External name *)
  1307.           IF sysflg = OberonFlag THEN
  1308.             CheckNonStandard(); sysflg := AsmFlag; mode := AProc
  1309.           END;
  1310.           NEW (label, Str.Length (OCS.name) + 1); COPY (OCS.name, label^);
  1311.           OCS.Get (sym)
  1312.         ELSIF sym = ident THEN (* LibCall *)
  1313.           mode := LibCall; sysflg := AsmFlag; label := NIL;
  1314.           qualident (x, FALSE);
  1315.           IF
  1316.             (x.mode # Var) OR (x.lev # (OCC.level)) OR (x.typ.size # 4)
  1317.           THEN
  1318.             OCS.Mark (352); proc.a1 := 0
  1319.           ELSE proc.a1 := x.a0
  1320.           END;
  1321.           CheckSym (comma);
  1322.           IF sym = minus THEN proc.a0 := -1; OCS.Get (sym)
  1323.           ELSE proc.a0 := 1
  1324.           END;
  1325.           IF (sym = number) & (OCS.numtyp = 2) THEN
  1326.             proc.a0 := proc.a0 * OCS.intval; OCS.Get (sym)
  1327.           ELSE OCS.Mark (17)
  1328.           END;
  1329.         ELSE OCS.Mark (342); label := NIL
  1330.         END;
  1331.         CheckSym (close);
  1332.         IF (sysflg = M2Proc) OR (sysflg = CProc) THEN OCS.Warn (923) END
  1333.       ELSIF sysflg # OberonFlag THEN
  1334.         OCS.Mark (342); label := NIL
  1335.       END;
  1336.  
  1337.       INC (OCC.level); OCT.OpenScope (OCC.level);
  1338.       (* work out offset of procedure parameters *)
  1339.       IF sysflg # OberonFlag THEN
  1340.         psize := 0
  1341.       ELSIF (mode = LProc) & (OCC.level > 1) THEN
  1342.         psize := LParOrg (* return address + frame ptr + static link *)
  1343.       ELSIF (mode = XProc) & ~OCS.pragma [OCS.longVars] THEN
  1344.         psize := XParOrg (* return address + frame ptr + global var base *)
  1345.       ELSE
  1346.         psize := ParOrg  (* return address + frame ptr *)
  1347.       END;
  1348.     END;
  1349.  
  1350.     proc.mode := mode; proc.typ := OCT.notyp;
  1351.     IF forward THEN proc.fwd := TRUE ELSE proc.fwd := FALSE END;
  1352.  
  1353.     IF sym = lparen THEN (* Get formal parameters *)
  1354.       OCS.Get (sym); FormalParameters (proc.typ, psize, sysflg)
  1355.     ELSIF mode = TProc THEN (* fixup receiver parameter *)
  1356.       par := OCT.topScope.right;
  1357.       IF par # NIL THEN
  1358.         par.a0 := psize;
  1359.         IF par.mode = Ind THEN INC (psize, RecDescSize)
  1360.         ELSE INC (psize, AdrSize)
  1361.         END
  1362.       END
  1363.     END;
  1364.     proc.link := OCT.topScope.right;
  1365.  
  1366.     IF proc1 # NIL THEN
  1367.       IF mode = TProc THEN (* forward declaration or redefinition *)
  1368.         IF
  1369.           ~proc1.fwd & (rtyp.strobj.visible = OCT.Exp)
  1370.           & (proc1.visible = OCT.Exp) & (proc.visible # OCT.Exp)
  1371.         THEN (* Redefined procedure must be exported *)
  1372.           OCS.Mark (330)
  1373.         END;
  1374.         OCH.CompareParLists (proc.link.link, proc1.link.link);
  1375.       ELSE (* forward declaration *)
  1376.         OCH.CompareParLists (proc.link, proc1.link);
  1377.       END;
  1378.       IF proc.typ # proc1.typ THEN OCS.Mark (118) END;
  1379.       IF
  1380.         (((mode = TProc) & (proc.a1 = proc1.a1)) OR (mode # TProc))
  1381.         & proc1.fwd
  1382.       THEN (* forward declaration *)
  1383.         proc.link := NIL; OCT.FreeObj (proc);
  1384.         proc := proc1; OCT.FreeObj (proc.link);
  1385.         proc.link := OCT.topScope.right
  1386.       END
  1387.     END;
  1388.  
  1389.     IF forward OR (~proc.fwd) THEN
  1390.       IF mode = TProc THEN
  1391.         IF rtyp # OCT.undftyp THEN
  1392.           proc.left := rtyp.link; rtyp.link := proc;
  1393.           OCT.MakeTProcLabel (rtyp, proc)
  1394.         END
  1395.       ELSIF sysflg = OberonFlag THEN
  1396.         OCT.MakeProcLabel (proc)
  1397.       ELSE
  1398.         proc.label := label
  1399.       END
  1400.     END;
  1401.     IF ~forward THEN proc.fwd := FALSE END;
  1402.  
  1403.     IF body THEN
  1404.       CheckSym (semicolon); OCT.topScope.typ := proc.typ;
  1405.  
  1406.       OCH.StartProcedure (proc);
  1407.       Block (proc, dsize, retList);
  1408.       (* proc.link := OCT.topScope.right; (* update *) *)
  1409.       OCH.EndProcBody (proc, SHORT (psize), retList, dsize # 0);
  1410.       OCS.ResetProcSwitches ();
  1411.  
  1412.       (* Check size of local variables *)
  1413.       IF dsize > ProcVarSize THEN OCS.Mark (209); dsize := 0 END;
  1414.  
  1415.       (* Check name at end of procedure *)
  1416.       IF sym = ident THEN
  1417.         IF OCT.InsertName (OCS.name) # proc.name THEN OCS.Mark (4) END;
  1418.         OCS.Get (sym)
  1419.       ELSE
  1420.         OCS.Mark (10)
  1421.       END;
  1422.     END; (* IF *)
  1423.  
  1424.     IF proc.link # NIL THEN
  1425.       par := proc.link; WHILE IsParam (par.link) DO par := par.link END;
  1426.       (*OCT.FreeObj (par.link);*) par.link := NIL
  1427.     END;
  1428.     DEC (OCC.level); OCT.CloseScope ()
  1429.   END; (* IF *)
  1430.   (* ;OCM.TraceOut (mname, pname); *)
  1431. END ProcedureDeclaration;
  1432.  
  1433. (*------------------------------------*)
  1434. (*
  1435.   $  CaseLabelList  =  CaseLabels {"," CaseLabels}.
  1436.   $  CaseLabels  =  ConstExpression [".." ConstExpression].
  1437. *)
  1438. PROCEDURE CaseLabelList (
  1439.   LabelForm : INTEGER; VAR n : INTEGER; VAR tab : ARRAY OF OCH.LabelRange);
  1440.  
  1441.   (* CONST pname = "CaseLabelList"; *)
  1442.  
  1443.   VAR
  1444.     x, y : OCT.Item; i, f, g : INTEGER;
  1445.  
  1446. BEGIN (* CaseLabelList *)
  1447.   (* OCM.TraceIn (mname, pname); *)
  1448.   IF ~(LabelForm IN labeltyps) THEN OCS.Mark (61) END;
  1449.   LOOP
  1450.     ConstExpression (x); f := x.typ.form;
  1451.     IF (f = String) & (x.a1 <= 2) THEN
  1452.       x.a0 := x.a2; x.typ := OCT.chartyp; f := Char
  1453.     END;
  1454.     IF f IN intSet THEN
  1455.       IF LabelForm < f THEN OCS.Mark (60) END
  1456.     ELSIF f # LabelForm THEN
  1457.       OCS.Mark (60)
  1458.     END;
  1459.     IF sym = upto THEN
  1460.       OCS.Get (sym); ConstExpression (y); g := y.typ.form;
  1461.       IF (g = String) & (y.a1 <= 2) THEN
  1462.         y.a0 := y.a2; y.typ := OCT.chartyp; g := Char
  1463.       END;
  1464.       IF (g # f) & ~((f IN intSet) & (g IN intSet)) THEN
  1465.         OCS.Mark (60)
  1466.       END;
  1467.       IF y.a0 < x.a0 THEN OCS.Mark (63); y.a0 := x.a0 END
  1468.     ELSE
  1469.       y := x
  1470.     END;
  1471.     (* enter label range into ordered table *)
  1472.     i := n;
  1473.     IF i < NofCases THEN
  1474.       LOOP
  1475.         IF i = 0 THEN EXIT END;
  1476.         IF tab [i-1].low <= y.a0 THEN
  1477.           IF tab[i-1].high >= x.a0 THEN OCS.Mark (62) END;
  1478.           EXIT
  1479.         END;
  1480.         tab [i] := tab[i-1]; DEC (i)
  1481.       END; (* LOOP *)
  1482.       tab [i].low := SHORT (x.a0); tab[i].high := SHORT (y.a0);
  1483.       tab[i].label := OCC.pc; INC (n)
  1484.     ELSE
  1485.       OCS.Mark (213)
  1486.     END;
  1487.     IF sym = comma THEN
  1488.       OCS.Get (sym)
  1489.     ELSIF (sym = number) OR (sym = ident) THEN
  1490.       OCS.Mark (19)
  1491.     ELSE
  1492.       EXIT
  1493.     END;
  1494.   END; (* LOOP *)
  1495.   (* ;OCM.TraceOut (mname, pname); *)
  1496. END CaseLabelList;
  1497.  
  1498. (*------------------------------------*)
  1499. (*
  1500.   $  StatementSequence  =  statement {";" statement}.
  1501.  
  1502.   $  statement  =  [assignment | ProcedureCall |
  1503.   $    IfStatement | CaseStatement | WhileStatement | RepeatStatement |
  1504.   $    LoopStatement | WithStatement | EXIT | RETURN [expression] ].
  1505.  
  1506.   $  assignment  =  designator ":=" expression.
  1507.  
  1508.   $  ProcedureCall  =  designator [ActualParameters].
  1509.  
  1510.   $  IfStatement  =  IF expression THEN StatementSequence
  1511.   $    {ELSIF expression THEN StatementSequence}
  1512.   $    [ELSE StatementSequence]
  1513.   $    END.
  1514.  
  1515.   $  CaseStatement  =  CASE expression OF case {"|" case}
  1516.   $    [ELSE StatementSequence] END.
  1517.   $  case  =  [CaseLabelList ":" StatementSequence].
  1518.  
  1519.   $  WhileStatement  =  WHILE expression DO StatementSequence END.
  1520.  
  1521.   $  RepeatStatement  =   REPEAT StatementSequence UNTIL expression.
  1522.  
  1523.   $  LoopStatement  =  LOOP StatementSequence END.
  1524.  
  1525.   $  WithStatement  =  WITH qualident ":" qualident DO
  1526.   $    StatementSequence END.
  1527. *)
  1528. PROCEDURE StatSeq (VAR retList : INTEGER);
  1529.  
  1530.   (* CONST pname = "StatSeq"; *)
  1531.  
  1532.   VAR
  1533.     fpar : OCT.Object; xtyp : OCT.Struct; stackload : LONGINT;
  1534.     x, rcvr, y, z, step : OCT.Item; L0, L1, ExitIndex : INTEGER;
  1535.     R, R1, mask : SET;
  1536.  
  1537.   (*------------------------------------*)
  1538.   PROCEDURE CasePart ();
  1539.  
  1540.     (* CONST pname = "CasePart"; *)
  1541.  
  1542.     VAR
  1543.       x : OCT.Item; n, L0, L1, L2 : INTEGER;
  1544.       tab : ARRAY NofCases OF OCH.LabelRange;
  1545.  
  1546.   BEGIN (* CasePart *)
  1547.     (* OCM.TraceIn (mname, pname); *)
  1548.     n := 0; L1 := 0;
  1549.     Expression (x); OCH.CaseIn (x, L0); CheckSym (of);
  1550.     LOOP
  1551.       IF sym < bar THEN
  1552.         CaseLabelList (x.typ.form, n, tab);
  1553.         CheckSym (colon); StatSeq (retList); OCH.FJ (L1)
  1554.       END;
  1555.       IF sym = bar THEN OCS.Get (sym) ELSE EXIT END
  1556.     END; (* LOOP *)
  1557.     L2 := OCC.pc;
  1558.     IF sym = else THEN
  1559.       OCS.Get (sym); StatSeq (retList); OCH.FJ (L1)
  1560.     ELSE
  1561.       IF OCS.pragma [OCS.caseChk] THEN OCC.Trap (OCC.CaseCheck)
  1562.       ELSE OCH.FJ (L1)
  1563.       END
  1564.     END;
  1565.     OCH.CaseOut (x, L0, L1, L2, n, tab)
  1566.     (* ;OCM.TraceOut (mname, pname); *)
  1567.   END CasePart;
  1568.  
  1569. BEGIN (* StatSeq *)
  1570.   (* OCM.TraceIn (mname, pname); *)
  1571.   R := OCC.RegSet;
  1572.   LOOP
  1573.     IF sym < ident THEN (* illegal symbol *)
  1574.       OCS.Mark (14);
  1575.       REPEAT OCS.Get (sym) UNTIL sym >= ident;
  1576.     END;
  1577.  
  1578.     IF sym = ident THEN (* assignment or procedure call *)
  1579.       qualident (x, TRUE); selector (x, rcvr);
  1580.       IF sym = becomes THEN (* assignment *)
  1581.         OCS.Get (sym); Expression (y); OCH.Assign (x, y, FALSE)
  1582.       ELSIF sym = eql THEN (* typo ? *)
  1583.         OCS.Mark (33); OCS.Get (sym); Expression (y);
  1584.         OCH.Assign (x, y, FALSE)
  1585.       ELSIF x.mode = SProc THEN (* standard procedure call *)
  1586.         StandProcCall (x); IF x.typ # OCT.notyp THEN OCS.Mark (55) END
  1587.       ELSE (* procedure call *)
  1588.         OCH.PrepCall (x, fpar, mask);
  1589.         IF x.mode = TProc THEN
  1590.           OCC.SaveRegisters (R1, rcvr, mask);
  1591.           OCH.Receiver (rcvr, x.obj.link)
  1592.         ELSE
  1593.           OCC.SaveRegisters (R1, x, mask);
  1594.         END;
  1595.         stackload := 0;
  1596.         IF sym = lparen THEN
  1597.           OCS.Get (sym); ActualParameters (fpar, x.mode, stackload);
  1598.           CheckSym (rparen);
  1599.         ELSIF IsParam (fpar) THEN (* parameters missing *)
  1600.           OCS.Mark (65)
  1601.         END;
  1602.         OCH.Call (x, rcvr, stackload);
  1603.         OCC.RestoreRegisters (R1, x);
  1604.         IF x.typ # OCT.notyp THEN OCS.Mark (55) END;
  1605.       END;
  1606.       (*OCT.FreeDesc (x.desc);*)
  1607.  
  1608.     ELSIF sym = if THEN (* if statement *)
  1609.       OCS.Get (sym); Expression (x); OCH.CFJ (x, L0); OCC.FreeRegs (R);
  1610.       CheckSym (then); StatSeq (retList); L1 := 0;
  1611.       WHILE sym = elsif DO
  1612.         OCS.Get (sym); OCH.FJ (L1); OCC.FixLink (L0);
  1613.         Expression (x); OCH.CFJ (x, L0); OCC.FreeRegs (R);
  1614.         CheckSym (then); StatSeq (retList)
  1615.       END;
  1616.       IF sym = else THEN
  1617.         OCS.Get (sym); OCH.FJ (L1); OCC.FixLink (L0);
  1618.         StatSeq (retList)
  1619.       ELSE
  1620.         OCC.FixLink (L0)
  1621.       END;
  1622.       OCC.FixLink (L1); CheckSym (end)
  1623.  
  1624.     ELSIF sym = case THEN (* case statement *)
  1625.       OCS.Get (sym); CasePart (); CheckSym (end)
  1626.  
  1627.     ELSIF sym = while THEN (* while statement *)
  1628.       OCS.Get (sym); L1 := OCC.pc;
  1629.       Expression (x); OCH.CFJ (x, L0); OCC.FreeRegs (R);
  1630.       CheckSym (do); StatSeq (retList); OCH.BJ (L1); OCC.FixLink (L0);
  1631.       CheckSym (end)
  1632.  
  1633.     ELSIF sym = repeat THEN (* repeat statement *)
  1634.       OCS.Get (sym); L0 := OCC.pc; StatSeq (retList);
  1635.       IF sym = until THEN
  1636.         OCS.Get (sym); Expression (x); OCH.CBJ (x, L0)
  1637.       ELSE
  1638.         OCS.Mark (43)
  1639.       END;
  1640.  
  1641.     ELSIF sym = for THEN
  1642.       OCS.Get (sym);
  1643.       IF sym = ident THEN
  1644.         qualident (x, FALSE);
  1645.         IF x.lev < 0 THEN OCS.Mark (327)
  1646.         ELSIF ~(x.typ.form IN intSet) THEN OCS.Mark (314)
  1647.         END;
  1648.         CheckSym (becomes); Expression (y);
  1649.         IF ~(y.typ.form IN intSet) THEN OCS.Mark (315) END;
  1650.         CheckSym (to); Expression (z);
  1651.         IF ~(z.typ.form IN intSet) THEN OCS.Mark (315) END;
  1652.         IF sym = by THEN OCS.Get (sym); ConstExpression (step);
  1653.           IF ~(step.typ.form IN intSet) THEN OCS.Mark (17)
  1654.           ELSIF step.a0 = 0 THEN OCS.Mark (316); step.a0 := 1
  1655.           END;
  1656.         ELSE step.mode := Con; step.a0 := 1; step.typ := OCT.sinttyp
  1657.         END;
  1658.         OCH.BeginFor (x, y, z, step, L0, L1); OCC.FreeRegs (R);
  1659.         IF z.mode = Reg THEN OCC.ReserveReg (SHORT (z.a0)) END;
  1660.         CheckSym (do); StatSeq (retList); OCH.EndFor (x, step, L0, L1);
  1661.         IF z.mode = Reg THEN OCC.UnReserveReg (SHORT (z.a0)) END;
  1662.         CheckSym (end)
  1663.       ELSE OCS.Mark (10)
  1664.       END;
  1665.  
  1666.     ELSIF sym = loop THEN (* loop statement *)
  1667.       OCS.Get (sym); ExitIndex := ExitNo; INC (LoopLevel);
  1668.       L0 := OCC.pc; StatSeq (retList); OCH.BJ (L0); DEC (LoopLevel);
  1669.       WHILE ExitNo > ExitIndex DO
  1670.         DEC (ExitNo); OCC.fixup (LoopExit [ExitNo])
  1671.       END;
  1672.       CheckSym (end)
  1673.  
  1674.     ELSIF sym = with THEN (*,regional type guard *)
  1675.       L1 := 0;
  1676.       REPEAT
  1677.         OCS.Get (sym); x.obj := NIL; xtyp := NIL;
  1678.         IF sym = ident THEN (* got variable OK *)
  1679.           qualident (x, FALSE); CheckSym (colon);
  1680.           IF sym = ident THEN
  1681.             qualident (y, FALSE);
  1682.             IF y.mode = Typ THEN (* got type OK *)
  1683.               IF x.obj # NIL THEN
  1684.                 xtyp := x.typ; x.obj.typ := y.typ; OCE.TypTest (x, y, TRUE)
  1685.               ELSE OCS.Mark (130) (* variable has anonymous type *)
  1686.               END
  1687.             ELSE OCS.Mark (52) (* not a type *)
  1688.             END
  1689.           ELSE OCS.Mark (10)
  1690.           END
  1691.         ELSE OCS.Mark (10)
  1692.         END;
  1693.         CheckSym (do); OCC.FreeRegs (R); OCH.CFJ (x, L0); StatSeq (retList);
  1694.         IF (sym = bar) OR (sym = else) THEN
  1695.           OCH.FJ (L1); OCC.FixLink (L0)
  1696.         END;
  1697.         IF xtyp # NIL THEN x.obj.typ := xtyp END;
  1698.       UNTIL sym # bar;
  1699.       IF sym = else THEN OCS.Get (sym); StatSeq (retList)
  1700.       ELSIF OCS.pragma [OCS.typeChk] THEN OCC.TypeTrap (L0)
  1701.       ELSE OCC.FixLink (L0)
  1702.       END;
  1703.       OCC.FixLink (L1);
  1704.       CheckSym (end);
  1705.  
  1706.     ELSIF sym = exit THEN (* Loop exit statement *)
  1707.       OCS.Get (sym); L0 := 0; OCH.FJ (L0);
  1708.       IF LoopLevel = 0 THEN OCS.Mark (45)
  1709.       ELSIF ExitNo < NumLoopLevels THEN
  1710.         LoopExit [ExitNo] := L0; INC (ExitNo)
  1711.       ELSE OCS.Mark (214)
  1712.       END;
  1713.  
  1714.     ELSIF sym = return THEN (* Procedure return statement *)
  1715.       OCS.Get (sym);
  1716.       IF OCC.level > 0 THEN (* Return from procedure *)
  1717.         IF sym < semicolon THEN
  1718.           Expression (x); OCH.Result (x, OCT.topScope.typ)
  1719.         ELSIF OCT.topScope.typ # OCT.notyp THEN (* expression missing *)
  1720.           OCS.Mark (124)
  1721.         END;
  1722.         OCH.FJ (retList)
  1723.       ELSE (* return from module body *)
  1724.         IF sym < semicolon THEN Expression (x); OCS.Mark (124) END;
  1725.         OCH.FJ (retList)
  1726.       END;
  1727.     END;
  1728.  
  1729.     OCC.FreeRegs (R);
  1730.  
  1731.     IF sym = semicolon THEN
  1732.       OCS.Get (sym)
  1733.     ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN
  1734.       OCS.Mark (38)
  1735.     ELSE
  1736.       EXIT
  1737.     END;
  1738.   END; (* LOOP *)
  1739.   (* ;OCM.TraceOut (mname, pname); *)
  1740. END StatSeq;
  1741.  
  1742. (*------------------------------------*)
  1743. (*
  1744.   $  module  =  MODULE ident ";"  [ImportList]
  1745.   $    DeclarationSequence [BEGIN StatementSequence] END ident "." .
  1746.        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  1747.  
  1748.   $  ProcedureBody  =  DeclarationSequence [BEGIN StatementSequence] END.
  1749.                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  1750.  
  1751.   $  DeclarationSequence  =  {CONST {ConstantDeclaration ";"} |
  1752.   $      TYPE {TypeDeclaration ";"} | VAR {VariableDeclaration ";"}}
  1753.   $      {ProcedureDeclaration ";" | ForwardDeclaration ";"}.
  1754. *)
  1755. PROCEDURE Block (
  1756.   proc : OCT.Object; VAR dsize : LONGINT; VAR retList : INTEGER);
  1757.  
  1758.   (* CONST pname = "Block"; *)
  1759.  
  1760.   VAR
  1761.     typ, forward : OCT.Struct;
  1762.     obj, first, last : OCT.Object;
  1763.     x : OCT.Item;
  1764.     L0 : INTEGER;
  1765.     adr, size : LONGINT;
  1766.     mk : SHORTINT;
  1767.     id0 : ARRAY 32 OF CHAR;
  1768.  
  1769. BEGIN (* Block *)
  1770.   (* OCM.TraceIn (mname, pname); *)
  1771.   (* Calculate base address of variables *)
  1772.   IF OCC.level = 0 THEN (* +ve offsets from module variable base *)
  1773.     adr := dsize
  1774.   ELSE (* -ve offsets from frame pointer *)
  1775.     adr := -dsize
  1776.   END;
  1777.  
  1778.   last := OCT.topScope.right;
  1779.   IF last # NIL THEN
  1780.     WHILE last.link # NIL DO last := last.link END;
  1781.   END;
  1782.  
  1783.   LOOP
  1784.     IF sym = const THEN (* Constant declaration(s) *)
  1785.       OCS.Get (sym);
  1786.       WHILE sym = ident DO
  1787.         COPY (OCS.name, id0); CheckMark (mk, FALSE);
  1788.         IF sym = eql THEN
  1789.           OCS.Get (sym); ConstExpression (x)
  1790.         ELSIF sym = becomes THEN
  1791.           OCS.Mark (9); OCS.Get (sym); ConstExpression (x)
  1792.         ELSE
  1793.           OCS.Mark (9)
  1794.         END;
  1795.  
  1796.         (* Enforce limitation on aliasing imported string constants *)
  1797.         IF (x.lev < 0) & (x.typ = OCT.stringtyp) & (x.a1 > 2) THEN
  1798.           OCS.Mark (323)
  1799.         END;
  1800.  
  1801.         (* Insert in symbol table *)
  1802.         OCT.Insert (id0, obj, SHORT (x.mode));
  1803.         obj.typ := x.typ; obj.a0 := x.a0; obj.a1 := x.a1; obj.a2 := x.a2;
  1804.         obj.visible := mk; obj.label := x.label;
  1805.  
  1806.         CheckSym (semicolon)
  1807.       END; (* WHILE *)
  1808.     END; (* IF *)
  1809.  
  1810.     IF sym = type THEN (* Type declaration(s) *)
  1811.       OCS.Get (sym);
  1812.       WHILE sym = ident DO
  1813.         (* Insert in symbol table *)
  1814.         typ := OCT.undftyp; OCT.Insert (OCS.name, obj, Typ);
  1815.         forward := obj.typ; obj.typ := OCT.notyp;
  1816.         CheckMark (obj.visible, FALSE);
  1817.  
  1818.         IF sym = eql THEN
  1819.           OCS.Get (sym); Type (typ, TRUE);
  1820.         ELSIF (sym = becomes) OR (sym = colon) THEN
  1821.           OCS.Mark (9);
  1822.           OCS.Get (sym); Type (typ, TRUE);
  1823.         ELSE
  1824.           OCS.Mark (9); typ := OCT.undftyp
  1825.         END;
  1826.  
  1827.         obj.typ := typ;
  1828.         IF typ.strobj = NIL THEN typ.strobj := obj END;
  1829.         IF forward # NIL THEN (* fixup *) SetPtrBase (forward, typ) END;
  1830.  
  1831.         CheckSym (semicolon);
  1832.       END; (* WHILE *)
  1833.     END; (* IF *)
  1834.  
  1835.     IF sym = var THEN (* Variable declarations *)
  1836.       (*IF (OCC.level = 0) & ~OCS.createObj THEN OCS.Mark (918) END;*)
  1837.       OCS.Get (sym);
  1838.       WHILE sym = ident DO
  1839.         (* Insert in symbol table *)
  1840.         OCT.Insert (OCS.name, obj, Var); CheckMark (obj.visible, TRUE);
  1841.         IF (obj # last) & (obj.link = NIL) THEN
  1842.           IF last = NIL THEN OCT.topScope.right := obj
  1843.           ELSE last.link := obj
  1844.           END;
  1845.           first := obj; last := obj
  1846.         END;
  1847.  
  1848.         LOOP (* Get identifier list *)
  1849.           IF sym = comma THEN     OCS.Get (sym)
  1850.           ELSIF sym = ident THEN  OCS.Mark (19)
  1851.           ELSE                    EXIT
  1852.           END;
  1853.           IF sym = ident THEN
  1854.             OCT.Insert (OCS.name, obj, Var); CheckMark (obj.visible, TRUE);
  1855.             IF (obj # last) & (obj.link = NIL) THEN
  1856.               last.link := obj; last := obj
  1857.             END
  1858.           ELSE
  1859.             OCS.Mark (10)
  1860.           END;
  1861.         END; (* LOOP *)
  1862.  
  1863.         (* Get type *)
  1864.         CheckSym (colon); Type (typ, FALSE);
  1865.         size := typ.size;
  1866.         IF (size > 1) & ODD (size) THEN INC (size) END;
  1867.  
  1868.         (* Calculate variable addresses *)
  1869.         IF OCC.level = 0 THEN (* Global variable *)
  1870.           IF (size > 1) & ODD (adr) THEN INC (adr) END; (* Word align *)
  1871.           WHILE first # NIL DO
  1872.             first.typ := typ; first.a0 := adr; INC (adr, size);
  1873.             first := first.link
  1874.           END;
  1875.         ELSE                  (* Local procedure variable *)
  1876.           IF (size > 1) & ODD (adr) THEN DEC (adr) END; (* Word align *)
  1877.           WHILE first # NIL DO
  1878.             first.typ := typ; DEC (adr, size); first.a0 := adr;
  1879.             first := first.link
  1880.           END;
  1881.         END;
  1882.  
  1883.         CheckSym (semicolon);
  1884.       END; (* WHILE *)
  1885.     END; (* IF *)
  1886.     IF (sym < const) OR (sym > var) THEN EXIT END;
  1887.   END; (* LOOP *)
  1888.  
  1889.   CheckUndefPointerTypes ();
  1890.  
  1891.   WHILE sym = procedure DO (* Procedure declarations *)
  1892.     OCS.Get (sym); ProcedureDeclaration (); CheckSym (semicolon)
  1893.   END;
  1894.  
  1895.   CheckForwardProcs ();
  1896.  
  1897.   (* Calculate data size (rounded up to even value) *)
  1898.   IF OCC.level = 0 THEN dsize := adr
  1899.   ELSE                  dsize := -adr
  1900.   END;
  1901.   IF ODD (dsize) THEN INC (dsize) END;
  1902.  
  1903.   retList := 0; (* set up list of return branches *)
  1904.   IF OCC.level = 0 THEN
  1905.     OCH.StartModuleBody (dsize, retList)
  1906.   ELSE
  1907.     IF proc.link = NIL THEN proc.link := OCT.topScope.right END;
  1908.     OCH.StartProcBody (proc, dsize)
  1909.   END;
  1910.   IF sym = begin THEN (* Main body of block *)
  1911.     OCS.Get (sym); StatSeq (retList);
  1912.   END;
  1913.  
  1914.   CheckSym (end);
  1915.   (* ;OCM.TraceOut (mname, pname); *)
  1916. END Block;
  1917.  
  1918. (*------------------------------------*)
  1919. (*
  1920.   $  module  =  MODULE ident ";"  [ImportList] DeclarationSequence
  1921.   $      [BEGIN StatementSequence] END ident "." .
  1922.   $  ImportList  =  IMPORT import {"," import} ";" .
  1923.   $  import  =  identdef [":" ident].
  1924. *)
  1925. PROCEDURE CompilationUnit * ( source : Files.File);
  1926.  
  1927.   (* CONST pname = "CompilationUnit"; *)
  1928.  
  1929.   VAR
  1930.     L0, retList : INTEGER; ch : CHAR;
  1931.     time, date, key, dsize : LONGINT;
  1932.     name, alias : ARRAY 32 OF CHAR;
  1933.     FName : ARRAY 256 OF CHAR;
  1934.  
  1935. BEGIN (* CompilationUnit *)
  1936.   (* OCM.TraceIn (mname, pname); *)
  1937.   procNo := 1; dsize := 0; LoopLevel := 0; ExitNo := 0;
  1938.   defaultFlag := OberonFlag;
  1939.   OCC.Init (); OCT.Init (); OCS.Init (source);
  1940.  
  1941.   REPEAT OCS.Get (sym) UNTIL (sym = eof) OR (sym = module);
  1942.   IF sym # module THEN
  1943.     OCM.OutStr0 (OCStrings.Compiler1);
  1944.     RETURN
  1945.   END;
  1946.  
  1947.   OCS.allowOptions := FALSE; OCS.Get (sym);
  1948.   IF sym = lbrak THEN SysFlag (defaultFlag) END;
  1949.  
  1950.   IF sym = ident THEN
  1951.     L0 := 0; ch := OCS.name [0];
  1952.     WHILE (ch # 0X) & (L0 < ModNameLen) DO
  1953.       OCT.ModuleName [L0] := ch; INC (L0); ch := OCS.name [L0];
  1954.     END;
  1955.     OCT.ModuleName [L0] := 0X;
  1956.     IF ch # 0X THEN OCS.Mark (334) END;
  1957.  
  1958.     OCS.StartModule (OCT.ModuleName);
  1959.     OCT.StartModule ();
  1960.     OCC.StartModule (OCT.ModuleName);
  1961.     OCT.OpenScope (0);
  1962.  
  1963.     OCS.Get (sym);
  1964.     IF sym = lbrak THEN (* List of external modules *)
  1965.       REPEAT
  1966.         OCS.Get (sym);
  1967.         IF sym = string THEN OCT.ExtLib (); OCS.Get (sym)
  1968.         ELSE OCS.Mark (342)
  1969.         END
  1970.       UNTIL sym # comma;
  1971.       CheckSym (rbrak); CheckNonStandard ()
  1972.     END;
  1973.     CheckSym (semicolon);
  1974.  
  1975.     OCH.ModulePrologue ();
  1976.  
  1977.     IF sym = import THEN
  1978.       OCS.Get (sym);
  1979.  
  1980.       LOOP
  1981.         IF sym = ident THEN
  1982.           COPY (OCS.name, alias); OCS.Get (sym);
  1983.           name := alias;
  1984.           IF sym = becomes THEN
  1985.             OCS.Get (sym);
  1986.             IF sym = ident THEN COPY (OCS.name, name); OCS.Get (sym);
  1987.             ELSE OCS.Mark (10);
  1988.             END
  1989.           END;
  1990.           OCT.Import (name, alias)
  1991.         ELSE OCS.Mark (10)
  1992.         END;
  1993.  
  1994.         IF sym = comma THEN     OCS.Get (sym);
  1995.         ELSIF sym = ident THEN  OCS.Mark (19);
  1996.         ELSE                    EXIT;
  1997.         END;
  1998.       END; (* LOOP *)
  1999.  
  2000.       CheckSym (semicolon);
  2001.     END; (* IF *)
  2002.  
  2003.     IF ~OCS.scanerr THEN
  2004.       Block (NIL, dsize, retList);
  2005.       OCH.EndModuleBody (dsize, retList);
  2006.  
  2007.       IF sym = ident THEN
  2008.         IF OCS.name # OCT.ModuleName THEN OCS.Mark (4) END;
  2009.         OCS.Get (sym);
  2010.       ELSE
  2011.         OCS.Mark (10);
  2012.       END;
  2013.  
  2014.       IF sym # period THEN OCS.Mark (18) END;
  2015.  
  2016.       IF ~OCS.scanerr OR OCM.Force THEN
  2017.         OCC.AllocSlots;
  2018.         Oberon.GetClock (time, date);
  2019.         key := (date MOD 4000H) * 20000H + time;
  2020.         OCT.Export (OCT.ModuleName, newSF, key);
  2021.         IF ~OCS.scanerr OR OCM.Force THEN
  2022.           OCM.ObjectFileName (OCT.ModuleName, FName);
  2023.           IF OCM.Verbose THEN OCM.OutStr1 (OCStrings.Compiler2, FName) END;
  2024.           OCC.OutCode (FName, key, dsize);
  2025.           IF OCM.Verbose THEN
  2026.             OCM.OutInt4
  2027.               ( OCStrings.Compiler3, OCC.pc, OCC.DataSize(), dsize,
  2028.                 OCC.pc + dsize + OCC.DataSize ());
  2029.           END
  2030.         END
  2031.       END (* IF *)
  2032.     END; (* IF *)
  2033.     OCT.CloseScope ();
  2034.     OCT.EndModule (); OCS.EndModule ();
  2035.   ELSE
  2036.     OCM.OutStr0 (OCStrings.Compiler4)
  2037.   END;
  2038.  
  2039.   (* ;OCM.TraceOut (mname, pname); *)
  2040. END CompilationUnit;
  2041.  
  2042. <*$ClearVars+*>
  2043. BEGIN (* Compiler *)
  2044. END Compiler.
  2045.  
  2046. (***************************************************************************
  2047.  
  2048.   $Log: Compiler.mod $
  2049.   Revision 5.15  1995/01/26  00:17:17  fjc
  2050.   - Release 1.5
  2051.  
  2052.   Revision 5.14  1995/01/16  10:35:35  fjc
  2053.   *** empty log message ***
  2054.  
  2055.   Revision 5.13  1995/01/09  13:59:06  fjc
  2056.   - Changed console output depending on OCM.Verbose.
  2057.  
  2058.   Revision 5.12  1995/01/05  11:39:48  fjc
  2059.   - Changed forceCode to OCM.Force.
  2060.  
  2061.   Revision 5.11  1995/01/03  21:26:02  fjc
  2062.   - Changed OCG to OCM.
  2063.   - Changed to use catalogs:
  2064.     - Uses OCM for console I/O instead of Out.
  2065.     - Gets text from OCStrings instead of hard-coding it.
  2066.  
  2067.   Revision 5.10  1994/12/16  17:43:38  fjc
  2068.   - Changed Symbol to Label.
  2069.   - Uses module OCG for constructing file names.
  2070.   - Changed handling of forward declarations.
  2071.   - Added call to OCC.AllocSlots().
  2072.  
  2073.   Revision 5.9  1994/11/13  11:40:01  fjc
  2074.   - Fixed bug in handling sysflags when module default was
  2075.     not Oberon.
  2076.   - Now allows braces in place of square brackets for some
  2077.     purposes.
  2078.  
  2079.   Revision 5.8  1994/10/23  16:34:03  fjc
  2080.   - Replaced StdIO with Out for console IO.
  2081.   - Uses new interface for module Strings.
  2082.   - Changed to reflect changes in interfaces to OCH and OCP.
  2083.  
  2084.   Revision 5.7  1994/09/25  18:12:09  fjc
  2085.   - Changed to reflect new object modes and system flags:
  2086.     - Removed code for parsing CPOINTER, BPOINTER and LIBCALL
  2087.       declarations.
  2088.     - Added code to parse system flags.
  2089.     - Added checks for system flags in record, pointer and
  2090.       procedure declarations.
  2091.   - Simplified checking for dynamic array types.
  2092.  
  2093.   Revision 5.6  1994/09/19  23:10:05  fjc
  2094.   - Re-implemented Amiga library calls
  2095.  
  2096.   Revision 5.5  1994/09/16  17:37:41  fjc
  2097.   - Removed defunct error message.
  2098.  
  2099.   Revision 5.4  1994/09/15  11:34:09  fjc
  2100.   - Merged in bug fix from 4.17.
  2101.  
  2102.   Revision 5.3  1994/09/15  10:44:05  fjc
  2103.   - Replaced switches with pragmas.
  2104.  
  2105.   Revision 5.2  1994/09/08  10:53:28  fjc
  2106.   - Changed to use pragmas/options.
  2107.  
  2108.   Revision 5.1  1994/09/03  19:29:08  fjc
  2109.   - Bumped version number
  2110.  
  2111. ***************************************************************************)
  2112.