Artifact d919fb0fd67a491435b8b40b3a12d5541dbf8c6c95ccf921911e88619f49703a:

• File psl-1983/3-1/tests/mini-allocators.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1498) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/tests/mini-allocators.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1498) [annotate] [blame] [check-ins using]

% MINI-ALLOC.RED : Crude Mini Allocator and support
%            See PT:P-ALLOCATORS.RED
% Revisions: MLG, 18 Feb,1983
%	     Moved HEAP declaration to XXX-HEADER 
%            Had to provide an InitHeap routine
%            (or will be LoadTime :=)
on syslisp;

external Wvar HeapLowerBound, HeapUpperBound;

external WVar HeapLast,			        % next free slot in heap	
	      HeapPreviousLast;			% save start of new block

syslsp procedure GtHEAP N;		        
%  get heap block of N words
if null N then (HeapUpperBound - HeapLast) / AddressingUnitsPerItem else
<<  HeapPreviousLast := HeapLast;
    HeapLast := HeapLast + N*AddressingUnitsPerItem;
    if HeapLast > HeapUpperBound then
    <<  !%Reclaim();
	HeapPreviousLast := HeapLast;
	HeapLast := HeapLast + N*AddressingUnitsPerItem;
	if HeapLast > HeapUpperBound then
	    FatalError "Heap space exhausted" >>;
    HeapPreviousLast >>;

syslsp procedure GtSTR N;		
%  Allocate space for a string N chars
begin scalar S, NW;
    S := GtHEAP((NW := STRPack N) + 1);
    @S := MkItem(HBytes, N);
    S[NW] := 0;				% clear last word, including last byte
    return S;
end;

syslsp procedure GtVECT N;		
%  Allocate space for a vector N items
begin scalar V;
    V := GtHEAP(VECTPack N + 1);
    @V := MkItem(HVECT, N);
    return V;
end;

Procedure GtWarray N;  
% Dummy for Now, since no GC
 GtVect N;

Procedure GtID();
% Simple ID Allocator
 Begin scalar D;
  D:=NextSymbol;
  NextSymbol:=NextSymbol+1;
  return D;
 End;

Off syslisp;

End;