X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fload.lisp;h=2c3371b7b3dabdd28f5fbc62ff9c26ae731638b2;hb=c01ff86b012283af04641a02e45f066aa7cdb10c;hp=02a029393eb9b285ba883aa499047a350680146e;hpb=1b778d435773891979dab6d442c19f2b7b62b869;p=sbcl.git

diff --git a/src/code/load.lisp b/src/code/load.lisp
index 02a0293..2c3371b 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -51,6 +51,10 @@
 
 #!-sb-fluid (declaim (inline read-byte))
 
+;;; FIXME: why do all of these reading functions and macros declare
+;;; (SPEED 0)?  was there some bug in the compiler which has since
+;;; been fixed?  --njf, 2004-09-08
+
 ;;; This expands into code to read an N-byte unsigned integer using
 ;;; FAST-READ-BYTE.
 (defmacro fast-read-u-integer (n)
@@ -87,7 +91,7 @@
 	 (cnt 1 (1+ cnt)))
 	((>= cnt n) res))))
 
-;;; Read an N-byte unsigned integer from the *FASL-INPUT-STREAM*
+;;; Read an N-byte unsigned integer from the *FASL-INPUT-STREAM*.
 (defmacro read-arg (n)
   (declare (optimize (speed 0)))
   (if (= n 1)
@@ -97,11 +101,19 @@
 	  (fast-read-u-integer ,n)
 	  (done-with-fast-read-byte)))))
 
-;;; FIXME: This deserves a more descriptive name, and should probably
-;;; be implemented as an ordinary function, not a macro.
-;;;
-;;; (for the names: There seem to be only two cases, so it could be
-;;; named READ-U-INTEGER-8 and READ-U-INTEGER-32 or something.)
+(declaim (inline read-byte-arg read-halfword-arg read-word-arg))
+(defun read-byte-arg ()
+  (declare (optimize (speed 0)))
+  (read-arg 1))
+
+(defun read-halfword-arg ()
+  (declare (optimize (speed 0)))
+  (read-arg #.(/ sb!vm:n-word-bytes 2)))
+
+(defun read-word-arg ()
+  (declare (optimize (speed 0)))
+  (read-arg #.sb!vm:n-word-bytes))
+
 
 ;;;; the fop table
 
@@ -293,7 +305,7 @@
 
       ;; Read and validate version-specific compatibility stuff.
       (flet ((string-from-stream ()
-               (let* ((length (read-arg 4))
+               (let* ((length (read-word-arg))
 		      (result (make-string length)))
 		 (read-string-as-bytes stream result)
 		 result)))
@@ -301,7 +313,7 @@
 	(let* ((implementation (keywordicate (string-from-stream)))
 	       ;; FIXME: The logic above to read a keyword from the fasl file
 	       ;; could probably be shared with the read-a-keyword fop.
-	       (version (read-arg 4)))
+	       (version (read-word-arg)))
 	  (flet ((check-version (variant
 				 possible-implementation
 				 needed-version)
@@ -336,6 +348,11 @@
 #!+sb-show
 (defvar *show-fops-p* nil)
 
+;; buffer for loading symbols
+(defvar *fasl-symbol-buffer*)
+(declaim (simple-string *fasl-symbol-buffer*))
+
+;;; 
 ;;; a helper function for LOAD-AS-FASL
 ;;;
 ;;; Return true if we successfully load a group from the stream, or
@@ -348,31 +365,26 @@
 	(loop
 	  (let ((byte (read-byte stream)))
 
-	    ;; stale code from before rewrite of *FOP-STACK* as
-	    ;; adjustable vector (probably worth rewriting when next
-	    ;; anyone needs to debug FASL stuff)
-	    #|
 	    ;; Do some debugging output.
 	    #!+sb-show
 	    (when *show-fops-p*
-	      (let ((ptr *fop-stack-pointer*)
-		    (stack *fop-stack*))
-		(fresh-line *trace-output*)
-		;; The FOP operations are stack based, so it's sorta
-		;; logical to display the operand before the operator.
-		;; ("reverse Polish notation")
-		(unless (= ptr (length stack))
-		  (write-char #\space *trace-output*)
-		  (prin1 (svref stack ptr) *trace-output*)
-		  (terpri *trace-output*))
-		;; Display the operator.
-		(format *trace-output*
-			"~&~S (#X~X at ~D) (~S)~%"
-			(svref *fop-names* byte)
-			byte
-			(1- (file-position stream))
-			(svref *fop-funs* byte))))
-            |#
+              (let* ((stack *fop-stack*)
+                     (ptr (1- (fill-pointer *fop-stack*))))
+                (fresh-line *trace-output*)
+                ;; The FOP operations are stack based, so it's sorta
+                ;; logical to display the operand before the operator.
+                ;; ("reverse Polish notation")
+                (unless (= ptr -1)
+                  (write-char #\space *trace-output*)
+                  (prin1 (aref stack ptr) *trace-output*)
+                  (terpri *trace-output*))
+                ;; Display the operator.
+                (format *trace-output*
+                        "~&~S (#X~X at ~D) (~S)~%"
+                        (aref *fop-names* byte)
+                        byte
+                        (1- (file-position stream))
+                        (svref *fop-funs* byte))))
 
 	    ;; Actually execute the fop.
 	    (funcall (the function (svref *fop-funs* byte)))))))))
@@ -388,6 +400,7 @@
   (maybe-announce-load stream verbose)
   (sb!thread:with-recursive-lock (sb!c::*big-compiler-lock*)
     (let* ((*fasl-input-stream* stream)
+           (*fasl-symbol-buffer* (make-string 100))
 	   (*current-fop-table* (or (pop *free-fop-tables*) (make-array 1000)))
 	   (*current-fop-table-size* (length *current-fop-table*))
 	   (*fop-stack* (make-array 100 :fill-pointer 0 :adjustable t)))
@@ -400,20 +413,6 @@
 	;; that this would go away?
 	(fill *current-fop-table* nil))))
   t)
-
-;;; This is used in in target-load and also genesis, using
-;;; *COLD-FOREIGN-SYMBOL-TABLE*. All the speculative prefix-adding
-;;; code for foreign symbol lookup should be here.
-(defun find-foreign-symbol-in-table (name table)
-  (let ((prefixes
-         #!+(or osf1 sunos linux freebsd darwin) #("" "ldso_stub__")
-	 #!+openbsd #("")))
-    (declare (notinline some)) ; to suppress bug 117 bogowarning
-    (some (lambda (prefix)
-	    (gethash (concatenate 'string prefix name)
-		     table
-		     nil))
-	  prefixes)))
 
 ;;;; stuff for debugging/tuning by collecting statistics on FOPs (?)