Skip to content
Snippets Groups Projects
Commit 41305f48 authored by ram's avatar ram
Browse files

Changed to zero the table pointer at the end of each group so that we can

trivially concatenate fasl files.
parent 8f047501
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.33 1991/11/24 22:55:31 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.34 1991/12/04 18:20:34 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -269,7 +269,6 @@ ...@@ -269,7 +269,6 @@
(let* ((*fasl-file* stream) (let* ((*fasl-file* stream)
(*current-fop-table* (pop *free-fop-tables*)) (*current-fop-table* (pop *free-fop-tables*))
(*current-fop-table-size* ()) (*current-fop-table-size* ())
(*current-fop-table-index* 0)
(*fop-stack-pointer-on-entry* *fop-stack-pointer*)) (*fop-stack-pointer-on-entry* *fop-stack-pointer*))
(if (null *current-fop-table*) (if (null *current-fop-table*)
(setq *current-fop-table* (make-array 1000))) (setq *current-fop-table* (make-array 1000)))
...@@ -279,18 +278,16 @@ ...@@ -279,18 +278,16 @@
(do ((loaded-group (load-group stream) (load-group stream))) (do ((loaded-group (load-group stream) (load-group stream)))
((not loaded-group))) ((not loaded-group)))
(setq *fop-stack-pointer* *fop-stack-pointer-on-entry*) (setq *fop-stack-pointer* *fop-stack-pointer-on-entry*)
(push *current-fop-table* *free-fop-tables*)
;; ;;
;; Nil out the table, so we don't hold onto garbage. ;; Nil out the stack and table, so we don't hold onto garbage.
(let ((tab *current-fop-table*))
(dotimes (i *current-fop-table-index*)
(declare (fixnum i))
(setf (svref tab i) nil))
(push tab *free-fop-tables*))
;;
;; Ditto for the stack...
(dotimes (i *fop-stack-pointer-on-entry*) (dotimes (i *fop-stack-pointer-on-entry*)
(declare (fixnum i)) (declare (fixnum i))
(setf (svref *fop-stack* i) nil)))) (setf (svref *fop-stack* i) nil))
(let ((tab *current-fop-table*))
(dotimes (i (length tab))
(declare (fixnum i))
(setf (svref tab i) nil)))))
t) t)
#| #|
...@@ -340,7 +337,8 @@ ...@@ -340,7 +337,8 @@
(defun load-group (file) (defun load-group (file)
(when (check-header file) (when (check-header file)
(catch 'group-end (catch 'group-end
(let ((*current-code-format* nil)) (let ((*current-code-format* nil)
(*current-fop-table-index* 0))
(loop (loop
(let ((byte (read-byte file))) (let ((byte (read-byte file)))
(if (eql byte 3) (if (eql byte 3)
...@@ -354,6 +352,7 @@ ...@@ -354,6 +352,7 @@
(svref *current-fop-table* (read-byte file)))) (svref *current-fop-table* (read-byte file))))
(funcall (svref fop-functions byte))))))))) (funcall (svref fop-functions byte)))))))))
;;; Check-Header returns t if t succesfully read a header from the file, ;;; Check-Header returns t if t succesfully read a header from the file,
;;; or () if EOF was hit before anything was read. An error is signaled ;;; or () if EOF was hit before anything was read. An error is signaled
;;; if garbage is encountered. ;;; if garbage is encountered.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment