From c4a7c011895ef40a88b204aa1ab72b286cee3327 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Wed, 21 Nov 1990 10:08:09 +0000
Subject: [PATCH] Took package qualifiers off of %primitives, because the names
 get re-interned in the C package automatically.  Rewrote fop-int-vector to
 just call make-array instead of trying to use allocate-vector itself.

---
 code/load.lisp | 53 +++++++++++++++++++++++---------------------------
 1 file changed, 24 insertions(+), 29 deletions(-)

diff --git a/code/load.lisp b/code/load.lisp
index 8d4e347c1..6d7d825a7 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.17 1990/11/19 05:06:59 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.18 1990/11/21 10:08:09 wlott Exp $
 ;;;
 ;;; Loader for Spice Lisp.
 ;;; Written by Skef Wholey and Rob MacLachlan.
@@ -668,21 +668,17 @@
   (prepare-for-fast-read-byte *fasl-file*
     (let* ((len (fast-read-u-integer 4))
 	   (size (fast-read-byte))
-	   (type (case size
-		   (1 vm:simple-bit-vector-type)
-		   (2 vm:simple-array-unsigned-byte-2-type)
-		   (4 vm:simple-array-unsigned-byte-4-type)
-		   (8 vm:simple-array-unsigned-byte-8-type)
-		   (16 vm:simple-array-unsigned-byte-16-type)
-		   (32 vm:simple-array-unsigned-byte-32-type)
-		   (t (error "Losing i-vector element size: ~S"))))
-	   (bits (* len size))
-	   (res (%primitive allocate-vector type len
-			    (the index (ceiling bits vm:word-bits)))))
-      (declare (type (unsigned-byte 8) type)
-	       (type index len))
+	   (res (case size
+		  (1 (make-array len :element-type 'bit))
+		  (2 (make-array len :element-type '(unsigned-byte 2)))
+		  (4 (make-array len :element-type '(unsigned-byte 4)))
+		  (8 (make-array len :element-type '(unsigned-byte 8)))
+		  (16 (make-array len :element-type '(unsigned-byte 16)))
+		  (32 (make-array len :element-type '(unsigned-byte 32)))
+		  (t (error "Losing i-vector element size: ~S" size)))))
+      (declare (type index len))
       (done-with-fast-read-byte)
-      (read-n-bytes *fasl-file* res 0 (ceiling bits vm:byte-bits))
+      (read-n-bytes *fasl-file* res 0 (ceiling (* size len) vm:byte-bits))
       res)))
 
 
@@ -777,16 +773,15 @@
 	 (let ((box-num ,nitems)
 	       (code-length ,size))
 	   (declare (fixnum box-num code-length))
-	   (let ((code (%primitive vm:allocate-code-object
-				   box-num code-length)))
-	     (%primitive c::set-code-debug-info code (pop-stack))
+	   (let ((code (%primitive allocate-code-object box-num code-length)))
+	     (%primitive set-code-debug-info code (pop-stack))
 	     (do ((index (1- box-num) (1- index)))
 		 ((minusp index))
 	       (declare (fixnum index))
-	       (%primitive vm:code-constant-set code index (pop-stack)))
+	       (%primitive code-constant-set code index (pop-stack)))
 	     (system:without-gcing
 	      (let ((inst (truly-the system-area-pointer
-				     (%primitive vm:code-instructions code))))
+				     (%primitive code-instructions code))))
 		(read-n-bytes *fasl-file* inst 0 code-length)))
 	     code)))
        (error
@@ -812,7 +807,7 @@
 	(code (pop-stack))
 	(index (- (clone-arg) vm:code-constants-offset)))
     (declare (type index index))
-    (%primitive vm:code-constant-set code index value)
+    (%primitive code-constant-set code index value)
     (undefined-value)))
 
 (define-fop (fop-function-entry 142)
@@ -824,14 +819,14 @@
     (declare (type index offset))
     (unless (zerop (logand offset vm:lowtag-mask))
       (error "Unaligned function object, offset = #x~X." offset))
-    (let ((fun (%primitive c::compute-function code-object offset)))
-      (%primitive c::set-function-self fun fun)
-      (%primitive c::set-function-next fun
-		  (%primitive c::code-entry-points code-object))
-      (%primitive c::set-code-entry-points code-object fun)
-      (%primitive c::set-function-name fun name)
-      (%primitive c::set-function-arglist fun arglist)
-      (%primitive c::set-function-type fun type)
+    (let ((fun (%primitive compute-function code-object offset)))
+      (%primitive set-function-self fun fun)
+      (%primitive set-function-next fun
+		  (%primitive code-entry-points code-object))
+      (%primitive set-code-entry-points code-object fun)
+      (%primitive set-function-name fun name)
+      (%primitive set-function-arglist fun arglist)
+      (%primitive set-function-type fun type)
       (when *load-print-stuff*
 	(format t "~&; ~S defined" fun))
       fun)))
-- 
GitLab