home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / nonfpu / opp.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  35KB  |  1,018 lines
  1. Syntax24b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax10.Scn.Fnt
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. (* Amiga NonFPU *) 
  8. MODULE OPP;    (* NW, RC 6.3.89 / 10.2.94 *)
  9.     IMPORT
  10.         OPT, OPS, OPM, OPB, AmigaMathL;
  11.     CONST
  12.         (* numtyp values *)
  13.         char = 1; integer = 2; real = 3; longreal = 4;
  14.         (* symbol values *)
  15.         null = 0; times = 1; slash = 2; div = 3; mod = 4;
  16.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  17.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  18.         in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  19.         colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  20.         of = 25; then = 26; do = 27; to = 28; by = 29;
  21.         lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  22.         number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  23.         bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  24.         if = 45; case = 46; while = 47; repeat = 48; for = 49;
  25.         loop = 50; with = 51; exit = 52; return = 53; array = 54;
  26.         record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  27.         var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  28.         (* object modes *)
  29.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  30.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  31.         (* Structure forms *)
  32.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  33.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  34.         Pointer = 13; ProcTyp = 14; Comp = 15;
  35.         intSet = {SInt..LInt};
  36.         (* composite structure forms *)
  37.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  38.         (*function number*)
  39.         haltfn = 0; newfn = 1; incfn = 13; sysnewfn = 30;
  40.         (* nodes classes *)
  41.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  42.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  43.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  44.         Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  45.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  46.         (* node subclasses *)
  47.         super = 1;
  48.         (* module visibility of objects *)
  49.         internal = 0; external = 1; externalR = 2;
  50.         (* procedure flags (conval^.setval) *)
  51.         hasBody = 1; isRedef = 2; slNeeded = 3;
  52.     TYPE
  53.         CaseTable = ARRAY OPM.MaxCases OF
  54.             RECORD
  55.                 low, high: LONGINT
  56.             END ;
  57.         sym, level: SHORTINT;
  58.         LoopLevel: INTEGER;
  59.         TDinit, lastTDinit: OPT.Node;
  60.         nofFwdPtr: INTEGER;
  61.         FwdPtr: ARRAY 64 OF OPT.Struct;
  62.     PROCEDURE^ Type(VAR typ, banned: OPT.Struct);
  63.     PROCEDURE^ Expression(VAR x: OPT.Node);
  64.     PROCEDURE^ Block(VAR procdec, statseq: OPT.Node);
  65.     PROCEDURE err(n: INTEGER);
  66.     BEGIN OPM.err(n)
  67.     END err;
  68.     PROCEDURE CheckSym(s: INTEGER);
  69.     BEGIN
  70.         IF sym = s THEN OPS.Get(sym) ELSE OPM.err(s) END
  71.     END CheckSym;
  72.     PROCEDURE qualident(VAR id: OPT.Object);
  73.         VAR obj: OPT.Object; lev: SHORTINT;
  74.     BEGIN (*sym = ident*)
  75.         OPT.Find(obj); OPS.Get(sym);
  76.         IF (sym = period) & (obj # NIL) & (obj^.mode = Mod) THEN
  77.             OPS.Get(sym);
  78.             IF sym = ident THEN
  79.                 OPT.FindImport(obj, obj); OPS.Get(sym)
  80.             ELSE err(ident); obj := NIL
  81.             END
  82.         END ;
  83.         IF obj = NIL THEN err(0);
  84.             obj := OPT.NewObj(); obj^.mode := Var; obj^.typ := OPT.undftyp; obj^.adr := 0
  85.         ELSE lev := obj^.mnolev;
  86.             IF (obj^.mode IN {Var, VarPar}) & (lev # level) THEN
  87.                 obj^.leaf := FALSE;
  88.                 IF lev > 0 THEN OPB.StaticLink(level-lev) END
  89.             END
  90.         END ;
  91.         id := obj
  92.     END qualident;
  93.     PROCEDURE ConstExpression(VAR x: OPT.Node);
  94.     BEGIN Expression(x);
  95.         IF x^.class # Nconst THEN
  96.             err(50); x := OPB.NewIntConst(1) 
  97.         END
  98.     END ConstExpression;
  99.     PROCEDURE CheckMark(VAR vis: SHORTINT);
  100.     BEGIN OPS.Get(sym);
  101.         IF (sym = times) OR (sym = minus) THEN
  102.             IF level > 0 THEN err(47) END ;
  103.             IF sym = times THEN vis := external ELSE vis := externalR END ;
  104.             OPS.Get(sym)
  105.         ELSE vis := internal
  106.         END
  107.     END CheckMark;
  108.     PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
  109.         VAR x: OPT.Node; sf: LONGINT;
  110.     BEGIN
  111.         IF sym = lbrak THEN OPS.Get(sym); ConstExpression(x);
  112.             IF x^.typ^.form IN intSet THEN sf := x^.conval^.intval;
  113.                 IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
  114.             ELSE err(51); sf := 0
  115.             END ;
  116.             sysflag := SHORT(sf); CheckSym(rbrak)
  117.         ELSE sysflag := default
  118.         END
  119.     END CheckSysFlag;
  120.     PROCEDURE RecordType(VAR typ, banned: OPT.Struct);
  121.         VAR fld, first, last, base: OPT.Object;
  122.             ftyp: OPT.Struct; sysflag: INTEGER;
  123.     BEGIN typ := OPT.NewStr(Comp, Record); typ^.BaseTyp := NIL;
  124.         CheckSysFlag(sysflag, -1);
  125.         IF sym = lparen THEN
  126.             OPS.Get(sym); (*record extension*)
  127.             IF sym = ident THEN
  128.                 qualident(base);
  129.                 IF (base^.mode = Typ) & (base^.typ^.comp = Record) THEN
  130.                     IF base^.typ = banned THEN err(58)
  131.                     ELSE typ^.BaseTyp := base^.typ; typ^.extlev := base^.typ^.extlev + 1; typ^.sysflag := base^.typ^.sysflag
  132.                     END
  133.                 ELSE err(52)
  134.                 END
  135.             ELSE err(ident)
  136.             END ;
  137.             CheckSym(rparen)
  138.         END ;
  139.         IF sysflag >= 0 THEN typ^.sysflag := sysflag END ;
  140.         OPT.OpenScope(0, NIL); first := NIL; last := NIL;
  141.         LOOP
  142.             IF sym = ident THEN
  143.                 LOOP
  144.                     IF sym = ident THEN
  145.                         IF typ^.BaseTyp # NIL THEN
  146.                             OPT.FindField(OPS.name, typ^.BaseTyp, fld);
  147.                             IF fld # NIL THEN err(1) END
  148.                         END ;
  149.                         OPT.Insert(OPS.name, fld); CheckMark(fld^.vis);
  150.                         fld^.mode := Fld; fld^.link := NIL; fld^.typ := OPT.undftyp;
  151.                         IF first = NIL THEN first := fld END ;
  152.                         IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ;
  153.                         last := fld
  154.                     ELSE err(ident)
  155.                     END ;
  156.                     IF sym = comma THEN OPS.Get(sym)
  157.                     ELSIF sym = ident THEN err(comma)
  158.                     ELSE EXIT
  159.                     END
  160.                 END ;
  161.                 CheckSym(colon); Type(ftyp, banned);
  162.                 IF ftyp^.comp = DynArr THEN ftyp := OPT.undftyp; err(88) END ;
  163.                 WHILE first # NIL DO
  164.                     first^.typ := ftyp; first := first^.link
  165.                 END
  166.             END ;
  167.             IF sym = semicolon THEN OPS.Get(sym)
  168.             ELSIF sym = ident THEN err(semicolon)
  169.             ELSE EXIT
  170.             END
  171.         END ;
  172.         OPT.CloseScope
  173.     END RecordType;
  174.     PROCEDURE ArrayType(VAR typ, banned: OPT.Struct);
  175.         VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER;
  176.     BEGIN CheckSysFlag(sysflag, 0);
  177.         IF sym = of THEN    (*dynamic array*)
  178.             typ := OPT.NewStr(Comp, DynArr); typ^.mno := 0; typ^.sysflag := sysflag;
  179.             OPS.Get(sym); Type(typ^.BaseTyp, banned);
  180.             IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1
  181.             ELSE typ^.n := 0
  182.             END
  183.         ELSE
  184.             typ := OPT.NewStr(Comp, Array); typ^.sysflag := sysflag; ConstExpression(x);
  185.             IF x^.typ^.form IN intSet THEN n := x^.conval^.intval;
  186.                 IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
  187.             ELSE err(51); n := 1
  188.             END ;
  189.             typ^.n := n;
  190.             IF sym = of THEN
  191.                 OPS.Get(sym); Type(typ^.BaseTyp, banned)
  192.             ELSIF sym = comma THEN
  193.                 OPS.Get(sym); IF sym # of THEN ArrayType(typ^.BaseTyp, banned) END
  194.             ELSE err(35)
  195.             END ;
  196.             IF typ^.BaseTyp^.comp = DynArr THEN typ^.BaseTyp := OPT.undftyp; err(88) END
  197.         END
  198.     END ArrayType;
  199.     PROCEDURE PointerType(VAR typ: OPT.Struct);
  200.         VAR id: OPT.Object;
  201.     BEGIN typ := OPT.NewStr(Pointer, Basic); CheckSysFlag(typ^.sysflag, 0);
  202.         CheckSym(to);
  203.         IF sym = ident THEN OPT.Find(id);
  204.             IF id = NIL THEN
  205.                 IF nofFwdPtr < LEN(FwdPtr) THEN FwdPtr[nofFwdPtr] := typ; INC(nofFwdPtr)
  206.                 ELSE err(224)
  207.                 END ;
  208.                 typ^.link := OPT.NewObj(); COPY(OPS.name, typ^.link^.name);
  209.                 typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*)
  210.             ELSE qualident(id);
  211.                 IF id^.mode = Typ THEN
  212.                     IF id^.typ^.comp IN {Array, DynArr, Record} THEN
  213.                         typ^.BaseTyp := id^.typ
  214.                     ELSE typ^.BaseTyp := OPT.undftyp; err(57)
  215.                     END
  216.                 ELSE typ^.BaseTyp := OPT.undftyp; err(52)
  217.                 END
  218.             END
  219.         ELSE Type(typ^.BaseTyp, OPT.notyp);
  220.             IF ~(typ^.BaseTyp^.comp IN {Array, DynArr, Record}) THEN
  221.                 typ^.BaseTyp := OPT.undftyp; err(57)
  222.             END
  223.         END
  224.     END PointerType;
  225.     PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct);
  226.         VAR mode: SHORTINT;
  227.                 par, first, last, res: OPT.Object; typ: OPT.Struct;
  228.     BEGIN first := NIL; last := firstPar;
  229.         IF (sym = ident) OR (sym = var) THEN
  230.             LOOP
  231.                 IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  232.                 LOOP
  233.                     IF sym = ident THEN
  234.                         OPT.Insert(OPS.name, par); OPS.Get(sym);
  235.                         par^.mode := mode; par^.link := NIL;
  236.                         IF first = NIL THEN first := par END ;
  237.                         IF firstPar = NIL THEN firstPar := par ELSE last^.link := par END ;
  238.                         last := par
  239.                     ELSE err(ident)
  240.                     END ;
  241.                     IF sym = comma THEN OPS.Get(sym)
  242.                     ELSIF sym = ident THEN err(comma)
  243.                     ELSIF sym = var THEN err(comma); OPS.Get(sym)
  244.                     ELSE EXIT
  245.                     END
  246.                 END ;
  247.                 CheckSym(colon); Type(typ, OPT.notyp);
  248.                 WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  249.                 IF sym = semicolon THEN OPS.Get(sym)
  250.                 ELSIF sym = ident THEN err(semicolon)
  251.                 ELSE EXIT
  252.                 END
  253.             END
  254.         END ;
  255.         CheckSym(rparen);
  256.         IF sym = colon THEN
  257.             OPS.Get(sym); resTyp := OPT.undftyp;
  258.             IF sym = ident THEN qualident(res);
  259.                 IF res^.mode = Typ THEN
  260.                     IF res^.typ^.form < Comp THEN resTyp := res^.typ
  261.                     ELSE err(54)
  262.                     END
  263.                 ELSE err(52)
  264.                 END
  265.             ELSE err(ident)
  266.             END
  267.         ELSE resTyp := OPT.notyp
  268.         END
  269.     END FormalParameters;
  270.     PROCEDURE TypeDecl(VAR typ, banned: OPT.Struct);
  271.         VAR id: OPT.Object;
  272.     BEGIN typ := OPT.undftyp;
  273.         IF sym < lparen THEN err(12);
  274.             REPEAT OPS.Get(sym) UNTIL sym >= lparen
  275.         END ;
  276.         IF sym = ident THEN qualident(id);
  277.             IF id^.mode = Typ THEN
  278.                 IF id^.typ # banned THEN typ := id^.typ ELSE err(58) END
  279.             ELSE err(52)
  280.             END
  281.         ELSIF sym = array THEN
  282.             OPS.Get(sym); ArrayType(typ, banned)
  283.         ELSIF sym = record THEN
  284.             OPS.Get(sym); RecordType(typ, banned);
  285.             OPB.Inittd(TDinit, lastTDinit, typ); CheckSym(end)
  286.         ELSIF sym = pointer THEN
  287.             OPS.Get(sym); PointerType(typ)
  288.         ELSIF sym = procedure THEN
  289.             OPS.Get(sym); typ := OPT.NewStr(ProcTyp, Basic); CheckSysFlag(typ^.sysflag, 0);
  290.             IF sym = lparen THEN
  291.                 OPS.Get(sym); OPT.OpenScope(level, NIL);
  292.                 FormalParameters(typ^.link, typ^.BaseTyp); OPT.CloseScope
  293.             ELSE typ^.BaseTyp := OPT.notyp; typ^.link := NIL
  294.             END
  295.         ELSE err(12)
  296.         END ;
  297.         LOOP
  298.             IF (sym >= semicolon) & (sym <= else) OR (sym = rparen) OR (sym = eof) THEN EXIT END;
  299.             err(15); IF sym = ident THEN EXIT END;
  300.             OPS.Get(sym)
  301.         END
  302.     END TypeDecl;
  303.     PROCEDURE Type(VAR typ, banned: OPT.Struct);
  304.     BEGIN TypeDecl(typ, banned);
  305.         IF (typ^.form = Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END
  306.     END Type;
  307.     PROCEDURE selector(VAR x: OPT.Node);
  308.         VAR obj, proc: OPT.Object; y: OPT.Node; typ: OPT.Struct; name: OPS.Name;
  309.     BEGIN
  310.         LOOP
  311.             IF sym = lbrak THEN OPS.Get(sym);
  312.                 LOOP
  313.                     IF (x^.typ # NIL) & (x^.typ^.form = Pointer) THEN OPB.DeRef(x) END ;
  314.                     Expression(y); OPB.Index(x, y);
  315.                     IF sym = comma THEN OPS.Get(sym) ELSE EXIT END
  316.                 END ;
  317.                 CheckSym(rbrak)
  318.             ELSIF sym = period THEN OPS.Get(sym);
  319.                 IF sym = ident THEN name := OPS.name; OPS.Get(sym);
  320.                     IF x^.typ # NIL THEN
  321.                         IF x^.typ^.form = Pointer THEN OPB.DeRef(x) END ;
  322.                         IF x^.typ^.comp = Record THEN
  323.                             OPT.FindField(name, x^.typ, obj); OPB.Field(x, obj);
  324.                             IF (obj # NIL) & (obj^.mode = TProc) THEN
  325.                                 IF sym = arrow THEN  (* super call *) OPS.Get(sym);
  326.                                     y := x^.left;
  327.                                     IF y^.class = Nderef THEN y := y^.left END ;    (* y = record variable *)
  328.                                     IF y^.obj # NIL THEN
  329.                                         proc := OPT.topScope;    (* find innermost scope which owner is a TProc *)
  330.                                         WHILE (proc^.link # NIL) & (proc^.link^.mode # TProc) DO proc := proc^.left END ;
  331.                                         IF (proc^.link = NIL) OR (proc^.link^.link # y^.obj) THEN err(75) END ;
  332.                                         typ := y^.obj^.typ;
  333.                                         IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  334.                                         OPT.FindField(x^.obj^.name, typ^.BaseTyp, proc);
  335.                                         IF proc # NIL THEN x^.subcl := super ELSE err(74) END
  336.                                     ELSE err(75)
  337.                                     END
  338.                                 END ;
  339.                                 IF (obj^.typ # OPT.notyp) & (sym # lparen) THEN err(lparen) END
  340.                             END
  341.                         ELSE err(53)
  342.                         END
  343.                     ELSE err(52)
  344.                     END
  345.                 ELSE err(ident)
  346.                 END
  347.             ELSIF sym = arrow THEN OPS.Get(sym); OPB.DeRef(x)
  348.             ELSIF (sym = lparen) & (x^.class < Nconst) & (x^.typ^.form # ProcTyp) &
  349.                     ((x^.obj = NIL) OR (x^.obj^.mode # TProc)) THEN
  350.                 OPS.Get(sym);
  351.                 IF sym = ident THEN
  352.                     qualident(obj);
  353.                     IF obj^.mode = Typ THEN OPB.TypTest(x, obj, TRUE)
  354.                     ELSE err(52)
  355.                     END
  356.                 ELSE err(ident)
  357.                 END ;
  358.                 CheckSym(rparen)
  359.             ELSE EXIT
  360.             END
  361.         END
  362.     END selector;
  363.     PROCEDURE ActualParameters(VAR aparlist: OPT.Node; fpar: OPT.Object);
  364.         VAR apar, last: OPT.Node;
  365.     BEGIN aparlist := NIL; last := NIL;
  366.         IF sym # rparen THEN
  367.             LOOP Expression(apar);
  368.                 IF fpar # NIL THEN
  369.                     OPB.Param(apar, fpar); OPB.Link(aparlist, last, apar);
  370.                     fpar := fpar^.link;
  371.                 ELSE err(64)
  372.                 END ;
  373.                 IF sym = comma THEN OPS.Get(sym)
  374.                 ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  375.                 ELSE EXIT
  376.                 END
  377.             END
  378.         END ;
  379.         IF fpar # NIL THEN err(65) END
  380.     END ActualParameters;
  381.     PROCEDURE StandProcCall(VAR x: OPT.Node);
  382.         VAR y: OPT.Node; m: SHORTINT; n: INTEGER;
  383.     BEGIN m := SHORT(SHORT(x^.obj^.adr)); n := 0;
  384.         IF sym = lparen THEN OPS.Get(sym);
  385.             IF sym # rparen THEN
  386.                 LOOP
  387.                     IF n = 0 THEN Expression(x); OPB.StPar0(x, m); n := 1
  388.                     ELSIF n = 1 THEN Expression(y); OPB.StPar1(x, y, m); n := 2
  389.                     ELSE Expression(y); OPB.StParN(x, y, m, n); INC(n)
  390.                     END ;
  391.                     IF sym = comma THEN OPS.Get(sym)
  392.                     ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  393.                     ELSE EXIT
  394.                     END
  395.                 END ;
  396.                 CheckSym(rparen)
  397.             ELSE OPS.Get(sym)
  398.             END ;
  399.             OPB.StFct(x, m, n)
  400.         ELSE err(lparen)
  401.         END ;
  402.         IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END
  403.     END StandProcCall;
  404.     PROCEDURE Element(VAR x: OPT.Node);
  405.         VAR y: OPT.Node;
  406.     BEGIN Expression(x);
  407.         IF sym = upto THEN
  408.             OPS.Get(sym); Expression(y); OPB.SetRange(x, y)
  409.         ELSE OPB.SetElem(x)
  410.         END
  411.     END Element;
  412.     PROCEDURE Sets(VAR x: OPT.Node);
  413.         VAR y: OPT.Node;
  414.     BEGIN
  415.         IF sym # rbrace THEN
  416.             Element(x);
  417.             LOOP
  418.                 IF sym = comma THEN OPS.Get(sym)
  419.                 ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  420.                 ELSE EXIT
  421.                 END ;
  422.                 Element(y); OPB.Op(plus, x, y)
  423.             END
  424.         ELSE x := OPB.EmptySet()
  425.         END ;
  426.         CheckSym(rbrace)
  427.     END Sets;
  428.     PROCEDURE Factor(VAR x: OPT.Node);
  429.         VAR fpar, id: OPT.Object; apar: OPT.Node; Dummy: LONGREAL;
  430.     BEGIN
  431.         IF sym < lparen THEN err(13);
  432.             REPEAT OPS.Get(sym) UNTIL sym >= lparen
  433.         END ;
  434.         IF sym = ident THEN
  435.             qualident(id); x := OPB.NewLeaf(id); selector(x);
  436.             IF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN StandProcCall(x)    (* x may be NIL *)
  437.             ELSIF sym = lparen THEN
  438.                 OPS.Get(sym); OPB.PrepCall(x, fpar);
  439.                 ActualParameters(apar, fpar);
  440.                 OPB.Call(x, apar, fpar);
  441.                 CheckSym(rparen);
  442.                 IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  443.             END
  444.         ELSIF sym = number THEN
  445.             CASE OPS.numtyp OF
  446.                char: x := OPB.NewIntConst(OPS.intval); x^.typ := OPT.chartyp
  447.             | integer: x := OPB.NewIntConst(OPS.intval)
  448.             | real:
  449.                 AmigaMathL.Long(OPS.realval, Dummy);
  450.                 x := OPB.NewRealConst(Dummy, OPT.realtyp)
  451. (*        | real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp)*)
  452.             | longreal: x := OPB.NewRealConst(OPS.lrlval, OPT.lrltyp)
  453.             END ;
  454.             OPS.Get(sym)
  455.         ELSIF sym = string THEN
  456.             x := OPB.NewString(OPS.str, OPS.intval); OPS.Get(sym)
  457.         ELSIF sym = nil THEN
  458.             x := OPB.Nil(); OPS.Get(sym)
  459.         ELSIF sym = lparen THEN
  460.             OPS.Get(sym); Expression(x); CheckSym(rparen)
  461.         ELSIF sym = lbrak THEN
  462.             OPS.Get(sym); err(lparen); Expression(x); CheckSym(rparen)
  463.         ELSIF sym = lbrace THEN OPS.Get(sym); Sets(x)
  464.         ELSIF sym = not THEN
  465.             OPS.Get(sym); Factor(x); OPB.MOp(not, x)
  466.         ELSE err(13); OPS.Get(sym); x := NIL
  467.         END ;
  468.         IF x = NIL THEN x := OPB.NewIntConst(1); x^.typ := OPT.undftyp END
  469.     END Factor;
  470.     PROCEDURE Term(VAR x: OPT.Node);
  471.         VAR y: OPT.Node; mulop: SHORTINT;
  472.     BEGIN Factor(x);
  473.         WHILE (times <= sym) & (sym <= and) DO
  474.             mulop := sym; OPS.Get(sym);
  475.             Factor(y); OPB.Op(mulop, x, y)
  476.         END
  477.     END Term;
  478.     PROCEDURE SimpleExpression(VAR x: OPT.Node);
  479.         VAR y: OPT.Node; addop: SHORTINT;
  480.     BEGIN
  481.         IF sym = minus THEN OPS.Get(sym); Term(x); OPB.MOp(minus, x)
  482.         ELSIF sym = plus THEN OPS.Get(sym); Term(x); OPB.MOp(plus, x)
  483.         ELSE Term(x)
  484.         END ;
  485.         WHILE (plus <= sym) & (sym <= or) DO
  486.             addop := sym; OPS.Get(sym);
  487.             Term(y); OPB.Op(addop, x, y)
  488.         END
  489.     END SimpleExpression;
  490.     PROCEDURE Expression(VAR x: OPT.Node);
  491.         VAR y: OPT.Node; obj: OPT.Object; relation: SHORTINT;
  492.     BEGIN SimpleExpression(x);
  493.         IF (eql <= sym) & (sym <= geq) THEN
  494.             relation := sym; OPS.Get(sym);
  495.             SimpleExpression(y); OPB.Op(relation, x, y)
  496.         ELSIF sym = in THEN
  497.             OPS.Get(sym); SimpleExpression(y); OPB.In(x, y)
  498.         ELSIF sym = is THEN
  499.             OPS.Get(sym);
  500.             IF sym = ident THEN
  501.                 qualident(obj);
  502.                 IF obj^.mode = Typ THEN OPB.TypTest(x, obj, FALSE)
  503.                 ELSE err(52)
  504.                 END
  505.             ELSE err(ident)
  506.             END
  507.         END
  508.     END Expression;
  509.     PROCEDURE Receiver(VAR mode: SHORTINT; VAR name: OPS.Name; VAR typ, rec: OPT.Struct);
  510.         VAR obj: OPT.Object;
  511.     BEGIN typ := OPT.undftyp; rec := NIL;
  512.         IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  513.         name := OPS.name; CheckSym(ident); CheckSym(colon);
  514.         IF sym = ident THEN OPT.Find(obj); OPS.Get(sym);
  515.             IF obj = NIL THEN err(0)
  516.             ELSIF obj^.mode # Typ THEN err(72)
  517.             ELSE typ := obj^.typ; rec := typ;
  518.                 IF rec^.form = Pointer THEN rec := rec^.BaseTyp END ;
  519.                 IF ~((mode = Var) & (typ^.form = Pointer) & (rec^.comp = Record) OR
  520.                     (mode = VarPar) & (typ^.comp = Record)) THEN err(70); rec := NIL END ;
  521.                 IF (rec # NIL) & (rec^.mno # level) THEN err(72); rec := NIL END
  522.             END
  523.         ELSE err(ident)
  524.         END ;
  525.         CheckSym(rparen);
  526.         IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END
  527.     END Receiver;
  528.     PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN;
  529.     BEGIN
  530.         IF (b^.form = Pointer) & (x^.form = Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ;
  531.         IF (b^.comp = Record) & (x^.comp = Record) THEN
  532.             REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b)
  533.         END ;
  534.         RETURN x = b
  535.     END Extends;
  536.     PROCEDURE ProcedureDeclaration(VAR x: OPT.Node);
  537.         VAR proc, fwd: OPT.Object;
  538.             name: OPS.Name;
  539.             mode, vis: SHORTINT;
  540.             forward: BOOLEAN;
  541.         PROCEDURE GetCode;
  542.             VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT;
  543.         BEGIN
  544.             ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
  545.             IF sym = string THEN
  546.                 WHILE OPS.str[n] # 0X DO ext[n+1] := OPS.str[n]; INC(n) END ;
  547.                 ext^[0] := CHR(n); OPS.Get(sym)
  548.             ELSE
  549.                 LOOP
  550.                     IF sym = number THEN c := OPS.intval; INC(n);
  551.                         IF (c < 0) OR (c > 255) OR (n = OPT.MaxConstLen) THEN
  552.                             err(64); c := 1; n := 1
  553.                         END ;
  554.                         OPS.Get(sym); ext^[n] := CHR(c)
  555.                     END ;
  556.                     IF sym = comma THEN OPS.Get(sym)
  557.                     ELSIF sym = number THEN err(comma)
  558.                     ELSE ext^[0] := CHR(n); EXIT
  559.                     END
  560.                 END
  561.             END ;
  562.             INCL(proc^.conval^.setval, hasBody)
  563.         END GetCode;
  564.         PROCEDURE GetParams;
  565.         BEGIN
  566.             proc^.vis := vis; proc^.mode := mode; proc^.typ := OPT.notyp;
  567.             proc^.conval := OPT.NewConst(); proc^.conval^.setval := {};
  568.             IF sym = lparen THEN
  569.                 OPS.Get(sym); FormalParameters(proc^.link, proc^.typ)
  570.             END ;
  571.             IF fwd # NIL THEN
  572.                 OPB.CheckParameters(proc^.link, fwd^.link, TRUE);
  573.                 IF proc^.typ # fwd^.typ THEN err(117) END ;
  574.                 proc := fwd; OPT.topScope := proc^.scope;
  575.                 IF mode = IProc THEN proc^.mode := IProc END
  576.             END
  577.         END GetParams;
  578.         PROCEDURE Body;
  579.             VAR procdec, statseq: OPT.Node; c: LONGINT;
  580.         BEGIN
  581.             c := OPM.errpos;
  582.             INCL(proc^.conval^.setval, hasBody);
  583.             CheckSym(semicolon); Block(procdec, statseq);
  584.             OPB.Enter(procdec, statseq, proc); x := procdec;
  585.             x^.conval := OPT.NewConst(); x^.conval^.intval := c;
  586.             IF sym = ident THEN
  587.                 IF OPS.name # proc^.name THEN err(4) END ;
  588.                 OPS.Get(sym)
  589.             ELSE err(ident)
  590.             END
  591.         END Body;
  592.         PROCEDURE TProcDecl;
  593.             VAR baseProc: OPT.Object;
  594.                 objTyp, recTyp: OPT.Struct;
  595.                 objMode: SHORTINT;
  596.                 objName: OPS.Name;
  597.         BEGIN
  598.             OPS.Get(sym); mode := TProc;
  599.             IF level > 0 THEN err(73) END ;
  600.             Receiver(objMode, objName, objTyp, recTyp);
  601.             IF sym = ident THEN
  602.                 name := OPS.name; CheckMark(vis);
  603.                 OPT.FindField(name, recTyp, fwd);
  604.                 OPT.FindField(name, recTyp^.BaseTyp, baseProc);
  605.                 IF (baseProc # NIL) & (baseProc^.mode # TProc) THEN baseProc := NIL END ;
  606.                 IF fwd = baseProc THEN fwd := NIL END ;
  607.                 IF (fwd # NIL) & (fwd^.mnolev # level) THEN fwd := NIL END ;
  608.                 IF (fwd # NIL) & (fwd^.mode = TProc) & ~(hasBody IN fwd^.conval^.setval) THEN
  609.                     (* there exists a corresponding forward declaration *)
  610.                     proc := OPT.NewObj(); proc^.leaf := TRUE;
  611.                     IF fwd^.vis # vis THEN err(118) END
  612.                 ELSE
  613.                     IF fwd # NIL THEN err(1); fwd := NIL END ;
  614.                     OPT.OpenScope(0, NIL); OPT.topScope^.right := recTyp^.link; OPT.Insert(name, proc);
  615.                     recTyp^.link := OPT.topScope^.right; OPT.CloseScope; 
  616.                 END ;
  617.                 INC(level); OPT.OpenScope(level, proc);
  618.                 OPT.Insert(objName, proc^.link); proc^.link^.mode := objMode; proc^.link^.typ := objTyp;
  619.                 GetParams;
  620.                 IF baseProc # NIL THEN
  621.                     IF (objMode # baseProc^.link^.mode) OR ~Extends(objTyp, baseProc^.link^.typ) THEN err(115) END ;
  622.                     OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE);
  623.                     IF proc^.typ # baseProc^.typ THEN err(117) END ;
  624.                     IF (baseProc^.vis = external) & (proc^.vis = internal) &
  625.                         (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = external) THEN err(109)
  626.                     END ;
  627.                     INCL(proc^.conval^.setval, isRedef)
  628.                 END ;
  629.                 IF ~forward THEN Body END ;
  630.                 DEC(level); OPT.CloseScope
  631.             ELSE err(ident)
  632.             END
  633.         END TProcDecl;
  634.     BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc;
  635.         IF (sym # ident) & (sym # lparen) THEN
  636.             IF sym = times THEN    (* mode set later in OPB.CheckAssign *)
  637.             ELSIF sym = arrow THEN forward := TRUE
  638.             ELSIF sym = plus THEN mode := IProc
  639.             ELSIF sym = minus THEN mode := CProc
  640.             ELSE err(ident)
  641.             END ;
  642.             IF (mode IN {IProc, CProc}) & ~OPT.SYSimported THEN err(135) END ;
  643.             OPS.Get(sym)
  644.         END ;
  645.         IF sym = lparen THEN TProcDecl
  646.         ELSIF sym = ident THEN OPT.Find(fwd);
  647.             name := OPS.name; CheckMark(vis);
  648.             IF (vis # internal) & (mode = LProc) THEN mode := XProc END ;
  649.             IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = SProc)) THEN fwd := NIL END ;
  650.             IF (fwd # NIL) & (fwd^.mode IN {LProc, XProc}) & ~(hasBody IN fwd^.conval^.setval) THEN
  651.                 (* there exists a corresponding forward declaration *)
  652.                 proc := OPT.NewObj(); proc^.leaf := TRUE;
  653.                 IF fwd^.vis # vis THEN err(118) END
  654.             ELSE
  655.                 IF fwd # NIL THEN err(1); fwd := NIL END ;
  656.                 OPT.Insert(name, proc)
  657.             END ;
  658.             IF (mode # LProc) & (level > 0) THEN err(73) END ;
  659.             INC(level); OPT.OpenScope(level, proc);
  660.             proc^.link := NIL; GetParams;
  661.             IF mode = CProc THEN GetCode
  662.             ELSIF ~forward THEN Body
  663.             END ;
  664.             DEC(level); OPT.CloseScope
  665.         ELSE err(ident)
  666.         END
  667.     END ProcedureDeclaration;
  668.     PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelForm: INTEGER; VAR n: INTEGER; VAR tab: CaseTable);
  669.         VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
  670.     BEGIN lab := NIL; lastlab := NIL;
  671.         LOOP ConstExpression(x); f := x^.typ^.form;
  672.             IF f IN intSet + {Char} THEN  xval := x^.conval^.intval
  673.             ELSE err(61); xval := 1
  674.             END ;
  675.             IF f IN intSet THEN
  676.                 IF LabelForm < f THEN err(60) END
  677.             ELSIF LabelForm # f THEN err(60)
  678.             END ;
  679.             IF sym = upto THEN
  680.                 OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval;
  681.                 IF (y^.typ^.form # f) & ~((f IN intSet) & (y^.typ^.form IN intSet)) THEN err(60) END ;
  682.                 IF yval < xval THEN err(63); yval := xval END
  683.             ELSE yval := xval
  684.             END ;
  685.             x^.conval^.intval2 := yval;
  686.             (*enter label range into ordered table*)  i := n;
  687.             IF i < OPM.MaxCases THEN
  688.                 LOOP
  689.                     IF i = 0 THEN EXIT END ;
  690.                     IF tab[i-1].low <= yval THEN
  691.                         IF tab[i-1].high >= xval THEN err(62) END ;
  692.                         EXIT
  693.                     END ;
  694.                     tab[i] := tab[i-1]; DEC(i)
  695.                 END ;
  696.                 tab[i].low := xval; tab[i].high := yval; INC(n)
  697.             ELSE err(213)
  698.             END ;
  699.             OPB.Link(lab, lastlab, x);
  700.             IF sym = comma THEN OPS.Get(sym)
  701.             ELSIF (sym = number) OR (sym = ident) THEN err(comma)
  702.             ELSE EXIT
  703.             END
  704.         END
  705.     END CaseLabelList;
  706.     PROCEDURE StatSeq(VAR stat: OPT.Node);
  707.         VAR fpar, id, t, obj: OPT.Object; idtyp: OPT.Struct; e: BOOLEAN;
  708.                 s, x, y, z, apar, last, lastif: OPT.Node; pos: LONGINT; name: OPS.Name;
  709.         PROCEDURE CasePart(VAR x: OPT.Node);
  710.             VAR n: INTEGER; low, high: LONGINT; e: BOOLEAN;
  711.                     tab: CaseTable; cases, lab, y, lastcase: OPT.Node; 
  712.         BEGIN
  713.             Expression(x); pos := OPM.errpos;
  714.             IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
  715.             ELSIF ~(x^.typ^.form IN {Char..LInt}) THEN err(125)
  716.             END ;
  717.             CheckSym(of); cases := NIL; lastcase := NIL; n := 0;
  718.             LOOP
  719.                 IF sym < bar THEN
  720.                     CaseLabelList(lab, x^.typ^.form, n, tab);
  721.                     CheckSym(colon); StatSeq(y);
  722.                     OPB.Construct(Ncasedo, lab, y); OPB.Link(cases, lastcase, lab)
  723.                 END ;
  724.                 IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  725.             END ;
  726.             IF n > 0 THEN low := tab[0].low; high := tab[n-1].high;
  727.                 IF high - low > OPM.MaxCaseRange THEN err(209) END
  728.             ELSE low := 1; high := 0
  729.             END ;
  730.             e := sym = else;
  731.             IF e THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL END ;
  732.             OPB.Construct(Ncaselse, cases, y); OPB.Construct(Ncase, x, cases);
  733.             cases^.conval := OPT.NewConst();
  734.             cases^.conval^.intval := low; cases^.conval^.intval2 := high;
  735.             IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END
  736.         END CasePart;
  737.         PROCEDURE SetPos(x: OPT.Node);
  738.         BEGIN
  739.             x^.conval := OPT.NewConst(); x^.conval^.intval := pos
  740.         END SetPos;
  741.         PROCEDURE CheckBool(VAR x: OPT.Node);
  742.         BEGIN
  743.             IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126); x := OPB.NewBoolConst(FALSE)
  744.             ELSIF x^.typ^.form # Bool THEN err(120); x := OPB.NewBoolConst(FALSE)
  745.             END ;
  746.             pos := OPM.errpos
  747.         END CheckBool;
  748.     BEGIN stat := NIL; last := NIL;
  749.         LOOP x := NIL;
  750.             IF sym < ident THEN err(14);
  751.                 REPEAT OPS.Get(sym) UNTIL sym >= ident
  752.             END ;
  753.             IF sym = ident THEN
  754.                 qualident(id); x := OPB.NewLeaf(id); selector(x);
  755.                 IF sym = becomes THEN
  756.                     OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  757.                 ELSIF sym = eql THEN
  758.                     err(becomes); OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  759.                 ELSIF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN
  760.                     StandProcCall(x);
  761.                     IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END
  762.                 ELSE OPB.PrepCall(x, fpar);
  763.                     IF sym = lparen THEN
  764.                         OPS.Get(sym); ActualParameters(apar, fpar); CheckSym(rparen)
  765.                     ELSE apar := NIL;
  766.                         IF fpar # NIL THEN err(65) END
  767.                     END ;
  768.                     OPB.Call(x, apar, fpar);
  769.                     IF x^.typ # OPT.notyp THEN err(55) END ;
  770.                     IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  771.                 END ;
  772.                 pos := OPM.errpos
  773.             ELSIF sym = if THEN
  774.                 OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(then); StatSeq(y);
  775.                 OPB.Construct(Nif, x, y); SetPos(x); lastif := x;
  776.                 WHILE sym = elsif DO
  777.                     OPS.Get(sym); Expression(y); CheckBool(y); CheckSym(then); StatSeq(z);
  778.                     OPB.Construct(Nif, y, z); SetPos(y); OPB.Link(x, lastif, y);
  779.                 END ;
  780.                 IF sym = else THEN OPS.Get(sym); StatSeq(y)
  781.                 ELSE y := NIL
  782.                 END ;
  783.                 OPB.Construct(Nifelse, x, y); CheckSym(end); OPB.OptIf(x); pos := OPM.errpos
  784.             ELSIF sym = case THEN
  785.                 OPS.Get(sym); CasePart(x); CheckSym(end)
  786.             ELSIF sym = while THEN
  787.                 OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(do); StatSeq(y);
  788.                 OPB.Construct(Nwhile, x, y); CheckSym(end)
  789.             ELSIF sym = repeat THEN
  790.                 OPS.Get(sym); StatSeq(x);
  791.                 IF sym = until THEN OPS.Get(sym); Expression(y); CheckBool(y)
  792.                 ELSE err(until)
  793.                 END ;
  794.                 OPB.Construct(Nrepeat, x, y)
  795.             ELSIF sym = for THEN
  796.                 OPS.Get(sym);
  797.                 IF sym = ident THEN qualident(id);
  798.                     IF ~(id^.typ^.form IN intSet) THEN err(68) END ;
  799.                     CheckSym(becomes); Expression(y); pos := OPM.errpos;
  800.                     x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x);
  801.                     CheckSym(to); Expression(y); pos := OPM.errpos;
  802.                     IF y^.class # Nconst THEN
  803.                         name := "@@"; OPT.Insert(name, t); t^.name := "@for";
  804.                         t^.mode := Var; t^.typ := x^.left^.typ;
  805.                         obj := OPT.topScope^.scope;
  806.                         IF obj = NIL THEN OPT.topScope^.scope := t
  807.                         ELSE
  808.                             WHILE obj^.link # NIL DO obj := obj^.link END ;
  809.                             obj^.link := t
  810.                         END ;
  811.                         z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z);
  812.                         y := OPB.NewLeaf(t)
  813.                     ELSIF (y^.typ^.form < SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113)
  814.                     END ;
  815.                     OPB.Link(stat, last, x);
  816.                     IF sym = by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ;
  817.                     pos := OPM.errpos; x := OPB.NewLeaf(id);
  818.                     IF z^.conval^.intval > 0 THEN OPB.Op(leq, x, y)
  819.                     ELSIF z^.conval^.intval < 0 THEN OPB.Op(geq, x, y)
  820.                     ELSE err(63); OPB.Op(geq, x, y)
  821.                     END ;
  822.                     CheckSym(do); StatSeq(s);
  823.                     y := OPB.NewLeaf(id); OPB.StPar1(y, z, incfn); SetPos(y);
  824.                     IF s = NIL THEN s := y
  825.                     ELSE z := s;
  826.                         WHILE z^.link # NIL DO z := z^.link END ;
  827.                         z^.link := y
  828.                     END ;
  829.                     CheckSym(end); OPB.Construct(Nwhile, x, s)
  830.                 ELSE err(ident)
  831.                 END
  832.             ELSIF sym = loop THEN
  833.                 OPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel);
  834.                 OPB.Construct(Nloop, x, NIL); CheckSym(end); pos := OPM.errpos
  835.             ELSIF sym = with THEN
  836.                 OPS.Get(sym); idtyp := NIL; x := NIL;
  837.                 LOOP
  838.                     IF sym = ident THEN
  839.                         qualident(id); y := OPB.NewLeaf(id);
  840.                         IF (id # NIL) & (id^.typ^.form = Pointer) & ((id^.mode = VarPar) OR ~id^.leaf) THEN
  841.                             err(-302)    (* warning 302 *)
  842.                         END ;
  843.                         CheckSym(colon);
  844.                         IF sym = ident THEN qualident(t);
  845.                             IF t^.mode = Typ THEN
  846.                                 IF id # NIL THEN
  847.                                     idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ
  848.                                 ELSE err(130)
  849.                                 END
  850.                             ELSE err(52)
  851.                             END
  852.                         ELSE err(ident)
  853.                         END
  854.                     ELSE err(ident)
  855.                     END ;
  856.                     pos := OPM.errpos; CheckSym(do); StatSeq(s); OPB.Construct(Nif, y, s); SetPos(y);
  857.                     IF idtyp # NIL THEN id^.typ := idtyp; idtyp := NIL END ;
  858.                     IF x = NIL THEN x := y; lastif := x ELSE OPB.Link(x, lastif, y) END ;
  859.                     IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  860.                 END;
  861.                 e := sym = else;
  862.                 IF e THEN OPS.Get(sym); StatSeq(s) ELSE s := NIL END ;
  863.                 OPB.Construct(Nwith, x, s); CheckSym(end);
  864.                 IF e THEN x^.subcl := 1 END
  865.             ELSIF sym = exit THEN
  866.                 OPS.Get(sym);
  867.                 IF LoopLevel = 0 THEN err(46) END ;
  868.                 OPB.Construct(Nexit, x, NIL);
  869.                 pos := OPM.errpos
  870.             ELSIF sym = return THEN OPS.Get(sym);
  871.                 IF sym < semicolon THEN Expression(x) END ;
  872.                 IF level > 0 THEN OPB.Return(x, OPT.topScope^.link)
  873.                 ELSE (* not standard Oberon *) OPB.Return(x, NIL)
  874.                 END ;
  875.                 pos := OPM.errpos
  876.             END ;
  877.             IF x # NIL THEN SetPos(x); OPB.Link(stat, last, x) END ;
  878.             IF sym = semicolon THEN OPS.Get(sym)
  879.             ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN err(semicolon)
  880.             ELSE EXIT
  881.             END
  882.         END
  883.     END StatSeq;
  884.     PROCEDURE Block(VAR procdec, statseq: OPT.Node);
  885.         VAR typ: OPT.Struct;
  886.             obj, first, last: OPT.Object;
  887.             x, lastdec: OPT.Node;
  888.             i: INTEGER;
  889.     BEGIN first := NIL; last := NIL; nofFwdPtr := 0;
  890.         LOOP
  891.             IF sym = const THEN
  892.                 OPS.Get(sym);
  893.                 WHILE sym = ident DO
  894.                     OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  895.                     obj^.typ := OPT.sinttyp; obj^.mode := Var;    (* Var to avoid recursive definition *)
  896.                     IF sym = eql THEN
  897.                         OPS.Get(sym); ConstExpression(x)
  898.                     ELSIF sym = becomes THEN
  899.                         err(eql); OPS.Get(sym); ConstExpression(x)
  900.                     ELSE err(eql); x := OPB.NewIntConst(1)
  901.                     END ;
  902.                     obj^.mode := Con; obj^.typ := x^.typ; obj^.conval := x^.conval; (* ConstDesc ist not copied *)
  903.                     CheckSym(semicolon)
  904.                 END
  905.             END ;
  906.             IF sym = type THEN
  907.                 OPS.Get(sym);
  908.                 WHILE sym = ident DO
  909.                     OPT.Insert(OPS.name, obj); obj^.mode := Typ; obj^.typ := OPT.undftyp;
  910.                     CheckMark(obj^.vis);
  911.                     IF sym = eql THEN
  912.                         OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  913.                     ELSIF (sym = becomes) OR (sym = colon) THEN
  914.                         err(eql); OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  915.                     ELSE err(eql)
  916.                     END ;
  917.                     IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ;
  918.                     IF obj^.typ^.comp IN {Record, Array, DynArr} THEN
  919.                         i := 0;
  920.                         WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i);
  921.                             IF typ^.link^.name = obj^.name THEN typ^.BaseTyp := obj^.typ; typ^.link^.name := "" END
  922.                         END
  923.                     END ;
  924.                     CheckSym(semicolon)
  925.                 END
  926.             END ;
  927.             IF sym = var THEN
  928.                 OPS.Get(sym);
  929.                 WHILE sym = ident DO
  930.                     LOOP
  931.                         IF sym = ident THEN
  932.                             OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  933.                             obj^.mode := Var; obj^.link := NIL; obj^.leaf := obj^.vis = internal; obj^.typ := OPT.undftyp;
  934.                             IF first = NIL THEN first := obj END ;
  935.                             IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ;
  936.                             last := obj
  937.                         ELSE err(ident)
  938.                         END ;
  939.                         IF sym = comma THEN OPS.Get(sym)
  940.                         ELSIF sym = ident THEN err(comma)
  941.                         ELSE EXIT
  942.                         END
  943.                     END ;
  944.                     CheckSym(colon); Type(typ, OPT.notyp);
  945.                     IF typ^.comp = DynArr THEN typ := OPT.undftyp; err(88) END ;
  946.                     WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  947.                     CheckSym(semicolon)
  948.                 END
  949.             END ;
  950.             IF (sym < const) OR (sym > var) THEN EXIT END ;
  951.         END ;
  952.         i := 0;
  953.         WHILE i < nofFwdPtr DO
  954.             IF FwdPtr[i]^.link^.name # "" THEN err(128) END ;
  955.             FwdPtr[i] := NIL;    (* garbage collection *)
  956.             INC(i)
  957.         END ;
  958.         OPT.topScope^.adr := OPM.errpos;
  959.         procdec := NIL; lastdec := NIL;
  960.         WHILE sym = procedure DO
  961.             OPS.Get(sym); ProcedureDeclaration(x);
  962.             IF x # NIL THEN
  963.                 IF lastdec = NIL THEN procdec := x ELSE lastdec^.link := x END ;
  964.                 lastdec := x
  965.             END ;
  966.             CheckSym(semicolon)
  967.         END ;
  968.         IF sym = begin THEN OPS.Get(sym); StatSeq(statseq)
  969.         ELSE statseq := NIL
  970.         END ;
  971.         IF (level = 0) & (TDinit # NIL) THEN
  972.             lastTDinit^.link := statseq; statseq := TDinit
  973.         END ;
  974.         CheckSym(end)
  975.     END Block;
  976.     PROCEDURE Module*(VAR prog: OPT.Node; VAR modName: OPS.Name);
  977.         VAR impName, aliasName: OPS.Name;
  978.                 procdec, statseq: OPT.Node;
  979.                 c: LONGINT;
  980.     BEGIN
  981.         LoopLevel := 0; level := 0;
  982.         OPS.Get(sym);
  983.         IF sym = module THEN OPS.Get(sym) ELSE err(16) END ;
  984.         IF sym = ident THEN
  985.             COPY(OPS.name, modName); OPS.Get(sym); CheckSym(semicolon);
  986.             IF sym = import THEN OPS.Get(sym);
  987.                 LOOP
  988.                     IF sym = ident THEN
  989.                         COPY(OPS.name, aliasName); COPY(aliasName, impName); OPS.Get(sym);
  990.                         IF sym = becomes THEN OPS.Get(sym);
  991.                             IF sym = ident THEN COPY(OPS.name, impName); OPS.Get(sym) ELSE err(ident) END
  992.                         END ;
  993.                         OPT.Import(aliasName, impName, modName)
  994.                     ELSE err(ident)
  995.                     END ;
  996.                     IF sym = comma THEN OPS.Get(sym)
  997.                     ELSIF sym = ident THEN err(comma)
  998.                     ELSE EXIT
  999.                     END
  1000.                 END ;
  1001.                 CheckSym(semicolon)
  1002.             END ;
  1003.             IF OPM.noerr THEN TDinit := NIL; lastTDinit := NIL; c := OPM.errpos;
  1004.                 Block(procdec, statseq); OPB.Enter(procdec, statseq, NIL); prog := procdec;
  1005.                 prog^.conval := OPT.NewConst(); prog^.conval^.intval := c;
  1006.                 IF sym = ident THEN
  1007.                     IF OPS.name # modName THEN err(4) END ;
  1008.                     OPS.Get(sym)
  1009.                 ELSE err(ident)
  1010.                 END ;
  1011.                 IF sym # period THEN err(period) END
  1012.             END
  1013.         ELSE err(ident)
  1014.         END ;
  1015.         TDinit := NIL; lastTDinit := NIL
  1016.     END Module;
  1017. END OPP.
  1018.