List of memory blocks allocated from the host operating system. This list is somehow unusual, as head doesn't point to the real beginning of a block. Instead it points to an address after the header, where the "Oberon managed portion" of the block starts. The list is sorted so that blocks at a lower memory address preceed blocks with a larger memory address.
heapSize-:LONGINT; (* Record the total size requested from the host operating system. *)
allocated-:LONGINT; (* Record the size of all allocations within Oberon. *)
nofiles*,stackBottom*:LONGINT;
freeList:ARRAY nofLists+1 OF ADDRESS; (* dummy,16,32,48,64,80,96,112,128,sentinel *)
This maintains separate free lists for small blocks. Thus for small allocations
a good fitting block is found easily.
bigBlocks:ADDRESS;
This is the list of "Oberon managed blocks".
heapEnd:ADDRESS; (*<<*)
points to the first address after the last memory block. Thus all heap managed memory
is contained in the memory area between heap and heapEnd.
firstTry:BOOLEAN;
fin:FinObject; (* List of registered objects for finalization *)
toBeFin:FinObject; (* List of unreferenced objects which have to be finalized *) (*<<*)
VAR i,i0,di,size,restsize,t:LONGINT; adr,next,prev:ADDRESS;
BEGIN
SYSTEM.GET(tag,size);
i0:=size DIV Unit; i:=i0;
Try to locate a free block in one of the small block lists, starting
with the best fitting one and working up to bigger ones, as long
as no free blocks are found.
IF i<nofLists THEN
adr:=freeList[i];
WHILE adr=Nil DO INC(i); adr:=freeList[i] END; (* This terminates because of sentinel. *)
END ;
IF i<nofLists THEN (* unlink *)
(*
A small block was found. It is unlinked from the free list.
*)
SYSTEM.GET(adr+nextOff,next);
freeList[i]:=next;
IF i#i0 THEN (* split *)
(*
The block was not the smallest possible. Thus it is split. The
first part forms the remaining free block, which is linked into
the appropriate free list. The second part forms the block
which is returned from New.
*)
di:=i - i0; restsize:=di*Unit;
SYSTEM.PUT(adr,restsize+ASH(1,freeblk));
SYSTEM.PUT(adr+nextOff,freeList[di]);
freeList[di]:=adr;
INC(adr,restsize)
END;
SYSTEM.PUT(adr,size+ASH(1,freeblk));
ELSE
(*
No free block of the small free blocks could be used, so one of the "big blocks" is taken. Eventually, this means requesting new blocks from the host operating system.
To describe the following code, its best to look at the possible szenarios:
1) bigBlocks contains a block large enough. This block is found, and the loop terminates at the EXIT statement. After some extra work, New will terminate.
2) bigBlocks is emtpy and a garbage collection won't change anything. In this case New is recursively called, with the global firstTry set to FALSE. The second invocation will, after traversing the bigBlocks list withou success, enter the ELSE-part of the IF firstTry statement. AllocHeap will allocate a memory block large enough to satisy the request and link it into the bigBlock list. New is invoked a third time. This third invocation will find the just allocated block in the list, and exit the loop through the EXIT statement, do the extra work and return. The RETURN adr is executed, terminating the second invocation. This is followed by a resetting of firstTry to TRUE and a RETURN adr, which terminates the main invocation of New.
3) bigBlocks is empty, but garbage collection will return some useful space. The invocation of New following the GC call will find this space either in one of the small block free lists, or in the big free list. In none of these cases it will enter the IF adr=Nil statement, but terminate regularly. After this invocation returns, the main New invocation is terminated.
IF t >=size THEN EXIT END ; (* why not IF t>=size ?? *)
prev:=adr;
SYSTEM.GET(adr+nextOff,adr);
END ;
(*
A block large enough is located. If the unneeded size is larger than the blocks managed in the freelist, it is simply shortened. Otherwise it is completely unliked, and the initial remaining block linked into the appropriate small block free list.
*)
restsize:=t - size - ASH(1,freeblk);
SYSTEM.PUT(adr+restsize,size+ASH(1,freeblk));
IF restsize >= nofLists*Unit THEN (*resize*) (* Shouldn't it be restsize >= nofLists*Unit ??? *)
SYSTEM.PUT(adr,restsize+ASH(1,freeblk))
ELSE (*unlink*)
SYSTEM.GET(adr+nextOff,next);
IF prev=Nil THEN bigBlocks:=next
ELSE SYSTEM.PUT(prev+nextOff,next)
END ;
IF restsize > 0 THEN (*move*)
di:=restsize DIV Unit;
SYSTEM.PUT(adr,restsize+ASH(1,freeblk));
SYSTEM.PUT(adr+nextOff,freeList[di]);
freeList[di]:=adr
END
END ;
INC(adr,restsize)
END ;
Erase the allocated block, and put the type tag at the beginning of the block.
i:=4; WHILE i<size DO SYSTEM.PUT(adr+i,Nil); INC(i,4) END ;
SYSTEM.PUT(adr,tag);
INC(allocated,size);
RETURN adr+4;
END New;
PROCEDURE SysNew*(size:LONGINT):ADDRESS;
VAR i,i0,di,restsize,t:LONGINT; adr,next,originalSize,prev:ADDRESS;
BEGIN
originalSize:=size;
INC(size,12); INC(size,(-size) MOD Unit);
i0:=size DIV Unit; i:=i0;
Try to locate a free block in one of the small block lists, starting
with the best fitting one and working up to bigger ones, as long
as no free blocks are found.
IF i<nofLists THEN
adr:=freeList[i];
WHILE adr=Nil DO INC(i); adr:=freeList[i] END; (* This terminates because of sentinel. *)
END ;
IF i<nofLists THEN (* unlink *)
(*
A small block was found. It is unlinked from the free list.
*)
SYSTEM.GET(adr+nextOff,next);
freeList[i]:=next;
IF i#i0 THEN (* split *)
(*
The block was not the smallest possible. Thus it is split. The
first part forms the remaining free block, which is linked into
the appropriate free list. The second part forms the block
which is returned from SysNew.
*)
di:=i - i0; restsize:=di*Unit;
SYSTEM.PUT(adr,restsize+ASH(1,freeblk));
SYSTEM.PUT(adr+nextOff,freeList[di]);
freeList[di]:=adr;
INC(adr,restsize)
END;
SYSTEM.PUT(adr,size+ASH(1,freeblk))
ELSE
(*
For a description, see the analoguos part in New().
IF t >= size THEN EXIT END ; (* why not IF t>=size ?? *)
prev:=adr;
SYSTEM.GET(adr+nextOff,adr)
END ;
(*
A block large enough is located. If the unneeded size is larger than the blocks managed in the freelist, it is simply shortened. Otherwise it is completely unliked, and the initial remaining block linked into the appropriate small block free list.
*)
restsize:=t - size - ASH(1,freeblk);
SYSTEM.PUT(adr+restsize,size+ASH(1,freeblk));
IF restsize >=nofLists*Unit THEN (*resize*) (* Shouldn't it be restsize >= nofLists*Unit ??? *)
SYSTEM.PUT(adr,restsize+ASH(1,freeblk))
ELSE (*unlink*)
SYSTEM.GET(adr+nextOff,next);
IF prev=Nil THEN bigBlocks:=next
ELSE SYSTEM.PUT(prev+nextOff,next)
END ;
IF restsize > 0 THEN (*move*)
di:=restsize DIV Unit;
SYSTEM.PUT(adr,restsize+ASH(1,freeblk));
SYSTEM.PUT(adr+nextOff,freeList[di]);
freeList[di]:=adr
END
END ;
INC(adr,restsize)
END ;
The type tag points to the end of the block, where just the size is
stored (a pseudo type tag?). To distinguish this block from a regular
(.txt)