From f143939b1dbaf38ebd4f92c851fbc4ecddf37af1 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Mon, 8 Oct 2001 16:21:30 +0000 Subject: [PATCH] 0.pre7.55: renamed low level function-as-opposed-to-closure objects as SIMPLE-FUN to disambiguate the old nasty (DEFPARAMETER *FUNCTION-HEADER-TYPES* (LIST FUNCALLABLE-INSTANCE-HEADER-TYPE FUNCTION-HEADER-TYPE ; <- source of confusion CLOSURE-FUNCTION-HEADER-TYPE CLOSURE-HEADER-TYPE)) ..generally s/%function/%simple-fun/ ..also s/%fun-type/%simple-fun-type/ ..s/function-code-header/fun-code-header/ ..Generally matches to "-i 'function.*header'" become corresponding 'simple.*fun.*header'. s/function-header-word/simple-fun-header-word/ s/function-pointer-type/fun-pointer-type/ ..also similarly matches to 'function.*slot' CHECK-FUNCTION-OR-SYMBOL is no longer used, probably because function names can be (SETF FOO) now. Delete it. Similarly, SYMBOL-FUNCTION-SLOT is no longer used. Delete it. Dunno why SYMBOL-SETF-FUNCTION-SLOT is no longer used -- FDEFNs, probably -- but by now you know the drill. and SYMBOL-RAW-FUNCTION-ADDR-SLOT, too back to SIMPLE-FUN and friends.. .."closure.*function.*header" to "closure.*fun.*header" ..s/scav_function_header/scav_fun_header/ ..tweaked DEFINE-PRIMITIVE-OBJECT (FUNCTION ..) to use SIMPLE-FUN name ..s/%fun-type/%simple-fun-type/ ..s/%fun-name/%simple-fun-name/ ..s/%fun-arglist/%simple-fun-arglist/ ..s/%fun-self/%simple-fun-self/ ..s/%fun-next/%simple-fun-next/ Also substitute s/function/fun/ in slot names defined in objdef.lisp, e.g. CLOSURE-FUN. --- package-data-list.lisp-expr | 61 +++++++++++----------- src/assembly/alpha/assem-rtns.lisp | 2 +- src/assembly/x86/assem-rtns.lisp | 8 +-- src/code/class.lisp | 2 +- src/code/debug-info.lisp | 7 +-- src/code/debug-int.lisp | 28 ++++++----- src/code/describe.lisp | 16 +++--- src/code/dyncount.lisp | 4 +- src/code/eval.lisp | 6 +-- src/code/fdefinition.lisp | 34 ++++++------- src/code/fop.lisp | 10 ++-- src/code/inspect.lisp | 4 +- src/code/kernel.lisp | 22 +++++--- src/code/ntrace.lisp | 2 +- src/code/print.lisp | 4 +- src/code/room.lisp | 2 +- src/code/stubs.lisp | 6 +-- src/code/target-defstruct.lisp | 16 +++--- src/code/target-misc.lisp | 10 ++-- src/code/target-type.lisp | 2 +- src/code/type-class.lisp | 22 ++++---- src/compiler/alpha/alloc.lisp | 8 +-- src/compiler/alpha/call.lisp | 14 +++--- src/compiler/alpha/cell.lisp | 36 ++++++------- src/compiler/alpha/debug.lisp | 10 ++-- src/compiler/alpha/insts.lisp | 4 +- src/compiler/alpha/macros.lisp | 4 +- src/compiler/alpha/system.lisp | 14 +++--- src/compiler/alpha/type-vops.lisp | 18 +++---- src/compiler/generic/early-objdef.lisp | 10 ++-- src/compiler/generic/genesis.lisp | 37 +++++++------- src/compiler/generic/objdef.lisp | 52 +++++++++---------- src/compiler/generic/target-core.lisp | 10 ++-- src/compiler/generic/vm-fndb.lisp | 14 +++--- src/compiler/generic/vm-macs.lisp | 6 +-- src/compiler/ir1tran.lisp | 8 +-- src/compiler/ir2tran.lisp | 4 +- src/compiler/target-disassem.lisp | 29 ++++++----- src/compiler/x86/alloc.lisp | 10 ++-- src/compiler/x86/call.lisp | 8 +-- src/compiler/x86/cell.lisp | 43 ++++++++-------- src/compiler/x86/debug.lisp | 10 ++-- src/compiler/x86/insts.lisp | 4 +- src/compiler/x86/system.lisp | 50 +++++++++---------- src/compiler/x86/type-vops.lisp | 20 +++----- src/pcl/boot.lisp | 2 +- src/pcl/braid.lisp | 2 +- src/pcl/construct.lisp | 46 +++++++++-------- src/pcl/dfun.lisp | 2 +- src/pcl/low.lisp | 8 +-- src/pcl/methods.lisp | 6 +-- src/runtime/alpha-assem.S | 10 ++-- src/runtime/backtrace.c | 10 ++-- src/runtime/gc.c | 68 +++++++++++++------------ src/runtime/gencgc.c | 86 +++++++++++++++++--------------- src/runtime/interrupt.c | 4 +- src/runtime/monitor.c | 16 +++--- src/runtime/print.c | 8 +-- src/runtime/purify.c | 80 +++++++++++++++-------------- src/runtime/runtime.h | 2 +- src/runtime/x86-assem.S | 6 +-- tests/interface.pure.lisp | 17 +++---- version.lisp-expr | 2 +- 63 files changed, 547 insertions(+), 519 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 70cbff2..2bd5b95 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -186,7 +186,7 @@ "CALL" "CALL-LOCAL" "CALL-NAMED" "CALL-OUT" "CALL-VARIABLE" "CALLEE-NFP-TN" "CALLEE-RETURN-PC-TN" "CASE-BODY" "CATCH-BLOCK" "CHECK-CONS" - "CHECK-FIXNUM" "CHECK-FUNCTION" "CHECK-FUNCTION-OR-SYMBOL" + "CHECK-FIXNUM" "CHECK-FUNCTION" "CHECK-SIGNED-BYTE-32" "CHECK-SYMBOL" "CHECK-UNSIGNED-BYTE-32" "CLOSURE-INIT" "CLOSURE-REF" "CODE-CONSTANT-REF" "CODE-CONSTANT-SET" @@ -260,7 +260,7 @@ "FIXUP-P" "MAKE-FIXUP" "DEF-ALLOC" "VAR-ALLOC" - "SAFE-FDEFN-FUNCTION" + "SAFE-FDEFN-FUN" "NOTE-FIXUP" "DEF-REFFER" "EMIT-NOP" @@ -279,7 +279,7 @@ "VOP-BLOCK" "*ASSEMBLY-OPTIMIZE*" "LARGE-ALLOC" - "%SET-FUNCTION-SELF" + "%SET-SIMPLE-FUN-SELF" "VM-SUPPORT-ROUTINES-IMMEDIATE-CONSTANT-SC" "VM-SUPPORT-ROUTINES-LOCATION-PRINT-NAME" "VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE-OF" @@ -901,7 +901,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%ARRAY-FILL-POINTER-P" "%ASIN" "%ASINH" "%ATAN" "%ATAN2" "%ATANH" - "%CALLER-FRAME-AND-PC" "%CHECK-BOUND" "%CLOSURE-FUNCTION" + "%CALLER-FRAME-AND-PC" "%CHECK-BOUND" "%CLOSURE-FUN" "%CLOSURE-INDEX-REF" "%COS" "%COS-QUICK" "%COSH" "%DEPOSIT-FIELD" "%DOUBLE-FLOAT" "%DPB" "%EXP" "%EXPM1" @@ -920,7 +920,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%RAW-REF-SINGLE" "%RAW-SET-COMPLEX-DOUBLE" "%RAW-SET-COMPLEX-LONG" "%RAW-SET-COMPLEX-SINGLE" "%RAW-SET-DOUBLE" "%RAW-SET-LONG" "%RAW-SET-SINGLE" - "%SCALB" "%SCALBN" "%SET-FUNCALLABLE-INSTANCE-FUNCTION" + "%SCALB" "%SCALBN" "%SET-FUNCALLABLE-INSTANCE-FUN" "%SET-FUNCALLABLE-INSTANCE-INFO" "%SET-RAW-BITS" "%SET-SAP-REF-16" "%SET-SAP-REF-32" "%SET-SAP-REF-64" "%SET-SAP-REF-8" "%SET-SAP-REF-DOUBLE" "%SET-SAP-REF-LONG" @@ -1015,15 +1015,14 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME" "FLOAT-FORMAT-MAX" "FLOATING-POINT-EXCEPTION" "FORM" "*FREE-INTERRUPT-CONTEXT-INDEX*" "FUNCALLABLE-INSTANCE-P" - "FUNCTION-CODE-HEADER" "FUNCTION-DOC" - "FUN-TYPE" - "FUN-TYPE-ALLOWP" + "FUN-CODE-HEADER" "FUNCTION-DOC" + "FUN-TYPE" "FUN-TYPE-ALLOWP" "FUN-TYPE-KEYP" "FUN-TYPE-KEYWORDS" "FUN-TYPE-NARGS" "FUN-TYPE-OPTIONAL" "FUN-TYPE-P" "FUN-TYPE-REQUIRED" "FUN-TYPE-REST" "FUN-TYPE-RETURNS" "FUN-TYPE-WILD-ARGS" - "FUNCTION-WORD-OFFSET" "GET-CLOSURE-LENGTH" + "FUN-WORD-OFFSET" "GET-CLOSURE-LENGTH" "GET-HEADER-DATA" "GET-LISP-OBJ-ADDRESS" "GET-LOWTAG" "GET-TYPE" @@ -1213,7 +1212,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "WRONG-NUMBER-OF-INDICES-ERROR" "FDEFN" "MAKE-FDEFN" "FDEFN-P" - "FDEFN-NAME" "FDEFN-FUNCTION" + "FDEFN-NAME" "FDEFN-FUN" "FDEFN-MAKUNBOUND" "%COERCE-NAME-TO-FUNCTION" "%COERCE-CALLABLE-TO-FUNCTION" "FUNCTION-SUBTYPE" "*MAXIMUM-ERROR-DEPTH*" @@ -1238,15 +1237,15 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%IMAGPART" "DSD-ACCESSOR-NAME" "%CODE-DEBUG-INFO" "DSD-%NAME" "LAYOUT-CLASS" "LAYOUT-INVALID" - "%FUNCTION-NAME" "DSD-TYPE" "%INSTANCEP" - "DEFSTRUCT-SLOT-DESCRIPTION" "%FUNCTION-ARGLIST" - "%FUNCTION-NEXT" "LAYOUT-CLOS-HASH-LENGTH" "DD-PREDICATE-NAME" + "%SIMPLE-FUN-NAME" "DSD-TYPE" "%INSTANCEP" + "DEFSTRUCT-SLOT-DESCRIPTION" "%SIMPLE-FUN-ARGLIST" + "%SIMPLE-FUN-NEXT" "LAYOUT-CLOS-HASH-LENGTH" "DD-PREDICATE-NAME" "CLASS-PROPER-NAME" "%NOTE-TYPE-DEFINED" "LAYOUT-INFO" "%SET-INSTANCE-LAYOUT" "DD-DEFAULT-CONSTRUCTOR" - "LAYOUT-OF" "%FUNCTION-SELF" "%REALPART" + "LAYOUT-OF" "%SIMPLE-FUN-SELF" "%REALPART" "STRUCTURE-CLASS-P" "DSD-INDEX" "%INSTANCE-LAYOUT" "LAYOUT-CLOS-HASH" - "%FUN-TYPE" "PROCLAIM-AS-FUNCTION-NAME" + "%SIMPLE-FUN-TYPE" "PROCLAIM-AS-FUNCTION-NAME" "BECOME-DEFINED-FUNCTION-NAME" "%NUMERATOR" "CLASS-TYPEP" "STRUCTURE-CLASS-PRINT-FUNCTION" "DSD-READ-ONLY" @@ -1264,7 +1263,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "CLASS-CELL-NAME" "BUILT-IN-CLASS-DIRECT-SUPERCLASSES" "RANDOM-LAYOUT-CLOS-HASH" "CLASS-PCL-CLASS" "FUNCALLABLE-STRUCTURE" - "FUNCALLABLE-INSTANCE-FUNCTION" + "FUNCALLABLE-INSTANCE-FUN" "%FUNCALLABLE-INSTANCE-LAYOUT" "BASIC-STRUCTURE-CLASS" "CLASS-CELL-CLASS" @@ -1272,7 +1271,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "FUNCALLABLE-INSTANCE" "RANDOM-FIXNUM-MAX" "MAKE-RANDOM-PCL-CLASS" "INSTANCE-LAMBDA" "%FUNCALLABLE-INSTANCE-LEXENV" "%MAKE-SYMBOL" - "%FUNCALLABLE-INSTANCE-FUNCTION" "SYMBOL-HASH" + "%FUNCALLABLE-INSTANCE-FUN" "SYMBOL-HASH" "MAKE-UNDEFINED-CLASS" "CLASS-DIRECT-SUPERCLASSES" "MAKE-LAYOUT" "REDEFINE-LAYOUT-WARNING" "SLOT-CLASS" @@ -1417,7 +1416,7 @@ definitely not guaranteed to be present in later versions of SBCL." "REMOVE-DEPENDENT" "REMOVE-DIRECT-METHOD" "REMOVE-DIRECT-SUBCLASS" - "SET-FUNCALLABLE-INSTANCE-FUNCTION" + "SET-FUNCALLABLE-INSTANCE-FUN" "SLOT-BOUNDP-USING-CLASS" "SLOT-DEFINITION-ALLOCATION" "SLOT-DEFINITION-INITARGS" @@ -1677,7 +1676,7 @@ structure representations" "CATCH-BLOCK-ENTRY-PC-SLOT" "CATCH-BLOCK-PREVIOUS-CATCH-SLOT" "CATCH-BLOCK-SC-NUMBER" "CATCH-BLOCK-SIZE" "CATCH-BLOCK-SIZE-SLOT" "CATCH-BLOCK-TAG-SLOT" "CERROR-TRAP" - "CLOSURE-FUNCTION-HEADER-TYPE" "CLOSURE-FUNCTION-SLOT" + "CLOSURE-FUN-HEADER-TYPE" "CLOSURE-FUN-SLOT" "CLOSURE-HEADER-TYPE" "CLOSURE-INFO-OFFSET" "CODE-CODE-SIZE-SLOT" "CODE-CONSTANTS-OFFSET" "CODE-DEBUG-INFO-SLOT" "CODE-ENTRY-POINTS-SLOT" "CODE-HEADER-TYPE" @@ -1713,7 +1712,7 @@ structure representations" "DOUBLE-STACK-SC-NUMBER" "ERROR-TRAP" "EVEN-FIXNUM-TYPE" "EXPORTED-STATIC-SYMBOLS" "EXTERN-ALIEN-NAME" - "FDEFN-FUNCTION-SLOT" "FDEFN-NAME-SLOT" "FDEFN-RAW-ADDR-SLOT" + "FDEFN-FUN-SLOT" "FDEFN-NAME-SLOT" "FDEFN-RAW-ADDR-SLOT" "FDEFN-SIZE" "FDEFN-TYPE" "FIND-HOLES" "FIXNUMIZE" "FIXUP-CODE-OBJECT" "FLOAT-DENORMAL-TRAP-BIT" "FLOAT-DIVIDE-BY-ZERO-TRAP-BIT" @@ -1723,16 +1722,21 @@ structure representations" "FORWARDING-POINTER-TYPE" "FP-CONSTANT-SC-NUMBER" "FP-DOUBLE-ZERO-SC-NUMBER" "FP-SINGLE-ZERO-SC-NUMBER" - "FUNCALLABLE-INSTANCE-FUNCTION-SLOT" + "FUNCALLABLE-INSTANCE-FUN-SLOT" "FUNCALLABLE-INSTANCE-HEADER-TYPE" "FUNCALLABLE-INSTANCE-INFO-OFFSET" - "FUNCTION-ARGLIST-SLOT" "FUNCTION-CODE-OFFSET" + "SIMPLE-FUN-ARGLIST-SLOT" "SIMPLE-FUN-CODE-OFFSET" "FUN-END-BREAKPOINT-TRAP" - "FUNCTION-HEADER-CODE-OFFSET" - "FUNCTION-HEADER-NEXT-SLOT" "FUNCTION-HEADER-SELF-SLOT" - "FUNCTION-HEADER-TYPE" "FUNCTION-HEADER-TYPE-SLOT" - "FUNCTION-NAME-SLOT" "FUNCTION-NEXT-SLOT" "FUNCTION-POINTER-TYPE" - "FUNCTION-SELF-SLOT" "FUNCTION-TYPE-SLOT" + "SIMPLE-FUN-HEADER-CODE-OFFSET" + "SIMPLE-FUN-HEADER-NEXT-SLOT" + "SIMPLE-FUN-HEADER-SELF-SLOT" + "SIMPLE-FUN-HEADER-TYPE" + "SIMPLE-FUN-HEADER-TYPE-SLOT" + "SIMPLE-FUN-NAME-SLOT" + "SIMPLE-FUN-NEXT-SLOT" + "FUN-POINTER-TYPE" + "SIMPLE-FUN-SELF-SLOT" + "SIMPLE-FUN-TYPE-SLOT" "FUNCALLABLE-INSTANCE-LAYOUT-SLOT" "FUNCALLABLE-INSTANCE-LEXENV-SLOT" "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER" @@ -1798,10 +1802,9 @@ structure representations" "SLOT-REST-P" "*STATIC-FUNCTIONS*" "STATIC-FUNCTION-OFFSET" "STATIC-SYMBOL-OFFSET" "STATIC-SYMBOL-P" "*STATIC-SPACE-FREE-POINTER*" "*STATIC-SYMBOLS*" - "STRUCTURE-USAGE" "SYMBOL-FUNCTION-SLOT" + "STRUCTURE-USAGE" "SYMBOL-HASH-SLOT" "SYMBOL-HEADER-TYPE" "SYMBOL-NAME-SLOT" "SYMBOL-PACKAGE-SLOT" "SYMBOL-PLIST-SLOT" - "SYMBOL-RAW-FUNCTION-ADDR-SLOT" "SYMBOL-SETF-FUNCTION-SLOT" "SYMBOL-SIZE" "SYMBOL-UNUSED-SLOT" "SYMBOL-VALUE-SLOT" "BINDING-STACK-START" "BINDING-STACK-END" "CONTROL-STACK-START" "CONTROL-STACK-END" diff --git a/src/assembly/alpha/assem-rtns.lisp b/src/assembly/alpha/assem-rtns.lisp index c005c0f..3febb15 100644 --- a/src/assembly/alpha/assem-rtns.lisp +++ b/src/assembly/alpha/assem-rtns.lisp @@ -153,7 +153,7 @@ DONE ;; We are done. Do the jump. (progn - (loadw temp lexenv closure-function-slot function-pointer-type) + (loadw temp lexenv closure-fun-slot fun-pointer-type) (lisp-jump temp lip))) diff --git a/src/assembly/x86/assem-rtns.lisp b/src/assembly/x86/assem-rtns.lisp index c56dbdc..1adceb5 100644 --- a/src/assembly/x86/assem-rtns.lisp +++ b/src/assembly/x86/assem-rtns.lisp @@ -165,8 +165,8 @@ ;; And jump into the function. (inst jmp (make-ea :byte :base eax - :disp (- (* closure-function-slot word-bytes) - function-pointer-type))) + :disp (- (* closure-fun-slot word-bytes) + fun-pointer-type))) ;; All the arguments fit in registers, so load them. REGISTER-ARGS @@ -183,8 +183,8 @@ ;; And away we go. (inst jmp (make-ea :byte :base eax - :disp (- (* closure-function-slot word-bytes) - function-pointer-type)))) + :disp (- (* closure-fun-slot word-bytes) + fun-pointer-type)))) (define-assembly-routine (throw (:return-style :none)) diff --git a/src/code/class.lisp b/src/code/class.lisp index 6951f30..7661571 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -928,7 +928,7 @@ (function :codes (#.sb!vm:closure-header-type - #.sb!vm:function-header-type) + #.sb!vm:simple-fun-header-type) :state :read-only) (funcallable-instance :inherits (function) diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 47f5c74..4c0b7be 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -108,9 +108,10 @@ ;; * SC-offset of primary location, if it has one ;; * SC-offset of save location, if it has one (variables nil :type (or simple-vector null)) - ;; A vector of the packed binary representation of the COMPILED-DEBUG-BLOCKs - ;; in this function, in the order that the blocks were emitted. The first - ;; block is the start of the function. This slot may be NIL to save space. + ;; a vector of the packed binary representation of the + ;; COMPILED-DEBUG-BLOCKs in this function, in the order that the + ;; blocks were emitted. The first block is the start of the + ;; function. This slot may be NIL to save space. ;; ;; FIXME: The "packed binary representation" description in the comment ;; above is the same as the description of the old representation of diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 6b49e82..140e90d 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -324,8 +324,11 @@ (defstruct (bogus-debug-fun (:include debug-fun) (:constructor make-bogus-debug-fun - (%name &aux (%lambda-list nil) (%debug-vars nil) - (blocks nil) (%function nil))) + (%name &aux + (%lambda-list nil) + (%debug-vars nil) + (blocks nil) + (%function nil))) (:copier nil)) %name) @@ -515,11 +518,11 @@ (defun current-fp () (current-fp)) (defun stack-ref (s n) (stack-ref s n)) (defun %set-stack-ref (s n value) (%set-stack-ref s n value)) -(defun function-code-header (fun) (function-code-header fun)) +(defun fun-code-header (fun) (fun-code-header fun)) (defun lra-code-header (lra) (lra-code-header lra)) (defun make-lisp-obj (value) (make-lisp-obj value)) (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing)) -(defun function-word-offset (fun) (function-word-offset fun)) +(defun fun-word-offset (fun) (fun-word-offset fun)) #!-sb-fluid (declaim (inline cstack-pointer-valid-p)) (defun cstack-pointer-valid-p (x) @@ -970,7 +973,7 @@ (declare (type (unsigned-byte 32) bits)) (let ((object (make-lisp-obj bits))) (if (functionp object) - (or (function-code-header object) + (or (fun-code-header object) :undefined-function) (let ((lowtag (get-lowtag object))) (if (= lowtag sb!vm:other-pointer-type) @@ -1147,7 +1150,7 @@ (sb!c::compiled-debug-fun-start-pc (compiled-debug-fun-compiler-debug-fun debug-fun)))) (do ((entry (%code-entry-points component) - (%function-next entry))) + (%simple-fun-next entry))) ((null entry) nil) (when (= start-pc (sb!c::compiled-debug-fun-start-pc @@ -1172,12 +1175,13 @@ (declare (type function fun)) (ecase (get-type fun) (#.sb!vm:closure-header-type - (fun-debug-fun (%closure-function fun))) + (fun-debug-fun (%closure-fun fun))) (#.sb!vm:funcallable-instance-header-type - (fun-debug-fun (funcallable-instance-function fun))) - ((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type) - (let* ((name (%function-name fun)) - (component (function-code-header fun)) + (fun-debug-fun (funcallable-instance-fun fun))) + ((#.sb!vm:simple-fun-header-type + #.sb!vm:closure-fun-header-type) + (let* ((name (%simple-fun-name fun)) + (component (fun-code-header fun)) (res (find-if (lambda (x) (and (sb!c::compiled-debug-fun-p x) @@ -1196,7 +1200,7 @@ ;; works for all named functions anyway. ;; -- WHN 20000120 (debug-fun-from-pc component - (* (- (function-word-offset fun) + (* (- (fun-word-offset fun) (get-header-data component)) sb!vm:word-bytes))))))) diff --git a/src/code/describe.lisp b/src/code/describe.lisp index d6098e4..c2ce9dc 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -158,14 +158,14 @@ ;;; the guts. (defun %describe-function-compiled (x s kind name) (declare (type stream s)) - ;; FIXME: The lowercaseness of %FUNCTION-ARGLIST results, and the + ;; FIXME: The lowercaseness of %SIMPLE-FUN-ARGLIST results, and the ;; non-sentenceness of the "Arguments" label, makes awkward output. ;; Better would be "Its arguments are: ~S" (with uppercase argument ;; names) when arguments are known, and otherwise "There is no ;; information available about its arguments." or "It has no - ;; arguments." (And why is %FUNCTION-ARGLIST a string instead of a + ;; arguments." (And why is %SIMPLE-FUN-ARGLIST a string instead of a ;; list of symbols anyway?) - (let ((args (%function-arglist x))) + (let ((args (%simple-fun-arglist x))) (format s "~@:_~@(~@[~A ~]arguments:~@:_~)" kind) (cond ((not args) (format s " There is no argument information available.")) @@ -176,11 +176,11 @@ (pprint-logical-block (s nil) (pprint-indent :current 2) (write-string args s))))) - (let ((name (or name (%function-name x)))) + (let ((name (or name (%simple-fun-name x)))) (%describe-doc name s 'function kind) (unless (eq kind :macro) - (%describe-function-name name s (%fun-type x)))) - (%describe-compiled-from (sb-kernel:function-code-header x) s)) + (%describe-function-name name s (%simple-fun-type x)))) + (%describe-compiled-from (sb-kernel:fun-code-header x) s)) ;;; Describe a function with the specified kind and name. The latter ;;; arguments provide some information about where the function came @@ -196,13 +196,13 @@ ((nil) (format s "~S is a function." x))) (case (get-type x) (#.sb-vm:closure-header-type - (%describe-function-compiled (%closure-function x) s kind name) + (%describe-function-compiled (%closure-fun x) s kind name) (format s "~@:_Its closure environment is:") (pprint-logical-block (s nil) (pprint-indent :current 8) (dotimes (i (- (get-closure-length x) (1- sb-vm:closure-info-offset))) (format s "~@:_~S: ~S" i (%closure-index-ref x i))))) - ((#.sb-vm:function-header-type #.sb-vm:closure-function-header-type) + ((#.sb-vm:simple-fun-header-type #.sb-vm:closure-fun-header-type) (%describe-function-compiled x s kind name)) (#.sb-vm:funcallable-instance-header-type (typecase x diff --git a/src/code/dyncount.lisp b/src/code/dyncount.lisp index d14727b..b322722 100644 --- a/src/code/dyncount.lisp +++ b/src/code/dyncount.lisp @@ -214,8 +214,8 @@ comments from CMU CL: ;;; Return the DYNCOUNT-INFO for FUNCTION. (defun find-info-for (function) (declare (type function function)) - (let* ((function (%primitive closure-function function)) - (component (sb!di::function-code-header function))) + (let* ((function (%primitive closure-fun function)) + (component (sb!di::fun-code-header function))) (do ((end (get-header-data component)) (i sb!vm:code-constants-offset (1+ i))) ((= end i)) diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 36531a5..3e30128 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -164,9 +164,9 @@ might have been enclosed in some non-null lexical environment, and NAME is some name (for debugging only) or NIL if there is no name." (declare (type function fun)) - (let* ((fun (%function-self fun)) - (name (%function-name fun)) - (code (sb!di::function-code-header fun)) + (let* ((fun (%simple-fun-self fun)) + (name (%simple-fun-name fun)) + (code (sb!di::fun-code-header fun)) (info (sb!kernel:%code-debug-info code))) (if info (let ((source (first (sb!c::compiled-debug-info-source info)))) diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 4a8c794..b52ca89 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -25,16 +25,16 @@ (declare (type fdefn fdefn)) (fdefn-name fdefn)) -(defun fdefn-function (fdefn) +(defun fdefn-fun (fdefn) (declare (type fdefn fdefn) (values (or function null))) - (fdefn-function fdefn)) + (fdefn-fun fdefn)) -(defun (setf fdefn-function) (fun fdefn) +(defun (setf fdefn-fun) (fun fdefn) (declare (type function fun) (type fdefn fdefn) (values function)) - (setf (fdefn-function fdefn) fun)) + (setf (fdefn-fun fdefn) fun)) (defun fdefn-makunbound (fdefn) (declare (type fdefn fdefn)) @@ -105,8 +105,8 @@ ;;; 5. Require that the function calling convention be stereotyped ;;; along the lines of ;;; mov %ebx, local_immediate_3 ; Point to symbol. -;;; mov %eax, symbol_function_offset(%eax) ; Point to function. -;;; call *function_code_pointer(%eax) ; Go. +;;; mov %eax, symbol_fun_offset(%eax) ; Point to function. +;;; call *function_code_pointer(%eax) ; Go. ;;; That way, it's guaranteed that on entry to a function, %EBX points ;;; back to the symbol which was used to indirect into the function, ;;; so the undefined function handler can base its complaint on that. @@ -140,7 +140,7 @@ "Return the definition for name, including any encapsulations. Settable with SETF." (let ((fdefn (fdefinition-object name nil))) - (or (and fdefn (fdefn-function fdefn)) + (or (and fdefn (fdefn-fun fdefn)) (error 'undefined-function :name name)))) (defun %coerce-callable-to-function (callable) @@ -156,7 +156,7 @@ (%coerce-name-to-function name)) (defun (setf raw-definition) (function name) (let ((fdefn (fdefinition-object name t))) - (setf (fdefn-function fdefn) function))) + (setf (fdefn-fun fdefn) function))) ;;; FIXME: There seems to be no good reason to have both ;;; %COERCE-NAME-TO-FUNCTION and RAW-DEFINITION names for the same @@ -188,7 +188,7 @@ ;;; encapsulations of the same name. (defun encapsulate (name type body) (let ((fdefn (fdefinition-object name nil))) - (unless (and fdefn (fdefn-function fdefn)) + (unless (and fdefn (fdefn-fun fdefn)) (error 'undefined-function :name name)) ;; We must bind and close over INFO. Consider the case where we ;; encapsulate (the second) an encapsulated (the first) @@ -199,8 +199,8 @@ ;; clobber the appropriate INFO structure to allow ;; basic-definition to be bound to the next definition instead of ;; an encapsulation that no longer exists. - (let ((info (make-encapsulation-info type (fdefn-function fdefn)))) - (setf (fdefn-function fdefn) + (let ((info (make-encapsulation-info type (fdefn-fun fdefn)))) + (setf (fdefn-fun fdefn) (lambda (&rest argument-list) (declare (special argument-list)) (let ((basic-definition (encapsulation-info-definition info))) @@ -236,14 +236,14 @@ #!+sb-doc "Removes NAME's most recent encapsulation of the specified TYPE." (let* ((fdefn (fdefinition-object name nil)) - (encap-info (encapsulation-info (fdefn-function fdefn)))) + (encap-info (encapsulation-info (fdefn-fun fdefn)))) (declare (type (or encapsulation-info null) encap-info)) (cond ((not encap-info) ;; It disappeared on us, so don't worry about it. ) ((eq (encapsulation-info-type encap-info) type) ;; It's the first one, so change the fdefn object. - (setf (fdefn-function fdefn) + (setf (fdefn-fun fdefn) (encapsulation-info-definition encap-info))) (t ;; It must be an interior one, so find it. @@ -264,7 +264,7 @@ ;;; Does NAME have an encapsulation of the given TYPE? (defun encapsulated-p (name type) (let ((fdefn (fdefinition-object name nil))) - (do ((encap-info (encapsulation-info (fdefn-function fdefn)) + (do ((encap-info (encapsulation-info (fdefn-fun fdefn)) (encapsulation-info (encapsulation-info-definition encap-info)))) ((null encap-info) nil) @@ -324,7 +324,7 @@ (dolist (f *setf-fdefinition-hook*) (funcall f name new-value))) - (let ((encap-info (encapsulation-info (fdefn-function fdefn)))) + (let ((encap-info (encapsulation-info (fdefn-fun fdefn)))) (cond (encap-info (loop (let ((more-info @@ -336,7 +336,7 @@ (setf (encapsulation-info-definition encap-info) new-value)))))) (t - (setf (fdefn-function fdefn) new-value)))))) + (setf (fdefn-fun fdefn) new-value)))))) ;;;; FBOUNDP and FMAKUNBOUND @@ -344,7 +344,7 @@ #!+sb-doc "Return true if name has a global function definition." (let ((fdefn (fdefinition-object name nil))) - (and fdefn (fdefn-function fdefn) t))) + (and fdefn (fdefn-fun fdefn) t))) (defun fmakunbound (name) #!+sb-doc diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 96da12e..b5f382b 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -646,12 +646,12 @@ bug.~:@>") (error "internal error: unaligned function object, offset = #X~X" offset)) (let ((fun (%primitive sb!c:compute-function code-object offset))) - (setf (%function-self fun) fun) - (setf (%function-next fun) (%code-entry-points code-object)) + (setf (%simple-fun-self fun) fun) + (setf (%simple-fun-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 (%fun-type fun) type) + (setf (%simple-fun-name fun) name) + (setf (%simple-fun-arglist fun) arglist) + (setf (%simple-fun-type fun) type) ;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL. #+nil (when *load-print* (load-fresh-line) diff --git a/src/code/inspect.lisp b/src/code/inspect.lisp index db51e0f..8a8aeb9 100644 --- a/src/code/inspect.lisp +++ b/src/code/inspect.lisp @@ -196,10 +196,10 @@ evaluated expressions. (defmethod inspected-parts ((object function)) (let* ((type (sb-kernel:get-type object)) (object (if (= type sb-vm:closure-header-type) - (sb-kernel:%closure-function object) + (sb-kernel:%closure-fun object) object))) (values (format nil "FUNCTION ~S.~@[~%Argument List: ~A~]." object - (sb-kernel:%function-arglist object) + (sb-kernel:%simple-fun-arglist object) ;; Defined-from stuff used to be here. Someone took ;; it out. FIXME: We should make it easy to get ;; to DESCRIBE from the inspector. diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp index 772a4e4..34dc5d4 100644 --- a/src/code/kernel.lisp +++ b/src/code/kernel.lisp @@ -62,20 +62,26 @@ (setf (function-subtype function) type)) ;;; Extract the arglist from the function header FUNC. -(defun %function-arglist (func) - (%function-arglist func)) +(defun %simple-fun-arglist (func) + (%simple-fun-arglist func)) ;;; Extract the name from the function header FUNC. -(defun %function-name (func) - (%function-name func)) +(defun %simple-fun-name (func) + (%simple-fun-name func)) ;;; Extract the type from the function header FUNC. -(defun %fun-type (func) - (%fun-type func)) +(defun %simple-fun-type (func) + (%simple-fun-type func)) + +(defun %simple-fun-next (simple-fun) + (%simple-fun-next simple-fun)) + +(defun %simple-fun-self (simple-fun) + (%simple-fun-self simple-fun)) ;;; Extract the function from CLOSURE. -(defun %closure-function (closure) - (%closure-function closure)) +(defun %closure-fun (closure) + (%closure-fun closure)) ;;; Return the length of VECTOR. There is no reason to use this in ;;; ordinary code, 'cause length (the vector foo)) is the same. diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 1b0540f..587c1b0 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -127,7 +127,7 @@ (t (values (fdefinition x) t))) (case (sb-kernel:get-type res) (#.sb-vm:closure-header-type - (values (sb-kernel:%closure-function res) + (values (sb-kernel:%closure-fun res) named-p :compiled-closure)) (#.sb-vm:funcallable-instance-header-type diff --git a/src/code/print.lisp b/src/code/print.lisp index b0ae43d..eee9391 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1556,7 +1556,7 @@ ;; pulled out in a function somewhere. (name (case (function-subtype object) (#.sb!vm:closure-header-type "CLOSURE") - (#.sb!vm:function-header-type (%function-name object)) + (#.sb!vm:simple-fun-header-type (%simple-fun-name object)) (t 'no-name-available))) (identified-by-name-p (and (symbolp name) (fboundp name) @@ -1584,7 +1584,7 @@ (write-string "unknown pointer object, type=" stream) (let ((*print-base* 16) (*print-radix* t)) (output-integer type stream)))))) - ((#.sb!vm:function-pointer-type + ((#.sb!vm:fun-pointer-type #.sb!vm:instance-pointer-type #.sb!vm:list-pointer-type) (write-string "unknown pointer object, type=" stream)) diff --git a/src/code/room.lisp b/src/code/room.lisp index ecd7c01..ab96ff2 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -185,7 +185,7 @@ (setq current (sap+ current size)))) ((eql header-type closure-header-type) (let* ((obj (make-lisp-obj (logior (sap-int current) - function-pointer-type))) + fun-pointer-type))) (size (round-to-dualword (* (the fixnum (1+ (get-closure-length obj))) word-bytes)))) diff --git a/src/code/stubs.lisp b/src/code/stubs.lisp index f54499f..e643439 100644 --- a/src/code/stubs.lisp +++ b/src/code/stubs.lisp @@ -18,9 +18,7 @@ (def-frob %code-code-size) (def-frob %code-debug-info) (def-frob %code-entry-points) - (def-frob %funcallable-instance-function) + (def-frob %funcallable-instance-fun) (def-frob %funcallable-instance-layout) (def-frob %funcallable-instance-lexenv) - (def-frob %function-next) - (def-frob %function-self) - (def-frob %set-funcallable-instance-function (fin new-val))) + (def-frob %set-funcallable-instance-fun (fin new-val))) diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 93c9beb..eb08e47 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -104,7 +104,7 @@ (defun %set-funcallable-instance-info (fin i new-value) (%set-funcallable-instance-info fin i new-value)) -(defun funcallable-instance-function (fin) +(defun funcallable-instance-fun (fin) (%funcallable-instance-lexenv fin)) ;;; The heart of the magic of funcallable instances ("FINs"). The @@ -128,13 +128,13 @@ ;;; think of another example offhand. -- WHN 2001-10-06) ;;; ;;; The only loss is that if someone accesses the -;;; FUNCALLABLE-INSTANCE-FUNCTION, then won't get a FIN back. This -;;; probably doesn't matter, since PCL only sets the FIN function. And -;;; the only reason that interpreted functions are FINs instead of -;;; bare closures is for debuggability. -(defun (setf funcallable-instance-function) (new-value fin) - (setf (%funcallable-instance-function fin) - (%closure-function new-value)) +;;; FUNCALLABLE-INSTANCE-FUN, then won't get a FIN back. This probably +;;; doesn't matter, since PCL only sets the FIN function. And the only +;;; reason that interpreted functions are FINs instead of bare +;;; closures is for debuggability. +(defun (setf funcallable-instance-fun) (new-value fin) + (setf (%funcallable-instance-fun fin) + (%closure-fun new-value)) (setf (%funcallable-instance-lexenv fin) (if (funcallable-instance-p new-value) (%funcallable-instance-lexenv new-value) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 00615ac..e70c868 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -19,12 +19,12 @@ (let ((name (case (get-type x) (#.sb!vm:closure-header-type - (%function-name (%closure-function x))) - ((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type) - (%function-name x)) + (%simple-fun-name (%closure-fun x))) + ((#.sb!vm:simple-fun-header-type #.sb!vm:closure-fun-header-type) + (%simple-fun-name x)) (#.sb!vm:funcallable-instance-header-type - (%function-name - (funcallable-instance-function x)))))) + (%simple-fun-name + (funcallable-instance-fun x)))))) (when (and name (typep name '(or symbol cons))) (values (info :function :documentation name))))) diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index d08becc..fcbc479 100644 --- a/src/code/target-type.lisp +++ b/src/code/target-type.lisp @@ -128,7 +128,7 @@ ;;; Pull the type specifier out of a function object. (defun extract-fun-type (fun) - (specifier-type (%fun-type (%closure-function fun)))) + (specifier-type (%simple-fun-type (%closure-fun fun)))) ;;;; miscellaneous interfaces diff --git a/src/code/type-class.lisp b/src/code/type-class.lisp index ee4bf5f..ae34c26 100644 --- a/src/code/type-class.lisp +++ b/src/code/type-class.lisp @@ -110,7 +110,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) ;; KLUDGE: If the slots of TYPE-CLASS ever change, the slots here ;; will have to be tweaked to match. -- WHN 19991021 - (defparameter *type-class-function-slots* + (defparameter *type-class-fun-slots* '((:simple-subtypep . type-class-simple-subtypep) (:complex-subtypep-arg1 . type-class-complex-subtypep-arg1) (:complex-subtypep-arg2 . type-class-complex-subtypep-arg2) @@ -150,17 +150,17 @@ (declaim (ftype (function (type-class) type-class) copy-type-class-coldly)) (defun copy-type-class-coldly (x) ;; KLUDGE: If the slots of TYPE-CLASS ever change in a way not - ;; reflected in *TYPE-CLASS-FUNCTION-SLOTS*, the slots here will + ;; reflected in *TYPE-CLASS-FUN-SLOTS*, the slots here will ;; have to be hand-tweaked to match. -- WHN 2001-03-19 (make-type-class :name (type-class-name x) - . #.(mapcan (lambda (type-class-function-slot) + . #.(mapcan (lambda (type-class-fun-slot) (destructuring-bind (keyword . slot-accessor) - type-class-function-slot + type-class-fun-slot `(,keyword (,slot-accessor x)))) - *type-class-function-slots*))) + *type-class-fun-slots*))) -(defun class-function-slot-or-lose (name) - (or (cdr (assoc name *type-class-function-slots*)) +(defun class-fun-slot-or-lose (name) + (or (cdr (assoc name *type-class-fun-slots*)) (error "~S is not a defined type class method." name))) ;;; FIXME: This seems to be called at runtime by cold init code. ;;; Make sure that it's not being called at runtime anywhere but @@ -176,7 +176,7 @@ ,@body) (!cold-init-forms ,@(mapcar (lambda (method) - `(setf (,(class-function-slot-or-lose method) + `(setf (,(class-fun-slot-or-lose method) (type-class-or-lose ',class)) #',name)) (cons method more-methods))) @@ -211,12 +211,12 @@ (complex-arg1 :foo complex-arg1-p)) (declare (type keyword simple complex-arg1 complex-arg2)) `(multiple-value-bind (result-a result-b valid-p) - (%invoke-type-method ',(class-function-slot-or-lose simple) - ',(class-function-slot-or-lose + (%invoke-type-method ',(class-fun-slot-or-lose simple) + ',(class-fun-slot-or-lose (if complex-arg1-p complex-arg1 complex-arg2)) - ',(class-function-slot-or-lose complex-arg2) + ',(class-fun-slot-or-lose complex-arg2) ,complex-arg1-p ,type1 ,type2) diff --git a/src/compiler/alpha/alloc.lisp b/src/compiler/alpha/alloc.lisp index af42bcb..71aa412 100644 --- a/src/compiler/alpha/alloc.lisp +++ b/src/compiler/alpha/alloc.lisp @@ -107,7 +107,7 @@ (:generator 37 (with-fixed-allocation (result temp fdefn-type fdefn-size) (storew name result fdefn-name-slot other-pointer-type) - (storew null-tn result fdefn-function-slot other-pointer-type) + (storew null-tn result fdefn-fun-slot other-pointer-type) (inst li (make-fixup "undefined_tramp" :foreign) temp) (storew temp result fdefn-raw-addr-slot other-pointer-type)))) @@ -120,9 +120,9 @@ (let ((size (+ length closure-info-offset))) (inst li (logior (ash (1- size) type-bits) closure-header-type) temp) (pseudo-atomic (:extra (pad-data-block size)) - (inst bis alloc-tn function-pointer-type result) - (storew temp result 0 function-pointer-type)) - (storew function result closure-function-slot function-pointer-type)))) + (inst bis alloc-tn fun-pointer-type result) + (storew temp result 0 fun-pointer-type)) + (storew function result closure-fun-slot fun-pointer-type)))) ;;; The compiler likes to be able to directly make value cells. ;;; diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 4e42c95..9b402ae 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -135,8 +135,8 @@ (trace-table-entry trace-table-function-prologue) (emit-label start-lab) ;; Allocate function header. - (inst function-header-word) - (dotimes (i (1- function-code-offset)) + (inst simple-fun-header-word) + (dotimes (i (1- simple-fun-code-offset)) (inst lword 0)) ;; The start of the actual code. ;; Compute CODE from the address of this entry point. @@ -779,18 +779,18 @@ default-value-8 (do-next-filler))) #!-gengc (inst ldl function - (- (ash closure-function-slot word-shift) - function-pointer-type) lexenv) + (- (ash closure-fun-slot word-shift) + fun-pointer-type) lexenv) #!-gengc (do-next-filler) #!-gengc (inst addq function - (- (ash function-code-offset word-shift) - function-pointer-type) entry-point) + (- (ash simple-fun-code-offset word-shift) + fun-pointer-type) entry-point) #!+gengc (inst ldl entry-point (- (ash closure-entry-point-slot word-shift) - function-pointer-type) lexenv) + fun-pointer-type) lexenv) #!+gengc (do-next-filler))) (loop diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index e200e3e..6f6147a 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -89,12 +89,12 @@ -;;;; FDEFINITION (fdefn) objects +;;;; fdefinition (FDEFN) objects -(define-vop (fdefn-function cell-ref) - (:variant fdefn-function-slot other-pointer-type)) +(define-vop (fdefn-fun cell-ref) + (:variant fdefn-fun-slot other-pointer-type)) -(define-vop (safe-fdefn-function) +(define-vop (safe-fdefn-fun) (:args (object :scs (descriptor-reg) :target obj-temp)) (:results (value :scs (descriptor-reg any-reg))) (:vop-var vop) @@ -103,14 +103,14 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 10 (move object obj-temp) - (loadw value obj-temp fdefn-function-slot other-pointer-type) + (loadw value obj-temp fdefn-fun-slot other-pointer-type) (let ((err-lab (generate-error-code vop undefined-symbol-error obj-temp))) (inst cmpeq value null-tn temp) (inst bne temp err-lab)))) -(define-vop (set-fdefn-function) +(define-vop (set-fdefn-fun) (:policy :fast-safe) - (:translate (setf fdefn-function)) + (:translate (setf fdefn-fun)) (:args (function :scs (descriptor-reg) :target result) (fdefn :scs (descriptor-reg))) (:temporary (:scs (interior-reg)) lip) @@ -118,16 +118,16 @@ (:results (result :scs (descriptor-reg))) (:generator 38 (let ((normal-fn (gen-label))) - (load-type type function (- function-pointer-type)) - (inst xor type function-header-type type) + (load-type type function (- fun-pointer-type)) + (inst xor type simple-fun-header-type type) (inst addq function - (- (ash function-code-offset word-shift) function-pointer-type) + (- (ash simple-fun-code-offset word-shift) fun-pointer-type) lip) (inst beq type normal-fn) (inst li (make-fixup "closure_tramp" :foreign) lip) (emit-label normal-fn) (storew lip fdefn fdefn-raw-addr-slot other-pointer-type) - (storew function fdefn fdefn-function-slot other-pointer-type) + (storew function fdefn fdefn-fun-slot other-pointer-type) (move function result)))) @@ -138,7 +138,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:results (result :scs (descriptor-reg))) (:generator 38 - (storew null-tn fdefn fdefn-function-slot other-pointer-type) + (storew null-tn fdefn fdefn-fun-slot other-pointer-type) (inst li (make-fixup "undefined_tramp" :foreign) temp) (move fdefn result) (storew temp fdefn fdefn-raw-addr-slot other-pointer-type))) @@ -202,25 +202,25 @@ ;;;; closure indexing (define-full-reffer closure-index-ref * - closure-info-offset function-pointer-type + closure-info-offset fun-pointer-type (descriptor-reg any-reg) * %closure-index-ref) (define-full-setter set-funcallable-instance-info * - funcallable-instance-info-offset function-pointer-type + funcallable-instance-info-offset fun-pointer-type (descriptor-reg any-reg null zero) * %set-funcallable-instance-info) (define-full-reffer funcallable-instance-info * - funcallable-instance-info-offset function-pointer-type + funcallable-instance-info-offset fun-pointer-type (descriptor-reg any-reg) * %funcallable-instance-info) (define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot function-pointer-type)) + (:variant funcallable-instance-lexenv-slot fun-pointer-type)) (define-vop (closure-ref slot-ref) - (:variant closure-info-offset function-pointer-type)) + (:variant closure-info-offset fun-pointer-type)) (define-vop (closure-init slot-set) - (:variant closure-info-offset function-pointer-type)) + (:variant closure-info-offset fun-pointer-type)) ;;;; value cell hackery diff --git a/src/compiler/alpha/debug.lisp b/src/compiler/alpha/debug.lisp index 7c81a51..8e9df70 100644 --- a/src/compiler/alpha/debug.lisp +++ b/src/compiler/alpha/debug.lisp @@ -107,8 +107,8 @@ (:variant sb!vm:other-pointer-type)) (define-vop (code-from-function code-from-mumble) - (:translate function-code-header) - (:variant sb!vm:function-pointer-type)) + (:translate fun-code-header) + (:variant sb!vm:fun-pointer-type)) (define-vop (make-lisp-obj) (:policy :fast-safe) @@ -128,14 +128,14 @@ (:generator 1 (move thing result))) -(define-vop (function-word-offset) +(define-vop (fun-word-offset) (:policy :fast-safe) - (:translate function-word-offset) + (:translate fun-word-offset) (:args (fun :scs (descriptor-reg))) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 5 - (loadw res fun 0 function-pointer-type) + (loadw res fun 0 fun-pointer-type) (inst srl res sb!vm:type-bits res))) (defknown make-number-stack-pointer ((unsigned-byte 32)) system-area-pointer diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index 147b872..098dfaa 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -539,10 +539,10 @@ (ash (+ posn (component-header-length)) (- type-bits word-shift))))))) -(define-instruction function-header-word (segment) +(define-instruction simple-fun-header-word (segment) (:cost 0) (:emitter - (emit-header-data segment function-header-type))) + (emit-header-data segment simple-fun-header-type))) (define-instruction lra-header-word (segment) (:cost 0) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 9e02f62..d898045 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -87,8 +87,8 @@ (defmacro lisp-jump (function lip) "Jump to the lisp function FUNCTION. LIP is an interior-reg temporary." `(progn - (inst lda ,lip (- (ash sb!vm:function-code-offset sb!vm:word-shift) - sb!vm:function-pointer-type) + (inst lda ,lip (- (ash sb!vm:simple-fun-code-offset sb!vm:word-shift) + sb!vm:fun-pointer-type) ,function) (move ,function code-tn) (inst jsr zero-tn ,lip 1))) diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp index 6d74baf..539ef59 100644 --- a/src/compiler/alpha/system.lisp +++ b/src/compiler/alpha/system.lisp @@ -34,7 +34,7 @@ (inst and object lowtag-mask result) (inst cmpeq result other-pointer-type ndescr) (inst bne ndescr other-ptr) - (inst cmpeq result function-pointer-type ndescr) + (inst cmpeq result fun-pointer-type ndescr) (inst bne ndescr function-ptr) ;; Pick off structure and list pointers. @@ -49,7 +49,7 @@ (inst br zero-tn done) FUNCTION-PTR - (load-type result object (- function-pointer-type)) + (load-type result object (- fun-pointer-type)) (inst br zero-tn done) OTHER-PTR @@ -64,7 +64,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type result function (- function-pointer-type)))) + (load-type result function (- fun-pointer-type)))) (define-vop (set-function-subtype) (:translate (setf function-subtype)) @@ -76,10 +76,10 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (inst ldl temp (- function-pointer-type) function) + (inst ldl temp (- fun-pointer-type) function) (inst and temp #xff temp) (inst bis type temp temp) - (inst stl temp (- function-pointer-type) function) + (inst stl temp (- fun-pointer-type) function) (move type result))) @@ -100,7 +100,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 function-pointer-type) + (loadw res x 0 fun-pointer-type) (inst srl res type-bits res))) (define-vop (set-header-data) @@ -210,7 +210,7 @@ (inst srl ndescr type-bits ndescr) (inst sll ndescr word-shift ndescr) (inst addq ndescr offset ndescr) - (inst subq ndescr (- other-pointer-type function-pointer-type) ndescr) + (inst subq ndescr (- other-pointer-type fun-pointer-type) ndescr) (inst addq code ndescr func))) ;;;; other random VOPs. diff --git a/src/compiler/alpha/type-vops.lisp b/src/compiler/alpha/type-vops.lisp index 887cc23..e5a4535 100644 --- a/src/compiler/alpha/type-vops.lisp +++ b/src/compiler/alpha/type-vops.lisp @@ -18,10 +18,10 @@ (defparameter *immediate-types* (list unbound-marker-type base-char-type)) -(defparameter *function-header-types* +(defparameter *fun-header-types* (list funcallable-instance-header-type - function-header-type - closure-function-header-type + simple-fun-header-type + closure-fun-header-type closure-header-type)) (defun canonicalize-headers (headers) @@ -58,8 +58,8 @@ (extended (remove lowtag-limit type-codes :test #'>)) (immediates (intersection extended *immediate-types* :test #'eql)) (headers (set-difference extended *immediate-types* :test #'eql)) - (function-p (if (intersection headers *function-header-types*) - (if (subsetp headers *function-header-types*) + (function-p (if (intersection headers *fun-header-types*) + (if (subsetp headers *fun-header-types*) t (error "Can't test for mix of function subtypes ~ and normal header types.")) @@ -141,7 +141,7 @@ (defun %test-headers (value temp target not-p function-p headers &optional (drop-through (gen-label))) - (let ((lowtag (if function-p function-pointer-type other-pointer-type))) + (let ((lowtag (if function-p fun-pointer-type other-pointer-type))) (multiple-value-bind (when-true when-false) ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when @@ -234,7 +234,7 @@ even-fixnum-type odd-fixnum-type) (def-type-vops functionp check-function function - object-not-function-error function-pointer-type) + object-not-function-error fun-pointer-type) (def-type-vops listp check-list list object-not-list-error list-pointer-type) @@ -388,10 +388,6 @@ simple-array-type complex-string-type complex-bit-vector-type complex-vector-type complex-array-type) -(def-type-vops nil check-function-or-symbol nil - object-not-function-or-symbol-error - function-pointer-type symbol-header-type) - (def-type-vops stringp check-string nil object-not-string-error simple-string-type complex-string-type) diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index a0da9e6..b40ee3a 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -26,8 +26,8 @@ ;; defined in the first DEFENUM. -- AL 20000216 (defenum (:suffix -type) even-fixnum - ;; Note: CMU CL, and SBCL < 0.pre7.39, had FUNCTION-POINTER-TYPE - ;; here. We swapped FUNCTION-POINTER-TYPE and + ;; Note: CMU CL, and SBCL < 0.pre7.39, had FUN-POINTER-TYPE + ;; here. We swapped FUN-POINTER-TYPE and ;; INSTANCE-POINTER-TYPE in sbcl-0.pre7.39 in order to help with a ;; low-level pun in the function call sequence on the PPC port. ;; For more information, see the PPC port code. -- WHN 2001-10-03 @@ -35,7 +35,7 @@ other-immediate-0 list-pointer odd-fixnum - function-pointer + fun-pointer other-immediate-1 other-pointer)) @@ -79,10 +79,10 @@ complex-array code-header - function-header + simple-fun-header closure-header funcallable-instance-header - closure-function-header + closure-fun-header return-pc-header value-cell-header diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 9cf61ef..89b6be2 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -251,7 +251,7 @@ (let ((lowtag (descriptor-lowtag des)) (high (descriptor-high des)) (low (descriptor-low des))) - (if (or (eql lowtag sb!vm:function-pointer-type) + (if (or (eql lowtag sb!vm:fun-pointer-type) (eql lowtag sb!vm:instance-pointer-type) (eql lowtag sb!vm:list-pointer-type) (eql lowtag sb!vm:other-pointer-type)) @@ -1368,7 +1368,7 @@ (1- sb!vm:fdefn-size) sb!vm:fdefn-type)) (write-wordindexed fdefn sb!vm:fdefn-name-slot cold-name) (unless leave-fn-raw - (write-wordindexed fdefn sb!vm:fdefn-function-slot + (write-wordindexed fdefn sb!vm:fdefn-fun-slot *nil-descriptor*) (write-wordindexed fdefn sb!vm:fdefn-raw-addr-slot @@ -1383,18 +1383,18 @@ (declare (type descriptor cold-name)) (let ((fdefn (cold-fdefinition-object cold-name t)) (type (logand (descriptor-low (read-memory defn)) sb!vm:type-mask))) - (write-wordindexed fdefn sb!vm:fdefn-function-slot defn) + (write-wordindexed fdefn sb!vm:fdefn-fun-slot defn) (write-wordindexed fdefn sb!vm:fdefn-raw-addr-slot (ecase type - (#.sb!vm:function-header-type + (#.sb!vm:simple-fun-header-type #!+sparc defn #!-sparc (make-random-descriptor (+ (logandc2 (descriptor-bits defn) sb!vm:lowtag-mask) - (ash sb!vm:function-code-offset + (ash sb!vm:simple-fun-code-offset sb!vm:word-shift)))) (#.sb!vm:closure-header-type (make-random-descriptor @@ -2330,18 +2330,18 @@ (offset (calc-offset code-object (read-arg 4))) (fn (descriptor-beyond code-object offset - sb!vm:function-pointer-type)) + sb!vm:fun-pointer-type)) (next (read-wordindexed code-object sb!vm:code-entry-points-slot))) (unless (zerop (logand offset sb!vm:lowtag-mask)) ;; FIXME: This should probably become a fatal error. (warn "unaligned function entry: ~S at #X~X" name offset)) (write-wordindexed code-object sb!vm:code-entry-points-slot fn) (write-memory fn - (make-other-immediate-descriptor (ash offset - (- sb!vm:word-shift)) - sb!vm:function-header-type)) + (make-other-immediate-descriptor + (ash offset (- sb!vm:word-shift)) + sb!vm:simple-fun-header-type)) (write-wordindexed fn - sb!vm:function-self-slot + sb!vm:simple-fun-self-slot ;; KLUDGE: Wiring decisions like this in at ;; this level ("if it's an x86") instead of a ;; higher level of abstraction ("if it has such @@ -2372,15 +2372,16 @@ ;; -- WHN 19990907 (make-random-descriptor (+ (descriptor-bits fn) - (- (ash sb!vm:function-code-offset sb!vm:word-shift) + (- (ash sb!vm:simple-fun-code-offset + sb!vm:word-shift) ;; FIXME: We should mask out the type ;; bits, not assume we know what they ;; are and subtract them out this way. - sb!vm:function-pointer-type)))) - (write-wordindexed fn sb!vm:function-next-slot next) - (write-wordindexed fn sb!vm:function-name-slot name) - (write-wordindexed fn sb!vm:function-arglist-slot arglist) - (write-wordindexed fn sb!vm:function-type-slot type) + sb!vm:fun-pointer-type)))) + (write-wordindexed fn sb!vm:simple-fun-next-slot next) + (write-wordindexed fn sb!vm:simple-fun-name-slot name) + (write-wordindexed fn sb!vm:simple-fun-arglist-slot arglist) + (write-wordindexed fn sb!vm:simple-fun-type-slot type) fn)) (define-cold-fop (fop-foreign-fixup) @@ -2680,7 +2681,7 @@ (undefs nil)) (maphash #'(lambda (name fdefn) (let ((fun (read-wordindexed fdefn - sb!vm:fdefn-function-slot))) + sb!vm:fdefn-fun-slot))) (if (= (descriptor-bits fun) (descriptor-bits *nil-descriptor*)) (push name undefs) @@ -2850,7 +2851,7 @@ initially undefined function references:~2%") (let* ((cold-name (cold-intern '!cold-init)) (cold-fdefn (cold-fdefinition-object cold-name)) (initial-function (read-wordindexed cold-fdefn - sb!vm:fdefn-function-slot))) + sb!vm:fdefn-fun-slot))) (format t "~&/(DESCRIPTOR-BITS INITIAL-FUNCTION)=#X~X~%" (descriptor-bits initial-function)) diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 3dfb2f8..e2303d2 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -133,14 +133,16 @@ :lowtag other-pointer-type :header fdefn-type) (name :ref-trans fdefn-name) - (function :type (or function null) :ref-trans fdefn-function) + (fun :type (or function null) :ref-trans fdefn-fun) (raw-addr :c-type #!-alpha "char *" #!+alpha "u32")) -(define-primitive-object (function :type function - :lowtag function-pointer-type - :header function-header-type) - #!-x86 (self :ref-trans %function-self - :set-trans (setf %function-self)) +;;; a simple function (as opposed to hairier things like closures +;;; which are also subtypes of Common Lisp's FUNCTION type) +(define-primitive-object (simple-fun :type function + :lowtag fun-pointer-type + :header simple-fun-header-type) + #!-x86 (self :ref-trans %simple-fun-self + :set-trans (setf %simple-fun-self)) #!+x86 (self ;; KLUDGE: There's no :SET-KNOWN, :SET-TRANS, :REF-KNOWN, or ;; :REF-TRANS here in this case. Instead, there's separate @@ -159,47 +161,47 @@ ) (next :type (or function null) :ref-known (flushable) - :ref-trans %function-next + :ref-trans %simple-fun-next :set-known (unsafe) - :set-trans (setf %function-next)) + :set-trans (setf %simple-fun-next)) (name :ref-known (flushable) - :ref-trans %function-name + :ref-trans %simple-fun-name :set-known (unsafe) - :set-trans (setf %function-name)) + :set-trans (setf %simple-fun-name)) (arglist :ref-known (flushable) - :ref-trans %function-arglist + :ref-trans %simple-fun-arglist :set-known (unsafe) - :set-trans (setf %function-arglist)) + :set-trans (setf %simple-fun-arglist)) (type :ref-known (flushable) - :ref-trans %fun-type + :ref-trans %simple-fun-type :set-known (unsafe) - :set-trans (setf %fun-type)) + :set-trans (setf %simple-fun-type)) (code :rest-p t :c-type "unsigned char")) (define-primitive-object (return-pc :lowtag other-pointer-type :header t) (return-point :c-type "unsigned char" :rest-p t)) -(define-primitive-object (closure :lowtag function-pointer-type +(define-primitive-object (closure :lowtag fun-pointer-type :header closure-header-type) - (function :init :arg :ref-trans %closure-function) + (fun :init :arg :ref-trans %closure-fun) (info :rest-p t)) (define-primitive-object (funcallable-instance - :lowtag function-pointer-type + :lowtag fun-pointer-type :header funcallable-instance-header-type :alloc-trans %make-funcallable-instance) #!-x86 - (function - :ref-known (flushable) :ref-trans %funcallable-instance-function - :set-known (unsafe) :set-trans (setf %funcallable-instance-function)) + (fun + :ref-known (flushable) :ref-trans %funcallable-instance-fun + :set-known (unsafe) :set-trans (setf %funcallable-instance-fun)) #!+x86 - (function - :ref-known (flushable) :ref-trans %funcallable-instance-function + (fun + :ref-known (flushable) :ref-trans %funcallable-instance-fun ;; KLUDGE: There's no :SET-KNOWN or :SET-TRANS in this case. ;; Instead, later in compiler/x86/system.lisp there's a separate - ;; DEFKNOWN for (SETF %FUNCALLABLE-INSTANCE-FUNCTION), and a weird - ;; unexplained DEFTRANSFORM from (SETF %FUNCTION-INSTANCE-FUNCTION) - ;; into (SETF %FUNCTION-SELF). The #!+X86 wrapped around this case + ;; DEFKNOWN for (SETF %FUNCALLABLE-INSTANCE-FUN), and a weird + ;; unexplained DEFTRANSFORM from (SETF %SIMPLE-FUN-INSTANCE-FUN) + ;; into (SETF %SIMPLE-FUN-SELF). The #!+X86 wrapped around this case ;; is a literal translation of the old CMU CL implementation into ;; the new world of sbcl-0.6.12.63, where multiple DEFKNOWNs for ;; the same operator cause an error (instead of silently deleting diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index b9f1c7b..df174f2 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -24,12 +24,12 @@ (unless (zerop (logand offset sb!vm:lowtag-mask)) (error "Unaligned function object, offset = #X~X." offset)) (let ((res (%primitive compute-function code-obj offset))) - (setf (%function-self res) res) - (setf (%function-next res) (%code-entry-points code-obj)) + (setf (%simple-fun-self res) res) + (setf (%simple-fun-next res) (%code-entry-points code-obj)) (setf (%code-entry-points code-obj) res) - (setf (%function-name res) (entry-info-name entry)) - (setf (%function-arglist res) (entry-info-arguments entry)) - (setf (%fun-type res) (entry-info-type entry)) + (setf (%simple-fun-name res) (entry-info-name entry)) + (setf (%simple-fun-arglist res) (entry-info-arguments entry)) + (setf (%simple-fun-type res) (entry-info-type entry)) (note-function entry res object)))) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 833ceac..8221f5b 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -151,10 +151,10 @@ (defknown stack-ref (system-area-pointer index) t (flushable)) (defknown %set-stack-ref (system-area-pointer index t) t (unsafe)) (defknown lra-code-header (t) t (movable flushable)) -(defknown function-code-header (t) t (movable flushable)) +(defknown fun-code-header (t) t (movable flushable)) (defknown make-lisp-obj ((unsigned-byte 32)) t (movable flushable)) (defknown get-lisp-obj-address (t) (unsigned-byte 32) (movable flushable)) -(defknown function-word-offset (function) index (movable flushable)) +(defknown fun-word-offset (function) index (movable flushable)) ;;;; 32-bit logical operations @@ -282,16 +282,16 @@ (defknown make-fdefn (t) fdefn (flushable movable)) (defknown fdefn-p (t) boolean (movable foldable flushable)) (defknown fdefn-name (fdefn) t (foldable flushable)) -(defknown fdefn-function (fdefn) (or function null) (flushable)) -(defknown (setf fdefn-function) (function fdefn) t (unsafe)) +(defknown fdefn-fun (fdefn) (or function null) (flushable)) +(defknown (setf fdefn-fun) (function fdefn) t (unsafe)) (defknown fdefn-makunbound (fdefn) t ()) -(defknown %function-self (function) function +(defknown %simple-fun-self (function) function (flushable)) -(defknown (setf %function-self) (function function) function +(defknown (setf %simple-fun-self) (function function) function (unsafe)) -(defknown %closure-function (function) function +(defknown %closure-fun (function) function (flushable)) (defknown %closure-index-ref (function index) t diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp index 072ae89..dd5f2ea 100644 --- a/src/compiler/generic/vm-macs.lisp +++ b/src/compiler/generic/vm-macs.lisp @@ -107,11 +107,7 @@ (incf offset length))) (unless variable-length (let ((size (symbolicate name "-SIZE"))) - (constants `(defconstant ,size ,offset - ,(format nil - "Number of slots used by each ~S~ - ~@[~* including the header~]." - name header))) + (constants `(defconstant ,size ,offset)) (exports size))) (when alloc-trans (forms `(def-alloc ,alloc-trans ,offset ,variable-length ,header diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 6b332e4..f042787 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -1963,10 +1963,10 @@ ;;;; hacking function names -;;; This is like LAMBDA, except the result is tweaked so that -;;; %FUNCTION-NAME can extract a name. (Also possibly the name could -;;; also be used at compile time to emit more-informative name-based -;;; compiler diagnostic messages as well.) +;;; This is like LAMBDA, except the result is tweaked so that FUN-NAME +;;; can extract a name. (Also possibly the name could also be used at +;;; compile time to emit more-informative name-based compiler +;;; diagnostic messages as well.) (defmacro-mundanely named-lambda (name args &body body) ;; FIXME: For now, in this stub version, we just discard the name. A diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 38e54fd..9d96c87 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -140,8 +140,8 @@ (:global-function (let ((fdefn-tn (make-load-time-constant-tn :fdefinition name))) (if unsafe - (vop fdefn-function node block fdefn-tn res) - (vop safe-fdefn-function node block fdefn-tn res)))))))) + (vop fdefn-fun node block fdefn-tn res) + (vop safe-fdefn-fun node block fdefn-tn res)))))))) (move-continuation-result node block locs cont)) (values)) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index ca5ca26..56b5924 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -339,19 +339,19 @@ (defun fun-self (fun) (declare (type compiled-function fun)) - (sb!kernel:%function-self fun)) + (sb!kernel:%simple-fun-self fun)) (defun fun-code (fun) (declare (type compiled-function fun)) - (sb!kernel:function-code-header (fun-self fun))) + (sb!kernel:fun-code-header (fun-self fun))) (defun fun-next (fun) (declare (type compiled-function fun)) - (sb!kernel:%function-next fun)) + (sb!kernel:%simple-fun-next fun)) (defun fun-address (function) (declare (type compiled-function function)) - (- (sb!kernel:get-lisp-obj-address function) sb!vm:function-pointer-type)) + (- (sb!kernel:get-lisp-obj-address function) sb!vm:fun-pointer-type)) ;;; the offset of FUNCTION from the start of its code-component's ;;; instruction area @@ -448,19 +448,22 @@ (segment-offs-to-code-offs (dstate-cur-offs dstate) seg))) (name (sb!kernel:code-header-ref code - (+ woffs sb!vm:function-name-slot))) + (+ woffs + sb!vm:simple-fun-name-slot))) (args (sb!kernel:code-header-ref code - (+ woffs sb!vm:function-arglist-slot))) + (+ woffs + sb!vm:simple-fun-arglist-slot))) (type (sb!kernel:code-header-ref code - (+ woffs sb!vm:function-type-slot)))) + (+ woffs + sb!vm:simple-fun-type-slot)))) (format stream ".~A ~S~:A" 'entry name args) (note (lambda (stream) (format stream "~:S" type)) ; use format to print NIL as () dstate))) (incf (dstate-next-offs dstate) - (words-to-bytes sb!vm:function-code-offset))) + (words-to-bytes sb!vm:simple-fun-code-offset))) (defun alignment-hook (chunk stream dstate) (declare (type dchunk chunk) @@ -937,7 +940,7 @@ (defun print-fun-headers (function) (declare (type compiled-function function)) (let* ((self (fun-self function)) - (code (sb!kernel:function-code-header self))) + (code (sb!kernel:fun-code-header self))) (format t "Code-header ~S: size: ~S, trace-table-offset: ~S~%" code (sb!kernel:code-header-ref code @@ -954,11 +957,11 @@ fun fun-offset (sb!kernel:code-header-ref - code (+ fun-offset sb!vm:function-name-slot)) + code (+ fun-offset sb!vm:simple-fun-name-slot)) (sb!kernel:code-header-ref - code (+ fun-offset sb!vm:function-arglist-slot)) + code (+ fun-offset sb!vm:simple-fun-arglist-slot)) (sb!kernel:code-header-ref - code (+ fun-offset sb!vm:function-type-slot))))))) + code (+ fun-offset sb!vm:simple-fun-type-slot))))))) ;;; getting at the source code... @@ -1312,7 +1315,7 @@ (declare (type compiled-function function)) (let* ((code (fun-code function)) (fun-map (code-fun-map code)) - (fname (sb!kernel:%function-name function)) + (fname (sb!kernel:%simple-fun-name function)) (sfcache (make-source-form-cache))) (let ((first-block-seen-p nil) (nil-block-seen-p nil) diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index 34a099c..dcf4727 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -147,7 +147,7 @@ (:generator 37 (with-fixed-allocation (result fdefn-type fdefn-size node) (storew name result fdefn-name-slot other-pointer-type) - (storew nil-value result fdefn-function-slot other-pointer-type) + (storew nil-value result fdefn-fun-slot other-pointer-type) (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) result fdefn-raw-addr-slot other-pointer-type)))) @@ -162,11 +162,11 @@ (let ((size (+ length closure-info-offset))) (allocation result (pad-data-block size) node) (inst lea result - (make-ea :byte :base result :disp function-pointer-type)) + (make-ea :byte :base result :disp fun-pointer-type)) (storew (logior (ash (1- size) type-bits) closure-header-type) - result 0 function-pointer-type)) - (loadw temp function closure-function-slot function-pointer-type) - (storew temp result closure-function-slot function-pointer-type)))) + result 0 fun-pointer-type)) + (loadw temp function closure-fun-slot fun-pointer-type) + (storew temp result closure-fun-slot fun-pointer-type)))) ;;; The compiler likes to be able to directly make value cells. (define-vop (make-value-cell) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 4fda851..a393bd4 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -168,8 +168,8 @@ (trace-table-entry trace-table-function-prologue) (emit-label start-lab) ;; Skip space for the function header. - (inst function-header-word) - (dotimes (i (1- sb!vm:function-code-offset)) + (inst simple-fun-header-word) + (dotimes (i (1- sb!vm:simple-fun-code-offset)) (inst dword 0)) ;; The start of the actual code. @@ -912,8 +912,8 @@ :disp ,(if named '(- (* fdefn-raw-addr-slot word-bytes) other-pointer-type) - '(- (* closure-function-slot word-bytes) - function-pointer-type)))) + '(- (* closure-fun-slot word-bytes) + fun-pointer-type)))) ,@(ecase return (:fixed '((default-unknown-values vop values nvals))) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 96bd5b4..34e6f72 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -114,8 +114,9 @@ (:results (res :scs (any-reg))) (:result-types positive-fixnum) (:generator 2 - ;; The symbol-hash slot of NIL holds NIL because it is also the cdr slot, - ;; so we have to strip off the two low bits to make sure it is a fixnum. + ;; The symbol-hash slot of NIL holds NIL because it is also the + ;; cdr slot, so we have to strip off the two low bits to make sure + ;; it is a fixnum. ;; ;; FIXME: Is this still true? It seems to me from my reading of ;; the DEFINE-PRIMITIVE-OBJECT in objdef.lisp that the symbol-hash @@ -125,18 +126,18 @@ (loadw res symbol symbol-hash-slot other-pointer-type) (inst and res (lognot #b11)))) -;;;; fdefinition (fdefn) objects +;;;; fdefinition (FDEFN) objects -(define-vop (fdefn-function cell-ref) ; /pfw - alpha - (:variant fdefn-function-slot other-pointer-type)) +(define-vop (fdefn-fun cell-ref) ; /pfw - alpha + (:variant fdefn-fun-slot other-pointer-type)) -(define-vop (safe-fdefn-function) +(define-vop (safe-fdefn-fun) (:args (object :scs (descriptor-reg) :to (:result 1))) (:results (value :scs (descriptor-reg any-reg))) (:vop-var vop) (:save-p :compute-only) (:generator 10 - (loadw value object fdefn-function-slot other-pointer-type) + (loadw value object fdefn-fun-slot other-pointer-type) (inst cmp value nil-value) ;; FIXME: UNDEFINED-SYMBOL-ERROR seems to actually be for symbols with no ;; function value, not, as the name might suggest, symbols with no ordinary @@ -144,25 +145,25 @@ (let ((err-lab (generate-error-code vop undefined-symbol-error object))) (inst jmp :e err-lab)))) -(define-vop (set-fdefn-function) +(define-vop (set-fdefn-fun) (:policy :fast-safe) - (:translate (setf fdefn-function)) + (:translate (setf fdefn-fun)) (:args (function :scs (descriptor-reg) :target result) (fdefn :scs (descriptor-reg))) (:temporary (:sc unsigned-reg) raw) (:temporary (:sc byte-reg) type) (:results (result :scs (descriptor-reg))) (:generator 38 - (load-type type function (- function-pointer-type)) + (load-type type function (- fun-pointer-type)) (inst lea raw (make-ea :byte :base function - :disp (- (* function-code-offset word-bytes) - function-pointer-type))) - (inst cmp type function-header-type) + :disp (- (* simple-fun-code-offset word-bytes) + fun-pointer-type))) + (inst cmp type simple-fun-header-type) (inst jmp :e normal-fn) (inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign)) NORMAL-FN - (storew function fdefn fdefn-function-slot other-pointer-type) + (storew function fdefn fdefn-fun-slot other-pointer-type) (storew raw fdefn fdefn-raw-addr-slot other-pointer-type) (move result function))) @@ -172,7 +173,7 @@ (:args (fdefn :scs (descriptor-reg) :target result)) (:results (result :scs (descriptor-reg))) (:generator 38 - (storew nil-value fdefn fdefn-function-slot other-pointer-type) + (storew nil-value fdefn fdefn-fun-slot other-pointer-type) (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) fdefn fdefn-raw-addr-slot other-pointer-type) (move result fdefn))) @@ -234,25 +235,25 @@ ;;;; closure indexing (define-full-reffer closure-index-ref * - closure-info-offset function-pointer-type + closure-info-offset fun-pointer-type (any-reg descriptor-reg) * %closure-index-ref) (define-full-setter set-funcallable-instance-info * - funcallable-instance-info-offset function-pointer-type + funcallable-instance-info-offset fun-pointer-type (any-reg descriptor-reg) * %set-funcallable-instance-info) (define-full-reffer funcallable-instance-info * - funcallable-instance-info-offset function-pointer-type + funcallable-instance-info-offset fun-pointer-type (descriptor-reg any-reg) * %funcallable-instance-info) (define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot function-pointer-type)) + (:variant funcallable-instance-lexenv-slot fun-pointer-type)) (define-vop (closure-ref slot-ref) - (:variant closure-info-offset function-pointer-type)) + (:variant closure-info-offset fun-pointer-type)) (define-vop (closure-init slot-set) - (:variant closure-info-offset function-pointer-type)) + (:variant closure-info-offset fun-pointer-type)) ;;;; value cell hackery diff --git a/src/compiler/x86/debug.lisp b/src/compiler/x86/debug.lisp index 998b06e..e3c405b 100644 --- a/src/compiler/x86/debug.lisp +++ b/src/compiler/x86/debug.lisp @@ -117,8 +117,8 @@ (:variant other-pointer-type)) (define-vop (code-from-function code-from-mumble) - (:translate sb!di::function-code-header) - (:variant function-pointer-type)) + (:translate sb!di::fun-code-header) + (:variant fun-pointer-type)) (define-vop (make-lisp-obj) (:policy :fast-safe) @@ -143,12 +143,12 @@ (move result thing))) -(define-vop (function-word-offset) +(define-vop (fun-word-offset) (:policy :fast-safe) - (:translate sb!di::function-word-offset) + (:translate sb!di::fun-word-offset) (:args (fun :scs (descriptor-reg))) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 5 - (loadw res fun 0 function-pointer-type) + (loadw res fun 0 fun-pointer-type) (inst shr res type-bits))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 5d864f6..36d91bc 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -1926,9 +1926,9 @@ (- type-bits word-shift))))))) -(define-instruction function-header-word (segment) +(define-instruction simple-fun-header-word (segment) (:emitter - (emit-header-data segment function-header-type))) + (emit-header-data segment simple-fun-header-type))) (define-instruction lra-header-word (segment) (:emitter diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index 86cc500..b6e5884 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -36,14 +36,14 @@ (inst and al-tn lowtag-mask) (inst cmp al-tn other-pointer-type) (inst jmp :e other-ptr) - (inst cmp al-tn function-pointer-type) + (inst cmp al-tn fun-pointer-type) (inst jmp :e function-ptr) - ;; pick off structures and list pointers + ;; Pick off structures and list pointers. (inst test al-tn 1) (inst jmp :ne done) - ;; pick off fixnums + ;; Pick off fixnums. (inst and al-tn 3) (inst jmp :e done) @@ -52,7 +52,7 @@ (inst jmp done) FUNCTION-PTR - (load-type al-tn object (- sb!vm:function-pointer-type)) + (load-type al-tn object (- sb!vm:fun-pointer-type)) (inst jmp done) OTHER-PTR @@ -69,7 +69,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type temp function (- sb!vm:function-pointer-type)) + (load-type temp function (- sb!vm:fun-pointer-type)) (inst movzx result temp))) (define-vop (set-function-subtype) @@ -86,7 +86,7 @@ (:generator 6 (move eax type) (inst mov - (make-ea :byte :base function :disp (- function-pointer-type)) + (make-ea :byte :base function :disp (- fun-pointer-type)) al-tn) (move result eax))) @@ -107,7 +107,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 function-pointer-type) + (loadw res x 0 fun-pointer-type) (inst shr res type-bits))) (define-vop (set-header-data) @@ -211,33 +211,33 @@ (inst shr func type-bits) (inst lea func (make-ea :byte :base offset :index func :scale 4 - :disp (- function-pointer-type other-pointer-type))) + :disp (- fun-pointer-type other-pointer-type))) (inst add func code))) -(define-vop (%function-self) +(define-vop (%simple-fun-self) (:policy :fast-safe) - (:translate %function-self) + (:translate %simple-fun-self) (:args (function :scs (descriptor-reg))) (:results (result :scs (descriptor-reg))) (:generator 3 - (loadw result function function-self-slot function-pointer-type) + (loadw result function simple-fun-self-slot fun-pointer-type) (inst lea result (make-ea :byte :base result - :disp (- function-pointer-type - (* function-code-offset word-bytes)))))) + :disp (- fun-pointer-type + (* simple-fun-code-offset word-bytes)))))) ;;; The closure function slot is a pointer to raw code on X86 instead ;;; of a pointer to the code function object itself. This VOP is used ;;; to reference the function object given the closure object. -(def-source-transform %closure-function (closure) - `(%function-self ,closure)) +(def-source-transform %closure-fun (closure) + `(%simple-fun-self ,closure)) -(def-source-transform %funcallable-instance-function (fin) - `(%function-self ,fin)) +(def-source-transform %funcallable-instance-fun (fin) + `(%simple-fun-self ,fin)) -(define-vop (%set-function-self) +(define-vop (%set-fun-self) (:policy :fast-safe) - (:translate (setf %function-self)) + (:translate (setf %simple-fun-self)) (:args (new-self :scs (descriptor-reg) :target result :to :result) (function :scs (descriptor-reg) :to :result)) (:temporary (:sc any-reg :from (:argument 0) :to :result) temp) @@ -245,9 +245,9 @@ (:generator 3 (inst lea temp (make-ea :byte :base new-self - :disp (- (ash function-code-offset word-shift) - function-pointer-type))) - (storew temp function function-self-slot function-pointer-type) + :disp (- (ash simple-fun-code-offset word-shift) + fun-pointer-type))) + (storew temp function simple-fun-self-slot fun-pointer-type) (move result new-self))) ;;; KLUDGE: This seems to be some kind of weird override of the way @@ -255,14 +255,14 @@ ;;; accessor. It's inherited from CMU CL, and it works, and naively ;;; deleting it seemed to cause problems, but it's not obvious why ;;; it's done this way. Any ideas? -- WHN 2001-08-02 -(defknown ((setf %funcallable-instance-function)) (function function) function +(defknown ((setf %funcallable-instance-fun)) (function function) function (unsafe)) ;;; CMU CL comment: ;;; We would have really liked to use a source-transform for this, but ;;; they don't work with SETF functions. ;;; FIXME: Can't we just use DEFSETF or something? -(deftransform (setf %funcallable-instance-function) ((value fin)) - '(setf (%function-self fin) value)) +(deftransform (setf %funcallable-instance-fun) ((value fin)) + '(setf (%simple-fun-self fin) value)) ;;;; other miscellaneous VOPs diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp index 143863a..b0067e6 100644 --- a/src/compiler/x86/type-vops.lisp +++ b/src/compiler/x86/type-vops.lisp @@ -18,10 +18,10 @@ (defparameter *immediate-types* (list unbound-marker-type base-char-type)) -(defparameter *function-header-types* +(defparameter *fun-header-types* (list funcallable-instance-header-type - function-header-type - closure-function-header-type + simple-fun-header-type + closure-fun-header-type closure-header-type)) (defun canonicalize-headers (headers) @@ -58,8 +58,8 @@ (extended (remove lowtag-limit type-codes :test #'>)) (immediates (intersection extended *immediate-types* :test #'eql)) (headers (set-difference extended *immediate-types* :test #'eql)) - (function-p (if (intersection headers *function-header-types*) - (if (subsetp headers *function-header-types*) + (function-p (if (intersection headers *fun-header-types*) + (if (subsetp headers *fun-header-types*) t (error "can't test for mix of function subtypes ~ and normal header types")) @@ -163,7 +163,7 @@ (defun %test-headers (value target not-p function-p headers &optional (drop-through (gen-label)) al-loaded) - (let ((lowtag (if function-p function-pointer-type other-pointer-type))) + (let ((lowtag (if function-p fun-pointer-type other-pointer-type))) (multiple-value-bind (equal less-or-equal when-true when-false) ;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET. ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know @@ -201,7 +201,7 @@ #+nil (defun %test-headers (value target not-p function-p headers &optional (drop-through (gen-label)) al-loaded) - (let ((lowtag (if function-p function-pointer-type other-pointer-type))) + (let ((lowtag (if function-p fun-pointer-type other-pointer-type))) (multiple-value-bind (equal less-or-equal when-true when-false) ;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET. ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know @@ -324,7 +324,7 @@ even-fixnum-type odd-fixnum-type) (def-type-vops functionp check-function function - object-not-function-error function-pointer-type) + object-not-function-error fun-pointer-type) (def-type-vops listp check-list list object-not-list-error list-pointer-type) @@ -493,10 +493,6 @@ simple-array-type complex-string-type complex-bit-vector-type complex-vector-type complex-array-type) -(def-type-vops nil check-function-or-symbol nil - object-not-function-or-symbol-error - function-pointer-type symbol-header-type) - (def-type-vops stringp check-string nil object-not-string-error simple-string-type complex-string-type) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index d85ca7d..cd9d775 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -1655,7 +1655,7 @@ bootstrapping. (defun make-early-gf (spec &optional lambda-list lambda-list-p function) (let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*))) - (set-funcallable-instance-function + (set-funcallable-instance-fun fin (or function (if (eq spec 'print-object) diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 7a16f9b..95eced7 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -64,7 +64,7 @@ (defun allocate-funcallable-instance (wrapper &optional (slots-init nil slots-init-p)) (let ((fin (allocate-funcallable-instance-1))) - (set-funcallable-instance-function + (set-funcallable-instance-fun fin #'(sb-kernel:instance-lambda (&rest args) (declare (ignore args)) diff --git a/src/pcl/construct.lisp b/src/pcl/construct.lisp index 0224049..8217abb 100644 --- a/src/pcl/construct.lisp +++ b/src/pcl/construct.lisp @@ -202,11 +202,11 @@ :reader constructor-code-generators)) ;could use. (:metaclass funcallable-standard-class)) -;;; Because the value in the code-type slot should always correspond to the -;;; funcallable-instance-function of the constructor, this function should -;;; always be used to set the both at the same time. +;;; Because the value in the code-type slot should always correspond +;;; to the FUNCALLABLE-INSTANCE-FUN of the constructor, this function +;;; should always be used to set them both at the same time. (defun set-constructor-code (constructor code type) - (set-funcallable-instance-function constructor code) + (set-funcallable-instance-fun constructor code) (set-function-name constructor (constructor-name constructor)) (setf (constructor-code-type constructor) type)) @@ -221,8 +221,9 @@ (doplist (key val) (constructor-code-generators constructor) (gather1 key))))) -;;; I am not in a hairy enough mood to make this implementation be metacircular -;;; enough that it can support a defconstructor for constructor objects. +;;; I am not in a hairy enough mood to make this implementation be +;;; metacircular enough that it can support a defconstructor for +;;; constructor objects. (defun make-constructor (class name supplied-initarg-names code-generators) (make-instance 'constructor :class class @@ -253,9 +254,10 @@ name class) ()))) -;;; This is called to actually load a defconstructor constructor. It must -;;; install the lazy installer in the function cell of the constructor name, -;;; and also add this constructor to the list of constructors the class has. +;;; This is called to actually load a defconstructor constructor. It +;;; must install the lazy installer in the function cell of the +;;; constructor name, and also add this constructor to the list of +;;; constructors the class has. (defmethod load-constructor-internal ((class slot-class) name initargs generators) (let ((constructor (make-constructor class name initargs generators)) @@ -275,21 +277,23 @@ (apply constructor args))) 'lazy))) -;;; The interface to keeping the constructors updated. +;;; the interface to keeping the constructors updated ;;; -;;; add-method and remove-method (for standard-generic-function and -method), -;;; promise to call maybe-update-constructors on the generic function and -;;; the method. +;;; add-method and remove-method (for standard-generic-function and +;;; -method), promise to call maybe-update-constructors on the generic +;;; function and the method. ;;; -;;; The class update code promises to call update-constructors whenever the -;;; class is changed. That is, whenever the supers, slots or options change. -;;; If user defined classes of constructor needs to be updated in more than -;;; these circumstances, they should use the dependent updating mechanism to -;;; make sure update-constructors is called. +;;; The class update code promises to call update-constructors +;;; whenever the class is changed. That is, whenever the supers, slots +;;; or options change. If user defined classes of constructor needs to +;;; be updated in more than these circumstances, they should use the +;;; dependent updating mechanism to make sure update-constructors is +;;; called. ;;; -;;; Bootstrapping concerns force the definitions of maybe-update-constructors -;;; and update-constructors to be in the file std-class. For clarity, they -;;; also appear below. Be sure to keep the definition here and there in sync. +;;; Bootstrapping concerns force the definitions of +;;; maybe-update-constructors and update-constructors to be in the +;;; file std-class. For clarity, they also appear below. Be sure to +;;; keep the definition here and there in sync. ;(defvar *initialization-generic-functions* ; (list #'make-instance ; #'default-initargs diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index bdb2dd0..003f6d3 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -1505,7 +1505,7 @@ And so, we are saved. (let ((dfun (if early-p (or dfun (make-initial-dfun generic-function)) (compute-discriminating-function generic-function)))) - (set-funcallable-instance-function generic-function dfun) + (set-funcallable-instance-fun generic-function dfun) (set-function-name generic-function gf-name) (when (and ocache (not (eq ocache cache))) (free-cache ocache)) dfun))) diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 0fd9df5..584ff72 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -78,10 +78,10 @@ ;;; portable to other implementations of Common Lisp, all the ;;; funcallable instance wrapper logic here can go away in favor ;;; of direct calls to native SBCL funcallable instance operations. -(defun set-funcallable-instance-function (fin new-value) +(defun set-funcallable-instance-fun (fin new-value) (declare (type function new-value)) (aver (funcallable-instance-p fin)) - (setf (sb-kernel:funcallable-instance-function fin) new-value)) + (setf (sb-kernel:funcallable-instance-fun fin) new-value)) (defmacro fsc-instance-p (fin) `(funcallable-instance-p ,fin)) (defmacro fsc-instance-class (fin) @@ -189,8 +189,8 @@ ;; it loses some info of potential hacking value. So, ;; lets not do this... #+nil - (let ((header (sb-kernel:%closure-function fcn))) - (setf (sb-kernel:%function-name header) new-name)) + (let ((header (sb-kernel:%closure-fun fcn))) + (setf (sb-kernel:%simple-fun-name header) new-name)) ;; XXX Maybe add better scheme here someday. fcn))) diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index f4fca4f..9ba3364 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -1321,7 +1321,7 @@ ;;; argument , and returns a result , that result must not be ;;; passed to apply or funcall directly. Rather, must be stored as ;;; the funcallable instance function of the same generic function -;;; (using set-funcallable-instance-function). Then the generic function +;;; (using set-funcallable-instance-fun). Then the generic function ;;; can be passed to funcall or apply. ;;; ;;; An important exception is that methods on this generic function are @@ -1363,7 +1363,7 @@ ;;; #'(lambda (arg) ;;; (cond ( ;;; -;;; (set-funcallable-instance-function +;;; (set-funcallable-instance-fun ;;; gf ;;; (compute-discriminating-function gf)) ;;; (funcall gf arg)) @@ -1375,7 +1375,7 @@ ;;; (defmethod compute-discriminating-function ((gf my-generic-function)) ;;; #'(lambda (arg) ;;; (cond ( -;;; (set-funcallable-instance-function +;;; (set-funcallable-instance-fun ;;; gf ;;; #'(lambda (a) ..)) ;;; (funcall gf arg)) diff --git a/src/runtime/alpha-assem.S b/src/runtime/alpha-assem.S index a14d458..b2be715 100644 --- a/src/runtime/alpha-assem.S +++ b/src/runtime/alpha-assem.S @@ -85,8 +85,8 @@ call_into_lisp: lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer /* Indirect the closure */ - ldl reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV) - addl reg_CODE,6*4-type_FunctionPointer,reg_LIP + ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV) + addl reg_CODE,6*4-type_FunPointer, reg_LIP /* And into lisp we go. */ jsr reg_ZERO,(reg_LIP) @@ -276,9 +276,9 @@ undefined_tramp_offset: .ent closure_tramp_offset closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page closure_tramp_offset: - ldl reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN) - ldl reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV) - addl reg_L0, FUNCTION_CODE_OFFSET, reg_LIP + ldl reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN) + ldl reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV) + addl reg_L0, FUN_CODE_OFFSET, reg_LIP jmp reg_ZERO,(reg_LIP) .end closure_tramp diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index 7895597..e43f96d 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -72,8 +72,8 @@ code_pointer(lispobj object) case type_CodeHeader: break; case type_ReturnPcHeader: - case type_FunctionHeader: - case type_ClosureFunctionHeader: + case type_SimpleFunHeader: + case type_ClosureFunHeader: len = HEADER_LENGTH(header); if (len == 0) headerp = NULL; @@ -114,7 +114,7 @@ call_info_from_context(struct call_info *info, os_context_t *context) info->interrupted = 1; if (LowtagOf(*os_context_register_addr(context, reg_CODE)) - == type_FunctionPointer) { + == type_FunPointer) { /* We tried to call a function, but crapped out before $CODE could * be fixed up. Probably an undefined function. */ info->frame = @@ -215,10 +215,10 @@ backtrace(int nframes) function = ((struct code *)info.code)->entry_points; #endif while (function != NIL) { - struct function *header; + struct simple_fun *header; lispobj name; - header = (struct function *) native_pointer(function); + header = (struct simple_fun *) native_pointer(function); name = header->name; if (LowtagOf(name) == type_OtherPointer) { diff --git a/src/runtime/gc.c b/src/runtime/gc.c index fc0b7df..b335682 100644 --- a/src/runtime/gc.c +++ b/src/runtime/gc.c @@ -594,7 +594,7 @@ print_garbage(lispobj *from_space, lispobj *from_space_free_pointer) printf("Don't know about instances yet!\n"); nwords = 1; break; - case type_FunctionPointer: + case type_FunPointer: nwords = 1; break; case type_OtherPointer: @@ -620,13 +620,16 @@ print_garbage(lispobj *from_space, lispobj *from_space_free_pointer) /* code and code-related objects */ -#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) +/* FIXME: (1) Shouldn't this be defined in sbcl.h? (2) Shouldn't it + * be in the same units as FDEFN_RAW_ADDR_OFFSET? (This is measured + * in words, that's measured in bytes. Gotta love CMU CL..) */ +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunPointer) -static lispobj trans_function_header(lispobj object); +static lispobj trans_fun_header(lispobj object); static lispobj trans_boxed(lispobj object); static int -scav_function_pointer(lispobj *where, lispobj object) +scav_fun_pointer(lispobj *where, lispobj object) { lispobj *first_pointer; lispobj copy; @@ -645,9 +648,9 @@ scav_function_pointer(lispobj *where, lispobj object) type = TypeOf(first); switch (type) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_header(object); + case type_SimpleFunHeader: + case type_ClosureFunHeader: + copy = trans_fun_header(object); break; default: copy = trans_boxed(object); @@ -717,16 +720,16 @@ trans_code(struct code *code) prev_pointer = &new_code->entry_points; while (fheaderl != NIL) { - struct function *fheaderp, *nfheaderp; + struct simple_fun *fheaderp, *nfheaderp; lispobj nfheaderl; - fheaderp = (struct function *) native_pointer(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = (struct simple_fun *) native_pointer(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader); /* calcuate the new function pointer and the new */ /* function header */ nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) native_pointer(nfheaderl); + nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); /* set forwarding pointer */ #ifdef DEBUG_CODE_GC @@ -757,7 +760,7 @@ scav_code_header(lispobj *where, lispobj object) struct code *code; int nheader_words, ncode_words, nwords; lispobj fheaderl; - struct function *fheaderp; + struct simple_fun *fheaderp; code = (struct code *) where; ncode_words = fixnum_value(code->code_size); @@ -780,8 +783,8 @@ scav_code_header(lispobj *where, lispobj object) /* code data block */ fheaderl = code->entry_points; while (fheaderl != NIL) { - fheaderp = (struct function *) native_pointer(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = (struct simple_fun *) native_pointer(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader); #if defined(DEBUG_CODE_GC) printf("Scavenging boxed section of entry point located at 0x%08x.\n", @@ -836,11 +839,11 @@ scav_return_pc_header(lispobj *where, lispobj object) static lispobj trans_return_pc_header(lispobj object) { - struct function *return_pc; + struct simple_fun *return_pc; unsigned long offset; struct code *code, *ncode; lispobj ret; - return_pc = (struct function *) native_pointer(object); + return_pc = (struct simple_fun *) native_pointer(object); offset = HeaderValue(return_pc->header) * 4 ; /* Transport the whole code object */ @@ -873,7 +876,7 @@ lispobj *where, object; lispobj fun; closure = (struct closure *)where; - fun = closure->function - RAW_ADDR_OFFSET; + fun = closure->fun - FUN_RAW_ADDR_OFFSET; scavenge(&fun, 1); return 2; @@ -881,7 +884,7 @@ lispobj *where, object; #endif static int -scav_function_header(lispobj *where, lispobj object) +scav_fun_header(lispobj *where, lispobj object) { fprintf(stderr, "GC lossage. Should not be scavenging a "); fprintf(stderr, "Function Header.\n"); @@ -892,20 +895,20 @@ scav_function_header(lispobj *where, lispobj object) } static lispobj -trans_function_header(lispobj object) +trans_fun_header(lispobj object) { - struct function *fheader; + struct simple_fun *fheader; unsigned long offset; struct code *code, *ncode; - fheader = (struct function *) native_pointer(object); + fheader = (struct simple_fun *) native_pointer(object); offset = HeaderValue(fheader->header) * 4; /* Transport the whole code object */ code = (struct code *) ((unsigned long) fheader - offset); ncode = trans_code(code); - return ((lispobj) LOW_WORD(ncode) + offset) | type_FunctionPointer; + return ((lispobj) LOW_WORD(ncode) + offset) | type_FunPointer; } @@ -1094,10 +1097,11 @@ scav_fdefn(lispobj *where, lispobj object) fdefn = (struct fdefn *)where; - if ((char *)(fdefn->function + RAW_ADDR_OFFSET) + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == (char *)((unsigned long)(fdefn->raw_addr))) { scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); - fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET; + fdefn->raw_addr = + (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET; return sizeof(struct fdefn) / sizeof(lispobj); } else @@ -1898,7 +1902,7 @@ gc_init(void) for (i = 0; i < 32; i++) { scavtab[type_EvenFixnum|(i<<3)] = scav_immediate; - scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer; + scavtab[type_FunPointer|(i<<3)] = scav_fun_pointer; /* OtherImmediate0 */ scavtab[type_ListPointer|(i<<3)] = scav_list_pointer; scavtab[type_OddFixnum|(i<<3)] = scav_immediate; @@ -1964,8 +1968,8 @@ gc_init(void) scavtab[type_ComplexVector] = scav_boxed; scavtab[type_ComplexArray] = scav_boxed; scavtab[type_CodeHeader] = scav_code_header; - scavtab[type_FunctionHeader] = scav_function_header; - scavtab[type_ClosureFunctionHeader] = scav_function_header; + scavtab[type_SimpleFunHeader] = scav_fun_header; + scavtab[type_ClosureFunHeader] = scav_fun_header; scavtab[type_ReturnPcHeader] = scav_return_pc_header; #ifdef __i386__ scavtab[type_ClosureHeader] = scav_closure_header; @@ -2048,8 +2052,8 @@ gc_init(void) transother[type_ComplexVector] = trans_boxed; transother[type_ComplexArray] = trans_boxed; transother[type_CodeHeader] = trans_code_header; - transother[type_FunctionHeader] = trans_function_header; - transother[type_ClosureFunctionHeader] = trans_function_header; + transother[type_SimpleFunHeader] = trans_fun_header; + transother[type_ClosureFunHeader] = trans_fun_header; transother[type_ReturnPcHeader] = trans_return_pc_header; transother[type_ClosureHeader] = trans_boxed; transother[type_FuncallableInstanceHeader] = trans_boxed; @@ -2069,7 +2073,7 @@ gc_init(void) for (i = 0; i < 32; i++) { sizetab[type_EvenFixnum|(i<<3)] = size_immediate; - sizetab[type_FunctionPointer|(i<<3)] = size_pointer; + sizetab[type_FunPointer|(i<<3)] = size_pointer; /* OtherImmediate0 */ sizetab[type_ListPointer|(i<<3)] = size_pointer; sizetab[type_OddFixnum|(i<<3)] = size_immediate; @@ -2137,8 +2141,8 @@ gc_init(void) sizetab[type_CodeHeader] = size_code_header; #if 0 /* Shouldn't see these so just lose if it happens */ - sizetab[type_FunctionHeader] = size_function_header; - sizetab[type_ClosureFunctionHeader] = size_function_header; + sizetab[type_SimpleFunHeader] = size_function_header; + sizetab[type_ClosureFunHeader] = size_function_header; sizetab[type_ReturnPcHeader] = size_return_pc_header; #endif sizetab[type_ClosureHeader] = size_boxed; diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index b7f9cbb..ea775b1 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -1793,13 +1793,16 @@ scavenge(lispobj *start, long n_words) * code and code-related objects */ -#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) +/* FIXME: (1) Shouldn't this be defined in sbcl.h? (2) Shouldn't it + * be in the same units as FDEFN_RAW_ADDR_OFFSET? (This is measured + * in words, that's measured in bytes. Gotta love CMU CL..) */ +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunPointer) -static lispobj trans_function_header(lispobj object); +static lispobj trans_fun_header(lispobj object); static lispobj trans_boxed(lispobj object); static int -scav_function_pointer(lispobj *where, lispobj object) +scav_fun_pointer(lispobj *where, lispobj object) { lispobj *first_pointer; lispobj copy; @@ -1813,9 +1816,9 @@ scav_function_pointer(lispobj *where, lispobj object) * header, a closure function header, or to a closure header. */ switch (TypeOf(*first_pointer)) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_header(object); + case type_SimpleFunHeader: + case type_ClosureFunHeader: + copy = trans_fun_header(object); break; default: copy = trans_boxed(object); @@ -2166,23 +2169,23 @@ trans_code(struct code *code) prev_pointer = &new_code->entry_points; while (fheaderl != NIL) { - struct function *fheaderp, *nfheaderp; + struct simple_fun *fheaderp, *nfheaderp; lispobj nfheaderl; - fheaderp = (struct function *) native_pointer(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = (struct simple_fun *) native_pointer(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader); /* Calculate the new function pointer and the new */ /* function header. */ nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) native_pointer(nfheaderl); + nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); /* Set forwarding pointer. */ ((lispobj *)fheaderp)[0] = 0x01; ((lispobj *)fheaderp)[1] = nfheaderl; /* Fix self pointer. */ - nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET; + nfheaderp->self = nfheaderl + FUN_RAW_ADDR_OFFSET; *prev_pointer = nfheaderl; @@ -2202,7 +2205,7 @@ scav_code_header(lispobj *where, lispobj object) struct code *code; int n_header_words, n_code_words, n_words; lispobj entry_point; /* tagged pointer to entry point */ - struct function *function_ptr; /* untagged pointer to entry point */ + struct simple_fun *function_ptr; /* untagged pointer to entry point */ code = (struct code *) where; n_code_words = fixnum_value(code->code_size); @@ -2221,8 +2224,8 @@ scav_code_header(lispobj *where, lispobj object) gc_assert(is_lisp_pointer(entry_point)); - function_ptr = (struct function *) native_pointer(entry_point); - gc_assert(TypeOf(function_ptr->header) == type_FunctionHeader); + function_ptr = (struct simple_fun *) native_pointer(entry_point); + gc_assert(TypeOf(function_ptr->header) == type_SimpleFunHeader); scavenge(&function_ptr->name, 1); scavenge(&function_ptr->arglist, 1); @@ -2269,13 +2272,13 @@ scav_return_pc_header(lispobj *where, lispobj object) static lispobj trans_return_pc_header(lispobj object) { - struct function *return_pc; + struct simple_fun *return_pc; unsigned long offset; struct code *code, *ncode; SHOW("/trans_return_pc_header: Will this work?"); - return_pc = (struct function *) native_pointer(object); + return_pc = (struct simple_fun *) native_pointer(object); offset = HeaderValue(return_pc->header) * 4; /* Transport the whole code object. */ @@ -2295,19 +2298,19 @@ scav_closure_header(lispobj *where, lispobj object) lispobj fun; closure = (struct closure *)where; - fun = closure->function - RAW_ADDR_OFFSET; + fun = closure->fun - FUN_RAW_ADDR_OFFSET; scavenge(&fun, 1); /* The function may have moved so update the raw address. But * don't write unnecessarily. */ - if (closure->function != fun + RAW_ADDR_OFFSET) - closure->function = fun + RAW_ADDR_OFFSET; + if (closure->fun != fun + FUN_RAW_ADDR_OFFSET) + closure->fun = fun + FUN_RAW_ADDR_OFFSET; return 2; } #endif static int -scav_function_header(lispobj *where, lispobj object) +scav_fun_header(lispobj *where, lispobj object) { lose("attempted to scavenge a function header where=0x%08x object=0x%08x", (unsigned long) where, @@ -2316,20 +2319,20 @@ scav_function_header(lispobj *where, lispobj object) } static lispobj -trans_function_header(lispobj object) +trans_fun_header(lispobj object) { - struct function *fheader; + struct simple_fun *fheader; unsigned long offset; struct code *code, *ncode; - fheader = (struct function *) native_pointer(object); + fheader = (struct simple_fun *) native_pointer(object); offset = HeaderValue(fheader->header) * 4; /* Transport the whole code object. */ code = (struct code *) ((unsigned long) fheader - offset); ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_FunctionPointer; + return ((lispobj) ncode + offset) | type_FunPointer; } /* @@ -2562,14 +2565,14 @@ scav_fdefn(lispobj *where, lispobj object) fdefn = (struct fdefn *)where; /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n", - fdefn->function, fdefn->raw_addr)); */ + fdefn->fun, fdefn->raw_addr)); */ - if ((char *)(fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) { + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr) { scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); /* Don't write unnecessarily. */ - if (fdefn->raw_addr != (char *)(fdefn->function + RAW_ADDR_OFFSET)) - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); + if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)) + fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); return sizeof(struct fdefn) / sizeof(lispobj); } else { @@ -3570,7 +3573,7 @@ gc_init_tables(void) * possible value of the high 5 bits). */ for (i = 0; i < 32; i++) { /* FIXME: bare constant length, ick! */ scavtab[type_EvenFixnum|(i<<3)] = scav_immediate; - scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer; + scavtab[type_FunPointer|(i<<3)] = scav_fun_pointer; /* OtherImmediate0 */ scavtab[type_ListPointer|(i<<3)] = scav_list_pointer; scavtab[type_OddFixnum|(i<<3)] = scav_immediate; @@ -3638,8 +3641,8 @@ gc_init_tables(void) scavtab[type_ComplexVector] = scav_boxed; scavtab[type_ComplexArray] = scav_boxed; scavtab[type_CodeHeader] = scav_code_header; - /*scavtab[type_FunctionHeader] = scav_function_header;*/ - /*scavtab[type_ClosureFunctionHeader] = scav_function_header;*/ + /*scavtab[type_SimpleFunHeader] = scav_fun_header;*/ + /*scavtab[type_ClosureFunHeader] = scav_fun_header;*/ /*scavtab[type_ReturnPcHeader] = scav_return_pc_header;*/ #ifdef __i386__ scavtab[type_ClosureHeader] = scav_closure_header; @@ -3717,8 +3720,8 @@ gc_init_tables(void) transother[type_ComplexVector] = trans_boxed; transother[type_ComplexArray] = trans_boxed; transother[type_CodeHeader] = trans_code_header; - transother[type_FunctionHeader] = trans_function_header; - transother[type_ClosureFunctionHeader] = trans_function_header; + transother[type_SimpleFunHeader] = trans_fun_header; + transother[type_ClosureFunHeader] = trans_fun_header; transother[type_ReturnPcHeader] = trans_return_pc_header; transother[type_ClosureHeader] = trans_boxed; transother[type_FuncallableInstanceHeader] = trans_boxed; @@ -3736,7 +3739,7 @@ gc_init_tables(void) sizetab[i] = size_lose; for (i = 0; i < 32; i++) { sizetab[type_EvenFixnum|(i<<3)] = size_immediate; - sizetab[type_FunctionPointer|(i<<3)] = size_pointer; + sizetab[type_FunPointer|(i<<3)] = size_pointer; /* OtherImmediate0 */ sizetab[type_ListPointer|(i<<3)] = size_pointer; sizetab[type_OddFixnum|(i<<3)] = size_immediate; @@ -3803,8 +3806,8 @@ gc_init_tables(void) sizetab[type_CodeHeader] = size_code_header; #if 0 /* We shouldn't see these, so just lose if it happens. */ - sizetab[type_FunctionHeader] = size_function_header; - sizetab[type_ClosureFunctionHeader] = size_function_header; + sizetab[type_SimpleFunHeader] = size_function_header; + sizetab[type_ClosureFunHeader] = size_function_header; sizetab[type_ReturnPcHeader] = size_return_pc_header; #endif sizetab[type_ClosureHeader] = size_boxed; @@ -3934,7 +3937,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) * and returning true from this function when *pointer is * a reference to that result. */ switch (LowtagOf((lispobj)pointer)) { - case type_FunctionPointer: + case type_FunPointer: /* Start_addr should be the enclosing code object, or a closure * header. */ switch (TypeOf(*start_addr)) { @@ -3944,7 +3947,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) case type_ClosureHeader: case type_FuncallableInstanceHeader: if ((unsigned)pointer != - ((unsigned)start_addr+type_FunctionPointer)) { + ((unsigned)start_addr+type_FunPointer)) { if (gencgc_verbose) FSHOW((stderr, "/Wf2: %x %x %x\n", @@ -5073,7 +5076,7 @@ verify_space(lispobj *start, size_t words) struct code *code; int nheader_words, ncode_words, nwords; lispobj fheaderl; - struct function *fheaderp; + struct simple_fun *fheaderp; code = (struct code *) start; @@ -5109,8 +5112,9 @@ verify_space(lispobj *start, size_t words) * the code data block. */ fheaderl = code->entry_points; while (fheaderl != NIL) { - fheaderp = (struct function *) native_pointer(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = + (struct simple_fun *) native_pointer(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_SimpleFunHeader); verify_space(&fheaderp->name, 1); verify_space(&fheaderp->arglist, 1); verify_space(&fheaderp->type, 1); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index c516822..590050a 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -141,7 +141,7 @@ fake_foreign_function_call(os_context_t *context) /* There is a small window during call where the callee's * frame isn't built yet. */ if (LowtagOf(*os_context_register_addr(context, reg_CODE)) - == type_FunctionPointer) { + == type_FunPointer) { /* We have called, but not built the new frame, so * build it for them. */ current_control_frame_pointer[0] = @@ -391,7 +391,7 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) * support decides to pass on it. */ lose("no handler for signal %d in interrupt_handle_now(..)", signal); - } else if (LowtagOf(handler.lisp) == type_FunctionPointer) { + } else if (LowtagOf(handler.lisp) == type_FunPointer) { /* Allocate the SAPs while the interrupts are still disabled. * (FIXME: Why? This is the way it was done in CMU CL, and it diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index 72d3104..f8a0778 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -246,14 +246,16 @@ search_cmd(char **ptr) obj = *end; addr = end; end += 2; - if (TypeOf(obj) == type_FunctionHeader) - print((long)addr | type_FunctionPointer); - else if (LowtagOf(obj) == type_OtherImmediate0 || LowtagOf(obj) == type_OtherImmediate1) + if (TypeOf(obj) == type_SimpleFunHeader) { + print((long)addr | type_FunPointer); + } else if (LowtagOf(obj) == type_OtherImmediate0 || + LowtagOf(obj) == type_OtherImmediate1) { print((lispobj)addr | type_OtherPointer); - else + } else { print((lispobj)addr); - if (count == -1) + } if (count == -1) { return; + } } } @@ -279,7 +281,7 @@ call_cmd(char **ptr) case type_Fdefn: fdefn: - function = FDEFN(thing)->function; + function = FDEFN(thing)->fun; if (function == NIL) { printf("Fdefn 0x%08lx is undefined.\n", (long unsigned)thing); return; @@ -292,7 +294,7 @@ call_cmd(char **ptr) return; } } - else if (LowtagOf(thing) != type_FunctionPointer) { + else if (LowtagOf(thing) != type_FunPointer) { printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n", (long unsigned)thing); return; diff --git a/src/runtime/print.c b/src/runtime/print.c index 485948f..525f250 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -594,8 +594,8 @@ static void print_otherptr(lispobj obj) print_slots(code_slots, count-1, ptr); break; - case type_FunctionHeader: - case type_ClosureFunctionHeader: + case type_SimpleFunHeader: + case type_ClosureFunHeader: print_slots(fn_slots, 5, ptr); break; @@ -665,7 +665,9 @@ static void print_obj(char *prefix, lispobj obj) if (var != NULL && var_clock(var) == cur_clock) dont_descend = 1; - if (var == NULL && (obj & type_FunctionPointer & type_ListPointer & type_InstancePointer & type_OtherPointer) != 0) + if (var == NULL && + /* FIXME: What does this "x & y & z & .." expression mean? */ + (obj & type_FunPointer & type_ListPointer & type_InstancePointer & type_OtherPointer) != 0) var = define_var(NULL, obj, 0); if (var != NULL) diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 9bc7515..a24767f 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -75,10 +75,13 @@ static int later_count = 0; #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) #define NWORDS(x,y) (CEILING((x),(y)) / (y)) +/* FIXME: (1) Shouldn't this be defined in sbcl.h? (2) Shouldn't it + * be in the same units as FDEFN_RAW_ADDR_OFFSET? (This is measured + * in words, that's measured in bytes. Gotta love CMU CL..) */ #ifdef sparc -#define RAW_ADDR_OFFSET 0 +#define FUN_RAW_ADDR_OFFSET 0 #else -#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunPointer) #endif static boolean @@ -147,7 +150,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) /* Check that the object pointed to is consistent with the pointer * low tag. */ switch (LowtagOf((lispobj)pointer)) { - case type_FunctionPointer: + case type_FunPointer: /* Start_addr should be the enclosing code object, or a closure * header. */ switch (TypeOf(*start_addr)) { @@ -156,7 +159,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) break; case type_ClosureHeader: case type_FuncallableInstanceHeader: - if ((int)pointer != ((int)start_addr+type_FunctionPointer)) { + if ((int)pointer != ((int)start_addr+type_FunPointer)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -544,10 +547,10 @@ ptrans_fdefn(lispobj thing, lispobj header) /* Scavenge the function. */ fdefn = (struct fdefn *)new; - oldfn = fdefn->function; - pscav(&fdefn->function, 1, 0); - if ((char *)oldfn + RAW_ADDR_OFFSET == fdefn->raw_addr) - fdefn->raw_addr = (char *)fdefn->function + RAW_ADDR_OFFSET; + oldfn = fdefn->fun; + pscav(&fdefn->fun, 1, 0); + if ((char *)oldfn + FUN_RAW_ADDR_OFFSET == fdefn->raw_addr) + fdefn->raw_addr = (char *)fdefn->fun + FUN_RAW_ADDR_OFFSET; return result; } @@ -714,9 +717,9 @@ ptrans_code(lispobj thing) /* Put in forwarding pointers for all the functions. */ for (func = code->entry_points; func != NIL; - func = ((struct function *)native_pointer(func))->next) { + func = ((struct simple_fun *)native_pointer(func))->next) { - gc_assert(LowtagOf(func) == type_FunctionPointer); + gc_assert(LowtagOf(func) == type_FunPointer); *(lispobj *)native_pointer(func) = result + (func - thing); } @@ -738,20 +741,21 @@ ptrans_code(lispobj thing) pscav(&new->entry_points, 1, 1); for (func = new->entry_points; func != NIL; - func = ((struct function *)native_pointer(func))->next) { - gc_assert(LowtagOf(func) == type_FunctionPointer); + func = ((struct simple_fun *)native_pointer(func))->next) { + gc_assert(LowtagOf(func) == type_FunPointer); gc_assert(!dynamic_pointer_p(func)); #ifdef __i386__ - /* Temporarly convert the self pointer to a real function - pointer. */ - ((struct function *)native_pointer(func))->self -= RAW_ADDR_OFFSET; + /* Temporarly convert the self pointer to a real function pointer. */ + ((struct simple_fun *)native_pointer(func))->self + -= FUN_RAW_ADDR_OFFSET; #endif - pscav(&((struct function *)native_pointer(func))->self, 2, 1); + pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); #ifdef __i386__ - ((struct function *)native_pointer(func))->self += RAW_ADDR_OFFSET; + ((struct simple_fun *)native_pointer(func))->self + += FUN_RAW_ADDR_OFFSET; #endif - pscav_later(&((struct function *)native_pointer(func))->name, 3); + pscav_later(&((struct simple_fun *)native_pointer(func))->name, 3); } return result; @@ -762,7 +766,7 @@ ptrans_func(lispobj thing, lispobj header) { int nwords; lispobj code, *new, *old, result; - struct function *function; + struct simple_fun *function; /* Thing can either be a function header, a closure function * header, a closure, or a funcallable-instance. If it's a closure @@ -770,14 +774,14 @@ ptrans_func(lispobj thing, lispobj header) * Otherwise we have to do something strange, 'cause it is buried * inside a code object. */ - if (TypeOf(header) == type_FunctionHeader || - TypeOf(header) == type_ClosureFunctionHeader) { + if (TypeOf(header) == type_SimpleFunHeader || + TypeOf(header) == type_ClosureFunHeader) { /* We can only end up here if the code object has not been * scavenged, because if it had been scavenged, forwarding pointers * would have been left behind for all the entry points. */ - function = (struct function *)native_pointer(thing); + function = (struct simple_fun *)native_pointer(thing); code = (native_pointer(thing) - (HeaderValue(function->header)*sizeof(lispobj))) | @@ -1014,11 +1018,11 @@ pscav_fdefn(struct fdefn *fdefn) { boolean fix_func; - fix_func = ((char *)(fdefn->function+RAW_ADDR_OFFSET) == fdefn->raw_addr); + fix_func = ((char *)(fdefn->fun+FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr); pscav(&fdefn->name, 1, 1); - pscav(&fdefn->function, 1, 0); + pscav(&fdefn->fun, 1, 0); if (fix_func) - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); + fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); return sizeof(struct fdefn) / sizeof(lispobj); } @@ -1041,20 +1045,22 @@ pscav_code(struct code*code) pscav(&code->entry_points, 1, 1); for (func = code->entry_points; func != NIL; - func = ((struct function *)native_pointer(func))->next) { - gc_assert(LowtagOf(func) == type_FunctionPointer); + func = ((struct simple_fun *)native_pointer(func))->next) { + gc_assert(LowtagOf(func) == type_FunPointer); gc_assert(!dynamic_pointer_p(func)); #ifdef __i386__ /* Temporarly convert the self pointer to a real function * pointer. */ - ((struct function *)native_pointer(func))->self -= RAW_ADDR_OFFSET; + ((struct simple_fun *)native_pointer(func))->self + -= FUN_RAW_ADDR_OFFSET; #endif - pscav(&((struct function *)native_pointer(func))->self, 2, 1); + pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); #ifdef __i386__ - ((struct function *)native_pointer(func))->self += RAW_ADDR_OFFSET; + ((struct simple_fun *)native_pointer(func))->self + += FUN_RAW_ADDR_OFFSET; #endif - pscav_later(&((struct function *)native_pointer(func))->name, 3); + pscav_later(&((struct simple_fun *)native_pointer(func))->name, 3); } return CEILING(nwords,2); @@ -1082,7 +1088,7 @@ pscav(lispobj *addr, int nwords, boolean constant) else { /* Nope, copy the object. */ switch (LowtagOf(thing)) { - case type_FunctionPointer: + case type_FunPointer: thing = ptrans_func(thing, header); break; @@ -1228,8 +1234,8 @@ pscav(lispobj *addr, int nwords, boolean constant) #endif break; - case type_FunctionHeader: - case type_ClosureFunctionHeader: + case type_SimpleFunHeader: + case type_ClosureFunHeader: case type_ReturnPcHeader: /* We should never hit any of these, 'cause they occur * buried in the middle of code objects. */ @@ -1242,10 +1248,10 @@ pscav(lispobj *addr, int nwords, boolean constant) /* The function self pointer needs special care on the * x86 because it is the real entry point. */ { - lispobj fun = ((struct closure *)addr)->function - - RAW_ADDR_OFFSET; + lispobj fun = ((struct closure *)addr)->fun + - FUN_RAW_ADDR_OFFSET; pscav(&fun, 1, constant); - ((struct closure *)addr)->function = fun + RAW_ADDR_OFFSET; + ((struct closure *)addr)->fun = fun + FUN_RAW_ADDR_OFFSET; } count = 2; break; diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h index 8315ea1..4a5e8d4 100644 --- a/src/runtime/runtime.h +++ b/src/runtime/runtime.h @@ -109,7 +109,7 @@ typedef int boolean; /* This only works for static symbols. */ /* FIXME: should be called StaticSymbolFunction, right? */ #define SymbolFunction(sym) \ - (((struct fdefn *)(SymbolValue(sym)-type_OtherPointer))->function) + (((struct fdefn *)(SymbolValue(sym)-type_OtherPointer))->fun) /* KLUDGE: As far as I can tell there's no ANSI C way of saying * "this function never returns". This is the way that you do it diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index b881daa..31ae91e 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -208,7 +208,7 @@ Ldone: mov %ebx,%ebp # Switch to new frame. /* Indirect the closure. */ - call *CLOSURE_FUNCTION_OFFSET(%eax) + call *CLOSURE_FUN_OFFSET(%eax) /* Multi-value return; blow off any extra values. */ mov %ebx, %esp @@ -279,14 +279,14 @@ GNAME(undefined_tramp): .global GNAME(closure_tramp) .type GNAME(closure_tramp),@function GNAME(closure_tramp): - movl FDEFN_FUNCTION_OFFSET(%eax),%eax + movl FDEFN_FUN_OFFSET(%eax),%eax /* FIXME: The '*' after "jmp" in the next line is from PVE's * patch posted to the CMU CL mailing list Oct 6, 1999. It looks * reasonable, and it certainly seems as though if CMU CL needs it, * SBCL needs it too, but I haven't actually verified that it's * right. It would be good to find a way to force the flow of * control through here to test it. */ - jmp *CLOSURE_FUNCTION_OFFSET(%eax) + jmp *CLOSURE_FUN_OFFSET(%eax) .size GNAME(closure_tramp), .-GNAME(closure_tramp) /* diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 8c163b8..e0b04f9 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -20,22 +20,21 @@ (defvar *public-package-names* '("SB-ALIEN" "SB-C-CALL" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-MP" "SB-PROFILE" "SB-PCL" "COMMON-LISP")) -(defun has-arglist-info-p (function) - (declare (type function function)) +(defun has-arglist-info-p (fun) + (declare (type function fun)) ;; The Lisp-level type FUNCTION can conceal a multitude of sins.. - (case (sb-kernel:get-type function) - ((#.sb-vm:function-header-type #.sb-vm:closure-function-header-type) - (sb-kernel:%function-arglist function)) + (case (sb-kernel:get-type fun) + ((#.sb-vm:simple-fun-header-type #.sb-vm:closure-fun-header-type) + (sb-kernel:%simple-fun-arglist fun)) (#.sb-vm:closure-header-type (has-arglist-info-p - (sb-kernel:%closure-function - function))) + (sb-kernel:%closure-fun fun))) ;; In code/describe.lisp, ll. 227 (%describe-function), we use a scheme ;; like above, and it seems to work. -- MNA 2001-06-12 ;; ;; (There might be other cases with arglist info also. - ;; FUNCTION-HEADER-TYPE and CLOSURE-HEADER-TYPE just + ;; SIMPLE-FUN-HEADER-TYPE and CLOSURE-HEADER-TYPE just ;; happen to be the two case that I had my nose rubbed in when - ;; debugging a GC problem caused by applying %FUNCTION-ARGLIST to + ;; debugging a GC problem caused by applying %SIMPLE-FUN-ARGLIST to ;; a closure. -- WHN 2001-06-05) (t nil))) (defun check-ext-symbols-arglist (package) diff --git a/version.lisp-expr b/version.lisp-expr index de792ec..9ac5126 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.54" +"0.pre7.55" -- 1.7.10.4