From 9c9c68bd6e5e3c6d02e9f1bfd583b87bb9e85eea Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Fri, 10 Oct 2003 07:33:32 +0000 Subject: [PATCH] 0.8.4.17: * Remove CLOSURE-FUN-HEADER-WIDETAG; preserve its number for some time in order to keep FASL compatibility. --- src/code/debug-int.lisp | 3 +-- src/code/defmacro.lisp | 3 +-- src/code/describe.lisp | 2 +- src/code/macros.lisp | 3 +-- src/code/target-misc.lisp | 6 ++---- src/compiler/generic/early-objdef.lisp | 2 +- src/compiler/generic/early-type-vops.lisp | 1 - src/runtime/backtrace.c | 1 - src/runtime/gc-common.c | 4 ---- src/runtime/print.c | 1 - src/runtime/purify.c | 4 +--- tests/debug.impure.lisp | 2 +- version.lisp-expr | 2 +- 13 files changed, 10 insertions(+), 24 deletions(-) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 76aaea4..d05a3da 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -1190,8 +1190,7 @@ (fun-debug-fun (%closure-fun fun))) (#.sb!vm:funcallable-instance-header-widetag (fun-debug-fun (funcallable-instance-fun fun))) - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag (let* ((name (%simple-fun-name fun)) (component (fun-code-header fun)) (res (find-if diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp index a68fb37..edbc93c 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -92,8 +92,7 @@ lambda-list (%simple-fun-name (%closure-fun definition)) debug-name)) - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag (setf (%simple-fun-arglist definition) lambda-list (%simple-fun-name definition) debug-name)))) name)))) diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 5fe79b8..ca2ab73 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -219,7 +219,7 @@ (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:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag) + (#.sb-vm:simple-fun-header-widetag (%describe-fun-compiled x s kind name)) (#.sb-vm:funcallable-instance-header-widetag ;; Only STANDARD-GENERIC-FUNCTION would be handled here, but diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 4ef3dc0..feb191c 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -168,8 +168,7 @@ lambda-list (%simple-fun-name (%closure-fun definition)) debug-name)) - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag (setf (%simple-fun-arglist definition) lambda-list (%simple-fun-name definition) debug-name)))) name)))) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 37bb400..8c798e2 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -54,8 +54,7 @@ (case (widetag-of fun) (#.sb!vm:closure-header-widetag (%simple-fun-name (%closure-fun fun))) - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag ;; KLUDGE: The pun that %SIMPLE-FUN-NAME is used for closure ;; functions is left over from CMU CL (modulo various renaming ;; that's gone on since the fork). @@ -68,8 +67,7 @@ (aver nil) ; since this is unsafe 'til bug 137 is fixed (let ((widetag (widetag-of fun))) (case widetag - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.sb!vm:simple-fun-header-widetag ;; KLUDGE: The pun that %SIMPLE-FUN-NAME is used for closure ;; functions is left over from CMU CL (modulo various renaming ;; that's gone on since the fork). diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index 25c1e0f..f639f6c 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -105,7 +105,7 @@ simple-fun-header closure-header funcallable-instance-header - closure-fun-header + nil ; this was closure-fun-header; remove when +FASL-FILE-VERSION+ will increase return-pc-header value-cell-header diff --git a/src/compiler/generic/early-type-vops.lisp b/src/compiler/generic/early-type-vops.lisp index fff6768..06d21b3 100644 --- a/src/compiler/generic/early-type-vops.lisp +++ b/src/compiler/generic/early-type-vops.lisp @@ -16,7 +16,6 @@ (defparameter *fun-header-widetags* (list funcallable-instance-header-widetag simple-fun-header-widetag - closure-fun-header-widetag closure-header-widetag)) (defun canonicalize-headers (headers) diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index 2b78c6a..c4840cc 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -79,7 +79,6 @@ code_pointer(lispobj object) break; case RETURN_PC_HEADER_WIDETAG: case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: len = HEADER_LENGTH(header); if (len == 0) headerp = NULL; diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 04096e8..acbadae 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -233,7 +233,6 @@ scav_fun_pointer(lispobj *where, lispobj object) switch (widetag_of(*first_pointer)) { case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: copy = trans_fun_header(object); break; default: @@ -1590,7 +1589,6 @@ gc_init_tables(void) scavtab[CODE_HEADER_WIDETAG] = scav_code_header; #ifndef LISP_FEATURE_GENCGC /* FIXME ..._X86 ? */ scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header; - scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header; scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header; #endif #ifdef LISP_FEATURE_X86 @@ -1698,7 +1696,6 @@ gc_init_tables(void) transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed; transother[CODE_HEADER_WIDETAG] = trans_code_header; transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header; - transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header; transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header; transother[CLOSURE_HEADER_WIDETAG] = trans_boxed; transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed; @@ -1805,7 +1802,6 @@ gc_init_tables(void) #if 0 /* We shouldn't see these, so just lose if it happens. */ sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header; - sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header; sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header; #endif sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed; diff --git a/src/runtime/print.c b/src/runtime/print.c index bdfbfda..6e6dd12 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -610,7 +610,6 @@ static void print_otherptr(lispobj obj) break; case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: print_slots(fn_slots, 5, ptr); break; diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 15f54eb..b7b6ecd 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -787,8 +787,7 @@ ptrans_func(lispobj thing, lispobj header) * Otherwise we have to do something strange, 'cause it is buried * inside a code object. */ - if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG || - widetag_of(header) == CLOSURE_FUN_HEADER_WIDETAG) { + if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG) { /* We can only end up here if the code object has not been * scavenged, because if it had been scavenged, forwarding pointers @@ -1268,7 +1267,6 @@ pscav(lispobj *addr, int nwords, boolean constant) break; case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: case RETURN_PC_HEADER_WIDETAG: /* We should never hit any of these, 'cause they occur * buried in the middle of code objects. */ diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index f7dfab9..96916bb 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -23,7 +23,7 @@ (declare (type function fun)) ;; The Lisp-level type FUNCTION can conceal a multitude of sins.. (case (sb-kernel:widetag-of fun) - ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag) + (#.sb-vm:simple-fun-header-widetag (sb-kernel:%simple-fun-arglist fun)) (#.sb-vm:closure-header-widetag (get-arglist (sb-kernel:%closure-fun fun))) diff --git a/version.lisp-expr b/version.lisp-expr index 4fb6f34..e5d65fb 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.4.16" +"0.8.4.17" -- 1.7.10.4