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

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;
(***** Objects *****)
(* Object.mode values *)
Var* = 1; VarPar* = 2; Con* = 3; Fld* = 4; Typ* = 5; LProc* = 6; XProc* = 7;
SProc* = 8; CProc* = 9; IProc* = 10; Mod* = 11; Head* = 12; TProc* = 13;
(* Object.vis - module visibility of objects *)
internal* = 0; external* = 1; externalR* = 2;
(* Object.history - History of imported objects *)
inserted* = 0; same* = 1; pbmodified* = 2; pvmodified* = 3; removed* = 4; inconsistent* = 5;
(* Object.adr Function numbers *)
haltfn* = 0; newfn* = 1; absfn* = 2; capfn* = 3; ordfn* = 4;
entierfn* = 5; oddfn* = 6; minfn* = 7; maxfn* = 8; chrfn* = 9;
shortfn* = 10; longfn* = 11; sizefn* = 12; incfn* = 13; decfn* = 14;
inclfn* = 15; exclfn* = 16; lenfn* = 17; copyfn* = 18; ashfn* = 19;
adrfn* = 20; ccfn* = 21; lshfn* = 22; rotfn* = 23; getfn* = 24; (* SYSTEM *)
putfn* = 25; getrfn* = 26; putrfn* = 27; bitfn* = 28; valfn* = 29; (* SYSTEM *)
sysnewfn* = 30; movefn* = 31; (* SYSTEM *)
assertfn* = 32;
(***** Structures *****)
(* Struct.form values *)
Undef* = 0; Byte* = 1; Bool* = 2; Char* = 3;
SInt* = 4; Int* = 5; LInt* = 6;
Real* = 7; LReal* = 8; Set* = 9; String* = 10;
NilTyp* = 11; NoTyp* = 12; Pointer* = 13; ProcTyp* = 14;
Comp* = 15;
intSet* = {SInt..LInt(*, Int8..Int64*)}; realSet* = {Real, LReal};
(* Struct.comp - Composite structure forms *)
Basic* = 1; Array* = 2; DynArr* = 3; Record* = 4;
(***** Nodes *****)
(* Node.class values *)
Nvar* = 0; Nvarpar* = 1; Nfield* = 2; Nderef* = 3; Nindex* = 4; Nguard* = 5; Neguard* = 6;
Nconst* = 7; Ntype* = 8; Nproc* = 9; Nupto* = 10; Nmop* = 11; Ndop* = 12; Ncall* = 13;
Ninittd* = 14; Nif* = 15; Ncaselse* = 16; Ncasedo* = 17; Nenter* = 18; Nassign* = 19;
Nifelse* = 20; Ncase* = 21; Nwhile* = 22; Nrepeat* = 23; Nloop* = 24; Nexit* = 25;
Nreturn* = 26; Nwith* = 27; Ntrap* = 28;
(* Node.subcl values - general *)
assign* = 0; (* Pseudo function number for assignment *)
super* = 1;
(* Node.subcl values - functions *)
ash* = 17; msk* = 18; len* = 19;
conv* = 20; abs* = 21; cap* = 22; odd* = 23;
(* Node.subcl values - SYSTEM functions *)
adr* = 24; cc* = 25; bit* = 26; lsh* = 27; rot* = 28; val* = 29;
(* Note: some object.adr function numbers and some symbol types are
also are used as Node.subcl function ids *)
(* conval^.setval procedure flags *)
hasBody* = 1; isRedef* = 2; slNeeded* = 3;
TYPE
FileName = ARRAY 32 OF CHAR;

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

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

386
src/compiler/OPV.Mod
View file

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