(let ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
(1- sb!vm:complex-single-float-size)
sb!vm:complex-single-float-widetag)))
- (write-wordindexed des sb!vm:complex-single-float-real-slot
- (make-random-descriptor (single-float-bits (realpart num))))
- (write-wordindexed des sb!vm:complex-single-float-imag-slot
- (make-random-descriptor (single-float-bits (imagpart num))))
+ #!-x86-64
+ (progn
+ (write-wordindexed des sb!vm:complex-single-float-real-slot
+ (make-random-descriptor (single-float-bits (realpart num))))
+ (write-wordindexed des sb!vm:complex-single-float-imag-slot
+ (make-random-descriptor (single-float-bits (imagpart num)))))
+ #!+x86-64
+ (write-wordindexed des sb!vm:complex-single-float-data-slot
+ (make-random-descriptor
+ (logior (ldb (byte 32 0) (single-float-bits (realpart num)))
+ (ash (single-float-bits (imagpart num)) 32))))
des))
(defun complex-double-float-to-core (num)
(write-wordindexed code slot value)))
(define-cold-fop (fop-fun-entry)
- (let* ((xrefs (pop-stack))
+ (let* ((info (pop-stack))
(type (pop-stack))
(arglist (pop-stack))
(name (pop-stack))
(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)
- (write-wordindexed fn sb!vm::simple-fun-xrefs-slot xrefs)
+ (write-wordindexed fn sb!vm::simple-fun-info-slot info)
fn))
(define-cold-fop (fop-foreign-fixup)
(c-symbol-name symbol)
(sb!xc:mask-field (symbol-value symbol) -1))))
-
+#!+sb-ldb
+(defun write-tagnames-h (&optional (out *standard-output*))
+ (labels
+ ((pretty-name (symbol strip)
+ (let ((name (string-downcase symbol)))
+ (substitute #\Space #\-
+ (subseq name 0 (- (length name) (length strip))))))
+ (list-sorted-tags (tail)
+ (loop for symbol being the external-symbols of "SB!VM"
+ when (and (constantp symbol)
+ (tailwise-equal (string symbol) tail))
+ collect symbol into tags
+ finally (return (sort tags #'< :key #'symbol-value))))
+ (write-tags (kind limit ash-count)
+ (format out "~%static const char *~(~A~)_names[] = {~%"
+ (subseq kind 1))
+ (let ((tags (list-sorted-tags kind)))
+ (dotimes (i limit)
+ (if (eql i (ash (or (symbol-value (first tags)) -1) ash-count))
+ (format out " \"~A\"" (pretty-name (pop tags) kind))
+ (format out " \"unknown [~D]\"" i))
+ (unless (eql i (1- limit))
+ (write-string "," out))
+ (terpri out)))
+ (write-line "};" out)))
+ (write-tags "-LOWTAG" sb!vm:lowtag-limit 0)
+ ;; this -2 shift depends on every OTHER-IMMEDIATE-?-LOWTAG
+ ;; ending with the same 2 bits. (#b10)
+ (write-tags "-WIDETAG" (ash (1+ sb!vm:widetag-mask) -2) -2))
+ (values))
(defun write-primitive-object (obj)
;; writing primitive object layouts
(write-map)))
(out-to "config" (write-config-h))
(out-to "constants" (write-constants-h))
+ #!+sb-ldb
+ (out-to "tagnames" (write-tagnames-h))
(let ((structs (sort (copy-list sb!vm:*primitive-objects*) #'string<
:key (lambda (obj)
(symbol-name
(when core-file-name
(write-initial-core-file core-file-name))))))
-
-