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

Update compiler source to V2.

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

33
src/compiler/OPB.Mod
View file

@ -411,7 +411,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
| adr: (*SYSTEM.ADR*)
IF (z^.class = Nconst) & (f = Char) & (z^.conval^.intval >= 20H) THEN
CharToString(z); f := String
END ;
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);

43
src/compiler/OPC.Mod
View file

@ -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);
@ -858,23 +859,19 @@ 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.newsf: OPM.Write("s")
| OPM.ptrinit: OPM.Write("p")
| OPM.include0: OPM.Write("i")
| OPM.lineno: OPM.Write("l")
| OPM.useparfile: 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")
@ -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:

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

File diff suppressed because it is too large Load diff

8
src/compiler/OPP.Mod
View file

@ -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

273
src/compiler/OPT.Mod
View file

@ -4,148 +4,154 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *)
2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file
*)
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,7 +294,6 @@ 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;
@ -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 --------------------------*)

55
src/compiler/OPV.Mod
View file

@ -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
@ -308,7 +310,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| len, in, ash, msk, bit, lsh, rot:
RETURN 10
ELSE
OPM.LogWStr("unhandled case in OPV.Precedence, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
OPM.LogWStr("unhandled case in OPV.Precedence Ndop, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END;
| 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)
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.PromoteIntConstToLInt()
ELSIF (comp = Record) & (mode = VarPar) 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:

141
src/compiler/Vishap.Mod
View file

@ -1,37 +1,14 @@
MODULE voc; (* J. Templ 3.2.95 *)
MODULE Vishap; (* J. Templ 3.2.95 *)
IMPORT
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,45 +22,36 @@ 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");
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");
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
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 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 *)
PROCEDURE PropagateElementaryTypeSizes;
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;
@ -93,35 +61,72 @@ VAR mname : ARRAY 256 OF CHAR; (* noch *)
OPT.lrltyp.size := OPM.LRealSize;
OPT.sinttyp.size := OPM.SIntSize;
OPT.booltyp.size := OPM.BoolSize;
END PropagateElementaryTypeSizes;
PROCEDURE Translate*;
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 := "";
IF OPM.OpenPar() THEN
(* gclock(); slightly faster translation but may lead to opening "too many files" *)
LOOP
OPM.Init(done, mname);
IF ~done THEN EXIT END ;
OPM.InitOptions;
Kernel.GC(FALSE);
OPM.Init(done, mname); (* Get next module name from command line *)
IF ~done THEN RETURN END ;
OPM.InitOptions; (* Get options ofr this module *)
PropagateElementaryTypeSizes;
(* Compile source to .c and .h files *)
Heap.GC(FALSE);
Module(done);
IF ~done THEN Unix.Exit(1) END;
IF ~done THEN
OPM.LogWLn; OPM.LogWStr("Module compilation failed."); OPM.LogWLn;
Platform.Exit(1)
END;
(* noch *)
IF done THEN
(* '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);
IF ~(OPM.mainProg OR OPM.mainLinkStat) THEN Strings.Append(" ",modulesobj); Strings.Append(OPM.modName, modulesobj); Strings.Append(".o ", modulesobj) END;
IF ~OPM.dontLink & (OPM.mainProg OR OPM.mainLinkStat) THEN
extTools.LinkMain (OPM.modName, OPM.mainLinkStat, modulesobj);
END;
END;
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.

140
src/compiler/extTools.Mod
View file

@ -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.