From: Christophe Rhodes Date: Mon, 10 Nov 2003 23:26:37 +0000 (+0000) Subject: 0.8.5.29: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;p=sbcl.git 0.8.5.29: Completely boring housekeeping commit ... rename grovel_headers.c to grovel-headers.c, as that underscore was the only non-logical-pathname-compliant character in the whole of the source and objects filenames. ... delete all redundant sb!vm: prefixes throughout src/compiler/$arch/*.lisp ... nothing interesting at all, in fact. Builds and passes tests on at least x86 and sparc. --- diff --git a/make-target-1.sh b/make-target-1.sh index 55dbad9..d0bdbd0 100644 --- a/make-target-1.sh +++ b/make-target-1.sh @@ -32,6 +32,6 @@ cd ../.. # Use a little C program to grab stuff from the C header files and # smash it into Lisp source code. cd tools-for-build -$GNUMAKE -I../src/runtime grovel_headers || exit 1 +$GNUMAKE -I../src/runtime grovel-headers || exit 1 cd .. -tools-for-build/grovel_headers > output/stuff-groveled-from-headers.lisp +tools-for-build/grovel-headers > output/stuff-groveled-from-headers.lisp diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 9305dd1..30d8648 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -973,7 +973,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%ARRAY-DATA-VECTOR" "%ARRAY-DIMENSION" "%ARRAY-DISPLACED-P" "%ARRAY-DISPLACEMENT" "%ARRAY-FILL-POINTER" - "%ARRAY-FILL-POINTER-P" + "%ARRAY-FILL-POINTER-P" "%ARRAY-RANK" "%ASIN" "%ASINH" "%ATAN" "%ATAN2" "%ATANH" "%CALLER-FRAME-AND-PC" "%CHECK-BOUND" @@ -1000,7 +1000,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%RAW-REF-SINGLE" "%RAW-SET-COMPLEX-DOUBLE" "%RAW-SET-COMPLEX-LONG" "%RAW-SET-COMPLEX-SINGLE" "%RAW-SET-DOUBLE" "%RAW-SET-LONG" "%RAW-SET-SINGLE" - "%SCALB" "%SCALBN" "%SET-FUNCALLABLE-INSTANCE-FUN" + "%SCALB" "%SCALBN" "%SET-ARRAY-DIMENSION" + "%SET-FUNCALLABLE-INSTANCE-FUN" "%SET-FUNCALLABLE-INSTANCE-INFO" "%SET-RAW-BITS" "%SET-SAP-REF-16" "%SET-SAP-REF-32" "%SET-SAP-REF-64" "%SET-SAP-REF-8" "%SET-SAP-REF-DOUBLE" "%SET-SAP-REF-LONG" diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index c6c8552..fccb1f0 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -645,21 +645,21 @@ ;;;; bignum stuff (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) + (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-set #!+gengc nil) + (unsigned-reg) unsigned-num sb!bignum:%bignum-set #!+gengc nil) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -673,7 +673,7 @@ (inst bge temp target)))) (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -689,7 +689,7 @@ (inst mskll result 4 result))) (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -707,7 +707,7 @@ (inst mskll result 4 result))) (define-vop (bignum-mult-and-add-3-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg)) @@ -724,7 +724,7 @@ (define-vop (bignum-mult-and-add-4-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg)) @@ -742,7 +742,7 @@ (inst mskll lo 4 lo))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) @@ -756,7 +756,7 @@ (inst mskll lo 4 lo))) (define-vop (bignum-lognot) - (:translate sb!bignum::%lognot) + (:translate sb!bignum:%lognot) (:policy :fast-safe) (:args (x :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -767,7 +767,7 @@ (inst mskll r 4 r))) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (any-reg))) (:arg-types tagged-num) @@ -777,7 +777,7 @@ (inst sra fixnum 2 digit))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (num-high :scs (unsigned-reg)) (num-low :scs (unsigned-reg)) @@ -807,7 +807,7 @@ (emit-label shift2))))) (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg) :target res)) (:arg-types unsigned-num) @@ -824,7 +824,7 @@ (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -837,12 +837,12 @@ (inst srl result 32 result))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (inst srl digit count result))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst sll digit count result))) diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index ed451bd..38572a3 100644 --- a/src/compiler/alpha/array.lisp +++ b/src/compiler/alpha/array.lisp @@ -40,25 +40,16 @@ ;;;; additional accessors and setters for the array header - -(defknown sb!impl::%array-dimension (t index) index - (flushable)) -(defknown sb!impl::%set-array-dimension (t index index) index - ()) - (define-full-reffer %array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%array-dimension) + (any-reg) positive-fixnum sb!kernel:%array-dimension) (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%set-array-dimension #!+gengc nil) - - -(defknown sb!impl::%array-rank (t) index (flushable)) + (any-reg) positive-fixnum sb!kernel:%set-array-dimension #!+gengc nil) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) @@ -68,8 +59,6 @@ (inst sra temp n-widetag-bits temp) (inst subq temp (1- array-dimensions-offset) temp) (inst sll temp 2 res))) - - ;;;; bounds checking routine diff --git a/src/compiler/alpha/char.lisp b/src/compiler/alpha/char.lisp index 5318c40..5c65b59 100644 --- a/src/compiler/alpha/char.lisp +++ b/src/compiler/alpha/char.lisp @@ -18,7 +18,7 @@ (:args (x :scs (any-reg descriptor-reg))) (:results (y :scs (base-char-reg))) (:generator 1 - (inst srl x sb!vm:n-widetag-bits y))) + (inst srl x n-widetag-bits y))) ;;; (define-move-vop move-to-base-char :move (any-reg descriptor-reg) (base-char-reg)) @@ -28,8 +28,8 @@ (:args (x :scs (base-char-reg))) (:results (y :scs (any-reg descriptor-reg))) (:generator 1 - (inst sll x sb!vm:n-widetag-bits y) - (inst bis y sb!vm:base-char-widetag y))) + (inst sll x n-widetag-bits y) + (inst bis y base-char-widetag y))) ;;; (define-move-vop move-from-base-char :move (base-char-reg) (any-reg descriptor-reg)) diff --git a/src/compiler/alpha/debug.lisp b/src/compiler/alpha/debug.lisp index 204cb77..0f309e8 100644 --- a/src/compiler/alpha/debug.lisp +++ b/src/compiler/alpha/debug.lisp @@ -90,11 +90,11 @@ (let ((bogus (gen-label)) (done (gen-label))) (loadw temp thing 0 lowtag) - (inst srl temp sb!vm:n-widetag-bits temp) + (inst srl temp n-widetag-bits temp) (inst beq temp bogus) - (inst sll temp (1- (integer-length sb!vm:n-word-bytes)) temp) - (unless (= lowtag sb!vm:other-pointer-lowtag) - (inst subq temp (- sb!vm:other-pointer-lowtag lowtag) temp)) + (inst sll temp (1- (integer-length n-word-bytes)) temp) + (unless (= lowtag other-pointer-lowtag) + (inst subq temp (- other-pointer-lowtag lowtag) temp)) (inst subq thing temp code) (emit-label done) (assemble (*elsewhere*) @@ -104,11 +104,11 @@ (define-vop (code-from-lra code-from-mumble) (:translate lra-code-header) - (:variant sb!vm:other-pointer-lowtag)) + (:variant other-pointer-lowtag)) (define-vop (code-from-function code-from-mumble) (:translate fun-code-header) - (:variant sb!vm:fun-pointer-lowtag)) + (:variant fun-pointer-lowtag)) (define-vop (make-lisp-obj) (:policy :fast-safe) @@ -136,7 +136,7 @@ (:result-types positive-fixnum) (:generator 5 (loadw res fun 0 fun-pointer-lowtag) - (inst srl res sb!vm:n-widetag-bits res))) + (inst srl res n-widetag-bits res))) (defknown make-number-stack-pointer ((unsigned-byte 32)) system-area-pointer (movable foldable flushable)) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 790d69e..a251501 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -87,8 +87,8 @@ (defmacro lisp-jump (function lip) "Jump to the lisp function FUNCTION. LIP is an interior-reg temporary." `(progn - (inst lda ,lip (- (ash sb!vm:simple-fun-code-offset sb!vm:word-shift) - sb!vm:fun-pointer-lowtag) + (inst lda ,lip (- (ash simple-fun-code-offset word-shift) + fun-pointer-lowtag) ,function) (move ,function code-tn) (inst jsr zero-tn ,lip 1))) diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index 2e414f2..89c2e8d 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -81,13 +81,13 @@ (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 22 - (inst lda block (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (inst lda block (* (tn-offset tn) n-word-bytes) cfp-tn) (load-symbol-value temp *current-unwind-protect-block*) - (storew temp block sb!vm:unwind-block-current-uwp-slot) - (storew cfp-tn block sb!vm:unwind-block-current-cont-slot) - (storew code-tn block sb!vm:unwind-block-current-code-slot) + (storew temp block unwind-block-current-uwp-slot) + (storew cfp-tn block unwind-block-current-cont-slot) + (storew code-tn block unwind-block-current-code-slot) (inst compute-lra-from-code temp code-tn entry-label ndescr) - (storew temp block sb!vm:catch-block-entry-pc-slot))) + (storew temp block catch-block-entry-pc-slot))) ;;; This is like Make-Unwind-Block, except that we also store in the @@ -101,17 +101,17 @@ (:temporary (:scs (descriptor-reg) :target block :to (:result 0)) result) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 44 - (inst lda result (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (inst lda result (* (tn-offset tn) n-word-bytes) cfp-tn) (load-symbol-value temp *current-unwind-protect-block*) - (storew temp result sb!vm:catch-block-current-uwp-slot) - (storew cfp-tn result sb!vm:catch-block-current-cont-slot) - (storew code-tn result sb!vm:catch-block-current-code-slot) + (storew temp result catch-block-current-uwp-slot) + (storew cfp-tn result catch-block-current-cont-slot) + (storew code-tn result catch-block-current-code-slot) (inst compute-lra-from-code temp code-tn entry-label ndescr) - (storew temp result sb!vm:catch-block-entry-pc-slot) + (storew temp result catch-block-entry-pc-slot) - (storew tag result sb!vm:catch-block-tag-slot) + (storew tag result catch-block-tag-slot) (load-symbol-value temp *current-catch-block*) - (storew temp result sb!vm:catch-block-previous-catch-slot) + (storew temp result catch-block-previous-catch-slot) (store-symbol-value result *current-catch-block*) (move result block))) @@ -122,7 +122,7 @@ (:args (tn)) (:temporary (:scs (descriptor-reg)) new-uwp) (:generator 7 - (inst lda new-uwp (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (inst lda new-uwp (* (tn-offset tn) n-word-bytes) cfp-tn) (store-symbol-value new-uwp *current-unwind-protect-block*))) (define-vop (unlink-catch-block) @@ -131,7 +131,7 @@ (:translate %catch-breakup) (:generator 17 (load-symbol-value block *current-catch-block*) - (loadw block block sb!vm:catch-block-previous-catch-slot) + (loadw block block catch-block-previous-catch-slot) (store-symbol-value block *current-catch-block*))) (define-vop (unlink-unwind-protect) @@ -140,7 +140,7 @@ (:translate %unwind-protect-breakup) (:generator 17 (load-symbol-value block *current-unwind-protect-block*) - (loadw block block sb!vm:unwind-block-current-uwp-slot) + (loadw block block unwind-block-current-uwp-slot) (store-symbol-value block *current-unwind-protect-block*))) ;;;; NLX entry VOPs @@ -236,10 +236,10 @@ ;; Copy stuff on stack. (emit-label loop) (loadw temp src) - (inst lda src sb!vm:n-word-bytes src) + (inst lda src n-word-bytes src) (storew temp dst) (inst lda num (fixnumize -1) num) - (inst lda dst sb!vm:n-word-bytes dst) + (inst lda dst n-word-bytes dst) (inst bne num loop) (emit-label done) diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp index 6c31284..b1b39d1 100644 --- a/src/compiler/alpha/vm.lisp +++ b/src/compiler/alpha/vm.lisp @@ -117,10 +117,7 @@ ((null classes) (nreverse forms)))) -;;; see comment in ../x86/vm.lisp. The value of 7 was taken from -;;; vm:catch-block-size in a cmucl that I happened to have around -;;; and seems to be working so far -dan -(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -243,7 +240,7 @@ ;; A catch or unwind block. (catch-block control-stack - :element-size sb!vm::kludge-nondeterministic-catch-block-size)) + :element-size kludge-nondeterministic-catch-block-size)) ;;; Make some random tns for important registers. (macrolet ((defregtn (name sc) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 04d1452..f9ee134 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -70,6 +70,12 @@ (defknown set-header-data (t (unsigned-byte 24)) t (unsafe)) +(defknown %array-dimension (t index) index + (flushable)) +(defknown %set-array-dimension (t index index) index + ()) +(defknown %array-rank (t) index + (flushable)) (defknown %make-instance (index) instance (unsafe)) diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index 2ca4be0..94f54c1 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -696,21 +696,21 @@ ;;;; Bignum stuff. (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) + (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-set) + (unsigned-reg) unsigned-num sb!bignum:%bignum-set) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -722,7 +722,7 @@ (inst bc :>= not-p digit zero-tn target))) (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -737,7 +737,7 @@ (inst addc zero-tn zero-tn carry))) (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -752,7 +752,7 @@ (inst addc zero-tn zero-tn borrow))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x-arg :scs (unsigned-reg) :target x) (y-arg :scs (unsigned-reg) :target y)) @@ -791,11 +791,11 @@ (define-source-transform sb!bignum:%multiply-and-add (x y carry &optional (extra 0)) #+nil ;; This would be greate if it worked, but it doesn't. (if (eql extra 0) - `(multiple-value-call #'sb!bignum::%dual-word-add + `(multiple-value-call #'sb!bignum:%dual-word-add (sb!bignum:%multiply ,x ,y) (values ,carry)) - `(multiple-value-call #'sb!bignum::%dual-word-add - (multiple-value-call #'sb!bignum::%dual-word-add + `(multiple-value-call #'sb!bignum:%dual-word-add + (multiple-value-call #'sb!bignum:%dual-word-add (sb!bignum:%multiply ,x ,y) (values ,carry)) (values ,extra))) @@ -831,7 +831,7 @@ (inst addc hi zero-tn hi-res))) (define-vop (bignum-lognot) - (:translate sb!bignum::%lognot) + (:translate sb!bignum:%lognot) (:policy :fast-safe) (:args (x :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -841,7 +841,7 @@ (inst uaddcm zero-tn x r))) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (signed-reg))) (:arg-types tagged-num) @@ -851,7 +851,7 @@ (move fixnum digit))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (hi :scs (unsigned-reg) :to (:argument 1)) (lo :scs (unsigned-reg) :to (:argument 0)) @@ -874,7 +874,7 @@ (inst add divisor rem rem))) (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg) :target res)) (:arg-types unsigned-num) @@ -884,7 +884,7 @@ (move digit res))) (define-vop (digit-lshr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -896,7 +896,7 @@ (inst shd zero-tn digit :variable result))) (define-vop (digit-ashr digit-lshr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 1 (inst extrs digit 0 1 temp) @@ -904,7 +904,7 @@ (inst shd temp digit :variable result))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst subi 31 count temp) (inst mtctl temp :sar) diff --git a/src/compiler/hppa/array.lisp b/src/compiler/hppa/array.lisp index e553bcc..c4de673 100644 --- a/src/compiler/hppa/array.lisp +++ b/src/compiler/hppa/array.lisp @@ -1,3 +1,14 @@ +;;;; the HPPA definitions for array operations + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") @@ -28,25 +39,16 @@ ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t index) index - (flushable)) -(defknown sb!impl::%set-array-dimension (t index index) index - ()) - (define-full-reffer %array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%array-dimension) + (any-reg) positive-fixnum sb!kernel:%array-dimension) (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%set-array-dimension) - - -(defknown sb!impl::%array-rank (t) index (flushable)) + (any-reg) positive-fixnum sb!kernel:%set-array-dimension) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:results (res :scs (unsigned-reg))) diff --git a/src/compiler/hppa/insts.lisp b/src/compiler/hppa/insts.lisp index 856770a..e07d742 100644 --- a/src/compiler/hppa/insts.lisp +++ b/src/compiler/hppa/insts.lisp @@ -1,10 +1,18 @@ +;;;; the instruction set definition for HPPA + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") -;;; (def-assembler-params -;;; :scheduler-p nil) (eval-when (:compile-toplevel :load-toplevel :execute) (setf sb!assem:*assem-scheduler-p* nil)) - ;;;; Utility functions. @@ -415,19 +423,19 @@ (declare (ignore inst)) (flet ((nt (x) (if stream (sb!disassem:note x dstate)))) (case (break-im5 chunk dstate) - (#.sb!vm:error-trap + (#.error-trap (nt "Error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.sb!vm:cerror-trap + (#.cerror-trap (nt "Cerror trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.sb!vm:breakpoint-trap + (#.breakpoint-trap (nt "Breakpoint trap")) - (#.sb!vm:pending-interrupt-trap + (#.pending-interrupt-trap (nt "Pending interrupt trap")) - (#.sb!vm:halt-trap + (#.halt-trap (nt "Halt trap")) - (#.sb!vm:fun-end-breakpoint-trap + (#.fun-end-breakpoint-trap (nt "Function end breakpoint trap")) ))) diff --git a/src/compiler/hppa/vm.lisp b/src/compiler/hppa/vm.lisp index faceddc..87d3c9c 100644 --- a/src/compiler/hppa/vm.lisp +++ b/src/compiler/hppa/vm.lisp @@ -1,3 +1,14 @@ +;;;; miscellaneous VM definition noise for HPPA + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") @@ -99,7 +110,7 @@ ((null classes) (nreverse forms)))) -(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -217,7 +228,7 @@ :alternate-scs (complex-double-stack)) ;; A catch or unwind block. - (catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size)) + (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)) ;;;; Make some random tns for important registers. diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index 3b6b890..9188d98 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -736,21 +736,21 @@ ;;;; Bignum stuff. (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) + (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-set) + (unsigned-reg) unsigned-num sb!bignum:%bignum-set) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -763,7 +763,7 @@ (inst nop))) (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -793,7 +793,7 @@ (move result res)))) (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -822,7 +822,7 @@ (move result res)))) (define-vop (bignum-mult-and-add-3-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg)) @@ -841,7 +841,7 @@ (inst addu hi temp))) (define-vop (bignum-mult-and-add-4-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg)) @@ -864,7 +864,7 @@ (inst addu hi temp))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) @@ -878,10 +878,10 @@ (inst mfhi hi))) (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) - (:translate sb!bignum::%lognot)) + (:translate sb!bignum:%lognot)) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (any-reg))) (:arg-types tagged-num) @@ -891,7 +891,7 @@ (inst sra digit fixnum 2))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (num-high :scs (unsigned-reg) :target rem) (num-low :scs (unsigned-reg) :target rem-low) @@ -923,7 +923,7 @@ (inst nor quo zero-tn))) (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg) :target res)) (:arg-types unsigned-num) @@ -938,7 +938,7 @@ (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -949,12 +949,12 @@ (inst sra result digit count))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (inst srl result digit count))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst sll result digit count))) diff --git a/src/compiler/mips/array.lisp b/src/compiler/mips/array.lisp index 27bfa19..79c81a4 100644 --- a/src/compiler/mips/array.lisp +++ b/src/compiler/mips/array.lisp @@ -1,3 +1,14 @@ +;;;; the MIPS definitions for array operations + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") @@ -29,25 +40,16 @@ ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t index) index - (flushable)) -(defknown sb!impl::%set-array-dimension (t index index) index - ()) - (define-full-reffer %array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%array-dimension) + (any-reg) positive-fixnum sb!kernel:%array-dimension) (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%set-array-dimension) - - -(defknown sb!impl::%array-rank (t) index (flushable)) + (any-reg) positive-fixnum sb!kernel:%set-array-dimension) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index 340066e..f061770 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -1,3 +1,14 @@ +;;;; miscellaneous VM definition noise for MIPS + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") @@ -93,7 +104,7 @@ ((null classes) (nreverse forms)))) -(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -220,7 +231,7 @@ :alternate-scs (complex-double-stack)) ;; A catch or unwind block. - (catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size) + (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size) ;; floating point numbers temporarily stuck in integer registers for c-call (single-int-carg-reg registers diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp index cb02b1a..336033d 100644 --- a/src/compiler/ppc/arith.lisp +++ b/src/compiler/ppc/arith.lisp @@ -758,22 +758,22 @@ ;;;; Bignum stuff. (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-vop (bignum-ref word-index-ref) - (:variant sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag) - (:translate sb!bignum::%bignum-ref) + (:variant bignum-digits-offset other-pointer-lowtag) + (:translate sb!bignum:%bignum-ref) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num)) (define-vop (bignum-set word-index-set) - (:variant sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag) - (:translate sb!bignum::%bignum-set) + (:variant bignum-digits-offset other-pointer-lowtag) + (:translate sb!bignum:%bignum-set) (:args (object :scs (descriptor-reg)) (index :scs (any-reg immediate zero)) (value :scs (unsigned-reg))) @@ -782,7 +782,7 @@ (:result-types unsigned-num)) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -796,7 +796,7 @@ (emit-label done)))) (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -812,7 +812,7 @@ (inst addze carry zero-tn))) (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -828,7 +828,7 @@ (inst addze borrow zero-tn))) (define-vop (bignum-mult-and-add-3-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg)) @@ -847,7 +847,7 @@ (inst addze hi hi-temp))) (define-vop (bignum-mult-and-add-4-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg)) @@ -869,7 +869,7 @@ (inst addze hi hi-temp))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :to (:eval 1)) (y :scs (unsigned-reg) :to (:eval 1))) @@ -882,10 +882,10 @@ (inst mulhwu hi x y))) (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) - (:translate sb!bignum::%lognot)) + (:translate sb!bignum:%lognot)) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (any-reg))) (:arg-types tagged-num) @@ -896,7 +896,7 @@ (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (num-high :scs (unsigned-reg) :target rem) (num-low :scs (unsigned-reg) :target rem-low) @@ -934,7 +934,7 @@ #| (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target rem) (div-low :scs (unsigned-reg) :target quo) @@ -950,7 +950,7 @@ |# (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg) :target res)) (:arg-types unsigned-num) @@ -965,7 +965,7 @@ (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -976,12 +976,12 @@ (inst sraw result digit count))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (inst srw result digit count))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst slw result digit count))) diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index a00f0ad..2a141f7 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -27,51 +27,39 @@ (:generator 0 (pseudo-atomic (pa-flag) (inst ori header alloc-tn other-pointer-lowtag) - (inst addi ndescr rank (* (1+ array-dimensions-offset) sb!vm:n-word-bytes)) + (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) (inst clrrwi ndescr ndescr n-lowtag-bits) (inst add alloc-tn alloc-tn ndescr) - (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset))) - (inst slwi ndescr ndescr sb!vm:n-widetag-bits) + (inst addi ndescr rank (fixnumize (1- array-dimensions-offset))) + (inst slwi ndescr ndescr n-widetag-bits) (inst or ndescr ndescr type) (inst srwi ndescr ndescr 2) - (storew ndescr header 0 sb!vm:other-pointer-lowtag)) + (storew ndescr header 0 other-pointer-lowtag)) (move result header))) ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t fixnum) fixnum - (flushable)) -(defknown sb!impl::%set-array-dimension (t fixnum fixnum) fixnum - ()) - (define-vop (%array-dimension word-index-ref) - (:translate sb!impl::%array-dimension) + (:translate sb!kernel:%array-dimension) (:policy :fast-safe) - (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag)) + (:variant array-dimensions-offset other-pointer-lowtag)) (define-vop (%set-array-dimension word-index-set) - (:translate sb!impl::%set-array-dimension) + (:translate sb!kernel:%set-array-dimension) (:policy :fast-safe) - (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag)) - - - -(defknown sb!impl::%array-rank (t) fixnum (flushable)) + (:variant array-dimensions-offset other-pointer-lowtag)) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:results (res :scs (any-reg descriptor-reg))) (:generator 6 - (loadw temp x 0 sb!vm:other-pointer-lowtag) - (inst srawi temp temp sb!vm:n-widetag-bits) - (inst subi temp temp (1- sb!vm:array-dimensions-offset)) + (loadw temp x 0 other-pointer-lowtag) + (inst srawi temp temp n-widetag-bits) + (inst subi temp temp (1- array-dimensions-offset)) (inst slwi res temp 2))) - - ;;;; Bounds checking routine. @@ -105,7 +93,7 @@ (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type)) ,(symbolicate (string variant) "-REF")) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types ,type positive-fixnum) (:results (value :scs ,scs)) @@ -113,7 +101,7 @@ (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type)) ,(symbolicate (string variant) "-SET")) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types ,type positive-fixnum ,element-type) (:args (object :scs (descriptor-reg)) @@ -152,7 +140,7 @@ ;;; (macrolet ((def-small-data-vector-frobs (type bits) - (let* ((elements-per-word (floor sb!vm:n-word-bits bits)) + (let* ((elements-per-word (floor n-word-bits bits)) (bit-shift (1- (integer-length elements-per-word)))) `(progn (define-vop (,(symbolicate 'data-vector-ref/ type)) @@ -168,8 +156,8 @@ (:generator 20 (inst srwi temp index ,bit-shift) (inst slwi temp temp 2) - (inst addi temp temp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi temp temp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lwzx result object temp) (inst andi. temp index ,(1- elements-per-word)) (inst xori temp temp ,(1- elements-per-word)) @@ -191,9 +179,9 @@ (multiple-value-bind (word extra) (floor index ,elements-per-word) (setf extra (logxor extra (1- ,elements-per-word))) - (let ((offset (- (* (+ word sb!vm:vector-data-offset) - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + (let ((offset (- (* (+ word vector-data-offset) + n-word-bytes) + other-pointer-lowtag))) (cond ((typep offset '(signed-byte 16)) (inst lwz result object offset)) (t @@ -218,8 +206,8 @@ (:generator 25 (inst srwi offset index ,bit-shift) (inst slwi offset offset 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lwzx old object offset) (inst andi. shift index ,(1- elements-per-word)) (inst xori shift shift ,(1- elements-per-word)) @@ -259,8 +247,8 @@ (:temporary (:scs (non-descriptor-reg)) offset-reg temp old) (:generator 20 (multiple-value-bind (word extra) (floor index ,elements-per-word) - (let ((offset (- (* (+ word sb!vm:vector-data-offset) sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) + other-pointer-lowtag))) (cond ((typep offset '(signed-byte 16)) (inst lwz old object offset)) (t @@ -322,8 +310,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:result-types single-float) (:generator 5 - (inst addi offset index (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset index (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfsx value object offset))) @@ -340,8 +328,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:generator 5 (inst addi offset index - (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfsx value object offset) (unless (location= result value) (inst frsp result value)))) @@ -358,8 +346,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:generator 7 (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfdx value object offset))) (define-vop (data-vector-set/simple-array-double-float) @@ -375,8 +363,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:generator 20 (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfdx value object offset) (unless (location= result value) (inst fmr result value)))) @@ -397,11 +385,11 @@ (:generator 5 (let ((real-tn (complex-single-reg-real-tn value))) (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfsx real-tn object offset)) (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst addi offset offset sb!vm:n-word-bytes) + (inst addi offset offset n-word-bytes) (inst lfsx imag-tn object offset)))) (define-vop (data-vector-set/simple-array-complex-single-float) @@ -420,14 +408,14 @@ (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfsx value-real object offset) (unless (location= result-real value-real) (inst frsp result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) - (inst addi offset offset sb!vm:n-word-bytes) + (inst addi offset offset n-word-bytes) (inst stfsx value-imag object offset) (unless (location= result-imag value-imag) (inst frsp result-imag value-imag))))) @@ -446,11 +434,11 @@ (:generator 7 (let ((real-tn (complex-double-reg-real-tn value))) (inst slwi offset index 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfdx real-tn object offset)) (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst addi offset offset (* 2 sb!vm:n-word-bytes)) + (inst addi offset offset (* 2 n-word-bytes)) (inst lfdx imag-tn object offset)))) (define-vop (data-vector-set/simple-array-complex-double-float) @@ -469,14 +457,14 @@ (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) (inst slwi offset index 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfdx value-real object offset) (unless (location= result-real value-real) (inst fmr result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) - (inst addi offset offset (* 2 sb!vm:n-word-bytes)) + (inst addi offset offset (* 2 n-word-bytes)) (inst stfdx value-imag object offset) (unless (location= result-imag value-imag) (inst fmr result-imag value-imag))))) @@ -533,7 +521,7 @@ (:translate %raw-bits) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 sb!vm:other-pointer-lowtag)) + (:variant 0 other-pointer-lowtag)) (define-vop (set-raw-bits word-index-set) (:note "setf raw-bits VOP") @@ -544,7 +532,7 @@ (:arg-types * positive-fixnum unsigned-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 sb!vm:other-pointer-lowtag)) + (:variant 0 other-pointer-lowtag)) @@ -567,7 +555,7 @@ (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types simple-array-signed-byte-8 positive-fixnum) (:results (value :scs (signed-reg))) @@ -575,7 +563,7 @@ (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num) (:args (object :scs (descriptor-reg)) @@ -587,7 +575,7 @@ (define-vop (data-vector-ref/simple-array-signed-byte-16 signed-halfword-index-ref) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types simple-array-signed-byte-16 positive-fixnum) (:results (value :scs (signed-reg))) @@ -595,7 +583,7 @@ (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num) (:args (object :scs (descriptor-reg)) diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp index 28f9088..fb9cd13 100644 --- a/src/compiler/ppc/call.lisp +++ b/src/compiler/ppc/call.lisp @@ -103,7 +103,7 @@ ;;; ../alpha/call.lisp (defun bytes-needed-for-non-descriptor-stack-frame () (logandc2 (+ +stack-alignment-bytes+ number-stack-displacement - (* (sb-allocated-size 'non-descriptor-stack) sb!vm:n-word-bytes)) + (* (sb-allocated-size 'non-descriptor-stack) n-word-bytes)) +stack-alignment-bytes+)) @@ -139,7 +139,7 @@ (emit-label start-lab) ;; Allocate function header. (inst simple-fun-header-word) - (dotimes (i (1- sb!vm:simple-fun-code-offset)) + (dotimes (i (1- simple-fun-code-offset)) (inst word 0)) (let* ((entry-point (gen-label))) (emit-label entry-point) @@ -776,10 +776,10 @@ default-value-8 (do-next-filler)) (constant (loadw lexenv code-tn (tn-offset arg-fun) - sb!vm:other-pointer-lowtag) + other-pointer-lowtag) (do-next-filler))) - (loadw function lexenv sb!vm:closure-fun-slot - sb!vm:fun-pointer-lowtag) + (loadw function lexenv closure-fun-slot + fun-pointer-lowtag) (do-next-filler) (inst addi entry-point function (- (ash simple-fun-code-offset word-shift) @@ -1067,10 +1067,10 @@ default-value-8 (emit-label loop) ;; *--dst = *--src, --count - (inst addi src src (- sb!vm:n-word-bytes)) + (inst addi src src (- n-word-bytes)) (inst addic. count count (- (fixnumize 1))) (loadw temp src) - (inst addi dst dst (- sb!vm:n-word-bytes)) + (inst addi dst dst (- n-word-bytes)) (storew temp dst) (inst bgt loop) diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index bf175f4..23532f5 100644 --- a/src/compiler/ppc/cell.lisp +++ b/src/compiler/ppc/cell.lisp @@ -1,9 +1,14 @@ -;;; VOPs for the PPC. -;;; -;;; Written by Rob MacLachlan -;;; -;;; Converted by William Lott. -;;; +;;;; the VM definition of various primitive memory access VOPs for the +;;;; PPC + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. (in-package "SB!VM") @@ -53,9 +58,9 @@ (:translate symbol-value) (:generator 9 (move obj-temp object) - (loadw value obj-temp sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) + (loadw value obj-temp symbol-value-slot other-pointer-lowtag) (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp))) - (inst cmpwi value sb!vm:unbound-marker-widetag) + (inst cmpwi value unbound-marker-widetag) (inst beq err-lab)))) ;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound. @@ -69,12 +74,12 @@ (define-vop (boundp boundp-frob) (:translate boundp) (:generator 9 - (loadw value object sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (inst cmpwi value sb!vm:unbound-marker-widetag) + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmpwi value unbound-marker-widetag) (inst b? (if not-p :eq :ne) target))) (define-vop (fast-symbol-value cell-ref) - (:variant sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) + (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate symbol-value)) @@ -144,21 +149,21 @@ (symbol :scs (descriptor-reg))) (:temporary (:scs (descriptor-reg)) temp) (:generator 5 - (loadw temp symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (inst addi bsp-tn bsp-tn (* 2 sb!vm:n-word-bytes)) - (storew temp bsp-tn (- sb!vm:binding-value-slot sb!vm:binding-size)) - (storew symbol bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) - (storew val symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag))) + (loadw temp symbol symbol-value-slot other-pointer-lowtag) + (inst addi bsp-tn bsp-tn (* 2 n-word-bytes)) + (storew temp bsp-tn (- binding-value-slot binding-size)) + (storew symbol bsp-tn (- binding-symbol-slot binding-size)) + (storew val symbol symbol-value-slot other-pointer-lowtag))) (define-vop (unbind) (:temporary (:scs (descriptor-reg)) symbol value) (:generator 0 - (loadw symbol bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) - (loadw value bsp-tn (- sb!vm:binding-value-slot sb!vm:binding-size)) - (storew value symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (storew zero-tn bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) - (inst subi bsp-tn bsp-tn (* 2 sb!vm:n-word-bytes)))) + (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) + (loadw value bsp-tn (- binding-value-slot binding-size)) + (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) + (inst subi bsp-tn bsp-tn (* 2 n-word-bytes)))) (define-vop (unbind-to-here) @@ -174,15 +179,15 @@ (inst beq done) (emit-label loop) - (loadw symbol bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) + (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (inst cmpwi symbol 0) (inst beq skip) - (loadw value bsp-tn (- sb!vm:binding-value-slot sb!vm:binding-size)) - (storew value symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (storew zero-tn bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) + (loadw value bsp-tn (- binding-value-slot binding-size)) + (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) - (inst subi bsp-tn bsp-tn (* 2 sb!vm:n-word-bytes)) + (inst subi bsp-tn bsp-tn (* 2 n-word-bytes)) (inst cmpw where bsp-tn) (inst bne loop) @@ -193,11 +198,11 @@ ;;;; Closure indexing. (define-vop (closure-index-ref word-index-ref) - (:variant sb!vm:closure-info-offset sb!vm:fun-pointer-lowtag) + (:variant closure-info-offset fun-pointer-lowtag) (:translate %closure-index-ref)) (define-vop (funcallable-instance-info word-index-ref) - (:variant funcallable-instance-info-offset sb!vm:fun-pointer-lowtag) + (:variant funcallable-instance-info-offset fun-pointer-lowtag) (:translate %funcallable-instance-info)) (define-vop (set-funcallable-instance-info word-index-set) @@ -236,7 +241,7 @@ (:result-types positive-fixnum) (:generator 4 (loadw temp struct 0 instance-pointer-lowtag) - (inst srwi res temp sb!vm:n-widetag-bits))) + (inst srwi res temp n-widetag-bits))) (define-vop (instance-ref slot-ref) (:variant instance-slots-offset instance-pointer-lowtag) diff --git a/src/compiler/ppc/char.lisp b/src/compiler/ppc/char.lisp index 04192de..4d4b357 100644 --- a/src/compiler/ppc/char.lisp +++ b/src/compiler/ppc/char.lisp @@ -19,7 +19,7 @@ (:results (y :scs (base-char-reg))) (:note "character untagging") (:generator 1 - (inst srwi y x sb!vm:n-widetag-bits))) + (inst srwi y x n-widetag-bits))) (define-move-vop move-to-base-char :move (any-reg descriptor-reg) (base-char-reg)) @@ -31,8 +31,8 @@ (:results (y :scs (any-reg descriptor-reg))) (:note "character tagging") (:generator 1 - (inst slwi y x sb!vm:n-widetag-bits) - (inst ori y y sb!vm:base-char-widetag))) + (inst slwi y x n-widetag-bits) + (inst ori y y base-char-widetag))) (define-move-vop move-from-base-char :move (base-char-reg) (any-reg descriptor-reg)) diff --git a/src/compiler/ppc/debug.lisp b/src/compiler/ppc/debug.lisp index cf5db5f..c358474 100644 --- a/src/compiler/ppc/debug.lisp +++ b/src/compiler/ppc/debug.lisp @@ -1,6 +1,14 @@ -;;; -;;; Written by William Lott. -;;; +;;;; PPC compiler support for the debugger + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") (define-vop (debug-cur-sp) @@ -53,12 +61,12 @@ (let ((bogus (gen-label)) (done (gen-label))) (loadw temp thing 0 lowtag) - (inst srwi temp temp sb!vm:n-widetag-bits) + (inst srwi temp temp n-widetag-bits) (inst cmpwi temp 0) - (inst slwi temp temp (1- (integer-length sb!vm:n-word-bytes))) + (inst slwi temp temp (1- (integer-length n-word-bytes))) (inst beq bogus) - (unless (= lowtag sb!vm:other-pointer-lowtag) - (inst addi temp temp (- lowtag sb!vm:other-pointer-lowtag))) + (unless (= lowtag other-pointer-lowtag) + (inst addi temp temp (- lowtag other-pointer-lowtag))) (inst sub code thing temp) (emit-label done) (assemble (*elsewhere*) @@ -68,11 +76,11 @@ (define-vop (code-from-lra code-from-mumble) (:translate sb!di::lra-code-header) - (:variant sb!vm:other-pointer-lowtag)) + (:variant other-pointer-lowtag)) (define-vop (code-from-fun code-from-mumble) (:translate sb!di::fun-code-header) - (:variant sb!vm:fun-pointer-lowtag)) + (:variant fun-pointer-lowtag)) (define-vop (make-lisp-obj) (:policy :fast-safe) @@ -101,4 +109,4 @@ (:result-types positive-fixnum) (:generator 5 (loadw res fun 0 fun-pointer-lowtag) - (inst srwi res res sb!vm:n-widetag-bits))) + (inst srwi res res n-widetag-bits))) diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp index d2bd56f..c8bfcba 100644 --- a/src/compiler/ppc/float.lisp +++ b/src/compiler/ppc/float.lisp @@ -15,23 +15,23 @@ (define-move-fun (load-single 1) (vop x y) ((single-stack) (single-reg)) - (inst lfs y (current-nfp-tn vop) (* (tn-offset x) sb!vm:n-word-bytes))) + (inst lfs y (current-nfp-tn vop) (* (tn-offset x) n-word-bytes))) (define-move-fun (store-single 1) (vop x y) ((single-reg) (single-stack)) - (inst stfs x (current-nfp-tn vop) (* (tn-offset y) sb!vm:n-word-bytes))) + (inst stfs x (current-nfp-tn vop) (* (tn-offset y) n-word-bytes))) (define-move-fun (load-double 2) (vop x y) ((double-stack) (double-reg)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset x) sb!vm:n-word-bytes))) + (offset (* (tn-offset x) n-word-bytes))) (inst lfd y nfp offset))) (define-move-fun (store-double 2) (vop x y) ((double-reg) (double-stack)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset y) sb!vm:n-word-bytes))) + (offset (* (tn-offset y) n-word-bytes))) (inst stfd x nfp offset))) @@ -65,8 +65,8 @@ (:generator 13 (with-fixed-allocation (y pa-flag ndescr type size)) (if double-p - (inst stfd x y (- (* data sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag)) - (inst stfs x y (- (* data sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag))))) + (inst stfd x y (- (* data n-word-bytes) other-pointer-lowtag)) + (inst stfs x y (- (* data n-word-bytes) other-pointer-lowtag))))) (macrolet ((frob (name sc &rest args) `(progn @@ -76,9 +76,9 @@ (:variant ,@args)) (define-move-vop ,name :move (,sc) (descriptor-reg))))) (frob move-from-single single-reg - nil sb!vm:single-float-size sb!vm:single-float-widetag sb!vm:single-float-value-slot) + nil single-float-size single-float-widetag single-float-value-slot) (frob move-from-double double-reg - t sb!vm:double-float-size sb!vm:double-float-widetag sb!vm:double-float-value-slot)) + t double-float-size double-float-widetag double-float-value-slot)) (macrolet ((frob (name sc double-p value) `(progn @@ -88,10 +88,10 @@ (:note "pointer to float coercion") (:generator 2 (inst ,(if double-p 'lfd 'lfs) y x - (- (* ,value sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag)))) + (- (* ,value n-word-bytes) other-pointer-lowtag)))) (define-move-vop ,name :move (descriptor-reg) (,sc))))) - (frob move-to-single single-reg nil sb!vm:single-float-value-slot) - (frob move-to-double double-reg t sb!vm:double-float-value-slot)) + (frob move-to-single single-reg nil single-float-value-slot) + (frob move-to-double double-reg t double-float-value-slot)) (macrolet ((frob (name sc stack-sc double-p) @@ -108,7 +108,7 @@ (unless (location= x y) (inst fmr y x))) (,stack-sc - (let ((offset (* (tn-offset y) sb!vm:n-word-bytes))) + (let ((offset (* (tn-offset y) n-word-bytes))) (inst ,(if double-p 'stfd 'stfs) x nfp offset)))))) (define-move-vop ,name :move-arg (,sc descriptor-reg) (,sc))))) @@ -137,39 +137,39 @@ (define-move-fun (load-complex-single 2) (vop x y) ((complex-single-stack) (complex-single-reg)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset x) sb!vm:n-word-bytes))) + (offset (* (tn-offset x) n-word-bytes))) (let ((real-tn (complex-single-reg-real-tn y))) (inst lfs real-tn nfp offset)) (let ((imag-tn (complex-single-reg-imag-tn y))) - (inst lfs imag-tn nfp (+ offset sb!vm:n-word-bytes))))) + (inst lfs imag-tn nfp (+ offset n-word-bytes))))) (define-move-fun (store-complex-single 2) (vop x y) ((complex-single-reg) (complex-single-stack)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset y) sb!vm:n-word-bytes))) + (offset (* (tn-offset y) n-word-bytes))) (let ((real-tn (complex-single-reg-real-tn x))) (inst stfs real-tn nfp offset)) (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst stfs imag-tn nfp (+ offset sb!vm:n-word-bytes))))) + (inst stfs imag-tn nfp (+ offset n-word-bytes))))) (define-move-fun (load-complex-double 4) (vop x y) ((complex-double-stack) (complex-double-reg)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset x) sb!vm:n-word-bytes))) + (offset (* (tn-offset x) n-word-bytes))) (let ((real-tn (complex-double-reg-real-tn y))) (inst lfd real-tn nfp offset)) (let ((imag-tn (complex-double-reg-imag-tn y))) - (inst lfd imag-tn nfp (+ offset (* 2 sb!vm:n-word-bytes)))))) + (inst lfd imag-tn nfp (+ offset (* 2 n-word-bytes)))))) (define-move-fun (store-complex-double 4) (vop x y) ((complex-double-reg) (complex-double-stack)) (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset y) sb!vm:n-word-bytes))) + (offset (* (tn-offset y) n-word-bytes))) (let ((real-tn (complex-double-reg-real-tn x))) (inst stfd real-tn nfp offset)) (let ((imag-tn (complex-double-reg-imag-tn x))) - (inst stfd imag-tn nfp (+ offset (* 2 sb!vm:n-word-bytes)))))) + (inst stfd imag-tn nfp (+ offset (* 2 n-word-bytes)))))) ;;; @@ -225,16 +225,16 @@ (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:note "complex single float to pointer coercion") (:generator 13 - (with-fixed-allocation (y pa-flag ndescr sb!vm:complex-single-float-widetag - sb!vm:complex-single-float-size)) + (with-fixed-allocation (y pa-flag ndescr complex-single-float-widetag + complex-single-float-size)) (let ((real-tn (complex-single-reg-real-tn x))) - (inst stfs real-tn y (- (* sb!vm:complex-single-float-real-slot - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + (inst stfs real-tn y (- (* complex-single-float-real-slot + n-word-bytes) + other-pointer-lowtag))) (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst stfs imag-tn y (- (* sb!vm:complex-single-float-imag-slot - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))))) + (inst stfs imag-tn y (- (* complex-single-float-imag-slot + n-word-bytes) + other-pointer-lowtag))))) ;;; (define-move-vop move-from-complex-single :move (complex-single-reg) (descriptor-reg)) @@ -246,16 +246,16 @@ (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:note "complex double float to pointer coercion") (:generator 13 - (with-fixed-allocation (y pa-flag ndescr sb!vm:complex-double-float-widetag - sb!vm:complex-double-float-size)) + (with-fixed-allocation (y pa-flag ndescr complex-double-float-widetag + complex-double-float-size)) (let ((real-tn (complex-double-reg-real-tn x))) - (inst stfd real-tn y (- (* sb!vm:complex-double-float-real-slot - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + (inst stfd real-tn y (- (* complex-double-float-real-slot + n-word-bytes) + other-pointer-lowtag))) (let ((imag-tn (complex-double-reg-imag-tn x))) - (inst stfd imag-tn y (- (* sb!vm:complex-double-float-imag-slot - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))))) + (inst stfd imag-tn y (- (* complex-double-float-imag-slot + n-word-bytes) + other-pointer-lowtag))))) ;;; (define-move-vop move-from-complex-double :move (complex-double-reg) (descriptor-reg)) @@ -461,10 +461,10 @@ (:vop-var vop) (:save-p :compute-only) (:generator 5 - (let* ((stack-offset (* (tn-offset temp) sb!vm:n-word-bytes)) + (let* ((stack-offset (* (tn-offset temp) n-word-bytes)) (nfp-tn (current-nfp-tn vop)) - (temp-offset-high (* stack-offset sb!vm:n-word-bytes)) - (temp-offset-low (* (1+ stack-offset) sb!vm:n-word-bytes))) + (temp-offset-high (* stack-offset n-word-bytes)) + (temp-offset-low (* (1+ stack-offset) n-word-bytes))) (inst lis rtemp #x4330) ; High word of magic constant (inst stw rtemp nfp-tn temp-offset-high) (inst lis rtemp #x8000) @@ -514,9 +514,9 @@ (note-this-location vop :internal-error) (inst ,inst temp x) (inst stfd temp (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (* (tn-offset stack-temp) n-word-bytes)) (inst lwz y (current-nfp-tn vop) - (+ 4 (* (tn-offset stack-temp) sb!vm:n-word-bytes))))))) + (+ 4 (* (tn-offset stack-temp) n-word-bytes))))))) (frob %unary-truncate single-reg single-float fctiwz) (frob %unary-truncate double-reg double-float fctiwz) (frob %unary-round single-reg single-float fctiw) @@ -540,23 +540,23 @@ (sc-case res (single-reg (inst stw bits (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (* (tn-offset stack-temp) n-word-bytes)) (inst lfs res (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes))) + (* (tn-offset stack-temp) n-word-bytes))) (single-stack (inst stw bits (current-nfp-tn vop) - (* (tn-offset res) sb!vm:n-word-bytes))))) + (* (tn-offset res) n-word-bytes))))) (signed-stack (sc-case res (single-reg (inst lfs res (current-nfp-tn vop) - (* (tn-offset bits) sb!vm:n-word-bytes))) + (* (tn-offset bits) n-word-bytes))) (single-stack (unless (location= bits res) (inst lwz temp (current-nfp-tn vop) - (* (tn-offset bits) sb!vm:n-word-bytes)) + (* (tn-offset bits) n-word-bytes)) (inst stw temp (current-nfp-tn vop) - (* (tn-offset res) sb!vm:n-word-bytes))))))))) + (* (tn-offset res) n-word-bytes))))))))) (define-vop (make-double-float) (:args (hi-bits :scs (signed-reg)) @@ -574,12 +574,12 @@ (double-stack res) (double-reg temp)))) (inst stw hi-bits (current-nfp-tn vop) - (* (tn-offset stack-tn) sb!vm:n-word-bytes)) + (* (tn-offset stack-tn) n-word-bytes)) (inst stw lo-bits (current-nfp-tn vop) - (* (1+ (tn-offset stack-tn)) sb!vm:n-word-bytes))) + (* (1+ (tn-offset stack-tn)) n-word-bytes))) (when (sc-is res double-reg) (inst lfd res (current-nfp-tn vop) - (* (tn-offset temp) sb!vm:n-word-bytes))))) + (* (tn-offset temp) n-word-bytes))))) (define-vop (single-float-bits) (:args (float :scs (single-reg descriptor-reg) @@ -599,19 +599,19 @@ (sc-case float (single-reg (inst stfs float (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (* (tn-offset stack-temp) n-word-bytes)) (inst lwz bits (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes))) + (* (tn-offset stack-temp) n-word-bytes))) (single-stack (inst lwz bits (current-nfp-tn vop) - (* (tn-offset float) sb!vm:n-word-bytes))) + (* (tn-offset float) n-word-bytes))) (descriptor-reg - (loadw bits float sb!vm:single-float-value-slot sb!vm:other-pointer-lowtag)))) + (loadw bits float single-float-value-slot other-pointer-lowtag)))) (signed-stack (sc-case float (single-reg (inst stfs float (current-nfp-tn vop) - (* (tn-offset bits) sb!vm:n-word-bytes)))))))) + (* (tn-offset bits) n-word-bytes)))))))) (define-vop (double-float-high-bits) (:args (float :scs (double-reg descriptor-reg) @@ -627,15 +627,15 @@ (sc-case float (double-reg (inst stfd float (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (* (tn-offset stack-temp) n-word-bytes)) (inst lwz hi-bits (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes))) + (* (tn-offset stack-temp) n-word-bytes))) (double-stack (inst lwz hi-bits (current-nfp-tn vop) - (* (tn-offset float) sb!vm:n-word-bytes))) + (* (tn-offset float) n-word-bytes))) (descriptor-reg - (loadw hi-bits float sb!vm:double-float-value-slot - sb!vm:other-pointer-lowtag))))) + (loadw hi-bits float double-float-value-slot + other-pointer-lowtag))))) (define-vop (double-float-low-bits) (:args (float :scs (double-reg descriptor-reg) @@ -651,15 +651,15 @@ (sc-case float (double-reg (inst stfd float (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (* (tn-offset stack-temp) n-word-bytes)) (inst lwz lo-bits (current-nfp-tn vop) - (* (1+ (tn-offset stack-temp)) sb!vm:n-word-bytes))) + (* (1+ (tn-offset stack-temp)) n-word-bytes))) (double-stack (inst lwz lo-bits (current-nfp-tn vop) - (* (1+ (tn-offset float)) sb!vm:n-word-bytes))) + (* (1+ (tn-offset float)) n-word-bytes))) (descriptor-reg - (loadw lo-bits float (1+ sb!vm:double-float-value-slot) - sb!vm:other-pointer-lowtag))))) + (loadw lo-bits float (1+ double-float-value-slot) + other-pointer-lowtag))))) ;;;; Float mode hackery: @@ -725,10 +725,10 @@ (inst fmr r-imag imag)))) (complex-single-stack (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset r) sb!vm:n-word-bytes))) + (offset (* (tn-offset r) n-word-bytes))) (unless (location= real r) (inst stfs real nfp offset)) - (inst stfs imag nfp (+ offset sb!vm:n-word-bytes))))))) + (inst stfs imag nfp (+ offset n-word-bytes))))))) (define-vop (make-complex-double-float) (:translate complex) @@ -753,10 +753,10 @@ (inst fmr r-imag imag)))) (complex-double-stack (let ((nfp (current-nfp-tn vop)) - (offset (* (tn-offset r) sb!vm:n-word-bytes))) + (offset (* (tn-offset r) n-word-bytes))) (unless (location= real r) (inst stfd real nfp offset)) - (inst stfd imag nfp (+ offset (* 2 sb!vm:n-word-bytes)))))))) + (inst stfd imag nfp (+ offset (* 2 n-word-bytes)))))))) (define-vop (complex-single-float-value) @@ -779,7 +779,7 @@ (complex-single-stack (inst lfs r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 1)) (tn-offset x)) - sb!vm:n-word-bytes)))))) + n-word-bytes)))))) (define-vop (realpart/complex-single-float complex-single-float-value) (:translate realpart) @@ -811,7 +811,7 @@ (complex-double-stack (inst lfd r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 2)) (tn-offset x)) - sb!vm:n-word-bytes)))))) + n-word-bytes)))))) (define-vop (realpart/complex-double-float complex-double-float-value) (:translate realpart) @@ -822,5 +822,3 @@ (:translate imagpart) (:note "complex double float imagpart") (:variant :imag)) - - diff --git a/src/compiler/ppc/insts.lisp b/src/compiler/ppc/insts.lisp index 26bad5c..2c86cd6 100644 --- a/src/compiler/ppc/insts.lisp +++ b/src/compiler/ppc/insts.lisp @@ -232,10 +232,10 @@ (cond (length-only (values 0 (1+ length) nil nil)) (t - (sb!kernel:copy-from-system-area sap (* sb!vm:n-byte-bits (1+ offset)) - vector (* sb!vm:n-word-bits - sb!vm:vector-data-offset) - (* length sb!vm:n-byte-bits)) + (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset)) + vector (* n-word-bits + vector-data-offset) + (* length n-byte-bits)) (collect ((sc-offsets) (lengths)) (lengths 1) ; the length byte @@ -623,23 +623,23 @@ (declare (ignore inst)) (flet ((nt (x) (if stream (sb!disassem:note x dstate)))) (case (xinstr-data chunk dstate) - (#.sb!vm:error-trap + (#.error-trap (nt "Error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.sb!vm:cerror-trap + (#.cerror-trap (nt "Cerror trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.sb!vm:object-not-list-trap + (#.object-not-list-trap (nt "Object not list trap")) - (#.sb!vm:breakpoint-trap + (#.breakpoint-trap (nt "Breakpoint trap")) - (#.sb!vm:pending-interrupt-trap + (#.pending-interrupt-trap (nt "Pending interrupt trap")) - (#.sb!vm:halt-trap + (#.halt-trap (nt "Halt trap")) - (#.sb!vm:fun-end-breakpoint-trap + (#.fun-end-breakpoint-trap (nt "Function end breakpoint trap")) - (#.sb!vm:object-not-instance-trap + (#.object-not-instance-trap (nt "Object not instance trap")) ))) diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index bb38e53..a4da8d3 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -76,8 +76,8 @@ "Jump to the lisp function FUNCTION. LIP is an interior-reg temporary." `(progn ;; something is deeply bogus. look at this - ;; (loadw ,lip ,function sb!vm:function-code-offset sb!vm:function-pointer-type) - (inst addi ,lip ,function (- (* n-word-bytes sb!vm:simple-fun-code-offset) sb!vm:fun-pointer-lowtag)) + ;; (loadw ,lip ,function function-code-offset function-pointer-type) + (inst addi ,lip ,function (- (* n-word-bytes simple-fun-code-offset) fun-pointer-lowtag)) (inst mtctr ,lip) (move code-tn ,function) (inst bctr))) diff --git a/src/compiler/ppc/memory.lisp b/src/compiler/ppc/memory.lisp index 6a71ba7..ca9870e 100644 --- a/src/compiler/ppc/memory.lisp +++ b/src/compiler/ppc/memory.lisp @@ -1,12 +1,17 @@ -;;; reference VOPs inherited by basic memory reference operations. -;;; -;;; Written by Rob MacLachlan -;;; -;;; Converted by William Lott. -;;; +;;;; the PPC definitions of some general purpose memory reference VOPs +;;;; inherited by basic memory reference operations -(in-package "SB!VM") +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") + ;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the offset to ;;; be read or written is a property of the VOP used. ;;; @@ -70,8 +75,8 @@ (let ((offset (- (+ (if (sc-is index zero) 0 (ash (tn-value index) - (- sb!vm:word-shift ,shift))) - (ash offset sb!vm:word-shift)) + (- word-shift ,shift))) + (ash offset word-shift)) lowtag))) (etypecase offset ((signed-byte 16) @@ -83,7 +88,7 @@ ,@(unless (zerop shift) `((inst srwi temp index ,shift))) (inst addi temp ,(if (zerop shift) 'index 'temp) - (- (ash offset sb!vm:word-shift) lowtag)) + (- (ash offset word-shift) lowtag)) (inst ,rr-op value object temp))) ,@(when sign-extend-byte `((inst extsb value value))) diff --git a/src/compiler/ppc/nlx.lisp b/src/compiler/ppc/nlx.lisp index b1815a6..b950e5e 100644 --- a/src/compiler/ppc/nlx.lisp +++ b/src/compiler/ppc/nlx.lisp @@ -1,5 +1,15 @@ -;;; Written by Rob MacLachlan -;;; +;;;; the PPC definitions of VOPs used for non-local exit (throw, +;;;; lexical exit, etc.) + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. @@ -70,13 +80,13 @@ (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 22 - (inst addi block cfp-tn (* (tn-offset tn) sb!vm:n-word-bytes)) + (inst addi block cfp-tn (* (tn-offset tn) n-word-bytes)) (load-symbol-value temp *current-unwind-protect-block*) - (storew temp block sb!vm:unwind-block-current-uwp-slot) - (storew cfp-tn block sb!vm:unwind-block-current-cont-slot) - (storew code-tn block sb!vm:unwind-block-current-code-slot) + (storew temp block unwind-block-current-uwp-slot) + (storew cfp-tn block unwind-block-current-cont-slot) + (storew code-tn block unwind-block-current-code-slot) (inst compute-lra-from-code temp code-tn entry-label ndescr) - (storew temp block sb!vm:catch-block-entry-pc-slot))) + (storew temp block catch-block-entry-pc-slot))) ;;; Like Make-Unwind-Block, except that we also store in the specified tag, and @@ -91,17 +101,17 @@ (:temporary (:scs (descriptor-reg) :target block :to (:result 0)) result) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 44 - (inst addi result cfp-tn (* (tn-offset tn) sb!vm:n-word-bytes)) + (inst addi result cfp-tn (* (tn-offset tn) n-word-bytes)) (load-symbol-value temp *current-unwind-protect-block*) - (storew temp result sb!vm:catch-block-current-uwp-slot) - (storew cfp-tn result sb!vm:catch-block-current-cont-slot) - (storew code-tn result sb!vm:catch-block-current-code-slot) + (storew temp result catch-block-current-uwp-slot) + (storew cfp-tn result catch-block-current-cont-slot) + (storew code-tn result catch-block-current-code-slot) (inst compute-lra-from-code temp code-tn entry-label ndescr) - (storew temp result sb!vm:catch-block-entry-pc-slot) + (storew temp result catch-block-entry-pc-slot) - (storew tag result sb!vm:catch-block-tag-slot) + (storew tag result catch-block-tag-slot) (load-symbol-value temp *current-catch-block*) - (storew temp result sb!vm:catch-block-previous-catch-slot) + (storew temp result catch-block-previous-catch-slot) (store-symbol-value result *current-catch-block*) (move block result))) @@ -114,7 +124,7 @@ (:args (tn)) (:temporary (:scs (descriptor-reg)) new-uwp) (:generator 7 - (inst addi new-uwp cfp-tn (* (tn-offset tn) sb!vm:n-word-bytes)) + (inst addi new-uwp cfp-tn (* (tn-offset tn) n-word-bytes)) (store-symbol-value new-uwp *current-unwind-protect-block*))) @@ -124,7 +134,7 @@ (:translate %catch-breakup) (:generator 17 (load-symbol-value block *current-catch-block*) - (loadw block block sb!vm:catch-block-previous-catch-slot) + (loadw block block catch-block-previous-catch-slot) (store-symbol-value block *current-catch-block*))) (define-vop (unlink-unwind-protect) @@ -133,7 +143,7 @@ (:translate %unwind-protect-breakup) (:generator 17 (load-symbol-value block *current-unwind-protect-block*) - (loadw block block sb!vm:unwind-block-current-uwp-slot) + (loadw block block unwind-block-current-uwp-slot) (store-symbol-value block *current-unwind-protect-block*))) diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index 6a1377f..4e05dd7 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -2,6 +2,14 @@ ;;;; attributes for the PPC. This file is separate from other stuff so ;;;; that it can be compiled and loaded earlier. +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. (in-package "SB!VM") @@ -88,13 +96,10 @@ (def!constant number-stack-displacement (* #!-darwin 2 #!+darwin 8 - sb!vm:n-word-bytes)) - + n-word-bytes)) - ;;; Where to put the different spaces. -;;; (def!constant read-only-space-start #x01000000) (def!constant read-only-space-end #x04ff8000) diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp index 23f7a25..8d74e7c 100644 --- a/src/compiler/ppc/system.lisp +++ b/src/compiler/ppc/system.lisp @@ -1,11 +1,15 @@ -;;; -;;; Written by Rob MacLachlan -;;; -;;; Mips conversion by William Lott and Christopher Hoover. -;;; -(in-package "SB!VM") +;;;; PPC VM definitions of various system hacking operations +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") ;;;; Type frobbing VOPs @@ -16,7 +20,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 1 - (inst andi. result object sb!vm:lowtag-mask))) + (inst andi. result object lowtag-mask))) (define-vop (widetag-of) (:translate widetag-of) @@ -61,7 +65,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type result function (- sb!vm:fun-pointer-lowtag)))) + (load-type result function (- fun-pointer-lowtag)))) (define-vop (set-fun-subtype) (:translate (setf fun-subtype)) @@ -82,8 +86,8 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 sb!vm:other-pointer-lowtag) - (inst srwi res res sb!vm:n-widetag-bits))) + (loadw res x 0 other-pointer-lowtag) + (inst srwi res res n-widetag-bits))) (define-vop (get-closure-length) (:translate get-closure-length) @@ -92,8 +96,8 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (loadw res x 0 sb!vm:fun-pointer-lowtag) - (inst srwi res res sb!vm:n-widetag-bits))) + (loadw res x 0 fun-pointer-lowtag) + (inst srwi res res n-widetag-bits))) (define-vop (set-header-data) (:translate set-header-data) @@ -104,16 +108,16 @@ (:results (res :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) t1 t2) (:generator 6 - (loadw t1 x 0 sb!vm:other-pointer-lowtag) - (inst andi. t1 t1 sb!vm:widetag-mask) + (loadw t1 x 0 other-pointer-lowtag) + (inst andi. t1 t1 widetag-mask) (sc-case data (any-reg - (inst slwi t2 data (- sb!vm:n-widetag-bits 2)) + (inst slwi t2 data (- n-widetag-bits 2)) (inst or t1 t1 t2)) (immediate - (inst ori t1 t1 (ash (tn-value data) sb!vm:n-widetag-bits))) + (inst ori t1 t1 (ash (tn-value data) n-widetag-bits))) (zero)) - (storew t1 x 0 sb!vm:other-pointer-lowtag) + (storew t1 x 0 other-pointer-lowtag) (move res x))) @@ -136,11 +140,11 @@ (:generator 2 (sc-case type (immediate - (inst slwi temp val sb!vm:n-widetag-bits) + (inst slwi temp val n-widetag-bits) (inst ori res temp (tn-value type))) (t (inst srawi temp type 2) - (inst slwi res val (- sb!vm:n-widetag-bits 2)) + (inst slwi res val (- n-widetag-bits 2)) (inst or res res temp))))) @@ -181,10 +185,10 @@ (:results (sap :scs (sap-reg))) (:result-types system-area-pointer) (:generator 10 - (loadw ndescr code 0 sb!vm:other-pointer-lowtag) - (inst srwi ndescr ndescr sb!vm:n-widetag-bits) - (inst slwi ndescr ndescr sb!vm:word-shift) - (inst subi ndescr ndescr sb!vm:other-pointer-lowtag) + (loadw ndescr code 0 other-pointer-lowtag) + (inst srwi ndescr ndescr n-widetag-bits) + (inst slwi ndescr ndescr word-shift) + (inst subi ndescr ndescr other-pointer-lowtag) (inst add sap code ndescr))) (define-vop (compute-fun) @@ -194,11 +198,11 @@ (:results (func :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 10 - (loadw ndescr code 0 sb!vm:other-pointer-lowtag) - (inst srwi ndescr ndescr sb!vm:n-widetag-bits) - (inst slwi ndescr ndescr sb!vm:word-shift) + (loadw ndescr code 0 other-pointer-lowtag) + (inst srwi ndescr ndescr n-widetag-bits) + (inst slwi ndescr ndescr word-shift) (inst add ndescr ndescr offset) - (inst addi ndescr ndescr (- sb!vm:fun-pointer-lowtag sb!vm:other-pointer-lowtag)) + (inst addi ndescr ndescr (- fun-pointer-lowtag other-pointer-lowtag)) (inst add func code ndescr))) diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 3f41b89..12b552c 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -1,4 +1,14 @@ -;;; +;;;; miscellaneous VM definition noise for the PPC + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") @@ -98,9 +108,7 @@ ((null classes) (nreverse forms)))) -;; XXX this is most likely wrong. Check with Eric Marsden next time you -;; see him -(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (define-storage-classes @@ -221,9 +229,7 @@ ;; A catch or unwind block. (catch-block control-stack - :element-size sb!vm::kludge-nondeterministic-catch-block-size)) - - + :element-size kludge-nondeterministic-catch-block-size)) ;;;; Make some random tns for important registers. diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index 412c56f..7acaa6b 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -874,22 +874,22 @@ ;;;; Bignum stuff. (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-vop (bignum-ref word-index-ref) (:variant bignum-digits-offset other-pointer-lowtag) - (:translate sb!bignum::%bignum-ref) + (:translate sb!bignum:%bignum-ref) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num)) (define-vop (bignum-set word-index-set) (:variant bignum-digits-offset other-pointer-lowtag) - (:translate sb!bignum::%bignum-set) + (:translate sb!bignum:%bignum-set) (:args (object :scs (descriptor-reg)) (index :scs (any-reg immediate zero)) (value :scs (unsigned-reg))) @@ -898,7 +898,7 @@ (:result-types unsigned-num)) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -913,7 +913,7 @@ (emit-label done)))) (define-vop (v9-digit-0-or-plus-cmove) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -927,7 +927,7 @@ ;; This doesn't work? #+nil (define-vop (v9-digit-0-or-plus-movr) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -940,7 +940,7 @@ (inst movr result temp digit :gez))) (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -955,7 +955,7 @@ (inst addx carry zero-tn zero-tn))) (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg)) (b :scs (unsigned-reg)) @@ -1023,7 +1023,7 @@ (inst rdy result-low))))) (define-vop (bignum-mult-and-add-3-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :to (:eval 1)) (y :scs (unsigned-reg) :to (:eval 1)) @@ -1038,7 +1038,7 @@ (inst addx hi zero-tn))) (define-vop (bignum-mult-and-add-4-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :to (:eval 1)) (y :scs (unsigned-reg) :to (:eval 1)) @@ -1056,7 +1056,7 @@ (inst addx hi zero-tn))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :to (:result 1)) (y :scs (unsigned-reg) :to (:result 1))) @@ -1068,10 +1068,10 @@ (emit-multiply x y hi lo))) (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) - (:translate sb!bignum::%lognot)) + (:translate sb!bignum:%lognot)) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (any-reg))) (:arg-types tagged-num) @@ -1081,7 +1081,7 @@ (inst sra digit fixnum n-fixnum-tag-bits))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target rem) (div-low :scs (unsigned-reg) :target quo) @@ -1105,7 +1105,7 @@ (inst not quo))) (define-vop (bignum-floor-v8) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target rem) (div-low :scs (unsigned-reg) :target quo) @@ -1134,7 +1134,7 @@ (move quo q)))) (define-vop (bignum-floor-v9) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg)) (div-low :scs (unsigned-reg)) @@ -1156,7 +1156,7 @@ (inst sub rem dividend rem))) (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg) :target res)) (:arg-types unsigned-num) @@ -1170,7 +1170,7 @@ (move res digit))))) (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -1181,12 +1181,12 @@ (inst sra result digit count))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (inst srl result digit count))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst sll result digit count))) diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index e48b0a0..a984102 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -39,28 +39,18 @@ ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t fixnum) fixnum - (flushable)) -(defknown sb!impl::%set-array-dimension (t fixnum fixnum) fixnum - ()) - (define-vop (%array-dimension word-index-ref) - (:translate sb!impl::%array-dimension) + (:translate sb!kernel:%array-dimension) (:policy :fast-safe) (:variant array-dimensions-offset other-pointer-lowtag)) (define-vop (%set-array-dimension word-index-set) - (:translate sb!impl::%set-array-dimension) + (:translate sb!kernel:%set-array-dimension) (:policy :fast-safe) (:variant array-dimensions-offset other-pointer-lowtag)) - - -(defknown sb!impl::%array-rank (t) fixnum (flushable)) - (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) @@ -70,12 +60,8 @@ (inst sra temp n-widetag-bits) (inst sub temp (1- array-dimensions-offset)) (inst sll res temp n-fixnum-tag-bits))) - - ;;;; Bounds checking routine. - - (define-vop (check-bound) (:translate %check-bound) (:policy :fast-safe) @@ -92,8 +78,6 @@ (inst b :geu error) (inst nop) (move result index)))) - - ;;;; Accessors/Setters diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp index c6f3de7..5ae9ef2 100644 --- a/src/compiler/sparc/float.lisp +++ b/src/compiler/sparc/float.lisp @@ -2510,7 +2510,7 @@ ;;; expression since we don't have to do branches. (define-source-transform min (&rest args) - (if (member :sparc-v9 sb!vm:*backend-subfeatures*) + (if (member :sparc-v9 *backend-subfeatures*) (case (length args) ((0 2) (values nil t)) (1 `(values ,(first args))) @@ -2518,7 +2518,7 @@ (values nil t))) (define-source-transform max (&rest args) - (if (member :sparc-v9 sb!vm:*backend-subfeatures*) + (if (member :sparc-v9 *backend-subfeatures*) (case (length args) ((0 2) (values nil t)) (1 `(values ,(first args))) @@ -2551,8 +2551,8 @@ (deftransform max ((x y) (number number) *) (let ((x-type (lvar-type x)) (y-type (lvar-type y)) - (signed (specifier-type '(signed-byte #.sb!vm:n-word-bits))) - (unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits))) + (signed (specifier-type '(signed-byte #.n-word-bits))) + (unsigned (specifier-type '(unsigned-byte #.n-word-bits))) (d-float (specifier-type 'double-float)) (s-float (specifier-type 'single-float))) ;; Use %%max if both args are good types of the same type. As a @@ -2581,8 +2581,8 @@ (deftransform min ((x y) (real real) *) (let ((x-type (lvar-type x)) (y-type (lvar-type y)) - (signed (specifier-type '(signed-byte #.sb!vm:n-word-bits))) - (unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits))) + (signed (specifier-type '(signed-byte #.n-word-bits))) + (unsigned (specifier-type '(unsigned-byte #.n-word-bits))) (d-float (specifier-type 'double-float)) (s-float (specifier-type 'single-float))) (cond ((and (csubtypep x-type signed) diff --git a/src/compiler/sparc/nlx.lisp b/src/compiler/sparc/nlx.lisp index c761d32..12e29f7 100644 --- a/src/compiler/sparc/nlx.lisp +++ b/src/compiler/sparc/nlx.lisp @@ -1,5 +1,5 @@ -;;;; the definitions of VOPs used for non-local exit (throw, lexical -;;;; exit, etc.) +;;;; the SPARC definitions of VOPs used for non-local exit (throw, +;;;; lexical exit, etc.) ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index cf1041d..e2d549a 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -118,7 +118,7 @@ ;;; and seems to be working so far -dan ;;; ;;; arbitrarily taken for alpha, too. - Christophe -(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -270,7 +270,7 @@ ;; A catch or unwind block. - (catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size)) + (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)) ;;;; Make some miscellaneous TNs for important registers. (macrolet ((defregtn (name sc) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 36b869d..3c7dda2 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1,4 +1,4 @@ -;;;; the VM definition arithmetic VOPs for the x86 +;;;; the VM definition of arithmetic VOPs for the x86 ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -1203,21 +1203,21 @@ ;;;; bignum stuff (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) + (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-set) + (unsigned-reg) unsigned-num sb!bignum:%bignum-set) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -1233,7 +1233,7 @@ ;;; 4. This is easy to deal with and may save a fixnum-word ;;; conversion. (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg) :target result) (b :scs (unsigned-reg unsigned-stack) :to :eval) @@ -1254,7 +1254,7 @@ ;;; Note: the borrow is the oppostite of the x86 convention - 1 for no ;;; borrow and 0 for a borrow. (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg) :to :eval :target result) (b :scs (unsigned-reg unsigned-stack) :to :result) @@ -1273,7 +1273,7 @@ (define-vop (bignum-mult-and-add-3-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :target eax) (y :scs (unsigned-reg unsigned-stack)) @@ -1295,7 +1295,7 @@ (move lo eax))) (define-vop (bignum-mult-and-add-4-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :target eax) (y :scs (unsigned-reg unsigned-stack)) @@ -1321,7 +1321,7 @@ (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :target eax) (y :scs (unsigned-reg unsigned-stack))) @@ -1340,10 +1340,10 @@ (move lo eax))) (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) - (:translate sb!bignum::%lognot)) + (:translate sb!bignum:%lognot)) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (any-reg control-stack) :target digit)) (:arg-types tagged-num) @@ -1357,7 +1357,7 @@ (inst sar digit 2))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target edx) (div-low :scs (unsigned-reg) :target eax) @@ -1378,7 +1378,7 @@ (move rem edx))) (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg unsigned-stack) :target res)) (:arg-types unsigned-num) @@ -1393,7 +1393,7 @@ (inst shl res 2)))) (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg unsigned-stack) :target result) (count :scs (unsigned-reg) :target ecx)) @@ -1409,14 +1409,14 @@ (inst sar result :cl))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (move result digit) (move ecx count) (inst shr result :cl))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (move result digit) (move ecx count) diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp index c240261..a13fb67 100644 --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -40,24 +40,16 @@ (storew header result 0 other-pointer-lowtag)))) ;;;; additional accessors and setters for the array header - -(defknown sb!impl::%array-dimension (t index) index - (flushable)) -(defknown sb!impl::%set-array-dimension (t index index) index - ()) - (define-full-reffer %array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%array-dimension) + (any-reg) positive-fixnum sb!kernel:%array-dimension) (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%set-array-dimension) - -(defknown sb!impl::%array-rank (t) index (flushable)) + (any-reg) positive-fixnum sb!kernel:%set-array-dimension) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:results (res :scs (unsigned-reg))) @@ -160,7 +152,7 @@ ;;;; bit, 2-bit, and 4-bit vectors (macrolet ((def-small-data-vector-frobs (type bits) - (let* ((elements-per-word (floor sb!vm:n-word-bits bits)) + (let* ((elements-per-word (floor n-word-bits bits)) (bit-shift (1- (integer-length elements-per-word)))) `(progn (define-vop (,(symbolicate 'data-vector-ref/ type)) @@ -307,9 +299,9 @@ (:generator 5 (with-empty-tn@fp-top(value) (inst fld (make-ea :dword :base object :index index :scale 1 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)))))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag)))))) (define-vop (data-vector-ref-c/simple-array-single-float) (:note "inline array access") @@ -323,10 +315,10 @@ (:generator 4 (with-empty-tn@fp-top(value) (inst fld (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 4 index)) - sb!vm:other-pointer-lowtag)))))) + other-pointer-lowtag)))))) (define-vop (data-vector-set/simple-array-single-float) (:note "inline array store") @@ -342,9 +334,9 @@ (cond ((zerop (tn-offset value)) ;; Value is in ST0. (inst fst (make-ea :dword :base object :index index :scale 1 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fst result))) @@ -352,9 +344,9 @@ ;; Value is not in ST0. (inst fxch value) (inst fst (make-ea :dword :base object :index index :scale 1 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fst value)) @@ -379,10 +371,10 @@ (cond ((zerop (tn-offset value)) ;; Value is in ST0. (inst fst (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 4 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fst result))) @@ -390,10 +382,10 @@ ;; Value is not in ST0. (inst fxch value) (inst fst (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 4 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fst value)) @@ -415,9 +407,9 @@ (:generator 7 (with-empty-tn@fp-top(value) (inst fldd (make-ea :dword :base object :index index :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)))))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag)))))) (define-vop (data-vector-ref-c/simple-array-double-float) (:note "inline array access") @@ -431,10 +423,10 @@ (:generator 6 (with-empty-tn@fp-top(value) (inst fldd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index)) - sb!vm:other-pointer-lowtag)))))) + other-pointer-lowtag)))))) (define-vop (data-vector-set/simple-array-double-float) (:note "inline array store") @@ -450,9 +442,9 @@ (cond ((zerop (tn-offset value)) ;; Value is in ST0. (inst fstd (make-ea :dword :base object :index index :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -460,9 +452,9 @@ ;; Value is not in ST0. (inst fxch value) (inst fstd (make-ea :dword :base object :index index :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -487,10 +479,10 @@ (cond ((zerop (tn-offset value)) ;; Value is in ST0. (inst fstd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -498,10 +490,10 @@ ;; Value is not in ST0. (inst fxch value) (inst fstd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -527,9 +519,9 @@ (inst lea temp (make-ea :dword :base index :index index :scale 2)) (with-empty-tn@fp-top(value) (inst fldl (make-ea :dword :base object :index temp :scale 1 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)))))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag)))))) #!+long-float (define-vop (data-vector-ref-c/simple-array-long-float) @@ -544,10 +536,10 @@ (:generator 6 (with-empty-tn@fp-top(value) (inst fldl (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 12 index)) - sb!vm:other-pointer-lowtag)))))) + other-pointer-lowtag)))))) #!+long-float (define-vop (data-vector-set/simple-array-long-float) @@ -568,8 +560,8 @@ ;; Value is in ST0. (store-long-float (make-ea :dword :base object :index temp :scale 1 - :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -578,8 +570,8 @@ (inst fxch value) (store-long-float (make-ea :dword :base object :index temp :scale 1 - :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -604,10 +596,10 @@ (cond ((zerop (tn-offset value)) ;; Value is in ST0. (store-long-float (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 12 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (zerop (tn-offset result)) ;; Value is in ST0 but not result. (inst fstd result))) @@ -615,10 +607,10 @@ ;; Value is not in ST0. (inst fxch value) (store-long-float (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 12 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (cond ((zerop (tn-offset result)) ;; The result is in ST0. (inst fstd value)) @@ -643,15 +635,15 @@ (let ((real-tn (complex-single-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) (inst fld (make-ea :dword :base object :index index :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))))) (let ((imag-tn (complex-single-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fld (make-ea :dword :base object :index index :scale 2 - :disp (- (* (1+ sb!vm:vector-data-offset) - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))))))) + :disp (- (* (1+ vector-data-offset) + n-word-bytes) + other-pointer-lowtag))))))) (define-vop (data-vector-ref-c/simple-array-complex-single-float) (:note "inline array access") @@ -666,17 +658,17 @@ (let ((real-tn (complex-single-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) (inst fld (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index)) - sb!vm:other-pointer-lowtag))))) + other-pointer-lowtag))))) (let ((imag-tn (complex-single-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fld (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index) 4) - sb!vm:other-pointer-lowtag))))))) + other-pointer-lowtag))))))) (define-vop (data-vector-set/simple-array-complex-single-float) (:note "inline array store") @@ -695,9 +687,9 @@ (cond ((zerop (tn-offset value-real)) ;; Value is in ST0. (inst fst (make-ea :dword :base object :index index :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fst result-real))) @@ -705,9 +697,9 @@ ;; Value is not in ST0. (inst fxch value-real) (inst fst (make-ea :dword :base object :index index :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fst value-real)) @@ -720,10 +712,10 @@ (result-imag (complex-single-reg-imag-tn result))) (inst fxch value-imag) (inst fst (make-ea :dword :base object :index index :scale 2 - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) 4) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fst result-imag)) (inst fxch value-imag)))) @@ -745,10 +737,10 @@ (cond ((zerop (tn-offset value-real)) ;; Value is in ST0. (inst fst (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fst result-real))) @@ -756,10 +748,10 @@ ;; Value is not in ST0. (inst fxch value-real) (inst fst (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fst value-real)) @@ -772,10 +764,10 @@ (result-imag (complex-single-reg-imag-tn result))) (inst fxch value-imag) (inst fst (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 8 index) 4) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fst result-imag)) (inst fxch value-imag)))) @@ -794,16 +786,16 @@ (let ((real-tn (complex-double-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) (inst fldd (make-ea :dword :base object :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))))) (let ((imag-tn (complex-double-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldd (make-ea :dword :base object :index index :scale 4 - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) 8) - sb!vm:other-pointer-lowtag))))))) + other-pointer-lowtag))))))) (define-vop (data-vector-ref-c/simple-array-complex-double-float) (:note "inline array access") @@ -818,17 +810,17 @@ (let ((real-tn (complex-double-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) (inst fldd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 16 index)) - sb!vm:other-pointer-lowtag))))) + other-pointer-lowtag))))) (let ((imag-tn (complex-double-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 16 index) 8) - sb!vm:other-pointer-lowtag))))))) + other-pointer-lowtag))))))) (define-vop (data-vector-set/simple-array-complex-double-float) (:note "inline array store") @@ -847,9 +839,9 @@ (cond ((zerop (tn-offset value-real)) ;; Value is in ST0. (inst fstd (make-ea :dword :base object :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -857,9 +849,9 @@ ;; Value is not in ST0. (inst fxch value-real) (inst fstd (make-ea :dword :base object :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -872,10 +864,10 @@ (result-imag (complex-double-reg-imag-tn result))) (inst fxch value-imag) (inst fstd (make-ea :dword :base object :index index :scale 4 - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) 8) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -897,10 +889,10 @@ (cond ((zerop (tn-offset value-real)) ;; Value is in ST0. (inst fstd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 16 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -908,10 +900,10 @@ ;; Value is not in ST0. (inst fxch value-real) (inst fstd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 16 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -924,10 +916,10 @@ (result-imag (complex-double-reg-imag-tn result))) (inst fxch value-imag) (inst fstd (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 16 index) 8) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -950,16 +942,16 @@ (let ((real-tn (complex-long-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) (inst fldl (make-ea :dword :base object :index temp :scale 2 - :disp (- (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))))) + :disp (- (* vector-data-offset + n-word-bytes) + other-pointer-lowtag))))) (let ((imag-tn (complex-long-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldl (make-ea :dword :base object :index temp :scale 2 - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) 12) - sb!vm:other-pointer-lowtag))))))) + other-pointer-lowtag))))))) #!+long-float (define-vop (data-vector-ref-c/simple-array-complex-long-float) @@ -975,17 +967,17 @@ (let ((real-tn (complex-long-reg-real-tn value))) (with-empty-tn@fp-top (real-tn) (inst fldl (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 24 index)) - sb!vm:other-pointer-lowtag))))) + other-pointer-lowtag))))) (let ((imag-tn (complex-long-reg-imag-tn value))) (with-empty-tn@fp-top (imag-tn) (inst fldl (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 24 index) 12) - sb!vm:other-pointer-lowtag))))))) + other-pointer-lowtag))))))) #!+long-float (define-vop (data-vector-set/simple-array-complex-long-float) @@ -1009,8 +1001,8 @@ ;; Value is in ST0. (store-long-float (make-ea :dword :base object :index temp :scale 2 - :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -1019,8 +1011,8 @@ (inst fxch value-real) (store-long-float (make-ea :dword :base object :index temp :scale 2 - :disp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + :disp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -1034,8 +1026,8 @@ (inst fxch value-imag) (store-long-float (make-ea :dword :base object :index temp :scale 2 - :disp (- (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes) 12) - sb!vm:other-pointer-lowtag))) + :disp (- (+ (* vector-data-offset n-word-bytes) 12) + other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) @@ -1059,10 +1051,10 @@ ;; Value is in ST0. (store-long-float (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 24 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (zerop (tn-offset result-real)) ;; Value is in ST0 but not result. (inst fstd result-real))) @@ -1071,10 +1063,10 @@ (inst fxch value-real) (store-long-float (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) (* 24 index)) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (cond ((zerop (tn-offset result-real)) ;; The result is in ST0. (inst fstd value-real)) @@ -1088,15 +1080,15 @@ (inst fxch value-imag) (store-long-float (make-ea :dword :base object - :disp (- (+ (* sb!vm:vector-data-offset - sb!vm:n-word-bytes) + :disp (- (+ (* vector-data-offset + n-word-bytes) ;; FIXME: There are so many of these bare constants ;; (24, 12..) in the LONG-FLOAT code that it's ;; ridiculous. I should probably just delete it all ;; instead of appearing to flirt with supporting ;; this maintenance nightmare. (* 24 index) 12) - sb!vm:other-pointer-lowtag))) + other-pointer-lowtag))) (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 1a42db4..29cb698 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -637,7 +637,7 @@ (let ((offset (fixup-offset fixup))) (if (label-p offset) (emit-back-patch segment - 4 ; FIXME: sb!vm:n-word-bytes + 4 ; FIXME: n-word-bytes (lambda (segment posn) (declare (ignore posn)) (emit-dword segment diff --git a/tools-for-build/.cvsignore b/tools-for-build/.cvsignore index 144fd45..9e0c53c 100644 --- a/tools-for-build/.cvsignore +++ b/tools-for-build/.cvsignore @@ -1,3 +1,3 @@ -grovel_headers +grovel-headers determine-endianness where-is-mcontext diff --git a/tools-for-build/Makefile b/tools-for-build/Makefile index b188542..db33d7d 100644 --- a/tools-for-build/Makefile +++ b/tools-for-build/Makefile @@ -11,7 +11,7 @@ CPPFLAGS=-I../src/runtime -all: grovel_headers determine-endianness where-is-mcontext +all: grovel-headers determine-endianness where-is-mcontext clean: - rm -f *.o grovel_headers determine-endianness where-is-mcontext + rm -f *.o grovel-headers determine-endianness where-is-mcontext diff --git a/tools-for-build/grovel-headers.c b/tools-for-build/grovel-headers.c new file mode 100644 index 0000000..2254aa3 --- /dev/null +++ b/tools-for-build/grovel-headers.c @@ -0,0 +1,196 @@ +/* + * Rummage through the system header files using the C compiler itself + * as a parser, extracting stuff like preprocessor constants and the + * sizes and signedness of basic system types, and write it out as + * Lisp code. + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * While most of SBCL is derived from the CMU CL system, many + * utilities for the build process (like this one) were written from + * scratch after the fork from CMU CL. + * + * This software is in the public domain and is provided with + * absolutely no warranty. See the COPYING and CREDITS files for + * more information. + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "genesis/config.h" + +#define DEFTYPE(lispname,cname) { cname foo; \ + printf("(define-alien-type " lispname " (%s %d))\n", (((foo=-1)<0) ? "sb!alien:signed" : "unsigned"), (8 * (sizeof foo))); } + +void +defconstant(char* lisp_name, long unix_number) +{ + printf("(defconstant %s %ld) ; #x%lx\n", + lisp_name, unix_number, unix_number); +} + +#define DEFSIGNAL(name) defconstant(#name, name) + +int +main(int argc, char *argv[]) +{ + /* don't need no steenking command line arguments */ + if (1 != argc) { + fprintf(stderr, "argh! command line argument(s)\n"); + exit(1); + } + + /* don't need no steenking hand-editing */ + printf( +";;;; This is an automatically generated file, please do not hand-edit it.\n\ +;;;; See the program \"grovel_headers.c\".\n\ +\n\ +"); + + printf("(in-package \"SB!UNIX\")\n\n"); + + printf(";;; types, types, types\n"); + DEFTYPE("clock-t", clock_t); + DEFTYPE("dev-t", dev_t); + DEFTYPE("gid-t", gid_t); + DEFTYPE("ino-t", ino_t); + DEFTYPE("mode-t", mode_t); + DEFTYPE("nlink-t", nlink_t); + DEFTYPE("off-t", off_t); + DEFTYPE("size-t", size_t); + DEFTYPE("time-t", time_t); + DEFTYPE("uid-t", uid_t); + printf("\n"); + + printf(";;; fcntl.h (or unistd.h on OpenBSD)\n"); + defconstant("r_ok", R_OK); + defconstant("w_ok", W_OK); + defconstant("x_ok", X_OK); + defconstant("f_ok", F_OK); + printf("\n"); + + printf(";;; fcntlbits.h\n"); + defconstant("o_rdonly", O_RDONLY); + defconstant("o_wronly", O_WRONLY); + defconstant("o_rdwr", O_RDWR); + defconstant("o_accmode", O_ACCMODE); + defconstant("o_creat", O_CREAT); + defconstant("o_excl", O_EXCL); + defconstant("o_noctty", O_NOCTTY); + defconstant("o_trunc", O_TRUNC); + defconstant("o_append", O_APPEND); + printf(";;;\n"); + defconstant("s-ifmt", S_IFMT); + defconstant("s-ififo", S_IFIFO); + defconstant("s-ifchr", S_IFCHR); + defconstant("s-ifdir", S_IFDIR); + defconstant("s-ifblk", S_IFBLK); + defconstant("s-ifreg", S_IFREG); + printf("\n"); + + defconstant("s-iflnk", S_IFLNK); + defconstant("s-ifsock", S_IFSOCK); + printf("\n"); + + printf(";;; for wait3(2) in run-program.lisp\n"); + defconstant("wnohang", WNOHANG); + defconstant("wuntraced", WUNTRACED); + printf("\n"); + + printf(";;; various ioctl(2) flags\n"); + defconstant("tiocnotty", TIOCNOTTY); + defconstant("tiocgwinsz", TIOCGWINSZ); + defconstant("tiocswinsz", TIOCSWINSZ); + defconstant("tiocgpgrp", TIOCGPGRP); + defconstant("tiocspgrp", TIOCSPGRP); + /* KLUDGE: These are referenced by old CMUCL-derived code, but + * Linux doesn't define them. + * + * I think these are the BSD names, but I don't know what the + * corresponding SysV/Linux names are. As a point of reference, + * CMUCL doesn't have these defined either (although the defining + * forms *do* exist in src/code/unix.lisp), so I don't feel nearly + * so bad about not hunting them down. Insight into renamed + * obscure ioctl(2) flags appreciated. --njf, 2002-08-26 + * + * I note that the first one I grepped for, TIOCSIGSEND, is + * referenced in SBCL conditional on #+HPUX. Maybe the porters of + * Oxbridge know more about things like that? And even if they + * don't, one benefit of the Rhodes crusade to heal the worthy + * ports should be that afterwards, if we grep for something like + * this in CVS and it's not there, we can lightheartedly nuke it. + * -- WHN 2002-08-30 */ + /* + defconstant("tiocsigsend", TIOCSIGSEND); + defconstant("tiocflush", TIOCFLUSH); + defconstant("tiocgetp", TIOCGETP); + defconstant("tiocsetp", TIOCSETP); + defconstant("tiocgetc", TIOCGETC); + defconstant("tiocsetc", TIOCSETC); + defconstant("tiocgltc", TIOCGLTC); + defconstant("tiocsltc", TIOCSLTC); + */ + printf("\n"); + + printf(";;; signals\n"); + DEFSIGNAL(SIGALRM); + DEFSIGNAL(SIGBUS); + DEFSIGNAL(SIGCHLD); + DEFSIGNAL(SIGCONT); +/* FIXME: Maybe #ifdef SIGEMT would be a smarter conditional? */ +#if (!(defined LISP_FEATURE_LINUX) || !((defined LISP_FEATURE_PPC) || (defined LISP_FEATURE_X86))) + DEFSIGNAL(SIGEMT); +#endif + DEFSIGNAL(SIGFPE); + DEFSIGNAL(SIGHUP); + DEFSIGNAL(SIGILL); + DEFSIGNAL(SIGINT); + DEFSIGNAL(SIGIO); + DEFSIGNAL(SIGIOT); + DEFSIGNAL(SIGKILL); + DEFSIGNAL(SIGPIPE); + DEFSIGNAL(SIGPROF); + DEFSIGNAL(SIGQUIT); + DEFSIGNAL(SIGSEGV); +#if ((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_X86)) + DEFSIGNAL(SIGSTKFLT); +#endif + DEFSIGNAL(SIGSTOP); +#if (!((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_X86))) + DEFSIGNAL(SIGSYS); +#endif + DEFSIGNAL(SIGTERM); + DEFSIGNAL(SIGTRAP); + DEFSIGNAL(SIGTSTP); + DEFSIGNAL(SIGTTIN); + DEFSIGNAL(SIGTTOU); + DEFSIGNAL(SIGURG); + DEFSIGNAL(SIGUSR1); + DEFSIGNAL(SIGUSR2); + DEFSIGNAL(SIGVTALRM); +#ifdef LISP_FEATURE_SUNOS + DEFSIGNAL(SIGWAITING); +#endif + DEFSIGNAL(SIGWINCH); +#ifndef LISP_FEATURE_HPUX + DEFSIGNAL(SIGXCPU); + DEFSIGNAL(SIGXFSZ); +#endif +#ifdef LISP_FEATURE_SB_THREAD + /* FIXME OAOOM alert: this information is duplicated in linux-os.h */ + defconstant("sig-dequeue",SIGRTMIN+2); +#endif + return 0; +} diff --git a/tools-for-build/grovel_headers.c b/tools-for-build/grovel_headers.c deleted file mode 100644 index 2254aa3..0000000 --- a/tools-for-build/grovel_headers.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Rummage through the system header files using the C compiler itself - * as a parser, extracting stuff like preprocessor constants and the - * sizes and signedness of basic system types, and write it out as - * Lisp code. - */ - -/* - * This software is part of the SBCL system. See the README file for - * more information. - * - * While most of SBCL is derived from the CMU CL system, many - * utilities for the build process (like this one) were written from - * scratch after the fork from CMU CL. - * - * This software is in the public domain and is provided with - * absolutely no warranty. See the COPYING and CREDITS files for - * more information. - */ - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "genesis/config.h" - -#define DEFTYPE(lispname,cname) { cname foo; \ - printf("(define-alien-type " lispname " (%s %d))\n", (((foo=-1)<0) ? "sb!alien:signed" : "unsigned"), (8 * (sizeof foo))); } - -void -defconstant(char* lisp_name, long unix_number) -{ - printf("(defconstant %s %ld) ; #x%lx\n", - lisp_name, unix_number, unix_number); -} - -#define DEFSIGNAL(name) defconstant(#name, name) - -int -main(int argc, char *argv[]) -{ - /* don't need no steenking command line arguments */ - if (1 != argc) { - fprintf(stderr, "argh! command line argument(s)\n"); - exit(1); - } - - /* don't need no steenking hand-editing */ - printf( -";;;; This is an automatically generated file, please do not hand-edit it.\n\ -;;;; See the program \"grovel_headers.c\".\n\ -\n\ -"); - - printf("(in-package \"SB!UNIX\")\n\n"); - - printf(";;; types, types, types\n"); - DEFTYPE("clock-t", clock_t); - DEFTYPE("dev-t", dev_t); - DEFTYPE("gid-t", gid_t); - DEFTYPE("ino-t", ino_t); - DEFTYPE("mode-t", mode_t); - DEFTYPE("nlink-t", nlink_t); - DEFTYPE("off-t", off_t); - DEFTYPE("size-t", size_t); - DEFTYPE("time-t", time_t); - DEFTYPE("uid-t", uid_t); - printf("\n"); - - printf(";;; fcntl.h (or unistd.h on OpenBSD)\n"); - defconstant("r_ok", R_OK); - defconstant("w_ok", W_OK); - defconstant("x_ok", X_OK); - defconstant("f_ok", F_OK); - printf("\n"); - - printf(";;; fcntlbits.h\n"); - defconstant("o_rdonly", O_RDONLY); - defconstant("o_wronly", O_WRONLY); - defconstant("o_rdwr", O_RDWR); - defconstant("o_accmode", O_ACCMODE); - defconstant("o_creat", O_CREAT); - defconstant("o_excl", O_EXCL); - defconstant("o_noctty", O_NOCTTY); - defconstant("o_trunc", O_TRUNC); - defconstant("o_append", O_APPEND); - printf(";;;\n"); - defconstant("s-ifmt", S_IFMT); - defconstant("s-ififo", S_IFIFO); - defconstant("s-ifchr", S_IFCHR); - defconstant("s-ifdir", S_IFDIR); - defconstant("s-ifblk", S_IFBLK); - defconstant("s-ifreg", S_IFREG); - printf("\n"); - - defconstant("s-iflnk", S_IFLNK); - defconstant("s-ifsock", S_IFSOCK); - printf("\n"); - - printf(";;; for wait3(2) in run-program.lisp\n"); - defconstant("wnohang", WNOHANG); - defconstant("wuntraced", WUNTRACED); - printf("\n"); - - printf(";;; various ioctl(2) flags\n"); - defconstant("tiocnotty", TIOCNOTTY); - defconstant("tiocgwinsz", TIOCGWINSZ); - defconstant("tiocswinsz", TIOCSWINSZ); - defconstant("tiocgpgrp", TIOCGPGRP); - defconstant("tiocspgrp", TIOCSPGRP); - /* KLUDGE: These are referenced by old CMUCL-derived code, but - * Linux doesn't define them. - * - * I think these are the BSD names, but I don't know what the - * corresponding SysV/Linux names are. As a point of reference, - * CMUCL doesn't have these defined either (although the defining - * forms *do* exist in src/code/unix.lisp), so I don't feel nearly - * so bad about not hunting them down. Insight into renamed - * obscure ioctl(2) flags appreciated. --njf, 2002-08-26 - * - * I note that the first one I grepped for, TIOCSIGSEND, is - * referenced in SBCL conditional on #+HPUX. Maybe the porters of - * Oxbridge know more about things like that? And even if they - * don't, one benefit of the Rhodes crusade to heal the worthy - * ports should be that afterwards, if we grep for something like - * this in CVS and it's not there, we can lightheartedly nuke it. - * -- WHN 2002-08-30 */ - /* - defconstant("tiocsigsend", TIOCSIGSEND); - defconstant("tiocflush", TIOCFLUSH); - defconstant("tiocgetp", TIOCGETP); - defconstant("tiocsetp", TIOCSETP); - defconstant("tiocgetc", TIOCGETC); - defconstant("tiocsetc", TIOCSETC); - defconstant("tiocgltc", TIOCGLTC); - defconstant("tiocsltc", TIOCSLTC); - */ - printf("\n"); - - printf(";;; signals\n"); - DEFSIGNAL(SIGALRM); - DEFSIGNAL(SIGBUS); - DEFSIGNAL(SIGCHLD); - DEFSIGNAL(SIGCONT); -/* FIXME: Maybe #ifdef SIGEMT would be a smarter conditional? */ -#if (!(defined LISP_FEATURE_LINUX) || !((defined LISP_FEATURE_PPC) || (defined LISP_FEATURE_X86))) - DEFSIGNAL(SIGEMT); -#endif - DEFSIGNAL(SIGFPE); - DEFSIGNAL(SIGHUP); - DEFSIGNAL(SIGILL); - DEFSIGNAL(SIGINT); - DEFSIGNAL(SIGIO); - DEFSIGNAL(SIGIOT); - DEFSIGNAL(SIGKILL); - DEFSIGNAL(SIGPIPE); - DEFSIGNAL(SIGPROF); - DEFSIGNAL(SIGQUIT); - DEFSIGNAL(SIGSEGV); -#if ((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_X86)) - DEFSIGNAL(SIGSTKFLT); -#endif - DEFSIGNAL(SIGSTOP); -#if (!((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_X86))) - DEFSIGNAL(SIGSYS); -#endif - DEFSIGNAL(SIGTERM); - DEFSIGNAL(SIGTRAP); - DEFSIGNAL(SIGTSTP); - DEFSIGNAL(SIGTTIN); - DEFSIGNAL(SIGTTOU); - DEFSIGNAL(SIGURG); - DEFSIGNAL(SIGUSR1); - DEFSIGNAL(SIGUSR2); - DEFSIGNAL(SIGVTALRM); -#ifdef LISP_FEATURE_SUNOS - DEFSIGNAL(SIGWAITING); -#endif - DEFSIGNAL(SIGWINCH); -#ifndef LISP_FEATURE_HPUX - DEFSIGNAL(SIGXCPU); - DEFSIGNAL(SIGXFSZ); -#endif -#ifdef LISP_FEATURE_SB_THREAD - /* FIXME OAOOM alert: this information is duplicated in linux-os.h */ - defconstant("sig-dequeue",SIGRTMIN+2); -#endif - return 0; -} diff --git a/version.lisp-expr b/version.lisp-expr index a681f34..e397a3c 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.5.28" +"0.8.5.29"