From cf4cb9554515c59eddbde38d1cf236339c37f55f Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Tue, 10 Aug 2004 00:20:45 +0000 Subject: [PATCH] 0.8.13.47: The quest for a real 64-bit port continues: * add logic for 64-bit friendly specialized array types (although the appropriate getter and setter VOPs may not be written); * add widetags for the same and attempt to preserve binary compatibility by not moving around the widetags for existing 32-bit ports; * modify bits of the garbage collector to handle the same, mostly in scavenging and friends. The garbage collector has not been reviewed (yet) for 64-bit cleanness; * export symbols for 64-bit friendly specialized array types from appropriate packages (but note KLUDGE in package-data-list); * export several Lisp-determined constants in SB!VM to C-land. Since they are no longer hard-coded in the C source files, rearrange headers to #include sbcl.h as the first user-defined header to ensure constants are recognized in other header files; * remove 32-bit assumptions from NWORDS in the garbage collector and remove duplicate definitions from various places. --- package-data-list.lisp-expr | 51 +++++++++- src/code/class.lisp | 40 +++++++- src/compiler/generic/early-objdef.lisp | 26 ++++- src/compiler/generic/genesis.lisp | 47 ++++++--- src/compiler/generic/vm-array.lisp | 18 ++++ src/compiler/generic/vm-fndb.lisp | 18 +++- src/compiler/generic/vm-typetran.lisp | 17 ++++ src/runtime/Config.alpha-osf1 | 5 +- src/runtime/alloc.c | 1 - src/runtime/alloc.h | 1 + src/runtime/alpha-arch.c | 2 +- src/runtime/alpha-linux-os.c | 2 +- src/runtime/alpha-lispregs.h | 1 - src/runtime/alpha-osf1-os.c | 2 +- src/runtime/backtrace.c | 2 +- src/runtime/cheneygc.c | 4 +- src/runtime/core.h | 1 + src/runtime/dynbind.c | 2 +- src/runtime/gc-common.c | 167 ++++++++++++++++++++++++++------ src/runtime/gc-internal.h | 9 +- src/runtime/gencgc.c | 2 +- src/runtime/globals.c | 2 +- src/runtime/globals.h | 1 + src/runtime/hppa-arch.c | 2 +- src/runtime/hppa-linux-os.c | 2 +- src/runtime/mips-arch.c | 2 +- src/runtime/mips-linux-os.c | 2 +- src/runtime/monitor.c | 2 +- src/runtime/os.h | 1 + src/runtime/osf1-os.c | 2 +- src/runtime/parse.c | 2 +- src/runtime/ppc-linux-os.c | 2 +- src/runtime/print.c | 2 +- src/runtime/print.h | 1 + src/runtime/purify.c | 32 ++++-- src/runtime/runtime.h | 9 +- src/runtime/search.c | 2 +- src/runtime/sparc-arch.c | 2 +- src/runtime/sparc-linux-os.c | 2 +- src/runtime/sparc-sunos-os.c | 2 +- src/runtime/sunos-os.c | 2 +- src/runtime/thread.c | 17 ++-- src/runtime/time.c | 1 + src/runtime/wrap.c | 2 +- src/runtime/x86-arch.c | 2 +- version.lisp-expr | 2 +- 46 files changed, 411 insertions(+), 105 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 48ef986..b2a324b 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1278,15 +1278,38 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-15-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-16-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-2-ERROR" + ;; KLUDGE: 32-bit and 64-bit ports implement a + ;; different set of specialized array types. + ;; Various bits of code in SBCL assume that + ;; symbols connected to the specialized array + ;; types are exported. But there's not a good + ;; way at this point to know whether the port + ;; for which we're building is 32-bit or 64-bit. + ;; Granted, we could hardcode the particulars + ;; (or even come up with a special :64BIT feature), + ;; but that seems a little inelegant. For now, + ;; we brute-force the issue by always exporting + ;; all the names required for both 32-bit and 64-bit + ;; ports. Other bits connected to the same issue + ;; are noted throughout the code below with the + ;; tag "32/64-bit issues". --njf, 2004-08-09 "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-29-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-31-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-32-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-4-ERROR" + ;; FIXME: 32/64-bit issues + "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-60-ERROR" + "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-63-ERROR" + "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-64-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-7-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-8-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-16-ERROR" + ;; FIXME: 32/64-bit issues "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-30-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-32-ERROR" + ;; FIXME: 32/64-bit issues + "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-61-ERROR" + "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-64-ERROR" "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-8-ERROR" "OBJECT-NOT-SIMPLE-BIT-VECTOR-ERROR" "OBJECT-NOT-SIMPLE-BASE-STRING-ERROR" @@ -1329,15 +1352,23 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "SIMPLE-ARRAY-UNSIGNED-BYTE-15-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-2-P" + ;; FIXME: 32/64-bit issues "SIMPLE-ARRAY-UNSIGNED-BYTE-29-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-31-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-32-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-4-P" + ;; FIXME: 32/64-bit issues + "SIMPLE-ARRAY-UNSIGNED-BYTE-60-P" + "SIMPLE-ARRAY-UNSIGNED-BYTE-63-P" + "SIMPLE-ARRAY-UNSIGNED-BYTE-64-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-7-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-8-P" "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P" "SIMPLE-ARRAY-SIGNED-BYTE-32-P" + ;; FIXME: 32/64-bit issues + "SIMPLE-ARRAY-SIGNED-BYTE-61-P" + "SIMPLE-ARRAY-SIGNED-BYTE-64-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" "SIMPLE-BASE-STRING-P" "SIMPLE-PACKAGE-ERROR" @@ -2074,8 +2105,13 @@ structure representations" "OBJECT-NOT-LIST-TRAP" "OBJECT-NOT-INSTANCE-TRAP" "OCFP-SAVE-OFFSET" "ODD-FIXNUM-LOWTAG" - "OFFSET-STATIC-SYMBOL" "OTHER-IMMEDIATE-0-LOWTAG" - "OTHER-IMMEDIATE-1-LOWTAG" "OTHER-POINTER-LOWTAG" + "OFFSET-STATIC-SYMBOL" + "OTHER-IMMEDIATE-0-LOWTAG" + "OTHER-IMMEDIATE-1-LOWTAG" + ;; FIXME: 32/64-bit issues + "OTHER-IMMEDIATE-2-LOWTAG" + "OTHER-IMMEDIATE-3-LOWTAG" + "OTHER-POINTER-LOWTAG" "PAD-DATA-BLOCK" "PENDING-INTERRUPT-TRAP" "PRIMITIVE-OBJECT" "PRIMITIVE-OBJECT-WIDETAG" "PRIMITIVE-OBJECT-LOWTAG" "PRIMITIVE-OBJECT-NAME" @@ -2107,15 +2143,24 @@ structure representations" "SIMPLE-ARRAY-UNSIGNED-BYTE-15-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-2-WIDETAG" + ;; FIXME: 32/64-bit issues "SIMPLE-ARRAY-UNSIGNED-BYTE-29-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-31-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-32-WIDETAG" + ;; FIXME: 32/64-bit issues + "SIMPLE-ARRAY-UNSIGNED-BYTE-60-WIDETAG" + "SIMPLE-ARRAY-UNSIGNED-BYTE-63-WIDETAG" + "SIMPLE-ARRAY-UNSIGNED-BYTE-64-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-4-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-7-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-8-WIDETAG" "SIMPLE-ARRAY-SIGNED-BYTE-16-WIDETAG" - "SIMPLE-ARRAY-SIGNED-BYTE-30-WIDETAG" + ;; FIXME: 32/64-bit issues + "SIMPLE-ARRAY-SIGNED-BYTE-30-WIDETAG" "SIMPLE-ARRAY-SIGNED-BYTE-32-WIDETAG" + ;; FIXME: 32/64-bit issues + "SIMPLE-ARRAY-SIGNED-BYTE-61-WIDETAG" + "SIMPLE-ARRAY-SIGNED-BYTE-64-WIDETAG" "SIMPLE-ARRAY-SIGNED-BYTE-8-WIDETAG" "SIMPLE-BIT-VECTOR-WIDETAG" "SIMPLE-BASE-STRING-WIDETAG" diff --git a/src/code/class.lisp b/src/code/class.lisp index fd13983..6845b19 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1024,8 +1024,7 @@ :translation (and integer (not fixnum)) :inherits (integer rational real number) :codes (#.sb!vm:bignum-widetag) - ;; FIXME: wrong for 64-bit! - :prototype-form (expt 2 42)) + :prototype-form (expt 2 #.(* sb!vm:n-word-bits (/ 3 2)))) (array :translation array :codes (#.sb!vm:complex-array-widetag) :hierarchical-p nil @@ -1091,6 +1090,7 @@ :direct-superclasses (vector simple-array) :inherits (vector simple-array array sequence) :prototype-form (make-array 0 :element-type '(unsigned-byte 16))) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (simple-array-unsigned-byte-29 :translation (simple-array (unsigned-byte 29) (*)) :codes (#.sb!vm:simple-array-unsigned-byte-29-widetag) @@ -1109,6 +1109,27 @@ :direct-superclasses (vector simple-array) :inherits (vector simple-array array sequence) :prototype-form (make-array 0 :element-type '(unsigned-byte 32))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (simple-array-unsigned-byte-60 + :translation (simple-array (unsigned-byte 60) (*)) + :codes (#.sb!vm:simple-array-unsigned-byte-60-widetag) + :direct-superclasses (vector simple-array) + :inherits (vector simple-array array sequence) + :prototype-form (make-array 0 :element-type '(unsigned-byte 60))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (simple-array-unsigned-byte-63 + :translation (simple-array (unsigned-byte 63) (*)) + :codes (#.sb!vm:simple-array-unsigned-byte-63-widetag) + :direct-superclasses (vector simple-array) + :inherits (vector simple-array array sequence) + :prototype-form (make-array 0 :element-type '(unsigned-byte 63))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (simple-array-unsigned-byte-64 + :translation (simple-array (unsigned-byte 64) (*)) + :codes (#.sb!vm:simple-array-unsigned-byte-64-widetag) + :direct-superclasses (vector simple-array) + :inherits (vector simple-array array sequence) + :prototype-form (make-array 0 :element-type '(unsigned-byte 64))) (simple-array-signed-byte-8 :translation (simple-array (signed-byte 8) (*)) :codes (#.sb!vm:simple-array-signed-byte-8-widetag) @@ -1121,6 +1142,7 @@ :direct-superclasses (vector simple-array) :inherits (vector simple-array array sequence) :prototype-form (make-array 0 :element-type '(signed-byte 16))) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (simple-array-signed-byte-30 :translation (simple-array (signed-byte 30) (*)) :codes (#.sb!vm:simple-array-signed-byte-30-widetag) @@ -1133,6 +1155,20 @@ :direct-superclasses (vector simple-array) :inherits (vector simple-array array sequence) :prototype-form (make-array 0 :element-type '(signed-byte 32))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (simple-array-signed-byte-61 + :translation (simple-array (signed-byte 61) (*)) + :codes (#.sb!vm:simple-array-signed-byte-61-widetag) + :direct-superclasses (vector simple-array) + :inherits (vector simple-array array sequence) + :prototype-form (make-array 0 :element-type '(signed-byte 61))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (simple-array-signed-byte-64 + :translation (simple-array (signed-byte 64) (*)) + :codes (#.sb!vm:simple-array-signed-byte-64-widetag) + :direct-superclasses (vector simple-array) + :inherits (vector simple-array array sequence) + :prototype-form (make-array 0 :element-type '(signed-byte 64))) (simple-array-single-float :translation (simple-array single-float (*)) :codes (#.sb!vm:simple-array-single-float-widetag) diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index 090decb..a3ca7fb 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -110,8 +110,15 @@ ;;; ;;; rather than two separate tests and jumps (defenum (:suffix -widetag + ;; The first widetag must be greater than SB!VM:LOWTAG-LIMIT + ;; otherwise code in generic/early-type-vops will suffer + ;; a long, horrible death. --njf, 2004-08-09 :start (+ (ash 1 n-lowtag-bits) other-immediate-0-lowtag) :step 4) + ;; NOTE: the binary numbers off to the side are only valid for 32-bit + ;; ports; add #x1000 if you want to know the values for 64-bit ports. + ;; And note that the numbers get a little scrambled further down. + ;; --njf, 2004-08-09 bignum ; 00001010 ratio ; 00001110 single-float ; 00010010 @@ -146,8 +153,10 @@ unused07 ; 01110110 unused08 ; 01111010 unused09 ; 01111110 - + + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) unused10 ; 10000010 + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) unused11 ; 10000110 simple-array-unsigned-byte-2 ; 10001010 @@ -160,13 +169,25 @@ simple-base-string ; 10100110 simple-bit-vector ; 10101010 simple-vector ; 10101110 + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) simple-array-unsigned-byte-29 ; 10110010 simple-array-unsigned-byte-31 ; 10110110 simple-array-unsigned-byte-32 ; 10111010 + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-60 + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-63 + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-64 simple-array-signed-byte-8 ; 10111110 simple-array-signed-byte-16 ; 11000010 + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) simple-array-signed-byte-30 ; 11000110 simple-array-signed-byte-32 ; 11001010 + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-signed-byte-61 + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-signed-byte-64 simple-array-single-float ; 11001110 simple-array-double-float ; 11010010 simple-array-complex-single-float ; 11010110 @@ -178,8 +199,11 @@ complex-vector ; 11101110 complex-array ; 11110010 + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) unused12 ; 11110110 + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) unused13 ; 11111010 + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) unused14 ; 11111110 ) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index a5bbe1f..411f671 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -308,7 +308,11 @@ (- unsigned #x40000000) unsigned)))) ((or (= lowtag sb!vm:other-immediate-0-lowtag) - (= lowtag sb!vm:other-immediate-1-lowtag)) + (= lowtag sb!vm:other-immediate-1-lowtag) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (= lowtag sb!vm:other-immediate-2-lowtag) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (= lowtag sb!vm:other-immediate-3-lowtag)) (format stream "for other immediate: #X~X, type #b~8,'0B" (ash (descriptor-bits des) (- sb!vm:n-widetag-bits)) @@ -364,15 +368,15 @@ (defun descriptor-fixnum (des) (let ((bits (descriptor-bits des))) (if (logbitp (1- sb!vm:n-word-bits) bits) - ;; KLUDGE: The (- SB!VM:N-WORD-BITS 2) term here looks right to - ;; me, and it works, but in CMU CL it was (1- SB!VM:N-WORD-BITS), - ;; and although that doesn't make sense for me, or work for me, - ;; it's hard to see how it could have been wrong, since CMU CL - ;; genesis worked. It would be nice to understand how this came - ;; to be.. -- WHN 19990901 - (logior (ash bits (- 1 sb!vm:n-lowtag-bits)) - (ash -1 (- sb!vm:n-word-bits (1- sb!vm:n-lowtag-bits)))) - (ash bits (- 1 sb!vm:n-lowtag-bits))))) + ;; KLUDGE: The (- SB!VM:N-WORD-BITS 2) term here looks right to + ;; me, and it works, but in CMU CL it was (1- SB!VM:N-WORD-BITS), + ;; and although that doesn't make sense for me, or work for me, + ;; it's hard to see how it could have been wrong, since CMU CL + ;; genesis worked. It would be nice to understand how this came + ;; to be.. -- WHN 19990901 + (logior (ash bits (- 1 sb!vm:n-lowtag-bits)) + (ash -1 (1+ sb!vm:n-positive-fixnum-bits))) + (ash bits (- 1 sb!vm:n-lowtag-bits))))) ;;; common idioms (defun descriptor-bytes (des) @@ -1833,7 +1837,7 @@ (note-load-time-code-fixup code-object after-header value - kind)))))) )) + kind)))))))) (values)) (defun resolve-assembler-fixups () @@ -2136,6 +2140,11 @@ (31 (prog1 sb!vm:simple-array-unsigned-byte-31-widetag (setf sizebits 32))) (32 sb!vm:simple-array-unsigned-byte-32-widetag) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (63 (prog1 sb!vm:simple-array-unsigned-byte-63-widetag + (setf sizebits 64))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (64 (sb!vm:simple-array-unsigned-byte-64-widetag)) (t (error "losing element size: ~W" sizebits)))) (result (allocate-vector-object *dynamic* sizebits len type)) (start (+ (descriptor-byte-offset result) @@ -2631,6 +2640,22 @@ (maybe-record-with-translated-name '("-START" "-END") 6) (maybe-record-with-translated-name '("-CORE-ENTRY-TYPE-CODE") 7) (maybe-record-with-translated-name '("-CORE-SPACE-ID") 8)))))) + ;; KLUDGE: these constants are sort of important, but there's no + ;; pleasing way to inform the code above about them. So we fake + ;; it for now. nikodemus on #lisp (2004-08-09) suggested simply + ;; exporting every numeric constant from SB!VM; that would work, + ;; but the C runtime would have to be altered to use Lisp-like names + ;; rather than the munged names currently exported. --njf, 2004-08-09 + (dolist (c '(sb!vm:n-word-bits sb!vm:n-word-bytes + sb!vm:n-lowtag-bits sb!vm:lowtag-mask + sb!vm:n-widetag-bits sb!vm:widetag-mask + sb!vm:n-fixnum-tag-bits sb!vm:fixnum-tag-mask)) + (push (list (substitute #\_ #\- (symbol-name c)) + -1 ; invent a new priority + (symbol-value c) + nil) + constants)) + (setf constants (sort constants (lambda (const1 const2) diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp index 5d2c780..baa9972 100644 --- a/src/compiler/generic/vm-array.lisp +++ b/src/compiler/generic/vm-array.lisp @@ -99,12 +99,22 @@ :importance 12) ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16 :importance 12) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) ((unsigned-byte 29) 0 32 simple-array-unsigned-byte-29 :importance 8) ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31 :importance 11) ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32 :importance 11) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte 60) 0 64 simple-array-unsigned-byte-60 + :importance 8) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte 63) 0 64 simple-array-unsigned-byte-63 + :importance 9) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((unsigned-byte 64) 0 64 simple-array-unsigned-byte-64 + :importance 9) ((signed-byte 8) 0 8 simple-array-signed-byte-8 :importance 10) ((signed-byte 16) 0 16 simple-array-signed-byte-16 @@ -112,10 +122,18 @@ ;; KLUDGE: See the comment in PRIMITIVE-TYPE-AUX, ;; compiler/generic/primtype.lisp, for why this is FIXNUM and ;; not (SIGNED-BYTE 30) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (fixnum 0 32 simple-array-signed-byte-30 :importance 8) ((signed-byte 32) 0 32 simple-array-signed-byte-32 :importance 7) + ;; KLUDGE: see above KLUDGE for the 32-bit case + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (fixnum 0 64 simple-array-signed-byte-61 + :importance 8) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((signed-byte 64) 0 64 simple-array-signed-byte-64 + :importance 7) ((complex single-float) #C(0.0f0 0.0f0) 64 simple-array-complex-single-float :importance 3) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index e2264f1..d554a28 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -27,11 +27,25 @@ simple-array-unsigned-byte-2-p simple-array-unsigned-byte-4-p simple-array-unsigned-byte-7-p simple-array-unsigned-byte-8-p simple-array-unsigned-byte-15-p - simple-array-unsigned-byte-16-p simple-array-unsigned-byte-29-p + simple-array-unsigned-byte-16-p + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-29-p simple-array-unsigned-byte-31-p simple-array-unsigned-byte-32-p + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-60-p + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-63-p + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-unsigned-byte-64-p simple-array-signed-byte-8-p simple-array-signed-byte-16-p - simple-array-signed-byte-30-p simple-array-signed-byte-32-p + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + simple-array-signed-byte-30-p + simple-array-signed-byte-32-p + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-signed-byte-61-p + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + simple-array-signed-byte-64-p simple-array-single-float-p simple-array-double-float-p #!+long-float simple-array-long-float-p simple-array-complex-single-float-p diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp index f80e41f..f88f635 100644 --- a/src/compiler/generic/vm-typetran.lisp +++ b/src/compiler/generic/vm-typetran.lisp @@ -47,20 +47,37 @@ (simple-array (unsigned-byte 15) (*))) (define-type-predicate simple-array-unsigned-byte-16-p (simple-array (unsigned-byte 16) (*))) +#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (define-type-predicate simple-array-unsigned-byte-29-p (simple-array (unsigned-byte 29) (*))) (define-type-predicate simple-array-unsigned-byte-31-p (simple-array (unsigned-byte 31) (*))) (define-type-predicate simple-array-unsigned-byte-32-p (simple-array (unsigned-byte 32) (*))) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate simple-array-unsigned-byte-60-p + (simple-array (unsigned-byte 60) (*))) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate simple-array-unsigned-byte-63-p + (simple-array (unsigned-byte 63) (*))) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate simple-array-unsigned-byte-64-p + (simple-array (unsigned-byte 64) (*))) (define-type-predicate simple-array-signed-byte-8-p (simple-array (signed-byte 8) (*))) (define-type-predicate simple-array-signed-byte-16-p (simple-array (signed-byte 16) (*))) +#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (define-type-predicate simple-array-signed-byte-30-p (simple-array (signed-byte 30) (*))) (define-type-predicate simple-array-signed-byte-32-p (simple-array (signed-byte 32) (*))) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate simple-array-signed-byte-61-p + (simple-array (signed-byte 61) (*))) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate simple-array-signed-byte-64-p + (simple-array (signed-byte 64) (*))) (define-type-predicate simple-array-single-float-p (simple-array single-float (*))) (define-type-predicate simple-array-double-float-p diff --git a/src/runtime/Config.alpha-osf1 b/src/runtime/Config.alpha-osf1 index e1d6e5e..bacf12d 100644 --- a/src/runtime/Config.alpha-osf1 +++ b/src/runtime/Config.alpha-osf1 @@ -8,9 +8,10 @@ # files for more information. CFLAGS += -Dalpha -Dosf1 -O0 -g -D_XOPEN_SOURCE=500 -D_OSF_SOURCE=500 +CFLAGS += -msg_disable newlocale ASFLAGS += -Dalpha -Dosf1 #-ULANGUAGE_ASSEMBLY -LD = ld -taso -LINKFLAGS = -taso -non_shared # dynamic -v -g -Wl,-T -Wl,ld-script.alpha-linux +LD = ld -xtaso +LINKFLAGS = -non_shared # dynamic -v -g -Wl,-T -Wl,ld-script.alpha-linux # Digital^WCompaq^WHP's cc declares `static inline' functions to exist # in multiple places in the binary; we add the '-g' flag to suppress all # internal (i.e. static) function names being spat out. GENESIS diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index 9fcafd3..9d9c6d6 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -18,7 +18,6 @@ #include #include "sbcl.h" -#include "genesis/config.h" #include "runtime.h" #include "os.h" #include "alloc.h" diff --git a/src/runtime/alloc.h b/src/runtime/alloc.h index 361d5cb..0f2714c 100644 --- a/src/runtime/alloc.h +++ b/src/runtime/alloc.h @@ -12,6 +12,7 @@ #ifndef _ALLOC_H_ #define _ALLOC_H_ +#include "sbcl.h" #include "runtime.h" extern lispobj alloc_cons(lispobj car, lispobj cdr); diff --git a/src/runtime/alpha-arch.c b/src/runtime/alpha-arch.c index 4402723..8cd654a 100644 --- a/src/runtime/alpha-arch.c +++ b/src/runtime/alpha-arch.c @@ -16,8 +16,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "globals.h" #include "validate.h" #include "os.h" diff --git a/src/runtime/alpha-linux-os.c b/src/runtime/alpha-linux-os.c index 99c8856..dab6e7a 100644 --- a/src/runtime/alpha-linux-os.c +++ b/src/runtime/alpha-linux-os.c @@ -18,6 +18,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -25,7 +26,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/alpha-lispregs.h b/src/runtime/alpha-lispregs.h index f3bd72d..bf650ae 100644 --- a/src/runtime/alpha-lispregs.h +++ b/src/runtime/alpha-lispregs.h @@ -68,5 +68,4 @@ reg_L0, reg_L1, reg_L2 \ } - #define call_into_lisp_LRA_page 0x10000 diff --git a/src/runtime/alpha-osf1-os.c b/src/runtime/alpha-osf1-os.c index aeec91b..cc72e4d 100644 --- a/src/runtime/alpha-osf1-os.c +++ b/src/runtime/alpha-osf1-os.c @@ -19,6 +19,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -26,7 +27,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index c4840cc..e10af61 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -15,8 +15,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "globals.h" #include "os.h" #include "interrupt.h" diff --git a/src/runtime/cheneygc.c b/src/runtime/cheneygc.c index 23b62d7..07e9d15 100644 --- a/src/runtime/cheneygc.c +++ b/src/runtime/cheneygc.c @@ -17,8 +17,8 @@ #include #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "os.h" #include "gc.h" #include "gc-internal.h" @@ -541,8 +541,6 @@ scav_fdefn(lispobj *where, lispobj object) /* vector-like objects */ -/* #define NWORDS(x,y) (CEILING((x),(y)) / (y)) */ - static int scav_vector(lispobj *where, lispobj object) { diff --git a/src/runtime/core.h b/src/runtime/core.h index aa57ba9..efda49b 100644 --- a/src/runtime/core.h +++ b/src/runtime/core.h @@ -12,6 +12,7 @@ #ifndef _CORE_H_ #define _CORE_H_ +#include "sbcl.h" #include "runtime.h" struct ndir_entry { diff --git a/src/runtime/dynbind.c b/src/runtime/dynbind.c index 1c3a6ab..12da1cb 100644 --- a/src/runtime/dynbind.c +++ b/src/runtime/dynbind.c @@ -13,8 +13,8 @@ * files for more information. */ -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "globals.h" #include "dynbind.h" #include "thread.h" diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index b266f42..3246b72 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -28,8 +28,8 @@ #include #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "os.h" #include "interr.h" #include "globals.h" @@ -743,8 +743,6 @@ size_unboxed(lispobj *where) static int /* vector-like objects */ -#define NWORDS(x,y) (CEILING((x),(y)) / (y)) - scav_base_string(lispobj *where, lispobj object) { struct vector *vector; @@ -755,7 +753,7 @@ scav_base_string(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return nwords; } @@ -773,7 +771,7 @@ trans_base_string(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -790,7 +788,7 @@ size_base_string(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return nwords; } @@ -852,7 +850,7 @@ scav_vector_bit(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 1) + 2, 2); return nwords; } @@ -867,7 +865,7 @@ trans_vector_bit(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 1) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -880,7 +878,7 @@ size_vector_bit(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 1) + 2, 2); return nwords; } @@ -893,7 +891,7 @@ scav_vector_unsigned_byte_2(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); return nwords; } @@ -908,7 +906,7 @@ trans_vector_unsigned_byte_2(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -921,7 +919,7 @@ size_vector_unsigned_byte_2(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); return nwords; } @@ -934,7 +932,7 @@ scav_vector_unsigned_byte_4(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); return nwords; } @@ -949,7 +947,7 @@ trans_vector_unsigned_byte_4(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -961,7 +959,7 @@ size_vector_unsigned_byte_4(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); return nwords; } @@ -975,7 +973,7 @@ scav_vector_unsigned_byte_8(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return nwords; } @@ -994,7 +992,7 @@ trans_vector_unsigned_byte_8(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -1007,7 +1005,7 @@ size_vector_unsigned_byte_8(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return nwords; } @@ -1021,7 +1019,7 @@ scav_vector_unsigned_byte_16(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); return nwords; } @@ -1036,7 +1034,7 @@ trans_vector_unsigned_byte_16(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -1049,7 +1047,7 @@ size_vector_unsigned_byte_16(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); return nwords; } @@ -1062,7 +1060,7 @@ scav_vector_unsigned_byte_32(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } @@ -1077,7 +1075,7 @@ trans_vector_unsigned_byte_32(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return copy_large_unboxed_object(object, nwords); } @@ -1090,11 +1088,54 @@ size_vector_unsigned_byte_32(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } +#if N_WORD_BITS == 64 +static int +scav_vector_unsigned_byte_64(lispobj *where, lispobj object) +{ + struct vector *vector; + int length, nwords; + + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 64) + 2, 2); + + return nwords; +} + +static lispobj +trans_vector_unsigned_byte_64(lispobj object) +{ + struct vector *vector; + int length, nwords; + + gc_assert(is_lisp_pointer(object)); + + vector = (struct vector *) native_pointer(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 64) + 2, 2); + + return copy_large_unboxed_object(object, nwords); +} + +static int +size_vector_unsigned_byte_64(lispobj *where) +{ + struct vector *vector; + int length, nwords; + + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 64) + 2, 2); + + return nwords; +} +#endif + static int scav_vector_single_float(lispobj *where, lispobj object) { @@ -1520,12 +1561,26 @@ gc_init_tables(void) scav_vector_unsigned_byte_16; scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = scav_vector_unsigned_byte_16; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_29_WIDETAG scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] = scav_vector_unsigned_byte_32; +#endif scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] = scav_vector_unsigned_byte_32; scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = scav_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] = + scav_vector_unsigned_byte_64; +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] = + scav_vector_unsigned_byte_64; +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] = + scav_vector_unsigned_byte_64; +#endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8; #endif @@ -1541,6 +1596,14 @@ gc_init_tables(void) scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = scav_vector_unsigned_byte_32; #endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] = + scav_vector_unsigned_byte_64; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] = + scav_vector_unsigned_byte_64; +#endif scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float; scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float; #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG @@ -1624,12 +1687,26 @@ gc_init_tables(void) trans_vector_unsigned_byte_16; transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = trans_vector_unsigned_byte_16; +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] = trans_vector_unsigned_byte_32; +#endif transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] = trans_vector_unsigned_byte_32; transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = trans_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] = + trans_vector_unsigned_byte_32; +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] = + trans_vector_unsigned_byte_64; +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] = + trans_vector_unsigned_byte_64; +#endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = trans_vector_unsigned_byte_8; @@ -1646,6 +1723,14 @@ gc_init_tables(void) transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = trans_vector_unsigned_byte_32; #endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] = + trans_vector_unsigned_byte_64; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] = + trans_vector_unsigned_byte_64; +#endif transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = trans_vector_single_float; transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = @@ -1689,14 +1774,14 @@ gc_init_tables(void) for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++) sizetab[i] = size_lose; for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) { - sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate; - sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer; + sizetab[EVEN_FIXNUM_LOWTAG|(i< #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "os.h" #include "interr.h" #include "globals.h" diff --git a/src/runtime/globals.c b/src/runtime/globals.c index 7cf1139..916cd1f 100644 --- a/src/runtime/globals.c +++ b/src/runtime/globals.c @@ -17,8 +17,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "globals.h" #include "validate.h" diff --git a/src/runtime/globals.h b/src/runtime/globals.h index 8991729..7c48249 100644 --- a/src/runtime/globals.h +++ b/src/runtime/globals.h @@ -16,6 +16,7 @@ #include #include +#include "sbcl.h" #include "runtime.h" extern int foreign_function_call_active; diff --git a/src/runtime/hppa-arch.c b/src/runtime/hppa-arch.c index 98ad085..f91a065 100644 --- a/src/runtime/hppa-arch.c +++ b/src/runtime/hppa-arch.c @@ -11,9 +11,9 @@ #include /* Copied from sparc-arch.c. Not all of these are necessary, probably */ +#include "sbcl.h" #include "runtime.h" #include "arch.h" -#include "sbcl.h" #include "globals.h" #include "validate.h" #include "os.h" diff --git a/src/runtime/hppa-linux-os.c b/src/runtime/hppa-linux-os.c index 696ee1d..b762926 100644 --- a/src/runtime/hppa-linux-os.c +++ b/src/runtime/hppa-linux-os.c @@ -17,6 +17,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -24,7 +25,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/mips-arch.c b/src/runtime/mips-arch.c index b2c927e..9e7651d 100644 --- a/src/runtime/mips-arch.c +++ b/src/runtime/mips-arch.c @@ -7,9 +7,9 @@ #include +#include "sbcl.h" #include "runtime.h" #include "arch.h" -#include "sbcl.h" #include "globals.h" #include "validate.h" #include "os.h" diff --git a/src/runtime/mips-linux-os.c b/src/runtime/mips-linux-os.c index 2f4a0da..1b9bed7 100644 --- a/src/runtime/mips-linux-os.c +++ b/src/runtime/mips-linux-os.c @@ -17,6 +17,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -24,7 +25,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index 5247efe..2c91308 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -18,8 +18,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" /* Almost all of this file can be skipped if we're not supporting LDB. */ #if defined(LISP_FEATURE_SB_LDB) diff --git a/src/runtime/os.h b/src/runtime/os.h index 7519f7c..145f2e1 100644 --- a/src/runtime/os.h +++ b/src/runtime/os.h @@ -17,6 +17,7 @@ #define _OS_H_INCLUDED_ +#include "sbcl.h" #include "runtime.h" /* Some standard preprocessor definitions and typedefs are needed from diff --git a/src/runtime/osf1-os.c b/src/runtime/osf1-os.c index 5dd0d46..b5b96ac 100644 --- a/src/runtime/osf1-os.c +++ b/src/runtime/osf1-os.c @@ -24,6 +24,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -31,7 +32,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include #include diff --git a/src/runtime/parse.c b/src/runtime/parse.c index 8a2d9e3..f6c6360 100644 --- a/src/runtime/parse.c +++ b/src/runtime/parse.c @@ -15,8 +15,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #if defined(LISP_FEATURE_SB_LDB) diff --git a/src/runtime/ppc-linux-os.c b/src/runtime/ppc-linux-os.c index 86c2bae..9df7561 100644 --- a/src/runtime/ppc-linux-os.c +++ b/src/runtime/ppc-linux-os.c @@ -18,6 +18,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -25,7 +26,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/print.c b/src/runtime/print.c index 6e6dd12..166eca7 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -20,9 +20,9 @@ #include +#include "sbcl.h" #include "print.h" #include "runtime.h" -#include "sbcl.h" /* This file can be skipped if we're not supporting LDB. */ #if defined(LISP_FEATURE_SB_LDB) diff --git a/src/runtime/print.h b/src/runtime/print.h index 7e6b119..9bfe560 100644 --- a/src/runtime/print.h +++ b/src/runtime/print.h @@ -12,6 +12,7 @@ #ifndef _PRINT_H_ #define _PRINT_H_ +#include "sbcl.h" #include "runtime.h" extern char *lowtag_Names[], *subtype_Names[]; diff --git a/src/runtime/purify.c b/src/runtime/purify.c index cc8496e..1cac459 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -80,9 +80,6 @@ later { } *later_blocks = NULL; static int later_count = 0; -#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) -#define NWORDS(x,y) (CEILING((x),(y)) / (y)) - /* FIXME: Shouldn't this be defined in sbcl.h? See also notes in * cheneygc.c */ @@ -1151,22 +1148,22 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_BASE_STRING_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2); break; case SIMPLE_BIT_VECTOR_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),1)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: @@ -1175,7 +1172,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: @@ -1184,7 +1181,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: @@ -1197,9 +1194,24 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(fixnum_value(vector->length)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); break; +#if N_WORD_BITS == 64 + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: +#endif + vector = (struct vector *)addr; + count = CEILING(NWORDS(fixnum_value(vector->length),64)+2,2); + break; +#endif + case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: vector = (struct vector *)addr; count = CEILING(fixnum_value(vector->length)+2,2); diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h index f144291..88d6ca9 100644 --- a/src/runtime/runtime.h +++ b/src/runtime/runtime.h @@ -37,11 +37,6 @@ * problem.. */ #define QSHOW_SIGNALS 0 -#define N_LOWTAG_BITS 3 -#define LOWTAG_MASK ((1<>2) +#define make_fixnum(n) ((lispobj)((n)<>N_FIXNUM_TAG_BITS) /* Too bad ANSI C doesn't define "bool" as C++ does.. */ typedef int boolean; diff --git a/src/runtime/search.c b/src/runtime/search.c index 1ea8dfa..3f96bc3 100644 --- a/src/runtime/search.c +++ b/src/runtime/search.c @@ -11,8 +11,8 @@ #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "os.h" #include "search.h" #include "thread.h" diff --git a/src/runtime/sparc-arch.c b/src/runtime/sparc-arch.c index bd1e663..92b7228 100644 --- a/src/runtime/sparc-arch.c +++ b/src/runtime/sparc-arch.c @@ -10,9 +10,9 @@ */ #include +#include "sbcl.h" #include "runtime.h" #include "arch.h" -#include "sbcl.h" #include "globals.h" #include "validate.h" #include "os.h" diff --git a/src/runtime/sparc-linux-os.c b/src/runtime/sparc-linux-os.c index cae1bbf..e405e33 100644 --- a/src/runtime/sparc-linux-os.c +++ b/src/runtime/sparc-linux-os.c @@ -17,6 +17,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -24,7 +25,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/sparc-sunos-os.c b/src/runtime/sparc-sunos-os.c index 72a2931..9414b06 100644 --- a/src/runtime/sparc-sunos-os.c +++ b/src/runtime/sparc-sunos-os.c @@ -17,6 +17,7 @@ #include #include #include +#include "sbcl.h" #include "./signal.h" #include "os.h" #include "arch.h" @@ -24,7 +25,6 @@ #include "interrupt.h" #include "interr.h" #include "lispregs.h" -#include "sbcl.h" #include #include diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c index 8c1d9b4..8bcddcf 100644 --- a/src/runtime/sunos-os.c +++ b/src/runtime/sunos-os.c @@ -8,13 +8,13 @@ #include #include +#include "sbcl.h" #include "os.h" #include "arch.h" #include "interr.h" #include "interrupt.h" #include "globals.h" #include "validate.h" -#include "sbcl.h" #include "target-arch-os.h" #define OS_VM_DEFAULT_PAGESIZE 8192 diff --git a/src/runtime/thread.c b/src/runtime/thread.c index c9558a5..e5003f9 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -8,8 +8,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "validate.h" /* for CONTROL_STACK_SIZE etc */ #include "thread.h" #include "arch.h" @@ -19,6 +19,9 @@ #include "dynbind.h" #include "genesis/cons.h" #include "genesis/fdefn.h" +#include "interr.h" /* for lose() */ +#include "gc-internal.h" + #define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */ int dynamic_values_bytes=4096*sizeof(lispobj); /* same for all threads */ @@ -157,13 +160,13 @@ struct thread * create_thread_struct(lispobj initial_function) { * we use the appropriate SymbolValue macros to access any of the * variable quantities from the C runtime. It's not quite OAOOM, * it just feels like it */ - SetSymbolValue(BINDING_STACK_START,th->binding_stack_start,th); - SetSymbolValue(CONTROL_STACK_START,th->control_stack_start,th); - SetSymbolValue(CONTROL_STACK_END,th->control_stack_end,th); + SetSymbolValue(BINDING_STACK_START,(lispobj)th->binding_stack_start,th); + SetSymbolValue(CONTROL_STACK_START,(lispobj)th->control_stack_start,th); + SetSymbolValue(CONTROL_STACK_END,(lispobj)th->control_stack_end,th); #ifdef LISP_FEATURE_X86 - SetSymbolValue(BINDING_STACK_POINTER,th->binding_stack_pointer,th); - SetSymbolValue(ALIEN_STACK,th->alien_stack_pointer,th); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC,th->pseudo_atomic_atomic,th); + SetSymbolValue(BINDING_STACK_POINTER,(lispobj)th->binding_stack_pointer,th); + SetSymbolValue(ALIEN_STACK,(lispobj)th->alien_stack_pointer,th); + SetSymbolValue(PSEUDO_ATOMIC_ATOMIC,(lispobj)th->pseudo_atomic_atomic,th); SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th->pseudo_atomic_interrupted,th); #else current_binding_stack_pointer=th->binding_stack_pointer; diff --git a/src/runtime/time.c b/src/runtime/time.c index 716e7d8..59e9d1e 100644 --- a/src/runtime/time.c +++ b/src/runtime/time.c @@ -15,6 +15,7 @@ #include #include +#include "sbcl.h" #include "runtime.h" void get_timezone(time_t when, int *secwest, boolean *dst) diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c index f12e896..3b195b8 100644 --- a/src/runtime/wrap.c +++ b/src/runtime/wrap.c @@ -32,8 +32,8 @@ #include #include -#include "runtime.h" #include "sbcl.h" +#include "runtime.h" #include "util.h" /* Although it might seem as though this should be in some standard diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index 2b1edba..ec468cc 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -11,11 +11,11 @@ #include +#include "sbcl.h" #include "runtime.h" #include "globals.h" #include "validate.h" #include "os.h" -#include "sbcl.h" #include "arch.h" #include "lispregs.h" #include "signal.h" diff --git a/version.lisp-expr b/version.lisp-expr index fc7e5bc..5337980 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.13.46" +"0.8.13.47" -- 1.7.10.4