mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 02:52:24 +00:00
Update compiler source to V2.
This commit is contained in:
David Brown
parent
efefcf0fb4
commit
efb7b6b030
9 changed files with 1023 additions and 1177 deletions
|
|
@ -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 ;
|
||||
|
|
@ -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;
|
||||
|
|
@ -1471,7 +1481,9 @@ avoid unnecessary intermediate variables in voc
|
|||
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
|
||||
|
|
@ -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,7 +1611,14 @@ 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);
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
|
|||
various promotion rules changed (long) => (LONGINT), xxxL avoided
|
||||
*)
|
||||
|
||||
IMPORT OPT, OPM, version;
|
||||
IMPORT OPT, OPM, Configuration;
|
||||
|
||||
CONST demoVersion = FALSE;
|
||||
|
||||
|
|
@ -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;
|
||||
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);
|
||||
|
|
@ -656,8 +657,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
|
|||
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")
|
||||
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;
|
||||
|
|
@ -858,29 +859,25 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
|
|||
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.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,7 +939,7 @@ 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(");
|
||||
BegStat; OPM.WriteString("__MODULE_IMPORT(");
|
||||
OPM.WriteStringVar(OPT.GlbMod[-obj^.mnolev].name);
|
||||
OPM.Write(CloseParen); EndStat
|
||||
END ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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*)
|
||||
|
|
@ -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:
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -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);
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -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);
|
||||
|
|
@ -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 --------------------------*)
|
||||
|
|
@ -633,9 +638,9 @@ BEGIN
|
|||
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 *)
|
||||
old := NIL (* do not insert type desc anchor here, but in OPL *)
|
||||
ELSE
|
||||
obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := ""
|
||||
obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := ""
|
||||
END ;
|
||||
typ := NewStr(Undef, Basic)
|
||||
ELSE
|
||||
|
|
@ -649,7 +654,7 @@ BEGIN
|
|||
typ^.fpdone := FALSE; typ^.idfpdone := FALSE
|
||||
END
|
||||
ELSE
|
||||
typ := NewStr(Undef, Basic)
|
||||
typ := NewStr(Undef, Basic)
|
||||
END
|
||||
END ;
|
||||
impCtxt.ref[ref] := typ; impCtxt.old[ref] := old;
|
||||
|
|
@ -663,26 +668,26 @@ BEGIN
|
|||
CASE tag OF
|
||||
| Sptr:
|
||||
typ^.form := Pointer; typ^.size := OPM.PointerSize;
|
||||
typ^.n := 0; InStruct(typ^.BaseTyp)
|
||||
typ^.n := 0; InStruct(typ^.BaseTyp)
|
||||
| Sarr:
|
||||
typ^.form := Comp; typ^.comp := Array;
|
||||
InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt();
|
||||
InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt();
|
||||
typSize(typ) (* no bounds address !! *)
|
||||
| Sdarr:
|
||||
typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp);
|
||||
IF typ^.BaseTyp^.comp = DynArr THEN
|
||||
typ^.n := typ^.BaseTyp^.n + 1
|
||||
typ^.n := typ^.BaseTyp^.n + 1
|
||||
ELSE
|
||||
typ^.n := 0
|
||||
typ^.n := 0
|
||||
END ;
|
||||
typSize(typ)
|
||||
| Srec:
|
||||
typ^.form := Comp; typ^.comp := Record;
|
||||
InStruct(typ^.BaseTyp);
|
||||
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)
|
||||
InSign(mno, typ^.BaseTyp, typ^.link)
|
||||
ELSE
|
||||
OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
|
||||
OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
|
||||
END ;
|
||||
IF ref = impCtxt.minr THEN
|
||||
WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO
|
||||
|
|
@ -710,39 +715,39 @@ END ;
|
|||
IF obj^.name # "" THEN FPrintObj(obj) END ;
|
||||
old := impCtxt.old[ref];
|
||||
IF old # NIL THEN
|
||||
t^.strobj := old; (* restore strobj *)
|
||||
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
|
||||
IF old^.history # inconsistent THEN
|
||||
IF old^.fprint # obj^.fprint THEN
|
||||
old^.history := pbmodified
|
||||
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
|
||||
old^.history := pvmodified
|
||||
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 *)
|
||||
old^.history := same (* may be changed to "removed" in InObj *)
|
||||
ELSE
|
||||
old^.history := inserted (* may be changed to "same" in InObj *)
|
||||
old^.history := inserted (* may be changed to "same" in InObj *)
|
||||
END
|
||||
ELSE
|
||||
(* check private part, delay error message until really used *)
|
||||
IF impCtxt.pvfp[ref] # t^.pvfp THEN
|
||||
old^.history := inconsistent
|
||||
END ;
|
||||
old^.history := inconsistent
|
||||
END ;
|
||||
IF old^.fprint # obj^.fprint THEN
|
||||
FPrintErr(old, 249)
|
||||
END
|
||||
FPrintErr(old, 249)
|
||||
END
|
||||
END
|
||||
ELSIF impCtxt.self THEN
|
||||
obj^.history := removed
|
||||
obj^.history := removed
|
||||
ELSE
|
||||
obj^.history := same
|
||||
obj^.history := same
|
||||
END ;
|
||||
INC(ref)
|
||||
END ;
|
||||
|
|
@ -774,8 +779,8 @@ 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)
|
||||
|
|
@ -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,8 +979,8 @@ 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;
|
||||
END
|
||||
|
|
@ -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
|
||||
OPM.DeleteNewSym
|
||||
END
|
||||
(* OPM.RegisterNewSym is called in OP2 after writing the object file *)
|
||||
END
|
||||
END
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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)
|
||||
|
|
@ -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(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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
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 ~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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue