From efb7b6b0305be35521de51954ade53f779daf923 Mon Sep 17 00:00:00 2001 From: David Brown Date: Thu, 16 Jun 2016 13:58:01 +0100 Subject: [PATCH] Update compiler source to V2. --- src/compiler/OPB.Mod | 129 ++--- src/compiler/OPC.Mod | 115 +++-- src/compiler/OPM.cmdln.Mod | 985 +++++++++++++++---------------------- src/compiler/OPP.Mod | 44 +- src/compiler/OPS.Mod | 18 +- src/compiler/OPT.Mod | 457 ++++++++--------- src/compiler/OPV.Mod | 135 ++--- src/compiler/Vishap.Mod | 177 +++---- src/compiler/extTools.Mod | 140 +++--- 9 files changed, 1023 insertions(+), 1177 deletions(-) diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index 6e4430d0..8b7468c1 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -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; (*SYSTEM*) adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29; - + (* object modes *) 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; (* Structure forms *) - Undef = 0; Byte = 1; Bool = 2; Char = 3; + Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; @@ -29,8 +29,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) Comp = 19; *) (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; - Pointer = 13; ProcTyp = 14; - Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + Pointer = 13; ProcTyp = 14; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; Comp = (*15*)19;*) 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; shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; - + (*SYSTEM function number*) adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; @@ -69,11 +69,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) typSize*: PROCEDURE(typ: OPT.Struct); exp: INTEGER; (*side effect of log*) maxExp: LONGINT; (* max n in ASH(1, n) on this machine *) - + PROCEDURE err(n: INTEGER); BEGIN OPM.err(n) END err; - + PROCEDURE NewLeaf*(obj: OPT.Object): OPT.Node; VAR node: OPT.Node; 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; RETURN node END NewLeaf; - + PROCEDURE Construct*(class: SHORTINT; VAR x: OPT.Node; y: OPT.Node); VAR node: OPT.Node; BEGIN node := OPT.NewNode(class); node^.typ := OPT.notyp; node^.left := x; node^.right := y; x := node END Construct; - + PROCEDURE Link*(VAR x, last: OPT.Node; y: OPT.Node); BEGIN IF x = NIL THEN x := y ELSE last^.link := y END ; WHILE y^.link # NIL DO y := y^.link END ; last := y END Link; - + PROCEDURE BoolToInt(b: BOOLEAN): LONGINT; BEGIN IF b THEN RETURN 1 ELSE RETURN 0 END END BoolToInt; - + PROCEDURE IntToBool(i: LONGINT): BOOLEAN; BEGIN IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END END IntToBool; - + PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node; VAR x: OPT.Node; 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^.conval^.intval := intval; SetIntType(x); RETURN x END NewIntConst; - + PROCEDURE NewRealConst*(realval: LONGREAL; typ: OPT.Struct): OPT.Node; VAR x: OPT.Node; 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; RETURN x END NewString; - + PROCEDURE CharToString(n: OPT.Node); VAR ch: CHAR; BEGIN @@ -248,7 +248,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; BindNodes(Nindex, typ, x, y); x^.readonly := x^.left^.readonly END Index; - + PROCEDURE Field*(VAR x: OPT.Node; y: OPT.Object); BEGIN (*x^.typ^.comp = Record*) 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 END END Field; - + PROCEDURE TypTest*(VAR x: OPT.Node; obj: OPT.Object; guard: BOOLEAN); 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 ; IF guard THEN x^.typ := obj^.typ ELSE x^.typ := OPT.booltyp END END TypTest; - + PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node); VAR f: INTEGER; k: LONGINT; BEGIN f := x^.typ^.form; @@ -337,10 +337,10 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; x^.intval := OPM.ConstNotAlloc END CheckRealType; - + PROCEDURE MOp*(op: SHORTINT; VAR x: OPT.Node); VAR f: INTEGER; typ: OPT.Struct; z: OPT.Node; - + PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; z: OPT.Node): OPT.Node; VAR node: OPT.Node; BEGIN @@ -409,9 +409,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; z^.typ := OPT.booltyp | adr: (*SYSTEM.ADR*) - IF (z^.class = Nconst) & (f = Char) & (z^.conval^.intval >= 20H) THEN - CharToString(z); f := String - END ; + IF (z^.class = Nconst) & (f = Char) & (z^.conval^.intval >= 20H) THEN + CharToString(z); f := String + END; IF (z^.class < Nconst) OR (f = String) THEN z := NewOp(op, typ, z) ELSE err(127) END ; @@ -428,7 +428,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; x := z END MOp; - + PROCEDURE CheckPtr(x, y: OPT.Node); VAR g: INTEGER; p, q, t: OPT.Struct; BEGIN g := y^.typ^.form; @@ -641,7 +641,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) | plus: IF f IN intSet THEN temp := (yval^.intval >= 0) & (xval^.intval <= MAX(LONGINT) - yval^.intval); - IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(LONGINT) - yval^.intval) THEN + IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(LONGINT) - yval^.intval) THEN INC(xval^.intval, yval^.intval); SetIntType(x) ELSE err(206) END @@ -658,7 +658,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) | minus: IF f IN intSet THEN 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) ELSE err(207) 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); VAR k, l: LONGINT; 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 IF x^.class = Nconst THEN k := x^.conval^.intval; @@ -958,7 +958,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; x^.typ := OPT.settyp END SetElem; - + PROCEDURE CheckAssign(x: OPT.Struct; ynode: OPT.Node); (* x := y *) VAR f, g: INTEGER; y, p, q: OPT.Struct; BEGIN @@ -976,24 +976,24 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) CASE f OF Undef, String: (* | 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; - err(113) + err(113) END | 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; - err(113) + err(113) END | 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; - err(113) + err(113) END | 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; - err(113) + err(113) END*) | Byte: 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 (ynode^.class = Nconst) & (g = Char) THEN CharToString(ynode); y := ynode^.typ; g := String END ; IF x = y THEN (* ok *) - ELSIF (g = String) & (x^.BaseTyp = OPT.chartyp) THEN (*check length of string*) - IF ynode^.conval^.intval2 > x^.n THEN err(114) END ; + ELSIF x^.BaseTyp = OPT.chartyp THEN (* Assign to (static) ARRAY OF CHAR *) + 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) END 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 ELSE err(113) END - ELSE (*DynArr*) err(113) + ELSE err(113) END 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; @@ -1055,18 +1065,18 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) Convert(ynode, x) END END CheckAssign; - + PROCEDURE CheckLeaf(x: OPT.Node; dynArrToo: BOOLEAN); 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 = 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 *) END CheckLeaf; - + PROCEDURE StPar0*(VAR par0: OPT.Node; fctno: INTEGER); (* par0: first param of standard proc *) VAR f: INTEGER; typ: OPT.Struct; x: OPT.Node; BEGIN x := par0; f := x^.typ^.form; @@ -1099,7 +1109,7 @@ avoid unnecessary intermediate variables in voc MOp(abs, x) | capfn: (*CAP*) MOp(cap, x) - | ordfn: (*ORD*) + | ordfn: (*ORD*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) ELSIF f = Char THEN Convert(x, OPT.inttyp) ELSE err(111) @@ -1151,7 +1161,7 @@ avoid unnecessary intermediate variables in voc END ELSE err(110) END - | chrfn: (*CHR*) + | chrfn: (*CHR*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) ELSIF f IN {Undef, SInt..LInt(*, Int8..Int64*)} THEN Convert(x, 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) ELSE err(111) END - | incfn, decfn: (*INC, DEC*) + | incfn, decfn: (*INC, DEC*) IF NotVar(x) THEN err(112) ELSIF ~(f IN intSet) THEN err(111) 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 *) VAR f, L: INTEGER; typ: OPT.Struct; p, t: OPT.Node; - + PROCEDURE NewOp(class, subcl: SHORTINT; left, right: OPT.Node): OPT.Node; VAR node: OPT.Node; BEGIN node := OPT.NewNode(class); node^.subcl := subcl; node^.left := left; node^.right := right; RETURN node END NewOp; - + BEGIN p := par0; f := x^.typ^.form; CASE fctno OF incfn, decfn: (*INC DEC*) @@ -1465,13 +1475,15 @@ avoid unnecessary intermediate variables in voc END ; par0 := p END StFct; - + PROCEDURE DynArrParCheck(ftyp, atyp: OPT.Struct; fvarpar: BOOLEAN); VAR f: INTEGER; BEGIN (* ftyp^.comp = DynArr *) f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp; 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 IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar) 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 END END CheckReceiver; - + PROCEDURE PrepCall*(VAR x: OPT.Node; VAR fpar: OPT.Object); BEGIN 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 Param; - + PROCEDURE StaticLink*(dlev: SHORTINT); VAR scope: OPT.Object; BEGIN @@ -1566,7 +1578,7 @@ avoid unnecessary intermediate variables in voc x := OPT.NewNode(Nenter); x^.typ := OPT.notyp; x^.obj := proc; x^.left := procdec; x^.right := stat; procdec := x END Enter; - + PROCEDURE Return*(VAR x: OPT.Node; proc: OPT.Object); VAR node: OPT.Node; BEGIN @@ -1581,7 +1593,7 @@ avoid unnecessary intermediate variables in voc END Return; PROCEDURE Assign*(VAR x: OPT.Node; y: OPT.Node); - VAR z: OPT.Node; + VAR z: OPT.Node; subcl: SHORTINT; BEGIN IF x^.class >= Nconst THEN err(56) END ; CheckAssign(x^.typ, y); @@ -1599,9 +1611,16 @@ avoid unnecessary intermediate variables in voc y^.typ := OPT.chartyp; y^.conval^.intval := 0; Index(x, NewIntConst(0)) 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; - + PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct); VAR node: OPT.Node; BEGIN @@ -1610,7 +1629,7 @@ avoid unnecessary intermediate variables in voc IF inittd = NIL THEN inittd := node ELSE last^.link := node END ; last := node END Inittd; - + BEGIN maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp END OPB. diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod index 2843f145..718ba572 100644 --- a/src/compiler/OPC.Mod +++ b/src/compiler/OPC.Mod @@ -1,17 +1,17 @@ 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 various promotion rules changed (long) => (LONGINT), xxxL avoided *) - IMPORT OPT, OPM, version; + IMPORT OPT, OPM, Configuration; CONST demoVersion = FALSE; CONST (* structure forms *) - Byte = 1; Bool = 2; Char = 3; + Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; @@ -23,7 +23,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) Comp = 19; *) (*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; Comp = (*15*)19;*) @@ -184,7 +184,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) 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 OPM.WriteString("SYSTEM_") - + END ; OPM.WriteStringVar(obj^.name) END @@ -257,7 +257,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END DeclareObj; PROCEDURE Andent*(typ: OPT.Struct); (* ident of possibly anonymous record type *) - BEGIN + BEGIN IF (typ^.strobj = NIL) OR (typ^.align >= 10000H) THEN OPM.WriteStringVar(OPM.modName); Str1("__#", typ^.align DIV 10000H) ELSE Ident(typ^.strobj) @@ -265,7 +265,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END Andent; PROCEDURE Undefined(obj: OPT.Object): BOOLEAN; - BEGIN + BEGIN (* 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 = "") END Undefined; @@ -302,7 +302,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.WriteString(Struct); BegBlk; BegStat; Str1("LONGINT len[#]", nofdims); EndStat; 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); EndStat; EndBlk0 END @@ -365,7 +365,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF obj^.mode = TProc THEN BegStat; OPM.WriteString("__INITBP("); - Ident(typ); OPM.WriteString(Comma); Ident(obj); + Ident(typ); OPM.WriteString(Comma); Ident(obj); Str1(", #)", obj^.adr DIV 10000H); EndStat END ; @@ -431,7 +431,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) DeclareTProcs(obj^.left, empty); IF obj^.mode = TProc THEN 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 DefineTProcTypes(obj); 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 END END ; - IF (obj # NIL) & Undefined(obj) THEN + IF (obj # NIL) & Undefined(obj) THEN OPM.WriteString("typedef"); OPM.WriteLn; OPM.Write(Tab); Indent(1); 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 *) DeclareObj(obj, FALSE); 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; PROCEDURE Prefixed(x: OPT.ConstExt; y: ARRAY OF CHAR): BOOLEAN; - VAR i: INTEGER; - BEGIN i := 0; + VAR i: INTEGER; r: BOOLEAN; + BEGIN i := 0; WHILE x[i+1] = y[i] DO INC(i) END ; - RETURN y[i] = 0X + r := y[i] = 0X; + RETURN r; END Prefixed; 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 *) IF (obj^.mode = CProc) & (obj^.vis >= vis) & (obj^.adr = 1) THEN ext := obj.conval.ext; i := 1; - IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN + IF (ext[1] # "#") & ~(Prefixed(ext, "extern ") OR Prefixed(ext, Extern)) THEN OPM.WriteString("#define "); Ident(obj); DeclareParams(obj^.link, TRUE); OPM.Write(Tab); @@ -591,7 +592,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) VAR nofptrs: LONGINT; o: OPT.Object; BEGIN - BegStat; OPM.WriteString("__TDESC("); + BegStat; OPM.WriteString("__TDESC("); Andent(typ); Str1(", #", typ^.n + 1); Str1(", #) = {__TDFLDS(", NofPtrs(typ)); 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); BEGIN - CASE base OF + CASE base OF | 2: INC(adr, adr MOD 2) | 4: INC(adr, (-adr) MOD 4) | 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); IF (curAlign < align) & (gap - (adr - off) >= align) THEN (* preserve alignment of the enclosing struct! *) DEC(gap, (adr - off) + align); - BegStat; - IF align = OPM.IntSize THEN OPM.WriteString("INTEGER") - ELSIF align = OPM.LIntSize THEN OPM.WriteString("LONGINT") + BegStat; + IF align = OPM.IntSize THEN OPM.WriteString("INTEGER") + ELSIF align = OPM.LIntSize THEN OPM.WriteString("LONGINT") ELSIF align = OPM.LRealSize THEN OPM.WriteString("LONGREAL") END ; Str1(" _prvt#", n); INC(n); EndStat; @@ -751,7 +752,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) ELSE LOOP DeclareBase(obj); - IF showParamNames THEN + IF showParamNames THEN OPM.Write(Blank); DeclareObj(obj, FALSE) ELSE 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; VAR i: INTEGER; BEGIN - OPM.WriteString("/*"); OPM.WriteString(HeaderMsg); - OPM.Write(" "); OPM.WriteString(version.versionLong); OPM.Write (" "); (* noch *) - FOR i := 0 TO OPM.MaxSet (*31*) DO (*noch*) + OPM.WriteString("/*"); OPM.WriteString(HeaderMsg); + OPM.Write(" "); OPM.WriteString(Configuration.versionLong); OPM.Write (" "); (* noch *) + FOR i := 0 TO MAX(SET) DO IF i IN OPM.glbopt THEN CASE i OF (* c.f. ScanOptions in OPM *) - | OPM.extsf: OPM.Write("e") - | OPM.newsf: OPM.Write("s") - | OPM.mainprog: OPM.Write("m") - | OPM.inxchk: OPM.Write("x") - | OPM.vcpp: OPM.Write("v") - | OPM.ranchk: OPM.Write("r") - | OPM.typchk: OPM.Write("t") - | OPM.assert: OPM.Write("a") - | OPM.ansi: OPM.Write("k") - | OPM.ptrinit: OPM.Write("p") - | OPM.include0: OPM.Write("i") - | OPM.lineno: OPM.Write("l") - | OPM.useparfile: OPM.Write("P") - | OPM.dontasm: OPM.Write("S") - | OPM.dontlink: OPM.Write("c") - | OPM.mainlinkstat: OPM.Write("M") + | OPM.inxchk: OPM.Write("x") + | OPM.ranchk: OPM.Write("r") + | OPM.typchk: OPM.Write("t") + | OPM.newsf: OPM.Write("s") + | OPM.ptrinit: OPM.Write("p") + | OPM.ansi: OPM.Write("k") + | OPM.assert: OPM.Write("a") + | OPM.extsf: OPM.Write("e") + | OPM.mainprog: OPM.Write("m") + | OPM.dontasm: OPM.Write("S") + | OPM.dontlink: OPM.Write("c") + | OPM.mainlinkstat: OPM.Write("M") | OPM.notcoloroutput: OPM.Write("f") - | OPM.forcenewsym: OPM.Write("F") - | OPM.verbose: OPM.Write("v") + | OPM.forcenewsym: OPM.Write("F") + | OPM.verbose: OPM.Write("v") ELSE (* this else is necessary cause 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 generate __CASECHK and cause Halt, 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; @@ -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("#define "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn; OPM.WriteLn; + IF OPM.LIntSize = 8 THEN OPM.WriteString("#define LARGE"); OPM.WriteLn END; Include(BasicIncludeFile); IncludeImports(OPT.topScope^.right, 1); OPM.WriteLn END GenHdrIncludes; @@ -911,6 +909,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN OPM.currFile := OPM.BodyFile; GenHeaderMsg; + IF OPM.LIntSize = 8 THEN OPM.WriteString("#define LARGE"); OPM.WriteLn END; Include(BasicIncludeFile); IncludeImports(OPT.topScope^.right, 0); OPM.WriteLn; DefAnonRecs(n); @@ -940,8 +939,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF obj # NIL THEN InitImports(obj^.left); IF (obj^.mode = Mod) & (obj^.mnolev # 0) THEN - BegStat; OPM.WriteString("__IMPORT("); - OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name); + BegStat; OPM.WriteString("__MODULE_IMPORT("); + OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name); OPM.Write(CloseParen); EndStat END ; 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*))") ELSE OPM.WriteString("void EnumPtrs(P)"); OPM.WriteLn; - OPM.Write(Tab); OPM.WriteString("void (*P)();"); + OPM.Write(Tab); OPM.WriteString("void (*P)();"); END ; OPM.WriteLn; BegBlk @@ -995,7 +994,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.WriteLn; OPM.WriteString(Export); IF mainprog THEN IF ansi THEN - OPM.WriteString("main(int argc, char **argv)"); OPM.WriteLn; + OPM.WriteString("int main(int argc, char **argv)"); OPM.WriteLn; ELSE OPM.WriteString("main(argc, 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 ; EndStat; 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 END ; 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 ; ProcHeader(proc, TRUE); 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; IdentList(scope^.scope, 0); 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; WHILE var # NIL DO (* copy value array parameters *) IF (var^.typ^.comp IN {Array, DynArr}) & (var^.mode = Var) & (var^.typ^.sysflag = 0) THEN - BegStat; + BegStat; IF var^.typ^.comp = Array THEN OPM.WriteString(DupArrFunc); Ident(var); OPM.WriteString(Comma); @@ -1263,7 +1271,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END; OPM.WriteString(Colon); END Case; - + PROCEDURE SetInclude* (exclude: BOOLEAN); BEGIN 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 ELSE (* array *) 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 Len; @@ -1313,7 +1321,6 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.WriteInt(con^.intval) (* | Int8, Int16, Int32, Int64: OPM.WriteInt(con^.intval)*) - | Real: OPM.WriteReal(con^.realval, "f") | LReal: @@ -1397,7 +1404,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) Enter("volatile"); 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 Hardware: interdata, pdp11, u370, u3b, u3b2, u3b5, u3b15, u3b20d, diff --git a/src/compiler/OPM.cmdln.Mod b/src/compiler/OPM.cmdln.Mod index 313e5a70..6a02cc91 100644 --- a/src/compiler/OPM.cmdln.Mod +++ b/src/compiler/OPM.cmdln.Mod @@ -1,152 +1,138 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) -(* constants needed for C code generation +(* constants needed for C code generation 31.1.2007 jt synchronized with BlackBox version, in particular PromoteIntConstToLInt added *) - IMPORT SYSTEM, Texts := Texts0, Files := Files0, Args, Console, errors, version, vt100; + IMPORT SYSTEM, Texts, Files, Platform, Console, errors, Configuration, vt100, Strings; CONST OptionChar* = "-"; (* compiler options; don't change the encoding *) - inxchk* = 0; (* index check on *) - vcpp* = 1; (* VC++ support on; former ovflchk; neither used nor documented *) - ranchk* = 2; (* range check on *) - typchk* = 3; (* type check on *) - newsf* = 4; (* generation of new symbol file allowed *) - ptrinit* = 5; (* pointer initialization *) - ansi* = 6; (* ANSI or K&R style prototypes *) - assert* = 7; (* assert evaluation *) - include0* = 8; (* include M.h0 in header file and M.c0 in body file if such files exist *) - extsf* = 9; (* extension of old symbol file allowed *) - mainprog* = 10; (* translate module body into C main function *) - lineno* = 11; (* emit line numbers rather than text positions in error messages *) - useparfile* = 12; (* use .par file *) - dontasm* = 13; (* don't call external assembler/C compiler *) - dontlink* = 14; (* don't link *) - mainlinkstat* = 15; (* generate code for main module and then link object file statically *) + inxchk* = 0; (* index check on *) + ranchk* = 2; (* range check on *) + typchk* = 3; (* type check on *) + newsf* = 4; (* generation of new symbol file allowed *) + ptrinit* = 5; (* pointer initialization *) + ansi* = 6; (* ANSI or K&R style prototypes *) + assert* = 7; (* assert evaluation *) + extsf* = 9; (* extension of old symbol file allowed *) + mainprog* = 10; (* translate module body into C main function *) + dontasm* = 13; (* don't call external assembler/C compiler *) + dontlink* = 14; (* don't link *) + mainlinkstat* = 15; (* generate code for main module and then link object file statically *) notcoloroutput* = 16; (* turn off color output *) - forcenewsym* = 17; (* force new symbol file *) - verbose* = 18; (* verbose *) - defopt* = {inxchk, typchk, ptrinit, ansi, assert}; (* default options *) + forcenewsym* = 17; (* force new symbol file *) + verbose* = 18; (* verbose *) + defopt* = {inxchk, typchk, ptrinit, ansi, assert}; (* default options *) - nilval* = 0; -(* - MinRealPat = 0FF7FFFFFH; (* most negative, 32-bit pattern, -3.40282346E38 *) - MinLRealPatL = 0FFFFFFFFH; (* most negative, lower 32-bit pattern *) - MinLRealPatH = 0FFEFFFFFH; (* most negative, higher 32-bit pattern *) - MaxRealPat = 7F7FFFFFH; (*3.40282346E38*) - MaxLRealPatL = -1; - MaxLRealPatH = 7FEFFFFFH; -*) + nilval* = 0; - MaxRExp* = 38; MaxLExp* = 308; MaxHDig* = 8; + MaxRExp* = 38; + MaxLExp* = 308; + MaxHDig* = 8; - MinHaltNr* = 0; - MaxHaltNr* = 255; - MaxSysFlag* = 1; + MinHaltNr* = 0; + MaxHaltNr* = 255; + MaxSysFlag* = 1; - MaxCC* = -1; (* SYSTEM.CC, GETREG, PUTREG; not implementable in C backend *) - MinRegNr* = 0; - MaxRegNr* = -1; + MaxCC* = -1; (* SYSTEM.CC, GETREG, PUTREG; not implementable in C backend *) + MinRegNr* = 0; + MaxRegNr* = -1; - LANotAlloc* = -1; (* XProc link adr initialization *) - ConstNotAlloc* = -1; (* for allocation of string and real constants *) - TDAdrUndef* = -1; (* no type desc allocated *) + LANotAlloc* = -1; (* XProc link adr initialization *) + ConstNotAlloc* = -1; (* for allocation of string and real constants *) + TDAdrUndef* = -1; (* no type desc allocated *) - MaxCases* = 128; - MaxCaseRange* = 512; + MaxCases* = 128; + MaxCaseRange* = 512; - MaxStruct* = 255; + MaxStruct* = 255; (* maximal number of pointer fields in a record: *) - MaxPtr* = MAX(LONGINT); + MaxPtr* = MAX(LONGINT); (* maximal number of global pointers per module: *) - MaxGPtr* = MAX(LONGINT); + MaxGPtr* = MAX(LONGINT); (* maximal number of hidden fields in an exported record: *) - MaxHdFld* = 2048; - - HdPtrName* = "@ptr"; - HdProcName* = "@proc"; - HdTProcName* = "@tproc"; + MaxHdFld* = 2048; - ExpHdPtrFld* = TRUE; - ExpHdProcFld* = FALSE; - ExpHdTProc* = FALSE; + HdPtrName* = "@ptr"; + HdProcName* = "@proc"; + HdTProcName* = "@tproc"; - NEWusingAdr* = FALSE; + ExpHdPtrFld* = TRUE; + ExpHdProcFld* = FALSE; + ExpHdTProc* = FALSE; - Eot* = 0X; + NEWusingAdr* = FALSE; - SFext = ".sym"; (* symbol file extension *) - BFext = ".c"; (* body file extension *) - HFext = ".h"; (* header file extension *) - SFtag = 0F7X; (* symbol file tag *) + Eot* = 0X; - HeaderFile* = 0; - BodyFile* = 1; - HeaderInclude* = 2; + HeaderFile* = 0; + BodyFile* = 1; + HeaderInclude* = 2; + + SFext = ".sym"; (* symbol file extension *) + BFext = ".c"; (* body file extension *) + HFext = ".h"; (* header file extension *) + SFtag = 0F7X; (* symbol file tag *) TYPE FileName = ARRAY 32 OF CHAR; VAR SourceFileName : ARRAY 256 OF CHAR; + + Alignment*: INTEGER; + ByteSize*, CharSize*, BoolSize*, SIntSize*, IntSize*, LIntSize*, SetSize*, RealSize*, LRealSize*, PointerSize*, ProcSize*, RecSize*, - (*Int8Size*, Int16Size*, Int32Size*, Int64Size*,*) (* these are constants actually, we need it to pass to GetProperty function; -- noch *) CharAlign*, BoolAlign*, SIntAlign*, IntAlign*, - (*Int8Align*, Int16Align*, Int32Align*, Int64Align*,*) (* need this for SYSTEM types; -- noch *) LIntAlign*, SetAlign*, RealAlign*, LRealAlign*, PointerAlign*, ProcAlign*, RecAlign*, - ByteOrder*, BitOrder*, MaxSet*: INTEGER; + MaxSet*: INTEGER; + MinSInt*, MinInt*, MinLInt*, MaxSInt*, MaxInt*, MaxLInt*, MaxIndex*: LONGINT; - (*MinInt8*, MaxInt8*, MinInt16*, MaxInt16*, MinInt32*, MaxInt32* : LONGINT; - MinInt64*, MaxInt64* : SYSTEM.INT64;*) + MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL; - noerr*: BOOLEAN; + noerr*: BOOLEAN; curpos*, errpos*: LONGINT; (* character and error position in source file *) - breakpc*: LONGINT; (* set by OPV.Init *) - currFile*: INTEGER; (* current output file *) - level*: INTEGER; (* procedure nesting level *) - pc*, entno*: INTEGER; (* entry number *) - modName*: ARRAY 32 OF CHAR; - objname*: ARRAY 64 OF CHAR; + breakpc*: LONGINT; (* set by OPV.Init *) + currFile*: INTEGER; (* current output file *) + level*: INTEGER; (* procedure nesting level *) + pc*, entno*: INTEGER; (* entry number *) + modName*: ARRAY 32 OF CHAR; + objname*: ARRAY 64 OF CHAR; + opt*, glbopt*: SET; - opt*, glbopt*: SET; + ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber: LONGINT; (* Limit = start of next line *) - lasterrpos: LONGINT; - inR: Texts.Reader; - Log: Texts.Text; - W: Texts.Writer; + lasterrpos: LONGINT; + inR: Texts.Reader; + Log: Texts.Text; + W: Texts.Writer; oldSF, newSF: Files.Rider; - R: ARRAY 3 OF Files.Rider; + R: ARRAY 3 OF Files.Rider; + oldSFile, newSFile, HFile, BFile, HIFile: Files.File; S: INTEGER; - stop, useLineNo, useParFile, dontAsm-, dontLink-, mainProg-, mainLinkStat-, notColorOutput-, forceNewSym-, Verbose-: BOOLEAN; + + dontAsm-, dontLink-, mainProg-, mainLinkStat-, notColorOutput-, forceNewSym-, Verbose-: BOOLEAN; + + OBERON: ARRAY 1024 OF CHAR; + MODULES: ARRAY 1024 OF CHAR; (* ------------------------- Log Output ------------------------- *) - PROCEDURE LogW*(ch: CHAR); - BEGIN Console.Char(ch) - END LogW; - - PROCEDURE LogWStr*(s: ARRAY OF CHAR); - BEGIN Console.String(s) - END LogWStr; - - PROCEDURE LogWNum*(i, len: LONGINT); - BEGIN Console.Int(i, len) - END LogWNum; - - PROCEDURE LogWLn*; - BEGIN Console.Ln - END LogWLn; + PROCEDURE LogW*(ch: CHAR); BEGIN Console.Char(ch) END LogW; + PROCEDURE LogWStr*(s: ARRAY OF CHAR); BEGIN Console.String(s) END LogWStr; + PROCEDURE LogWNum*(i, len: LONGINT); BEGIN Console.Int(i, len) END LogWNum; + PROCEDURE LogWLn*; BEGIN Console.Ln END LogWLn; (* ------------------------- parameter handling -------------------------*) @@ -161,143 +147,168 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) | "s": opt := opt / {newsf} | "m": opt := opt / {mainprog} | "x": opt := opt / {inxchk} - | "v": opt := opt / {vcpp}; | "r": opt := opt / {ranchk} | "t": opt := opt / {typchk} | "a": opt := opt / {assert} - | "k": opt := opt / {ansi} + | "k": opt := opt / {ansi} (* undocumented *) | "p": opt := opt / {ptrinit} - | "i": opt := opt / {include0} - | "l": opt := opt / {lineno} - | "P": opt := opt / {useparfile} | "S": opt := opt / {dontasm} | "c": opt := opt / {dontlink} | "M": opt := opt / {mainlinkstat} | "f": opt := opt / {notcoloroutput} | "F": opt := opt / {forcenewsym} | "V": opt := opt / {verbose} - ELSE LogWStr(" warning: option "); LogW(OptionChar); LogW(s[i]); LogWStr(" ignored"); LogWLn - END ; + | "B": IF s[i+1] # 0X THEN INC(i); IntSize := ORD(s[i]) - ORD('0') END; + IF s[i+1] # 0X THEN INC(i); PointerSize := ORD(s[i]) - ORD('0') END; + IF s[i+1] # 0X THEN INC(i); Alignment := ORD(s[i]) - ORD('0') END; + ASSERT((IntSize = 2) OR (IntSize = 4)); + ASSERT((PointerSize = 4) OR (PointerSize = 8)); + ASSERT((Alignment = 4) OR (Alignment = 8)) + ELSE + LogWStr(" warning: option "); + LogW(OptionChar); + LogW(s[i]); + LogWStr(" ignored"); + LogWLn + END; INC(i) END; END ScanOptions; + PROCEDURE ^GetProperties; - PROCEDURE OpenPar*; (* prepare for a sequence of translations *) + + (* Undocumented options used by the build system: + + The following two parameter overrides the integer size, pointer size and alignment + settings compiled into the binary. They are used when bootstrapping to generate + the C source for a compiler with different sizes to the current compiler. + + -Bnnn Where each n is a single digit specifying the integer size, pointer size + and alignment in bytes. + + An alignment of n means that types smaller than n align to their + own size, types larger than n align to n bytes. + + LONGINT size will be set to twice the integer size. + *) + + PROCEDURE OpenPar*(): BOOLEAN; (* prepare for a sequence of translations *) VAR s: ARRAY 256 OF CHAR; BEGIN - IF Args.argc = 1 THEN stop := TRUE; - Console.Ln; - Console.String("voc - Vishap Oberon-2 compiler "); - Console.String(version.version); Console.String (" "); - Console.String(version.date); Console.String (" for "); Console.String(version.arch); - Console.Ln; - Console.String("based on Ofront by Software Templ OEG"); Console.Ln; - Console.String("continued by Norayr Chilingarian and others"); Console.Ln; - Console.Ln; - Console.String(' command = "voc" options {file options}.'); Console.Ln; - Console.String(' options = ["-" {option} ].'); Console.Ln; - Console.String(' option = "m" | "M" | "s" | "e" | "i" | "l" | "k" | "r" | "x" | "a" | "p" | "t" | "P" | "S" | "c" | "f" | "F" | "V" .'); Console.Ln; - Console.Ln; - Console.String(" m - generate code for main module"); Console.Ln; - Console.String(" M - generate code for main module and link object statically"); Console.Ln; - Console.String(" s - generate new symbol file"); Console.Ln; - Console.String(" e - allow extending the module interface"); Console.Ln; - Console.String(" i - include header and body prefix files (c0)"); Console.Ln; - Console.String(" l - use line numbers"); Console.Ln; - Console.String(" r - check value ranges"); Console.Ln; - Console.String(" x - turn off array indices check"); Console.Ln; - Console.String(" a - don't check ASSERTs at runtime, use this option in tested production code"); Console.Ln; - Console.String(" p - turn off automatic pointer initialization"); Console.Ln; - Console.String(" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)"); Console.Ln; - Console.String(" P - use .par file"); Console.Ln; - Console.String(" S - don't call external assembler/compiler, only generate the asm/C code"); Console.Ln; - Console.String(" c - don't call linker"); Console.Ln; - Console.String(" f - don't use color output"); Console.Ln; - Console.String(" F - force writing new symbol file"); Console.Ln; - Console.String(" V - verbose output"); Console.Ln; - Console.Ln; + IF Platform.ArgCount = 1 THEN + LogWLn; + LogWStr("Vishap Oberon-2 compiler v"); LogWStr(Configuration.versionLong); LogW("."); LogWLn; + LogWStr("Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others."); LogWLn; + LogWLn; + LogWStr('Usage:'); LogWLn; LogWLn; + LogWStr(' '); LogWStr(Configuration.name); LogWStr(' options {files {options}}.'); LogWLn; LogWLn; + LogWStr('Where options = ["-" {option} ].'); LogWLn; + LogWLn; + LogWStr(" m - generate code for main module"); LogWLn; + LogWStr(" M - generate code for main module and link object statically"); LogWLn; + LogWStr(" s - generate new symbol file"); LogWLn; + LogWStr(" e - allow extending the module interface"); LogWLn; + LogWStr(" r - check value ranges"); LogWLn; + LogWStr(" x - turn off array indices check"); LogWLn; + LogWStr(" a - don't check ASSERTs at runtime, use this option in tested production code"); LogWLn; + LogWStr(" p - turn off automatic pointer initialization"); LogWLn; + LogWStr(" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)"); LogWLn; + LogWStr(" S - don't call external assembler/compiler, only generate C code"); LogWLn; + LogWStr(" c - don't call linker"); LogWLn; + LogWStr(" f - don't use color output"); LogWLn; + LogWStr(" F - force writing new symbol file in current directory"); LogWLn; + LogWStr(" V - verbose output"); LogWLn; + LogWLn; + LogWStr('Initial options specify defaults for all files.'); LogWLn; + LogWStr('Options following a filename are specific to that file.'); LogWLn; + LogWStr('Repeating an option toggles its value.'); LogWLn; + RETURN FALSE ELSE - glbopt := defopt; S := 1; s := ""; - Args.Get(1, s); stop := FALSE; - WHILE s[0] = OptionChar DO ScanOptions(s, glbopt); INC(S); s := ""; Args.Get(S, s) END; - IF lineno IN opt THEN (* this brought here from InitOptions which turned out to be unnecessary *) - useLineNo := TRUE; curpos := 256; errpos := curpos; - lasterrpos := curpos - 10 - ELSE - useLineNo := FALSE; - END; - IF useparfile IN glbopt THEN useParFile := TRUE ELSE useParFile := FALSE END; (* this check must be made before calling getproperties, noch *) - IF dontasm IN glbopt THEN dontAsm := TRUE ELSE dontAsm := FALSE END; - IF dontlink IN glbopt THEN dontLink := TRUE ELSE dontLink := FALSE END; - IF mainprog IN glbopt THEN mainProg := TRUE ELSE mainProg := FALSE END; - IF mainlinkstat IN glbopt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END; - IF notcoloroutput IN glbopt THEN notColorOutput := TRUE ELSE notColorOutput := FALSE END; - IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END; - IF verbose IN glbopt THEN Verbose := TRUE ELSE Verbose := FALSE END; - GetProperties; (* GetProperties moved here in order to call it after ScanOptions because we have an option whether to use par file or not, noch *) + S:=1; s:=""; Platform.GetArg(S, s); + glbopt := defopt; + + WHILE s[0] = OptionChar DO + ScanOptions(s, glbopt); + INC(S); s:=""; Platform.GetArg(S, s) + END; + + RETURN TRUE END; END OpenPar; + PROCEDURE InitOptions*; (* get the options for one translation *) VAR s: ARRAY 256 OF CHAR; BEGIN - opt := glbopt; s := ""; Args.Get(S, s); - WHILE s[0] = OptionChar DO ScanOptions(s, opt); INC(S); s := ""; Args.Get(S, s) END ; - IF lineno IN opt THEN useLineNo := TRUE; curpos := 256; errpos := curpos; lasterrpos := curpos - 10 - ELSE useLineNo := FALSE; + opt := glbopt; + s:=""; Platform.GetArg(S, s); + WHILE s[0] = OptionChar DO + ScanOptions(s, opt); + INC(S); s:=""; Platform.GetArg(S, s) END; - IF useparfile IN opt THEN useParFile := TRUE ELSE useParFile := FALSE END; (* this check must be made before calling getproperties, noch *) - IF dontasm IN opt THEN dontAsm := TRUE ELSE dontAsm := FALSE END; - IF dontlink IN opt THEN dontLink := TRUE ELSE dontLink := FALSE END; - IF mainprog IN opt THEN mainProg := TRUE ELSE mainProg := FALSE END; - IF mainlinkstat IN opt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END; - IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END; - IF verbose IN glbopt THEN Verbose := TRUE ELSE Verbose := FALSE END; + dontAsm := dontasm IN opt; + dontLink := dontlink IN opt; + mainProg := mainprog IN opt; + mainLinkStat := mainlinkstat IN opt; + notColorOutput := notcoloroutput IN opt; + forceNewSym := forcenewsym IN opt; + Verbose := verbose IN opt; + + IF mainLinkStat THEN INCL(glbopt, mainprog) END; (* sic *) + + GetProperties; END InitOptions; + PROCEDURE Init*(VAR done: BOOLEAN; VAR mname : ARRAY OF CHAR); (* get the source for one translation *) - VAR T: Texts.Text; beg, end, time: LONGINT; - s: ARRAY 256 OF CHAR; + VAR + T: Texts.Text; + beg, end, time: LONGINT; + s: ARRAY 256 OF CHAR; BEGIN - done := FALSE; curpos := 0; - IF stop OR (S >= Args.argc) THEN RETURN END ; - s := ""; Args.Get(S, s); + done := FALSE; + curpos := 0; + IF S >= Platform.ArgCount THEN RETURN END ; + + s:=""; Platform.GetArg(S, s); + NEW(T); Texts.Open(T, s); - LogWStr(s); + LogWStr(s); LogWStr(" "); COPY(s, mname); COPY(s, SourceFileName); (* to keep it also in this module -- noch *) - IF T.len = 0 THEN LogWStr(" not found"); LogWLn + + IF T.len = 0 THEN + LogWStr(s); LogWStr(" not found."); LogWLn ELSE Texts.OpenReader(inR, T, 0); - LogWStr(" translating"); done := TRUE - END ; + END; + INC(S); level := 0; noerr := TRUE; errpos := curpos; lasterrpos := curpos -10; + ErrorLineStartPos := 0; ErrorLineLimitPos := 0; ErrorLineNumber := 0; END Init; + + (* ------------------------- read source text -------------------------*) - + PROCEDURE Get*(VAR ch: CHAR); (* read next character from source text, 0X if eof *) BEGIN Texts.Read(inR, ch); - IF useLineNo THEN - IF ch = 0DX THEN curpos := (curpos DIV 256 + 1) * 256 - ELSIF curpos MOD 256 # 255 THEN INC(curpos) - (* at 255 means: >= 255 *) - END - ELSIF ch = 0DX THEN + IF ch = 0DX THEN curpos := Texts.Pos(inR); (* supports CR LF mapping *) ELSE INC(curpos) END ; IF (ch < 09X) & ~inR.eot THEN ch := " " END END Get; - + + PROCEDURE MakeFileName(VAR name, FName: ARRAY OF CHAR; ext: ARRAY OF CHAR); VAR i, j: INTEGER; ch: CHAR; BEGIN i := 0; @@ -310,15 +321,18 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) UNTIL ch = 0X END MakeFileName; + PROCEDURE LogErrMsg(n: INTEGER); - VAR S: Texts.Scanner; T: Texts.Text; ch: CHAR; i: INTEGER; + VAR + S: Texts.Scanner; T: Texts.Text; + ch: CHAR; i: INTEGER; buf: ARRAY 1024 OF CHAR; BEGIN - IF n >= 0 THEN + IF n >= 0 THEN IF ~notColorOutput THEN vt100.SetAttr(vt100.Red) END; LogWStr(" err "); IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; - ELSE + ELSE IF ~notColorOutput THEN vt100.SetAttr(vt100.Magenta) END; LogWStr(" warning "); n := -n; IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; @@ -336,243 +350,129 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) LogWStr(errors.errors[n]); END LogErrMsg; - PROCEDURE ShowLine(pos: LONGINT); - VAR - f : Files.File; - r : Files.Rider; - newpos, localpos, delta : LONGINT; - line : ARRAY 1023 OF CHAR; - i : INTEGER; - ch : CHAR; + + PROCEDURE FindLine(f: Files.File; VAR r: Files.Rider; pos: LONGINT); + (* Updates ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber to + describe the line containing pos. + Exits with the rider set to the start of the line conaining pos. *) + VAR + ch, cheol: CHAR; BEGIN - localpos := pos; - f := Files.Old(SourceFileName); + IF pos < ErrorLineStartPos THEN (* Desired position is before saved position, start again at the begnning of file *) + ErrorLineStartPos := 0; ErrorLineLimitPos := 0; ErrorLineNumber := 0 + END; + IF pos < ErrorLineLimitPos THEN (* Current saved line positions contain pos *) + Files.Set(r, f, ErrorLineStartPos); + RETURN + END; - (* - Console.Ln; Console.String("-- source file is "); Console.String(SourceFileName); Console.Ln; - Console.String("-- pos is "); Console.Int(pos, 0); Console.Ln; - *) - (* make sure previous character is character *) - REPEAT - DEC(localpos); IF localpos < 0 THEN localpos := 0 END; - Files.Set(r, f, localpos); - Files.Read(r, ch); - UNTIL (localpos < 1) OR(ORD(ch) >= 32) OR (ORD(ch)=9); - newpos := localpos; - (* - Console.String("-- newpos, last character before error "); Console.Int(newpos, 0); Console.Ln; - *) - (* finding last line end *) - REPEAT - DEC(localpos); IF localpos < 0 THEN newpos := 0 END; - Files.Set(r, f, localpos); - Files.Read(r, ch); -(* - Console.String("-- prev num "); Console.Int(localpos, 0);Console.String(" "); Console.Char(ch); Console.Ln; -*) - UNTIL (localpos < 1) OR ((ORD(ch) < 32) & (ORD(ch) # 9)); -(* - Console.String("-- previous line at pos "); Console.Int(localpos, 0); Console.Ln; -*) - delta := newpos - localpos - 1; - IF delta < 1 THEN delta := 1 END; - (* - Console.String("-- delta "); Console.Int(delta, 0); Console.Ln; -*) - (* skip enter *) - REPEAT - INC(localpos); - Files.Set(r, f, localpos); - Files.Read(r, ch); - UNTIL (ORD(ch) >= 32) OR (ORD(ch) = 9); - i := 0; - REPEAT - Files.Set(r, f, localpos); - Files.Read(r, ch); - IF ORD(ch) = 9 THEN ch := " " END; - line[i] := ch; -(* - Console.String("-- localpos "); Console.Int(localpos, 0); Console.Ln; - Console.String(" -- ch "); Console.Char(ch); Console.Ln; -*) - INC(localpos); - INC(i); - UNTIL r.eof OR (i >= 1022) OR ((ORD(ch) < 32) & (ORD(ch) # 9)); - line[i] := 0X; - IF (line[i-1] = 0AX) OR (line[i-1] = 0DX) THEN line[i-1] := 0X END; - (*Console.String(" -- length of line "); Console.Int(i, 0); Console.Ln;*) - Console.Ln; Console.Ln; Console.String(" "); Console.String(line); - Console.Ln; + Files.Set(r, f, ErrorLineLimitPos); + Files.Read(r, ch); + WHILE (ErrorLineLimitPos < pos) & ~r.eof DO + ErrorLineStartPos := ErrorLineLimitPos; + INC(ErrorLineNumber); + WHILE (ch # 0X) & (ch # 0DX) & (ch # 0AX) DO + Files.Read(r, ch); INC(ErrorLineLimitPos) + END; + cheol := ch; Files.Read(r, ch); INC(ErrorLineLimitPos); + IF (cheol = 0DX) & (ch = 0AX) THEN + INC(ErrorLineLimitPos); Files.Read(r, ch) + END + END; + Files.Set(r, f, ErrorLineStartPos); + END FindLine; - i := 0; - Console.String(" "); - REPEAT - Console.Char(" "); - INC(i); - UNTIL i >= delta; - IF ~notColorOutput THEN vt100.SetAttr(vt100.Green) END; - Console.Char("^"); (*Console.Ln;*) + + PROCEDURE ShowLine(pos: LONGINT); + VAR + f: Files.File; + r: Files.Rider; + line: ARRAY 1023 OF CHAR; + i: INTEGER; + ch: CHAR; + BEGIN + f := Files.Old(SourceFileName); + FindLine(f, r, pos); + + i := 0; Files.Read(r, ch); + WHILE (ch # 0X) & (ch # 0DX) & (ch # 0AX) & (i < LEN(line)-1) DO + line[i] := ch; INC(i); Files.Read(r, ch) + END; + line[i] := 0X; + + LogWLn; LogWLn; + LogWNum(ErrorLineNumber, 4); LogWStr(": "); LogWStr(line); LogWLn; + LogWStr(" "); + + IF pos >= ErrorLineLimitPos THEN pos := ErrorLineLimitPos-1 END; + i := SHORT(pos - ErrorLineStartPos); + WHILE i > 0 DO LogW(" "); DEC(i) END; + + IF ~notColorOutput THEN vt100.SetAttr(vt100.Green) END; + LogW("^"); IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; - Files.Close(f); + Files.Close(f); END ShowLine; - PROCEDURE ShowLineErr(linenum, posnum : LONGINT); - VAR - f : Files.File; - r : Files.Rider; - line : ARRAY 1023 OF CHAR; - i,j : LONGINT; - ch : CHAR; - BEGIN - - f := Files.Old(SourceFileName); - Files.Set(r, f, 0); - - (* skip non character symbols in the beginning *) - REPEAT - Files.Read(r, ch); - UNTIL ORD(ch) > 31; - - i := 0; j := 0; - REPEAT - IF (ORD(ch) > 31) OR (ORD(ch) = 9) THEN - IF ORD(ch)=9 THEN ch := " " END; - line[i] := ch; INC(i); line[i+1] := 0X; - Files.Read(r, ch); - ELSE - IF (ch = 0AX) OR (ch = 0DX) THEN - Files.Read(r, ch); - IF (ch = 0AX) OR (ch = 0DX) THEN - Files.Read(r, ch); - ELSE - INC(j); i := 0 - END - END - END; - (* - Console.Ln; Console.String("-- line["); Console.Int(i-1, 0); Console.String("] = "); Console.Char(ch); Console.Ln; -*) - (* - Console.String("-- i "); Console.Int(i, 0); Console.Ln; - - Console.String("--j "); Console.Int(j, 0); Console.Ln; - - Console.Char(ch); Console.Ln; -*) - UNTIL (j >= linenum) OR (i >= 1022) OR r.eof; - - Console.Ln; Console.String(" "); Console.String(line); Console.Ln; - - i := 0; - WHILE i < posnum-1 DO - Console.Char(" "); - INC(i); - END; - - Console.String(" "); (* compensate shift from Mark() ; -- noch *) - IF ~notColorOutput THEN vt100.SetAttr(vt100.Green) END; - Console.Char("^"); Console.Ln; - IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; - - Files.Close(f); - - END ShowLineErr; PROCEDURE Mark*(n: INTEGER; pos: LONGINT); - VAR - linenumber, posnumber : LONGINT; BEGIN IF pos = -1 THEN pos := 0 END; - - linenumber := pos DIV 256; - posnumber := pos MOD 256; -(* - Console.Ln; Console.String("-- linenumber "); Console.Int(linenumber, 0); Console.Ln; - Console.String("-- posnumber "); Console.Int(posnumber, 0); Console.Ln; -*) - IF useLineNo THEN - IF n >= 0 THEN - noerr := FALSE; -(* - Console.String("n = "); Console.Int(n, 0); Console.Ln; -*) - IF (pos < lasterrpos) OR (lasterrpos + 9 < pos) THEN lasterrpos := pos; LogWLn; LogWStr(" "); - IF n < 249 THEN ShowLineErr(linenumber, posnumber); LogWStr(" line "); LogWNum(linenumber, 1); - LogWStr(" pos "); LogWNum(posnumber, 1); LogErrMsg(n) - ELSIF n = 255 THEN ShowLineErr(linenumber, posnumber); LogWStr(" line "); LogWNum(linenumber, 1); - LogWStr(" pos "); LogWNum(posnumber, 1); LogWStr(" pc "); LogWNum(breakpc, 1) - ELSIF n = 254 THEN LogWStr("pc not found") - ELSE LogWStr(objname); - IF n = 253 THEN LogWStr(" is new, compile with option e") - ELSIF n = 252 THEN LogWStr(" is redefined, compile with option s") - ELSIF n = 251 THEN LogWStr(" is redefined (private part only), compile with option s") - ELSIF n = 250 THEN LogWStr(" is no longer visible, compile with option s") - ELSIF n = 249 THEN LogWStr(" is not consistently imported, recompile imports") - END + IF n >= 0 THEN + noerr := FALSE; + IF (pos < lasterrpos) OR (lasterrpos + 9 < pos) THEN lasterrpos := pos; ShowLine(pos); LogWLn; LogWStr(" "); + IF n < 249 THEN LogWStr(" pos"); LogWNum(pos, 6); LogErrMsg(n) + ELSIF n = 255 THEN LogWStr("pos"); LogWNum(pos, 6); LogWStr(" pc "); LogWNum(breakpc, 1) + ELSIF n = 254 THEN LogWStr("pc not found") + ELSE LogWStr(objname); + IF n = 253 THEN LogWStr(" is new, compile with option e") + ELSIF n = 252 THEN LogWStr(" is redefined, compile with option s") + ELSIF n = 251 THEN LogWStr(" is redefined (private part only), compile with option s") + ELSIF n = 250 THEN LogWStr(" is no longer visible, compile with option s") + ELSIF n = 249 THEN LogWStr(" is not consistently imported, recompile imports") END END - ELSE - ShowLineErr(linenumber, posnumber); - IF pos >= 0 THEN LogWLn; - LogWStr(" line "); LogWNum(pos DIV 256, 1); LogWStr(" pos "); LogWNum(pos MOD 256, 1) - END ; - LogErrMsg(n); - IF pos < 0 THEN LogWLn END END ELSE - IF n >= 0 THEN - noerr := FALSE; - IF (pos < lasterrpos) OR (lasterrpos + 9 < pos) THEN lasterrpos := pos; ShowLine(pos); LogWLn; LogWStr(" "); - IF n < 249 THEN LogWStr(" pos"); LogWNum(pos, 6); LogErrMsg(n) - ELSIF n = 255 THEN LogWStr("pos"); LogWNum(pos, 6); LogWStr(" pc "); LogWNum(breakpc, 1) - ELSIF n = 254 THEN LogWStr("pc not found") - ELSE LogWStr(objname); - IF n = 253 THEN LogWStr(" is new, compile with option e") - ELSIF n = 252 THEN LogWStr(" is redefined, compile with option s") - ELSIF n = 251 THEN LogWStr(" is redefined (private part only), compile with option s") - ELSIF n = 250 THEN LogWStr(" is no longer visible, compile with option s") - ELSIF n = 249 THEN LogWStr(" is not consistently imported, recompile imports") - END - END - END - ELSE - IF pos >= 0 THEN ShowLine(pos); LogWLn; LogWStr(" pos"); LogWNum(pos, 6) END ; - LogErrMsg(n); - IF pos < 0 THEN LogWLn END - END + IF pos >= 0 THEN ShowLine(pos); LogWLn; LogWStr(" pos"); LogWNum(pos, 6) END ; + LogErrMsg(n); + IF pos < 0 THEN LogWLn END END END Mark; + PROCEDURE err*(n: INTEGER); - BEGIN - IF useLineNo & (errpos MOD 256 = 255) THEN (* line underflow from OPS.Get *) - Mark(n, errpos + 1) - ELSE - Mark(n, errpos) - END + BEGIN Mark(n, errpos) END err; + PROCEDURE FPrint*(VAR fp: LONGINT; val: LONGINT); BEGIN fp := SYSTEM.ROT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, fp) / SYSTEM.VAL(SET, val)), 1) END FPrint; + PROCEDURE FPrintSet*(VAR fp: LONGINT; set: SET); BEGIN FPrint(fp, SYSTEM.VAL(LONGINT, set)) END FPrintSet; + PROCEDURE FPrintReal*(VAR fp: LONGINT; real: REAL); BEGIN FPrint(fp, SYSTEM.VAL(LONGINT, real)) END FPrintReal; + PROCEDURE FPrintLReal*(VAR fp: LONGINT; lr: LONGREAL); - VAR l, h: LONGINT; + VAR l, h: LONGINT; BEGIN SYSTEM.GET(SYSTEM.ADR(lr), l); SYSTEM.GET(SYSTEM.ADR(lr)+4, h); FPrint(fp, l); FPrint(fp, h) END FPrintLReal; + + + (* ------------------------- initialization ------------------------- *) PROCEDURE GetProperty(VAR S: Texts.Scanner; name: ARRAY OF CHAR; VAR size, align: INTEGER); @@ -585,12 +485,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) END GetProperty; - PROCEDURE minus(i: LONGINT): LONGINT; BEGIN - RETURN -i; + RETURN -i; END minus; + PROCEDURE power0(i, j : LONGINT) : LONGINT; (* we would like to calculate exact Min Max values in GetProperties, not hardcode em, noch *) VAR k : LONGINT; p : LONGINT; @@ -604,241 +504,125 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) RETURN p; END power0; + PROCEDURE VerboseListSizes; BEGIN - Console.String("Type Size Alignement"); Console.Ln; - Console.String("CHAR "); Console.Int(CharSize, 0); Console.Int(CharAlign, 5); Console.Ln; - Console.String("BOOLEAN "); Console.Int(BoolSize, 0); Console.Int(BoolAlign, 5); Console.Ln; - Console.String("SHORTINT "); Console.Int(SIntSize, 0); Console.Int(SIntAlign, 5); Console.Ln; - Console.String("INTEGER "); Console.Int(IntSize, 0); Console.Int(IntAlign, 5); Console.Ln; - Console.String("LONGINT "); Console.Int(LIntSize, 0); Console.Int(LIntAlign, 5); Console.Ln; - Console.String("SET "); Console.Int(SetSize, 0); Console.Int(SetAlign, 5); Console.Ln; - Console.String("REAL "); Console.Int(RealSize, 0); Console.Int(RealAlign, 5); Console.Ln; - Console.String("LONGREAL "); Console.Int(LRealSize, 0); Console.Int(LRealAlign, 5); Console.Ln; - Console.String("PTR "); Console.Int(PointerSize, 0); Console.Int(PointerAlign, 5); Console.Ln; - Console.String("PROC "); Console.Int(ProcSize, 0); Console.Int(ProcAlign, 5); Console.Ln; - Console.String("RECORD "); Console.Int(RecSize, 0); Console.Int(RecAlign, 5); Console.Ln; - Console.String("ENDIAN "); Console.Int(ByteOrder, 0); Console.Int(BitOrder, 5); Console.Ln; - (* - Console.String("SYSTEM.INT8 "); Console.Int(Int8Size, 0); Console.Int(Int8Align, 5); Console.Ln; - Console.String("SYSTEM.INT16 "); Console.Int(Int16Size, 0); Console.Int(Int16Align, 5); Console.Ln; - Console.String("SYSTEM.INT32 "); Console.Int(Int32Size, 0); Console.Int(Int32Align, 5); Console.Ln; - Console.String("SYSTEM.INT64 "); Console.Int(Int64Size, 0); Console.Int(Int64Align, 5); Console.Ln; - *) - Console.Ln; - Console.String("Min shortint "); Console.Int(MinSInt, 0); Console.Ln; - Console.String("Max shortint "); Console.Int(MaxSInt, 0); Console.Ln; - Console.String("Min integer "); Console.Int(MinInt, 0); Console.Ln; - Console.String("Max integer "); Console.Int(MaxInt, 0); Console.Ln; - Console.String("Min longint "); Console.Int(MinLInt, 0); Console.Ln; - (* - Console.String("Max longint "); Console.Int(MaxLInt, 0); Console.Ln; - Console.String("Min int8 "); Console.Int(MinInt8, 0); Console.Ln; - Console.String("Max int8 "); Console.Int(MaxInt8, 0); Console.Ln; - Console.String("Min int16 "); Console.Int(MinInt16, 0); Console.Ln; - Console.String("Max int16 "); Console.Int(MaxInt16, 0); Console.Ln; - Console.String("Min int32 "); Console.Int(MinInt32, 0); Console.Ln; - Console.String("Max int32 "); Console.Int(MaxInt32, 0); Console.Ln; - *) - + LogWLn; + LogWStr("Type Size Alignement"); LogWLn; + LogWStr("CHAR "); LogWNum(CharSize, 4); LogWNum(CharAlign, 5); LogWLn; + LogWStr("BOOLEAN "); LogWNum(BoolSize, 4); LogWNum(BoolAlign, 5); LogWLn; + LogWStr("SHORTINT "); LogWNum(SIntSize, 4); LogWNum(SIntAlign, 5); LogWLn; + LogWStr("INTEGER "); LogWNum(IntSize, 4); LogWNum(IntAlign, 5); LogWLn; + LogWStr("LONGINT "); LogWNum(LIntSize, 4); LogWNum(LIntAlign, 5); LogWLn; + LogWStr("SET "); LogWNum(SetSize, 4); LogWNum(SetAlign, 5); LogWLn; + LogWStr("REAL "); LogWNum(RealSize, 4); LogWNum(RealAlign, 5); LogWLn; + LogWStr("LONGREAL "); LogWNum(LRealSize, 4); LogWNum(LRealAlign, 5); LogWLn; + LogWStr("PTR "); LogWNum(PointerSize, 4); LogWNum(PointerAlign, 5); LogWLn; + LogWStr("PROC "); LogWNum(ProcSize, 4); LogWNum(ProcAlign, 5); LogWLn; + LogWStr("RECORD "); LogWNum(RecSize, 4); LogWNum(RecAlign, 5); LogWLn; + (*LogWStr("ENDIAN "); LogWNum(ByteOrder, 4); LogWNum(BitOrder, 5); LogWLn;*) + LogWLn; + LogWStr("Min shortint "); LogWNum(MinSInt, 4); LogWLn; + LogWStr("Max shortint "); LogWNum(MaxSInt, 4); LogWLn; + LogWStr("Min integer "); LogWNum(MinInt, 4); LogWLn; + LogWStr("Max integer "); LogWNum(MaxInt, 4); LogWLn; + LogWStr("Min longint "); LogWNum(MinLInt, 4); LogWLn; END VerboseListSizes; + + PROCEDURE Min(a,b: INTEGER): INTEGER; + BEGIN IF a= version.gnuarmv6j) & (version.defaultTarget <= version.gnuarmv7ahardfp) THEN - Console.String (" GNU "); - Console.String (version.arch); Console.String (" target"); Console.Ln; - ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 2; LIntSize := 4; - SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; - CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) - SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; + (* Fixed and Configuration.Mod based sizes have been initialised in + the module startup code, and maybe overridden by the -Bnnn bootstrap + parameter *) - (* not necessary, we will calculate values later - MinSInt := -80H; MinInt := -8000H; MinLInt := 80000000H; (*-2147483648*) - MaxSInt := 7FH; MaxInt := 7FFFH; MaxLInt := 7FFFFFFFH; (*2147483647*) - MaxSet := SetSize * 8 -1; (* noch *) - *) - ELSIF (version.defaultTarget = version.gnupowerpc) THEN - Console.String (" GNU "); - Console.String (version.arch); Console.String (" target"); Console.Ln; - ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 2; LIntSize := 4; - SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; - CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; + (* Derived sizes *) + ProcSize := PointerSize; + LIntSize := IntSize * 2; + SetSize := LIntSize; - (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) - SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; + (* Calculate all type alignments *) + CharAlign := Min(Alignment, CharSize); + BoolAlign := Min(Alignment, BoolSize); + SIntAlign := Min(Alignment, SIntSize); + RecAlign := Min(Alignment, RecSize); + RealAlign := Min(Alignment, RealSize); + LRealAlign := Min(Alignment, LRealSize); + PointerAlign := Min(Alignment, PointerSize); + ProcAlign := Min(Alignment, ProcSize); + IntAlign := Min(Alignment, IntSize); + LIntAlign := Min(Alignment, LIntSize); + SetAlign := Min(Alignment, SetSize); - - ELSIF version.defaultTarget = version.gnux86 THEN - Console.String("GNU "); Console.String(version.arch); Console.String(" target"); Console.Ln; - ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 2; LIntSize := 4; - SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; - CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - - (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) - SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; - - ELSE (* this should suite any gnu x86 system *) - Console.String (" generic target, like GNU x86 system"); Console.Ln; - ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 2; LIntSize := 4; - SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; - CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - - (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) - SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; -(* LRealAlign should be checked and confirmed *) - (* not necessary, will be calculated later - MinSInt := -80H; MinInt := -8000H; MinLInt := 80000000H; (*-2147483648*) - MaxSInt := 7FH; MaxInt := 7FFFH; MaxLInt := 7FFFFFFFH; (*2147483647*) - MaxSet := SetSize * 8 - 1; - *) - - END; (* if defaultTarget *) - END; (* if ~useParFile *) - (* read voc.par *) - - IF useParFile THEN (* noch *) - IF Verbose THEN Console.String ("loading type sizes from voc.par"); Console.Ln; END; - NEW(T); Texts.Open(T, "voc.par"); - IF T.len # 0 THEN - Texts.OpenScanner(S, T, 0); Texts.Scan(S); - GetProperty(S, "CHAR", CharSize, CharAlign); - GetProperty(S, "BOOLEAN", BoolSize, BoolAlign); - GetProperty(S, "SHORTINT", SIntSize, SIntAlign); - GetProperty(S, "INTEGER", IntSize, IntAlign); - GetProperty(S, "LONGINT", LIntSize, LIntAlign); - GetProperty(S, "SET", SetSize, SetAlign); - GetProperty(S, "REAL", RealSize, RealAlign); - GetProperty(S, "LONGREAL", LRealSize, LRealAlign); - GetProperty(S, "PTR", PointerSize, PointerAlign); - GetProperty(S, "PROC", ProcSize, ProcAlign); - GetProperty(S, "RECORD", RecSize, RecAlign); - (* Size = 0: natural size aligned to next power of 2 up to RecAlign; e.g. i960 - Size = 1; size and alignment follows from field types but at least RecAlign; e.g, SPARC, MIPS, PowerPC - *) - GetProperty(S, "ENDIAN", ByteOrder, BitOrder); (*currently not used*) - - (* - GetProperty(S, "SYSTEM.INT8", Int8Size, Int8Align); - GetProperty(S, "SYSTEM.INT16", Int16Size, Int16Align); - GetProperty(S, "SYSTEM.INT32", Int32Size, Int32Align); - GetProperty(S, "SYSTEM.INT64", Int64Size, Int64Align);*) - (* add here Max and Min sizes, noch *) - ByteSize := CharSize; - - ELSE Mark(-156, -1) - END ; - ELSE - IF Verbose THEN - Console.String ("not using voc.par file"); Console.Ln - END - END; (* if useParFile , noch *) - - (*Int8Size := 1; Int16Size := 2; Int32Size := 4; Int64Size := 8;*) - -(* commenting this by replacing with faster way; -- noch * - MinSInt := power0(-2, (SIntSize*8-1)); (* -2^(SIntSize*8-1)*) - (*MaxSInt := -(MinSint + 1);; may be optimized?*) - MaxSInt := minus(MinSInt + 1); - MinInt := power0(-2, (IntSize*8-1)); - MaxInt := minus(MinInt + 1); - - MinLInt := power0(-2, (LIntSize*8-1)); - MaxLInt := minus(MinLInt +1); -*) (* and I'd like to calculate it, not hardcode constants *) - base := -2; - (* we can do - MinLInt := ASH(-2, LIntSize*8-2); - but some compilers may treat -2 as SHORTINT, not LONGINT; -- noch *) + base := -2; MinSInt := ASH(base, SIntSize*8-2); MaxSInt := minus(MinSInt + 1); MinInt := ASH(base, IntSize*8-2); MaxInt := minus(MinInt + 1); - + MinLInt := ASH(base, LIntSize*8-2); MaxLInt := minus(MinLInt +1); - (* - MinInt8 := -80H; MinInt16 := -8000H; MinInt32 := 80000000H; (*-2147483648*) - MaxInt8 := 7FH; MaxInt16 := 7FFFH; MaxInt32 := 7FFFFFFFH; (*2147483647*) - - MinInt64 := ASH(base, Int64Size*8-2); - MaxInt64 := minus(ASH(base, Int64Size*8-2) + 1); -*) + IF RealSize = 4 THEN MaxReal := 3.40282346D38 ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999 (*should be 1.7976931348623157D308 *) END ; + IF LRealSize = 4 THEN MaxLReal := 3.40282346D38 ELSIF LRealSize = 8 THEN MaxLReal := 1.7976931348623157D307 * 9.999999 (*should be 1.7976931348623157D308 *) END ; + MinReal := -MaxReal; MinLReal := -MaxLReal; - (* commented this out, *) - (*IF IntSize = 4 THEN MinInt := MinLInt; MaxInt := MaxLInt END ;*) - (*IF IntSize = 4 THEN MinLInt := MinInt; MaxLInt := MaxInt END ;*) + MaxSet := SetSize * 8 - 1; MaxIndex := MaxLInt; (* shouldn't it be like max(int)? so that for loop will be safe, noch *) - IF Verbose THEN - VerboseListSizes - END; - + IF Verbose THEN VerboseListSizes END; END GetProperties; + + + (* ------------------------- Read Symbol File ------------------------- *) PROCEDURE SymRCh*(VAR ch: CHAR); BEGIN Files.Read(oldSF, ch) END SymRCh; - + PROCEDURE SymRInt*(): LONGINT; VAR k: LONGINT; BEGIN Files.ReadNum(oldSF, k); RETURN k END SymRInt; - + PROCEDURE SymRSet*(VAR s: SET); BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(LONGINT, s)) END SymRSet; - + PROCEDURE SymRReal*(VAR r: REAL); BEGIN Files.ReadReal(oldSF, r) END SymRReal; - + PROCEDURE SymRLReal*(VAR lr: LONGREAL); BEGIN Files.ReadLReal(oldSF, lr) END SymRLReal; - + PROCEDURE CloseOldSym*; END CloseOldSym; PROCEDURE OldSym*(VAR modName: ARRAY OF CHAR; VAR done: BOOLEAN); VAR ch: CHAR; fileName: FileName; - BEGIN MakeFileName(modName, fileName, SFext); + BEGIN + MakeFileName(modName, fileName, SFext); oldSFile := Files.Old(fileName); done := oldSFile # NIL; IF done THEN Files.Set(oldSF, oldSFile, 0); Files.Read(oldSF, ch); @@ -847,13 +631,16 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) END END END OldSym; - + PROCEDURE eofSF*(): BOOLEAN; BEGIN RETURN oldSF.eof END eofSF; - + + + + (* ------------------------- Write Symbol File ------------------------- *) - + PROCEDURE SymWCh*(ch: CHAR); BEGIN Files.Write(newSF, ch) END SymWCh; @@ -869,16 +656,16 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) PROCEDURE SymWReal*(r: REAL); BEGIN Files.WriteReal(newSF, r) END SymWReal; - + PROCEDURE SymWLReal*(lr: LONGREAL); BEGIN Files.WriteLReal(newSF, lr) END SymWLReal; - + PROCEDURE RegisterNewSym*; BEGIN IF (modName # "SYSTEM") OR (mainprog IN opt) THEN Files.Register(newSFile) END END RegisterNewSym; - + PROCEDURE DeleteNewSym*; END DeleteNewSym; @@ -891,6 +678,9 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) END END NewSym; + + + (* ------------------------- Write Header & Body Files ------------------------- *) PROCEDURE Write*(ch: CHAR); @@ -922,11 +712,16 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) s[2] := 0X; WriteString(s) END WriteHex; - + PROCEDURE WriteInt* (i: LONGINT); VAR s: ARRAY 20 OF CHAR; i1, k: LONGINT; BEGIN - IF i = MinLInt THEN Write("("); WriteInt(i+1); WriteString("-1)") (* requires special bootstrap for 64 bit *) + IF (i = MinInt) OR (i = MinLInt) THEN + (* abs(minint) is one more than maxint, causing problems representing the value as a minus sign + followed by absoute value. Therefore represent as -maxint - 1. For INTEGER this avoids a + compiler warning 'this decimal constant is unsigned only in ISO C90', for LONGINT it is the + only way to represent MinLInt. *) + Write("("); WriteInt(i+1); WriteString("-1)") ELSE i1 := ABS(i); s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1; WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END ; @@ -939,7 +734,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) VAR W: Texts.Writer; T: Texts.Text; R: Texts.Reader; s: ARRAY 32 OF CHAR; ch: CHAR; i: INTEGER; BEGIN (*should be improved *) - IF (r < MaxLInt) & (r > MinLInt) & (r = ENTIER(r)) THEN + IF (r < MaxLInt) & (r > MinLInt) & (r = ENTIER(r)) THEN IF suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ; WriteInt(ENTIER(r)) ELSE @@ -951,7 +746,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) (* s[i] := suffx; s[i+1] := 0X; suffix does not work in K&R *) s[i] := 0X; - i := 0; ch := s[0]; + i := 0; ch := s[0]; WHILE (ch # "D") & (ch # 0X) DO INC(i); ch := s[i] END ; IF ch = "D" THEN s[i] := "e" END ; WriteString(s) @@ -986,16 +781,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) MakeFileName(moduleName, FName, HFext); HIFile := Files.New(FName); IF HIFile # NIL THEN Files.Set(R[HeaderInclude], HIFile, 0) ELSE err(153) END ; - IF include0 IN opt THEN - MakeFileName(moduleName, FName, ".h0"); Append(R[HeaderInclude], Files.Old(FName)); - MakeFileName(moduleName, FName, ".c0"); Append(R[BodyFile], Files.Old(FName)) - END END OpenFiles; PROCEDURE CloseFiles*; VAR FName: ARRAY 32 OF CHAR; res: INTEGER; BEGIN - IF noerr THEN LogWStr(" "); LogWNum(Files.Pos(R[BodyFile]), 0) END ; + IF noerr THEN LogWStr(" "); LogWNum(Files.Pos(R[BodyFile]), 0); LogWStr(" chars.") END; IF noerr THEN IF modName = "SYSTEM" THEN IF ~(mainprog IN opt) THEN Files.Register(BFile) END @@ -1011,18 +802,30 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) HFile := NIL; BFile := NIL; HIFile := NIL; newSFile := NIL; oldSFile := NIL; Files.Set(R[0], NIL, 0); Files.Set(R[1], NIL, 0); Files.Set(R[2], NIL, 0); Files.Set(newSF, NIL, 0); Files.Set(oldSF, NIL, 0) END CloseFiles; - - PROCEDURE PromoteIntConstToLInt*(); - BEGIN - (* ANSI C does not need explicit promotion. - K&R C implicitly promotes integer constants to type int in parameter lists. - if the formal parameter, however, is of type long, appending "L" is required in ordere to promote - the parameter explicitly to type long (if LONGINT corresponds to long, which we do not really know). - It works for all known K&R versions of voc and K&R is dying out anyway. - A cleaner solution would be to cast with type (LONGINT), but this requires a bit more changes. - *) - IF ~(ansi IN opt) THEN Write("L") END - END PromoteIntConstToLInt; -BEGIN Texts.OpenWriter(W) + +BEGIN + + Texts.OpenWriter(W); + + MODULES := ""; Platform.GetEnv("MODULES", MODULES); + + OBERON := "."; Platform.GetEnv("OBERON", OBERON); + Strings.Append(";.;", OBERON); + Strings.Append(MODULES, OBERON); + Strings.Append(";", OBERON); + Strings.Append(Configuration.installdir, OBERON); + Strings.Append("/sym;", OBERON); + + Files.SetSearchPath(OBERON); + + (* Fixed type sizes *) + CharSize := 1; BoolSize := 1; SIntSize := 1; RecSize := 1; ByteSize := 1; + RealSize := 4; LRealSize := 8; + + (* type sizes with configuration based defaults *) + PointerSize := Configuration.addressSize; + Alignment := Configuration.alignment; + IntSize := Configuration.intsize; + END OPM. diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod index 7971ab96..a9f30a0c 100644 --- a/src/compiler/OPP.Mod +++ b/src/compiler/OPP.Mod @@ -2,7 +2,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IMPORT OPB, OPT, OPS, OPM; - + CONST (* numtyp values *) 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; (* Structure forms *) - Undef = 0; Byte = 1; Bool = 2; Char = 3; + Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; @@ -42,7 +42,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) Comp = (*15*)19;*) intSet = {SInt..LInt(*, Int8..Int64*)}; - + (* composite structure forms *) 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 *) super = 1; - + (* module visibility of objects *) 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 low, high: LONGINT END ; - + VAR sym, level: SHORTINT; 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); BEGIN Expression(x); IF x^.class # Nconst THEN - err(50); x := OPB.NewIntConst(1) + err(50); x := OPB.NewIntConst(1) END END ConstExpression; @@ -129,7 +129,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSE vis := internal END END CheckMark; - + PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER); VAR x: OPT.Node; sf: LONGINT; BEGIN @@ -256,7 +256,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END END PointerType; - + PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct); VAR mode: SHORTINT; 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) END END TypeDecl; - + PROCEDURE Type(VAR typ, banned: OPT.Struct); BEGIN TypeDecl(typ, banned); 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 ; IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END END StandProcCall; - + PROCEDURE Element(VAR x: OPT.Node); VAR y: OPT.Node; BEGIN Expression(x); @@ -469,7 +469,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ; CheckSym(rbrace) END Sets; - + PROCEDURE Factor(VAR x: OPT.Node); VAR fpar, id: OPT.Object; apar: OPT.Node; BEGIN @@ -573,7 +573,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) CheckSym(rparen); IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END END Receiver; - + PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN; BEGIN 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; IF sym = string THEN 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 LOOP 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 IF fwd # NIL THEN err(1); fwd := NIL END ; 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 ; INC(level); OPT.OpenScope(level, proc); 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) END END TProcDecl; - + BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc; IF (sym # ident) & (sym # lparen) THEN 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); 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 Expression(x); pos := OPM.errpos; 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 END ; e := sym = else; - IF e THEN OPS.Get(sym); StatSeq(y) - ELSE + IF e THEN OPS.Get(sym); StatSeq(y) + ELSE y := NIL; OPM.Mark(-307, OPM.curpos); (* notice about no else symbol; -- noch *) 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; IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END END CasePart; - + PROCEDURE SetPos(x: OPT.Node); BEGIN 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); IF sym = module THEN OPS.Get(sym) ELSE err(16) END ; 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); IF sym = import THEN OPS.Get(sym); LOOP diff --git a/src/compiler/OPS.Mod b/src/compiler/OPS.Mod index c251c2be..53d7e2e7 100644 --- a/src/compiler/OPS.Mod +++ b/src/compiler/OPS.Mod @@ -1,11 +1,11 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *) IMPORT OPM; - + CONST MaxStrLen* = 256; MaxIdLen = 256; - + TYPE Name* = ARRAY MaxIdLen 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 *) VAR - name*: Name; - str*: String; - numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *) - intval*: LONGINT; (* integer value or string length *) + name*: Name; + str*: String; + numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *) + intval*: LONGINT; (* integer value or string length *) realval*: REAL; - lrlval*: LONGREAL; + lrlval*: LONGREAL; (*symbols: | 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); BEGIN OPM.err(n) END err; - + PROCEDURE Str(VAR sym: SHORTINT); VAR i: INTEGER; och: CHAR; 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 END END Ord; - + BEGIN (* ("0" <= ch) & (ch <= "9") *) i := 0; m := 0; n := 0; d := 0; LOOP (* read mantissa *) diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod index 34a57061..5912149b 100644 --- a/src/compiler/OPT.Mod +++ b/src/compiler/OPT.Mod @@ -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 *) -IMPORT -OPS, OPM; +IMPORT OPS, OPM; CONST -MaxConstLen* = OPS.MaxStrLen; + MaxConstLen* = OPS.MaxStrLen; TYPE -Const* = POINTER TO ConstDesc; -Object* = POINTER TO ObjDesc; -Struct* = POINTER TO StrDesc; -Node* = POINTER TO NodeDesc; -ConstExt* = POINTER TO OPS.String; + Const* = POINTER TO ConstDesc; + Object* = POINTER TO ObjDesc; + Struct* = POINTER TO StrDesc; + Node* = POINTER TO NodeDesc; + ConstExt* = POINTER TO OPS.String; -ConstDesc* = RECORD -ext*: ConstExt; (* string or code for code proc *) -intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) -intval2*: LONGINT; (* string length, proc var size or larger case label *) -setval*: SET; (* constant value, procedure body present or "ELSE" present in case *) -realval*: LONGREAL (* real or longreal constant value *) -END ; + ConstDesc* = RECORD + ext*: ConstExt; (* string or code for code proc *) + intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) + intval2*: LONGINT; (* string length, proc var size or larger case label *) + setval*: SET; (* constant value, procedure body present or "ELSE" present in case *) + realval*: LONGREAL (* real or longreal constant value *) + END ; -ObjDesc* = RECORD -left*, right*, link*, scope*: Object; -name*: OPS.Name; -leaf*: BOOLEAN; -mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) -vis*: SHORTINT; (* internal, external, externalR *) -history*: SHORTINT; (* relevant if name # "" *) -used*, fpdone*: BOOLEAN; -fprint*: LONGINT; -typ*: Struct; -conval*: Const; -adr*, linkadr*: LONGINT; -x*: INTEGER (* linkadr and x can be freely used by the backend *) -END ; + ObjDesc* = RECORD + left*, right*: Object; + link*, scope*: Object; + name*: OPS.Name; + leaf*: BOOLEAN; + mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) + vis*: SHORTINT; (* internal, external, externalR *) + history*: SHORTINT; (* relevant if name # "" *) + used*, fpdone*: BOOLEAN; + fprint*: LONGINT; + typ*: Struct; + conval*: Const; + adr*, linkadr*: LONGINT; + x*: INTEGER (* linkadr and x can be freely used by the backend *) + END ; -StrDesc* = RECORD -form*, comp*, mno*, extlev*: SHORTINT; -ref*, sysflag*: INTEGER; -n*, size*, align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *) -allocated*, pbused*, pvused*, fpdone, idfpdone: BOOLEAN; -idfp, pbfp*, pvfp*:LONGINT; -BaseTyp*: Struct; -link*, strobj*: Object -END ; + StrDesc* = RECORD + form*, comp*: SHORTINT; + mno*, extlev*: SHORTINT; + ref*, sysflag*: INTEGER; + n*, size*: LONGINT; + align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *) + allocated*: BOOLEAN; + pbused*, pvused*: BOOLEAN; + fpdone, idfpdone: BOOLEAN; + idfp, pbfp*, pvfp*: LONGINT; + BaseTyp*: Struct; + link*, strobj*: Object + END ; -NodeDesc* = RECORD -left*, right*, link*: Node; -class*, subcl*: SHORTINT; -readonly*: BOOLEAN; -typ*: Struct; -obj*: Object; -conval*: Const -END ; + NodeDesc* = RECORD + left*, right*, link*: Node; + class*, subcl*: SHORTINT; + readonly*: BOOLEAN; + typ*: Struct; + obj*: Object; + conval*: Const + END ; CONST -maxImps = 64; (* must be <= MAX(SHORTINT) *) -maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) -FirstRef = (*20*)16; (* comp + 1 *) + maxImps = 64; (* must be <= MAX(SHORTINT) *) + maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) + FirstRef = (*20*)16; (* comp + 1 *) VAR -typSize*: PROCEDURE(typ: Struct); -topScope*: Object; -undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*, -realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*, -int8typ*, int16typ*, int32typ*, int64typ* *): Struct; -nofGmod*: SHORTINT; (*nof imports*) -GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) -SelfName*: OPS.Name; (* name of module being compiled *) -SYSimported*: BOOLEAN; + typSize*: PROCEDURE(typ: Struct); + topScope*: Object; + undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*, + realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*, + int8typ*, int16typ*, int32typ*, int64typ* *): Struct; + nofGmod*: SHORTINT; (*nof imports*) + GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) + SelfName*: OPS.Name; (* name of module being compiled *) + SYSimported*: BOOLEAN; CONST -(* object modes *) -Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; -SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; + (* object modes *) + 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; -(* structure forms *) -Undef = 0; Byte = 1; Bool = 2; Char = 3; -SInt = 4; Int = 5; LInt = 6; -Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; -Pointer = 13; ProcTyp = 14; -Comp = 15; + (* structure forms *) + Undef = 0; Byte = 1; Bool = 2; Char = 3; + SInt = 4; Int = 5; LInt = 6; + Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Pointer = 13; ProcTyp = 14; + Comp = 15; -(*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; -Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; -Pointer = 17; ProcTyp = 18; -Comp = 19;*) -(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; -Pointer = 13; ProcTyp = 14; -Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; -Comp = 19;*) + (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; + Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; + Pointer = 17; ProcTyp = 18; + Comp = 19;*) + (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Pointer = 13; ProcTyp = 14; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + Comp = 19;*) -(* composite structure forms *) -Basic = 1; Array = 2; DynArr = 3; Record = 4; + (* composite structure forms *) + Basic = 1; Array = 2; DynArr = 3; Record = 4; -(*function number*) -assign = 0; -haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4; -entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9; -shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; -inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; + (*function number*) + assign = 0; + haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4; + entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9; + shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; + inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; -(*SYSTEM function number*) -adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; -getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; -bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31; + (*SYSTEM function number*) + adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; + getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; + bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31; -(* module visibility of objects *) -internal = 0; external = 1; externalR = 2; + (* module visibility of objects *) + internal = 0; external = 1; externalR = 2; -(* history of imported objects *) -inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5; + (* history of imported objects *) + inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5; -(* symbol file items *) -Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22; -Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30; -Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40; + (* symbol file items *) + Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22; + Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30; + Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40; TYPE -ImpCtxt = RECORD -nextTag, reffp: LONGINT; -nofr, minr, nofm: INTEGER; -self: BOOLEAN; -ref: ARRAY maxStruct OF Struct; -old: ARRAY maxStruct OF Object; -pvfp: ARRAY maxStruct OF LONGINT; (* set only if old # NIL *) -glbmno: ARRAY maxImps OF SHORTINT (* index is local mno *) -END ; + ImpCtxt = RECORD + nextTag, reffp: LONGINT; + nofr, minr, nofm: INTEGER; + self: BOOLEAN; + ref: ARRAY maxStruct OF Struct; + old: ARRAY maxStruct OF Object; + pvfp: ARRAY maxStruct OF LONGINT; (* set only if old # NIL *) + glbmno: ARRAY maxImps OF SHORTINT (* index is local mno *) + END ; -ExpCtxt = RECORD -reffp: LONGINT; -ref: INTEGER; -nofm: SHORTINT; -locmno: ARRAY maxImps OF SHORTINT (* index is global mno *) -END ; + ExpCtxt = RECORD + reffp: LONGINT; + ref: INTEGER; + nofm: SHORTINT; + locmno: ARRAY maxImps OF SHORTINT (* index is global mno *) + END ; VAR -universe, syslink: Object; -impCtxt: ImpCtxt; -expCtxt: ExpCtxt; -nofhdfld: LONGINT; -newsf, findpc, extsf, sfpresent, symExtended, symNew: BOOLEAN; + universe, syslink: Object; + impCtxt: ImpCtxt; + expCtxt: ExpCtxt; + nofhdfld: LONGINT; + newsf, findpc: BOOLEAN; + extsf, sfpresent: BOOLEAN; + symExtended, symNew: BOOLEAN; PROCEDURE err(n: INTEGER); BEGIN OPM.err(n) @@ -244,7 +250,7 @@ END Find; PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object); VAR obj: Object; -BEGIN +BEGIN WHILE typ # NIL DO obj := typ^.link; WHILE obj # NIL DO IF name < obj^.name THEN obj := obj^.left @@ -288,17 +294,16 @@ PROCEDURE ^IdFPrint*(typ: Struct); PROCEDURE DebugStruct(btyp: Struct); BEGIN - - OPM.LogWLn; - 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^.form = "); OPM.LogWNum(btyp^.form, 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^.extlev = "); OPM.LogWNum(btyp^.extlev, 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^.txtpos = "); OPM.LogWNum(btyp^.txtpos, 0); OPM.LogWLn; + OPM.LogWLn; + 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^.form = "); OPM.LogWNum(btyp^.form, 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^.extlev = "); OPM.LogWNum(btyp^.extlev, 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^.txtpos = "); OPM.LogWNum(btyp^.txtpos, 0); OPM.LogWLn; END DebugStruct; PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object); @@ -306,8 +311,8 @@ PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object); BEGIN IdFPrint(result); OPM.FPrint(fp, result^.idfp); WHILE (par # NIL) (*& (par^.typ # NIL)*) DO (* !!! *) - OPM.FPrint(fp, par^.mode); - IdFPrint(par^.typ); + OPM.FPrint(fp, par^.mode); + IdFPrint(par^.typ); OPM.FPrint(fp, par^.typ^.idfp); (* par^.name and par^.adr not considered *) par := par^.link @@ -326,7 +331,7 @@ BEGIN END ; IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN 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) ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) END ; @@ -366,7 +371,7 @@ WHILE (fld # NIL) & (fld^.mode = Fld) DO IF (fld^.vis # internal) & visible THEN OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp) - ELSE + ELSE FPrintHdFld(fld^.typ, fld, fld^.adr + adr) END ; fld := fld^.link @@ -453,26 +458,26 @@ BEGIN END END FPrintObj; -PROCEDURE FPrintErr*(obj: Object; errno: INTEGER); +PROCEDURE FPrintErr*(obj: Object; errcode: INTEGER); VAR i, j: INTEGER; ch: CHAR; BEGIN -IF obj^.mnolev # 0 THEN -COPY(GlbMod[-obj^.mnolev]^.name, OPM.objname); i := 0; -WHILE OPM.objname[i] # 0X DO INC(i) END ; -OPM.objname[i] := "."; j := 0; INC(i); -REPEAT ch := obj^.name[j]; OPM.objname[i] := ch; INC(j); INC(i) UNTIL ch = 0X; -ELSE -COPY(obj^.name, OPM.objname) -END ; -IF errno = 249 THEN -IF OPM.noerr THEN err(errno) END -ELSIF errno = 253 THEN (* extension *) -IF ~symNew & ~symExtended & ~extsf THEN err(errno) END ; -symExtended := TRUE -ELSE -IF ~symNew & ~newsf THEN err(errno) END ; -symNew := TRUE -END + IF obj^.mnolev # 0 THEN + COPY(GlbMod[-obj^.mnolev]^.name, OPM.objname); i := 0; + WHILE OPM.objname[i] # 0X DO INC(i) END ; + OPM.objname[i] := "."; j := 0; INC(i); + REPEAT ch := obj^.name[j]; OPM.objname[i] := ch; INC(j); INC(i) UNTIL ch = 0X; + ELSE + COPY(obj^.name, OPM.objname) + END ; + IF errcode = 249 THEN + IF OPM.noerr THEN err(errcode) END + ELSIF errcode = 253 THEN (* extension *) + IF ~symNew & ~symExtended & ~extsf THEN err(errcode) END ; + symExtended := TRUE + ELSE + IF ~symNew & ~newsf THEN err(errcode) END ; + symNew := TRUE + END END FPrintErr; (*-------------------------- Import --------------------------*) @@ -625,20 +630,20 @@ VAR mno: SHORTINT; ref: INTEGER; tag: LONGINT; name: OPS.Name; t: Struct; obj, last, fld, old, dummy: Object; BEGIN tag := OPM.SymRInt(); - IF tag # Sstruct THEN + IF tag # Sstruct THEN typ := impCtxt.ref[-tag] ELSE ref := impCtxt.nofr; INC(impCtxt.nofr); IF ref < impCtxt.minr THEN impCtxt.minr := ref END ; InMod(mno); InName(name); obj := NewObj(); IF name = "" THEN - IF impCtxt.self THEN - old := NIL (* do not insert type desc anchor here, but in OPL *) - ELSE - obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" + IF impCtxt.self THEN + old := NIL (* do not insert type desc anchor here, but in OPL *) + ELSE + obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" END ; typ := NewStr(Undef, Basic) - ELSE + ELSE obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); IF old # NIL THEN (* recalculate fprints to compare with old fprints *) FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; @@ -648,11 +653,11 @@ BEGIN typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; typ^.fpdone := FALSE; typ^.idfpdone := FALSE END - ELSE - typ := NewStr(Undef, Basic) + ELSE + typ := NewStr(Undef, Basic) END END ; - impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; + impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; typ^.ref := ref + maxStruct; (* ref >= maxStruct: not exported yet, ref used for err 155 *) typ^.mno := mno; typ^.allocated := TRUE; @@ -662,27 +667,27 @@ BEGIN IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END ; CASE tag OF | Sptr: - typ^.form := Pointer; typ^.size := OPM.PointerSize; - typ^.n := 0; InStruct(typ^.BaseTyp) + typ^.form := Pointer; typ^.size := OPM.PointerSize; + typ^.n := 0; InStruct(typ^.BaseTyp) | Sarr: - typ^.form := Comp; typ^.comp := Array; - InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); + typ^.form := Comp; typ^.comp := Array; + InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); typSize(typ) (* no bounds address !! *) | Sdarr: typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); - IF typ^.BaseTyp^.comp = DynArr THEN - typ^.n := typ^.BaseTyp^.n + 1 - ELSE - typ^.n := 0 + IF typ^.BaseTyp^.comp = DynArr THEN + typ^.n := typ^.BaseTyp^.n + 1 + ELSE + typ^.n := 0 END ; typSize(typ) | Srec: - typ^.form := Comp; typ^.comp := Record; - InStruct(typ^.BaseTyp); + typ^.form := Comp; typ^.comp := Record; + InStruct(typ^.BaseTyp); IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; typ.extlev := 0; t := typ.BaseTyp; (* 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^.n := OPM.SymRInt(); impCtxt.nextTag := OPM.SymRInt(); last := NIL; @@ -692,16 +697,16 @@ BEGIN last := fld; InsertImport(fld, typ^.link, dummy); impCtxt.nextTag := OPM.SymRInt() END ; - WHILE impCtxt.nextTag # Send DO - fld := InTProc(mno); + WHILE impCtxt.nextTag # Send DO + fld := InTProc(mno); InsertImport(fld, typ^.link, dummy); impCtxt.nextTag := OPM.SymRInt() END | Spro: - typ^.form := ProcTyp; typ^.size := OPM.ProcSize; - InSign(mno, typ^.BaseTyp, typ^.link) - ELSE - OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; + typ^.form := ProcTyp; typ^.size := OPM.ProcSize; + InSign(mno, typ^.BaseTyp, typ^.link) + ELSE + OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; END ; IF ref = impCtxt.minr THEN 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) *) IF obj^.name # "" THEN FPrintObj(obj) END ; old := impCtxt.old[ref]; - IF old # NIL THEN - t^.strobj := old; (* restore strobj *) + IF old # NIL THEN + t^.strobj := old; (* restore strobj *) IF impCtxt.self THEN IF old^.mnolev < 0 THEN - IF old^.history # inconsistent THEN - IF old^.fprint # obj^.fprint THEN - old^.history := pbmodified - ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN - old^.history := pvmodified - END - (* ELSE remain inconsistent *) - END - ELSIF old^.fprint # obj^.fprint THEN - old^.history := pbmodified - ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN - old^.history := pvmodified - ELSIF old^.vis = internal THEN - old^.history := same (* may be changed to "removed" in InObj *) - ELSE - old^.history := inserted (* may be changed to "same" in InObj *) + IF old^.history # inconsistent THEN + IF old^.fprint # obj^.fprint THEN + old^.history := pbmodified + ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN + old^.history := pvmodified + END + (* ELSE remain inconsistent *) + END + ELSIF old^.fprint # obj^.fprint THEN + old^.history := pbmodified + ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN + old^.history := pvmodified + ELSIF old^.vis = internal THEN + old^.history := same (* may be changed to "removed" in InObj *) + ELSE + old^.history := inserted (* may be changed to "same" in InObj *) END ELSE (* check private part, delay error message until really used *) - IF impCtxt.pvfp[ref] # t^.pvfp THEN - old^.history := inconsistent - END ; - IF old^.fprint # obj^.fprint THEN - FPrintErr(old, 249) - END + IF impCtxt.pvfp[ref] # t^.pvfp THEN + old^.history := inconsistent + END ; + IF old^.fprint # obj^.fprint THEN + FPrintErr(old, 249) + END END - ELSIF impCtxt.self THEN - obj^.history := removed - ELSE - obj^.history := same + ELSIF impCtxt.self THEN + obj^.history := removed + ELSE + obj^.history := same END ; INC(ref) END ; @@ -774,12 +779,12 @@ END InStruct; ext := NewExt(); obj^.conval^.ext := ext; s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END - ELSE - OPM.LogWStr("unhandled case at OPT.InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; + ELSE + OPM.LogWStr("unhandled case at OPT.InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; END ELSIF tag = Salias THEN obj^.mode := Typ; InStruct(obj^.typ) - ELSE + ELSE obj^.mode := Var; IF tag = Srvar THEN obj^.vis := externalR END ; InStruct(obj^.typ) @@ -852,7 +857,7 @@ END InStruct; BEGIN i := 0; REPEAT ch := name[i]; OPM.SymWCh(ch); INC(i) UNTIL ch = 0X END OutName; - + PROCEDURE OutMod(mno: INTEGER); BEGIN IF expCtxt.locmno[mno] < 0 THEN (* new mod *) @@ -950,7 +955,7 @@ END InStruct; | pvmodified: FPrintErr(strobj, 251) | inconsistent: FPrintErr(strobj, 249) ELSE (* checked in OutObj or correct indirect export *) - (* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) + (* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) END ELSE OPM.SymWCh(0X) (* anonymous => never inconsistent, pvfp influences the client fp *) END ; @@ -974,10 +979,10 @@ END InStruct; nofhdfld := 0; OutFlds(typ^.link, 0, TRUE); IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END ; OutTProcs(typ, typ^.link); OPM.SymWInt(Send) - ELSE - OPM.LogWStr("unhandled case at OPT.OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn; + ELSE + OPM.LogWStr("unhandled case at OPT.OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn; END - ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; + ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; END END END OutStr; @@ -1017,8 +1022,8 @@ END InStruct; | same: (* ok *) | pbmodified: FPrintErr(obj, 252) | pvmodified: FPrintErr(obj, 251) - ELSE - OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; + ELSE + OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; END ; CASE obj^.mode OF | Con: @@ -1043,8 +1048,8 @@ END InStruct; j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END ; OutName(obj^.name) - ELSE - OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; + ELSE + OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; END END END ; @@ -1066,17 +1071,17 @@ END InStruct; i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ; OutObj(topScope^.right); ext := sfpresent & symExtended; new := ~sfpresent OR symNew; - IF OPM.forceNewSym THEN - new := TRUE - END; (* for bootstrapping -- noch *) + IF OPM.forceNewSym THEN + new := TRUE + END; (* for bootstrapping -- noch *) IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN new := TRUE; IF ~extsf THEN err(155) END END ; newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *) - IF ~OPM.noerr OR findpc THEN - OPM.DeleteNewSym - END + IF ~OPM.noerr OR findpc THEN + OPM.DeleteNewSym + END (* OPM.RegisterNewSym is called in OP2 after writing the object file *) END END @@ -1202,7 +1207,7 @@ Objects: Mod | scope Module Head | txtpos owner firstvar Scope anchor TProc | index sizes firstpar scope leaf Bound procedure, index = 10000H*mthno+entry, entry adr set in back-end - + Structures: 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. - class subcl obj left right link + class subcl obj left right link --------------------------------------------------------- design Nvar var nextexpr @@ -1255,7 +1260,7 @@ design Nvar var nextexpr expr design Nconst const (val = node^.conval) - Nupto expr expr nextexpr + Nupto expr expr nextexpr Nmop not expr nextexpr minus expr nextexpr is tsttype expr nextexpr @@ -1322,8 +1327,8 @@ stat NIL Ncase expr casestat stat Nwhile expr stat stat Nrepeat stat expr stat - Nloop stat stat - Nexit stat + Nloop stat stat + Nexit stat Nreturn proc nextexpr stat (proc = NIL for mod) Nwith ifstat stat stat Ntrap expr stat diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod index 8e00879f..702055f9 100644 --- a/src/compiler/OPV.Mod +++ b/src/compiler/OPV.Mod @@ -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 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; - + CONST (* object modes *) 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; Pointer = 17; ProcTyp = 18; Comp = 19;*) - (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; - Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; Comp = (*15*)19;*) (* composite structure forms *) @@ -57,38 +57,38 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 super = 1; - UndefinedType = 0; (* named type not yet defined *) + UndefinedType = 0; (* named type not yet defined *) ProcessingType = 1; (* pointer type is being processed *) PredefinedType = 2; (* for all predefined types *) - DefinedInHdr = 3+OPM.HeaderFile; (* named type has been defined in header file *) - DefinedInBdy = 3+OPM.BodyFile; (* named type has been defined in body 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 *) - OpenParen = "("; - CloseParen = ")"; - OpenBracket = "["; + OpenParen = "("; + CloseParen = ")"; + OpenBracket = "["; CloseBracket = "]"; - Blank = " "; - Comma = ", "; - Deref = "*"; - EntierFunc = "__ENTIER("; - IsFunc = "__IS("; - IsPFunc = "__ISP("; + Blank = " "; + Comma = ", "; + Deref = "*"; + EntierFunc = "__ENTIER("; + IsFunc = "__IS("; + IsPFunc = "__ISP("; GuardPtrFunc = "__GUARDP("; GuardRecFunc = "__GUARDR("; - TypeFunc = "__TYPEOF("; - SetOfFunc = "__SETOF("; + TypeFunc = "__TYPEOF("; + SetOfFunc = "__SETOF("; SetRangeFunc = "__SETRNG("; - CopyFunc = "__COPY("; - MoveFunc = "__MOVE("; - GetFunc = "__GET("; - PutFunc = "__PUT("; - DynTypExt = "__typ"; - WithChk = "__WITHCHK"; - Break = "break"; - ElseStat = "else "; + CopyFunc = "__COPY("; + MoveFunc = "__MOVE("; + GetFunc = "__GET("; + PutFunc = "__PUT("; + DynTypExt = "__typ"; + WithChk = "__WITHCHK"; + Break = "break"; + ElseStat = "else "; - MinPrec = -1; - MaxPrec = 12; + MinPrec = -1; + MaxPrec = 12; ProcTypeVar = 11; (* precedence number when a call is made with a proc type variable *) 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 ; typ^.size := offset; typ^.align := base; (* encode the trailing gap into the symbol table to allow dense packing of extended records *) - typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H) + typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H) ELSIF c = Array THEN TypSize(typ^.BaseTyp); 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); IF btyp^.comp = DynArr THEN typ^.size := btyp^.size + 4 (* describes dim not size *) ELSE typ^.size := 8 - END ; + END END END END TypSize; @@ -173,7 +173,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 mainprog := OPM.mainprog IN OPM.opt; ansi := OPM.ansi IN OPM.opt END Init; - + PROCEDURE ^Traverse (obj, outerScope: OPT.Object; exported: BOOLEAN); PROCEDURE GetTProcNum(obj: OPT.Object); @@ -284,6 +284,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 RETURN 9 | is, abs, cap, odd, cc: RETURN 10 + ELSE + OPM.LogWStr("unhandled case in OPV.Precedence Nmop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END | Ndop: CASE subclass OF @@ -307,8 +309,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 RETURN 0 | len, in, ash, msk, bit, lsh, rot: RETURN 10 - ELSE - OPM.LogWStr("unhandled case in OPV.Precedence, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; + ELSE + OPM.LogWStr("unhandled case in OPV.Precedence Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END; | Nupto: RETURN 10 @@ -355,7 +357,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF from < LInt THEN OPM.WriteString("(LONGINT)") END ; Entier(n, 9) (*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);*) ELSIF form = Int THEN 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: typ := n^.typ; obj := n^.left^.obj; 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*) OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj) ELSE (*local var-par record*) @@ -497,7 +499,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 | Neguard: IF OPM.typchk IN OPM.opt THEN 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) END ; (* __GUARDEQx includes deref *) 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 (* casting of params should be simplified eventually *) IF (mode = VarPar) & (typ # n^.typ) & (prec = MinPrec) THEN OPM.WriteString("(void*)") END - END ; - IF (mode = VarPar) & (n^.class = Nmop) & (n^.subcl = val) THEN expr(n^.left, prec) (* avoid cast in lvalue *) - ELSE expr(n, prec) - END ; - IF (form = LInt) & (n^.class = Nconst) - & (n^.conval^.intval <= OPM.MaxInt) & (n^.conval^.intval >= OPM.MinInt) THEN - OPM.PromoteIntConstToLInt() - ELSIF (comp = Record) & (mode = VarPar) THEN + END; + IF (mode = VarPar) & (n^.class = Nmop) & (n^.subcl = val) THEN + expr(n^.left, prec) (* avoid cast in lvalue *) + ELSIF (form = LInt) & (n^.class = Nconst) + & (n^.conval^.intval <= OPM.MaxInt) & (n^.conval^.intval >= OPM.MinInt) THEN + OPM.WriteString("((LONGINT)("); expr(n, prec); OPM.WriteString("))"); + ELSE + expr(n, prec) + END; + IF (comp = Record) & (mode = VarPar) THEN OPM.WriteString(", "); TypeOf(n) ELSIF comp = DynArr THEN 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 Len(n, dim); OPM.WriteString(" * "); INC(dim); aptyp := aptyp^.BaseTyp END ; - OPM.WriteInt(aptyp^.size); OPM.PromoteIntConstToLInt() + OPM.WriteString("((LONGINT)("); OPM.WriteInt(aptyp^.size); OPM.WriteString("))"); END END END ; @@ -613,7 +617,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 | minus: IF form = Set THEN OPM.Write("~") ELSE OPM.Write("-"); END ; expr(l, exprPrec) - | is: + | is: typ := n^.obj^.typ; IF l^.typ^.comp = Record THEN OPM.WriteString(IsFunc); OPC.TypeOf(l^.obj) 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: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen) | adr: (*SYSTEM*) - OPM.WriteString("(LONGINT)"); + OPM.WriteString("(LONGINT)(uintptr_t)"); IF l^.class = Nvarpar THEN OPC.CompleteIdent(l^.obj) ELSE 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}) & (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); + IF (n^.typ^.form IN {Pointer, ProcTyp}) OR (l^.typ^.form IN {Pointer, ProcTyp}) THEN + OPM.WriteString("(uintptr_t)") + END; expr(l, exprPrec) 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) END ELSE OPM.err(200) @@ -760,7 +772,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 | Ncall: IF (l^.obj # NIL) & (l^.obj^.mode = TProc) THEN 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 ; OPC.Ident(proc); n^.obj := proc^.link @@ -784,7 +796,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 if := n^.left; (* name := ""; *) WHILE if # NIL DO 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 *) obj := if^.left^.left^.obj; typ := obj^.typ; adr := obj^.adr; 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") ELSE OPM.WriteString("NIL") 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(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 *) WHILE typ # base DO OPM.WriteString(", "); 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) END ; x := x^.link - ELSE OPM.WriteInt(typ^.n); OPM.PromoteIntConstToLInt() + ELSE OPM.WriteString("(LONGINT)"); OPM.WriteInt(typ^.n) END ; typ := typ^.BaseTyp END ; @@ -1027,14 +1039,19 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF OPM.level = 0 THEN IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END ELSE - OPC.ExitProc(outerProc, FALSE, FALSE); - OPM.WriteString("return"); - IF n^.left # NIL THEN OPM.Write(Blank); + IF n^.left # NIL THEN + (* Make local copy of result before ExitProc deletes dynamic vars *) + OPM.WriteString("_o_result = "); IF (n^.left^.typ^.form = Pointer) & (n^.obj^.typ # n^.left^.typ) THEN OPM.WriteString("(void*)"); expr(n^.left, 10) ELSE 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 | Nwith: @@ -1050,7 +1067,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 when compiling Texts0.Mod on raspberry pi it generates __CASECHK and cause Halt, 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 ; IF ~(n^.class IN {Nenter, Ninittd, Nifelse, Nwith, Ncase, Nwhile, Nloop}) THEN OPC.EndStat END ; n := n^.link diff --git a/src/compiler/Vishap.Mod b/src/compiler/Vishap.Mod index a375af43..63cc4260 100644 --- a/src/compiler/Vishap.Mod +++ b/src/compiler/Vishap.Mod @@ -1,37 +1,14 @@ -MODULE voc; (* J. Templ 3.2.95 *) +MODULE Vishap; (* J. Templ 3.2.95 *) IMPORT - SYSTEM, Unix, Kernel := Kernel0, + SYSTEM, Heap, Platform, Configuration, OPP, OPB, OPT, OPV, OPC, OPM, 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); VAR ext, new: BOOLEAN; p: OPT.Node; BEGIN @@ -45,83 +22,111 @@ VAR mname : ARRAY 256 OF CHAR; (* noch *) OPC.Init; OPV.Module(p); IF OPM.noerr THEN - (*IF (OPM.mainprog IN OPM.opt) & (OPM.modName # "SYSTEM") THEN*) IF (OPM.mainProg OR OPM.mainLinkStat) & (OPM.modName # "SYSTEM") THEN - OPM.DeleteNewSym; - IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END; - OPM.LogWStr(" main program"); - IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; + OPM.DeleteNewSym; + IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END; + OPM.LogWStr(" Main program."); + IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; ELSE - IF new THEN - IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END; - OPM.LogWStr(" new symbol file"); - IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; - OPM.RegisterNewSym - ELSIF ext THEN OPM.LogWStr(" extended symbol file"); OPM.RegisterNewSym + IF new THEN + IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END; + OPM.LogWStr(" New symbol file."); + IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END; + OPM.RegisterNewSym + ELSIF ext THEN + OPM.LogWStr(" Extended symbol file."); + OPM.RegisterNewSym END END; - - - ELSE OPM.DeleteNewSym + ELSE + OPM.DeleteNewSym END END - END ; + END; OPM.CloseFiles; OPT.Close; - OPM.LogWLn; done := OPM.noerr; - - - + OPM.LogWLn; + done := OPM.noerr; 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*; - VAR done: BOOLEAN; - 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 *) + VAR + 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 modulesobj := ""; - OPM.OpenPar; (* gclock(); slightly faste rtranslation but may lead to opening "too many files" *) - OPT.bytetyp.size := OPM.ByteSize; - (*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; + IF OPM.OpenPar() THEN + (* gclock(); slightly faster translation but may lead to opening "too many files" *) - (* noch *) - IF done THEN - IF ~OPM.dontAsm THEN - extTools.Assemble(OPM.modName); - IF ~(OPM.mainProg OR OPM.mainLinkStat) THEN Strings.Append(" ",modulesobj); Strings.Append(OPM.modName, modulesobj); Strings.Append(".o ", modulesobj) END; + LOOP + OPM.Init(done, mname); (* Get next module name from command line *) + IF ~done THEN RETURN END ; - IF ~OPM.dontLink & (OPM.mainProg OR OPM.mainLinkStat) THEN - extTools.LinkMain (OPM.modName, OPM.mainLinkStat, modulesobj); - END; - END; - END + OPM.InitOptions; (* Get options ofr this module *) + PropagateElementaryTypeSizes; + (* 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; - - - END (* loop *) + (* 'assemble' (i.e. c compile) .c to object or executable. *) + IF ~OPM.dontAsm THEN + 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; + 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 - signal(2, Trap); (* interrupt *) - signal(3, Trap); (* quit *) - signal(4, Trap); (* illegal instruction, HALT *) + Platform.SetInterruptHandler(Trap); + Platform.SetQuitHandler(Trap); + Platform.SetBadInstructionHandler(Trap); OPB.typSize := OPV.TypSize; OPT.typSize := OPV.TypSize; Translate -END voc. +END Vishap. diff --git a/src/compiler/extTools.Mod b/src/compiler/extTools.Mod index 30790878..515c13e4 100644 --- a/src/compiler/extTools.Mod +++ b/src/compiler/extTools.Mod @@ -1,88 +1,74 @@ 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 cmd : ARRAY 1023 OF CHAR; -cc : ARRAY 1023 OF CHAR; -ext : ARRAY 5 OF CHAR; +VAR compilationOptions, CFLAGS: ARRAY 1023 OF CHAR; + + +PROCEDURE execute(title: ARRAY OF CHAR; cmd: ARRAY OF CHAR); + VAR r, status, exitcode: INTEGER; BEGIN -COPY (ccString, cc); -Strings.Append (" -c ", cc); -COPY(cc, cmd); -Strings.Append (" ", cmd); -Strings.Append (ccOpt, cmd); -ext := ".c"; -Strings.Append (ext, m); -Strings.Append(m, cmd); -(*Console.Ln; Console.String (cmd); Console.Ln;*) -Unix.system(cmd); -END Assemble; + IF OPM.Verbose THEN Console.String(title); Console.String(cmd); Console.Ln END; + r := Platform.System(cmd); + status := r MOD 128; + exitcode := r DIV 256; + IF exitcode > 127 THEN exitcode := exitcode - 256 END; (* Handle signed exit code *) + + IF r # 0 THEN + Console.String(title); Console.String(cmd); Console.Ln; + Console.String("-- failed: status "); Console.Int(status,1); + Console.String(", exitcode "); Console.Int(exitcode,1); + 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); -VAR lpath : ARRAY 1023 OF CHAR; -cc : ARRAY 1023 OF CHAR; -ccopt : ARRAY 1023 OF CHAR; -cmd : ARRAY 1023 OF CHAR; -ext : ARRAY 5 OF CHAR; -BEGIN -(* -gcc -g -o hello hello.c -I $RPATH/src/lib/system/gnuc/x86_64 -I. -I$RPATH -lOberon -L. -L$RPATH -static -*) -cmd := ""; -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); +PROCEDURE Assemble*(moduleName: ARRAY OF CHAR); + VAR + cmd: ARRAY 1023 OF CHAR; + BEGIN + cmd := Configuration.compile; + Strings.Append(compilationOptions, cmd); + Strings.Append("-c ", cmd); + Strings.Append(moduleName, cmd); + Strings.Append(".c", cmd); + execute("Assemble: ", cmd); + END Assemble; -Strings.Append (" -lVishapOberon -L. -L", ccOpt); -Strings.Append (version.prefix, ccOpt); -Strings.Append ("/lib ", ccOpt); -Strings.Append(ccOpt, cmd); -Console.Ln; Console.String(cmd); Console.Ln; (* may be it's feasible to add debug mode later *) -Unix.system(cmd); -END LinkMain; +PROCEDURE LinkMain*(VAR moduleName: ARRAY OF CHAR; statically: BOOLEAN; additionalopts: ARRAY OF CHAR); + VAR + cmd: ARRAY 1023 OF CHAR; + 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 - -incPath0 := "src/lib/system/linux/"; -Strings.Append (compiler, incPath0); -incPath1 := "lib/voc/obj "; -ccOpt := " -fPIC -g "; - -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); - + Strings.Append(' -I "', compilationOptions); + Strings.Append(Configuration.installdir, compilationOptions); + Strings.Append('/include" ', compilationOptions); + Platform.GetEnv("CFLAGS", CFLAGS); + Strings.Append (CFLAGS, compilationOptions); + Strings.Append (" ", compilationOptions); END extTools.