From 053d88570f37acbde8df31406faecbf7c5fb782c Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Thu, 18 Sep 2014 20:26:20 -0400
Subject: [PATCH] Check for fop stack underflow once only in LOAD-CODE.

---
 src/code/fop.lisp         |  4 ++--
 src/code/target-load.lisp | 31 ++++++++++++-------------------
 2 files changed, 14 insertions(+), 21 deletions(-)

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 5184b7770..487518236 100644
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -537,10 +537,10 @@
 ;;; putting the implementation and version in required fields in the
 ;;; fasl file header.)
 
-(define-fop (fop-code 58 () nil)
+(define-fop (fop-code 58)
   (load-code (read-word-arg) (read-word-arg)))
 
-(define-fop (fop-small-code 59 () nil)
+(define-fop (fop-small-code 59)
   (load-code (read-byte-arg) (read-halfword-arg)))
 
 (define-fop (fop-fdefinition 60 (name)) ; should probably be 'fop-fdefn'
diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 26454f88c..07200bd37 100644
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -209,15 +209,12 @@
 #!-x86
 (defun load-code (box-num code-length)
   (declare (fixnum box-num code-length))
-  (with-fop-stack t
-    (let ((code (sb!c:allocate-code-object box-num code-length))
-          (index (+ sb!vm:code-constants-offset box-num)))
-      (declare (type index index))
-      (setf (%code-debug-info code) (pop-stack))
-      (dotimes (i box-num)
-        (declare (fixnum i))
-        ;; FIXME: check for stack underflow once only
-        (setf (code-header-ref code (decf index)) (pop-stack)))
+  (let ((code (sb!c:allocate-code-object box-num code-length)))
+    (!with-fop-stack-reffer (stack ptr (1+ box-num))
+      (setf (%code-debug-info code) (fop-stack-ref (+ ptr box-num)))
+      (loop for i of-type index from sb!vm:code-constants-offset
+            for j of-type index from ptr below (+ ptr box-num)
+            do (setf (code-header-ref code i) (fop-stack-ref j)))
       (without-gcing
         (read-n-bytes *fasl-input-stream*
                       (code-instructions code)
@@ -236,15 +233,11 @@
 #!+x86
 (defun load-code (box-num code-length)
   (declare (fixnum box-num code-length))
-  (with-fop-stack t
-    (let ((stuff (list (pop-stack))))
-      (dotimes (i box-num)
-        (declare (fixnum i))
-        (push (pop-stack) stuff))
-      (let* ((dbi (car (last stuff))))  ; debug-info
-
-        (setq stuff (nreverse stuff))
-
+  (!with-fop-stack-reffer (stack ptr (1+ box-num))
+    (let* ((dbi (fop-stack-ref (+ ptr box-num))) ; debug-info
+           (stuff (cons dbi (loop for i of-type index
+                                  downfrom (+ ptr box-num -1) to ptr
+                                  collect (fop-stack-ref i)))))
         ;; FIXME: *LOAD-CODE-VERBOSE* should probably be #!+SB-SHOW.
         (when *load-code-verbose*
           (format t "stuff: ~S~%" stuff)
@@ -271,7 +264,7 @@
                           (code-instructions code)
                           0
                           code-length))
-          code)))))
+          code))))
 
 ;;;; linkage fixups
 
-- 
2.11.4.GIT