Artifact dea1bda62b0e2b88df3d47cfca1a3cd1f1fb74a1f5f1b85d6b5b04188da62827:

• File psl-1983/3-1/comp/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: 1749) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/comp/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: 1749) [annotate] [blame] [check-ins using]

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

(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 `,',(length (rest fluids)) (reg 1))
    (*call UnBindN)))

(defcmacro *freerstr)

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