mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 11:02:24 +00:00
Update system source to V2.
This commit is contained in:
David Brown
parent
efb7b6b030
commit
4245c6e8b3
10 changed files with 2150 additions and 1482 deletions
|
|
@ -1,60 +1,52 @@
|
|||
(*
|
||||
* voc (jet backend) runtime system, Version 1.1
|
||||
*
|
||||
* Copyright (c) Software Templ, 1994, 1995, 1996
|
||||
*
|
||||
* Module SYSTEM is subject to change any time without prior notification.
|
||||
* Software Templ disclaims all warranties with regard to module SYSTEM,
|
||||
* in particular shall Software Templ not be liable for any damage resulting
|
||||
* from inappropriate use or modification of module SYSTEM.
|
||||
*)
|
||||
MODULE Heap;
|
||||
|
||||
MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
||||
IMPORT SYSTEM; (* Cannot import anything else as heap initialization must complete
|
||||
before any other modules are initialized. *)
|
||||
|
||||
IMPORT SYSTEM; (*must not import other modules*)
|
||||
|
||||
CONST
|
||||
CONST
|
||||
ModNameLen = 20;
|
||||
CmdNameLen = 24;
|
||||
SZL = SIZE(LONGINT);
|
||||
Unit = 4*SZL; (* smallest possible heap block *)
|
||||
nofLists = 9; (* number of free_lists *)
|
||||
heapSize0 = 8000*Unit; (* startup heap size *)
|
||||
SZL = SIZE(LONGINT);
|
||||
Unit = 4*SZL; (* smallest possible heap block *)
|
||||
nofLists = 9; (* number of free_lists *)
|
||||
heapSize0 = 8000*Unit; (* startup heap size *)
|
||||
|
||||
(* all blocks look the same:
|
||||
free blocks describe themselves: size = Unit
|
||||
tag = &tag++
|
||||
->blksize
|
||||
->block size
|
||||
sentinel = -SZL
|
||||
next
|
||||
*)
|
||||
|
||||
(* heap chunks *)
|
||||
nextChnkOff = 0; (* next heap chunk, sorted ascendingly! *)
|
||||
endOff = SZL; (* end of heap chunk *)
|
||||
blkOff = 3*SZL; (* first block in a chunk *)
|
||||
nextChnkOff = LONG(LONG(0)); (* next heap chunk, sorted ascendingly! *)
|
||||
endOff = LONG(LONG(SZL)); (* end of heap chunk *)
|
||||
blkOff = LONG(LONG(3*SZL)); (* first block in a chunk *)
|
||||
|
||||
(* heap blocks *)
|
||||
tagOff = 0; (* block starts with tag *)
|
||||
sizeOff = SZL; (* block size in free block relative to block start *)
|
||||
sntlOff = 2*SZL; (* pointer offset table sentinel in free block relative to block start *)
|
||||
nextOff = 3*SZL; (* next pointer in free block relative to block start *)
|
||||
tagOff = LONG(LONG(0)); (* block starts with tag *)
|
||||
sizeOff = LONG(LONG(SZL)); (* block size in free block relative to block start *)
|
||||
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));
|
||||
|
||||
LongZero = LONG(LONG(0));
|
||||
|
||||
TYPE
|
||||
ModuleName = ARRAY ModNameLen OF CHAR;
|
||||
CmdName = ARRAY CmdNameLen OF CHAR;
|
||||
CmdName = ARRAY CmdNameLen OF CHAR;
|
||||
|
||||
Module = POINTER TO ModuleDesc;
|
||||
Cmd = POINTER TO CmdDesc;
|
||||
EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR));
|
||||
Cmd = POINTER TO CmdDesc;
|
||||
|
||||
EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR));
|
||||
|
||||
ModuleDesc = RECORD
|
||||
next: Module;
|
||||
name: ModuleName;
|
||||
refcnt: LONGINT;
|
||||
cmds: Cmd;
|
||||
types: LONGINT;
|
||||
next: Module;
|
||||
name: ModuleName;
|
||||
refcnt: LONGINT;
|
||||
cmds: Cmd;
|
||||
types: LONGINT;
|
||||
enumPtrs: EnumProc;
|
||||
reserved1, reserved2: LONGINT
|
||||
END ;
|
||||
|
|
@ -64,16 +56,16 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
CmdDesc = RECORD
|
||||
next: Cmd;
|
||||
name: CmdName;
|
||||
cmd: Command
|
||||
cmd: Command
|
||||
END ;
|
||||
|
||||
Finalizer = PROCEDURE(obj: SYSTEM.PTR);
|
||||
|
||||
FinNode = POINTER TO FinDesc;
|
||||
FinDesc = RECORD
|
||||
next: FinNode;
|
||||
obj: LONGINT; (* weak pointer *)
|
||||
marked: BOOLEAN;
|
||||
FinNode = POINTER TO FinDesc;
|
||||
FinDesc = RECORD
|
||||
next: FinNode;
|
||||
obj: LONGINT; (* weak pointer *)
|
||||
marked: BOOLEAN;
|
||||
finalize: Finalizer;
|
||||
END ;
|
||||
|
||||
|
|
@ -81,42 +73,66 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
(* the list of loaded (=initialization started) modules *)
|
||||
modules*: SYSTEM.PTR;
|
||||
|
||||
freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
|
||||
bigBlocks, allocated*: LONGINT;
|
||||
firstTry: BOOLEAN;
|
||||
freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
|
||||
bigBlocks: LONGINT;
|
||||
allocated*: LONGINT;
|
||||
firstTry: BOOLEAN;
|
||||
|
||||
(* extensible heap *)
|
||||
heap, (* the sorted list of heap chunks *)
|
||||
heapend, (* max possible pointer value (used for stack collection) *)
|
||||
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 *)
|
||||
|
||||
(* finalization candidates *)
|
||||
fin: FinNode;
|
||||
|
||||
(* garbage collector locking *)
|
||||
gclock*: SHORTINT;
|
||||
lockdepth: INTEGER;
|
||||
interrupted: BOOLEAN;
|
||||
|
||||
(* File system file count monitor *)
|
||||
FileCount*: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE -malloc(size: LONGINT): LONGINT "(LONGINT)malloc(size)";
|
||||
PROCEDURE -Lock() "Lock";
|
||||
PROCEDURE -Unlock() "Unlock";
|
||||
PROCEDURE -Mainfrm(): LONGINT "SYSTEM_mainfrm";
|
||||
(*
|
||||
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
|
||||
VAR oldflag : BOOLEAN;
|
||||
PROCEDURE Lock*;
|
||||
BEGIN
|
||||
oldflag := flag;
|
||||
flag := TRUE;
|
||||
RETURN oldflag;
|
||||
END TAS;
|
||||
*)
|
||||
INC(lockdepth);
|
||||
END Lock;
|
||||
|
||||
PROCEDURE -PlatformHalt(code: LONGINT) "Platform_Halt(code)";
|
||||
|
||||
PROCEDURE Unlock*;
|
||||
BEGIN
|
||||
DEC(lockdepth);
|
||||
IF interrupted & (lockdepth = 0) THEN
|
||||
PlatformHalt(-9);
|
||||
END
|
||||
END Unlock;
|
||||
|
||||
|
||||
(*
|
||||
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
|
||||
VAR oldflag : BOOLEAN;
|
||||
BEGIN
|
||||
oldflag := flag;
|
||||
flag := TRUE;
|
||||
RETURN oldflag;
|
||||
END TAS;
|
||||
*)
|
||||
|
||||
PROCEDURE REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): SYSTEM.PTR;
|
||||
VAR m: Module;
|
||||
BEGIN
|
||||
IF name = "SYSTEM" THEN (* cannot use NEW *)
|
||||
SYSTEM.NEW(m, SIZE(ModuleDesc)); m.cmds := NIL
|
||||
ELSE NEW(m)
|
||||
END ;
|
||||
(* REGMOD is called at the start of module initialisation code before that modules
|
||||
type descriptors have been set up. 'NEW' depends on the Heap modules type
|
||||
descriptors being ready for use, therefore, just for the Heap module itself, we
|
||||
must use SYSTEM.NEW. *)
|
||||
IF name = "Heap" THEN
|
||||
SYSTEM.NEW(m, SIZE(ModuleDesc))
|
||||
ELSE
|
||||
NEW(m)
|
||||
END;
|
||||
m.types := 0; m.cmds := NIL;
|
||||
COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := SYSTEM.VAL(Module, modules);
|
||||
modules := m;
|
||||
RETURN m
|
||||
|
|
@ -124,7 +140,16 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
|
||||
PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command);
|
||||
VAR c: Cmd;
|
||||
BEGIN NEW(c);
|
||||
BEGIN
|
||||
(* REGCMD is called during module initialisation code before that modules
|
||||
type descriptors have been set up. 'NEW' depends on the Heap modules type
|
||||
descriptors being ready for use, therefore, just for the commands registered
|
||||
by the Heap module itself, we must use SYSTEM.NEW. *)
|
||||
IF m.name = "Heap" THEN
|
||||
SYSTEM.NEW(c, SIZE(CmdDesc))
|
||||
ELSE
|
||||
NEW(c)
|
||||
END;
|
||||
COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c
|
||||
END REGCMD;
|
||||
|
||||
|
|
@ -136,13 +161,17 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
BEGIN INC(m.refcnt)
|
||||
END INCREF;
|
||||
|
||||
|
||||
PROCEDURE -ExternPlatformOSAllocate "extern LONGINT Platform_OSAllocate(LONGINT size);";
|
||||
PROCEDURE -OSAllocate(size: LONGINT): LONGINT "Platform_OSAllocate(size)";
|
||||
|
||||
PROCEDURE NewChunk(blksz: LONGINT): LONGINT;
|
||||
VAR chnk: LONGINT;
|
||||
BEGIN
|
||||
chnk := malloc(blksz + blkOff);
|
||||
chnk := OSAllocate(blksz + blkOff);
|
||||
IF chnk # 0 THEN
|
||||
SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz));
|
||||
SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff));
|
||||
SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz));
|
||||
SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff));
|
||||
SYSTEM.PUT(chnk + (blkOff + sizeOff), blksz);
|
||||
SYSTEM.PUT(chnk + (blkOff + sntlOff), NoPtrSntl);
|
||||
SYSTEM.PUT(chnk + (blkOff + nextOff), bigBlocks);
|
||||
|
|
@ -152,6 +181,13 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
RETURN chnk
|
||||
END NewChunk;
|
||||
|
||||
|
||||
(* 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)(uintptr_t)(*((void**)((uintptr_t)pointer)))";
|
||||
|
||||
PROCEDURE ExtendHeap(blksz: LONGINT);
|
||||
VAR size, chnk, j, next: LONGINT;
|
||||
BEGIN
|
||||
|
|
@ -159,39 +195,48 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
ELSE size := 10000*Unit (* additional heuristics *)
|
||||
END ;
|
||||
chnk := NewChunk(size);
|
||||
IF chnk # 0 THEN
|
||||
IF chnk # 0 THEN
|
||||
(*sorted insertion*)
|
||||
IF chnk < heap THEN
|
||||
SYSTEM.PUT(chnk, heap); heap := chnk
|
||||
ELSE
|
||||
j := heap; SYSTEM.GET(j, next);
|
||||
WHILE (next # 0) & (chnk > next) DO j := next; SYSTEM.GET(j, next) END ;
|
||||
j := heap; next := FetchAddress(j);
|
||||
WHILE (next # 0) & (chnk > next) DO
|
||||
j := next;
|
||||
next := FetchAddress(j)
|
||||
END;
|
||||
SYSTEM.PUT(chnk, next); SYSTEM.PUT(j, chnk)
|
||||
END ;
|
||||
IF next = 0 THEN SYSTEM.GET(chnk + endOff, heapend) END
|
||||
IF next = 0 THEN heapend := FetchAddress(chnk+endOff) END
|
||||
END
|
||||
END ExtendHeap;
|
||||
|
||||
PROCEDURE ^GC*(markStack: BOOLEAN);
|
||||
|
||||
PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR;
|
||||
VAR i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT; new: SYSTEM.PTR;
|
||||
VAR
|
||||
i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT;
|
||||
new: SYSTEM.PTR;
|
||||
BEGIN
|
||||
Lock();
|
||||
SYSTEM.GET(tag, blksz);
|
||||
blksz := FetchAddress(tag);
|
||||
|
||||
ASSERT((Unit = 16) OR (Unit = 32));
|
||||
ASSERT(SIZE(SYSTEM.PTR) <= SIZE(LONGINT));
|
||||
ASSERT(blksz MOD Unit = 0);
|
||||
|
||||
i0 := blksz DIV Unit; i := i0;
|
||||
IF i < nofLists THEN adr := freeList[i];
|
||||
WHILE adr = 0 DO INC(i); adr := freeList[i] END
|
||||
END ;
|
||||
IF i < nofLists THEN (* unlink *)
|
||||
SYSTEM.GET(adr + nextOff, next);
|
||||
next := FetchAddress(adr + nextOff);
|
||||
freeList[i] := next;
|
||||
IF i # i0 THEN (* split *)
|
||||
di := i - i0; restsize := di * Unit; end := adr + restsize;
|
||||
SYSTEM.PUT(end + sizeOff, blksz);
|
||||
SYSTEM.PUT(end + sntlOff, NoPtrSntl);
|
||||
SYSTEM.PUT(end, end + sizeOff);
|
||||
SYSTEM.PUT(end, end + sizeOff);
|
||||
SYSTEM.PUT(adr + sizeOff, restsize);
|
||||
SYSTEM.PUT(adr + nextOff, freeList[di]);
|
||||
freeList[di] := adr;
|
||||
|
|
@ -219,18 +264,18 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
Unlock(); RETURN NIL
|
||||
END
|
||||
END ;
|
||||
SYSTEM.GET(adr+sizeOff, t);
|
||||
t := FetchAddress(adr+sizeOff);
|
||||
IF t >= blksz THEN EXIT END ;
|
||||
prev := adr; SYSTEM.GET(adr + nextOff, adr)
|
||||
prev := adr; adr := FetchAddress(adr + nextOff)
|
||||
END ;
|
||||
restsize := t - blksz; end := adr + restsize;
|
||||
SYSTEM.PUT(end + sizeOff, blksz);
|
||||
SYSTEM.PUT(end + sntlOff, NoPtrSntl);
|
||||
SYSTEM.PUT(end, end + sizeOff);
|
||||
SYSTEM.PUT(end, end + sizeOff);
|
||||
IF restsize > nofLists * Unit THEN (*resize*)
|
||||
SYSTEM.PUT(adr + sizeOff, restsize)
|
||||
ELSE (*unlink*)
|
||||
SYSTEM.GET(adr + nextOff, next);
|
||||
next := FetchAddress(adr + nextOff);
|
||||
IF prev = 0 THEN bigBlocks := next
|
||||
ELSE SYSTEM.PUT(prev + nextOff, next);
|
||||
END ;
|
||||
|
|
@ -245,16 +290,16 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
END ;
|
||||
i := adr + 4*SZL; end := adr + blksz;
|
||||
WHILE i < end DO (*deliberately unrolled*)
|
||||
SYSTEM.PUT(i, LONG(LONG(0)));
|
||||
SYSTEM.PUT(i + SZL, LONG(LONG(0)));
|
||||
SYSTEM.PUT(i + 2*SZL, LONG(LONG(0)));
|
||||
SYSTEM.PUT(i + 3*SZL, LONG(LONG(0)));
|
||||
SYSTEM.PUT(i, LongZero);
|
||||
SYSTEM.PUT(i + SZL, LongZero);
|
||||
SYSTEM.PUT(i + 2*SZL, LongZero);
|
||||
SYSTEM.PUT(i + 3*SZL, LongZero);
|
||||
INC(i, 4*SZL)
|
||||
END ;
|
||||
SYSTEM.PUT(adr + nextOff, LONG(LONG(0)));
|
||||
SYSTEM.PUT(adr, tag);
|
||||
SYSTEM.PUT(adr + sizeOff, LONG(LONG(0)));
|
||||
SYSTEM.PUT(adr + sntlOff, LONG(LONG(0)));
|
||||
SYSTEM.PUT(adr + nextOff, LongZero);
|
||||
SYSTEM.PUT(adr, tag);
|
||||
SYSTEM.PUT(adr + sizeOff, LongZero);
|
||||
SYSTEM.PUT(adr + sntlOff, LongZero);
|
||||
INC(allocated, blksz);
|
||||
Unlock();
|
||||
RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL)
|
||||
|
|
@ -267,9 +312,9 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
|
||||
new := NEWREC(SYSTEM.ADR(blksz));
|
||||
tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL;
|
||||
SYSTEM.PUT(tag - SZL, LONG(LONG(0))); (*reserved for meta info*)
|
||||
SYSTEM.PUT(tag, blksz);
|
||||
SYSTEM.PUT(tag + SZL, NoPtrSntl);
|
||||
SYSTEM.PUT(tag - SZL, LongZero); (*reserved for meta info*)
|
||||
SYSTEM.PUT(tag, blksz);
|
||||
SYSTEM.PUT(tag + SZL, NoPtrSntl);
|
||||
SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag);
|
||||
Unlock();
|
||||
RETURN new
|
||||
|
|
@ -278,28 +323,31 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
PROCEDURE Mark(q: LONGINT);
|
||||
VAR p, tag, fld, n, offset, tagbits: LONGINT;
|
||||
BEGIN
|
||||
IF q # 0 THEN SYSTEM.GET(q - SZL, tagbits);
|
||||
IF ~ODD(tagbits) THEN
|
||||
SYSTEM.PUT(q - SZL, tagbits + 1);
|
||||
p := 0; tag := tagbits + SZL;
|
||||
IF q # 0 THEN
|
||||
tagbits := FetchAddress(q - SZL); (* Load the tag for the record at q *)
|
||||
IF ~ODD(tagbits) THEN (* If it has not already been marked *)
|
||||
SYSTEM.PUT(q - SZL, tagbits + 1); (* Mark it *)
|
||||
p := 0;
|
||||
tag := tagbits + SZL; (* Tag addresses first offset *)
|
||||
LOOP
|
||||
SYSTEM.GET(tag, offset);
|
||||
IF offset < 0 THEN
|
||||
SYSTEM.PUT(q - SZL, tag + offset + 1);
|
||||
SYSTEM.GET(tag, offset); (* Get next ptr field offset *)
|
||||
IF offset < 0 THEN (* If sentinel. (Value is -8*(#fields+1) *)
|
||||
SYSTEM.PUT(q - SZL, tag + offset + 1); (* Rotate base ptr into tag *)
|
||||
IF p = 0 THEN EXIT END ;
|
||||
n := q; q := p;
|
||||
SYSTEM.GET(q - SZL, tag); DEC(tag, 1);
|
||||
tag := FetchAddress(q - SZL); DEC(tag, 1);
|
||||
SYSTEM.GET(tag, offset); fld := q + offset;
|
||||
SYSTEM.GET(fld, p); SYSTEM.PUT(fld, n)
|
||||
ELSE
|
||||
fld := q + offset;
|
||||
SYSTEM.GET(fld, n);
|
||||
IF n # 0 THEN
|
||||
SYSTEM.GET(n - SZL, tagbits);
|
||||
p := FetchAddress(fld); SYSTEM.PUT(fld, SYSTEM.VAL(SYSTEM.PTR, n))
|
||||
ELSE (* offset references a ptr field *)
|
||||
fld := q + offset; (* Address the pointer *)
|
||||
n := FetchAddress(fld); (* Load the pointer *)
|
||||
IF n # 0 THEN (* If pointer is not NIL *)
|
||||
tagbits := FetchAddress(n - SZL); (* Consider record pointed to by this field *)
|
||||
IF ~ODD(tagbits) THEN
|
||||
SYSTEM.PUT(n - SZL, tagbits + 1);
|
||||
SYSTEM.PUT(q - SZL, tag + 1);
|
||||
SYSTEM.PUT(fld, p); p := q; q := n;
|
||||
SYSTEM.PUT(fld, SYSTEM.VAL(SYSTEM.PTR, p));
|
||||
p := q; q := n;
|
||||
tag := tagbits
|
||||
END
|
||||
END
|
||||
|
|
@ -321,42 +369,43 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
|
||||
freesize := 0; allocated := 0; chnk := heap;
|
||||
WHILE chnk # 0 DO
|
||||
adr := chnk + blkOff; SYSTEM.GET(chnk + endOff, end);
|
||||
adr := chnk + blkOff;
|
||||
end := FetchAddress(chnk + endOff);
|
||||
WHILE adr < end DO
|
||||
SYSTEM.GET(adr, tag);
|
||||
tag := FetchAddress(adr);
|
||||
IF ODD(tag) THEN (*marked*)
|
||||
IF freesize > 0 THEN
|
||||
start := adr - freesize;
|
||||
SYSTEM.PUT(start, start+SZL);
|
||||
SYSTEM.PUT(start, start+SZL);
|
||||
SYSTEM.PUT(start+sizeOff, freesize);
|
||||
SYSTEM.PUT(start+sntlOff, NoPtrSntl);
|
||||
i := freesize DIV Unit; freesize := 0;
|
||||
IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start
|
||||
ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start
|
||||
ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start
|
||||
END
|
||||
END ;
|
||||
DEC(tag, 1);
|
||||
SYSTEM.PUT(adr, tag);
|
||||
SYSTEM.GET(tag, size);
|
||||
size := FetchAddress(tag);
|
||||
INC(allocated, size);
|
||||
INC(adr, size)
|
||||
ELSE (*unmarked*)
|
||||
SYSTEM.GET(tag, size);
|
||||
size := FetchAddress(tag);
|
||||
INC(freesize, size);
|
||||
INC(adr, size)
|
||||
END
|
||||
END ;
|
||||
IF freesize > 0 THEN (*collect last block*)
|
||||
start := adr - freesize;
|
||||
SYSTEM.PUT(start, start+SZL);
|
||||
SYSTEM.PUT(start, start+SZL);
|
||||
SYSTEM.PUT(start+sizeOff, freesize);
|
||||
SYSTEM.PUT(start+sntlOff, NoPtrSntl);
|
||||
i := freesize DIV Unit; freesize := 0;
|
||||
IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start
|
||||
ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start
|
||||
ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start
|
||||
END
|
||||
END ;
|
||||
SYSTEM.GET(chnk, chnk)
|
||||
chnk := FetchAddress(chnk)
|
||||
END
|
||||
END Scan;
|
||||
|
||||
|
|
@ -384,14 +433,14 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
chnk := heap; i := 0; lim := cand[n-1];
|
||||
WHILE (chnk # 0 ) & (chnk < lim) DO
|
||||
adr := chnk + blkOff;
|
||||
SYSTEM.GET(chnk + endOff, lim1);
|
||||
lim1 := FetchAddress(chnk + endOff);
|
||||
IF lim < lim1 THEN lim1 := lim END ;
|
||||
WHILE adr < lim1 DO
|
||||
SYSTEM.GET(adr, tag);
|
||||
tag := FetchAddress(adr);
|
||||
IF ODD(tag) THEN (*already marked*)
|
||||
SYSTEM.GET(tag-1, size); INC(adr, size)
|
||||
size := FetchAddress(tag-1); INC(adr, size)
|
||||
ELSE
|
||||
SYSTEM.GET(tag, size);
|
||||
size := FetchAddress(tag);
|
||||
ptr := adr + SZL;
|
||||
WHILE cand[i] < ptr DO INC(i) END ;
|
||||
IF i = n THEN RETURN END ;
|
||||
|
|
@ -400,15 +449,16 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
adr := next
|
||||
END
|
||||
END ;
|
||||
SYSTEM.GET(chnk, chnk)
|
||||
chnk := FetchAddress(chnk)
|
||||
END
|
||||
END MarkCandidates;
|
||||
|
||||
PROCEDURE CheckFin;
|
||||
VAR n: FinNode; tag: LONGINT;
|
||||
BEGIN n := fin;
|
||||
BEGIN
|
||||
n := fin;
|
||||
WHILE n # NIL DO
|
||||
SYSTEM.GET(n.obj - SZL, tag);
|
||||
tag := FetchAddress(n.obj - SZL);
|
||||
IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj)
|
||||
ELSE n.marked := TRUE
|
||||
END ;
|
||||
|
|
@ -425,7 +475,8 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj));
|
||||
(* new nodes may have been pushed in n.finalize, therefore: *)
|
||||
IF prev = NIL THEN n := fin ELSE n := n.next END
|
||||
ELSE prev := n; n := n.next
|
||||
ELSE
|
||||
prev := n; n := n.next
|
||||
END
|
||||
END
|
||||
END Finalize;
|
||||
|
|
@ -439,6 +490,9 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
END
|
||||
END FINALL;
|
||||
|
||||
PROCEDURE -ExternMainStackFrame "extern LONGINT Platform_MainStackFrame;";
|
||||
PROCEDURE -PlatformMainStackFrame(): LONGINT "Platform_MainStackFrame";
|
||||
|
||||
PROCEDURE MarkStack(n: LONGINT; VAR cand: ARRAY OF LONGINT);
|
||||
VAR
|
||||
frame: SYSTEM.PTR;
|
||||
|
|
@ -449,9 +503,9 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *)
|
||||
IF n > 100 THEN RETURN END (* prevent tail recursion optimization *)
|
||||
END ;
|
||||
IF n = 0 THEN
|
||||
IF n = 0 THEN
|
||||
nofcand := 0; sp := SYSTEM.ADR(frame);
|
||||
stack0 := Mainfrm();
|
||||
stack0 := PlatformMainStackFrame();
|
||||
(* check for minimum alignment of pointers *)
|
||||
inc := SYSTEM.ADR(align.p) - SYSTEM.ADR(align);
|
||||
IF sp > stack0 THEN inc := -inc END ;
|
||||
|
|
@ -473,10 +527,10 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: LONGINT;
|
||||
cand: ARRAY 10000 OF LONGINT;
|
||||
BEGIN
|
||||
IF (gclock = 0) OR (gclock = 1) & ~markStack THEN
|
||||
IF (lockdepth = 0) OR (lockdepth = 1) & ~markStack THEN
|
||||
Lock();
|
||||
m := SYSTEM.VAL(Module, modules);
|
||||
WHILE m # NIL DO
|
||||
WHILE m # NIL DO
|
||||
IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ;
|
||||
m := m^.next
|
||||
END ;
|
||||
|
|
@ -484,7 +538,7 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
(* generate register pressure to force callee saved registers to memory;
|
||||
may be simplified by inlining OS calls or processor specific instructions
|
||||
*)
|
||||
i0 := -100; i1 := -101; i2 := -102; i3 := -103; i4 := -104; i5 := -105; i6 := -106; i7 := -107;
|
||||
i0 := -100; i1 := -101; i2 := -102; i3 := -103; i4 := -104; i5 := -105; i6 := -106; i7 := -107;
|
||||
i8 := 1; i9 := 2; i10 := 3; i11 := 4; i12 := 5; i13 := 6; i14 := 7; i15 := 8;
|
||||
i16 := 9; i17 := 10; i18 := 11; i19 := 12; i20 := 13; i21 := 14; i22 := 15; i23 := 16;
|
||||
LOOP INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8);
|
||||
|
|
@ -503,18 +557,29 @@ MODULE SYSTEM; (* J. Templ, 31.5.95 *)
|
|||
END
|
||||
END GC;
|
||||
|
||||
PROCEDURE REGFIN*(obj: SYSTEM.PTR; finalize: Finalizer);
|
||||
PROCEDURE RegisterFinalizer*(obj: SYSTEM.PTR; finalize: Finalizer);
|
||||
VAR f: FinNode;
|
||||
BEGIN NEW(f);
|
||||
f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE; f.next := fin; fin := f
|
||||
END REGFIN;
|
||||
f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE;
|
||||
f.next := fin; fin := f;
|
||||
END RegisterFinalizer;
|
||||
|
||||
PROCEDURE InitHeap; (* initialized before body to enable NEW, SYSTEM.NEW *)
|
||||
|
||||
PROCEDURE -ExternHeapInit "extern void *Heap__init();";
|
||||
PROCEDURE -HeapModuleInit 'Heap__init()';
|
||||
|
||||
PROCEDURE InitHeap*;
|
||||
(* InitHeap is called by Platform.init before any module bodies have been
|
||||
initialised, to enable NEW, SYSTEM.NEW *)
|
||||
BEGIN
|
||||
heap := NewChunk(heapSize0);
|
||||
SYSTEM.GET(heap + endOff, heapend);
|
||||
SYSTEM.PUT(heap, LONG(LONG(0)));
|
||||
allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; gclock := 0
|
||||
heap := NewChunk(heapSize0);
|
||||
heapend := FetchAddress(heap + endOff);
|
||||
SYSTEM.PUT(heap, LongZero);
|
||||
allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0;
|
||||
FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL;
|
||||
interrupted := FALSE;
|
||||
|
||||
HeapModuleInit;
|
||||
END InitHeap;
|
||||
|
||||
END SYSTEM.
|
||||
END Heap.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue