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

Deduplicate common constants into OPM and do some source format tidying.

Browse source
This commit is contained in:
David Brown 2016-08-11 18:37:56 +01:00
parent b1dc7d77e8
commit 480c2e02eb
7 changed files with 3401 additions and 3633 deletions
Download patch file Download diff file Expand all files Collapse all files

1210
src/compiler/OPB.Mod
View file

File diff suppressed because it is too large Load diff

543
src/compiler/OPC.Mod
View file

File diff suppressed because it is too large Load diff

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

@ -79,6 +79,127 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
HFext = ".h"; (* header file extension *) HFext = ".h"; (* header file extension *)
SFtag = 0F7X; (* symbol file tag *) SFtag = 0F7X; (* symbol file tag *)
(***** Symbols *****)
(* Symbols values (also used as op values):
| 0 1 2 3 4
---|--------------------------------------------------------
0 | null * / DIV MOD
5 | & + - OR =
10 | # < <= > >=
15 | IN IS ^ . ,
20 | : .. ) ] }
25 | OF THEN DO TO BY
30 | ( [ { ~ :=
35 | number NIL string OPM.ident ;
40 | | END ELSE ELSIF UNTIL
45 | IF CASE WHILE REPEAT FOR
50 | LOOP WITH EXIT RETURN ARRAY
55 | RECORD POINTER BEGIN CONST TYPE
60 | VAR PROCEDURE IMPORT MODULE eof
*)
null* = 0; times* = 1; slash* = 2; div* = 3; mod* = 4;
and* = 5; plus* = 6; minus* = 7; or* = 8; eql* = 9;
neq* = 10; lss* = 11; leq* = 12; gtr* = 13; geq* = 14;
in* = 15; is* = 16; arrow* = 17; period* = 18; comma* = 19;
colon* = 20; upto* = 21; rparen* = 22; rbrak* = 23; rbrace* = 24;
of* = 25; then* = 26; do* = 27; to* = 28; by* = 29;
lparen* = 30; lbrak* = 31; lbrace* = 32; not* = 33; becomes* = 34;
number* = 35; nil* = 36; string* = 37; ident* = 38; semicolon* = 39;
bar* = 40; end* = 41; else* = 42; elsif* = 43; until* = 44;
if* = 45; case* = 46; while* = 47; repeat* = 48; for* = 49;
loop* = 50; with* = 51; exit* = 52; return* = 53; array* = 54;
record* = 55; pointer* = 56; begin* = 57; const* = 58; type* = 59;
var* = 60; procedure* = 61; import* = 62; module* = 63; eof* = 64;
(* Symbol numtyp values *)
char* = 1; integer* = 2; real* = 3; longreal* = 4;
(***** Objects *****)
(* Object.mode values *)
Var* = 1; VarPar* = 2; Con* = 3; Fld* = 4; Typ* = 5; LProc* = 6; XProc* = 7;
SProc* = 8; CProc* = 9; IProc* = 10; Mod* = 11; Head* = 12; TProc* = 13;
(* Object.vis - module visibility of objects *)
internal* = 0; external* = 1; externalR* = 2;
(* Object.history - History of imported objects *)
inserted* = 0; same* = 1; pbmodified* = 2; pvmodified* = 3; removed* = 4; inconsistent* = 5;
(* Object.adr Function numbers *)
haltfn* = 0; newfn* = 1; absfn* = 2; capfn* = 3; ordfn* = 4;
entierfn* = 5; oddfn* = 6; minfn* = 7; maxfn* = 8; chrfn* = 9;
shortfn* = 10; longfn* = 11; sizefn* = 12; incfn* = 13; decfn* = 14;
inclfn* = 15; exclfn* = 16; lenfn* = 17; copyfn* = 18; ashfn* = 19;
adrfn* = 20; ccfn* = 21; lshfn* = 22; rotfn* = 23; getfn* = 24; (* SYSTEM *)
putfn* = 25; getrfn* = 26; putrfn* = 27; bitfn* = 28; valfn* = 29; (* SYSTEM *)
sysnewfn* = 30; movefn* = 31; (* SYSTEM *)
assertfn* = 32;
(***** Structures *****)
(* Struct.form values *)
Undef* = 0; Byte* = 1; Bool* = 2; Char* = 3;
SInt* = 4; Int* = 5; LInt* = 6;
Real* = 7; LReal* = 8; Set* = 9; String* = 10;
NilTyp* = 11; NoTyp* = 12; Pointer* = 13; ProcTyp* = 14;
Comp* = 15;
intSet* = {SInt..LInt(*, Int8..Int64*)}; realSet* = {Real, LReal};
(* Struct.comp - Composite structure forms *)
Basic* = 1; Array* = 2; DynArr* = 3; Record* = 4;
(***** Nodes *****)
(* Node.class values *)
Nvar* = 0; Nvarpar* = 1; Nfield* = 2; Nderef* = 3; Nindex* = 4; Nguard* = 5; Neguard* = 6;
Nconst* = 7; Ntype* = 8; Nproc* = 9; Nupto* = 10; Nmop* = 11; Ndop* = 12; Ncall* = 13;
Ninittd* = 14; Nif* = 15; Ncaselse* = 16; Ncasedo* = 17; Nenter* = 18; Nassign* = 19;
Nifelse* = 20; Ncase* = 21; Nwhile* = 22; Nrepeat* = 23; Nloop* = 24; Nexit* = 25;
Nreturn* = 26; Nwith* = 27; Ntrap* = 28;
(* Node.subcl values - general *)
assign* = 0; (* Pseudo function number for assignment *)
super* = 1;
(* Node.subcl values - functions *)
ash* = 17; msk* = 18; len* = 19;
conv* = 20; abs* = 21; cap* = 22; odd* = 23;
(* Node.subcl values - SYSTEM functions *)
adr* = 24; cc* = 25; bit* = 26; lsh* = 27; rot* = 28; val* = 29;
(* Note: some object.adr function numbers and some symbol types are
also are used as Node.subcl function ids *)
(* conval^.setval procedure flags *)
hasBody* = 1; isRedef* = 2; slNeeded* = 3;
TYPE TYPE
FileName = ARRAY 32 OF CHAR; FileName = ARRAY 32 OF CHAR;
@ -142,27 +263,30 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
i := 1; (* skip - *) i := 1; (* skip - *)
WHILE s[i] # 0X DO WHILE s[i] # 0X DO
CASE s[i] OF CASE s[i] OF
| "e": opt := opt / {extsf}
| "s": opt := opt / {newsf}
| "m": opt := opt / {mainprog}
| "x": opt := opt / {inxchk}
| "r": opt := opt / {ranchk}
| "t": opt := opt / {typchk}
| "a": opt := opt / {assert} | "a": opt := opt / {assert}
| "k": opt := opt / {ansi} (* undocumented *)
| "p": opt := opt / {ptrinit}
| "S": opt := opt / {dontasm}
| "c": opt := opt / {dontlink} | "c": opt := opt / {dontlink}
| "M": opt := opt / {mainlinkstat} | "e": opt := opt / {extsf}
| "f": opt := opt / {notcoloroutput} | "f": opt := opt / {notcoloroutput}
| "F": opt := opt / {forcenewsym} | "k": opt := opt / {ansi} (* undocumented *)
| "V": opt := opt / {verbose} | "m": opt := opt / {mainprog}
| "p": opt := opt / {ptrinit}
| "r": opt := opt / {ranchk}
| "s": opt := opt / {newsf}
| "t": opt := opt / {typchk}
| "x": opt := opt / {inxchk}
| "B": IF s[i+1] # 0X THEN INC(i); IntSize := ORD(s[i]) - ORD('0') END; | "B": IF s[i+1] # 0X THEN INC(i); IntSize := ORD(s[i]) - ORD('0') END;
IF s[i+1] # 0X THEN INC(i); PointerSize := ORD(s[i]) - ORD('0') END; IF s[i+1] # 0X THEN INC(i); PointerSize := ORD(s[i]) - ORD('0') END;
IF s[i+1] # 0X THEN INC(i); Alignment := ORD(s[i]) - ORD('0') END; IF s[i+1] # 0X THEN INC(i); Alignment := ORD(s[i]) - ORD('0') END;
ASSERT((IntSize = 2) OR (IntSize = 4)); ASSERT((IntSize = 2) OR (IntSize = 4));
ASSERT((PointerSize = 4) OR (PointerSize = 8)); ASSERT((PointerSize = 4) OR (PointerSize = 8));
ASSERT((Alignment = 4) OR (Alignment = 8)) ASSERT((Alignment = 4) OR (Alignment = 8));
Files.SetSearchPath("")
| "F": opt := opt / {forcenewsym}
| "M": opt := opt / {mainlinkstat}
| "S": opt := opt / {dontasm}
| "V": opt := opt / {verbose}
ELSE ELSE
LogWStr(" warning: option "); LogWStr(" warning: option ");
LogW(OptionChar); LogW(OptionChar);
@ -484,10 +608,10 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END GetProperty; END GetProperty;
PROCEDURE minus(i: LONGINT): LONGINT; PROCEDURE minusop(i: LONGINT): LONGINT;
BEGIN BEGIN
RETURN -i; RETURN -i;
END minus; END minusop;
PROCEDURE power0(i, j : LONGINT) : LONGINT; (* we would like to calculate exact Min Max values in GetProperties, not hardcode em, noch *) PROCEDURE power0(i, j : LONGINT) : LONGINT; (* we would like to calculate exact Min Max values in GetProperties, not hardcode em, noch *)
@ -529,9 +653,20 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END VerboseListSizes; END VerboseListSizes;
PROCEDURE Min(a,b: INTEGER): INTEGER; PROCEDURE AlignSize*(size: LONGINT): INTEGER;
BEGIN IF a<b THEN RETURN a ELSE RETURN b END VAR align: INTEGER;
END Min; BEGIN
IF size < Alignment THEN
IF size > 8 THEN align := 16
ELSIF size > 4 THEN align := 8
ELSIF size > 2 THEN align := 4
ELSE align := SHORT(size)
END
ELSE
align := Alignment
END;
RETURN align
END AlignSize;
PROCEDURE GetProperties(); PROCEDURE GetProperties();
VAR VAR
@ -547,28 +682,28 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
SetSize := LIntSize; SetSize := LIntSize;
(* Calculate all type alignments *) (* Calculate all type alignments *)
CharAlign := Min(Alignment, CharSize); CharAlign := AlignSize(CharSize);
BoolAlign := Min(Alignment, BoolSize); BoolAlign := AlignSize(BoolSize);
SIntAlign := Min(Alignment, SIntSize); SIntAlign := AlignSize(SIntSize);
RecAlign := Min(Alignment, RecSize); RecAlign := AlignSize(RecSize);
RealAlign := Min(Alignment, RealSize); RealAlign := AlignSize(RealSize);
LRealAlign := Min(Alignment, LRealSize); LRealAlign := AlignSize(LRealSize);
PointerAlign := Min(Alignment, PointerSize); PointerAlign := AlignSize(PointerSize);
ProcAlign := Min(Alignment, ProcSize); ProcAlign := AlignSize(ProcSize);
IntAlign := Min(Alignment, IntSize); IntAlign := AlignSize(IntSize);
LIntAlign := Min(Alignment, LIntSize); LIntAlign := AlignSize(LIntSize);
SetAlign := Min(Alignment, SetSize); SetAlign := AlignSize(SetSize);
(* and I'd like to calculate it, not hardcode constants *) (* and I'd like to calculate it, not hardcode constants *)
base := -2; base := -2;
MinSInt := ASH(base, SIntSize*8-2); MinSInt := ASH(base, SIntSize*8-2);
MaxSInt := minus(MinSInt + 1); MaxSInt := minusop(MinSInt + 1);
MinInt := ASH(base, IntSize*8-2); MinInt := ASH(base, IntSize*8-2);
MaxInt := minus(MinInt + 1); MaxInt := minusop(MinInt + 1);
MinLInt := ASH(base, LIntSize*8-2); MinLInt := ASH(base, LIntSize*8-2);
MaxLInt := minus(MinLInt +1); MaxLInt := minusop(MinLInt +1);
IF RealSize = 4 THEN MaxReal := 3.40282346D38 IF RealSize = 4 THEN MaxReal := 3.40282346D38
ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999 ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999

706
src/compiler/OPP.Mod
View file

File diff suppressed because it is too large Load diff

180
src/compiler/OPS.Mod
View file

@ -10,9 +10,8 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
Name* = ARRAY MaxIdLen OF CHAR; Name* = ARRAY MaxIdLen OF CHAR;
String* = ARRAY MaxStrLen OF CHAR; String* = ARRAY MaxStrLen OF CHAR;
(* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
VAR VAR
(* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
name*: Name; name*: Name;
str*: String; str*: String;
numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *) numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
@ -20,43 +19,6 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
realval*: REAL; realval*: REAL;
lrlval*: LONGREAL; lrlval*: LONGREAL;
(*symbols:
| 0 1 2 3 4
---|--------------------------------------------------------
0 | null * / DIV MOD
5 | & + - OR =
10 | # < <= > >=
15 | IN IS ^ . ,
20 | : .. ) ] }
25 | OF THEN DO TO BY
30 | ( [ { ~ :=
35 | number NIL string ident ;
40 | | END ELSE ELSIF UNTIL
45 | IF CASE WHILE REPEAT FOR
50 | LOOP WITH EXIT RETURN ARRAY
55 | RECORD POINTER BEGIN CONST TYPE
60 | VAR PROCEDURE IMPORT MODULE eof *)
CONST
(* numtyp values *)
char = 1; integer = 2; real = 3; longreal = 4;
(*symbol values*)
null = 0; times = 1; slash = 2; div = 3; mod = 4;
and = 5; plus = 6; minus = 7; or = 8; eql = 9;
neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
in = 15; is = 16; arrow = 17; period = 18; comma = 19;
colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
of = 25; then = 26; do = 27; to = 28; by = 29;
lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
bar = 40; end = 41; else = 42; elsif = 43; until = 44;
if = 45; case = 46; while = 47; repeat = 48; for = 49;
loop = 50; with = 51; exit = 52; return = 53; array = 54;
record = 55; pointer = 56; begin = 57; const = 58; type = 59;
var = 60; procedure = 61; import = 62; module = 63; eof = 64;
VAR
ch: CHAR; (*current character*) ch: CHAR; (*current character*)
PROCEDURE err(n: INTEGER); PROCEDURE err(n: INTEGER);
@ -74,8 +36,8 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
END ; END ;
OPM.Get(ch); str[i] := 0X; intval := i + 1; OPM.Get(ch); str[i] := 0X; intval := i + 1;
IF intval = 2 THEN IF intval = 2 THEN
sym := number; numtyp := 1; intval := ORD(str[0]) sym := OPM.number; numtyp := 1; intval := ORD(str[0])
ELSE sym := string ELSE sym := OPM.string
END END
END Str; END Str;
@ -86,7 +48,7 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
name[i] := ch; INC(i); OPM.Get(ch) name[i] := ch; INC(i); OPM.Get(ch)
UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen); UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
IF i = MaxIdLen THEN err(240); DEC(i) END ; IF i = MaxIdLen THEN err(240); DEC(i) END ;
name[i] := 0X; sym := ident name[i] := 0X; sym := OPM.ident
END Identifier; END Identifier;
PROCEDURE Number; PROCEDURE Number;
@ -128,21 +90,21 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
ELSE EXIT ELSE EXIT
END END
END; (* 0 <= n <= m <= i, 0 <= d <= i *) END; (* 0 <= n <= m <= i, 0 <= d <= i *)
IF d = 0 THEN (* integer *) IF d = 0 THEN (* OPM.integer *)
IF n = m THEN intval := 0; i := 0; IF n = m THEN intval := 0; i := 0;
IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char; IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := OPM.char;
IF n <= 2 THEN IF n <= 2 THEN
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
ELSE err(203) ELSE err(203)
END END
ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer; ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := OPM.integer;
IF MAX(LONGINT) > 2147483647 THEN maxHdig := 16 ELSE maxHdig := 8 END; IF MAX(LONGINT) > 2147483647 THEN maxHdig := 16 ELSE maxHdig := 8 END;
IF n <= maxHdig THEN IF n <= maxHdig THEN
IF (n = maxHdig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END; IF (n = maxHdig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
ELSE err(203) ELSE err(203)
END END
ELSE (* decimal *) numtyp := integer; ELSE (* decimal *) numtyp := OPM.integer;
WHILE i < n DO d := Ord(dig[i], FALSE); INC(i); WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
ELSE err(203) ELSE err(203)
@ -169,14 +131,14 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
END END
END; END;
DEC(e, i-d-m); (* decimal point shift *) DEC(e, i-d-m); (* decimal point shift *)
IF expCh = "E" THEN numtyp := real; IF expCh = "E" THEN numtyp := OPM.real;
IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
IF e < 0 THEN realval := SHORT(f / Ten(-e)) IF e < 0 THEN realval := SHORT(f / Ten(-e))
ELSE realval := SHORT(f * Ten(e)) ELSE realval := SHORT(f * Ten(e))
END END
ELSE err(203) ELSE err(203)
END END
ELSE numtyp := longreal; ELSE numtyp := OPM.longreal;
IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
IF e < 0 THEN lrlval := f / Ten(-e) IF e < 0 THEN lrlval := f / Ten(-e)
ELSE lrlval := f * Ten(e) ELSE lrlval := f * Ten(e)
@ -209,102 +171,100 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
BEGIN BEGIN
OPM.errpos := OPM.curpos-1; OPM.errpos := OPM.curpos-1;
WHILE ch <= " " DO (*ignore control characters*) WHILE ch <= " " DO (*ignore control characters*)
IF ch = OPM.Eot THEN sym := eof; RETURN IF ch = OPM.Eot THEN sym := OPM.eof; RETURN
ELSE OPM.Get(ch) ELSE OPM.Get(ch)
END END
END ; END ;
CASE ch OF (* ch > " " *) CASE ch OF (* ch > " " *)
| 22X, 27X : Str(s) | 22X, 27X : Str(s)
| "#" : s := neq; OPM.Get(ch) | "#" : s := OPM.neq; OPM.Get(ch)
| "&" : s := and; OPM.Get(ch) | "&" : s := OPM.and; OPM.Get(ch)
| "(" : OPM.Get(ch); | "(" : OPM.Get(ch);
IF ch = "*" THEN Comment; Get(s) IF ch = "*" THEN Comment; Get(s) ELSE s := OPM.lparen END
ELSE s := lparen | ")" : s := OPM.rparen; OPM.Get(ch)
END | "*" : s := OPM.times; OPM.Get(ch)
| ")" : s := rparen; OPM.Get(ch) | "+" : s := OPM.plus; OPM.Get(ch)
| "*" : s := times; OPM.Get(ch) | "," : s := OPM.comma; OPM.Get(ch)
| "+" : s := plus; OPM.Get(ch) | "-" : s := OPM.minus; OPM.Get(ch)
| "," : s := comma; OPM.Get(ch)
| "-" : s := minus; OPM.Get(ch)
| "." : OPM.Get(ch); | "." : OPM.Get(ch);
IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END IF ch = "." THEN OPM.Get(ch); s := OPM.upto ELSE s := OPM.period END
| "/" : s := slash; OPM.Get(ch) | "/" : s := OPM.slash; OPM.Get(ch)
| "0".."9": Number; s := number | "0".."9": Number; s := OPM.number
| ":" : OPM.Get(ch); | ":" : OPM.Get(ch);
IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END IF ch = "=" THEN OPM.Get(ch); s := OPM.becomes ELSE s := OPM.colon END
| ";" : s := semicolon; OPM.Get(ch) | ";" : s := OPM.semicolon; OPM.Get(ch)
| "<" : OPM.Get(ch); | "<" : OPM.Get(ch);
IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END IF ch = "=" THEN OPM.Get(ch); s := OPM.leq ELSE s := OPM.lss END
| "=" : s := eql; OPM.Get(ch) | "=" : s := OPM.eql; OPM.Get(ch)
| ">" : OPM.Get(ch); | ">" : OPM.Get(ch);
IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END IF ch = "=" THEN OPM.Get(ch); s := OPM.geq ELSE s := OPM.gtr END
| "A": Identifier(s); IF name = "ARRAY" THEN s := array END | "A": Identifier(s); IF name = "ARRAY" THEN s := OPM.array END
| "B": Identifier(s); | "B": Identifier(s);
IF name = "BEGIN" THEN s := begin IF name = "BEGIN" THEN s := OPM.begin
ELSIF name = "BY" THEN s := by ELSIF name = "BY" THEN s := OPM.by
END END
| "C": Identifier(s); | "C": Identifier(s);
IF name = "CASE" THEN s := case IF name = "CASE" THEN s := OPM.case
ELSIF name = "CONST" THEN s := const ELSIF name = "CONST" THEN s := OPM.const
END END
| "D": Identifier(s); | "D": Identifier(s);
IF name = "DO" THEN s := do IF name = "DO" THEN s := OPM.do
ELSIF name = "DIV" THEN s := div ELSIF name = "DIV" THEN s := OPM.div
END END
| "E": Identifier(s); | "E": Identifier(s);
IF name = "END" THEN s := end IF name = "END" THEN s := OPM.end
ELSIF name = "ELSE" THEN s := else ELSIF name = "ELSE" THEN s := OPM.else
ELSIF name = "ELSIF" THEN s := elsif ELSIF name = "ELSIF" THEN s := OPM.elsif
ELSIF name = "EXIT" THEN s := exit ELSIF name = "EXIT" THEN s := OPM.exit
END END
| "F": Identifier(s); IF name = "FOR" THEN s := for END | "F": Identifier(s); IF name = "FOR" THEN s := OPM.for END
| "I": Identifier(s); | "I": Identifier(s);
IF name = "IF" THEN s := if IF name = "IF" THEN s := OPM.if
ELSIF name = "IN" THEN s := in ELSIF name = "IN" THEN s := OPM.in
ELSIF name = "IS" THEN s := is ELSIF name = "IS" THEN s := OPM.is
ELSIF name = "IMPORT" THEN s := import ELSIF name = "IMPORT" THEN s := OPM.import
END END
| "L": Identifier(s); IF name = "LOOP" THEN s := loop END | "L": Identifier(s); IF name = "LOOP" THEN s := OPM.loop END
| "M": Identifier(s); | "M": Identifier(s);
IF name = "MOD" THEN s := mod IF name = "MOD" THEN s := OPM.mod
ELSIF name = "MODULE" THEN s := module ELSIF name = "MODULE" THEN s := OPM.module
END END
| "N": Identifier(s); IF name = "NIL" THEN s := nil END | "N": Identifier(s); IF name = "NIL" THEN s := OPM.nil END
| "O": Identifier(s); | "O": Identifier(s);
IF name = "OR" THEN s := or IF name = "OR" THEN s := OPM.or
ELSIF name = "OF" THEN s := of ELSIF name = "OF" THEN s := OPM.of
END END
| "P": Identifier(s); | "P": Identifier(s);
IF name = "PROCEDURE" THEN s := procedure IF name = "PROCEDURE" THEN s := OPM.procedure
ELSIF name = "POINTER" THEN s := pointer ELSIF name = "POINTER" THEN s := OPM.pointer
END END
| "R": Identifier(s); | "R": Identifier(s);
IF name = "RECORD" THEN s := record IF name = "RECORD" THEN s := OPM.record
ELSIF name = "REPEAT" THEN s := repeat ELSIF name = "REPEAT" THEN s := OPM.repeat
ELSIF name = "RETURN" THEN s := return ELSIF name = "RETURN" THEN s := OPM.return
END END
| "T": Identifier(s); | "T": Identifier(s);
IF name = "THEN" THEN s := then IF name = "THEN" THEN s := OPM.then
ELSIF name = "TO" THEN s := to ELSIF name = "TO" THEN s := OPM.to
ELSIF name = "TYPE" THEN s := type ELSIF name = "TYPE" THEN s := OPM.type
END END
| "U": Identifier(s); IF name = "UNTIL" THEN s := until END | "U": Identifier(s); IF name = "UNTIL" THEN s := OPM.until END
| "V": Identifier(s); IF name = "VAR" THEN s := var END | "V": Identifier(s); IF name = "VAR" THEN s := OPM.var END
| "W": Identifier(s); | "W": Identifier(s);
IF name = "WHILE" THEN s := while IF name = "WHILE" THEN s := OPM.while
ELSIF name = "WITH" THEN s := with ELSIF name = "WITH" THEN s := OPM.with
END END
| "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s) | "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
| "[" : s := lbrak; OPM.Get(ch) | "[" : s := OPM.lbrak; OPM.Get(ch)
| "]" : s := rbrak; OPM.Get(ch) | "]" : s := OPM.rbrak; OPM.Get(ch)
| "^" : s := arrow; OPM.Get(ch) | "^" : s := OPM.arrow; OPM.Get(ch)
| "a".."z": Identifier(s) | "a".."z": Identifier(s)
| "{" : s := lbrace; OPM.Get(ch) | "{" : s := OPM.lbrace; OPM.Get(ch)
| "|" : s := bar; OPM.Get(ch) | "|" : s := OPM.bar; OPM.Get(ch)
| "}" : s := rbrace; OPM.Get(ch) | "}" : s := OPM.rbrace; OPM.Get(ch)
| "~" : s := not; OPM.Get(ch) | "~" : s := OPM.not; OPM.Get(ch)
| 7FX : s := upto; OPM.Get(ch) | 7FX : s := OPM.upto; OPM.Get(ch)
ELSE s := null; OPM.Get(ch) ELSE s := OPM.null; OPM.Get(ch)
END ; END ;
sym := s sym := s
END Get; END Get;

561
src/compiler/OPT.Mod
View file

@ -30,7 +30,7 @@ TYPE
name*: OPS.Name; name*: OPS.Name;
leaf*: BOOLEAN; leaf*: BOOLEAN;
mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *)
vis*: SHORTINT; (* internal, external, externalR *) vis*: SHORTINT; (* OPM.internal, OPM.external, OPM.externalR *)
history*: SHORTINT; (* relevant if name # "" *) history*: SHORTINT; (* relevant if name # "" *)
used*, fpdone*: BOOLEAN; used*, fpdone*: BOOLEAN;
fprint*: LONGINT; fprint*: LONGINT;
@ -45,11 +45,11 @@ TYPE
mno*, extlev*: SHORTINT; mno*, extlev*: SHORTINT;
ref*, sysflag*: INTEGER; ref*, sysflag*: INTEGER;
n*, size*: LONGINT; n*, size*: LONGINT;
align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *) align*, txtpos*: LONGINT; (* align is alignment for records, len is offset for dynarrs *)
allocated*: BOOLEAN; allocated*: BOOLEAN;
pbused*, pvused*: BOOLEAN; pbused*, pvused*: BOOLEAN;
fpdone, idfpdone: BOOLEAN; fpdone, idfpdone: BOOLEAN;
idfp, pbfp*, pvfp*: LONGINT; idfp, pbfp, pvfp: LONGINT;
BaseTyp*: Struct; BaseTyp*: Struct;
link*, strobj*: Object link*, strobj*: Object
END; END;
@ -66,65 +66,31 @@ TYPE
CONST CONST
maxImps = 64; (* must be <= MAX(SHORTINT) *) maxImps = 64; (* must be <= MAX(SHORTINT) *)
maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *)
FirstRef = (*20*)16; (* comp + 1 *) FirstRef = OPM.Comp + 1;
VAR VAR
typSize*: PROCEDURE(typ: Struct); typSize*: PROCEDURE(typ: Struct);
topScope*: Object; topScope*: Object;
undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*,
realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*, undftyp*,
int8typ*, int16typ*, int32typ*, int64typ* *): Struct; bytetyp*, booltyp*, chartyp*,
sinttyp*, inttyp*, linttyp*,
realtyp*, lrltyp*, settyp*, stringtyp*,
niltyp*, notyp*, sysptrtyp*: Struct;
nofGmod*: SHORTINT; (*nof imports*) nofGmod*: SHORTINT; (*nof imports*)
GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *)
SelfName*: OPS.Name; (* name of module being compiled *) SelfName*: OPS.Name; (* name of module being compiled *)
SYSimported*: BOOLEAN; SYSimported*: BOOLEAN;
CONST CONST
(* object modes *) (* Symbol file items *)
Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21;
SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26;
Shdptr* = 27; Shdpro* = 28; Stpro* = 29; Shdtpro* = 30; Sxpro* = 31;
(* structure forms *) Sipro* = 32; Scpro* = 33; Sstruct* = 34; Ssys* = 35; Sptr* = 36;
Undef = 0; Byte = 1; Bool = 2; Char = 3; Sarr* = 37; Sdarr* = 38; Srec* = 39; Spro* = 40;
SInt = 4; Int = 5; LInt = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14;
Comp = 15;
(*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10;
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18;
Comp = 19;*)
(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14;
Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = 19;*)
(* composite structure forms *)
Basic = 1; Array = 2; DynArr = 3; Record = 4;
(*function number*)
assign = 0;
haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
(*SYSTEM function number*)
adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31;
(* module visibility of objects *)
internal = 0; external = 1; externalR = 2;
(* history of imported objects *)
inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5;
(* symbol file items *)
Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22;
Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30;
Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40;
TYPE TYPE
ImpCtxt = RECORD ImpCtxt = RECORD
@ -170,7 +136,7 @@ END NewObj;
PROCEDURE NewStr*(form, comp: SHORTINT): Struct; PROCEDURE NewStr*(form, comp: SHORTINT): Struct;
VAR typ: Struct; VAR typ: Struct;
BEGIN NEW(typ); typ^.form := form; typ^.comp := comp; typ^.ref := maxStruct; (* ref >= maxStruct: not exported yet *) BEGIN NEW(typ); typ^.form := form; typ^.comp := comp; typ^.ref := maxStruct; (* ref >= maxStruct: not exported yet *)
IF form # Undef THEN typ^.txtpos := OPM.errpos END ; (* txtpos remains 0 for structs read from symbol file *) IF form # OPM.Undef THEN typ^.txtpos := OPM.errpos END ; (* txtpos remains 0 for structs read from symbol file *)
typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ
END NewStr; END NewStr;
@ -187,7 +153,7 @@ END NewExt;
PROCEDURE OpenScope*(level: SHORTINT; owner: Object); PROCEDURE OpenScope*(level: SHORTINT; owner: Object);
VAR head: Object; VAR head: Object;
BEGIN head := NewObj(); BEGIN head := NewObj();
head^.mode := Head; head^.mnolev := level; head^.link := owner; head^.mode := OPM.Head; head^.mnolev := level; head^.link := owner;
IF owner # NIL THEN owner^.scope := head END; IF owner # NIL THEN owner^.scope := head END;
head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head
END OpenScope; END OpenScope;
@ -221,7 +187,7 @@ IF obj = NIL THEN EXIT END ;
IF OPS.name < obj^.name THEN obj := obj^.left IF OPS.name < obj^.name THEN obj := obj^.left
ELSIF OPS.name > obj^.name THEN obj := obj^.right ELSIF OPS.name > obj^.name THEN obj := obj^.right
ELSE (*found*) ELSE (*found*)
IF (obj^.mode = Typ) & (obj^.vis = internal) THEN obj := NIL IF (obj^.mode = OPM.Typ) & (obj^.vis = OPM.internal) THEN obj := NIL
ELSE obj^.used := TRUE ELSE obj^.used := TRUE
END; END;
EXIT EXIT
@ -282,8 +248,11 @@ END ;
obj := ob1 obj := ob1
END Insert; END Insert;
(*-------------------------- Fingerprinting --------------------------*) (*-------------------------- Fingerprinting --------------------------*)
(* Fingerprints prevent structural type equivalence. *)
PROCEDURE FPrintName(VAR fp: LONGINT; VAR name: ARRAY OF CHAR); PROCEDURE FPrintName(VAR fp: LONGINT; VAR name: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR; VAR i: INTEGER; ch: CHAR;
BEGIN i := 0; BEGIN i := 0;
@ -329,11 +298,11 @@ BEGIN
IF (strobj # NIL) & (strobj^.name # "") THEN IF (strobj # NIL) & (strobj^.name # "") THEN
FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name) FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name)
END; END;
IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN IF (f = OPM.Pointer) OR (c = OPM.Record) & (btyp # NIL) OR (c = OPM.DynArr) THEN
IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp) IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp)
ELSIF c = Array THEN ELSIF c = OPM.Array THEN
IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n) IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n)
ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) ELSIF f = OPM.ProcTyp THEN FPrintSign(idfp, btyp, typ^.link)
END; END;
typ^.idfp := idfp typ^.idfp := idfp
END END
@ -347,28 +316,28 @@ PROCEDURE ^FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *) PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *)
VAR i, j, n: LONGINT; btyp: Struct; VAR i, j, n: LONGINT; btyp: Struct;
BEGIN BEGIN
IF typ^.comp = Record THEN FPrintFlds(typ^.link, adr, FALSE) IF typ^.comp = OPM.Record THEN FPrintFlds(typ^.link, adr, FALSE)
ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n; ELSIF typ^.comp = OPM.Array THEN btyp := typ^.BaseTyp; n := typ^.n;
WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; WHILE btyp^.comp = OPM.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END;
IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN IF (btyp^.form = OPM.Pointer) OR (btyp^.comp = OPM.Record) THEN
j := nofhdfld; FPrintHdFld(btyp, fld, adr); j := nofhdfld; FPrintHdFld(btyp, fld, adr);
IF j # nofhdfld THEN i := 1; IF j # nofhdfld THEN i := 1;
WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
INC(adr, btyp^.size); FPrintHdFld(btyp, fld, adr); INC(i) INC(adr, btyp^.size); FPrintHdFld(btyp, fld, adr); INC(i)
END;
END END
END END
ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN END
OPM.FPrint(pvfp, Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld) ELSIF OPM.ExpHdPtrFld & ((typ^.form = OPM.Pointer) OR (fld^.name = OPM.HdPtrName)) THEN
ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN OPM.FPrint(pvfp, OPM.Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld)
OPM.FPrint(pvfp, ProcTyp); 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)
END END
END FPrintHdFld; END FPrintHdFld;
PROCEDURE FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); (* modifies pbfp and pvfp *) PROCEDURE FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); (* modifies pbfp and pvfp *)
BEGIN BEGIN
WHILE (fld # NIL) & (fld^.mode = Fld) DO WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO
IF (fld^.vis # internal) & visible THEN IF (fld^.vis # OPM.internal) & visible THEN
OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr);
FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp) FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp)
ELSE ELSE
@ -382,12 +351,12 @@ PROCEDURE FPrintTProcs(obj: Object); (* modifies pbfp and pvfp *)
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
FPrintTProcs(obj^.left); FPrintTProcs(obj^.left);
IF obj^.mode = TProc THEN IF obj^.mode = OPM.TProc THEN
IF obj^.vis # internal THEN IF obj^.vis # OPM.internal THEN
OPM.FPrint(pbfp, TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H); OPM.FPrint(pbfp, OPM.TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H);
FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name) FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name)
ELSIF OPM.ExpHdTProc THEN ELSIF OPM.ExpHdTProc THEN
OPM.FPrint(pvfp, TProc); OPM.FPrint(pvfp, obj^.adr DIV 10000H) OPM.FPrint(pvfp, OPM.TProc); OPM.FPrint(pvfp, obj^.adr DIV 10000H)
END END
END; END;
FPrintTProcs(obj^.right) FPrintTProcs(obj^.right)
@ -401,15 +370,15 @@ BEGIN
pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *) pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *)
typ^.fpdone := TRUE; typ^.fpdone := TRUE;
f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp; f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp;
IF f = Pointer THEN IF f = OPM.Pointer THEN
strobj := typ^.strobj; bstrobj := btyp^.strobj; strobj := typ^.strobj; bstrobj := btyp^.strobj;
IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN
FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); pvfp := pbfp FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); pvfp := pbfp
(* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *) (* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *)
END END
ELSIF f = ProcTyp THEN (* use idfp as pbfp and as pvfp *) ELSIF f = OPM.ProcTyp THEN (* use idfp as pbfp and as pvfp *)
ELSIF c IN {Array, DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp ELSIF c IN {OPM.Array, OPM.DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp
ELSE (* c = Record *) ELSE (* c = OPM.Record *)
IF btyp # NIL THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); OPM.FPrint(pvfp, btyp^.pvfp) END; IF btyp # NIL THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); OPM.FPrint(pvfp, btyp^.pvfp) END;
OPM.FPrint(pvfp, typ^.size); OPM.FPrint(pvfp, typ^.align); OPM.FPrint(pvfp, typ^.n); OPM.FPrint(pvfp, typ^.size); OPM.FPrint(pvfp, typ^.align); OPM.FPrint(pvfp, typ^.n);
nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE); nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE);
@ -418,7 +387,7 @@ BEGIN
IF (strobj = NIL) OR (strobj^.name = "") THEN pbfp := pvfp END IF (strobj = NIL) OR (strobj^.name = "") THEN pbfp := pvfp END
END; END;
typ^.pbfp := pbfp; typ^.pvfp := pvfp typ^.pbfp := pbfp; typ^.pvfp := pvfp
END; END
END FPrintStr; END FPrintStr;
PROCEDURE FPrintObj*(obj: Object); PROCEDURE FPrintObj*(obj: Object);
@ -427,31 +396,30 @@ BEGIN
IF ~obj^.fpdone THEN IF ~obj^.fpdone THEN
fprint := 0; obj^.fpdone := TRUE; fprint := 0; obj^.fpdone := TRUE;
OPM.FPrint(fprint, obj^.mode); OPM.FPrint(fprint, obj^.mode);
IF obj^.mode = Con THEN IF obj^.mode = OPM.Con THEN
f := obj^.typ^.form; OPM.FPrint(fprint, f); f := obj^.typ^.form; OPM.FPrint(fprint, f);
CASE f OF CASE f OF
| Bool, Char, SInt, Int, LInt(*, Int8, Int16, Int32, Int64*): | OPM.Bool,
OPM.FPrint(fprint, obj^.conval^.intval) OPM.Char,
| Set: OPM.SInt,
OPM.FPrintSet(fprint, obj^.conval^.setval) OPM.Int,
| Real: OPM.LInt: OPM.FPrint(fprint, obj^.conval^.intval)
rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval) | OPM.Set: OPM.FPrintSet(fprint, obj^.conval^.setval)
| LReal: | OPM.Real: rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval)
OPM.FPrintLReal(fprint, obj^.conval^.realval) | OPM.LReal: OPM.FPrintLReal(fprint, obj^.conval^.realval)
| String: | OPM.String: FPrintName(fprint, obj^.conval^.ext^)
FPrintName(fprint, obj^.conval^.ext^) | OPM.NilTyp:
| NilTyp:
ELSE err(127) ELSE err(127)
END END
ELSIF obj^.mode = Var THEN ELSIF obj^.mode = OPM.Var THEN
OPM.FPrint(fprint, obj^.vis); FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) OPM.FPrint(fprint, obj^.vis); FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp)
ELSIF obj^.mode IN {XProc, IProc} THEN ELSIF obj^.mode IN {OPM.XProc, OPM.IProc} THEN
FPrintSign(fprint, obj^.typ, obj^.link) FPrintSign(fprint, obj^.typ, obj^.link)
ELSIF obj^.mode = CProc THEN ELSIF obj^.mode = OPM.CProc THEN
FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext; FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext;
m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m); m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m);
WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END; WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END;
ELSIF obj^.mode = Typ THEN ELSIF obj^.mode = OPM.Typ THEN
FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp)
END; END;
obj^.fprint := fprint obj^.fprint := fprint
@ -527,7 +495,7 @@ i := 0;
WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END; WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END;
IF i < nofGmod THEN mno := i (*module already present*) IF i < nofGmod THEN mno := i (*module already present*)
ELSE ELSE
head := NewObj(); head^.mode := Head; COPY(name, head^.name); head := NewObj(); head^.mode := OPM.Head; COPY(name, head^.name);
mno := nofGmod; head^.mnolev := -mno; mno := nofGmod; head^.mnolev := -mno;
IF nofGmod < maxImps THEN IF nofGmod < maxImps THEN
GlbMod[mno] := head; INC(nofGmod) GlbMod[mno] := head; INC(nofGmod)
@ -545,31 +513,25 @@ PROCEDURE InConstant(f: LONGINT; conval: Const);
VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL;
BEGIN BEGIN
CASE f OF CASE f OF
| (*Int8,*) Byte, Char, Bool: | OPM.Byte,
OPM.SymRCh(ch); conval^.intval := ORD(ch) OPM.Char,
(*| Int8, Int16, Int32, Int64: OPM.Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch)
conval^.intval := OPM.SymRInt()*) | OPM.SInt,
| SInt, Int, LInt: OPM.Int,
conval^.intval := OPM.SymRInt() OPM.LInt: conval^.intval := OPM.SymRInt()
| Set: | OPM.Set: OPM.SymRSet(conval^.setval)
OPM.SymRSet(conval^.setval) | OPM.Real: OPM.SymRReal(rval); conval^.realval := rval;
| Real:
OPM.SymRReal(rval); conval^.realval := rval;
conval^.intval := OPM.ConstNotAlloc conval^.intval := OPM.ConstNotAlloc
| LReal: | OPM.LReal: OPM.SymRLReal(conval^.realval);
OPM.SymRLReal(conval^.realval);
conval^.intval := OPM.ConstNotAlloc conval^.intval := OPM.ConstNotAlloc
| String: | OPM.String: ext := NewExt(); conval^.ext := ext; i := 0;
ext := NewExt(); conval^.ext := ext; i := 0;
REPEAT REPEAT
OPM.SymRCh(ch); ext^[i] := ch; INC(i) OPM.SymRCh(ch); ext^[i] := ch; INC(i)
UNTIL ch = 0X; UNTIL ch = 0X;
conval^.intval2 := i; conval^.intval2 := i;
conval^.intval := OPM.ConstNotAlloc conval^.intval := OPM.ConstNotAlloc
| NilTyp: | OPM.NilTyp: conval^.intval := OPM.nilval
conval^.intval := OPM.nilval ELSE OPM.LogWStr("unhandled case in OPT.InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
ELSE
OPM.LogWStr("unhandled case in OPT.InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
END END
END InConstant; END InConstant;
@ -583,7 +545,7 @@ tag := OPM.SymRInt(); last := NIL;
WHILE tag # Send DO WHILE tag # Send DO
new := NewObj(); new^.mnolev := -mno; new := NewObj(); new^.mnolev := -mno;
IF last = NIL THEN par := new ELSE last^.link := new END; IF last = NIL THEN par := new ELSE last^.link := new END;
IF tag = Svalpar THEN new^.mode := Var ELSE new^.mode := VarPar END ; IF tag = Svalpar THEN new^.mode := OPM.Var ELSE new^.mode := OPM.VarPar END;
InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name); InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name);
last := new; tag := OPM.SymRInt() last := new; tag := OPM.SymRInt()
END END
@ -594,14 +556,14 @@ VAR tag: LONGINT; obj: Object;
BEGIN BEGIN
tag := impCtxt.nextTag; obj := NewObj(); tag := impCtxt.nextTag; obj := NewObj();
IF tag <= Srfld THEN IF tag <= Srfld THEN
obj^.mode := Fld; obj^.mode := OPM.Fld;
IF tag = Srfld THEN obj^.vis := externalR ELSE obj^.vis := external END ; IF tag = Srfld THEN obj^.vis := OPM.externalR ELSE obj^.vis := OPM.external END;
InStruct(obj^.typ); InName(obj^.name); InStruct(obj^.typ); InName(obj^.name);
obj^.adr := OPM.SymRInt() obj^.adr := OPM.SymRInt()
ELSE ELSE
obj^.mode := Fld; obj^.mode := OPM.Fld;
IF tag = Shdptr THEN obj^.name := OPM.HdPtrName ELSE obj^.name := OPM.HdProcName END; IF tag = Shdptr THEN obj^.name := OPM.HdPtrName ELSE obj^.name := OPM.HdProcName END;
obj^.typ := undftyp; obj^.vis := internal; obj^.typ := undftyp; obj^.vis := OPM.internal;
obj^.adr := OPM.SymRInt() obj^.adr := OPM.SymRInt()
END; END;
RETURN obj RETURN obj
@ -613,13 +575,13 @@ BEGIN
tag := impCtxt.nextTag; tag := impCtxt.nextTag;
obj := NewObj(); obj^.mnolev := -mno; obj := NewObj(); obj^.mnolev := -mno;
IF tag = Stpro THEN IF tag = Stpro THEN
obj^.mode := TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1; obj^.mode := OPM.TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1;
InSign(mno, obj^.typ, obj^.link); obj^.vis := external; InName(obj^.name); InSign(mno, obj^.typ, obj^.link); obj^.vis := OPM.external; InName(obj^.name);
obj^.adr := 10000H*OPM.SymRInt() obj^.adr := 10000H*OPM.SymRInt()
ELSE (* tag = Shdtpro *) ELSE (* tag = Shdtpro *)
obj^.mode := TProc; obj^.name := OPM.HdTProcName; obj^.mode := OPM.TProc; obj^.name := OPM.HdTProcName;
obj^.link := NewObj(); (* dummy, easier in Browser *) obj^.link := NewObj(); (* dummy, easier in Browser *)
obj^.typ := undftyp; obj^.vis := internal; obj^.typ := undftyp; obj^.vis := OPM.internal;
obj^.adr := 10000H*OPM.SymRInt() obj^.adr := 10000H*OPM.SymRInt()
END; END;
RETURN obj RETURN obj
@ -642,52 +604,50 @@ BEGIN
ELSE ELSE
obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := ""
END; END;
typ := NewStr(Undef, Basic) typ := NewStr(OPM.Undef, OPM.Basic)
ELSE ELSE
obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); obj^.name := name; InsertImport(obj, GlbMod[mno].right, old);
IF old # NIL THEN (* recalculate fprints to compare with old fprints *) IF old # NIL THEN (* recalculate fprints to compare with old fprints *)
FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp;
IF impCtxt.self THEN (* do not overwrite old typ *) IF impCtxt.self THEN (* do not overwrite old typ *)
typ := NewStr(Undef, Basic) typ := NewStr(OPM.Undef, OPM.Basic)
ELSE (* overwrite old typ for compatibility reason *) ELSE (* overwrite old typ for compatibility reason *)
typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0;
typ^.fpdone := FALSE; typ^.idfpdone := FALSE typ^.fpdone := FALSE; typ^.idfpdone := FALSE
END END
ELSE ELSE
typ := NewStr(Undef, Basic) typ := NewStr(OPM.Undef, OPM.Basic)
END END
END; END;
impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; impCtxt.ref[ref] := typ; impCtxt.old[ref] := old;
typ^.ref := ref + maxStruct; typ^.ref := ref + maxStruct;
(* ref >= maxStruct: not exported yet, ref used for err 155 *) (* ref >= maxStruct: not exported yet, ref used for err 155 *)
typ^.mno := mno; typ^.allocated := TRUE; typ^.mno := mno; typ^.allocated := TRUE;
typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ; typ^.strobj := obj; obj^.mode := OPM.Typ; obj^.typ := typ;
obj^.mnolev := -mno; obj^.vis := internal; (* name not visible here *) obj^.mnolev := -mno; obj^.vis := OPM.internal; (* name not visible here *)
tag := OPM.SymRInt(); tag := OPM.SymRInt();
IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END; IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END;
CASE tag OF CASE tag OF
| Sptr: | Sptr: typ^.form := OPM.Pointer; typ^.size := OPM.PointerSize;
typ^.form := Pointer; typ^.size := OPM.PointerSize;
typ^.n := 0; InStruct(typ^.BaseTyp) typ^.n := 0; InStruct(typ^.BaseTyp)
| Sarr: | Sarr: typ^.form := OPM.Comp; typ^.comp := OPM.Array;
typ^.form := Comp; typ^.comp := Array;
InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt();
typSize(typ) (* no bounds address !! *) typSize(typ) (* no bounds address !! *)
| Sdarr: | Sdarr: typ^.form := OPM.Comp; typ^.comp := OPM.DynArr; InStruct(typ^.BaseTyp);
typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); IF typ^.BaseTyp^.comp = OPM.DynArr THEN
IF typ^.BaseTyp^.comp = DynArr THEN
typ^.n := typ^.BaseTyp^.n + 1 typ^.n := typ^.BaseTyp^.n + 1
ELSE ELSE
typ^.n := 0 typ^.n := 0
END; END;
typSize(typ) typSize(typ)
| Srec: | Srec: typ^.form := OPM.Comp; typ^.comp := OPM.Record;
typ^.form := Comp; typ^.comp := Record;
InStruct(typ^.BaseTyp); InStruct(typ^.BaseTyp);
IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END;
typ.extlev := 0; t := typ.BaseTyp; typ.extlev := 0; t := typ.BaseTyp;
(* do not take extlev from base type due to possible cycles! *) (* do not take extlev from base type due to possible cycles! *)
WHILE (t # NIL) (*& (t^.BaseTyp # t)*)(*(t^.(*BaseTyp^.*)form # 0)*) DO INC(typ^.extlev); t := t.BaseTyp END; (* !!! *) WHILE (t # NIL) (*& (t^.BaseTyp # t)*)(*(t^.(*BaseTyp^.*)form # 0)*) DO
INC(typ^.extlev); t := t.BaseTyp
END; (* !!! *)
typ^.size := OPM.SymRInt(); typ^.align := OPM.SymRInt(); typ^.size := OPM.SymRInt(); typ^.align := OPM.SymRInt();
typ^.n := OPM.SymRInt(); typ^.n := OPM.SymRInt();
impCtxt.nextTag := OPM.SymRInt(); last := NIL; impCtxt.nextTag := OPM.SymRInt(); last := NIL;
@ -702,11 +662,9 @@ BEGIN
InsertImport(fld, typ^.link, dummy); InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt() impCtxt.nextTag := OPM.SymRInt()
END END
| Spro: | Spro: typ^.form := OPM.ProcTyp; typ^.size := OPM.ProcSize;
typ^.form := ProcTyp; typ^.size := OPM.ProcSize;
InSign(mno, typ^.BaseTyp, typ^.link) InSign(mno, typ^.BaseTyp, typ^.link)
ELSE ELSE OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
END; END;
IF ref = impCtxt.minr THEN IF ref = impCtxt.minr THEN
WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO
@ -718,36 +676,36 @@ END ;
t^.strobj := old; (* restore strobj *) t^.strobj := old; (* restore strobj *)
IF impCtxt.self THEN IF impCtxt.self THEN
IF old^.mnolev < 0 THEN IF old^.mnolev < 0 THEN
IF old^.history # inconsistent THEN IF old^.history # OPM.inconsistent THEN
IF old^.fprint # obj^.fprint THEN IF old^.fprint # obj^.fprint THEN
old^.history := pbmodified old^.history := OPM.pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := pvmodified old^.history := OPM.pvmodified
END END
(* ELSE remain inconsistent *) (* ELSE remain OPM.inconsistent *)
END END
ELSIF old^.fprint # obj^.fprint THEN ELSIF old^.fprint # obj^.fprint THEN
old^.history := pbmodified old^.history := OPM.pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := pvmodified old^.history := OPM.pvmodified
ELSIF old^.vis = internal THEN ELSIF old^.vis = OPM.internal THEN
old^.history := same (* may be changed to "removed" in InObj *) old^.history := OPM.same (* may be changed to "OPM.removed" in InObj *)
ELSE ELSE
old^.history := inserted (* may be changed to "same" in InObj *) old^.history := OPM.inserted (* may be changed to "OPM.same" in InObj *)
END END
ELSE ELSE
(* check private part, delay error message until really used *) (* check private part, delay error message until really used *)
IF impCtxt.pvfp[ref] # t^.pvfp THEN IF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := inconsistent old^.history := OPM.inconsistent
END; END;
IF old^.fprint # obj^.fprint THEN IF old^.fprint # obj^.fprint THEN
FPrintErr(old, 249) FPrintErr(old, 249)
END END
END END
ELSIF impCtxt.self THEN ELSIF impCtxt.self THEN
obj^.history := removed obj^.history := OPM.removed
ELSE ELSE
obj^.history := same obj^.history := OPM.same
END; END;
INC(ref) INC(ref)
END; END;
@ -763,36 +721,35 @@ END InStruct;
tag := impCtxt.nextTag; tag := impCtxt.nextTag;
IF tag = Stype THEN IF tag = Stype THEN
InStruct(typ); obj := typ^.strobj; InStruct(typ); obj := typ^.strobj;
IF ~impCtxt.self THEN obj^.vis := external END (* type name visible now, obj^.fprint already done *) IF ~impCtxt.self THEN obj^.vis := OPM.external END (* type name visible now, obj^.fprint already done *)
ELSE ELSE
obj := NewObj(); obj^.mnolev := -mno; obj^.vis := external; obj := NewObj(); obj^.mnolev := -mno; obj^.vis := OPM.external;
IF tag <= Pointer THEN (* Constant *) IF tag <= OPM.Pointer THEN (* Constant *)
obj^.mode := Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval) obj^.mode := OPM.Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval)
ELSIF tag >= Sxpro THEN ELSIF tag >= Sxpro THEN
obj^.conval := NewConst(); obj^.conval := NewConst();
obj^.conval^.intval := -1; obj^.conval^.intval := -1;
InSign(mno, obj^.typ, obj^.link); InSign(mno, obj^.typ, obj^.link);
CASE tag OF CASE tag OF
| Sxpro: obj^.mode := XProc | Sxpro: obj^.mode := OPM.XProc
| Sipro: obj^.mode := IProc | Sipro: obj^.mode := OPM.IProc
| Scpro: obj^.mode := CProc; | Scpro: obj^.mode := OPM.CProc;
ext := NewExt(); obj^.conval^.ext := ext; ext := NewExt(); obj^.conval^.ext := ext;
s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1;
WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END
ELSE ELSE OPM.LogWStr("unhandled case at OPT.InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case at OPT.InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
END END
ELSIF tag = Salias THEN ELSIF tag = Salias THEN
obj^.mode := Typ; InStruct(obj^.typ) obj^.mode := OPM.Typ; InStruct(obj^.typ)
ELSE ELSE
obj^.mode := Var; obj^.mode := OPM.Var;
IF tag = Srvar THEN obj^.vis := externalR END ; IF tag = Srvar THEN obj^.vis := OPM.externalR END;
InStruct(obj^.typ) InStruct(obj^.typ)
END; END;
InName(obj^.name) InName(obj^.name)
END; END;
FPrintObj(obj); FPrintObj(obj);
IF (obj^.mode = Var) & ((obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "")) THEN IF (obj^.mode = OPM.Var) & ((obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "")) THEN
(* compute a global fingerprint to avoid structural type equivalence for anonymous types *) (* compute a global fingerprint to avoid structural type equivalence for anonymous types *)
OPM.FPrint(impCtxt.reffp, obj^.typ^.ref - maxStruct) OPM.FPrint(impCtxt.reffp, obj^.typ^.ref - maxStruct)
END; END;
@ -801,21 +758,21 @@ END InStruct;
IF impCtxt.self THEN IF impCtxt.self THEN
IF old # NIL THEN IF old # NIL THEN
(* obj is from old symbol file, old is new declaration *) (* obj is from old symbol file, old is new declaration *)
IF old^.vis = internal THEN old^.history := removed IF old^.vis = OPM.internal THEN old^.history := OPM.removed
ELSE FPrintObj(old); (* FPrint(obj) already called *) ELSE FPrintObj(old); (* FPrint(obj) already called *)
IF obj^.fprint # old^.fprint THEN old^.history := pbmodified IF obj^.fprint # old^.fprint THEN old^.history := OPM.pbmodified
ELSIF obj^.typ^.pvfp # old^.typ^.pvfp THEN old^.history := pvmodified ELSIF obj^.typ^.pvfp # old^.typ^.pvfp THEN old^.history := OPM.pvmodified
ELSE old^.history := same ELSE old^.history := OPM.same
END END
END END
ELSE obj^.history := removed (* OutObj not called if mnolev < 0 *) ELSE obj^.history := OPM.removed (* OutObj not called if mnolev < 0 *)
END END
(* ELSE old = NIL, or file read twice, consistent, OutObj not called *) (* ELSE old = NIL, or file read twice, consistent, OutObj not called *)
END END
ELSE (* obj already inserted in InStruct *) ELSE (* obj already OPM.inserted in InStruct *)
IF impCtxt.self THEN (* obj^.mnolev = 0 *) IF impCtxt.self THEN (* obj^.mnolev = 0 *)
IF obj^.vis = internal THEN obj^.history := removed IF obj^.vis = OPM.internal THEN obj^.history := OPM.removed
ELSIF obj^.history = inserted THEN obj^.history := same ELSIF obj^.history = OPM.inserted THEN obj^.history := OPM.same
END END
(* ELSE OutObj not called for obj with mnolev < 0 *) (* ELSE OutObj not called for obj with mnolev < 0 *)
END END
@ -827,7 +784,7 @@ END InStruct;
VAR obj: Object; mno: SHORTINT; (* done used in Browser *) VAR obj: Object; mno: SHORTINT; (* done used in Browser *)
BEGIN BEGIN
IF name = "SYSTEM" THEN SYSimported := TRUE; IF name = "SYSTEM" THEN SYSimported := TRUE;
Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp Insert(aliasName, obj); obj^.mode := OPM.Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp
ELSE ELSE
impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0; impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0;
impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0; impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0;
@ -839,7 +796,7 @@ END InStruct;
obj := InObj(mno); impCtxt.nextTag := OPM.SymRInt() obj := InObj(mno); impCtxt.nextTag := OPM.SymRInt()
END; END;
Insert(aliasName, obj); Insert(aliasName, obj);
obj^.mode := Mod; obj^.scope := GlbMod[mno].right; obj^.mode := OPM.Mod; obj^.scope := GlbMod[mno].right;
GlbMod[mno].link := obj; GlbMod[mno].link := obj;
obj^.mnolev := -mno; obj^.typ := notyp; obj^.mnolev := -mno; obj^.typ := notyp;
OPM.CloseOldSym OPM.CloseOldSym
@ -874,10 +831,10 @@ END InStruct;
PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT); PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT);
VAR i, j, n: LONGINT; btyp: Struct; VAR i, j, n: LONGINT; btyp: Struct;
BEGIN BEGIN
IF typ^.comp = Record THEN OutFlds(typ^.link, adr, FALSE) IF typ^.comp = OPM.Record THEN OutFlds(typ^.link, adr, FALSE)
ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n; ELSIF typ^.comp = OPM.Array THEN btyp := typ^.BaseTyp; n := typ^.n;
WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; WHILE btyp^.comp = OPM.Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END;
IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN IF (btyp^.form = OPM.Pointer) OR (btyp^.comp = OPM.Record) THEN
j := nofhdfld; OutHdFld(btyp, fld, adr); j := nofhdfld; OutHdFld(btyp, fld, adr);
IF j # nofhdfld THEN i := 1; IF j # nofhdfld THEN i := 1;
WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
@ -885,18 +842,18 @@ END InStruct;
END END
END END
END END
ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN ELSIF OPM.ExpHdPtrFld & ((typ^.form = OPM.Pointer) OR (fld^.name = OPM.HdPtrName)) THEN
OPM.SymWInt(Shdptr); OPM.SymWInt(adr); INC(nofhdfld) OPM.SymWInt(Shdptr); OPM.SymWInt(adr); INC(nofhdfld)
ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN ELSIF OPM.ExpHdProcFld & ((typ^.form = OPM.ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN
OPM.SymWInt(Shdpro); OPM.SymWInt(adr); INC(nofhdfld) OPM.SymWInt(Shdpro); OPM.SymWInt(adr); INC(nofhdfld)
END END
END OutHdFld; END OutHdFld;
PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
BEGIN BEGIN
WHILE (fld # NIL) & (fld^.mode = Fld) DO WHILE (fld # NIL) & (fld^.mode = OPM.Fld) DO
IF (fld^.vis # internal) & visible THEN IF (fld^.vis # OPM.internal) & visible THEN
IF fld^.vis = externalR THEN OPM.SymWInt(Srfld) ELSE OPM.SymWInt(Sfld) END ; IF fld^.vis = OPM.externalR THEN OPM.SymWInt(Srfld) ELSE OPM.SymWInt(Sfld) END;
OutStr(fld^.typ); OutName(fld^.name); OPM.SymWInt(fld^.adr) OutStr(fld^.typ); OutName(fld^.name); OPM.SymWInt(fld^.adr)
ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr) ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr)
END; END;
@ -908,7 +865,7 @@ END InStruct;
BEGIN BEGIN
OutStr(result); OutStr(result);
WHILE par # NIL DO WHILE par # NIL DO
IF par^.mode = Var THEN OPM.SymWInt(Svalpar) ELSE OPM.SymWInt(Svarpar) END ; IF par^.mode = OPM.Var THEN OPM.SymWInt(Svalpar) ELSE OPM.SymWInt(Svarpar) END;
OutStr(par^.typ); OutStr(par^.typ);
OPM.SymWInt(par^.adr); OPM.SymWInt(par^.adr);
OutName(par^.name); par := par^.link OutName(par^.name); par := par^.link
@ -920,13 +877,13 @@ END InStruct;
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
OutTProcs(typ, obj^.left); OutTProcs(typ, obj^.left);
IF obj^.mode = TProc THEN IF obj^.mode = OPM.TProc THEN
IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = internal) THEN IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = OPM.internal) THEN
OPM.Mark(109, typ^.txtpos) OPM.Mark(109, typ^.txtpos)
(* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *) (* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *)
END; END;
IF OPM.ExpHdTProc OR (obj^.vis # internal) THEN IF OPM.ExpHdTProc OR (obj^.vis # OPM.internal) THEN
IF obj^.vis # internal THEN IF obj^.vis # OPM.internal THEN
OPM.SymWInt(Stpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name); OPM.SymWInt(Stpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name);
OPM.SymWInt(obj^.adr DIV 10000H) OPM.SymWInt(obj^.adr DIV 10000H)
ELSE ELSE
@ -951,36 +908,29 @@ END InStruct;
IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name); IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name);
CASE strobj^.history OF CASE strobj^.history OF
| pbmodified: FPrintErr(strobj, 252) | OPM.pbmodified: FPrintErr(strobj, 252)
| pvmodified: FPrintErr(strobj, 251) | OPM.pvmodified: FPrintErr(strobj, 251)
| inconsistent: FPrintErr(strobj, 249) | OPM.inconsistent: FPrintErr(strobj, 249)
ELSE (* checked in OutObj or correct indirect export *) ELSE (* checked in OutObj or correct indirect export *)
(* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) (* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*)
END END
ELSE OPM.SymWCh(0X) (* anonymous => never inconsistent, pvfp influences the client fp *) ELSE OPM.SymWCh(0X) (* anonymous => never OPM.inconsistent, pvfp influences the client fp *)
END; END;
IF typ^.sysflag # 0 THEN OPM.SymWInt(Ssys); OPM.SymWInt(typ^.sysflag) END; IF typ^.sysflag # 0 THEN OPM.SymWInt(Ssys); OPM.SymWInt(typ^.sysflag) END;
CASE typ^.form OF CASE typ^.form OF
| Pointer: | OPM.Pointer: OPM.SymWInt(Sptr); OutStr(typ^.BaseTyp)
OPM.SymWInt(Sptr); OutStr(typ^.BaseTyp) | OPM.ProcTyp: OPM.SymWInt(Spro); OutSign(typ^.BaseTyp, typ^.link)
| ProcTyp: | OPM.Comp: CASE typ^.comp OF
OPM.SymWInt(Spro); OutSign(typ^.BaseTyp, typ^.link) | OPM.Array: OPM.SymWInt(Sarr); OutStr(typ^.BaseTyp); OPM.SymWInt(typ^.n)
| Comp: | OPM.DynArr: OPM.SymWInt(Sdarr); OutStr(typ^.BaseTyp)
CASE typ^.comp OF | OPM.Record: OPM.SymWInt(Srec);
| 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; IF typ^.BaseTyp = NIL THEN OutStr(notyp) ELSE OutStr(typ^.BaseTyp) END;
(* BaseTyp should be Notyp, too late to change *) (* BaseTyp should be Notyp, too late to change *)
OPM.SymWInt(typ^.size); OPM.SymWInt(typ^.align); OPM.SymWInt(typ^.n); OPM.SymWInt(typ^.size); OPM.SymWInt(typ^.align); OPM.SymWInt(typ^.n);
nofhdfld := 0; OutFlds(typ^.link, 0, TRUE); nofhdfld := 0; OutFlds(typ^.link, 0, TRUE);
IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END; IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END;
OutTProcs(typ, typ^.link); OPM.SymWInt(Send) OutTProcs(typ, typ^.link); OPM.SymWInt(Send)
ELSE ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case at OPT.OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn;
END END
ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn;
END END
@ -992,19 +942,16 @@ END InStruct;
BEGIN BEGIN
f := obj^.typ^.form; OPM.SymWInt(f); f := obj^.typ^.form; OPM.SymWInt(f);
CASE f OF CASE f OF
| Bool, Char: | OPM.Bool,
OPM.SymWCh(CHR(obj^.conval^.intval)) OPM.Char: OPM.SymWCh(CHR(obj^.conval^.intval))
| SInt, Int, LInt(*, Int8, Int16, Int32, Int64*): | OPM.SInt,
OPM.SymWInt(obj^.conval^.intval) OPM.Int,
| Set: OPM.LInt: OPM.SymWInt(obj^.conval^.intval)
OPM.SymWSet(obj^.conval^.setval) | OPM.Set: OPM.SymWSet(obj^.conval^.setval)
| Real: | OPM.Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval)
rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval) | OPM.LReal: OPM.SymWLReal(obj^.conval^.realval)
| LReal: | OPM.String: OutName(obj^.conval^.ext^)
OPM.SymWLReal(obj^.conval^.realval) | OPM.NilTyp:
| String:
OutName(obj^.conval^.ext^)
| NilTyp:
ELSE err(127) ELSE err(127)
END END
END OutConstant; END OutConstant;
@ -1014,42 +961,34 @@ END InStruct;
BEGIN BEGIN
IF obj # NIL THEN IF obj # NIL THEN
OutObj(obj^.left); OutObj(obj^.left);
IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN IF obj^.mode IN {OPM.Con, OPM.Typ, OPM.Var, OPM.LProc, OPM.XProc, OPM.CProc, OPM.IProc} THEN
IF obj^.history = removed THEN FPrintErr(obj, 250) IF obj^.history = OPM.removed THEN FPrintErr(obj, 250)
ELSIF obj^.vis # internal THEN ELSIF obj^.vis # OPM.internal THEN
CASE obj^.history OF CASE obj^.history OF
| inserted: FPrintErr(obj, 253) | OPM.inserted: FPrintErr(obj, 253)
| same: (* ok *) | OPM.same: (* ok *)
| pbmodified: FPrintErr(obj, 252) | OPM.pbmodified: FPrintErr(obj, 252)
| pvmodified: FPrintErr(obj, 251) | OPM.pvmodified: FPrintErr(obj, 251)
ELSE ELSE OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn;
END; END;
CASE obj^.mode OF CASE obj^.mode OF
| Con: | OPM.Con: OutConstant(obj); OutName(obj^.name)
OutConstant(obj); OutName(obj^.name) | OPM.Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ)
| Typ:
IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ)
ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name) ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name)
END END
| Var: | OPM.Var: IF obj^.vis = OPM.externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END;
IF obj^.vis = externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END ;
OutStr(obj^.typ); OutName(obj^.name); OutStr(obj^.typ); OutName(obj^.name);
IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN
(* compute fingerprint to avoid structural type equivalence *) (* compute fingerprint to avoid structural type equivalence *)
OPM.FPrint(expCtxt.reffp, obj^.typ^.ref) OPM.FPrint(expCtxt.reffp, obj^.typ^.ref)
END END
| XProc: | OPM.XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name)
OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) | OPM.IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name)
| IProc: | OPM.CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext;
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); j := ORD(ext^[0]); i := 1; OPM.SymWInt(j);
WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END; WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END;
OutName(obj^.name) OutName(obj^.name)
ELSE ELSE OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn;
END END
END END
END; END;
@ -1090,7 +1029,7 @@ END InStruct;
PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT); PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT);
BEGIN BEGIN
typ := NewStr(form, Basic); typ^.ref := form; typ^.size := OPM.ByteSize; typ^.allocated := TRUE; typ := NewStr(form, OPM.Basic); typ^.ref := form; typ^.size := OPM.ByteSize; typ^.allocated := TRUE;
typ^.strobj := NewObj(); typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE; typ^.strobj := NewObj(); typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE;
typ^.idfp := form; typ^.idfpdone := TRUE typ^.idfp := form; typ^.idfpdone := TRUE
END InitStruct; END InitStruct;
@ -1099,14 +1038,14 @@ END InStruct;
VAR obj: Object; VAR obj: Object;
BEGIN BEGIN
Insert(name, obj); obj^.conval := NewConst(); Insert(name, obj); obj^.conval := NewConst();
obj^.mode := Con; obj^.typ := booltyp; obj^.conval^.intval := value obj^.mode := OPM.Con; obj^.typ := booltyp; obj^.conval^.intval := value
END EnterBoolConst; END EnterBoolConst;
PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct); PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct);
VAR obj: Object; typ: Struct; VAR obj: Object; typ: Struct;
BEGIN BEGIN
Insert(name, obj); Insert(name, obj);
typ := NewStr(form, Basic); obj^.mode := Typ; obj^.typ := typ; obj^.vis := external; typ := NewStr(form, OPM.Basic); obj^.mode := OPM.Typ; obj^.typ := typ; obj^.vis := OPM.external;
typ^.strobj := obj; typ^.size := size; typ^.ref := form; typ^.allocated := TRUE; typ^.strobj := obj; typ^.size := size; typ^.ref := form; typ^.allocated := TRUE;
typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE; typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE;
typ^.idfp := form; typ^.idfpdone := TRUE; res := typ typ^.idfp := form; typ^.idfpdone := TRUE; res := typ
@ -1115,78 +1054,80 @@ END InStruct;
PROCEDURE EnterProc(name: OPS.Name; num: INTEGER); PROCEDURE EnterProc(name: OPS.Name; num: INTEGER);
VAR obj: Object; VAR obj: Object;
BEGIN Insert(name, obj); BEGIN Insert(name, obj);
obj^.mode := SProc; obj^.typ := notyp; obj^.adr := num obj^.mode := OPM.SProc; obj^.typ := notyp; obj^.adr := num
END EnterProc; END EnterProc;
BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp); InitStruct(undftyp, OPM.Undef); InitStruct(notyp, OPM.NoTyp);
InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp); InitStruct(stringtyp, OPM.String); InitStruct(niltyp, OPM.NilTyp);
undftyp^.BaseTyp := undftyp; undftyp^.BaseTyp := undftyp;
(*initialization of module SYSTEM*) (*initialization of module SYSTEM*)
EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp); EnterTyp("BYTE", OPM.Byte, OPM.ByteSize, bytetyp);
(* EnterTyp("PTR", OPM.Pointer, OPM.PointerSize, sysptrtyp);
EnterTyp("INT8", Int8, OPM.Int8Size, int8typ); EnterProc("ADR", OPM.adrfn);
EnterTyp("INT16", Int16, OPM.Int16Size, int16typ); EnterProc("CC", OPM.ccfn);
EnterTyp("INT32", Int32, OPM.Int32Size, int32typ); EnterProc("LSH", OPM.lshfn);
EnterTyp("INT64", Int64, OPM.Int64Size, int64typ); EnterProc("ROT", OPM.rotfn);
*) EnterProc("GET", OPM.getfn);
EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp); EnterProc("PUT", OPM.putfn);
EnterProc("ADR", adrfn); EnterProc("GETREG", OPM.getrfn);
EnterProc("CC", ccfn); EnterProc("PUTREG", OPM.putrfn);
EnterProc("LSH", lshfn); EnterProc("BIT", OPM.bitfn);
EnterProc("ROT", rotfn); EnterProc("VAL", OPM.valfn);
EnterProc("GET", getfn); EnterProc("NEW", OPM.sysnewfn);
EnterProc("PUT", putfn); EnterProc("MOVE", OPM.movefn);
EnterProc("GETREG", getrfn);
EnterProc("PUTREG", putrfn);
EnterProc("BIT", bitfn);
EnterProc("VAL", valfn);
EnterProc("NEW", sysnewfn);
EnterProc("MOVE", movefn);
syslink := topScope^.right; syslink := topScope^.right;
universe := topScope; topScope^.right := NIL; universe := topScope; topScope^.right := NIL;
EnterTyp("CHAR", Char, OPM.CharSize, chartyp); EnterTyp("BOOLEAN", OPM.Bool, OPM.BoolSize, booltyp);
EnterTyp("SET", Set, OPM.SetSize, settyp); EnterTyp("CHAR", OPM.Char, OPM.CharSize, chartyp);
EnterTyp("REAL", Real, OPM.RealSize, realtyp); EnterTyp("SET", OPM.Set, OPM.SetSize, settyp);
EnterTyp("INTEGER", Int, OPM.IntSize, inttyp); EnterTyp("REAL", OPM.Real, OPM.RealSize, realtyp);
EnterTyp("LONGINT", LInt, OPM.LIntSize, linttyp); EnterTyp("INTEGER", OPM.Int, OPM.IntSize, inttyp);
EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp); EnterTyp("LONGINT", OPM.LInt, OPM.LIntSize, linttyp);
EnterTyp("SHORTINT", SInt, OPM.SIntSize, sinttyp); EnterTyp("LONGREAL", OPM.LReal, OPM.LRealSize, lrltyp);
EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp); EnterTyp("SHORTINT", OPM.SInt, OPM.SIntSize, sinttyp);
EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler internal representation only *)
EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler OPM.internal representation only *)
EnterBoolConst("TRUE", 1); EnterBoolConst("TRUE", 1);
EnterProc("HALT", haltfn);
EnterProc("NEW", newfn); EnterProc("HALT", OPM.haltfn);
EnterProc("ABS", absfn); EnterProc("NEW", OPM.newfn);
EnterProc("CAP", capfn); EnterProc("ABS", OPM.absfn);
EnterProc("ORD", ordfn); EnterProc("CAP", OPM.capfn);
EnterProc("ENTIER", entierfn); EnterProc("ORD", OPM.ordfn);
EnterProc("ODD", oddfn); EnterProc("ENTIER", OPM.entierfn);
EnterProc("MIN", minfn); EnterProc("ODD", OPM.oddfn);
EnterProc("MAX", maxfn); EnterProc("MIN", OPM.minfn);
EnterProc("CHR", chrfn); EnterProc("MAX", OPM.maxfn);
EnterProc("SHORT", shortfn); EnterProc("CHR", OPM.chrfn);
EnterProc("LONG", longfn); EnterProc("SHORT", OPM.shortfn);
EnterProc("SIZE", sizefn); EnterProc("LONG", OPM.longfn);
EnterProc("INC", incfn); EnterProc("SIZE", OPM.sizefn);
EnterProc("DEC", decfn); EnterProc("INC", OPM.incfn);
EnterProc("INCL", inclfn); EnterProc("DEC", OPM.decfn);
EnterProc("EXCL", exclfn); EnterProc("INCL", OPM.inclfn);
EnterProc("LEN", lenfn); EnterProc("EXCL", OPM.exclfn);
EnterProc("COPY", copyfn); EnterProc("LEN", OPM.lenfn);
EnterProc("ASH", ashfn); EnterProc("COPY", OPM.copyfn);
EnterProc("ASSERT", assertfn); EnterProc("ASH", OPM.ashfn);
impCtxt.ref[Undef] := undftyp; impCtxt.ref[Byte] := bytetyp; EnterProc("ASSERT", OPM.assertfn);
(* impCtxt.ref[Int8] := int8typ; impCtxt.ref[Int16] := int16typ;
impCtxt.ref[Int32] := int32typ; impCtxt.ref[Int64] := int64typ;*) impCtxt.ref[OPM.Undef] := undftyp;
impCtxt.ref[Bool] := booltyp; impCtxt.ref[Char] := chartyp; impCtxt.ref[OPM.Byte] := bytetyp;
impCtxt.ref[SInt] := sinttyp; impCtxt.ref[Int] := inttyp; impCtxt.ref[OPM.Bool] := booltyp;
impCtxt.ref[LInt] := linttyp; impCtxt.ref[Real] := realtyp; impCtxt.ref[OPM.Char] := chartyp;
impCtxt.ref[LReal] := lrltyp; impCtxt.ref[Set] := settyp; impCtxt.ref[OPM.SInt] := sinttyp;
impCtxt.ref[String] := stringtyp; impCtxt.ref[NilTyp] := niltyp; impCtxt.ref[OPM.Int] := inttyp;
impCtxt.ref[NoTyp] := notyp; impCtxt.ref[Pointer] := sysptrtyp 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
END OPT. END OPT.
Objects: Objects:
@ -1219,6 +1160,7 @@ Objects:
SInt Basic | SInt Basic |
Int Basic | Int Basic |
LInt Basic | LInt Basic |
XInt Basic | bits
Real Basic | Real Basic |
LReal Basic | LReal Basic |
Set Basic | Set Basic |
@ -1332,4 +1274,3 @@ stat NIL
Nreturn proc nextexpr stat (proc = NIL for mod) Nreturn proc nextexpr stat (proc = NIL for mod)
Nwith ifstat stat stat Nwith ifstat stat stat
Ntrap expr stat Ntrap expr stat

495
src/compiler/OPV.Mod
View file

File diff suppressed because it is too large Load diff