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

Update compiler source to V2.

Browse source
This commit is contained in:
David Brown 2016-06-16 13:58:01 +01:00
parent efefcf0fb4
commit efb7b6b030
9 changed files with 1023 additions and 1177 deletions
Download patch file Download diff file Expand all files Collapse all files

129
src/compiler/OPB.Mod
View file

@ -12,13 +12,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
conv = 20; abs = 21; cap = 22; odd = 23; not = 33; conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
(*SYSTEM*) (*SYSTEM*)
adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29; adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
(* object modes *) (* object modes *)
Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; 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; SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
(* Structure forms *) (* Structure forms *)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Undef = 0; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; SInt = 4; Int = 5; LInt = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
@ -29,8 +29,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
Comp = 19; Comp = 19;
*) *)
(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)19;*) Comp = (*15*)19;*)
intSet = {SInt..LInt(*, Int8..Int64*)}; realSet = {Real, LReal}; intSet = {SInt..LInt(*, Int8..Int64*)}; realSet = {Real, LReal};
@ -51,7 +51,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9; entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
(*SYSTEM function number*) (*SYSTEM function number*)
adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
@ -69,11 +69,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
typSize*: PROCEDURE(typ: OPT.Struct); typSize*: PROCEDURE(typ: OPT.Struct);
exp: INTEGER; (*side effect of log*) exp: INTEGER; (*side effect of log*)
maxExp: LONGINT; (* max n in ASH(1, n) on this machine *) maxExp: LONGINT; (* max n in ASH(1, n) on this machine *)
PROCEDURE err(n: INTEGER); PROCEDURE err(n: INTEGER);
BEGIN OPM.err(n) BEGIN OPM.err(n)
END err; END err;
PROCEDURE NewLeaf*(obj: OPT.Object): OPT.Node; PROCEDURE NewLeaf*(obj: OPT.Object): OPT.Node;
VAR node: OPT.Node; VAR node: OPT.Node;
BEGIN BEGIN
@ -94,31 +94,31 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
node^.obj := obj; node^.typ := obj^.typ; node^.obj := obj; node^.typ := obj^.typ;
RETURN node RETURN node
END NewLeaf; END NewLeaf;
PROCEDURE Construct*(class: SHORTINT; VAR x: OPT.Node; y: OPT.Node); PROCEDURE Construct*(class: SHORTINT; VAR x: OPT.Node; y: OPT.Node);
VAR node: OPT.Node; VAR node: OPT.Node;
BEGIN BEGIN
node := OPT.NewNode(class); node^.typ := OPT.notyp; node := OPT.NewNode(class); node^.typ := OPT.notyp;
node^.left := x; node^.right := y; x := node node^.left := x; node^.right := y; x := node
END Construct; END Construct;
PROCEDURE Link*(VAR x, last: OPT.Node; y: OPT.Node); PROCEDURE Link*(VAR x, last: OPT.Node; y: OPT.Node);
BEGIN BEGIN
IF x = NIL THEN x := y ELSE last^.link := y END ; IF x = NIL THEN x := y ELSE last^.link := y END ;
WHILE y^.link # NIL DO y := y^.link END ; WHILE y^.link # NIL DO y := y^.link END ;
last := y last := y
END Link; END Link;
PROCEDURE BoolToInt(b: BOOLEAN): LONGINT; PROCEDURE BoolToInt(b: BOOLEAN): LONGINT;
BEGIN BEGIN
IF b THEN RETURN 1 ELSE RETURN 0 END IF b THEN RETURN 1 ELSE RETURN 0 END
END BoolToInt; END BoolToInt;
PROCEDURE IntToBool(i: LONGINT): BOOLEAN; PROCEDURE IntToBool(i: LONGINT): BOOLEAN;
BEGIN BEGIN
IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END
END IntToBool; END IntToBool;
PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node; PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node;
VAR x: OPT.Node; VAR x: OPT.Node;
BEGIN BEGIN
@ -181,7 +181,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
x := OPT.NewNode(Nconst); x^.conval := OPT.NewConst(); x := OPT.NewNode(Nconst); x^.conval := OPT.NewConst();
x^.conval^.intval := intval; SetIntType(x); RETURN x x^.conval^.intval := intval; SetIntType(x); RETURN x
END NewIntConst; END NewIntConst;
PROCEDURE NewRealConst*(realval: LONGREAL; typ: OPT.Struct): OPT.Node; PROCEDURE NewRealConst*(realval: LONGREAL; typ: OPT.Struct): OPT.Node;
VAR x: OPT.Node; VAR x: OPT.Node;
BEGIN BEGIN
@ -198,7 +198,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
x^.conval^.ext := OPT.NewExt(); x^.conval^.ext^ := str; x^.conval^.ext := OPT.NewExt(); x^.conval^.ext^ := str;
RETURN x RETURN x
END NewString; END NewString;
PROCEDURE CharToString(n: OPT.Node); PROCEDURE CharToString(n: OPT.Node);
VAR ch: CHAR; VAR ch: CHAR;
BEGIN BEGIN
@ -248,7 +248,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
BindNodes(Nindex, typ, x, y); x^.readonly := x^.left^.readonly BindNodes(Nindex, typ, x, y); x^.readonly := x^.left^.readonly
END Index; END Index;
PROCEDURE Field*(VAR x: OPT.Node; y: OPT.Object); PROCEDURE Field*(VAR x: OPT.Node; y: OPT.Object);
BEGIN (*x^.typ^.comp = Record*) BEGIN (*x^.typ^.comp = Record*)
IF x^.class >= Nconst THEN err(77) END ; IF x^.class >= Nconst THEN err(77) END ;
@ -258,7 +258,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE err(83); x^.typ := OPT.undftyp ELSE err(83); x^.typ := OPT.undftyp
END END
END Field; END Field;
PROCEDURE TypTest*(VAR x: OPT.Node; obj: OPT.Object; guard: BOOLEAN); PROCEDURE TypTest*(VAR x: OPT.Node; obj: OPT.Object; guard: BOOLEAN);
PROCEDURE GTT(t0, t1: OPT.Struct); PROCEDURE GTT(t0, t1: OPT.Struct);
@ -297,7 +297,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
IF guard THEN x^.typ := obj^.typ ELSE x^.typ := OPT.booltyp END IF guard THEN x^.typ := obj^.typ ELSE x^.typ := OPT.booltyp END
END TypTest; END TypTest;
PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node); PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node);
VAR f: INTEGER; k: LONGINT; VAR f: INTEGER; k: LONGINT;
BEGIN f := x^.typ^.form; BEGIN f := x^.typ^.form;
@ -337,10 +337,10 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
x^.intval := OPM.ConstNotAlloc x^.intval := OPM.ConstNotAlloc
END CheckRealType; END CheckRealType;
PROCEDURE MOp*(op: SHORTINT; VAR x: OPT.Node); PROCEDURE MOp*(op: SHORTINT; VAR x: OPT.Node);
VAR f: INTEGER; typ: OPT.Struct; z: OPT.Node; VAR f: INTEGER; typ: OPT.Struct; z: OPT.Node;
PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; z: OPT.Node): OPT.Node; PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; z: OPT.Node): OPT.Node;
VAR node: OPT.Node; VAR node: OPT.Node;
BEGIN BEGIN
@ -409,9 +409,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
z^.typ := OPT.booltyp z^.typ := OPT.booltyp
| adr: (*SYSTEM.ADR*) | adr: (*SYSTEM.ADR*)
IF (z^.class = Nconst) & (f = Char) & (z^.conval^.intval >= 20H) THEN IF (z^.class = Nconst) & (f = Char) & (z^.conval^.intval >= 20H) THEN
CharToString(z); f := String CharToString(z); f := String
END ; END;
IF (z^.class < Nconst) OR (f = String) THEN z := NewOp(op, typ, z) IF (z^.class < Nconst) OR (f = String) THEN z := NewOp(op, typ, z)
ELSE err(127) ELSE err(127)
END ; END ;
@ -428,7 +428,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
x := z x := z
END MOp; END MOp;
PROCEDURE CheckPtr(x, y: OPT.Node); PROCEDURE CheckPtr(x, y: OPT.Node);
VAR g: INTEGER; p, q, t: OPT.Struct; VAR g: INTEGER; p, q, t: OPT.Struct;
BEGIN g := y^.typ^.form; BEGIN g := y^.typ^.form;
@ -641,7 +641,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
| plus: | plus:
IF f IN intSet THEN IF f IN intSet THEN
temp := (yval^.intval >= 0) & (xval^.intval <= MAX(LONGINT) - yval^.intval); temp := (yval^.intval >= 0) & (xval^.intval <= MAX(LONGINT) - yval^.intval);
IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(LONGINT) - yval^.intval) THEN IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(LONGINT) - yval^.intval) THEN
INC(xval^.intval, yval^.intval); SetIntType(x) INC(xval^.intval, yval^.intval); SetIntType(x)
ELSE err(206) ELSE err(206)
END END
@ -658,7 +658,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
| minus: | minus:
IF f IN intSet THEN IF f IN intSet THEN
IF (yval^.intval >= 0) & (xval^.intval >= MIN(LONGINT) + yval^.intval) OR IF (yval^.intval >= 0) & (xval^.intval >= MIN(LONGINT) + yval^.intval) OR
(yval^.intval < 0) & (xval^.intval <= MAX(LONGINT) + yval^.intval) THEN (yval^.intval < 0) & (xval^.intval <= MAX(LONGINT) + yval^.intval) THEN
DEC(xval^.intval, yval^.intval); SetIntType(x) DEC(xval^.intval, yval^.intval); SetIntType(x)
ELSE err(207) ELSE err(207)
END END
@ -920,7 +920,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node); PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node);
VAR k, l: LONGINT; VAR k, l: LONGINT;
BEGIN BEGIN
IF (x^.class = Ntype) OR (x^.class = Nproc) OR (y^.class = Ntype) OR (y^.class = Nproc) THEN err(126) IF (x^.class = Ntype) OR (x^.class = Nproc) OR (y^.class = Ntype) OR (y^.class = Nproc) THEN err(126)
ELSIF (x^.typ^.form IN intSet) & (y^.typ^.form IN intSet) THEN ELSIF (x^.typ^.form IN intSet) & (y^.typ^.form IN intSet) THEN
IF x^.class = Nconst THEN IF x^.class = Nconst THEN
k := x^.conval^.intval; k := x^.conval^.intval;
@ -958,7 +958,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
x^.typ := OPT.settyp x^.typ := OPT.settyp
END SetElem; END SetElem;
PROCEDURE CheckAssign(x: OPT.Struct; ynode: OPT.Node); (* x := y *) PROCEDURE CheckAssign(x: OPT.Struct; ynode: OPT.Node); (* x := y *)
VAR f, g: INTEGER; y, p, q: OPT.Struct; VAR f, g: INTEGER; y, p, q: OPT.Struct;
BEGIN BEGIN
@ -976,24 +976,24 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
CASE f OF CASE f OF
Undef, String: Undef, String:
(* | Int8: (* | Int8:
IF (ynode.typ.size > OPM.Int8Size) THEN IF (ynode.typ.size > OPM.Int8Size) THEN
IF OPM.Verbose THEN OPM.LogWStr("f of int8"); OPM.LogWLn END; IF OPM.Verbose THEN OPM.LogWStr("f of int8"); OPM.LogWLn END;
err(113) err(113)
END END
| Int16: | Int16:
IF (ynode.typ.size > OPM.Int16Size) THEN IF (ynode.typ.size > OPM.Int16Size) THEN
IF OPM.Verbose THEN OPM.LogWStr("f of int16"); OPM.LogWLn END; IF OPM.Verbose THEN OPM.LogWStr("f of int16"); OPM.LogWLn END;
err(113) err(113)
END END
| Int32: | Int32:
IF (ynode.typ.size > OPM.Int32Size) THEN IF (ynode.typ.size > OPM.Int32Size) THEN
IF OPM.Verbose THEN OPM.LogWStr("f of int32"); OPM.LogWLn END; IF OPM.Verbose THEN OPM.LogWStr("f of int32"); OPM.LogWLn END;
err(113) err(113)
END END
| Int64: | Int64:
IF ynode.typ.size > OPM.Int64Size THEN IF ynode.typ.size > OPM.Int64Size THEN
IF OPM.Verbose THEN OPM.LogWStr("f of int64"); OPM.LogWLn END; IF OPM.Verbose THEN OPM.LogWStr("f of int64"); OPM.LogWLn END;
err(113) err(113)
END*) END*)
| Byte: | Byte:
IF ~(g IN {Byte, Char, SInt}) THEN err(113) END IF ~(g IN {Byte, Char, SInt}) THEN err(113) END
@ -1034,8 +1034,18 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF x^.comp = Array THEN IF x^.comp = Array THEN
IF (ynode^.class = Nconst) & (g = Char) THEN CharToString(ynode); y := ynode^.typ; g := String END ; IF (ynode^.class = Nconst) & (g = Char) THEN CharToString(ynode); y := ynode^.typ; g := String END ;
IF x = y THEN (* ok *) IF x = y THEN (* ok *)
ELSIF (g = String) & (x^.BaseTyp = OPT.chartyp) THEN (*check length of string*) ELSIF x^.BaseTyp = OPT.chartyp THEN (* Assign to (static) ARRAY OF CHAR *)
IF ynode^.conval^.intval2 > x^.n THEN err(114) END ; IF g = String THEN (*check length of string*)
IF ynode^.conval^.intval2 > x^.n THEN err(114) END
ELSIF (y.comp IN {DynArr, Array}) & (y.BaseTyp = OPT.chartyp) THEN
(* Assignment from ARRAY OF CHAR is good.*)
ELSE err(113)
END
ELSE err(113)
END
ELSIF (x.comp = DynArr) & (x^.BaseTyp = OPT.chartyp) THEN (* Assign to dynamic ARRAY OF CHAR*)
IF (y.comp IN {DynArr, Array}) & (y.BaseTyp = OPT.chartyp) THEN
(* Assignment from ARRAY OF CHAR is good.*)
ELSE err(113) ELSE err(113)
END END
ELSIF x^.comp = Record THEN ELSIF x^.comp = Record THEN
@ -1046,7 +1056,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF q = NIL THEN err(113) END IF q = NIL THEN err(113) END
ELSE err(113) ELSE err(113)
END END
ELSE (*DynArr*) err(113) ELSE err(113)
END END
ELSE (* In case of not estimated f it would crash -- noch *) ELSE (* In case of not estimated f it would crash -- noch *)
OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn; OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
@ -1055,18 +1065,18 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
Convert(ynode, x) Convert(ynode, x)
END END
END CheckAssign; END CheckAssign;
PROCEDURE CheckLeaf(x: OPT.Node; dynArrToo: BOOLEAN); PROCEDURE CheckLeaf(x: OPT.Node; dynArrToo: BOOLEAN);
BEGIN BEGIN
(* (*
avoid unnecessary intermediate variables in voc avoid unnecessary intermediate variables in voc
IF (x^.class = Nmop) & (x^.subcl = val) THEN x := x^.left END ; IF (x^.class = Nmop) & (x^.subcl = val) THEN x := x^.left END ;
IF x^.class = Nguard THEN x := x^.left END ; (* skip last (and unique) guard *) IF x^.class = Nguard THEN x := x^.left END ; (* skip last (and unique) guard *)
IF (x^.class = Nvar) & (dynArrToo OR (x^.typ^.comp # DynArr)) THEN x^.obj^.leaf := FALSE END IF (x^.class = Nvar) & (dynArrToo OR (x^.typ^.comp # DynArr)) THEN x^.obj^.leaf := FALSE END
*) *)
END CheckLeaf; END CheckLeaf;
PROCEDURE StPar0*(VAR par0: OPT.Node; fctno: INTEGER); (* par0: first param of standard proc *) PROCEDURE StPar0*(VAR par0: OPT.Node; fctno: INTEGER); (* par0: first param of standard proc *)
VAR f: INTEGER; typ: OPT.Struct; x: OPT.Node; VAR f: INTEGER; typ: OPT.Struct; x: OPT.Node;
BEGIN x := par0; f := x^.typ^.form; BEGIN x := par0; f := x^.typ^.form;
@ -1099,7 +1109,7 @@ avoid unnecessary intermediate variables in voc
MOp(abs, x) MOp(abs, x)
| capfn: (*CAP*) | capfn: (*CAP*)
MOp(cap, x) MOp(cap, x)
| ordfn: (*ORD*) | ordfn: (*ORD*)
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
ELSIF f = Char THEN Convert(x, OPT.inttyp) ELSIF f = Char THEN Convert(x, OPT.inttyp)
ELSE err(111) ELSE err(111)
@ -1151,7 +1161,7 @@ avoid unnecessary intermediate variables in voc
END END
ELSE err(110) ELSE err(110)
END END
| chrfn: (*CHR*) | chrfn: (*CHR*)
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
ELSIF f IN {Undef, SInt..LInt(*, Int8..Int64*)} THEN Convert(x, OPT.chartyp) ELSIF f IN {Undef, SInt..LInt(*, Int8..Int64*)} THEN Convert(x, OPT.chartyp)
ELSE err(111); x^.typ := OPT.chartyp ELSE err(111); x^.typ := OPT.chartyp
@ -1177,7 +1187,7 @@ avoid unnecessary intermediate variables in voc
ELSIF f = Char THEN Convert(x, OPT.linttyp) ELSIF f = Char THEN Convert(x, OPT.linttyp)
ELSE err(111) ELSE err(111)
END END
| incfn, decfn: (*INC, DEC*) | incfn, decfn: (*INC, DEC*)
IF NotVar(x) THEN err(112) IF NotVar(x) THEN err(112)
ELSIF ~(f IN intSet) THEN err(111) ELSIF ~(f IN intSet) THEN err(111)
ELSIF x^.readonly THEN err(76) ELSIF x^.readonly THEN err(76)
@ -1248,14 +1258,14 @@ avoid unnecessary intermediate variables in voc
PROCEDURE StPar1*(VAR par0: OPT.Node; x: OPT.Node; fctno: SHORTINT); (* x: second parameter of standard proc *) PROCEDURE StPar1*(VAR par0: OPT.Node; x: OPT.Node; fctno: SHORTINT); (* x: second parameter of standard proc *)
VAR f, L: INTEGER; typ: OPT.Struct; p, t: OPT.Node; VAR f, L: INTEGER; typ: OPT.Struct; p, t: OPT.Node;
PROCEDURE NewOp(class, subcl: SHORTINT; left, right: OPT.Node): OPT.Node; PROCEDURE NewOp(class, subcl: SHORTINT; left, right: OPT.Node): OPT.Node;
VAR node: OPT.Node; VAR node: OPT.Node;
BEGIN BEGIN
node := OPT.NewNode(class); node^.subcl := subcl; node := OPT.NewNode(class); node^.subcl := subcl;
node^.left := left; node^.right := right; RETURN node node^.left := left; node^.right := right; RETURN node
END NewOp; END NewOp;
BEGIN p := par0; f := x^.typ^.form; BEGIN p := par0; f := x^.typ^.form;
CASE fctno OF CASE fctno OF
incfn, decfn: (*INC DEC*) incfn, decfn: (*INC DEC*)
@ -1465,13 +1475,15 @@ avoid unnecessary intermediate variables in voc
END ; END ;
par0 := p par0 := p
END StFct; END StFct;
PROCEDURE DynArrParCheck(ftyp, atyp: OPT.Struct; fvarpar: BOOLEAN); PROCEDURE DynArrParCheck(ftyp, atyp: OPT.Struct; fvarpar: BOOLEAN);
VAR f: INTEGER; VAR f: INTEGER;
BEGIN (* ftyp^.comp = DynArr *) BEGIN (* ftyp^.comp = DynArr *)
f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp; f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp;
IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *) IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *)
IF ~(f IN {Array, DynArr}) OR ~(atyp^.form IN {Byte..SInt(*, Int8..Int64*)}) THEN err(-301) END (* ... warning 301 *) IF ~(f IN {Array, DynArr}) OR ~(atyp^.form IN {Byte..SInt(*, Int8..Int64*)}) THEN
IF OPM.verbose IN OPM.opt THEN err(-301) END
END
ELSIF f IN {Array, DynArr} THEN ELSIF f IN {Array, DynArr} THEN
IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar) IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar)
ELSIF ftyp # atyp THEN ELSIF ftyp # atyp THEN
@ -1495,7 +1507,7 @@ avoid unnecessary intermediate variables in voc
IF x^.class = Nderef THEN x := x^.left (*undo DeRef*) ELSE (*x^.typ^.comp = Record*) err(71) END IF x^.class = Nderef THEN x := x^.left (*undo DeRef*) ELSE (*x^.typ^.comp = Record*) err(71) END
END END
END CheckReceiver; END CheckReceiver;
PROCEDURE PrepCall*(VAR x: OPT.Node; VAR fpar: OPT.Object); PROCEDURE PrepCall*(VAR x: OPT.Node; VAR fpar: OPT.Object);
BEGIN BEGIN
IF (x^.obj # NIL) & (x^.obj^.mode IN {LProc, XProc, TProc, CProc}) THEN IF (x^.obj # NIL) & (x^.obj^.mode IN {LProc, XProc, TProc, CProc}) THEN
@ -1535,7 +1547,7 @@ avoid unnecessary intermediate variables in voc
END END
END END
END Param; END Param;
PROCEDURE StaticLink*(dlev: SHORTINT); PROCEDURE StaticLink*(dlev: SHORTINT);
VAR scope: OPT.Object; VAR scope: OPT.Object;
BEGIN BEGIN
@ -1566,7 +1578,7 @@ avoid unnecessary intermediate variables in voc
x := OPT.NewNode(Nenter); x^.typ := OPT.notyp; x^.obj := proc; x := OPT.NewNode(Nenter); x^.typ := OPT.notyp; x^.obj := proc;
x^.left := procdec; x^.right := stat; procdec := x x^.left := procdec; x^.right := stat; procdec := x
END Enter; END Enter;
PROCEDURE Return*(VAR x: OPT.Node; proc: OPT.Object); PROCEDURE Return*(VAR x: OPT.Node; proc: OPT.Object);
VAR node: OPT.Node; VAR node: OPT.Node;
BEGIN BEGIN
@ -1581,7 +1593,7 @@ avoid unnecessary intermediate variables in voc
END Return; END Return;
PROCEDURE Assign*(VAR x: OPT.Node; y: OPT.Node); PROCEDURE Assign*(VAR x: OPT.Node; y: OPT.Node);
VAR z: OPT.Node; VAR z: OPT.Node; subcl: SHORTINT;
BEGIN BEGIN
IF x^.class >= Nconst THEN err(56) END ; IF x^.class >= Nconst THEN err(56) END ;
CheckAssign(x^.typ, y); CheckAssign(x^.typ, y);
@ -1599,9 +1611,16 @@ avoid unnecessary intermediate variables in voc
y^.typ := OPT.chartyp; y^.conval^.intval := 0; y^.typ := OPT.chartyp; y^.conval^.intval := 0;
Index(x, NewIntConst(0)) Index(x, NewIntConst(0))
END ; END ;
BindNodes(Nassign, OPT.notyp, x, y); x^.subcl := assign IF (x.typ.comp IN {Array, DynArr}) & (x.typ.BaseTyp = OPT.chartyp)
& (y.typ.comp IN {Array, DynArr}) & (y.typ.BaseTyp = OPT.chartyp) THEN
subcl := copyfn
ELSE
subcl := assign
END;
BindNodes(Nassign, OPT.notyp, x, y);
x^.subcl := subcl;
END Assign; END Assign;
PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct); PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct);
VAR node: OPT.Node; VAR node: OPT.Node;
BEGIN BEGIN
@ -1610,7 +1629,7 @@ avoid unnecessary intermediate variables in voc
IF inittd = NIL THEN inittd := node ELSE last^.link := node END ; IF inittd = NIL THEN inittd := node ELSE last^.link := node END ;
last := node last := node
END Inittd; END Inittd;
BEGIN BEGIN
maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp
END OPB. END OPB.

115
src/compiler/OPC.Mod
View file

@ -1,17 +1,17 @@
MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
(* C source code generator version (* C source code generator version
30.4.2000 jt, synchronized with BlackBox version, in particular 30.4.2000 jt, synchronized with BlackBox version, in particular
various promotion rules changed (long) => (LONGINT), xxxL avoided various promotion rules changed (long) => (LONGINT), xxxL avoided
*) *)
IMPORT OPT, OPM, version; IMPORT OPT, OPM, Configuration;
CONST demoVersion = FALSE; CONST demoVersion = FALSE;
CONST CONST
(* structure forms *) (* structure forms *)
Byte = 1; Bool = 2; Char = 3; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; SInt = 4; Int = 5; LInt = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
@ -23,7 +23,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Comp = 19; Comp = 19;
*) *)
(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)19;*) Comp = (*15*)19;*)
@ -184,7 +184,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.Write(Underscore) OPM.Write(Underscore)
ELSIF (obj = OPT.sysptrtyp^.strobj) OR (obj = OPT.bytetyp^.strobj) (*OR (obj = OPT.int8typ^.strobj) OR (obj = OPT.int16typ^.strobj) OR (obj = OPT.int32typ^.strobj) OR (obj = OPT.int64typ^.strobj)*) THEN ELSIF (obj = OPT.sysptrtyp^.strobj) OR (obj = OPT.bytetyp^.strobj) (*OR (obj = OPT.int8typ^.strobj) OR (obj = OPT.int16typ^.strobj) OR (obj = OPT.int32typ^.strobj) OR (obj = OPT.int64typ^.strobj)*) THEN
OPM.WriteString("SYSTEM_") OPM.WriteString("SYSTEM_")
END ; END ;
OPM.WriteStringVar(obj^.name) OPM.WriteStringVar(obj^.name)
END END
@ -257,7 +257,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END DeclareObj; END DeclareObj;
PROCEDURE Andent*(typ: OPT.Struct); (* ident of possibly anonymous record type *) PROCEDURE Andent*(typ: OPT.Struct); (* ident of possibly anonymous record type *)
BEGIN BEGIN
IF (typ^.strobj = NIL) OR (typ^.align >= 10000H) THEN IF (typ^.strobj = NIL) OR (typ^.align >= 10000H) THEN
OPM.WriteStringVar(OPM.modName); Str1("__#", typ^.align DIV 10000H) OPM.WriteStringVar(OPM.modName); Str1("__#", typ^.align DIV 10000H)
ELSE Ident(typ^.strobj) ELSE Ident(typ^.strobj)
@ -265,7 +265,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END Andent; END Andent;
PROCEDURE Undefined(obj: OPT.Object): BOOLEAN; PROCEDURE Undefined(obj: OPT.Object): BOOLEAN;
BEGIN BEGIN
(* imported anonymous types have obj^.name = ""; used e.g. for repeating inherited fields *) (* imported anonymous types have obj^.name = ""; used e.g. for repeating inherited fields *)
RETURN (obj^.mnolev >= 0) & (obj^.linkadr # 3+OPM.currFile ) & (obj^.linkadr # PredefinedType) OR (obj^.name = "") RETURN (obj^.mnolev >= 0) & (obj^.linkadr # 3+OPM.currFile ) & (obj^.linkadr # PredefinedType) OR (obj^.name = "")
END Undefined; END Undefined;
@ -302,7 +302,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString(Struct); BegBlk; OPM.WriteString(Struct); BegBlk;
BegStat; Str1("LONGINT len[#]", nofdims); EndStat; BegStat; Str1("LONGINT len[#]", nofdims); EndStat;
BegStat; NEW(obj); NEW(obj.typ); (* aux. object for easy declaration *) BegStat; NEW(obj); NEW(obj.typ); (* aux. object for easy declaration *)
obj.typ.form := Comp; obj.typ.comp := Array; obj.typ.n := 1; obj.typ.BaseTyp := typ; obj.mode := Fld; obj.name := "data"; obj.typ.form := Comp; obj.typ.comp := Array; obj.typ.n := 1; obj.typ.BaseTyp := typ; obj.mode := Fld; obj.name := "data";
obj.linkadr := UndefinedType; DeclareBase(obj); OPM.Write(Blank); DeclareObj(obj, FALSE); obj.linkadr := UndefinedType; DeclareBase(obj); OPM.Write(Blank); DeclareObj(obj, FALSE);
EndStat; EndBlk0 EndStat; EndBlk0
END END
@ -365,7 +365,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF obj^.mode = TProc THEN IF obj^.mode = TProc THEN
BegStat; BegStat;
OPM.WriteString("__INITBP("); OPM.WriteString("__INITBP(");
Ident(typ); OPM.WriteString(Comma); Ident(obj); Ident(typ); OPM.WriteString(Comma); Ident(obj);
Str1(", #)", obj^.adr DIV 10000H); Str1(", #)", obj^.adr DIV 10000H);
EndStat EndStat
END ; END ;
@ -431,7 +431,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
DeclareTProcs(obj^.left, empty); DeclareTProcs(obj^.left, empty);
IF obj^.mode = TProc THEN IF obj^.mode = TProc THEN
IF obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ; IF obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ;
IF OPM.currFile = OPM.HeaderFile THEN IF OPM.currFile = OPM.HeaderFile THEN
IF obj^.vis = external THEN IF obj^.vis = external THEN
DefineTProcTypes(obj); DefineTProcTypes(obj);
OPM.WriteString(Extern); empty := FALSE; OPM.WriteString(Extern); empty := FALSE;
@ -518,10 +518,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
WHILE field # NIL DO DefineType(field^.typ); field := field^.link END WHILE field # NIL DO DefineType(field^.typ); field := field^.link END
END END
END ; END ;
IF (obj # NIL) & Undefined(obj) THEN IF (obj # NIL) & Undefined(obj) THEN
OPM.WriteString("typedef"); OPM.WriteLn; OPM.Write(Tab); Indent(1); OPM.WriteString("typedef"); OPM.WriteLn; OPM.Write(Tab); Indent(1);
obj^.linkadr := ProcessingType; obj^.linkadr := ProcessingType;
DeclareBase(obj); OPM.Write(Blank); DeclareBase(obj); OPM.Write(Blank);
obj^.typ^.strobj := NIL; (* SG: trick to make DeclareObj declare the type *) obj^.typ^.strobj := NIL; (* SG: trick to make DeclareObj declare the type *)
DeclareObj(obj, FALSE); DeclareObj(obj, FALSE);
obj^.typ^.strobj := obj; (* SG: revert trick *) obj^.typ^.strobj := obj; (* SG: revert trick *)
@ -536,10 +536,11 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END DefineType; END DefineType;
PROCEDURE Prefixed(x: OPT.ConstExt; y: ARRAY OF CHAR): BOOLEAN; PROCEDURE Prefixed(x: OPT.ConstExt; y: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; VAR i: INTEGER; r: BOOLEAN;
BEGIN i := 0; BEGIN i := 0;
WHILE x[i+1] = y[i] DO INC(i) END ; WHILE x[i+1] = y[i] DO INC(i) END ;
RETURN y[i] = 0X r := y[i] = 0X;
RETURN r;
END Prefixed; END Prefixed;
PROCEDURE CProcDefs(obj: OPT.Object; vis: INTEGER); PROCEDURE CProcDefs(obj: OPT.Object; vis: INTEGER);
@ -550,7 +551,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
(* bug: obj.history cannot be used to cover unexported and deleted CProcs; use special flag obj.adr = 1 *) (* bug: obj.history cannot be used to cover unexported and deleted CProcs; use special flag obj.adr = 1 *)
IF (obj^.mode = CProc) & (obj^.vis >= vis) & (obj^.adr = 1) THEN IF (obj^.mode = CProc) & (obj^.vis >= vis) & (obj^.adr = 1) THEN
ext := obj.conval.ext; i := 1; ext := obj.conval.ext; i := 1;
IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN
OPM.WriteString("#define "); Ident(obj); OPM.WriteString("#define "); Ident(obj);
DeclareParams(obj^.link, TRUE); DeclareParams(obj^.link, TRUE);
OPM.Write(Tab); OPM.Write(Tab);
@ -591,7 +592,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
VAR nofptrs: LONGINT; VAR nofptrs: LONGINT;
o: OPT.Object; o: OPT.Object;
BEGIN BEGIN
BegStat; OPM.WriteString("__TDESC("); BegStat; OPM.WriteString("__TDESC(");
Andent(typ); Andent(typ);
Str1(", #", typ^.n + 1); Str1(", #) = {__TDFLDS(", NofPtrs(typ)); Str1(", #", typ^.n + 1); Str1(", #) = {__TDFLDS(", NofPtrs(typ));
OPM.Write('"'); OPM.Write('"');
@ -613,7 +614,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE Align*(VAR adr: LONGINT; base: LONGINT); PROCEDURE Align*(VAR adr: LONGINT; base: LONGINT);
BEGIN BEGIN
CASE base OF CASE base OF
| 2: INC(adr, adr MOD 2) | 2: INC(adr, adr MOD 2)
| 4: INC(adr, (-adr) MOD 4) | 4: INC(adr, (-adr) MOD 4)
| 8: INC(adr, (-adr) MOD 8) | 8: INC(adr, (-adr) MOD 8)
@ -655,9 +656,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
adr := off; Align(adr, align); adr := off; Align(adr, align);
IF (curAlign < align) & (gap - (adr - off) >= align) THEN (* preserve alignment of the enclosing struct! *) IF (curAlign < align) & (gap - (adr - off) >= align) THEN (* preserve alignment of the enclosing struct! *)
DEC(gap, (adr - off) + align); DEC(gap, (adr - off) + align);
BegStat; BegStat;
IF align = OPM.IntSize THEN OPM.WriteString("INTEGER") IF align = OPM.IntSize THEN OPM.WriteString("INTEGER")
ELSIF align = OPM.LIntSize THEN OPM.WriteString("LONGINT") ELSIF align = OPM.LIntSize THEN OPM.WriteString("LONGINT")
ELSIF align = OPM.LRealSize THEN OPM.WriteString("LONGREAL") ELSIF align = OPM.LRealSize THEN OPM.WriteString("LONGREAL")
END ; END ;
Str1(" _prvt#", n); INC(n); EndStat; Str1(" _prvt#", n); INC(n); EndStat;
@ -751,7 +752,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
ELSE ELSE
LOOP LOOP
DeclareBase(obj); DeclareBase(obj);
IF showParamNames THEN IF showParamNames THEN
OPM.Write(Blank); DeclareObj(obj, FALSE) OPM.Write(Blank); DeclareObj(obj, FALSE)
ELSE ELSE
COPY(obj^.name, name); obj^.name := ""; DeclareObj(obj, FALSE); COPY(name, obj^.name) COPY(obj^.name, name); obj^.name := ""; DeclareObj(obj, FALSE); COPY(name, obj^.name)
@ -857,30 +858,26 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE GenHeaderMsg; PROCEDURE GenHeaderMsg;
VAR i: INTEGER; VAR i: INTEGER;
BEGIN BEGIN
OPM.WriteString("/*"); OPM.WriteString(HeaderMsg); OPM.WriteString("/*"); OPM.WriteString(HeaderMsg);
OPM.Write(" "); OPM.WriteString(version.versionLong); OPM.Write (" "); (* noch *) OPM.Write(" "); OPM.WriteString(Configuration.versionLong); OPM.Write (" "); (* noch *)
FOR i := 0 TO OPM.MaxSet (*31*) DO (*noch*) FOR i := 0 TO MAX(SET) DO
IF i IN OPM.glbopt THEN IF i IN OPM.glbopt THEN
CASE i OF (* c.f. ScanOptions in OPM *) CASE i OF (* c.f. ScanOptions in OPM *)
| OPM.extsf: OPM.Write("e") | OPM.inxchk: OPM.Write("x")
| OPM.newsf: OPM.Write("s") | OPM.ranchk: OPM.Write("r")
| OPM.mainprog: OPM.Write("m") | OPM.typchk: OPM.Write("t")
| OPM.inxchk: OPM.Write("x") | OPM.newsf: OPM.Write("s")
| OPM.vcpp: OPM.Write("v") | OPM.ptrinit: OPM.Write("p")
| OPM.ranchk: OPM.Write("r") | OPM.ansi: OPM.Write("k")
| OPM.typchk: OPM.Write("t") | OPM.assert: OPM.Write("a")
| OPM.assert: OPM.Write("a") | OPM.extsf: OPM.Write("e")
| OPM.ansi: OPM.Write("k") | OPM.mainprog: OPM.Write("m")
| OPM.ptrinit: OPM.Write("p") | OPM.dontasm: OPM.Write("S")
| OPM.include0: OPM.Write("i") | OPM.dontlink: OPM.Write("c")
| OPM.lineno: OPM.Write("l") | OPM.mainlinkstat: OPM.Write("M")
| OPM.useparfile: OPM.Write("P")
| OPM.dontasm: OPM.Write("S")
| OPM.dontlink: OPM.Write("c")
| OPM.mainlinkstat: OPM.Write("M")
| OPM.notcoloroutput: OPM.Write("f") | OPM.notcoloroutput: OPM.Write("f")
| OPM.forcenewsym: OPM.Write("F") | OPM.forcenewsym: OPM.Write("F")
| OPM.verbose: OPM.Write("v") | OPM.verbose: OPM.Write("v")
ELSE ELSE
(* this else is necessary cause (* this else is necessary cause
if someone defined a new option in OPM module if someone defined a new option in OPM module
@ -888,7 +885,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
if option is passed this will if option is passed this will
generate __CASECHK and cause Halt, generate __CASECHK and cause Halt,
noch *) noch *)
OPM.LogWStr ("( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg"); OPM.LogWLn; OPM.LogWStr ("( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg"); OPM.LogWLn;
END END
END END
END; END;
@ -903,6 +900,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString("#ifndef "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn; OPM.WriteString("#ifndef "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn;
OPM.WriteString("#define "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn; OPM.WriteString("#define "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn;
OPM.WriteLn; OPM.WriteLn;
IF OPM.LIntSize = 8 THEN OPM.WriteString("#define LARGE"); OPM.WriteLn END;
Include(BasicIncludeFile); Include(BasicIncludeFile);
IncludeImports(OPT.topScope^.right, 1); OPM.WriteLn IncludeImports(OPT.topScope^.right, 1); OPM.WriteLn
END GenHdrIncludes; END GenHdrIncludes;
@ -911,6 +909,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN BEGIN
OPM.currFile := OPM.BodyFile; OPM.currFile := OPM.BodyFile;
GenHeaderMsg; GenHeaderMsg;
IF OPM.LIntSize = 8 THEN OPM.WriteString("#define LARGE"); OPM.WriteLn END;
Include(BasicIncludeFile); Include(BasicIncludeFile);
IncludeImports(OPT.topScope^.right, 0); OPM.WriteLn; IncludeImports(OPT.topScope^.right, 0); OPM.WriteLn;
DefAnonRecs(n); DefAnonRecs(n);
@ -940,8 +939,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF obj # NIL THEN IF obj # NIL THEN
InitImports(obj^.left); InitImports(obj^.left);
IF (obj^.mode = Mod) & (obj^.mnolev # 0) THEN IF (obj^.mode = Mod) & (obj^.mnolev # 0) THEN
BegStat; OPM.WriteString("__IMPORT("); BegStat; OPM.WriteString("__MODULE_IMPORT(");
OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name); OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name);
OPM.Write(CloseParen); EndStat OPM.Write(CloseParen); EndStat
END ; END ;
InitImports(obj^.right) InitImports(obj^.right)
@ -960,7 +959,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString("void EnumPtrs(void (*P)(void*))") OPM.WriteString("void EnumPtrs(void (*P)(void*))")
ELSE ELSE
OPM.WriteString("void EnumPtrs(P)"); OPM.WriteLn; OPM.WriteString("void EnumPtrs(P)"); OPM.WriteLn;
OPM.Write(Tab); OPM.WriteString("void (*P)();"); OPM.Write(Tab); OPM.WriteString("void (*P)();");
END ; END ;
OPM.WriteLn; OPM.WriteLn;
BegBlk BegBlk
@ -995,7 +994,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteLn; OPM.WriteString(Export); OPM.WriteLn; OPM.WriteString(Export);
IF mainprog THEN IF mainprog THEN
IF ansi THEN IF ansi THEN
OPM.WriteString("main(int argc, char **argv)"); OPM.WriteLn; OPM.WriteString("int main(int argc, char **argv)"); OPM.WriteLn;
ELSE ELSE
OPM.WriteString("main(argc, argv)"); OPM.WriteLn; OPM.WriteString("main(argc, argv)"); OPM.WriteLn;
OPM.Write(Tab); OPM.WriteString("int argc; char **argv;"); OPM.WriteLn OPM.Write(Tab); OPM.WriteString("int argc; char **argv;"); OPM.WriteLn
@ -1008,7 +1007,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF mainprog THEN OPM.WriteString("__INIT(argc, argv)") ELSE OPM.WriteString("__DEFMOD") END ; IF mainprog THEN OPM.WriteString("__INIT(argc, argv)") ELSE OPM.WriteString("__DEFMOD") END ;
EndStat; EndStat;
IF mainprog & demoVersion THEN BegStat; IF mainprog & demoVersion THEN BegStat;
OPM.WriteString('/*don`t do it!*/ printf("DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\n")'); OPM.WriteString('/*don`t do it!*/ printf("DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\n")');
EndStat EndStat
END ; END ;
InitImports(OPT.topScope^.right); InitImports(OPT.topScope^.right);
@ -1050,6 +1049,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF proc^.vis # external THEN OPM.WriteString(Static) END ; IF proc^.vis # external THEN OPM.WriteString(Static) END ;
ProcHeader(proc, TRUE); ProcHeader(proc, TRUE);
BegBlk; BegBlk;
(* If there will be a result, provide a result variable. *)
IF proc^.typ # OPT.notyp THEN
BegStat;
Ident(proc^.typ^.strobj);
OPM.WriteString(" _o_result;");
OPM.WriteLn;
END;
scope := proc^.scope; scope := proc^.scope;
IdentList(scope^.scope, 0); IdentList(scope^.scope, 0);
IF ~scope^.leaf THEN (* declare intermediate procedure scope record variable*) IF ~scope^.leaf THEN (* declare intermediate procedure scope record variable*)
@ -1080,7 +1088,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
var := proc^.link; var := proc^.link;
WHILE var # NIL DO (* copy value array parameters *) WHILE var # NIL DO (* copy value array parameters *)
IF (var^.typ^.comp IN {Array, DynArr}) & (var^.mode = Var) & (var^.typ^.sysflag = 0) THEN IF (var^.typ^.comp IN {Array, DynArr}) & (var^.mode = Var) & (var^.typ^.sysflag = 0) THEN
BegStat; BegStat;
IF var^.typ^.comp = Array THEN IF var^.typ^.comp = Array THEN
OPM.WriteString(DupArrFunc); OPM.WriteString(DupArrFunc);
Ident(var); OPM.WriteString(Comma); Ident(var); OPM.WriteString(Comma);
@ -1263,7 +1271,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END; END;
OPM.WriteString(Colon); OPM.WriteString(Colon);
END Case; END Case;
PROCEDURE SetInclude* (exclude: BOOLEAN); PROCEDURE SetInclude* (exclude: BOOLEAN);
BEGIN BEGIN
IF exclude THEN OPM.WriteString(" &= ~"); ELSE OPM.WriteString(" |= "); END; IF exclude THEN OPM.WriteString(" &= ~"); ELSE OPM.WriteString(" |= "); END;
@ -1286,7 +1294,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF dim # 0 THEN OPM.WriteInt(dim) END IF dim # 0 THEN OPM.WriteInt(dim) END
ELSE (* array *) ELSE (* array *)
WHILE dim > 0 DO array := array^.BaseTyp; DEC(dim) END ; WHILE dim > 0 DO array := array^.BaseTyp; DEC(dim) END ;
OPM.WriteInt(array^.n); OPM.PromoteIntConstToLInt() OPM.WriteString("((LONGINT)("); OPM.WriteInt(array^.n); OPM.WriteString("))");
END END
END Len; END Len;
@ -1313,7 +1321,6 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteInt(con^.intval) OPM.WriteInt(con^.intval)
(* | Int8, Int16, Int32, Int64: (* | Int8, Int16, Int32, Int64:
OPM.WriteInt(con^.intval)*) OPM.WriteInt(con^.intval)*)
| Real: | Real:
OPM.WriteReal(con^.realval, "f") OPM.WriteReal(con^.realval, "f")
| LReal: | LReal:
@ -1397,7 +1404,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Enter("volatile"); Enter("volatile");
Enter("while"); Enter("while");
(* what about common predefined names from cpp as e.g. (* what about common predefined names from cpp as e.g.
Operating System: ibm, gcos, os, tss and unix Operating System: ibm, gcos, os, tss and unix
Hardware: interdata, pdp11, u370, u3b, Hardware: interdata, pdp11, u370, u3b,
u3b2, u3b5, u3b15, u3b20d, u3b2, u3b5, u3b15, u3b20d,

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

File diff suppressed because it is too large Load diff

44
src/compiler/OPP.Mod
View file

@ -2,7 +2,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
IMPORT IMPORT
OPB, OPT, OPS, OPM; OPB, OPT, OPS, OPM;
CONST CONST
(* numtyp values *) (* numtyp values *)
char = 1; integer = 2; real = 3; longreal = 4; char = 1; integer = 2; real = 3; longreal = 4;
@ -27,7 +27,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
(* Structure forms *) (* Structure forms *)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Undef = 0; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; SInt = 4; Int = 5; LInt = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
@ -42,7 +42,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
Comp = (*15*)19;*) Comp = (*15*)19;*)
intSet = {SInt..LInt(*, Int8..Int64*)}; intSet = {SInt..LInt(*, Int8..Int64*)};
(* composite structure forms *) (* composite structure forms *)
Basic = 1; Array = 2; DynArr = 3; Record = 4; Basic = 1; Array = 2; DynArr = 3; Record = 4;
@ -58,7 +58,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
(* node subclasses *) (* node subclasses *)
super = 1; super = 1;
(* module visibility of objects *) (* module visibility of objects *)
internal = 0; external = 1; externalR = 2; internal = 0; external = 1; externalR = 2;
@ -70,7 +70,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
RECORD RECORD
low, high: LONGINT low, high: LONGINT
END ; END ;
VAR VAR
sym, level: SHORTINT; sym, level: SHORTINT;
LoopLevel: INTEGER; LoopLevel: INTEGER;
@ -116,7 +116,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
PROCEDURE ConstExpression(VAR x: OPT.Node); PROCEDURE ConstExpression(VAR x: OPT.Node);
BEGIN Expression(x); BEGIN Expression(x);
IF x^.class # Nconst THEN IF x^.class # Nconst THEN
err(50); x := OPB.NewIntConst(1) err(50); x := OPB.NewIntConst(1)
END END
END ConstExpression; END ConstExpression;
@ -129,7 +129,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ELSE vis := internal ELSE vis := internal
END END
END CheckMark; END CheckMark;
PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER); PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
VAR x: OPT.Node; sf: LONGINT; VAR x: OPT.Node; sf: LONGINT;
BEGIN BEGIN
@ -256,7 +256,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END END
END END
END PointerType; END PointerType;
PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct); PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct);
VAR mode: SHORTINT; VAR mode: SHORTINT;
par, first, last, res: OPT.Object; typ: OPT.Struct; par, first, last, res: OPT.Object; typ: OPT.Struct;
@ -338,7 +338,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
OPS.Get(sym) OPS.Get(sym)
END END
END TypeDecl; END TypeDecl;
PROCEDURE Type(VAR typ, banned: OPT.Struct); PROCEDURE Type(VAR typ, banned: OPT.Struct);
BEGIN TypeDecl(typ, banned); BEGIN TypeDecl(typ, banned);
IF (typ^.form = Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END IF (typ^.form = Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END
@ -443,7 +443,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END ; END ;
IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END
END StandProcCall; END StandProcCall;
PROCEDURE Element(VAR x: OPT.Node); PROCEDURE Element(VAR x: OPT.Node);
VAR y: OPT.Node; VAR y: OPT.Node;
BEGIN Expression(x); BEGIN Expression(x);
@ -469,7 +469,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END ; END ;
CheckSym(rbrace) CheckSym(rbrace)
END Sets; END Sets;
PROCEDURE Factor(VAR x: OPT.Node); PROCEDURE Factor(VAR x: OPT.Node);
VAR fpar, id: OPT.Object; apar: OPT.Node; VAR fpar, id: OPT.Object; apar: OPT.Node;
BEGIN BEGIN
@ -573,7 +573,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
CheckSym(rparen); CheckSym(rparen);
IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END
END Receiver; END Receiver;
PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN; PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN;
BEGIN BEGIN
IF (b^.form = Pointer) & (x^.form = Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ; IF (b^.form = Pointer) & (x^.form = Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ;
@ -595,7 +595,11 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0; ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
IF sym = string THEN IF sym = string THEN
WHILE OPS.str[n] # 0X DO ext[n+1] := OPS.str[n]; INC(n) END ; WHILE OPS.str[n] # 0X DO ext[n+1] := OPS.str[n]; INC(n) END ;
ext^[0] := CHR(n); OPS.Get(sym) ext^[0] := CHR(n); OPS.Get(sym);
(*
Console.String("Code procedure, length "); Console.Int(n,1); Console.Ln;
Console.String(' "'); Console.String(ext^); Console.String('"'); Console.Ln;
*)
ELSE ELSE
LOOP LOOP
IF sym = number THEN c := OPS.intval; INC(n); IF sym = number THEN c := OPS.intval; INC(n);
@ -666,7 +670,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ELSE ELSE
IF fwd # NIL THEN err(1); fwd := NIL END ; IF fwd # NIL THEN err(1); fwd := NIL END ;
OPT.OpenScope(0, NIL); OPT.topScope^.right := recTyp^.link; OPT.Insert(name, proc); OPT.OpenScope(0, NIL); OPT.topScope^.right := recTyp^.link; OPT.Insert(name, proc);
recTyp^.link := OPT.topScope^.right; OPT.CloseScope; recTyp^.link := OPT.topScope^.right; OPT.CloseScope;
END ; END ;
INC(level); OPT.OpenScope(level, proc); INC(level); OPT.OpenScope(level, proc);
OPT.Insert(objName, proc^.link); proc^.link^.mode := objMode; proc^.link^.typ := objTyp; OPT.Insert(objName, proc^.link); proc^.link^.mode := objMode; proc^.link^.typ := objTyp;
@ -685,7 +689,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ELSE err(ident) ELSE err(ident)
END END
END TProcDecl; END TProcDecl;
BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc; BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc;
IF (sym # ident) & (sym # lparen) THEN IF (sym # ident) & (sym # lparen) THEN
IF sym = times THEN (* mode set later in OPB.CheckAssign *) IF sym = times THEN (* mode set later in OPB.CheckAssign *)
@ -766,7 +770,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
PROCEDURE CasePart(VAR x: OPT.Node); PROCEDURE CasePart(VAR x: OPT.Node);
VAR n: INTEGER; low, high: LONGINT; e: BOOLEAN; VAR n: INTEGER; low, high: LONGINT; e: BOOLEAN;
tab: CaseTable; cases, lab, y, lastcase: OPT.Node; tab: CaseTable; cases, lab, y, lastcase: OPT.Node;
BEGIN BEGIN
Expression(x); pos := OPM.errpos; Expression(x); pos := OPM.errpos;
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
@ -786,8 +790,8 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ELSE low := 1; high := 0 ELSE low := 1; high := 0
END ; END ;
e := sym = else; e := sym = else;
IF e THEN OPS.Get(sym); StatSeq(y) IF e THEN OPS.Get(sym); StatSeq(y)
ELSE ELSE
y := NIL; y := NIL;
OPM.Mark(-307, OPM.curpos); (* notice about no else symbol; -- noch *) OPM.Mark(-307, OPM.curpos); (* notice about no else symbol; -- noch *)
END ; END ;
@ -796,7 +800,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
cases^.conval^.intval := low; cases^.conval^.intval2 := high; cases^.conval^.intval := low; cases^.conval^.intval2 := high;
IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END
END CasePart; END CasePart;
PROCEDURE SetPos(x: OPT.Node); PROCEDURE SetPos(x: OPT.Node);
BEGIN BEGIN
x^.conval := OPT.NewConst(); x^.conval^.intval := pos x^.conval := OPT.NewConst(); x^.conval^.intval := pos
@ -1048,7 +1052,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
OPS.Init; LoopLevel := 0; level := 0; OPS.Get(sym); OPS.Init; LoopLevel := 0; level := 0; OPS.Get(sym);
IF sym = module THEN OPS.Get(sym) ELSE err(16) END ; IF sym = module THEN OPS.Get(sym) ELSE err(16) END ;
IF sym = ident THEN IF sym = ident THEN
OPM.LogW(" "); OPM.LogWStr(OPS.name); OPM.LogWStr("compiling "); OPM.LogWStr(OPS.name); OPM.LogW(".");
OPT.Init(OPS.name, opt); OPS.Get(sym); CheckSym(semicolon); OPT.Init(OPS.name, opt); OPS.Get(sym); CheckSym(semicolon);
IF sym = import THEN OPS.Get(sym); IF sym = import THEN OPS.Get(sym);
LOOP LOOP

18
src/compiler/OPS.Mod
View file

@ -1,11 +1,11 @@
MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *) MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
IMPORT OPM; IMPORT OPM;
CONST CONST
MaxStrLen* = 256; MaxStrLen* = 256;
MaxIdLen = 256; MaxIdLen = 256;
TYPE TYPE
Name* = ARRAY MaxIdLen OF CHAR; Name* = ARRAY MaxIdLen OF CHAR;
String* = ARRAY MaxStrLen OF CHAR; String* = ARRAY MaxStrLen OF CHAR;
@ -13,12 +13,12 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
(* name, str, numtyp, intval, realval, lrlval are implicit results of Get *) (* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
VAR VAR
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 *)
intval*: LONGINT; (* integer value or string length *) intval*: LONGINT; (* integer value or string length *)
realval*: REAL; realval*: REAL;
lrlval*: LONGREAL; lrlval*: LONGREAL;
(*symbols: (*symbols:
| 0 1 2 3 4 | 0 1 2 3 4
@ -62,7 +62,7 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
PROCEDURE err(n: INTEGER); PROCEDURE err(n: INTEGER);
BEGIN OPM.err(n) BEGIN OPM.err(n)
END err; END err;
PROCEDURE Str(VAR sym: SHORTINT); PROCEDURE Str(VAR sym: SHORTINT);
VAR i: INTEGER; och: CHAR; VAR i: INTEGER; och: CHAR;
BEGIN i := 0; och := ch; BEGIN i := 0; och := ch;
@ -110,7 +110,7 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
ELSE err(2); RETURN 0 ELSE err(2); RETURN 0
END END
END Ord; END Ord;
BEGIN (* ("0" <= ch) & (ch <= "9") *) BEGIN (* ("0" <= ch) & (ch <= "9") *)
i := 0; m := 0; n := 0; d := 0; i := 0; m := 0; n := 0; d := 0;
LOOP (* read mantissa *) LOOP (* read mantissa *)

457
src/compiler/OPT.Mod
View file

@ -4,148 +4,154 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *)
2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file 2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file
*) *)
IMPORT IMPORT OPS, OPM;
OPS, OPM;
CONST CONST
MaxConstLen* = OPS.MaxStrLen; MaxConstLen* = OPS.MaxStrLen;
TYPE TYPE
Const* = POINTER TO ConstDesc; Const* = POINTER TO ConstDesc;
Object* = POINTER TO ObjDesc; Object* = POINTER TO ObjDesc;
Struct* = POINTER TO StrDesc; Struct* = POINTER TO StrDesc;
Node* = POINTER TO NodeDesc; Node* = POINTER TO NodeDesc;
ConstExt* = POINTER TO OPS.String; ConstExt* = POINTER TO OPS.String;
ConstDesc* = RECORD ConstDesc* = RECORD
ext*: ConstExt; (* string or code for code proc *) ext*: ConstExt; (* string or code for code proc *)
intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *)
intval2*: LONGINT; (* string length, proc var size or larger case label *) intval2*: LONGINT; (* string length, proc var size or larger case label *)
setval*: SET; (* constant value, procedure body present or "ELSE" present in case *) setval*: SET; (* constant value, procedure body present or "ELSE" present in case *)
realval*: LONGREAL (* real or longreal constant value *) realval*: LONGREAL (* real or longreal constant value *)
END ; END ;
ObjDesc* = RECORD ObjDesc* = RECORD
left*, right*, link*, scope*: Object; left*, right*: Object;
name*: OPS.Name; link*, scope*: Object;
leaf*: BOOLEAN; name*: OPS.Name;
mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) leaf*: BOOLEAN;
vis*: SHORTINT; (* internal, external, externalR *) mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *)
history*: SHORTINT; (* relevant if name # "" *) vis*: SHORTINT; (* internal, external, externalR *)
used*, fpdone*: BOOLEAN; history*: SHORTINT; (* relevant if name # "" *)
fprint*: LONGINT; used*, fpdone*: BOOLEAN;
typ*: Struct; fprint*: LONGINT;
conval*: Const; typ*: Struct;
adr*, linkadr*: LONGINT; conval*: Const;
x*: INTEGER (* linkadr and x can be freely used by the backend *) adr*, linkadr*: LONGINT;
END ; x*: INTEGER (* linkadr and x can be freely used by the backend *)
END ;
StrDesc* = RECORD StrDesc* = RECORD
form*, comp*, mno*, extlev*: SHORTINT; form*, comp*: SHORTINT;
ref*, sysflag*: INTEGER; mno*, extlev*: SHORTINT;
n*, size*, align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *) ref*, sysflag*: INTEGER;
allocated*, pbused*, pvused*, fpdone, idfpdone: BOOLEAN; n*, size*: LONGINT;
idfp, pbfp*, pvfp*:LONGINT; align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *)
BaseTyp*: Struct; allocated*: BOOLEAN;
link*, strobj*: Object pbused*, pvused*: BOOLEAN;
END ; fpdone, idfpdone: BOOLEAN;
idfp, pbfp*, pvfp*: LONGINT;
BaseTyp*: Struct;
link*, strobj*: Object
END ;
NodeDesc* = RECORD NodeDesc* = RECORD
left*, right*, link*: Node; left*, right*, link*: Node;
class*, subcl*: SHORTINT; class*, subcl*: SHORTINT;
readonly*: BOOLEAN; readonly*: BOOLEAN;
typ*: Struct; typ*: Struct;
obj*: Object; obj*: Object;
conval*: Const conval*: Const
END ; END ;
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 = (*20*)16; (* comp + 1 *)
VAR VAR
typSize*: PROCEDURE(typ: Struct); typSize*: PROCEDURE(typ: Struct);
topScope*: Object; topScope*: Object;
undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*, undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*,
realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*, realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*,
int8typ*, int16typ*, int32typ*, int64typ* *): Struct; int8typ*, int16typ*, int32typ*, int64typ* *): 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 *) (* object modes *)
Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; 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; SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
(* structure forms *) (* structure forms *)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Undef = 0; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; SInt = 4; Int = 5; LInt = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
Comp = 15; Comp = 15;
(*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10;
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18; Pointer = 17; ProcTyp = 18;
Comp = 19;*) Comp = 19;*)
(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Pointer = 13; ProcTyp = 14;
Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = 19;*) Comp = 19;*)
(* composite structure forms *) (* composite structure forms *)
Basic = 1; Array = 2; DynArr = 3; Record = 4; Basic = 1; Array = 2; DynArr = 3; Record = 4;
(*function number*) (*function number*)
assign = 0; assign = 0;
haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4; haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9; entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
(*SYSTEM function number*) (*SYSTEM function number*)
adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31; bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31;
(* module visibility of objects *) (* module visibility of objects *)
internal = 0; external = 1; externalR = 2; internal = 0; external = 1; externalR = 2;
(* history of imported objects *) (* history of imported objects *)
inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5; inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5;
(* symbol file items *) (* symbol file items *)
Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22; 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; 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; 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
nextTag, reffp: LONGINT; nextTag, reffp: LONGINT;
nofr, minr, nofm: INTEGER; nofr, minr, nofm: INTEGER;
self: BOOLEAN; self: BOOLEAN;
ref: ARRAY maxStruct OF Struct; ref: ARRAY maxStruct OF Struct;
old: ARRAY maxStruct OF Object; old: ARRAY maxStruct OF Object;
pvfp: ARRAY maxStruct OF LONGINT; (* set only if old # NIL *) pvfp: ARRAY maxStruct OF LONGINT; (* set only if old # NIL *)
glbmno: ARRAY maxImps OF SHORTINT (* index is local mno *) glbmno: ARRAY maxImps OF SHORTINT (* index is local mno *)
END ; END ;
ExpCtxt = RECORD ExpCtxt = RECORD
reffp: LONGINT; reffp: LONGINT;
ref: INTEGER; ref: INTEGER;
nofm: SHORTINT; nofm: SHORTINT;
locmno: ARRAY maxImps OF SHORTINT (* index is global mno *) locmno: ARRAY maxImps OF SHORTINT (* index is global mno *)
END ; END ;
VAR VAR
universe, syslink: Object; universe, syslink: Object;
impCtxt: ImpCtxt; impCtxt: ImpCtxt;
expCtxt: ExpCtxt; expCtxt: ExpCtxt;
nofhdfld: LONGINT; nofhdfld: LONGINT;
newsf, findpc, extsf, sfpresent, symExtended, symNew: BOOLEAN; newsf, findpc: BOOLEAN;
extsf, sfpresent: BOOLEAN;
symExtended, symNew: BOOLEAN;
PROCEDURE err(n: INTEGER); PROCEDURE err(n: INTEGER);
BEGIN OPM.err(n) BEGIN OPM.err(n)
@ -244,7 +250,7 @@ END Find;
PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object); PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object);
VAR obj: Object; VAR obj: Object;
BEGIN BEGIN
WHILE typ # NIL DO obj := typ^.link; WHILE typ # NIL DO obj := typ^.link;
WHILE obj # NIL DO WHILE obj # NIL DO
IF name < obj^.name THEN obj := obj^.left IF name < obj^.name THEN obj := obj^.left
@ -288,17 +294,16 @@ PROCEDURE ^IdFPrint*(typ: Struct);
PROCEDURE DebugStruct(btyp: Struct); PROCEDURE DebugStruct(btyp: Struct);
BEGIN BEGIN
OPM.LogWLn;
OPM.LogWLn; IF btyp = NIL THEN OPM.LogWStr("btyp is nil"); OPM.LogWLn END;
IF btyp = NIL THEN OPM.LogWStr("btyp is nil"); OPM.LogWLn END; OPM.LogWStr("btyp^.strobji^.name = "); OPM.LogWStr(btyp^.strobj^.name); OPM.LogWLn;
OPM.LogWStr("btyp^.strobji^.name = "); OPM.LogWStr(btyp^.strobj^.name); OPM.LogWLn; OPM.LogWStr("btyp^.form = "); OPM.LogWNum(btyp^.form, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.form = "); OPM.LogWNum(btyp^.form, 0); OPM.LogWLn; OPM.LogWStr("btyp^.comp = "); OPM.LogWNum(btyp^.comp, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.comp = "); OPM.LogWNum(btyp^.comp, 0); OPM.LogWLn; OPM.LogWStr("btyp^.mno = "); OPM.LogWNum(btyp^.mno, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.mno = "); OPM.LogWNum(btyp^.mno, 0); OPM.LogWLn; OPM.LogWStr("btyp^.extlev = "); OPM.LogWNum(btyp^.extlev, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.extlev = "); OPM.LogWNum(btyp^.extlev, 0); OPM.LogWLn; OPM.LogWStr("btyp^.size = "); OPM.LogWNum(btyp^.size, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.size = "); OPM.LogWNum(btyp^.size, 0); OPM.LogWLn; OPM.LogWStr("btyp^.align = "); OPM.LogWNum(btyp^.align, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.align = "); OPM.LogWNum(btyp^.align, 0); OPM.LogWLn; OPM.LogWStr("btyp^.txtpos = "); OPM.LogWNum(btyp^.txtpos, 0); OPM.LogWLn;
OPM.LogWStr("btyp^.txtpos = "); OPM.LogWNum(btyp^.txtpos, 0); OPM.LogWLn;
END DebugStruct; END DebugStruct;
PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object); PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object);
@ -306,8 +311,8 @@ PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object);
BEGIN BEGIN
IdFPrint(result); OPM.FPrint(fp, result^.idfp); IdFPrint(result); OPM.FPrint(fp, result^.idfp);
WHILE (par # NIL) (*& (par^.typ # NIL)*) DO (* !!! *) WHILE (par # NIL) (*& (par^.typ # NIL)*) DO (* !!! *)
OPM.FPrint(fp, par^.mode); OPM.FPrint(fp, par^.mode);
IdFPrint(par^.typ); IdFPrint(par^.typ);
OPM.FPrint(fp, par^.typ^.idfp); OPM.FPrint(fp, par^.typ^.idfp);
(* par^.name and par^.adr not considered *) (* par^.name and par^.adr not considered *)
par := par^.link par := par^.link
@ -326,7 +331,7 @@ BEGIN
END ; END ;
IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN
IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp) IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp)
ELSIF c = Array THEN ELSIF c = Array THEN
IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n) IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n)
ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link)
END ; END ;
@ -366,7 +371,7 @@ WHILE (fld # NIL) & (fld^.mode = Fld) DO
IF (fld^.vis # internal) & visible THEN IF (fld^.vis # internal) & visible THEN
OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr);
FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp) FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp)
ELSE ELSE
FPrintHdFld(fld^.typ, fld, fld^.adr + adr) FPrintHdFld(fld^.typ, fld, fld^.adr + adr)
END ; END ;
fld := fld^.link fld := fld^.link
@ -453,26 +458,26 @@ BEGIN
END END
END FPrintObj; END FPrintObj;
PROCEDURE FPrintErr*(obj: Object; errno: INTEGER); PROCEDURE FPrintErr*(obj: Object; errcode: INTEGER);
VAR i, j: INTEGER; ch: CHAR; VAR i, j: INTEGER; ch: CHAR;
BEGIN BEGIN
IF obj^.mnolev # 0 THEN IF obj^.mnolev # 0 THEN
COPY(GlbMod[-obj^.mnolev]^.name, OPM.objname); i := 0; COPY(GlbMod[-obj^.mnolev]^.name, OPM.objname); i := 0;
WHILE OPM.objname[i] # 0X DO INC(i) END ; WHILE OPM.objname[i] # 0X DO INC(i) END ;
OPM.objname[i] := "."; j := 0; INC(i); OPM.objname[i] := "."; j := 0; INC(i);
REPEAT ch := obj^.name[j]; OPM.objname[i] := ch; INC(j); INC(i) UNTIL ch = 0X; REPEAT ch := obj^.name[j]; OPM.objname[i] := ch; INC(j); INC(i) UNTIL ch = 0X;
ELSE ELSE
COPY(obj^.name, OPM.objname) COPY(obj^.name, OPM.objname)
END ; END ;
IF errno = 249 THEN IF errcode = 249 THEN
IF OPM.noerr THEN err(errno) END IF OPM.noerr THEN err(errcode) END
ELSIF errno = 253 THEN (* extension *) ELSIF errcode = 253 THEN (* extension *)
IF ~symNew & ~symExtended & ~extsf THEN err(errno) END ; IF ~symNew & ~symExtended & ~extsf THEN err(errcode) END ;
symExtended := TRUE symExtended := TRUE
ELSE ELSE
IF ~symNew & ~newsf THEN err(errno) END ; IF ~symNew & ~newsf THEN err(errcode) END ;
symNew := TRUE symNew := TRUE
END END
END FPrintErr; END FPrintErr;
(*-------------------------- Import --------------------------*) (*-------------------------- Import --------------------------*)
@ -625,20 +630,20 @@ VAR mno: SHORTINT; ref: INTEGER; tag: LONGINT; name: OPS.Name;
t: Struct; obj, last, fld, old, dummy: Object; t: Struct; obj, last, fld, old, dummy: Object;
BEGIN BEGIN
tag := OPM.SymRInt(); tag := OPM.SymRInt();
IF tag # Sstruct THEN IF tag # Sstruct THEN
typ := impCtxt.ref[-tag] typ := impCtxt.ref[-tag]
ELSE ELSE
ref := impCtxt.nofr; INC(impCtxt.nofr); ref := impCtxt.nofr; INC(impCtxt.nofr);
IF ref < impCtxt.minr THEN impCtxt.minr := ref END ; IF ref < impCtxt.minr THEN impCtxt.minr := ref END ;
InMod(mno); InName(name); obj := NewObj(); InMod(mno); InName(name); obj := NewObj();
IF name = "" THEN IF name = "" THEN
IF impCtxt.self THEN IF impCtxt.self THEN
old := NIL (* do not insert type desc anchor here, but in OPL *) old := NIL (* do not insert type desc anchor here, but in OPL *)
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(Undef, Basic)
ELSE ELSE
obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); obj^.name := name; InsertImport(obj, GlbMod[mno].right, old);
IF old # NIL THEN (* recalculate fprints to compare with old fprints *) IF old # NIL THEN (* recalculate fprints to compare with old fprints *)
FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp;
@ -648,11 +653,11 @@ BEGIN
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(Undef, Basic)
END END
END ; END ;
impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; impCtxt.ref[ref] := typ; impCtxt.old[ref] := old;
typ^.ref := ref + maxStruct; typ^.ref := ref + maxStruct;
(* ref >= maxStruct: not exported yet, ref used for err 155 *) (* ref >= maxStruct: not exported yet, ref used for err 155 *)
typ^.mno := mno; typ^.allocated := TRUE; typ^.mno := mno; typ^.allocated := TRUE;
@ -662,27 +667,27 @@ BEGIN
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 := 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 := Comp; typ^.comp := 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 := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp);
IF typ^.BaseTyp^.comp = 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 := Comp; typ^.comp := 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;
@ -692,16 +697,16 @@ BEGIN
last := fld; InsertImport(fld, typ^.link, dummy); last := fld; InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt() impCtxt.nextTag := OPM.SymRInt()
END ; END ;
WHILE impCtxt.nextTag # Send DO WHILE impCtxt.nextTag # Send DO
fld := InTProc(mno); fld := InTProc(mno);
InsertImport(fld, typ^.link, dummy); InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt() impCtxt.nextTag := OPM.SymRInt()
END END
| Spro: | Spro:
typ^.form := 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
@ -709,40 +714,40 @@ END ;
obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *) obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *)
IF obj^.name # "" THEN FPrintObj(obj) END ; IF obj^.name # "" THEN FPrintObj(obj) END ;
old := impCtxt.old[ref]; old := impCtxt.old[ref];
IF old # NIL THEN IF old # NIL THEN
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 # inconsistent THEN
IF old^.fprint # obj^.fprint THEN IF old^.fprint # obj^.fprint THEN
old^.history := pbmodified old^.history := pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := pvmodified old^.history := pvmodified
END END
(* ELSE remain inconsistent *) (* ELSE remain inconsistent *)
END END
ELSIF old^.fprint # obj^.fprint THEN ELSIF old^.fprint # obj^.fprint THEN
old^.history := pbmodified old^.history := pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := pvmodified old^.history := pvmodified
ELSIF old^.vis = internal THEN ELSIF old^.vis = internal THEN
old^.history := same (* may be changed to "removed" in InObj *) old^.history := same (* may be changed to "removed" in InObj *)
ELSE ELSE
old^.history := inserted (* may be changed to "same" in InObj *) old^.history := inserted (* may be changed to "same" in InObj *)
END END
ELSE ELSE
(* check private part, delay error message until really used *) (* check private part, delay error message until really used *)
IF impCtxt.pvfp[ref] # t^.pvfp THEN IF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := inconsistent old^.history := inconsistent
END ; END ;
IF old^.fprint # obj^.fprint THEN IF old^.fprint # obj^.fprint THEN
FPrintErr(old, 249) FPrintErr(old, 249)
END END
END END
ELSIF impCtxt.self THEN ELSIF impCtxt.self THEN
obj^.history := removed obj^.history := removed
ELSE ELSE
obj^.history := same obj^.history := same
END ; END ;
INC(ref) INC(ref)
END ; END ;
@ -774,12 +779,12 @@ END InStruct;
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 := Typ; InStruct(obj^.typ)
ELSE ELSE
obj^.mode := Var; obj^.mode := Var;
IF tag = Srvar THEN obj^.vis := externalR END ; IF tag = Srvar THEN obj^.vis := externalR END ;
InStruct(obj^.typ) InStruct(obj^.typ)
@ -852,7 +857,7 @@ END InStruct;
BEGIN i := 0; BEGIN i := 0;
REPEAT ch := name[i]; OPM.SymWCh(ch); INC(i) UNTIL ch = 0X REPEAT ch := name[i]; OPM.SymWCh(ch); INC(i) UNTIL ch = 0X
END OutName; END OutName;
PROCEDURE OutMod(mno: INTEGER); PROCEDURE OutMod(mno: INTEGER);
BEGIN BEGIN
IF expCtxt.locmno[mno] < 0 THEN (* new mod *) IF expCtxt.locmno[mno] < 0 THEN (* new mod *)
@ -950,7 +955,7 @@ END InStruct;
| pvmodified: FPrintErr(strobj, 251) | pvmodified: FPrintErr(strobj, 251)
| inconsistent: FPrintErr(strobj, 249) | inconsistent: FPrintErr(strobj, 249)
ELSE (* checked in OutObj or correct indirect export *) ELSE (* checked in OutObj or correct indirect export *)
(* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) (* OPM.LogWStr("unhandled case at 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 inconsistent, pvfp influences the client fp *)
END ; END ;
@ -974,10 +979,10 @@ END InStruct;
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
END END
END OutStr; END OutStr;
@ -1017,8 +1022,8 @@ END InStruct;
| same: (* ok *) | same: (* ok *)
| pbmodified: FPrintErr(obj, 252) | pbmodified: FPrintErr(obj, 252)
| pvmodified: FPrintErr(obj, 251) | 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: | Con:
@ -1043,8 +1048,8 @@ END InStruct;
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 ;
@ -1066,17 +1071,17 @@ END InStruct;
i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ; i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ;
OutObj(topScope^.right); OutObj(topScope^.right);
ext := sfpresent & symExtended; new := ~sfpresent OR symNew; ext := sfpresent & symExtended; new := ~sfpresent OR symNew;
IF OPM.forceNewSym THEN IF OPM.forceNewSym THEN
new := TRUE new := TRUE
END; (* for bootstrapping -- noch *) END; (* for bootstrapping -- noch *)
IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN
new := TRUE; new := TRUE;
IF ~extsf THEN err(155) END IF ~extsf THEN err(155) END
END ; END ;
newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *) newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *)
IF ~OPM.noerr OR findpc THEN IF ~OPM.noerr OR findpc THEN
OPM.DeleteNewSym OPM.DeleteNewSym
END END
(* OPM.RegisterNewSym is called in OP2 after writing the object file *) (* OPM.RegisterNewSym is called in OP2 after writing the object file *)
END END
END END
@ -1202,7 +1207,7 @@ Objects:
Mod | scope Module Mod | scope Module
Head | txtpos owner firstvar Scope anchor Head | txtpos owner firstvar Scope anchor
TProc | index sizes firstpar scope leaf Bound procedure, index = 10000H*mthno+entry, entry adr set in back-end TProc | index sizes firstpar scope leaf Bound procedure, index = 10000H*mthno+entry, entry adr set in back-end
Structures: Structures:
form comp | n BaseTyp link mno txtpos sysflag form comp | n BaseTyp link mno txtpos sysflag
@ -1238,7 +1243,7 @@ stat = NIL|Ninittd|Nenter|Nassign|Ncall|Nifelse|Ncase|Nwhile|Nrepeat|
Nloop|Nexit|Nreturn|Nwith|Ntrap. Nloop|Nexit|Nreturn|Nwith|Ntrap.
class subcl obj left right link class subcl obj left right link
--------------------------------------------------------- ---------------------------------------------------------
design Nvar var nextexpr design Nvar var nextexpr
@ -1255,7 +1260,7 @@ design Nvar var nextexpr
expr design expr design
Nconst const (val = node^.conval) Nconst const (val = node^.conval)
Nupto expr expr nextexpr Nupto expr expr nextexpr
Nmop not expr nextexpr Nmop not expr nextexpr
minus expr nextexpr minus expr nextexpr
is tsttype expr nextexpr is tsttype expr nextexpr
@ -1322,8 +1327,8 @@ stat NIL
Ncase expr casestat stat Ncase expr casestat stat
Nwhile expr stat stat Nwhile expr stat stat
Nrepeat stat expr stat Nrepeat stat expr stat
Nloop stat stat Nloop stat stat
Nexit stat Nexit stat
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

135
src/compiler/OPV.Mod
View file

@ -1,4 +1,4 @@
MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
26.7.2002 jt bug fix in Len: wrong result if called for fixed Array 26.7.2002 jt bug fix in Len: wrong result if called for fixed Array
31.1.2007 jt synchronized with BlackBox version, in particular: 31.1.2007 jt synchronized with BlackBox version, in particular:
@ -6,7 +6,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
*) *)
IMPORT OPT, OPC, OPM, OPS; IMPORT OPT, OPC, OPM, OPS;
CONST CONST
(* object modes *) (* object modes *)
Var = 1; VarPar = 2; Fld = 4; Typ = 5; LProc = 6; XProc = 7; Var = 1; VarPar = 2; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
@ -31,8 +31,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18; Pointer = 17; ProcTyp = 18;
Comp = 19;*) Comp = 19;*)
(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14;
Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)19;*) Comp = (*15*)19;*)
(* composite structure forms *) (* composite structure forms *)
@ -57,38 +57,38 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
super = 1; super = 1;
UndefinedType = 0; (* named type not yet defined *) UndefinedType = 0; (* named type not yet defined *)
ProcessingType = 1; (* pointer type is being processed *) ProcessingType = 1; (* pointer type is being processed *)
PredefinedType = 2; (* for all predefined types *) PredefinedType = 2; (* for all predefined types *)
DefinedInHdr = 3+OPM.HeaderFile; (* named type has been defined in header file *) DefinedInHdr = 3+OPM.HeaderFile; (* named type has been defined in header file *)
DefinedInBdy = 3+OPM.BodyFile; (* named type has been defined in body file *) DefinedInBdy = 3+OPM.BodyFile; (* named type has been defined in body file *)
OpenParen = "("; OpenParen = "(";
CloseParen = ")"; CloseParen = ")";
OpenBracket = "["; OpenBracket = "[";
CloseBracket = "]"; CloseBracket = "]";
Blank = " "; Blank = " ";
Comma = ", "; Comma = ", ";
Deref = "*"; Deref = "*";
EntierFunc = "__ENTIER("; EntierFunc = "__ENTIER(";
IsFunc = "__IS("; IsFunc = "__IS(";
IsPFunc = "__ISP("; IsPFunc = "__ISP(";
GuardPtrFunc = "__GUARDP("; GuardPtrFunc = "__GUARDP(";
GuardRecFunc = "__GUARDR("; GuardRecFunc = "__GUARDR(";
TypeFunc = "__TYPEOF("; TypeFunc = "__TYPEOF(";
SetOfFunc = "__SETOF("; SetOfFunc = "__SETOF(";
SetRangeFunc = "__SETRNG("; SetRangeFunc = "__SETRNG(";
CopyFunc = "__COPY("; CopyFunc = "__COPY(";
MoveFunc = "__MOVE("; MoveFunc = "__MOVE(";
GetFunc = "__GET("; GetFunc = "__GET(";
PutFunc = "__PUT("; PutFunc = "__PUT(";
DynTypExt = "__typ"; DynTypExt = "__typ";
WithChk = "__WITHCHK"; WithChk = "__WITHCHK";
Break = "break"; Break = "break";
ElseStat = "else "; ElseStat = "else ";
MinPrec = -1; MinPrec = -1;
MaxPrec = 12; MaxPrec = 12;
ProcTypeVar = 11; (* precedence number when a call is made with a proc type variable *) ProcTypeVar = 11; (* precedence number when a call is made with a proc type variable *)
internal = 0; internal = 0;
@ -145,7 +145,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF (typ^.strobj = NIL) & (typ^.align MOD 10000H = 0) THEN INC(recno); INC(base, recno * 10000H) END ; IF (typ^.strobj = NIL) & (typ^.align MOD 10000H = 0) THEN INC(recno); INC(base, recno * 10000H) END ;
typ^.size := offset; typ^.align := base; typ^.size := offset; typ^.align := base;
(* encode the trailing gap into the symbol table to allow dense packing of extended records *) (* encode the trailing gap into the symbol table to allow dense packing of extended records *)
typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H) typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H)
ELSIF c = Array THEN ELSIF c = Array THEN
TypSize(typ^.BaseTyp); TypSize(typ^.BaseTyp);
typ^.size := typ^.n * typ^.BaseTyp^.size; typ^.size := typ^.n * typ^.BaseTyp^.size;
@ -160,7 +160,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
btyp := typ^.BaseTyp; TypSize(btyp); btyp := typ^.BaseTyp; TypSize(btyp);
IF btyp^.comp = DynArr THEN typ^.size := btyp^.size + 4 (* describes dim not size *) IF btyp^.comp = DynArr THEN typ^.size := btyp^.size + 4 (* describes dim not size *)
ELSE typ^.size := 8 ELSE typ^.size := 8
END ; END
END END
END END
END TypSize; END TypSize;
@ -173,7 +173,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
mainprog := OPM.mainprog IN OPM.opt; mainprog := OPM.mainprog IN OPM.opt;
ansi := OPM.ansi IN OPM.opt ansi := OPM.ansi IN OPM.opt
END Init; END Init;
PROCEDURE ^Traverse (obj, outerScope: OPT.Object; exported: BOOLEAN); PROCEDURE ^Traverse (obj, outerScope: OPT.Object; exported: BOOLEAN);
PROCEDURE GetTProcNum(obj: OPT.Object); PROCEDURE GetTProcNum(obj: OPT.Object);
@ -284,6 +284,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
RETURN 9 RETURN 9
| is, abs, cap, odd, cc: | is, abs, cap, odd, cc:
RETURN 10 RETURN 10
ELSE
OPM.LogWStr("unhandled case in OPV.Precedence Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END END
| Ndop: | Ndop:
CASE subclass OF CASE subclass OF
@ -307,8 +309,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
RETURN 0 RETURN 0
| len, in, ash, msk, bit, lsh, rot: | len, in, ash, msk, bit, lsh, rot:
RETURN 10 RETURN 10
ELSE ELSE
OPM.LogWStr("unhandled case in OPV.Precedence, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; OPM.LogWStr("unhandled case in OPV.Precedence Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
| Nupto: | Nupto:
RETURN 10 RETURN 10
@ -355,7 +357,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF from < LInt THEN OPM.WriteString("(LONGINT)") END ; IF from < LInt THEN OPM.WriteString("(LONGINT)") END ;
Entier(n, 9) Entier(n, 9)
(*ELSIF form = Int64 THEN (*ELSIF form = Int64 THEN
IF (from >= SInt) & (from <= LInt) OR (from >= Int8) & (from < Int64) THEN OPM.WriteString("(SYSTEM_INT64)") END; IF (from >= SInt) & (from <= LInt) OR (from >= Int8) & (from < Int64) THEN OPM.WriteString("(SYSTEM_INT64)") END;
Entier(n, 9);*) Entier(n, 9);*)
ELSIF form = Int THEN ELSIF form = Int THEN
IF from < Int THEN OPM.WriteString("(int)"); expr(n, 9) IF from < Int THEN OPM.WriteString("(int)"); expr(n, 9)
@ -474,7 +476,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| Nguard: | Nguard:
typ := n^.typ; obj := n^.left^.obj; typ := n^.typ; obj := n^.left^.obj;
IF OPM.typchk IN OPM.opt THEN IF OPM.typchk IN OPM.opt THEN
IF typ^.comp = Record THEN OPM.WriteString(GuardRecFunc); IF typ^.comp = Record THEN OPM.WriteString(GuardRecFunc);
IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*) IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*)
OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj) OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj)
ELSE (*local var-par record*) ELSE (*local var-par record*)
@ -497,7 +499,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| Neguard: | Neguard:
IF OPM.typchk IN OPM.opt THEN IF OPM.typchk IN OPM.opt THEN
IF n^.left^.class = Nvarpar THEN OPM.WriteString("__GUARDEQR("); IF n^.left^.class = Nvarpar THEN OPM.WriteString("__GUARDEQR(");
OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left); OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left);
ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec) ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec)
END ; (* __GUARDEQx includes deref *) END ; (* __GUARDEQx includes deref *)
OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(")") OPM.WriteString(Comma); OPC.Ident(n^.left^.typ^.strobj); OPM.Write(")")
@ -543,14 +545,16 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSIF ansi THEN ELSIF ansi THEN
(* casting of params should be simplified eventually *) (* casting of params should be simplified eventually *)
IF (mode = VarPar) & (typ # n^.typ) & (prec = MinPrec) THEN OPM.WriteString("(void*)") END IF (mode = VarPar) & (typ # n^.typ) & (prec = MinPrec) THEN OPM.WriteString("(void*)") END
END ; END;
IF (mode = VarPar) & (n^.class = Nmop) & (n^.subcl = val) THEN expr(n^.left, prec) (* avoid cast in lvalue *) IF (mode = VarPar) & (n^.class = Nmop) & (n^.subcl = val) THEN
ELSE expr(n, prec) expr(n^.left, prec) (* avoid cast in lvalue *)
END ; ELSIF (form = LInt) & (n^.class = Nconst)
IF (form = LInt) & (n^.class = Nconst) & (n^.conval^.intval <= OPM.MaxInt) & (n^.conval^.intval >= OPM.MinInt) THEN
& (n^.conval^.intval <= OPM.MaxInt) & (n^.conval^.intval >= OPM.MinInt) THEN OPM.WriteString("((LONGINT)("); expr(n, prec); OPM.WriteString("))");
OPM.PromoteIntConstToLInt() ELSE
ELSIF (comp = Record) & (mode = VarPar) THEN expr(n, prec)
END;
IF (comp = Record) & (mode = VarPar) THEN
OPM.WriteString(", "); TypeOf(n) OPM.WriteString(", "); TypeOf(n)
ELSIF comp = DynArr THEN ELSIF comp = DynArr THEN
IF n^.class = Nconst THEN (* ap is string constant *) IF n^.class = Nconst THEN (* ap is string constant *)
@ -566,7 +570,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
WHILE aptyp^.comp = DynArr DO WHILE aptyp^.comp = DynArr DO
Len(n, dim); OPM.WriteString(" * "); INC(dim); aptyp := aptyp^.BaseTyp Len(n, dim); OPM.WriteString(" * "); INC(dim); aptyp := aptyp^.BaseTyp
END ; END ;
OPM.WriteInt(aptyp^.size); OPM.PromoteIntConstToLInt() OPM.WriteString("((LONGINT)("); OPM.WriteInt(aptyp^.size); OPM.WriteString("))");
END END
END END
END ; END ;
@ -613,7 +617,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| minus: | minus:
IF form = Set THEN OPM.Write("~") ELSE OPM.Write("-"); END ; IF form = Set THEN OPM.Write("~") ELSE OPM.Write("-"); END ;
expr(l, exprPrec) expr(l, exprPrec)
| is: | is:
typ := n^.obj^.typ; typ := n^.obj^.typ;
IF l^.typ^.comp = Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) IF l^.typ^.comp = Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj)
ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp ELSE OPM.WriteString(IsPFunc); expr(l, MinPrec); typ := typ^.BaseTyp
@ -638,7 +642,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| odd: | odd:
OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen) OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen)
| adr: (*SYSTEM*) | adr: (*SYSTEM*)
OPM.WriteString("(LONGINT)"); OPM.WriteString("(LONGINT)(uintptr_t)");
IF l^.class = Nvarpar THEN OPC.CompleteIdent(l^.obj) IF l^.class = Nvarpar THEN OPC.CompleteIdent(l^.obj)
ELSE ELSE
IF (l^.typ^.form # String) & ~(l^.typ^.comp IN {Array, DynArr}) THEN OPM.Write("&") END ; IF (l^.typ^.form # String) & ~(l^.typ^.comp IN {Array, DynArr}) THEN OPM.Write("&") END ;
@ -648,9 +652,17 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF (n^.typ^.form IN {LInt, Pointer, Set, ProcTyp}) & (l^.typ^.form IN {LInt, Pointer, Set, ProcTyp}) IF (n^.typ^.form IN {LInt, Pointer, Set, ProcTyp}) & (l^.typ^.form IN {LInt, Pointer, Set, ProcTyp})
& (n^.typ^.size = l^.typ^.size) OR ~(l^.class IN {Nvar, Nvarpar, Nfield, Nindex}) THEN & (n^.typ^.size = l^.typ^.size) OR ~(l^.class IN {Nvar, Nvarpar, Nfield, Nindex}) THEN
OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen); OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen);
IF (n^.typ^.form IN {Pointer, ProcTyp}) OR (l^.typ^.form IN {Pointer, ProcTyp}) THEN
OPM.WriteString("(uintptr_t)")
END;
expr(l, exprPrec) expr(l, exprPrec)
ELSE ELSE
OPM.WriteString("__VAL("); OPC.Ident(n^.typ^.strobj); OPM.WriteString(Comma); IF (n^.typ^.form IN {Pointer, ProcTyp}) OR (l^.typ^.form IN {Pointer, ProcTyp}) THEN
OPM.WriteString("__VALP(");
ELSE
OPM.WriteString("__VAL(");
END;
OPC.Ident(n^.typ^.strobj); OPM.WriteString(Comma);
expr(l, MinPrec); OPM.Write(CloseParen) expr(l, MinPrec); OPM.Write(CloseParen)
END END
ELSE OPM.err(200) ELSE OPM.err(200)
@ -760,7 +772,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| Ncall: | Ncall:
IF (l^.obj # NIL) & (l^.obj^.mode = TProc) THEN IF (l^.obj # NIL) & (l^.obj^.mode = TProc) THEN
IF l^.subcl = super THEN proc := SuperProc(n) IF l^.subcl = super THEN proc := SuperProc(n)
ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj) ELSE OPM.WriteString("__"); proc := OPC.BaseTProc(l^.obj)
END ; END ;
OPC.Ident(proc); OPC.Ident(proc);
n^.obj := proc^.link n^.obj := proc^.link
@ -784,7 +796,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
if := n^.left; (* name := ""; *) if := n^.left; (* name := ""; *)
WHILE if # NIL DO WHILE if # NIL DO
OPM.WriteString("if "); expr(if^.left, MaxPrec); (* if *) OPM.WriteString("if "); expr(if^.left, MaxPrec); (* if *)
OPM.Write(Blank); OPC.BegBlk; OPM.Write(Blank); OPC.BegBlk;
IF (n^.class = Nwith) & (if^.left^.left # NIL) THEN (* watch out for const expr *) IF (n^.class = Nwith) & (if^.left^.left # NIL) THEN (* watch out for const expr *)
obj := if^.left^.left^.obj; typ := obj^.typ; adr := obj^.adr; obj := if^.left^.left^.obj; typ := obj^.typ; adr := obj^.adr;
IF typ^.comp = Record THEN IF typ^.comp = Record THEN
@ -869,18 +881,18 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSIF base^.form = Pointer THEN OPM.WriteString("POINTER__typ") ELSIF base^.form = Pointer THEN OPM.WriteString("POINTER__typ")
ELSE OPM.WriteString("NIL") ELSE OPM.WriteString("NIL")
END ; END ;
OPM.WriteString(", "); OPM.WriteInt(base^.size); OPM.PromoteIntConstToLInt(); (* element size *) OPM.WriteString(", "); OPM.WriteString("((LONGINT)("); OPM.WriteInt(base^.size); OPM.WriteString("))");
OPM.WriteString(", "); OPM.WriteInt(OPC.Base(base)); (* element alignment *) OPM.WriteString(", "); OPM.WriteInt(OPC.Base(base)); (* element alignment *)
OPM.WriteString(", "); OPM.WriteInt(nofdim); (* total number of dimensions = number of additional parameters *) OPM.WriteString(", "); OPM.WriteInt(nofdim); (* total number of dimensions = number of additional parameters *)
OPM.WriteString(", "); OPM.WriteInt(nofdyn); (* number of dynamic dimensions *) OPM.WriteString(", "); OPM.WriteInt(nofdyn); (* number of dynamic dimensions *)
WHILE typ # base DO WHILE typ # base DO
OPM.WriteString(", "); OPM.WriteString(", ");
IF typ^.comp = DynArr THEN IF typ^.comp = DynArr THEN
IF x^.class = Nconst THEN expr(x, MinPrec); OPM.PromoteIntConstToLInt() IF x^.class = Nconst THEN OPM.WriteString("(LONGINT)("); expr(x, MinPrec); OPM.WriteString(")")
ELSE OPM.WriteString("(LONGINT)"); expr(x, 10) ELSE OPM.WriteString("(LONGINT)"); expr(x, 10)
END ; END ;
x := x^.link x := x^.link
ELSE OPM.WriteInt(typ^.n); OPM.PromoteIntConstToLInt() ELSE OPM.WriteString("(LONGINT)"); OPM.WriteInt(typ^.n)
END ; END ;
typ := typ^.BaseTyp typ := typ^.BaseTyp
END ; END ;
@ -1027,14 +1039,19 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF OPM.level = 0 THEN IF OPM.level = 0 THEN
IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END
ELSE ELSE
OPC.ExitProc(outerProc, FALSE, FALSE); IF n^.left # NIL THEN
OPM.WriteString("return"); (* Make local copy of result before ExitProc deletes dynamic vars *)
IF n^.left # NIL THEN OPM.Write(Blank); OPM.WriteString("_o_result = ");
IF (n^.left^.typ^.form = Pointer) & (n^.obj^.typ # n^.left^.typ) THEN IF (n^.left^.typ^.form = Pointer) & (n^.obj^.typ # n^.left^.typ) THEN
OPM.WriteString("(void*)"); expr(n^.left, 10) OPM.WriteString("(void*)"); expr(n^.left, 10)
ELSE ELSE
expr(n^.left, MinPrec) expr(n^.left, MinPrec)
END END;
OPM.WriteString(";"); OPM.WriteLn; OPC.BegStat;
OPC.ExitProc(outerProc, FALSE, FALSE);
OPM.WriteString("return _o_result");
ELSE
OPM.WriteString("return");
END END
END END
| Nwith: | Nwith:
@ -1050,7 +1067,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
when compiling Texts0.Mod on raspberry pi when compiling Texts0.Mod on raspberry pi
it generates __CASECHK and cause Halt, it generates __CASECHK and cause Halt,
noch *) noch *)
OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn; OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
END ; END ;
IF ~(n^.class IN {Nenter, Ninittd, Nifelse, Nwith, Ncase, Nwhile, Nloop}) THEN OPC.EndStat END ; IF ~(n^.class IN {Nenter, Ninittd, Nifelse, Nwith, Ncase, Nwhile, Nloop}) THEN OPC.EndStat END ;
n := n^.link n := n^.link

177
src/compiler/Vishap.Mod
View file

@ -1,37 +1,14 @@
MODULE voc; (* J. Templ 3.2.95 *) MODULE Vishap; (* J. Templ 3.2.95 *)
IMPORT IMPORT
SYSTEM, Unix, Kernel := Kernel0, SYSTEM, Heap, Platform, Configuration,
OPP, OPB, OPT, OPP, OPB, OPT,
OPV, OPC, OPM, OPV, OPC, OPM,
extTools, Strings, vt100; extTools, Strings, vt100;
VAR mname : ARRAY 256 OF CHAR; (* noch *) VAR mname : ARRAY 256 OF CHAR; (* noch *)
PROCEDURE -signal(sig: LONGINT; func: Unix.SignalHandler)
"signal(sig, func)";
PROCEDURE -fin()
"SYSTEM_FINALL()";
PROCEDURE -halt(): LONGINT
"SYSTEM_halt";
(*
PROCEDURE -gclock()
"SYSTEM_gclock = 1";
*)
PROCEDURE Trap(sig, code: LONGINT; scp: Unix.SigCtxPtr);
BEGIN fin();
IF sig = 3 THEN Unix.Exit(0)
ELSE
IF (sig = 4) & (halt() = -15) THEN OPM.LogWStr(" --- voc: internal error"); OPM.LogWLn END ;
Unix.Exit(2)
END
END Trap;
PROCEDURE Module*(VAR done: BOOLEAN); PROCEDURE Module*(VAR done: BOOLEAN);
VAR ext, new: BOOLEAN; p: OPT.Node; VAR ext, new: BOOLEAN; p: OPT.Node;
BEGIN BEGIN
@ -45,83 +22,111 @@ VAR mname : ARRAY 256 OF CHAR; (* noch *)
OPC.Init; OPC.Init;
OPV.Module(p); OPV.Module(p);
IF OPM.noerr THEN IF OPM.noerr THEN
(*IF (OPM.mainprog IN OPM.opt) & (OPM.modName # "SYSTEM") THEN*)
IF (OPM.mainProg OR OPM.mainLinkStat) & (OPM.modName # "SYSTEM") THEN IF (OPM.mainProg OR OPM.mainLinkStat) & (OPM.modName # "SYSTEM") THEN
OPM.DeleteNewSym; OPM.DeleteNewSym;
IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END; IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END;
OPM.LogWStr(" main program"); OPM.LogWStr(" Main program.");
IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
ELSE ELSE
IF new THEN IF new THEN
IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END; IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END;
OPM.LogWStr(" new symbol file"); OPM.LogWStr(" New symbol file.");
IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
OPM.RegisterNewSym OPM.RegisterNewSym
ELSIF ext THEN OPM.LogWStr(" extended symbol file"); OPM.RegisterNewSym ELSIF ext THEN
OPM.LogWStr(" Extended symbol file.");
OPM.RegisterNewSym
END END
END; END;
ELSE
OPM.DeleteNewSym
ELSE OPM.DeleteNewSym
END END
END END
END ; END;
OPM.CloseFiles; OPT.Close; OPM.CloseFiles; OPT.Close;
OPM.LogWLn; done := OPM.noerr; OPM.LogWLn;
done := OPM.noerr;
END Module; END Module;
PROCEDURE PropagateElementaryTypeSizes;
BEGIN
OPT.bytetyp.size := OPM.ByteSize;
OPT.sysptrtyp.size := OPM.PointerSize;
OPT.chartyp.size := OPM.CharSize;
OPT.settyp.size := OPM.SetSize;
OPT.realtyp.size := OPM.RealSize;
OPT.inttyp.size := OPM.IntSize;
OPT.linttyp.size := OPM.LIntSize;
OPT.lrltyp.size := OPM.LRealSize;
OPT.sinttyp.size := OPM.SIntSize;
OPT.booltyp.size := OPM.BoolSize;
END PropagateElementaryTypeSizes;
PROCEDURE Translate*; PROCEDURE Translate*;
VAR done: BOOLEAN; VAR
VAR modulesobj: ARRAY 2048 OF CHAR; (* here we hold all modules name given on the command line, to add corresponding .o files to the external compiler options *) done: BOOLEAN;
modulesobj: ARRAY 2048 OF CHAR; (* here we hold all modules name given on the command line, to add corresponding .o files to the external compiler options *)
BEGIN BEGIN
modulesobj := ""; modulesobj := "";
OPM.OpenPar; (* gclock(); slightly faste rtranslation but may lead to opening "too many files" *) IF OPM.OpenPar() THEN
OPT.bytetyp.size := OPM.ByteSize; (* gclock(); slightly faster translation but may lead to opening "too many files" *)
(*OPT.int8typ.size := 1;
OPT.int16typ.size := 2;
OPT.int32typ.size := 4;
OPT.int64typ.size := 8;*)
OPT.sysptrtyp.size := OPM.PointerSize;
OPT.chartyp.size := OPM.CharSize;
OPT.settyp.size := OPM.SetSize;
OPT.realtyp.size := OPM.RealSize;
OPT.inttyp.size := OPM.IntSize;
OPT.linttyp.size := OPM.LIntSize;
OPT.lrltyp.size := OPM.LRealSize;
OPT.sinttyp.size := OPM.SIntSize;
OPT.booltyp.size := OPM.BoolSize;
LOOP
OPM.Init(done, mname);
IF ~done THEN EXIT END ;
OPM.InitOptions;
Kernel.GC(FALSE);
Module(done);
IF ~done THEN Unix.Exit(1) END;
(* noch *) LOOP
IF done THEN OPM.Init(done, mname); (* Get next module name from command line *)
IF ~OPM.dontAsm THEN IF ~done THEN RETURN END ;
extTools.Assemble(OPM.modName);
IF ~(OPM.mainProg OR OPM.mainLinkStat) THEN Strings.Append(" ",modulesobj); Strings.Append(OPM.modName, modulesobj); Strings.Append(".o ", modulesobj) END;
IF ~OPM.dontLink & (OPM.mainProg OR OPM.mainLinkStat) THEN OPM.InitOptions; (* Get options ofr this module *)
extTools.LinkMain (OPM.modName, OPM.mainLinkStat, modulesobj); PropagateElementaryTypeSizes;
END;
END;
END
(* Compile source to .c and .h files *)
Heap.GC(FALSE);
Module(done);
IF ~done THEN
OPM.LogWLn; OPM.LogWStr("Module compilation failed."); OPM.LogWLn;
Platform.Exit(1)
END;
(* 'assemble' (i.e. c compile) .c to object or executable. *)
IF ~OPM.dontAsm THEN
END (* loop *) IF OPM.dontLink THEN
(* If not linking, just assemble each module. *)
extTools.Assemble(OPM.modName)
ELSE
IF ~(OPM.mainProg OR OPM.mainLinkStat) THEN
(* Assemble non main rogram and add object name to link list *)
extTools.Assemble(OPM.modName);
Strings.Append(" ", modulesobj);
Strings.Append(OPM.modName, modulesobj);
Strings.Append(Configuration.objext, modulesobj)
ELSE
(* Assemble and link main program *)
extTools.LinkMain (OPM.modName, OPM.mainLinkStat, modulesobj)
END
END
END
END (* loop *)
END
END Translate; END Translate;
PROCEDURE Trap(sig: INTEGER);
BEGIN
Heap.FINALL();
IF sig = 3 THEN
Platform.Exit(0)
ELSE
IF (sig = 4) & (Platform.HaltCode = -15) THEN
OPM.LogWStr(" --- Vishap Oberon: internal error");
OPM.LogWLn
END ;
Platform.Exit(2)
END
END Trap;
BEGIN BEGIN
signal(2, Trap); (* interrupt *) Platform.SetInterruptHandler(Trap);
signal(3, Trap); (* quit *) Platform.SetQuitHandler(Trap);
signal(4, Trap); (* illegal instruction, HALT *) Platform.SetBadInstructionHandler(Trap);
OPB.typSize := OPV.TypSize; OPT.typSize := OPV.TypSize; Translate OPB.typSize := OPV.TypSize; OPT.typSize := OPV.TypSize; Translate
END voc. END Vishap.

140
src/compiler/extTools.Mod
View file

@ -1,88 +1,74 @@
MODULE extTools; MODULE extTools;
IMPORT Args, Unix, Strings, Console, version;
(*
INCLUDEPATH = -Isrc/lib/system/gnuc/x86_64
CCOPT = -fPIC $(INCLUDEPATH) -g
CLOBERONOPTS = -fPIC $(INCLUDEPATH) -L. -L/usr/lib -lOberon -static -g
CC = cc $(CCOPT) -c
*)
CONST compiler="gcc";
VAR incPath0, incPath1, ccOpt, ccString, CFLAGS, tmp0, tmp1 : ARRAY 1023 OF CHAR; IMPORT Strings, Console, Configuration, Platform, OPM;
PROCEDURE Assemble*(m : ARRAY OF CHAR); VAR compilationOptions, CFLAGS: ARRAY 1023 OF CHAR;
VAR cmd : ARRAY 1023 OF CHAR;
cc : ARRAY 1023 OF CHAR;
ext : ARRAY 5 OF CHAR; PROCEDURE execute(title: ARRAY OF CHAR; cmd: ARRAY OF CHAR);
VAR r, status, exitcode: INTEGER;
BEGIN BEGIN
COPY (ccString, cc); IF OPM.Verbose THEN Console.String(title); Console.String(cmd); Console.Ln END;
Strings.Append (" -c ", cc); r := Platform.System(cmd);
COPY(cc, cmd); status := r MOD 128;
Strings.Append (" ", cmd); exitcode := r DIV 256;
Strings.Append (ccOpt, cmd); IF exitcode > 127 THEN exitcode := exitcode - 256 END; (* Handle signed exit code *)
ext := ".c";
Strings.Append (ext, m); IF r # 0 THEN
Strings.Append(m, cmd); Console.String(title); Console.String(cmd); Console.Ln;
(*Console.Ln; Console.String (cmd); Console.Ln;*) Console.String("-- failed: status "); Console.Int(status,1);
Unix.system(cmd); Console.String(", exitcode "); Console.Int(exitcode,1);
END Assemble; Console.String("."); Console.Ln;
IF (status = 0) & (exitcode = 127) THEN
Console.String("Is the C compiler in the current command path?"); Console.Ln
END;
IF status # 0 THEN Platform.Halt(status) ELSE Platform.Halt(exitcode) END
END;
END execute;
PROCEDURE LinkMain*(VAR m : ARRAY OF CHAR; statically : BOOLEAN; additionalopts : ARRAY OF CHAR); PROCEDURE Assemble*(moduleName: ARRAY OF CHAR);
VAR lpath : ARRAY 1023 OF CHAR; VAR
cc : ARRAY 1023 OF CHAR; cmd: ARRAY 1023 OF CHAR;
ccopt : ARRAY 1023 OF CHAR; BEGIN
cmd : ARRAY 1023 OF CHAR; cmd := Configuration.compile;
ext : ARRAY 5 OF CHAR; Strings.Append(compilationOptions, cmd);
BEGIN Strings.Append("-c ", cmd);
(* Strings.Append(moduleName, cmd);
gcc -g -o hello hello.c -I $RPATH/src/lib/system/gnuc/x86_64 -I. -I$RPATH -lOberon -L. -L$RPATH -static Strings.Append(".c", cmd);
*) execute("Assemble: ", cmd);
cmd := ""; END Assemble;
cc := "";
ext := ".c";
COPY(ccString, cc);
COPY (cc, cmd);
Strings.Append(" ", cmd);
Strings.Append(m, cmd);
Strings.Append(ext, cmd);
Strings.Append(additionalopts, cmd);
IF statically THEN Strings.Append(" -static ", cmd) END;
Strings.Append(" -o ", cmd);
Strings.Append(m, cmd);
Strings.Append(" ", cmd);
Strings.Append (" -lVishapOberon -L. -L", ccOpt);
Strings.Append (version.prefix, ccOpt);
Strings.Append ("/lib ", ccOpt);
Strings.Append(ccOpt, cmd); PROCEDURE LinkMain*(VAR moduleName: ARRAY OF CHAR; statically: BOOLEAN; additionalopts: ARRAY OF CHAR);
Console.Ln; Console.String(cmd); Console.Ln; (* may be it's feasible to add debug mode later *) VAR
Unix.system(cmd); cmd: ARRAY 1023 OF CHAR;
END LinkMain; BEGIN
cmd := Configuration.compile;
Strings.Append(" ", cmd);
Strings.Append(compilationOptions, cmd);
Strings.Append(moduleName, cmd);
Strings.Append(".c ", cmd);
Strings.Append(additionalopts, cmd);
IF statically THEN
Strings.Append(Configuration.staticLink, cmd)
END;
Strings.Append(Configuration.objflag, cmd);
Strings.Append(moduleName, cmd);
Strings.Append(Configuration.linkflags, cmd);
Strings.Append(Configuration.installdir, cmd);
Strings.Append('/lib"', cmd);
Strings.Append(Configuration.libspec, cmd);
execute("Assemble and link: ", cmd);
END LinkMain;
BEGIN BEGIN
Strings.Append(' -I "', compilationOptions);
incPath0 := "src/lib/system/linux/"; Strings.Append(Configuration.installdir, compilationOptions);
Strings.Append (compiler, incPath0); Strings.Append('/include" ', compilationOptions);
incPath1 := "lib/voc/obj "; Platform.GetEnv("CFLAGS", CFLAGS);
ccOpt := " -fPIC -g "; Strings.Append (CFLAGS, compilationOptions);
Strings.Append (" ", compilationOptions);
COPY ("-I ", tmp1);
Strings.Append (version.prefix, tmp1);
Strings.Append("/", tmp1);
Strings.Append(incPath0, tmp1);
Strings.Append("/", tmp1);
Strings.Append(version.arch, tmp1);
Strings.Append(" -I ", tmp1);
Strings.Append(version.prefix, tmp1);
Strings.Append("/", tmp1);
Strings.Append(incPath1, tmp1);
Strings.Append(tmp1, ccOpt);
Args.GetEnv("CFLAGS", CFLAGS);
Strings.Append (CFLAGS, ccOpt);
Strings.Append (" ", ccOpt);
ccString := compiler;
Strings.Append (" ", ccString);
END extTools. END extTools.