#s(sb-cold:package-data
:name "SB!DI"
:doc "private: primitives used to write debuggers"
- :use ("CL" "SB!EXT" "SB!INT" "SB!KERNEL" "SB!SYS")
+ :use ("CL" "SB!EXT" "SB!INT" "SB!KERNEL" "SB!SYS" "SB!VM")
:import-from (("SB!C"
"DEBUG-SOURCE-FROM" "DEBUG-SOURCE-NAME"
"DEBUG-SOURCE-CREATED" "DEBUG-SOURCE-COMPILED"
"TARGET-FASL-CODE-FORMAT" "TARGET-FASL-FILE-TYPE"
"TARGET-HEAP-ADDRESS-SPACE" "*TARGET-MOST-NEGATIVE-FIXNUM*"
"*TARGET-MOST-POSITIVE-FIXNUM*" "*READ-ONLY-SPACE-START*"
- "*STATIC-SPACE-START*" "TRACE-TABLE-CALL-SITE"
+ "STATIC-SPACE-START" "TRACE-TABLE-CALL-SITE"
"TRACE-TABLE-FUNCTION-EPILOGUE" "TRACE-TABLE-FUNCTION-PROLOGUE"
"TRACE-TABLE-NORMAL" "TYPE-BITS" "TYPE-MASK" "UNBOUND-MARKER-TYPE"
"UNSIGNED-IMMEDIATE-SC-NUMBER"
(inst mov ecx (fixnumize 2)) ; arg count
(inst jmp
(make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-function-offset
',(symbolicate "TWO-ARG-" fun)))))
(inst push eax)
(inst mov ecx (fixnumize 1)) ; arg count
(inst jmp (make-ea :dword
- :disp (+ *nil-value* (static-function-offset '%negate))))
+ :disp (+ nil-value (static-function-offset '%negate))))
FIXNUM
(move res x)
; SINGLE-FLOAT-BITS are parallel,
; should be named parallelly.
(inst jmp (make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-function-offset
',static-fn))))
INLINE-FIXNUM-COMPARE
(inst cmp x y)
(inst jmp ,test RETURN-TRUE)
- (inst mov res *nil-value*)
+ (inst mov res nil-value)
;; FIXME: A note explaining this return convention, or a
;; symbolic name for it, would be nice. (It looks as though we
;; should be hand-crafting the same return sequence as would be
(inst jmp :nz DO-STATIC-FN)
RETURN-NIL
- (inst mov res *nil-value*)
+ (inst mov res nil-value)
(inst pop eax)
(inst add eax 2)
(inst jmp eax)
(inst push eax)
(inst mov ecx (fixnumize 2))
(inst jmp (make-ea :dword
- :disp (+ *nil-value* (static-function-offset 'eql))))
+ :disp (+ nil-value (static-function-offset 'eql))))
RETURN-T
(load-symbol res t)
(:temp ecx unsigned-reg ecx-offset)
)
(inst test x 3) ; descriptor?
- (inst jmp :nz DO-STATIC-FN) ; yes do it here
+ (inst jmp :nz DO-STATIC-FN) ; yes, do it here
(inst test y 3) ; descriptor?
(inst jmp :nz DO-STATIC-FN)
(inst cmp x y)
(inst jmp :e RETURN-T) ; ok
- (inst mov res *nil-value*)
+ (inst mov res nil-value)
(inst pop eax)
(inst add eax 2)
(inst jmp eax)
(inst push eax)
(inst mov ecx (fixnumize 2))
(inst jmp (make-ea :dword
- :disp (+ *nil-value* (static-function-offset 'two-arg-=))))
+ :disp (+ nil-value (static-function-offset 'two-arg-=))))
RETURN-T
(load-symbol res t))
;; Handle the register arg cases.
ZERO-VALUES
(move esp-tn ebx)
- (inst mov edx *nil-value*)
+ (inst mov edx nil-value)
(inst mov edi edx)
(inst mov esi edx)
(inst jmp eax)
TWO-VALUES
(loadw edx esi -1)
(loadw edi esi -2)
- (inst mov esi *nil-value*)
+ (inst mov esi nil-value)
(inst lea esp-tn (make-ea :dword :base ebx :disp (* -2 word-bytes)))
(inst jmp eax)
;; care.
(cond
((zerop length)
- ;; Actually, we aren't even writing one word. This is real easy.
+ ;; Actually, we aren't even writing one word. This is really easy.
)
((= length unit-bits)
;; DST-BIT-OFFSET must be equal to zero, or we would be writing
(or (< sb!vm:*read-only-space-start* val
(* sb!vm:*read-only-space-free-pointer*
sb!vm:word-bytes))
- (< sb!vm::*static-space-start* val
+ (< sb!vm::static-space-start val
(* sb!vm:*static-space-free-pointer*
sb!vm:word-bytes))
(< (sb!vm:current-dynamic-space-start) val
(defun static-space-usage ()
(- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)
- sb!vm:*static-space-start*))
+ sb!vm:static-space-start))
(defun read-only-space-usage ()
(- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes)
(declare (type spaces space))
(ecase space
(:static
- (values (int-sap *static-space-start*)
+ (values (int-sap static-space-start)
(int-sap (* *static-space-free-pointer* word-bytes))))
(:read-only
(values (int-sap *read-only-space-start*)
found
name))))
((eql values 0)
- ;; Real easy!
+ ;; really easy!
nil)
(t
(etypecase leaf
;; We actually ran GENESIS, use the real value.
(descriptor-bits (cold-intern symbol))
;; We didn't run GENESIS, so guess at the address.
- (+ sb!vm:*static-space-start*
+ (+ sb!vm:static-space-start
sb!vm:word-bytes
sb!vm:other-pointer-type
(if symbol (sb!vm:static-symbol-offset symbol) 0)))))
sb!vm:*read-only-space-start*))
(*static* (make-gspace :static
static-space-id
- sb!vm:*static-space-start*))
+ sb!vm:static-space-start))
(*dynamic* (make-gspace :dynamic
dynamic-space-id
sb!vm:*dynamic-space-start*))
(:node-var node)
(:generator 0
(cond ((zerop num)
- ;; (move result *nil-value*)
- (inst mov result *nil-value*))
+ ;; (move result nil-value)
+ (inst mov result nil-value))
((and star (= num 1))
(move result (tn-ref-tn things)))
(t
(setf things (tn-ref-across things))
(store-car (tn-ref-tn things) ptr cons-cdr-slot))
(t
- (storew *nil-value* ptr cons-cdr-slot
+ (storew nil-value ptr cons-cdr-slot
list-pointer-type)))
(assert (null (tn-ref-across things)))))
(move result res))))))
(inst or boxed code-header-type)
(storew boxed result 0 other-pointer-type)
(storew unboxed result code-code-size-slot other-pointer-type)
- (inst mov temp *nil-value*)
+ (inst mov temp nil-value)
(storew temp result code-entry-points-slot other-pointer-type))
(storew temp result code-debug-info-slot other-pointer-type)))
(inst or boxed code-header-type)
(storew boxed result 0 other-pointer-type)
(storew unboxed result code-code-size-slot other-pointer-type)
- (storew *nil-value* result code-entry-points-slot other-pointer-type))
- (storew *nil-value* result code-debug-info-slot other-pointer-type)))
+ (storew nil-value result code-entry-points-slot other-pointer-type))
+ (storew nil-value result code-debug-info-slot other-pointer-type)))
\f
(define-vop (make-fdefn)
(:policy :fast-safe)
(:generator 37
(with-fixed-allocation (result fdefn-type fdefn-size node)
(storew name result fdefn-name-slot other-pointer-type)
- (storew *nil-value* result fdefn-function-slot other-pointer-type)
+ (storew nil-value result fdefn-function-slot other-pointer-type)
(storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
result fdefn-raw-addr-slot other-pointer-type))))
(inst shr temp 1)
(inst and temp #xfffffffc)
(storew temp result symbol-hash-slot other-pointer-type)
- (storew *nil-value* result symbol-plist-slot other-pointer-type)
- (storew *nil-value* result symbol-package-slot other-pointer-type))))
+ (storew nil-value result symbol-plist-slot other-pointer-type)
+ (storew nil-value result symbol-package-slot other-pointer-type))))
(unless (zerop amount)
(let ((delta (logandc2 (+ amount 3) 3)))
(inst sub (make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-symbol-offset '*alien-stack*)
(ash symbol-value-slot word-shift)
(- other-pointer-type)))
(unless (zerop amount)
(let ((delta (logandc2 (+ amount 3) 3)))
(inst add (make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-symbol-offset '*alien-stack*)
(ash symbol-value-slot word-shift)
(- other-pointer-type)))
;; Default the unsuppled registers.
(let* ((2nd-tn-ref (tn-ref-across values))
(2nd-tn (tn-ref-tn 2nd-tn-ref)))
- (inst mov 2nd-tn *nil-value*)
+ (inst mov 2nd-tn nil-value)
(when (> nvals 2)
(loop
for tn-ref = (tn-ref-across 2nd-tn-ref)
(inst jmp-short regs-defaulted)
;; Do the single value case.
;; Default the register args
- (inst mov eax-tn *nil-value*)
+ (inst mov eax-tn nil-value)
(do ((i 1 (1+ i))
(val (tn-ref-across values) (tn-ref-across val)))
((= i (min nvals register-arg-count)))
(emit-label regs-defaulted)
- (inst mov eax-tn *nil-value*)
+ (inst mov eax-tn nil-value)
(storew edx-tn ebx-tn -1)
(collect ((defaults))
(do ((i register-arg-count (1+ i))
;; the MV return point.
(inst mov ebx-tn esp-tn)
(inst push edx-tn)
- (inst mov edi-tn *nil-value*)
+ (inst mov edi-tn nil-value)
(inst push edi-tn)
(inst mov esi-tn edi-tn)
;; Compute a pointer to where to put the [defaulted] stack values.
:disp (* (- (1+ register-arg-count)) word-bytes)))
;; Load EAX with NIL so we can quickly store it, and set up stuff
;; for the loop.
- (inst mov eax-tn *nil-value*)
+ (inst mov eax-tn nil-value)
(inst std)
(inst mov ecx-tn (- nvals register-arg-count))
;; Jump into the default loop.
(inst mov ecx-tn eax-tn)
(inst shr ecx-tn word-shift) ; word count
;; Load EAX with NIL for fast storing.
- (inst mov eax-tn *nil-value*)
+ (inst mov eax-tn nil-value)
;; Do the store.
(emit-label default-stack-vals)
(inst rep)
(when (< nvals register-arg-count)
(let* ((arg-tns (nthcdr nvals (list a0 a1 a2)))
(first (first arg-tns)))
- (inst mov first *nil-value*)
+ (inst mov first nil-value)
(dolist (tn (cdr arg-tns))
(inst mov tn first))))
;; And away we go. Except that return-pc is still on the
(move src context)
(move ecx count)
;; Check to see whether there are no args, and just return NIL if so.
- (inst mov result *nil-value*)
+ (inst mov result nil-value)
(inst jecxz done)
(inst lea dst (make-ea :dword :index ecx :scale 2))
(pseudo-atomic
;; Go back for more.
(inst loop loop)
;; NIL out the last cons.
- (storew *nil-value* dst 1 sb!vm:list-pointer-type))
+ (storew nil-value dst 1 sb!vm:list-pointer-type))
(emit-label done))))
;;; Return the location and size of the more arg glob created by Copy-More-Arg.
(inst mov
(make-ea :dword :base object
:disp (- (* offset word-bytes) lowtag))
- (+ *nil-value* (static-symbol-offset val))))
+ (+ nil-value (static-symbol-offset val))))
(character
(inst mov
(make-ea :dword :base object
(:save-p :compute-only)
(:generator 10
(loadw value object fdefn-function-slot other-pointer-type)
- (inst cmp value *nil-value*)
+ (inst cmp value nil-value)
;; FIXME: UNDEFINED-SYMBOL-ERROR seems to actually be for symbols with no
;; function value, not, as the name might suggest, symbols with no ordinary
;; value. Perhaps the name could be made more mnemonic?
(:args (fdefn :scs (descriptor-reg) :target result))
(:results (result :scs (descriptor-reg)))
(:generator 38
- (storew *nil-value* fdefn fdefn-function-slot other-pointer-type)
+ (storew nil-value fdefn fdefn-function-slot other-pointer-type)
(storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
fdefn fdefn-raw-addr-slot other-pointer-type)
(move result fdefn)))
(emit-label done)
(assemble (*elsewhere*)
(emit-label bogus)
- (inst mov code *nil-value*)
+ (inst mov code nil-value)
(inst jmp done)))))
(define-vop (code-from-lra code-from-mumble)
;;;; macros to generate useful values
(defmacro load-symbol (reg symbol)
- `(inst mov ,reg (+ *nil-value* (static-symbol-offset ,symbol))))
+ `(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol))))
(defmacro load-symbol-value (reg symbol)
`(inst mov ,reg
(make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
(- other-pointer-type)))))
(defmacro store-symbol-value (reg symbol)
`(inst mov
(make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
(- other-pointer-type)))
(when *enable-pseudo-atomic*
;; FIXME: The MAKE-EA noise should become a MACROLET macro or
;; something. (perhaps SVLB, for static variable low byte)
- (inst mov (make-ea :byte :disp (+ *nil-value*
+ (inst mov (make-ea :byte :disp (+ nil-value
(static-symbol-offset
'sb!impl::*pseudo-atomic-interrupted*)
(ash symbol-value-slot word-shift)
;; take out type bits.
(- other-pointer-type)))
0)
- (inst mov (make-ea :byte :disp (+ *nil-value*
+ (inst mov (make-ea :byte :disp (+ nil-value
(static-symbol-offset
'sb!impl::*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
(fixnumize 1)))
,@forms
(when *enable-pseudo-atomic*
- (inst mov (make-ea :byte :disp (+ *nil-value*
+ (inst mov (make-ea :byte :disp (+ nil-value
(static-symbol-offset
'sb!impl::*pseudo-atomic-atomic*)
(ash symbol-value-slot word-shift)
;; are pending? I wish I could find the documentation for
;; pseudo-atomics.. -- WHN 19991130
(inst cmp (make-ea :byte
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-symbol-offset
'sb!impl::*pseudo-atomic-interrupted*)
(ash symbol-value-slot word-shift)
(inst mov
(make-ea :dword :base object
:disp (- (* (+ base offset) word-bytes) lowtag))
- (+ *nil-value* (static-symbol-offset val))))
+ (+ nil-value (static-symbol-offset val))))
(character
(inst mov
(make-ea :dword :base object
(inst xor y y)
(inst mov y (fixnumize val))))
(symbol
- (inst mov y (+ *nil-value* (static-symbol-offset val))))
+ (inst mov y (+ nil-value (static-symbol-offset val))))
(character
(inst mov y (logior (ash (char-code val) type-bits)
base-char-type)))))
(integer
(storew (fixnumize val) fp (tn-offset y)))
(symbol
- (storew (+ *nil-value* (static-symbol-offset val))
+ (storew (+ nil-value (static-symbol-offset val))
fp (tn-offset y)))
(character
(storew (logior (ash (char-code val) type-bits)
(integer
(storew (fixnumize val) fp (- (1+ (tn-offset y)))))
(symbol
- (storew (+ *nil-value* (static-symbol-offset val))
+ (storew (+ nil-value (static-symbol-offset val))
fp (- (1+ (tn-offset y)))))
(character
(storew (logior (ash (char-code val) type-bits)
(cond ((zerop nvals))
((= nvals 1)
(let ((no-values (gen-label)))
- (inst mov (tn-ref-tn values) *nil-value*)
+ (inst mov (tn-ref-tn values) nil-value)
(inst jecxz no-values)
(loadw (tn-ref-tn values) start -1)
(emit-label no-values)))
(assemble (*elsewhere*)
(dolist (def (defaults))
(emit-label (car def))
- (inst mov (cdr def) *nil-value*))
+ (inst mov (cdr def) nil-value))
(inst jmp defaulting-done))))))
(inst mov esp-tn sp)))
;;; Note: Mostly these values are black magic, inherited from CMU CL
;;; without any documentation. However, there have been a few changes
;;; since the fork:
-;;; * The FreeBSD *STATIC-SPACE-START* value was bumped up
+;;; * The FreeBSD STATIC-SPACE-START value was bumped up
;;; from #x28000000 to #x30000000 when FreeBSD ld.so dynamic linking
;;; support was added for FreeBSD ca. 20000910. This was to keep from
;;; stomping on an address range that the dynamic libraries want to use.
;;; (They want to use this address range even if we try to reserve it
;;; with a call to validate() as the first operation in main().)
#!-linux (defparameter *read-only-space-start* #x10000000)
-#!-linux (defparameter *static-space-start*
- #!+freebsd #x30000000
- #!+openbsd #x28000000)
+#!-linux (defconstant static-space-start
+ #!+freebsd #x30000000
+ #!+openbsd #x28000000)
#!-linux (defparameter *dynamic-space-start* #x48000000)
#!+linux (defparameter *read-only-space-start* #x01000000)
-#!+linux (defparameter *static-space-start* #x05000000)
+#!+linux (defconstant static-space-start #x05000000)
#!+linux (defparameter *dynamic-space-start* #x09000000)
;;; Given that NIL is the first thing allocated in static space, we
;;; know its value at compile time:
-(defparameter *nil-value* (+ *static-space-start* #xb))
+(defconstant nil-value (+ static-space-start #xb))
\f
;;;; other miscellaneous constants
(inst test x x) ; smaller
(inst cmp x (fixnumize val))))
(symbol
- (inst cmp x (+ *nil-value* (static-symbol-offset val))))
+ (inst cmp x (+ nil-value (static-symbol-offset val))))
(character
(inst cmp x (logior (ash (char-code val) type-bits)
base-char-type))))))
(inst test y y) ; smaller
(inst cmp y (fixnumize val))))
(symbol
- (inst cmp y (+ *nil-value* (static-symbol-offset val))))
+ (inst cmp y (+ nil-value (static-symbol-offset val))))
(character
(inst cmp y (logior (ash (char-code val) type-bits)
base-char-type))))))
;; low tag of 3 is added the resulting value points to the
;; raw address slot of the fdefn (at +4).
(inst call (make-ea :dword
- :disp (+ *nil-value*
+ :disp (+ nil-value
(static-function-offset function))))
,(collect ((bindings) (links))
(do ((temp (temp-names) (cdr temp))
;; Move OBJECT into a temp we can bash on, and initialize the count.
(move ptr object)
(inst xor count count)
- ;; If we are starting with NIL, then it's real easy.
- (inst cmp ptr *nil-value*)
+ ;; If we are starting with NIL, then it's really easy.
+ (inst cmp ptr nil-value)
(inst jmp :e done)
;; Note: we don't have to test to see whether the original argument is a
;; list, because this is a :fast-safe vop.
(loadw ptr ptr cons-cdr-slot list-pointer-type)
(inst add count (fixnumize 1))
;; If we hit NIL, then we are done.
- (inst cmp ptr *nil-value*)
+ (inst cmp ptr nil-value)
(inst jmp :e done)
;; Otherwise, check to see whether we hit the end of a dotted list. If
;; not, loop back for more.
(move ptr object)
(inst xor count count)
;; If we are starting with NIL, we be done.
- (inst cmp ptr *nil-value*)
+ (inst cmp ptr nil-value)
(inst jmp :e done)
;; Indirect the next cons cell, and boost the count.
LOOP
(loadw ptr ptr cons-cdr-slot list-pointer-type)
(inst add count (fixnumize 1))
;; If we aren't done, go back for more.
- (inst cmp ptr *nil-value*)
+ (inst cmp ptr nil-value)
(inst jmp :ne loop)
DONE))
(:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp)
(:save-p t)
(:generator 25
- (inst cmp inherit *nil-value*)
+ (inst cmp inherit nil-value)
(inst jmp :e FRESH-STACK)
;; Child inherits the stack of the parent.
RETURN
;; Stack already clean if it reaches here. Parent returns NIL.
- (inst mov child *nil-value*)
+ (inst mov child nil-value)
(inst jmp-short DONE)
STACK-SAVE-DONE
(:translate symbolp)
(:generator 12
(let ((is-symbol-label (if not-p drop-thru target)))
- (inst cmp value *nil-value*)
+ (inst cmp value nil-value)
(inst jmp :e is-symbol-label)
(test-type value target not-p symbol-header-type))
DROP-THRU))
(define-vop (check-symbol check-type)
(:generator 12
(let ((error (generate-error-code vop object-not-symbol-error value)))
- (inst cmp value *nil-value*)
+ (inst cmp value nil-value)
(inst jmp :e drop-thru)
(test-type value error t symbol-header-type))
DROP-THRU
(:translate consp)
(:generator 8
(let ((is-not-cons-label (if not-p target drop-thru)))
- (inst cmp value *nil-value*)
+ (inst cmp value nil-value)
(inst jmp :e is-not-cons-label)
(test-type value target not-p list-pointer-type))
DROP-THRU))
(define-vop (check-cons check-type)
(:generator 8
(let ((error (generate-error-code vop object-not-cons-error value)))
- (inst cmp value *nil-value*)
+ (inst cmp value nil-value)
(inst jmp :e error)
(test-type value error t list-pointer-type)
(move result value))))
(:generator 0
(move list arg)
(move start esp-tn) ; WARN pointing 1 below
- (inst mov nil-temp *nil-value*)
+ (inst mov nil-temp nil-value)
LOOP
(inst cmp list nil-temp)
lispobj first_word = *ptr;
if (first_word == 0x01) {
- /* Yep, there be a forwarding pointer. */
+ /* Yes, there's a forwarding pointer. */
*start = ptr[1];
words_scavenged = 1;
}
}
} else {
if ((object & 3) == 0) {
- /* It's a fixnum. Real easy.. */
+ /* It's a fixnum: really easy.. */
words_scavenged = 1;
} else {
/* It's some sort of header object or another. */
;;; versions, and a string a la "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.7.9"
+"0.6.7.10"
projects / sbcl.git / commitdiff