diff --git a/code/debug-int.lisp b/code/debug-int.lisp index 0c5a2b5d9b88361152223a99f2d3e4115c1236b6..31cc79d883f3c30933af7d0b861764b632f37bf0 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 d84758da521abbede3f4e5d865771bad769e87b6..7f8c9ccf451d7edcf75168e8709605f2c81bac0b 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 ef6503a4406481d9937ee166756678f2beb6d496..89a8c70696d7efbebc23fe4211cf0345f8bceca8 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 09937a542e563d0da2af28bbbc5b0efb4befe296..1e26907c7ac761f63fa93300b0a4b5ab8e1bd546 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 100aca0aa5d63b96866fc315746c4199264936cf..ab36c128c28be54be96e33afdd1f7025189567df 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