X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=f2ec21c55bb3e6f92e31e5618a7b930bc6834430;hb=f6a2be77637d025bfded9430f02863c28f74f77a;hp=c5791edd6780f7aee98bdae61b98917060639937;hpb=b08344ddbb8d0193054b72c01be7e367422ccf03;p=sbcl.git diff --git a/src/code/fop.lisp b/src/code/fop.lisp index c5791ed..f2ec21c 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -1,30 +1,24 @@ ;;;; FOP definitions -(in-package "SB!IMPL") +(in-package "SB!FASL") ;;; Define NAME as a fasl operation, with op-code FOP-CODE. PUSHP ;;; describes what the body does to the fop stack: -;;; :NOPE -;;; The body neither pushes or pops the fop stack. ;;; T ;;; The body might pop the fop stack. The result of the body is ;;; pushed on the fop stack. ;;; NIL ;;; The body might pop the fop stack. The result of the body is ;;; discarded. -;;; -;;; FIXME: Make PUSHP into a &KEY argument accepting a booleana value. -;;; Handle the :PUSHP :NOPE case with a separate :STACKP NIL argument, -;;; meaning "the body doesn't interact with the FOP stack." -(defmacro define-fop ((name fop-code &optional (pushp t)) &rest forms) +;;; STACKP describes whether or not the body interacts with the fop stack. +(defmacro define-fop ((name fop-code &key (pushp t) (stackp t)) &rest forms) `(progn (defun ,name () - ,(if (eq pushp :nope) - `(progn ,@forms) - `(with-fop-stack ,pushp ,@forms))) + ,(if stackp + `(with-fop-stack ,pushp ,@forms) + `(progn ,@forms))) (%define-fop ',name ,fop-code))) -;;; FIXME: This can be byte coded. (defun %define-fop (name code) (let ((oname (svref *fop-names* code))) (when (and oname (not (eq oname name))) @@ -38,7 +32,7 @@ (error "multiple codes for fop name ~S: ~D and ~D" name code ocode))) (setf (svref *fop-names* code) name (get name 'fop-code) code - (svref *fop-functions* code) (symbol-function name)) + (svref *fop-funs* code) (symbol-function name)) (values)) ;;; Define a pair of fops which are identical except that one reads @@ -63,18 +57,20 @@ ;;; Some of this logic is already in DUMP-FOP*, but that still requires the ;;; caller to know that it's a 1-byte-arg/4-byte-arg cloned fop pair, and to ;;; know both the 1-byte-arg and the 4-byte-arg fop names. -- WHN 19990902 -(defmacro define-cloned-fops ((name code &optional (pushp t)) +(defmacro define-cloned-fops ((name code &key (pushp t) (stackp t)) (small-name small-code) &rest forms) - (check-type pushp (member nil t :nope)) + (aver (member pushp '(nil t))) + (aver (member stackp '(nil t))) `(progn (macrolet ((clone-arg () '(read-arg 4))) - (define-fop (,name ,code ,pushp) ,@forms)) + (define-fop (,name ,code :pushp ,pushp :stackp ,stackp) ,@forms)) (macrolet ((clone-arg () '(read-arg 1))) - (define-fop (,small-name ,small-code ,pushp) ,@forms)))) + (define-fop (,small-name ,small-code :pushp ,pushp :stackp stackp) ,@forms)))) -;;; a helper function for reading string values from FASL files: sort of like -;;; READ-SEQUENCE specialized for files of (UNSIGNED-BYTE 8), with an automatic -;;; conversion from (UNSIGNED-BYTE 8) into CHARACTER for each element read +;;; a helper function for reading string values from FASL files: sort +;;; of like READ-SEQUENCE specialized for files of (UNSIGNED-BYTE 8), +;;; with an automatic conversion from (UNSIGNED-BYTE 8) into CHARACTER +;;; for each element read (declaim (ftype (function (stream simple-string &optional index) (values)) read-string-as-bytes)) (defun read-string-as-bytes (stream string &optional (length (length string))) (dotimes (i length) @@ -95,24 +91,25 @@ ;;; Setting this variable causes execution of a FOP-NOP4 to produce ;;; output to *DEBUG-IO*. This can be handy when trying to follow the -;;; progress of FASLOAD. +;;; progress of FASL loading. #!+sb-show (defvar *show-fop-nop4-p* nil) -;;; CMU CL had a single no-op fop, FOP-NOP, with fop code 0. Since 0 occurs -;;; disproportionately often in fasl files for other reasons, FOP-NOP is less -;;; than ideal for writing human-readable patterns into fasl files for -;;; debugging purposes. There's no shortage of unused fop codes, so we add this -;;; second NOP, which reads 4 arbitrary bytes and discards them. -(define-fop (fop-nop4 137 :nope) +;;; CMU CL had a single no-op fop, FOP-NOP, with fop code 0. Since 0 +;;; occurs disproportionately often in fasl files for other reasons, +;;; FOP-NOP is less than ideal for writing human-readable patterns +;;; into fasl files for debugging purposes. There's no shortage of +;;; unused fop codes, so we add this second NOP, which reads 4 +;;; arbitrary bytes and discards them. +(define-fop (fop-nop4 137 :stackp nil) (let ((arg (read-arg 4))) (declare (ignorable arg)) #!+sb-show (when *show-fop-nop4-p* - (format *debug-io* "~&/FOP-NOP4 ARG=~D=#X~X~%" arg arg)))) + (format *debug-io* "~&/FOP-NOP4 ARG=~W=#X~X~%" arg arg)))) -(define-fop (fop-nop 0 :nope)) -(define-fop (fop-pop 1 nil) (push-fop-table (pop-stack))) +(define-fop (fop-nop 0 :stackp nil)) +(define-fop (fop-pop 1 :pushp nil) (push-fop-table (pop-stack))) (define-fop (fop-push 2) (svref *current-fop-table* (read-arg 4))) (define-fop (fop-byte-push 3) (svref *current-fop-table* (read-arg 1))) @@ -124,7 +121,7 @@ #+sb-xc-host ; since xc host doesn't know how to compile %PRIMITIVE (error "FOP-MISC-TRAP can't be defined without %PRIMITIVE.") #-sb-xc-host - (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-type)) + (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-widetag)) (define-fop (fop-character 68) (code-char (read-arg 3))) @@ -151,20 +148,21 @@ (name (pop-stack))) (find-and-init-or-check-layout name length inherits depthoid))) -(define-fop (fop-end-group 64 :nope) +(define-fop (fop-end-group 64 :stackp nil) + (/show0 "THROWing FASL-GROUP-END") (throw 'fasl-group-end t)) ;;; In the normal loader, we just ignore these. GENESIS overwrites ;;; FOP-MAYBE-COLD-LOAD with something that knows whether to revert to ;;; cold-loading or not. -(define-fop (fop-normal-load 81 :nope)) -(define-fop (fop-maybe-cold-load 82 :nope)) +(define-fop (fop-normal-load 81 :stackp nil)) +(define-fop (fop-maybe-cold-load 82 :stackp nil)) -(define-fop (fop-verify-table-size 62 :nope) +(define-fop (fop-verify-table-size 62 :stackp nil) (let ((expected-index (read-arg 4))) (unless (= *current-fop-table-index* expected-index) (error "internal error: fasl table of improper size")))) -(define-fop (fop-verify-empty-stack 63 :nope) +(define-fop (fop-verify-empty-stack 63 :stackp nil) (unless (= *fop-stack-pointer* *fop-stack-pointer-on-entry*) (error "internal error: fasl stack not empty when it should be"))) @@ -178,8 +176,8 @@ ;;; (1) *LOAD-SYMBOL-BUFFER-SIZE* is redundant, should just be ;;; (LENGTH *LOAD-SYMBOL-BUFFER*). ;;; (2) *LOAD-SYMBOL-BUFFER* should not have a global value, but should -;;; be bound on entry to FASLOAD, and it should be renamed to -;;; *FASLOAD-SYMBOL-BUFFER*. +;;; be bound on entry to FASL loading, and it should be renamed to +;;; *FASL-SYMBOL-BUFFER*. (macrolet (;; FIXME: Should all this code really be duplicated inside ;; each fop? Perhaps it would be better for this shared @@ -190,7 +188,7 @@ (n-size (gensym)) (n-buffer (gensym))) `(define-fop (,name ,code) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (let ((,n-package ,package) (,n-size (fast-read-u-integer ,name-size))) (when (> ,n-size *load-symbol-buffer-size*) @@ -199,20 +197,22 @@ (* ,n-size 2))))) (done-with-fast-read-byte) (let ((,n-buffer *load-symbol-buffer*)) - (read-string-as-bytes *fasl-file* + (read-string-as-bytes *fasl-input-stream* ,n-buffer ,n-size) (push-fop-table (intern* ,n-buffer ,n-size ,n-package))))))))) - ;; Note: CMU CL had FOP-SYMBOL-SAVE and FOP-SMALL-SYMBOL-SAVE, but since they - ;; made the behavior of the fasloader depend on the *PACKAGE* variable, not - ;; only were they a pain to support (because they required various hacks to - ;; handle *PACKAGE*-manipulation forms) they were basically broken by design, - ;; because ANSI gives the user so much flexibility in manipulating *PACKAGE* - ;; at load-time that no reasonable hacks could possibly make things work - ;; right. The ones used in CMU CL certainly didn't, as shown by e.g. + ;; Note: CMU CL had FOP-SYMBOL-SAVE and FOP-SMALL-SYMBOL-SAVE, but + ;; since they made the behavior of the fasloader depend on the + ;; *PACKAGE* variable, not only were they a pain to support (because + ;; they required various hacks to handle *PACKAGE*-manipulation + ;; forms) they were basically broken by design, because ANSI gives + ;; the user so much flexibility in manipulating *PACKAGE* at + ;; load-time that no reasonable hacks could possibly make things + ;; work right. The ones used in CMU CL certainly didn't, as shown by + ;; e.g. ;; (IN-PACKAGE :CL-USER) ;; (DEFVAR CL::*FOO* 'FOO-VALUE) ;; (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) @@ -245,7 +245,7 @@ (fop-uninterned-small-symbol-save 13) (let* ((arg (clone-arg)) (res (make-string arg))) - (read-string-as-bytes *fasl-file* res) + (read-string-as-bytes *fasl-input-stream* res) (push-fop-table (make-symbol res)))) (define-fop (fop-package 14) @@ -253,12 +253,12 @@ ;;;; fops for loading numbers -;;; Load a signed integer LENGTH bytes long from *FASL-FILE*. +;;; Load a signed integer LENGTH bytes long from *FASL-INPUT-STREAM*. (defun load-s-integer (length) (declare (fixnum length)) ;; #+cmu (declare (optimize (inhibit-warnings 2))) (do* ((index length (1- index)) - (byte 0 (read-byte *fasl-file*)) + (byte 0 (read-byte *fasl-input-stream*)) (result 0 (+ result (ash byte bits))) (bits 0 (+ bits 8))) ((= index 0) @@ -271,13 +271,13 @@ (load-s-integer (clone-arg))) (define-fop (fop-word-integer 35) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (fast-read-s-integer 4) (done-with-fast-read-byte)))) (define-fop (fop-byte-integer 36) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (fast-read-s-integer 1) (done-with-fast-read-byte)))) @@ -291,14 +291,14 @@ (%make-complex (pop-stack) im))) (define-fop (fop-complex-single-float 72) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (complex (make-single-float (fast-read-s-integer 4)) (make-single-float (fast-read-s-integer 4))) (done-with-fast-read-byte)))) (define-fop (fop-complex-double-float 73) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (let* ((re-lo (fast-read-u-integer 4)) (re-hi (fast-read-u-integer 4)) @@ -311,7 +311,7 @@ #!+long-float (define-fop (fop-complex-long-float 67) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (let* ((re-lo (fast-read-u-integer 4)) #!+sparc (re-mid (fast-read-u-integer 4)) @@ -327,12 +327,12 @@ (done-with-fast-read-byte)))) (define-fop (fop-single-float 46) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (make-single-float (fast-read-s-integer 4)) (done-with-fast-read-byte)))) (define-fop (fop-double-float 47) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (let ((lo (fast-read-u-integer 4))) (make-double-float (fast-read-s-integer 4) lo)) @@ -340,7 +340,7 @@ #!+long-float (define-fop (fop-long-float 52) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (prog1 (let ((lo (fast-read-u-integer 4)) #!+sparc (mid (fast-read-u-integer 4)) @@ -390,7 +390,7 @@ (define-cloned-fops (fop-string 37) (fop-small-string 38) (let* ((arg (clone-arg)) (res (make-string arg))) - (read-string-as-bytes *fasl-file* res) + (read-string-as-bytes *fasl-input-stream* res) res)) (define-cloned-fops (fop-vector 39) (fop-small-vector 40) @@ -406,7 +406,7 @@ (let* ((rank (read-arg 4)) (vec (pop-stack)) (length (length vec)) - (res (make-array-header sb!vm:simple-array-type rank))) + (res (make-array-header sb!vm:simple-array-widetag rank))) (declare (simple-array vec) (type (unsigned-byte 24) rank)) (set-array-header res vec length length 0 @@ -420,51 +420,55 @@ (define-fop (fop-single-float-vector 84) (let* ((length (read-arg 4)) (result (make-array length :element-type 'single-float))) - (read-n-bytes *fasl-file* result 0 (* length sb!vm:word-bytes)) + (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes)) result)) (define-fop (fop-double-float-vector 85) (let* ((length (read-arg 4)) (result (make-array length :element-type 'double-float))) - (read-n-bytes *fasl-file* result 0 (* length sb!vm:word-bytes 2)) + (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2)) result)) #!+long-float (define-fop (fop-long-float-vector 88) (let* ((length (read-arg 4)) (result (make-array length :element-type 'long-float))) - (read-n-bytes *fasl-file* + (read-n-bytes *fasl-input-stream* result 0 - (* length sb!vm:word-bytes #!+x86 3 #!+sparc 4)) + (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4)) result)) (define-fop (fop-complex-single-float-vector 86) (let* ((length (read-arg 4)) (result (make-array length :element-type '(complex single-float)))) - (read-n-bytes *fasl-file* result 0 (* length sb!vm:word-bytes 2)) + (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2)) result)) (define-fop (fop-complex-double-float-vector 87) (let* ((length (read-arg 4)) (result (make-array length :element-type '(complex double-float)))) - (read-n-bytes *fasl-file* result 0 (* length sb!vm:word-bytes 2 2)) + (read-n-bytes *fasl-input-stream* + result + 0 + (* length sb!vm:n-word-bytes 2 2)) result)) #!+long-float (define-fop (fop-complex-long-float-vector 89) (let* ((length (read-arg 4)) (result (make-array length :element-type '(complex long-float)))) - (read-n-bytes *fasl-file* result 0 - (* length sb!vm:word-bytes #!+x86 3 #!+sparc 4 2)) + (read-n-bytes *fasl-input-stream* result 0 + (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4 2)) result)) -;;; *** NOT *** the FOP-INT-VECTOR as currently documented in rtguts. Size -;;; must be a directly supported I-vector element size, with no extra bits. -;;; This must be packed according to the local byte-ordering, allowing us to -;;; directly read the bits. +;;; CMU CL comment: +;;; *** NOT *** the FOP-INT-VECTOR as currently documented in rtguts. +;;; Size must be a directly supported I-vector element size, with no +;;; extra bits. This must be packed according to the local +;;; byte-ordering, allowing us to directly read the bits. (define-fop (fop-int-vector 43) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (let* ((len (fast-read-u-integer 4)) (size (fast-read-byte)) (res (case size @@ -478,19 +482,17 @@ size))))) (declare (type index len)) (done-with-fast-read-byte) - (read-n-bytes *fasl-file* + (read-n-bytes *fasl-input-stream* res 0 (ceiling (the index (* size len)) - sb!vm:byte-bits)) + sb!vm:n-byte-bits)) res))) -;;; FOP-SIGNED-INT-VECTOR -;;; -;;; Same as FOP-INT-VECTOR, except this is for signed simple-arrays. -;;; It appears that entry 50 and 51 are clear. +;;; This is the same as FOP-INT-VECTOR, except this is for signed +;;; SIMPLE-ARRAYs. (define-fop (fop-signed-int-vector 50) - (prepare-for-fast-read-byte *fasl-file* + (prepare-for-fast-read-byte *fasl-input-stream* (let* ((len (fast-read-u-integer 4)) (size (fast-read-byte)) (res (case size @@ -502,12 +504,12 @@ size))))) (declare (type index len)) (done-with-fast-read-byte) - (read-n-bytes *fasl-file* + (read-n-bytes *fasl-input-stream* res 0 (ceiling (the index (* (if (= size 30) 32 ; Adjust for (signed-byte 30) - size) len)) sb!vm:byte-bits)) + size) len)) sb!vm:n-byte-bits)) res))) (define-fop (fop-eval 53) @@ -517,11 +519,12 @@ ;; (load-fresh-line) ;; (prin1 result) ;; (terpri)) - ;; Unfortunately, this dependence on the *LOAD-PRINT* global variable is - ;; non-ANSI, so for now we've just punted printing in fasload. + ;; Unfortunately, this dependence on the *LOAD-PRINT* global + ;; variable is non-ANSI, so for now we've just punted printing in + ;; fasl loading. result)) -(define-fop (fop-eval-for-effect 54 nil) +(define-fop (fop-eval-for-effect 54 :pushp nil) (let ((result (eval (pop-stack)))) ;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL. (declare (ignore result)) @@ -539,7 +542,7 @@ ((zerop n) (apply (pop-stack) args)) (declare (type index n)))))) -(define-fop (fop-funcall-for-effect 56 nil) +(define-fop (fop-funcall-for-effect 56 :pushp nil) (let ((arg (read-arg 1))) (if (zerop arg) (funcall (pop-stack)) @@ -550,19 +553,19 @@ ;;;; fops for fixing up circularities -(define-fop (fop-rplaca 200 nil) +(define-fop (fop-rplaca 200 :pushp nil) (let ((obj (svref *current-fop-table* (read-arg 4))) (idx (read-arg 4)) (val (pop-stack))) (setf (car (nthcdr idx obj)) val))) -(define-fop (fop-rplacd 201 nil) +(define-fop (fop-rplacd 201 :pushp nil) (let ((obj (svref *current-fop-table* (read-arg 4))) (idx (read-arg 4)) (val (pop-stack))) (setf (cdr (nthcdr idx obj)) val))) -(define-fop (fop-svset 202 nil) +(define-fop (fop-svset 202 :pushp nil) (let* ((obi (read-arg 4)) (obj (svref *current-fop-table* obi)) (idx (read-arg 4)) @@ -571,12 +574,14 @@ (setf (%instance-ref obj idx) val) (setf (svref obj idx) val)))) -(define-fop (fop-structset 204 nil) +(define-fop (fop-structset 204 :pushp nil) (setf (%instance-ref (svref *current-fop-table* (read-arg 4)) (read-arg 4)) (pop-stack))) -(define-fop (fop-nthcdr 203 t) +;;; In the original CMUCL code, this actually explicitly declared PUSHP +;;; to be T, even though that's what it defaults to in DEFINE-FOP. +(define-fop (fop-nthcdr 203) (nthcdr (read-arg 4) (pop-stack))) ;;;; fops for loading functions @@ -588,10 +593,10 @@ ;;; putting the implementation and version in required fields in the ;;; fasl file header.) -(define-fop (fop-code 58 :nope) +(define-fop (fop-code 58 :stackp nil) (load-code (read-arg 4) (read-arg 4))) -(define-fop (fop-small-code 59 :nope) +(define-fop (fop-small-code 59 :stackp nil) (load-code (read-arg 1) (read-arg 2))) (define-fop (fop-fdefinition 60) @@ -602,23 +607,37 @@ (sb!vm:sanctify-for-execution component) component)) -;;; This a no-op except in cold load. (In ordinary warm load, -;;; everything involved with function definition can be handled nicely -;;; by ordinary toplevel code.) -(define-fop (fop-fset 74 nil) - (pop-stack) - (pop-stack)) +(define-fop (fop-fset 74 :pushp nil) + ;; Ordinary, not-for-cold-load code shouldn't need to mess with this + ;; at all, since it's only used as part of the conspiracy between + ;; the cross-compiler and GENESIS to statically link FDEFINITIONs + ;; for cold init. + (warn "~@") + ;; Unlike CMU CL, we don't treat this as a no-op in ordinary code. + ;; If the user (or, more likely, developer) is trying to reload + ;; compiled-for-cold-load code into a warm SBCL, we'll do a warm + ;; assignment. (This is partly for abstract tidiness, since the warm + ;; assignment is the closest analogy to what happens at cold load, + ;; and partly because otherwise our compiled-for-cold-load code will + ;; fail, since in SBCL things like compiled-for-cold-load %DEFUN + ;; depend more strongly than in CMU CL on FOP-FSET actually doing + ;; something.) + (let ((fn (pop-stack)) + (name (pop-stack))) + (setf (fdefinition name) fn))) -;;; Modify a slot in a Constants object. -(define-cloned-fops (fop-alter-code 140 nil) (fop-byte-alter-code 141) +;;; Modify a slot in a CONSTANTS object. +(define-cloned-fops (fop-alter-code 140 :pushp nil) (fop-byte-alter-code 141) (let ((value (pop-stack)) (code (pop-stack))) (setf (code-header-ref code (clone-arg)) value) (values))) -(define-fop (fop-function-entry 142) +(define-fop (fop-fun-entry 142) #+sb-xc-host ; since xc host doesn't know how to compile %PRIMITIVE - (error "FOP-FUNCTION-ENTRY can't be defined without %PRIMITIVE.") + (error "FOP-FUN-ENTRY can't be defined without %PRIMITIVE.") #-sb-xc-host (let ((type (pop-stack)) (arglist (pop-stack)) @@ -629,38 +648,22 @@ (unless (zerop (logand offset sb!vm:lowtag-mask)) (error "internal error: unaligned function object, offset = #X~X" offset)) - (let ((fun (%primitive sb!c:compute-function code-object offset))) - (setf (%function-self fun) fun) - (setf (%function-next fun) (%code-entry-points code-object)) + (let ((fun (%primitive sb!c:compute-fun code-object offset))) + (setf (%simple-fun-self fun) fun) + (setf (%simple-fun-next fun) (%code-entry-points code-object)) (setf (%code-entry-points code-object) fun) - (setf (%function-name fun) name) - (setf (%function-arglist fun) arglist) - (setf (%function-type fun) type) + (setf (%simple-fun-name fun) name) + (setf (%simple-fun-arglist fun) arglist) + (setf (%simple-fun-type fun) type) ;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL. #+nil (when *load-print* (load-fresh-line) (format t "~S defined~%" fun)) fun))) - -(define-fop (fop-make-byte-compiled-function 143) - (let* ((size (read-arg 1)) - (layout (pop-stack)) - (res (%make-funcallable-instance size layout))) - (declare (type index size)) - (do ((n (1- size) (1- n))) - ((minusp n)) - (declare (type (integer -1 #.most-positive-fixnum) n)) - (setf (%funcallable-instance-info res n) (pop-stack))) - (initialize-byte-compiled-function res) - ;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL. - #+nil (when *load-print* - (load-fresh-line) - (format t "~S defined~%" res)) - res)) -;;;; Some Dylan fops used to live here. By 1 November 1998 the code was -;;;; sufficiently stale that the functions it called were no longer defined, -;;;; so I (William Harold Newman) deleted it. +;;;; Some Dylan FOPs used to live here. By 1 November 1998 the code +;;;; was sufficiently stale that the functions it called were no +;;;; longer defined, so I (William Harold Newman) deleted it. ;;;; ;;;; In case someone in the future is trying to make sense of FOP layout, ;;;; it might be worth recording that the Dylan FOPs were @@ -677,7 +680,7 @@ (code-object (pop-stack)) (len (read-arg 1)) (sym (make-string len))) - (read-n-bytes *fasl-file* sym 0 len) + (read-n-bytes *fasl-input-stream* sym 0 len) (sb!vm:fixup-code-object code-object (read-arg 4) (foreign-symbol-address-as-integer sym)