home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / lsp / fast-mv.lisp < prev    next >
Encoding:
Text File  |  1989-08-29  |  1.3 KB  |  42 lines
  1. (in-package 'compiler)
  2.  
  3. ;; Author W. Schelter
  4.  
  5. ;; Using fast-values in place of values, and fast-multiple-setq
  6. ;; allow functions to still be declared to have only 1 value, while
  7. ;; in effect returning several.   This allows a great speed up in
  8. ;; returning extra values.   Eventually we may incorporate this system
  9. ;; to allow similar code to be put out where multiple values are proclaimed
  10. ;; for the function.
  11.  
  12. ;; The primitives set-mv and  mv-ref provide access to 10 storage places
  13. ;; directly by address, without the indirection of going through an array
  14. ;; or symbol.
  15.  
  16. ;; Sample usage:
  17.  
  18. ;;(proclaim '(function goo-fast-mv () t))
  19. ;;(proclaim '(function foo-fast-mv (t) t))
  20. ;;
  21. ;;(defun foo-fast-mv (n)
  22. ;;  (let (x y z)
  23. ;;   (sloop for i below n
  24. ;;     do (fast-multiple-value-setq (x y z) (goo-fast-mv)))
  25. ;;  (list x y z)))
  26. ;;
  27. ;;(defun goo-fast-mv  () (fast-values 1 2 7))
  28.  
  29. (defmacro fast-values (a &rest l)
  30.   (or (< (length l) 10) (error "too many values"))
  31.   `(prog1 ,a ,@ (sloop::sloop for v in l
  32.                for i below 10
  33.                collect `(si::set-mv ,i ,v))))
  34.  
  35. (defmacro fast-multiple-value-setq ((x &rest l) form)
  36.   (or (< (length l) 10) (error "too many values"))
  37.   `(prog1 (setq ,x ,form)
  38.      ,@ (sloop::sloop for i below 10
  39.            for v in l
  40.            collect `(setq ,v (si::mv-ref ,i)))))
  41.  
  42.