(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.	%

if status (feature,its) 
   then (sstatus(who1,42.,"%",118.,0.);	    % Set up "WHO" line variables %
	 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 (if space = 'LIST' then 200. else 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.,(if space = 'LIST' then 200. else 32.)]]))

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

=exit

(setq GC-DAEMON (cond ((null GC-DAEMON)  'GC-DAEMON)
		      ((let ((g (gensym)) 
			     (h (cond ((or (symbolp gc-daemon)
					   (and (not (atom gc-daemon))
						(eq (car gc-daemon) 'LAMBDA)))
				       `(,gc-daemon))
				      (`(FUNCALL ',gc-daemon)))))
			    `(LAMBDA (,g) 
				     (GC-DAEMON ,g)
				     (,.H ,g))))))