mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 22:42:24 +00:00
voc compiler first commit
This commit is contained in:
Norayr Chilingarian
parent
4a7dc4b549
commit
760d826948
119 changed files with 30394 additions and 0 deletions
1538
src/voc/OPB.Mod
Normal file
1538
src/voc/OPB.Mod
Normal file
File diff suppressed because it is too large
Load diff
1378
src/voc/OPC.Mod
Normal file
1378
src/voc/OPC.Mod
Normal file
File diff suppressed because it is too large
Load diff
748
src/voc/OPM.cmdln.Mod
Normal file
748
src/voc/OPM.cmdln.Mod
Normal file
|
|
@ -0,0 +1,748 @@
|
|||
MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
|
||||
(* constants needed for C code generation
|
||||
|
||||
31.1.2007 jt synchronized with BlackBox version, in particular PromoteIntConstToLInt added
|
||||
*)
|
||||
|
||||
IMPORT SYSTEM, Texts := CmdlnTexts, Files, Args, Console, errors, version;
|
||||
|
||||
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 *)
|
||||
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;
|
||||
*)
|
||||
|
||||
MaxRExp* = 38; MaxLExp* = 308; MaxHDig* = 8;
|
||||
|
||||
MinHaltNr* = 0;
|
||||
MaxHaltNr* = 255;
|
||||
MaxSysFlag* = 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 *)
|
||||
|
||||
MaxCases* = 128;
|
||||
MaxCaseRange* = 512;
|
||||
|
||||
MaxStruct* = 255;
|
||||
|
||||
(* maximal number of pointer fields in a record: *)
|
||||
MaxPtr* = MAX(LONGINT);
|
||||
|
||||
(* maximal number of global pointers per module: *)
|
||||
MaxGPtr* = MAX(LONGINT);
|
||||
|
||||
(* maximal number of hidden fields in an exported record: *)
|
||||
MaxHdFld* = 512;
|
||||
|
||||
HdPtrName* = "@ptr";
|
||||
HdProcName* = "@proc";
|
||||
HdTProcName* = "@tproc";
|
||||
|
||||
ExpHdPtrFld* = TRUE;
|
||||
ExpHdProcFld* = FALSE;
|
||||
ExpHdTProc* = FALSE;
|
||||
|
||||
NEWusingAdr* = FALSE;
|
||||
|
||||
Eot* = 0X;
|
||||
|
||||
SFext = ".sym"; (* symbol file extension *)
|
||||
BFext = ".c"; (* body file extension *)
|
||||
HFext = ".h"; (* header file extension *)
|
||||
SFtag = 0F7X; (* symbol file tag *)
|
||||
|
||||
HeaderFile* = 0;
|
||||
BodyFile* = 1;
|
||||
HeaderInclude* = 2;
|
||||
|
||||
TYPE
|
||||
FileName = ARRAY 32 OF CHAR;
|
||||
|
||||
VAR
|
||||
|
||||
ByteSize*, CharSize*, BoolSize*, SIntSize*, IntSize*,
|
||||
LIntSize*, SetSize*, RealSize*, LRealSize*, PointerSize*, ProcSize*, RecSize*,
|
||||
CharAlign*, BoolAlign*, SIntAlign*, IntAlign*,
|
||||
LIntAlign*, SetAlign*, RealAlign*, LRealAlign*, PointerAlign*, ProcAlign*, RecAlign*,
|
||||
ByteOrder*, BitOrder*, MaxSet*: INTEGER;
|
||||
MinSInt*, MinInt*, MinLInt*, MaxSInt*, MaxInt*, MaxLInt*, MaxIndex*: LONGINT;
|
||||
MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL;
|
||||
|
||||
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;
|
||||
|
||||
opt*, glbopt*: SET;
|
||||
|
||||
lasterrpos: LONGINT;
|
||||
inR: Texts.Reader;
|
||||
Log: Texts.Text;
|
||||
W: Texts.Writer;
|
||||
oldSF, newSF: Files.Rider;
|
||||
R: ARRAY 3 OF Files.Rider;
|
||||
oldSFile, newSFile, HFile, BFile, HIFile: Files.File;
|
||||
|
||||
S: INTEGER;
|
||||
stop, useLineNo, useParFile, dontAsm-, dontLink-, mainProg-, mainLinkStat-: BOOLEAN;
|
||||
|
||||
|
||||
(* ------------------------- 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;
|
||||
|
||||
|
||||
(* ------------------------- parameter handling -------------------------*)
|
||||
|
||||
PROCEDURE ScanOptions(VAR s: ARRAY OF CHAR; VAR opt: SET);
|
||||
VAR i: INTEGER;
|
||||
BEGIN
|
||||
i := 1; (* skip - *)
|
||||
WHILE s[i] # 0X DO
|
||||
CASE s[i] OF
|
||||
| "e": opt := opt / {extsf}
|
||||
| "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}
|
||||
| "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}
|
||||
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 *)
|
||||
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" .'); 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.Ln;
|
||||
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;
|
||||
|
||||
GetProperties; (* GetProperties moved here in order to call it after ScanOptions because we have an option whether to use par file or not, noch *)
|
||||
|
||||
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;
|
||||
END;
|
||||
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;
|
||||
BEGIN
|
||||
done := FALSE; curpos := 0;
|
||||
IF stop OR (S >= Args.argc) THEN RETURN END ;
|
||||
s := ""; Args.Get(S, s);
|
||||
NEW(T); Texts.Open(T, s);
|
||||
LogWStr(s);
|
||||
COPY(s, mname);
|
||||
IF T.len = 0 THEN LogWStr(" not found"); LogWLn
|
||||
ELSE
|
||||
Texts.OpenReader(inR, T, 0);
|
||||
LogWStr(" translating");
|
||||
done := TRUE
|
||||
END ;
|
||||
INC(S);
|
||||
level := 0; noerr := TRUE; errpos := curpos; lasterrpos := curpos -10;
|
||||
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
|
||||
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;
|
||||
LOOP ch := name[i];
|
||||
IF ch = 0X THEN EXIT END ;
|
||||
FName[i] := ch; INC(i)
|
||||
END ;
|
||||
j := 0;
|
||||
REPEAT ch := ext[j]; FName[i] := ch; INC(i); INC(j)
|
||||
UNTIL ch = 0X
|
||||
END MakeFileName;
|
||||
|
||||
PROCEDURE LogErrMsg(n: INTEGER);
|
||||
VAR S: Texts.Scanner; T: Texts.Text; ch: CHAR; i: INTEGER;
|
||||
buf: ARRAY 1024 OF CHAR;
|
||||
BEGIN
|
||||
IF n >= 0 THEN LogWStr(" err ")
|
||||
ELSE LogWStr(" warning "); n := -n
|
||||
END ;
|
||||
LogWNum(n, 1);
|
||||
LogWStr(" ");
|
||||
(*NEW(T); Texts.Open(T, "vocErrors.Text"); Texts.OpenScanner(S, T, 0);
|
||||
REPEAT S.line := 0;
|
||||
REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
|
||||
UNTIL S.eot OR (S.class = Texts.Int) & (S.i = n);
|
||||
IF ~S.eot THEN Texts.Read(S, ch); i := 0;
|
||||
WHILE ~S.eot & (ch # 0DX) DO buf[i] := ch; INC(i); Texts.Read(S, ch) END ;
|
||||
buf[i] := 0X; LogWStr(buf);
|
||||
END*)
|
||||
LogWStr(errors.errors[n]);
|
||||
END LogErrMsg;
|
||||
|
||||
PROCEDURE Mark*(n: INTEGER; pos: LONGINT);
|
||||
BEGIN
|
||||
IF useLineNo THEN
|
||||
IF n >= 0 THEN
|
||||
noerr := FALSE;
|
||||
IF (pos < lasterrpos) OR (lasterrpos + 9 < pos) THEN lasterrpos := pos; LogWLn; LogWStr(" ");
|
||||
IF n < 249 THEN LogWStr(" line "); LogWNum(pos DIV 256, 1);
|
||||
LogWStr(" pos "); LogWNum(pos MOD 256, 1); LogErrMsg(n)
|
||||
ELSIF n = 255 THEN LogWStr(" line "); LogWNum(pos DIV 256, 1);
|
||||
LogWStr(" pos "); LogWNum(pos MOD 256, 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
|
||||
END
|
||||
END
|
||||
ELSE
|
||||
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; 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 LogWLn; LogWStr(" pos"); LogWNum(pos, 6) END ;
|
||||
LogErrMsg(n);
|
||||
IF pos < 0 THEN LogWLn END
|
||||
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
|
||||
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;
|
||||
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);
|
||||
BEGIN
|
||||
IF (S.class = Texts.Name) & (S.s = name) THEN Texts.Scan(S);
|
||||
IF S.class = Texts.Int THEN size := SHORT(S.i); Texts.Scan(S) ELSE Mark(-157, -1) END ;
|
||||
IF S.class = Texts.Int THEN align := SHORT(S.i); Texts.Scan(S) ELSE Mark(-157, -1) END
|
||||
ELSE Mark(-157, -1)
|
||||
END
|
||||
END GetProperty;
|
||||
|
||||
PROCEDURE power0(i, j : INTEGER) : LONGINT; (* we would like to calculate exact Min Max values in GetProperties, not hardcode em, noch *)
|
||||
VAR k : INTEGER;
|
||||
p : LONGINT;
|
||||
BEGIN
|
||||
k := 1;
|
||||
p := i;
|
||||
REPEAT
|
||||
p := p * i;
|
||||
INC(k);
|
||||
UNTIL k=j;
|
||||
RETURN p;
|
||||
END power0;
|
||||
|
||||
|
||||
PROCEDURE GetProperties();
|
||||
VAR T: Texts.Text; S: Texts.Scanner;
|
||||
BEGIN
|
||||
|
||||
(* default characteristics *)
|
||||
IF ~useParFile THEN
|
||||
IF version.defaultTarget = version.gnux8664 THEN
|
||||
Console.String (" GNU "); Console.String(version.arch); Console.String(" target"); Console.Ln;
|
||||
ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 4; LIntSize := 8;
|
||||
SetSize := 8; RealSize := 4; LRealSize := 8; ProcSize := 8; PointerSize := 8; RecSize := 1;
|
||||
CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 4; LIntAlign := 8;
|
||||
SetAlign := 8; RealAlign := 4; LRealAlign := 8; ProcAlign := 8; PointerAlign := 8; RecAlign := 1;
|
||||
(* not necessary, we will calculate values later
|
||||
MinSInt := -80H; MaxSInt := 7FH;
|
||||
MinInt := 80000000H(*-2147483648*);
|
||||
MaxInt := 7FFFFFFFH (*2147483647*);
|
||||
(*MinLInt := -8000000000000000H*) (*-9223372036854775808*) ; (* -2^63 *)
|
||||
(*MaxLInt := 7FFFFFFFFFFFFFFFH *)(*9223372036854775807*) ;(* 2^63-1 *)
|
||||
(*MaxSet := 31;*)
|
||||
MaxSet := SetSize * 8 - 1; (*noch*)
|
||||
*)
|
||||
ELSIF (version.defaultTarget >= 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;
|
||||
SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1;
|
||||
|
||||
(* 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.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;
|
||||
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;
|
||||
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 *)
|
||||
Console.String ("loading type sizes from voc.par"); Console.Ln;
|
||||
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*)
|
||||
(* add here Max and Min sizes, noch *)
|
||||
ByteSize := CharSize;
|
||||
ELSE Mark(-156, -1)
|
||||
END ;
|
||||
ELSE Console.String ("not using voc.par file"); Console.Ln;
|
||||
END; (* if useParFile , noch *)
|
||||
|
||||
|
||||
MinSInt := power0(-2, (SIntSize*8-1)); (* -2^(SIntSize*8-1)*)
|
||||
MaxSInt := power0(2, (SIntSize*8-1))-1;
|
||||
MinInt := power0(-2, (IntSize*8-1));
|
||||
MaxInt := power0(2, (IntSize*8-1))-1;
|
||||
MinLInt := power0(-2, (LIntSize*8-1));
|
||||
MaxLInt := power0(2, (LIntSize*8-1))-1;
|
||||
|
||||
(*
|
||||
Console.Int(MinSInt, 0); Console.Ln;
|
||||
Console.Int(MaxSInt, 0); Console.Ln;
|
||||
Console.Int(MinInt, 0); Console.Ln;
|
||||
Console.Int(MaxInt, 0); Console.Ln;
|
||||
Console.Int(MinLInt, 0); Console.Ln;
|
||||
Console.Int(MaxLInt, 0); Console.Ln;
|
||||
*)
|
||||
|
||||
|
||||
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 *)
|
||||
|
||||
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);
|
||||
oldSFile := Files.Old(fileName); done := oldSFile # NIL;
|
||||
IF done THEN
|
||||
Files.Set(oldSF, oldSFile, 0); Files.Read(oldSF, ch);
|
||||
IF ch # SFtag THEN err(-306); (*possibly a symbol file from another Oberon implementation, e.g. HP-Oberon*)
|
||||
CloseOldSym; done := FALSE
|
||||
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;
|
||||
|
||||
PROCEDURE SymWInt*(i: LONGINT);
|
||||
BEGIN Files.WriteNum(newSF, i)
|
||||
END SymWInt;
|
||||
|
||||
PROCEDURE SymWSet*(s: SET);
|
||||
BEGIN Files.WriteNum(newSF, SYSTEM.VAL(LONGINT, s))
|
||||
END SymWSet;
|
||||
|
||||
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;
|
||||
|
||||
PROCEDURE NewSym*(VAR modName: ARRAY OF CHAR);
|
||||
VAR fileName: FileName;
|
||||
BEGIN MakeFileName(modName, fileName, SFext);
|
||||
newSFile := Files.New(fileName);
|
||||
IF newSFile # NIL THEN Files.Set(newSF, newSFile, 0); Files.Write(newSF, SFtag)
|
||||
ELSE err(153)
|
||||
END
|
||||
END NewSym;
|
||||
|
||||
(* ------------------------- Write Header & Body Files ------------------------- *)
|
||||
|
||||
PROCEDURE Write*(ch: CHAR);
|
||||
BEGIN Files.Write(R[currFile], ch)
|
||||
END Write;
|
||||
|
||||
PROCEDURE WriteString*(s: ARRAY [1] OF CHAR);
|
||||
VAR i: INTEGER;
|
||||
BEGIN i := 0;
|
||||
WHILE s[i] # 0X DO INC(i) END ;
|
||||
Files.WriteBytes(R[currFile], s, i)
|
||||
END WriteString;
|
||||
|
||||
PROCEDURE WriteStringVar*(VAR s: ARRAY OF CHAR);
|
||||
VAR i: INTEGER;
|
||||
BEGIN i := 0;
|
||||
WHILE s[i] # 0X DO INC(i) END ;
|
||||
Files.WriteBytes(R[currFile], s, i)
|
||||
END WriteStringVar;
|
||||
|
||||
PROCEDURE WriteHex* (i: LONGINT);
|
||||
VAR s: ARRAY 3 OF CHAR;
|
||||
digit : INTEGER;
|
||||
BEGIN
|
||||
digit := SHORT(i) DIV 16;
|
||||
IF digit < 10 THEN s[0] := CHR (ORD ("0") + digit); ELSE s[0] := CHR (ORD ("a") - 10 + digit ); END;
|
||||
digit := SHORT(i) MOD 16;
|
||||
IF digit < 10 THEN s[1] := CHR (ORD ("0") + digit); ELSE s[1] := CHR (ORD ("a") - 10 + digit ); END;
|
||||
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 *)
|
||||
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 ;
|
||||
IF i < 0 THEN s[k] := "-"; INC(k) END ;
|
||||
WHILE k > 0 DO DEC(k); Write(s[k]) END
|
||||
END ;
|
||||
END WriteInt;
|
||||
|
||||
PROCEDURE WriteReal* (r: LONGREAL; suffx: CHAR);
|
||||
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 suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ;
|
||||
WriteInt(ENTIER(r))
|
||||
ELSE
|
||||
Texts.OpenWriter(W);
|
||||
IF suffx = "f" THEN Texts.WriteLongReal(W, r, 16) ELSE Texts.WriteLongReal(W, r, 23) END ;
|
||||
NEW(T); Texts.Open(T, ""); Texts.Append(T, W.buf);
|
||||
Texts.OpenReader(R, T, 0); i := 0; Texts.Read(R, ch);
|
||||
WHILE ch # 0X DO s[i] := ch; INC(i); Texts.Read(R, ch) END ;
|
||||
(* s[i] := suffx; s[i+1] := 0X;
|
||||
suffix does not work in K&R *)
|
||||
s[i] := 0X;
|
||||
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)
|
||||
END
|
||||
END WriteReal;
|
||||
|
||||
PROCEDURE WriteLn* ();
|
||||
BEGIN Files.Write(R[currFile], 0AX)
|
||||
END WriteLn;
|
||||
|
||||
PROCEDURE Append(VAR R: Files.Rider; F: Files.File);
|
||||
VAR R1: Files.Rider; buffer: ARRAY 4096 OF CHAR;
|
||||
BEGIN
|
||||
IF F # NIL THEN
|
||||
Files.Set(R1, F, 0); Files.ReadBytes(R1, buffer, LEN(buffer));
|
||||
WHILE LEN(buffer) - R1.res > 0 DO
|
||||
Files.WriteBytes(R, buffer, LEN(buffer) - R1.res);
|
||||
Files.ReadBytes(R1, buffer, LEN(buffer))
|
||||
END
|
||||
END
|
||||
END Append;
|
||||
|
||||
PROCEDURE OpenFiles*(VAR moduleName: ARRAY OF CHAR);
|
||||
VAR FName: ARRAY 32 OF CHAR;
|
||||
BEGIN
|
||||
COPY(moduleName, modName);
|
||||
HFile := Files.New("");
|
||||
IF HFile # NIL THEN Files.Set(R[HeaderFile], HFile, 0) ELSE err(153) END ;
|
||||
MakeFileName(moduleName, FName, BFext);
|
||||
BFile := Files.New(FName);
|
||||
IF BFile # NIL THEN Files.Set(R[BodyFile], BFile, 0) ELSE err(153) END ;
|
||||
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
|
||||
IF modName = "SYSTEM" THEN
|
||||
IF ~(mainprog IN opt) THEN Files.Register(BFile) END
|
||||
ELSIF ~(mainprog IN opt) THEN
|
||||
Append(R[HeaderInclude], HFile);
|
||||
Files.Register(HIFile); Files.Register(BFile)
|
||||
ELSE
|
||||
MakeFileName(modName, FName, HFext); Files.Delete(FName, res);
|
||||
MakeFileName(modName, FName, SFext); Files.Delete(FName, res);
|
||||
Files.Register(BFile)
|
||||
END
|
||||
END ;
|
||||
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)
|
||||
END OPM.
|
||||
1066
src/voc/OPP.Mod
Normal file
1066
src/voc/OPP.Mod
Normal file
File diff suppressed because it is too large
Load diff
315
src/voc/OPS.Mod
Normal file
315
src/voc/OPS.Mod
Normal file
|
|
@ -0,0 +1,315 @@
|
|||
MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
|
||||
|
||||
IMPORT OPM;
|
||||
|
||||
CONST
|
||||
MaxStrLen* = 256;
|
||||
MaxIdLen = 32;
|
||||
|
||||
TYPE
|
||||
Name* = ARRAY MaxIdLen OF CHAR;
|
||||
String* = ARRAY MaxStrLen OF CHAR;
|
||||
|
||||
(* 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 *)
|
||||
realval*: REAL;
|
||||
lrlval*: LONGREAL;
|
||||
|
||||
(*symbols:
|
||||
| 0 1 2 3 4
|
||||
---|--------------------------------------------------------
|
||||
0 | null * / DIV MOD
|
||||
5 | & + - OR =
|
||||
10 | # < <= > >=
|
||||
15 | IN IS ^ . ,
|
||||
20 | : .. ) ] }
|
||||
25 | OF THEN DO TO BY
|
||||
30 | ( [ { ~ :=
|
||||
35 | number NIL string ident ;
|
||||
40 | | END ELSE ELSIF UNTIL
|
||||
45 | IF CASE WHILE REPEAT FOR
|
||||
50 | LOOP WITH EXIT RETURN ARRAY
|
||||
55 | RECORD POINTER BEGIN CONST TYPE
|
||||
60 | VAR PROCEDURE IMPORT MODULE eof *)
|
||||
|
||||
CONST
|
||||
(* numtyp values *)
|
||||
char = 1; integer = 2; real = 3; longreal = 4;
|
||||
|
||||
(*symbol values*)
|
||||
null = 0; times = 1; slash = 2; div = 3; mod = 4;
|
||||
and = 5; plus = 6; minus = 7; or = 8; eql = 9;
|
||||
neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
|
||||
in = 15; is = 16; arrow = 17; period = 18; comma = 19;
|
||||
colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
|
||||
of = 25; then = 26; do = 27; to = 28; by = 29;
|
||||
lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
|
||||
number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
|
||||
bar = 40; end = 41; else = 42; elsif = 43; until = 44;
|
||||
if = 45; case = 46; while = 47; repeat = 48; for = 49;
|
||||
loop = 50; with = 51; exit = 52; return = 53; array = 54;
|
||||
record = 55; pointer = 56; begin = 57; const = 58; type = 59;
|
||||
var = 60; procedure = 61; import = 62; module = 63; eof = 64;
|
||||
|
||||
VAR
|
||||
ch: CHAR; (*current character*)
|
||||
|
||||
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;
|
||||
LOOP OPM.Get(ch);
|
||||
IF ch = och THEN EXIT END ;
|
||||
IF ch < " " THEN err(3); EXIT END ;
|
||||
IF i = MaxStrLen-1 THEN err(241); EXIT END ;
|
||||
str[i] := ch; INC(i)
|
||||
END ;
|
||||
OPM.Get(ch); str[i] := 0X; intval := i + 1;
|
||||
IF intval = 2 THEN
|
||||
sym := number; numtyp := 1; intval := ORD(str[0])
|
||||
ELSE sym := string
|
||||
END
|
||||
END Str;
|
||||
|
||||
PROCEDURE Identifier(VAR sym: SHORTINT);
|
||||
VAR i: INTEGER;
|
||||
BEGIN i := 0;
|
||||
REPEAT
|
||||
name[i] := ch; INC(i); OPM.Get(ch)
|
||||
UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
|
||||
IF i = MaxIdLen THEN err(240); DEC(i) END ;
|
||||
name[i] := 0X; sym := ident
|
||||
END Identifier;
|
||||
|
||||
PROCEDURE Number;
|
||||
VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
|
||||
|
||||
PROCEDURE Ten(e: INTEGER): LONGREAL;
|
||||
VAR x, p: LONGREAL;
|
||||
BEGIN x := 1; p := 10;
|
||||
WHILE e > 0 DO
|
||||
IF ODD(e) THEN x := x*p END;
|
||||
e := e DIV 2;
|
||||
IF e > 0 THEN p := p*p END (* prevent overflow *)
|
||||
END;
|
||||
RETURN x
|
||||
END Ten;
|
||||
|
||||
PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
|
||||
BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
|
||||
IF ch <= "9" THEN RETURN ORD(ch) - ORD("0")
|
||||
ELSIF hex THEN RETURN ORD(ch) - ORD("A") + 10
|
||||
ELSE err(2); RETURN 0
|
||||
END
|
||||
END Ord;
|
||||
|
||||
BEGIN (* ("0" <= ch) & (ch <= "9") *)
|
||||
i := 0; m := 0; n := 0; d := 0;
|
||||
LOOP (* read mantissa *)
|
||||
IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
|
||||
IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
|
||||
IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
|
||||
INC(m)
|
||||
END;
|
||||
OPM.Get(ch); INC(i)
|
||||
ELSIF ch = "." THEN OPM.Get(ch);
|
||||
IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
|
||||
ELSIF d = 0 THEN (* i > 0 *) d := i
|
||||
ELSE err(2)
|
||||
END
|
||||
ELSE EXIT
|
||||
END
|
||||
END; (* 0 <= n <= m <= i, 0 <= d <= i *)
|
||||
IF d = 0 THEN (* integer *)
|
||||
IF n = m THEN intval := 0; i := 0;
|
||||
IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char;
|
||||
IF n <= 2 THEN
|
||||
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
|
||||
ELSE err(203)
|
||||
END
|
||||
ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
|
||||
IF n <= OPM.MaxHDig THEN
|
||||
IF (n = OPM.MaxHDig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
|
||||
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
|
||||
ELSE err(203)
|
||||
END
|
||||
ELSE (* decimal *) numtyp := integer;
|
||||
WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
|
||||
IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
|
||||
ELSE err(203)
|
||||
END
|
||||
END
|
||||
END
|
||||
ELSE err(203)
|
||||
END
|
||||
ELSE (* fraction *)
|
||||
f := 0; e := 0; expCh := "E";
|
||||
WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
|
||||
IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
|
||||
IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
|
||||
ELSIF ch = "+" THEN OPM.Get(ch)
|
||||
END;
|
||||
IF ("0" <= ch) & (ch <= "9") THEN
|
||||
REPEAT n := Ord(ch, FALSE); OPM.Get(ch);
|
||||
IF e <= (MAX(INTEGER) - n) DIV 10 THEN e := e*10 + n
|
||||
ELSE err(203)
|
||||
END
|
||||
UNTIL (ch < "0") OR ("9" < ch);
|
||||
IF neg THEN e := -e END
|
||||
ELSE err(2)
|
||||
END
|
||||
END;
|
||||
DEC(e, i-d-m); (* decimal point shift *)
|
||||
IF expCh = "E" THEN numtyp := real;
|
||||
IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
|
||||
IF e < 0 THEN realval := SHORT(f / Ten(-e))
|
||||
ELSE realval := SHORT(f * Ten(e))
|
||||
END
|
||||
ELSE err(203)
|
||||
END
|
||||
ELSE numtyp := longreal;
|
||||
IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
|
||||
IF e < 0 THEN lrlval := f / Ten(-e)
|
||||
ELSE lrlval := f * Ten(e)
|
||||
END
|
||||
ELSE err(203)
|
||||
END
|
||||
END
|
||||
END
|
||||
END Number;
|
||||
|
||||
PROCEDURE Get*(VAR sym: SHORTINT);
|
||||
VAR s: SHORTINT;
|
||||
|
||||
PROCEDURE Comment; (* do not read after end of file *)
|
||||
BEGIN OPM.Get(ch);
|
||||
LOOP
|
||||
LOOP
|
||||
WHILE ch = "(" DO OPM.Get(ch);
|
||||
IF ch = "*" THEN Comment END
|
||||
END ;
|
||||
IF ch = "*" THEN OPM.Get(ch); EXIT END ;
|
||||
IF ch = OPM.Eot THEN EXIT END ;
|
||||
OPM.Get(ch)
|
||||
END ;
|
||||
IF ch = ")" THEN OPM.Get(ch); EXIT END ;
|
||||
IF ch = OPM.Eot THEN err(5); EXIT END
|
||||
END
|
||||
END Comment;
|
||||
|
||||
BEGIN
|
||||
OPM.errpos := OPM.curpos-1;
|
||||
WHILE ch <= " " DO (*ignore control characters*)
|
||||
IF ch = OPM.Eot THEN sym := eof; RETURN
|
||||
ELSE OPM.Get(ch)
|
||||
END
|
||||
END ;
|
||||
CASE ch OF (* ch > " " *)
|
||||
| 22X, 27X : Str(s)
|
||||
| "#" : s := neq; OPM.Get(ch)
|
||||
| "&" : s := and; OPM.Get(ch)
|
||||
| "(" : OPM.Get(ch);
|
||||
IF ch = "*" THEN Comment; Get(s)
|
||||
ELSE s := lparen
|
||||
END
|
||||
| ")" : s := rparen; OPM.Get(ch)
|
||||
| "*" : s := times; OPM.Get(ch)
|
||||
| "+" : s := plus; OPM.Get(ch)
|
||||
| "," : s := comma; OPM.Get(ch)
|
||||
| "-" : s := minus; OPM.Get(ch)
|
||||
| "." : OPM.Get(ch);
|
||||
IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END
|
||||
| "/" : s := slash; OPM.Get(ch)
|
||||
| "0".."9": Number; s := number
|
||||
| ":" : OPM.Get(ch);
|
||||
IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END
|
||||
| ";" : s := semicolon; OPM.Get(ch)
|
||||
| "<" : OPM.Get(ch);
|
||||
IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END
|
||||
| "=" : s := eql; OPM.Get(ch)
|
||||
| ">" : OPM.Get(ch);
|
||||
IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END
|
||||
| "A": Identifier(s); IF name = "ARRAY" THEN s := array END
|
||||
| "B": Identifier(s);
|
||||
IF name = "BEGIN" THEN s := begin
|
||||
ELSIF name = "BY" THEN s := by
|
||||
END
|
||||
| "C": Identifier(s);
|
||||
IF name = "CASE" THEN s := case
|
||||
ELSIF name = "CONST" THEN s := const
|
||||
END
|
||||
| "D": Identifier(s);
|
||||
IF name = "DO" THEN s := do
|
||||
ELSIF name = "DIV" THEN s := div
|
||||
END
|
||||
| "E": Identifier(s);
|
||||
IF name = "END" THEN s := end
|
||||
ELSIF name = "ELSE" THEN s := else
|
||||
ELSIF name = "ELSIF" THEN s := elsif
|
||||
ELSIF name = "EXIT" THEN s := exit
|
||||
END
|
||||
| "F": Identifier(s); IF name = "FOR" THEN s := for END
|
||||
| "I": Identifier(s);
|
||||
IF name = "IF" THEN s := if
|
||||
ELSIF name = "IN" THEN s := in
|
||||
ELSIF name = "IS" THEN s := is
|
||||
ELSIF name = "IMPORT" THEN s := import
|
||||
END
|
||||
| "L": Identifier(s); IF name = "LOOP" THEN s := loop END
|
||||
| "M": Identifier(s);
|
||||
IF name = "MOD" THEN s := mod
|
||||
ELSIF name = "MODULE" THEN s := module
|
||||
END
|
||||
| "N": Identifier(s); IF name = "NIL" THEN s := nil END
|
||||
| "O": Identifier(s);
|
||||
IF name = "OR" THEN s := or
|
||||
ELSIF name = "OF" THEN s := of
|
||||
END
|
||||
| "P": Identifier(s);
|
||||
IF name = "PROCEDURE" THEN s := procedure
|
||||
ELSIF name = "POINTER" THEN s := pointer
|
||||
END
|
||||
| "R": Identifier(s);
|
||||
IF name = "RECORD" THEN s := record
|
||||
ELSIF name = "REPEAT" THEN s := repeat
|
||||
ELSIF name = "RETURN" THEN s := return
|
||||
END
|
||||
| "T": Identifier(s);
|
||||
IF name = "THEN" THEN s := then
|
||||
ELSIF name = "TO" THEN s := to
|
||||
ELSIF name = "TYPE" THEN s := type
|
||||
END
|
||||
| "U": Identifier(s); IF name = "UNTIL" THEN s := until END
|
||||
| "V": Identifier(s); IF name = "VAR" THEN s := var END
|
||||
| "W": Identifier(s);
|
||||
IF name = "WHILE" THEN s := while
|
||||
ELSIF name = "WITH" THEN s := with
|
||||
END
|
||||
| "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
|
||||
| "[" : s := lbrak; OPM.Get(ch)
|
||||
| "]" : s := rbrak; OPM.Get(ch)
|
||||
| "^" : s := arrow; OPM.Get(ch)
|
||||
| "a".."z": Identifier(s)
|
||||
| "{" : s := lbrace; OPM.Get(ch)
|
||||
| "|" : s := bar; OPM.Get(ch)
|
||||
| "}" : s := rbrace; OPM.Get(ch)
|
||||
| "~" : s := not; OPM.Get(ch)
|
||||
| 7FX : s := upto; OPM.Get(ch)
|
||||
ELSE s := null; OPM.Get(ch)
|
||||
END ;
|
||||
sym := s
|
||||
END Get;
|
||||
|
||||
PROCEDURE Init*;
|
||||
BEGIN ch := " "
|
||||
END Init;
|
||||
|
||||
END OPS.
|
||||
1243
src/voc/OPT.Mod
Normal file
1243
src/voc/OPT.Mod
Normal file
File diff suppressed because it is too large
Load diff
1023
src/voc/OPV.Mod
Normal file
1023
src/voc/OPV.Mod
Normal file
File diff suppressed because it is too large
Load diff
213
src/voc/errors.Mod
Normal file
213
src/voc/errors.Mod
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
MODULE errors;
|
||||
|
||||
TYPE string* = ARRAY 128 OF CHAR;
|
||||
|
||||
VAR errors- : ARRAY 350 OF string;
|
||||
|
||||
|
||||
BEGIN
|
||||
(* Incorroct use of the language Oberon *)
|
||||
errors[0] := "undeclared identifier";
|
||||
errors[1] := "multiply defined identifier";
|
||||
errors[2] := "illegal character in number";
|
||||
errors[3] := "illegal character in string";
|
||||
errors[4] := "identifier does not match procedure name";
|
||||
errors[5] := "comment not closed";
|
||||
errors[6] := "";
|
||||
errors[6] := "";
|
||||
errors[6] := "";
|
||||
errors[9] := "'=' expected";
|
||||
errors[10] :="";
|
||||
errors[11] :="";
|
||||
errors[12] := "type definition starts with incorrect symbol";
|
||||
errors[13] := "factor starts with incorrect symbol";
|
||||
errors[14] := "statement starts with incorrect symbol";
|
||||
errors[15] := "declaration followed by incorrect symbol";
|
||||
errors[16] := "MODULE expected";
|
||||
errors[17] := "";
|
||||
errors[18] := "'.' missing";
|
||||
errors[19] := "',' missing";
|
||||
errors[20] := "':' missing";
|
||||
errors[21] := "";
|
||||
errors[22] := "')' missing";
|
||||
errors[23] := "']' missing";
|
||||
errors[24] := "'}' missing";
|
||||
errors[25] := "OF missing";
|
||||
errors[26] := "THEN missing";
|
||||
errors[27] := "DO missing";
|
||||
errors[28] := "TO missing";
|
||||
errors[29] := "";
|
||||
errors[30] := "'(' missing";
|
||||
errors[31] := "";
|
||||
errors[32] := "";
|
||||
errors[33] := "";
|
||||
errors[34] := "':=' missing";
|
||||
errors[35] := "',' or OF expected";
|
||||
errors[36] := "";
|
||||
errors[37] := "";
|
||||
errors[38] := "identifier expected";
|
||||
errors[39] := "';' missing";
|
||||
errors[40] := "";
|
||||
errors[41] := "END missing";
|
||||
errors[42] := "";
|
||||
errors[43] := "";
|
||||
errors[44] := "UNTIL missing";
|
||||
errors[45] := "";
|
||||
errors[46] := "EXIT not within loop statement";
|
||||
errors[47] := "illegally marked identifier";
|
||||
errors[48] := "";
|
||||
errors[49] := "";
|
||||
errors[50] := "expression should be constant";
|
||||
errors[51] := "constant not an integer";
|
||||
errors[52] := "identifier does not denote a type";
|
||||
errors[53] := "identifier does not denote a record type";
|
||||
errors[54] := "result type of procedure is not a basic type";
|
||||
errors[55] := "procedure call of a function";
|
||||
errors[56] := "assignment to non-variable";
|
||||
errors[57] := "pointer not bound to record or array type";
|
||||
errors[58] := "recursive type definition";
|
||||
errors[59] := "illegal open array parameter";
|
||||
errors[60] := "wrong type of case label";
|
||||
errors[61] := "inadmissible type of case label";
|
||||
errors[62] := "case label defined more than once";
|
||||
errors[63] := "illegal value of constant";
|
||||
errors[64] := "more actual than formal parameters";
|
||||
errors[65] := "fewer actual than formal parameters";
|
||||
errors[66] := "element types of actual array and formal open array differ";
|
||||
errors[67] := "actual parameter corresponding to open array is not an array";
|
||||
errors[68] := "control variable must be integer";
|
||||
errors[69] := "parameter must be an integer constant";
|
||||
errors[70] := "pointer or VAR record required as formal receiver";
|
||||
errors[71] := "pointer expected as actual receiver";
|
||||
errors[72] := "procedure must be bound to a record of the same scope";
|
||||
errors[73] := "procedure must have level 0";
|
||||
errors[74] := "procedure unknown in base type";
|
||||
errors[75] := "invalid call of base procedure";
|
||||
errors[76] := "this variable (field) is read only";
|
||||
errors[77] := "object is not a record";
|
||||
errors[78] := "dereferenced object is not a variable";
|
||||
errors[79] := "indexed object is not a variable";
|
||||
errors[80] := "index expression is not an integer";
|
||||
errors[81] := "index out of specified bounds";
|
||||
errors[82] := "indexed variable is not an array";
|
||||
errors[83] := "undefined record field";
|
||||
errors[84] := "dereferenced variable is not a pointer";
|
||||
errors[85] := "guard or test type is not an extension of variable type";
|
||||
errors[86] := "guard or testtype is not a pointer";
|
||||
errors[87] := "guarded or tested variable is neither a pointer nor a VAR-parameter record";
|
||||
errors[88] := "open array not allowed as variable, record field or array element";
|
||||
errors[89] := "";
|
||||
errors[90] := "";
|
||||
errors[91] := "";
|
||||
errors[92] := "operand of IN not an integer, or not a set";
|
||||
errors[93] := "set element type is not an integer";
|
||||
errors[94] := "operand of & is not of type BOOLEAN";
|
||||
errors[95] := "operand of OR is not of type BOOLEAN";
|
||||
errors[96] := "operand not applicable to (unary) +";
|
||||
errors[97] := "operand not applicable to (unary) -";
|
||||
errors[98] := "operand of ~ is not of type BOOLEAN";
|
||||
errors[99] := "ASSERT fault";
|
||||
errors[100] := "incompatible operands of dyadic operator";
|
||||
errors[101] := "operand type inapplicable to *";
|
||||
errors[102] := "operand type inapplicable to /";
|
||||
errors[103] := "operand type inapplicable to DIV";
|
||||
errors[104] := "operand type inapplicable to MOD";
|
||||
errors[105] := "operand type inapplicable to +";
|
||||
errors[106] := "operand type inapplicable to -";
|
||||
errors[107] := "operand type inapplicable to = or #";
|
||||
errors[108] := "operand type inapplicable to relation";
|
||||
errors[109] := "overriding method must be exported";
|
||||
errors[110] := "operand is not a type";
|
||||
errors[111] := "operand inapplicable to (this) function";
|
||||
errors[112] := "operand is not a variable";
|
||||
errors[113] := "incompatible assignment";
|
||||
errors[114] := "string too long to be assigned";
|
||||
errors[115] := "parameter doesn't match";
|
||||
errors[116] := "number of parameters doesn't match";
|
||||
errors[117] := "result type doesn't match";
|
||||
errors[118] := "export mark doesn't match with forward declaration";
|
||||
errors[119] := "redefinition textually precedes procedure bound to base type";
|
||||
errors[120] := "type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN";
|
||||
errors[121] := "called object is not a procedure (or is an interrupt procedure)";
|
||||
errors[122] := "actual VAR-parameter is not a variable";
|
||||
errors[123] := "type of actual parameter is not identical with that of formal VAR-parameter";
|
||||
errors[124] := "type of result expression differs from that of procedure";
|
||||
errors[125] := "type of case expression is neither INTEGER nor CHAR";
|
||||
errors[126] := "this expression cannot be a type or a procedure";
|
||||
errors[127] := "illegal use of object";
|
||||
errors[128] := "unsatisfied forward reference";
|
||||
errors[129] := "unsatisfied forward procedure";
|
||||
errors[130] := "WITH clause does not specify a variable";
|
||||
errors[131] := "LEN not applied to array";
|
||||
errors[132] := "dimension in LEN too large or negative";
|
||||
errors[135] := "SYSTEM not imported";
|
||||
errors[150] := "key inconsistency of imported module";
|
||||
errors[151] := "incorrect symbol file";
|
||||
errors[152] := "symbol file of imported module not found";
|
||||
errors[153] := "object or symbol file not opened (disk full?)";
|
||||
errors[154] := "recursive import not allowed";
|
||||
errors[155] := "generation of new symbol file not allowed";
|
||||
errors[156] := "parameter file not found";
|
||||
errors[157] := "syntax error in parameter file";
|
||||
(* Limitations of implementation*)
|
||||
errors[200] := "not yet implemented";
|
||||
errors[201] := "lower bound of set range greater than higher bound";
|
||||
errors[202] := "set element greater than MAX(SET) or less than 0";
|
||||
errors[203] := "number too large";
|
||||
errors[204] := "product too large";
|
||||
errors[205] := "division by zero";
|
||||
errors[206] := "sum too large";
|
||||
errors[207] := "difference too large";
|
||||
errors[208] := "overflow in arithmetic shift";
|
||||
errors[209] := "case range too large";
|
||||
errors[213] := "too many cases in case statement";
|
||||
errors[218] := "illegal value of parameter (0 <= p < 256)";
|
||||
errors[219] := "machine registers cannot be accessed";
|
||||
errors[220] := "illegal value of parameter";
|
||||
errors[221] := "too many pointers in a record";
|
||||
errors[222] := "too many global pointers";
|
||||
errors[223] := "too many record types";
|
||||
errors[224] := "too many pointer types";
|
||||
errors[225] := "address of pointer variable too large (move forward in text)";
|
||||
errors[226] := "too many exported procedures";
|
||||
errors[227] := "too many imported modules";
|
||||
errors[228] := "too many exported structures";
|
||||
errors[229] := "too many nested records for import";
|
||||
errors[230] := "too many constants (strings) in module";
|
||||
errors[231] := "too many link table entries (external procedures)";
|
||||
errors[232] := "too many commands in module";
|
||||
errors[233] := "record extension hierarchy too high";
|
||||
errors[234] := "export of recursive type not allowed";
|
||||
errors[240] := "identifier too long";
|
||||
errors[241] := "string too long";
|
||||
errors[242] := "address overflow";
|
||||
errors[244] := "cyclic type definition not allowed";
|
||||
errors[245] := "guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable";
|
||||
(* Compiler Warnings *)
|
||||
|
||||
errors[301] := "implicit type cast";
|
||||
errors[306] := "inappropriate symbol file ignored";
|
||||
|
||||
END errors.
|
||||
(*
|
||||
Run-time Error Messages
|
||||
SYSTEM_halt
|
||||
0 silent HALT(0)
|
||||
1..255 HALT(n), cf. SYSTEM_halt
|
||||
-1 assertion failed, cf. SYSTEM_assert
|
||||
-2 invalid array index
|
||||
-3 function procedure without RETURN statement
|
||||
-4 invalid case in CASE statement
|
||||
-5 type guard failed
|
||||
-6 implicit type guard in record assignment failed
|
||||
-7 invalid case in WITH statement
|
||||
-8 value out of range
|
||||
-9 (delayed) interrupt
|
||||
-10 NIL access
|
||||
-11 alignment error
|
||||
-12 zero divide
|
||||
-13 arithmetic overflow/underflow
|
||||
-14 invalid function argument
|
||||
-15 internal error
|
||||
*)
|
||||
|
||||
4
src/voc/gnuc/armv6j/architecture.Mod
Normal file
4
src/voc/gnuc/armv6j/architecture.Mod
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
MODULE architecture;
|
||||
CONST arch* = "armv6j";
|
||||
|
||||
END architecture.
|
||||
4
src/voc/gnuc/armv6j_hardfp/architecture.Mod
Normal file
4
src/voc/gnuc/armv6j_hardfp/architecture.Mod
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
MODULE architecture;
|
||||
CONST arch* = "armv6j_hardfp";
|
||||
|
||||
END architecture.
|
||||
4
src/voc/gnuc/armv7a_hardfp/architecture.Mod
Normal file
4
src/voc/gnuc/armv7a_hardfp/architecture.Mod
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
MODULE architecture;
|
||||
CONST arch* = "armv7a_hardfp";
|
||||
|
||||
END architecture.
|
||||
79
src/voc/gnuc/extTools.Mod
Normal file
79
src/voc/gnuc/extTools.Mod
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
MODULE extTools;
|
||||
IMPORT Args, Unix, Strings := oocOakStrings, 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
|
||||
*)
|
||||
|
||||
VAR incPath0, incPath1, ccOpt, ccString, CFLAGS, tmp0, tmp1 : ARRAY 256 OF CHAR;
|
||||
|
||||
PROCEDURE Assemble*(m : ARRAY OF CHAR);
|
||||
VAR cmd : ARRAY 256 OF CHAR;
|
||||
cc : ARRAY 23 OF CHAR;
|
||||
ext : ARRAY 5 OF CHAR;
|
||||
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;
|
||||
|
||||
|
||||
PROCEDURE LinkMain*(VAR m : ARRAY OF CHAR; statically : BOOLEAN);
|
||||
VAR lpath : ARRAY 256 OF CHAR;
|
||||
cc : ARRAY 256 OF CHAR;
|
||||
ccopt : ARRAY 256 OF CHAR;
|
||||
cmd : ARRAY 256 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);
|
||||
IF statically THEN Strings.Append(" -static ", cmd) END;
|
||||
Strings.Append(" -o ", cmd);
|
||||
Strings.Append(m, cmd);
|
||||
Strings.Append(" ", cmd);
|
||||
Strings.Append(ccOpt, cmd);
|
||||
Console.Ln; Console.String(cmd); Console.Ln;
|
||||
Unix.system(cmd);
|
||||
END LinkMain;
|
||||
|
||||
BEGIN
|
||||
|
||||
incPath0 := "src/lib/system/gnuc/x86_64 ";
|
||||
incPath1 := "lib/voc/obj ";
|
||||
ccOpt := " -fPIC -g -I ";
|
||||
COPY (version.prefix, tmp1);
|
||||
Strings.Append("/", tmp1);
|
||||
Strings.Append(incPath0, tmp1);
|
||||
Strings.Append(" -I ", tmp1);
|
||||
Strings.Append(version.prefix, tmp1);
|
||||
Strings.Append("/", tmp1);
|
||||
Strings.Append(incPath1, tmp1);
|
||||
Strings.Append(tmp1, ccOpt);
|
||||
Strings.Append ("-lVishapOberon -L. -L", ccOpt);
|
||||
Strings.Append (version.prefix, ccOpt);
|
||||
Strings.Append ("/lib ", ccOpt);
|
||||
Args.GetEnv("CFLAGS", CFLAGS);
|
||||
Strings.Append (CFLAGS, ccOpt);
|
||||
Strings.Append (" ", ccOpt);
|
||||
ccString := "cc ";
|
||||
(*Strings.Append (ccOpt, ccString);*)
|
||||
|
||||
END extTools.
|
||||
4
src/voc/gnuc/x86/architecture.Mod
Normal file
4
src/voc/gnuc/x86/architecture.Mod
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
MODULE architecture;
|
||||
CONST arch* = "x86";
|
||||
|
||||
END architecture.
|
||||
4
src/voc/gnuc/x86_64/architecture.Mod
Normal file
4
src/voc/gnuc/x86_64/architecture.Mod
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
MODULE architecture;
|
||||
CONST arch* = "x86_64";
|
||||
|
||||
END architecture.
|
||||
38
src/voc/version.Mod
Normal file
38
src/voc/version.Mod
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
MODULE version;
|
||||
IMPORT Strings := oocOakStrings, architecture;
|
||||
CONST
|
||||
(* targets *)
|
||||
gnux86* = 0; gnux8664* = 1; gnuarmv6j* = 2; gnuarmv6jhardfp* = 3; gnuarmv7ahardfp* = 4;
|
||||
|
||||
VAR arch-, version-, date-, versionLong-, prefix0-, prefix- : ARRAY 23 OF CHAR;
|
||||
defaultTarget* : INTEGER;
|
||||
BEGIN
|
||||
arch := architecture.arch;
|
||||
date := " [2013/09/23]";
|
||||
version := "1.0";
|
||||
versionLong := "";
|
||||
COPY(version, versionLong);
|
||||
Strings.Append (" ", versionLong);
|
||||
Strings.Append(date, versionLong);
|
||||
prefix := "";
|
||||
prefix0 := "/opt";
|
||||
COPY (prefix0, prefix);
|
||||
Strings.Append ("/voc-", prefix);
|
||||
Strings.Append(version, prefix); (* /opt/voc-1.0 *)
|
||||
(* will be used later in Kernel.Mod to set OBERON default path *)
|
||||
|
||||
IF arch = "x86_64" THEN
|
||||
defaultTarget := gnux8664
|
||||
ELSIF arch = "x86" THEN
|
||||
defaultTarget := gnux86
|
||||
ELSIF arch = "armv6j" THEN
|
||||
defaultTarget := gnuarmv6j
|
||||
ELSIF arch = "armv6j_hardfp" THEN
|
||||
defaultTarget := gnuarmv6jhardfp
|
||||
ELSIF arch = "armv7a_hardfp" THEN
|
||||
defaultTarget := gnuarmv7ahardfp
|
||||
ELSE
|
||||
defaultTarget := gnux8664
|
||||
END
|
||||
|
||||
END version.
|
||||
111
src/voc/voc.Mod
Normal file
111
src/voc/voc.Mod
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
MODULE voc; (* J. Templ 3.2.95 *)
|
||||
|
||||
IMPORT
|
||||
SYSTEM, Unix, Kernel,
|
||||
OPP, OPB, OPT,
|
||||
OPV, OPC, OPM,
|
||||
extTools;
|
||||
|
||||
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
|
||||
OPP.Module(p, OPM.opt);
|
||||
IF OPM.noerr THEN
|
||||
OPV.Init;
|
||||
OPV.AdrAndSize(OPT.topScope);
|
||||
OPT.Export(ext, new);
|
||||
IF OPM.noerr THEN
|
||||
OPM.OpenFiles(OPT.SelfName);
|
||||
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; OPM.LogWStr(" main program")
|
||||
ELSE
|
||||
IF new THEN OPM.LogWStr(" new symbol file"); OPM.RegisterNewSym
|
||||
ELSIF ext THEN OPM.LogWStr(" extended symbol file"); OPM.RegisterNewSym
|
||||
END
|
||||
END;
|
||||
|
||||
|
||||
ELSE OPM.DeleteNewSym
|
||||
END
|
||||
END
|
||||
END ;
|
||||
OPM.CloseFiles; OPT.Close;
|
||||
OPM.LogWLn; done := OPM.noerr;
|
||||
|
||||
(* noch *)
|
||||
IF done THEN
|
||||
IF ~OPM.dontAsm THEN
|
||||
IF ~(OPM.mainProg OR OPM.mainLinkStat) THEN
|
||||
extTools.Assemble(OPM.modName);
|
||||
ELSE
|
||||
IF ~OPM.dontLink THEN
|
||||
extTools.LinkMain (OPM.modName, OPM.mainLinkStat);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END
|
||||
|
||||
|
||||
|
||||
END Module;
|
||||
|
||||
PROCEDURE Translate*;
|
||||
VAR done: BOOLEAN;
|
||||
BEGIN
|
||||
OPM.OpenPar; (* gclock(); slightly faste rtranslation but may lead to opening "too many files" *)
|
||||
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;
|
||||
LOOP
|
||||
OPM.Init(done, mname);
|
||||
IF ~done THEN EXIT END ;
|
||||
OPM.InitOptions;
|
||||
Kernel.GC(FALSE);
|
||||
Module(done);
|
||||
IF ~done THEN Unix.Exit(1) END
|
||||
END
|
||||
END Translate;
|
||||
|
||||
BEGIN
|
||||
signal(2, Trap); (* interrupt *)
|
||||
signal(3, Trap); (* quit *)
|
||||
signal(4, Trap); (* illegal instruction, HALT *)
|
||||
OPB.typSize := OPV.TypSize; OPT.typSize := OPV.TypSize; Translate
|
||||
END voc.
|
||||
Loading…
Add table
Add a link
Reference in a new issue