(write-wordindexed code slot value)))
(define-cold-fop (fop-fun-entry)
- (let* ((type (pop-stack))
+ (let* ((xrefs (pop-stack))
+ (type (pop-stack))
(arglist (pop-stack))
(name (pop-stack))
(code-object (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)
fn))
(define-cold-fop (fop-foreign-fixup)
(setf prev-priority priority))
(format t "#define ~A " name)
(format t
- ;; KLUDGE: As of sbcl-0.6.7.14, we're dumping two
- ;; different kinds of values here, (1) small codes
- ;; and (2) machine addresses. The small codes can be
- ;; dumped as bare integer values. The large machine
- ;; addresses might cause problems if they're large
- ;; and represented as (signed) C integers, so we
- ;; want to force them to be unsigned. We do that by
- ;; wrapping them in the LISPOBJ macro. (We could do
- ;; it with a bare "(unsigned)" cast, except that
- ;; this header file is used not only in C files, but
- ;; also in assembly files, which don't understand
- ;; the cast syntax. The LISPOBJ macro goes away in
- ;; assembly files, but that shouldn't matter because
- ;; we don't do arithmetic on address constants in
- ;; assembly files. See? It really is a kludge..) --
- ;; WHN 2000-10-18
+ ;; KLUDGE: We're dumping two different kinds of
+ ;; values here, (1) small codes and (2) machine
+ ;; addresses. The small codes can be dumped as bare
+ ;; integer values. The large machine addresses might
+ ;; cause problems if they're large and represented
+ ;; as (signed) C integers, so we want to force them
+ ;; to be unsigned by appending an U to the
+ ;; literal. We can't dump all the values using the
+ ;; literal-U syntax, since the assembler doesn't
+ ;; support that syntax and some of the small
+ ;; constants can be used in assembler files.
(let (;; cutoff for treatment as a small code
(cutoff (expt 2 16)))
(cond ((minusp value)
((< value cutoff)
"~D")
(t
- "LISPOBJ(~DU)")))
+ "~DU")))
value)
(format t " /* 0x~X */~@[ /* ~A */~]~%" value doc))))
(terpri))
i)))))
(terpri)
+ ;; I'm not really sure why this is in SB!C, since it seems
+ ;; conceptually like something that belongs to SB!VM. In any case,
+ ;; it's needed C-side.
+ (format t "#define BACKEND_PAGE_SIZE ~DU~%" sb!c:*backend-page-size*)
+
+ (terpri)
+
;; FIXME: The SPARC has a PSEUDO-ATOMIC-TRAP that differs between
;; platforms. If we export this from the SB!VM package, it gets
;; written out as #define trap_PseudoAtomic, which is confusing as
(defun write-primitive-object (obj)
;; writing primitive object layouts
- (format t "#ifndef LANGUAGE_ASSEMBLY~2%")
- (format t
- "struct ~A {~%"
- (substitute #\_ #\-
- (string-downcase (string (sb!vm:primitive-object-name obj)))))
- (when (sb!vm:primitive-object-widetag obj)
- (format t " lispobj header;~%"))
- (dolist (slot (sb!vm:primitive-object-slots obj))
- (format t " ~A ~A~@[[1]~];~%"
- (getf (sb!vm:slot-options slot) :c-type "lispobj")
- (substitute #\_ #\-
- (string-downcase (string (sb!vm:slot-name slot))))
- (sb!vm:slot-rest-p slot)))
+ (format t "#ifndef LANGUAGE_ASSEMBLY~2%")
+ (format t
+ "struct ~A {~%"
+ (substitute #\_ #\-
+ (string-downcase (string (sb!vm:primitive-object-name obj)))))
+ (when (sb!vm:primitive-object-widetag obj)
+ (format t " lispobj header;~%"))
+ (dolist (slot (sb!vm:primitive-object-slots obj))
+ (format t " ~A ~A~@[[1]~];~%"
+ (getf (sb!vm:slot-options slot) :c-type "lispobj")
+ (substitute #\_ #\-
+ (string-downcase (string (sb!vm:slot-name slot))))
+ (sb!vm:slot-rest-p slot)))
(format t "};~2%")
- (format t "#else /* LANGUAGE_ASSEMBLY */~2%")
- (let ((name (sb!vm:primitive-object-name obj))
- (lowtag (eval (sb!vm:primitive-object-lowtag obj))))
- (when lowtag
- (dolist (slot (sb!vm:primitive-object-slots obj))
- (format t "#define ~A_~A_OFFSET ~D~%"
- (substitute #\_ #\- (string name))
- (substitute #\_ #\- (string (sb!vm:slot-name slot)))
- (- (* (sb!vm:slot-offset slot) sb!vm:n-word-bytes) lowtag)))
+ (format t "#else /* LANGUAGE_ASSEMBLY */~2%")
+ (format t "/* These offsets are SLOT-OFFSET * N-WORD-BYTES - LOWTAG~%")
+ (format t " * so they work directly on tagged addresses. */~2%")
+ (let ((name (sb!vm:primitive-object-name obj))
+ (lowtag (eval (sb!vm:primitive-object-lowtag obj))))
+ (when lowtag
+ (dolist (slot (sb!vm:primitive-object-slots obj))
+ (format t "#define ~A_~A_OFFSET ~D~%"
+ (substitute #\_ #\- (string name))
+ (substitute #\_ #\- (string (sb!vm:slot-name slot)))
+ (- (* (sb!vm:slot-offset slot) sb!vm:n-word-bytes) lowtag)))
(terpri)))
- (format t "#endif /* LANGUAGE_ASSEMBLY */~2%"))
+ (format t "#endif /* LANGUAGE_ASSEMBLY */~2%"))
(defun write-structure-object (dd)
(flet ((cstring (designator)
projects / sbcl.git / blobdiff