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

Moving Heap.Mod to SYSTEM.UINTPTR. Only 64 bit working for now.

Browse source
This commit is contained in:
David Brown 2016-09-03 11:56:17 +01:00
parent 11de6b8512
commit cdd8a26481
205 changed files with 656 additions and 650 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/compiler/OPB.Mod
View file

@ -1208,7 +1208,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
err(126)
END;
(* Warn if the result type includes memory past the end of the source variable *)
IF x.typ.size < p.typ.size THEN err(-308) END;
IF (x.class # OPT.Nconst) & (x.typ.size < p.typ.size) THEN err(-308) END;
t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t;
(*
IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN

6
src/compiler/OPV.Mod
View file

@ -566,7 +566,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("(SYSTEM_ADRINT)"); (*SYSTEM*)
| OPT.adr: OPM.WriteString("(uintptr)"); (*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 ;
@ -579,7 +579,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("(SYSTEM_ADRINT)")
OPM.WriteString("(uintptr)")
END;
expr(l, exprPrec)
ELSE
@ -797,7 +797,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("((SYSTEM_ADRINT)("); expr(x, 10); OPM.WriteString("))")
ELSE OPM.WriteString("((uintptr)("); expr(x, 10); OPM.WriteString("))")
END ;
x := x^.link
ELSE

38
src/system/Heap.Mod
View file

@ -30,6 +30,7 @@ MODULE Heap;
sntlOff = LONG(LONG(2*SZL)); (* pointer offset table sentinel in free block relative to block start *)
nextOff = LONG(LONG(3*SZL)); (* next pointer in free block relative to block start *)
NoPtrSntl = LONG(LONG(-SZL));
(*NoPtrSntl = SYSTEM.VAL(SYSTEM.UINTPTR, -SZL);*)
LongZero = LONG(LONG(0));
TYPE
@ -64,7 +65,7 @@ MODULE Heap;
FinNode = POINTER TO FinDesc;
FinDesc = RECORD
next: FinNode;
obj: LONGINT; (* weak pointer *)
obj: SYSTEM.UINTPTR; (* weak pointer *)
marked: BOOLEAN;
finalize: Finalizer;
END ;
@ -75,13 +76,13 @@ MODULE Heap;
freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
bigBlocks: LONGINT;
allocated*: LONGINT;
allocated*: SYSTEM.UINTPTR;
firstTry: BOOLEAN;
(* extensible heap *)
heap: LONGINT; (* the sorted list of heap chunks *)
heapend: LONGINT; (* max possible pointer value (used for stack collection) *)
heapsize*: LONGINT; (* the sum of all heap chunk sizes *)
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 *)
(* finalization candidates *)
fin: FinNode;
@ -153,7 +154,7 @@ MODULE Heap;
COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c
END REGCMD;
PROCEDURE REGTYP*(m: Module; typ: LONGINT);
PROCEDURE REGTYP*(m: Module; typ: SYSTEM.UINTPTR);
BEGIN SYSTEM.PUT(typ, m.types); m.types := typ
END REGTYP;
@ -165,8 +166,8 @@ MODULE Heap;
PROCEDURE -ExternPlatformOSAllocate "extern uintptr Platform_OSAllocate(uintptr size);";
PROCEDURE -OSAllocate(size: SYSTEM.UINTPTR): SYSTEM.UINTPTR "Platform_OSAllocate(size)";
PROCEDURE NewChunk(blksz: LONGINT): LONGINT;
VAR chnk: LONGINT;
PROCEDURE NewChunk(blksz: SYSTEM.UINTPTR): SYSTEM.UINTPTR;
VAR chnk: SYSTEM.UINTPTR;
BEGIN
chnk := OSAllocate(blksz + blkOff);
IF chnk # 0 THEN
@ -185,8 +186,13 @@ MODULE Heap;
(* FetchAddress fetches a pointer from memory and returns it as a LONGINT. It works
correctly regardless of the size of an address. Specifically on 32 bit address
architectures with 64 bit LONGINT, it loads 32 bits and extends it to LONGINT
rather than loading 64 bits. *)
PROCEDURE -FetchAddress(pointer: LONGINT): LONGINT "(LONGINT)(SYSTEM_ADRINT)(*((void**)((SYSTEM_ADRINT)pointer)))";
rather than loading 64 bits.
NOTE - with uintpr work complete this function should be replaces withSYSTEM.GET
as there will be no need to extend addresses to larger types.
*)
PROCEDURE -FetchAddress(pointer: SYSTEM.UINTPTR): SYSTEM.UINTPTR "(uintptr)(*((void**)((uintptr)pointer)))";
PROCEDURE ExtendHeap(blksz: LONGINT);
VAR size, chnk, j, next: LONGINT;
@ -213,16 +219,16 @@ MODULE Heap;
PROCEDURE ^GC*(markStack: BOOLEAN);
PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR;
PROCEDURE NEWREC*(tag: SYSTEM.UINTPTR): SYSTEM.PTR;
VAR
i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT;
i, i0, di, blksz, restsize, t, adr, end, next, prev: SYSTEM.UINTPTR;
new: SYSTEM.PTR;
BEGIN
Lock();
blksz := FetchAddress(tag);
ASSERT((Unit = 16) OR (Unit = 32));
ASSERT(SIZE(SYSTEM.PTR) <= SIZE(LONGINT));
ASSERT(SIZE(SYSTEM.PTR) = SIZE(SYSTEM.UINTPTR));
ASSERT(blksz MOD Unit = 0);
i0 := blksz DIV Unit; i := i0;
@ -305,8 +311,8 @@ MODULE Heap;
RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL)
END NEWREC;
PROCEDURE NEWBLK*(size: LONGINT): SYSTEM.PTR;
VAR blksz, tag: LONGINT; new: SYSTEM.PTR;
PROCEDURE NEWBLK*(size: SYSTEM.UINTPTR): SYSTEM.PTR;
VAR blksz, tag: SYSTEM.UINTPTR; new: SYSTEM.PTR;
BEGIN
Lock();
blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
@ -364,7 +370,7 @@ MODULE Heap;
END MarkP;
PROCEDURE Scan;
VAR chnk, adr, end, start, tag, i, size, freesize: LONGINT;
VAR chnk, adr, end, start, tag, i, size, freesize: SYSTEM.UINTPTR;
BEGIN bigBlocks := 0; i := 1;
WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
freesize := 0; allocated := 0; chnk := heap;

6
src/system/Platformunix.Mod
View file

@ -189,7 +189,7 @@ END ArgPos;
(* Signals and traps *)
PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (SYSTEM_ADRINT)h)";
PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (uintptr)h)";
PROCEDURE SetInterruptHandler*(handler: SignalHandler);
BEGIN sethandler(2, handler); END SetInterruptHandler;
@ -369,7 +369,7 @@ END Size;
PROCEDURE -readfile (fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
"read(fd, (void*)(SYSTEM_ADRINT)(p), l)";
"read(fd, (void*)(uintptr)(p), l)";
PROCEDURE Read*(h: FileHandle; p: LONGINT; l: LONGINT; VAR n: LONGINT): ErrorCode;
BEGIN
@ -386,7 +386,7 @@ END ReadBuf;
PROCEDURE -writefile(fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
"write(fd, (void*)(SYSTEM_ADRINT)(p), l)";
"write(fd, (void*)(uintptr)(p), l)";
PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
VAR written: LONGINT;

8
src/system/SYSTEM.h
View file

@ -39,8 +39,8 @@ typedef unsigned short int uint16;
typedef signed char int8;
typedef unsigned char uint8;
#define uintptr size_t
//#define uintptr size_t
#define uintptr int64
// The compiler uses 'import' and 'export' which translate to 'extern' and
// nothing respectively.
@ -255,8 +255,8 @@ extern void Platform_AssertFail(LONGINT x);
// Memory allocation
extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
extern SYSTEM_PTR Heap_NEWBLK (uintptr size);
extern SYSTEM_PTR Heap_NEWREC (uintptr tag);
extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))