Syntax24b.Scn.Fnt
ParcElems
Alloc
Syntax10.Scn.Fnt
(* Amiga NonFPU *) 
MODULE OPB; (* RC 6.3.89 / 5.1.93 *)
(* build parse tree *)
 IMPORT OPT, OPS, OPM, AmigaMathL;
 CONST
  (* symbol values or ops *)
  times = 1; slash = 2; div = 3; mod = 4;
  and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  in = 15; is = 16; ash = 17; msk = 18; len = 19;
  conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
  (*SYSTEM*)
  adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
  (* object modes *)
  Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  (* Structure forms *)
  Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  Pointer = 13; ProcTyp = 14; Comp = 15;
  intSet = {SInt..LInt}; realSet = {Real, LReal};
  (* composite structure forms *)
  Basic = 1; Array = 2; DynArr = 3; Record = 4;
  (* nodes classes *)
  Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  Nreturn = 26; Nwith = 27; Ntrap = 28;
  (*function number*)
  assign = 0;
  haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
  entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
  shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
  inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
  (*SYSTEM function number*)
  adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
  getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
  bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31;
  (* module visibility of objects *)
  internal = 0; external = 1; externalR = 2;
  (* procedure flags (conval^.setval) *)
  hasBody = 1; isRedef = 2; slNeeded = 3;
  AssertTrap = 0; (* default trap number *)
  typSize*: PROCEDURE(typ: OPT.Struct; allocDesc: BOOLEAN);
  exp: INTEGER; (*side effect of log*)
  maxExp: LONGINT; (* max n in ASH(1, n) on this machine *)
 PROCEDURE err(n: INTEGER);
 BEGIN OPM.err(n)
 END err;
 PROCEDURE NewLeaf*(obj: OPT.Object): OPT.Node;
  VAR node: OPT.Node;
 BEGIN
  CASE obj^.mode OF
    Var:
    node := OPT.NewNode(Nvar); node^.readonly := (obj^.vis = externalR) & (obj^.mnolev < 0)
  | VarPar:
    node := OPT.NewNode(Nvarpar)
  | Con:
    node := OPT.NewNode(Nconst); node^.conval := OPT.NewConst();
    node^.conval^ := obj^.conval^ (* string is not copied, only its ref *)
  | Typ:
    node := OPT.NewNode(Ntype)
  | LProc..IProc:
    node := OPT.NewNode(Nproc)
  ELSE err(127); node := OPT.NewNode(Nvar)
  END ;
  node^.obj := obj; node^.typ := obj^.typ;
  RETURN node
 END NewLeaf;
 PROCEDURE Construct*(class: SHORTINT; VAR x: OPT.Node;  y: OPT.Node);
  VAR node: OPT.Node;
 BEGIN
  node := OPT.NewNode(class); node^.typ := OPT.notyp;
  node^.left := x; node^.right := y; x := node
 END Construct;
 PROCEDURE Link*(VAR x, last: OPT.Node; y: OPT.Node);
 BEGIN
  IF x = NIL THEN x := y ELSE last^.link := y END ;
  WHILE y^.link # NIL DO y := y^.link END ;
  last := y
 END Link;
 PROCEDURE BoolToInt(b: BOOLEAN): LONGINT;
 BEGIN
  IF b THEN RETURN 1 ELSE RETURN 0 END
 END BoolToInt;
 PROCEDURE IntToBool(i: LONGINT): BOOLEAN;
 BEGIN
  IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END
 END IntToBool;
 PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node;
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nconst); x^.typ := OPT.booltyp;
  x^.conval := OPT.NewConst(); x^.conval^.intval := BoolToInt(boolval); RETURN x
 END NewBoolConst;
 PROCEDURE OptIf*(VAR x: OPT.Node); (* x^.link = NIL *)
  VAR if, pred: OPT.Node;
 BEGIN
  if := x^.left;
  WHILE if^.left^.class = Nconst DO
   IF IntToBool(if^.left^.conval^.intval) THEN x := if^.right; RETURN
   ELSIF if^.link = NIL THEN x := x^.right; RETURN
   ELSE if := if^.link; x^.left := if
   END
  END ;
  pred := if; if := if^.link;
  WHILE if # NIL DO
   IF if^.left^.class = Nconst THEN
    IF IntToBool(if^.left^.conval^.intval) THEN
     pred^.link := NIL; x^.right := if^.right; RETURN
    ELSE if := if^.link; pred^.link := if
    END
   ELSE pred := if; if := if^.link
   END
  END
 END OptIf;
 PROCEDURE Nil*(): OPT.Node;
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nconst); x^.typ := OPT.niltyp;
  x^.conval := OPT.NewConst(); x^.conval^.intval := OPM.nilval; RETURN x
 END Nil;
 PROCEDURE EmptySet*(): OPT.Node;
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nconst); x^.typ := OPT.settyp;
  x^.conval := OPT.NewConst(); x^.conval^.setval := {}; RETURN x
 END EmptySet;
 PROCEDURE SetIntType(node: OPT.Node);
  VAR v: LONGINT;
 BEGIN v := node^.conval^.intval;
  IF (OPM.MinSInt <= v) & (v <= OPM.MaxSInt) THEN node^.typ := OPT.sinttyp
  ELSIF (OPM.MinInt <= v) & (v <= OPM.MaxInt) THEN node^.typ := OPT.inttyp
  ELSIF (OPM.MinLInt <= v) & (v <= OPM.MaxLInt) (*bootstrap or cross*) THEN
   node^.typ := OPT.linttyp
  ELSE err(203); node^.typ := OPT.sinttyp; node^.conval^.intval := 1
  END
 END SetIntType;
 PROCEDURE NewIntConst*(intval: LONGINT): OPT.Node;
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nconst); x^.conval := OPT.NewConst();
  x^.conval^.intval := intval; SetIntType(x); RETURN x
 END NewIntConst;
 PROCEDURE NewRealConst*(realval: LONGREAL; typ: OPT.Struct): OPT.Node;
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nconst); x^.conval := OPT.NewConst();
  x^.conval^.realval := realval; x^.typ := typ; x^.conval^.intval := OPM.ConstNotAlloc;
  RETURN x
 END NewRealConst;
 PROCEDURE NewString*(VAR str: OPS.String; len: LONGINT): OPT.Node;
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nconst); x^.conval := OPT.NewConst(); x^.typ := OPT.stringtyp;
  x^.conval^.intval := OPM.ConstNotAlloc; x^.conval^.intval2 := len;
  x^.conval^.ext := OPT.NewExt(); x^.conval^.ext^ := str;
  RETURN x
 END NewString;
 PROCEDURE CharToString(n: OPT.Node);
  VAR ch: CHAR;
 BEGIN
  n^.typ := OPT.stringtyp; ch := CHR(n^.conval^.intval); n^.conval^.ext := OPT.NewExt();
  IF ch = 0X THEN n^.conval^.intval2 := 1 ELSE n^.conval^.intval2 := 2; n^.conval^.ext[1] := 0X END ;
  n^.conval^.ext[0] := ch; n^.conval^.intval := OPM.ConstNotAlloc; n^.obj := NIL
 END CharToString;
 PROCEDURE BindNodes(class: SHORTINT; typ: OPT.Struct; VAR x: OPT.Node; y: OPT.Node);
  VAR node: OPT.Node;
 BEGIN
  node := OPT.NewNode(class); node^.typ := typ;
  node^.left := x; node^.right := y; x := node
 END BindNodes;
 PROCEDURE NotVar(x: OPT.Node): BOOLEAN;
 BEGIN RETURN (x^.class >= Nconst) & ((x^.class # Nmop) OR (x^.subcl # val) OR (x^.left^.class >= Nconst))
 END NotVar;
 PROCEDURE DeRef*(VAR x: OPT.Node);
 BEGIN
  IF x^.class >= Nconst THEN err(78)
  ELSIF x^.typ^.form = Pointer THEN BindNodes(Nderef, x^.typ^.BaseTyp, x, NIL)
  ELSE err(84)
  END
 END DeRef;
 PROCEDURE Index*(VAR x: OPT.Node; y: OPT.Node);
  VAR f: INTEGER; typ: OPT.Struct;
 BEGIN
  f := y^.typ^.form;
  IF x^.class >= Nconst THEN err(79)
  ELSIF ~(f IN intSet) THEN err(80); y^.typ := OPT.inttyp END ;
  IF x^.typ^.comp = Array THEN typ := x^.typ^.BaseTyp;
   IF (y^.class = Nconst) & ((y^.conval^.intval < 0) OR (y^.conval^.intval >= x^.typ^.n)) THEN err(81) END
  ELSIF x^.typ^.comp = DynArr THEN typ := x^.typ^.BaseTyp;
   IF (y^.class = Nconst) & (y^.conval^.intval < 0) THEN err(81) END
  ELSE err(82); typ := OPT.undftyp
  END ;
  BindNodes(Nindex, typ, x, y); x^.readonly := x^.left^.readonly
 END Index;
 PROCEDURE Field*(VAR x: OPT.Node; y: OPT.Object);
 BEGIN (*x^.typ^.comp = Record*)
  IF x^.class >= Nconst THEN err(77)
  ELSIF (y # NIL) & (y^.mode IN {Fld, TProc}) THEN
   BindNodes(Nfield, y^.typ, x, NIL); x^.obj := y;
   x^.readonly := x^.left^.readonly OR ((y^.vis = externalR) & (y^.mnolev < 0))
  ELSE err(83); x^.typ := OPT.undftyp
  END
 END Field;
  PROCEDURE TypTest*(VAR x: OPT.Node; obj: OPT.Object; guard: BOOLEAN);
    PROCEDURE GTT(t0, t1: OPT.Struct);
      VAR node: OPT.Node; t: OPT.Struct;
    BEGIN t := t0;
      WHILE (t # NIL) & (t # t1) & (t # OPT.undftyp) DO t := t^.BaseTyp END ;
      IF t # t1 THEN
        WHILE (t1 # NIL) & (t1 # t0) & (t1 # OPT.undftyp) DO t1 :=
t1^.BaseTyp END ;
        IF t1 = t0 THEN
          IF guard THEN BindNodes(Nguard, NIL, x, NIL); x^.readonly :=
x^.left^.readonly
          ELSE node := OPT.NewNode(Nmop); node^.subcl := is; node^.left := x;
            node^.obj := obj; x := node
          END
        ELSE err(85)
        END
        ELSIF t0 # t1 THEN err(85)	(* prevent down guard *)
      ELSIF ~guard THEN
        IF x^.class = Nguard THEN  (* cannot skip guard *)
          node := OPT.NewNode(Nmop); node^.subcl := is; node^.left := x;
          node^.obj := obj; x := node
        ELSE x := NewBoolConst(TRUE)
        END
      END
    END GTT;
  BEGIN
    IF NotVar(x) THEN err(112)
    ELSIF x^.typ^.form = Pointer THEN
      IF x^.typ^.BaseTyp^.comp # Record THEN err(85)
      ELSIF obj^.typ^.form = Pointer THEN GTT(x^.typ^.BaseTyp,
obj^.typ^.BaseTyp)
      ELSE err(86)
      END
    ELSIF (x^.typ^.comp = Record) & (x^.class = Nvarpar) & (obj^.typ^.comp =
Record) THEN
      GTT(x^.typ, obj^.typ)
    ELSE err(87)
    END ;
    IF guard THEN x^.typ := obj^.typ ELSE x^.typ := OPT.booltyp END
  END TypTest;
 PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node);
  VAR f: INTEGER; k: LONGINT;
 BEGIN f := x^.typ^.form;
  IF (x^.class = Ntype) OR (x^.class = Nproc) OR (y^.class = Ntype) OR (y^.class = Nproc) THEN err(126)
  ELSIF (f IN intSet) & (y^.typ^.form = Set) THEN
   IF x^.class = Nconst THEN
    k := x^.conval^.intval;
    IF (k < 0) OR (k > OPM.MaxSet) THEN err(202)
    ELSIF y^.class = Nconst THEN x^.conval^.intval := BoolToInt(k IN y^.conval^.setval); x^.obj := NIL
    ELSE BindNodes(Ndop, OPT.booltyp, x, y); x^.subcl := in
    END
   ELSE BindNodes(Ndop, OPT.booltyp, x, y); x^.subcl := in
   END
  ELSE err(92)
  END ;
  x^.typ := OPT.booltyp
 END In;
 PROCEDURE log(x: LONGINT): LONGINT;
 BEGIN exp := 0;
  IF x > 0 THEN
   WHILE ~ODD(x) DO x := x DIV 2; INC(exp) END
  END ;
  RETURN x
 END log;
 PROCEDURE CheckRealType(f, nr: INTEGER; x: OPT.Const);
  VAR min, max, r: LONGREAL;Dummy: REAL;
 BEGIN
  IF f = Real THEN 
  	AmigaMathL.Long(OPM.MinReal,min);(* min := OPM.MinReal; *)
  	AmigaMathL.Long(OPM.MaxReal,max);(* max := OPM.MaxReal; *)
  ELSE min := OPM.MinLReal; max := OPM.MaxLReal
  END ;
  AmigaMathL.Abs(x^.realval,r);
(*  r := ABS(x^.realval);*)
  IF (AmigaMathL.Cmp(r,max)>0) OR (AmigaMathL.Cmp(r,min)<0) THEN
(*  IF (r > max) OR (r < min) THEN*)
    err(nr); x^.realval := 1(*.0*)
  ELSIF f = Real THEN
   AmigaMathL.Short(x^.realval, Dummy);
   AmigaMathL.Long(Dummy, x^.realval);
(*   x^.realval := SHORT(x^.realval) (* single precision only *)*)
  END ;
  x^.intval := OPM.ConstNotAlloc
 END CheckRealType;
 PROCEDURE MOp*(op: SHORTINT; VAR x: OPT.Node);
  VAR f: INTEGER; typ: OPT.Struct;
  PROCEDURE NewOp;
   VAR node: OPT.Node;
  BEGIN
   node := OPT.NewNode(Nmop); node^.subcl := op; node^.typ := typ;
   node^.left := x; x := node
  END NewOp;
 BEGIN
  IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
  ELSE typ := x^.typ; f := typ^.form;
   CASE op OF
     not:
     IF f = Bool THEN
      IF x^.class = Nconst THEN
       x^.conval^.intval := BoolToInt(~IntToBool(x^.conval^.intval)); x^.obj := NIL
      ELSE NewOp
      END
     ELSE err(98)
     END
   | plus:
     IF ~(f IN intSet + realSet) THEN err(96) END
   | minus:
     IF f IN intSet + realSet +{Set}THEN
      IF x^.class = Nconst THEN
       IF f IN intSet THEN
        IF x^.conval^.intval = MIN(LONGINT) THEN err(203)
        ELSE x^.conval^.intval := -x^.conval^.intval; SetIntType(x)
        END
       ELSIF f IN realSet THEN
        AmigaMathL.Neg(x^.conval^.realval, x^.conval^.realval);
        (* x^.conval^.realval := -x^.conval^.realval *)
       ELSE x^.conval^.setval := -x^.conval^.setval
       END ;
       x^.obj := NIL
      ELSE NewOp
      END
     ELSE err(97)
     END
   | abs:
     IF f IN intSet + realSet THEN
      IF x^.class = Nconst THEN
       IF f IN intSet THEN
        IF x^.conval^.intval = MIN(LONGINT) THEN err(203)
        ELSE x^.conval^.intval := ABS(x^.conval^.intval); SetIntType(x)
        END
       ELSE 
        AmigaMathL.Abs(x^.conval^.realval, x^.conval^.realval);
        (* x^.conval^.realval := ABS(x^.conval^.realval) *)
       END ;
       x^.obj := NIL
      ELSE NewOp
      END
     ELSE err(111)
     END
   | cap:
     IF f = Char THEN
      IF x^.class = Nconst THEN
       x^.conval^.intval := ORD(CAP(CHR(x^.conval^.intval))); x^.obj := NIL
      ELSE NewOp
      END
     ELSE err(111); x^.typ := OPT.chartyp
     END
   | odd:
     IF f IN intSet THEN
      IF x^.class = Nconst THEN
       x^.conval^.intval := BoolToInt(ODD(x^.conval^.intval)); x^.obj := NIL
      ELSE NewOp
      END
     ELSE err(111)
     END ;
     x^.typ := OPT.booltyp
   | adr: (*SYSTEM.ADR*)
     IF (x^.class < Nconst) OR (f = String) THEN NewOp
     ELSE err(127)
     END ;
     x^.typ := OPT.linttyp
   | cc: (*SYSTEM.CC*)
     IF (f IN intSet) & (x^.class = Nconst) THEN
      IF (0 <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxCC) THEN NewOp ELSE err(219) END
     ELSE err(69)
     END ;
     x^.typ := OPT.booltyp
   END
  END
 END MOp;
 PROCEDURE CheckPtr(x, y: OPT.Node);
  VAR g: INTEGER; p, q, t: OPT.Struct;
 BEGIN g := y^.typ^.form;
  IF g = Pointer THEN
   p := x^.typ^.BaseTyp; q := y^.typ^.BaseTyp;
   IF (p^.comp = Record) & (q^.comp = Record) THEN
    IF p^.extlev < q^.extlev THEN t := p; p := q; q := t END ;
    WHILE (p # q) & (p # NIL) & (p # OPT.undftyp) DO p := p^.BaseTyp END ;
    IF p = NIL THEN err(100) END
   ELSE err(100)
   END
  ELSIF g # NilTyp THEN err(100)
  END
 END CheckPtr;
 PROCEDURE CheckParameters*(fp, ap: OPT.Object; checkNames: BOOLEAN);
  VAR ft, at: OPT.Struct;
 BEGIN
  WHILE fp # NIL DO
   IF ap # NIL THEN
    ft := fp^.typ; at := ap^.typ;
    WHILE (ft^.comp = DynArr) & (at^.comp = DynArr) DO
     ft := ft^.BaseTyp; at := at^.BaseTyp
    END ;
    IF ft # at THEN
     IF (ft^.form = ProcTyp) & (at^.form = ProcTyp) THEN
      IF ft^.BaseTyp = at^.BaseTyp THEN CheckParameters(ft^.BaseTyp^.link, at^.BaseTyp^.link, FALSE)
      ELSE err(117)
      END
     ELSE err(115)
     END
    END ;
    IF (fp^.mode # ap^.mode) OR checkNames & (fp^.name # ap^.name) THEN err(115) END ;
    ap := ap^.link
   ELSE err(116)
   END ;
   fp := fp^.link
  END ;
  IF ap # NIL THEN err(116) END
 END CheckParameters;
 PROCEDURE CheckProc(x: OPT.Struct; y: OPT.Object); (* proc var x := proc y, check compatibility *)
 BEGIN
  IF y^.mode IN {XProc, IProc, LProc} THEN
   IF y^.mode = LProc THEN
    IF y^.mnolev = 0 THEN y^.mode := XProc
    ELSE err(73)
    END
   END ;
   IF x^.BaseTyp = y^.typ THEN CheckParameters(x^.link, y^.link, FALSE)
   ELSE err(117)
   END
  ELSE err(113)
  END
 END CheckProc;
 PROCEDURE ConstOp(op: INTEGER; x, y: OPT.Node);
  VAR f, g: INTEGER; xval, yval: OPT.Const; xv, yv: LONGINT;
    temp: BOOLEAN; (* temp avoids err 215 *)
    LDummy, xAbs, yAbs: LONGREAL;
  PROCEDURE ConstCmp(): INTEGER;
   VAR res: INTEGER;
  BEGIN
   CASE f OF
     Undef:
     res := eql
   | Byte, Char..LInt:
     IF xval^.intval < yval^.intval THEN res := lss
     ELSIF xval^.intval > yval^.intval THEN res := gtr
     ELSE res := eql
     END
   | Real, LReal:
     IF AmigaMathL.Cmp(xval^.realval, yval^.realval)<0 THEN res := lss
     ELSIF AmigaMathL.Cmp(xval^.realval, yval^.realval)>0 THEN res := gtr
     ELSE res := eql
     END
(*     IF xval^.realval < yval^.realval THEN res := lss
     ELSIF xval^.realval > yval^.realval THEN res := gtr
     ELSE res := eql
     END *)
   | Bool:
     IF xval^.intval # yval^.intval THEN res := neq
     ELSE res := eql
     END
   | Set:
     IF xval^.setval # yval^.setval THEN res := neq
     ELSE res := eql
     END
   | String:
     IF xval^.ext^ < yval^.ext^ THEN res := lss
     ELSIF xval^.ext^ > yval^.ext^ THEN res := gtr
     ELSE res := eql
     END
   | NilTyp, Pointer, ProcTyp:
     IF xval^.intval # yval^.intval THEN res := neq
     ELSE res := eql
     END
   END ;
   x^.typ := OPT.booltyp; RETURN res
  END ConstCmp;
 BEGIN
  f := x^.typ^.form; g := y^.typ^.form; xval := x^.conval; yval := y^.conval;
  IF f # g THEN
   CASE f OF
     Char:
     IF g = String THEN CharToString(x)
     ELSE err(100); y^.typ := x^.typ; yval^ := xval^
     END ;
   | SInt:
     IF g IN intSet THEN x^.typ := y^.typ
     ELSIF g = Real THEN
      x^.typ := OPT.realtyp;
      AmigaMathL.IntToReal(xval^.intval, xval^.realval); (*xval^.realval := xval^.intval*)
     ELSIF g = LReal THEN
      x^.typ := OPT.lrltyp;
      AmigaMathL.IntToReal(xval^.intval, xval^.realval); (*xval^.realval := xval^.intval*)
     ELSE  err(100); y^.typ := x^.typ; yval^ := xval^
     END
   | Int:
     IF g = SInt THEN y^.typ := OPT.inttyp
     ELSIF g IN intSet THEN x^.typ := y^.typ
     ELSIF g = Real THEN x^.typ := OPT.realtyp;
      AmigaMathL.IntToReal(xval^.intval, xval^.realval); (*xval^.realval := xval^.intval*)
     ELSIF g = LReal THEN x^.typ := OPT.lrltyp;
      AmigaMathL.IntToReal(xval^.intval, xval^.realval); (*xval^.realval := xval^.intval*)
     ELSE  err(100); y^.typ := x^.typ; yval^ := xval^
     END
   | LInt:
     IF g IN intSet THEN y^.typ := OPT.linttyp
     ELSIF g = Real THEN x^.typ := OPT.realtyp;
      AmigaMathL.IntToReal(xval^.intval, xval^.realval); (*xval^.realval := xval^.intval*)
     ELSIF g = LReal THEN x^.typ := OPT.lrltyp;
      AmigaMathL.IntToReal(xval^.intval, xval^.realval); (*xval^.realval := xval^.intval*)
     ELSE  err(100); y^.typ := x^.typ; yval^ := xval^
     END
   | Real:
     IF g IN intSet THEN y^.typ := x^.typ;
      AmigaMathL.IntToReal(yval^.intval, yval^.realval); (*yval^.realval := yval^.intval*)
     ELSIF g = LReal THEN x^.typ := OPT.lrltyp
     ELSE  err(100); y^.typ := x^.typ; yval^ := xval^
     END
   | LReal:
     IF g IN intSet THEN y^.typ := x^.typ;
      AmigaMathL.IntToReal(yval^.intval, yval^.realval); (*yval^.realval := yval^.intval*)
     ELSIF g = Real THEN y^.typ := OPT.lrltyp
     ELSE  err(100); y^.typ := x^.typ; yval^ := xval^
     END
   | String:
     IF g = Char THEN CharToString(y); g := String
     ELSE err(100); y^.typ := x^.typ; yval^ := xval^
     END ;
   | NilTyp:
     IF ~(g IN {Pointer, ProcTyp}) THEN err(100) END
   | Pointer:
     CheckPtr(x, y)
   | ProcTyp:
     IF g # NilTyp THEN err(100) END
   ELSE err(100); y^.typ := x^.typ; yval^ := xval^
   END ;
   f := x^.typ^.form
  END ; (* {x^.typ = y^.typ} *)
  CASE op OF
    times:
    IF f IN intSet THEN xv := xval^.intval; yv := yval^.intval;
     IF (xv = 0) OR (yv = 0) OR (* division with negative numbers is not defined *)
      (xv > 0) & (yv > 0) & (yv <= MAX(LONGINT) DIV xv) OR
      (xv > 0) & (yv < 0) & (yv >= MIN(LONGINT) DIV xv) OR
      (xv < 0) & (yv > 0) & (xv >= MIN(LONGINT) DIV yv) OR
      (xv < 0) & (yv < 0) & (xv # MIN(LONGINT)) & (yv # MIN(LONGINT)) & (-xv <= MAX(LONGINT) DIV (-yv)) THEN
      xval^.intval := xv * yv; SetIntType(x)
     ELSE err(204)
     END
    ELSIF f IN realSet THEN
     AmigaMathL.Abs(yval^.realval, yAbs);AmigaMathL.Abs(xval^.realval, xAbs);
     temp:=AmigaMathL.Cmp(yAbs, 1) <= 0;
     AmigaMathL.Div(MAX(LONGREAL), yAbs, LDummy);
     IF temp OR (AmigaMathL.Cmp(xAbs, LDummy) <= 0) THEN
     (* temp := ABS(yval^.realval) <= 1(*.0*);
     IF temp OR (ABS(xval^.realval) <= MAX(LONGREAL) / ABS(yval^.realval)) THEN*)
      AmigaMathL.Mul(xval^.realval, yval^.realval, xval^.realval);
      (* xval^.realval := xval^.realval * yval^.realval; *)
      CheckRealType(f, 204, xval)
     ELSE err(204)
     END
    ELSIF f = Set THEN
      xval^.setval := xval^.setval * yval^.setval
    ELSIF f # Undef THEN err(101)
    END
  | slash:
    IF f IN intSet THEN
     IF yval^.intval # 0 THEN
      AmigaMathL.IntToReal(xval^.intval, xAbs);
      AmigaMathL.IntToReal(yval^.intval, yAbs);
      AmigaMathL.Div(xAbs, yAbs, xval^.realval);
      (* xval^.realval := xval^.intval / yval^.intval; *)
      CheckRealType(Real, 205, xval)
     ELSE err(205); AmigaMathL.IntToReal(1, xval^.realval); (*xval^.realval := 1(*.0*)*)
     END ;
     x^.typ := OPT.realtyp
    ELSIF f IN realSet THEN
     AmigaMathL.Abs(yval^.realval, yAbs);AmigaMathL.Abs(xval^.realval, xAbs);
     temp:=AmigaMathL.Cmp(yAbs, 1) >= 0;  (* !?!?! *)
     AmigaMathL.Mul(MAX(LONGREAL), yAbs, LDummy);
     IF temp OR (AmigaMathL.Cmp(xAbs, LDummy) <= 0) THEN
     (* temp := ABS(yval^.realval) >= 1(*.0*);
     IF temp OR (ABS(xval^.realval) <= MAX(LONGREAL) * ABS(yval^.realval)) THEN*)
      AmigaMathL.Div(xval^.realval, yval^.realval, xval^.realval);
      (* xval^.realval := xval^.realval / yval^.realval; *)
      CheckRealType(f, 205, xval)
     ELSE err(205)
     END
    ELSIF f = Set THEN
     xval^.setval := xval^.setval / yval^.setval
    ELSIF f # Undef THEN err(102)
    END
  | div:
    IF f IN intSet THEN
     IF yval^.intval # 0 THEN
      xval^.intval := xval^.intval DIV yval^.intval; SetIntType(x)
     ELSE err(205)
     END
    ELSIF f # Undef THEN err(103)
    END
  | mod:
    IF f IN intSet THEN
     IF yval^.intval # 0 THEN
      xval^.intval := xval^.intval MOD yval^.intval; SetIntType(x)
     ELSE err(205)
     END
    ELSIF f # Undef THEN err(104)
    END
  | and:
    IF f = Bool THEN
     xval^.intval := BoolToInt(IntToBool(xval^.intval) & IntToBool(yval^.intval))
    ELSE err(94)
    END
  | plus:
    IF f IN intSet THEN
     temp := (yval^.intval >= 0) & (xval^.intval <= MAX(LONGINT) - yval^.intval);
     IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(LONGINT) - yval^.intval) THEN
       INC(xval^.intval, yval^.intval); SetIntType(x)
     ELSE err(206)
     END
    ELSIF f IN realSet THEN
     AmigaMathL.Sub(MAX(LONGREAL), yval^.realval, LDummy);
     temp := (AmigaMathL.Tst(yval^.realval) >= 0) & (AmigaMathL.Cmp(xval^.realval, LDummy) <= 0);
     AmigaMathL.Sub(-MAX(LONGREAL), yval^.realval, LDummy);
     IF temp OR (AmigaMathL.Tst(yval^.realval) < 0 ) & (AmigaMathL.Cmp(xval^.realval, LDummy) >= 0) THEN
     (* temp := (yval^.realval >= 0(*.0*)) & (xval^.realval <= MAX(LONGREAL) - yval^.realval);
     IF temp OR (yval^.realval < 0(*.0*)) & (xval^.realval >= -MAX(LONGREAL) - yval^.realval) THEN*) 
       AmigaMathL.Add(xval^.realval, yval^.realval, xval^.realval); CheckRealType(f, 206, xval)
       (* xval^.realval := xval^.realval + yval^.realval; CheckRealType(f, 206, xval) *)
     ELSE err(206)
     END
    ELSIF f = Set THEN
     xval^.setval := xval^.setval + yval^.setval
    ELSIF f # Undef THEN err(105)
    END
  | minus:
    IF f IN intSet THEN
     IF (yval^.intval >= 0) & (xval^.intval >= MIN(LONGINT) + yval^.intval) OR
      (yval^.intval < 0) & (xval^.intval <= MAX(LONGINT) + yval^.intval) THEN
       DEC(xval^.intval, yval^.intval); SetIntType(x)
     ELSE err(207)
     END
    ELSIF f IN realSet THEN
     AmigaMathL.Add(-MAX(LONGREAL), yval^.realval, LDummy);
     temp := (AmigaMathL.Tst(yval^.realval) >= 0) & (AmigaMathL.Cmp(xval^.realval, LDummy) >= 0);
     AmigaMathL.Add(MAX(LONGREAL), yval^.realval, LDummy);
     IF temp OR (AmigaMathL.Tst(yval^.realval) < 0) & (AmigaMathL.Cmp(xval^.realval, LDummy) <= 0) THEN
     (* temp := (yval^.realval >= 0(*.0*)) & (xval^.realval >= -MAX(LONGREAL) + yval^.realval);
     IF temp OR (yval^.realval < 0(*.0*)) & (xval^.realval <= MAX(LONGREAL) + yval^.realval) THEN *)
       AmigaMathL.Sub(xval^.realval, yval^.realval, xval^.realval); CheckRealType(f, 207, xval)
       (* xval^.realval := xval^.realval - yval^.realval; CheckRealType(f, 207, xval) *)
     ELSE err(207)
     END
    ELSIF f = Set THEN
     xval^.setval := xval^.setval - yval^.setval
    ELSIF f # Undef THEN err(106)
    END
  | or:
    IF f = Bool THEN
     xval^.intval := BoolToInt(IntToBool(xval^.intval) OR IntToBool(yval^.intval))
    ELSE err(95)
    END
  | eql:
    xval^.intval := BoolToInt(ConstCmp() = eql)
  | neq:
    xval^.intval := BoolToInt(ConstCmp() # eql)
  | lss:
    IF f IN {Bool, Set, NilTyp, Pointer} THEN err(108)
    ELSE xval^.intval := BoolToInt(ConstCmp() = lss)
    END
  | leq:
    IF f IN {Bool, Set, NilTyp, Pointer} THEN err(108)
    ELSE xval^.intval := BoolToInt(ConstCmp() # gtr)
    END
  | gtr:
    IF f IN {Bool, Set, NilTyp, Pointer} THEN err(108)
    ELSE xval^.intval := BoolToInt(ConstCmp() = gtr)
    END
  | geq:
    IF f IN {Bool, Set, NilTyp, Pointer} THEN err(108)
    ELSE xval^.intval := BoolToInt(ConstCmp() # lss)
    END
  END
 END ConstOp;
 PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct);
  VAR node: OPT.Node; f, g: INTEGER; k: LONGINT; r: LONGREAL; Max, Min: LONGREAL;
 BEGIN f := x^.typ^.form; g := typ^.form;
  IF x^.class = Nconst THEN
   IF f IN intSet THEN
    IF g IN intSet THEN
     IF f > g THEN SetIntType(x);
      IF x^.typ^.form > g THEN err(203); x^.conval^.intval := 1 END
     END
    ELSIF g IN realSet THEN
     AmigaMathL.IntToReal(x^.conval^.intval, x^.conval^.realval);
     (* x^.conval^.realval := x^.conval^.intval; *)
     x^.conval^.intval := OPM.ConstNotAlloc
    ELSE (*g = Char*) k := x^.conval^.intval;
     IF (0 > k) OR (k > 0FFH) THEN err(220) END
    END
   ELSIF f IN realSet THEN
    IF g IN realSet THEN CheckRealType(g, 203, x^.conval)
    ELSE (*g = LInt*)
     r := x^.conval^.realval;
     AmigaMathL.IntToReal(MIN(LONGINT), Min);
     AmigaMathL.IntToReal(MAX(LONGINT), Max);
     IF (AmigaMathL.Cmp(r, Min) < 0) OR (AmigaMathL.Cmp(r, Max) > 0) THEN err(203); r := 1 END ;
     (* IF (r < MIN(LONGINT)) OR (r > MAX(LONGINT)) THEN err(203); r := 1 END ;*)
     x^.conval^.intval := AmigaMathL.Entier(r); SetIntType(x)
     (* x^.conval^.intval := ENTIER(r); SetIntType(x) *)
    END
   ELSE (* (f IN {Char, Byte}) & (g IN {Byte} + intSet) OR (f = Undef) *)
   END ;
   x^.obj := NIL
  ELSIF (x^.class = Nmop) & (x^.subcl = conv) & ((x^.left^.typ^.form < f) OR (f > g)) THEN
   (* don't create new node *)
   IF x^.left^.typ = typ THEN (* and suppress existing node *) x := x^.left END
  ELSE node := OPT.NewNode(Nmop); node^.subcl := conv; node^.left := x; x := node
  END ;
  x^.typ := typ
 END Convert;
 PROCEDURE Op*(op: SHORTINT; VAR x: OPT.Node; y: OPT.Node);
  VAR f, g: INTEGER; t: OPT.Node; typ: OPT.Struct; do: BOOLEAN; val: LONGINT;
  PROCEDURE NewOp;
   VAR node: OPT.Node;
  BEGIN
   node := OPT.NewNode(Ndop); node^.subcl := op; node^.typ := typ;
   node^.left := x; node^.right := y; x := node
  END NewOp;
  PROCEDURE strings(): BOOLEAN;
   VAR ok, xCharArr, yCharArr: BOOLEAN;
  BEGIN
   xCharArr := ((x^.typ^.comp IN {Array, DynArr}) & (x^.typ^.BaseTyp^.form=Char)) OR (f=String);
   yCharArr := (((y^.typ^.comp IN {Array, DynArr}) & (y^.typ^.BaseTyp^.form=Char)) OR (g=String));
   IF xCharArr & (g = Char) & (y^.class = Nconst) THEN CharToString(y); g := String; yCharArr := TRUE END ;
   IF yCharArr & (f = Char) & (x^.class = Nconst) THEN CharToString(x); f := String; xCharArr := TRUE END ;
   ok := xCharArr & yCharArr;
   IF ok THEN (* replace ""-string compare with 0X-char compare, if possible *)
    IF (f=String) & (x^.conval^.intval2 = 1) THEN (* y is array of char *)
     x^.typ := OPT.chartyp; x^.conval^.intval := 0;
     Index(y, NewIntConst(0))
    ELSIF (g=String) & (y^.conval^.intval2 = 1) THEN (* x is array of char *)
     y^.typ := OPT.chartyp; y^.conval^.intval := 0;
     Index(x, NewIntConst(0))
    END
   END ;
   RETURN ok
  END strings;
 BEGIN
  IF (x^.class = Ntype) OR (x^.class = Nproc) OR (y^.class = Ntype) OR (y^.class = Nproc) THEN err(126)
  ELSIF (x^.class = Nconst) & (y^.class = Nconst) THEN ConstOp(op, x, y); x^.obj := NIL
  ELSE
   IF x^.typ # y^.typ THEN
    g := y^.typ^.form;
    CASE x^.typ^.form OF
       SInt:
      IF g IN intSet + realSet THEN Convert(x, y^.typ)
      ELSE  err(100)
      END
    | Int:
      IF g = SInt THEN Convert(y, x^.typ)
      ELSIF g IN intSet + realSet THEN Convert(x, y^.typ)
      ELSE  err(100)
      END
    | LInt:
      IF g IN intSet THEN Convert(y, x^.typ)
      ELSIF g IN realSet THEN Convert(x, y^.typ)
      ELSE  err(100)
      END
    | Real:
      IF g IN intSet THEN Convert(y, x^.typ)
      ELSIF g IN realSet THEN Convert(x, y^.typ)
      ELSE  err(100)
      END
    | LReal:
      IF g IN intSet + realSet THEN Convert(y, x^.typ)
      ELSIF g IN realSet THEN Convert(y, x^.typ)
      ELSE  err(100)
      END
    | NilTyp:
      IF ~(g IN {Pointer, ProcTyp}) THEN err(100) END
    | Pointer:
      CheckPtr(x, y)
    | ProcTyp:
      IF g # NilTyp THEN err(100) END
    | String:
    | Comp:
      IF x^.typ^.comp = Record THEN err(100) END
    ELSE err(100)
    END
   END ; (* {x^.typ = y^.typ} *)
   typ := x^.typ; f := typ^.form; g := y^.typ^.form;
   CASE op OF
     times:
     do := TRUE;
     IF f IN intSet THEN
      IF x^.class = Nconst THEN val := x^.conval^.intval;
       IF val = 1 THEN do := FALSE; x := y
       ELSIF val = 0 THEN do := FALSE
       ELSIF log(val) = 1 THEN
        t := y; y := x; x := t;
        op := ash; y^.typ := OPT.sinttyp; y^.conval^.intval := exp; y^.obj := NIL
       END
      ELSIF y^.class = Nconst THEN val := y^.conval^.intval;
       IF val = 1 THEN do := FALSE
       ELSIF val = 0 THEN do := FALSE; x := y
       ELSIF log(val) = 1 THEN
        op := ash; y^.typ := OPT.sinttyp; y^.conval^.intval := exp; y^.obj := NIL
       END
      END
     ELSIF ~(f IN {Undef, Real..Set}) THEN err(105); typ := OPT.undftyp
     END ;
     IF do THEN NewOp END
   | slash:
     IF f IN intSet THEN
      IF (y^.class = Nconst) & (y^.conval^.intval = 0) THEN err(205) END ;
      Convert(x, OPT.realtyp); Convert(y, OPT.realtyp);
      typ := OPT.realtyp
     ELSIF f IN realSet THEN
      IF (y^.class = Nconst) & (AmigaMathL.Tst(y^.conval^.realval) = 0) THEN err(205) END
      (* IF (y^.class = Nconst) & (y^.conval^.realval = 0(*.0*)) THEN err(205) END*)
     ELSIF (f # Set) & (f # Undef) THEN err(102); typ := OPT.undftyp
     END ;
     NewOp
   | div:
     do := TRUE;
     IF f IN intSet THEN
      IF y^.class = Nconst THEN val := y^.conval^.intval;
       IF val = 0 THEN err(205)
       ELSIF val = 1 THEN do := FALSE
       ELSIF log(val) = 1 THEN
        op := ash; y^.typ := OPT.sinttyp; y^.conval^.intval := -exp; y^.obj := NIL
       END
      END
     ELSIF f # Undef THEN err(103); typ := OPT.undftyp
     END ;
     IF do THEN NewOp END
   | mod:
     IF f IN intSet THEN
      IF y^.class = Nconst THEN
       IF y^.conval^.intval = 0 THEN err(205)
       ELSIF log(y^.conval^.intval) = 1 THEN
        op := msk; y^.conval^.intval := ASH(-1, exp); y^.obj := NIL
       END
      END
     ELSIF f # Undef THEN err(104); typ := OPT.undftyp
     END ;
     NewOp
   | and:
     IF f = Bool THEN
      IF x^.class = Nconst THEN
       IF IntToBool(x^.conval^.intval) THEN x := y END
      ELSIF (y^.class = Nconst) & IntToBool(y^.conval^.intval) THEN (* optimize x & TRUE -> x *)
    (* ELSIF (y^.class = Nconst) & ~IntToBool(y^.conval^.intval) THEN
       don't optimize x & FALSE -> FALSE: side effects possible *)
      ELSE NewOp
      END
     ELSIF f # Undef THEN err(94); x^.typ := OPT.undftyp
     END
   | plus:
     IF ~(f IN {Undef, SInt..Set}) THEN err(105); typ := OPT.undftyp END ;
     do := TRUE;
     IF f IN intSet THEN
      IF (x^.class = Nconst) & (x^.conval^.intval = 0) THEN do := FALSE; x := y END ;
      IF (y^.class = Nconst) & (y^.conval^.intval = 0) THEN do := FALSE END
     END ;
     IF do THEN NewOp END
   | minus:
     IF ~(f IN {Undef, SInt..Set}) THEN err(106); typ := OPT.undftyp END ;
     IF ~(f IN intSet) OR (y^.class # Nconst) OR (y^.conval^.intval # 0) THEN NewOp END
   | or:
     IF f = Bool THEN
      IF x^.class = Nconst THEN
       IF ~IntToBool(x^.conval^.intval) THEN x := y END
      ELSIF (y^.class = Nconst) & ~IntToBool(y^.conval^.intval) THEN (* optimize x OR FALSE -> x *)
    (* ELSIF (y^.class = Nconst) & IntToBool(y^.conval^.intval) THEN
       don't optimize x OR TRUE -> TRUE: side effects possible *)
      ELSE NewOp
      END
     ELSIF f # Undef THEN err(95); x^.typ := OPT.undftyp
     END
   | eql, neq:
     IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp}) OR strings() THEN typ := OPT.booltyp
     ELSE err(107); typ := OPT.undftyp
     END ;
     NewOp
   | lss, leq, gtr, geq:
     IF (f IN {Undef, Char..LReal}) OR strings() THEN typ := OPT.booltyp
     ELSE err(108); typ := OPT.undftyp
     END ;
     NewOp
   END
  END
 END Op;
 PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node);
  VAR k, l: LONGINT;
 BEGIN
  IF (x^.class = Ntype) OR (x^.class = Nproc) OR (y^.class = Ntype) OR (y^.class = Nproc) THEN err(126)
  ELSIF (x^.typ^.form IN intSet) & (y^.typ^.form IN intSet) THEN
   IF x^.class = Nconst THEN
    k := x^.conval^.intval;
    IF (0 > k) OR (k > OPM.MaxSet) THEN err(202) END
   END ;
   IF y^.class = Nconst THEN
    l := y^.conval^.intval;
    IF (0 > l) OR (l > OPM.MaxSet) THEN err(202) END
   END ;
   IF (x^.class = Nconst) & (y^.class = Nconst) THEN
    IF k <= l THEN
     x^.conval^.setval := {k..l}
    ELSE err(201); x^.conval^.setval := {l..k}
    END ;
    x^.obj := NIL
   ELSE BindNodes(Nupto, OPT.settyp, x, y)
   END
  ELSE err(93)
  END ;
  x^.typ := OPT.settyp
 END SetRange;
 PROCEDURE SetElem*(VAR x: OPT.Node);
  VAR k: LONGINT;
 BEGIN
  IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
  ELSIF ~(x^.typ^.form IN intSet) THEN err(93)
  ELSIF x^.class = Nconst THEN
   k := x^.conval^.intval;
   IF (0 <= k) & (k <= OPM.MaxSet) THEN x^.conval^.setval := {k}
   ELSE err(202)
   END ;
   x^.obj := NIL
  ELSE Convert(x, OPT.settyp)
  END ;
  x^.typ := OPT.settyp
 END SetElem;
 PROCEDURE CheckAssign(x: OPT.Struct; ynode: OPT.Node); (* x := y *)
  VAR f, g: INTEGER; y, p, q: OPT.Struct;
 BEGIN
  y := ynode^.typ; f := x^.form; g := y^.form;
  IF (ynode^.class = Ntype) OR (ynode^.class = Nproc) & (f # ProcTyp) THEN err(126) END ;
  CASE f OF
    Undef:
  | Byte:
    IF ~(g IN {Byte, Char, SInt}) THEN err(113) END
  | Bool, Char, SInt, Set:
    IF g # f THEN err(113) END
  | Int:
    IF ~(g IN {SInt, Int}) THEN err(113) END
  | LInt:
    IF ~(g IN intSet) THEN err(113) END
  | Real:
    IF ~(g IN {SInt..Real}) THEN err(113) END
  | LReal:
    IF ~(g IN {SInt..LReal}) THEN err(113) END
  | Pointer:
    IF (x = y) OR (g = NilTyp) OR (x = OPT.sysptrtyp) & (g = Pointer) THEN (* ok *)
    ELSIF g = Pointer THEN
     p := x^.BaseTyp; q := y^.BaseTyp;
     IF (p^.comp = Record) & (q^.comp = Record) THEN
      WHILE (q # p) & (q # NIL) & (q # OPT.undftyp) DO q := q^.BaseTyp END ;
      IF q = NIL THEN err(113) END
     ELSE err(113)
     END
    ELSE err(113)
    END
  | ProcTyp:
    IF ynode^.class = Nproc THEN CheckProc(x, ynode^.obj)
    ELSIF (x = y) OR (g = NilTyp) THEN (* ok *)
    ELSE err(113)
    END
  | NoTyp, NilTyp:
    err(113)
  | Comp:
    IF x^.comp = Array THEN
     IF (ynode^.class = Nconst) & (g = Char) THEN CharToString(ynode); y := ynode^.typ; g := String END ;
     IF x = y THEN (* ok *)
     ELSIF (g = String) & (x^.BaseTyp = OPT.chartyp) THEN (*check length of string*)
      IF ynode^.conval^.intval2 > x^.n THEN err(114) END ;
     ELSE err(113)
     END
    ELSIF x^.comp = Record THEN
     IF x = y THEN (* ok *)
     ELSIF y^.comp = Record THEN
      q := y^.BaseTyp;
      WHILE (q # NIL) & (q # x) & (q # OPT.undftyp) DO q := q^.BaseTyp END ;
      IF q = NIL THEN err(113) END
     ELSE err(113)
     END
    ELSE (*DynArr*) err(113)
    END
  END ;
  IF (ynode^.class = Nconst) & (g < f) & (g IN {SInt..Real}) & (f IN {Int..LReal}) THEN
   Convert(ynode, x)
  END
 END CheckAssign;
 PROCEDURE CheckLeaf(x: OPT.Node; dynArrToo: BOOLEAN);
 BEGIN
  IF (x^.class = Nmop) & (x^.subcl = val) THEN x := x^.left END ;
  IF x^.class = Nguard THEN x := x^.left END ; (* skip last (and unique) guard *)
  IF (x^.class = Nvar) & (dynArrToo OR (x^.typ^.comp # DynArr)) THEN x^.obj^.leaf := FALSE END
 END CheckLeaf;
 PROCEDURE StPar0*(VAR par0: OPT.Node; fctno: INTEGER); (* par0: first param of standard proc *)
  VAR f: INTEGER; typ: OPT.Struct; x: OPT.Node; Dummy:LONGREAL;
 BEGIN x := par0; f := x^.typ^.form;
  CASE fctno OF
    haltfn: (*HALT*)
    IF (f IN intSet) & (x^.class = Nconst) THEN
     IF (OPM.MinHaltNr <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxHaltNr) THEN
      BindNodes(Ntrap, OPT.notyp, x, x)
     ELSE err(218)
     END
    ELSE err(69)
    END ;
    x^.typ := OPT.notyp
  | newfn: (*NEW*)
    typ := OPT.notyp;
    IF NotVar(x) THEN err(112)
    ELSIF f = Pointer THEN
     IF OPM.NEWusingAdr THEN CheckLeaf(x, TRUE) END ;
     IF x^.readonly THEN err(76) END ;
     f := x^.typ^.BaseTyp^.comp;
     IF f IN {Record, DynArr, Array} THEN
      IF f = DynArr THEN typ := x^.typ^.BaseTyp END ;
      BindNodes(Nassign, OPT.notyp, x, NIL); x^.subcl := newfn
     ELSE err(111)
     END
    ELSE err(111)
    END ;
    x^.typ := typ
  | absfn: (*ABS*)
    MOp(abs, x)
  | capfn: (*CAP*)
    MOp(cap, x)
  | ordfn: (*ORD*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f = Char THEN Convert(x, OPT.inttyp)
    ELSE err(111)
    END ;
    x^.typ := OPT.inttyp
  | entierfn: (*ENTIER*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN realSet THEN Convert(x, OPT.linttyp)
    ELSE err(111)
    END ;
    x^.typ := OPT.linttyp
  | oddfn: (*ODD*)
    MOp(odd, x)
  | minfn: (*MIN*)
    IF x^.class = Ntype THEN
     CASE f OF
       Bool:  x := NewBoolConst(FALSE)
     | Char:  x := NewIntConst(0); x^.typ := OPT.chartyp
     | SInt:  x := NewIntConst(OPM.MinSInt)
     | Int:   x := NewIntConst(OPM.MinInt)
     | LInt:  x := NewIntConst(OPM.MinLInt)
     | Set:   x := NewIntConst(0); x^.typ := OPT.inttyp
     | Real:  
     	AmigaMathL.Long(OPM.MinReal, Dummy);
     	x := NewRealConst(Dummy, OPT.realtyp)
     	(* x := NewRealConst(OPM.MinReal, OPT.realtyp) *)
     | LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp)
     ELSE err(111)
     END
    ELSE err(110)
    END
  | maxfn: (*MAX*)
    IF x^.class = Ntype THEN
     CASE f OF
       Bool:  x := NewBoolConst(TRUE)
     | Char:  x := NewIntConst(0FFH); x^.typ := OPT.chartyp
     | SInt:  x := NewIntConst(OPM.MaxSInt)
     | Int:   x := NewIntConst(OPM.MaxInt)
     | LInt:  x := NewIntConst(OPM.MaxLInt)
     | Set:   x := NewIntConst(OPM.MaxSet); x^.typ := OPT.inttyp
     | Real:  
		AmigaMathL.Long(OPM.MaxReal, Dummy);
     	x := NewRealConst(Dummy, OPT.realtyp)
     	(* x := NewRealConst(OPM.MaxReal, OPT.realtyp) *)
     | LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp)
     ELSE err(111)
     END
    ELSE err(110)
    END
  | chrfn: (*CHR*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN {Undef, SInt..LInt} THEN Convert(x, OPT.chartyp)
    ELSE err(111); x^.typ := OPT.chartyp
    END
  | shortfn: (*SHORT*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f = Int THEN Convert(x, OPT.sinttyp)
    ELSIF f = LInt THEN Convert(x, OPT.inttyp)
    ELSIF f = LReal THEN Convert(x, OPT.realtyp)
    ELSE err(111)
    END
  | longfn: (*LONG*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f = SInt THEN Convert(x, OPT.inttyp)
    ELSIF f = Int THEN Convert(x, OPT.linttyp)
    ELSIF f = Real THEN Convert(x, OPT.lrltyp)
    ELSIF f = Char THEN Convert(x, OPT.linttyp)
    ELSE err(111)
    END
  | incfn, decfn: (*INC, DEC*)
    IF NotVar(x) THEN err(112)
    ELSIF ~(f IN intSet) THEN err(111)
    ELSIF x^.readonly THEN err(76)
    END
  | inclfn, exclfn: (*INCL, EXCL*)
    IF NotVar(x) THEN err(112)
    ELSIF x^.typ # OPT.settyp THEN err(111); x^.typ := OPT.settyp
    ELSIF x^.readonly THEN err(76)
    END
  | lenfn: (*LEN*)
    IF ~(x^.typ^.comp IN {DynArr, Array}) THEN err(131) END
  | copyfn: (*COPY*)
    IF (x^.class = Nconst) & (f = Char) THEN CharToString(x); f := String END ;
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF (~(x^.typ^.comp IN {DynArr, Array}) OR (x^.typ^.BaseTyp^.form # Char))
      & (f # String) THEN err(111)
    END
  | ashfn: (*ASH*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN intSet THEN
     IF f # LInt THEN Convert(x, OPT.linttyp) END
    ELSE err(111); x^.typ := OPT.linttyp
    END
  | adrfn: (*SYSTEM.ADR*)
    CheckLeaf(x, FALSE); MOp(adr, x)
  | sizefn: (*SIZE*)
    IF x^.class # Ntype THEN err(110); x := NewIntConst(1)
    ELSIF (f IN {Byte..Set, Pointer, ProcTyp}) OR (x^.typ^.comp IN {Array, Record}) THEN
     typSize(x^.typ, FALSE); x := NewIntConst(x^.typ^.size)
    ELSE err(111); x := NewIntConst(1)
    END
  | ccfn: (*SYSTEM.CC*)
    MOp(cc, x)
  | lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF ~(f IN intSet + {Byte, Char, Set}) THEN err(111)
    END
  | getfn, putfn, bitfn, movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF (x^.class = Nconst) & (f IN {SInt, Int}) THEN Convert(x, OPT.linttyp)
    ELSIF ~(f IN {LInt, Pointer}) THEN err(111); x^.typ := OPT.linttyp
    END
  | getrfn, putrfn: (*SYSTEM.GETREG, SYSTEM.PUTREG*)
    IF (f IN intSet) & (x^.class = Nconst) THEN
     IF (x^.conval^.intval < OPM.MinRegNr) OR (x^.conval^.intval > OPM.MaxRegNr) THEN err(220) END
    ELSE err(69)
    END
  | valfn: (*SYSTEM.VAL*)
    IF x^.class # Ntype THEN err(110)
    ELSIF (f IN {Undef, String, NoTyp}) OR (x^.typ^.comp = DynArr) THEN err(111)
    END
  | sysnewfn: (*SYSTEM.NEW*)
    IF NotVar(x) THEN err(112)
    ELSIF f = Pointer THEN
     IF OPM.NEWusingAdr THEN CheckLeaf(x, TRUE) END
    ELSE err(111)
    END
  | assertfn: (*ASSERT*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126); x := NewBoolConst(FALSE)
    ELSIF f # Bool THEN err(120); x := NewBoolConst(FALSE)
    ELSE MOp(not, x)
    END
  END ;
  par0 := x
 END StPar0;
 PROCEDURE StPar1*(VAR par0: OPT.Node; x: OPT.Node; fctno: SHORTINT); (* x: second parameter of standard proc *)
  VAR f, L: INTEGER; typ: OPT.Struct; p, t: OPT.Node;
  PROCEDURE NewOp(class: SHORTINT);
   VAR node: OPT.Node;
  BEGIN
   node := OPT.NewNode(class);
   node^.left := p; node^.right := x; p := node
  END NewOp;
 BEGIN p := par0; f := x^.typ^.form;
  CASE fctno OF
    incfn, decfn: (*INC DEC*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126); p^.typ := OPT.notyp
    ELSE
     IF x^.typ # p^.typ THEN
      IF (x^.class = Nconst) & (f IN intSet) THEN Convert(x, p^.typ)
      ELSE err(111)
      END
     END ;
     NewOp(Nassign); p^.subcl := fctno;
     p^.typ := OPT.notyp
    END
  | inclfn, exclfn: (*INCL, EXCL*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN intSet THEN
     IF (x^.class = Nconst) & ((0 > x^.conval^.intval) OR (x^.conval^.intval > OPM.MaxSet)) THEN err(202)
     END ;
     NewOp(Nassign); p^.subcl := fctno
    ELSE err(111)
    END ;
    p^.typ := OPT.notyp
  | lenfn: (*LEN*)
    IF ~(f IN intSet) OR (x^.class # Nconst) THEN err(69)
    ELSIF f = SInt THEN
     L := SHORT(x^.conval^.intval); typ := p^.typ;
     WHILE (L > 0) & (typ^.comp IN {DynArr, Array}) DO typ := typ^.BaseTyp; DEC(L) END ;
     IF (L # 0) OR ~(typ^.comp IN {DynArr, Array}) THEN err(132)
     ELSE x^.obj := NIL;
      IF typ^.comp = DynArr THEN
       WHILE p^.class = Nindex DO p := p^.left; INC(x^.conval^.intval) END ; (* possible side effect ignored *)
       NewOp(Ndop); p^.subcl := len; p^.typ := OPT.linttyp
      ELSE p := x; p^.conval^.intval := typ^.n; SetIntType(p)
      END
     END
    ELSE err(132)
    END
  | copyfn: (*COPY*)
    IF NotVar(x) THEN err(112)
    ELSIF (x^.typ^.comp IN {Array, DynArr}) & (x^.typ^.BaseTyp^.form = Char) THEN
     IF x^.readonly THEN err(76) END ;
     t := x; x := p; p := t; NewOp(Nassign); p^.subcl := copyfn
    ELSE err(111)
    END ;
    p^.typ := OPT.notyp
  | ashfn: (*ASH*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN intSet THEN
     IF (p^.class = Nconst) & (x^.class = Nconst) THEN
      IF (-maxExp > x^.conval^.intval) OR (x^.conval^.intval > maxExp) THEN err(208); p^.conval^.intval := 1
      ELSIF x^.conval^.intval >= 0 THEN
       IF ABS(p^.conval^.intval) <= MAX(LONGINT) DIV ASH(1, x^.conval^.intval) THEN
        p^.conval^.intval := p^.conval^.intval * ASH(1, x^.conval^.intval)
       ELSE err(208); p^.conval^.intval := 1
       END
      ELSE p^.conval^.intval := ASH(p^.conval^.intval, x^.conval^.intval)
      END ;
      p^.obj := NIL
     ELSE NewOp(Ndop); p^.subcl := ash; p^.typ := OPT.linttyp
     END
    ELSE err(111)
    END
  | newfn: (*NEW(p, x...)*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF p^.typ^.comp = DynArr THEN
     IF f IN intSet THEN
      IF (x^.class = Nconst) & ((x^.conval^.intval <= 0) OR (x^.conval^.intval > OPM.MaxIndex)) THEN err(63) END
     ELSE err(111)
     END ;
     p^.right := x; p^.typ := p^.typ^.BaseTyp
    ELSE err(64)
    END
  | lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF ~(f IN intSet) THEN err(111)
    ELSE NewOp(Ndop); p^.typ := p^.left^.typ;
     IF fctno = lshfn THEN p^.subcl := lsh ELSE p^.subcl := rot END
    END
  | getfn, putfn, getrfn, putrfn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.GETREG, SYSTEM.PUTREG*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN {Undef..Set, Pointer, ProcTyp} THEN
     IF (fctno = getfn) OR (fctno = getrfn) THEN
      IF NotVar(x) THEN err(112) END ;
      t := x; x := p; p := t
     END ;
     NewOp(Nassign); p^.subcl := fctno
    ELSE err(111)
    END ;
    p^.typ := OPT.notyp
  | bitfn: (*SYSTEM.BIT*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN intSet THEN
     NewOp(Ndop); p^.subcl := bit
    ELSE err(111)
    END ;
    p^.typ := OPT.booltyp
  | valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *)
    IF (x^.class = Ntype) OR (x^.class = Nproc) OR
     (f IN {Undef, String, NoTyp}) OR (x^.typ^.comp = DynArr) THEN err(126)
    END ;
    IF (x^.class >= Nconst) OR ((f IN realSet) # (p^.typ^.form IN realSet)) THEN
     t := OPT.NewNode(Nmop); t^.subcl := val; t^.left := x; x := t
    ELSE x^.readonly := FALSE
    END ;
    x^.typ := p^.typ; p := x
  | sysnewfn: (*SYSTEM.NEW*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF f IN intSet THEN
     NewOp(Nassign); p^.subcl := sysnewfn
    ELSE err(111)
    END ;
    p^.typ := OPT.notyp
  | movefn: (*SYSTEM.MOVE*)
    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
    ELSIF (x^.class = Nconst) & (f IN {SInt, Int}) THEN Convert(x, OPT.linttyp)
    ELSIF ~(f IN {LInt, Pointer}) THEN err(111); x^.typ := OPT.linttyp
    END ;
    p^.link := x
  | assertfn: (*ASSERT*)
    IF (f IN intSet) & (x^.class = Nconst) THEN
     IF (OPM.MinHaltNr <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxHaltNr) THEN
      BindNodes(Ntrap, OPT.notyp, x, x);
      x^.conval := OPT.NewConst(); x^.conval^.intval := OPM.errpos;
      Construct(Nif, p, x); p^.conval := OPT.NewConst(); p^.conval^.intval := OPM.errpos;
      Construct(Nifelse, p, NIL); OptIf(p);
      IF p = NIL THEN (* ASSERT(TRUE) *)
      ELSIF p^.class = Ntrap THEN err(99)
      ELSE p^.subcl := assertfn
      END
     ELSE err(218)
     END
    ELSE err(69)
    END
  ELSE err(64)
  END ;
  par0 := p
 END StPar1;
 PROCEDURE StParN*(VAR par0: OPT.Node; x: OPT.Node; fctno, n: INTEGER); (* x: n+1-th param of standard proc *)
  VAR node: OPT.Node; f: INTEGER; p: OPT.Node;
 BEGIN p := par0; f := x^.typ^.form;
  IF fctno = newfn THEN (*NEW(p, ..., x...*)
   IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
   ELSIF p^.typ^.comp # DynArr THEN err(64)
   ELSIF f IN intSet THEN
    IF (x^.class = Nconst) & ((x^.conval^.intval <= 0) OR (x^.conval^.intval > OPM.MaxIndex)) THEN err(63) END ;
    node := p^.right; WHILE node^.link # NIL DO node := node^.link END;
    node^.link := x; p^.typ := p^.typ^.BaseTyp
   ELSE err(111)
   END
  ELSIF (fctno = movefn) & (n = 2) THEN (*SYSTEM.MOVE*)
   IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
   ELSIF f IN intSet THEN
    node := OPT.NewNode(Nassign); node^.subcl := movefn; node^.right := p;
    node^.left := p^.link; p^.link := x; p := node
   ELSE err(111)
   END ;
   p^.typ := OPT.notyp
  ELSE err(64)
  END ;
  par0 := p
 END StParN;
 PROCEDURE StFct*(VAR par0: OPT.Node; fctno: SHORTINT; parno: INTEGER);
  VAR dim: INTEGER; x, p: OPT.Node;
 BEGIN p := par0;
  IF fctno <= ashfn THEN
   IF (fctno = newfn) & (p^.typ # OPT.notyp) THEN
    IF p^.typ^.comp = DynArr THEN err(65) END ;
    p^.typ := OPT.notyp
   ELSIF fctno <= sizefn THEN (* 1 param *)
    IF parno < 1 THEN err(65) END
   ELSE (* more than 1 param *)
    IF ((fctno = incfn) OR (fctno = decfn)) & (parno = 1) THEN (*INC, DEC*)
     BindNodes(Nassign, OPT.notyp, p, NewIntConst(1)); p^.subcl := fctno
    ELSIF (fctno = lenfn) & (parno = 1) THEN (*LEN*)
     IF p^.typ^.comp = DynArr THEN dim := 0;
      WHILE p^.class = Nindex DO p := p^.left; INC(dim) END ; (* possible side effect ignored *)
      BindNodes(Ndop, OPT.linttyp, p, NewIntConst(dim)); p^.subcl := len
     ELSE
      p := NewIntConst(p^.typ^.n)
     END
    ELSIF parno < 2 THEN err(65)
    END
   END
  ELSIF fctno = assertfn THEN
   IF parno = 1 THEN x := NIL;
    BindNodes(Ntrap, OPT.notyp, x, NewIntConst(AssertTrap));
    x^.conval := OPT.NewConst(); x^.conval^.intval := OPM.errpos;
    Construct(Nif, p, x); p^.conval := OPT.NewConst(); p^.conval^.intval := OPM.errpos;
    Construct(Nifelse, p, NIL); OptIf(p);
    IF p = NIL THEN (* ASSERT(TRUE) *)
    ELSIF p^.class = Ntrap THEN err(99)
    ELSE p^.subcl := assertfn
    END
   ELSIF parno < 1 THEN err(65)
   END
  ELSE (*SYSTEM*)
   IF (parno < 1) OR
    (fctno > ccfn) & (parno < 2) OR
    (fctno = movefn) & (parno < 3) THEN err(65)
   END
  END ;
  par0 := p
 END StFct;
 PROCEDURE DynArrParCheck(ftyp, atyp: OPT.Struct; fvarpar: BOOLEAN);
  VAR f: INTEGER;
 BEGIN (* ftyp^.comp = DynArr *)
  f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp;
  IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *)
   IF ~(f IN {Array, DynArr}) OR ~(atyp^.form IN {Byte..SInt}) THEN err(-301) END (* ... warning 301 *)
  ELSIF f IN {Array, DynArr} THEN
   IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar)
   ELSIF ftyp # atyp THEN
    IF ~fvarpar & (ftyp.form = Pointer) & (atyp.form = Pointer) THEN
     ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp;
     IF (ftyp^.comp = Record) & (atyp^.comp = Record) THEN
      WHILE (ftyp # atyp) & (atyp # NIL) & (atyp # OPT.undftyp) DO atyp := atyp^.BaseTyp END ;
      IF atyp = NIL THEN err(113) END
     ELSE err(66)
     END
    ELSE err(66)
    END
   END ;
  ELSE err(67)
  END
 END DynArrParCheck;
 PROCEDURE CheckReceiver(VAR x: OPT.Node; fp: OPT.Object);
 BEGIN
  IF fp^.typ^.form = Pointer THEN
   IF x^.class = Nderef THEN x := x^.left (*undo DeRef*) ELSE (*x^.typ^.comp = Record*) err(71) END
  END
 END CheckReceiver;
 PROCEDURE PrepCall*(VAR x: OPT.Node; VAR fpar: OPT.Object);
 BEGIN
  IF (x^.obj # NIL) & (x^.obj^.mode IN {LProc, XProc, TProc, CProc}) THEN
   fpar := x^.obj^.link;
   IF x^.obj^.mode = TProc THEN CheckReceiver(x^.left, fpar); fpar := fpar^.link END
  ELSIF (x^.class # Ntype) & (x^.typ # NIL) & (x^.typ^.form = ProcTyp) THEN
   fpar := x^.typ^.link
  ELSE err(121); fpar := NIL; x^.typ := OPT.undftyp
  END
 END PrepCall;
 PROCEDURE Param*(ap: OPT.Node; fp: OPT.Object);
  VAR q: OPT.Struct;
 BEGIN
  IF fp.typ.form # Undef THEN
   IF fp^.mode = VarPar THEN
    IF NotVar(ap) THEN err(122)
    ELSE CheckLeaf(ap, FALSE)
    END ;
    IF ap^.readonly THEN err(76) END ;
    IF fp^.typ^.comp = DynArr THEN DynArrParCheck(fp^.typ, ap^.typ, TRUE)
    ELSIF (fp^.typ^.comp = Record) & (ap^.typ^.comp = Record) THEN
     q := ap^.typ;
     WHILE (q # fp^.typ) & (q # NIL) & (q # OPT.undftyp) DO q := q^.BaseTyp END ;
     IF q = NIL THEN err(111) END
    ELSIF (fp^.typ = OPT.sysptrtyp) & (ap^.typ^.form = Pointer) THEN (* ok *)
    ELSIF (ap^.typ # fp^.typ) & ~((fp^.typ^.form = Byte) & (ap^.typ^.form IN {Char, SInt})) THEN err(123)
    END
   ELSIF fp^.typ^.comp = DynArr THEN
    IF (ap^.class = Nconst) & (ap^.typ^.form = Char) THEN CharToString(ap) END ;
    IF (ap^.typ^.form = String) & (fp^.typ^.BaseTyp^.form = Char) THEN (* ok *)
    ELSIF ap^.class >= Nconst THEN err(59)
    ELSE DynArrParCheck(fp^.typ, ap^.typ, FALSE)
    END
   ELSE CheckAssign(fp^.typ, ap)
   END
  END
 END Param;
 PROCEDURE StaticLink*(dlev: SHORTINT);
  VAR scope: OPT.Object;
 BEGIN
  scope := OPT.topScope;
  WHILE dlev > 0 DO DEC(dlev);
   INCL(scope^.link^.conval^.setval, slNeeded);
   scope := scope^.left
  END
 END StaticLink;
 PROCEDURE Call*(VAR x: OPT.Node; apar: OPT.Node; fp: OPT.Object);
  VAR typ: OPT.Struct; p: OPT.Node; lev: SHORTINT;
 BEGIN
  IF x^.class = Nproc THEN typ := x^.typ;
   lev := x^.obj^.mnolev;
   IF lev > 0 THEN StaticLink(OPT.topScope^.mnolev-lev) END ;
   IF x^.obj^.mode = IProc THEN err(121) END
  ELSIF (x^.class = Nfield) & (x^.obj^.mode = TProc) THEN typ := x^.typ;
   x^.class := Nproc; p := x^.left; x^.left := NIL; p^.link := apar; apar := p; fp := x^.obj^.link
  ELSE typ := x^.typ^.BaseTyp
  END ;
  BindNodes(Ncall, typ, x, apar); x^.obj := fp
 END Call;
 PROCEDURE Enter*(VAR procdec: OPT.Node; stat: OPT.Node; proc: OPT.Object);
  VAR x: OPT.Node;
 BEGIN
  x := OPT.NewNode(Nenter); x^.typ := OPT.notyp; x^.obj := proc;
  x^.left := procdec; x^.right := stat; procdec := x
 END Enter;
 PROCEDURE Return*(VAR x: OPT.Node; proc: OPT.Object);
  VAR node: OPT.Node;
 BEGIN
  IF proc = NIL THEN (* return from module *)
   IF x # NIL THEN err(124) END
  ELSE
   IF x # NIL THEN CheckAssign(proc^.typ, x)
   ELSIF proc^.typ # OPT.notyp THEN err(124)
   END
  END ;
  node := OPT.NewNode(Nreturn); node^.typ := OPT.notyp; node^.obj := proc; node^.left := x; x := node
 END Return;
 PROCEDURE Assign*(VAR x: OPT.Node; y: OPT.Node);
  VAR z: OPT.Node;
 BEGIN
  IF x^.class >= Nconst THEN err(56) END ;
  CheckAssign(x^.typ, y);
  IF x^.readonly THEN err(76) END ;
  IF x^.typ^.comp = Record THEN
   IF x^.class = Nguard THEN z := x^.left ELSE z := x END ;
   IF (z^.class = Nderef) & (z^.left^.class = Nguard) THEN
    z^.left := z^.left^.left (* skip guard before dereferencing *)
   END ;
   IF (x^.typ^.strobj # NIL) & ((z^.class = Nderef) OR (z^.class = Nvarpar)) THEN
    BindNodes(Neguard, x^.typ, z, NIL); x := z
   END
  ELSIF (x^.typ^.comp = Array) & (x^.typ^.BaseTyp = OPT.chartyp) &
    (y^.typ^.form = String) & (y^.conval^.intval2 = 1) THEN (* replace array := "" with array[0] := 0X *)
   y^.typ := OPT.chartyp; y^.conval^.intval := 0;
   Index(x, NewIntConst(0))
  END ;
  BindNodes(Nassign, OPT.notyp, x, y); x^.subcl := assign
 END Assign;
 PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct);
  VAR node: OPT.Node;
 BEGIN
  node := OPT.NewNode(Ninittd); node^.typ := typ;
  node^.conval := OPT.NewConst(); node^.conval^.intval := typ^.txtpos;
  IF inittd = NIL THEN inittd := node ELSE last^.link := node END ;
  last := node
 END Inittd;
BEGIN
 maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp
END OPB.