# 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
"%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"
"%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"
;;;; 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)
(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))
(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))
(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))
(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))
(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)))
(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)
(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)
(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))
(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)
(define-vop (digit-ashr)
- (:translate sb!bignum::%ashr)
+ (:translate sb!bignum:%ashr)
(:policy :fast-safe)
(:args (digit :scs (unsigned-reg))
(count :scs (unsigned-reg)))
(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)))
\f
\f
;;;; 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)
(inst sra temp n-widetag-bits temp)
(inst subq temp (1- array-dimensions-offset) temp)
(inst sll temp 2 res)))
-
-
\f
;;;; bounds checking routine
(: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))
(: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))
(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*)
(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)
(: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))
(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)))
(: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
(: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)))
(: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)
(: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)
(: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*)))
\f
;;;; NLX entry VOPs
;; 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)
((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
;; 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))
\f
;;; Make some random tns for important registers.
(macrolet ((defregtn (name sc)
(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))
;;;; 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)
(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))
(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))
(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))
(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)))
(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)
(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)
(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))
(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)
(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)))
(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)
(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)
+;;;; 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")
\f
\f
;;;; 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)))
+;;;; 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))
-
\f
;;;; Utility functions.
(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"))
)))
+;;;; 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")
\f
((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
: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))
\f
;;;; Make some random tns for important registers.
;;;; 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)
(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))
(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))
(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))
(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))
(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)))
(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)
(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)
(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)
(define-vop (digit-ashr)
- (:translate sb!bignum::%ashr)
+ (:translate sb!bignum:%ashr)
(:policy :fast-safe)
(:args (digit :scs (unsigned-reg))
(count :scs (unsigned-reg)))
(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)))
+;;;; 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")
\f
\f
;;;; 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)
+;;;; 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")
\f
((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
: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
;;;; 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)))
(: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)
(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))
(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))
(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))
(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))
(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)))
(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)
(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)
#|
(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)
|#
(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)
(define-vop (digit-ashr)
- (:translate sb!bignum::%ashr)
+ (:translate sb!bignum:%ashr)
(:policy :fast-safe)
(:args (digit :scs (unsigned-reg))
(count :scs (unsigned-reg)))
(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)))
(: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)))
\f
;;;; 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)))
-
-
\f
;;;; Bounds checking routine.
(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))
(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))
;;;
(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))
(: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))
(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
(: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))
(: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
(: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)))
(: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))))
(: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)
(: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))))
(: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)
(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)))))
(: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)
(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)))))
(: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")
(: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))
\f
(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)))
(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))
(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)))
(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))
;;; ../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+))
(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)
(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)
(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)
-;;; 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")
(: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.
(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))
(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)
(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)
;;;; 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)
(: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)
(: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))
(: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))
-;;;
-;;; 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)
(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*)
(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)
(: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)))
(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)))
(: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
(: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
(: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)
(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)))))
(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))))))
;;;
(: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))
(: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))
(: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)
(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)
(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))
(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)
(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)
(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)
(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)))))
\f
;;;; Float mode hackery:
(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)
(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)
(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)
(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)
(:translate imagpart)
(:note "complex double float imagpart")
(:variant :imag))
-
-\f
(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
(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"))
)))
"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)))
-;;; 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")
+\f
;;; 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.
;;;
(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)
,@(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)))
-;;; 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.
(: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
(: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)))
(: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*)))
(: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)
(: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*)))
\f
;;;; 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")
(def!constant number-stack-displacement
(* #!-darwin 2
#!+darwin 8
- sb!vm:n-word-bytes))
-
+ n-word-bytes))
\f
-
;;; Where to put the different spaces.
-;;;
(def!constant read-only-space-start #x01000000)
(def!constant read-only-space-end #x04ff8000)
-;;;
-;;; 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")
\f
;;;; Type frobbing VOPs
(: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)
(: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))
(: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)
(: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)
(: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)))
(: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)))))
\f
(: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)
(: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)))
-;;;
+;;;; 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")
\f
((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
;; 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))
\f
;;;; Make some random tns for important registers.
\f
;;;; 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)))
(: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)
(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)
;; 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)
(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))
(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))
(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))
(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))
(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)))
(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)
(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)
(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)
(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))
(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)
(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)))
(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)))
\f
;;;; 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)
(inst sra temp n-widetag-bits)
(inst sub temp (1- array-dimensions-offset))
(inst sll res temp n-fixnum-tag-bits)))
-
-
\f
;;;; Bounds checking routine.
-
-
(define-vop (check-bound)
(:translate %check-bound)
(:policy :fast-safe)
(inst b :geu error)
(inst nop)
(move result index))))
-
-
\f
;;;; Accessors/Setters
;;; 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)))
(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)))
(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
(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)
-;;;; 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.
;;; 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
;; 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))
\f
;;;; Make some miscellaneous TNs for important registers.
(macrolet ((defregtn (name sc)
-;;;; 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.
;;;; 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)
;;; 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)
;;; 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)
(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))
(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))
(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)))
(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)
(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)
(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)
(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))
(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)
(storew header result 0 other-pointer-lowtag))))
\f
;;;; 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)))
;;;; 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))
(: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")
(: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")
(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)))
;; 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))
(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)))
;; 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))
(: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")
(: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")
(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)))
;; 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))
(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)))
;; 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))
(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)
(: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)
;; 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)))
(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))
(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)))
;; 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))
(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")
(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")
(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)))
;; 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))
(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))))
(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)))
;; 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))
(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))))
(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")
(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")
(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)))
;; 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))
(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))))
(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)))
;; 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))
(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))))
(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)
(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)
;; 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)))
(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))
(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))))
;; 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)))
(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))
(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))))
(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
-grovel_headers
+grovel-headers
determine-endianness
where-is-mcontext
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
--- /dev/null
+/*
+ * 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 <stdio.h>
+#include <sys/types.h>
+#include <sys/times.h>
+#include <sys/stat.h>
+#include <sys/wait.h>
+#include <sys/ioctl.h>
+#include <sys/termios.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <signal.h>
+
+#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;
+}
+++ /dev/null
-/*
- * 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 <stdio.h>
-#include <sys/types.h>
-#include <sys/times.h>
-#include <sys/stat.h>
-#include <sys/wait.h>
-#include <sys/ioctl.h>
-#include <sys/termios.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <signal.h>
-
-#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;
-}
;;; 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"
projects / sbcl.git / commitdiff