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

Use SYSTEM.ADDRESS in libraries. Build all with -O2. Support INC(a,b) for any int a,b that support a:=a+b.

Browse source
This commit is contained in:
David Brown 2016-09-23 13:04:24 +01:00
parent f1cbbdba28
commit 22a4f8e263
92 changed files with 2752 additions and 2695 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/compiler/OPB.Mod
View file

@ -1098,7 +1098,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126); p^.typ := OPT.notyp
ELSE
IF x^.typ # p^.typ THEN
IF (x^.class = OPT.Nconst) & (f = OPT.Int) THEN Convert(x, p^.typ)
IF (f = OPT.Int)
& ( (x^.class = OPT.Nconst)
OR (p.typ.form = OPT.Int) & (x.typ.size <= p.typ.size)) THEN Convert(x, p^.typ)
ELSE err(111)
END
END ;

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

@ -871,17 +871,9 @@ BEGIN
AddressSize := Configuration.addressSize;
Alignment := Configuration.alignment;
IF Configuration.intsize = 2 THEN
(* Original Oberon-2 implementation sizes (-O2) *)
ShortintSize := 1;
IntegerSize := 2;
LongintSize := 4;
SetSize := 4;
ELSE
(* Legacy Vishap 64 bit build sizes (-OV) *)
ShortintSize := 1;
IntegerSize := 4;
LongintSize := 8;
SetSize := 8;
END
(* Default type size model is that of the original Oberon-2 implementation (-O2) *)
ShortintSize := 1;
IntegerSize := 2;
LongintSize := 4;
SetSize := 4
END OPM.

3
src/library/s3/ethMD5.Mod
View file

@ -41,7 +41,8 @@ under a public-key cryptosystem such as RSA. *)
PROCEDURE ByteReverse(VAR in: ARRAY OF SYSTEM.BYTE; VAR out: ARRAY OF LONGINT; longs: LONGINT);
VAR
adr, t, i: LONGINT;
adr: SYSTEM.ADDRESS;
t, i: LONGINT;
bytes: ARRAY 4 OF CHAR;
BEGIN
adr := SYSTEM.ADR(in[0]); i := 0;

22
src/library/s3/ethZlibBuffers.Mod
View file

@ -3,8 +3,7 @@ Refer to the "General ETH Oberon System Source License" contract available at: h
MODULE ethZlibBuffers; (** Stefan Walthert **)
IMPORT
SYSTEM;
IMPORT SYSTEM;
(*
should be portable even if SYSTEM is imported:
- PUT and GET only with byte sized operands
@ -13,13 +12,14 @@ IMPORT
TYPE
(** input/output buffer **)
Address = LONGINT;
Address = SYSTEM.ADDRESS;
Buffer* = RECORD
avail-: LONGINT; (** number of bytes that can be produced/consumed **)
size-: LONGINT; (** total number of bytes in buffer memory **)
totalOut-, totalIn-: LONGINT; (** total number of bytes produced/consumed **)
next: Address; (* address of next byte to produce/consume **)
adr: Address; (* buffer memory *)
avail-: LONGINT; (** number of bytes that can be produced/consumed **)
size-: LONGINT; (** total number of bytes in buffer memory **)
totalOut-: LONGINT; (** total number of bytes produced **)
totalIn-: LONGINT; (** total number of bytes consumed **)
next: Address; (* address of next byte to produce/consume **)
adr: Address; (* buffer memory *)
END;
@ -50,9 +50,9 @@ PROCEDURE ReadBytes* (VAR buf: Buffer; VAR dst: ARRAY OF CHAR; offset, len: LONG
BEGIN
ASSERT((0 <= offset) & (0 < len) & (offset + len <= LEN(dst)) & (len <= buf.avail), 100);
SYSTEM.MOVE(buf.next, SYSTEM.ADR(dst[offset]), len);
INC(buf.next, len); DEC(buf.avail, len); INC(buf.totalIn, len)
INC(buf.next, len); DEC(buf.avail, len); INC(buf.totalIn, len)
END ReadBytes;
(** write byte into (output) buffer **)
PROCEDURE Write* (VAR buf: Buffer; ch: CHAR);
BEGIN
@ -89,7 +89,7 @@ PROCEDURE Rewrite* (VAR buf: Buffer);
BEGIN
buf.next := buf.adr; buf.avail := buf.size
END Rewrite;
(** fill input buffer with new bytes to consume **)
PROCEDURE Fill* (VAR buf: Buffer; VAR src: ARRAY OF CHAR; offset, size: LONGINT);
BEGIN

20
src/library/ulm/ulmIO.Mod
View file

@ -1,6 +1,6 @@
MODULE ulmIO;
IMPORT SYS := ulmSYSTEM, SYSTEM;
IMPORT SYS := ulmSYSTEM, SYSTEM, Platform;
CONST nl = 0AX;
@ -118,6 +118,7 @@ MODULE ulmIO;
(* ========================= terminal ============================ *)
(*
PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
CONST read = 3;
(*VAR r0, r1: INTEGER;*)
@ -125,7 +126,17 @@ MODULE ulmIO;
BEGIN
RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0)
END ReadChar;
*)
PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
(* Read one byte, returning success flag *)
VAR error: Platform.ErrorCode; readcount: LONGINT;
BEGIN
error := Platform.ReadBuf(Platform.StdIn, ch, readcount);
RETURN readcount > 0
END ReadChar;
(*
PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
CONST write = 4;
(*VAR r0, r1: INTEGER;*)
@ -133,6 +144,13 @@ MODULE ulmIO;
BEGIN
RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1)
END WriteChar;
*)
PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
(* Write one byte, returning success flag *)
BEGIN
RETURN Platform.Write(Platform.StdOut, SYSTEM.ADR(ch), 1) = 0
END WriteChar;
PROCEDURE Read*(VAR ch: CHAR);
BEGIN

6
src/library/ulm/ulmSYSTEM.Mod
View file

@ -49,6 +49,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
RETURN oldflag;
END TAS;
(*
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
arg1, arg2, arg3: LONGINT) : BOOLEAN;
VAR
@ -122,7 +123,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
END
END UNIXCALL;
*)
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
BEGIN
@ -135,8 +136,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
END UNIXSIGNAL;
PROCEDURE WMOVE*(from, to, n : LONGINT);
VAR l : LONGINT;
PROCEDURE WMOVE*(from, to, n : SYSTEM.ADDRESS);
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;

8
src/library/v4/Args.Mod
View file

@ -3,7 +3,7 @@ MODULE Args; (* jt, 8.12.94 *)
(* command line argument handling for voc (jet backend) *)
IMPORT Platform;
IMPORT Platform, SYSTEM;
TYPE
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
@ -11,17 +11,17 @@ MODULE Args; (* jt, 8.12.94 *)
VAR
argc-: LONGINT;
argv-: LONGINT;
argv-: SYSTEM.ADDRESS;
PROCEDURE Get* (n: INTEGER; VAR val: ARRAY OF CHAR); BEGIN Platform.GetArg(n, val) END Get;
PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); BEGIN Platform.GetIntArg(n, val) END GetInt;
PROCEDURE Pos* (s: ARRAY OF CHAR): INTEGER; BEGIN RETURN Platform.ArgPos(s) END Pos;
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
BEGIN Platform.GetEnv(var, val) END GetEnv;
PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
BEGIN RETURN Platform.getEnv(var, val) END getEnv;

24
src/library/v4/Printer.Mod
View file

@ -87,7 +87,7 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
VAR family: ARRAY 7 OF CHAR;
BEGIN
COPY(fname, family);
Ch(fontR, "/"); Str(fontR, fname);
Ch(fontR, "/"); Str(fontR, fname);
IF family = "Syntax" THEN Str(fontR, " DefineSMapFont") ELSE Str(fontR, " DefineMapFont") END;
Ln(fontR); Ln(fontR);
END SetMappedFont;
@ -161,7 +161,7 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
| 92: Str(fontR, "backslash")
| 93: Str(fontR, "bracketright")
| 94: Str(fontR, "arrowup")
| 95: Str(fontR, "underscore")
| 95: Str(fontR, "underscore")
| 96: Str(fontR, "grave")
| 97..122: Ch(fontR, CHR(m))
| 123: Str(fontR, "braceleft")
@ -205,8 +205,8 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
Str(fontR, "% Conversion of the Oberon font "); Str(fontR, fd.name); Ln(fontR);
Files.Read(R, ch);
IF ch = fontFileId THEN
Files.Read(R, ch); Str(fontR, "% abstraction: "); Int(fontR, ORD(ch));
Files.Read(R, ch); Str(fontR, ", family: "); Ch(fontR, ch);
Files.Read(R, ch); Str(fontR, "% abstraction: "); Int(fontR, ORD(ch));
Files.Read(R, ch); Str(fontR, ", family: "); Ch(fontR, ch);
Files.Read(R, ch); Str(fontR, ", variant: "); Int(fontR, ORD(ch)); Ln(fontR);
Files.ReadInt(R, height); Str(fontR, "% height: "); Int(fontR, height); Ln(fontR); Ln(fontR);
Files.ReadInt(R, minX); Files.ReadInt(R, maxX);
@ -223,7 +223,7 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
Str(fontR, "/FontMatrix [ 72 "); Int(fontR, pRes); Str(fontR, " div "); Str(fontR, " .24 div 0 0 ");
Str(fontR, "72 "); Int(fontR, pRes); Str(fontR, " div "); Str(fontR, " .24 div 0 0");
Str(fontR, "] def"); Ln(fontR);
Str(fontR, "/FontBBox [");
Str(fontR, "/FontBBox [");
Int(fontR, minX); Ch(fontR, " ");
Int(fontR, minY); Ch(fontR, " ");
Int(fontR, maxX); Ch(fontR, " ");
@ -339,7 +339,7 @@ END;
Error("file not found", headerFileName)
END
END Open;
PROCEDURE UseListFont*(VAR name: ARRAY OF CHAR);
BEGIN
COPY(name, listFont); curFont := -1
@ -368,7 +368,7 @@ END;
IF fname = listFont THEN fontname := "Courier8.Scn.Fnt" ELSE COPY(fname, fontname) END ;
IF (curFont < 0) OR (fontTable[curFont].name # fontname) THEN
COPY(fontname, fontTable[fontIndex+1].name);
i := 0; WHILE i < 8 DO fontTable[fontIndex+1].used[i] := {}; INC(i) END;
i := 0; WHILE i < 8 DO fontTable[fontIndex+1].used[i] := {}; INC(i) END;
fNo := 0;
WHILE fontTable[fNo].name # fontname DO INC(fNo) END;
IF fNo > fontIndex THEN (* DefineFont(fontname); *) fontIndex := fNo END;
@ -394,7 +394,7 @@ END;
END;
Str(bodyR, ") s"); Ln(bodyR)
END ContString;
PROCEDURE String*(x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
BEGIN
Int(bodyR, x); Ch(bodyR, " ");
@ -410,7 +410,7 @@ END;
Int(bodyR, col); Str(bodyR, " b"); Ln(bodyR);
END ReplPattern;
PROCEDURE Picture*(x, y, w, h, mode: INTEGER; adr: LONGINT);
PROCEDURE Picture*(x, y, w, h, mode: INTEGER; adr: SYSTEM.ADDRESS);
VAR n, i, v: INTEGER; ch: CHAR;
BEGIN
Int(bodyR, x); Ch(bodyR, " ");
@ -517,7 +517,7 @@ END;
a[i] := 2.0*b[i-1] + hn; d[i] := d1 + dn;
w[i] := 1.0; i := 0;
WHILE i < n-2 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;
SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1);
SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1);
d1 := (d[0] + d[i])/(w[0] + w[i] + x[i+1] - x[i]); i := 0;
WHILE i < n-1 DO d[i] := d[i] - d1*w[i]; INC(i) END ;
d[i] := d[0]
@ -582,7 +582,7 @@ END;
END Spline;
PROCEDURE Page*(nofcopies: INTEGER);
BEGIN
BEGIN
curR := 0; curG := 0; curB := 0; curFont := -1;
INC(pno); ppos := Files.Pos(bodyR); PrintCopies := nofcopies;
IF PrintMode[1] # ":" THEN
@ -639,7 +639,7 @@ END;
IF PrinterName # "none" THEN Files.Write(printR, 4X) (*force reset postscript*) END ;
Files.Register(printF);
IF PrinterName # "none" THEN
cmd := "lp -c -s ";
cmd := "lp -c -s ";
IF PrinterName # "Pluto" THEN Append(cmd, "-d "); Append(cmd, PrinterName) END ;
Append(cmd, " "); Append(cmd, printFileName);
i := Platform.System(cmd);

4
src/system/Platformunix.Mod
View file

@ -369,7 +369,7 @@ END Size;
PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): LONGINT
"read(fd, (void*)(address)(p), l)";
"(LONGINT)read(fd, (void*)(address)(p), l)";
PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: LONGINT): ErrorCode;
BEGIN
@ -388,7 +388,7 @@ END ReadBuf;
PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): SYSTEM.ADDRESS
"write(fd, (void*)(address)(p), l)";
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): ErrorCode;
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
VAR written: SYSTEM.ADDRESS;
BEGIN
written := writefile(h, p, l);

26
src/system/Platformwindows.Mod
View file

@ -25,7 +25,7 @@ TYPE
EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
ArgVecPtr = POINTER TO ARRAY 1 OF LONGINT;
ArgVecPtr = POINTER TO ARRAY 1 OF SYSTEM.ADDRESS;
VAR
@ -412,31 +412,29 @@ BEGIN
END Size;
PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS; VAR n: SYSTEM.ADDRESS): INTEGER
PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: SYSTEM.INT32): INTEGER
"(INTEGER)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)";
PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS; VAR n: SYSTEM.ADDRESS): ErrorCode;
VAR result: INTEGER;
PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: LONGINT): ErrorCode;
VAR result: INTEGER; lengthread: SYSTEM.INT32;
BEGIN
n := 0; (* Clear n because readfile takes a LONGINT but only updates the bottom 32 bits *)
result := readfile(h, p, l, n);
IF result = 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
result := readfile(h, p, l, lengthread);
IF result = 0 THEN n := 0; RETURN err() ELSE n := lengthread; RETURN 0 END
END Read;
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: SYSTEM.ADDRESS): ErrorCode;
VAR result: INTEGER;
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: LONGINT): ErrorCode;
VAR result: INTEGER; lengthread: SYSTEM.INT32;
BEGIN
n := 0; (* Clear n because readfile takes a SYSTEM.ADDRESS but only updates the bottom 32 bits *)
result := readfile(h, SYSTEM.ADR(b), LEN(b), n);
IF result = 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
result := readfile(h, SYSTEM.ADR(b), LEN(b), lengthread);
IF result = 0 THEN n := 0; RETURN err() ELSE n := lengthread; RETURN 0 END
END ReadBuf;
PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): INTEGER
PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): INTEGER
"(INTEGER)WriteFile((HANDLE)fd, (void*)(p), (DWORD)l, 0,0)";
PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
BEGIN
IF writefile(h, p, l) = 0 THEN RETURN err() ELSE RETURN 0 END
END Write;

2
src/tools/make/vishap.make
View file

@ -20,7 +20,7 @@ FLAVOUR = $(OS).$(DATAMODEL).$(COMPILER)
BUILDDIR = build/$(FLAVOUR)
VISHAP = $(ONAME)$(BINEXT)
#MODEL=-O2 # Override model - build everything as S8,I16,L32.
MODEL=-O2 # Override model - build everything as S8,I16,L32.