(cgol)

declare(muzzled(t))	% Shut up about closed compilation. %

%	GC-daemon for optimal allocation.			%
%	Described in AI Working Paper #142.			%
%	set "alloc-mark-ratio" to a flonum between 0.2 and 5.0.	%

lisp_version_number := let ibase=10. in readlist(explodec(status(lispv)))

if lisp_version_number < 1258.
   then (print "GCDEMN requires LISP 1258. or greater."; error("gcdemn"))

if status(ttytype,tyo)=5.		% Check if we are on TV!  %
   then (sstatus(who1,42.,"%",118.,0.);	% Set up "who" line on tv's.  %
	 sstatus(gcwho,3.);
	 who3 := "GCDEMN")

% Change to check for "init_size" property of space.  Will never go
  below this size on an allocation.  %

% Initialize property lists of space names.  %
let gc_daemon=
    '\spacelist;
     (let alloct=nil.alloc(t);		% Get list of current allocations.  %
      for element in spacelist		% Loop through all spaces.  %
	  do (if length(element) < 5. then error("gcdemn: spacelist wrong format.");
	      let space = car(element),
		  freebefore = cadr(element),
		  freeafter = caddr(element),
		  sizebefore = cadddr(element),
		  sizeafter = car(cddddr(element));
	      % Initialize state of each space for gc-daemon.  %
	      accessible ofq space := sizeafter-freeafter;
	      % Make sure that we don't get a gc-overflow interrupt.  %
	      alloc([space,[max(512.,car(space of alloct) or sizeafter),
			    262143.,
			    if sizeafter>0 then 32. else 0.]])))'
    in gc()

alloc_mark_ratio := 1.0 		% Mean words allocated/words marked by gc. %

special alloc_mark_ratio

define "GC-DAEMON" (spacelist);
  let total_accessible = 0.0,
      total_consed = 0.0;
  % Go through spaces and accumulate consed and accessible information.  %
  for element in spacelist			% Argument is "alist" of spaces. %
      do (if length(element) < 5. then error("gcdemn: spacelist wrong format.");
	  let space = car(element),		% Give names to parameters.  %
	      freebefore = cadr(element),
	      freeafter = caddr(element),
	      sizebefore = cadddr(element),
	      sizeafter = car(cddddr(element));
	  % Compute consed since last gc and accessible now for this space.  %
	  consed ofq space := sizebefore-freebefore-accessible ofq space;
	  total_consed := total_consed + consed ofq space;
	  accessible ofq space := sizeafter-freeafter;
	  total_accessible := total_accessible + accessible ofq space);
  % Store total consed, total accessible and compute total free.  %
  consed ofq 'total_storage' := total_consed;
  accessible ofq 'total_storage' := total_accessible;
  let total_free = alloc_mark_ratio * total_accessible;
  free ofq 'total_storage' := total_free;
  % Go through spaces and re-allocate where necessary.  %
  for element in spacelist
      do (let space = car element;
	  alloc_rate ofq space := consed ofq space / total_consed;
	  free ofq space := fix(total_free * alloc_rate ofq space);
	  let spcsize = accessible ofq space + free ofq space + 511.;
	      if spcsize>511. then alloc([space,[spcsize,262143.,32.]]))

gc_daemon := 'gc_daemon'		% Arm interrupt with our handler.  %

=exit