From f6b2e375747a54a1bfa34ead9f9af2d4e8b5aa38 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Wed, 5 Jun 2013 22:24:54 +0400 Subject: [PATCH] Get rid of vm-support-routines indirection. VM routines were defined using two functions, one calling another through structure slots. This is unnecessary, removing leads to a ~200KB core size reduction on x86-64. --- package-data-list.lisp-expr | 51 +++++++------- src/assembly/alpha/support.lisp | 4 +- src/assembly/hppa/support.lisp | 4 +- src/assembly/mips/support.lisp | 4 +- src/assembly/ppc/support.lisp | 4 +- src/assembly/sparc/support.lisp | 4 +- src/assembly/x86-64/support.lisp | 4 +- src/assembly/x86/support.lisp | 4 +- src/compiler/alpha/c-call.lisp | 2 +- src/compiler/alpha/call.lisp | 22 +++--- src/compiler/alpha/nlx.lisp | 4 +- src/compiler/alpha/pred.lisp | 2 +- src/compiler/alpha/vm.lisp | 8 +-- src/compiler/backend.lisp | 136 ++++++++++++------------------------ src/compiler/generic/late-nlx.lisp | 2 +- src/compiler/generic/primtype.lisp | 4 +- src/compiler/hppa/c-call.lisp | 2 +- src/compiler/hppa/call.lisp | 22 +++--- src/compiler/hppa/insts.lisp | 2 +- src/compiler/hppa/nlx.lisp | 4 +- src/compiler/hppa/pred.lisp | 2 +- src/compiler/hppa/vm.lisp | 8 +-- src/compiler/mips/c-call.lisp | 2 +- src/compiler/mips/call.lisp | 22 +++--- src/compiler/mips/insts.lisp | 4 +- src/compiler/mips/nlx.lisp | 4 +- src/compiler/mips/pred.lisp | 2 +- src/compiler/mips/vm.lisp | 8 +-- src/compiler/ppc/c-call.lisp | 2 +- src/compiler/ppc/call.lisp | 22 +++--- src/compiler/ppc/insts.lisp | 4 +- src/compiler/ppc/nlx.lisp | 4 +- src/compiler/ppc/pred.lisp | 2 +- src/compiler/ppc/vm.lisp | 8 +-- src/compiler/sparc/c-call.lisp | 2 +- src/compiler/sparc/call.lisp | 22 +++--- src/compiler/sparc/insts.lisp | 4 +- src/compiler/sparc/nlx.lisp | 4 +- src/compiler/sparc/pred.lisp | 2 +- src/compiler/sparc/vm.lisp | 8 +-- src/compiler/x86-64/c-call.lisp | 2 +- src/compiler/x86-64/call.lisp | 22 +++--- src/compiler/x86-64/nlx.lisp | 4 +- src/compiler/x86-64/pred.lisp | 2 +- src/compiler/x86-64/vm.lisp | 8 +-- src/compiler/x86/c-call.lisp | 2 +- src/compiler/x86/call.lisp | 22 +++--- src/compiler/x86/nlx.lisp | 4 +- src/compiler/x86/pred.lisp | 2 +- src/compiler/x86/vm.lisp | 8 +-- tests/vm.before-xc.lisp | 4 +- 51 files changed, 231 insertions(+), 274 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 9dad11f..91a5c88 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -374,30 +374,33 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "*ASSEMBLY-OPTIMIZE*" "LARGE-ALLOC" "%SET-SIMPLE-FUN-SELF" - "VM-SUPPORT-ROUTINES-IMMEDIATE-CONSTANT-SC" - "VM-SUPPORT-ROUTINES-BOXED-IMMEDIATE-SC-P" - "VM-SUPPORT-ROUTINES-LOCATION-PRINT-NAME" - "VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE-OF" - "VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE" - "VM-SUPPORT-ROUTINES-MAKE-CALL-OUT-TNS" - "VM-SUPPORT-ROUTINES-STANDARD-ARG-LOCATION" - "VM-SUPPORT-ROUTINES-MAKE-RETURN-PC-PASSING-LOCATION" - "VM-SUPPORT-ROUTINES-MAKE-OLD-FP-PASSING-LOCATION" - "VM-SUPPORT-ROUTINES-MAKE-OLD-FP-SAVE-LOCATION" - "VM-SUPPORT-ROUTINES-MAKE-RETURN-PC-SAVE-LOCATION" - "VM-SUPPORT-ROUTINES-MAKE-ARG-COUNT-LOCATION" - "VM-SUPPORT-ROUTINES-MAKE-NFP-TN" - "VM-SUPPORT-ROUTINES-MAKE-STACK-POINTER-TN" - "VM-SUPPORT-ROUTINES-MAKE-NUMBER-STACK-POINTER-TN" - "VM-SUPPORT-ROUTINES-MAKE-UNKNOWN-VALUES-LOCATIONS" - "VM-SUPPORT-ROUTINES-SELECT-COMPONENT-FORMAT" - "VM-SUPPORT-ROUTINES-MAKE-NLX-SP-TN" - "VM-SUPPORT-ROUTINES-MAKE-DYNAMIC-STATE-TNS" - "VM-SUPPORT-ROUTINES-MAKE-NLX-ENTRY-ARG-START-LOCATION" - "VM-SUPPORT-ROUTINES-GENERATE-CALL-SEQUENCE" - "VM-SUPPORT-ROUTINES-GENERATE-RETURN-SEQUENCE" - "VM-SUPPORT-ROUTINES-EMIT-NOP" - "VM-SUPPORT-ROUTINES-LOCATION-NUMBER" + + "IMMEDIATE-CONSTANT-SC" + "BOXED-IMMEDIATE-SC-P" + "COMBINATION-IMPLEMENTATION-STYLE" + "CONVERT-CONDITIONAL-MOVE-P" + "LOCATION-PRINT-NAME" + "PRIMITIVE-TYPE-OF" + "PRIMITIVE-TYPE" + "MAKE-CALL-OUT-TNS" + "STANDARD-ARG-LOCATION" + "MAKE-RETURN-PC-PASSING-LOCATION" + "MAKE-OLD-FP-PASSING-LOCATION" + "MAKE-OLD-FP-SAVE-LOCATION" + "MAKE-RETURN-PC-SAVE-LOCATION" + "MAKE-ARG-COUNT-LOCATION" + "MAKE-NFP-TN" + "MAKE-STACK-POINTER-TN" + "MAKE-NUMBER-STACK-POINTER-TN" + "MAKE-UNKNOWN-VALUES-LOCATIONS" + "SELECT-COMPONENT-FORMAT" + "MAKE-NLX-SP-TN" + "MAKE-DYNAMIC-STATE-TNS" + "MAKE-NLX-ENTRY-ARG-START-LOCATION" + "GENERATE-CALL-SEQUENCE" + "GENERATE-RETURN-SEQUENCE" + "EMIT-NOP" + "LOCATION-NUMBER" "WITH-SOURCE-LOCATION" "*SOURCE-LOCATION-THUNKS*" diff --git a/src/assembly/alpha/support.lisp b/src/assembly/alpha/support.lisp index 9e75098..6f676b6 100644 --- a/src/assembly/alpha/support.lisp +++ b/src/assembly/alpha/support.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) (values @@ -52,7 +52,7 @@ (:temporary (:scs (non-descriptor-reg)) temp1) (:save-p t))))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `((inst ret zero-tn lip-tn))) diff --git a/src/assembly/hppa/support.lisp b/src/assembly/hppa/support.lisp index 2a5e4e1..82c8d16 100644 --- a/src/assembly/hppa/support.lisp +++ b/src/assembly/hppa/support.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) (with-unique-names (fixup) @@ -52,7 +52,7 @@ ,nfp-save) (:save-p t))))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `((inst bv lip-tn :nullify t))) diff --git a/src/assembly/mips/support.lisp b/src/assembly/mips/support.lisp index cb3a759..a6f1f99 100644 --- a/src/assembly/mips/support.lisp +++ b/src/assembly/mips/support.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) (values @@ -49,7 +49,7 @@ ,nfp-save) (:save-p t))))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `((inst j lip-tn) diff --git a/src/assembly/ppc/support.lisp b/src/assembly/ppc/support.lisp index a6d9cfc..18c0a3a 100644 --- a/src/assembly/ppc/support.lisp +++ b/src/assembly/ppc/support.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) (let ((jump (make-symbol "JUMP"))) @@ -54,7 +54,7 @@ (:temporary (:sc any-reg) ,jump) (:save-p :compute-only))))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `((inst blr))) diff --git a/src/assembly/sparc/support.lisp b/src/assembly/sparc/support.lisp index edb29f9..b0308ea 100644 --- a/src/assembly/sparc/support.lisp +++ b/src/assembly/sparc/support.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) (let ((temp (make-symbol "TEMP")) @@ -54,7 +54,7 @@ ,nfp-save) (:save-p :compute-only))))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `((inst j diff --git a/src/assembly/x86-64/support.lisp b/src/assembly/x86-64/support.lisp index fb18d8a..c56bf76 100644 --- a/src/assembly/x86-64/support.lisp +++ b/src/assembly/x86-64/support.lisp @@ -9,7 +9,7 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style (:raw (values @@ -33,7 +33,7 @@ (inst jmp temp-reg-tn)) nil)))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `(inst ret)) diff --git a/src/assembly/x86/support.lisp b/src/assembly/x86/support.lisp index 1b814f3..7985f7c 100644 --- a/src/assembly/x86/support.lisp +++ b/src/assembly/x86/support.lisp @@ -23,7 +23,7 @@ ;;; value, which again simplifies the return path. ;;; -- AB, 2006/Feb/05. -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) (values @@ -44,7 +44,7 @@ (emit-label single-value))))) '((:save-p :compute-only)))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `(inst ret)) diff --git a/src/compiler/alpha/c-call.lisp b/src/compiler/alpha/c-call.lisp index f56225d..b930761 100644 --- a/src/compiler/alpha/c-call.lisp +++ b/src/compiler/alpha/c-call.lisp @@ -95,7 +95,7 @@ (when values (invoke-alien-type-method :result-tn (car values) state)))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) (dolist (arg-type (alien-fun-type-arg-types type)) diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 2b6137f..0172f66 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -15,7 +15,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* @@ -29,7 +29,7 @@ ;;; is true, then use the standard (full call) location, otherwise use ;;; any legal location. Even in the non-standard case, this may be ;;; restricted by a desire to use a subroutine call instruction. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) @@ -39,7 +39,7 @@ ;;; standard convention, but is totally unrestricted in non-standard ;;; conventions, since we can always fetch it off of the stack using ;;; the arg pointer. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -47,13 +47,13 @@ ;;; These functions make the TNs used to hold Old-FP and Return-PC ;;; within the current function. We treat these specially so that the ;;; debugger can find them at a known location. -(!def-vm-support-routine make-old-fp-save-location (env) +(defun make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -(!def-vm-support-routine make-return-pc-save-location (env) +(defun make-return-pc-save-location (env) (let ((ptype *backend-t-primitive-type*)) (specify-save-tn (physenv-debug-live-tn (make-normal-tn ptype) env) @@ -62,25 +62,25 @@ ;;; Make a TN for the standard argument count passing location. We ;;; only need to make the standard location, since a count is never ;;; passed when we are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is ;;; allocated once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) ;;; Return a list of TNs that can be used to represent an ;;; unknown-values continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -89,7 +89,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We ;;; push placeholder entries in the CONSTANTS to leave room for ;;; additional noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index 14c3516..db7b885 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -13,14 +13,14 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) ;;; Make a TN for the argument count passing location for a ;;; non-local entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) ;;;; save and restoring the dynamic environment diff --git a/src/compiler/alpha/pred.lisp b/src/compiler/alpha/pred.lisp index d08b417..413eaab 100644 --- a/src/compiler/alpha/pred.lisp +++ b/src/compiler/alpha/pred.lisp @@ -33,7 +33,7 @@ (:generator 0 (error "BRANCH-IF not yet implemented"))) -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node dst-tn x-tn y-tn)) nil) diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp index 77b6319..0330eec 100644 --- a/src/compiler/alpha/vm.lisp +++ b/src/compiler/alpha/vm.lisp @@ -284,7 +284,7 @@ ;;; If value can be represented as an immediate constant, then return ;;; the appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((integer 0 0) (sc-number-or-lose 'zero)) @@ -306,7 +306,7 @@ (sc-number-or-lose 'fp-double-zero ) nil)))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (or (eql sc (sc-number-or-lose 'zero)) (eql sc (sc-number-or-lose 'null)) (eql sc (sc-number-or-lose 'immediate)))) @@ -347,7 +347,7 @@ ;;; This function is called by debug output routines that want a ;;; pretty name for a TN's location. It returns a thing that can be ;;; printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) ; (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) (offset (tn-offset tn))) @@ -360,7 +360,7 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node) (ignore node)) (values :default nil)) diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index 2d1a88c..9e532ea 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -134,97 +134,51 @@ (defvar *backend-internal-errors* nil) (declaim (type (or simple-vector null) *backend-internal-errors*)) -;;;; VM support routines - -;;; FIXME: Do we need this kind of indirection for the VM support -;;; routines any more? - -;;; forward declaration -(defvar *backend-support-routines*) - -(macrolet ((def-vm-support-routines (&rest routines) - `(progn - (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *vm-support-routines* ',routines)) - (defstruct (vm-support-routines (:copier nil)) - ,@(mapcar (lambda (routine) - `(,routine nil :type (or function null))) - routines)) - ,@(mapcar - (lambda (name) - `(defun ,name (&rest args) - (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-" - name) - *backend-support-routines*) - (error "machine-specific support ~S ~ - routine undefined" - ',name)) - args))) - routines)))) - - (def-vm-support-routines - - ;; from vm.lisp - immediate-constant-sc - location-print-name - combination-implementation-style - boxed-immediate-sc-p - - ;; from primtype.lisp - primitive-type-of - primitive-type - - ;; from c-call.lisp - make-call-out-tns - - ;; from call.lisp - standard-arg-location - make-return-pc-passing-location - make-old-fp-passing-location - make-old-fp-save-location - make-return-pc-save-location - make-arg-count-location - make-nfp-tn - make-stack-pointer-tn - make-number-stack-pointer-tn - make-unknown-values-locations - select-component-format - - ;; from nlx.lisp - make-nlx-sp-tn - make-dynamic-state-tns - make-nlx-entry-arg-start-location - - ;; from pred.lisp - convert-conditional-move-p - - ;; from support.lisp - generate-call-sequence - generate-return-sequence - - ;; for use with scheduler - emit-nop - location-number)) - -(defprinter (vm-support-routines)) - -(defmacro !def-vm-support-routine (name ll &body body) - (unless (member (intern (string name) (find-package "SB!C")) - *vm-support-routines*) - (warn "unknown VM support routine: ~A" name)) - (let ((local-name (symbolicate "IMPL-OF-VM-SUPPORT-ROUTINE-" name))) - `(progn - (defun ,local-name ,ll ,@body) - (setf (,(intern (concatenate 'simple-string - "VM-SUPPORT-ROUTINES-" - (string name)) - (find-package "SB!C")) - *backend-support-routines*) - #',local-name)))) - -;;; the VM support routines -(defvar *backend-support-routines* (make-vm-support-routines)) -(declaim (type vm-support-routines *backend-support-routines*)) +;;;; VM support routines which backends need to implement + +;;; from vm.lisp +;;; immediate-constant-sc +;;; location-print-name +;;; combination-implementation-style +;;; convert-conditional-move-p +;;; boxed-immediate-sc-p + +;;; from primtype.lisp +;;; primitive-type-of +;;; primitive-type + +;;; from c-call.lisp +;;; make-call-out-tns + +;;; from call.lisp +;;; standard-arg-location +;;; make-return-pc-passing-location +;;; make-old-fp-passing-location +;;; make-old-fp-save-location +;;; make-return-pc-save-location +;;; make-arg-count-location +;;; make-nfp-tn +;;; make-stack-pointer-tn +;;; make-number-stack-pointer-tn +;;; make-unknown-values-locations +;;; select-component-format + +;;; from nlx.lisp +;;; make-nlx-sp-tn +;;; make-dynamic-state-tns +;;; make-nlx-entry-arg-start-location + +;;; from pred.lisp +;;; convert-conditional-move-p + +;;; from support.lisp +;;; generate-call-sequence +;;; generate-return-sequence + +;;; for use with scheduler +;;; emit-nop +;;; location-number + ;;;; This is a prototype interface to support Christophe Rhodes' new ;;;; (sbcl-0.pre7.57) VOP :GUARD clauses for implementations which diff --git a/src/compiler/generic/late-nlx.lisp b/src/compiler/generic/late-nlx.lisp index d2d5855..e8a2727 100644 --- a/src/compiler/generic/late-nlx.lisp +++ b/src/compiler/generic/late-nlx.lisp @@ -13,7 +13,7 @@ ;;; Return a list of TNs that can be used to snapshot the dynamic ;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs. -(!def-vm-support-routine make-dynamic-state-tns () +(defun make-dynamic-state-tns () (make-n-tns #.(let ((nsave (sb!c::vop-info-num-results (template-or-lose 'save-dynamic-state))) diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index fa33e9c..ea2e4b6 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -132,7 +132,7 @@ ;;; Return the most restrictive primitive type that contains OBJECT. (/show0 "primtype.lisp 147") -(!def-vm-support-routine primitive-type-of (object) +(defun primitive-type-of (object) (let ((type (ctype-of object))) (cond ((not (member-type-p type)) (primitive-type type)) ((and (eql 1 (member-type-size type)) @@ -151,7 +151,7 @@ ;;; We need an aux function because we need to use both ;;; !DEF-VM-SUPPORT-ROUTINE and DEFUN-CACHED. (/show0 "primtype.lisp 188") -(!def-vm-support-routine primitive-type (type) +(defun primitive-type (type) (sb!kernel::maybe-reparse-specifier! type) (primitive-type-aux type)) (/show0 "primtype.lisp 191") diff --git a/src/compiler/hppa/c-call.lisp b/src/compiler/hppa/c-call.lisp index 21aabde..1029ee9 100644 --- a/src/compiler/hppa/c-call.lisp +++ b/src/compiler/hppa/c-call.lisp @@ -141,7 +141,7 @@ (invoke-alien-type-method :result-tn type state)) values))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (let ((arg-state (make-arg-state)) (nargs 0)) (dolist (arg-type (alien-fun-type-arg-types type)) diff --git a/src/compiler/hppa/call.lisp b/src/compiler/hppa/call.lisp index 8c004db..be8e880 100644 --- a/src/compiler/hppa/call.lisp +++ b/src/compiler/hppa/call.lisp @@ -15,7 +15,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* @@ -29,7 +29,7 @@ ;;; true, then use the standard (full call) location, otherwise use any legal ;;; location. Even in the non-standard case, this may be restricted by a ;;; desire to use a subroutine call instruction. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) @@ -39,7 +39,7 @@ ;;; standard convention, but is totally unrestricted in non-standard ;;; conventions, since we can always fetch it off of the stack using ;;; the arg pointer. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -47,14 +47,14 @@ ;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current ;;; function. We treat these specially so that the debugger can find ;;; them at a known location. -(!def-vm-support-routine make-old-fp-save-location (env) +(defun make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -(!def-vm-support-routine make-return-pc-save-location (env) +(defun make-return-pc-save-location (env) (let ((ptype *backend-t-primitive-type*)) (specify-save-tn (physenv-debug-live-tn (make-normal-tn ptype) env) @@ -63,25 +63,25 @@ ;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we ;;; are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is allocated ;;; once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) ;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -90,7 +90,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil diff --git a/src/compiler/hppa/insts.lisp b/src/compiler/hppa/insts.lisp index fac58b4..24b3fc8 100644 --- a/src/compiler/hppa/insts.lisp +++ b/src/compiler/hppa/insts.lisp @@ -138,7 +138,7 @@ ; immediate or anything else. ; this routine will return an location-number ; this number must be less than *assem-max-locations* -(!def-vm-support-routine location-number (loc) +(defun location-number (loc) (etypecase loc (null) (number) diff --git a/src/compiler/hppa/nlx.lisp b/src/compiler/hppa/nlx.lisp index c6c81f4..78884d6 100644 --- a/src/compiler/hppa/nlx.lisp +++ b/src/compiler/hppa/nlx.lisp @@ -1,14 +1,14 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) ;;; Make a TN for the argument count passing location for a ;;; non-local entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) ;;; Save and restore dynamic environment. diff --git a/src/compiler/hppa/pred.lisp b/src/compiler/hppa/pred.lisp index 7721bd5..d6261fb 100644 --- a/src/compiler/hppa/pred.lisp +++ b/src/compiler/hppa/pred.lisp @@ -23,7 +23,7 @@ (:generator 0 (error "BRANCH-IF not yet implemented"))) -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node dst-tn x-tn y-tn)) nil) diff --git a/src/compiler/hppa/vm.lisp b/src/compiler/hppa/vm.lisp index d0f9eab..28f1db2 100644 --- a/src/compiler/hppa/vm.lisp +++ b/src/compiler/hppa/vm.lisp @@ -308,7 +308,7 @@ ;;; If VALUE can be represented as an immediate constant, then return ;;; the appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((integer 0 0) (sc-number-or-lose 'zero)) @@ -330,7 +330,7 @@ (sc-number-or-lose 'fp-double-zero) nil)))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (or (eql sc (sc-number-or-lose 'zero)) (eql sc (sc-number-or-lose 'null)) (eql sc (sc-number-or-lose 'immediate)))) @@ -375,7 +375,7 @@ ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) (offset (tn-offset tn))) @@ -388,7 +388,7 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node) (ignore node)) (values :default nil)) diff --git a/src/compiler/mips/c-call.lisp b/src/compiler/mips/c-call.lisp index 01d6e55..fcaecfb 100644 --- a/src/compiler/mips/c-call.lisp +++ b/src/compiler/mips/c-call.lisp @@ -131,7 +131,7 @@ (invoke-alien-type-method :result-tn type state)) values))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) (dolist (arg-type (alien-fun-type-arg-types type)) diff --git a/src/compiler/mips/call.lisp b/src/compiler/mips/call.lisp index b10e80e..0a42bdc 100644 --- a/src/compiler/mips/call.lisp +++ b/src/compiler/mips/call.lisp @@ -15,7 +15,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* @@ -29,7 +29,7 @@ ;;; true, then use the standard (full call) location, otherwise use any legal ;;; location. Even in the non-standard case, this may be restricted by a ;;; desire to use a subroutine call instruction. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) @@ -39,7 +39,7 @@ ;;; standard convention, but is totally unrestricted in non-standard ;;; conventions, since we can always fetch it off of the stack using ;;; the arg pointer. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -47,14 +47,14 @@ ;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current ;;; function. We treat these specially so that the debugger can find ;;; them at a known location. -(!def-vm-support-routine make-old-fp-save-location (env) +(defun make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -(!def-vm-support-routine make-return-pc-save-location (env) +(defun make-return-pc-save-location (env) (let ((ptype *backend-t-primitive-type*)) (specify-save-tn (physenv-debug-live-tn (make-normal-tn ptype) env) @@ -63,25 +63,25 @@ ;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we ;;; are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is allocated ;;; once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) ;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -90,7 +90,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil diff --git a/src/compiler/mips/insts.lisp b/src/compiler/mips/insts.lisp index d441d5c..0d03366 100644 --- a/src/compiler/mips/insts.lisp +++ b/src/compiler/mips/insts.lisp @@ -36,7 +36,7 @@ (defvar *disassem-use-lisp-reg-names* t) -(!def-vm-support-routine location-number (loc) +(defun location-number (loc) (etypecase loc (null) (number) @@ -1117,7 +1117,7 @@ (:emitter (emit-word segment 0))) -(!def-vm-support-routine emit-nop (segment) +(defun emit-nop (segment) (emit-word segment 0)) (define-instruction word (segment word) diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp index 8aa7a0c..18d6552 100644 --- a/src/compiler/mips/nlx.lisp +++ b/src/compiler/mips/nlx.lisp @@ -1,7 +1,7 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) @@ -9,7 +9,7 @@ ;;; Make a TN for the argument count passing location for a ;;; non-local entry. ;;; -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) ;;; Save and restore dynamic environment. diff --git a/src/compiler/mips/pred.lisp b/src/compiler/mips/pred.lisp index a5e62bb..7bd7c16 100644 --- a/src/compiler/mips/pred.lisp +++ b/src/compiler/mips/pred.lisp @@ -24,7 +24,7 @@ (:generator 0 (error "BRANCH-IF not yet implemented"))) -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node dst-tn x-tn y-tn)) nil) diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index 9602f2f..cf90976 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -295,7 +295,7 @@ ;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((integer 0 0) (sc-number-or-lose 'zero)) @@ -313,7 +313,7 @@ (character (sc-number-or-lose 'immediate)))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (or (eql sc (sc-number-or-lose 'zero)) (eql sc (sc-number-or-lose 'null)) (eql sc (sc-number-or-lose 'immediate)))) @@ -362,7 +362,7 @@ ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) (offset (tn-offset tn))) @@ -375,7 +375,7 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node) (ignore node)) (values :default nil)) diff --git a/src/compiler/ppc/c-call.lisp b/src/compiler/ppc/c-call.lisp index 4411684..340600a 100644 --- a/src/compiler/ppc/c-call.lisp +++ b/src/compiler/ppc/c-call.lisp @@ -195,7 +195,7 @@ (values 'unsigned-byte-32 'unsigned-reg)) (my-make-wired-tn ptype reg-sc (result-reg-offset num-results))))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (declare (type alien-fun-type type)) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp index 0dab7f0..09e8b2b 100644 --- a/src/compiler/ppc/call.lisp +++ b/src/compiler/ppc/call.lisp @@ -15,7 +15,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* register-arg-scn @@ -28,7 +28,7 @@ ;;; otherwise use any legal location. Even in the non-standard case, ;;; this may be restricted by a desire to use a subroutine call ;;; instruction. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) @@ -38,7 +38,7 @@ ;;; standard convention, but is totally unrestricted in non-standard ;;; conventions, since we can always fetch it off of the stack using ;;; the arg pointer. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -46,13 +46,13 @@ ;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current ;;; function. We treat these specially so that the debugger can find ;;; them at a known location. -(!def-vm-support-routine make-old-fp-save-location (env) +(defun make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -(!def-vm-support-routine make-return-pc-save-location (env) +(defun make-return-pc-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env) (make-wired-tn *backend-t-primitive-type* @@ -62,25 +62,25 @@ ;;; Make a TN for the standard argument count passing location. We ;;; only need to make the standard location, since a count is never ;;; passed when we are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is ;;; allocated once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) ;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -88,7 +88,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil diff --git a/src/compiler/ppc/insts.lisp b/src/compiler/ppc/insts.lisp index 8229af3..cdb9f5a 100644 --- a/src/compiler/ppc/insts.lisp +++ b/src/compiler/ppc/insts.lisp @@ -42,7 +42,7 @@ (defvar *disassem-use-lisp-reg-names* t) -(!def-vm-support-routine location-number (loc) +(defun location-number (loc) (etypecase loc (null) (number) @@ -1818,7 +1818,7 @@ `(inst nor. ,ra ,rs ,rs)) - (!def-vm-support-routine emit-nop (segment) + (defun emit-nop (segment) (emit-word segment #x60000000)) (define-instruction-macro extlwi (ra rs n b) diff --git a/src/compiler/ppc/nlx.lisp b/src/compiler/ppc/nlx.lisp index 783fcd4..e3fe28d 100644 --- a/src/compiler/ppc/nlx.lisp +++ b/src/compiler/ppc/nlx.lisp @@ -13,14 +13,14 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) ;;; Make a TN for the argument count passing location for a ;;; non-local entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) diff --git a/src/compiler/ppc/pred.lisp b/src/compiler/ppc/pred.lisp index 22aa9a9..9237916 100644 --- a/src/compiler/ppc/pred.lisp +++ b/src/compiler/ppc/pred.lisp @@ -27,7 +27,7 @@ (:generator 0 (error "BRANCH-IF not yet implemented"))) -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node dst-tn x-tn y-tn)) nil) diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 7f1bc96..720f8b3 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -273,7 +273,7 @@ ;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((integer 0 0) (sc-number-or-lose 'zero)) @@ -287,7 +287,7 @@ (sc-number-or-lose 'immediate) nil)))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (or (eql sc (sc-number-or-lose 'zero)) (eql sc (sc-number-or-lose 'null)) (eql sc (sc-number-or-lose 'immediate)))) @@ -344,7 +344,7 @@ ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) (offset (tn-offset tn))) @@ -357,7 +357,7 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node)) (flet ((valid-funtype (args result) (sb!c::valid-fun-use node diff --git a/src/compiler/sparc/c-call.lisp b/src/compiler/sparc/c-call.lisp index 87f3a00..1d9cb53 100644 --- a/src/compiler/sparc/c-call.lisp +++ b/src/compiler/sparc/c-call.lisp @@ -87,7 +87,7 @@ (invoke-alien-type-method :result-tn type state)) values))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (declare (type alien-fun-type type)) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) diff --git a/src/compiler/sparc/call.lisp b/src/compiler/sparc/call.lisp index 8956262..4f00c2d 100644 --- a/src/compiler/sparc/call.lisp +++ b/src/compiler/sparc/call.lisp @@ -16,7 +16,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* register-arg-scn @@ -29,7 +29,7 @@ ;;; otherwise use any legal location. Even in the non-standard case, ;;; this may be restricted by a desire to use a subroutine call ;;; instruction. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) @@ -39,7 +39,7 @@ ;;; standard convention, but is totally unrestricted in non-standard ;;; conventions, since we can always fetch it off of the stack using ;;; the arg pointer. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -47,14 +47,14 @@ ;;; Make the TNs used to hold Old-FP and Return-PC within the current ;;; function. We treat these specially so that the debugger can find ;;; them at a known location. -(!def-vm-support-routine make-old-fp-save-location (env) +(defun make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -(!def-vm-support-routine make-return-pc-save-location (env) +(defun make-return-pc-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env) (make-wired-tn *backend-t-primitive-type* @@ -64,25 +64,25 @@ ;;; Make a TN for the standard argument count passing location. We ;;; only need to make the standard location, since a count is never ;;; passed when we are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is ;;; allocated once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) ;;; Return a list of TNs that can be used to represent an ;;; unknown-values continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -91,7 +91,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the CONSTANTS to leave room for additional ;;; noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil diff --git a/src/compiler/sparc/insts.lisp b/src/compiler/sparc/insts.lisp index 02f2d0f..4d47ade 100644 --- a/src/compiler/sparc/insts.lisp +++ b/src/compiler/sparc/insts.lisp @@ -48,7 +48,7 @@ "If non-NIL, print registers using the Lisp register names. Otherwise, use the Sparc register names") -(!def-vm-support-routine location-number (loc) +(defun location-number (loc) (etypecase loc (null) (number) @@ -1733,7 +1733,7 @@ about function addresses and register values.") (:delay 0) (:emitter (emit-format-2-immed segment 0 0 #b100 0))) -(!def-vm-support-routine emit-nop (segment) +(defun emit-nop (segment) (emit-format-2-immed segment 0 0 #b100 0)) (define-instruction cmp (segment src1 &optional src2) diff --git a/src/compiler/sparc/nlx.lisp b/src/compiler/sparc/nlx.lisp index 8a144d3..0f76a33 100644 --- a/src/compiler/sparc/nlx.lisp +++ b/src/compiler/sparc/nlx.lisp @@ -13,14 +13,14 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) ;;; Make a TN for the argument count passing location for a non-local ;;; entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) ;;; save and restore dynamic environment. diff --git a/src/compiler/sparc/pred.lisp b/src/compiler/sparc/pred.lisp index 3d00528..9677a69 100644 --- a/src/compiler/sparc/pred.lisp +++ b/src/compiler/sparc/pred.lisp @@ -34,7 +34,7 @@ (:generator 0 (error "BRANCH-IF not yet implemented"))) -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node dst-tn x-tn y-tn)) nil) diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index c282c6a..f50443b 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -311,7 +311,7 @@ ;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((integer 0 0) (sc-number-or-lose 'zero)) @@ -325,7 +325,7 @@ (sc-number-or-lose 'immediate) nil)))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (or (eql sc (sc-number-or-lose 'zero)) (eql sc (sc-number-or-lose 'null)) (eql sc (sc-number-or-lose 'immediate)))) @@ -366,7 +366,7 @@ ;;; This function is called by debug output routines that want a ;;; pretty name for a TN's location. It returns a thing that can be ;;; printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) ; FIXME: commented out on alpha (let ((sb (sb-name (sc-sb (tn-sc tn)))) (offset (tn-offset tn))) @@ -379,7 +379,7 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node) (ignore node)) (values :default nil)) diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index e093930..ede3845 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -122,7 +122,7 @@ (invoke-alien-type-method :result-tn type state)) values))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) (dolist (arg-type (alien-fun-type-arg-types type)) diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp index 58538fe..2b96e42 100644 --- a/src/compiler/x86-64/call.lisp +++ b/src/compiler/x86-64/call.lisp @@ -15,7 +15,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number @@ -26,7 +26,7 @@ ;;; ;;; Always wire the return PC location to the stack in its standard ;;; location. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (declare (ignore standard)) (make-wired-tn (primitive-type-or-lose 'system-area-pointer) sap-stack-sc-number return-pc-save-offset)) @@ -38,7 +38,7 @@ ;;; because we want to be able to assume it's always there. Besides, ;;; the x86 doesn't have enough registers to really make it profitable ;;; to pass it in a register. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (declare (ignore standard)) (make-wired-tn *fixnum-primitive-type* control-stack-sc-number ocfp-save-offset)) @@ -49,12 +49,12 @@ ;;; ;;; Without using a save-tn - which does not make much sense if it is ;;; wired to the stack? -(!def-vm-support-routine make-old-fp-save-location (physenv) +(defun make-old-fp-save-location (physenv) (physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type* control-stack-sc-number ocfp-save-offset) physenv)) -(!def-vm-support-routine make-return-pc-save-location (physenv) +(defun make-return-pc-save-location (physenv) (physenv-debug-live-tn (make-wired-tn (primitive-type-or-lose 'system-area-pointer) sap-stack-sc-number return-pc-save-offset) @@ -63,23 +63,23 @@ ;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we ;;; are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* any-reg-sc-number rcx-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is allocated ;;; once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number)) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number)) ;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -87,7 +87,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We ;;; push placeholder entries in the CONSTANTS to leave room for ;;; additional noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil diff --git a/src/compiler/x86-64/nlx.lisp b/src/compiler/x86-64/nlx.lisp index 6cd885f..5816030 100644 --- a/src/compiler/x86-64/nlx.lisp +++ b/src/compiler/x86-64/nlx.lisp @@ -12,13 +12,13 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* any-reg-sc-number) env)) ;;; Make a TN for the argument count passing location for a non-local entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* any-reg-sc-number rbx-offset)) (defun catch-block-ea (tn) diff --git a/src/compiler/x86-64/pred.lisp b/src/compiler/x86-64/pred.lisp index a490a0a..f017a36 100644 --- a/src/compiler/x86-64/pred.lisp +++ b/src/compiler/x86-64/pred.lisp @@ -95,7 +95,7 @@ the values, and VOP-name the name of the VOP that will be used to execute the conditional move.") -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node)) (let* ((ptype (sb!c::tn-primitive-type dst-tn)) diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index ef34846..aa1c77b 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -491,7 +491,7 @@ ;;; If value can be represented as an immediate constant, then return ;;; the appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) character) @@ -528,7 +528,7 @@ #-sb-xc-host simd-pack (sc-number-or-lose 'int-sse-immediate)))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (eql sc (sc-number-or-lose 'immediate))) ;;;; miscellaneous function call parameters @@ -562,7 +562,7 @@ ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let* ((sc (tn-sc tn)) (sb (sb-name (sc-sb sc))) @@ -602,7 +602,7 @@ (def!constant cfp-offset rbp-offset) ; pfw - needed by stuff in /code -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node)) (flet ((valid-funtype (args result) (sb!c::valid-fun-use node diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index 4d57b8e..38f6a09 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -119,7 +119,7 @@ (invoke-alien-type-method :result-tn type state)) values))) -(!def-vm-support-routine make-call-out-tns (type) +(defun make-call-out-tns (type) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) (dolist (arg-type (alien-fun-type-arg-types type)) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index a8e09c6..e060921 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -15,7 +15,7 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -(!def-vm-support-routine standard-arg-location (n) +(defun standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number @@ -26,7 +26,7 @@ ;;; ;;; Always wire the return PC location to the stack in its standard ;;; location. -(!def-vm-support-routine make-return-pc-passing-location (standard) +(defun make-return-pc-passing-location (standard) (declare (ignore standard)) (make-wired-tn (primitive-type-or-lose 'system-area-pointer) sap-stack-sc-number return-pc-save-offset)) @@ -38,7 +38,7 @@ ;;; because we want to be able to assume it's always there. Besides, ;;; the x86 doesn't have enough registers to really make it profitable ;;; to pass it in a register. -(!def-vm-support-routine make-old-fp-passing-location (standard) +(defun make-old-fp-passing-location (standard) (declare (ignore standard)) (make-wired-tn *fixnum-primitive-type* control-stack-sc-number ocfp-save-offset)) @@ -49,12 +49,12 @@ ;;; ;;; Without using a save-tn - which does not make much sense if it is ;;; wired to the stack? -(!def-vm-support-routine make-old-fp-save-location (physenv) +(defun make-old-fp-save-location (physenv) (physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type* control-stack-sc-number ocfp-save-offset) physenv)) -(!def-vm-support-routine make-return-pc-save-location (physenv) +(defun make-return-pc-save-location (physenv) (physenv-debug-live-tn (make-wired-tn (primitive-type-or-lose 'system-area-pointer) sap-stack-sc-number return-pc-save-offset) @@ -63,23 +63,23 @@ ;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we ;;; are using non-standard conventions. -(!def-vm-support-routine make-arg-count-location () +(defun make-arg-count-location () (make-wired-tn *fixnum-primitive-type* any-reg-sc-number ecx-offset)) ;;; Make a TN to hold the number-stack frame pointer. This is allocated ;;; once per component, and is component-live. -(!def-vm-support-routine make-nfp-tn () +(defun make-nfp-tn () (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number)) -(!def-vm-support-routine make-stack-pointer-tn () +(defun make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -(!def-vm-support-routine make-number-stack-pointer-tn () +(defun make-number-stack-pointer-tn () (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number)) ;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -(!def-vm-support-routine make-unknown-values-locations () +(defun make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) @@ -87,7 +87,7 @@ ;;; VM-dependent initialization of the IR2-COMPONENT structure. We ;;; push placeholder entries in the CONSTANTS to leave room for ;;; additional noise in the code object header. -(!def-vm-support-routine select-component-format (component) +(defun select-component-format (component) (declare (type component component)) ;; The 1+ here is because for the x86 the first constant is a ;; pointer to a list of fixups, or NIL if the code object has none. diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index b31e635..2c24331 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -12,13 +12,13 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* any-reg-sc-number) env)) ;;; Make a TN for the argument count passing location for a non-local entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* any-reg-sc-number ebx-offset)) (defun catch-block-ea (tn) diff --git a/src/compiler/x86/pred.lisp b/src/compiler/x86/pred.lisp index 1843fe3..dd41d52 100644 --- a/src/compiler/x86/pred.lisp +++ b/src/compiler/x86/pred.lisp @@ -82,7 +82,7 @@ the values, and VOP-name the name of the VOP that will be used to execute the conditional move.") -(!def-vm-support-routine +(defun convert-conditional-move-p (node dst-tn x-tn y-tn) (declare (ignore node)) (let* ((ptype (sb!c::tn-primitive-type dst-tn)) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 0006fb5..72c25aa 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -382,7 +382,7 @@ ;;; If value can be represented as an immediate constant, then return ;;; the appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) character) @@ -408,7 +408,7 @@ (eql value (log 2l0 2.718281828459045235360287471352662L0))) (sc-number-or-lose 'fp-constant))))) -(!def-vm-support-routine boxed-immediate-sc-p (sc) +(defun boxed-immediate-sc-p (sc) (eql sc (sc-number-or-lose 'immediate))) ;; For an immediate TN, return its value encoded for use as a literal. @@ -463,7 +463,7 @@ ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let* ((sc (tn-sc tn)) (sb (sb-name (sc-sb sc))) @@ -489,7 +489,7 @@ (noise (symbol-name (sc-name sc)))))) ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW? -(!def-vm-support-routine combination-implementation-style (node) +(defun combination-implementation-style (node) (declare (type sb!c::combination node)) (flet ((valid-funtype (args result) (sb!c::valid-fun-use node diff --git a/tests/vm.before-xc.lisp b/tests/vm.before-xc.lisp index 3fd2f2f..7471802 100644 --- a/tests/vm.before-xc.lisp +++ b/tests/vm.before-xc.lisp @@ -19,10 +19,10 @@ (flet ((yes (x) (assert (eql (sc-number-or-lose 'immediate) - (impl-of-vm-support-routine-immediate-constant-sc x)))) + (immediate-constant-sc x)))) (no (x) (assert - (not (impl-of-vm-support-routine-immediate-constant-sc x))))) + (not (immediate-constant-sc x))))) ;; target fixnums can be dealt with as immediates; target bignums ;; can not. (yes #.sb-xc:most-positive-fixnum) -- 1.7.10.4