From e72357cc5e4560a67b31832a28e2e8dc698c720b Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sun, 13 Dec 1992 15:54:09 +0000
Subject: [PATCH] Changed several uses of %primitive to eqv functions now that
 eqv functions exist.

---
 code/debug-int.lisp | 12 ++++++------
 code/eval.lisp      |  6 +++---
 code/load.lisp      | 15 +++++++--------
 code/print.lisp     | 12 +++++-------
 code/room.lisp      | 10 ++++------
 5 files changed, 25 insertions(+), 30 deletions(-)

diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index 0c5a2b5d9..31cc79d88 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.52 1992/08/19 02:53:18 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.53 1992/12/13 15:46:07 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1247,8 +1247,8 @@
 			(c::compiled-debug-function-start-pc
 			 (compiled-debug-function-compiler-debug-fun
 			  debug-function))))
-		   (do ((entry (system:%primitive code-entry-points component)
-			       (system:%primitive function-next entry)))
+		   (do ((entry (kernel:%code-entry-points component)
+			       (kernel:%function-next entry)))
 		       ((null entry) nil)
 		     (when (= start-pc
 			      (c::compiled-debug-function-start-pc
@@ -1287,7 +1287,7 @@
 	(make-interpreted-debug-function
 	 (or (eval::eval-function-definition eval-fun)
 	     (eval::convert-eval-fun eval-fun))))
-      (let* ((name (system:%primitive c::function-name fun))
+      (let* ((name (kernel:%function-name fun))
 	     (component (kernel:function-code-header fun))
 	     (res (find-if
 		   #'(lambda (x)
@@ -2380,7 +2380,7 @@
      (check-type frame compiled-frame)
      (let ((res (access-compiled-debug-var-slot debug-var frame)))
        (if (indirect-value-cell-p res)
-	   (system:%primitive c::value-cell-ref res)
+	   (c:value-cell-ref res)
 	   res)))
     (interpreted-debug-variable
      (check-type frame interpreted-frame)
@@ -2505,7 +2505,7 @@
      (check-type frame compiled-frame)
      (let ((current-value (access-compiled-debug-var-slot debug-var frame)))
        (if (indirect-value-cell-p current-value)
-	   (system:%primitive c::value-cell-set current-value value)
+	   (c:value-cell-set current-value value)
 	   (set-compiled-debug-variable-slot debug-var frame value))))
     (interpreted-debug-variable
      (check-type frame interpreted-frame)
diff --git a/code/eval.lisp b/code/eval.lisp
index d84758da5..7f8c9ccf4 100644
--- a/code/eval.lisp
+++ b/code/eval.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.19 1992/09/19 17:45:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.20 1992/12/13 15:47:47 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -221,8 +221,8 @@
   (declare (type function fun))
   (if (eval:interpreted-function-p fun)
       (eval:interpreted-function-lambda-expression fun)
-      (let* ((fun (%primitive c::function-self fun))
-	     (name (%primitive c::function-name fun))
+      (let* ((fun (%function-self fun))
+	     (name (%function-name fun))
 	     (code (di::function-code-header fun))
 	     (info (di::code-debug-info code)))
 	(if info
diff --git a/code/load.lisp b/code/load.lisp
index ef6503a44..89a8c7069 100644
--- a/code/load.lisp
+++ b/code/load.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.45 1992/10/09 14:01:15 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.46 1992/12/13 15:50:00 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1030,13 +1030,12 @@
     (unless (zerop (logand offset vm:lowtag-mask))
       (error "Unaligned function object, offset = #x~X." offset))
     (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)
+      (setf (%function-self fun) fun)
+      (setf (%function-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)
       (when *load-print*
 	(load-fresh-line)
 	(format t "~S defined~%" fun))
diff --git a/code/print.lisp b/code/print.lisp
index 09937a542..1e26907c7 100644
--- a/code/print.lisp
+++ b/code/print.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.46 1992/12/06 20:17:35 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.47 1992/12/13 15:52:01 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1687,9 +1687,8 @@
 ;;; below.
 
 (defun output-function-object (subr stream)
-  (let ((name (%primitive c::function-name subr)))
-    (write-string "Function " stream)
-    (prin1 name stream)))
+  (write-string "Function " stream)
+  (prin1 (%function-name subr) stream))
 
 
 ;;; OUTPUT-INTERPRETED-FUNCTION  --  Internal
@@ -1719,8 +1718,7 @@
 	 (output-interpreted-function function stream))
 	(t
 	 (write-string "Closure Over " stream)
-	 (output-function-object (%primitive c::closure-function function)
-				 stream))))
+	 (output-function-object (%closure-function function) stream))))
       (#.vm:dylan-function-header-type
        (write-string "Dylan Function" stream))
       (t
@@ -1738,7 +1736,7 @@
 	    (case type
 	      (#.vm:value-cell-header-type
 	       (write-string "Value Cell " stream)
-	       (output-object (%primitive value-cell-ref object) stream))
+	       (output-object (c:value-cell-ref object) stream))
 	      (t
 	       (write-string "Unknown Pointer Object, type=" stream)
 	       (let ((*print-base* 16) (*print-radix* t))
diff --git a/code/room.lisp b/code/room.lisp
index 100aca0aa..ab36c128c 100644
--- a/code/room.lisp
+++ b/code/room.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.16 1992/02/26 12:13:16 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.17 1992/12/13 15:54:09 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -233,8 +233,7 @@
 			      (+ (the fixnum
 				      (* (get-header-data obj) word-bytes))
 				 (round-to-dualword
-				  (* (the fixnum
-					  (%primitive code-code-size obj))
+				  (* (the fixnum (%code-code-size obj))
 				     word-bytes)))))))
 		(declare (fixnum size))
 		(funcall fun obj header-type size)
@@ -420,7 +419,7 @@
  	 (declare (fixnum size) (optimize (safety 0)))
 	 (when (eql type code-header-type)
 	   (incf total-bytes size)
-	   (let ((words (truly-the fixnum (%primitive code-code-size obj)))
+	   (let ((words (truly-the fixnum (%code-code-size obj)))
 		 (sap (truly-the system-area-pointer
 				 (%primitive code-instructions obj))))
 	     (incf code-words words)
@@ -452,8 +451,7 @@
 	   (declare (fixnum size) (optimize (safety 0)))
 	   (case type
 	     (#.code-header-type
-	      (let ((inst-words
-		     (truly-the fixnum (%primitive code-code-size obj))))
+	      (let ((inst-words (truly-the fixnum (%code-code-size obj))))
 		(declare (type fixnum inst-words))
 		(incf non-descriptor-bytes (* inst-words word-bytes))
 		(incf descriptor-words
-- 
GitLab