From 298da0d13c41dfaeee22eedbbb37b4707bd79d63 Mon Sep 17 00:00:00 2001 From: David Brown Date: Mon, 22 Aug 2016 12:49:50 +0100 Subject: [PATCH] Move table constants from OPM to OPT. --- src/compiler/OPB.Mod | 962 ++++++++++++++++++------------------- src/compiler/OPC.Mod | 268 +++++------ src/compiler/OPM.cmdln.Mod | 79 --- src/compiler/OPP.Mod | 202 ++++---- src/compiler/OPT.Mod | 562 +++++++++++++--------- src/compiler/OPV.Mod | 386 +++++++-------- 6 files changed, 1231 insertions(+), 1228 deletions(-) diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index 5f5f2c5e..603952c4 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -23,16 +23,16 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) VAR node: OPT.Node; BEGIN CASE obj^.mode OF - | OPM.Var: node := OPT.NewNode(OPM.Nvar); - node^.readonly := (obj^.vis = OPM.externalR) & (obj^.mnolev < 0) - | OPM.VarPar: node := OPT.NewNode(OPM.Nvarpar) - | OPM.Con: node := OPT.NewNode(OPM.Nconst); + | OPT.Var: node := OPT.NewNode(OPT.Nvar); + node^.readonly := (obj^.vis = OPT.externalR) & (obj^.mnolev < 0) + | OPT.VarPar: node := OPT.NewNode(OPT.Nvarpar) + | OPT.Con: node := OPT.NewNode(OPT.Nconst); node^.conval := OPT.NewConst(); node^.conval^ := obj^.conval^ (* string is not copied, only its ref *) - | OPM.Typ: node := OPT.NewNode(OPM.Ntype) - | OPM.LProc - ..OPM.IProc: node := OPT.NewNode(OPM.Nproc) - ELSE node := OPT.NewNode(OPM.Nvar); err(127) + | OPT.Typ: node := OPT.NewNode(OPT.Ntype) + | OPT.LProc + ..OPT.IProc: node := OPT.NewNode(OPT.Nproc) + ELSE node := OPT.NewNode(OPT.Nvar); err(127) END ; node^.obj := obj; node^.typ := obj^.typ; RETURN node @@ -65,7 +65,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node; VAR x: OPT.Node; BEGIN - x := OPT.NewNode(OPM.Nconst); x^.typ := OPT.booltyp; + x := OPT.NewNode(OPT.Nconst); x^.typ := OPT.booltyp; x^.conval := OPT.NewConst(); x^.conval^.intval := BoolToInt(boolval); RETURN x END NewBoolConst; @@ -73,7 +73,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) VAR if, pred: OPT.Node; BEGIN if := x^.left; - WHILE if^.left^.class = OPM.Nconst DO + WHILE if^.left^.class = OPT.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 @@ -81,7 +81,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; pred := if; if := if^.link; WHILE if # NIL DO - IF if^.left^.class = OPM.Nconst THEN + IF if^.left^.class = OPT.Nconst THEN IF IntToBool(if^.left^.conval^.intval) THEN pred^.link := NIL; x^.right := if^.right; RETURN ELSE if := if^.link; pred^.link := if @@ -94,14 +94,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE Nil*(): OPT.Node; VAR x: OPT.Node; BEGIN - x := OPT.NewNode(OPM.Nconst); x^.typ := OPT.niltyp; + x := OPT.NewNode(OPT.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(OPM.Nconst); x^.typ := OPT.settyp; + x := OPT.NewNode(OPT.Nconst); x^.typ := OPT.settyp; x^.conval := OPT.NewConst(); x^.conval^.setval := {}; RETURN x END EmptySet; @@ -145,14 +145,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE NewIntConst*(intval: LONGINT): OPT.Node; VAR x: OPT.Node; BEGIN - x := OPT.NewNode(OPM.Nconst); x^.conval := OPT.NewConst(); + x := OPT.NewNode(OPT.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(OPM.Nconst); x^.conval := OPT.NewConst(); + x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst(); x^.conval^.realval := realval; x^.typ := typ; x^.conval^.intval := OPM.ConstNotAlloc; RETURN x END NewRealConst; @@ -160,7 +160,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE NewString*(VAR str: OPS.String; len: LONGINT): OPT.Node; VAR x: OPT.Node; BEGIN - x := OPT.NewNode(OPM.Nconst); x^.conval := OPT.NewConst(); x^.typ := OPT.stringtyp; + x := OPT.NewNode(OPT.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 @@ -182,21 +182,21 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END BindNodes; PROCEDURE NotVar(x: OPT.Node): BOOLEAN; - BEGIN RETURN (x^.class >= OPM.Nconst) & ((x^.class # OPM.Nmop) OR (x^.subcl # OPM.val) OR (x^.left^.class >= OPM.Nconst)) + BEGIN RETURN (x^.class >= OPT.Nconst) & ((x^.class # OPT.Nmop) OR (x^.subcl # OPT.val) OR (x^.left^.class >= OPT.Nconst)) END NotVar; PROCEDURE DeRef*(VAR x: OPT.Node); VAR strobj, bstrobj: OPT.Object; typ, btyp: OPT.Struct; BEGIN typ := x^.typ; - IF x^.class >= OPM.Nconst THEN err(78) - ELSIF typ^.form = OPM.Pointer THEN + IF x^.class >= OPT.Nconst THEN err(78) + ELSIF typ^.form = OPT.Pointer THEN IF typ = OPT.sysptrtyp THEN err(57) END ; btyp := typ^.BaseTyp; strobj := typ^.strobj; bstrobj := btyp^.strobj; IF (strobj # NIL) & (strobj^.name # "") & (bstrobj # NIL) & (bstrobj^.name # "") THEN btyp^.pbused := TRUE END ; - BindNodes(OPM.Nderef, btyp, x, NIL) + BindNodes(OPT.Nderef, btyp, x, NIL) ELSE err(84) END END DeRef; @@ -205,23 +205,23 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) VAR f: INTEGER; typ: OPT.Struct; BEGIN f := y^.typ^.form; - IF x^.class >= OPM.Nconst THEN err(79) - ELSIF ~(f IN OPM.intSet) OR (y^.class IN {OPM.Nproc, OPM.Ntype}) THEN err(80); y^.typ := OPT.inttyp END ; - IF x^.typ^.comp = OPM.Array THEN typ := x^.typ^.BaseTyp; - IF (y^.class = OPM.Nconst) & ((y^.conval^.intval < 0) OR (y^.conval^.intval >= x^.typ^.n)) THEN err(81) END - ELSIF x^.typ^.comp = OPM.DynArr THEN typ := x^.typ^.BaseTyp; - IF (y^.class = OPM.Nconst) & (y^.conval^.intval < 0) THEN err(81) END + IF x^.class >= OPT.Nconst THEN err(79) + ELSIF ~(f IN OPT.intSet) OR (y^.class IN {OPT.Nproc, OPT.Ntype}) THEN err(80); y^.typ := OPT.inttyp END ; + IF x^.typ^.comp = OPT.Array THEN typ := x^.typ^.BaseTyp; + IF (y^.class = OPT.Nconst) & ((y^.conval^.intval < 0) OR (y^.conval^.intval >= x^.typ^.n)) THEN err(81) END + ELSIF x^.typ^.comp = OPT.DynArr THEN typ := x^.typ^.BaseTyp; + IF (y^.class = OPT.Nconst) & (y^.conval^.intval < 0) THEN err(81) END ELSE err(82); typ := OPT.undftyp END ; - BindNodes(OPM.Nindex, typ, x, y); x^.readonly := x^.left^.readonly + BindNodes(OPT.Nindex, typ, x, y); x^.readonly := x^.left^.readonly END Index; PROCEDURE Field*(VAR x: OPT.Node; y: OPT.Object); - BEGIN (*x^.typ^.comp = OPM.Record*) - IF x^.class >= OPM.Nconst THEN err(77) END ; - IF (y # NIL) & (y^.mode IN {OPM.Fld, OPM.TProc}) THEN - BindNodes(OPM.Nfield, y^.typ, x, NIL); x^.obj := y; - x^.readonly := x^.left^.readonly OR ((y^.vis = OPM.externalR) & (y^.mnolev < 0)) + BEGIN (*x^.typ^.comp = OPT.Record*) + IF x^.class >= OPT.Nconst THEN err(77) END ; + IF (y # NIL) & (y^.mode IN {OPT.Fld, OPT.TProc}) THEN + BindNodes(OPT.Nfield, y^.typ, x, NIL); x^.obj := y; + x^.readonly := x^.left^.readonly OR ((y^.vis = OPT.externalR) & (y^.mnolev < 0)) ELSE err(83); x^.typ := OPT.undftyp END END Field; @@ -234,17 +234,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) 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) OR (t0.form = OPM.Undef (*SYSTEM.PTR*)) THEN - IF guard THEN BindNodes(OPM.Nguard, NIL, x, NIL); x^.readonly := x^.left^.readonly - ELSE node := OPT.NewNode(OPM.Nmop); node^.subcl := OPM.is; node^.left := x; + IF (t1 = t0) OR (t0.form = OPT.Undef (*SYSTEM.PTR*)) THEN + IF guard THEN BindNodes(OPT.Nguard, NIL, x, NIL); x^.readonly := x^.left^.readonly + ELSE node := OPT.NewNode(OPT.Nmop); node^.subcl := OPM.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 = OPM.Nguard THEN (* cannot skip guard *) - node := OPT.NewNode(OPM.Nmop); node^.subcl := OPM.is; node^.left := x; + IF x^.class = OPT.Nguard THEN (* cannot skip guard *) + node := OPT.NewNode(OPT.Nmop); node^.subcl := OPM.is; node^.left := x; node^.obj := obj; x := node ELSE x := NewBoolConst(TRUE) END @@ -253,12 +253,12 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) BEGIN IF NotVar(x) THEN err(112) - ELSIF x^.typ^.form = OPM.Pointer THEN - IF (x^.typ^.BaseTyp^.comp # OPM.Record) & (x^.typ # OPT.sysptrtyp) THEN err(85) - ELSIF obj^.typ^.form = OPM.Pointer THEN GTT(x^.typ^.BaseTyp, obj^.typ^.BaseTyp) + ELSIF x^.typ^.form = OPT.Pointer THEN + IF (x^.typ^.BaseTyp^.comp # OPT.Record) & (x^.typ # OPT.sysptrtyp) THEN err(85) + ELSIF obj^.typ^.form = OPT.Pointer THEN GTT(x^.typ^.BaseTyp, obj^.typ^.BaseTyp) ELSE err(86) END - ELSIF (x^.typ^.comp = OPM.Record) & (x^.class = OPM.Nvarpar) & (obj^.typ^.comp = OPM.Record) THEN + ELSIF (x^.typ^.comp = OPT.Record) & (x^.class = OPT.Nvarpar) & (obj^.typ^.comp = OPT.Record) THEN GTT(x^.typ, obj^.typ) ELSE err(87) END ; @@ -268,15 +268,15 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node); VAR f: INTEGER; k: LONGINT; BEGIN f := x^.typ^.form; - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) OR (y^.class = OPM.Ntype) OR (y^.class = OPM.Nproc) THEN err(126) - ELSIF (f IN OPM.intSet) & (y^.typ^.form = OPM.Set) THEN - IF x^.class = OPM.Nconst THEN + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126) + ELSIF (f IN OPT.intSet) & (y^.typ^.form = OPT.Set) THEN + IF x^.class = OPT.Nconst THEN k := x^.conval^.intval; IF (k < 0) OR (k > OPM.MaxSet) THEN err(202) - ELSIF y^.class = OPM.Nconst THEN x^.conval^.intval := BoolToInt(k IN y^.conval^.setval); x^.obj := NIL - ELSE BindNodes(OPM.Ndop, OPT.booltyp, x, y); x^.subcl := OPM.in + ELSIF y^.class = OPT.Nconst THEN x^.conval^.intval := BoolToInt(k IN y^.conval^.setval); x^.obj := NIL + ELSE BindNodes(OPT.Ndop, OPT.booltyp, x, y); x^.subcl := OPM.in END - ELSE BindNodes(OPM.Ndop, OPT.booltyp, x, y); x^.subcl := OPM.in + ELSE BindNodes(OPT.Ndop, OPT.booltyp, x, y); x^.subcl := OPM.in END ELSE err(92) END ; @@ -294,13 +294,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE CheckRealType(f, nr: INTEGER; x: OPT.Const); VAR min, max, r: LONGREAL; BEGIN - IF f = OPM.Real THEN min := OPM.MinReal; max := OPM.MaxReal + IF f = OPT.Real THEN min := OPM.MinReal; max := OPM.MaxReal ELSE min := OPM.MinLReal; max := OPM.MaxLReal END ; r := ABS(x^.realval); IF (r > max) OR (r < min) THEN err(nr); x^.realval := 1.0 - ELSIF f = OPM.Real THEN x^.realval := SHORT(x^.realval) (* single precision only *) + ELSIF f = OPT.Real THEN x^.realval := SHORT(x^.realval) (* single precision only *) END ; x^.intval := OPM.ConstNotAlloc END CheckRealType; @@ -311,29 +311,29 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; z: OPT.Node): OPT.Node; VAR node: OPT.Node; BEGIN - node := OPT.NewNode(OPM.Nmop); node^.subcl := op; node^.typ := typ; + node := OPT.NewNode(OPT.Nmop); node^.subcl := op; node^.typ := typ; node^.left := z; RETURN node END NewOp; BEGIN z := x; - IF (z^.class = OPM.Ntype) OR (z^.class = OPM.Nproc) THEN err(126) + IF (z^.class = OPT.Ntype) OR (z^.class = OPT.Nproc) THEN err(126) ELSE typ := z^.typ; f := typ^.form; CASE op OF - |OPM.not: IF f = OPM.Bool THEN - IF z^.class = OPM.Nconst THEN + |OPM.not: IF f = OPT.Bool THEN + IF z^.class = OPT.Nconst THEN z^.conval^.intval := BoolToInt(~IntToBool(z^.conval^.intval)); z^.obj := NIL ELSE z := NewOp(op, typ, z) END ELSE err(98) END - |OPM.plus: IF ~(f IN OPM.intSet + OPM.realSet) THEN err(96) END - |OPM.minus: IF f IN OPM.intSet + OPM.realSet +{OPM.Set}THEN - IF z^.class = OPM.Nconst THEN - IF f IN OPM.intSet THEN + |OPM.plus: IF ~(f IN OPT.intSet + OPT.realSet) THEN err(96) END + |OPM.minus: IF f IN OPT.intSet + OPT.realSet +{OPT.Set}THEN + IF z^.class = OPT.Nconst THEN + IF f IN OPT.intSet THEN IF z^.conval^.intval = MIN(LONGINT) THEN err(203) ELSE z^.conval^.intval := -z^.conval^.intval; SetIntType(z) END - ELSIF f IN OPM.realSet THEN z^.conval^.realval := -z^.conval^.realval + ELSIF f IN OPT.realSet THEN z^.conval^.realval := -z^.conval^.realval ELSE z^.conval^.setval := -z^.conval^.setval END ; z^.obj := NIL @@ -341,9 +341,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ELSE err(97) END - |OPM.abs: IF f IN OPM.intSet + OPM.realSet THEN - IF z^.class = OPM.Nconst THEN - IF f IN OPM.intSet THEN + |OPT.abs: IF f IN OPT.intSet + OPT.realSet THEN + IF z^.class = OPT.Nconst THEN + IF f IN OPT.intSet THEN IF z^.conval^.intval = MIN(LONGINT) THEN err(203) ELSE z^.conval^.intval := ABS(z^.conval^.intval); SetIntType(z) END @@ -354,29 +354,29 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ELSE err(111) END - |OPM.cap: IF f = OPM.Char THEN - IF z^.class = OPM.Nconst THEN + |OPT.cap: IF f = OPT.Char THEN + IF z^.class = OPT.Nconst THEN z^.conval^.intval := ORD(CAP(CHR(z^.conval^.intval))); z^.obj := NIL ELSE z := NewOp(op, typ, z) END ELSE err(111); z^.typ := OPT.chartyp END - |OPM.odd: IF f IN OPM.intSet THEN - IF z^.class = OPM.Nconst THEN + |OPT.odd: IF f IN OPT.intSet THEN + IF z^.class = OPT.Nconst THEN z^.conval^.intval := BoolToInt(ODD(z^.conval^.intval)); z^.obj := NIL ELSE z := NewOp(op, typ, z) END ELSE err(111) END ; z^.typ := OPT.booltyp - |OPM.adr: IF (z^.class = OPM.Nconst) & (f = OPM.Char) & (z^.conval^.intval >= 20H) THEN (*SYSTEM.ADR*) - CharToString(z); f := OPM.String + |OPT.adr: IF (z^.class = OPT.Nconst) & (f = OPT.Char) & (z^.conval^.intval >= 20H) THEN (*SYSTEM.ADR*) + CharToString(z); f := OPT.String END; - IF (z^.class < OPM.Nconst) OR (f = OPM.String) THEN z := NewOp(op, typ, z) + IF (z^.class < OPT.Nconst) OR (f = OPT.String) THEN z := NewOp(op, typ, z) ELSE err(127) END ; z^.typ := OPT.linttyp - |OPM.cc: IF (f IN OPM.intSet) & (z^.class = OPM.Nconst) THEN (*SYSTEM.CC*) + |OPT.cc: IF (f IN OPT.intSet) & (z^.class = OPT.Nconst) THEN (*SYSTEM.CC*) IF (0 <= z^.conval^.intval) & (z^.conval^.intval <= OPM.MaxCC) THEN z := NewOp(op, typ, z) ELSE err(219) END ELSE err(69) END ; @@ -390,15 +390,15 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE CheckPtr(x, y: OPT.Node); VAR g: INTEGER; p, q, t: OPT.Struct; BEGIN g := y^.typ^.form; - IF g = OPM.Pointer THEN + IF g = OPT.Pointer THEN p := x^.typ^.BaseTyp; q := y^.typ^.BaseTyp; - IF (p^.comp = OPM.Record) & (q^.comp = OPM.Record) THEN + IF (p^.comp = OPT.Record) & (q^.comp = OPT.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 # OPM.NilTyp THEN err(100) + ELSIF g # OPT.NilTyp THEN err(100) END END CheckPtr; @@ -408,11 +408,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) WHILE fp # NIL DO IF ap # NIL THEN ft := fp^.typ; at := ap^.typ; - WHILE (ft^.comp = OPM.DynArr) & (at^.comp = OPM.DynArr) DO + WHILE (ft^.comp = OPT.DynArr) & (at^.comp = OPT.DynArr) DO ft := ft^.BaseTyp; at := at^.BaseTyp END ; IF ft # at THEN - IF (ft^.form = OPM.ProcTyp) & (at^.form = OPM.ProcTyp) THEN + IF (ft^.form = OPT.ProcTyp) & (at^.form = OPT.ProcTyp) THEN IF ft^.BaseTyp = at^.BaseTyp THEN CheckParameters(ft^.link, at^.link, FALSE) ELSE err(117) END @@ -430,9 +430,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE CheckProc(x: OPT.Struct; y: OPT.Object); (* proc var x := proc y, check compatibility *) BEGIN - IF y^.mode IN {OPM.XProc, OPM.IProc, OPM.LProc} THEN - IF y^.mode = OPM.LProc THEN - IF y^.mnolev = 0 THEN y^.mode := OPM.XProc + IF y^.mode IN {OPT.XProc, OPT.IProc, OPT.LProc} THEN + IF y^.mode = OPT.LProc THEN + IF y^.mnolev = 0 THEN y^.mode := OPT.XProc ELSE err(73) END END ; @@ -451,31 +451,31 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) VAR res: INTEGER; BEGIN CASE f OF - |OPM.Undef: res := OPM.eql - |OPM.Byte, - OPM.Char - ..OPM.LInt: IF xval^.intval < yval^.intval THEN res := OPM.lss + |OPT.Undef: res := OPM.eql + |OPT.Byte, + OPT.Char + ..OPT.LInt: IF xval^.intval < yval^.intval THEN res := OPM.lss ELSIF xval^.intval > yval^.intval THEN res := OPM.gtr ELSE res := OPM.eql END - |OPM.Real, - OPM.LReal: IF xval^.realval < yval^.realval THEN res := OPM.lss + |OPT.Real, + OPT.LReal: IF xval^.realval < yval^.realval THEN res := OPM.lss ELSIF xval^.realval > yval^.realval THEN res := OPM.gtr ELSE res := OPM.eql END - |OPM.Bool: IF xval^.intval # yval^.intval THEN res := OPM.neq + |OPT.Bool: IF xval^.intval # yval^.intval THEN res := OPM.neq ELSE res := OPM.eql END - |OPM.Set: IF xval^.setval # yval^.setval THEN res := OPM.neq + |OPT.Set: IF xval^.setval # yval^.setval THEN res := OPM.neq ELSE res := OPM.eql END - |OPM.String: IF xval^.ext^ < yval^.ext^ THEN res := OPM.lss + |OPT.String: IF xval^.ext^ < yval^.ext^ THEN res := OPM.lss ELSIF xval^.ext^ > yval^.ext^ THEN res := OPM.gtr ELSE res := OPM.eql END - |OPM.NilTyp, - OPM.Pointer, - OPM.ProcTyp: IF xval^.intval # yval^.intval THEN res := OPM.neq + |OPT.NilTyp, + OPT.Pointer, + OPT.ProcTyp: IF xval^.intval # yval^.intval THEN res := OPM.neq ELSE res := OPM.eql END ELSE OPM.LogWStr("unhandled case in OPB.ConstCmp, f = "); OPM.LogWNum(f, 0); OPM.LogWLn; @@ -488,37 +488,37 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) f := x^.typ^.form; g := y^.typ^.form; xval := x^.conval; yval := y^.conval; IF f # g THEN CASE f OF - |OPM.Char: IF g = OPM.String THEN CharToString(x) + |OPT.Char: IF g = OPT.String THEN CharToString(x) ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END ; - |OPM.SInt, - OPM.Int, - OPM.LInt: IF g IN OPM.intSet THEN + |OPT.SInt, + OPT.Int, + OPT.LInt: IF g IN OPT.intSet THEN IF x.typ.size <= y.typ.size THEN x.typ := y.typ ELSE x.typ := IntType(x.typ.size) END - ELSIF g = OPM.Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval - ELSIF g = OPM.LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval + ELSIF g = OPT.Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval + ELSIF g = OPT.LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END - |OPM.Real: IF g IN OPM.intSet THEN y^.typ := x^.typ; yval^.realval := yval^.intval - ELSIF g = OPM.LReal THEN x^.typ := OPT.lrltyp + |OPT.Real: IF g IN OPT.intSet THEN y^.typ := x^.typ; yval^.realval := yval^.intval + ELSIF g = OPT.LReal THEN x^.typ := OPT.lrltyp ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END - |OPM.LReal: IF g IN OPM.intSet THEN y^.typ := x^.typ; yval^.realval := yval^.intval - ELSIF g = OPM.Real THEN y^.typ := OPT.lrltyp + |OPT.LReal: IF g IN OPT.intSet THEN y^.typ := x^.typ; yval^.realval := yval^.intval + ELSIF g = OPT.Real THEN y^.typ := OPT.lrltyp ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END - |OPM.String: IF g = OPM.Char THEN CharToString(y); g := OPM.String + |OPT.String: IF g = OPT.Char THEN CharToString(y); g := OPT.String ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END ; - |OPM.NilTyp: IF ~(g IN {OPM.Pointer, OPM.ProcTyp}) THEN err(100) END - |OPM.Pointer: CheckPtr(x, y) - |OPM.ProcTyp: IF g # OPM.NilTyp THEN err(100) END + |OPT.NilTyp: IF ~(g IN {OPT.Pointer, OPT.ProcTyp}) THEN err(100) END + |OPT.Pointer: CheckPtr(x, y) + |OPT.ProcTyp: IF g # OPT.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 - |OPM.times: IF f IN OPM.intSet THEN xv := xval^.intval; yv := yval^.intval; + |OPM.times: IF f IN OPT.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 @@ -527,98 +527,98 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) xval^.intval := xv * yv; SetIntType(x) ELSE err(204) END - ELSIF f IN OPM.realSet THEN + ELSIF f IN OPT.realSet THEN temp := ABS(yval^.realval) <= 1.0; IF temp OR (ABS(xval^.realval) <= MAX(LONGREAL) / ABS(yval^.realval)) THEN xval^.realval := xval^.realval * yval^.realval; CheckRealType(f, 204, xval) ELSE err(204) END - ELSIF f = OPM.Set THEN + ELSIF f = OPT.Set THEN xval^.setval := xval^.setval * yval^.setval - ELSIF f # OPM.Undef THEN err(101) + ELSIF f # OPT.Undef THEN err(101) END - |OPM.slash: IF f IN OPM.intSet THEN + |OPM.slash: IF f IN OPT.intSet THEN IF yval^.intval # 0 THEN - xval^.realval := xval^.intval / yval^.intval; CheckRealType(OPM.Real, 205, xval) + xval^.realval := xval^.intval / yval^.intval; CheckRealType(OPT.Real, 205, xval) ELSE err(205); xval^.realval := 1.0 END ; x^.typ := OPT.realtyp - ELSIF f IN OPM.realSet THEN + ELSIF f IN OPT.realSet THEN temp := ABS(yval^.realval) >= 1.0; IF temp OR (ABS(xval^.realval) <= MAX(LONGREAL) * ABS(yval^.realval)) THEN xval^.realval := xval^.realval / yval^.realval; CheckRealType(f, 205, xval) ELSE err(205) END - ELSIF f = OPM.Set THEN + ELSIF f = OPT.Set THEN xval^.setval := xval^.setval / yval^.setval - ELSIF f # OPM.Undef THEN err(102) + ELSIF f # OPT.Undef THEN err(102) END - |OPM.div: IF f IN OPM.intSet THEN + |OPM.div: IF f IN OPT.intSet THEN IF yval^.intval # 0 THEN xval^.intval := xval^.intval DIV yval^.intval; SetIntType(x) ELSE err(205) END - ELSIF f # OPM.Undef THEN err(103) + ELSIF f # OPT.Undef THEN err(103) END - |OPM.mod: IF f IN OPM.intSet THEN + |OPM.mod: IF f IN OPT.intSet THEN IF yval^.intval # 0 THEN xval^.intval := xval^.intval MOD yval^.intval; SetIntType(x) ELSE err(205) END - ELSIF f # OPM.Undef THEN err(104) + ELSIF f # OPT.Undef THEN err(104) END - |OPM.and: IF f = OPM.Bool THEN + |OPM.and: IF f = OPT.Bool THEN xval^.intval := BoolToInt(IntToBool(xval^.intval) & IntToBool(yval^.intval)) ELSE err(94) END - |OPM.plus: IF f IN OPM.intSet THEN + |OPM.plus: IF f IN OPT.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 OPM.realSet THEN + ELSIF f IN OPT.realSet 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 xval^.realval := xval^.realval + yval^.realval; CheckRealType(f, 206, xval) ELSE err(206) END - ELSIF f = OPM.Set THEN + ELSIF f = OPT.Set THEN xval^.setval := xval^.setval + yval^.setval - ELSIF f # OPM.Undef THEN err(105) + ELSIF f # OPT.Undef THEN err(105) END - |OPM.minus: IF f IN OPM.intSet THEN + |OPM.minus: IF f IN OPT.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 OPM.realSet THEN + ELSIF f IN OPT.realSet 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 xval^.realval := xval^.realval - yval^.realval; CheckRealType(f, 207, xval) ELSE err(207) END - ELSIF f = OPM.Set THEN + ELSIF f = OPT.Set THEN xval^.setval := xval^.setval - yval^.setval - ELSIF f # OPM.Undef THEN err(106) + ELSIF f # OPT.Undef THEN err(106) END - |OPM.or: IF f = OPM.Bool THEN + |OPM.or: IF f = OPT.Bool THEN xval^.intval := BoolToInt(IntToBool(xval^.intval) OR IntToBool(yval^.intval)) ELSE err(95) END |OPM.eql: xval^.intval := BoolToInt(ConstCmp() = OPM.eql) |OPM.neq: xval^.intval := BoolToInt(ConstCmp() # OPM.eql) - |OPM.lss: IF f IN {OPM.Bool, OPM.Set, OPM.NilTyp, OPM.Pointer} THEN err(108) + |OPM.lss: IF f IN {OPT.Bool, OPT.Set, OPT.NilTyp, OPT.Pointer} THEN err(108) ELSE xval^.intval := BoolToInt(ConstCmp() = OPM.lss) END - |OPM.leq: IF f IN {OPM.Bool, OPM.Set, OPM.NilTyp, OPM.Pointer} THEN err(108) + |OPM.leq: IF f IN {OPT.Bool, OPT.Set, OPT.NilTyp, OPT.Pointer} THEN err(108) ELSE xval^.intval := BoolToInt(ConstCmp() # OPM.gtr) END - |OPM.gtr: IF f IN {OPM.Bool, OPM.Set, OPM.NilTyp, OPM.Pointer} THEN err(108) + |OPM.gtr: IF f IN {OPT.Bool, OPT.Set, OPT.NilTyp, OPT.Pointer} THEN err(108) ELSE xval^.intval := BoolToInt(ConstCmp() = OPM.gtr) END - |OPM.geq: IF f IN {OPM.Bool, OPM.Set, OPM.NilTyp, OPM.Pointer} THEN err(108) + |OPM.geq: IF f IN {OPT.Bool, OPT.Set, OPT.NilTyp, OPT.Pointer} THEN err(108) ELSE xval^.intval := BoolToInt(ConstCmp() # OPM.lss) END ELSE @@ -629,30 +629,30 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct); VAR node: OPT.Node; f, g: INTEGER; k: LONGINT; r: LONGREAL; BEGIN f := x^.typ^.form; g := typ^.form; - IF x^.class = OPM.Nconst THEN - IF f IN OPM.intSet THEN - IF g IN OPM.intSet THEN + IF x^.class = OPT.Nconst THEN + IF f IN OPT.intSet THEN + IF g IN OPT.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 OPM.realSet THEN x^.conval^.realval := x^.conval^.intval; x^.conval^.intval := OPM.ConstNotAlloc - ELSE (*g = OPM.Char*) k := x^.conval^.intval; + ELSIF g IN OPT.realSet THEN x^.conval^.realval := x^.conval^.intval; x^.conval^.intval := OPM.ConstNotAlloc + ELSE (*g = OPT.Char*) k := x^.conval^.intval; IF (0 > k) OR (k > 0FFH) THEN err(220) END END - ELSIF f IN OPM.realSet THEN - IF g IN OPM.realSet THEN CheckRealType(g, 203, x^.conval) - ELSE (*g = OPM.LInt*) + ELSIF f IN OPT.realSet THEN + IF g IN OPT.realSet THEN CheckRealType(g, 203, x^.conval) + ELSE (*g = OPT.LInt*) r := x^.conval^.realval; IF (r < MIN(LONGINT)) OR (r > MAX(LONGINT)) THEN err(203); r := 1 END ; x^.conval^.intval := ENTIER(r); SetIntType(x) END - ELSE (* (f IN {OPM.Char, OPM.Byte}) & (g IN {OPM.Byte} + OPM.intSet) OR (f = OPM.Undef) *) + ELSE (* (f IN {OPT.Char, OPT.Byte}) & (g IN {OPT.Byte} + OPT.intSet) OR (f = OPT.Undef) *) END ; x^.obj := NIL - ELSIF (x^.class = OPM.Nmop) & (x^.subcl = OPM.conv) & ((x^.left^.typ^.form < f) OR (f > g)) THEN + ELSIF (x^.class = OPT.Nmop) & (x^.subcl = OPT.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(OPM.Nmop); node^.subcl := OPM.conv; node^.left := x; x := node + ELSE node := OPT.NewNode(OPT.Nmop); node^.subcl := OPT.conv; node^.left := x; x := node END ; x^.typ := typ END Convert; @@ -663,23 +663,23 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; VAR x: OPT.Node; y: OPT.Node); VAR node: OPT.Node; BEGIN - node := OPT.NewNode(OPM.Ndop); node^.subcl := op; node^.typ := typ; + node := OPT.NewNode(OPT.Ndop); node^.subcl := op; node^.typ := typ; node^.left := x; node^.right := y; x := node END NewOp; PROCEDURE strings(VAR x, y: OPT.Node): BOOLEAN; VAR ok, xCharArr, yCharArr: BOOLEAN; BEGIN - xCharArr := ((x^.typ^.comp IN {OPM.Array, OPM.DynArr}) & (x^.typ^.BaseTyp^.form=OPM.Char)) OR (f=OPM.String); - yCharArr := (((y^.typ^.comp IN {OPM.Array, OPM.DynArr}) & (y^.typ^.BaseTyp^.form=OPM.Char)) OR (g=OPM.String)); - IF xCharArr & (g = OPM.Char) & (y^.class = OPM.Nconst) THEN CharToString(y); g := OPM.String; yCharArr := TRUE END ; - IF yCharArr & (f = OPM.Char) & (x^.class = OPM.Nconst) THEN CharToString(x); f := OPM.String; xCharArr := TRUE END ; + xCharArr := ((x^.typ^.comp IN {OPT.Array, OPT.DynArr}) & (x^.typ^.BaseTyp^.form=OPT.Char)) OR (f=OPT.String); + yCharArr := (((y^.typ^.comp IN {OPT.Array, OPT.DynArr}) & (y^.typ^.BaseTyp^.form=OPT.Char)) OR (g=OPT.String)); + IF xCharArr & (g = OPT.Char) & (y^.class = OPT.Nconst) THEN CharToString(y); g := OPT.String; yCharArr := TRUE END ; + IF yCharArr & (f = OPT.Char) & (x^.class = OPT.Nconst) THEN CharToString(x); f := OPT.String; xCharArr := TRUE END ; ok := xCharArr & yCharArr; IF ok THEN (* replace ""-string compare with 0X-char compare, if possible *) - IF (f=OPM.String) & (x^.conval^.intval2 = 1) THEN (* y is array of char *) + IF (f=OPT.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=OPM.String) & (y^.conval^.intval2 = 1) THEN (* x is array of char *) + ELSIF (g=OPT.String) & (y^.conval^.intval2 = 1) THEN (* x is array of char *) y^.typ := OPT.chartyp; y^.conval^.intval := 0; Index(x, NewIntConst(0)) END @@ -689,125 +689,125 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) BEGIN z := x; - IF (z^.class = OPM.Ntype) OR (z^.class = OPM.Nproc) OR (y^.class = OPM.Ntype) OR (y^.class = OPM.Nproc) THEN err(126) - ELSIF (z^.class = OPM.Nconst) & (y^.class = OPM.Nconst) THEN ConstOp(op, z, y); z^.obj := NIL + IF (z^.class = OPT.Ntype) OR (z^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126) + ELSIF (z^.class = OPT.Nconst) & (y^.class = OPT.Nconst) THEN ConstOp(op, z, y); z^.obj := NIL ELSE IF z^.typ # y^.typ THEN g := y^.typ^.form; CASE z^.typ^.form OF - |OPM.Char: IF z^.class = OPM.Nconst THEN CharToString(z) ELSE err(100) END - |OPM.SInt, - OPM.Int, - OPM.LInt: IF (g IN OPM.intSet) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ) - ELSIF g IN OPM.intSet + OPM.realSet THEN Convert(z, y.typ) + |OPT.Char: IF z^.class = OPT.Nconst THEN CharToString(z) ELSE err(100) END + |OPT.SInt, + OPT.Int, + OPT.LInt: IF (g IN OPT.intSet) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ) + ELSIF g IN OPT.intSet + OPT.realSet THEN Convert(z, y.typ) ELSE err(100) END - |OPM.Real: IF g IN OPM.intSet THEN Convert(y, z^.typ) - ELSIF g IN OPM.realSet THEN Convert(z, y^.typ) + |OPT.Real: IF g IN OPT.intSet THEN Convert(y, z^.typ) + ELSIF g IN OPT.realSet THEN Convert(z, y^.typ) ELSE err(100) END - |OPM.LReal: IF g IN OPM.intSet + OPM.realSet THEN Convert(y, z^.typ) - ELSIF g IN OPM.realSet THEN Convert(y, z^.typ) (* DCWB: Surely this line does nothing. *) + |OPT.LReal: IF g IN OPT.intSet + OPT.realSet THEN Convert(y, z^.typ) + ELSIF g IN OPT.realSet THEN Convert(y, z^.typ) (* DCWB: Surely this line does nothing. *) ELSE err(100) END - |OPM.NilTyp: IF ~(g IN {OPM.Pointer, OPM.ProcTyp}) THEN err(100) END - |OPM.Pointer: CheckPtr(z, y) - |OPM.ProcTyp: IF g # OPM.NilTyp THEN err(100) END - |OPM.String: - |OPM.Comp: IF z^.typ^.comp = OPM.Record THEN err(100) END + |OPT.NilTyp: IF ~(g IN {OPT.Pointer, OPT.ProcTyp}) THEN err(100) END + |OPT.Pointer: CheckPtr(z, y) + |OPT.ProcTyp: IF g # OPT.NilTyp THEN err(100) END + |OPT.String: + |OPT.Comp: IF z^.typ^.comp = OPT.Record THEN err(100) END ELSE err(100) END END ; (* {z^.typ = y^.typ} *) typ := z^.typ; f := typ^.form; g := y^.typ^.form; CASE op OF |OPM.times: do := TRUE; - IF f IN OPM.intSet THEN - IF z^.class = OPM.Nconst THEN val := z^.conval^.intval; + IF f IN OPT.intSet THEN + IF z^.class = OPT.Nconst THEN val := z^.conval^.intval; IF val = 1 THEN do := FALSE; z := y ELSIF val = 0 THEN do := FALSE ELSIF log(val) = 1 THEN t := y; y := z; z := t; - op := OPM.ash; y^.typ := OPT.sinttyp; y^.conval^.intval := exp; y^.obj := NIL + op := OPT.ash; y^.typ := OPT.sinttyp; y^.conval^.intval := exp; y^.obj := NIL END - ELSIF y^.class = OPM.Nconst THEN val := y^.conval^.intval; + ELSIF y^.class = OPT.Nconst THEN val := y^.conval^.intval; IF val = 1 THEN do := FALSE ELSIF val = 0 THEN do := FALSE; z := y ELSIF log(val) = 1 THEN - op := OPM.ash; y^.typ := OPT.sinttyp; y^.conval^.intval := exp; y^.obj := NIL + op := OPT.ash; y^.typ := OPT.sinttyp; y^.conval^.intval := exp; y^.obj := NIL END END - ELSIF ~(f IN {OPM.Undef, OPM.Real..OPM.Set}) THEN err(105); typ := OPT.undftyp + ELSIF ~(f IN {OPT.Undef, OPT.Real..OPT.Set}) THEN err(105); typ := OPT.undftyp END ; IF do THEN NewOp(op, typ, z, y) END - |OPM.slash: IF f IN OPM.intSet THEN - IF (y^.class = OPM.Nconst) & (y^.conval^.intval = 0) THEN err(205) END ; + |OPM.slash: IF f IN OPT.intSet THEN + IF (y^.class = OPT.Nconst) & (y^.conval^.intval = 0) THEN err(205) END ; Convert(z, OPT.realtyp); Convert(y, OPT.realtyp); typ := OPT.realtyp - ELSIF f IN OPM.realSet THEN - IF (y^.class = OPM.Nconst) & (y^.conval^.realval = 0.0) THEN err(205) END - ELSIF (f # OPM.Set) & (f # OPM.Undef) THEN err(102); typ := OPT.undftyp + ELSIF f IN OPT.realSet THEN + IF (y^.class = OPT.Nconst) & (y^.conval^.realval = 0.0) THEN err(205) END + ELSIF (f # OPT.Set) & (f # OPT.Undef) THEN err(102); typ := OPT.undftyp END ; NewOp(op, typ, z, y) |OPM.div: do := TRUE; - IF f IN OPM.intSet THEN - IF y^.class = OPM.Nconst THEN val := y^.conval^.intval; + IF f IN OPT.intSet THEN + IF y^.class = OPT.Nconst THEN val := y^.conval^.intval; IF val = 0 THEN err(205) ELSIF val = 1 THEN do := FALSE ELSIF log(val) = 1 THEN - op := OPM.ash; y^.typ := OPT.sinttyp; y^.conval^.intval := -exp; y^.obj := NIL + op := OPT.ash; y^.typ := OPT.sinttyp; y^.conval^.intval := -exp; y^.obj := NIL END END - ELSIF f # OPM.Undef THEN err(103); typ := OPT.undftyp + ELSIF f # OPT.Undef THEN err(103); typ := OPT.undftyp END ; IF do THEN NewOp(op, typ, z, y) END - |OPM.mod: IF f IN OPM.intSet THEN - IF y^.class = OPM.Nconst THEN + |OPM.mod: IF f IN OPT.intSet THEN + IF y^.class = OPT.Nconst THEN IF y^.conval^.intval = 0 THEN err(205) ELSIF log(y^.conval^.intval) = 1 THEN - op := OPM.msk; y^.conval^.intval := ASH(-1, exp); y^.obj := NIL + op := OPT.msk; y^.conval^.intval := ASH(-1, exp); y^.obj := NIL END END - ELSIF f # OPM.Undef THEN err(104); typ := OPT.undftyp + ELSIF f # OPT.Undef THEN err(104); typ := OPT.undftyp END ; NewOp(op, typ, z, y) - |OPM.and: IF f = OPM.Bool THEN - IF z^.class = OPM.Nconst THEN + |OPM.and: IF f = OPT.Bool THEN + IF z^.class = OPT.Nconst THEN IF IntToBool(z^.conval^.intval) THEN z := y END - ELSIF (y^.class = OPM.Nconst) & IntToBool(y^.conval^.intval) THEN (* optimize z & TRUE -> z *) - (*ELSIF (y^.class = OPM.Nconst) & ~IntToBool(y^.conval^.intval) THEN + ELSIF (y^.class = OPT.Nconst) & IntToBool(y^.conval^.intval) THEN (* optimize z & TRUE -> z *) + (*ELSIF (y^.class = OPT.Nconst) & ~IntToBool(y^.conval^.intval) THEN don't optimize z & FALSE -> FALSE: side effects possible *) ELSE NewOp(op, typ, z, y) END - ELSIF f # OPM.Undef THEN err(94); z^.typ := OPT.undftyp + ELSIF f # OPT.Undef THEN err(94); z^.typ := OPT.undftyp END - |OPM.plus: IF ~(f IN {OPM.Undef, OPM.SInt..OPM.Set}) THEN err(105); typ := OPT.undftyp END ; + |OPM.plus: IF ~(f IN {OPT.Undef, OPT.SInt..OPT.Set}) THEN err(105); typ := OPT.undftyp END ; do := TRUE; - IF f IN OPM.intSet THEN - IF (z^.class = OPM.Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ; - IF (y^.class = OPM.Nconst) & (y^.conval^.intval = 0) THEN do := FALSE END + IF f IN OPT.intSet THEN + IF (z^.class = OPT.Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ; + IF (y^.class = OPT.Nconst) & (y^.conval^.intval = 0) THEN do := FALSE END END ; IF do THEN NewOp(op, typ, z, y) END - |OPM.minus: IF ~(f IN {OPM.Undef, OPM.SInt..OPM.Set}) THEN err(106); typ := OPT.undftyp END ; - IF ~(f IN OPM.intSet) OR (y^.class # OPM.Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END - |OPM.or: IF f = OPM.Bool THEN - IF z^.class = OPM.Nconst THEN + |OPM.minus: IF ~(f IN {OPT.Undef, OPT.SInt..OPT.Set}) THEN err(106); typ := OPT.undftyp END ; + IF ~(f IN OPT.intSet) OR (y^.class # OPT.Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END + |OPM.or: IF f = OPT.Bool THEN + IF z^.class = OPT.Nconst THEN IF ~IntToBool(z^.conval^.intval) THEN z := y END - ELSIF (y^.class = OPM.Nconst) & ~IntToBool(y^.conval^.intval) THEN (* optimize z OR FALSE -> z *) - (*ELSIF (y^.class = OPM.Nconst) & IntToBool(y^.conval^.intval) THEN + ELSIF (y^.class = OPT.Nconst) & ~IntToBool(y^.conval^.intval) THEN (* optimize z OR FALSE -> z *) + (*ELSIF (y^.class = OPT.Nconst) & IntToBool(y^.conval^.intval) THEN don't optimize z OR TRUE -> TRUE: side effects possible *) ELSE NewOp(op, typ, z, y) END - ELSIF f # OPM.Undef THEN err(95); z^.typ := OPT.undftyp + ELSIF f # OPT.Undef THEN err(95); z^.typ := OPT.undftyp END |OPM.eql, - OPM.neq: IF (f IN {OPM.Undef..OPM.Set, OPM.NilTyp, OPM.Pointer, OPM.ProcTyp}) OR strings(z, y) THEN typ := OPT.booltyp + OPM.neq: IF (f IN {OPT.Undef..OPT.Set, OPT.NilTyp, OPT.Pointer, OPT.ProcTyp}) OR strings(z, y) THEN typ := OPT.booltyp ELSE err(107); typ := OPT.undftyp END ; NewOp(op, typ, z, y) |OPM.lss, OPM.leq, OPM.gtr, - OPM.geq: IF (f IN {OPM.Undef, OPM.Char..OPM.LReal}) OR strings(z, y) THEN typ := OPT.booltyp + OPM.geq: IF (f IN {OPT.Undef, OPT.Char..OPT.LReal}) OR strings(z, y) THEN typ := OPT.booltyp ELSE OPM.LogWLn; OPM.LogWStr("ELSE in Op()"); OPM.LogWLn; err(108); typ := OPT.undftyp @@ -822,23 +822,23 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node); VAR k, l: LONGINT; BEGIN - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) OR (y^.class = OPM.Ntype) OR (y^.class = OPM.Nproc) THEN err(126) - ELSIF (x^.typ^.form IN OPM.intSet) & (y^.typ^.form IN OPM.intSet) THEN - IF x^.class = OPM.Nconst THEN + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126) + ELSIF (x^.typ^.form IN OPT.intSet) & (y^.typ^.form IN OPT.intSet) THEN + IF x^.class = OPT.Nconst THEN k := x^.conval^.intval; IF (0 > k) OR (k > OPM.MaxSet) THEN err(202) END END ; - IF y^.class = OPM.Nconst THEN + IF y^.class = OPT.Nconst THEN l := y^.conval^.intval; IF (0 > l) OR (l > OPM.MaxSet) THEN err(202) END END ; - IF (x^.class = OPM.Nconst) & (y^.class = OPM.Nconst) THEN + IF (x^.class = OPT.Nconst) & (y^.class = OPT.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(OPM.Nupto, OPT.settyp, x, y) + ELSE BindNodes(OPT.Nupto, OPT.settyp, x, y) END ELSE err(93) END ; @@ -848,9 +848,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE SetElem*(VAR x: OPT.Node); VAR k: LONGINT; BEGIN - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF ~(x^.typ^.form IN OPM.intSet) THEN err(93) - ELSIF x^.class = OPM.Nconst THEN + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF ~(x^.typ^.form IN OPT.intSet) THEN err(93) + ELSIF x^.class = OPT.Nconst THEN k := x^.conval^.intval; IF (0 <= k) & (k <= OPM.MaxSet) THEN x^.conval^.setval := {k} ELSE err(202) @@ -878,56 +878,56 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) OPM.LogWStr("g = "); OPM.LogWNum(g, 0); OPM.LogWLn; OPM.LogWStr("ynode.typ.syze = "); OPM.LogWNum(ynode.typ.size, 0); OPM.LogWLn; END; - IF (ynode^.class = OPM.Ntype) OR (ynode^.class = OPM.Nproc) & (f # OPM.ProcTyp) THEN err(126) END ; + IF (ynode^.class = OPT.Ntype) OR (ynode^.class = OPT.Nproc) & (f # OPT.ProcTyp) THEN err(126) END ; CASE f OF - OPM.Undef, - OPM.String: - | OPM.Byte: IF ~((g IN ({OPM.Byte, OPM.Char} + OPM.intSet)) & (y.size = 1)) THEN err(113) END - | OPM.Bool, - OPM.Char, - OPM.Set: IF g # f THEN err(113) END - | OPM.SInt, - OPM.Int, - OPM.LInt: IF ~(g IN OPM.intSet) OR (x.size < y.size) THEN err(113) END - | OPM.Real: IF ~(g IN {OPM.SInt..OPM.Real}) THEN err(113) END - | OPM.LReal: IF ~(g IN {OPM.SInt..OPM.LReal}) THEN err(113) END - | OPM.Pointer: IF (x = y) OR (g = OPM.NilTyp) OR (x = OPT.sysptrtyp) & (g = OPM.Pointer) THEN (* ok *) - ELSIF g = OPM.Pointer THEN + OPT.Undef, + OPT.String: + | OPT.Byte: IF ~((g IN ({OPT.Byte, OPT.Char} + OPT.intSet)) & (y.size = 1)) THEN err(113) END + | OPT.Bool, + OPT.Char, + OPT.Set: IF g # f THEN err(113) END + | OPT.SInt, + OPT.Int, + OPT.LInt: IF ~(g IN OPT.intSet) OR (x.size < y.size) THEN err(113) END + | OPT.Real: IF ~(g IN {OPT.SInt..OPT.Real}) THEN err(113) END + | OPT.LReal: IF ~(g IN {OPT.SInt..OPT.LReal}) THEN err(113) END + | OPT.Pointer: IF (x = y) OR (g = OPT.NilTyp) OR (x = OPT.sysptrtyp) & (g = OPT.Pointer) THEN (* ok *) + ELSIF g = OPT.Pointer THEN p := x^.BaseTyp; q := y^.BaseTyp; - IF (p^.comp = OPM.Record) & (q^.comp = OPM.Record) THEN + IF (p^.comp = OPT.Record) & (q^.comp = OPT.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 - | OPM.ProcTyp: IF ynode^.class = OPM.Nproc THEN CheckProc(x, ynode^.obj) - ELSIF (x = y) OR (g = OPM.NilTyp) THEN (* ok *) + | OPT.ProcTyp: IF ynode^.class = OPT.Nproc THEN CheckProc(x, ynode^.obj) + ELSIF (x = y) OR (g = OPT.NilTyp) THEN (* ok *) ELSE err(113) END - | OPM.NoTyp, - OPM.NilTyp: err(113) - | OPM.Comp: x^.pvused := TRUE; (* idfp of y guarantees assignment compatibility with x *) - IF x^.comp = OPM.Array THEN - IF (ynode^.class = OPM.Nconst) & (g = OPM.Char) THEN CharToString(ynode); y := ynode^.typ; g := OPM.String END ; + | OPT.NoTyp, + OPT.NilTyp: err(113) + | OPT.Comp: x^.pvused := TRUE; (* idfp of y guarantees assignment compatibility with x *) + IF x^.comp = OPT.Array THEN + IF (ynode^.class = OPT.Nconst) & (g = OPT.Char) THEN CharToString(ynode); y := ynode^.typ; g := OPT.String END ; IF x = y THEN (* ok *) ELSIF x^.BaseTyp = OPT.chartyp THEN (* Assign to (static) ARRAY OF CHAR *) - IF g = OPM.String THEN (*check length of string*) + IF g = OPT.String THEN (*check length of string*) IF ynode^.conval^.intval2 > x^.n THEN err(114) END - ELSIF (y.comp IN {OPM.DynArr, OPM.Array}) & (y.BaseTyp = OPT.chartyp) THEN + ELSIF (y.comp IN {OPT.DynArr, OPT.Array}) & (y.BaseTyp = OPT.chartyp) THEN (* Assignment from ARRAY OF CHAR is good.*) ELSE err(113) END ELSE err(113) END - ELSIF (x.comp = OPM.DynArr) & (x^.BaseTyp = OPT.chartyp) THEN (* Assign to dynamic ARRAY OF CHAR*) - IF (y.comp IN {OPM.DynArr, OPM.Array}) & (y.BaseTyp = OPT.chartyp) THEN + ELSIF (x.comp = OPT.DynArr) & (x^.BaseTyp = OPT.chartyp) THEN (* Assign to dynamic ARRAY OF CHAR*) + IF (y.comp IN {OPT.DynArr, OPT.Array}) & (y.BaseTyp = OPT.chartyp) THEN (* Assignment from ARRAY OF CHAR is good.*) ELSE err(113) END - ELSIF x^.comp = OPM.Record THEN + ELSIF x^.comp = OPT.Record THEN IF x = y THEN (* ok *) - ELSIF y^.comp = OPM.Record THEN + ELSIF y^.comp = OPT.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 @@ -937,7 +937,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ELSE OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn; END ; - IF (ynode^.class = OPM.Nconst) & (g < f) & (g IN {OPM.SInt..OPM.Real}) & (f IN {OPM.Int..OPM.LReal}) THEN + IF (ynode^.class = OPT.Nconst) & (g < f) & (g IN {OPT.SInt..OPT.Real}) & (f IN {OPT.Int..OPT.LReal}) THEN Convert(ynode, x) END END CheckAssign; @@ -945,9 +945,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE CheckLeaf(x: OPT.Node; dynArrToo: BOOLEAN); BEGIN (* avoid unnecessary intermediate variables in voc - IF (x^.class = OPM.Nmop) & (x^.subcl = val) THEN x := x^.left END ; - IF x^.class = OPM.Nguard THEN x := x^.left END ; (* skip last (and unique) guard *) - IF (x^.class = OPM.Nvar) & (dynArrToo OR (x^.typ^.comp # OPM.DynArr)) THEN x^.obj^.leaf := FALSE END + IF (x^.class = OPT.Nmop) & (x^.subcl = val) THEN x := x^.left END ; + IF x^.class = OPT.Nguard THEN x := x^.left END ; (* skip last (and unique) guard *) + IF (x^.class = OPT.Nvar) & (dynArrToo OR (x^.typ^.comp # OPT.DynArr)) THEN x^.obj^.leaf := FALSE END *) END CheckLeaf; @@ -955,165 +955,165 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) VAR f: INTEGER; typ: OPT.Struct; x: OPT.Node; BEGIN x := par0; f := x^.typ^.form; CASE fctno OF - |OPM.haltfn: (*HALT*) - IF (f IN OPM.intSet) & (x^.class = OPM.Nconst) THEN + |OPT.haltfn: (*HALT*) + IF (f IN OPT.intSet) & (x^.class = OPT.Nconst) THEN IF (OPM.MinHaltNr <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxHaltNr) THEN - BindNodes(OPM.Ntrap, OPT.notyp, x, x) + BindNodes(OPT.Ntrap, OPT.notyp, x, x) ELSE err(218) END ELSE err(69) END ; x^.typ := OPT.notyp - |OPM.newfn: (*NEW*) + |OPT.newfn: (*NEW*) typ := OPT.notyp; IF NotVar(x) THEN err(112) - ELSIF f = OPM.Pointer THEN + ELSIF f = OPT.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 {OPM.Record, OPM.DynArr, OPM.Array} THEN - IF f = OPM.DynArr THEN typ := x^.typ^.BaseTyp END ; - BindNodes(OPM.Nassign, OPT.notyp, x, NIL); x^.subcl := OPM.newfn + IF f IN {OPT.Record, OPT.DynArr, OPT.Array} THEN + IF f = OPT.DynArr THEN typ := x^.typ^.BaseTyp END ; + BindNodes(OPT.Nassign, OPT.notyp, x, NIL); x^.subcl := OPT.newfn ELSE err(111) END ELSE err(111) END ; x^.typ := typ - |OPM.absfn: (*ABS*) - MOp(OPM.abs, x) - |OPM.capfn: (*CAP*) - MOp(OPM.cap, x) - |OPM.ordfn: (*ORD*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f = OPM.Char THEN Convert(x, OPT.inttyp) + |OPT.absfn: (*ABS*) + MOp(OPT.abs, x) + |OPT.capfn: (*CAP*) + MOp(OPT.cap, x) + |OPT.ordfn: (*ORD*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f = OPT.Char THEN Convert(x, OPT.inttyp) ELSE err(111) END ; x^.typ := OPT.inttyp - |OPM.entierfn: (*ENTIER*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.realSet THEN Convert(x, OPT.linttyp) + |OPT.entierfn: (*ENTIER*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.realSet THEN Convert(x, OPT.linttyp) ELSE err(111) END ; x^.typ := OPT.linttyp - |OPM.oddfn: (*ODD*) - MOp(OPM.odd, x) - |OPM.minfn: (*MIN*) - IF x^.class = OPM.Ntype THEN + |OPT.oddfn: (*ODD*) + MOp(OPT.odd, x) + |OPT.minfn: (*MIN*) + IF x^.class = OPT.Ntype THEN CASE f OF - OPM.Bool: x := NewBoolConst(FALSE) - | OPM.Char: x := NewIntConst(0); x^.typ := OPT.chartyp - | OPM.SInt, - OPM.Int, - OPM.LInt: x := NewIntConst(OPM.SignedMinimum(x.typ.size)) - | OPM.Set: x := NewIntConst(0); x^.typ := OPT.inttyp - | OPM.Real: x := NewRealConst(OPM.MinReal, OPT.realtyp) - | OPM.LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp) + OPT.Bool: x := NewBoolConst(FALSE) + | OPT.Char: x := NewIntConst(0); x^.typ := OPT.chartyp + | OPT.SInt, + OPT.Int, + OPT.LInt: x := NewIntConst(OPM.SignedMinimum(x.typ.size)) + | OPT.Set: x := NewIntConst(0); x^.typ := OPT.inttyp + | OPT.Real: x := NewRealConst(OPM.MinReal, OPT.realtyp) + | OPT.LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp) ELSE err(111) END ELSE err(110) END - |OPM.maxfn: (*MAX*) - IF x^.class = OPM.Ntype THEN + |OPT.maxfn: (*MAX*) + IF x^.class = OPT.Ntype THEN CASE f OF - OPM.Bool: x := NewBoolConst(TRUE) - | OPM.Char: x := NewIntConst(0FFH); x^.typ := OPT.chartyp - | OPM.SInt, - OPM.Int, - OPM.LInt: x := NewIntConst(OPM.SignedMaximum(x.typ.size)) - | OPM.Set: x := NewIntConst(OPM.MaxSet); x^.typ := OPT.inttyp - | OPM.Real: x := NewRealConst(OPM.MaxReal, OPT.realtyp) - | OPM.LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp) + OPT.Bool: x := NewBoolConst(TRUE) + | OPT.Char: x := NewIntConst(0FFH); x^.typ := OPT.chartyp + | OPT.SInt, + OPT.Int, + OPT.LInt: x := NewIntConst(OPM.SignedMaximum(x.typ.size)) + | OPT.Set: x := NewIntConst(OPM.MaxSet); x^.typ := OPT.inttyp + | OPT.Real: x := NewRealConst(OPM.MaxReal, OPT.realtyp) + | OPT.LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp) ELSE err(111) END ELSE err(110) END - |OPM.chrfn: (*CHR*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN {OPM.Undef} + OPM.intSet THEN Convert(x, OPT.chartyp) + |OPT.chrfn: (*CHR*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN {OPT.Undef} + OPT.intSet THEN Convert(x, OPT.chartyp) ELSE err(111); x^.typ := OPT.chartyp END - |OPM.shortfn: (*SHORT*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF (f IN OPM.intSet) & (x.typ.size > OPM.SIntSize) THEN Convert(x, IntType(ShorterSize(x.typ.size))) - ELSIF f = OPM.LReal THEN Convert(x, OPT.realtyp) + |OPT.shortfn: (*SHORT*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF (f IN OPT.intSet) & (x.typ.size > OPM.SIntSize) THEN Convert(x, IntType(ShorterSize(x.typ.size))) + ELSIF f = OPT.LReal THEN Convert(x, OPT.realtyp) ELSE err(111) END - |OPM.longfn: (*LONG*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF (f IN OPM.intSet) & (x.typ.size < OPM.LIntSize) THEN Convert(x, IntType(LongerSize(x.typ.size))) - ELSIF f = OPM.Real THEN Convert(x, OPT.lrltyp) - ELSIF f = OPM.Char THEN Convert(x, OPT.linttyp) + |OPT.longfn: (*LONG*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF (f IN OPT.intSet) & (x.typ.size < OPM.LIntSize) THEN Convert(x, IntType(LongerSize(x.typ.size))) + ELSIF f = OPT.Real THEN Convert(x, OPT.lrltyp) + ELSIF f = OPT.Char THEN Convert(x, OPT.linttyp) ELSE err(111) END - |OPM.incfn, - OPM.decfn: (*INC, DEC*) + |OPT.incfn, + OPT.decfn: (*INC, DEC*) IF NotVar(x) THEN err(112) - ELSIF ~(f IN OPM.intSet) THEN err(111) + ELSIF ~(f IN OPT.intSet) THEN err(111) ELSIF x^.readonly THEN err(76) END - |OPM.inclfn, - OPM.exclfn: (*INCL, EXCL*) + |OPT.inclfn, + OPT.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 - |OPM.lenfn: (*LEN*) - IF ~(x^.typ^.comp IN {OPM.DynArr, OPM.Array}) THEN err(131) END - |OPM.copyfn: (*COPY*) - IF (x^.class = OPM.Nconst) & (f = OPM.Char) THEN CharToString(x); f := OPM.String END ; - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF (~(x^.typ^.comp IN {OPM.DynArr, OPM.Array}) OR (x^.typ^.BaseTyp^.form # OPM.Char)) - & (f # OPM.String) THEN err(111) + |OPT.lenfn: (*LEN*) + IF ~(x^.typ^.comp IN {OPT.DynArr, OPT.Array}) THEN err(131) END + |OPT.copyfn: (*COPY*) + IF (x^.class = OPT.Nconst) & (f = OPT.Char) THEN CharToString(x); f := OPT.String END ; + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF (~(x^.typ^.comp IN {OPT.DynArr, OPT.Array}) OR (x^.typ^.BaseTyp^.form # OPT.Char)) + & (f # OPT.String) THEN err(111) END - |OPM.ashfn: (*ASH*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.intSet THEN + |OPT.ashfn: (*ASH*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.intSet THEN IF x.typ.size # OPM.LIntSize THEN Convert(x, OPT.linttyp) END ELSE err(111); x^.typ := OPT.linttyp END - |OPM.adrfn: (*SYSTEM.ADR*) - CheckLeaf(x, FALSE); MOp(OPM.adr, x) - |OPM.sizefn: (*SIZE*) - IF x^.class # OPM.Ntype THEN err(110); x := NewIntConst(1) - ELSIF (f IN {OPM.Byte..OPM.Set, OPM.Pointer, OPM.ProcTyp}) - OR (x^.typ^.comp IN {OPM.Array, OPM.Record}) THEN + |OPT.adrfn: (*SYSTEM.ADR*) + CheckLeaf(x, FALSE); MOp(OPT.adr, x) + |OPT.sizefn: (*SIZE*) + IF x^.class # OPT.Ntype THEN err(110); x := NewIntConst(1) + ELSIF (f IN {OPT.Byte..OPT.Set, OPT.Pointer, OPT.ProcTyp}) + OR (x^.typ^.comp IN {OPT.Array, OPT.Record}) THEN typSize(x^.typ); x^.typ^.pvused := TRUE; x := NewIntConst(x^.typ^.size) ELSE err(111); x := NewIntConst(1) END - |OPM.ccfn: (*SYSTEM.CC*) - MOp(OPM.cc, x) - |OPM.lshfn, - OPM.rotfn: (*SYSTEM.LSH, SYSTEM.ROT*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF ~(f IN OPM.intSet + {OPM.Byte, OPM.Char, OPM.Set}) THEN err(111) + |OPT.ccfn: (*SYSTEM.CC*) + MOp(OPT.cc, x) + |OPT.lshfn, + OPT.rotfn: (*SYSTEM.LSH, SYSTEM.ROT*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF ~(f IN OPT.intSet + {OPT.Byte, OPT.Char, OPT.Set}) THEN err(111) END - |OPM.getfn, - OPM.putfn, - OPM.bitfn, - OPM.movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF (x^.class = OPM.Nconst) & (f IN OPM.intSet) & (x.typ.size < OPT.linttyp.size) THEN Convert(x, OPT.linttyp) - ELSIF ~((x.typ.form IN {OPM.Pointer} + OPM.intSet) & (x.typ.size = OPM.PointerSize)) THEN err(111); x^.typ := OPT.linttyp + |OPT.getfn, + OPT.putfn, + OPT.bitfn, + OPT.movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF (x^.class = OPT.Nconst) & (f IN OPT.intSet) & (x.typ.size < OPT.linttyp.size) THEN Convert(x, OPT.linttyp) + ELSIF ~((x.typ.form IN {OPT.Pointer} + OPT.intSet) & (x.typ.size = OPM.PointerSize)) THEN err(111); x^.typ := OPT.linttyp END - |OPM.getrfn, - OPM.putrfn: (*SYSTEM.GETREG, SYSTEM.PUTREG*) - IF (f IN OPM.intSet) & (x^.class = OPM.Nconst) THEN + |OPT.getrfn, + OPT.putrfn: (*SYSTEM.GETREG, SYSTEM.PUTREG*) + IF (f IN OPT.intSet) & (x^.class = OPT.Nconst) THEN IF (x^.conval^.intval < OPM.MinRegNr) OR (x^.conval^.intval > OPM.MaxRegNr) THEN err(220) END ELSE err(69) END - |OPM.valfn: (*SYSTEM.VAL*) - IF x^.class # OPM.Ntype THEN err(110) - ELSIF (f IN {OPM.Undef, OPM.String, OPM.NoTyp}) OR (x^.typ^.comp = OPM.DynArr) THEN err(111) + |OPT.valfn: (*SYSTEM.VAL*) + IF x^.class # OPT.Ntype THEN err(110) + ELSIF (f IN {OPT.Undef, OPT.String, OPT.NoTyp}) OR (x^.typ^.comp = OPT.DynArr) THEN err(111) END - |OPM.sysnewfn: (*SYSTEM.NEW*) + |OPT.sysnewfn: (*SYSTEM.NEW*) IF NotVar(x) THEN err(112) - ELSIF f = OPM.Pointer THEN + ELSIF f = OPT.Pointer THEN IF OPM.NEWusingAdr THEN CheckLeaf(x, TRUE) END ELSE err(111) END - |OPM.assertfn: (*ASSERT*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126); x := NewBoolConst(FALSE) - ELSIF f # OPM.Bool THEN err(120); x := NewBoolConst(FALSE) + |OPT.assertfn: (*ASSERT*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126); x := NewBoolConst(FALSE) + ELSIF f # OPT.Bool THEN err(120); x := NewBoolConst(FALSE) ELSE MOp(OPM.not, x) END ELSE OPM.LogWStr("unhandled case in OPB.StPar0, fctno = "); OPM.LogWNum(fctno, 0); OPM.LogWLn; @@ -1133,55 +1133,55 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) BEGIN p := par0; f := x^.typ^.form; CASE fctno OF - |OPM.incfn, - OPM.decfn: (*INC DEC*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126); p^.typ := OPT.notyp + |OPT.incfn, + OPT.decfn: (*INC DEC*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126); p^.typ := OPT.notyp ELSE IF x^.typ # p^.typ THEN - IF (x^.class = OPM.Nconst) & (f IN OPM.intSet) THEN Convert(x, p^.typ) + IF (x^.class = OPT.Nconst) & (f IN OPT.intSet) THEN Convert(x, p^.typ) ELSE err(111) END END ; - p := NewOp(OPM.Nassign, fctno, p, x); + p := NewOp(OPT.Nassign, fctno, p, x); p^.typ := OPT.notyp END - |OPM.inclfn, - OPM.exclfn: (*INCL, EXCL*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.intSet THEN - IF (x^.class = OPM.Nconst) & ((0 > x^.conval^.intval) OR (x^.conval^.intval > OPM.MaxSet)) THEN err(202) + |OPT.inclfn, + OPT.exclfn: (*INCL, EXCL*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.intSet THEN + IF (x^.class = OPT.Nconst) & ((0 > x^.conval^.intval) OR (x^.conval^.intval > OPM.MaxSet)) THEN err(202) END ; - p := NewOp(OPM.Nassign, fctno, p, x) + p := NewOp(OPT.Nassign, fctno, p, x) ELSE err(111) END ; p^.typ := OPT.notyp - |OPM.lenfn: (*LEN*) - IF ~(f IN OPM.intSet) OR (x^.class # OPM.Nconst) THEN err(69) + |OPT.lenfn: (*LEN*) + IF ~(f IN OPT.intSet) OR (x^.class # OPT.Nconst) THEN err(69) ELSIF x.typ.size = 1 THEN (* Hard limit of 127 dimensions *) L := SHORT(x^.conval^.intval); typ := p^.typ; - WHILE (L > 0) & (typ^.comp IN {OPM.DynArr, OPM.Array}) DO typ := typ^.BaseTyp; DEC(L) END ; - IF (L # 0) OR ~(typ^.comp IN {OPM.DynArr, OPM.Array}) THEN err(132) + WHILE (L > 0) & (typ^.comp IN {OPT.DynArr, OPT.Array}) DO typ := typ^.BaseTyp; DEC(L) END ; + IF (L # 0) OR ~(typ^.comp IN {OPT.DynArr, OPT.Array}) THEN err(132) ELSE x^.obj := NIL; - IF typ^.comp = OPM.DynArr THEN - WHILE p^.class = OPM.Nindex DO p := p^.left; INC(x^.conval^.intval) END ; (* possible side effect ignored *) - p := NewOp(OPM.Ndop, OPM.len, p, x); p^.typ := OPT.linttyp + IF typ^.comp = OPT.DynArr THEN + WHILE p^.class = OPT.Nindex DO p := p^.left; INC(x^.conval^.intval) END ; (* possible side effect ignored *) + p := NewOp(OPT.Ndop, OPT.len, p, x); p^.typ := OPT.linttyp ELSE p := x; p^.conval^.intval := typ^.n; SetIntType(p) END END ELSE err(132) END - |OPM.copyfn: (*COPY*) + |OPT.copyfn: (*COPY*) IF NotVar(x) THEN err(112) - ELSIF (x^.typ^.comp IN {OPM.Array, OPM.DynArr}) & (x^.typ^.BaseTyp^.form = OPM.Char) THEN + ELSIF (x^.typ^.comp IN {OPT.Array, OPT.DynArr}) & (x^.typ^.BaseTyp^.form = OPT.Char) THEN IF x^.readonly THEN err(76) END ; - t := x; x := p; p := t; p := NewOp(OPM.Nassign, OPM.copyfn, p, x) + t := x; x := p; p := t; p := NewOp(OPT.Nassign, OPT.copyfn, p, x) ELSE err(111) END ; p^.typ := OPT.notyp - |OPM.ashfn: (*ASH*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.intSet THEN - IF (p^.class = OPM.Nconst) & (x^.class = OPM.Nconst) THEN + |OPT.ashfn: (*ASH*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.intSet THEN + IF (p^.class = OPT.Nconst) & (x^.class = OPT.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 @@ -1191,89 +1191,89 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE p^.conval^.intval := ASH(p^.conval^.intval, x^.conval^.intval) END ; p^.obj := NIL - ELSE p := NewOp(OPM.Ndop, OPM.ash, p, x); p^.typ := OPT.linttyp + ELSE p := NewOp(OPT.Ndop, OPT.ash, p, x); p^.typ := OPT.linttyp END ELSE err(111) END - |OPM.newfn: (*NEW(p, x...)*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF p^.typ^.comp = OPM.DynArr THEN - IF f IN OPM.intSet THEN - IF (x^.class = OPM.Nconst) & ((x^.conval^.intval <= 0) OR (x^.conval^.intval > OPM.MaxIndex)) THEN err(63) END + |OPT.newfn: (*NEW(p, x...)*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF p^.typ^.comp = OPT.DynArr THEN + IF f IN OPT.intSet THEN + IF (x^.class = OPT.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 - |OPM.lshfn, - OPM.rotfn: (*SYSTEM.LSH, SYSTEM.ROT*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF ~(f IN OPM.intSet) THEN err(111) + |OPT.lshfn, + OPT.rotfn: (*SYSTEM.LSH, SYSTEM.ROT*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF ~(f IN OPT.intSet) THEN err(111) ELSE - IF fctno = OPM.lshfn THEN p := NewOp(OPM.Ndop, OPM.lsh, p, x) ELSE p := NewOp(OPM.Ndop, OPM.rot, p, x) END ; + IF fctno = OPT.lshfn THEN p := NewOp(OPT.Ndop, OPT.lsh, p, x) ELSE p := NewOp(OPT.Ndop, OPT.rot, p, x) END ; p^.typ := p^.left^.typ END - |OPM.getfn, - OPM.putfn, - OPM.getrfn, - OPM.putrfn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.GETREG, SYSTEM.PUTREG*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN {OPM.Undef..OPM.Set, OPM.Pointer, OPM.ProcTyp} THEN - IF (fctno = OPM.getfn) OR (fctno = OPM.getrfn) THEN + |OPT.getfn, + OPT.putfn, + OPT.getrfn, + OPT.putrfn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.GETREG, SYSTEM.PUTREG*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN {OPT.Undef..OPT.Set, OPT.Pointer, OPT.ProcTyp} THEN + IF (fctno = OPT.getfn) OR (fctno = OPT.getrfn) THEN IF NotVar(x) THEN err(112) END ; t := x; x := p; p := t END ; - p := NewOp(OPM.Nassign, fctno, p, x) + p := NewOp(OPT.Nassign, fctno, p, x) ELSE err(111) END ; p^.typ := OPT.notyp - |OPM.bitfn: (*SYSTEM.BIT*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.intSet THEN - p := NewOp(OPM.Ndop, OPM.bit, p, x) + |OPT.bitfn: (*SYSTEM.BIT*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.intSet THEN + p := NewOp(OPT.Ndop, OPT.bit, p, x) ELSE err(111) END ; p^.typ := OPT.booltyp - |OPM.valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *) - IF (x^.class = OPM.Ntype) - OR (x^.class = OPM.Nproc) - OR (f IN {OPM.Undef, OPM.String, OPM.NoTyp}) - OR (x^.typ^.comp = OPM.DynArr) THEN + |OPT.valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *) + IF (x^.class = OPT.Ntype) + OR (x^.class = OPT.Nproc) + OR (f IN {OPT.Undef, OPT.String, OPT.NoTyp}) + OR (x^.typ^.comp = OPT.DynArr) THEN err(126) END; (* Warn if the result type includes memory past the end of the source variable *) IF x.typ.size < p.typ.size THEN err(-308) END; - t := OPT.NewNode(OPM.Nmop); t^.subcl := OPM.val; t^.left := x; x := t; + t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t; (* - IF (x^.class >= OPM.Nconst) OR ((f IN OPM.realSet) # (p^.typ^.form IN OPM.realSet)) THEN - t := OPT.NewNode(OPM.Nmop); t^.subcl := val; t^.left := x; x := t + IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN + t := OPT.NewNode(OPT.Nmop); t^.subcl := val; t^.left := x; x := t ELSE x^.readonly := FALSE END ; *) x^.typ := p^.typ; p := x - |OPM.sysnewfn: (*SYSTEM.NEW*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.intSet THEN - p := NewOp(OPM.Nassign, OPM.sysnewfn, p, x) + |OPT.sysnewfn: (*SYSTEM.NEW*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.intSet THEN + p := NewOp(OPT.Nassign, OPT.sysnewfn, p, x) ELSE err(111) END ; p^.typ := OPT.notyp - |OPM.movefn: (*SYSTEM.MOVE*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF (x^.class = OPM.Nconst) & (f IN OPM.intSet) & (x.typ.size < OPT.linttyp.size) THEN Convert(x, OPT.linttyp) - ELSIF ~((x.typ.form IN {OPM.Pointer} + OPM.intSet) & (x.typ.size = OPM.PointerSize)) THEN err(111); x^.typ := OPT.linttyp + |OPT.movefn: (*SYSTEM.MOVE*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF (x^.class = OPT.Nconst) & (f IN OPT.intSet) & (x.typ.size < OPT.linttyp.size) THEN Convert(x, OPT.linttyp) + ELSIF ~((x.typ.form IN {OPT.Pointer} + OPT.intSet) & (x.typ.size = OPM.PointerSize)) THEN err(111); x^.typ := OPT.linttyp END; p^.link := x - |OPM.assertfn: (*ASSERT*) - IF (f IN OPM.intSet) & (x^.class = OPM.Nconst) THEN + |OPT.assertfn: (*ASSERT*) + IF (f IN OPT.intSet) & (x^.class = OPT.Nconst) THEN IF (OPM.MinHaltNr <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxHaltNr) THEN - BindNodes(OPM.Ntrap, OPT.notyp, x, x); + BindNodes(OPT.Ntrap, OPT.notyp, x, x); x^.conval := OPT.NewConst(); x^.conval^.intval := OPM.errpos; - Construct(OPM.Nif, p, x); p^.conval := OPT.NewConst(); p^.conval^.intval := OPM.errpos; - Construct(OPM.Nifelse, p, NIL); OptIf(p); + Construct(OPT.Nif, p, x); p^.conval := OPT.NewConst(); p^.conval^.intval := OPM.errpos; + Construct(OPT.Nifelse, p, NIL); OptIf(p); IF p = NIL THEN (* ASSERT(TRUE) *) - ELSIF p^.class = OPM.Ntrap THEN err(99) - ELSE p^.subcl := OPM.assertfn + ELSIF p^.class = OPT.Ntrap THEN err(99) + ELSE p^.subcl := OPT.assertfn END ELSE err(218) END @@ -1287,19 +1287,19 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) 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 = OPM.newfn THEN (*NEW(p, ..., x...*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF p^.typ^.comp # OPM.DynArr THEN err(64) - ELSIF f IN OPM.intSet THEN - IF (x^.class = OPM.Nconst) & ((x^.conval^.intval <= 0) OR (x^.conval^.intval > OPM.MaxIndex)) THEN err(63) END ; + IF fctno = OPT.newfn THEN (*NEW(p, ..., x...*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF p^.typ^.comp # OPT.DynArr THEN err(64) + ELSIF f IN OPT.intSet THEN + IF (x^.class = OPT.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 = OPM.movefn) & (n = 2) THEN (*SYSTEM.MOVE*) - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF f IN OPM.intSet THEN - node := OPT.NewNode(OPM.Nassign); node^.subcl := OPM.movefn; node^.right := p; + ELSIF (fctno = OPT.movefn) & (n = 2) THEN (*SYSTEM.MOVE*) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF f IN OPT.intSet THEN + node := OPT.NewNode(OPT.Nassign); node^.subcl := OPT.movefn; node^.right := p; node^.left := p^.link; p^.link := x; p := node ELSE err(111) END ; @@ -1312,41 +1312,41 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE StFct*(VAR par0: OPT.Node; fctno: SHORTINT; parno: INTEGER); VAR dim: INTEGER; x, p: OPT.Node; BEGIN p := par0; - IF fctno <= OPM.ashfn THEN - IF (fctno = OPM.newfn) & (p^.typ # OPT.notyp) THEN - IF p^.typ^.comp = OPM.DynArr THEN err(65) END ; + IF fctno <= OPT.ashfn THEN + IF (fctno = OPT.newfn) & (p^.typ # OPT.notyp) THEN + IF p^.typ^.comp = OPT.DynArr THEN err(65) END ; p^.typ := OPT.notyp - ELSIF fctno <= OPM.sizefn THEN (* 1 param *) + ELSIF fctno <= OPT.sizefn THEN (* 1 param *) IF parno < 1 THEN err(65) END ELSE (* more than 1 param *) - IF ((fctno = OPM.incfn) OR (fctno = OPM.decfn)) & (parno = 1) THEN (*INC, DEC*) - BindNodes(OPM.Nassign, OPT.notyp, p, NewIntConst(1)); p^.subcl := fctno; p^.right^.typ := p^.left^.typ - ELSIF (fctno = OPM.lenfn) & (parno = 1) THEN (*LEN*) - IF p^.typ^.comp = OPM.DynArr THEN dim := 0; - WHILE p^.class = OPM.Nindex DO p := p^.left; INC(dim) END ; (* possible side effect ignored *) - BindNodes(OPM.Ndop, OPT.linttyp, p, NewIntConst(dim)); p^.subcl := OPM.len + IF ((fctno = OPT.incfn) OR (fctno = OPT.decfn)) & (parno = 1) THEN (*INC, DEC*) + BindNodes(OPT.Nassign, OPT.notyp, p, NewIntConst(1)); p^.subcl := fctno; p^.right^.typ := p^.left^.typ + ELSIF (fctno = OPT.lenfn) & (parno = 1) THEN (*LEN*) + IF p^.typ^.comp = OPT.DynArr THEN dim := 0; + WHILE p^.class = OPT.Nindex DO p := p^.left; INC(dim) END ; (* possible side effect ignored *) + BindNodes(OPT.Ndop, OPT.linttyp, p, NewIntConst(dim)); p^.subcl := OPT.len ELSE p := NewIntConst(p^.typ^.n) END ELSIF parno < 2 THEN err(65) END END - ELSIF fctno = OPM.assertfn THEN + ELSIF fctno = OPT.assertfn THEN IF parno = 1 THEN x := NIL; - BindNodes(OPM.Ntrap, OPT.notyp, x, NewIntConst(AssertTrap)); + BindNodes(OPT.Ntrap, OPT.notyp, x, NewIntConst(AssertTrap)); x^.conval := OPT.NewConst(); x^.conval^.intval := OPM.errpos; - Construct(OPM.Nif, p, x); p^.conval := OPT.NewConst(); p^.conval^.intval := OPM.errpos; - Construct(OPM.Nifelse, p, NIL); OptIf(p); + Construct(OPT.Nif, p, x); p^.conval := OPT.NewConst(); p^.conval^.intval := OPM.errpos; + Construct(OPT.Nifelse, p, NIL); OptIf(p); IF p = NIL THEN (* ASSERT(TRUE) *) - ELSIF p^.class = OPM.Ntrap THEN err(99) - ELSE p^.subcl := OPM.assertfn + ELSIF p^.class = OPT.Ntrap THEN err(99) + ELSE p^.subcl := OPT.assertfn END ELSIF parno < 1 THEN err(65) END ELSE (*SYSTEM*) IF (parno < 1) OR - (fctno > OPM.ccfn) & (parno < 2) OR - (fctno = OPM.movefn) & (parno < 3) THEN err(65) + (fctno > OPT.ccfn) & (parno < 2) OR + (fctno = OPT.movefn) & (parno < 3) THEN err(65) END END ; par0 := p @@ -1354,18 +1354,18 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE DynArrParCheck(ftyp, atyp: OPT.Struct; fvarpar: BOOLEAN); VAR f: INTEGER; - BEGIN (* ftyp^.comp = OPM.DynArr *) + BEGIN (* ftyp^.comp = OPT.DynArr *) f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp; IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *) - IF ~(f IN {OPM.Array, OPM.DynArr}) OR ~((atyp.form IN {OPM.Byte..OPM.Char} + OPM.intSet) & (atyp.size = 1)) THEN + IF ~(f IN {OPT.Array, OPT.DynArr}) OR ~((atyp.form IN {OPT.Byte..OPT.Char} + OPT.intSet) & (atyp.size = 1)) THEN IF OPM.verbose IN OPM.opt THEN err(-301) END END - ELSIF f IN {OPM.Array, OPM.DynArr} THEN - IF ftyp^.comp = OPM.DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar) + ELSIF f IN {OPT.Array, OPT.DynArr} THEN + IF ftyp^.comp = OPT.DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar) ELSIF ftyp # atyp THEN - IF ~fvarpar & (ftyp.form = OPM.Pointer) & (atyp.form = OPM.Pointer) THEN + IF ~fvarpar & (ftyp.form = OPT.Pointer) & (atyp.form = OPT.Pointer) THEN ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp; - IF (ftyp^.comp = OPM.Record) & (atyp^.comp = OPM.Record) THEN + IF (ftyp^.comp = OPT.Record) & (atyp^.comp = OPT.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) @@ -1379,17 +1379,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE CheckReceiver(VAR x: OPT.Node; fp: OPT.Object); BEGIN - IF fp^.typ^.form = OPM.Pointer THEN - IF x^.class = OPM.Nderef THEN x := x^.left (*undo DeRef*) ELSE (*x^.typ^.comp = OPM.Record*) err(71) END + IF fp^.typ^.form = OPT.Pointer THEN + IF x^.class = OPT.Nderef THEN x := x^.left (*undo DeRef*) ELSE (*x^.typ^.comp = OPT.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 {OPM.LProc, OPM.XProc, OPM.TProc, OPM.CProc}) THEN + IF (x^.obj # NIL) & (x^.obj^.mode IN {OPT.LProc, OPT.XProc, OPT.TProc, OPT.CProc}) THEN fpar := x^.obj^.link; - IF x^.obj^.mode = OPM.TProc THEN CheckReceiver(x^.left, fpar); fpar := fpar^.link END - ELSIF (x^.class # OPM.Ntype) & (x^.typ # NIL) & (x^.typ^.form = OPM.ProcTyp) THEN + IF x^.obj^.mode = OPT.TProc THEN CheckReceiver(x^.left, fpar); fpar := fpar^.link END + ELSIF (x^.class # OPT.Ntype) & (x^.typ # NIL) & (x^.typ^.form = OPT.ProcTyp) THEN fpar := x^.typ^.link ELSE err(121); fpar := NIL; x^.typ := OPT.undftyp END @@ -1398,25 +1398,25 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE Param*(ap: OPT.Node; fp: OPT.Object); VAR q: OPT.Struct; BEGIN - IF fp.typ.form # OPM.Undef THEN - IF fp^.mode = OPM.VarPar THEN + IF fp.typ.form # OPT.Undef THEN + IF fp^.mode = OPT.VarPar THEN IF NotVar(ap) THEN err(122) ELSE CheckLeaf(ap, FALSE) END ; IF ap^.readonly THEN err(76) END ; - IF fp^.typ^.comp = OPM.DynArr THEN DynArrParCheck(fp^.typ, ap^.typ, TRUE) - ELSIF (fp^.typ^.comp = OPM.Record) & (ap^.typ^.comp = OPM.Record) THEN + IF fp^.typ^.comp = OPT.DynArr THEN DynArrParCheck(fp^.typ, ap^.typ, TRUE) + ELSIF (fp^.typ^.comp = OPT.Record) & (ap^.typ^.comp = OPT.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 = OPM.Pointer) THEN (* ok *) - ELSIF (ap^.typ # fp^.typ) & ~((fp^.typ^.form = OPM.Byte) & ((ap.typ.form IN {OPM.Byte..OPM.Char} + OPM.intSet) & (ap.typ.size = 1))) THEN err(123) - ELSIF (fp^.typ^.form = OPM.Pointer) & (ap^.class = OPM.Nguard) THEN err(123) + ELSIF (fp^.typ = OPT.sysptrtyp) & (ap^.typ^.form = OPT.Pointer) THEN (* ok *) + ELSIF (ap^.typ # fp^.typ) & ~((fp^.typ^.form = OPT.Byte) & ((ap.typ.form IN {OPT.Byte..OPT.Char} + OPT.intSet) & (ap.typ.size = 1))) THEN err(123) + ELSIF (fp^.typ^.form = OPT.Pointer) & (ap^.class = OPT.Nguard) THEN err(123) END - ELSIF fp^.typ^.comp = OPM.DynArr THEN - IF (ap^.class = OPM.Nconst) & (ap^.typ^.form = OPM.Char) THEN CharToString(ap) END ; - IF (ap^.typ^.form = OPM.String) & (fp^.typ^.BaseTyp^.form = OPM.Char) THEN (* ok *) - ELSIF ap^.class >= OPM.Nconst THEN err(59) + ELSIF fp^.typ^.comp = OPT.DynArr THEN + IF (ap^.class = OPT.Nconst) & (ap^.typ^.form = OPT.Char) THEN CharToString(ap) END ; + IF (ap^.typ^.form = OPT.String) & (fp^.typ^.BaseTyp^.form = OPT.Char) THEN (* ok *) + ELSIF ap^.class >= OPT.Nconst THEN err(59) ELSE DynArrParCheck(fp^.typ, ap^.typ, FALSE) END ELSE CheckAssign(fp^.typ, ap) @@ -1429,7 +1429,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) BEGIN scope := OPT.topScope; WHILE dlev > 0 DO DEC(dlev); - INCL(scope^.link^.conval^.setval, OPM.slNeeded); + INCL(scope^.link^.conval^.setval, OPT.slNeeded); scope := scope^.left END END StaticLink; @@ -1437,21 +1437,21 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) 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 = OPM.Nproc THEN typ := x^.typ; + IF x^.class = OPT.Nproc THEN typ := x^.typ; lev := x^.obj^.mnolev; IF lev > 0 THEN StaticLink(OPT.topScope^.mnolev-lev) END ; - IF x^.obj^.mode = OPM.IProc THEN err(121) END - ELSIF (x^.class = OPM.Nfield) & (x^.obj^.mode = OPM.TProc) THEN typ := x^.typ; - x^.class := OPM.Nproc; p := x^.left; x^.left := NIL; p^.link := apar; apar := p; fp := x^.obj^.link + IF x^.obj^.mode = OPT.IProc THEN err(121) END + ELSIF (x^.class = OPT.Nfield) & (x^.obj^.mode = OPT.TProc) THEN typ := x^.typ; + x^.class := OPT.Nproc; p := x^.left; x^.left := NIL; p^.link := apar; apar := p; fp := x^.obj^.link ELSE typ := x^.typ^.BaseTyp END ; - BindNodes(OPM.Ncall, typ, x, apar); x^.obj := fp + BindNodes(OPT.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(OPM.Nenter); x^.typ := OPT.notyp; x^.obj := proc; + x := OPT.NewNode(OPT.Nenter); x^.typ := OPT.notyp; x^.obj := proc; x^.left := procdec; x^.right := stat; procdec := x END Enter; @@ -1465,42 +1465,42 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF proc^.typ # OPT.notyp THEN err(124) END END ; - node := OPT.NewNode(OPM.Nreturn); node^.typ := OPT.notyp; node^.obj := proc; node^.left := x; x := node + node := OPT.NewNode(OPT.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; subcl: SHORTINT; BEGIN - IF x^.class >= OPM.Nconst THEN err(56) END ; + IF x^.class >= OPT.Nconst THEN err(56) END ; CheckAssign(x^.typ, y); IF x^.readonly THEN err(76) END ; - IF x^.typ^.comp = OPM.Record THEN - IF x^.class = OPM.Nguard THEN z := x^.left ELSE z := x END ; - IF (z^.class = OPM.Nderef) & (z^.left^.class = OPM.Nguard) THEN + IF x^.typ^.comp = OPT.Record THEN + IF x^.class = OPT.Nguard THEN z := x^.left ELSE z := x END ; + IF (z^.class = OPT.Nderef) & (z^.left^.class = OPT.Nguard) THEN z^.left := z^.left^.left (* skip guard before dereferencing *) END ; - IF (x^.typ^.strobj # NIL) & ((z^.class = OPM.Nderef) OR (z^.class = OPM.Nvarpar)) THEN - BindNodes(OPM.Neguard, x^.typ, z, NIL); x := z + IF (x^.typ^.strobj # NIL) & ((z^.class = OPT.Nderef) OR (z^.class = OPT.Nvarpar)) THEN + BindNodes(OPT.Neguard, x^.typ, z, NIL); x := z END - ELSIF (x^.typ^.comp = OPM.Array) & (x^.typ^.BaseTyp = OPT.chartyp) & - (y^.typ^.form = OPM.String) & (y^.conval^.intval2 = 1) THEN (* replace array := "" with array[0] := 0X *) + ELSIF (x^.typ^.comp = OPT.Array) & (x^.typ^.BaseTyp = OPT.chartyp) & + (y^.typ^.form = OPT.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 ; - IF (x.typ.comp IN {OPM.Array, OPM.DynArr}) & (x.typ.BaseTyp = OPT.chartyp) - & (y.typ.comp IN {OPM.Array, OPM.DynArr}) & (y.typ.BaseTyp = OPT.chartyp) THEN - subcl := OPM.copyfn + IF (x.typ.comp IN {OPT.Array, OPT.DynArr}) & (x.typ.BaseTyp = OPT.chartyp) + & (y.typ.comp IN {OPT.Array, OPT.DynArr}) & (y.typ.BaseTyp = OPT.chartyp) THEN + subcl := OPT.copyfn ELSE - subcl := OPM.assign + subcl := OPT.assign END; - BindNodes(OPM.Nassign, OPT.notyp, x, y); + BindNodes(OPT.Nassign, OPT.notyp, x, y); x^.subcl := subcl; END Assign; PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct); VAR node: OPT.Node; BEGIN - node := OPT.NewNode(OPM.Ninittd); node^.typ := typ; + node := OPT.NewNode(OPT.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 diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod index ee492515..5e45a626 100644 --- a/src/compiler/OPC.Mod +++ b/src/compiler/OPC.Mod @@ -111,15 +111,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) VAR mode, level, h: INTEGER; BEGIN mode := obj^.mode; level := obj^.mnolev; - IF (mode IN {OPM.Var, OPM.Typ, OPM.LProc}) & (level > 0) OR (mode IN {OPM.Fld, OPM.VarPar}) THEN + IF (mode IN {OPT.Var, OPT.Typ, OPT.LProc}) & (level > 0) OR (mode IN {OPT.Fld, OPT.VarPar}) THEN OPM.WriteStringVar(obj^.name); h := PerfectHash(obj^.name); IF hashtab[h] >= 0 THEN IF keytab[hashtab[h]] = obj^.name THEN OPM.Write('_') END END ELSE - IF (mode # OPM.Typ) OR (obj^.linkadr # PredefinedType) THEN - IF mode = OPM.TProc THEN Ident(obj^.link^.typ^.strobj) + IF (mode # OPT.Typ) OR (obj^.linkadr # PredefinedType) THEN + IF mode = OPT.TProc THEN Ident(obj^.link^.typ^.strobj) ELSIF level < 0 THEN (* use unaliased module name *) OPM.WriteStringVar(OPT.GlbMod[-level].name); IF OPM.currFile = OPM.HeaderFile THEN OPT.GlbMod[-level].vis := 1 (*include in header file*) END ; @@ -138,21 +138,21 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) VAR pointers: INTEGER; BEGIN openClause := FALSE; - IF ((typ^.strobj = NIL) OR (typ^.strobj^.name = "")) & (typ^.comp # OPM.Record) THEN - IF typ^.comp IN {OPM.Array, OPM.DynArr} THEN + IF ((typ^.strobj = NIL) OR (typ^.strobj^.name = "")) & (typ^.comp # OPT.Record) THEN + IF typ^.comp IN {OPT.Array, OPT.DynArr} THEN Stars (typ^.BaseTyp, openClause); - openClause := (typ^.comp = OPM.Array) - ELSIF typ^.form = OPM.ProcTyp THEN + openClause := (typ^.comp = OPT.Array) + ELSIF typ^.form = OPT.ProcTyp THEN OPM.Write('('); OPM.Write('*') ELSE pointers := 0; - (*WHILE (typ^.strobj = NIL) & (typ^.form = OPM.Pointer) DO INC (pointers); typ := typ^.BaseTyp END ; - IF (typ^.comp # OPM.DynArr) & (pointers # 0) THEN Stars (typ, openClause) END ;*) - WHILE ((typ^.strobj = NIL) OR (typ^.strobj^.name = "")) & (typ^.form = OPM.Pointer) DO + (*WHILE (typ^.strobj = NIL) & (typ^.form = OPT.Pointer) DO INC (pointers); typ := typ^.BaseTyp END ; + IF (typ^.comp # OPT.DynArr) & (pointers # 0) THEN Stars (typ, openClause) END ;*) + WHILE ((typ^.strobj = NIL) OR (typ^.strobj^.name = "")) & (typ^.form = OPT.Pointer) DO INC (pointers); typ := typ^.BaseTyp END ; IF pointers > 0 THEN - IF typ^.comp # OPM.DynArr THEN Stars (typ, openClause) END ; + IF typ^.comp # OPT.DynArr THEN Stars (typ, openClause) END ; IF openClause THEN OPM.Write('('); openClause := FALSE END ; WHILE pointers > 0 DO OPM.Write('*'); DEC (pointers) END END @@ -168,7 +168,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) varPar, openClause: BOOLEAN; form, comp: INTEGER; BEGIN typ := dcl^.typ; - varPar := ((dcl^.mode = OPM.VarPar) & (typ^.comp # OPM.Array)) OR (typ^.comp = OPM.DynArr) OR scopeDef; + varPar := ((dcl^.mode = OPT.VarPar) & (typ^.comp # OPT.Array)) OR (typ^.comp = OPT.DynArr) OR scopeDef; Stars(typ, openClause); IF varPar THEN IF openClause THEN OPM.Write('(') END ; @@ -180,17 +180,17 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) LOOP form := typ^.form; comp := typ^.comp; - IF ((typ^.strobj # NIL) & (typ^.strobj^.name # "")) OR (form = OPM.NoTyp) OR (comp = OPM.Record) THEN EXIT - ELSIF (form = OPM.Pointer) & (typ^.BaseTyp^.comp # OPM.DynArr) THEN + IF ((typ^.strobj # NIL) & (typ^.strobj^.name # "")) OR (form = OPT.NoTyp) OR (comp = OPT.Record) THEN EXIT + ELSIF (form = OPT.Pointer) & (typ^.BaseTyp^.comp # OPT.DynArr) THEN openClause := TRUE - ELSIF (form = OPM.ProcTyp) OR (comp IN {OPM.Array, OPM.DynArr}) THEN + ELSIF (form = OPT.ProcTyp) OR (comp IN {OPT.Array, OPT.DynArr}) THEN IF openClause THEN OPM.Write(')'); openClause := FALSE END ; - IF form = OPM.ProcTyp THEN + IF form = OPT.ProcTyp THEN IF ansi THEN OPM.Write(")"); AnsiParamList(typ^.link, FALSE) ELSE OPM.WriteString(")()") END ; EXIT - ELSIF comp = OPM.Array THEN + ELSIF comp = OPT.Array THEN OPM.Write('['); OPM.WriteInt(typ^.n); OPM.Write(']') END ELSE @@ -224,35 +224,35 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) VAR typ, prev: OPT.Struct; obj: OPT.Object; nofdims: INTEGER; off, n, dummy: LONGINT; BEGIN typ := dcl^.typ; prev := typ; - WHILE ((typ^.strobj = NIL) OR (typ^.comp = OPM.DynArr) OR Undefined(typ^.strobj)) - & (typ^.comp # OPM.Record) - & (typ^.form # OPM.NoTyp) - & ~((typ^.form = OPM.Pointer) & (typ^.BaseTyp^.comp = OPM.DynArr)) DO + WHILE ((typ^.strobj = NIL) OR (typ^.comp = OPT.DynArr) OR Undefined(typ^.strobj)) + & (typ^.comp # OPT.Record) + & (typ^.form # OPT.NoTyp) + & ~((typ^.form = OPT.Pointer) & (typ^.BaseTyp^.comp = OPT.DynArr)) DO prev := typ; typ := typ^.BaseTyp; END ; obj := typ^.strobj; - IF typ^.form = OPM.NoTyp THEN (* proper procedure *) + IF typ^.form = OPT.NoTyp THEN (* proper procedure *) OPM.WriteString('void') ELSIF (obj # NIL) & ~Undefined(obj) THEN (* named type, already declared *) Ident(obj) - ELSIF typ^.comp = OPM.Record THEN + ELSIF typ^.comp = OPT.Record THEN OPM.WriteString('struct '); Andent(typ); - IF (prev.form # OPM.Pointer) & ((obj # NIL) OR (dcl.name = "")) THEN + IF (prev.form # OPT.Pointer) & ((obj # NIL) OR (dcl.name = "")) THEN (* named record type not yet declared OR anonymous record with empty name *) - IF (typ^.BaseTyp # NIL) & (typ^.BaseTyp^.strobj.vis # OPM.internal) THEN + IF (typ^.BaseTyp # NIL) & (typ^.BaseTyp^.strobj.vis # OPT.internal) THEN OPM.WriteString(" { /* "); Ident(typ^.BaseTyp^.strobj); OPM.WriteString(" */"); OPM.WriteLn; Indent(1) ELSE OPM.Write(' '); BegBlk END ; FieldList(typ, TRUE, off, n, dummy); EndBlk0 END - ELSIF (typ^.form = OPM.Pointer) & (typ^.BaseTyp^.comp = OPM.DynArr) THEN + ELSIF (typ^.form = OPT.Pointer) & (typ^.BaseTyp^.comp = OPT.DynArr) THEN typ := typ^.BaseTyp^.BaseTyp; nofdims := 1; - WHILE typ^.comp = OPM.DynArr DO INC(nofdims); typ := typ^.BaseTyp END ; + WHILE typ^.comp = OPT.DynArr DO INC(nofdims); typ := typ^.BaseTyp END ; OPM.WriteString('struct '); BegBlk; BegStat; Str1("LONGINT len[#]", nofdims); EndStat; BegStat; NEW(obj); NEW(obj.typ); (* aux. object for easy declaration *) - obj.typ.form := OPM.Comp; obj.typ.comp := OPM.Array; obj.typ.n := 1; obj.typ.BaseTyp := typ; obj.mode := OPM.Fld; obj.name := "data"; + obj.typ.form := OPT.Comp; obj.typ.comp := OPT.Array; obj.typ.n := 1; obj.typ.BaseTyp := typ; obj.mode := OPT.Fld; obj.name := "data"; obj.linkadr := UndefinedType; DeclareBase(obj); OPM.Write(' '); DeclareObj(obj, FALSE); EndStat; EndBlk0 END @@ -261,21 +261,21 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE NofPtrs* (typ: OPT.Struct): LONGINT; VAR fld: OPT.Object; btyp: OPT.Struct; n: LONGINT; BEGIN - IF (typ^.form = OPM.Pointer) & (typ^.sysflag = 0) THEN RETURN 1 - ELSIF (typ^.comp = OPM.Record) & (typ^.sysflag MOD 100H = 0) THEN + IF (typ^.form = OPT.Pointer) & (typ^.sysflag = 0) THEN RETURN 1 + ELSIF (typ^.comp = OPT.Record) & (typ^.sysflag MOD 100H = 0) THEN btyp := typ^.BaseTyp; IF btyp # NIL THEN n := NofPtrs(btyp) ELSE n := 0 END ; fld := typ^.link; - WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO + WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO IF fld^.name # OPM.HdPtrName THEN n := n + NofPtrs(fld^.typ) ELSE INC(n) END ; fld := fld^.link END ; RETURN n - ELSIF typ^.comp = OPM.Array THEN + ELSIF typ^.comp = OPT.Array THEN btyp := typ^.BaseTyp; n := typ^.n; - WHILE btyp^.comp = OPM.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; + WHILE btyp^.comp = OPT.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; RETURN NofPtrs(btyp) * n ELSE RETURN 0 END @@ -284,14 +284,14 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE PutPtrOffsets (typ: OPT.Struct; adr: LONGINT; VAR cnt: LONGINT); VAR fld: OPT.Object; btyp: OPT.Struct; n, i: LONGINT; BEGIN - IF (typ^.form = OPM.Pointer) & (typ^.sysflag = 0) THEN + IF (typ^.form = OPT.Pointer) & (typ^.sysflag = 0) THEN OPM.WriteInt(adr); OPM.WriteString(", "); INC(cnt); IF cnt MOD 16 = 0 THEN OPM.WriteLn; OPM.Write(Tab) END - ELSIF (typ^.comp = OPM.Record) & (typ^.sysflag MOD 100H = 0) THEN + ELSIF (typ^.comp = OPT.Record) & (typ^.sysflag MOD 100H = 0) THEN btyp := typ^.BaseTyp; IF btyp # NIL THEN PutPtrOffsets(btyp, adr, cnt) END ; fld := typ^.link; - WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO + WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO IF fld^.name # OPM.HdPtrName THEN PutPtrOffsets(fld^.typ, adr + fld^.adr, cnt) ELSE OPM.WriteInt(adr + fld^.adr); OPM.WriteString(", "); INC(cnt); @@ -299,9 +299,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END ; fld := fld^.link END - ELSIF typ^.comp = OPM.Array THEN + ELSIF typ^.comp = OPT.Array THEN btyp := typ^.BaseTyp; n := typ^.n; - WHILE btyp^.comp = OPM.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; + WHILE btyp^.comp = OPT.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; IF NofPtrs(btyp) > 0 THEN i := 0; WHILE i < n DO PutPtrOffsets(btyp, adr + i * btyp^.size, cnt); INC(i) END END @@ -312,7 +312,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN InitTProcs(typ, obj^.left); - IF obj^.mode = OPM.TProc THEN + IF obj^.mode = OPT.TProc THEN BegStat; OPM.WriteString("__INITBP("); Ident(typ); OPM.WriteString(', '); Ident(obj); @@ -336,7 +336,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF showParamName THEN Ident(par); OPM.WriteString(LenExt) END ; dim := 1; typ := par^.typ^.BaseTyp; - WHILE typ^.comp = OPM.DynArr DO + WHILE typ^.comp = OPT.DynArr DO IF ansiDefine THEN OPM.WriteString(", LONGINT ") ELSE OPM.WriteString(', ') END ; IF showParamName THEN Ident(par); OPM.WriteString(LenExt); OPM.WriteInt(dim) END ; typ := typ^.BaseTyp; INC(dim) @@ -349,12 +349,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) WHILE par # NIL DO IF macro THEN OPM.WriteStringVar(par.name) ELSE - IF (par^.mode = OPM.Var) & (par^.typ^.form = OPM.Real) THEN OPM.Write("_") END ; + IF (par^.mode = OPT.Var) & (par^.typ^.form = OPT.Real) THEN OPM.Write("_") END ; Ident(par) END ; - IF par^.typ^.comp = OPM.DynArr THEN + IF par^.typ^.comp = OPT.DynArr THEN OPM.WriteString(', '); LenList(par, FALSE, TRUE); - ELSIF (par^.mode = OPM.VarPar) & (par^.typ^.comp = OPM.Record) THEN + ELSIF (par^.mode = OPT.VarPar) & (par^.typ^.comp = OPT.Record) THEN OPM.WriteString(', '); OPM.WriteStringVar(par.name); OPM.WriteString(TagExt) END ; par := par^.link; @@ -366,7 +366,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE ^DefineType(str: OPT.Struct); PROCEDURE ^ProcHeader(proc: OPT.Object; define: BOOLEAN); - PROCEDURE DefineTProcTypes(obj: OPT.Object); (* define all types that are used in a OPM.TProc definition *) + PROCEDURE DefineTProcTypes(obj: OPT.Object); (* define all types that are used in a OPT.TProc definition *) VAR par: OPT.Object; BEGIN IF obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ; @@ -379,17 +379,17 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN DeclareTProcs(obj^.left, empty); - IF obj^.mode = OPM.TProc THEN + IF obj^.mode = OPT.TProc THEN IF obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ; IF OPM.currFile = OPM.HeaderFile THEN - IF obj^.vis = OPM.external THEN + IF obj^.vis = OPT.external THEN DefineTProcTypes(obj); OPM.WriteString(Extern); empty := FALSE; ProcHeader(obj, FALSE) END ELSE empty := FALSE; DefineTProcTypes(obj); - IF obj^.vis = OPM.internal THEN OPM.WriteString('static ') + IF obj^.vis = OPT.internal THEN OPM.WriteString('static ') ELSE OPM.WriteString(Export) END ; ProcHeader(obj, FALSE) @@ -402,7 +402,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE BaseTProc*(obj: OPT.Object): OPT.Object; VAR typ, base: OPT.Struct; mno: LONGINT; BEGIN typ := obj^.link^.typ; (* receiver type *) - IF typ^.form = OPM.Pointer THEN typ := typ^.BaseTyp END ; + IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ; base := typ^.BaseTyp; mno := obj^.adr DIV 10000H; WHILE (base # NIL) & (mno < base^.n) DO typ := base; base := typ^.BaseTyp END ; OPT.FindField(obj^.name, typ, obj); @@ -413,12 +413,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN DefineTProcMacros(obj^.left, empty); - IF (obj^.mode = OPM.TProc) & (obj = BaseTProc(obj)) & ((OPM.currFile # OPM.HeaderFile) OR (obj^.vis = OPM.external)) THEN + IF (obj^.mode = OPT.TProc) & (obj = BaseTProc(obj)) & ((OPM.currFile # OPM.HeaderFile) OR (obj^.vis = OPT.external)) THEN OPM.WriteString("#define __"); Ident(obj); DeclareParams(obj^.link, TRUE); OPM.WriteString(" __SEND("); - IF obj^.link^.typ^.form = OPM.Pointer THEN + IF obj^.link^.typ^.form = OPT.Pointer THEN OPM.WriteString("__TYPEOF("); Ident(obj^.link); OPM.Write(")") ELSE Ident(obj^.link); OPM.WriteString(TagExt) END ; @@ -446,23 +446,23 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF (obj = NIL) OR Undefined(obj) THEN IF obj # NIL THEN (* check for cycles *) IF obj^.linkadr = ProcessingType THEN - IF str^.form # OPM.Pointer THEN OPM.Mark(244, str^.txtpos); obj^.linkadr := PredefinedType END + IF str^.form # OPT.Pointer THEN OPM.Mark(244, str^.txtpos); obj^.linkadr := PredefinedType END ELSE obj^.linkadr := ProcessingType END END ; - IF str^.comp = OPM.Record THEN + IF str^.comp = OPT.Record THEN (* the following exports the base type of an exported type even if the former is non-exported *) IF str^.BaseTyp # NIL THEN DefineType(str^.BaseTyp) END ; field := str^.link; - WHILE (field # NIL) & (field^.mode = OPM.Fld) DO - IF (field^.vis # OPM.internal) OR (OPM.currFile = OPM.BodyFile) THEN DefineType(field^.typ) END ; + WHILE (field # NIL) & (field^.mode = OPT.Fld) DO + IF (field^.vis # OPT.internal) OR (OPM.currFile = OPM.BodyFile) THEN DefineType(field^.typ) END ; field := field^.link END - ELSIF str^.form = OPM.Pointer THEN - IF str^.BaseTyp^.comp # OPM.Record THEN DefineType(str^.BaseTyp) END - ELSIF str^.comp IN {OPM.Array, OPM.DynArr} THEN + ELSIF str^.form = OPT.Pointer THEN + IF str^.BaseTyp^.comp # OPT.Record THEN DefineType(str^.BaseTyp) END + ELSIF str^.comp IN {OPT.Array, OPT.DynArr} THEN DefineType(str^.BaseTyp) - ELSIF str^.form = OPM.ProcTyp THEN + ELSIF str^.form = OPT.ProcTyp THEN IF str^.BaseTyp # OPT.notyp THEN DefineType(str^.BaseTyp) END ; field := str^.link; WHILE field # NIL DO DefineType(field^.typ); field := field^.link END @@ -477,7 +477,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) obj^.typ^.strobj := obj; (* SG: revert trick *) obj^.linkadr := 3+OPM.currFile; EndStat; Indent(-1); OPM.WriteLn; - IF obj^.typ^.comp = OPM.Record THEN empty := TRUE; + IF obj^.typ^.comp = OPT.Record THEN empty := TRUE; DeclareTProcs(str^.link, empty); DefineTProcMacros(str^.link, empty); IF ~empty THEN OPM.WriteLn END END @@ -499,7 +499,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF obj # NIL THEN CProcDefs(obj^.left, vis); (* bug: obj.history cannot be used to cover unexported and deleted CProcs; use special flag obj.adr = 1 *) - IF (obj^.mode = OPM.CProc) & (obj^.vis >= vis) & (obj^.adr = 1) THEN + IF (obj^.mode = OPT.CProc) & (obj^.vis >= vis) & (obj^.adr = 1) THEN ext := obj.conval.ext; i := 1; IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN OPM.WriteString("#define "); Ident(obj); @@ -518,7 +518,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF obj # NIL THEN TypeDefs(obj^.left, vis); (* test typ.txtpos to skip types that have been unexported; obj.history # removed is not enough!*) - IF (obj^.mode = OPM.Typ) & (obj^.typ^.txtpos > 0) THEN DefineType(obj^.typ) END ; + IF (obj^.mode = OPT.Typ) & (obj^.typ^.txtpos > 0) THEN DefineType(obj^.typ) END ; TypeDefs(obj^.right, vis) END END TypeDefs; @@ -526,7 +526,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE DefAnonRecs(n: OPT.Node); VAR o: OPT.Object; typ: OPT.Struct; BEGIN - WHILE (n # NIL) & (n^.class = OPM.Ninittd) DO + WHILE (n # NIL) & (n^.class = OPT.Ninittd) DO typ := n^.typ; IF (typ^.strobj = NIL) & ((OPM.currFile = OPM.BodyFile) OR (typ.ref < OPM.MaxStruct)) THEN DefineType(typ); (* declare base and field types, if any *) @@ -589,8 +589,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE BaseAlignment*(typ: OPT.Struct): LONGINT; VAR alignment: LONGINT; BEGIN - IF typ.form = OPM.Comp THEN - IF typ.comp = OPM.Record THEN + IF typ.form = OPT.Comp THEN + IF typ.comp = OPT.Record THEN alignment := typ.align MOD 10000H ELSE alignment := BaseAlignment(typ.BaseTyp) @@ -626,11 +626,11 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF typ.BaseTyp # NIL THEN FieldList(typ.BaseTyp, FALSE, off, n, curAlign) ELSE off := 0; n := 0; curAlign := 1 END ; - WHILE (fld # NIL) & (fld.mode = OPM.Fld) DO - IF (OPM.currFile = OPM.HeaderFile) & (fld.vis = OPM.internal) OR - (OPM.currFile = OPM.BodyFile) & (fld.vis = OPM.internal) & (typ^.mno # 0) THEN + WHILE (fld # NIL) & (fld.mode = OPT.Fld) DO + IF (OPM.currFile = OPM.HeaderFile) & (fld.vis = OPT.internal) OR + (OPM.currFile = OPM.BodyFile) & (fld.vis = OPT.internal) & (typ^.mno # 0) THEN fld := fld.link; - WHILE (fld # NIL) & (fld.mode = OPM.Fld) & (fld.vis = OPM.internal) DO fld := fld.link END ; + WHILE (fld # NIL) & (fld.mode = OPT.Fld) & (fld.vis = OPT.internal) DO fld := fld.link END ; ELSE (* mimic OPV.TypSize to detect gaps caused by private fields *) adr := off; fldAlign := BaseAlignment(fld^.typ); Align(adr, fldAlign); @@ -639,8 +639,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF gap > 0 THEN FillGap(gap, off, align, n, curAlign) END ; BegStat; DeclareBase(fld); OPM.Write(' '); DeclareObj(fld, FALSE); off := fld.adr + fld.typ.size; base := fld.typ; fld := fld.link; - WHILE (fld # NIL) & (fld.mode = OPM.Fld) & (fld.typ = base) & (fld.adr = off) -(* ?? *) & ((OPM.currFile = OPM.BodyFile) OR (fld.vis # OPM.internal) OR (fld.typ.strobj = NIL)) DO + WHILE (fld # NIL) & (fld.mode = OPT.Fld) & (fld.typ = base) & (fld.adr = off) +(* ?? *) & ((OPM.currFile = OPM.BodyFile) OR (fld.vis # OPT.internal) OR (fld.typ.strobj = NIL)) DO OPM.WriteString(", "); DeclareObj(fld, FALSE); off := fld.adr + fld.typ.size; fld := fld.link END ; EndStat @@ -658,36 +658,36 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) VAR base: OPT.Struct; first: BOOLEAN; lastvis: INTEGER; BEGIN base := NIL; first := TRUE; - WHILE (obj # NIL) & (obj^.mode # OPM.TProc) DO + WHILE (obj # NIL) & (obj^.mode # OPT.TProc) DO IF (vis IN {0, 2}) OR ((vis = 1) & (obj^.vis # 0)) OR ((vis = 3) & ~obj^.leaf) THEN IF (obj^.typ # base) OR (obj^.vis # lastvis) THEN (* new variable base type definition required *) IF ~first THEN EndStat END ; first := FALSE; base := obj^.typ; lastvis := obj^.vis; BegStat; - IF (vis = 1) & (obj^.vis # OPM.internal) THEN OPM.WriteString(Extern) + IF (vis = 1) & (obj^.vis # OPT.internal) THEN OPM.WriteString(Extern) ELSIF (obj^.mnolev = 0) & (vis = 0) THEN - IF obj^.vis = OPM.internal THEN OPM.WriteString('static ') + IF obj^.vis = OPT.internal THEN OPM.WriteString('static ') ELSE OPM.WriteString(Export) END END ; - IF (vis = 2) & (obj^.mode = OPM.Var) & (base^.form = OPM.Real) THEN OPM.WriteString("double") + IF (vis = 2) & (obj^.mode = OPT.Var) & (base^.form = OPT.Real) THEN OPM.WriteString("double") ELSE DeclareBase(obj) END ELSE OPM.Write(","); END ; OPM.Write(' '); - IF (vis = 2) & (obj^.mode = OPM.Var) & (base^.form = OPM.Real) THEN OPM.Write("_") END ; + IF (vis = 2) & (obj^.mode = OPT.Var) & (base^.form = OPT.Real) THEN OPM.Write("_") END ; DeclareObj(obj, vis = 3); - IF obj^.typ^.comp = OPM.DynArr THEN (* declare len parameter(s) *) + IF obj^.typ^.comp = OPT.DynArr THEN (* declare len parameter(s) *) EndStat; BegStat; base := OPT.linttyp; OPM.WriteString("LONGINT "); LenList(obj, FALSE, TRUE) - ELSIF (obj^.mode = OPM.VarPar) & (obj^.typ^.comp = OPM.Record) THEN + ELSIF (obj^.mode = OPT.VarPar) & (obj^.typ^.comp = OPT.Record) THEN EndStat; BegStat; OPM.WriteString("LONGINT *"); Ident(obj); OPM.WriteString(TagExt); base := NIL - ELSIF ptrinit & (vis = 0) & (obj^.mnolev > 0) & (obj^.typ^.form = OPM.Pointer) THEN + ELSIF ptrinit & (vis = 0) & (obj^.mnolev > 0) & (obj^.typ^.form = OPT.Pointer) THEN OPM.WriteString(" = NIL") END END ; @@ -700,7 +700,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) VAR name: ARRAY 32 OF CHAR; BEGIN OPM.Write("("); - IF (obj = NIL) OR (obj^.mode = OPM.TProc) THEN OPM.WriteString("void") + IF (obj = NIL) OR (obj^.mode = OPT.TProc) THEN OPM.WriteString("void") ELSE LOOP DeclareBase(obj); @@ -709,14 +709,14 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) ELSE COPY(obj^.name, name); obj^.name := ""; DeclareObj(obj, FALSE); COPY(name, obj^.name) END ; - IF obj^.typ^.comp = OPM.DynArr THEN + IF obj^.typ^.comp = OPT.DynArr THEN OPM.WriteString(", LONGINT "); LenList(obj, TRUE, showParamNames) - ELSIF (obj^.mode = OPM.VarPar) & (obj^.typ^.comp = OPM.Record) THEN + ELSIF (obj^.mode = OPT.VarPar) & (obj^.typ^.comp = OPT.Record) THEN OPM.WriteString(", LONGINT *"); IF showParamNames THEN Ident(obj); OPM.WriteString(TagExt) END END ; - IF (obj^.link = NIL) OR (obj^.link.mode = OPM.TProc) THEN EXIT END ; + IF (obj^.link = NIL) OR (obj^.link.mode = OPT.TProc) THEN EXIT END ; OPM.WriteString(", "); obj := obj^.link END @@ -744,10 +744,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN ProcPredefs(obj^.left, vis); - IF (obj^.mode IN {OPM.LProc, OPM.XProc}) & (obj^.vis >= vis) & ((obj^.history # OPM.removed) OR (obj^.mode = OPM.LProc)) THEN - (* previous OPM.XProc may be deleted or become OPM.LProc after interface change*) - IF vis = OPM.external THEN OPM.WriteString(Extern) - ELSIF obj^.vis = OPM.internal THEN OPM.WriteString('static ') + IF (obj^.mode IN {OPT.LProc, OPT.XProc}) & (obj^.vis >= vis) & ((obj^.history # OPT.removed) OR (obj^.mode = OPT.LProc)) THEN + (* previous OPT.XProc may be deleted or become OPT.LProc after interface change*) + IF vis = OPT.external THEN OPM.WriteString(Extern) + ELSIF obj^.vis = OPT.internal THEN OPM.WriteString('static ') ELSE OPM.WriteString(Export) END ; ProcHeader(obj, FALSE); @@ -766,7 +766,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN IncludeImports(obj^.left, vis); - IF (obj^.mode = OPM.Mod) & (obj^.mnolev # 0) & (OPT.GlbMod[-obj^.mnolev].vis >= vis) THEN (* @self and SYSTEM have mnolev = 0 *) + IF (obj^.mode = OPT.Mod) & (obj^.mnolev # 0) & (OPT.GlbMod[-obj^.mnolev].vis >= vis) THEN (* @self and SYSTEM have mnolev = 0 *) Include(OPT.GlbMod[-obj^.mnolev].name) (* use unaliased module name *) END; IncludeImports(obj^.right, vis); @@ -776,11 +776,11 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE GenDynTypes (n: OPT.Node; vis: INTEGER); VAR typ: OPT.Struct; BEGIN - WHILE (n # NIL) & (n^.class = OPM.Ninittd) DO + WHILE (n # NIL) & (n^.class = OPT.Ninittd) DO typ := n^.typ; - IF (vis = OPM.internal) OR (typ^.ref < OPM.MaxStruct (*type needed in symbol file*)) THEN + IF (vis = OPT.internal) OR (typ^.ref < OPM.MaxStruct (*type needed in symbol file*)) THEN BegStat; - IF vis = OPM.external THEN OPM.WriteString(Extern) + IF vis = OPT.external THEN OPM.WriteString(Extern) ELSIF (typ^.strobj # NIL) & (typ^.strobj^.mnolev > 0) THEN OPM.WriteString('static ') ELSE OPM.WriteString(Export) END ; @@ -798,7 +798,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) DefAnonRecs(n); TypeDefs(OPT.topScope^.right, 1); OPM.WriteLn; IdentList(OPT.topScope^.scope, 1); OPM.WriteLn; - GenDynTypes(n, OPM.external); OPM.WriteLn; + GenDynTypes(n, OPT.external); OPM.WriteLn; ProcPredefs(OPT.topScope^.right, 1); OPM.WriteString(Extern); OPM.WriteString("void *"); OPM.WriteStringVar(OPM.modName); OPM.WriteString(BodyNameExt); @@ -860,7 +860,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) DefAnonRecs(n); TypeDefs(OPT.topScope^.right, 0); OPM.WriteLn; IdentList(OPT.topScope^.scope, 0); OPM.WriteLn; - GenDynTypes(n, OPM.internal); OPM.WriteLn; + GenDynTypes(n, OPT.internal); OPM.WriteLn; ProcPredefs(OPT.topScope^.right, 0); OPM.WriteLn; CProcDefs(OPT.topScope^.right, 0); OPM.WriteLn END GenBdy; @@ -869,7 +869,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN RegCmds(obj^.left); - IF (obj^.mode = OPM.XProc) & (obj^.history # OPM.removed) THEN + IF (obj^.mode = OPT.XProc) & (obj^.history # OPT.removed) THEN IF (obj^.vis # 0) & (obj^.link = NIL) & (obj^.typ = OPT.notyp) THEN (*command*) BegStat; OPM.WriteString('__REGCMD("'); OPM.WriteStringVar(obj.name); OPM.WriteString('", '); Ident(obj); OPM.Write(")"); EndStat @@ -883,7 +883,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN InitImports(obj^.left); - IF (obj^.mode = OPM.Mod) & (obj^.mnolev # 0) THEN + IF (obj^.mode = OPT.Mod) & (obj^.mnolev # 0) THEN BegStat; OPM.WriteString("__MODULE_IMPORT("); OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name); OPM.Write(')'); EndStat @@ -910,17 +910,17 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BegBlk END ; BegStat; - IF typ^.form = OPM.Pointer THEN + IF typ^.form = OPT.Pointer THEN OPM.WriteString("P("); Ident(var); OPM.Write(")"); - ELSIF typ^.comp = OPM.Record THEN + ELSIF typ^.comp = OPT.Record THEN OPM.WriteString("__ENUMR(&"); Ident(var); OPM.WriteString(", "); Andent(typ); OPM.WriteString(DynTypExt); Str1(", #", typ^.size); OPM.WriteString(", 1, P)") - ELSIF typ^.comp = OPM.Array THEN + ELSIF typ^.comp = OPT.Array THEN n := typ^.n; typ := typ^.BaseTyp; - WHILE typ^.comp = OPM.Array DO n := n * typ^.n; typ := typ^.BaseTyp END ; - IF typ^.form = OPM.Pointer THEN + WHILE typ^.comp = OPT.Array DO n := n * typ^.n; typ := typ^.BaseTyp END ; + IF typ^.form = OPT.Pointer THEN OPM.WriteString("__ENUMP("); Ident(var); Str1(", #, P)", n) - ELSIF typ^.comp = OPM.Record THEN + ELSIF typ^.comp = OPT.Record THEN OPM.WriteString("__ENUMR("); Ident(var); OPM.WriteString(", "); Andent(typ); OPM.WriteString(DynTypExt); Str1(", #", typ^.size); Str1(", #, P)", n) END @@ -991,7 +991,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE EnterProc* (proc: OPT.Object); VAR var, scope: OPT.Object; typ: OPT.Struct; dim: INTEGER; BEGIN - IF proc^.vis # OPM.external THEN OPM.WriteString('static ') END ; + IF proc^.vis # OPT.external THEN OPM.WriteString('static ') END ; ProcHeader(proc, TRUE); BegBlk; @@ -1011,7 +1011,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END ; var := proc^.link; WHILE var # NIL DO (* declare copy of fixed size value array parameters *) - IF (var^.typ^.comp = OPM.Array) & (var^.mode = OPM.Var) THEN + IF (var^.typ^.comp = OPT.Array) & (var^.mode = OPT.Var) THEN BegStat; IF var^.typ^.strobj = NIL THEN OPM.Mark(200, var^.typ^.txtpos) ELSE Ident(var^.typ^.strobj) END ; OPM.Write(' '); Ident(var); OPM.WriteString("__copy"); @@ -1022,7 +1022,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF ~ansi THEN var := proc^.link; WHILE var # NIL DO (* "unpromote" value real parameters *) - IF (var^.typ^.form = OPM.Real) & (var^.mode = OPM.Var) THEN + IF (var^.typ^.form = OPT.Real) & (var^.mode = OPT.Var) THEN BegStat; Ident(var^.typ^.strobj); OPM.Write(' '); Ident(var); OPM.WriteString(" = _"); Ident(var); EndStat @@ -1032,9 +1032,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END ; var := proc^.link; WHILE var # NIL DO (* copy value array parameters *) - IF (var^.typ^.comp IN {OPM.Array, OPM.DynArr}) & (var^.mode = OPM.Var) & (var^.typ^.sysflag = 0) THEN + IF (var^.typ^.comp IN {OPT.Array, OPT.DynArr}) & (var^.mode = OPT.Var) & (var^.typ^.sysflag = 0) THEN BegStat; - IF var^.typ^.comp = OPM.Array THEN + IF var^.typ^.comp = OPT.Array THEN OPM.WriteString("__DUPARR("); Ident(var); OPM.WriteString(', '); IF var^.typ^.strobj = NIL THEN OPM.Mark(200, var^.typ^.txtpos) ELSE Ident(var^.typ^.strobj) END @@ -1042,7 +1042,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.WriteString('__DUP('); Ident(var); OPM.WriteString(', '); Ident(var); OPM.WriteString(LenExt); typ := var^.typ^.BaseTyp; dim := 1; - WHILE typ^.comp = OPM.DynArr DO + WHILE typ^.comp = OPT.DynArr DO OPM.WriteString(" * "); Ident(var); OPM.WriteString(LenExt); OPM.WriteInt(dim); typ := typ^.BaseTyp; INC(dim) END ; @@ -1062,12 +1062,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BegStat; OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(' = '); - IF var^.typ^.comp IN {OPM.Array, OPM.DynArr} THEN OPM.WriteString("(void*)") + IF var^.typ^.comp IN {OPT.Array, OPT.DynArr} THEN OPM.WriteString("(void*)") (* K&R and ANSI differ in the type: array or element type*) - ELSIF var^.mode # OPM.VarPar THEN OPM.Write("&") + ELSIF var^.mode # OPT.VarPar THEN OPM.Write("&") END ; Ident(var); - IF var^.typ^.comp = OPM.DynArr THEN + IF var^.typ^.comp = OPT.DynArr THEN typ := var^.typ; dim := 0; REPEAT (* copy len(s) *) OPM.WriteString("; "); @@ -1076,8 +1076,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.WriteString(' = '); Ident(var); OPM.WriteString(LenExt); IF dim # 0 THEN OPM.WriteInt(dim) END ; typ := typ^.BaseTyp - UNTIL typ^.comp # OPM.DynArr; - ELSIF (var^.mode = OPM.VarPar) & (var^.typ^.comp = OPM.Record) THEN + UNTIL typ^.comp # OPT.DynArr; + ELSIF (var^.mode = OPT.VarPar) & (var^.typ^.comp = OPT.Record) THEN OPM.WriteString("; "); OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(TagExt); OPM.WriteString(' = '); Ident(var); OPM.WriteString(TagExt) @@ -1091,7 +1091,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF ~var^.leaf THEN (* only if used by a nested procedure *) BegStat; OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(' = '); - IF var^.typ^.comp # OPM.Array THEN OPM.Write("&") + IF var^.typ^.comp # OPT.Array THEN OPM.Write("&") ELSE OPM.WriteString("(void*)") (* K&R and ANSI differ in the type: array or element type*) END ; Ident(var); EndStat @@ -1123,7 +1123,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) (* delete array value parameters *) var := proc^.link; WHILE var # NIL DO - IF (var^.typ^.comp = OPM.DynArr) & (var^.mode = OPM.Var) & (var^.typ^.sysflag = 0) THEN + IF (var^.typ^.comp = OPT.DynArr) & (var^.mode = OPT.Var) & (var^.typ^.sysflag = 0) THEN IF indent THEN BegStat ELSE indent := TRUE END ; OPM.WriteString('__DEL('); Ident(var); OPM.Write(')'); EndStat END ; @@ -1138,16 +1138,16 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE CompleteIdent*(obj: OPT.Object); VAR comp, level: INTEGER; BEGIN - (* obj^.mode IN {OPM.Var, OPM.VarPar} *) + (* obj^.mode IN {OPT.Var, OPT.VarPar} *) level := obj^.mnolev; IF obj^.adr = 1 THEN (* WITH-variable *) - IF obj^.typ^.comp = OPM.Record THEN Ident(obj); OPM.WriteString("__") + IF obj^.typ^.comp = OPT.Record THEN Ident(obj); OPM.WriteString("__") ELSE (* cast with guard pointer type *) OPM.WriteString("(("); Ident(obj^.typ^.strobj); OPM.Write(")"); Ident(obj); OPM.Write(")") END ELSIF (level # OPM.level) & (level > 0) THEN (* intermediate var *) comp := obj^.typ^.comp; - IF (obj^.mode # OPM.VarPar) & (comp # OPM.DynArr) THEN OPM.Write('*'); END; + IF (obj^.mode # OPT.VarPar) & (comp # OPT.DynArr) THEN OPM.Write('*'); END; OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString(GlobalScope); OPM.WriteString("->"); Ident(obj) ELSE @@ -1158,8 +1158,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE TypeOf*(ap: OPT.Object); VAR i: INTEGER; BEGIN - ASSERT(ap.typ.comp = OPM.Record); - IF ap.mode = OPM.VarPar THEN + ASSERT(ap.typ.comp = OPT.Record); + IF ap.mode = OPT.VarPar THEN IF ap.mnolev # OPM.level THEN (*intermediate level var-par record; possible WITH-guarded*) OPM.WriteStringVar(ap^.scope^.name); OPM.WriteString("_s->"); Ident(ap) ELSE (*local var-par record*) @@ -1231,10 +1231,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN OPM.WriteString('case '); CASE form OF - | OPM.Char: CharacterLiteral(caseVal) - | OPM.SInt, - OPM.Int, - OPM.LInt: OPM.WriteInt(caseVal); + | OPT.Char: CharacterLiteral(caseVal) + | OPT.SInt, + OPT.Int, + OPT.LInt: OPM.WriteInt(caseVal); ELSE OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; END; OPM.WriteString(': '); @@ -1257,7 +1257,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: LONGINT); BEGIN - IF array^.comp = OPM.DynArr THEN + IF array^.comp = OPT.DynArr THEN CompleteIdent(obj); OPM.WriteString(LenExt); IF dim # 0 THEN OPM.WriteInt(dim) END ELSE (* array *) @@ -1271,15 +1271,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) hex: LONGINT; skipLeading: BOOLEAN; BEGIN CASE form OF - | OPM.Byte: OPM.WriteInt(con^.intval) - | OPM.Bool: OPM.WriteInt(con^.intval) - | OPM.Char: CharacterLiteral(con.intval) - | OPM.SInt, - OPM.Int, - OPM.LInt: OPM.WriteInt(con^.intval) - | OPM.Real: OPM.WriteReal(con^.realval, "f") - | OPM.LReal: OPM.WriteReal(con^.realval, 0X) - | OPM.Set: OPM.WriteString("0x"); + | OPT.Byte: OPM.WriteInt(con^.intval) + | OPT.Bool: OPM.WriteInt(con^.intval) + | OPT.Char: CharacterLiteral(con.intval) + | OPT.SInt, + OPT.Int, + OPT.LInt: OPM.WriteInt(con^.intval) + | OPT.Real: OPM.WriteReal(con^.realval, "f") + | OPT.LReal: OPM.WriteReal(con^.realval, 0X) + | OPT.Set: OPM.WriteString("0x"); skipLeading := TRUE; s := con^.setval; i := MAX(SET) + 1; REPEAT @@ -1294,8 +1294,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END UNTIL i = 0; IF skipLeading THEN OPM.Write("0") END - | OPM.String: StringLiteral(con.ext^, con.intval2-1) - | OPM.NilTyp: OPM.WriteString('NIL'); + | OPT.String: StringLiteral(con.ext^, con.intval2-1) + | OPT.NilTyp: OPM.WriteString('NIL'); ELSE OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; END; END Constant; diff --git a/src/compiler/OPM.cmdln.Mod b/src/compiler/OPM.cmdln.Mod index 33d358fb..ef1f51a7 100644 --- a/src/compiler/OPM.cmdln.Mod +++ b/src/compiler/OPM.cmdln.Mod @@ -121,85 +121,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) char* = 1; integer* = 2; real* = 3; longreal* = 4; - - - (***** Objects *****) - - - (* Object.mode values *) - 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; - - (* Object.vis - module visibility of objects *) - internal* = 0; external* = 1; externalR* = 2; - - (* Object.history - History of imported objects *) - inserted* = 0; same* = 1; pbmodified* = 2; pvmodified* = 3; removed* = 4; inconsistent* = 5; - - (* Object.adr Function numbers *) - 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; - adrfn* = 20; ccfn* = 21; lshfn* = 22; rotfn* = 23; getfn* = 24; (* SYSTEM *) - putfn* = 25; getrfn* = 26; putrfn* = 27; bitfn* = 28; valfn* = 29; (* SYSTEM *) - sysnewfn* = 30; movefn* = 31; (* SYSTEM *) - assertfn* = 32; - - - - - (***** Structures *****) - - - (* Struct.form values *) - 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(*, Int8..Int64*)}; realSet* = {Real, LReal}; - - (* Struct.comp - Composite structure forms *) - Basic* = 1; Array* = 2; DynArr* = 3; Record* = 4; - - - - - (***** Nodes *****) - - - (* Node.class values *) - 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; - - - (* Node.subcl values - general *) - assign* = 0; (* Pseudo function number for assignment *) - super* = 1; - - (* Node.subcl values - functions *) - ash* = 17; msk* = 18; len* = 19; - conv* = 20; abs* = 21; cap* = 22; odd* = 23; - - (* Node.subcl values - SYSTEM functions *) - adr* = 24; cc* = 25; bit* = 26; lsh* = 27; rot* = 28; val* = 29; - - (* Note: some object.adr function numbers and some symbol types are - also are used as Node.subcl function ids *) - - - - (* conval^.setval procedure flags *) - hasBody* = 1; isRedef* = 2; slNeeded* = 3; - - - - TYPE FileName = ARRAY 32 OF CHAR; diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod index 79a32bc5..a73ff835 100644 --- a/src/compiler/OPP.Mod +++ b/src/compiler/OPP.Mod @@ -33,7 +33,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) VAR obj: OPT.Object; lev: SHORTINT; BEGIN (*sym = OPM.ident*) OPT.Find(obj); OPS.Get(sym); - IF (sym = OPM.period) & (obj # NIL) & (obj^.mode = OPM.Mod) THEN + IF (sym = OPM.period) & (obj # NIL) & (obj^.mode = OPT.Mod) THEN OPS.Get(sym); IF sym = OPM.ident THEN OPT.FindImport(obj, obj); OPS.Get(sym) @@ -41,9 +41,9 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END ; IF obj = NIL THEN err(0); - obj := OPT.NewObj(); obj^.mode := OPM.Var; obj^.typ := OPT.undftyp; obj^.adr := 0 + obj := OPT.NewObj(); obj^.mode := OPT.Var; obj^.typ := OPT.undftyp; obj^.adr := 0 ELSE lev := obj^.mnolev; - IF (obj^.mode IN {OPM.Var, OPM.VarPar}) & (lev # level) THEN + IF (obj^.mode IN {OPT.Var, OPT.VarPar}) & (lev # level) THEN obj^.leaf := FALSE; IF lev > 0 THEN OPB.StaticLink(level-lev) END END @@ -53,7 +53,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) PROCEDURE ConstExpression(VAR x: OPT.Node); BEGIN Expression(x); - IF x^.class # OPM.Nconst THEN + IF x^.class # OPT.Nconst THEN err(50); x := OPB.NewIntConst(1) END END ConstExpression; @@ -62,9 +62,9 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) BEGIN OPS.Get(sym); IF (sym = OPM.times) OR (sym = OPM.minus) THEN IF level > 0 THEN err(47) END ; - IF sym = OPM.times THEN vis := OPM.external ELSE vis := OPM.externalR END ; + IF sym = OPM.times THEN vis := OPT.external ELSE vis := OPT.externalR END ; OPS.Get(sym) - ELSE vis := OPM.internal + ELSE vis := OPT.internal END END CheckMark; @@ -74,7 +74,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IF sym = OPM.lbrak THEN OPS.Get(sym); IF ~OPT.SYSimported THEN err(135) END; ConstExpression(x); - IF x^.typ^.form IN OPM.intSet THEN sf := x^.conval^.intval; + IF x^.typ^.form IN OPT.intSet THEN sf := x^.conval^.intval; IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END ELSE err(51); sf := 0 END ; @@ -86,13 +86,13 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) PROCEDURE RecordType(VAR typ, banned: OPT.Struct); VAR fld, first, last, base: OPT.Object; ftyp: OPT.Struct; sysflag: INTEGER; - BEGIN typ := OPT.NewStr(OPM.Comp, OPM.Record); typ^.BaseTyp := NIL; + BEGIN typ := OPT.NewStr(OPT.Comp, OPT.Record); typ^.BaseTyp := NIL; CheckSysFlag(sysflag, -1); IF sym = OPM.lparen THEN OPS.Get(sym); (*record extension*) IF sym = OPM.ident THEN qualident(base); - IF (base^.mode = OPM.Typ) & (base^.typ^.comp = OPM.Record) THEN + IF (base^.mode = OPT.Typ) & (base^.typ^.comp = OPT.Record) THEN IF base^.typ = banned THEN err(58) ELSE base^.typ^.pvused := TRUE; typ^.BaseTyp := base^.typ; typ^.extlev := base^.typ^.extlev + 1; typ^.sysflag := base^.typ^.sysflag @@ -114,7 +114,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IF fld # NIL THEN err(1) END END ; OPT.Insert(OPS.name, fld); CheckMark(fld^.vis); - fld^.mode := OPM.Fld; fld^.link := NIL; fld^.typ := OPT.undftyp; + fld^.mode := OPT.Fld; fld^.link := NIL; fld^.typ := OPT.undftyp; IF first = NIL THEN first := fld END ; IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ; last := fld @@ -127,7 +127,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ; CheckSym(OPM.colon); Type(ftyp, banned); ftyp^.pvused := TRUE; - IF ftyp^.comp = OPM.DynArr THEN ftyp := OPT.undftyp; err(88) END ; + IF ftyp^.comp = OPT.DynArr THEN ftyp := OPT.undftyp; err(88) END ; WHILE first # NIL DO first^.typ := ftyp; first := first^.link END @@ -144,15 +144,15 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER; BEGIN CheckSysFlag(sysflag, 0); IF sym = OPM.of THEN (*dynamic array*) - typ := OPT.NewStr(OPM.Comp, OPM.DynArr); typ^.mno := 0; typ^.sysflag := sysflag; + typ := OPT.NewStr(OPT.Comp, OPT.DynArr); typ^.mno := 0; typ^.sysflag := sysflag; OPS.Get(sym); Type(typ^.BaseTyp, banned); typ^.BaseTyp^.pvused := TRUE; - IF typ^.BaseTyp^.comp = OPM.DynArr THEN typ^.n := typ^.BaseTyp^.n + 1 + IF typ^.BaseTyp^.comp = OPT.DynArr THEN typ^.n := typ^.BaseTyp^.n + 1 ELSE typ^.n := 0 END ELSE - typ := OPT.NewStr(OPM.Comp, OPM.Array); typ^.sysflag := sysflag; ConstExpression(x); - IF x^.typ^.form IN OPM.intSet THEN n := x^.conval^.intval; + typ := OPT.NewStr(OPT.Comp, OPT.Array); typ^.sysflag := sysflag; ConstExpression(x); + IF x^.typ^.form IN OPT.intSet THEN n := x^.conval^.intval; IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END ELSE err(51); n := 1 END ; @@ -164,13 +164,13 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPS.Get(sym); IF sym # OPM.of THEN ArrayType(typ^.BaseTyp, banned) END ELSE err(35) END ; - IF typ^.BaseTyp^.comp = OPM.DynArr THEN typ^.BaseTyp := OPT.undftyp; err(88) END + IF typ^.BaseTyp^.comp = OPT.DynArr THEN typ^.BaseTyp := OPT.undftyp; err(88) END END END ArrayType; PROCEDURE PointerType(VAR typ: OPT.Struct); VAR id: OPT.Object; - BEGIN typ := OPT.NewStr(OPM.Pointer, OPM.Basic); CheckSysFlag(typ^.sysflag, 0); + BEGIN typ := OPT.NewStr(OPT.Pointer, OPT.Basic); CheckSysFlag(typ^.sysflag, 0); CheckSym(OPM.to); IF sym = OPM.ident THEN OPT.Find(id); IF id = NIL THEN @@ -180,8 +180,8 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) typ^.link := OPT.NewObj(); COPY(OPS.name, typ^.link^.name); typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*) ELSE qualident(id); - IF id^.mode = OPM.Typ THEN - IF id^.typ^.comp IN {OPM.Array, OPM.DynArr, OPM.Record} THEN + IF id^.mode = OPT.Typ THEN + IF id^.typ^.comp IN {OPT.Array, OPT.DynArr, OPT.Record} THEN typ^.BaseTyp := id^.typ ELSE typ^.BaseTyp := OPT.undftyp; err(57) END @@ -189,7 +189,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END ELSE Type(typ^.BaseTyp, OPT.notyp); - IF ~(typ^.BaseTyp^.comp IN {OPM.Array, OPM.DynArr, OPM.Record}) THEN + IF ~(typ^.BaseTyp^.comp IN {OPT.Array, OPT.DynArr, OPT.Record}) THEN typ^.BaseTyp := OPT.undftyp; err(57) END END @@ -201,7 +201,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) BEGIN first := NIL; last := firstPar; IF (sym = OPM.ident) OR (sym = OPM.var) THEN LOOP - IF sym = OPM.var THEN OPS.Get(sym); mode := OPM.VarPar ELSE mode := OPM.Var END ; + IF sym = OPM.var THEN OPS.Get(sym); mode := OPT.VarPar ELSE mode := OPT.Var END ; LOOP IF sym = OPM.ident THEN OPT.Insert(OPS.name, par); OPS.Get(sym); @@ -218,7 +218,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END ; CheckSym(OPM.colon); Type(typ, OPT.notyp); - IF mode = OPM.Var THEN typ^.pvused := TRUE END ; + IF mode = OPT.Var THEN typ^.pvused := TRUE END ; (* typ^.pbused is set when parameter type name is parsed *) WHILE first # NIL DO first^.typ := typ; first := first^.link END ; IF sym = OPM.semicolon THEN OPS.Get(sym) @@ -231,8 +231,8 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IF sym = OPM.colon THEN OPS.Get(sym); resTyp := OPT.undftyp; IF sym = OPM.ident THEN qualident(res); - IF res^.mode = OPM.Typ THEN - IF (res^.typ^.form < OPM.Comp) (*OR (res^.typ^.form >= Int8) & (res^.typ^.form <= Int64)*) THEN resTyp := res^.typ; + IF res^.mode = OPT.Typ THEN + IF (res^.typ^.form < OPT.Comp) (*OR (res^.typ^.form >= Int8) & (res^.typ^.form <= Int64)*) THEN resTyp := res^.typ; ELSE err(54) END ELSE err(52) @@ -250,7 +250,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) REPEAT OPS.Get(sym) UNTIL sym >= OPM.lparen END ; IF sym = OPM.ident THEN qualident(id); - IF id^.mode = OPM.Typ THEN + IF id^.mode = OPT.Typ THEN IF id^.typ = banned THEN err(58) ELSE typ := id.typ END @@ -264,7 +264,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSIF sym = OPM.pointer THEN OPS.Get(sym); PointerType(typ) ELSIF sym = OPM.procedure THEN - OPS.Get(sym); typ := OPT.NewStr(OPM.ProcTyp, OPM.Basic); CheckSysFlag(typ^.sysflag, 0); + OPS.Get(sym); typ := OPT.NewStr(OPT.ProcTyp, OPT.Basic); CheckSysFlag(typ^.sysflag, 0); IF sym = OPM.lparen THEN OPS.Get(sym); OPT.OpenScope(level, NIL); FormalParameters(typ^.link, typ^.BaseTyp); OPT.CloseScope @@ -281,7 +281,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) PROCEDURE Type(VAR typ, banned: OPT.Struct); BEGIN TypeDecl(typ, banned); - IF (typ^.form = OPM.Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END + IF (typ^.form = OPT.Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END END Type; PROCEDURE selector(VAR x: OPT.Node); @@ -290,7 +290,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) LOOP IF sym = OPM.lbrak THEN OPS.Get(sym); LOOP - IF (x^.typ # NIL) & (x^.typ^.form = OPM.Pointer) THEN OPB.DeRef(x) END ; + IF (x^.typ # NIL) & (x^.typ^.form = OPT.Pointer) THEN OPB.DeRef(x) END ; Expression(y); OPB.Index(x, y); IF sym = OPM.comma THEN OPS.Get(sym) ELSE EXIT END END ; @@ -298,21 +298,21 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSIF sym = OPM.period THEN OPS.Get(sym); IF sym = OPM.ident THEN name := OPS.name; OPS.Get(sym); IF x^.typ # NIL THEN - IF x^.typ^.form = OPM.Pointer THEN OPB.DeRef(x) END ; - IF x^.typ^.comp = OPM.Record THEN + IF x^.typ^.form = OPT.Pointer THEN OPB.DeRef(x) END ; + IF x^.typ^.comp = OPT.Record THEN OPT.FindField(name, x^.typ, obj); OPB.Field(x, obj); - IF (obj # NIL) & (obj^.mode = OPM.TProc) THEN + IF (obj # NIL) & (obj^.mode = OPT.TProc) THEN IF sym = OPM.arrow THEN (* super call *) OPS.Get(sym); y := x^.left; - IF y^.class = OPM.Nderef THEN y := y^.left END ; (* y = record variable *) + IF y^.class = OPT.Nderef THEN y := y^.left END ; (* y = record variable *) IF y^.obj # NIL THEN - proc := OPT.topScope; (* find innermost scope which owner is a OPM.TProc *) - WHILE (proc^.link # NIL) & (proc^.link^.mode # OPM.TProc) DO proc := proc^.left END ; + proc := OPT.topScope; (* find innermost scope which owner is a OPT.TProc *) + WHILE (proc^.link # NIL) & (proc^.link^.mode # OPT.TProc) DO proc := proc^.left END ; IF (proc^.link = NIL) OR (proc^.link^.link # y^.obj) THEN err(75) END ; typ := y^.obj^.typ; - IF typ^.form = OPM.Pointer THEN typ := typ^.BaseTyp END ; + IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ; OPT.FindField(x^.obj^.name, typ^.BaseTyp, proc); - IF proc # NIL THEN x^.subcl := OPM.super ELSE err(74) END + IF proc # NIL THEN x^.subcl := OPT.super ELSE err(74) END ELSE err(75) END END ; @@ -325,12 +325,12 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSE err(OPM.ident) END ELSIF sym = OPM.arrow THEN OPS.Get(sym); OPB.DeRef(x) - ELSIF (sym = OPM.lparen) & (x^.class < OPM.Nconst) & (x^.typ^.form # OPM.ProcTyp) & - ((x^.obj = NIL) OR (x^.obj^.mode # OPM.TProc)) THEN + ELSIF (sym = OPM.lparen) & (x^.class < OPT.Nconst) & (x^.typ^.form # OPT.ProcTyp) & + ((x^.obj = NIL) OR (x^.obj^.mode # OPT.TProc)) THEN OPS.Get(sym); IF sym = OPM.ident THEN qualident(obj); - IF obj^.mode = OPM.Typ THEN OPB.TypTest(x, obj, TRUE) + IF obj^.mode = OPT.Typ THEN OPB.TypTest(x, obj, TRUE) ELSE err(52) END ELSE err(OPM.ident) @@ -381,7 +381,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPB.StFct(x, m, n) ELSE err(OPM.lparen) END ; - IF (level > 0) & ((m = OPM.newfn) OR (m = OPM.sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END + IF (level > 0) & ((m = OPT.newfn) OR (m = OPT.sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END END StandProcCall; PROCEDURE Element(VAR x: OPT.Node); @@ -418,7 +418,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ; IF sym = OPM.ident THEN qualident(id); x := OPB.NewLeaf(id); selector(x); - IF (x^.class = OPM.Nproc) & (x^.obj^.mode = OPM.SProc) THEN StandProcCall(x) (* x may be NIL *) + IF (x^.class = OPT.Nproc) & (x^.obj^.mode = OPT.SProc) THEN StandProcCall(x) (* x may be NIL *) ELSIF sym = OPM.lparen THEN OPS.Get(sym); OPB.PrepCall(x, fpar); ActualParameters(apar, fpar); @@ -486,7 +486,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPS.Get(sym); IF sym = OPM.ident THEN qualident(obj); - IF obj^.mode = OPM.Typ THEN OPB.TypTest(x, obj, FALSE) + IF obj^.mode = OPT.Typ THEN OPB.TypTest(x, obj, FALSE) ELSE err(52) END ELSE err(OPM.ident) @@ -497,27 +497,27 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) PROCEDURE Receiver(VAR mode: SHORTINT; VAR name: OPS.Name; VAR typ, rec: OPT.Struct); VAR obj: OPT.Object; BEGIN typ := OPT.undftyp; rec := NIL; - IF sym = OPM.var THEN OPS.Get(sym); mode := OPM.VarPar ELSE mode := OPM.Var END ; + IF sym = OPM.var THEN OPS.Get(sym); mode := OPT.VarPar ELSE mode := OPT.Var END ; name := OPS.name; CheckSym(OPM.ident); CheckSym(OPM.colon); IF sym = OPM.ident THEN OPT.Find(obj); OPS.Get(sym); IF obj = NIL THEN err(0) - ELSIF obj^.mode # OPM.Typ THEN err(72) + ELSIF obj^.mode # OPT.Typ THEN err(72) ELSE typ := obj^.typ; rec := typ; - IF rec^.form = OPM.Pointer THEN rec := rec^.BaseTyp END ; - IF ~((mode = OPM.Var) & (typ^.form = OPM.Pointer) & (rec^.comp = OPM.Record) OR - (mode = OPM.VarPar) & (typ^.comp = OPM.Record)) THEN err(70); rec := NIL END ; + IF rec^.form = OPT.Pointer THEN rec := rec^.BaseTyp END ; + IF ~((mode = OPT.Var) & (typ^.form = OPT.Pointer) & (rec^.comp = OPT.Record) OR + (mode = OPT.VarPar) & (typ^.comp = OPT.Record)) THEN err(70); rec := NIL END ; IF (rec # NIL) & (rec^.mno # level) THEN err(72); rec := NIL END END ELSE err(OPM.ident) END ; CheckSym(OPM.rparen); - IF rec = NIL THEN rec := OPT.NewStr(OPM.Comp, OPM.Record); rec^.BaseTyp := NIL END + IF rec = NIL THEN rec := OPT.NewStr(OPT.Comp, OPT.Record); rec^.BaseTyp := NIL END END Receiver; PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN; BEGIN - IF (b^.form = OPM.Pointer) & (x^.form = OPM.Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ; - IF (b^.comp = OPM.Record) & (x^.comp = OPM.Record) THEN + IF (b^.form = OPT.Pointer) & (x^.form = OPT.Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ; + IF (b^.comp = OPT.Record) & (x^.comp = OPT.Record) THEN REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b) END ; RETURN x = b @@ -554,7 +554,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END END ; - INCL(proc^.conval^.setval, OPM.hasBody) + INCL(proc^.conval^.setval, OPT.hasBody) END GetCode; PROCEDURE GetParams; @@ -568,7 +568,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPB.CheckParameters(proc^.link, fwd^.link, TRUE); IF proc^.typ # fwd^.typ THEN err(117) END ; proc := fwd; OPT.topScope := proc^.scope; - IF mode = OPM.IProc THEN proc^.mode := OPM.IProc END + IF mode = OPT.IProc THEN proc^.mode := OPT.IProc END END END GetParams; @@ -576,7 +576,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) VAR procdec, statseq: OPT.Node; c: LONGINT; BEGIN c := OPM.errpos; - INCL(proc^.conval^.setval, OPM.hasBody); + INCL(proc^.conval^.setval, OPT.hasBody); CheckSym(OPM.semicolon); Block(procdec, statseq); OPB.Enter(procdec, statseq, proc); x := procdec; x^.conval := OPT.NewConst(); x^.conval^.intval := c; @@ -593,17 +593,17 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) objMode: SHORTINT; objName: OPS.Name; BEGIN - OPS.Get(sym); mode := OPM.TProc; + OPS.Get(sym); mode := OPT.TProc; IF level > 0 THEN err(73) END ; Receiver(objMode, objName, objTyp, recTyp); IF sym = OPM.ident THEN name := OPS.name; CheckMark(vis); OPT.FindField(name, recTyp, fwd); OPT.FindField(name, recTyp^.BaseTyp, baseProc); - IF (baseProc # NIL) & (baseProc^.mode # OPM.TProc) THEN baseProc := NIL END ; + IF (baseProc # NIL) & (baseProc^.mode # OPT.TProc) THEN baseProc := NIL END ; IF fwd = baseProc THEN fwd := NIL END ; IF (fwd # NIL) & (fwd^.mnolev # level) THEN fwd := NIL END ; - IF (fwd # NIL) & (fwd^.mode = OPM.TProc) & ~(OPM.hasBody IN fwd^.conval^.setval) THEN + IF (fwd # NIL) & (fwd^.mode = OPT.TProc) & ~(OPT.hasBody IN fwd^.conval^.setval) THEN (* there exists a corresponding forward declaration *) proc := OPT.NewObj(); proc^.leaf := TRUE; IF fwd^.vis # vis THEN err(118) END @@ -619,10 +619,10 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IF (objMode # baseProc^.link^.mode) OR ~Extends(objTyp, baseProc^.link^.typ) THEN err(115) END ; OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE); IF proc^.typ # baseProc^.typ THEN err(117) END ; - IF (baseProc^.vis = OPM.external) & (proc^.vis = OPM.internal) & - (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = OPM.external) THEN err(109) + IF (baseProc^.vis = OPT.external) & (proc^.vis = OPT.internal) & + (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = OPT.external) THEN err(109) END ; - INCL(proc^.conval^.setval, OPM.isRedef) + INCL(proc^.conval^.setval, OPT.isRedef) END ; IF ~forward THEN Body END ; DEC(level); OPT.CloseScope @@ -630,23 +630,23 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END TProcDecl; - BEGIN proc := NIL; forward := FALSE; x := NIL; mode := OPM.LProc; + BEGIN proc := NIL; forward := FALSE; x := NIL; mode := OPT.LProc; IF (sym # OPM.ident) & (sym # OPM.lparen) THEN IF sym = OPM.times THEN (* mode set later in OPB.CheckAssign *) ELSIF sym = OPM.arrow THEN forward := TRUE - ELSIF sym = OPM.plus THEN mode := OPM.IProc - ELSIF sym = OPM.minus THEN mode := OPM.CProc + ELSIF sym = OPM.plus THEN mode := OPT.IProc + ELSIF sym = OPM.minus THEN mode := OPT.CProc ELSE err(OPM.ident) END ; - IF (mode IN {OPM.IProc, OPM.CProc}) & ~OPT.SYSimported THEN err(135) END ; + IF (mode IN {OPT.IProc, OPT.CProc}) & ~OPT.SYSimported THEN err(135) END ; OPS.Get(sym) END ; IF sym = OPM.lparen THEN TProcDecl ELSIF sym = OPM.ident THEN OPT.Find(fwd); name := OPS.name; CheckMark(vis); - IF (vis # OPM.internal) & (mode = OPM.LProc) THEN mode := OPM.XProc END ; - IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = OPM.SProc)) THEN fwd := NIL END ; - IF (fwd # NIL) & (fwd^.mode IN {OPM.LProc, OPM.XProc}) & ~(OPM.hasBody IN fwd^.conval^.setval) THEN + IF (vis # OPT.internal) & (mode = OPT.LProc) THEN mode := OPT.XProc END ; + IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = OPT.SProc)) THEN fwd := NIL END ; + IF (fwd # NIL) & (fwd^.mode IN {OPT.LProc, OPT.XProc}) & ~(OPT.hasBody IN fwd^.conval^.setval) THEN (* there exists a corresponding forward declaration *) proc := OPT.NewObj(); proc^.leaf := TRUE; IF fwd^.vis # vis THEN err(118) END @@ -654,10 +654,10 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IF fwd # NIL THEN err(1); fwd := NIL END ; OPT.Insert(name, proc) END ; - IF (mode # OPM.LProc) & (level > 0) THEN err(73) END ; + IF (mode # OPT.LProc) & (level > 0) THEN err(73) END ; INC(level); OPT.OpenScope(level, proc); proc^.link := NIL; GetParams; - IF mode = OPM.CProc THEN GetCode + IF mode = OPT.CProc THEN GetCode ELSIF ~forward THEN Body END ; DEC(level); OPT.CloseScope @@ -669,16 +669,16 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT; BEGIN lab := NIL; lastlab := NIL; LOOP ConstExpression(x); f := x^.typ^.form; - IF f IN OPM.intSet + {OPM.Char} THEN xval := x^.conval^.intval + IF f IN OPT.intSet + {OPT.Char} THEN xval := x^.conval^.intval ELSE err(61); xval := 1 END ; - IF f IN OPM.intSet THEN + IF f IN OPT.intSet THEN IF LabelForm < f THEN err(60) END ELSIF LabelForm # f THEN err(60) END ; IF sym = OPM.upto THEN OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval; - IF (y^.typ^.form # f) & ~((f IN OPM.intSet) & (y^.typ^.form IN OPM.intSet)) THEN err(60) END ; + IF (y^.typ^.form # f) & ~((f IN OPT.intSet) & (y^.typ^.form IN OPT.intSet)) THEN err(60) END ; IF yval < xval THEN err(63); yval := xval END ELSE yval := xval END ; @@ -713,15 +713,15 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) tab: CaseTable; cases, lab, y, lastcase: OPT.Node; BEGIN Expression(x); pos := OPM.errpos; - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) - ELSIF ~(x^.typ^.form IN {OPM.Char..OPM.LInt}) THEN err(125) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) + ELSIF ~(x^.typ^.form IN {OPT.Char..OPT.LInt}) THEN err(125) END ; CheckSym(OPM.of); cases := NIL; lastcase := NIL; n := 0; LOOP IF sym < OPM.bar THEN CaseLabelList(lab, x^.typ^.form, n, tab); CheckSym(OPM.colon); StatSeq(y); - OPB.Construct(OPM.Ncasedo, lab, y); OPB.Link(cases, lastcase, lab) + OPB.Construct(OPT.Ncasedo, lab, y); OPB.Link(cases, lastcase, lab) END ; IF sym = OPM.bar THEN OPS.Get(sym) ELSE EXIT END END ; @@ -735,7 +735,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) y := NIL; OPM.Mark(-307, OPM.curpos); (* notice about no OPM.else symbol; -- noch *) END ; - OPB.Construct(OPM.Ncaselse, cases, y); OPB.Construct(OPM.Ncase, x, cases); + OPB.Construct(OPT.Ncaselse, cases, y); OPB.Construct(OPT.Ncase, x, cases); cases^.conval := OPT.NewConst(); cases^.conval^.intval := low; cases^.conval^.intval2 := high; IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END @@ -748,8 +748,8 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) PROCEDURE CheckBool(VAR x: OPT.Node); BEGIN - IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126); x := OPB.NewBoolConst(FALSE) - ELSIF x^.typ^.form # OPM.Bool THEN err(120); x := OPB.NewBoolConst(FALSE) + IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126); x := OPB.NewBoolConst(FALSE) + ELSIF x^.typ^.form # OPT.Bool THEN err(120); x := OPB.NewBoolConst(FALSE) END ; pos := OPM.errpos END CheckBool; @@ -765,7 +765,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPS.Get(sym); Expression(y); OPB.Assign(x, y) ELSIF sym = OPM.eql THEN err(OPM.becomes); OPS.Get(sym); Expression(y); OPB.Assign(x, y) - ELSIF (x^.class = OPM.Nproc) & (x^.obj^.mode = OPM.SProc) THEN + ELSIF (x^.class = OPT.Nproc) & (x^.obj^.mode = OPT.SProc) THEN StandProcCall(x); IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END ELSE OPB.PrepCall(x, fpar); @@ -781,34 +781,34 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) pos := OPM.errpos ELSIF sym = OPM.if THEN OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(OPM.then); StatSeq(y); - OPB.Construct(OPM.Nif, x, y); SetPos(x); lastif := x; + OPB.Construct(OPT.Nif, x, y); SetPos(x); lastif := x; WHILE sym = OPM.elsif DO OPS.Get(sym); Expression(y); CheckBool(y); CheckSym(OPM.then); StatSeq(z); - OPB.Construct(OPM.Nif, y, z); SetPos(y); OPB.Link(x, lastif, y) + OPB.Construct(OPT.Nif, y, z); SetPos(y); OPB.Link(x, lastif, y) END ; IF sym = OPM.else THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL END ; - OPB.Construct(OPM.Nifelse, x, y); CheckSym(OPM.end); OPB.OptIf(x); pos := OPM.errpos + OPB.Construct(OPT.Nifelse, x, y); CheckSym(OPM.end); OPB.OptIf(x); pos := OPM.errpos ELSIF sym = OPM.case THEN OPS.Get(sym); CasePart(x); CheckSym(OPM.end) ELSIF sym = OPM.while THEN OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(OPM.do); StatSeq(y); - OPB.Construct(OPM.Nwhile, x, y); CheckSym(OPM.end) + OPB.Construct(OPT.Nwhile, x, y); CheckSym(OPM.end) ELSIF sym = OPM.repeat THEN OPS.Get(sym); StatSeq(x); IF sym = OPM.until THEN OPS.Get(sym); Expression(y); CheckBool(y) ELSE err(OPM.until) END ; - OPB.Construct(OPM.Nrepeat, x, y) + OPB.Construct(OPT.Nrepeat, x, y) ELSIF sym = OPM.for THEN OPS.Get(sym); IF sym = OPM.ident THEN qualident(id); - IF ~(id^.typ^.form IN OPM.intSet) THEN err(68) END ; + IF ~(id^.typ^.form IN OPT.intSet) THEN err(68) END ; CheckSym(OPM.becomes); Expression(y); pos := OPM.errpos; x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x); CheckSym(OPM.to); Expression(y); pos := OPM.errpos; - IF y^.class # OPM.Nconst THEN + IF y^.class # OPT.Nconst THEN name := "@@"; OPT.Insert(name, t); t^.name := "@for"; (* avoid err 1 *) - t^.mode := OPM.Var; t^.typ := x^.left^.typ; + t^.mode := OPT.Var; t^.typ := x^.left^.typ; obj := OPT.topScope^.scope; IF obj = NIL THEN OPT.topScope^.scope := t ELSE @@ -817,7 +817,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ; z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z); y := OPB.NewLeaf(t) - ELSIF (y^.typ^.form < OPM.SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113) + ELSIF (y^.typ^.form < OPT.SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113) END ; OPB.Link(stat, last, x); IF sym = OPM.by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ; @@ -827,29 +827,29 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSE err(63); OPB.Op(OPM.geq, x, y) END ; CheckSym(OPM.do); StatSeq(s); - y := OPB.NewLeaf(id); OPB.StPar1(y, z, OPM.incfn); SetPos(y); + y := OPB.NewLeaf(id); OPB.StPar1(y, z, OPT.incfn); SetPos(y); IF s = NIL THEN s := y ELSE z := s; WHILE z^.link # NIL DO z := z^.link END ; z^.link := y END ; - CheckSym(OPM.end); OPB.Construct(OPM.Nwhile, x, s) + CheckSym(OPM.end); OPB.Construct(OPT.Nwhile, x, s) ELSE err(OPM.ident) END ELSIF sym = OPM.loop THEN OPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel); - OPB.Construct(OPM.Nloop, x, NIL); CheckSym(OPM.end); pos := OPM.errpos + OPB.Construct(OPT.Nloop, x, NIL); CheckSym(OPM.end); pos := OPM.errpos ELSIF sym = OPM.with THEN OPS.Get(sym); idtyp := NIL; x := NIL; LOOP IF sym = OPM.ident THEN qualident(id); y := OPB.NewLeaf(id); - IF (id # NIL) & (id^.typ^.form = OPM.Pointer) & ((id^.mode = OPM.VarPar) OR ~id^.leaf) THEN + IF (id # NIL) & (id^.typ^.form = OPT.Pointer) & ((id^.mode = OPT.VarPar) OR ~id^.leaf) THEN err(245) (* jt: do not allow WITH on non-local pointers *) END ; CheckSym(OPM.colon); IF sym = OPM.ident THEN qualident(t); - IF t^.mode = OPM.Typ THEN + IF t^.mode = OPT.Typ THEN IF id # NIL THEN idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ ELSE err(130) @@ -860,19 +860,19 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ELSE err(OPM.ident) END ; - pos := OPM.errpos; CheckSym(OPM.do); StatSeq(s); OPB.Construct(OPM.Nif, y, s); SetPos(y); + pos := OPM.errpos; CheckSym(OPM.do); StatSeq(s); OPB.Construct(OPT.Nif, y, s); SetPos(y); IF idtyp # NIL THEN id^.typ := idtyp; idtyp := NIL END ; IF x = NIL THEN x := y; lastif := x ELSE OPB.Link(x, lastif, y) END ; IF sym = OPM.bar THEN OPS.Get(sym) ELSE EXIT END END; e := sym = OPM.else; IF e THEN OPS.Get(sym); StatSeq(s) ELSE s := NIL END ; - OPB.Construct(OPM.Nwith, x, s); CheckSym(OPM.end); + OPB.Construct(OPT.Nwith, x, s); CheckSym(OPM.end); IF e THEN x^.subcl := 1 END ELSIF sym = OPM.exit THEN OPS.Get(sym); IF LoopLevel = 0 THEN err(46) END ; - OPB.Construct(OPM.Nexit, x, NIL); + OPB.Construct(OPT.Nexit, x, NIL); pos := OPM.errpos ELSIF sym = OPM.return THEN OPS.Get(sym); IF sym < OPM.semicolon THEN Expression(x) END ; @@ -901,21 +901,21 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPS.Get(sym); WHILE sym = OPM.ident DO OPT.Insert(OPS.name, obj); CheckMark(obj^.vis); - obj^.typ := OPT.sinttyp; obj^.mode := OPM.Var; (* OPM.Var to avoid recursive definition *) + obj^.typ := OPT.sinttyp; obj^.mode := OPT.Var; (* OPT.Var to avoid recursive definition *) IF sym = OPM.eql THEN OPS.Get(sym); ConstExpression(x) ELSIF sym = OPM.becomes THEN err(OPM.eql); OPS.Get(sym); ConstExpression(x) ELSE err(OPM.eql); x := OPB.NewIntConst(1) END ; - obj^.mode := OPM.Con; obj^.typ := x^.typ; obj^.conval := x^.conval; (* ConstDesc ist not copied *) + obj^.mode := OPT.Con; obj^.typ := x^.typ; obj^.conval := x^.conval; (* ConstDesc ist not copied *) CheckSym(OPM.semicolon) END END ; IF sym = OPM.type THEN OPS.Get(sym); WHILE sym = OPM.ident DO - OPT.Insert(OPS.name, obj); obj^.mode := OPM.Typ; obj^.typ := OPT.undftyp; + OPT.Insert(OPS.name, obj); obj^.mode := OPT.Typ; obj^.typ := OPT.undftyp; CheckMark(obj^.vis); IF sym = OPM.eql THEN OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ) @@ -924,7 +924,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSE err(OPM.eql) END ; IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ; - IF obj^.typ^.comp IN {OPM.Record, OPM.Array, OPM.DynArr} THEN + IF obj^.typ^.comp IN {OPT.Record, OPT.Array, OPT.DynArr} THEN i := 0; WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i); IF typ^.link^.name = obj^.name THEN typ^.BaseTyp := obj^.typ; typ^.link^.name := "" END @@ -939,7 +939,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) LOOP IF sym = OPM.ident THEN OPT.Insert(OPS.name, obj); CheckMark(obj^.vis); - obj^.mode := OPM.Var; obj^.link := NIL; obj^.leaf := obj^.vis = OPM.internal; obj^.typ := OPT.undftyp; + obj^.mode := OPT.Var; obj^.link := NIL; obj^.leaf := obj^.vis = OPT.internal; obj^.typ := OPT.undftyp; IF first = NIL THEN first := obj END ; IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ; last := obj @@ -952,7 +952,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ; CheckSym(OPM.colon); Type(typ, OPT.notyp); typ^.pvused := TRUE; - IF typ^.comp = OPM.DynArr THEN typ := OPT.undftyp; err(88) END ; + IF typ^.comp = OPT.DynArr THEN typ := OPT.undftyp; err(88) END ; WHILE first # NIL DO first^.typ := typ; first := first^.link END ; CheckSym(OPM.semicolon) END diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod index d4c9f4eb..8e550c03 100644 --- a/src/compiler/OPT.Mod +++ b/src/compiler/OPT.Mod @@ -6,16 +6,11 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *) IMPORT OPS, OPM; -CONST - MaxConstLen* = OPS.MaxStrLen; +(* Constants - value of literals *) TYPE - Const* = POINTER TO ConstDesc; - Object* = POINTER TO ObjDesc; - Struct* = POINTER TO StrDesc; - Node* = POINTER TO NodeDesc; - ConstExt* = POINTER TO OPS.String; - + Const* = POINTER TO ConstDesc; + ConstExt* = POINTER TO OPS.String; ConstDesc* = RECORD ext*: ConstExt; (* string or code for code proc *) intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) @@ -24,13 +19,26 @@ TYPE realval*: LONGREAL (* real or longreal constant value *) END; +CONST + MaxConstLen* = OPS.MaxStrLen; + + (* conval^.setval procedure flags *) + hasBody* = 1; isRedef* = 2; slNeeded* = 3; + + + + +(* Objects - named items - constants, types, variables, procedures *) +TYPE + Object* = POINTER TO ObjDesc; + Struct* = POINTER TO StrDesc; ObjDesc* = RECORD left*, right*: Object; link*, scope*: Object; name*: OPS.Name; leaf*: BOOLEAN; mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) - vis*: SHORTINT; (* OPM.internal, OPM.external, OPM.externalR *) + vis*: SHORTINT; (* internal, external, externalR *) history*: SHORTINT; (* relevant if name # "" *) used*, fpdone*: BOOLEAN; fprint*: LONGINT; @@ -40,6 +48,32 @@ TYPE x*: INTEGER (* linkadr and x can be freely used by the backend *) END; +CONST + (* Object.mode values *) + 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; + + (* Object.vis - module visibility of objects *) + internal* = 0; external* = 1; externalR* = 2; + + (* Object.history - History of imported objects *) + inserted* = 0; same* = 1; pbmodified* = 2; pvmodified* = 3; removed* = 4; inconsistent* = 5; + + (* Object.adr Function numbers *) + 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; + adrfn* = 20; ccfn* = 21; lshfn* = 22; rotfn* = 23; getfn* = 24; (* SYSTEM *) + putfn* = 25; getrfn* = 26; putrfn* = 27; bitfn* = 28; valfn* = 29; (* SYSTEM *) + sysnewfn* = 30; movefn* = 31; (* SYSTEM *) + assertfn* = 32; + + + + +(* Structures - describe types independently of their name *) +TYPE StrDesc* = RECORD form*, comp*: SHORTINT; mno*, extlev*: SHORTINT; @@ -54,6 +88,25 @@ TYPE link*, strobj*: Object END; +CONST + (* Struct.form values *) + 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}; + + (* Struct.comp - Composite structure forms *) + Basic* = 1; Array* = 2; DynArr* = 3; Record* = 4; + + + + +(* Nodes - statements, expressions and sub-expressions *) +TYPE + Node* = POINTER TO NodeDesc; NodeDesc* = RECORD left*, right*, link*: Node; class*, subcl*: SHORTINT; @@ -63,10 +116,36 @@ TYPE conval*: Const END; +CONST + (* Node.class values *) + 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; + + + (* Node.subcl values - general *) + assign* = 0; (* Pseudo function number for assignment *) + super* = 1; + + (* Node.subcl values - functions *) + ash* = 17; msk* = 18; len* = 19; + conv* = 20; abs* = 21; cap* = 22; odd* = 23; + + (* Node.subcl values - SYSTEM functions *) + adr* = 24; cc* = 25; bit* = 26; lsh* = 27; rot* = 28; val* = 29; + + (* Note: some object.adr function numbers and some symbol types are + also are used as Node.subcl function ids *) + + + + CONST maxImps = 64; (* must be <= MAX(SHORTINT) *) maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) - FirstRef = OPM.Comp + 1; + FirstRef = Comp + 1; VAR typSize*: PROCEDURE(typ: Struct); @@ -85,6 +164,9 @@ VAR SYSimported*: BOOLEAN; CONST + + + (* Symbol file items *) Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21; Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26; @@ -136,7 +218,7 @@ END NewObj; PROCEDURE NewStr*(form, comp: SHORTINT): Struct; VAR typ: Struct; BEGIN NEW(typ); typ^.form := form; typ^.comp := comp; typ^.ref := maxStruct; (* ref >= maxStruct: not exported yet *) - IF form # OPM.Undef THEN typ^.txtpos := OPM.errpos END ; (* txtpos remains 0 for structs read from symbol file *) + IF form # Undef THEN typ^.txtpos := OPM.errpos END ; (* txtpos remains 0 for structs read from symbol file *) typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ END NewStr; @@ -153,7 +235,7 @@ END NewExt; PROCEDURE OpenScope*(level: SHORTINT; owner: Object); VAR head: Object; BEGIN head := NewObj(); - head^.mode := OPM.Head; head^.mnolev := level; head^.link := owner; + head^.mode := Head; head^.mnolev := level; head^.link := owner; IF owner # NIL THEN owner^.scope := head END; head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head END OpenScope; @@ -187,7 +269,7 @@ BEGIN obj := mod^.scope; IF OPS.name < obj^.name THEN obj := obj^.left ELSIF OPS.name > obj^.name THEN obj := obj^.right ELSE (*found*) - IF (obj^.mode = OPM.Typ) & (obj^.vis = OPM.internal) THEN obj := NIL + IF (obj^.mode = Typ) & (obj^.vis = internal) THEN obj := NIL ELSE obj^.used := TRUE END; EXIT @@ -298,11 +380,11 @@ BEGIN IF (strobj # NIL) & (strobj^.name # "") THEN FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name) END; - IF (f = OPM.Pointer) OR (c = OPM.Record) & (btyp # NIL) OR (c = OPM.DynArr) THEN + IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp) - ELSIF c = OPM.Array THEN + ELSIF c = Array THEN IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n) - ELSIF f = OPM.ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) + ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) END; typ^.idfp := idfp END @@ -316,10 +398,10 @@ PROCEDURE FPrintStr*(typ: Struct); PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *) VAR i, j, n: LONGINT; btyp: Struct; BEGIN - IF typ^.comp = OPM.Record THEN FPrintFlds(typ^.link, adr, FALSE) - ELSIF typ^.comp = OPM.Array THEN btyp := typ^.BaseTyp; n := typ^.n; - WHILE btyp^.comp = OPM.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END; - IF (btyp^.form = OPM.Pointer) OR (btyp^.comp = OPM.Record) THEN + IF typ^.comp = Record THEN FPrintFlds(typ^.link, adr, FALSE) + ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n; + WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END; + IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN j := nofhdfld; FPrintHdFld(btyp, fld, adr); IF j # nofhdfld THEN i := 1; WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO @@ -327,17 +409,17 @@ PROCEDURE FPrintStr*(typ: Struct); END END END - ELSIF OPM.ExpHdPtrFld & ((typ^.form = OPM.Pointer) OR (fld^.name = OPM.HdPtrName)) THEN - OPM.FPrint(pvfp, OPM.Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld) - ELSIF OPM.ExpHdProcFld & ((typ^.form = OPM.ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN - OPM.FPrint(pvfp, OPM.ProcTyp); OPM.FPrint(pvfp, adr); INC(nofhdfld) + ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN + OPM.FPrint(pvfp, Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld) + ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN + OPM.FPrint(pvfp, ProcTyp); OPM.FPrint(pvfp, adr); INC(nofhdfld) END END FPrintHdFld; PROCEDURE FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); (* modifies pbfp and pvfp *) BEGIN - WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO - IF (fld^.vis # OPM.internal) & visible THEN + WHILE (fld # NIL) & (fld^.mode = Fld) DO + IF (fld^.vis # internal) & visible THEN OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp) ELSE @@ -351,12 +433,12 @@ PROCEDURE FPrintStr*(typ: Struct); BEGIN IF obj # NIL THEN FPrintTProcs(obj^.left); - IF obj^.mode = OPM.TProc THEN - IF obj^.vis # OPM.internal THEN - OPM.FPrint(pbfp, OPM.TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H); + IF obj^.mode = TProc THEN + IF obj^.vis # internal THEN + OPM.FPrint(pbfp, TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H); FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name) ELSIF OPM.ExpHdTProc THEN - OPM.FPrint(pvfp, OPM.TProc); OPM.FPrint(pvfp, obj^.adr DIV 10000H) + OPM.FPrint(pvfp, TProc); OPM.FPrint(pvfp, obj^.adr DIV 10000H) END END; FPrintTProcs(obj^.right) @@ -370,15 +452,15 @@ BEGIN pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *) typ^.fpdone := TRUE; f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp; - IF f = OPM.Pointer THEN + IF f = Pointer THEN strobj := typ^.strobj; bstrobj := btyp^.strobj; IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); pvfp := pbfp (* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *) END - ELSIF f = OPM.ProcTyp THEN (* use idfp as pbfp and as pvfp *) - ELSIF c IN {OPM.Array, OPM.DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp - ELSE (* c = OPM.Record *) + ELSIF f = ProcTyp THEN (* use idfp as pbfp and as pvfp *) + ELSIF c IN {Array, DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp + ELSE (* c = Record *) IF btyp # NIL THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); OPM.FPrint(pvfp, btyp^.pvfp) END; OPM.FPrint(pvfp, typ^.size); OPM.FPrint(pvfp, typ^.align); OPM.FPrint(pvfp, typ^.n); nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE); @@ -396,30 +478,30 @@ BEGIN IF ~obj^.fpdone THEN fprint := 0; obj^.fpdone := TRUE; OPM.FPrint(fprint, obj^.mode); - IF obj^.mode = OPM.Con THEN + IF obj^.mode = Con THEN f := obj^.typ^.form; OPM.FPrint(fprint, f); CASE f OF - | OPM.Bool, - OPM.Char, - OPM.SInt, - OPM.Int, - OPM.LInt: OPM.FPrint(fprint, obj^.conval^.intval) - | OPM.Set: OPM.FPrintSet(fprint, obj^.conval^.setval) - | OPM.Real: rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval) - | OPM.LReal: OPM.FPrintLReal(fprint, obj^.conval^.realval) - | OPM.String: FPrintName(fprint, obj^.conval^.ext^) - | OPM.NilTyp: + | Bool, + Char, + SInt, + Int, + LInt: OPM.FPrint(fprint, obj^.conval^.intval) + | Set: OPM.FPrintSet(fprint, obj^.conval^.setval) + | Real: rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval) + | LReal: OPM.FPrintLReal(fprint, obj^.conval^.realval) + | String: FPrintName(fprint, obj^.conval^.ext^) + | NilTyp: ELSE err(127) END - ELSIF obj^.mode = OPM.Var THEN + ELSIF obj^.mode = Var THEN OPM.FPrint(fprint, obj^.vis); FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) - ELSIF obj^.mode IN {OPM.XProc, OPM.IProc} THEN + ELSIF obj^.mode IN {XProc, IProc} THEN FPrintSign(fprint, obj^.typ, obj^.link) - ELSIF obj^.mode = OPM.CProc THEN + ELSIF obj^.mode = CProc THEN FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext; m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m); WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END; - ELSIF obj^.mode = OPM.Typ THEN + ELSIF obj^.mode = Typ THEN FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) END; obj^.fprint := fprint @@ -495,7 +577,7 @@ BEGIN WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END; IF i < nofGmod THEN mno := i (*module already present*) ELSE - head := NewObj(); head^.mode := OPM.Head; COPY(name, head^.name); + head := NewObj(); head^.mode := Head; COPY(name, head^.name); mno := nofGmod; head^.mnolev := -mno; IF nofGmod < maxImps THEN GlbMod[mno] := head; INC(nofGmod) @@ -513,25 +595,25 @@ PROCEDURE InConstant(f: LONGINT; conval: Const); VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; BEGIN CASE f OF - | OPM.Byte, - OPM.Char, - OPM.Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch) - | OPM.SInt, - OPM.Int, - OPM.LInt: conval^.intval := OPM.SymRInt() - | OPM.Set: OPM.SymRSet(conval^.setval) - | OPM.Real: OPM.SymRReal(rval); conval^.realval := rval; - conval^.intval := OPM.ConstNotAlloc - | OPM.LReal: OPM.SymRLReal(conval^.realval); - conval^.intval := OPM.ConstNotAlloc - | OPM.String: ext := NewExt(); conval^.ext := ext; i := 0; - REPEAT - OPM.SymRCh(ch); ext^[i] := ch; INC(i) - UNTIL ch = 0X; - conval^.intval2 := i; - conval^.intval := OPM.ConstNotAlloc - | OPM.NilTyp: conval^.intval := OPM.nilval - ELSE OPM.LogWStr("unhandled case in OPT.InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn; + | Byte, + Char, + Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch) + | SInt, + Int, + LInt: conval^.intval := OPM.SymRInt() + | Set: OPM.SymRSet(conval^.setval) + | Real: OPM.SymRReal(rval); conval^.realval := rval; + conval^.intval := OPM.ConstNotAlloc + | LReal: OPM.SymRLReal(conval^.realval); + conval^.intval := OPM.ConstNotAlloc + | String: ext := NewExt(); conval^.ext := ext; i := 0; + REPEAT + OPM.SymRCh(ch); ext^[i] := ch; INC(i) + UNTIL ch = 0X; + conval^.intval2 := i; + conval^.intval := OPM.ConstNotAlloc + | NilTyp: conval^.intval := OPM.nilval + ELSE OPM.LogWStr("unhandled case in InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn; END END InConstant; @@ -545,7 +627,7 @@ BEGIN WHILE tag # Send DO new := NewObj(); new^.mnolev := -mno; IF last = NIL THEN par := new ELSE last^.link := new END; - IF tag = Svalpar THEN new^.mode := OPM.Var ELSE new^.mode := OPM.VarPar END; + IF tag = Svalpar THEN new^.mode := Var ELSE new^.mode := VarPar END; InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name); last := new; tag := OPM.SymRInt() END @@ -556,14 +638,14 @@ PROCEDURE InFld(): Object; (* first number in impCtxt.nextTag, mno set outside BEGIN tag := impCtxt.nextTag; obj := NewObj(); IF tag <= Srfld THEN - obj^.mode := OPM.Fld; - IF tag = Srfld THEN obj^.vis := OPM.externalR ELSE obj^.vis := OPM.external END; + obj^.mode := Fld; + IF tag = Srfld THEN obj^.vis := externalR ELSE obj^.vis := external END; InStruct(obj^.typ); InName(obj^.name); obj^.adr := OPM.SymRInt() ELSE - obj^.mode := OPM.Fld; + obj^.mode := Fld; IF tag = Shdptr THEN obj^.name := OPM.HdPtrName ELSE obj^.name := OPM.HdProcName END; - obj^.typ := undftyp; obj^.vis := OPM.internal; + obj^.typ := undftyp; obj^.vis := internal; obj^.adr := OPM.SymRInt() END; RETURN obj @@ -575,13 +657,13 @@ BEGIN tag := impCtxt.nextTag; obj := NewObj(); obj^.mnolev := -mno; IF tag = Stpro THEN - obj^.mode := OPM.TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1; - InSign(mno, obj^.typ, obj^.link); obj^.vis := OPM.external; InName(obj^.name); + obj^.mode := TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1; + InSign(mno, obj^.typ, obj^.link); obj^.vis := external; InName(obj^.name); obj^.adr := 10000H*OPM.SymRInt() ELSE (* tag = Shdtpro *) - obj^.mode := OPM.TProc; obj^.name := OPM.HdTProcName; + obj^.mode := TProc; obj^.name := OPM.HdTProcName; obj^.link := NewObj(); (* dummy, easier in Browser *) - obj^.typ := undftyp; obj^.vis := OPM.internal; + obj^.typ := undftyp; obj^.vis := internal; obj^.adr := 10000H*OPM.SymRInt() END; RETURN obj @@ -604,43 +686,43 @@ BEGIN ELSE obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" END; - typ := NewStr(OPM.Undef, OPM.Basic) + typ := NewStr(Undef, Basic) ELSE obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); IF old # NIL THEN (* recalculate fprints to compare with old fprints *) FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; IF impCtxt.self THEN (* do not overwrite old typ *) - typ := NewStr(OPM.Undef, OPM.Basic) + typ := NewStr(Undef, Basic) ELSE (* overwrite old typ for compatibility reason *) typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; typ^.fpdone := FALSE; typ^.idfpdone := FALSE END ELSE - typ := NewStr(OPM.Undef, OPM.Basic) + typ := NewStr(Undef, Basic) END END; impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; typ^.ref := ref + maxStruct; (* ref >= maxStruct: not exported yet, ref used for err 155 *) typ^.mno := mno; typ^.allocated := TRUE; - typ^.strobj := obj; obj^.mode := OPM.Typ; obj^.typ := typ; - obj^.mnolev := -mno; obj^.vis := OPM.internal; (* name not visible here *) + typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ; + obj^.mnolev := -mno; obj^.vis := internal; (* name not visible here *) tag := OPM.SymRInt(); IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END; CASE tag OF - | Sptr: typ^.form := OPM.Pointer; typ^.size := OPM.PointerSize; + | Sptr: typ^.form := Pointer; typ^.size := OPM.PointerSize; typ^.n := 0; InStruct(typ^.BaseTyp) - | Sarr: typ^.form := OPM.Comp; typ^.comp := OPM.Array; + | Sarr: typ^.form := Comp; typ^.comp := Array; InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); typSize(typ) (* no bounds address !! *) - | Sdarr: typ^.form := OPM.Comp; typ^.comp := OPM.DynArr; InStruct(typ^.BaseTyp); - IF typ^.BaseTyp^.comp = OPM.DynArr THEN + | Sdarr: typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); + IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1 ELSE typ^.n := 0 END; typSize(typ) - | Srec: typ^.form := OPM.Comp; typ^.comp := OPM.Record; + | Srec: typ^.form := Comp; typ^.comp := Record; InStruct(typ^.BaseTyp); IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; typ.extlev := 0; t := typ.BaseTyp; @@ -662,9 +744,9 @@ BEGIN InsertImport(fld, typ^.link, dummy); impCtxt.nextTag := OPM.SymRInt() END - | Spro: typ^.form := OPM.ProcTyp; typ^.size := OPM.ProcSize; + | Spro: typ^.form := ProcTyp; typ^.size := OPM.ProcSize; InSign(mno, typ^.BaseTyp, typ^.link) - ELSE OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; + ELSE OPM.LogWStr("unhandled case at InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; END; IF ref = impCtxt.minr THEN WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO @@ -676,36 +758,36 @@ BEGIN t^.strobj := old; (* restore strobj *) IF impCtxt.self THEN IF old^.mnolev < 0 THEN - IF old^.history # OPM.inconsistent THEN + IF old^.history # inconsistent THEN IF old^.fprint # obj^.fprint THEN - old^.history := OPM.pbmodified + old^.history := pbmodified ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN - old^.history := OPM.pvmodified + old^.history := pvmodified END - (* ELSE remain OPM.inconsistent *) + (* ELSE remain inconsistent *) END ELSIF old^.fprint # obj^.fprint THEN - old^.history := OPM.pbmodified + old^.history := pbmodified ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN - old^.history := OPM.pvmodified - ELSIF old^.vis = OPM.internal THEN - old^.history := OPM.same (* may be changed to "OPM.removed" in InObj *) + old^.history := pvmodified + ELSIF old^.vis = internal THEN + old^.history := same (* may be changed to "removed" in InObj *) ELSE - old^.history := OPM.inserted (* may be changed to "OPM.same" in InObj *) + old^.history := inserted (* may be changed to "same" in InObj *) END ELSE (* check private part, delay error message until really used *) IF impCtxt.pvfp[ref] # t^.pvfp THEN - old^.history := OPM.inconsistent + old^.history := inconsistent END; IF old^.fprint # obj^.fprint THEN FPrintErr(old, 249) END END ELSIF impCtxt.self THEN - obj^.history := OPM.removed + obj^.history := removed ELSE - obj^.history := OPM.same + obj^.history := same END; INC(ref) END; @@ -721,35 +803,35 @@ BEGIN tag := impCtxt.nextTag; IF tag = Stype THEN InStruct(typ); obj := typ^.strobj; - IF ~impCtxt.self THEN obj^.vis := OPM.external END (* type name visible now, obj^.fprint already done *) + IF ~impCtxt.self THEN obj^.vis := external END (* type name visible now, obj^.fprint already done *) ELSE - obj := NewObj(); obj^.mnolev := -mno; obj^.vis := OPM.external; - IF tag <= OPM.Pointer THEN (* Constant *) - obj^.mode := OPM.Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval) + obj := NewObj(); obj^.mnolev := -mno; obj^.vis := external; + IF tag <= Pointer THEN (* Constant *) + obj^.mode := Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval) ELSIF tag >= Sxpro THEN obj^.conval := NewConst(); obj^.conval^.intval := -1; InSign(mno, obj^.typ, obj^.link); CASE tag OF - | Sxpro: obj^.mode := OPM.XProc - | Sipro: obj^.mode := OPM.IProc - | Scpro: obj^.mode := OPM.CProc; + | Sxpro: obj^.mode := XProc + | Sipro: obj^.mode := IProc + | Scpro: obj^.mode := CProc; ext := NewExt(); obj^.conval^.ext := ext; s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END - ELSE OPM.LogWStr("unhandled case at OPT.InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; + ELSE OPM.LogWStr("unhandled case at InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; END ELSIF tag = Salias THEN - obj^.mode := OPM.Typ; InStruct(obj^.typ) + obj^.mode := Typ; InStruct(obj^.typ) ELSE - obj^.mode := OPM.Var; - IF tag = Srvar THEN obj^.vis := OPM.externalR END; + obj^.mode := Var; + IF tag = Srvar THEN obj^.vis := externalR END; InStruct(obj^.typ) END; InName(obj^.name) END; FPrintObj(obj); - IF (obj^.mode = OPM.Var) & ((obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "")) THEN + IF (obj^.mode = Var) & ((obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "")) THEN (* compute a global fingerprint to avoid structural type equivalence for anonymous types *) OPM.FPrint(impCtxt.reffp, obj^.typ^.ref - maxStruct) END; @@ -758,21 +840,21 @@ BEGIN IF impCtxt.self THEN IF old # NIL THEN (* obj is from old symbol file, old is new declaration *) - IF old^.vis = OPM.internal THEN old^.history := OPM.removed + IF old^.vis = internal THEN old^.history := removed ELSE FPrintObj(old); (* FPrint(obj) already called *) - IF obj^.fprint # old^.fprint THEN old^.history := OPM.pbmodified - ELSIF obj^.typ^.pvfp # old^.typ^.pvfp THEN old^.history := OPM.pvmodified - ELSE old^.history := OPM.same + IF obj^.fprint # old^.fprint THEN old^.history := pbmodified + ELSIF obj^.typ^.pvfp # old^.typ^.pvfp THEN old^.history := pvmodified + ELSE old^.history := same END END - ELSE obj^.history := OPM.removed (* OutObj not called if mnolev < 0 *) + ELSE obj^.history := removed (* OutObj not called if mnolev < 0 *) END (* ELSE old = NIL, or file read twice, consistent, OutObj not called *) END - ELSE (* obj already OPM.inserted in InStruct *) + ELSE (* obj already inserted in InStruct *) IF impCtxt.self THEN (* obj^.mnolev = 0 *) - IF obj^.vis = OPM.internal THEN obj^.history := OPM.removed - ELSIF obj^.history = OPM.inserted THEN obj^.history := OPM.same + IF obj^.vis = internal THEN obj^.history := removed + ELSIF obj^.history = inserted THEN obj^.history := same END (* ELSE OutObj not called for obj with mnolev < 0 *) END @@ -784,7 +866,7 @@ PROCEDURE Import*(aliasName: OPS.Name; VAR name: OPS.Name; VAR done: BOOLEAN); VAR obj: Object; mno: SHORTINT; (* done used in Browser *) BEGIN IF name = "SYSTEM" THEN SYSimported := TRUE; - Insert(aliasName, obj); obj^.mode := OPM.Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp + Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp ELSE impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0; impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0; @@ -796,7 +878,7 @@ BEGIN obj := InObj(mno); impCtxt.nextTag := OPM.SymRInt() END; Insert(aliasName, obj); - obj^.mode := OPM.Mod; obj^.scope := GlbMod[mno].right; + obj^.mode := Mod; obj^.scope := GlbMod[mno].right; GlbMod[mno].link := obj; obj^.mnolev := -mno; obj^.typ := notyp; OPM.CloseOldSym @@ -831,10 +913,10 @@ END Import; PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT); VAR i, j, n: LONGINT; btyp: Struct; BEGIN - IF typ^.comp = OPM.Record THEN OutFlds(typ^.link, adr, FALSE) - ELSIF typ^.comp = OPM.Array THEN btyp := typ^.BaseTyp; n := typ^.n; - WHILE btyp^.comp = OPM.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END; - IF (btyp^.form = OPM.Pointer) OR (btyp^.comp = OPM.Record) THEN + IF typ^.comp = Record THEN OutFlds(typ^.link, adr, FALSE) + ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n; + WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END; + IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN j := nofhdfld; OutHdFld(btyp, fld, adr); IF j # nofhdfld THEN i := 1; WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO @@ -842,18 +924,18 @@ END Import; END END END - ELSIF OPM.ExpHdPtrFld & ((typ^.form = OPM.Pointer) OR (fld^.name = OPM.HdPtrName)) THEN + ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN OPM.SymWInt(Shdptr); OPM.SymWInt(adr); INC(nofhdfld) - ELSIF OPM.ExpHdProcFld & ((typ^.form = OPM.ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN + ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN OPM.SymWInt(Shdpro); OPM.SymWInt(adr); INC(nofhdfld) END END OutHdFld; PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); BEGIN - WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO - IF (fld^.vis # OPM.internal) & visible THEN - IF fld^.vis = OPM.externalR THEN OPM.SymWInt(Srfld) ELSE OPM.SymWInt(Sfld) END; + WHILE (fld # NIL) & (fld^.mode = Fld) DO + IF (fld^.vis # internal) & visible THEN + IF fld^.vis = externalR THEN OPM.SymWInt(Srfld) ELSE OPM.SymWInt(Sfld) END; OutStr(fld^.typ); OutName(fld^.name); OPM.SymWInt(fld^.adr) ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr) END; @@ -865,7 +947,7 @@ END Import; BEGIN OutStr(result); WHILE par # NIL DO - IF par^.mode = OPM.Var THEN OPM.SymWInt(Svalpar) ELSE OPM.SymWInt(Svarpar) END; + IF par^.mode = Var THEN OPM.SymWInt(Svalpar) ELSE OPM.SymWInt(Svarpar) END; OutStr(par^.typ); OPM.SymWInt(par^.adr); OutName(par^.name); par := par^.link @@ -877,13 +959,13 @@ END Import; BEGIN IF obj # NIL THEN OutTProcs(typ, obj^.left); - IF obj^.mode = OPM.TProc THEN - IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = OPM.internal) THEN + IF obj^.mode = TProc THEN + IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = internal) THEN OPM.Mark(109, typ^.txtpos) (* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *) END; - IF OPM.ExpHdTProc OR (obj^.vis # OPM.internal) THEN - IF obj^.vis # OPM.internal THEN + IF OPM.ExpHdTProc OR (obj^.vis # internal) THEN + IF obj^.vis # internal THEN OPM.SymWInt(Stpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name); OPM.SymWInt(obj^.adr DIV 10000H) ELSE @@ -908,31 +990,31 @@ END Import; IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name); CASE strobj^.history OF - | OPM.pbmodified: FPrintErr(strobj, 252) - | OPM.pvmodified: FPrintErr(strobj, 251) - | OPM.inconsistent: FPrintErr(strobj, 249) + | pbmodified: FPrintErr(strobj, 252) + | pvmodified: FPrintErr(strobj, 251) + | inconsistent: FPrintErr(strobj, 249) ELSE (* checked in OutObj or correct indirect export *) - (* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) + (* OPM.LogWStr("unhandled case at OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) END - ELSE OPM.SymWCh(0X) (* anonymous => never OPM.inconsistent, pvfp influences the client fp *) + ELSE OPM.SymWCh(0X) (* anonymous => never inconsistent, pvfp influences the client fp *) END; IF typ^.sysflag # 0 THEN OPM.SymWInt(Ssys); OPM.SymWInt(typ^.sysflag) END; CASE typ^.form OF - | OPM.Pointer: OPM.SymWInt(Sptr); OutStr(typ^.BaseTyp) - | OPM.ProcTyp: OPM.SymWInt(Spro); OutSign(typ^.BaseTyp, typ^.link) - | OPM.Comp: CASE typ^.comp OF - | OPM.Array: OPM.SymWInt(Sarr); OutStr(typ^.BaseTyp); OPM.SymWInt(typ^.n) - | OPM.DynArr: OPM.SymWInt(Sdarr); OutStr(typ^.BaseTyp) - | OPM.Record: OPM.SymWInt(Srec); + | Pointer: OPM.SymWInt(Sptr); OutStr(typ^.BaseTyp) + | ProcTyp: OPM.SymWInt(Spro); OutSign(typ^.BaseTyp, typ^.link) + | Comp: CASE typ^.comp OF + | Array: OPM.SymWInt(Sarr); OutStr(typ^.BaseTyp); OPM.SymWInt(typ^.n) + | DynArr: OPM.SymWInt(Sdarr); OutStr(typ^.BaseTyp) + | Record: OPM.SymWInt(Srec); IF typ^.BaseTyp = NIL THEN OutStr(notyp) ELSE OutStr(typ^.BaseTyp) END; (* BaseTyp should be Notyp, too late to change *) OPM.SymWInt(typ^.size); OPM.SymWInt(typ^.align); OPM.SymWInt(typ^.n); nofhdfld := 0; OutFlds(typ^.link, 0, TRUE); IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END; OutTProcs(typ, typ^.link); OPM.SymWInt(Send) - ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn; + ELSE OPM.LogWStr("unhandled case at OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn; END - ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; + ELSE OPM.LogWStr("unhandled case at OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; END END END OutStr; @@ -942,16 +1024,16 @@ END Import; BEGIN f := obj^.typ^.form; OPM.SymWInt(f); CASE f OF - | OPM.Bool, - OPM.Char: OPM.SymWCh(CHR(obj^.conval^.intval)) - | OPM.SInt, - OPM.Int, - OPM.LInt: OPM.SymWInt(obj^.conval^.intval) - | OPM.Set: OPM.SymWSet(obj^.conval^.setval) - | OPM.Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval) - | OPM.LReal: OPM.SymWLReal(obj^.conval^.realval) - | OPM.String: OutName(obj^.conval^.ext^) - | OPM.NilTyp: + | Bool, + Char: OPM.SymWCh(CHR(obj^.conval^.intval)) + | SInt, + Int, + LInt: OPM.SymWInt(obj^.conval^.intval) + | Set: OPM.SymWSet(obj^.conval^.setval) + | Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval) + | LReal: OPM.SymWLReal(obj^.conval^.realval) + | String: OutName(obj^.conval^.ext^) + | NilTyp: ELSE err(127) END END OutConstant; @@ -961,34 +1043,34 @@ END Import; BEGIN IF obj # NIL THEN OutObj(obj^.left); - IF obj^.mode IN {OPM.Con, OPM.Typ, OPM.Var, OPM.LProc, OPM.XProc, OPM.CProc, OPM.IProc} THEN - IF obj^.history = OPM.removed THEN FPrintErr(obj, 250) - ELSIF obj^.vis # OPM.internal THEN + IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN + IF obj^.history = removed THEN FPrintErr(obj, 250) + ELSIF obj^.vis # internal THEN CASE obj^.history OF - | OPM.inserted: FPrintErr(obj, 253) - | OPM.same: (* ok *) - | OPM.pbmodified: FPrintErr(obj, 252) - | OPM.pvmodified: FPrintErr(obj, 251) - ELSE OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; + | inserted: FPrintErr(obj, 253) + | same: (* ok *) + | pbmodified: FPrintErr(obj, 252) + | pvmodified: FPrintErr(obj, 251) + ELSE OPM.LogWStr("unhandled case at OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; END; CASE obj^.mode OF - | OPM.Con: OutConstant(obj); OutName(obj^.name) - | OPM.Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ) + | Con: OutConstant(obj); OutName(obj^.name) + | Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ) ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name) END - | OPM.Var: IF obj^.vis = OPM.externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END; + | Var: IF obj^.vis = externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END; OutStr(obj^.typ); OutName(obj^.name); IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN (* compute fingerprint to avoid structural type equivalence *) OPM.FPrint(expCtxt.reffp, obj^.typ^.ref) END - | OPM.XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) - | OPM.IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) - | OPM.CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext; + | XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) + | IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) + | CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext; j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END; OutName(obj^.name) - ELSE OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; + ELSE OPM.LogWStr("unhandled case at OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; END END END; @@ -1029,7 +1111,7 @@ END Import; PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT); BEGIN - typ := NewStr(form, OPM.Basic); typ^.ref := form; typ^.size := OPM.ByteSize; typ^.allocated := TRUE; + typ := NewStr(form, Basic); typ^.ref := form; typ^.size := OPM.ByteSize; typ^.allocated := TRUE; typ^.strobj := NewObj(); typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE; typ^.idfp := form; typ^.idfpdone := TRUE END InitStruct; @@ -1038,14 +1120,14 @@ END Import; VAR obj: Object; BEGIN Insert(name, obj); obj^.conval := NewConst(); - obj^.mode := OPM.Con; obj^.typ := booltyp; obj^.conval^.intval := value + obj^.mode := Con; obj^.typ := booltyp; obj^.conval^.intval := value END EnterBoolConst; PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct); VAR obj: Object; typ: Struct; BEGIN Insert(name, obj); - typ := NewStr(form, OPM.Basic); obj^.mode := OPM.Typ; obj^.typ := typ; obj^.vis := OPM.external; + typ := NewStr(form, Basic); obj^.mode := Typ; obj^.typ := typ; obj^.vis := external; typ^.strobj := obj; typ^.size := size; typ^.ref := form; typ^.allocated := TRUE; typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE; typ^.idfp := form; typ^.idfpdone := TRUE; res := typ @@ -1054,80 +1136,80 @@ END Import; PROCEDURE EnterProc(name: OPS.Name; num: INTEGER); VAR obj: Object; BEGIN Insert(name, obj); - obj^.mode := OPM.SProc; obj^.typ := notyp; obj^.adr := num + obj^.mode := SProc; obj^.typ := notyp; obj^.adr := num END EnterProc; BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; - InitStruct(undftyp, OPM.Undef); InitStruct(notyp, OPM.NoTyp); - InitStruct(stringtyp, OPM.String); InitStruct(niltyp, OPM.NilTyp); + InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp); + InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp); undftyp^.BaseTyp := undftyp; (*initialization of module SYSTEM*) - EnterTyp("BYTE", OPM.Byte, OPM.ByteSize, bytetyp); - EnterTyp("PTR", OPM.Pointer, OPM.PointerSize, sysptrtyp); - EnterProc("ADR", OPM.adrfn); - EnterProc("CC", OPM.ccfn); - EnterProc("LSH", OPM.lshfn); - EnterProc("ROT", OPM.rotfn); - EnterProc("GET", OPM.getfn); - EnterProc("PUT", OPM.putfn); - EnterProc("GETREG", OPM.getrfn); - EnterProc("PUTREG", OPM.putrfn); - EnterProc("BIT", OPM.bitfn); - EnterProc("VAL", OPM.valfn); - EnterProc("NEW", OPM.sysnewfn); - EnterProc("MOVE", OPM.movefn); + EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp); + EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp); + EnterProc("ADR", adrfn); + EnterProc("CC", ccfn); + EnterProc("LSH", lshfn); + EnterProc("ROT", rotfn); + EnterProc("GET", getfn); + EnterProc("PUT", putfn); + EnterProc("GETREG", getrfn); + EnterProc("PUTREG", putrfn); + EnterProc("BIT", bitfn); + EnterProc("VAL", valfn); + EnterProc("NEW", sysnewfn); + EnterProc("MOVE", movefn); syslink := topScope^.right; universe := topScope; topScope^.right := NIL; - EnterTyp("BOOLEAN", OPM.Bool, OPM.BoolSize, booltyp); - EnterTyp("CHAR", OPM.Char, OPM.CharSize, chartyp); - EnterTyp("SET", OPM.Set, OPM.SetSize, settyp); - EnterTyp("REAL", OPM.Real, OPM.RealSize, realtyp); - EnterTyp("INTEGER", OPM.Int, OPM.IntSize, inttyp); - EnterTyp("LONGINT", OPM.LInt, OPM.LIntSize, linttyp); - EnterTyp("LONGREAL", OPM.LReal, OPM.LRealSize, lrltyp); - EnterTyp("SHORTINT", OPM.SInt, OPM.SIntSize, sinttyp); + EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp); + EnterTyp("CHAR", Char, OPM.CharSize, chartyp); + EnterTyp("SET", Set, OPM.SetSize, settyp); + EnterTyp("REAL", Real, OPM.RealSize, realtyp); + EnterTyp("INTEGER", Int, OPM.IntSize, inttyp); + EnterTyp("LONGINT", LInt, OPM.LIntSize, linttyp); + EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp); + EnterTyp("SHORTINT", SInt, OPM.SIntSize, sinttyp); - EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler OPM.internal representation only *) + EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler internal representation only *) EnterBoolConst("TRUE", 1); - EnterProc("HALT", OPM.haltfn); - EnterProc("NEW", OPM.newfn); - EnterProc("ABS", OPM.absfn); - EnterProc("CAP", OPM.capfn); - EnterProc("ORD", OPM.ordfn); - EnterProc("ENTIER", OPM.entierfn); - EnterProc("ODD", OPM.oddfn); - EnterProc("MIN", OPM.minfn); - EnterProc("MAX", OPM.maxfn); - EnterProc("CHR", OPM.chrfn); - EnterProc("SHORT", OPM.shortfn); - EnterProc("LONG", OPM.longfn); - EnterProc("SIZE", OPM.sizefn); - EnterProc("INC", OPM.incfn); - EnterProc("DEC", OPM.decfn); - EnterProc("INCL", OPM.inclfn); - EnterProc("EXCL", OPM.exclfn); - EnterProc("LEN", OPM.lenfn); - EnterProc("COPY", OPM.copyfn); - EnterProc("ASH", OPM.ashfn); - EnterProc("ASSERT", OPM.assertfn); + EnterProc("HALT", haltfn); + EnterProc("NEW", newfn); + EnterProc("ABS", absfn); + EnterProc("CAP", capfn); + EnterProc("ORD", ordfn); + EnterProc("ENTIER", entierfn); + EnterProc("ODD", oddfn); + EnterProc("MIN", minfn); + EnterProc("MAX", maxfn); + EnterProc("CHR", chrfn); + EnterProc("SHORT", shortfn); + EnterProc("LONG", longfn); + EnterProc("SIZE", sizefn); + EnterProc("INC", incfn); + EnterProc("DEC", decfn); + EnterProc("INCL", inclfn); + EnterProc("EXCL", exclfn); + EnterProc("LEN", lenfn); + EnterProc("COPY", copyfn); + EnterProc("ASH", ashfn); + EnterProc("ASSERT", assertfn); - impCtxt.ref[OPM.Undef] := undftyp; - impCtxt.ref[OPM.Byte] := bytetyp; - impCtxt.ref[OPM.Bool] := booltyp; - impCtxt.ref[OPM.Char] := chartyp; - impCtxt.ref[OPM.SInt] := sinttyp; - impCtxt.ref[OPM.Int] := inttyp; - impCtxt.ref[OPM.LInt] := linttyp; - impCtxt.ref[OPM.Real] := realtyp; - impCtxt.ref[OPM.LReal] := lrltyp; - impCtxt.ref[OPM.Set] := settyp; - impCtxt.ref[OPM.String] := stringtyp; - impCtxt.ref[OPM.NilTyp] := niltyp; - impCtxt.ref[OPM.NoTyp] := notyp; - impCtxt.ref[OPM.Pointer] := sysptrtyp + impCtxt.ref[Undef] := undftyp; + impCtxt.ref[Byte] := bytetyp; + impCtxt.ref[Bool] := booltyp; + impCtxt.ref[Char] := chartyp; + impCtxt.ref[SInt] := sinttyp; + impCtxt.ref[Int] := inttyp; + impCtxt.ref[LInt] := linttyp; + impCtxt.ref[Real] := realtyp; + impCtxt.ref[LReal] := lrltyp; + impCtxt.ref[Set] := settyp; + impCtxt.ref[String] := stringtyp; + impCtxt.ref[NilTyp] := niltyp; + impCtxt.ref[NoTyp] := notyp; + impCtxt.ref[Pointer] := sysptrtyp END OPT. Objects: diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod index b62793a8..7e29244e 100644 --- a/src/compiler/OPV.Mod +++ b/src/compiler/OPV.Mod @@ -1,6 +1,6 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 - 26.7.2002 jt bug fix OPM.in Len: wrong result if called for fixed OPM.Array + 26.7.2002 jt bug fix OPM.in Len: wrong result if called for fixed OPT.Array 31.1.2007 jt synchronized with BlackBox version, in particular: various promotion rules changed (long) => (LONGINT), xxxL avoided *) @@ -75,12 +75,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF typ = OPT.undftyp THEN OPM.err(58) ELSIF typ^.size = -1 THEN f := typ^.form; c := typ^.comp; - IF c = OPM.Record THEN btyp := typ^.BaseTyp; + IF c = OPT.Record THEN btyp := typ^.BaseTyp; IF btyp = NIL THEN offset := 0; base := (*OPM.RecAlign*)OPC.SizeAlignment(OPM.RecSize); ELSE TypSize(btyp); offset := btyp^.size - btyp^.sysflag DIV 100H; base := btyp^.align; END; fld := typ^.link; - WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO + WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO btyp := fld^.typ; TypSize(btyp); size := btyp^.size; fbase := OPC.BaseAlignment(btyp); OPC.Align(offset, fbase); @@ -96,19 +96,19 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 typ^.size := offset; typ^.align := base; (* encode the trailing gap into the symbol table to allow dense packing of extended records *) typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H) - ELSIF c = OPM.Array THEN + ELSIF c = OPT.Array THEN TypSize(typ^.BaseTyp); typ^.size := typ^.n * typ^.BaseTyp^.size; - ELSIF f = OPM.Pointer THEN + ELSIF f = OPT.Pointer THEN typ^.size := OPM.PointerSize; IF typ^.BaseTyp = OPT.undftyp THEN OPM.Mark(128, typ^.n) ELSE TypSize(typ^.BaseTyp) END - ELSIF f = OPM.ProcTyp THEN + ELSIF f = OPT.ProcTyp THEN typ^.size := OPM.ProcSize; - ELSIF c = OPM.DynArr THEN + ELSIF c = OPT.DynArr THEN btyp := typ^.BaseTyp; TypSize(btyp); - IF btyp^.comp = OPM.DynArr THEN typ^.size := btyp^.size + 4 (* describes dim not size *) + IF btyp^.comp = OPT.DynArr THEN typ^.size := btyp^.size + 4 (* describes dim not size *) ELSE typ^.size := 8 END END @@ -131,10 +131,10 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 BEGIN oldPos := OPM.errpos; OPM.errpos := obj^.scope^.adr; typ := obj^.link^.typ; - IF typ^.form = OPM.Pointer THEN typ := typ^.BaseTyp END ; + IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ; OPT.FindField(obj^.name, typ^.BaseTyp, redef); IF redef # NIL THEN obj^.adr := 10000H*(redef^.adr DIV 10000H) (*mthno*); - IF ~(OPM.isRedef IN obj^.conval^.setval) THEN OPM.err(119) END + IF ~(OPT.isRedef IN obj^.conval^.setval) THEN OPM.err(119) END ELSE INC(obj^.adr, 10000H*typ^.n); INC(typ^.n) END ; OPM.errpos := oldPos @@ -168,23 +168,23 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF obj^.name[0] = "@" THEN obj^.name[0] := "_"; Stamp(obj^.name) END ; (* translate and make unique @for, ... *) obj^.linkadr := UndefinedType; mode := obj^.mode; - IF (mode = OPM.Typ) & ((obj^.vis # OPM.internal) = exported) THEN + IF (mode = OPT.Typ) & ((obj^.vis # OPT.internal) = exported) THEN typ := obj^.typ; TypSize(obj^.typ); - IF typ^.form = OPM.Pointer THEN typ := typ^.BaseTyp END ; - IF typ^.comp = OPM.Record THEN TraverseRecord(typ) END - ELSIF mode = OPM.TProc THEN GetTProcNum(obj) - ELSIF mode = OPM.Var THEN TypSize(obj^.typ) + IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ; + IF typ^.comp = OPT.Record THEN TraverseRecord(typ) END + ELSIF mode = OPT.TProc THEN GetTProcNum(obj) + ELSIF mode = OPT.Var THEN TypSize(obj^.typ) END ; IF ~exported THEN (* do this only once *) - IF (mode IN {OPM.LProc, OPM.Typ}) & (obj^.mnolev > 0) THEN Stamp(obj^.name) END ; - IF mode IN {OPM.Var, OPM.VarPar, OPM.Typ} THEN + IF (mode IN {OPT.LProc, OPT.Typ}) & (obj^.mnolev > 0) THEN Stamp(obj^.name) END ; + IF mode IN {OPT.Var, OPT.VarPar, OPT.Typ} THEN obj^.scope := outerScope - ELSIF mode IN {OPM.LProc, OPM.XProc, OPM.TProc, OPM.CProc, OPM.IProc} THEN + ELSIF mode IN {OPT.LProc, OPT.XProc, OPT.TProc, OPT.CProc, OPT.IProc} THEN IF obj^.conval^.setval = {} THEN OPM.err(129) END ; scope := obj^.scope; scope^.leaf := TRUE; scope^.name := obj^.name; Stamp(scope^.name); - IF mode = OPM.CProc THEN obj^.adr := 1 (* c.f. OPC.CProcDefs *) END ; + IF mode = OPT.CProc THEN obj^.adr := 1 (* c.f. OPC.CProcDefs *) END ; IF scope^.mnolev > 1 THEN outerScope^.leaf := FALSE END ; Traverse (obj^.scope^.right, obj^.scope, FALSE) END @@ -217,27 +217,27 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE Precedence (class, subclass, form, comp: INTEGER): INTEGER; BEGIN CASE class OF - | OPM.Nconst, - OPM.Nvar, - OPM.Nfield, - OPM.Nindex, - OPM.Nproc, - OPM.Ncall: RETURN 10 - | OPM.Nguard: IF OPM.typchk IN OPM.opt THEN RETURN 10 ELSE RETURN 9 (*cast*) END - | OPM.Nvarpar: IF comp IN {OPM.Array, OPM.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *) - | OPM.Nderef: RETURN 9 - | OPM.Nmop: CASE subclass OF - | OPM.not, OPM.minus, OPM.adr, OPM.val, OPM.conv: RETURN 9 - | OPM.is, OPM.abs, OPM.cap, OPM.odd, OPM.cc: RETURN 10 - ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; + | OPT.Nconst, + OPT.Nvar, + OPT.Nfield, + OPT.Nindex, + OPT.Nproc, + OPT.Ncall: RETURN 10 + | OPT.Nguard: IF OPM.typchk IN OPM.opt THEN RETURN 10 ELSE RETURN 9 (*cast*) END + | OPT.Nvarpar: IF comp IN {OPT.Array, OPT.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *) + | OPT.Nderef: RETURN 9 + | OPT.Nmop: CASE subclass OF + | OPM.not, OPM.minus, OPT.adr, OPT.val, OPT.conv: RETURN 9 + | OPM.is, OPT.abs, OPT.cap, OPT.odd, OPT.cc: RETURN 10 + ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPT.Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END - | OPM.Ndop: CASE subclass OF - | OPM.times: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 8 END - | OPM.slash: IF form = OPM.Set THEN RETURN 3 ELSE RETURN 8 END + | OPT.Ndop: CASE subclass OF + | OPM.times: IF form = OPT.Set THEN RETURN 4 ELSE RETURN 8 END + | OPM.slash: IF form = OPT.Set THEN RETURN 3 ELSE RETURN 8 END | OPM.div, OPM.mod: RETURN 10 (* div/mod are replaced by functions *) - | OPM.plus: IF form = OPM.Set THEN RETURN 2 ELSE RETURN 7 END - | OPM.minus: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 7 END + | OPM.plus: IF form = OPT.Set THEN RETURN 2 ELSE RETURN 7 END + | OPM.minus: IF form = OPT.Set THEN RETURN 4 ELSE RETURN 7 END | OPM.lss, OPM.leq, OPM.gtr, @@ -246,18 +246,18 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.neq: RETURN 5 | OPM.and: RETURN 1 | OPM.or: RETURN 0 - | OPM.len, + | OPT.len, OPM.in, - OPM.ash, - OPM.msk, - OPM.bit, - OPM.lsh, - OPM.rot: RETURN 10 - ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; + OPT.ash, + OPT.msk, + OPT.bit, + OPT.lsh, + OPT.rot: RETURN 10 + ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPT.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END; - | OPM.Nupto: RETURN 10 - | OPM.Ntype, - OPM.Neguard: (* ignored anyway *) RETURN MaxPrec + | OPT.Nupto: RETURN 10 + | OPT.Ntype, + OPT.Neguard: (* ignored anyway *) RETURN MaxPrec ELSE OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; END; END Precedence; @@ -267,8 +267,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE Len(n: OPT.Node; dim: LONGINT); BEGIN - WHILE (n^.class = OPM.Nindex) & (n^.typ^.comp = OPM.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ; - IF (n^.class = OPM.Nderef) & (n^.typ^.comp = OPM.DynArr) THEN + WHILE (n^.class = OPT.Nindex) & (n^.typ^.comp = OPT.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ; + IF (n^.class = OPT.Nderef) & (n^.typ^.comp = OPT.DynArr) THEN design(n^.left, 10); OPM.WriteString("->len["); OPM.WriteInt(dim); OPM.Write("]") ELSE OPC.Len(n^.obj, n^.typ, dim) @@ -277,14 +277,14 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE SideEffects(n: OPT.Node): BOOLEAN; BEGIN - IF n # NIL THEN RETURN (n^.class = OPM.Ncall) OR SideEffects(n^.left) OR SideEffects(n^.right) + IF n # NIL THEN RETURN (n^.class = OPT.Ncall) OR SideEffects(n^.left) OR SideEffects(n^.right) ELSE RETURN FALSE END END SideEffects; PROCEDURE Entier(n: OPT.Node; prec: INTEGER); BEGIN - IF n^.typ^.form IN {OPM.Real, OPM.LReal} THEN + IF n^.typ^.form IN {OPT.Real, OPT.LReal} THEN OPM.WriteString(EntierFunc); expr(n, MinPrec); OPM.Write(CloseParen) ELSE expr(n, prec) END @@ -301,8 +301,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE Convert(n: OPT.Node; newtype: OPT.Struct; prec: INTEGER); VAR from, to: INTEGER; BEGIN from := n^.typ^.form; to := newtype.form; - IF to = OPM.Set THEN OPM.WriteString(SetOfFunc); Entier(n, MinPrec); OPM.Write(CloseParen) - ELSIF to IN OPM.intSet THEN + IF to = OPT.Set THEN OPM.WriteString(SetOfFunc); Entier(n, MinPrec); OPM.Write(CloseParen) + ELSIF to IN OPT.intSet THEN IF (newtype.size < n.typ.size) & (OPM.ranchk IN OPM.opt) THEN OPM.WriteString("__SHORT"); IF SideEffects(n) THEN OPM.Write("F") END; OPM.Write(OpenParen); Entier(n, MinPrec); OPM.WriteString(Comma); @@ -311,7 +311,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF newtype.size # n.typ.size THEN SizeCast(newtype.size) END; Entier(n, 9) END - ELSIF to = OPM.Char THEN + ELSIF to = OPT.Char THEN IF OPM.ranchk IN OPM.opt THEN OPM.WriteString("__CHR"); IF SideEffects(n) THEN OPM.Write("F") END ; OPM.Write(OpenParen); Entier(n, MinPrec); OPM.Write(CloseParen) @@ -323,15 +323,15 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE TypeOf(n: OPT.Node); BEGIN - IF n^.typ^.form = OPM.Pointer THEN + IF n^.typ^.form = OPT.Pointer THEN OPM.WriteString(TypeFunc); expr(n, MinPrec); OPM.Write(")") - ELSIF n^.class IN {OPM.Nvar, OPM.Nindex, OPM.Nfield} THEN (* dyn rec type = stat rec type *) + ELSIF n^.class IN {OPT.Nvar, OPT.Nindex, OPT.Nfield} THEN (* dyn rec type = stat rec type *) OPC.Andent(n^.typ); OPM.WriteString(DynTypExt) - ELSIF n^.class = OPM.Nderef THEN (* p^ *) + ELSIF n^.class = OPT.Nderef THEN (* p^ *) OPM.WriteString(TypeFunc); expr(n^.left, MinPrec); OPM.Write(")") - ELSIF n^.class = OPM.Nguard THEN (* r(T) *) + ELSIF n^.class = OPT.Nguard THEN (* r(T) *) TypeOf(n^.left) (* skip guard *) - ELSIF (n^.class = OPM.Nmop) & (n^.subcl = OPM.val) THEN + ELSIF (n^.class = OPT.Nmop) & (n^.subcl = OPT.val) THEN (*SYSTEM.VAL(typ, var par rec)*) OPC.TypeOf(n^.left^.obj) ELSE (* var par rec *) @@ -342,7 +342,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE Index(n, d: OPT.Node; prec, dim: INTEGER); BEGIN IF ~inxchk - OR (n^.right^.class = OPM.Nconst) & ((n^.right^.conval^.intval = 0) OR (n^.left^.typ^.comp # OPM.DynArr)) THEN + OR (n^.right^.class = OPT.Nconst) & ((n^.right^.conval^.intval = 0) OR (n^.left^.typ^.comp # OPT.DynArr)) THEN expr(n^.right, prec) ELSE IF SideEffects(n^.right) THEN OPM.WriteString("__XF(") ELSE OPM.WriteString("__X(") END ; @@ -357,28 +357,28 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 BEGIN comp := n^.typ^.comp; obj := n^.obj; class := n^.class; designPrec := Precedence(class, n^.subcl, n^.typ^.form, comp); - IF (class = OPM.Nvar) & (obj^.mnolev > 0) & (obj^.mnolev # OPM.level) & (prec = 10) THEN designPrec := 9 END ; + IF (class = OPT.Nvar) & (obj^.mnolev > 0) & (obj^.mnolev # OPM.level) & (prec = 10) THEN designPrec := 9 END ; IF prec > designPrec THEN OPM.Write(OpenParen) END; IF prec = ProcTypeVar THEN OPM.Write(Deref) END; (* proc var calls must be dereferenced in K&R C *) CASE class OF - | OPM.Nproc: OPC.Ident(n^.obj) - | OPM.Nvar: OPC.CompleteIdent(n^.obj) - | OPM.Nvarpar: IF ~(comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write(Deref) END; (* deref var parameter *) + | OPT.Nproc: OPC.Ident(n^.obj) + | OPT.Nvar: OPC.CompleteIdent(n^.obj) + | OPT.Nvarpar: IF ~(comp IN {OPT.Array, OPT.DynArr}) THEN OPM.Write(Deref) END; (* deref var parameter *) OPC.CompleteIdent(n^.obj) - | OPM.Nfield: IF n^.left^.class = OPM.Nderef THEN design(n^.left^.left, designPrec); OPM.WriteString("->") + | OPT.Nfield: IF n^.left^.class = OPT.Nderef THEN design(n^.left^.left, designPrec); OPM.WriteString("->") ELSE design(n^.left, designPrec); OPM.Write(".") END ; OPC.Ident(n^.obj) - | OPM.Nderef: IF n^.typ^.comp = OPM.DynArr THEN design(n^.left, 10); OPM.WriteString("->data") + | OPT.Nderef: IF n^.typ^.comp = OPT.DynArr THEN design(n^.left, 10); OPM.WriteString("->data") ELSE OPM.Write(Deref); design(n^.left, designPrec) END - | OPM.Nindex: d := n^.left; - IF d^.typ^.comp = OPM.DynArr THEN dims := 0; - WHILE d^.class = OPM.Nindex DO d := d^.left; INC(dims) END ; - IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("&") END ; + | OPT.Nindex: d := n^.left; + IF d^.typ^.comp = OPT.DynArr THEN dims := 0; + WHILE d^.class = OPT.Nindex DO d := d^.left; INC(dims) END ; + IF n^.typ^.comp = OPT.DynArr THEN OPM.Write("&") END ; design(d, designPrec); OPM.Write(OpenBracket); - IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("(") END ; + IF n^.typ^.comp = OPT.DynArr THEN OPM.Write("(") END ; i := dims; x := n; WHILE x # d DO (* apply Horner schema *) IF x^.left # d THEN Index(x, d, 7, i); OPM.WriteString(" + "); Len(d, i); OPM.WriteString(" * ("); DEC(i) @@ -387,8 +387,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 x := x^.left END ; FOR i := 1 TO dims DO OPM.Write(")") END ; - IF n^.typ^.comp = OPM.DynArr THEN - (* element type is OPM.DynArr; finish Horner schema with virtual indices = 0*) + IF n^.typ^.comp = OPT.DynArr THEN + (* element type is OPT.DynArr; finish Horner schema with virtual indices = 0*) OPM.Write(")"); WHILE i < (d^.typ^.size - 4) DIV 4 DO OPM.WriteString(" * "); Len(d, i); @@ -402,9 +402,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 Index(n, n^.left, MinPrec, 0); OPM.Write(CloseBracket) END - | OPM.Nguard: typ := n^.typ; obj := n^.left^.obj; + | OPT.Nguard: typ := n^.typ; obj := n^.left^.obj; IF OPM.typchk IN OPM.opt THEN - IF typ^.comp = OPM.Record THEN OPM.WriteString(GuardRecFunc); + IF typ^.comp = OPT.Record THEN OPM.WriteString(GuardRecFunc); IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*) OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj) ELSE (*local var-par record*) @@ -418,14 +418,14 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPC.Andent(typ); OPM.WriteString(Comma); OPM.WriteInt(typ^.extlev); OPM.Write(")") ELSE - IF typ^.comp = OPM.Record THEN (* do not cast record directly, cast pointer to record *) + IF typ^.comp = OPT.Record THEN (* do not cast record directly, cast pointer to record *) OPM.WriteString("*("); OPC.Ident(typ^.strobj); OPM.WriteString("*)"); OPC.CompleteIdent(obj) ELSE (*simply cast pointer*) OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec) END END - | OPM.Neguard: IF OPM.typchk IN OPM.opt THEN - IF n^.left^.class = OPM.Nvarpar THEN OPM.WriteString("__GUARDEQR("); + | OPT.Neguard: IF OPM.typchk IN OPM.opt THEN + IF n^.left^.class = OPT.Nvarpar THEN OPM.WriteString("__GUARDEQR("); OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left); ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec) END ; (* __GUARDEQx includes deref *) @@ -433,7 +433,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 ELSE expr(n^.left, MinPrec) (* always lhs of assignment *) END - | OPM.Nmop: IF n^.subcl = OPM.val THEN design(n^.left, prec) END + | OPT.Nmop: IF n^.subcl = OPT.val THEN design(n^.left, prec) END ELSE OPM.LogWStr("unhandled case in OPV.design, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; END ; IF prec > designPrec THEN OPM.Write(CloseParen) END @@ -445,52 +445,52 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.Write(OpenParen); WHILE n # NIL DO typ := fp^.typ; comp := typ^.comp; form := typ^.form; mode := fp^.mode; prec := MinPrec; - IF (mode = OPM.VarPar) & (n^.class = OPM.Nmop) & (n^.subcl = OPM.val) THEN (* avoid cast in lvalue *) + IF (mode = OPT.VarPar) & (n^.class = OPT.Nmop) & (n^.subcl = OPT.val) THEN (* avoid cast in lvalue *) OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.WriteString("*)"); prec := 10 END ; - IF ~(n^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN - IF mode = OPM.VarPar THEN + IF ~(n^.typ^.comp IN {OPT.Array, OPT.DynArr}) THEN + IF mode = OPT.VarPar THEN IF ansi & (typ # n^.typ) THEN OPM.WriteString("(void*)") END ; OPM.Write("&"); prec := 9 ELSIF ansi THEN - IF (comp IN {OPM.Array, OPM.DynArr}) & (n^.class = OPM.Nconst) THEN + IF (comp IN {OPT.Array, OPT.DynArr}) & (n^.class = OPT.Nconst) THEN OPM.WriteString("(CHAR*)") (* force to unsigned char *) - ELSIF (form = OPM.Pointer) & (typ # n^.typ) & (n^.typ # OPT.niltyp) THEN + ELSIF (form = OPT.Pointer) & (typ # n^.typ) & (n^.typ # OPT.niltyp) THEN OPM.WriteString("(void*)") (* type extension *) END ELSE - IF (form IN {OPM.Real, OPM.LReal}) & (n^.typ^.form IN OPM.intSet) THEN (* real promotion *) + IF (form IN {OPT.Real, OPT.LReal}) & (n^.typ^.form IN OPT.intSet) THEN (* real promotion *) OPM.WriteString("(double)"); prec := 9 - ELSIF (form = OPM.LInt) & (n^.typ^.form < OPM.LInt) THEN (* integral promotion *) + ELSIF (form = OPT.LInt) & (n^.typ^.form < OPT.LInt) THEN (* integral promotion *) OPM.WriteString("(LONGINT)"); prec := 9 END END ELSIF ansi THEN (* casting of params should be simplified eventually *) - IF (mode = OPM.VarPar) & (typ # n^.typ) & (prec = MinPrec) THEN OPM.WriteString("(void*)") END + IF (mode = OPT.VarPar) & (typ # n^.typ) & (prec = MinPrec) THEN OPM.WriteString("(void*)") END END; - IF (mode = OPM.VarPar) & (n^.class = OPM.Nmop) & (n^.subcl = OPM.val) THEN + IF (mode = OPT.VarPar) & (n^.class = OPT.Nmop) & (n^.subcl = OPT.val) THEN expr(n^.left, prec) (* avoid cast in lvalue *) - ELSIF (form = OPM.LInt) & (n^.class = OPM.Nconst) + ELSIF (form = OPT.LInt) & (n^.class = OPT.Nconst) & (n^.conval^.intval <= OPM.SignedMaximum(OPM.IntSize)) & (n^.conval^.intval >= OPM.SignedMinimum(OPM.IntSize)) THEN OPM.WriteString("((LONGINT)("); expr(n, prec); OPM.WriteString("))"); ELSE expr(n, prec) END; - IF (comp = OPM.Record) & (mode = OPM.VarPar) THEN + IF (comp = OPT.Record) & (mode = OPT.VarPar) THEN OPM.WriteString(", "); TypeOf(n) - ELSIF comp = OPM.DynArr THEN - IF n^.class = OPM.Nconst THEN (* ap is string constant *) + ELSIF comp = OPT.DynArr THEN + IF n^.class = OPT.Nconst THEN (* ap is string constant *) OPM.WriteString(Comma); OPM.WriteString("(LONGINT)"); OPM.WriteInt(n^.conval^.intval2) ELSE aptyp := n^.typ; dim := 0; - WHILE (typ^.comp = OPM.DynArr) & (typ^.BaseTyp^.form # OPM.Byte) DO + WHILE (typ^.comp = OPT.DynArr) & (typ^.BaseTyp^.form # OPT.Byte) DO OPM.WriteString(Comma); Len(n, dim); typ := typ^.BaseTyp; aptyp := aptyp^.BaseTyp; INC(dim) END ; - IF (typ^.comp = OPM.DynArr) & (typ^.BaseTyp^.form = OPM.Byte) THEN + IF (typ^.comp = OPT.DynArr) & (typ^.BaseTyp^.form = OPT.Byte) THEN OPM.WriteString(Comma); - WHILE aptyp^.comp = OPM.DynArr DO + WHILE aptyp^.comp = OPT.DynArr DO Len(n, dim); OPM.WriteString(" * "); INC(dim); aptyp := aptyp^.BaseTyp END ; OPM.WriteString("((LONGINT)("); OPM.WriteInt(aptyp^.size); OPM.WriteString("))"); @@ -506,7 +506,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE SuperProc(n: OPT.Node): OPT.Object; VAR obj: OPT.Object; typ: OPT.Struct; BEGIN typ := n^.right^.typ; (* receiver type *) - IF typ^.form = OPM.Pointer THEN typ := typ^.BaseTyp END ; + IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ; OPT.FindField(n^.left^.obj^.name, typ^.BaseTyp, obj); RETURN obj END SuperProc; @@ -524,51 +524,51 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 class := n^.class; subclass := n^.subcl; form := n^.typ^.form; l := n^.left; r := n^.right; exprPrec := Precedence (class, subclass, form, n^.typ^.comp); - IF (exprPrec <= prec) & (class IN {OPM.Nconst, OPM.Nupto, OPM.Nmop, OPM.Ndop, OPM.Ncall, OPM.Nguard, OPM.Neguard}) THEN + IF (exprPrec <= prec) & (class IN {OPT.Nconst, OPT.Nupto, OPT.Nmop, OPT.Ndop, OPT.Ncall, OPT.Nguard, OPT.Neguard}) THEN OPM.Write(OpenParen); END; CASE class OF - | OPM.Nconst: OPC.Constant(n^.conval, form) - | OPM.Nupto: (* n^.typ = OPT.settyp *) + | OPT.Nconst: OPC.Constant(n^.conval, form) + | OPT.Nupto: (* n^.typ = OPT.settyp *) OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec); OPM.Write(CloseParen) - | OPM.Nmop: + | OPT.Nmop: CASE subclass OF | OPM.not: OPM.Write("!"); expr(l, exprPrec) - | OPM.minus: IF form = OPM.Set THEN OPM.Write("~") ELSE OPM.Write("-") END; + | OPM.minus: IF form = OPT.Set THEN OPM.Write("~") ELSE OPM.Write("-") END; expr(l, exprPrec) | OPM.is: typ := n^.obj^.typ; - IF l^.typ^.comp = OPM.Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) + IF l^.typ^.comp = OPT.Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp END ; OPM.WriteString(Comma); OPC.Andent(typ); OPM.WriteString(Comma); OPM.WriteInt(typ^.extlev); OPM.Write(")") - | OPM.conv: Convert(l, n.typ, exprPrec) - | OPM.abs: IF SideEffects(l) THEN - IF l^.typ^.form < OPM.Real THEN - IF l^.typ^.form < OPM.LInt THEN OPM.WriteString("(int)") END ; + | OPT.conv: Convert(l, n.typ, exprPrec) + | OPT.abs: IF SideEffects(l) THEN + IF l^.typ^.form < OPT.Real THEN + IF l^.typ^.form < OPT.LInt THEN OPM.WriteString("(int)") END ; OPM.WriteString("__ABSF(") ELSE OPM.WriteString("__ABSFD(") END ELSE OPM.WriteString("__ABS(") END ; expr(l, MinPrec); OPM.Write(CloseParen) - | OPM.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen) - | OPM.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen) - | OPM.adr: OPM.WriteString("(LONGINT)(uintptr_t)"); (*SYSTEM*) - IF l^.class = OPM.Nvarpar THEN OPC.CompleteIdent(l^.obj) + | OPT.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen) + | OPT.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen) + | OPT.adr: OPM.WriteString("(LONGINT)(uintptr_t)"); (*SYSTEM*) + IF l^.class = OPT.Nvarpar THEN OPC.CompleteIdent(l^.obj) ELSE - IF (l^.typ^.form # OPM.String) & ~(l^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write("&") END ; + IF (l^.typ^.form # OPT.String) & ~(l^.typ^.comp IN {OPT.Array, OPT.DynArr}) THEN OPM.Write("&") END ; expr(l, exprPrec) END - | OPM.val: IF ~(l^.class IN {OPM.Nvar, OPM.Nvarpar, OPM.Nfield, OPM.Nindex}) (*SYSTEM*) - OR (n^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) - & (l^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) + | OPT.val: IF ~(l^.class IN {OPT.Nvar, OPT.Nvarpar, OPT.Nfield, OPT.Nindex}) (*SYSTEM*) + OR (n^.typ^.form IN {OPT.LInt, OPT.Pointer, OPT.Set, OPT.ProcTyp}) + & (l^.typ^.form IN {OPT.LInt, OPT.Pointer, OPT.Set, OPT.ProcTyp}) & (n^.typ^.size = l^.typ^.size) THEN OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen); - IF (n^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) OR (l^.typ^.form IN {OPM.Pointer, OPM.ProcTyp}) THEN + IF (n^.typ^.form IN {OPT.Pointer, OPT.ProcTyp}) OR (l^.typ^.form IN {OPT.Pointer, OPT.ProcTyp}) THEN OPM.WriteString("(uintptr_t)") END; expr(l, exprPrec) @@ -579,44 +579,44 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 END ELSE OPM.err(200) END - | OPM.Ndop: CASE subclass OF - | OPM.len: Len(l, r^.conval^.intval) + | OPT.Ndop: CASE subclass OF + | OPT.len: Len(l, r^.conval^.intval) | OPM.in, - OPM.ash, - OPM.msk, - OPM.bit, - OPM.lsh, - OPM.rot, + OPT.ash, + OPT.msk, + OPT.bit, + OPT.lsh, + OPT.rot, OPM.div, OPM.mod: CASE subclass OF | OPM.in: OPM.WriteString("__IN(") - | OPM.ash: IF r^.class = OPM.Nconst THEN + | OPT.ash: IF r^.class = OPT.Nconst THEN IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ASHL(") ELSE OPM.WriteString("__ASHR(") END ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(") ELSE OPM.WriteString("__ASH(") END - | OPM.msk: OPM.WriteString("__MASK("); - | OPM.bit: OPM.WriteString("__BIT(") - | OPM.lsh: IF r^.class = OPM.Nconst THEN + | OPT.msk: OPM.WriteString("__MASK("); + | OPT.bit: OPM.WriteString("__BIT(") + | OPT.lsh: IF r^.class = OPT.Nconst THEN IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(") ELSE OPM.WriteString("__LSHR(") END ELSE OPM.WriteString("__LSH(") END - | OPM.rot: IF r^.class = OPM.Nconst THEN + | OPT.rot: IF r^.class = OPT.Nconst THEN IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ROTL(") ELSE OPM.WriteString("__ROTR(") END ELSE OPM.WriteString("__ROT(") END | OPM.div: IF SideEffects(n) THEN - IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; + IF form < OPT.LInt THEN OPM.WriteString("(int)") END ; OPM.WriteString("__DIVF(") ELSE OPM.WriteString("__DIV(") END - | OPM.mod: IF form < OPM.LInt THEN OPM.WriteString("(int)") END ; + | OPM.mod: IF form < OPT.LInt THEN OPM.WriteString("(int)") END ; IF SideEffects(n) THEN OPM.WriteString("__MODF(") ELSE OPM.WriteString("__MOD(") END; @@ -624,63 +624,63 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 END ; expr(l, MinPrec); OPM.WriteString(Comma); - IF (subclass IN {OPM.ash, OPM.lsh, OPM.rot}) & (r^.class = OPM.Nconst) & (r^.conval^.intval < 0) THEN + IF (subclass IN {OPT.ash, OPT.lsh, OPT.rot}) & (r^.class = OPT.Nconst) & (r^.conval^.intval < 0) THEN OPM.WriteInt(-r^.conval^.intval) ELSE expr(r, MinPrec) END ; - IF subclass IN {OPM.lsh, OPM.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ; + IF subclass IN {OPT.lsh, OPT.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ; OPM.Write(CloseParen) | OPM.eql - .. OPM.geq: IF l^.typ^.form IN {OPM.String, OPM.Comp} THEN + .. OPM.geq: IF l^.typ^.form IN {OPT.String, OPT.Comp} THEN OPM.WriteString("__STRCMP("); expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen); OPC.Cmp(subclass); OPM.Write("0") ELSE expr(l, exprPrec); OPC.Cmp(subclass); typ := l^.typ; - IF (typ^.form = OPM.Pointer) & (r^.typ.form # OPM.NilTyp) & (r^.typ # typ) & (r^.typ # OPT.sysptrtyp) THEN + IF (typ^.form = OPT.Pointer) & (r^.typ.form # OPT.NilTyp) & (r^.typ # typ) & (r^.typ # OPT.sysptrtyp) THEN OPM.WriteString("(void *) ") END ; expr(r, exprPrec) END - ELSE IF (subclass = OPM.and) OR ((form = OPM.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(OpenParen); END; (* to silence clang warnings; -- noch *) + ELSE IF (subclass = OPM.and) OR ((form = OPT.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(OpenParen); END; (* to silence clang warnings; -- noch *) expr(l, exprPrec); CASE subclass OF - | OPM.times: IF form = OPM.Set THEN OPM.WriteString(" & ") + | OPM.times: IF form = OPT.Set THEN OPM.WriteString(" & ") ELSE OPM.WriteString(" * ") END - | OPM.slash: IF form = OPM.Set THEN OPM.WriteString(" ^ ") + | OPM.slash: IF form = OPT.Set THEN OPM.WriteString(" ^ ") ELSE OPM.WriteString(" / "); - IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPM.intSet) THEN + IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPT.intSet) THEN OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen) END END | OPM.and: OPM.WriteString(" && ") - | OPM.plus: IF form = OPM.Set THEN OPM.WriteString(" | ") + | OPM.plus: IF form = OPT.Set THEN OPM.WriteString(" | ") ELSE OPM.WriteString(" + ") END - | OPM.minus: IF form = OPM.Set THEN OPM.WriteString(" & ~") + | OPM.minus: IF form = OPT.Set THEN OPM.WriteString(" & ~") ELSE OPM.WriteString(" - ") END; | OPM.or: OPM.WriteString(" || "); ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END; expr(r, exprPrec); - IF (subclass = OPM.and) OR ((form = OPM.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(CloseParen) END; (* to silence clang warnings, -- noch*) + IF (subclass = OPM.and) OR ((form = OPT.Set) & ((subclass = OPM.times) OR (subclass = OPM.minus))) THEN OPM.Write(CloseParen) END; (* to silence clang warnings, -- noch*) END - | OPM.Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = OPM.TProc) THEN - IF l^.subcl = OPM.super THEN proc := SuperProc(n) + | OPT.Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = OPT.TProc) THEN + IF l^.subcl = OPT.super THEN proc := SuperProc(n) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj) END ; OPC.Ident(proc); n^.obj := proc^.link - ELSIF l^.class = OPM.Nproc THEN design(l, 10) + ELSIF l^.class = OPT.Nproc THEN design(l, 10) ELSE design(l, ProcTypeVar) END ; ActualPar(r, n^.obj) ELSE design(n, prec); (* not exprPrec! *) END; - IF (exprPrec <= prec) & (class IN {OPM.Nconst, OPM.Nupto, OPM.Nmop, OPM.Ndop, OPM.Ncall, OPM.Nguard}) THEN + IF (exprPrec <= prec) & (class IN {OPT.Nconst, OPT.Nupto, OPT.Nmop, OPT.Ndop, OPT.Ncall, OPT.Nguard}) THEN OPM.Write(CloseParen) END END expr; @@ -689,14 +689,14 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE IfStat(n: OPT.Node; withtrap: BOOLEAN; outerProc: OPT.Object); VAR if: OPT.Node; obj: OPT.Object; typ: OPT.Struct; adr: LONGINT; - BEGIN (* n^.class IN {OPM.Nifelse, OPM.Nwith} *) + BEGIN (* n^.class IN {OPT.Nifelse, OPT.Nwith} *) if := n^.left; (* name := ""; *) WHILE if # NIL DO OPM.WriteString("if "); expr(if^.left, MaxPrec); (* if *) OPM.Write(Blank); OPC.BegBlk; - IF (n^.class = OPM.Nwith) & (if^.left^.left # NIL) THEN (* watch out for const expr *) + IF (n^.class = OPT.Nwith) & (if^.left^.left # NIL) THEN (* watch out for const expr *) obj := if^.left^.left^.obj; typ := obj^.typ; adr := obj^.adr; - IF typ^.comp = OPM.Record THEN + IF typ^.comp = OPT.Record THEN (* introduce alias pointer for var records; T1 *name__ = rec; *) OPC.BegStat; OPC.Ident(if^.left^.obj); OPM.WriteString(" *"); OPM.WriteString(obj.name); OPM.WriteString("__ = (void*)"); @@ -762,7 +762,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE ImplicitReturn(n: OPT.Node): BOOLEAN; BEGIN - WHILE (n # NIL) & (n.class # OPM.Nreturn) DO n := n^.link END ; + WHILE (n # NIL) & (n.class # OPT.Nreturn) DO n := n^.link END ; RETURN n = NIL END ImplicitReturn; @@ -770,12 +770,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 VAR typ, base: OPT.Struct; nofdim, nofdyn: INTEGER; BEGIN typ := d^.typ^.BaseTyp; base := typ; nofdim := 0; nofdyn := 0; - WHILE base^.comp = OPM.DynArr DO INC(nofdim); INC(nofdyn); base := base^.BaseTyp END ; + WHILE base^.comp = OPT.DynArr DO INC(nofdim); INC(nofdyn); base := base^.BaseTyp END ; design(d, MinPrec); OPM.WriteString(" = __NEWARR("); - WHILE base^.comp = OPM.Array DO INC(nofdim); base := base^.BaseTyp END ; - IF (base^.comp = OPM.Record) & (OPC.NofPtrs(base) # 0) THEN + WHILE base^.comp = OPT.Array DO INC(nofdim); base := base^.BaseTyp END ; + IF (base^.comp = OPT.Record) & (OPC.NofPtrs(base) # 0) THEN OPC.Ident(base^.strobj); OPM.WriteString(DynTypExt) - ELSIF base^.form = OPM.Pointer THEN OPM.WriteString("POINTER__typ") + ELSIF base^.form = OPT.Pointer THEN OPM.WriteString("POINTER__typ") ELSE OPM.WriteString("NIL") END ; OPM.WriteString(", "); OPM.WriteString("((LONGINT)("); OPM.WriteInt(base^.size); OPM.WriteString("))"); @@ -784,8 +784,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.WriteString(", "); OPM.WriteInt(nofdyn); (* number of dynamic dimensions *) WHILE typ # base DO OPM.WriteString(", "); - IF typ^.comp = OPM.DynArr THEN - IF x^.class = OPM.Nconst THEN OPM.WriteString("(LONGINT)("); expr(x, MinPrec); OPM.WriteString(")") + IF typ^.comp = OPT.DynArr THEN + IF x^.class = OPT.Nconst THEN OPM.WriteString("(LONGINT)("); expr(x, MinPrec); OPM.WriteString(")") ELSE OPM.WriteString("(LONGINT)"); expr(x, 10) END ; x := x^.link @@ -798,12 +798,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE DefineTDescs(n: OPT.Node); BEGIN - WHILE (n # NIL) & (n^.class = OPM.Ninittd) DO OPC.TDescDecl(n^.typ); n := n^.link END + WHILE (n # NIL) & (n^.class = OPT.Ninittd) DO OPC.TDescDecl(n^.typ); n := n^.link END END DefineTDescs; PROCEDURE InitTDescs(n: OPT.Node); BEGIN - WHILE (n # NIL) & (n^.class = OPM.Ninittd) DO OPC.InitTDesc(n^.typ); n := n^.link END + WHILE (n # NIL) & (n^.class = OPT.Ninittd) DO OPC.InitTDesc(n^.typ); n := n^.link END END InitTDescs; PROCEDURE stat(n: OPT.Node; outerProc: OPT.Object); @@ -811,9 +811,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 BEGIN WHILE (n # NIL) & OPM.noerr DO OPM.errpos := n^.conval^.intval; - IF n^.class # OPM.Ninittd THEN OPC.BegStat END; + IF n^.class # OPT.Ninittd THEN OPC.BegStat END; CASE n^.class OF - | OPM.Nenter: IF n^.obj = NIL THEN (* enter module *) + | OPT.Nenter: IF n^.obj = NIL THEN (* enter module *) INC(OPM.level); stat(n^.left, outerProc); DEC(OPM.level); OPC.GenEnumPtrs(OPT.topScope^.scope); DefineTDescs(n^.right); OPC.EnterBody; InitTDescs(n^.right); @@ -827,10 +827,10 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPC.EnterProc(proc); stat(n^.right, proc); OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right)); END - | OPM.Ninittd: (* done in enter module *) - | OPM.Nassign: CASE n^.subcl OF - | OPM.assign: l := n^.left; r := n^.right; - IF l^.typ^.comp = OPM.Array THEN (* includes string assignment but not COPY *) + | OPT.Ninittd: (* done in enter module *) + | OPT.Nassign: CASE n^.subcl OF + | OPT.assign: l := n^.left; r := n^.right; + IF l^.typ^.comp = OPT.Array THEN (* includes string assignment but not COPY *) OPM.WriteString(MoveFunc); expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma); IF r^.typ = OPT.stringtyp THEN OPM.WriteInt(r^.conval^.intval2) @@ -838,95 +838,95 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 END ; OPM.Write(CloseParen) ELSE - IF (l^.typ^.form = OPM.Pointer) & (l^.obj # NIL) & (l^.obj^.adr = 1) & (l^.obj^.mode = OPM.Var) THEN + IF (l^.typ^.form = OPT.Pointer) & (l^.obj # NIL) & (l^.obj^.adr = 1) & (l^.obj^.mode = OPT.Var) THEN l^.obj^.adr := 0; design(l, MinPrec); l^.obj^.adr := 1; (* avoid cast of WITH-variable *) - IF r^.typ^.form # OPM.NilTyp THEN OPM.WriteString(" = (void*)") + IF r^.typ^.form # OPT.NilTyp THEN OPM.WriteString(" = (void*)") ELSE OPM.WriteString(" = ") END ELSE design(l, MinPrec); OPM.WriteString(" = ") END ; IF l^.typ = r^.typ THEN expr(r, MinPrec) - ELSIF (l^.typ^.form = OPM.Pointer) & (r^.typ^.form # OPM.NilTyp) & (l^.typ^.strobj # NIL) THEN + ELSIF (l^.typ^.form = OPT.Pointer) & (r^.typ^.form # OPT.NilTyp) & (l^.typ^.strobj # NIL) THEN OPM.Write("("); OPC.Ident(l^.typ^.strobj); OPM.Write(")"); expr(r, MinPrec) - ELSIF l^.typ^.comp = OPM.Record THEN + ELSIF l^.typ^.comp = OPT.Record THEN OPM.WriteString("*("); OPC.Andent(l^.typ); OPM.WriteString("*)&"); expr(r, 9) ELSE expr(r, MinPrec) END END - | OPM.newfn: IF n^.left^.typ^.BaseTyp^.comp = OPM.Record THEN + | OPT.newfn: IF n^.left^.typ^.BaseTyp^.comp = OPT.Record THEN OPM.WriteString("__NEW("); design(n^.left, MinPrec); OPM.WriteString(", "); OPC.Andent(n^.left^.typ^.BaseTyp); OPM.WriteString(")") - ELSIF n^.left^.typ^.BaseTyp^.comp IN {OPM.Array, OPM.DynArr} THEN + ELSIF n^.left^.typ^.BaseTyp^.comp IN {OPT.Array, OPT.DynArr} THEN NewArr(n^.left, n^.right) END - | OPM.incfn, - OPM.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPM.decfn); expr(n^.right, MinPrec) - | OPM.inclfn, - OPM.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPM.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec); + | OPT.incfn, + OPT.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPT.decfn); expr(n^.right, MinPrec) + | OPT.inclfn, + OPT.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPT.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec); OPM.Write(CloseParen) - | OPM.copyfn: OPM.WriteString(CopyFunc); + | OPT.copyfn: OPM.WriteString(CopyFunc); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); Len(n^.left, 0); OPM.Write(CloseParen) - | OPM.movefn: (*SYSTEM*) + | OPT.movefn: (*SYSTEM*) OPM.WriteString(MoveFunc); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right^.link, MinPrec); OPM.Write(CloseParen) - | OPM.getfn: (*SYSTEM*) + | OPT.getfn: (*SYSTEM*) OPM.WriteString(GetFunc); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(CloseParen) - | OPM.putfn: (*SYSTEM*) + | OPT.putfn: (*SYSTEM*) OPM.WriteString(PutFunc); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right, MinPrec); OPM.WriteString(Comma); OPC.Ident(n^.right^.typ^.strobj); OPM.Write(CloseParen) - | OPM.getrfn, (*SYSTEM*) - OPM.putrfn: (*SYSTEM*) OPM.err(200) - | OPM.sysnewfn: (*SYSTEM*) + | OPT.getrfn, (*SYSTEM*) + OPT.putrfn: (*SYSTEM*) OPM.err(200) + | OPT.sysnewfn: (*SYSTEM*) OPM.WriteString("__SYSNEW("); design(n^.left, MinPrec); OPM.WriteString(", "); expr(n^.right, MinPrec); OPM.Write(")") ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn; END - | OPM.Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPM.TProc) THEN - IF n^.left^.subcl = OPM.super THEN proc := SuperProc(n) + | OPT.Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPT.TProc) THEN + IF n^.left^.subcl = OPT.super THEN proc := SuperProc(n) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj) END ; OPC.Ident(proc); n^.obj := proc^.link - ELSIF n^.left^.class = OPM.Nproc THEN design(n^.left, 10) + ELSIF n^.left^.class = OPT.Nproc THEN design(n^.left, 10) ELSE design(n^.left, ProcTypeVar) END ; ActualPar(n^.right, n^.obj) - | OPM.Nifelse: IF n^.subcl # OPM.assertfn THEN IfStat(n, FALSE, outerProc) + | OPT.Nifelse: IF n^.subcl # OPT.assertfn THEN IfStat(n, FALSE, outerProc) ELSIF assert THEN OPM.WriteString("__ASSERT("); expr(n^.left^.left^.left, MinPrec); OPM.WriteString(Comma); OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat END - | OPM.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level) - | OPM.Nwhile: INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec); + | OPT.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level) + | OPT.Nwhile: INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec); OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk; DEC(exit.level) - | OPM.Nrepeat: INC(exit.level); OPM.WriteString("do "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk0; + | OPT.Nrepeat: INC(exit.level); OPM.WriteString("do "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk0; OPM.WriteString(" while (!"); expr(n^.right, 9); OPM.Write(CloseParen); DEC(exit.level) - | OPM.Nloop: saved := exit; exit.level := 0; exit.label := -1; + | OPT.Nloop: saved := exit; exit.level := 0; exit.label := -1; OPM.WriteString("for (;;) "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk; IF exit.label # -1 THEN OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat END ; exit := saved - | OPM.Nexit: IF exit.level = 0 THEN OPM.WriteString(Break) + | OPT.Nexit: IF exit.level = 0 THEN OPM.WriteString(Break) ELSE IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ; OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label) END - | OPM.Nreturn: IF OPM.level = 0 THEN + | OPT.Nreturn: IF OPM.level = 0 THEN IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END ELSE IF n^.left # NIL THEN (* Make local copy of result before ExitProc deletes dynamic vars *) OPM.WriteString("_o_result = "); - IF (n^.left^.typ^.form = OPM.Pointer) & (n^.obj^.typ # n^.left^.typ) THEN + IF (n^.left^.typ^.form = OPT.Pointer) & (n^.obj^.typ # n^.left^.typ) THEN OPM.WriteString("(void*)"); expr(n^.left, 10) ELSE expr(n^.left, MinPrec) @@ -938,11 +938,11 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.WriteString("return"); END END - | OPM.Nwith: IfStat(n, n^.subcl = 0, outerProc) - | OPM.Ntrap: OPC.Halt(n^.right^.conval^.intval) + | OPT.Nwith: IfStat(n, n^.subcl = 0, outerProc) + | OPT.Ntrap: OPC.Halt(n^.right^.conval^.intval) ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn; END; - IF ~(n^.class IN {OPM.Nenter, OPM.Ninittd, OPM.Nifelse, OPM.Nwith, OPM.Ncase, OPM.Nwhile, OPM.Nloop}) THEN OPC.EndStat END ; + IF ~(n^.class IN {OPT.Nenter, OPT.Ninittd, OPT.Nifelse, OPT.Nwith, OPT.Ncase, OPT.Nwhile, OPT.Nloop}) THEN OPC.EndStat END ; n := n^.link END END stat;