Artifact 5459cc7ecea383a0c3951c7985483d289ff061ed5280892298e3ec401bf21c6b:

• File psl-1983/3-1/tests/p-lambind.sl — 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: 1906) [annotate] [blame] [check-ins using] [more...]

%
% P-LAMBIND.SL - Portable cmacro definitions *LAMBIND, *PROGBIND and *FREERSTR
% 
% Author:      Eric Benson
%              Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        6 August 1982
% Copyright (c) 1982 University of Utah
%
% Modification by MLG to preserve REG 1 across FREERSTR
% 19 March,1983
(compiletime (load useful))

(imports '(syslisp))			% requires SYSLISP for AddrUnitsPerItem

(de *lambind (regs fluids)
  (prog (n firstreg)
    (setq n 0)
    (setq regs (rest regs))		% remove REGISTERS at the front
    (setq fluids (rest fluids))		% remove NONLOCALVARS at the front
    (setq fluids			% convert fluids list into vector
          (list2vector (foreach x in fluids collect (second x))))
    (setq firstreg (first regs))
    (setq regs (rest regs))
    (return (if (null regs)			% only one to bind
        `((*move ,firstreg (reg 2))
	  (*move `,',(getv fluids 0) (reg 1))
	  (*call lbind1))
	`((*move ,firstreg (memory (fluid LambindArgs*) (wconst 0)))
	  (*move (fluid LambindArgs*) ,firstreg)
	  ,@(foreach x in regs collect
	    (progn (setq n (add1 n))
	           `(*move ,x
		     (memory ,firstreg
			     (wconst (wtimes2 (wconst AddressingUnitsPerItem)
					      (wconst ,n)))))))
	  (*move `,',fluids (reg 1))
	  (*call lambind))))))

(defcmacro *lambind)

(de *progbind (fluids)
  (if (null (rest (rest fluids)))
      `((*move `,',(second (first (rest fluids))) (reg 1))
	(*call pbind1))
      `((*move `,',(list2vector (foreach x in (rest fluids) collect
				         (second x)))
	       (reg 1))
	(*call progbind))))

(defcmacro *progbind)

(de *freerstr (fluids)
  `((*move (reg 1) (Fluid FreeRstrSave!*))
    (*move `,',(length (rest fluids)) (reg 1))
    (*call UnBindN)
    (*move (Fluid FreeRstrSave!*) (reg 1))))

(defcmacro *freerstr)

(setq *unsafebinder t)			% has to save registers across calls