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