mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 07:32:24 +00:00
Change of mind: s/uintptr/address/. Replace LONGINT with ADDRESS in Platform*.
This commit is contained in:
David Brown
parent
90737e5677
commit
a865643d6c
215 changed files with 1441 additions and 1410 deletions
|
|
@ -1213,6 +1213,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|
|||
IF (x.class # OPT.Nconst) & (x.typ.size < p.typ.size) THEN err(-308) END;
|
||||
|
||||
IF (x.class = OPT.Nconst) & (x.typ.form = OPT.Int) & (p.typ.form = OPT.Int) THEN
|
||||
(* Convert integer constants in place allowing usage in CONST section. *)
|
||||
Convert(x, p.typ)
|
||||
ELSE
|
||||
t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t;
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
|
|||
IF keytab[hashtab[h]] = obj^.name THEN OPM.Write('_') END
|
||||
END
|
||||
ELSIF (mode = OPT.Typ) & (obj.typ.form = OPT.Int) THEN
|
||||
IF obj.typ = OPT.pinttyp THEN OPM.WriteString("uintptr")
|
||||
IF obj.typ = OPT.adrtyp THEN OPM.WriteString("address")
|
||||
ELSE OPM.WriteString("int"); OPM.WriteInt(obj.typ.size*8)
|
||||
END
|
||||
ELSE
|
||||
|
|
@ -1320,7 +1320,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
|
|||
|
||||
BEGIN n := 0;
|
||||
FOR i := 0 TO 104 DO hashtab[i] := -1 END ;
|
||||
Enter("adrint"); (* pseudo keyword used by voc *)
|
||||
Enter("address"); (* pseudo keyword used by voc *)
|
||||
Enter("asm");
|
||||
Enter("auto");
|
||||
Enter("break");
|
||||
|
|
@ -1357,7 +1357,6 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
|
|||
Enter("struct");
|
||||
Enter("switch");
|
||||
Enter("typedef");
|
||||
Enter("uintptr"); (* pseudo keyword used by voc *)
|
||||
Enter("uint16"); (* pseudo keyword used by voc *)
|
||||
Enter("uint32"); (* pseudo keyword used by voc *)
|
||||
Enter("uint64"); (* pseudo keyword used by voc *)
|
||||
|
|
|
|||
|
|
@ -155,7 +155,7 @@ VAR
|
|||
undftyp*,
|
||||
bytetyp*, booltyp*, chartyp*,
|
||||
sinttyp*, inttyp*, linttyp*,
|
||||
pinttyp*,
|
||||
adrtyp*,
|
||||
int8typ*, int16typ*, int32typ*, int64typ*,
|
||||
realtyp*, lrltyp*, settyp*, stringtyp*,
|
||||
niltyp*, notyp*, sysptrtyp*: Struct;
|
||||
|
|
@ -1188,7 +1188,7 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
|
|||
(*initialization of module SYSTEM*)
|
||||
EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp);
|
||||
EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp);
|
||||
EnterTyp("UINTPTR", Int, OPM.PointerSize, pinttyp);
|
||||
EnterTyp("ADDRESS", Int, OPM.PointerSize, adrtyp);
|
||||
EnterTyp("INT8", Int, 1, int8typ);
|
||||
EnterTyp("INT16", Int, 2, int16typ);
|
||||
EnterTyp("INT32", Int, 4, int32typ);
|
||||
|
|
|
|||
|
|
@ -205,7 +205,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
|
|||
OPT.realtyp^.strobj^.linkadr := PredefinedType;
|
||||
OPT.inttyp^.strobj^.linkadr := PredefinedType;
|
||||
OPT.linttyp^.strobj^.linkadr := PredefinedType;
|
||||
OPT.pinttyp^.strobj^.linkadr := PredefinedType;
|
||||
OPT.adrtyp^.strobj^.linkadr := PredefinedType;
|
||||
OPT.int8typ^.strobj^.linkadr := PredefinedType;
|
||||
OPT.int16typ^.strobj^.linkadr := PredefinedType;
|
||||
OPT.int32typ^.strobj^.linkadr := PredefinedType;
|
||||
|
|
@ -565,7 +565,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
|
|||
expr(l, MinPrec); OPM.Write(CloseParen)
|
||||
| OPT.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen)
|
||||
| OPT.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen)
|
||||
| OPT.adr: OPM.WriteString("(uintptr)"); (*SYSTEM*)
|
||||
| OPT.adr: OPM.WriteString("(address)"); (*SYSTEM*)
|
||||
IF l^.class = OPT.Nvarpar THEN OPC.CompleteIdent(l^.obj)
|
||||
ELSE
|
||||
IF (l^.typ^.form # OPT.String) & ~(l^.typ^.comp IN {OPT.Array, OPT.DynArr}) THEN OPM.Write("&") END ;
|
||||
|
|
@ -578,7 +578,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
|
|||
THEN
|
||||
OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen);
|
||||
IF (n^.typ^.form IN {OPT.Pointer, OPT.ProcTyp}) OR (l^.typ^.form IN {OPT.Pointer, OPT.ProcTyp}) THEN
|
||||
OPM.WriteString("(uintptr)")
|
||||
OPM.WriteString("(address)")
|
||||
END;
|
||||
expr(l, exprPrec)
|
||||
ELSE
|
||||
|
|
@ -796,7 +796,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
|
|||
IF typ^.comp = OPT.DynArr THEN
|
||||
IF x^.class = OPT.Nconst THEN
|
||||
OPC.IntLiteral(x.conval.intval, OPM.PointerSize)
|
||||
ELSE OPM.WriteString("((uintptr)("); expr(x, 10); OPM.WriteString("))")
|
||||
ELSE OPM.WriteString("((address)("); expr(x, 10); OPM.WriteString("))")
|
||||
END ;
|
||||
x := x^.link
|
||||
ELSE
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ MODULE Vishap; (* J. Templ 3.2.95 *)
|
|||
OPT.realtyp.size := OPM.RealSize;
|
||||
OPT.inttyp.size := OPM.IntSize;
|
||||
OPT.linttyp.size := OPM.LIntSize;
|
||||
OPT.pinttyp.size := OPM.PointerSize;
|
||||
OPT.adrtyp.size := OPM.PointerSize;
|
||||
OPT.lrltyp.size := OPM.LRealSize;
|
||||
OPT.sinttyp.size := OPM.SIntSize;
|
||||
OPT.booltyp.size := OPM.BoolSize
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ MODULE Heap;
|
|||
CONST
|
||||
ModNameLen = 20;
|
||||
CmdNameLen = 24;
|
||||
SZA = SIZE(SYSTEM.UINTPTR); (* Size of address *)
|
||||
SZA = SIZE(SYSTEM.ADDRESS); (* Size of address *)
|
||||
Unit = 4*SZA; (* smallest possible heap block *)
|
||||
nofLists = 9; (* number of free_lists *)
|
||||
heapSize0 = 8000*Unit; (* startup heap size *)
|
||||
|
|
@ -20,17 +20,17 @@ MODULE Heap;
|
|||
*)
|
||||
|
||||
(* heap chunks *)
|
||||
nextChnkOff = SYSTEM.VAL(SYSTEM.UINTPTR, 0); (* next heap chunk, sorted ascendingly! *)
|
||||
endOff = SYSTEM.VAL(SYSTEM.UINTPTR, SZA); (* end of heap chunk *)
|
||||
blkOff = SYSTEM.VAL(SYSTEM.UINTPTR, 3*SZA); (* first block in a chunk *)
|
||||
nextChnkOff = SYSTEM.VAL(SYSTEM.ADDRESS, 0); (* next heap chunk, sorted ascendingly! *)
|
||||
endOff = SYSTEM.VAL(SYSTEM.ADDRESS, SZA); (* end of heap chunk *)
|
||||
blkOff = SYSTEM.VAL(SYSTEM.ADDRESS, 3*SZA); (* first block in a chunk *)
|
||||
|
||||
(* heap blocks *)
|
||||
tagOff = SYSTEM.VAL(SYSTEM.UINTPTR, 0); (* block starts with tag *)
|
||||
sizeOff = SYSTEM.VAL(SYSTEM.UINTPTR, SZA); (* block size in free block relative to block start *)
|
||||
sntlOff = SYSTEM.VAL(SYSTEM.UINTPTR, 2*SZA); (* pointer offset table sentinel in free block relative to block start *)
|
||||
nextOff = SYSTEM.VAL(SYSTEM.UINTPTR, 3*SZA); (* next pointer in free block relative to block start *)
|
||||
NoPtrSntl = SYSTEM.VAL(SYSTEM.UINTPTR, -SZA);
|
||||
AddressZero = SYSTEM.VAL(SYSTEM.UINTPTR, 0);
|
||||
tagOff = SYSTEM.VAL(SYSTEM.ADDRESS, 0); (* block starts with tag *)
|
||||
sizeOff = SYSTEM.VAL(SYSTEM.ADDRESS, SZA); (* block size in free block relative to block start *)
|
||||
sntlOff = SYSTEM.VAL(SYSTEM.ADDRESS, 2*SZA); (* pointer offset table sentinel in free block relative to block start *)
|
||||
nextOff = SYSTEM.VAL(SYSTEM.ADDRESS, 3*SZA); (* next pointer in free block relative to block start *)
|
||||
NoPtrSntl = SYSTEM.VAL(SYSTEM.ADDRESS, -SZA);
|
||||
AddressZero = SYSTEM.VAL(SYSTEM.ADDRESS, 0);
|
||||
|
||||
TYPE
|
||||
ModuleName = ARRAY ModNameLen OF CHAR;
|
||||
|
|
@ -46,7 +46,7 @@ MODULE Heap;
|
|||
name: ModuleName;
|
||||
refcnt: LONGINT;
|
||||
cmds: Cmd;
|
||||
types: SYSTEM.UINTPTR;
|
||||
types: SYSTEM.ADDRESS;
|
||||
enumPtrs: EnumProc;
|
||||
reserved1, reserved2: LONGINT
|
||||
END ;
|
||||
|
|
@ -64,7 +64,7 @@ MODULE Heap;
|
|||
FinNode = POINTER TO FinDesc;
|
||||
FinDesc = RECORD
|
||||
next: FinNode;
|
||||
obj: SYSTEM.UINTPTR; (* weak pointer *)
|
||||
obj: SYSTEM.ADDRESS; (* weak pointer *)
|
||||
marked: BOOLEAN;
|
||||
finalize: Finalizer;
|
||||
END ;
|
||||
|
|
@ -73,15 +73,15 @@ MODULE Heap;
|
|||
(* the list of loaded (=initialization started) modules *)
|
||||
modules*: SYSTEM.PTR;
|
||||
|
||||
freeList: ARRAY nofLists + 1 OF SYSTEM.UINTPTR; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
|
||||
bigBlocks: SYSTEM.UINTPTR;
|
||||
allocated*: SYSTEM.UINTPTR;
|
||||
freeList: ARRAY nofLists + 1 OF SYSTEM.ADDRESS; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
|
||||
bigBlocks: SYSTEM.ADDRESS;
|
||||
allocated*: SYSTEM.ADDRESS;
|
||||
firstTry: BOOLEAN;
|
||||
|
||||
(* extensible heap *)
|
||||
heap: SYSTEM.UINTPTR; (* the sorted list of heap chunks *)
|
||||
heapend: SYSTEM.UINTPTR; (* max possible pointer value (used for stack collection) *)
|
||||
heapsize*: SYSTEM.UINTPTR; (* the sum of all heap chunk sizes *)
|
||||
heap: SYSTEM.ADDRESS; (* the sorted list of heap chunks *)
|
||||
heapend: SYSTEM.ADDRESS; (* max possible pointer value (used for stack collection) *)
|
||||
heapsize*: SYSTEM.ADDRESS; (* the sum of all heap chunk sizes *)
|
||||
|
||||
(* finalization candidates *)
|
||||
fin: FinNode;
|
||||
|
|
@ -153,7 +153,7 @@ MODULE Heap;
|
|||
COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c
|
||||
END REGCMD;
|
||||
|
||||
PROCEDURE REGTYP*(m: Module; typ: SYSTEM.UINTPTR);
|
||||
PROCEDURE REGTYP*(m: Module; typ: SYSTEM.ADDRESS);
|
||||
BEGIN SYSTEM.PUT(typ, m.types); m.types := typ
|
||||
END REGTYP;
|
||||
|
||||
|
|
@ -162,11 +162,11 @@ MODULE Heap;
|
|||
END INCREF;
|
||||
|
||||
|
||||
PROCEDURE -ExternPlatformOSAllocate "extern uintptr Platform_OSAllocate(uintptr size);";
|
||||
PROCEDURE -OSAllocate(size: SYSTEM.UINTPTR): SYSTEM.UINTPTR "Platform_OSAllocate(size)";
|
||||
PROCEDURE -ExternPlatformOSAllocate "extern address Platform_OSAllocate(address size);";
|
||||
PROCEDURE -OSAllocate(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "Platform_OSAllocate(size)";
|
||||
|
||||
PROCEDURE NewChunk(blksz: SYSTEM.UINTPTR): SYSTEM.UINTPTR;
|
||||
VAR chnk: SYSTEM.UINTPTR;
|
||||
PROCEDURE NewChunk(blksz: SYSTEM.ADDRESS): SYSTEM.ADDRESS;
|
||||
VAR chnk: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
chnk := OSAllocate(blksz + blkOff);
|
||||
IF chnk # 0 THEN
|
||||
|
|
@ -191,10 +191,10 @@ MODULE Heap;
|
|||
as there will be no need to extend addresses to larger types.
|
||||
*)
|
||||
|
||||
PROCEDURE -FetchAddress(pointer: SYSTEM.UINTPTR): SYSTEM.UINTPTR "(uintptr)(*((void**)((uintptr)pointer)))";
|
||||
PROCEDURE -FetchAddress(pointer: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(address)(*((void**)((address)pointer)))";
|
||||
|
||||
PROCEDURE ExtendHeap(blksz: SYSTEM.UINTPTR);
|
||||
VAR size, chnk, j, next: SYSTEM.UINTPTR;
|
||||
PROCEDURE ExtendHeap(blksz: SYSTEM.ADDRESS);
|
||||
VAR size, chnk, j, next: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
IF blksz > 10000*Unit THEN size := blksz
|
||||
ELSE size := 10000*Unit (* additional heuristics *)
|
||||
|
|
@ -218,16 +218,16 @@ MODULE Heap;
|
|||
|
||||
PROCEDURE ^GC*(markStack: BOOLEAN);
|
||||
|
||||
PROCEDURE NEWREC*(tag: SYSTEM.UINTPTR): SYSTEM.PTR;
|
||||
PROCEDURE NEWREC*(tag: SYSTEM.ADDRESS): SYSTEM.PTR;
|
||||
VAR
|
||||
i, i0, di, blksz, restsize, t, adr, end, next, prev: SYSTEM.UINTPTR;
|
||||
i, i0, di, blksz, restsize, t, adr, end, next, prev: SYSTEM.ADDRESS;
|
||||
new: SYSTEM.PTR;
|
||||
BEGIN
|
||||
Lock();
|
||||
blksz := FetchAddress(tag);
|
||||
|
||||
ASSERT((Unit = 16) OR (Unit = 32));
|
||||
ASSERT(SIZE(SYSTEM.PTR) = SIZE(SYSTEM.UINTPTR));
|
||||
ASSERT(SIZE(SYSTEM.PTR) = SIZE(SYSTEM.ADDRESS));
|
||||
ASSERT(blksz MOD Unit = 0);
|
||||
|
||||
i0 := blksz DIV Unit; i := i0;
|
||||
|
|
@ -310,23 +310,23 @@ MODULE Heap;
|
|||
RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZA)
|
||||
END NEWREC;
|
||||
|
||||
PROCEDURE NEWBLK*(size: SYSTEM.UINTPTR): SYSTEM.PTR;
|
||||
VAR blksz, tag: SYSTEM.UINTPTR; new: SYSTEM.PTR;
|
||||
PROCEDURE NEWBLK*(size: SYSTEM.ADDRESS): SYSTEM.PTR;
|
||||
VAR blksz, tag: SYSTEM.ADDRESS; new: SYSTEM.PTR;
|
||||
BEGIN
|
||||
Lock();
|
||||
blksz := (size + (4*SZA + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
|
||||
new := NEWREC(SYSTEM.ADR(blksz));
|
||||
tag := SYSTEM.VAL(SYSTEM.UINTPTR, new) + blksz - 3*SZA;
|
||||
tag := SYSTEM.VAL(SYSTEM.ADDRESS, new) + blksz - 3*SZA;
|
||||
SYSTEM.PUT(tag - SZA, AddressZero); (*reserved for meta info*)
|
||||
SYSTEM.PUT(tag, blksz);
|
||||
SYSTEM.PUT(tag + SZA, NoPtrSntl);
|
||||
SYSTEM.PUT(SYSTEM.VAL(SYSTEM.UINTPTR, new) - SZA, tag);
|
||||
SYSTEM.PUT(SYSTEM.VAL(SYSTEM.ADDRESS, new) - SZA, tag);
|
||||
Unlock();
|
||||
RETURN new
|
||||
END NEWBLK;
|
||||
|
||||
PROCEDURE Mark(q: SYSTEM.UINTPTR);
|
||||
VAR p, tag, offset, fld, n, tagbits: SYSTEM.UINTPTR;
|
||||
PROCEDURE Mark(q: SYSTEM.ADDRESS);
|
||||
VAR p, tag, offset, fld, n, tagbits: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
IF q # 0 THEN
|
||||
tagbits := FetchAddress(q - SZA); (* Load the tag for the record at q *)
|
||||
|
|
@ -336,7 +336,7 @@ MODULE Heap;
|
|||
tag := tagbits + SZA; (* Tag addresses first offset *)
|
||||
LOOP
|
||||
SYSTEM.GET(tag, offset); (* Get next ptr field offset *)
|
||||
IF SYSTEM.BIT(SYSTEM.ADR(offset), SIZE(SYSTEM.UINTPTR)*8 - 1) THEN
|
||||
IF SYSTEM.BIT(SYSTEM.ADR(offset), SIZE(SYSTEM.ADDRESS)*8 - 1) THEN
|
||||
(* Sentinel reached: Value is -8*(#fields+1) *)
|
||||
SYSTEM.PUT(q - SZA, tag + offset + 1); (* Rotate base ptr into tag *)
|
||||
IF p = 0 THEN EXIT END ;
|
||||
|
|
@ -366,11 +366,11 @@ MODULE Heap;
|
|||
|
||||
PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *)
|
||||
BEGIN
|
||||
Mark(SYSTEM.VAL(SYSTEM.UINTPTR, p))
|
||||
Mark(SYSTEM.VAL(SYSTEM.ADDRESS, p))
|
||||
END MarkP;
|
||||
|
||||
PROCEDURE Scan;
|
||||
VAR chnk, adr, end, start, tag, i, size, freesize: SYSTEM.UINTPTR;
|
||||
VAR chnk, adr, end, start, tag, i, size, freesize: SYSTEM.ADDRESS;
|
||||
BEGIN bigBlocks := 0; i := 1;
|
||||
WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
|
||||
freesize := 0; allocated := 0; chnk := heap;
|
||||
|
|
@ -415,8 +415,8 @@ MODULE Heap;
|
|||
END
|
||||
END Scan;
|
||||
|
||||
PROCEDURE Sift (l, r: SYSTEM.UINTPTR; VAR a: ARRAY OF SYSTEM.UINTPTR);
|
||||
VAR i, j, x: SYSTEM.UINTPTR;
|
||||
PROCEDURE Sift (l, r: SYSTEM.ADDRESS; VAR a: ARRAY OF SYSTEM.ADDRESS);
|
||||
VAR i, j, x: SYSTEM.ADDRESS;
|
||||
BEGIN j := l; x := a[j];
|
||||
LOOP i := j; j := 2*j + 1;
|
||||
IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END;
|
||||
|
|
@ -426,15 +426,15 @@ MODULE Heap;
|
|||
a[i] := x
|
||||
END Sift;
|
||||
|
||||
PROCEDURE HeapSort (n: SYSTEM.UINTPTR; VAR a: ARRAY OF SYSTEM.UINTPTR);
|
||||
VAR l, r, x: SYSTEM.UINTPTR;
|
||||
PROCEDURE HeapSort (n: SYSTEM.ADDRESS; VAR a: ARRAY OF SYSTEM.ADDRESS);
|
||||
VAR l, r, x: SYSTEM.ADDRESS;
|
||||
BEGIN l := n DIV 2; r := n - 1;
|
||||
WHILE l > 0 DO DEC(l); Sift(l, r, a) END;
|
||||
WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END
|
||||
END HeapSort;
|
||||
|
||||
PROCEDURE MarkCandidates(n: SYSTEM.UINTPTR; VAR cand: ARRAY OF SYSTEM.UINTPTR);
|
||||
VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: SYSTEM.UINTPTR;
|
||||
PROCEDURE MarkCandidates(n: SYSTEM.ADDRESS; VAR cand: ARRAY OF SYSTEM.ADDRESS);
|
||||
VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
chnk := heap; i := 0; lim := cand[n-1];
|
||||
WHILE (chnk # 0 ) & (chnk < lim) DO
|
||||
|
|
@ -460,7 +460,7 @@ MODULE Heap;
|
|||
END MarkCandidates;
|
||||
|
||||
PROCEDURE CheckFin;
|
||||
VAR n: FinNode; tag: SYSTEM.UINTPTR;
|
||||
VAR n: FinNode; tag: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
n := fin;
|
||||
WHILE n # NIL DO
|
||||
|
|
@ -496,14 +496,14 @@ MODULE Heap;
|
|||
END
|
||||
END FINALL;
|
||||
|
||||
PROCEDURE -ExternMainStackFrame "extern uintptr Platform_MainStackFrame;";
|
||||
PROCEDURE -PlatformMainStackFrame(): SYSTEM.UINTPTR "Platform_MainStackFrame";
|
||||
PROCEDURE -ExternMainStackFrame "extern address Platform_MainStackFrame;";
|
||||
PROCEDURE -PlatformMainStackFrame(): SYSTEM.ADDRESS "Platform_MainStackFrame";
|
||||
|
||||
PROCEDURE MarkStack(n: SYSTEM.UINTPTR; VAR cand: ARRAY OF SYSTEM.UINTPTR);
|
||||
PROCEDURE MarkStack(n: SYSTEM.ADDRESS; VAR cand: ARRAY OF SYSTEM.ADDRESS);
|
||||
VAR
|
||||
frame: SYSTEM.PTR;
|
||||
inc, nofcand: SYSTEM.UINTPTR;
|
||||
sp, p, stack0: SYSTEM.UINTPTR;
|
||||
inc, nofcand: SYSTEM.ADDRESS;
|
||||
sp, p, stack0: SYSTEM.ADDRESS;
|
||||
align: RECORD ch: CHAR; p: SYSTEM.PTR END ;
|
||||
BEGIN
|
||||
IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *)
|
||||
|
|
@ -530,8 +530,8 @@ MODULE Heap;
|
|||
PROCEDURE GC*(markStack: BOOLEAN);
|
||||
VAR
|
||||
m: Module;
|
||||
i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: SYSTEM.UINTPTR;
|
||||
cand: ARRAY 10000 OF SYSTEM.UINTPTR;
|
||||
i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: SYSTEM.ADDRESS;
|
||||
cand: ARRAY 10000 OF SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
IF (lockdepth = 0) OR (lockdepth = 1) & ~markStack THEN
|
||||
Lock();
|
||||
|
|
@ -566,7 +566,7 @@ MODULE Heap;
|
|||
PROCEDURE RegisterFinalizer*(obj: SYSTEM.PTR; finalize: Finalizer);
|
||||
VAR f: FinNode;
|
||||
BEGIN NEW(f);
|
||||
f.obj := SYSTEM.VAL(SYSTEM.UINTPTR, obj); f.finalize := finalize; f.marked := TRUE;
|
||||
f.obj := SYSTEM.VAL(SYSTEM.ADDRESS, obj); f.finalize := finalize; f.marked := TRUE;
|
||||
f.next := fin; fin := f;
|
||||
END RegisterFinalizer;
|
||||
|
||||
|
|
|
|||
|
|
@ -27,13 +27,13 @@ TYPE
|
|||
|
||||
VAR
|
||||
LittleEndian-: BOOLEAN;
|
||||
MainStackFrame-: SYSTEM.UINTPTR;
|
||||
MainStackFrame-: SYSTEM.ADDRESS;
|
||||
HaltCode-: LONGINT;
|
||||
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
|
||||
CWD-: ARRAY 256 OF CHAR;
|
||||
ArgCount-: INTEGER;
|
||||
|
||||
ArgVector-: SYSTEM.UINTPTR;
|
||||
ArgVector-: SYSTEM.ADDRESS;
|
||||
HaltHandler: HaltProcedure;
|
||||
TimeStart: LONGINT;
|
||||
|
||||
|
|
@ -106,11 +106,11 @@ BEGIN RETURN (e = ECONNREFUSED()) OR (e = ECONNABORTED())
|
|||
|
||||
(* OS memory allocaton *)
|
||||
|
||||
PROCEDURE -allocate (size: SYSTEM.UINTPTR): SYSTEM.UINTPTR "(uintptr)((void*)malloc((size_t)size))";
|
||||
PROCEDURE OSAllocate*(size: SYSTEM.UINTPTR): SYSTEM.UINTPTR; BEGIN RETURN allocate(size) END OSAllocate;
|
||||
PROCEDURE -allocate (size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(address)((void*)malloc((size_t)size))";
|
||||
PROCEDURE OSAllocate*(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS; BEGIN RETURN allocate(size) END OSAllocate;
|
||||
|
||||
PROCEDURE -free(address: SYSTEM.UINTPTR) "free((void*)address)";
|
||||
PROCEDURE OSFree*(address: SYSTEM.UINTPTR); BEGIN free(address) END OSFree;
|
||||
PROCEDURE -free(address: SYSTEM.ADDRESS) "free((void*)address)";
|
||||
PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
|
||||
|
||||
|
||||
|
||||
|
|
@ -120,7 +120,7 @@ PROCEDURE OSFree*(address: SYSTEM.UINTPTR); BEGIN free(address) END OSFree;
|
|||
PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
|
||||
PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
|
||||
|
||||
PROCEDURE Init*(argc: INTEGER; argvadr: LONGINT);
|
||||
PROCEDURE Init*(argc: INTEGER; argvadr: SYSTEM.ADDRESS);
|
||||
VAR av: ArgVecPtr;
|
||||
BEGIN
|
||||
MainStackFrame := argvadr;
|
||||
|
|
@ -189,7 +189,7 @@ END ArgPos;
|
|||
|
||||
(* Signals and traps *)
|
||||
|
||||
PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (uintptr)h)";
|
||||
PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (address)h)";
|
||||
|
||||
PROCEDURE SetInterruptHandler*(handler: SignalHandler);
|
||||
BEGIN sethandler(2, handler); END SetInterruptHandler;
|
||||
|
|
@ -368,16 +368,16 @@ END Size;
|
|||
|
||||
|
||||
|
||||
PROCEDURE -readfile (fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
|
||||
"read(fd, (void*)(uintptr)(p), l)";
|
||||
PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): SYSTEM.ADDRESS
|
||||
"read(fd, (void*)(address)(p), l)";
|
||||
|
||||
PROCEDURE Read*(h: FileHandle; p: LONGINT; l: LONGINT; VAR n: LONGINT): ErrorCode;
|
||||
PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS; VAR n: SYSTEM.ADDRESS): ErrorCode;
|
||||
BEGIN
|
||||
n := readfile(h, p, l);
|
||||
IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
|
||||
END Read;
|
||||
|
||||
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: LONGINT): ErrorCode;
|
||||
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: SYSTEM.ADDRESS): ErrorCode;
|
||||
BEGIN
|
||||
n := readfile(h, SYSTEM.ADR(b), LEN(b));
|
||||
IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
|
||||
|
|
@ -385,11 +385,11 @@ END ReadBuf;
|
|||
|
||||
|
||||
|
||||
PROCEDURE -writefile(fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
|
||||
"write(fd, (void*)(uintptr)(p), l)";
|
||||
PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): SYSTEM.ADDRESS
|
||||
"write(fd, (void*)(address)(p), l)";
|
||||
|
||||
PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
|
||||
VAR written: LONGINT;
|
||||
PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): ErrorCode;
|
||||
VAR written: SYSTEM.ADDRESS;
|
||||
BEGIN
|
||||
written := writefile(h, p, l);
|
||||
IF written < 0 THEN RETURN err() ELSE RETURN 0 END
|
||||
|
|
@ -467,7 +467,7 @@ BEGIN exit(code) END Exit;
|
|||
PROCEDURE -errstring(s: ARRAY OF CHAR) 'write(1, s, s__len-1)';
|
||||
PROCEDURE -errc (c: CHAR) 'write(1, &c, 1)';
|
||||
PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
|
||||
PROCEDURE errln; BEGIN errch(0DX); errch(0AX) END errln;
|
||||
PROCEDURE errln; BEGIN errch(0AX) END errln;
|
||||
|
||||
PROCEDURE errposint(l: LONGINT);
|
||||
BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
|
||||
|
|
|
|||
|
|
@ -30,13 +30,13 @@ TYPE
|
|||
|
||||
VAR
|
||||
LittleEndian-: BOOLEAN;
|
||||
MainStackFrame-: LONGINT;
|
||||
MainStackFrame-: SYSTEM.ADDRESS;
|
||||
HaltCode-: LONGINT;
|
||||
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
|
||||
CWD-: ARRAY 4096 OF CHAR;
|
||||
ArgCount-: INTEGER;
|
||||
|
||||
ArgVector-: LONGINT;
|
||||
ArgVector-: SYSTEM.ADDRESS;
|
||||
HaltHandler: HaltProcedure;
|
||||
TimeStart: LONGINT;
|
||||
|
||||
|
|
@ -104,11 +104,11 @@ BEGIN RETURN (e = ECONNREFUSED()) OR (e = ECONNABORTED())
|
|||
|
||||
(* OS memory allocaton *)
|
||||
|
||||
PROCEDURE -allocate(size: LONGINT): LONGINT "(LONGINT)(SYSTEM_ADRINT)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))";
|
||||
PROCEDURE OSAllocate*(size: LONGINT): LONGINT; BEGIN RETURN allocate(size) END OSAllocate;
|
||||
PROCEDURE -allocate(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(address)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))";
|
||||
PROCEDURE OSAllocate*(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS; BEGIN RETURN allocate(size) END OSAllocate;
|
||||
|
||||
PROCEDURE -free(address: LONGINT) "HeapFree(GetProcessHeap(), 0, (void*)(SYSTEM_ADRINT)address)";
|
||||
PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
|
||||
PROCEDURE -free(address: SYSTEM.ADDRESS) "HeapFree(GetProcessHeap(), 0, (void*)address)";
|
||||
PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
|
||||
|
||||
|
||||
|
||||
|
|
@ -118,7 +118,7 @@ PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
|
|||
PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
|
||||
PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
|
||||
|
||||
PROCEDURE Init*(argc: INTEGER; argvadr: LONGINT);
|
||||
PROCEDURE Init*(argc: INTEGER; argvadr: SYSTEM.ADDRESS);
|
||||
VAR av: ArgVecPtr;
|
||||
BEGIN
|
||||
MainStackFrame := argvadr;
|
||||
|
|
@ -200,8 +200,8 @@ END ArgPos;
|
|||
|
||||
(* Ctrl/c handling *)
|
||||
|
||||
PROCEDURE -SetInterruptHandler*(h: SignalHandler) "SystemSetInterruptHandler((SYSTEM_ADRINT)h)";
|
||||
PROCEDURE -SetQuitHandler* (h: SignalHandler) "SystemSetQuitHandler((SYSTEM_ADRINT)h)";
|
||||
PROCEDURE -SetInterruptHandler*(h: SignalHandler) "SystemSetInterruptHandler((address)h)";
|
||||
PROCEDURE -SetQuitHandler* (h: SignalHandler) "SystemSetQuitHandler((address)h)";
|
||||
|
||||
PROCEDURE SetBadInstructionHandler*(handler: SignalHandler);
|
||||
BEGIN (* TODO *) END SetBadInstructionHandler;
|
||||
|
|
@ -293,16 +293,16 @@ PROCEDURE Error*(): ErrorCode; BEGIN RETURN err() END Error;
|
|||
|
||||
(* File system *)
|
||||
|
||||
PROCEDURE -invalidHandleValue(): LONGINT "((LONGINT)(SYSTEM_ADRINT)INVALID_HANDLE_VALUE)";
|
||||
PROCEDURE -invalidHandleValue(): LONGINT "((LONGINT)(address)INVALID_HANDLE_VALUE)";
|
||||
|
||||
PROCEDURE -openrw (n: ARRAY OF CHAR): LONGINT
|
||||
"(LONGINT)(SYSTEM_ADRINT)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
|
||||
"(LONGINT)(address)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
|
||||
|
||||
PROCEDURE -openro (n: ARRAY OF CHAR): LONGINT
|
||||
"(LONGINT)(SYSTEM_ADRINT)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
|
||||
"(LONGINT)(address)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
|
||||
|
||||
PROCEDURE -opennew(n: ARRAY OF CHAR): LONGINT
|
||||
"(LONGINT)(SYSTEM_ADRINT)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)";
|
||||
"(LONGINT)(address)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)";
|
||||
|
||||
|
||||
|
||||
|
|
@ -332,7 +332,7 @@ END New;
|
|||
|
||||
|
||||
|
||||
PROCEDURE -closeHandle(h: FileHandle): INTEGER "(INTEGER)CloseHandle((HANDLE)(SYSTEM_ADRINT)h)";
|
||||
PROCEDURE -closeHandle(h: FileHandle): INTEGER "(INTEGER)CloseHandle((HANDLE)(address)h)";
|
||||
|
||||
PROCEDURE Close*(h: FileHandle): ErrorCode;
|
||||
BEGIN
|
||||
|
|
@ -342,7 +342,7 @@ END Close;
|
|||
|
||||
|
||||
PROCEDURE -byHandleFileInformation "BY_HANDLE_FILE_INFORMATION bhfi";
|
||||
PROCEDURE -getFileInformationByHandle(h: FileHandle): INTEGER "(INTEGER)GetFileInformationByHandle((HANDLE)(SYSTEM_ADRINT)h, &bhfi)";
|
||||
PROCEDURE -getFileInformationByHandle(h: FileHandle): INTEGER "(INTEGER)GetFileInformationByHandle((HANDLE)(address)h, &bhfi)";
|
||||
PROCEDURE -bhfiMtimeHigh(): LONGINT "(LONGINT)bhfi.ftLastWriteTime.dwHighDateTime";
|
||||
PROCEDURE -bhfiMtimeLow(): LONGINT "(LONGINT)bhfi.ftLastWriteTime.dwLowDateTime";
|
||||
PROCEDURE -bhfiVsn(): LONGINT "(LONGINT)bhfi.dwVolumeSerialNumber";
|
||||
|
|
@ -401,7 +401,7 @@ END MTimeAsClock;
|
|||
|
||||
PROCEDURE -largeInteger "LARGE_INTEGER li";
|
||||
PROCEDURE -liLongint(): LONGINT "(LONGINT)li.QuadPart";
|
||||
PROCEDURE -getFileSize(h: FileHandle): INTEGER "(INTEGER)GetFileSizeEx((HANDLE)(SYSTEM_ADRINT)h, &li)";
|
||||
PROCEDURE -getFileSize(h: FileHandle): INTEGER "(INTEGER)GetFileSizeEx((HANDLE)(address)h, &li)";
|
||||
|
||||
PROCEDURE Size*(h: FileHandle; VAR l: LONGINT): ErrorCode;
|
||||
BEGIN
|
||||
|
|
@ -412,10 +412,10 @@ BEGIN
|
|||
END Size;
|
||||
|
||||
|
||||
PROCEDURE -readfile (fd: LONGINT; p: LONGINT; l: LONGINT; VAR n: LONGINT): INTEGER
|
||||
"(INTEGER)ReadFile ((HANDLE)(SYSTEM_ADRINT)fd, (void*)(SYSTEM_ADRINT)(p), (DWORD)l, (DWORD*)n, 0)";
|
||||
PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS; VAR n: SYSTEM.ADDRESS): SYSTEM.ADDRESS
|
||||
"(address)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)";
|
||||
|
||||
PROCEDURE Read*(h: FileHandle; p: LONGINT; l: LONGINT; VAR n: LONGINT): ErrorCode;
|
||||
PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS; VAR n: SYSTEM.ADDRESS): ErrorCode;
|
||||
VAR result: INTEGER;
|
||||
BEGIN
|
||||
n := 0; (* Clear n because readfile takes a LONGINT but only updates the bottom 32 bits *)
|
||||
|
|
@ -423,18 +423,18 @@ BEGIN
|
|||
IF result = 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
|
||||
END Read;
|
||||
|
||||
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: LONGINT): ErrorCode;
|
||||
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: SYSTEM.ADDRESS): ErrorCode;
|
||||
VAR result: INTEGER;
|
||||
BEGIN
|
||||
n := 0; (* Clear n because readfile takes a LONGINT but only updates the bottom 32 bits *)
|
||||
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
|
||||
END ReadBuf;
|
||||
|
||||
|
||||
|
||||
PROCEDURE -writefile(fd: LONGINT; p: LONGINT; l: LONGINT): INTEGER
|
||||
"(INTEGER)WriteFile((HANDLE)(SYSTEM_ADRINT)fd, (void*)(SYSTEM_ADRINT)(p), (DWORD)l, 0,0)";
|
||||
PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: SYSTEM.ADDRESS): INTEGER
|
||||
"(INTEGER)WriteFile((HANDLE)fd, (void*)(p), (DWORD)l, 0,0)";
|
||||
|
||||
PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
|
||||
BEGIN
|
||||
|
|
@ -443,7 +443,7 @@ END Write;
|
|||
|
||||
|
||||
|
||||
PROCEDURE -flushFileBuffers(h: FileHandle): INTEGER "(INTEGER)FlushFileBuffers((HANDLE)(SYSTEM_ADRINT)h)";
|
||||
PROCEDURE -flushFileBuffers(h: FileHandle): INTEGER "(INTEGER)FlushFileBuffers((HANDLE)h)";
|
||||
|
||||
PROCEDURE Sync*(h: FileHandle): ErrorCode;
|
||||
BEGIN
|
||||
|
|
@ -453,7 +453,7 @@ END Sync;
|
|||
|
||||
|
||||
PROCEDURE -setFilePointerEx(h: FileHandle; o: LONGINT; r: INTEGER; VAR rc: INTEGER)
|
||||
"li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADRINT)h, li, 0, (DWORD)r)";
|
||||
"li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(address)h, li, 0, (DWORD)r)";
|
||||
|
||||
PROCEDURE -seekset(): INTEGER "FILE_BEGIN";
|
||||
PROCEDURE -seekcur(): INTEGER "FILE_CURRENT";
|
||||
|
|
@ -469,9 +469,9 @@ END Seek;
|
|||
|
||||
|
||||
|
||||
PROCEDURE -setEndOfFile(h: FileHandle): INTEGER "(INTEGER)SetEndOfFile((HANDLE)(SYSTEM_ADRINT)h)";
|
||||
PROCEDURE -setEndOfFile(h: FileHandle): INTEGER "(INTEGER)SetEndOfFile((HANDLE)(address)h)";
|
||||
PROCEDURE -getFilePos(h: FileHandle; VAR r: LONGINT; VAR rc: INTEGER)
|
||||
"LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADRINT)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart";
|
||||
"LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(address)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart";
|
||||
|
||||
PROCEDURE Truncate*(h: FileHandle; limit: LONGINT): ErrorCode;
|
||||
VAR rc: INTEGER; oldpos: LONGINT;
|
||||
|
|
@ -529,8 +529,8 @@ PROCEDURE Exit*(code: INTEGER);
|
|||
BEGIN exit(code) END Exit;
|
||||
|
||||
|
||||
PROCEDURE -errstring(s: ARRAY OF CHAR) 'WriteFile((HANDLE)(SYSTEM_ADRINT)Platform_StdOut, s, s__len-1, 0,0)';
|
||||
PROCEDURE -errc (c: CHAR) 'WriteFile((HANDLE)(SYSTEM_ADRINT)Platform_StdOut, &c, 1, 0,0)';
|
||||
PROCEDURE -errstring(s: ARRAY OF CHAR) 'WriteFile((HANDLE)(address)Platform_StdOut, s, s__len-1, 0,0)';
|
||||
PROCEDURE -errc (c: CHAR) 'WriteFile((HANDLE)(address)Platform_StdOut, &c, 1, 0,0)';
|
||||
PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
|
||||
PROCEDURE errln; BEGIN errch(0DX); errch(0AX) END errln;
|
||||
|
||||
|
|
@ -552,7 +552,12 @@ BEGIN
|
|||
| -7: errstring("WITH statement type guard failed.")
|
||||
| -8: errstring("SHORT: Value too large for shorter type.")
|
||||
| -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
|
||||
|-15: errstring("Type descriptor size mismatch.")
|
||||
|-10: errstring("NIL access.");
|
||||
|-11: errstring("Alignment error.");
|
||||
|-12: errstring("Divide by zero.");
|
||||
|-13: errstring("Arithmetic overflow/underflow.");
|
||||
|-14: errstring("Invalid function argument.");
|
||||
|-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
|
||||
|-20: errstring("Too many, or negative number of, elements in dynamic array.")
|
||||
ELSE
|
||||
END
|
||||
|
|
@ -589,9 +594,9 @@ PROCEDURE TestLittleEndian;
|
|||
BEGIN i := 1; SYSTEM.GET(SYSTEM.ADR(i), LittleEndian); END TestLittleEndian;
|
||||
|
||||
|
||||
PROCEDURE -getstdinhandle(): FileHandle "(SYSTEM_ADRINT)GetStdHandle(STD_INPUT_HANDLE)";
|
||||
PROCEDURE -getstdouthandle(): FileHandle "(SYSTEM_ADRINT)GetStdHandle(STD_OUTPUT_HANDLE)";
|
||||
PROCEDURE -getstderrhandle(): FileHandle "(SYSTEM_ADRINT)GetStdHandle(STD_ERROR_HANDLE)";
|
||||
PROCEDURE -getstdinhandle(): FileHandle "(address)GetStdHandle(STD_INPUT_HANDLE)";
|
||||
PROCEDURE -getstdouthandle(): FileHandle "(address)GetStdHandle(STD_OUTPUT_HANDLE)";
|
||||
PROCEDURE -getstderrhandle(): FileHandle "(address)GetStdHandle(STD_ERROR_HANDLE)";
|
||||
PROCEDURE -getpid(): INTEGER "(INTEGER)GetCurrentProcessId()";
|
||||
|
||||
BEGIN
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
|
|||
void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
|
||||
{
|
||||
while (n > 0) {
|
||||
P((uintptr)(*((void**)(adr))));
|
||||
P((address)(*((void**)(adr))));
|
||||
adr = ((void**)adr) + 1;
|
||||
n--;
|
||||
}
|
||||
|
|
@ -51,7 +51,7 @@ void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
|
|||
while (n > 0) {
|
||||
t = typ;
|
||||
off = *t;
|
||||
while (off >= 0) {P(*(uintptr*)((char*)adr+off)); t++; off = *t;}
|
||||
while (off >= 0) {P(*(address*)((char*)adr+off)); t++; off = *t;}
|
||||
adr = ((char*)adr) + size;
|
||||
n--;
|
||||
}
|
||||
|
|
@ -109,7 +109,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
|
|||
else if (typ == (LONGINT*)POINTER__typ) {
|
||||
/* element type is a pointer */
|
||||
x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
|
||||
p = (LONGINT*)(uintptr)x[-1];
|
||||
p = (LONGINT*)(address)x[-1];
|
||||
p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
|
||||
p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
|
||||
while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
|
||||
|
|
@ -122,7 +122,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
|
|||
while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
|
||||
nptr = nofelems * nofptrs; /* total number of pointers */
|
||||
x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
|
||||
p = (LONGINT*)(uintptr)x[- 1];
|
||||
p = (LONGINT*)(address)x[- 1];
|
||||
p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
|
||||
p -= nptr - 1; n = 0; off = dataoff;
|
||||
while (n < nofelems) {i = 0;
|
||||
|
|
@ -158,7 +158,7 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
|
|||
// (Ignore other signals)
|
||||
}
|
||||
|
||||
void SystemSetHandler(int s, uintptr h) {
|
||||
void SystemSetHandler(int s, address h) {
|
||||
if (s >= 2 && s <= 4) {
|
||||
int needtosetsystemhandler = handler[s-2] == 0;
|
||||
handler[s-2] = (SystemSignalHandler)h;
|
||||
|
|
@ -197,12 +197,12 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
|
|||
}
|
||||
}
|
||||
|
||||
void SystemSetInterruptHandler(uintptr h) {
|
||||
void SystemSetInterruptHandler(address h) {
|
||||
EnsureConsoleCtrlHandler();
|
||||
SystemInterruptHandler = (SystemSignalHandler)h;
|
||||
}
|
||||
|
||||
void SystemSetQuitHandler(uintptr h) {
|
||||
void SystemSetQuitHandler(address h) {
|
||||
EnsureConsoleCtrlHandler();
|
||||
SystemQuitHandler = (SystemSignalHandler)h;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ typedef unsigned short int uint16;
|
|||
typedef signed char int8;
|
||||
typedef unsigned char uint8;
|
||||
|
||||
#define uintptr size_t
|
||||
#define address size_t
|
||||
|
||||
// The compiler uses 'import' and 'export' which translate to 'extern' and
|
||||
// nothing respectively.
|
||||
|
|
@ -53,7 +53,7 @@ typedef unsigned char uint8;
|
|||
|
||||
#define NIL ((void*)0)
|
||||
#define __MAXEXT 16
|
||||
#define POINTER__typ ((uintptr*)(1)) // not NIL and not a valid type
|
||||
#define POINTER__typ ((address*)(1)) // not NIL and not a valid type
|
||||
|
||||
|
||||
// Oberon types
|
||||
|
|
@ -98,8 +98,8 @@ typedef void* SYSTEM_PTR;
|
|||
|
||||
// OS Memory allocation interfaces are in PlatformXXX.Mod
|
||||
|
||||
extern uintptr Platform_OSAllocate (uintptr size);
|
||||
extern void Platform_OSFree (uintptr addr);
|
||||
extern address Platform_OSAllocate (address size);
|
||||
extern void Platform_OSFree (address addr);
|
||||
|
||||
|
||||
// Run time system routines in SYSTEM.c
|
||||
|
|
@ -120,10 +120,10 @@ extern LONGINT SYSTEM_ENTIER (double x);
|
|||
// Signal handling in SYSTEM.c
|
||||
|
||||
#ifndef _WIN32
|
||||
extern void SystemSetHandler(int s, uintptr h);
|
||||
extern void SystemSetHandler(int s, address h);
|
||||
#else
|
||||
extern void SystemSetInterruptHandler(uintptr h);
|
||||
extern void SystemSetQuitHandler (uintptr h);
|
||||
extern void SystemSetInterruptHandler(address h);
|
||||
extern void SystemSetQuitHandler (address h);
|
||||
#endif
|
||||
|
||||
|
||||
|
|
@ -146,9 +146,9 @@ static int __str_cmp(CHAR *x, CHAR *y){
|
|||
|
||||
#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
|
||||
while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
|
||||
#define __DUP(x, l, t) x=(void*)memcpy((void*)(uintptr)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
|
||||
#define __DUP(x, l, t) x=(void*)memcpy((void*)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
|
||||
#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
|
||||
#define __DEL(x) Platform_OSFree((LONGINT)(uintptr)x)
|
||||
#define __DEL(x) Platform_OSFree((address)x)
|
||||
|
||||
|
||||
// Index and range checks
|
||||
|
|
@ -165,8 +165,8 @@ static int __str_cmp(CHAR *x, CHAR *y){
|
|||
#define __VAL(t, x) (*(t*)&(x))
|
||||
|
||||
|
||||
#define __GET(a, x, t) x= *(t*)(uintptr)(a)
|
||||
#define __PUT(a, x, t) *(t*)(uintptr)(a)=x
|
||||
#define __GET(a, x, t) x= *(t*)(address)(a)
|
||||
#define __PUT(a, x, t) *(t*)(address)(a)=x
|
||||
|
||||
#define __LSHL(x, n, t) ((t)((u##t)(x)<<(n)))
|
||||
#define __LSHR(x, n, t) ((t)((u##t)(x)>>(n)))
|
||||
|
|
@ -182,7 +182,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
|
|||
#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
|
||||
|
||||
#define __BIT(x, n) (*(uint64*)(x)>>(n)&1)
|
||||
#define __MOVE(s, d, n) memcpy((char*)(uintptr)(d),(char*)(uintptr)(s),n)
|
||||
#define __MOVE(s, d, n) memcpy((char*)(address)(d),(char*)(address)(s),n)
|
||||
#define __SHORT(x, y) ((int)((uLONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
|
||||
#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
|
||||
#define __CHR(x) ((CHAR)__R(x, 256))
|
||||
|
|
@ -235,10 +235,10 @@ extern void Heap_INCREF();
|
|||
|
||||
// Main module initialisation, registration and finalisation
|
||||
|
||||
extern void Platform_Init(INTEGER argc, LONGINT argv);
|
||||
extern void Platform_Init(INTEGER argc, address argv);
|
||||
extern void Heap_FINALL();
|
||||
|
||||
#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr)&argv);
|
||||
#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (address)&argv);
|
||||
#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
|
||||
#define __FINI Heap_FINALL(); return 0
|
||||
|
||||
|
|
@ -254,12 +254,12 @@ extern void Platform_AssertFail(LONGINT x);
|
|||
|
||||
// Memory allocation
|
||||
|
||||
extern SYSTEM_PTR Heap_NEWBLK (uintptr size);
|
||||
extern SYSTEM_PTR Heap_NEWREC (uintptr tag);
|
||||
extern SYSTEM_PTR Heap_NEWBLK (address size);
|
||||
extern SYSTEM_PTR Heap_NEWREC (address tag);
|
||||
extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
|
||||
|
||||
#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
|
||||
#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(uintptr)t##__typ)
|
||||
#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(address)t##__typ)
|
||||
#define __NEWARR SYSTEM_NEWARR
|
||||
|
||||
|
||||
|
|
@ -290,20 +290,20 @@ extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
|
|||
#define __INITYP(t, t0, level) \
|
||||
t##__typ = (LONGINT*)&t##__desc.blksz; \
|
||||
memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
|
||||
t##__desc.basep[level] = (LONGINT)(uintptr)t##__typ; \
|
||||
t##__desc.module = (LONGINT)(uintptr)m; \
|
||||
t##__desc.basep[level] = (LONGINT)(address)t##__typ; \
|
||||
t##__desc.module = (LONGINT)(address)m; \
|
||||
if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
|
||||
t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
|
||||
Heap_REGTYP(m, (LONGINT)(uintptr)&t##__desc.next); \
|
||||
Heap_REGTYP(m, (LONGINT)(address)&t##__desc.next); \
|
||||
SYSTEM_INHERIT(t##__typ, t0##__typ)
|
||||
|
||||
#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr)typ##__typ)
|
||||
#define __TYPEOF(p) ((LONGINT*)(uintptr)(*(((LONGINT*)(p))-1)))
|
||||
#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(address)typ##__typ)
|
||||
#define __TYPEOF(p) ((LONGINT*)(address)(*(((LONGINT*)(p))-1)))
|
||||
#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
|
||||
|
||||
// Oberon-2 type bound procedures support
|
||||
#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(uintptr)proc
|
||||
#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr)*(typ-(__TPROC0OFF+num))))parlist
|
||||
#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(address)proc
|
||||
#define __SEND(typ, num, funtyp, parlist) ((funtyp)((address)*(typ-(__TPROC0OFF+num))))parlist
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue