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