X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=485d71bf26110b012e76422f781435f67527f02e;hb=99501797db3d77ff2a7f32071d7fab0db3fdacae;hp=0de5f034180ae19413cfe211989393718014c978;hpb=d2e48d5a1805e3fb98268473a71aff38d8fd9d0b;p=sbcl.git diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 0de5f03..485d71b 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -598,7 +598,7 @@ (des (allocate-vector-object gspace sb!vm:n-byte-bits (1+ length) - sb!vm:simple-string-widetag)) + sb!vm:simple-base-string-widetag)) (bytes (gspace-bytes gspace)) (offset (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes) (descriptor-byte-offset des)))) @@ -1253,11 +1253,12 @@ (macrolet ((frob (symbol) `(cold-set ',symbol (cold-fdefinition-object (cold-intern ',symbol))))) - (frob maybe-gc) + (frob sub-gc) (frob internal-error) (frob sb!kernel::control-stack-exhausted-error) (frob sb!di::handle-breakpoint) - (frob sb!di::handle-fun-end-breakpoint)) + (frob sb!di::handle-fun-end-breakpoint) + (frob sb!thread::handle-thread-exit)) (cold-set '*current-catch-block* (make-fixnum-descriptor 0)) (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0)) @@ -2021,7 +2022,7 @@ (defun cold-load-symbol (size package) (let ((string (make-string size))) (read-string-as-bytes *fasl-input-stream* string) - (cold-intern (intern string package) package))) + (cold-intern (intern string package)))) (macrolet ((frob (name pname-len package-len) `(define-cold-fop (,name) @@ -2125,11 +2126,18 @@ (let* ((len (read-arg 4)) (sizebits (read-arg 1)) (type (case sizebits + (0 sb!vm:simple-array-nil-widetag) (1 sb!vm:simple-bit-vector-widetag) (2 sb!vm:simple-array-unsigned-byte-2-widetag) (4 sb!vm:simple-array-unsigned-byte-4-widetag) + (7 (prog1 sb!vm:simple-array-unsigned-byte-7-widetag + (setf sizebits 8))) (8 sb!vm:simple-array-unsigned-byte-8-widetag) + (15 (prog1 sb!vm:simple-array-unsigned-byte-15-widetag + (setf sizebits 16))) (16 sb!vm:simple-array-unsigned-byte-16-widetag) + (31 (prog1 sb!vm:simple-array-unsigned-byte-31-widetag + (setf sizebits 32))) (32 sb!vm:simple-array-unsigned-byte-32-widetag) (t (error "losing element size: ~W" sizebits)))) (result (allocate-vector-object *dynamic* sizebits len type))