p-lambind.sl 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. %
  2. % P-LAMBIND.SL - Portable cmacro definitions *LAMBIND, *PROGBIND and *FREERSTR
  3. %
  4. % Author: Eric Benson
  5. % Symbolic Computation Group
  6. % Computer Science Dept.
  7. % University of Utah
  8. % Date: 6 August 1982
  9. % Copyright (c) 1982 University of Utah
  10. %
  11. (compiletime (load useful))
  12. (imports '(syslisp)) % requires SYSLISP for AddrUnitsPerItem
  13. (de *lambind (regs fluids)
  14. (prog (n firstreg)
  15. (setq n 0)
  16. (setq regs (rest regs)) % remove REGISTERS at the front
  17. (setq fluids (rest fluids)) % remove NONLOCALVARS at the front
  18. (setq fluids % convert fluids list into vector
  19. (list2vector (foreach x in fluids collect (second x))))
  20. (setq firstreg (first regs))
  21. (setq regs (rest regs))
  22. (return (if (null regs) % only one to bind
  23. `((*move ,firstreg (reg 2))
  24. (*move `,',(getv fluids 0) (reg 1))
  25. (*call lbind1))
  26. `((*move ,firstreg (memory (fluid LambindArgs*) (wconst 0)))
  27. (*move (fluid LambindArgs*) ,firstreg)
  28. ,@(foreach x in regs collect
  29. (progn (setq n (add1 n))
  30. `(*move ,x
  31. (memory ,firstreg
  32. (wconst (wtimes2 (wconst AddressingUnitsPerItem)
  33. (wconst ,n)))))))
  34. (*move `,',fluids (reg 1))
  35. (*call lambind))))))
  36. (defcmacro *lambind)
  37. (de *progbind (fluids)
  38. (if (null (rest (rest fluids)))
  39. `((*move `,',(second (first (rest fluids))) (reg 1))
  40. (*call pbind1))
  41. `((*move `,',(list2vector (foreach x in (rest fluids) collect
  42. (second x)))
  43. (reg 1))
  44. (*call progbind))))
  45. (defcmacro *progbind)
  46. (de *freerstr (fluids)
  47. `((*move `,',(length (rest fluids)) (reg 1))
  48. (*call UnBindN)))
  49. (defcmacro *freerstr)
  50. (setq *unsafebinder t) % has to save registers across calls