Artifact 868f78fd0cf24d96820c4e5a32cd527974eb34d20fff4e0beeff61bbb8c45690:

• File psl-1983/3-1/kernel/20/fast-binder.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: 3029) [annotate] [blame] [check-ins using] [more...]

%
% FAST-BINDER.RED - Fast binding and unbinding routines in LAP for Dec-20 PSL
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        12 July 1981
% Copyright (c) 1981 University of Utah
%

%  25-May-1983 Mark R. Swanson
%  Changed FastBind to zero out left half of a symbol table index (for extended
%  addressing 20).

on SysLisp;

external WVar BndStkPtr,	% The binding stack pointer
	      BndStkLowerBound,	% Bottom of the binding stack
	      BndStkUpperBound;	% Top of the binding stack

% TAG( FastBind )

lap '((!*Entry FastBind expr 0)		% Bind IDs to values in registers
%
% FastBind is called with JSP T5, followed by
%  regnum,,idnum
%  ...
%
	(!*MOVE (WVar BndStkPtr) (reg t2))	% load binding stack pointer
Loop
	(!*MOVE (Indexed (reg t5) (WConst 0)) (reg t1))	% get next entry
	(tlnn (reg t1) 8#777000)	% if it's not an instruction
	(!*JUMP (Label MoreLeft))	% keep binding
	(!*MOVE (reg t2) (WVar BndStkPtr)) % Otherwise store bind stack pointer
	(!*JUMP (MEMORY (reg t5) (WConst 0)))	% and return
MoreLeft
	(!*WPLUS2 (reg t2) (WConst 2))	% add 2 to binding stack pointer
	(caml (reg t2) (WVar BndStkUpperBound))	% if overflow occured
	(!*JCALL BStackOverflow)	% then error
	(hlrz (reg t3) (reg t1))	% stick register number in t3
	(caile (reg t3) (WConst MaxRealRegs))	% is it a real register?
	(!*WPLUS2 (reg t3)		% no, move to arg block
		  (WConst (difference (WArray ArgumentBlock)
				      (plus (WConst MaxRealRegs) 1))))
				        
	(hrrzm (reg t1) (Indexed (reg t2) (WConst -1)))
					% store ID number in BndStk
        (hrrz  (reg t1) (reg t1))	% zero out left half of reg t1 for
				        % extended memory
	(!*MOVE (MEMORY (reg t1) (WConst SymVal)) (reg t4))
					% get old value for ID in t4
	(!*MOVE (reg t4) (MEMORY (reg t2) (WConst 0)))	% store value in BndStk
	(!*MOVE (MEMORY (reg t3) (WConst 0)) (reg t3))  % get reg value in t3
	(!*MOVE (reg t3) (MEMORY (reg t1) (WConst SymVal)))
					% store in ID value cell
	(aoja (reg t5) Loop)		% try again
);

% TAG( FastUnBind )

lap '((!*Entry FastUnBind expr 0)	% Unbind last N entries in bind stack
%
% FastUnBind is called with JSP T5, followed by word containing count to
% unbind.
%
	(!*MOVE (WVar BndStkPtr) (reg t1)) % get binding stack pointer in t1
	(!*MOVE (MEMORY (reg t5) (WConst 0)) (reg t2))	% count in t2
Loop
	(!*JUMPWGREATERP (Label MoreLeft) (reg t2) (WConst 0))
					% continue if count is > zero
	(!*MOVE (reg t1) (WVar BndStkPtr)) % otherwise store bind stack pointer
	(!*JUMP (MEMORY (reg t5) (WConst 1)))	% and return
MoreLeft
	(camge (reg t1) (WVar BndStkLowerBound))	% check for underflow
	(!*JCALL BStackUnderflow)
	(dmove (reg t3) (Indexed (reg t1) -1)) % get ID # in t3, value in t4
	(!*MOVE (reg t4) (MEMORY (reg t3) (WConst SymVal)))
					% restore to value cell
	(!*WDIFFERENCE (reg t1) (WConst 2)) % adjust binding stack pointer -2
	(soja (reg t2) Loop)		% and count down by 1, then try again
);

off SysLisp;

END;