diff --git a/code/load.lisp b/code/load.lisp
index dd3499fabe330b7d5ec247de928369b643f995eb..f52e45363d005d6a049d56b623776140b0332e53 100644
--- a/code/load.lisp
+++ b/code/load.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.9 1990/10/10 13:11:11 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.10 1990/10/13 20:24:52 wlott Exp $
 ;;;
 ;;; Loader for Spice Lisp.
 ;;; Written by Skef Wholey and Rob MacLachlan.
@@ -884,7 +884,7 @@
   (makunbound '*initial-foreign-symbols*))
 
 
-(define-fop (fop-foreign-fixup 143)
+(define-fop (fop-old-foreign-fixup 143)
   (let* ((code-object (pop-stack))
 	 (offset (read-arg 4))
 	 (len (read-arg 1))
@@ -898,13 +898,31 @@
       (fixup-code-object code-object offset value))
     code-object))
 
+(define-fop (fop-foreign-fixup 147)
+  (let* ((code-object (pop-stack))
+	 (len (read-arg 1))
+	 (sym (make-string len)))
+    (read-n-bytes *fasl-file* sym 0 len)
+    (multiple-value-bind
+	(value found)
+	(gethash sym *foreign-symbols* 0)
+      (unless found
+	(error "Unknown foreign symbol: ~S" sym))
+      (let* ((offset (read-arg 4))
+	     (byte (read-arg 1))
+	     (kind (car (or (find byte vm:*fixup-values*
+				  :key #'cdr :test #'eql)
+			    (error "Unknown fixup kind: ~D" byte)))))
+	(fixup-code-object code-object offset value kind)))
+    code-object))
+
 (define-fop (fop-assembler-code 144)
   (error "Cannot load assembler code."))
 
 (define-fop (fop-assembler-routine 145)
   (error "Cannot load assembler code."))
 
-(define-fop (fop-assembler-fixup 146)
+(define-fop (fop-old-assembler-fixup 146)
   (let ((routine (pop-stack))
 	(code-object (pop-stack))
 	(offset (read-arg 4)))
@@ -916,26 +934,49 @@
       (fixup-code-object code-object offset value)
       code-object)))
 
-(defun fixup-code-object (code offset fixup)
+(define-fop (fop-assembler-fixup 148)
+  (let* ((routine (pop-stack))
+	 (code-object (pop-stack))
+	 (offset (read-arg 4))
+	 (byte (read-arg 1))
+	 (kind (car (or (find byte vm:*fixup-values* :key #'cdr :test #'eql)
+			(error "Unknown fixup kind: ~D" byte)))))
+    (multiple-value-bind
+	(value found)
+	(gethash routine *assembler-routines*)
+      (unless found
+	(error "Undefined assembler routine: ~S" routine))
+      (fixup-code-object code-object offset value kind))
+    code-object))
+
+(defun fixup-code-object (code offset fixup &optional (kind :both))
   ;; Currently, the only kind of fixup we can have is a lui followed by an
   ;; addi.
-  (multiple-value-bind
-      (word-offset rem)
-      (truncate offset vm:word-bytes)
-    (unless (zerop rem)
-      (error "Unaligned instruction?  offset=#x~X." offset))
-    (system:without-gcing
-     (let* ((sap (truly-the system-area-pointer
-			    (%primitive c::code-instructions code)))
-	    (half-word-offset (* word-offset 2))
-	    (new-val (+ fixup
-			(ash (sap-ref-16 sap half-word-offset) 16)
-			(signed-sap-ref-16 sap (+ half-word-offset 2))))
-	    (low (logand new-val (1- (ash 1 16))))
-	    (high (+ (ash new-val -16)
-		     (if (logbitp 15 low) 1 0))))
-       (setf (sap-ref-16 sap half-word-offset) high)
-       (setf (sap-ref-16 sap (+ half-word-offset 2)) low)))))
+  (cond ((eq kind :both)
+	 (fixup-code-object code offset fixup :lui)
+	 (fixup-code-object code (+ offset vm:word-bytes) fixup :addi))
+	(t
+	 (multiple-value-bind
+	     (word-offset rem)
+	     (truncate offset vm:word-bytes)
+	   (unless (zerop rem)
+	     (error "Unaligned instruction?  offset=#x~X." offset))
+	   (system:without-gcing
+	    (let ((sap (truly-the system-area-pointer
+				  (%primitive c::code-instructions code))))
+	      (ecase kind
+		(:jump
+		 (assert (zerop (ash fixup -26)))
+		 (setf (ldb (byte 26 0)
+			    (system:sap-ref-32 sap word-offset))
+		       (ash fixup -2)))
+		(:lui
+		 (setf (sap-ref-16 sap (* word-offset 2))
+		       (+ (ash fixup -16)
+			  (if (logbitp 15 fixup) 1 0))))
+		(:addi
+		 (setf (sap-ref-16 sap (* word-offset 2))
+		       (ldb (byte 16 0) fixup))))))))))
 
 
 (proclaim '(notinline read-byte))