home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / purify.lisp < prev    next >
Encoding:
Text File  |  1992-05-30  |  1.3 KB  |  42 lines
  1. ;;; -*- Log: code.log; Package: Lisp -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: purify.lisp,v 1.13 92/03/26 03:18:51 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; Storage purifier for Spice Lisp.
  15. ;;; Written by Rob MacLachlan and Skef Wholey.
  16. ;;;
  17. ;;; Rewritten in C by William Lott.
  18. ;;;
  19. (in-package 'lisp)
  20.  
  21. (alien:def-alien-routine ("purify" %purify) c-call:void
  22.   (static-roots c-call:unsigned-long)
  23.   (read-only-roots c-call:unsigned-long))
  24.  
  25. (defun purify (&key root-structures constants)
  26.   (let ((*gc-notify-before*
  27.      #'(lambda (bytes-in-use)
  28.          (declare (ignore bytes-in-use))
  29.          (write-string "[Doing purification: ")
  30.          (force-output)))
  31.     (*internal-gc*
  32.      #'(lambda ()
  33.          (%purify (get-lisp-obj-address root-structures)
  34.               (get-lisp-obj-address constants))))
  35.     (*gc-notify-after*
  36.      #'(lambda (&rest ignore)
  37.          (declare (ignore ignore))
  38.          (write-line "Done.]"))))
  39.     (gc t))
  40.   nil)
  41.  
  42.