vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 15:42:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Move table constants from OPM to OPT.

Browse source
This commit is contained in:
David Brown 2016-08-22 12:49:50 +01:00
parent 02803ae1fb
commit 298da0d13c
6 changed files with 1231 additions and 1228 deletions
Download patch file Download diff file Expand all files Collapse all files

962
src/compiler/OPB.Mod
View file

File diff suppressed because it is too large Load diff

268
src/compiler/OPC.Mod
View file

@ -111,15 +111,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
VAR mode, level, h: INTEGER; VAR mode, level, h: INTEGER;
BEGIN BEGIN
mode := obj^.mode; level := obj^.mnolev; 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); OPM.WriteStringVar(obj^.name);
h := PerfectHash(obj^.name); h := PerfectHash(obj^.name);
IF hashtab[h] >= 0 THEN IF hashtab[h] >= 0 THEN
IF keytab[hashtab[h]] = obj^.name THEN OPM.Write('_') END IF keytab[hashtab[h]] = obj^.name THEN OPM.Write('_') END
END END
ELSE ELSE
IF (mode # OPM.Typ) OR (obj^.linkadr # PredefinedType) THEN IF (mode # OPT.Typ) OR (obj^.linkadr # PredefinedType) THEN
IF mode = OPM.TProc THEN Ident(obj^.link^.typ^.strobj) IF mode = OPT.TProc THEN Ident(obj^.link^.typ^.strobj)
ELSIF level < 0 THEN (* use unaliased module name *) ELSIF level < 0 THEN (* use unaliased module name *)
OPM.WriteStringVar(OPT.GlbMod[-level].name); OPM.WriteStringVar(OPT.GlbMod[-level].name);
IF OPM.currFile = OPM.HeaderFile THEN OPT.GlbMod[-level].vis := 1 (*include in header file*) END ; 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; VAR pointers: INTEGER;
BEGIN BEGIN
openClause := FALSE; openClause := FALSE;
IF ((typ^.strobj = NIL) OR (typ^.strobj^.name = "")) & (typ^.comp # OPM.Record) THEN IF ((typ^.strobj = NIL) OR (typ^.strobj^.name = "")) & (typ^.comp # OPT.Record) THEN
IF typ^.comp IN {OPM.Array, OPM.DynArr} THEN IF typ^.comp IN {OPT.Array, OPT.DynArr} THEN
Stars (typ^.BaseTyp, openClause); Stars (typ^.BaseTyp, openClause);
openClause := (typ^.comp = OPM.Array) openClause := (typ^.comp = OPT.Array)
ELSIF typ^.form = OPM.ProcTyp THEN ELSIF typ^.form = OPT.ProcTyp THEN
OPM.Write('('); OPM.Write('*') OPM.Write('('); OPM.Write('*')
ELSE ELSE
pointers := 0; pointers := 0;
(*WHILE (typ^.strobj = NIL) & (typ^.form = OPM.Pointer) DO INC (pointers); typ := typ^.BaseTyp END ; (*WHILE (typ^.strobj = NIL) & (typ^.form = OPT.Pointer) DO INC (pointers); typ := typ^.BaseTyp END ;
IF (typ^.comp # OPM.DynArr) & (pointers # 0) THEN Stars (typ, openClause) END ;*) IF (typ^.comp # OPT.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) OR (typ^.strobj^.name = "")) & (typ^.form = OPT.Pointer) DO
INC (pointers); typ := typ^.BaseTyp INC (pointers); typ := typ^.BaseTyp
END ; END ;
IF pointers > 0 THEN 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 ; IF openClause THEN OPM.Write('('); openClause := FALSE END ;
WHILE pointers > 0 DO OPM.Write('*'); DEC (pointers) END WHILE pointers > 0 DO OPM.Write('*'); DEC (pointers) END
END END
@ -168,7 +168,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
varPar, openClause: BOOLEAN; form, comp: INTEGER; varPar, openClause: BOOLEAN; form, comp: INTEGER;
BEGIN BEGIN
typ := dcl^.typ; 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); Stars(typ, openClause);
IF varPar THEN IF varPar THEN
IF openClause THEN OPM.Write('(') END ; IF openClause THEN OPM.Write('(') END ;
@ -180,17 +180,17 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
LOOP LOOP
form := typ^.form; form := typ^.form;
comp := typ^.comp; comp := typ^.comp;
IF ((typ^.strobj # NIL) & (typ^.strobj^.name # "")) OR (form = OPM.NoTyp) OR (comp = OPM.Record) THEN EXIT IF ((typ^.strobj # NIL) & (typ^.strobj^.name # "")) OR (form = OPT.NoTyp) OR (comp = OPT.Record) THEN EXIT
ELSIF (form = OPM.Pointer) & (typ^.BaseTyp^.comp # OPM.DynArr) THEN ELSIF (form = OPT.Pointer) & (typ^.BaseTyp^.comp # OPT.DynArr) THEN
openClause := TRUE 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 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) IF ansi THEN OPM.Write(")"); AnsiParamList(typ^.link, FALSE)
ELSE OPM.WriteString(")()") ELSE OPM.WriteString(")()")
END ; END ;
EXIT EXIT
ELSIF comp = OPM.Array THEN ELSIF comp = OPT.Array THEN
OPM.Write('['); OPM.WriteInt(typ^.n); OPM.Write(']') OPM.Write('['); OPM.WriteInt(typ^.n); OPM.Write(']')
END END
ELSE 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; VAR typ, prev: OPT.Struct; obj: OPT.Object; nofdims: INTEGER; off, n, dummy: LONGINT;
BEGIN BEGIN
typ := dcl^.typ; prev := typ; typ := dcl^.typ; prev := typ;
WHILE ((typ^.strobj = NIL) OR (typ^.comp = OPM.DynArr) OR Undefined(typ^.strobj)) WHILE ((typ^.strobj = NIL) OR (typ^.comp = OPT.DynArr) OR Undefined(typ^.strobj))
& (typ^.comp # OPM.Record) & (typ^.comp # OPT.Record)
& (typ^.form # OPM.NoTyp) & (typ^.form # OPT.NoTyp)
& ~((typ^.form = OPM.Pointer) & (typ^.BaseTyp^.comp = OPM.DynArr)) DO & ~((typ^.form = OPT.Pointer) & (typ^.BaseTyp^.comp = OPT.DynArr)) DO
prev := typ; typ := typ^.BaseTyp; prev := typ; typ := typ^.BaseTyp;
END ; END ;
obj := typ^.strobj; obj := typ^.strobj;
IF typ^.form = OPM.NoTyp THEN (* proper procedure *) IF typ^.form = OPT.NoTyp THEN (* proper procedure *)
OPM.WriteString('void') OPM.WriteString('void')
ELSIF (obj # NIL) & ~Undefined(obj) THEN (* named type, already declared *) ELSIF (obj # NIL) & ~Undefined(obj) THEN (* named type, already declared *)
Ident(obj) Ident(obj)
ELSIF typ^.comp = OPM.Record THEN ELSIF typ^.comp = OPT.Record THEN
OPM.WriteString('struct '); Andent(typ); 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 *) (* 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) OPM.WriteString(" { /* "); Ident(typ^.BaseTyp^.strobj); OPM.WriteString(" */"); OPM.WriteLn; Indent(1)
ELSE OPM.Write(' '); BegBlk ELSE OPM.Write(' '); BegBlk
END ; END ;
FieldList(typ, TRUE, off, n, dummy); FieldList(typ, TRUE, off, n, dummy);
EndBlk0 EndBlk0
END 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; 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; OPM.WriteString('struct '); BegBlk;
BegStat; Str1("LONGINT len[#]", nofdims); EndStat; BegStat; Str1("LONGINT len[#]", nofdims); EndStat;
BegStat; NEW(obj); NEW(obj.typ); (* aux. object for easy declaration *) 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); obj.linkadr := UndefinedType; DeclareBase(obj); OPM.Write(' '); DeclareObj(obj, FALSE);
EndStat; EndBlk0 EndStat; EndBlk0
END END
@ -261,21 +261,21 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE NofPtrs* (typ: OPT.Struct): LONGINT; PROCEDURE NofPtrs* (typ: OPT.Struct): LONGINT;
VAR fld: OPT.Object; btyp: OPT.Struct; n: LONGINT; VAR fld: OPT.Object; btyp: OPT.Struct; n: LONGINT;
BEGIN BEGIN
IF (typ^.form = OPM.Pointer) & (typ^.sysflag = 0) THEN RETURN 1 IF (typ^.form = OPT.Pointer) & (typ^.sysflag = 0) THEN RETURN 1
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; btyp := typ^.BaseTyp;
IF btyp # NIL THEN n := NofPtrs(btyp) ELSE n := 0 END ; IF btyp # NIL THEN n := NofPtrs(btyp) ELSE n := 0 END ;
fld := typ^.link; 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) IF fld^.name # OPM.HdPtrName THEN n := n + NofPtrs(fld^.typ)
ELSE INC(n) ELSE INC(n)
END ; END ;
fld := fld^.link fld := fld^.link
END ; END ;
RETURN n RETURN n
ELSIF typ^.comp = OPM.Array THEN ELSIF typ^.comp = OPT.Array THEN
btyp := typ^.BaseTyp; n := typ^.n; 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 RETURN NofPtrs(btyp) * n
ELSE RETURN 0 ELSE RETURN 0
END 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); PROCEDURE PutPtrOffsets (typ: OPT.Struct; adr: LONGINT; VAR cnt: LONGINT);
VAR fld: OPT.Object; btyp: OPT.Struct; n, i: LONGINT; VAR fld: OPT.Object; btyp: OPT.Struct; n, i: LONGINT;
BEGIN 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); OPM.WriteInt(adr); OPM.WriteString(", "); INC(cnt);
IF cnt MOD 16 = 0 THEN OPM.WriteLn; OPM.Write(Tab) END 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; btyp := typ^.BaseTyp;
IF btyp # NIL THEN PutPtrOffsets(btyp, adr, cnt) END ; IF btyp # NIL THEN PutPtrOffsets(btyp, adr, cnt) END ;
fld := typ^.link; 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) IF fld^.name # OPM.HdPtrName THEN PutPtrOffsets(fld^.typ, adr + fld^.adr, cnt)
ELSE ELSE
OPM.WriteInt(adr + fld^.adr); OPM.WriteString(", "); INC(cnt); 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 ; END ;
fld := fld^.link fld := fld^.link
END END
ELSIF typ^.comp = OPM.Array THEN ELSIF typ^.comp = OPT.Array THEN
btyp := typ^.BaseTyp; n := typ^.n; 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; IF NofPtrs(btyp) > 0 THEN i := 0;
WHILE i < n DO PutPtrOffsets(btyp, adr + i * btyp^.size, cnt); INC(i) END WHILE i < n DO PutPtrOffsets(btyp, adr + i * btyp^.size, cnt); INC(i) END
END END
@ -312,7 +312,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
InitTProcs(typ, obj^.left); InitTProcs(typ, obj^.left);
IF obj^.mode = OPM.TProc THEN IF obj^.mode = OPT.TProc THEN
BegStat; BegStat;
OPM.WriteString("__INITBP("); OPM.WriteString("__INITBP(");
Ident(typ); OPM.WriteString(', '); Ident(obj); Ident(typ); OPM.WriteString(', '); Ident(obj);
@ -336,7 +336,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
IF showParamName THEN Ident(par); OPM.WriteString(LenExt) END ; IF showParamName THEN Ident(par); OPM.WriteString(LenExt) END ;
dim := 1; typ := par^.typ^.BaseTyp; 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 ansiDefine THEN OPM.WriteString(", LONGINT ") ELSE OPM.WriteString(', ') END ;
IF showParamName THEN Ident(par); OPM.WriteString(LenExt); OPM.WriteInt(dim) END ; IF showParamName THEN Ident(par); OPM.WriteString(LenExt); OPM.WriteInt(dim) END ;
typ := typ^.BaseTyp; INC(dim) 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 WHILE par # NIL DO
IF macro THEN OPM.WriteStringVar(par.name) IF macro THEN OPM.WriteStringVar(par.name)
ELSE 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) Ident(par)
END ; END ;
IF par^.typ^.comp = OPM.DynArr THEN IF par^.typ^.comp = OPT.DynArr THEN
OPM.WriteString(', '); LenList(par, FALSE, TRUE); 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) OPM.WriteString(', '); OPM.WriteStringVar(par.name); OPM.WriteString(TagExt)
END ; END ;
par := par^.link; 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 ^DefineType(str: OPT.Struct);
PROCEDURE ^ProcHeader(proc: OPT.Object; define: BOOLEAN); 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; VAR par: OPT.Object;
BEGIN BEGIN
IF obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ; 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 BEGIN
IF obj # NIL THEN IF obj # NIL THEN
DeclareTProcs(obj^.left, empty); 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 obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ;
IF OPM.currFile = OPM.HeaderFile THEN IF OPM.currFile = OPM.HeaderFile THEN
IF obj^.vis = OPM.external THEN IF obj^.vis = OPT.external THEN
DefineTProcTypes(obj); DefineTProcTypes(obj);
OPM.WriteString(Extern); empty := FALSE; OPM.WriteString(Extern); empty := FALSE;
ProcHeader(obj, FALSE) ProcHeader(obj, FALSE)
END END
ELSE empty := FALSE; ELSE empty := FALSE;
DefineTProcTypes(obj); DefineTProcTypes(obj);
IF obj^.vis = OPM.internal THEN OPM.WriteString('static ') IF obj^.vis = OPT.internal THEN OPM.WriteString('static ')
ELSE OPM.WriteString(Export) ELSE OPM.WriteString(Export)
END ; END ;
ProcHeader(obj, FALSE) 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; PROCEDURE BaseTProc*(obj: OPT.Object): OPT.Object;
VAR typ, base: OPT.Struct; mno: LONGINT; VAR typ, base: OPT.Struct; mno: LONGINT;
BEGIN typ := obj^.link^.typ; (* receiver type *) 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; base := typ^.BaseTyp; mno := obj^.adr DIV 10000H;
WHILE (base # NIL) & (mno < base^.n) DO typ := base; base := typ^.BaseTyp END ; WHILE (base # NIL) & (mno < base^.n) DO typ := base; base := typ^.BaseTyp END ;
OPT.FindField(obj^.name, typ, obj); OPT.FindField(obj^.name, typ, obj);
@ -413,12 +413,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
DefineTProcMacros(obj^.left, empty); 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 __"); OPM.WriteString("#define __");
Ident(obj); Ident(obj);
DeclareParams(obj^.link, TRUE); DeclareParams(obj^.link, TRUE);
OPM.WriteString(" __SEND("); 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(")") OPM.WriteString("__TYPEOF("); Ident(obj^.link); OPM.Write(")")
ELSE Ident(obj^.link); OPM.WriteString(TagExt) ELSE Ident(obj^.link); OPM.WriteString(TagExt)
END ; 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) OR Undefined(obj) THEN
IF obj # NIL THEN (* check for cycles *) IF obj # NIL THEN (* check for cycles *)
IF obj^.linkadr = ProcessingType THEN 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 ELSE obj^.linkadr := ProcessingType
END END
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 *) (* 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 ; IF str^.BaseTyp # NIL THEN DefineType(str^.BaseTyp) END ;
field := str^.link; field := str^.link;
WHILE (field # NIL) & (field^.mode = OPM.Fld) DO WHILE (field # NIL) & (field^.mode = OPT.Fld) DO
IF (field^.vis # OPM.internal) OR (OPM.currFile = OPM.BodyFile) THEN DefineType(field^.typ) END ; IF (field^.vis # OPT.internal) OR (OPM.currFile = OPM.BodyFile) THEN DefineType(field^.typ) END ;
field := field^.link field := field^.link
END END
ELSIF str^.form = OPM.Pointer THEN ELSIF str^.form = OPT.Pointer THEN
IF str^.BaseTyp^.comp # OPM.Record THEN DefineType(str^.BaseTyp) END IF str^.BaseTyp^.comp # OPT.Record THEN DefineType(str^.BaseTyp) END
ELSIF str^.comp IN {OPM.Array, OPM.DynArr} THEN ELSIF str^.comp IN {OPT.Array, OPT.DynArr} THEN
DefineType(str^.BaseTyp) 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 ; IF str^.BaseTyp # OPT.notyp THEN DefineType(str^.BaseTyp) END ;
field := str^.link; field := str^.link;
WHILE field # NIL DO DefineType(field^.typ); field := field^.link END 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^.typ^.strobj := obj; (* SG: revert trick *)
obj^.linkadr := 3+OPM.currFile; obj^.linkadr := 3+OPM.currFile;
EndStat; Indent(-1); OPM.WriteLn; 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); DeclareTProcs(str^.link, empty); DefineTProcMacros(str^.link, empty);
IF ~empty THEN OPM.WriteLn END IF ~empty THEN OPM.WriteLn END
END END
@ -499,7 +499,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF obj # NIL THEN IF obj # NIL THEN
CProcDefs(obj^.left, vis); CProcDefs(obj^.left, vis);
(* bug: obj.history cannot be used to cover unexported and deleted CProcs; use special flag obj.adr = 1 *) (* 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; ext := obj.conval.ext; i := 1;
IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN
OPM.WriteString("#define "); Ident(obj); 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 IF obj # NIL THEN
TypeDefs(obj^.left, vis); TypeDefs(obj^.left, vis);
(* test typ.txtpos to skip types that have been unexported; obj.history # removed is not enough!*) (* 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) TypeDefs(obj^.right, vis)
END END
END TypeDefs; END TypeDefs;
@ -526,7 +526,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE DefAnonRecs(n: OPT.Node); PROCEDURE DefAnonRecs(n: OPT.Node);
VAR o: OPT.Object; typ: OPT.Struct; VAR o: OPT.Object; typ: OPT.Struct;
BEGIN BEGIN
WHILE (n # NIL) & (n^.class = OPM.Ninittd) DO WHILE (n # NIL) & (n^.class = OPT.Ninittd) DO
typ := n^.typ; typ := n^.typ;
IF (typ^.strobj = NIL) & ((OPM.currFile = OPM.BodyFile) OR (typ.ref < OPM.MaxStruct)) THEN IF (typ^.strobj = NIL) & ((OPM.currFile = OPM.BodyFile) OR (typ.ref < OPM.MaxStruct)) THEN
DefineType(typ); (* declare base and field types, if any *) 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; PROCEDURE BaseAlignment*(typ: OPT.Struct): LONGINT;
VAR alignment: LONGINT; VAR alignment: LONGINT;
BEGIN BEGIN
IF typ.form = OPM.Comp THEN IF typ.form = OPT.Comp THEN
IF typ.comp = OPM.Record THEN IF typ.comp = OPT.Record THEN
alignment := typ.align MOD 10000H alignment := typ.align MOD 10000H
ELSE ELSE
alignment := BaseAlignment(typ.BaseTyp) 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) IF typ.BaseTyp # NIL THEN FieldList(typ.BaseTyp, FALSE, off, n, curAlign)
ELSE off := 0; n := 0; curAlign := 1 ELSE off := 0; n := 0; curAlign := 1
END ; END ;
WHILE (fld # NIL) & (fld.mode = OPM.Fld) DO WHILE (fld # NIL) & (fld.mode = OPT.Fld) DO
IF (OPM.currFile = OPM.HeaderFile) & (fld.vis = OPM.internal) OR IF (OPM.currFile = OPM.HeaderFile) & (fld.vis = OPT.internal) OR
(OPM.currFile = OPM.BodyFile) & (fld.vis = OPM.internal) & (typ^.mno # 0) THEN (OPM.currFile = OPM.BodyFile) & (fld.vis = OPT.internal) & (typ^.mno # 0) THEN
fld := fld.link; 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 ELSE
(* mimic OPV.TypSize to detect gaps caused by private fields *) (* mimic OPV.TypSize to detect gaps caused by private fields *)
adr := off; fldAlign := BaseAlignment(fld^.typ); Align(adr, fldAlign); 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 ; IF gap > 0 THEN FillGap(gap, off, align, n, curAlign) END ;
BegStat; DeclareBase(fld); OPM.Write(' '); DeclareObj(fld, FALSE); BegStat; DeclareBase(fld); OPM.Write(' '); DeclareObj(fld, FALSE);
off := fld.adr + fld.typ.size; base := fld.typ; fld := fld.link; 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) WHILE (fld # NIL) & (fld.mode = OPT.Fld) & (fld.typ = base) & (fld.adr = off)
(* ?? *) & ((OPM.currFile = OPM.BodyFile) OR (fld.vis # OPM.internal) OR (fld.typ.strobj = NIL)) DO (* ?? *) & ((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 OPM.WriteString(", "); DeclareObj(fld, FALSE); off := fld.adr + fld.typ.size; fld := fld.link
END ; END ;
EndStat 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; VAR base: OPT.Struct; first: BOOLEAN; lastvis: INTEGER;
BEGIN BEGIN
base := NIL; first := TRUE; 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 (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 (obj^.typ # base) OR (obj^.vis # lastvis) THEN (* new variable base type definition required *)
IF ~first THEN EndStat END ; IF ~first THEN EndStat END ;
first := FALSE; first := FALSE;
base := obj^.typ; lastvis := obj^.vis; base := obj^.typ; lastvis := obj^.vis;
BegStat; 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 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) ELSE OPM.WriteString(Export)
END END
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) ELSE DeclareBase(obj)
END END
ELSE OPM.Write(","); ELSE OPM.Write(",");
END ; END ;
OPM.Write(' '); 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); 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; EndStat; BegStat;
base := OPT.linttyp; base := OPT.linttyp;
OPM.WriteString("LONGINT "); LenList(obj, FALSE, TRUE) 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; EndStat; BegStat;
OPM.WriteString("LONGINT *"); Ident(obj); OPM.WriteString(TagExt); OPM.WriteString("LONGINT *"); Ident(obj); OPM.WriteString(TagExt);
base := NIL 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") OPM.WriteString(" = NIL")
END END
END ; END ;
@ -700,7 +700,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
VAR name: ARRAY 32 OF CHAR; VAR name: ARRAY 32 OF CHAR;
BEGIN BEGIN
OPM.Write("("); 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 ELSE
LOOP LOOP
DeclareBase(obj); DeclareBase(obj);
@ -709,14 +709,14 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
ELSE ELSE
COPY(obj^.name, name); obj^.name := ""; DeclareObj(obj, FALSE); COPY(name, obj^.name) COPY(obj^.name, name); obj^.name := ""; DeclareObj(obj, FALSE); COPY(name, obj^.name)
END ; END ;
IF obj^.typ^.comp = OPM.DynArr THEN IF obj^.typ^.comp = OPT.DynArr THEN
OPM.WriteString(", LONGINT "); OPM.WriteString(", LONGINT ");
LenList(obj, TRUE, showParamNames) 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 *"); OPM.WriteString(", LONGINT *");
IF showParamNames THEN Ident(obj); OPM.WriteString(TagExt) END IF showParamNames THEN Ident(obj); OPM.WriteString(TagExt) END
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(", "); OPM.WriteString(", ");
obj := obj^.link obj := obj^.link
END END
@ -744,10 +744,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
ProcPredefs(obj^.left, vis); 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 IF (obj^.mode IN {OPT.LProc, OPT.XProc}) & (obj^.vis >= vis) & ((obj^.history # OPT.removed) OR (obj^.mode = OPT.LProc)) THEN
(* previous OPM.XProc may be deleted or become OPM.LProc after interface change*) (* previous OPT.XProc may be deleted or become OPT.LProc after interface change*)
IF vis = OPM.external THEN OPM.WriteString(Extern) IF vis = OPT.external THEN OPM.WriteString(Extern)
ELSIF obj^.vis = OPM.internal THEN OPM.WriteString('static ') ELSIF obj^.vis = OPT.internal THEN OPM.WriteString('static ')
ELSE OPM.WriteString(Export) ELSE OPM.WriteString(Export)
END ; END ;
ProcHeader(obj, FALSE); ProcHeader(obj, FALSE);
@ -766,7 +766,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
IncludeImports(obj^.left, vis); 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 *) Include(OPT.GlbMod[-obj^.mnolev].name) (* use unaliased module name *)
END; END;
IncludeImports(obj^.right, vis); 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); PROCEDURE GenDynTypes (n: OPT.Node; vis: INTEGER);
VAR typ: OPT.Struct; VAR typ: OPT.Struct;
BEGIN BEGIN
WHILE (n # NIL) & (n^.class = OPM.Ninittd) DO WHILE (n # NIL) & (n^.class = OPT.Ninittd) DO
typ := n^.typ; 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; 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 ') ELSIF (typ^.strobj # NIL) & (typ^.strobj^.mnolev > 0) THEN OPM.WriteString('static ')
ELSE OPM.WriteString(Export) ELSE OPM.WriteString(Export)
END ; END ;
@ -798,7 +798,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
DefAnonRecs(n); DefAnonRecs(n);
TypeDefs(OPT.topScope^.right, 1); OPM.WriteLn; TypeDefs(OPT.topScope^.right, 1); OPM.WriteLn;
IdentList(OPT.topScope^.scope, 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); ProcPredefs(OPT.topScope^.right, 1);
OPM.WriteString(Extern); OPM.WriteString("void *"); OPM.WriteString(Extern); OPM.WriteString("void *");
OPM.WriteStringVar(OPM.modName); OPM.WriteString(BodyNameExt); 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); DefAnonRecs(n);
TypeDefs(OPT.topScope^.right, 0); OPM.WriteLn; TypeDefs(OPT.topScope^.right, 0); OPM.WriteLn;
IdentList(OPT.topScope^.scope, 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; ProcPredefs(OPT.topScope^.right, 0); OPM.WriteLn;
CProcDefs(OPT.topScope^.right, 0); OPM.WriteLn CProcDefs(OPT.topScope^.right, 0); OPM.WriteLn
END GenBdy; END GenBdy;
@ -869,7 +869,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
RegCmds(obj^.left); 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*) IF (obj^.vis # 0) & (obj^.link = NIL) & (obj^.typ = OPT.notyp) THEN (*command*)
BegStat; OPM.WriteString('__REGCMD("'); BegStat; OPM.WriteString('__REGCMD("');
OPM.WriteStringVar(obj.name); OPM.WriteString('", '); Ident(obj); OPM.Write(")"); EndStat 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 BEGIN
IF obj # NIL THEN IF obj # NIL THEN
InitImports(obj^.left); 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("); BegStat; OPM.WriteString("__MODULE_IMPORT(");
OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name); OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name);
OPM.Write(')'); EndStat OPM.Write(')'); EndStat
@ -910,17 +910,17 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BegBlk BegBlk
END ; END ;
BegStat; BegStat;
IF typ^.form = OPM.Pointer THEN IF typ^.form = OPT.Pointer THEN
OPM.WriteString("P("); Ident(var); OPM.Write(")"); 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(", "); OPM.WriteString("__ENUMR(&"); Ident(var); OPM.WriteString(", ");
Andent(typ); OPM.WriteString(DynTypExt); Str1(", #", typ^.size); OPM.WriteString(", 1, P)") 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; n := typ^.n; typ := typ^.BaseTyp;
WHILE typ^.comp = OPM.Array DO n := n * typ^.n; typ := typ^.BaseTyp END ; WHILE typ^.comp = OPT.Array DO n := n * typ^.n; typ := typ^.BaseTyp END ;
IF typ^.form = OPM.Pointer THEN IF typ^.form = OPT.Pointer THEN
OPM.WriteString("__ENUMP("); Ident(var); Str1(", #, P)", n) 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(", "); OPM.WriteString("__ENUMR("); Ident(var); OPM.WriteString(", ");
Andent(typ); OPM.WriteString(DynTypExt); Str1(", #", typ^.size); Str1(", #, P)", n) Andent(typ); OPM.WriteString(DynTypExt); Str1(", #", typ^.size); Str1(", #, P)", n)
END END
@ -991,7 +991,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE EnterProc* (proc: OPT.Object); PROCEDURE EnterProc* (proc: OPT.Object);
VAR var, scope: OPT.Object; typ: OPT.Struct; dim: INTEGER; VAR var, scope: OPT.Object; typ: OPT.Struct; dim: INTEGER;
BEGIN BEGIN
IF proc^.vis # OPM.external THEN OPM.WriteString('static ') END ; IF proc^.vis # OPT.external THEN OPM.WriteString('static ') END ;
ProcHeader(proc, TRUE); ProcHeader(proc, TRUE);
BegBlk; BegBlk;
@ -1011,7 +1011,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END ; END ;
var := proc^.link; var := proc^.link;
WHILE var # NIL DO (* declare copy of fixed size value array parameters *) 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; BegStat;
IF var^.typ^.strobj = NIL THEN OPM.Mark(200, var^.typ^.txtpos) ELSE Ident(var^.typ^.strobj) END ; 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"); 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 IF ~ansi THEN
var := proc^.link; var := proc^.link;
WHILE var # NIL DO (* "unpromote" value real parameters *) 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; BegStat;
Ident(var^.typ^.strobj); OPM.Write(' '); Ident(var); OPM.WriteString(" = _"); Ident(var); Ident(var^.typ^.strobj); OPM.Write(' '); Ident(var); OPM.WriteString(" = _"); Ident(var);
EndStat EndStat
@ -1032,9 +1032,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END ; END ;
var := proc^.link; var := proc^.link;
WHILE var # NIL DO (* copy value array parameters *) 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; BegStat;
IF var^.typ^.comp = OPM.Array THEN IF var^.typ^.comp = OPT.Array THEN
OPM.WriteString("__DUPARR("); OPM.WriteString("__DUPARR(");
Ident(var); OPM.WriteString(', '); Ident(var); OPM.WriteString(', ');
IF var^.typ^.strobj = NIL THEN OPM.Mark(200, var^.typ^.txtpos) ELSE Ident(var^.typ^.strobj) END 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('); OPM.WriteString('__DUP(');
Ident(var); OPM.WriteString(', '); Ident(var); OPM.WriteString(LenExt); Ident(var); OPM.WriteString(', '); Ident(var); OPM.WriteString(LenExt);
typ := var^.typ^.BaseTyp; dim := 1; 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); OPM.WriteString(" * "); Ident(var); OPM.WriteString(LenExt); OPM.WriteInt(dim);
typ := typ^.BaseTyp; INC(dim) typ := typ^.BaseTyp; INC(dim)
END ; END ;
@ -1062,12 +1062,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BegStat; BegStat;
OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var);
OPM.WriteString(' = '); 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*) (* 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 ; END ;
Ident(var); Ident(var);
IF var^.typ^.comp = OPM.DynArr THEN IF var^.typ^.comp = OPT.DynArr THEN
typ := var^.typ; dim := 0; typ := var^.typ; dim := 0;
REPEAT (* copy len(s) *) REPEAT (* copy len(s) *)
OPM.WriteString("; "); 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); OPM.WriteString(' = '); Ident(var); OPM.WriteString(LenExt);
IF dim # 0 THEN OPM.WriteInt(dim) END ; IF dim # 0 THEN OPM.WriteInt(dim) END ;
typ := typ^.BaseTyp typ := typ^.BaseTyp
UNTIL typ^.comp # OPM.DynArr; UNTIL typ^.comp # OPT.DynArr;
ELSIF (var^.mode = OPM.VarPar) & (var^.typ^.comp = OPM.Record) THEN ELSIF (var^.mode = OPT.VarPar) & (var^.typ^.comp = OPT.Record) THEN
OPM.WriteString("; "); OPM.WriteString("; ");
OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(TagExt); OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(TagExt);
OPM.WriteString(' = '); 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 *) IF ~var^.leaf THEN (* only if used by a nested procedure *)
BegStat; BegStat;
OPM.WriteString(LocalScope); OPM.Write('.'); Ident(var); OPM.WriteString(' = '); 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*) ELSE OPM.WriteString("(void*)") (* K&R and ANSI differ in the type: array or element type*)
END ; END ;
Ident(var); EndStat Ident(var); EndStat
@ -1123,7 +1123,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
(* delete array value parameters *) (* delete array value parameters *)
var := proc^.link; var := proc^.link;
WHILE var # NIL DO 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 ; IF indent THEN BegStat ELSE indent := TRUE END ;
OPM.WriteString('__DEL('); Ident(var); OPM.Write(')'); EndStat OPM.WriteString('__DEL('); Ident(var); OPM.Write(')'); EndStat
END ; END ;
@ -1138,16 +1138,16 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE CompleteIdent*(obj: OPT.Object); PROCEDURE CompleteIdent*(obj: OPT.Object);
VAR comp, level: INTEGER; VAR comp, level: INTEGER;
BEGIN BEGIN
(* obj^.mode IN {OPM.Var, OPM.VarPar} *) (* obj^.mode IN {OPT.Var, OPT.VarPar} *)
level := obj^.mnolev; level := obj^.mnolev;
IF obj^.adr = 1 THEN (* WITH-variable *) 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 *) ELSE (* cast with guard pointer type *)
OPM.WriteString("(("); Ident(obj^.typ^.strobj); OPM.Write(")"); Ident(obj); OPM.Write(")") OPM.WriteString("(("); Ident(obj^.typ^.strobj); OPM.Write(")"); Ident(obj); OPM.Write(")")
END END
ELSIF (level # OPM.level) & (level > 0) THEN (* intermediate var *) ELSIF (level # OPM.level) & (level > 0) THEN (* intermediate var *)
comp := obj^.typ^.comp; 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.WriteStringVar(obj^.scope^.name); OPM.WriteString(GlobalScope);
OPM.WriteString("->"); Ident(obj) OPM.WriteString("->"); Ident(obj)
ELSE ELSE
@ -1158,8 +1158,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE TypeOf*(ap: OPT.Object); PROCEDURE TypeOf*(ap: OPT.Object);
VAR i: INTEGER; VAR i: INTEGER;
BEGIN BEGIN
ASSERT(ap.typ.comp = OPM.Record); ASSERT(ap.typ.comp = OPT.Record);
IF ap.mode = OPM.VarPar THEN IF ap.mode = OPT.VarPar THEN
IF ap.mnolev # OPM.level THEN (*intermediate level var-par record; possible WITH-guarded*) IF ap.mnolev # OPM.level THEN (*intermediate level var-par record; possible WITH-guarded*)
OPM.WriteStringVar(ap^.scope^.name); OPM.WriteString("_s->"); Ident(ap) OPM.WriteStringVar(ap^.scope^.name); OPM.WriteString("_s->"); Ident(ap)
ELSE (*local var-par record*) ELSE (*local var-par record*)
@ -1231,10 +1231,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
OPM.WriteString('case '); OPM.WriteString('case ');
CASE form OF CASE form OF
| OPM.Char: CharacterLiteral(caseVal) | OPT.Char: CharacterLiteral(caseVal)
| OPM.SInt, | OPT.SInt,
OPM.Int, OPT.Int,
OPM.LInt: OPM.WriteInt(caseVal); OPT.LInt: OPM.WriteInt(caseVal);
ELSE OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END; END;
OPM.WriteString(': '); 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); PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: LONGINT);
BEGIN BEGIN
IF array^.comp = OPM.DynArr THEN IF array^.comp = OPT.DynArr THEN
CompleteIdent(obj); OPM.WriteString(LenExt); CompleteIdent(obj); OPM.WriteString(LenExt);
IF dim # 0 THEN OPM.WriteInt(dim) END IF dim # 0 THEN OPM.WriteInt(dim) END
ELSE (* array *) ELSE (* array *)
@ -1271,15 +1271,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
hex: LONGINT; skipLeading: BOOLEAN; hex: LONGINT; skipLeading: BOOLEAN;
BEGIN BEGIN
CASE form OF CASE form OF
| OPM.Byte: OPM.WriteInt(con^.intval) | OPT.Byte: OPM.WriteInt(con^.intval)
| OPM.Bool: OPM.WriteInt(con^.intval) | OPT.Bool: OPM.WriteInt(con^.intval)
| OPM.Char: CharacterLiteral(con.intval) | OPT.Char: CharacterLiteral(con.intval)
| OPM.SInt, | OPT.SInt,
OPM.Int, OPT.Int,
OPM.LInt: OPM.WriteInt(con^.intval) OPT.LInt: OPM.WriteInt(con^.intval)
| OPM.Real: OPM.WriteReal(con^.realval, "f") | OPT.Real: OPM.WriteReal(con^.realval, "f")
| OPM.LReal: OPM.WriteReal(con^.realval, 0X) | OPT.LReal: OPM.WriteReal(con^.realval, 0X)
| OPM.Set: OPM.WriteString("0x"); | OPT.Set: OPM.WriteString("0x");
skipLeading := TRUE; skipLeading := TRUE;
s := con^.setval; i := MAX(SET) + 1; s := con^.setval; i := MAX(SET) + 1;
REPEAT REPEAT
@ -1294,8 +1294,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END END
UNTIL i = 0; UNTIL i = 0;
IF skipLeading THEN OPM.Write("0") END IF skipLeading THEN OPM.Write("0") END
| OPM.String: StringLiteral(con.ext^, con.intval2-1) | OPT.String: StringLiteral(con.ext^, con.intval2-1)
| OPM.NilTyp: OPM.WriteString('NIL'); | OPT.NilTyp: OPM.WriteString('NIL');
ELSE OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END; END;
END Constant; END Constant;

79
src/compiler/OPM.cmdln.Mod
View file

@ -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; 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 TYPE
FileName = ARRAY 32 OF CHAR; FileName = ARRAY 32 OF CHAR;

202
src/compiler/OPP.Mod
View file

@ -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; VAR obj: OPT.Object; lev: SHORTINT;
BEGIN (*sym = OPM.ident*) BEGIN (*sym = OPM.ident*)
OPT.Find(obj); OPS.Get(sym); 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); OPS.Get(sym);
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
OPT.FindImport(obj, obj); OPS.Get(sym) 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
END ; END ;
IF obj = NIL THEN err(0); 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; 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; obj^.leaf := FALSE;
IF lev > 0 THEN OPB.StaticLink(level-lev) END IF lev > 0 THEN OPB.StaticLink(level-lev) END
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); PROCEDURE ConstExpression(VAR x: OPT.Node);
BEGIN Expression(x); BEGIN Expression(x);
IF x^.class # OPM.Nconst THEN IF x^.class # OPT.Nconst THEN
err(50); x := OPB.NewIntConst(1) err(50); x := OPB.NewIntConst(1)
END END
END ConstExpression; 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); BEGIN OPS.Get(sym);
IF (sym = OPM.times) OR (sym = OPM.minus) THEN IF (sym = OPM.times) OR (sym = OPM.minus) THEN
IF level > 0 THEN err(47) END ; 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) OPS.Get(sym)
ELSE vis := OPM.internal ELSE vis := OPT.internal
END END
END CheckMark; 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 sym = OPM.lbrak THEN OPS.Get(sym);
IF ~OPT.SYSimported THEN err(135) END; IF ~OPT.SYSimported THEN err(135) END;
ConstExpression(x); 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 IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
ELSE err(51); sf := 0 ELSE err(51); sf := 0
END ; 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); PROCEDURE RecordType(VAR typ, banned: OPT.Struct);
VAR fld, first, last, base: OPT.Object; VAR fld, first, last, base: OPT.Object;
ftyp: OPT.Struct; sysflag: INTEGER; 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); CheckSysFlag(sysflag, -1);
IF sym = OPM.lparen THEN IF sym = OPM.lparen THEN
OPS.Get(sym); (*record extension*) OPS.Get(sym); (*record extension*)
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
qualident(base); 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) IF base^.typ = banned THEN err(58)
ELSE base^.typ^.pvused := TRUE; ELSE base^.typ^.pvused := TRUE;
typ^.BaseTyp := base^.typ; typ^.extlev := base^.typ^.extlev + 1; typ^.sysflag := base^.typ^.sysflag 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 IF fld # NIL THEN err(1) END
END ; END ;
OPT.Insert(OPS.name, fld); CheckMark(fld^.vis); 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 first = NIL THEN first := fld END ;
IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ; IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ;
last := fld last := fld
@ -127,7 +127,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END ; END ;
CheckSym(OPM.colon); Type(ftyp, banned); CheckSym(OPM.colon); Type(ftyp, banned);
ftyp^.pvused := TRUE; 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 WHILE first # NIL DO
first^.typ := ftyp; first := first^.link first^.typ := ftyp; first := first^.link
END 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; VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER;
BEGIN CheckSysFlag(sysflag, 0); BEGIN CheckSysFlag(sysflag, 0);
IF sym = OPM.of THEN (*dynamic array*) 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); OPS.Get(sym); Type(typ^.BaseTyp, banned);
typ^.BaseTyp^.pvused := TRUE; 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 ELSE typ^.n := 0
END END
ELSE ELSE
typ := OPT.NewStr(OPM.Comp, OPM.Array); typ^.sysflag := sysflag; ConstExpression(x); typ := OPT.NewStr(OPT.Comp, OPT.Array); typ^.sysflag := sysflag; ConstExpression(x);
IF x^.typ^.form IN OPM.intSet THEN n := x^.conval^.intval; 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 IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
ELSE err(51); n := 1 ELSE err(51); n := 1
END ; 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 OPS.Get(sym); IF sym # OPM.of THEN ArrayType(typ^.BaseTyp, banned) END
ELSE err(35) ELSE err(35)
END ; 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
END ArrayType; END ArrayType;
PROCEDURE PointerType(VAR typ: OPT.Struct); PROCEDURE PointerType(VAR typ: OPT.Struct);
VAR id: OPT.Object; 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); CheckSym(OPM.to);
IF sym = OPM.ident THEN OPT.Find(id); IF sym = OPM.ident THEN OPT.Find(id);
IF id = NIL THEN 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^.link := OPT.NewObj(); COPY(OPS.name, typ^.link^.name);
typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*) typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*)
ELSE qualident(id); ELSE qualident(id);
IF id^.mode = OPM.Typ THEN IF id^.mode = OPT.Typ THEN
IF id^.typ^.comp IN {OPM.Array, OPM.DynArr, OPM.Record} THEN IF id^.typ^.comp IN {OPT.Array, OPT.DynArr, OPT.Record} THEN
typ^.BaseTyp := id^.typ typ^.BaseTyp := id^.typ
ELSE typ^.BaseTyp := OPT.undftyp; err(57) ELSE typ^.BaseTyp := OPT.undftyp; err(57)
END END
@ -189,7 +189,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END END
END END
ELSE Type(typ^.BaseTyp, OPT.notyp); 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) typ^.BaseTyp := OPT.undftyp; err(57)
END END
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; BEGIN first := NIL; last := firstPar;
IF (sym = OPM.ident) OR (sym = OPM.var) THEN IF (sym = OPM.ident) OR (sym = OPM.var) THEN
LOOP 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 LOOP
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
OPT.Insert(OPS.name, par); OPS.Get(sym); 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
END ; END ;
CheckSym(OPM.colon); Type(typ, OPT.notyp); 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 *) (* typ^.pbused is set when parameter type name is parsed *)
WHILE first # NIL DO first^.typ := typ; first := first^.link END ; WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
IF sym = OPM.semicolon THEN OPS.Get(sym) 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 IF sym = OPM.colon THEN
OPS.Get(sym); resTyp := OPT.undftyp; OPS.Get(sym); resTyp := OPT.undftyp;
IF sym = OPM.ident THEN qualident(res); IF sym = OPM.ident THEN qualident(res);
IF res^.mode = OPM.Typ THEN IF res^.mode = OPT.Typ THEN
IF (res^.typ^.form < OPM.Comp) (*OR (res^.typ^.form >= Int8) & (res^.typ^.form <= Int64)*) THEN resTyp := res^.typ; IF (res^.typ^.form < OPT.Comp) (*OR (res^.typ^.form >= Int8) & (res^.typ^.form <= Int64)*) THEN resTyp := res^.typ;
ELSE err(54) ELSE err(54)
END END
ELSE err(52) 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 REPEAT OPS.Get(sym) UNTIL sym >= OPM.lparen
END ; END ;
IF sym = OPM.ident THEN qualident(id); 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 IF id^.typ = banned THEN err(58) ELSE
typ := id.typ typ := id.typ
END 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 ELSIF sym = OPM.pointer THEN
OPS.Get(sym); PointerType(typ) OPS.Get(sym); PointerType(typ)
ELSIF sym = OPM.procedure THEN 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 IF sym = OPM.lparen THEN
OPS.Get(sym); OPT.OpenScope(level, NIL); OPS.Get(sym); OPT.OpenScope(level, NIL);
FormalParameters(typ^.link, typ^.BaseTyp); OPT.CloseScope 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); PROCEDURE Type(VAR typ, banned: OPT.Struct);
BEGIN TypeDecl(typ, banned); 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; END Type;
PROCEDURE selector(VAR x: OPT.Node); 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 LOOP
IF sym = OPM.lbrak THEN OPS.Get(sym); IF sym = OPM.lbrak THEN OPS.Get(sym);
LOOP 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); Expression(y); OPB.Index(x, y);
IF sym = OPM.comma THEN OPS.Get(sym) ELSE EXIT END IF sym = OPM.comma THEN OPS.Get(sym) ELSE EXIT END
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); ELSIF sym = OPM.period THEN OPS.Get(sym);
IF sym = OPM.ident THEN name := OPS.name; OPS.Get(sym); IF sym = OPM.ident THEN name := OPS.name; OPS.Get(sym);
IF x^.typ # NIL THEN IF x^.typ # NIL THEN
IF x^.typ^.form = OPM.Pointer THEN OPB.DeRef(x) END ; IF x^.typ^.form = OPT.Pointer THEN OPB.DeRef(x) END ;
IF x^.typ^.comp = OPM.Record THEN IF x^.typ^.comp = OPT.Record THEN
OPT.FindField(name, x^.typ, obj); OPB.Field(x, obj); 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); IF sym = OPM.arrow THEN (* super call *) OPS.Get(sym);
y := x^.left; 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 IF y^.obj # NIL THEN
proc := OPT.topScope; (* find innermost scope which owner is a OPM.TProc *) proc := OPT.topScope; (* find innermost scope which owner is a OPT.TProc *)
WHILE (proc^.link # NIL) & (proc^.link^.mode # OPM.TProc) DO proc := proc^.left END ; 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 ; IF (proc^.link = NIL) OR (proc^.link^.link # y^.obj) THEN err(75) END ;
typ := y^.obj^.typ; 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); 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) ELSE err(75)
END END
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) ELSE err(OPM.ident)
END END
ELSIF sym = OPM.arrow THEN OPS.Get(sym); OPB.DeRef(x) ELSIF sym = OPM.arrow THEN OPS.Get(sym); OPB.DeRef(x)
ELSIF (sym = OPM.lparen) & (x^.class < OPM.Nconst) & (x^.typ^.form # OPM.ProcTyp) & ELSIF (sym = OPM.lparen) & (x^.class < OPT.Nconst) & (x^.typ^.form # OPT.ProcTyp) &
((x^.obj = NIL) OR (x^.obj^.mode # OPM.TProc)) THEN ((x^.obj = NIL) OR (x^.obj^.mode # OPT.TProc)) THEN
OPS.Get(sym); OPS.Get(sym);
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
qualident(obj); 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) ELSE err(52)
END END
ELSE err(OPM.ident) 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) OPB.StFct(x, m, n)
ELSE err(OPM.lparen) ELSE err(OPM.lparen)
END ; 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; END StandProcCall;
PROCEDURE Element(VAR x: OPT.Node); 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 ; END ;
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
qualident(id); x := OPB.NewLeaf(id); selector(x); 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 ELSIF sym = OPM.lparen THEN
OPS.Get(sym); OPB.PrepCall(x, fpar); OPS.Get(sym); OPB.PrepCall(x, fpar);
ActualParameters(apar, 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); OPS.Get(sym);
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
qualident(obj); 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) ELSE err(52)
END END
ELSE err(OPM.ident) 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); PROCEDURE Receiver(VAR mode: SHORTINT; VAR name: OPS.Name; VAR typ, rec: OPT.Struct);
VAR obj: OPT.Object; VAR obj: OPT.Object;
BEGIN typ := OPT.undftyp; rec := NIL; 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); name := OPS.name; CheckSym(OPM.ident); CheckSym(OPM.colon);
IF sym = OPM.ident THEN OPT.Find(obj); OPS.Get(sym); IF sym = OPM.ident THEN OPT.Find(obj); OPS.Get(sym);
IF obj = NIL THEN err(0) 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; ELSE typ := obj^.typ; rec := typ;
IF rec^.form = OPM.Pointer THEN rec := rec^.BaseTyp END ; IF rec^.form = OPT.Pointer THEN rec := rec^.BaseTyp END ;
IF ~((mode = OPM.Var) & (typ^.form = OPM.Pointer) & (rec^.comp = OPM.Record) OR IF ~((mode = OPT.Var) & (typ^.form = OPT.Pointer) & (rec^.comp = OPT.Record) OR
(mode = OPM.VarPar) & (typ^.comp = OPM.Record)) THEN err(70); rec := NIL END ; (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 IF (rec # NIL) & (rec^.mno # level) THEN err(72); rec := NIL END
END END
ELSE err(OPM.ident) ELSE err(OPM.ident)
END ; END ;
CheckSym(OPM.rparen); 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; END Receiver;
PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN; PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN;
BEGIN BEGIN
IF (b^.form = OPM.Pointer) & (x^.form = OPM.Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ; IF (b^.form = OPT.Pointer) & (x^.form = OPT.Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ;
IF (b^.comp = OPM.Record) & (x^.comp = OPM.Record) THEN IF (b^.comp = OPT.Record) & (x^.comp = OPT.Record) THEN
REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b) REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b)
END ; END ;
RETURN x = b 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 END
END ; END ;
INCL(proc^.conval^.setval, OPM.hasBody) INCL(proc^.conval^.setval, OPT.hasBody)
END GetCode; END GetCode;
PROCEDURE GetParams; 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); OPB.CheckParameters(proc^.link, fwd^.link, TRUE);
IF proc^.typ # fwd^.typ THEN err(117) END ; IF proc^.typ # fwd^.typ THEN err(117) END ;
proc := fwd; OPT.topScope := proc^.scope; 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
END GetParams; 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; VAR procdec, statseq: OPT.Node; c: LONGINT;
BEGIN BEGIN
c := OPM.errpos; c := OPM.errpos;
INCL(proc^.conval^.setval, OPM.hasBody); INCL(proc^.conval^.setval, OPT.hasBody);
CheckSym(OPM.semicolon); Block(procdec, statseq); CheckSym(OPM.semicolon); Block(procdec, statseq);
OPB.Enter(procdec, statseq, proc); x := procdec; OPB.Enter(procdec, statseq, proc); x := procdec;
x^.conval := OPT.NewConst(); x^.conval^.intval := c; 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; objMode: SHORTINT;
objName: OPS.Name; objName: OPS.Name;
BEGIN BEGIN
OPS.Get(sym); mode := OPM.TProc; OPS.Get(sym); mode := OPT.TProc;
IF level > 0 THEN err(73) END ; IF level > 0 THEN err(73) END ;
Receiver(objMode, objName, objTyp, recTyp); Receiver(objMode, objName, objTyp, recTyp);
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
name := OPS.name; CheckMark(vis); name := OPS.name; CheckMark(vis);
OPT.FindField(name, recTyp, fwd); OPT.FindField(name, recTyp, fwd);
OPT.FindField(name, recTyp^.BaseTyp, baseProc); 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 = baseProc THEN fwd := NIL END ;
IF (fwd # NIL) & (fwd^.mnolev # level) 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 *) (* there exists a corresponding forward declaration *)
proc := OPT.NewObj(); proc^.leaf := TRUE; proc := OPT.NewObj(); proc^.leaf := TRUE;
IF fwd^.vis # vis THEN err(118) END 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 ; IF (objMode # baseProc^.link^.mode) OR ~Extends(objTyp, baseProc^.link^.typ) THEN err(115) END ;
OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE); OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE);
IF proc^.typ # baseProc^.typ THEN err(117) END ; IF proc^.typ # baseProc^.typ THEN err(117) END ;
IF (baseProc^.vis = OPM.external) & (proc^.vis = OPM.internal) & IF (baseProc^.vis = OPT.external) & (proc^.vis = OPT.internal) &
(recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = OPM.external) THEN err(109) (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = OPT.external) THEN err(109)
END ; END ;
INCL(proc^.conval^.setval, OPM.isRedef) INCL(proc^.conval^.setval, OPT.isRedef)
END ; END ;
IF ~forward THEN Body END ; IF ~forward THEN Body END ;
DEC(level); OPT.CloseScope 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
END TProcDecl; 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.ident) & (sym # OPM.lparen) THEN
IF sym = OPM.times THEN (* mode set later in OPB.CheckAssign *) IF sym = OPM.times THEN (* mode set later in OPB.CheckAssign *)
ELSIF sym = OPM.arrow THEN forward := TRUE ELSIF sym = OPM.arrow THEN forward := TRUE
ELSIF sym = OPM.plus THEN mode := OPM.IProc ELSIF sym = OPM.plus THEN mode := OPT.IProc
ELSIF sym = OPM.minus THEN mode := OPM.CProc ELSIF sym = OPM.minus THEN mode := OPT.CProc
ELSE err(OPM.ident) ELSE err(OPM.ident)
END ; 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) OPS.Get(sym)
END ; END ;
IF sym = OPM.lparen THEN TProcDecl IF sym = OPM.lparen THEN TProcDecl
ELSIF sym = OPM.ident THEN OPT.Find(fwd); ELSIF sym = OPM.ident THEN OPT.Find(fwd);
name := OPS.name; CheckMark(vis); name := OPS.name; CheckMark(vis);
IF (vis # OPM.internal) & (mode = OPM.LProc) THEN mode := OPM.XProc END ; IF (vis # OPT.internal) & (mode = OPT.LProc) THEN mode := OPT.XProc END ;
IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = OPM.SProc)) THEN fwd := NIL END ; IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = OPT.SProc)) THEN fwd := NIL END ;
IF (fwd # NIL) & (fwd^.mode IN {OPM.LProc, OPM.XProc}) & ~(OPM.hasBody IN fwd^.conval^.setval) THEN IF (fwd # NIL) & (fwd^.mode IN {OPT.LProc, OPT.XProc}) & ~(OPT.hasBody IN fwd^.conval^.setval) THEN
(* there exists a corresponding forward declaration *) (* there exists a corresponding forward declaration *)
proc := OPT.NewObj(); proc^.leaf := TRUE; proc := OPT.NewObj(); proc^.leaf := TRUE;
IF fwd^.vis # vis THEN err(118) END 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 ; IF fwd # NIL THEN err(1); fwd := NIL END ;
OPT.Insert(name, proc) OPT.Insert(name, proc)
END ; 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); INC(level); OPT.OpenScope(level, proc);
proc^.link := NIL; GetParams; proc^.link := NIL; GetParams;
IF mode = OPM.CProc THEN GetCode IF mode = OPT.CProc THEN GetCode
ELSIF ~forward THEN Body ELSIF ~forward THEN Body
END ; END ;
DEC(level); OPT.CloseScope 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; VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
BEGIN lab := NIL; lastlab := NIL; BEGIN lab := NIL; lastlab := NIL;
LOOP ConstExpression(x); f := x^.typ^.form; 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 ELSE err(61); xval := 1
END ; END ;
IF f IN OPM.intSet THEN IF f IN OPT.intSet THEN
IF LabelForm < f THEN err(60) END IF LabelForm < f THEN err(60) END
ELSIF LabelForm # f THEN err(60) ELSIF LabelForm # f THEN err(60)
END ; END ;
IF sym = OPM.upto THEN IF sym = OPM.upto THEN
OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval; 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 IF yval < xval THEN err(63); yval := xval END
ELSE yval := xval ELSE yval := xval
END ; 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; tab: CaseTable; cases, lab, y, lastcase: OPT.Node;
BEGIN BEGIN
Expression(x); pos := OPM.errpos; Expression(x); pos := OPM.errpos;
IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
ELSIF ~(x^.typ^.form IN {OPM.Char..OPM.LInt}) THEN err(125) ELSIF ~(x^.typ^.form IN {OPT.Char..OPT.LInt}) THEN err(125)
END ; END ;
CheckSym(OPM.of); cases := NIL; lastcase := NIL; n := 0; CheckSym(OPM.of); cases := NIL; lastcase := NIL; n := 0;
LOOP LOOP
IF sym < OPM.bar THEN IF sym < OPM.bar THEN
CaseLabelList(lab, x^.typ^.form, n, tab); CaseLabelList(lab, x^.typ^.form, n, tab);
CheckSym(OPM.colon); StatSeq(y); 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 ; END ;
IF sym = OPM.bar THEN OPS.Get(sym) ELSE EXIT END IF sym = OPM.bar THEN OPS.Get(sym) ELSE EXIT END
END ; END ;
@ -735,7 +735,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
y := NIL; y := NIL;
OPM.Mark(-307, OPM.curpos); (* notice about no OPM.else symbol; -- noch *) OPM.Mark(-307, OPM.curpos); (* notice about no OPM.else symbol; -- noch *)
END ; 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 := OPT.NewConst();
cases^.conval^.intval := low; cases^.conval^.intval2 := high; cases^.conval^.intval := low; cases^.conval^.intval2 := high;
IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END 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); PROCEDURE CheckBool(VAR x: OPT.Node);
BEGIN BEGIN
IF (x^.class = OPM.Ntype) OR (x^.class = OPM.Nproc) THEN err(126); 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 # OPM.Bool THEN err(120); x := OPB.NewBoolConst(FALSE) ELSIF x^.typ^.form # OPT.Bool THEN err(120); x := OPB.NewBoolConst(FALSE)
END ; END ;
pos := OPM.errpos pos := OPM.errpos
END CheckBool; 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) OPS.Get(sym); Expression(y); OPB.Assign(x, y)
ELSIF sym = OPM.eql THEN ELSIF sym = OPM.eql THEN
err(OPM.becomes); OPS.Get(sym); Expression(y); OPB.Assign(x, y) 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); StandProcCall(x);
IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END
ELSE OPB.PrepCall(x, fpar); 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 pos := OPM.errpos
ELSIF sym = OPM.if THEN ELSIF sym = OPM.if THEN
OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(OPM.then); StatSeq(y); 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 WHILE sym = OPM.elsif DO
OPS.Get(sym); Expression(y); CheckBool(y); CheckSym(OPM.then); StatSeq(z); 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 ; END ;
IF sym = OPM.else THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL 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 ELSIF sym = OPM.case THEN
OPS.Get(sym); CasePart(x); CheckSym(OPM.end) OPS.Get(sym); CasePart(x); CheckSym(OPM.end)
ELSIF sym = OPM.while THEN ELSIF sym = OPM.while THEN
OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(OPM.do); StatSeq(y); 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 ELSIF sym = OPM.repeat THEN
OPS.Get(sym); StatSeq(x); OPS.Get(sym); StatSeq(x);
IF sym = OPM.until THEN OPS.Get(sym); Expression(y); CheckBool(y) IF sym = OPM.until THEN OPS.Get(sym); Expression(y); CheckBool(y)
ELSE err(OPM.until) ELSE err(OPM.until)
END ; END ;
OPB.Construct(OPM.Nrepeat, x, y) OPB.Construct(OPT.Nrepeat, x, y)
ELSIF sym = OPM.for THEN ELSIF sym = OPM.for THEN
OPS.Get(sym); OPS.Get(sym);
IF sym = OPM.ident THEN qualident(id); 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; CheckSym(OPM.becomes); Expression(y); pos := OPM.errpos;
x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x); x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x);
CheckSym(OPM.to); Expression(y); pos := OPM.errpos; 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 *) 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; obj := OPT.topScope^.scope;
IF obj = NIL THEN OPT.topScope^.scope := t IF obj = NIL THEN OPT.topScope^.scope := t
ELSE ELSE
@ -817,7 +817,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END ; END ;
z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z); z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z);
y := OPB.NewLeaf(t) 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 ; END ;
OPB.Link(stat, last, x); OPB.Link(stat, last, x);
IF sym = OPM.by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ; 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) ELSE err(63); OPB.Op(OPM.geq, x, y)
END ; END ;
CheckSym(OPM.do); StatSeq(s); 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 IF s = NIL THEN s := y
ELSE z := s; ELSE z := s;
WHILE z^.link # NIL DO z := z^.link END ; WHILE z^.link # NIL DO z := z^.link END ;
z^.link := y z^.link := y
END ; END ;
CheckSym(OPM.end); OPB.Construct(OPM.Nwhile, x, s) CheckSym(OPM.end); OPB.Construct(OPT.Nwhile, x, s)
ELSE err(OPM.ident) ELSE err(OPM.ident)
END END
ELSIF sym = OPM.loop THEN ELSIF sym = OPM.loop THEN
OPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel); 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 ELSIF sym = OPM.with THEN
OPS.Get(sym); idtyp := NIL; x := NIL; OPS.Get(sym); idtyp := NIL; x := NIL;
LOOP LOOP
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
qualident(id); y := OPB.NewLeaf(id); 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 *) err(245) (* jt: do not allow WITH on non-local pointers *)
END ; END ;
CheckSym(OPM.colon); CheckSym(OPM.colon);
IF sym = OPM.ident THEN qualident(t); IF sym = OPM.ident THEN qualident(t);
IF t^.mode = OPM.Typ THEN IF t^.mode = OPT.Typ THEN
IF id # NIL THEN IF id # NIL THEN
idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ
ELSE err(130) ELSE err(130)
@ -860,19 +860,19 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END END
ELSE err(OPM.ident) ELSE err(OPM.ident)
END ; 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 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 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 IF sym = OPM.bar THEN OPS.Get(sym) ELSE EXIT END
END; END;
e := sym = OPM.else; e := sym = OPM.else;
IF e THEN OPS.Get(sym); StatSeq(s) ELSE s := NIL END ; 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 IF e THEN x^.subcl := 1 END
ELSIF sym = OPM.exit THEN ELSIF sym = OPM.exit THEN
OPS.Get(sym); OPS.Get(sym);
IF LoopLevel = 0 THEN err(46) END ; IF LoopLevel = 0 THEN err(46) END ;
OPB.Construct(OPM.Nexit, x, NIL); OPB.Construct(OPT.Nexit, x, NIL);
pos := OPM.errpos pos := OPM.errpos
ELSIF sym = OPM.return THEN OPS.Get(sym); ELSIF sym = OPM.return THEN OPS.Get(sym);
IF sym < OPM.semicolon THEN Expression(x) END ; 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); OPS.Get(sym);
WHILE sym = OPM.ident DO WHILE sym = OPM.ident DO
OPT.Insert(OPS.name, obj); CheckMark(obj^.vis); 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 IF sym = OPM.eql THEN
OPS.Get(sym); ConstExpression(x) OPS.Get(sym); ConstExpression(x)
ELSIF sym = OPM.becomes THEN ELSIF sym = OPM.becomes THEN
err(OPM.eql); OPS.Get(sym); ConstExpression(x) err(OPM.eql); OPS.Get(sym); ConstExpression(x)
ELSE err(OPM.eql); x := OPB.NewIntConst(1) ELSE err(OPM.eql); x := OPB.NewIntConst(1)
END ; 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) CheckSym(OPM.semicolon)
END END
END ; END ;
IF sym = OPM.type THEN IF sym = OPM.type THEN
OPS.Get(sym); OPS.Get(sym);
WHILE sym = OPM.ident DO 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); CheckMark(obj^.vis);
IF sym = OPM.eql THEN IF sym = OPM.eql THEN
OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ) 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) ELSE err(OPM.eql)
END ; END ;
IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj 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; i := 0;
WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i); WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i);
IF typ^.link^.name = obj^.name THEN typ^.BaseTyp := obj^.typ; typ^.link^.name := "" END 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 LOOP
IF sym = OPM.ident THEN IF sym = OPM.ident THEN
OPT.Insert(OPS.name, obj); CheckMark(obj^.vis); 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 first = NIL THEN first := obj END ;
IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ; IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ;
last := obj last := obj
@ -952,7 +952,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); CheckSym(OPM.colon); Type(typ, OPT.notyp);
typ^.pvused := TRUE; 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 ; WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
CheckSym(OPM.semicolon) CheckSym(OPM.semicolon)
END END

544
src/compiler/OPT.Mod
View file

@ -6,16 +6,11 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *)
IMPORT OPS, OPM; IMPORT OPS, OPM;
CONST
MaxConstLen* = OPS.MaxStrLen;
(* Constants - value of literals *)
TYPE TYPE
Const* = POINTER TO ConstDesc; Const* = POINTER TO ConstDesc;
Object* = POINTER TO ObjDesc;
Struct* = POINTER TO StrDesc;
Node* = POINTER TO NodeDesc;
ConstExt* = POINTER TO OPS.String; ConstExt* = POINTER TO OPS.String;
ConstDesc* = RECORD ConstDesc* = RECORD
ext*: ConstExt; (* string or code for code proc *) ext*: ConstExt; (* string or code for code proc *)
intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) 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 *) realval*: LONGREAL (* real or longreal constant value *)
END; 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 ObjDesc* = RECORD
left*, right*: Object; left*, right*: Object;
link*, scope*: Object; link*, scope*: Object;
name*: OPS.Name; name*: OPS.Name;
leaf*: BOOLEAN; leaf*: BOOLEAN;
mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) 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 # "" *) history*: SHORTINT; (* relevant if name # "" *)
used*, fpdone*: BOOLEAN; used*, fpdone*: BOOLEAN;
fprint*: LONGINT; fprint*: LONGINT;
@ -40,6 +48,32 @@ TYPE
x*: INTEGER (* linkadr and x can be freely used by the backend *) x*: INTEGER (* linkadr and x can be freely used by the backend *)
END; 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 StrDesc* = RECORD
form*, comp*: SHORTINT; form*, comp*: SHORTINT;
mno*, extlev*: SHORTINT; mno*, extlev*: SHORTINT;
@ -54,6 +88,25 @@ TYPE
link*, strobj*: Object link*, strobj*: Object
END; 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 NodeDesc* = RECORD
left*, right*, link*: Node; left*, right*, link*: Node;
class*, subcl*: SHORTINT; class*, subcl*: SHORTINT;
@ -63,10 +116,36 @@ TYPE
conval*: Const conval*: Const
END; 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 CONST
maxImps = 64; (* must be <= MAX(SHORTINT) *) maxImps = 64; (* must be <= MAX(SHORTINT) *)
maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *)
FirstRef = OPM.Comp + 1; FirstRef = Comp + 1;
VAR VAR
typSize*: PROCEDURE(typ: Struct); typSize*: PROCEDURE(typ: Struct);
@ -85,6 +164,9 @@ VAR
SYSimported*: BOOLEAN; SYSimported*: BOOLEAN;
CONST CONST
(* Symbol file items *) (* Symbol file items *)
Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21; Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21;
Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26; Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26;
@ -136,7 +218,7 @@ END NewObj;
PROCEDURE NewStr*(form, comp: SHORTINT): Struct; PROCEDURE NewStr*(form, comp: SHORTINT): Struct;
VAR typ: Struct; VAR typ: Struct;
BEGIN NEW(typ); typ^.form := form; typ^.comp := comp; typ^.ref := maxStruct; (* ref >= maxStruct: not exported yet *) 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 typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ
END NewStr; END NewStr;
@ -153,7 +235,7 @@ END NewExt;
PROCEDURE OpenScope*(level: SHORTINT; owner: Object); PROCEDURE OpenScope*(level: SHORTINT; owner: Object);
VAR head: Object; VAR head: Object;
BEGIN head := NewObj(); 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; IF owner # NIL THEN owner^.scope := head END;
head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head
END OpenScope; END OpenScope;
@ -187,7 +269,7 @@ BEGIN obj := mod^.scope;
IF OPS.name < obj^.name THEN obj := obj^.left IF OPS.name < obj^.name THEN obj := obj^.left
ELSIF OPS.name > obj^.name THEN obj := obj^.right ELSIF OPS.name > obj^.name THEN obj := obj^.right
ELSE (*found*) 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 ELSE obj^.used := TRUE
END; END;
EXIT EXIT
@ -298,11 +380,11 @@ BEGIN
IF (strobj # NIL) & (strobj^.name # "") THEN IF (strobj # NIL) & (strobj^.name # "") THEN
FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name) FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name)
END; 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) 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) 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; END;
typ^.idfp := idfp typ^.idfp := idfp
END END
@ -316,10 +398,10 @@ PROCEDURE FPrintStr*(typ: Struct);
PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *) PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *)
VAR i, j, n: LONGINT; btyp: Struct; VAR i, j, n: LONGINT; btyp: Struct;
BEGIN BEGIN
IF typ^.comp = OPM.Record THEN FPrintFlds(typ^.link, adr, FALSE) IF typ^.comp = Record THEN FPrintFlds(typ^.link, adr, FALSE)
ELSIF typ^.comp = OPM.Array THEN btyp := typ^.BaseTyp; n := typ^.n; ELSIF typ^.comp = 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 = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END;
IF (btyp^.form = OPM.Pointer) OR (btyp^.comp = OPM.Record) THEN IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN
j := nofhdfld; FPrintHdFld(btyp, fld, adr); j := nofhdfld; FPrintHdFld(btyp, fld, adr);
IF j # nofhdfld THEN i := 1; IF j # nofhdfld THEN i := 1;
WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
@ -327,17 +409,17 @@ PROCEDURE FPrintStr*(typ: Struct);
END END
END 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.FPrint(pvfp, OPM.Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld) OPM.FPrint(pvfp, Pointer); OPM.FPrint(pvfp, 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.FPrint(pvfp, OPM.ProcTyp); OPM.FPrint(pvfp, adr); INC(nofhdfld) OPM.FPrint(pvfp, ProcTyp); OPM.FPrint(pvfp, adr); INC(nofhdfld)
END END
END FPrintHdFld; END FPrintHdFld;
PROCEDURE FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); (* modifies pbfp and pvfp *) PROCEDURE FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); (* modifies pbfp and pvfp *)
BEGIN BEGIN
WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO WHILE (fld # NIL) & (fld^.mode = Fld) DO
IF (fld^.vis # OPM.internal) & visible THEN IF (fld^.vis # internal) & visible THEN
OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); 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) FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp)
ELSE ELSE
@ -351,12 +433,12 @@ PROCEDURE FPrintStr*(typ: Struct);
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
FPrintTProcs(obj^.left); FPrintTProcs(obj^.left);
IF obj^.mode = OPM.TProc THEN IF obj^.mode = TProc THEN
IF obj^.vis # OPM.internal THEN IF obj^.vis # internal THEN
OPM.FPrint(pbfp, OPM.TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H); OPM.FPrint(pbfp, TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H);
FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name) FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name)
ELSIF OPM.ExpHdTProc THEN 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
END; END;
FPrintTProcs(obj^.right) FPrintTProcs(obj^.right)
@ -370,15 +452,15 @@ BEGIN
pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *) pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *)
typ^.fpdone := TRUE; typ^.fpdone := TRUE;
f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp; f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp;
IF f = OPM.Pointer THEN IF f = Pointer THEN
strobj := typ^.strobj; bstrobj := btyp^.strobj; strobj := typ^.strobj; bstrobj := btyp^.strobj;
IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN
FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); pvfp := pbfp 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 *) (* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *)
END END
ELSIF f = OPM.ProcTyp THEN (* use idfp as pbfp and as pvfp *) ELSIF f = 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 ELSIF c IN {Array, DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp
ELSE (* c = OPM.Record *) ELSE (* c = Record *)
IF btyp # NIL THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); OPM.FPrint(pvfp, btyp^.pvfp) END; 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); OPM.FPrint(pvfp, typ^.size); OPM.FPrint(pvfp, typ^.align); OPM.FPrint(pvfp, typ^.n);
nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE); nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE);
@ -396,30 +478,30 @@ BEGIN
IF ~obj^.fpdone THEN IF ~obj^.fpdone THEN
fprint := 0; obj^.fpdone := TRUE; fprint := 0; obj^.fpdone := TRUE;
OPM.FPrint(fprint, obj^.mode); OPM.FPrint(fprint, obj^.mode);
IF obj^.mode = OPM.Con THEN IF obj^.mode = Con THEN
f := obj^.typ^.form; OPM.FPrint(fprint, f); f := obj^.typ^.form; OPM.FPrint(fprint, f);
CASE f OF CASE f OF
| OPM.Bool, | Bool,
OPM.Char, Char,
OPM.SInt, SInt,
OPM.Int, Int,
OPM.LInt: OPM.FPrint(fprint, obj^.conval^.intval) LInt: OPM.FPrint(fprint, obj^.conval^.intval)
| OPM.Set: OPM.FPrintSet(fprint, obj^.conval^.setval) | Set: OPM.FPrintSet(fprint, obj^.conval^.setval)
| OPM.Real: rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval) | Real: rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval)
| OPM.LReal: OPM.FPrintLReal(fprint, obj^.conval^.realval) | LReal: OPM.FPrintLReal(fprint, obj^.conval^.realval)
| OPM.String: FPrintName(fprint, obj^.conval^.ext^) | String: FPrintName(fprint, obj^.conval^.ext^)
| OPM.NilTyp: | NilTyp:
ELSE err(127) ELSE err(127)
END 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) 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) 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; FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext;
m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m); m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m);
WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END; 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) FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp)
END; END;
obj^.fprint := fprint obj^.fprint := fprint
@ -495,7 +577,7 @@ BEGIN
WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END; WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END;
IF i < nofGmod THEN mno := i (*module already present*) IF i < nofGmod THEN mno := i (*module already present*)
ELSE 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; mno := nofGmod; head^.mnolev := -mno;
IF nofGmod < maxImps THEN IF nofGmod < maxImps THEN
GlbMod[mno] := head; INC(nofGmod) GlbMod[mno] := head; INC(nofGmod)
@ -513,25 +595,25 @@ PROCEDURE InConstant(f: LONGINT; conval: Const);
VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL;
BEGIN BEGIN
CASE f OF CASE f OF
| OPM.Byte, | Byte,
OPM.Char, Char,
OPM.Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch) Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch)
| OPM.SInt, | SInt,
OPM.Int, Int,
OPM.LInt: conval^.intval := OPM.SymRInt() LInt: conval^.intval := OPM.SymRInt()
| OPM.Set: OPM.SymRSet(conval^.setval) | Set: OPM.SymRSet(conval^.setval)
| OPM.Real: OPM.SymRReal(rval); conval^.realval := rval; | Real: OPM.SymRReal(rval); conval^.realval := rval;
conval^.intval := OPM.ConstNotAlloc conval^.intval := OPM.ConstNotAlloc
| OPM.LReal: OPM.SymRLReal(conval^.realval); | LReal: OPM.SymRLReal(conval^.realval);
conval^.intval := OPM.ConstNotAlloc conval^.intval := OPM.ConstNotAlloc
| OPM.String: ext := NewExt(); conval^.ext := ext; i := 0; | String: ext := NewExt(); conval^.ext := ext; i := 0;
REPEAT REPEAT
OPM.SymRCh(ch); ext^[i] := ch; INC(i) OPM.SymRCh(ch); ext^[i] := ch; INC(i)
UNTIL ch = 0X; UNTIL ch = 0X;
conval^.intval2 := i; conval^.intval2 := i;
conval^.intval := OPM.ConstNotAlloc conval^.intval := OPM.ConstNotAlloc
| OPM.NilTyp: conval^.intval := OPM.nilval | NilTyp: conval^.intval := OPM.nilval
ELSE OPM.LogWStr("unhandled case in OPT.InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
END END
END InConstant; END InConstant;
@ -545,7 +627,7 @@ BEGIN
WHILE tag # Send DO WHILE tag # Send DO
new := NewObj(); new^.mnolev := -mno; new := NewObj(); new^.mnolev := -mno;
IF last = NIL THEN par := new ELSE last^.link := new END; 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); InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name);
last := new; tag := OPM.SymRInt() last := new; tag := OPM.SymRInt()
END END
@ -556,14 +638,14 @@ PROCEDURE InFld(): Object; (* first number in impCtxt.nextTag, mno set outside
BEGIN BEGIN
tag := impCtxt.nextTag; obj := NewObj(); tag := impCtxt.nextTag; obj := NewObj();
IF tag <= Srfld THEN IF tag <= Srfld THEN
obj^.mode := OPM.Fld; obj^.mode := Fld;
IF tag = Srfld THEN obj^.vis := OPM.externalR ELSE obj^.vis := OPM.external END; IF tag = Srfld THEN obj^.vis := externalR ELSE obj^.vis := external END;
InStruct(obj^.typ); InName(obj^.name); InStruct(obj^.typ); InName(obj^.name);
obj^.adr := OPM.SymRInt() obj^.adr := OPM.SymRInt()
ELSE ELSE
obj^.mode := OPM.Fld; obj^.mode := Fld;
IF tag = Shdptr THEN obj^.name := OPM.HdPtrName ELSE obj^.name := OPM.HdProcName END; 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() obj^.adr := OPM.SymRInt()
END; END;
RETURN obj RETURN obj
@ -575,13 +657,13 @@ BEGIN
tag := impCtxt.nextTag; tag := impCtxt.nextTag;
obj := NewObj(); obj^.mnolev := -mno; obj := NewObj(); obj^.mnolev := -mno;
IF tag = Stpro THEN IF tag = Stpro THEN
obj^.mode := OPM.TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1; obj^.mode := TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1;
InSign(mno, obj^.typ, obj^.link); obj^.vis := OPM.external; InName(obj^.name); InSign(mno, obj^.typ, obj^.link); obj^.vis := external; InName(obj^.name);
obj^.adr := 10000H*OPM.SymRInt() obj^.adr := 10000H*OPM.SymRInt()
ELSE (* tag = Shdtpro *) 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^.link := NewObj(); (* dummy, easier in Browser *)
obj^.typ := undftyp; obj^.vis := OPM.internal; obj^.typ := undftyp; obj^.vis := internal;
obj^.adr := 10000H*OPM.SymRInt() obj^.adr := 10000H*OPM.SymRInt()
END; END;
RETURN obj RETURN obj
@ -604,43 +686,43 @@ BEGIN
ELSE ELSE
obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := ""
END; END;
typ := NewStr(OPM.Undef, OPM.Basic) typ := NewStr(Undef, Basic)
ELSE ELSE
obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); obj^.name := name; InsertImport(obj, GlbMod[mno].right, old);
IF old # NIL THEN (* recalculate fprints to compare with old fprints *) IF old # NIL THEN (* recalculate fprints to compare with old fprints *)
FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp;
IF impCtxt.self THEN (* do not overwrite old typ *) 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 *) ELSE (* overwrite old typ for compatibility reason *)
typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0;
typ^.fpdone := FALSE; typ^.idfpdone := FALSE typ^.fpdone := FALSE; typ^.idfpdone := FALSE
END END
ELSE ELSE
typ := NewStr(OPM.Undef, OPM.Basic) typ := NewStr(Undef, Basic)
END END
END; END;
impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; impCtxt.ref[ref] := typ; impCtxt.old[ref] := old;
typ^.ref := ref + maxStruct; typ^.ref := ref + maxStruct;
(* ref >= maxStruct: not exported yet, ref used for err 155 *) (* ref >= maxStruct: not exported yet, ref used for err 155 *)
typ^.mno := mno; typ^.allocated := TRUE; typ^.mno := mno; typ^.allocated := TRUE;
typ^.strobj := obj; obj^.mode := OPM.Typ; obj^.typ := typ; typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ;
obj^.mnolev := -mno; obj^.vis := OPM.internal; (* name not visible here *) obj^.mnolev := -mno; obj^.vis := internal; (* name not visible here *)
tag := OPM.SymRInt(); tag := OPM.SymRInt();
IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END; IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END;
CASE tag OF 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) 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(); InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt();
typSize(typ) (* no bounds address !! *) typSize(typ) (* no bounds address !! *)
| Sdarr: typ^.form := OPM.Comp; typ^.comp := OPM.DynArr; InStruct(typ^.BaseTyp); | Sdarr: typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp);
IF typ^.BaseTyp^.comp = OPM.DynArr THEN IF typ^.BaseTyp^.comp = DynArr THEN
typ^.n := typ^.BaseTyp^.n + 1 typ^.n := typ^.BaseTyp^.n + 1
ELSE ELSE
typ^.n := 0 typ^.n := 0
END; END;
typSize(typ) typSize(typ)
| Srec: typ^.form := OPM.Comp; typ^.comp := OPM.Record; | Srec: typ^.form := Comp; typ^.comp := Record;
InStruct(typ^.BaseTyp); InStruct(typ^.BaseTyp);
IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END;
typ.extlev := 0; t := typ.BaseTyp; typ.extlev := 0; t := typ.BaseTyp;
@ -662,9 +744,9 @@ BEGIN
InsertImport(fld, typ^.link, dummy); InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt() impCtxt.nextTag := OPM.SymRInt()
END END
| Spro: typ^.form := OPM.ProcTyp; typ^.size := OPM.ProcSize; | Spro: typ^.form := ProcTyp; typ^.size := OPM.ProcSize;
InSign(mno, typ^.BaseTyp, typ^.link) 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; END;
IF ref = impCtxt.minr THEN IF ref = impCtxt.minr THEN
WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO
@ -676,36 +758,36 @@ BEGIN
t^.strobj := old; (* restore strobj *) t^.strobj := old; (* restore strobj *)
IF impCtxt.self THEN IF impCtxt.self THEN
IF old^.mnolev < 0 THEN IF old^.mnolev < 0 THEN
IF old^.history # OPM.inconsistent THEN IF old^.history # inconsistent THEN
IF old^.fprint # obj^.fprint THEN IF old^.fprint # obj^.fprint THEN
old^.history := OPM.pbmodified old^.history := pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := OPM.pvmodified old^.history := pvmodified
END END
(* ELSE remain OPM.inconsistent *) (* ELSE remain inconsistent *)
END END
ELSIF old^.fprint # obj^.fprint THEN ELSIF old^.fprint # obj^.fprint THEN
old^.history := OPM.pbmodified old^.history := pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := OPM.pvmodified old^.history := pvmodified
ELSIF old^.vis = OPM.internal THEN ELSIF old^.vis = internal THEN
old^.history := OPM.same (* may be changed to "OPM.removed" in InObj *) old^.history := same (* may be changed to "removed" in InObj *)
ELSE ELSE
old^.history := OPM.inserted (* may be changed to "OPM.same" in InObj *) old^.history := inserted (* may be changed to "same" in InObj *)
END END
ELSE ELSE
(* check private part, delay error message until really used *) (* check private part, delay error message until really used *)
IF impCtxt.pvfp[ref] # t^.pvfp THEN IF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := OPM.inconsistent old^.history := inconsistent
END; END;
IF old^.fprint # obj^.fprint THEN IF old^.fprint # obj^.fprint THEN
FPrintErr(old, 249) FPrintErr(old, 249)
END END
END END
ELSIF impCtxt.self THEN ELSIF impCtxt.self THEN
obj^.history := OPM.removed obj^.history := removed
ELSE ELSE
obj^.history := OPM.same obj^.history := same
END; END;
INC(ref) INC(ref)
END; END;
@ -721,35 +803,35 @@ BEGIN
tag := impCtxt.nextTag; tag := impCtxt.nextTag;
IF tag = Stype THEN IF tag = Stype THEN
InStruct(typ); obj := typ^.strobj; 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 ELSE
obj := NewObj(); obj^.mnolev := -mno; obj^.vis := OPM.external; obj := NewObj(); obj^.mnolev := -mno; obj^.vis := external;
IF tag <= OPM.Pointer THEN (* Constant *) IF tag <= Pointer THEN (* Constant *)
obj^.mode := OPM.Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval) obj^.mode := Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval)
ELSIF tag >= Sxpro THEN ELSIF tag >= Sxpro THEN
obj^.conval := NewConst(); obj^.conval := NewConst();
obj^.conval^.intval := -1; obj^.conval^.intval := -1;
InSign(mno, obj^.typ, obj^.link); InSign(mno, obj^.typ, obj^.link);
CASE tag OF CASE tag OF
| Sxpro: obj^.mode := OPM.XProc | Sxpro: obj^.mode := XProc
| Sipro: obj^.mode := OPM.IProc | Sipro: obj^.mode := IProc
| Scpro: obj^.mode := OPM.CProc; | Scpro: obj^.mode := CProc;
ext := NewExt(); obj^.conval^.ext := ext; ext := NewExt(); obj^.conval^.ext := ext;
s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1;
WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END 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 END
ELSIF tag = Salias THEN ELSIF tag = Salias THEN
obj^.mode := OPM.Typ; InStruct(obj^.typ) obj^.mode := Typ; InStruct(obj^.typ)
ELSE ELSE
obj^.mode := OPM.Var; obj^.mode := Var;
IF tag = Srvar THEN obj^.vis := OPM.externalR END; IF tag = Srvar THEN obj^.vis := externalR END;
InStruct(obj^.typ) InStruct(obj^.typ)
END; END;
InName(obj^.name) InName(obj^.name)
END; END;
FPrintObj(obj); 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 *) (* compute a global fingerprint to avoid structural type equivalence for anonymous types *)
OPM.FPrint(impCtxt.reffp, obj^.typ^.ref - maxStruct) OPM.FPrint(impCtxt.reffp, obj^.typ^.ref - maxStruct)
END; END;
@ -758,21 +840,21 @@ BEGIN
IF impCtxt.self THEN IF impCtxt.self THEN
IF old # NIL THEN IF old # NIL THEN
(* obj is from old symbol file, old is new declaration *) (* 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 *) ELSE FPrintObj(old); (* FPrint(obj) already called *)
IF obj^.fprint # old^.fprint THEN old^.history := OPM.pbmodified IF obj^.fprint # old^.fprint THEN old^.history := pbmodified
ELSIF obj^.typ^.pvfp # old^.typ^.pvfp THEN old^.history := OPM.pvmodified ELSIF obj^.typ^.pvfp # old^.typ^.pvfp THEN old^.history := pvmodified
ELSE old^.history := OPM.same ELSE old^.history := same
END END
END END
ELSE obj^.history := OPM.removed (* OutObj not called if mnolev < 0 *) ELSE obj^.history := removed (* OutObj not called if mnolev < 0 *)
END END
(* ELSE old = NIL, or file read twice, consistent, OutObj not called *) (* ELSE old = NIL, or file read twice, consistent, OutObj not called *)
END END
ELSE (* obj already OPM.inserted in InStruct *) ELSE (* obj already inserted in InStruct *)
IF impCtxt.self THEN (* obj^.mnolev = 0 *) IF impCtxt.self THEN (* obj^.mnolev = 0 *)
IF obj^.vis = OPM.internal THEN obj^.history := OPM.removed IF obj^.vis = internal THEN obj^.history := removed
ELSIF obj^.history = OPM.inserted THEN obj^.history := OPM.same ELSIF obj^.history = inserted THEN obj^.history := same
END END
(* ELSE OutObj not called for obj with mnolev < 0 *) (* ELSE OutObj not called for obj with mnolev < 0 *)
END 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 *) VAR obj: Object; mno: SHORTINT; (* done used in Browser *)
BEGIN BEGIN
IF name = "SYSTEM" THEN SYSimported := TRUE; 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 ELSE
impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0; impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0;
impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0; impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0;
@ -796,7 +878,7 @@ BEGIN
obj := InObj(mno); impCtxt.nextTag := OPM.SymRInt() obj := InObj(mno); impCtxt.nextTag := OPM.SymRInt()
END; END;
Insert(aliasName, obj); Insert(aliasName, obj);
obj^.mode := OPM.Mod; obj^.scope := GlbMod[mno].right; obj^.mode := Mod; obj^.scope := GlbMod[mno].right;
GlbMod[mno].link := obj; GlbMod[mno].link := obj;
obj^.mnolev := -mno; obj^.typ := notyp; obj^.mnolev := -mno; obj^.typ := notyp;
OPM.CloseOldSym OPM.CloseOldSym
@ -831,10 +913,10 @@ END Import;
PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT); PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT);
VAR i, j, n: LONGINT; btyp: Struct; VAR i, j, n: LONGINT; btyp: Struct;
BEGIN BEGIN
IF typ^.comp = OPM.Record THEN OutFlds(typ^.link, adr, FALSE) IF typ^.comp = Record THEN OutFlds(typ^.link, adr, FALSE)
ELSIF typ^.comp = OPM.Array THEN btyp := typ^.BaseTyp; n := typ^.n; ELSIF typ^.comp = 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 = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END;
IF (btyp^.form = OPM.Pointer) OR (btyp^.comp = OPM.Record) THEN IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN
j := nofhdfld; OutHdFld(btyp, fld, adr); j := nofhdfld; OutHdFld(btyp, fld, adr);
IF j # nofhdfld THEN i := 1; IF j # nofhdfld THEN i := 1;
WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
@ -842,18 +924,18 @@ END Import;
END END
END 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) 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) OPM.SymWInt(Shdpro); OPM.SymWInt(adr); INC(nofhdfld)
END END
END OutHdFld; END OutHdFld;
PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
BEGIN BEGIN
WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO WHILE (fld # NIL) & (fld^.mode = Fld) DO
IF (fld^.vis # OPM.internal) & visible THEN IF (fld^.vis # internal) & visible THEN
IF fld^.vis = OPM.externalR THEN OPM.SymWInt(Srfld) ELSE OPM.SymWInt(Sfld) END; IF fld^.vis = externalR THEN OPM.SymWInt(Srfld) ELSE OPM.SymWInt(Sfld) END;
OutStr(fld^.typ); OutName(fld^.name); OPM.SymWInt(fld^.adr) OutStr(fld^.typ); OutName(fld^.name); OPM.SymWInt(fld^.adr)
ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr) ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr)
END; END;
@ -865,7 +947,7 @@ END Import;
BEGIN BEGIN
OutStr(result); OutStr(result);
WHILE par # NIL DO 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); OutStr(par^.typ);
OPM.SymWInt(par^.adr); OPM.SymWInt(par^.adr);
OutName(par^.name); par := par^.link OutName(par^.name); par := par^.link
@ -877,13 +959,13 @@ END Import;
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
OutTProcs(typ, obj^.left); OutTProcs(typ, obj^.left);
IF obj^.mode = OPM.TProc THEN IF obj^.mode = TProc THEN
IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = OPM.internal) THEN IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = internal) THEN
OPM.Mark(109, typ^.txtpos) OPM.Mark(109, typ^.txtpos)
(* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *) (* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *)
END; END;
IF OPM.ExpHdTProc OR (obj^.vis # OPM.internal) THEN IF OPM.ExpHdTProc OR (obj^.vis # internal) THEN
IF obj^.vis # OPM.internal THEN IF obj^.vis # internal THEN
OPM.SymWInt(Stpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name); OPM.SymWInt(Stpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name);
OPM.SymWInt(obj^.adr DIV 10000H) OPM.SymWInt(obj^.adr DIV 10000H)
ELSE ELSE
@ -908,31 +990,31 @@ END Import;
IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name); IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name);
CASE strobj^.history OF CASE strobj^.history OF
| OPM.pbmodified: FPrintErr(strobj, 252) | pbmodified: FPrintErr(strobj, 252)
| OPM.pvmodified: FPrintErr(strobj, 251) | pvmodified: FPrintErr(strobj, 251)
| OPM.inconsistent: FPrintErr(strobj, 249) | inconsistent: FPrintErr(strobj, 249)
ELSE (* checked in OutObj or correct indirect export *) 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 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; END;
IF typ^.sysflag # 0 THEN OPM.SymWInt(Ssys); OPM.SymWInt(typ^.sysflag) END; IF typ^.sysflag # 0 THEN OPM.SymWInt(Ssys); OPM.SymWInt(typ^.sysflag) END;
CASE typ^.form OF CASE typ^.form OF
| OPM.Pointer: OPM.SymWInt(Sptr); OutStr(typ^.BaseTyp) | Pointer: OPM.SymWInt(Sptr); OutStr(typ^.BaseTyp)
| OPM.ProcTyp: OPM.SymWInt(Spro); OutSign(typ^.BaseTyp, typ^.link) | ProcTyp: OPM.SymWInt(Spro); OutSign(typ^.BaseTyp, typ^.link)
| OPM.Comp: CASE typ^.comp OF | Comp: CASE typ^.comp OF
| OPM.Array: OPM.SymWInt(Sarr); OutStr(typ^.BaseTyp); OPM.SymWInt(typ^.n) | Array: OPM.SymWInt(Sarr); OutStr(typ^.BaseTyp); OPM.SymWInt(typ^.n)
| OPM.DynArr: OPM.SymWInt(Sdarr); OutStr(typ^.BaseTyp) | DynArr: OPM.SymWInt(Sdarr); OutStr(typ^.BaseTyp)
| OPM.Record: OPM.SymWInt(Srec); | Record: OPM.SymWInt(Srec);
IF typ^.BaseTyp = NIL THEN OutStr(notyp) ELSE OutStr(typ^.BaseTyp) END; IF typ^.BaseTyp = NIL THEN OutStr(notyp) ELSE OutStr(typ^.BaseTyp) END;
(* BaseTyp should be Notyp, too late to change *) (* BaseTyp should be Notyp, too late to change *)
OPM.SymWInt(typ^.size); OPM.SymWInt(typ^.align); OPM.SymWInt(typ^.n); OPM.SymWInt(typ^.size); OPM.SymWInt(typ^.align); OPM.SymWInt(typ^.n);
nofhdfld := 0; OutFlds(typ^.link, 0, TRUE); nofhdfld := 0; OutFlds(typ^.link, 0, TRUE);
IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END; IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END;
OutTProcs(typ, typ^.link); OPM.SymWInt(Send) 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 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 END
END OutStr; END OutStr;
@ -942,16 +1024,16 @@ END Import;
BEGIN BEGIN
f := obj^.typ^.form; OPM.SymWInt(f); f := obj^.typ^.form; OPM.SymWInt(f);
CASE f OF CASE f OF
| OPM.Bool, | Bool,
OPM.Char: OPM.SymWCh(CHR(obj^.conval^.intval)) Char: OPM.SymWCh(CHR(obj^.conval^.intval))
| OPM.SInt, | SInt,
OPM.Int, Int,
OPM.LInt: OPM.SymWInt(obj^.conval^.intval) LInt: OPM.SymWInt(obj^.conval^.intval)
| OPM.Set: OPM.SymWSet(obj^.conval^.setval) | Set: OPM.SymWSet(obj^.conval^.setval)
| OPM.Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval) | Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval)
| OPM.LReal: OPM.SymWLReal(obj^.conval^.realval) | LReal: OPM.SymWLReal(obj^.conval^.realval)
| OPM.String: OutName(obj^.conval^.ext^) | String: OutName(obj^.conval^.ext^)
| OPM.NilTyp: | NilTyp:
ELSE err(127) ELSE err(127)
END END
END OutConstant; END OutConstant;
@ -961,34 +1043,34 @@ END Import;
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
OutObj(obj^.left); OutObj(obj^.left);
IF obj^.mode IN {OPM.Con, OPM.Typ, OPM.Var, OPM.LProc, OPM.XProc, OPM.CProc, OPM.IProc} THEN IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN
IF obj^.history = OPM.removed THEN FPrintErr(obj, 250) IF obj^.history = removed THEN FPrintErr(obj, 250)
ELSIF obj^.vis # OPM.internal THEN ELSIF obj^.vis # internal THEN
CASE obj^.history OF CASE obj^.history OF
| OPM.inserted: FPrintErr(obj, 253) | inserted: FPrintErr(obj, 253)
| OPM.same: (* ok *) | same: (* ok *)
| OPM.pbmodified: FPrintErr(obj, 252) | pbmodified: FPrintErr(obj, 252)
| OPM.pvmodified: FPrintErr(obj, 251) | pvmodified: FPrintErr(obj, 251)
ELSE OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case at OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn;
END; END;
CASE obj^.mode OF CASE obj^.mode OF
| OPM.Con: OutConstant(obj); OutName(obj^.name) | Con: OutConstant(obj); OutName(obj^.name)
| OPM.Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ) | Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ)
ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name) ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name)
END 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); OutStr(obj^.typ); OutName(obj^.name);
IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN
(* compute fingerprint to avoid structural type equivalence *) (* compute fingerprint to avoid structural type equivalence *)
OPM.FPrint(expCtxt.reffp, obj^.typ^.ref) OPM.FPrint(expCtxt.reffp, obj^.typ^.ref)
END END
| OPM.XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) | 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) | 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; | CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext;
j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); j := ORD(ext^[0]); i := 1; OPM.SymWInt(j);
WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END; WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END;
OutName(obj^.name) 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 END
END; END;
@ -1029,7 +1111,7 @@ END Import;
PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT); PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT);
BEGIN 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^.strobj := NewObj(); typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE;
typ^.idfp := form; typ^.idfpdone := TRUE typ^.idfp := form; typ^.idfpdone := TRUE
END InitStruct; END InitStruct;
@ -1038,14 +1120,14 @@ END Import;
VAR obj: Object; VAR obj: Object;
BEGIN BEGIN
Insert(name, obj); obj^.conval := NewConst(); 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; END EnterBoolConst;
PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct); PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct);
VAR obj: Object; typ: Struct; VAR obj: Object; typ: Struct;
BEGIN BEGIN
Insert(name, obj); 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^.strobj := obj; typ^.size := size; typ^.ref := form; typ^.allocated := TRUE;
typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE; typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE;
typ^.idfp := form; typ^.idfpdone := TRUE; res := typ typ^.idfp := form; typ^.idfpdone := TRUE; res := typ
@ -1054,80 +1136,80 @@ END Import;
PROCEDURE EnterProc(name: OPS.Name; num: INTEGER); PROCEDURE EnterProc(name: OPS.Name; num: INTEGER);
VAR obj: Object; VAR obj: Object;
BEGIN Insert(name, obj); 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; END EnterProc;
BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
InitStruct(undftyp, OPM.Undef); InitStruct(notyp, OPM.NoTyp); InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
InitStruct(stringtyp, OPM.String); InitStruct(niltyp, OPM.NilTyp); InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp);
undftyp^.BaseTyp := undftyp; undftyp^.BaseTyp := undftyp;
(*initialization of module SYSTEM*) (*initialization of module SYSTEM*)
EnterTyp("BYTE", OPM.Byte, OPM.ByteSize, bytetyp); EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp);
EnterTyp("PTR", OPM.Pointer, OPM.PointerSize, sysptrtyp); EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp);
EnterProc("ADR", OPM.adrfn); EnterProc("ADR", adrfn);
EnterProc("CC", OPM.ccfn); EnterProc("CC", ccfn);
EnterProc("LSH", OPM.lshfn); EnterProc("LSH", lshfn);
EnterProc("ROT", OPM.rotfn); EnterProc("ROT", rotfn);
EnterProc("GET", OPM.getfn); EnterProc("GET", getfn);
EnterProc("PUT", OPM.putfn); EnterProc("PUT", putfn);
EnterProc("GETREG", OPM.getrfn); EnterProc("GETREG", getrfn);
EnterProc("PUTREG", OPM.putrfn); EnterProc("PUTREG", putrfn);
EnterProc("BIT", OPM.bitfn); EnterProc("BIT", bitfn);
EnterProc("VAL", OPM.valfn); EnterProc("VAL", valfn);
EnterProc("NEW", OPM.sysnewfn); EnterProc("NEW", sysnewfn);
EnterProc("MOVE", OPM.movefn); EnterProc("MOVE", movefn);
syslink := topScope^.right; syslink := topScope^.right;
universe := topScope; topScope^.right := NIL; universe := topScope; topScope^.right := NIL;
EnterTyp("BOOLEAN", OPM.Bool, OPM.BoolSize, booltyp); EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp);
EnterTyp("CHAR", OPM.Char, OPM.CharSize, chartyp); EnterTyp("CHAR", Char, OPM.CharSize, chartyp);
EnterTyp("SET", OPM.Set, OPM.SetSize, settyp); EnterTyp("SET", Set, OPM.SetSize, settyp);
EnterTyp("REAL", OPM.Real, OPM.RealSize, realtyp); EnterTyp("REAL", Real, OPM.RealSize, realtyp);
EnterTyp("INTEGER", OPM.Int, OPM.IntSize, inttyp); EnterTyp("INTEGER", Int, OPM.IntSize, inttyp);
EnterTyp("LONGINT", OPM.LInt, OPM.LIntSize, linttyp); EnterTyp("LONGINT", LInt, OPM.LIntSize, linttyp);
EnterTyp("LONGREAL", OPM.LReal, OPM.LRealSize, lrltyp); EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp);
EnterTyp("SHORTINT", OPM.SInt, OPM.SIntSize, sinttyp); 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); EnterBoolConst("TRUE", 1);
EnterProc("HALT", OPM.haltfn); EnterProc("HALT", haltfn);
EnterProc("NEW", OPM.newfn); EnterProc("NEW", newfn);
EnterProc("ABS", OPM.absfn); EnterProc("ABS", absfn);
EnterProc("CAP", OPM.capfn); EnterProc("CAP", capfn);
EnterProc("ORD", OPM.ordfn); EnterProc("ORD", ordfn);
EnterProc("ENTIER", OPM.entierfn); EnterProc("ENTIER", entierfn);
EnterProc("ODD", OPM.oddfn); EnterProc("ODD", oddfn);
EnterProc("MIN", OPM.minfn); EnterProc("MIN", minfn);
EnterProc("MAX", OPM.maxfn); EnterProc("MAX", maxfn);
EnterProc("CHR", OPM.chrfn); EnterProc("CHR", chrfn);
EnterProc("SHORT", OPM.shortfn); EnterProc("SHORT", shortfn);
EnterProc("LONG", OPM.longfn); EnterProc("LONG", longfn);
EnterProc("SIZE", OPM.sizefn); EnterProc("SIZE", sizefn);
EnterProc("INC", OPM.incfn); EnterProc("INC", incfn);
EnterProc("DEC", OPM.decfn); EnterProc("DEC", decfn);
EnterProc("INCL", OPM.inclfn); EnterProc("INCL", inclfn);
EnterProc("EXCL", OPM.exclfn); EnterProc("EXCL", exclfn);
EnterProc("LEN", OPM.lenfn); EnterProc("LEN", lenfn);
EnterProc("COPY", OPM.copyfn); EnterProc("COPY", copyfn);
EnterProc("ASH", OPM.ashfn); EnterProc("ASH", ashfn);
EnterProc("ASSERT", OPM.assertfn); EnterProc("ASSERT", assertfn);
impCtxt.ref[OPM.Undef] := undftyp; impCtxt.ref[Undef] := undftyp;
impCtxt.ref[OPM.Byte] := bytetyp; impCtxt.ref[Byte] := bytetyp;
impCtxt.ref[OPM.Bool] := booltyp; impCtxt.ref[Bool] := booltyp;
impCtxt.ref[OPM.Char] := chartyp; impCtxt.ref[Char] := chartyp;
impCtxt.ref[OPM.SInt] := sinttyp; impCtxt.ref[SInt] := sinttyp;
impCtxt.ref[OPM.Int] := inttyp; impCtxt.ref[Int] := inttyp;
impCtxt.ref[OPM.LInt] := linttyp; impCtxt.ref[LInt] := linttyp;
impCtxt.ref[OPM.Real] := realtyp; impCtxt.ref[Real] := realtyp;
impCtxt.ref[OPM.LReal] := lrltyp; impCtxt.ref[LReal] := lrltyp;
impCtxt.ref[OPM.Set] := settyp; impCtxt.ref[Set] := settyp;
impCtxt.ref[OPM.String] := stringtyp; impCtxt.ref[String] := stringtyp;
impCtxt.ref[OPM.NilTyp] := niltyp; impCtxt.ref[NilTyp] := niltyp;
impCtxt.ref[OPM.NoTyp] := notyp; impCtxt.ref[NoTyp] := notyp;
impCtxt.ref[OPM.Pointer] := sysptrtyp impCtxt.ref[Pointer] := sysptrtyp
END OPT. END OPT.
Objects: Objects:

386
src/compiler/OPV.Mod
View file

@ -1,6 +1,6 @@
MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 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: 31.1.2007 jt synchronized with BlackBox version, in particular:
various promotion rules changed (long) => (LONGINT), xxxL avoided 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) IF typ = OPT.undftyp THEN OPM.err(58)
ELSIF typ^.size = -1 THEN ELSIF typ^.size = -1 THEN
f := typ^.form; c := typ^.comp; 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); 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; ELSE TypSize(btyp); offset := btyp^.size - btyp^.sysflag DIV 100H; base := btyp^.align;
END; END;
fld := typ^.link; fld := typ^.link;
WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO
btyp := fld^.typ; TypSize(btyp); btyp := fld^.typ; TypSize(btyp);
size := btyp^.size; fbase := OPC.BaseAlignment(btyp); size := btyp^.size; fbase := OPC.BaseAlignment(btyp);
OPC.Align(offset, fbase); OPC.Align(offset, fbase);
@ -96,19 +96,19 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
typ^.size := offset; typ^.align := base; typ^.size := offset; typ^.align := base;
(* encode the trailing gap into the symbol table to allow dense packing of extended records *) (* 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) typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H)
ELSIF c = OPM.Array THEN ELSIF c = OPT.Array THEN
TypSize(typ^.BaseTyp); TypSize(typ^.BaseTyp);
typ^.size := typ^.n * typ^.BaseTyp^.size; typ^.size := typ^.n * typ^.BaseTyp^.size;
ELSIF f = OPM.Pointer THEN ELSIF f = OPT.Pointer THEN
typ^.size := OPM.PointerSize; typ^.size := OPM.PointerSize;
IF typ^.BaseTyp = OPT.undftyp THEN OPM.Mark(128, typ^.n) IF typ^.BaseTyp = OPT.undftyp THEN OPM.Mark(128, typ^.n)
ELSE TypSize(typ^.BaseTyp) ELSE TypSize(typ^.BaseTyp)
END END
ELSIF f = OPM.ProcTyp THEN ELSIF f = OPT.ProcTyp THEN
typ^.size := OPM.ProcSize; typ^.size := OPM.ProcSize;
ELSIF c = OPM.DynArr THEN ELSIF c = OPT.DynArr THEN
btyp := typ^.BaseTyp; TypSize(btyp); 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 ELSE typ^.size := 8
END END
END END
@ -131,10 +131,10 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
BEGIN BEGIN
oldPos := OPM.errpos; OPM.errpos := obj^.scope^.adr; oldPos := OPM.errpos; OPM.errpos := obj^.scope^.adr;
typ := obj^.link^.typ; 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); OPT.FindField(obj^.name, typ^.BaseTyp, redef);
IF redef # NIL THEN obj^.adr := 10000H*(redef^.adr DIV 10000H) (*mthno*); 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) ELSE INC(obj^.adr, 10000H*typ^.n); INC(typ^.n)
END ; END ;
OPM.errpos := oldPos 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, ... *) IF obj^.name[0] = "@" THEN obj^.name[0] := "_"; Stamp(obj^.name) END ; (* translate and make unique @for, ... *)
obj^.linkadr := UndefinedType; obj^.linkadr := UndefinedType;
mode := obj^.mode; 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); typ := obj^.typ; TypSize(obj^.typ);
IF typ^.form = OPM.Pointer THEN typ := typ^.BaseTyp END ; IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ;
IF typ^.comp = OPM.Record THEN TraverseRecord(typ) END IF typ^.comp = OPT.Record THEN TraverseRecord(typ) END
ELSIF mode = OPM.TProc THEN GetTProcNum(obj) ELSIF mode = OPT.TProc THEN GetTProcNum(obj)
ELSIF mode = OPM.Var THEN TypSize(obj^.typ) ELSIF mode = OPT.Var THEN TypSize(obj^.typ)
END ; END ;
IF ~exported THEN (* do this only once *) 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 {OPT.LProc, OPT.Typ}) & (obj^.mnolev > 0) THEN Stamp(obj^.name) END ;
IF mode IN {OPM.Var, OPM.VarPar, OPM.Typ} THEN IF mode IN {OPT.Var, OPT.VarPar, OPT.Typ} THEN
obj^.scope := outerScope 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 ; IF obj^.conval^.setval = {} THEN OPM.err(129) END ;
scope := obj^.scope; scope := obj^.scope;
scope^.leaf := TRUE; scope^.leaf := TRUE;
scope^.name := obj^.name; Stamp(scope^.name); 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 ; IF scope^.mnolev > 1 THEN outerScope^.leaf := FALSE END ;
Traverse (obj^.scope^.right, obj^.scope, FALSE) Traverse (obj^.scope^.right, obj^.scope, FALSE)
END END
@ -217,27 +217,27 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE Precedence (class, subclass, form, comp: INTEGER): INTEGER; PROCEDURE Precedence (class, subclass, form, comp: INTEGER): INTEGER;
BEGIN BEGIN
CASE class OF CASE class OF
| OPM.Nconst, | OPT.Nconst,
OPM.Nvar, OPT.Nvar,
OPM.Nfield, OPT.Nfield,
OPM.Nindex, OPT.Nindex,
OPM.Nproc, OPT.Nproc,
OPM.Ncall: RETURN 10 OPT.Ncall: RETURN 10
| OPM.Nguard: IF OPM.typchk IN OPM.opt THEN RETURN 10 ELSE RETURN 9 (*cast*) END | OPT.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 *) | OPT.Nvarpar: IF comp IN {OPT.Array, OPT.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *)
| OPM.Nderef: RETURN 9 | OPT.Nderef: RETURN 9
| OPM.Nmop: CASE subclass OF | OPT.Nmop: CASE subclass OF
| OPM.not, OPM.minus, OPM.adr, OPM.val, OPM.conv: RETURN 9 | OPM.not, OPM.minus, OPT.adr, OPT.val, OPT.conv: RETURN 9
| OPM.is, OPM.abs, OPM.cap, OPM.odd, OPM.cc: RETURN 10 | OPM.is, OPT.abs, OPT.cap, OPT.odd, OPT.cc: RETURN 10
ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPT.Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END END
| OPM.Ndop: CASE subclass OF | OPT.Ndop: CASE subclass OF
| OPM.times: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 8 END | OPM.times: IF form = OPT.Set THEN RETURN 4 ELSE RETURN 8 END
| OPM.slash: IF form = OPM.Set THEN RETURN 3 ELSE RETURN 8 END | OPM.slash: IF form = OPT.Set THEN RETURN 3 ELSE RETURN 8 END
| OPM.div, | OPM.div,
OPM.mod: RETURN 10 (* div/mod are replaced by functions *) OPM.mod: RETURN 10 (* div/mod are replaced by functions *)
| OPM.plus: IF form = OPM.Set THEN RETURN 2 ELSE RETURN 7 END | OPM.plus: IF form = OPT.Set THEN RETURN 2 ELSE RETURN 7 END
| OPM.minus: IF form = OPM.Set THEN RETURN 4 ELSE RETURN 7 END | OPM.minus: IF form = OPT.Set THEN RETURN 4 ELSE RETURN 7 END
| OPM.lss, | OPM.lss,
OPM.leq, OPM.leq,
OPM.gtr, OPM.gtr,
@ -246,18 +246,18 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.neq: RETURN 5 OPM.neq: RETURN 5
| OPM.and: RETURN 1 | OPM.and: RETURN 1
| OPM.or: RETURN 0 | OPM.or: RETURN 0
| OPM.len, | OPT.len,
OPM.in, OPM.in,
OPM.ash, OPT.ash,
OPM.msk, OPT.msk,
OPM.bit, OPT.bit,
OPM.lsh, OPT.lsh,
OPM.rot: RETURN 10 OPT.rot: RETURN 10
ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPM.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPV.Precedence OPT.Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
| OPM.Nupto: RETURN 10 | OPT.Nupto: RETURN 10
| OPM.Ntype, | OPT.Ntype,
OPM.Neguard: (* ignored anyway *) RETURN MaxPrec OPT.Neguard: (* ignored anyway *) RETURN MaxPrec
ELSE OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
END; END;
END Precedence; END Precedence;
@ -267,8 +267,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE Len(n: OPT.Node; dim: LONGINT); PROCEDURE Len(n: OPT.Node; dim: LONGINT);
BEGIN BEGIN
WHILE (n^.class = OPM.Nindex) & (n^.typ^.comp = OPM.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ; WHILE (n^.class = OPT.Nindex) & (n^.typ^.comp = OPT.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ;
IF (n^.class = OPM.Nderef) & (n^.typ^.comp = OPM.DynArr) THEN IF (n^.class = OPT.Nderef) & (n^.typ^.comp = OPT.DynArr) THEN
design(n^.left, 10); OPM.WriteString("->len["); OPM.WriteInt(dim); OPM.Write("]") design(n^.left, 10); OPM.WriteString("->len["); OPM.WriteInt(dim); OPM.Write("]")
ELSE ELSE
OPC.Len(n^.obj, n^.typ, dim) 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; PROCEDURE SideEffects(n: OPT.Node): BOOLEAN;
BEGIN 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 ELSE RETURN FALSE
END END
END SideEffects; END SideEffects;
PROCEDURE Entier(n: OPT.Node; prec: INTEGER); PROCEDURE Entier(n: OPT.Node; prec: INTEGER);
BEGIN 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) OPM.WriteString(EntierFunc); expr(n, MinPrec); OPM.Write(CloseParen)
ELSE expr(n, prec) ELSE expr(n, prec)
END 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); PROCEDURE Convert(n: OPT.Node; newtype: OPT.Struct; prec: INTEGER);
VAR from, to: INTEGER; VAR from, to: INTEGER;
BEGIN from := n^.typ^.form; to := newtype.form; BEGIN from := n^.typ^.form; to := newtype.form;
IF to = OPM.Set THEN OPM.WriteString(SetOfFunc); Entier(n, MinPrec); OPM.Write(CloseParen) IF to = OPT.Set THEN OPM.WriteString(SetOfFunc); Entier(n, MinPrec); OPM.Write(CloseParen)
ELSIF to IN OPM.intSet THEN ELSIF to IN OPT.intSet THEN
IF (newtype.size < n.typ.size) & (OPM.ranchk IN OPM.opt) 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.WriteString("__SHORT"); IF SideEffects(n) THEN OPM.Write("F") END;
OPM.Write(OpenParen); Entier(n, MinPrec); OPM.WriteString(Comma); 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; IF newtype.size # n.typ.size THEN SizeCast(newtype.size) END;
Entier(n, 9) Entier(n, 9)
END END
ELSIF to = OPM.Char THEN ELSIF to = OPT.Char THEN
IF OPM.ranchk IN OPM.opt THEN OPM.WriteString("__CHR"); IF OPM.ranchk IN OPM.opt THEN OPM.WriteString("__CHR");
IF SideEffects(n) THEN OPM.Write("F") END ; IF SideEffects(n) THEN OPM.Write("F") END ;
OPM.Write(OpenParen); Entier(n, MinPrec); OPM.Write(CloseParen) 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); PROCEDURE TypeOf(n: OPT.Node);
BEGIN BEGIN
IF n^.typ^.form = OPM.Pointer THEN IF n^.typ^.form = OPT.Pointer THEN
OPM.WriteString(TypeFunc); expr(n, MinPrec); OPM.Write(")") 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) 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(")") 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 *) 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)*) (*SYSTEM.VAL(typ, var par rec)*)
OPC.TypeOf(n^.left^.obj) OPC.TypeOf(n^.left^.obj)
ELSE (* var par rec *) 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); PROCEDURE Index(n, d: OPT.Node; prec, dim: INTEGER);
BEGIN BEGIN
IF ~inxchk 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) expr(n^.right, prec)
ELSE ELSE
IF SideEffects(n^.right) THEN OPM.WriteString("__XF(") ELSE OPM.WriteString("__X(") END ; 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 BEGIN
comp := n^.typ^.comp; obj := n^.obj; class := n^.class; comp := n^.typ^.comp; obj := n^.obj; class := n^.class;
designPrec := Precedence(class, n^.subcl, n^.typ^.form, comp); 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 > designPrec THEN OPM.Write(OpenParen) END;
IF prec = ProcTypeVar THEN OPM.Write(Deref) END; (* proc var calls must be dereferenced in K&R C *) IF prec = ProcTypeVar THEN OPM.Write(Deref) END; (* proc var calls must be dereferenced in K&R C *)
CASE class OF CASE class OF
| OPM.Nproc: OPC.Ident(n^.obj) | OPT.Nproc: OPC.Ident(n^.obj)
| OPM.Nvar: OPC.CompleteIdent(n^.obj) | OPT.Nvar: OPC.CompleteIdent(n^.obj)
| OPM.Nvarpar: IF ~(comp IN {OPM.Array, OPM.DynArr}) THEN OPM.Write(Deref) END; (* deref var parameter *) | OPT.Nvarpar: IF ~(comp IN {OPT.Array, OPT.DynArr}) THEN OPM.Write(Deref) END; (* deref var parameter *)
OPC.CompleteIdent(n^.obj) 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(".") ELSE design(n^.left, designPrec); OPM.Write(".")
END ; END ;
OPC.Ident(n^.obj) 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) ELSE OPM.Write(Deref); design(n^.left, designPrec)
END END
| OPM.Nindex: d := n^.left; | OPT.Nindex: d := n^.left;
IF d^.typ^.comp = OPM.DynArr THEN dims := 0; IF d^.typ^.comp = OPT.DynArr THEN dims := 0;
WHILE d^.class = OPM.Nindex DO d := d^.left; INC(dims) END ; WHILE d^.class = OPT.Nindex DO d := d^.left; INC(dims) END ;
IF n^.typ^.comp = OPM.DynArr THEN OPM.Write("&") END ; IF n^.typ^.comp = OPT.DynArr THEN OPM.Write("&") END ;
design(d, designPrec); design(d, designPrec);
OPM.Write(OpenBracket); 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; i := dims; x := n;
WHILE x # d DO (* apply Horner schema *) 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) 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 x := x^.left
END ; END ;
FOR i := 1 TO dims DO OPM.Write(")") END ; FOR i := 1 TO dims DO OPM.Write(")") END ;
IF n^.typ^.comp = OPM.DynArr THEN IF n^.typ^.comp = OPT.DynArr THEN
(* element type is OPM.DynArr; finish Horner schema with virtual indices = 0*) (* element type is OPT.DynArr; finish Horner schema with virtual indices = 0*)
OPM.Write(")"); OPM.Write(")");
WHILE i < (d^.typ^.size - 4) DIV 4 DO WHILE i < (d^.typ^.size - 4) DIV 4 DO
OPM.WriteString(" * "); Len(d, i); 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); Index(n, n^.left, MinPrec, 0);
OPM.Write(CloseBracket) OPM.Write(CloseBracket)
END 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 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*) IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*)
OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj) OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj)
ELSE (*local var-par record*) 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); OPC.Andent(typ); OPM.WriteString(Comma);
OPM.WriteInt(typ^.extlev); OPM.Write(")") OPM.WriteInt(typ^.extlev); OPM.Write(")")
ELSE 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) OPM.WriteString("*("); OPC.Ident(typ^.strobj); OPM.WriteString("*)"); OPC.CompleteIdent(obj)
ELSE (*simply cast pointer*) ELSE (*simply cast pointer*)
OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec) OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec)
END END
END END
| OPM.Neguard: IF OPM.typchk IN OPM.opt THEN | OPT.Neguard: IF OPM.typchk IN OPM.opt THEN
IF n^.left^.class = OPM.Nvarpar THEN OPM.WriteString("__GUARDEQR("); IF n^.left^.class = OPT.Nvarpar THEN OPM.WriteString("__GUARDEQR(");
OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left); OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left);
ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec) ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec)
END ; (* __GUARDEQx includes deref *) END ; (* __GUARDEQx includes deref *)
@ -433,7 +433,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE ELSE
expr(n^.left, MinPrec) (* always lhs of assignment *) expr(n^.left, MinPrec) (* always lhs of assignment *)
END 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; ELSE OPM.LogWStr("unhandled case in OPV.design, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
END ; END ;
IF prec > designPrec THEN OPM.Write(CloseParen) 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); OPM.Write(OpenParen);
WHILE n # NIL DO typ := fp^.typ; WHILE n # NIL DO typ := fp^.typ;
comp := typ^.comp; form := typ^.form; mode := fp^.mode; prec := MinPrec; 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 OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.WriteString("*)"); prec := 10
END ; END ;
IF ~(n^.typ^.comp IN {OPM.Array, OPM.DynArr}) THEN IF ~(n^.typ^.comp IN {OPT.Array, OPT.DynArr}) THEN
IF mode = OPM.VarPar THEN IF mode = OPT.VarPar THEN
IF ansi & (typ # n^.typ) THEN OPM.WriteString("(void*)") END ; IF ansi & (typ # n^.typ) THEN OPM.WriteString("(void*)") END ;
OPM.Write("&"); prec := 9 OPM.Write("&"); prec := 9
ELSIF ansi THEN 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 *) 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 *) OPM.WriteString("(void*)") (* type extension *)
END END
ELSE 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 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 OPM.WriteString("(LONGINT)"); prec := 9
END END
END END
ELSIF ansi THEN ELSIF ansi THEN
(* casting of params should be simplified eventually *) (* 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; 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 *) 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 & (n^.conval^.intval <= OPM.SignedMaximum(OPM.IntSize)) & (n^.conval^.intval >= OPM.SignedMinimum(OPM.IntSize)) THEN
OPM.WriteString("((LONGINT)("); expr(n, prec); OPM.WriteString("))"); OPM.WriteString("((LONGINT)("); expr(n, prec); OPM.WriteString("))");
ELSE ELSE
expr(n, prec) expr(n, prec)
END; END;
IF (comp = OPM.Record) & (mode = OPM.VarPar) THEN IF (comp = OPT.Record) & (mode = OPT.VarPar) THEN
OPM.WriteString(", "); TypeOf(n) OPM.WriteString(", "); TypeOf(n)
ELSIF comp = OPM.DynArr THEN ELSIF comp = OPT.DynArr THEN
IF n^.class = OPM.Nconst THEN (* ap is string constant *) IF n^.class = OPT.Nconst THEN (* ap is string constant *)
OPM.WriteString(Comma); OPM.WriteString("(LONGINT)"); OPM.WriteInt(n^.conval^.intval2) OPM.WriteString(Comma); OPM.WriteString("(LONGINT)"); OPM.WriteInt(n^.conval^.intval2)
ELSE ELSE
aptyp := n^.typ; dim := 0; 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); OPM.WriteString(Comma); Len(n, dim);
typ := typ^.BaseTyp; aptyp := aptyp^.BaseTyp; INC(dim) typ := typ^.BaseTyp; aptyp := aptyp^.BaseTyp; INC(dim)
END ; 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); 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 Len(n, dim); OPM.WriteString(" * "); INC(dim); aptyp := aptyp^.BaseTyp
END ; END ;
OPM.WriteString("((LONGINT)("); OPM.WriteInt(aptyp^.size); OPM.WriteString("))"); 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; PROCEDURE SuperProc(n: OPT.Node): OPT.Object;
VAR obj: OPT.Object; typ: OPT.Struct; VAR obj: OPT.Object; typ: OPT.Struct;
BEGIN typ := n^.right^.typ; (* receiver type *) 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); OPT.FindField(n^.left^.obj^.name, typ^.BaseTyp, obj);
RETURN obj RETURN obj
END SuperProc; 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; class := n^.class; subclass := n^.subcl; form := n^.typ^.form;
l := n^.left; r := n^.right; l := n^.left; r := n^.right;
exprPrec := Precedence (class, subclass, form, n^.typ^.comp); 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); OPM.Write(OpenParen);
END; END;
CASE class OF CASE class OF
| OPM.Nconst: OPC.Constant(n^.conval, form) | OPT.Nconst: OPC.Constant(n^.conval, form)
| OPM.Nupto: (* n^.typ = OPT.settyp *) | OPT.Nupto: (* n^.typ = OPT.settyp *)
OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec); OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec);
OPM.Write(CloseParen) OPM.Write(CloseParen)
| OPM.Nmop: | OPT.Nmop:
CASE subclass OF CASE subclass OF
| OPM.not: OPM.Write("!"); expr(l, exprPrec) | 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) expr(l, exprPrec)
| OPM.is: typ := n^.obj^.typ; | 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 ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp
END ; END ;
OPM.WriteString(Comma); OPM.WriteString(Comma);
OPC.Andent(typ); OPM.WriteString(Comma); OPC.Andent(typ); OPM.WriteString(Comma);
OPM.WriteInt(typ^.extlev); OPM.Write(")") OPM.WriteInt(typ^.extlev); OPM.Write(")")
| OPM.conv: Convert(l, n.typ, exprPrec) | OPT.conv: Convert(l, n.typ, exprPrec)
| OPM.abs: IF SideEffects(l) THEN | OPT.abs: IF SideEffects(l) THEN
IF l^.typ^.form < OPM.Real THEN IF l^.typ^.form < OPT.Real THEN
IF l^.typ^.form < OPM.LInt THEN OPM.WriteString("(int)") END ; IF l^.typ^.form < OPT.LInt THEN OPM.WriteString("(int)") END ;
OPM.WriteString("__ABSF(") OPM.WriteString("__ABSF(")
ELSE OPM.WriteString("__ABSFD(") ELSE OPM.WriteString("__ABSFD(")
END END
ELSE OPM.WriteString("__ABS(") ELSE OPM.WriteString("__ABS(")
END ; END ;
expr(l, MinPrec); OPM.Write(CloseParen) expr(l, MinPrec); OPM.Write(CloseParen)
| OPM.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen) | OPT.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen)
| OPM.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen) | OPT.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen)
| OPM.adr: OPM.WriteString("(LONGINT)(uintptr_t)"); (*SYSTEM*) | OPT.adr: OPM.WriteString("(LONGINT)(uintptr_t)"); (*SYSTEM*)
IF l^.class = OPM.Nvarpar THEN OPC.CompleteIdent(l^.obj) IF l^.class = OPT.Nvarpar THEN OPC.CompleteIdent(l^.obj)
ELSE 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) expr(l, exprPrec)
END END
| OPM.val: IF ~(l^.class IN {OPM.Nvar, OPM.Nvarpar, OPM.Nfield, OPM.Nindex}) (*SYSTEM*) | OPT.val: IF ~(l^.class IN {OPT.Nvar, OPT.Nvarpar, OPT.Nfield, OPT.Nindex}) (*SYSTEM*)
OR (n^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) OR (n^.typ^.form IN {OPT.LInt, OPT.Pointer, OPT.Set, OPT.ProcTyp})
& (l^.typ^.form IN {OPM.LInt, OPM.Pointer, OPM.Set, OPM.ProcTyp}) & (l^.typ^.form IN {OPT.LInt, OPT.Pointer, OPT.Set, OPT.ProcTyp})
& (n^.typ^.size = l^.typ^.size) & (n^.typ^.size = l^.typ^.size)
THEN THEN
OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen); 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)") OPM.WriteString("(uintptr_t)")
END; END;
expr(l, exprPrec) expr(l, exprPrec)
@ -579,44 +579,44 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END END
ELSE OPM.err(200) ELSE OPM.err(200)
END END
| OPM.Ndop: CASE subclass OF | OPT.Ndop: CASE subclass OF
| OPM.len: Len(l, r^.conval^.intval) | OPT.len: Len(l, r^.conval^.intval)
| OPM.in, | OPM.in,
OPM.ash, OPT.ash,
OPM.msk, OPT.msk,
OPM.bit, OPT.bit,
OPM.lsh, OPT.lsh,
OPM.rot, OPT.rot,
OPM.div, OPM.div,
OPM.mod: CASE subclass OF OPM.mod: CASE subclass OF
| OPM.in: OPM.WriteString("__IN(") | 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(") IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ASHL(")
ELSE OPM.WriteString("__ASHR(") ELSE OPM.WriteString("__ASHR(")
END END
ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(") ELSIF SideEffects(r) THEN OPM.WriteString("__ASHF(")
ELSE OPM.WriteString("__ASH(") ELSE OPM.WriteString("__ASH(")
END END
| OPM.msk: OPM.WriteString("__MASK("); | OPT.msk: OPM.WriteString("__MASK(");
| OPM.bit: OPM.WriteString("__BIT(") | OPT.bit: OPM.WriteString("__BIT(")
| OPM.lsh: IF r^.class = OPM.Nconst THEN | OPT.lsh: IF r^.class = OPT.Nconst THEN
IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(") IF r^.conval^.intval >= 0 THEN OPM.WriteString("__LSHL(")
ELSE OPM.WriteString("__LSHR(") ELSE OPM.WriteString("__LSHR(")
END END
ELSE OPM.WriteString("__LSH(") ELSE OPM.WriteString("__LSH(")
END 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(") IF r^.conval^.intval >= 0 THEN OPM.WriteString("__ROTL(")
ELSE OPM.WriteString("__ROTR(") ELSE OPM.WriteString("__ROTR(")
END END
ELSE OPM.WriteString("__ROT(") ELSE OPM.WriteString("__ROT(")
END END
| OPM.div: IF SideEffects(n) THEN | 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(") OPM.WriteString("__DIVF(")
ELSE OPM.WriteString("__DIV(") ELSE OPM.WriteString("__DIV(")
END 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(") IF SideEffects(n) THEN OPM.WriteString("__MODF(")
ELSE OPM.WriteString("__MOD(") ELSE OPM.WriteString("__MOD(")
END; END;
@ -624,63 +624,63 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END ; END ;
expr(l, MinPrec); expr(l, MinPrec);
OPM.WriteString(Comma); 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) OPM.WriteInt(-r^.conval^.intval)
ELSE expr(r, MinPrec) ELSE expr(r, MinPrec)
END ; 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.Write(CloseParen)
| OPM.eql | 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("); OPM.WriteString("__STRCMP(");
expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen); expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.Write(CloseParen);
OPC.Cmp(subclass); OPM.Write("0") OPC.Cmp(subclass); OPM.Write("0")
ELSE ELSE
expr(l, exprPrec); OPC.Cmp(subclass); expr(l, exprPrec); OPC.Cmp(subclass);
typ := l^.typ; 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 *) ") OPM.WriteString("(void *) ")
END ; END ;
expr(r, exprPrec) expr(r, exprPrec)
END 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); expr(l, exprPrec);
CASE subclass OF CASE subclass OF
| OPM.times: IF form = OPM.Set THEN OPM.WriteString(" & ") | OPM.times: IF form = OPT.Set THEN OPM.WriteString(" & ")
ELSE OPM.WriteString(" * ") ELSE OPM.WriteString(" * ")
END END
| OPM.slash: IF form = OPM.Set THEN OPM.WriteString(" ^ ") | OPM.slash: IF form = OPT.Set THEN OPM.WriteString(" ^ ")
ELSE 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) OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen)
END END
END END
| OPM.and: OPM.WriteString(" && ") | 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(" + ") ELSE OPM.WriteString(" + ")
END END
| OPM.minus: IF form = OPM.Set THEN OPM.WriteString(" & ~") | OPM.minus: IF form = OPT.Set THEN OPM.WriteString(" & ~")
ELSE OPM.WriteString(" - ") ELSE OPM.WriteString(" - ")
END; END;
| OPM.or: OPM.WriteString(" || "); | OPM.or: OPM.WriteString(" || ");
ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
expr(r, exprPrec); 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 END
| OPM.Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = OPM.TProc) THEN | OPT.Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = OPT.TProc) THEN
IF l^.subcl = OPM.super THEN proc := SuperProc(n) IF l^.subcl = OPT.super THEN proc := SuperProc(n)
ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj)
END ; END ;
OPC.Ident(proc); OPC.Ident(proc);
n^.obj := proc^.link 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) ELSE design(l, ProcTypeVar)
END ; END ;
ActualPar(r, n^.obj) ActualPar(r, n^.obj)
ELSE design(n, prec); (* not exprPrec! *) ELSE design(n, prec); (* not exprPrec! *)
END; 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) OPM.Write(CloseParen)
END END
END expr; 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); PROCEDURE IfStat(n: OPT.Node; withtrap: BOOLEAN; outerProc: OPT.Object);
VAR if: OPT.Node; obj: OPT.Object; typ: OPT.Struct; adr: LONGINT; 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 := ""; *) if := n^.left; (* name := ""; *)
WHILE if # NIL DO WHILE if # NIL DO
OPM.WriteString("if "); expr(if^.left, MaxPrec); (* if *) OPM.WriteString("if "); expr(if^.left, MaxPrec); (* if *)
OPM.Write(Blank); OPC.BegBlk; 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; 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; *) (* introduce alias pointer for var records; T1 *name__ = rec; *)
OPC.BegStat; OPC.Ident(if^.left^.obj); OPM.WriteString(" *"); OPC.BegStat; OPC.Ident(if^.left^.obj); OPM.WriteString(" *");
OPM.WriteString(obj.name); OPM.WriteString("__ = (void*)"); 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; PROCEDURE ImplicitReturn(n: OPT.Node): BOOLEAN;
BEGIN 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 RETURN n = NIL
END ImplicitReturn; END ImplicitReturn;
@ -770,12 +770,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
VAR typ, base: OPT.Struct; nofdim, nofdyn: INTEGER; VAR typ, base: OPT.Struct; nofdim, nofdyn: INTEGER;
BEGIN BEGIN
typ := d^.typ^.BaseTyp; base := typ; nofdim := 0; nofdyn := 0; 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("); design(d, MinPrec); OPM.WriteString(" = __NEWARR(");
WHILE base^.comp = OPM.Array DO INC(nofdim); base := base^.BaseTyp END ; WHILE base^.comp = OPT.Array DO INC(nofdim); base := base^.BaseTyp END ;
IF (base^.comp = OPM.Record) & (OPC.NofPtrs(base) # 0) THEN IF (base^.comp = OPT.Record) & (OPC.NofPtrs(base) # 0) THEN
OPC.Ident(base^.strobj); OPM.WriteString(DynTypExt) 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") ELSE OPM.WriteString("NIL")
END ; END ;
OPM.WriteString(", "); OPM.WriteString("((LONGINT)("); OPM.WriteInt(base^.size); OPM.WriteString("))"); 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 *) OPM.WriteString(", "); OPM.WriteInt(nofdyn); (* number of dynamic dimensions *)
WHILE typ # base DO WHILE typ # base DO
OPM.WriteString(", "); OPM.WriteString(", ");
IF typ^.comp = OPM.DynArr THEN IF typ^.comp = OPT.DynArr THEN
IF x^.class = OPM.Nconst THEN OPM.WriteString("(LONGINT)("); expr(x, MinPrec); OPM.WriteString(")") IF x^.class = OPT.Nconst THEN OPM.WriteString("(LONGINT)("); expr(x, MinPrec); OPM.WriteString(")")
ELSE OPM.WriteString("(LONGINT)"); expr(x, 10) ELSE OPM.WriteString("(LONGINT)"); expr(x, 10)
END ; END ;
x := x^.link x := x^.link
@ -798,12 +798,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE DefineTDescs(n: OPT.Node); PROCEDURE DefineTDescs(n: OPT.Node);
BEGIN 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; END DefineTDescs;
PROCEDURE InitTDescs(n: OPT.Node); PROCEDURE InitTDescs(n: OPT.Node);
BEGIN 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; END InitTDescs;
PROCEDURE stat(n: OPT.Node; outerProc: OPT.Object); PROCEDURE stat(n: OPT.Node; outerProc: OPT.Object);
@ -811,9 +811,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
BEGIN BEGIN
WHILE (n # NIL) & OPM.noerr DO WHILE (n # NIL) & OPM.noerr DO
OPM.errpos := n^.conval^.intval; 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 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); INC(OPM.level); stat(n^.left, outerProc); DEC(OPM.level);
OPC.GenEnumPtrs(OPT.topScope^.scope); OPC.GenEnumPtrs(OPT.topScope^.scope);
DefineTDescs(n^.right); OPC.EnterBody; InitTDescs(n^.right); 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.EnterProc(proc); stat(n^.right, proc);
OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right)); OPC.ExitProc(proc, TRUE, ImplicitReturn(n^.right));
END END
| OPM.Ninittd: (* done in enter module *) | OPT.Ninittd: (* done in enter module *)
| OPM.Nassign: CASE n^.subcl OF | OPT.Nassign: CASE n^.subcl OF
| OPM.assign: l := n^.left; r := n^.right; | OPT.assign: l := n^.left; r := n^.right;
IF l^.typ^.comp = OPM.Array THEN (* includes string assignment but not COPY *) IF l^.typ^.comp = OPT.Array THEN (* includes string assignment but not COPY *)
OPM.WriteString(MoveFunc); OPM.WriteString(MoveFunc);
expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma);
IF r^.typ = OPT.stringtyp THEN OPM.WriteInt(r^.conval^.intval2) 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 ; END ;
OPM.Write(CloseParen) OPM.Write(CloseParen)
ELSE 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 *) 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(" = ") ELSE OPM.WriteString(" = ")
END END
ELSE ELSE
design(l, MinPrec); OPM.WriteString(" = ") design(l, MinPrec); OPM.WriteString(" = ")
END ; END ;
IF l^.typ = r^.typ THEN expr(r, MinPrec) 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) 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) OPM.WriteString("*("); OPC.Andent(l^.typ); OPM.WriteString("*)&"); expr(r, 9)
ELSE expr(r, MinPrec) ELSE expr(r, MinPrec)
END END
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(", "); OPM.WriteString("__NEW("); design(n^.left, MinPrec); OPM.WriteString(", ");
OPC.Andent(n^.left^.typ^.BaseTyp); 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) NewArr(n^.left, n^.right)
END END
| OPM.incfn, | OPT.incfn,
OPM.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPM.decfn); expr(n^.right, MinPrec) OPT.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPT.decfn); expr(n^.right, MinPrec)
| OPM.inclfn, | OPT.inclfn,
OPM.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPM.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec); OPT.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPT.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec);
OPM.Write(CloseParen) 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); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma);
Len(n^.left, 0); OPM.Write(CloseParen) Len(n^.left, 0); OPM.Write(CloseParen)
| OPM.movefn: (*SYSTEM*) | OPT.movefn: (*SYSTEM*)
OPM.WriteString(MoveFunc); OPM.WriteString(MoveFunc);
expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma); expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma);
expr(n^.right^.link, MinPrec); expr(n^.right^.link, MinPrec);
OPM.Write(CloseParen) 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(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.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(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.WriteString(Comma); OPC.Ident(n^.right^.typ^.strobj); OPM.Write(CloseParen)
| OPM.getrfn, (*SYSTEM*) | OPT.getrfn, (*SYSTEM*)
OPM.putrfn: (*SYSTEM*) OPM.err(200) OPT.putrfn: (*SYSTEM*) OPM.err(200)
| OPM.sysnewfn: (*SYSTEM*) | OPT.sysnewfn: (*SYSTEM*)
OPM.WriteString("__SYSNEW("); OPM.WriteString("__SYSNEW(");
design(n^.left, MinPrec); OPM.WriteString(", "); design(n^.left, MinPrec); OPM.WriteString(", ");
expr(n^.right, MinPrec); expr(n^.right, MinPrec);
OPM.Write(")") OPM.Write(")")
ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn;
END END
| OPM.Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPM.TProc) THEN | OPT.Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = OPT.TProc) THEN
IF n^.left^.subcl = OPM.super THEN proc := SuperProc(n) IF n^.left^.subcl = OPT.super THEN proc := SuperProc(n)
ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(n^.left^.obj)
END ; END ;
OPC.Ident(proc); OPC.Ident(proc);
n^.obj := proc^.link 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) ELSE design(n^.left, ProcTypeVar)
END ; END ;
ActualPar(n^.right, n^.obj) 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); 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 OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat
END END
| OPM.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level) | OPT.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level)
| OPM.Nwhile: INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec); | OPT.Nwhile: INC(exit.level); OPM.WriteString("while "); expr(n^.left, MaxPrec);
OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk; OPM.Write(Blank); OPC.BegBlk; stat(n^.right, outerProc); OPC.EndBlk;
DEC(exit.level) 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); OPM.WriteString(" while (!"); expr(n^.right, 9); OPM.Write(CloseParen);
DEC(exit.level) 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; OPM.WriteString("for (;;) "); OPC.BegBlk; stat(n^.left, outerProc); OPC.EndBlk;
IF exit.label # -1 THEN IF exit.label # -1 THEN
OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat OPC.BegStat; OPM.WriteString("exit__"); OPM.WriteInt(exit.label); OPM.Write(":"); OPC.EndStat
END ; END ;
exit := saved exit := saved
| OPM.Nexit: IF exit.level = 0 THEN OPM.WriteString(Break) | OPT.Nexit: IF exit.level = 0 THEN OPM.WriteString(Break)
ELSE ELSE
IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ; IF exit.label = -1 THEN exit.label := nofExitLabels; INC(nofExitLabels) END ;
OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label) OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label)
END 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 IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END
ELSE ELSE
IF n^.left # NIL THEN IF n^.left # NIL THEN
(* Make local copy of result before ExitProc deletes dynamic vars *) (* Make local copy of result before ExitProc deletes dynamic vars *)
OPM.WriteString("_o_result = "); 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) OPM.WriteString("(void*)"); expr(n^.left, 10)
ELSE ELSE
expr(n^.left, MinPrec) expr(n^.left, MinPrec)
@ -938,11 +938,11 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString("return"); OPM.WriteString("return");
END END
END END
| OPM.Nwith: IfStat(n, n^.subcl = 0, outerProc) | OPT.Nwith: IfStat(n, n^.subcl = 0, outerProc)
| OPM.Ntrap: OPC.Halt(n^.right^.conval^.intval) | 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; ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
END; 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 n := n^.link
END END
END stat; END stat;