From: Nikodemus S. <de...@us...> - 2006-12-05 15:46:27
|
Update of /cvsroot/sbcl/sbcl/src/compiler/generic In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv6017/src/compiler/generic Modified Files: genesis.lisp Log Message: 1.0.0.21: fix build on PPC -- breakage from XREF commit * Less offset hardcoding in ppc-assem.S, missing xrefs "slot" in undefined_tramp and funcallable_instance_tramp. * Also adjust mips-assem.S and sparc-assem.S for the new simple-fun layout: add xrefs "slot" to undefined_tramp, closure_tramp, and funcallable_instance_tramp. UNTESTED! * Explain what the _OFFSETs are in generated header files. Index: genesis.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v retrieving revision 1.126 retrieving revision 1.127 diff -u -d -r1.126 -r1.127 --- genesis.lisp 5 Dec 2006 04:35:57 -0000 1.126 +++ genesis.lisp 5 Dec 2006 15:46:15 -0000 1.127 @@ -2798,31 +2798,33 @@ (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) |