changes in sbcl-0.8.17 relative to sbcl-0.8.16:
+ * minor incompatible change: BASE-CHAR no longer names a class;
+ however, CHARACTER continues to do so, as required by ANSI.
* bug fix: READ, READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST,
and READ-FROM-STRING all now return a primary value of NIL if
*READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL)
(description-maybe-internals "character ~W char-code #x~2,'0X"
(list object (char-code object))
"[#x~8,'0X]"
- (logior sb-vm:base-char-widetag
+ (logior sb-vm:character-widetag
(ash (char-code object)
sb-vm:n-widetag-bits))))
"ARRAY-TYPE" "ARRAY-TYPE-COMPLEXP"
"ARRAY-TYPE-DIMENSIONS" "ARRAY-TYPE-ELEMENT-TYPE"
"ARRAY-TYPE-P" "ARRAY-TYPE-SPECIALIZED-ELEMENT-TYPE"
- "ASH-INDEX" "ASSERT-ERROR" "BASE-CHAR-P" "BASE-STRING-P"
+ "ASH-INDEX" "ASSERT-ERROR" "BASE-STRING-P"
"BINDING-STACK-POINTER-SAP" "BIT-BASH-COPY" "BIT-INDEX"
"BOGUS-ARG-TO-VALUES-LIST-ERROR" "BOOLE-CODE"
"BOUNDING-INDICES-BAD-ERROR" "BYTE-SPECIFIER" "%BYTE-BLT"
"FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "DYNAMIC-USAGE"
"EFFECTIVE-FIND-POSITION-TEST"
"EFFECTIVE-FIND-POSITION-KEY" "ERROR-NUMBER-OR-LOSE"
+ "EXTENDED-CHAR-P"
"FAILED-%WITH-ARRAY-DATA" "FDEFINITION-OBJECT"
"FDOCUMENTATION" "FILENAME"
"FIND-AND-INIT-OR-CHECK-LAYOUT" "FLOAT-EXPONENT"
"NUMERIC-TYPE-CLASS" "NUMERIC-TYPE-COMPLEXP"
"NUMERIC-TYPE-EQUAL" "NUMERIC-TYPE-FORMAT"
"NUMERIC-TYPE-HIGH" "NUMERIC-TYPE-LOW" "NUMERIC-TYPE-P"
- "OBJECT-NOT-ARRAY-ERROR" "OBJECT-NOT-BASE-CHAR-ERROR"
+ "OBJECT-NOT-ARRAY-ERROR" "OBJECT-NOT-CHARACTER-ERROR"
"OBJECT-NOT-BASE-STRING-ERROR" "OBJECT-NOT-BIGNUM-ERROR"
"OBJECT-NOT-BIT-VECTOR-ERROR" "OBJECT-NOT-COMPLEX-ERROR"
"OBJECT-NOT-COMPLEX-FLOAT-ERROR"
"ANY-REG-SC-NUMBER" "ARRAY-DATA-SLOT" "ARRAY-DIMENSIONS-OFFSET"
"ARRAY-DISPLACED-P-SLOT" "ARRAY-DISPLACEMENT-SLOT"
"ARRAY-ELEMENTS-SLOT" "ARRAY-FILL-POINTER-P-SLOT"
- "ARRAY-FILL-POINTER-SLOT" "ATOMIC-FLAG" "BASE-CHAR-REG-SC-NUMBER"
- "BASE-CHAR-STACK-SC-NUMBER" "BASE-CHAR-WIDETAG"
+ "ARRAY-FILL-POINTER-SLOT" "ATOMIC-FLAG"
+ "CHARACTER-REG-SC-NUMBER"
+ "CHARACTER-STACK-SC-NUMBER" "CHARACTER-WIDETAG"
"BIGNUM-DIGITS-OFFSET" "BIGNUM-WIDETAG" "BINDING-SIZE"
"BINDING-SYMBOL-SLOT" "BINDING-VALUE-SLOT" "BREAKPOINT-TRAP"
"N-BYTE-BITS" "BYTE-REG-SC-NUMBER"
"FUNCALLABLE-INSTANCE-LAYOUT-SLOT"
"FUNCALLABLE-INSTANCE-LEXENV-SLOT"
"GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
- "IMMEDIATE-BASE-CHAR-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
+ "IMMEDIATE-CHARACTER-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
"IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*"
"INSTANCE-HEADER-WIDETAG" "INSTANCE-POINTER-LOWTAG"
"INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE"
;; and for all in any reasonable user programs.)
((t)
(values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
- ((base-char standard-char)
+ ((base-char standard-char character)
(values #.sb!vm:simple-base-string-widetag #.sb!vm:n-byte-bits))
((bit)
(values #.sb!vm:simple-bit-vector-widetag 1))
;; Pick off some easy common cases.
((t)
#.sb!vm:complex-vector-widetag)
- ((base-char)
+ ((base-char character)
#.sb!vm:complex-base-string-widetag)
((nil)
#.sb!vm:complex-vector-nil-widetag)
(t
(pick-vector-type type
(nil #.sb!vm:complex-vector-nil-widetag)
- (base-char #.sb!vm:complex-base-string-widetag)
+ (character #.sb!vm:complex-base-string-widetag)
(bit #.sb!vm:complex-bit-vector-widetag)
(t #.sb!vm:complex-vector-widetag)))))
,@(map 'list
(lambda (saetp)
`((simple-array ,(sb!vm:saetp-specifier saetp) (*))
- ,(if (eq (sb!vm:saetp-specifier saetp) 'base-char)
+ ,(if (eq (sb!vm:saetp-specifier saetp) 'character)
*default-init-char-form*
(sb!vm:saetp-initial-element-default saetp))))
(remove-if-not
(setq
*built-in-classes*
'((t :state :read-only :translation t)
- (character :enumerable t :translation base-char
- :prototype-form (code-char 42))
- (base-char :enumerable t
- :inherits (character)
- :codes (#.sb!vm:base-char-widetag)
+ (character :enumerable t
+ :codes (#.sb!vm:character-widetag)
:prototype-form (code-char 42))
(symbol :codes (#.sb!vm:symbol-header-widetag)
:prototype-form '#:mu)
(cond ((typep x 'standard-char)
;; (Note that SBCL doesn't distinguish between BASE-CHAR and
;; CHARACTER.)
- (find-classoid 'base-char))
+ (specifier-type 'base-char))
((not (characterp x))
nil)
(t
(zerop (logand val 3))
;; character
(and (zerop (logand val #xffff0000)) ; Top bits zero
- (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag
+ (= (logand val #xff) sb!vm:character-widetag)) ; char tag
;; unbound marker
(= val sb!vm:unbound-marker-widetag)
;; pointer
(sb!sys:without-gcing
(with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(with-escaped-value (val)
(code-char val)))
(#.sb!vm:sap-reg-sc-number
sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
(sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(with-nfp (nfp)
(code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
sb!vm:n-word-bytes)))))
(without-gcing
(with-escaped-value (val)
(make-valid-lisp-obj val))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(with-escaped-value (val)
(code-char val)))
(#.sb!vm:sap-reg-sc-number
sb!vm:n-word-bytes)))))
(#.sb!vm:control-stack-sc-number
(stack-ref fp (sb!c:sc-offset-offset sc-offset)))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(code-char
(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))))
(without-gcing
(set-escaped-value
(get-lisp-obj-address value))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(set-escaped-value (char-code value)))
(#.sb!vm:sap-reg-sc-number
(set-escaped-value (sap-int value)))
(the long-float (realpart value)))))
(#.sb!vm:control-stack-sc-number
(setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(with-nfp (nfp)
(setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
sb!vm:n-word-bytes))
(without-gcing
(set-escaped-value
(get-lisp-obj-address value))))
- (#.sb!vm:base-char-reg-sc-number
+ (#.sb!vm:character-reg-sc-number
(set-escaped-value (char-code value)))
(#.sb!vm:sap-reg-sc-number
(set-escaped-value (sap-int value)))
(imagpart (the (complex long-float) value))))
(#.sb!vm:control-stack-sc-number
(setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
- (#.sb!vm:base-char-stack-sc-number
+ (#.sb!vm:character-stack-sc-number
(setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
sb!vm:n-word-bytes)))
(char-code (the character value))))
(sb!xc:deftype atom () '(not cons))
+(sb!xc:deftype base-char () 'character)
+
(sb!xc:deftype extended-char ()
#!+sb-doc
"Type of CHARACTERs that aren't BASE-CHARs."
(:none character)
(:line character)
(:full character))
- (if (and (base-char-p byte) (char= byte #\Newline))
+ (if (char= byte #\Newline)
(setf (fd-stream-char-pos stream) 0)
(incf (fd-stream-char-pos stream)))
(setf (sap-ref-8 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
(deferr unbound-symbol-error (symbol)
(error 'unbound-variable :name symbol))
-(deferr object-not-base-char-error (object)
+(deferr object-not-character-error (object)
(error 'type-error
:datum object
- :expected-type 'base-char))
+ :expected-type 'character))
(deferr object-not-sap-error (object)
(error 'type-error
(if (eq (car dims) '*)
(case eltype
(bit 'bit-vector)
- (base-char 'base-string)
+ ((base-char character) 'base-string)
(* 'vector)
(t `(vector ,eltype)))
(case eltype
(bit `(bit-vector ,(car dims)))
- (base-char `(base-string ,(car dims)))
+ ((base-char character) `(base-string ,(car dims)))
(t `(vector ,eltype ,(car dims)))))
(if (eq (car dims) '*)
(case eltype
(bit 'simple-bit-vector)
- (base-char 'simple-base-string)
+ ((base-char character) 'simple-base-string)
((t) 'simple-vector)
(t `(simple-array ,eltype (*))))
(case eltype
(bit `(simple-bit-vector ,(car dims)))
- (base-char `(simple-base-string ,(car dims)))
+ ((base-char character) `(simple-base-string ,(car dims)))
((t) `(simple-vector ,(car dims)))
(t `(simple-array ,eltype ,dims))))))
(t
;; the type it tests for in the Common Lisp type system, and since it's
;; only used in the implementation of a few specialized things.)
(def-type-predicate-wrapper double-float-p)
+ (def-type-predicate-wrapper extended-char-p)
(def-type-predicate-wrapper fdefn-p)
(def-type-predicate-wrapper fixnump)
(def-type-predicate-wrapper floatp)
(def-type-predicate-wrapper ratiop)
(def-type-predicate-wrapper realp)
(def-type-predicate-wrapper short-float-p)
- (def-type-predicate-wrapper sb!kernel:simple-array-p)
+ (def-type-predicate-wrapper simple-array-p)
(def-type-predicate-wrapper simple-bit-vector-p)
(def-type-predicate-wrapper simple-base-string-p)
(def-type-predicate-wrapper simple-string-p)
(def-full-data-vector-frobs simple-vector *
descriptor-reg any-reg null zero)
- (def-partial-data-vector-frobs simple-base-string base-char :byte nil
- base-char-reg)
+ (def-partial-data-vector-frobs simple-base-string character :byte nil
+ character-reg)
(def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
:byte nil unsigned-reg signed-reg)
;;;; moves and coercions
;;; Move a tagged char to an untagged representation.
-(define-vop (move-to-base-char)
+(define-vop (move-to-character)
(:args (x :scs (any-reg descriptor-reg)))
- (:results (y :scs (base-char-reg)))
+ (:results (y :scs (character-reg)))
(:generator 1
(inst srl x n-widetag-bits y)))
-;;;
-(define-move-vop move-to-base-char :move
- (any-reg descriptor-reg) (base-char-reg))
+(define-move-vop move-to-character :move
+ (any-reg descriptor-reg) (character-reg))
;;; Move an untagged char to a tagged representation.
-(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg)))
+(define-vop (move-from-character)
+ (:args (x :scs (character-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:generator 1
(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))
+ (inst bis y character-widetag y)))
+(define-move-vop move-from-character :move
+ (character-reg) (any-reg descriptor-reg))
-;;; Move untagged base-char values.
-(define-vop (base-char-move)
+;;; Move untagged character values.
+(define-vop (character-move)
(:args (x :target y
- :scs (base-char-reg)
+ :scs (character-reg)
:load-if (not (location= x y))))
- (:results (y :scs (base-char-reg)
+ (:results (y :scs (character-reg)
:load-if (not (location= x y))))
(:effects)
(:affected)
(:generator 0
(move x y)))
-;;;
-(define-move-vop base-char-move :move
- (base-char-reg) (base-char-reg))
+(define-move-vop character-move :move
+ (character-reg) (character-reg))
-;;; Move untagged base-char arguments/return-values.
-(define-vop (move-base-char-arg)
+;;; Move untagged character arguments/return-values.
+(define-vop (move-character-arg)
(:args (x :target y
- :scs (base-char-reg))
+ :scs (character-reg))
(fp :scs (any-reg)
- :load-if (not (sc-is y base-char-reg))))
+ :load-if (not (sc-is y character-reg))))
(:results (y))
(:generator 0
(sc-case y
- (base-char-reg
+ (character-reg
(move x y))
- (base-char-stack
+ (character-stack
(storew x fp (tn-offset y))))))
-;;;
-(define-move-vop move-base-char-arg :move-arg
- (any-reg base-char-reg) (base-char-reg))
-
+(define-move-vop move-character-arg :move-arg
+ (any-reg character-reg) (character-reg))
-;;; Use standard MOVE-ARG + coercion to move an untagged base-char
+;;; Use standard MOVE-ARG + coercion to move an untagged character
;;; to a descriptor passing location.
;;;
(define-move-vop move-arg :move-arg
- (base-char-reg) (any-reg descriptor-reg))
+ (character-reg) (any-reg descriptor-reg))
\f
;;;; other operations
-
(define-vop (char-code)
(:translate char-code)
(:policy :fast-safe)
- (:args (ch :scs (base-char-reg) :target res))
- (:arg-types base-char)
+ (:args (ch :scs (character-reg) :target res))
+ (:arg-types character)
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 1
(:policy :fast-safe)
(:args (code :scs (any-reg) :target res))
(:arg-types positive-fixnum)
- (:results (res :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (res :scs (character-reg)))
+ (:result-types character)
(:generator 1
(inst srl code n-fixnum-tag-bits res)))
\f
-;;;; comparison of BASE-CHARs
+;;;; comparison of CHARACTERs
-(define-vop (base-char-compare)
- (:args (x :scs (base-char-reg))
- (y :scs (base-char-reg)))
- (:arg-types base-char base-char)
+(define-vop (character-compare)
+ (:args (x :scs (character-reg))
+ (y :scs (character-reg)))
+ (:arg-types character character)
(:temporary (:scs (non-descriptor-reg)) temp)
(:conditional)
(:info target not-p)
(inst beq temp target)
(inst bne temp target))))
-(define-vop (fast-char=/base-char base-char-compare)
+(define-vop (fast-char=/character character-compare)
(:translate char=)
(:variant :eq))
-(define-vop (fast-char</base-char base-char-compare)
+(define-vop (fast-char</character character-compare)
(:translate char<)
(:variant :lt))
-(define-vop (fast-char>/base-char base-char-compare)
+(define-vop (fast-char>/character character-compare)
(:translate char>)
(:variant :gt))
-(define-vop (base-char-compare/c)
- (:args (x :scs (base-char-reg)))
- (:arg-types base-char (:constant base-char))
+(define-vop (character-compare/c)
+ (:args (x :scs (character-reg)))
+ (:arg-types character (:constant character))
(:temporary (:scs (non-descriptor-reg)) temp)
(:conditional)
(:info target not-p y)
(inst beq temp target)
(inst bne temp target)))))
-(define-vop (fast-char=/base-char/c base-char-compare/c)
+(define-vop (fast-char=/character/c character-compare/c)
(:translate char=)
(:variant :eq))
-(define-vop (fast-char</base-char/c base-char-compare/c)
+(define-vop (fast-char</character/c character-compare/c)
(:translate char<)
(:variant :lt))
-(define-vop (fast-char>/base-char/c base-char-compare/c)
+(define-vop (fast-char>/character/c character-compare/c)
(:translate char>)
(:variant :gt))
(symbol
(load-symbol y val))
(character
- (inst li (logior (ash (char-code val) n-widetag-bits) base-char-widetag)
+ (inst li (logior (ash (char-code val) n-widetag-bits) character-widetag)
y)))))
(define-move-fun (load-number 1) (vop x y)
(signed-reg unsigned-reg))
(inst li (tn-value x) y))
-(define-move-fun (load-base-char 1) (vop x y)
- ((immediate) (base-char-reg))
+(define-move-fun (load-character 1) (vop x y)
+ ((immediate) (character-reg))
(inst li (char-code (tn-value x)) y))
(define-move-fun (load-system-area-pointer 1) (vop x y)
(load-stack-tn y x))
(define-move-fun (load-number-stack 5) (vop x y)
- ((base-char-stack) (base-char-reg))
+ ((character-stack) (character-reg))
(let ((nfp (current-nfp-tn vop)))
(loadw y nfp (tn-offset x))))
(store-stack-tn y x))
(define-move-fun (store-number-stack 5) (vop x y)
- ((base-char-reg) (base-char-stack))
+ ((character-reg) (character-stack))
(let ((nfp (current-nfp-tn vop)))
(storew x nfp (tn-offset y))))
;;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
;;;; integer to a tagged bignum or fixnum.
-;;; Arg is a fixnum, so just shift it. We need a type restriction
+;;; ARG is a fixnum, so just shift it. We need a type restriction
;;; because some possible arg SCs (control-stack) overlap with
;;; possible bignum arg SCs.
(define-vop (move-to-word/fixnum)
(:note "fixnum untagging")
(:generator 1
(inst sra x n-fixnum-tag-bits y)))
-;;;
(define-move-vop move-to-word/fixnum :move
(any-reg descriptor-reg) (signed-reg unsigned-reg))
-;;; Arg is a non-immediate constant, load it.
+;;; ARG is a non-immediate constant, load it.
(define-vop (move-to-word-c)
(:args (x :scs (constant)))
(:results (y :scs (signed-reg unsigned-reg)))
(:note "constant load")
(:generator 1
(inst li (tn-value x) y)))
-;;;
(define-move-vop move-to-word-c :move
(constant) (signed-reg unsigned-reg))
-;;; Arg is a fixnum or bignum, figure out which and load if necessary.
+;;; ARG is a fixnum or bignum, figure out which and load if necessary.
(define-vop (move-to-word/integer)
(:args (x :scs (descriptor-reg)))
(:results (y :scs (signed-reg unsigned-reg)))
(when (sc-is y unsigned-reg)
(inst mskll y 4 y))
DONE))
-;;;
(define-move-vop move-to-word/integer :move
(descriptor-reg) (signed-reg unsigned-reg))
-
-;;; Result is a fixnum, so we can just shift. We need the result type
+;;; RESULT is a fixnum, so we can just shift. We need the result type
;;; restriction because of the control-stack ambiguity noted above.
(define-vop (move-from-word/fixnum)
(:args (x :scs (signed-reg unsigned-reg)))
(:note "fixnum tagging")
(:generator 1
(inst sll x n-fixnum-tag-bits y)))
-;;;
(define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg))
-;;; Result may be a bignum, so we have to check. Use a worst-case cost
+;;; RESULT may be a bignum, so we have to check. Use a worst-case cost
;;; to make sure people know they may be number consing.
(define-vop (move-from-signed)
(:args (arg :scs (signed-reg unsigned-reg) :target x))
(inst srl x 32 temp)
(storew temp y (1+ bignum-digits-offset) other-pointer-lowtag))
DONE))
-
-;;;
(define-move-vop move-from-signed :move
(signed-reg) (descriptor-reg))
(inst srl x 32 temp)
(storew temp y (1+ bignum-digits-offset) other-pointer-lowtag))
DONE))
-
-;;;
(define-move-vop move-from-unsigned :move
(unsigned-reg) (descriptor-reg))
(:note "word integer move")
(:generator 0
(move x y)))
-;;;
(define-move-vop word-move :move
(signed-reg unsigned-reg) (signed-reg unsigned-reg))
(move x y))
((signed-stack unsigned-stack)
(storeq x fp (tn-offset y))))))
-;;;
(define-move-vop move-word-arg :move-arg
(descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
:element-size 2 :alignment 2) ; (signed-byte 64)
(unsigned-stack non-descriptor-stack
:element-size 2 :alignment 2) ; (unsigned-byte 64)
- (base-char-stack non-descriptor-stack) ; non-descriptor characters.
+ (character-stack non-descriptor-stack) ; non-descriptor characters.
(sap-stack non-descriptor-stack
:element-size 2 :alignment 2) ; System area pointers.
(single-stack non-descriptor-stack) ; single-floats
:alternate-scs (control-stack))
;; Non-Descriptor characters
- (base-char-reg registers
+ (character-reg registers
:locations #.non-descriptor-regs
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; Non-Descriptor SAP's (arbitrary pointers into address space)
(sap-reg registers
return-pc-header ; 00110110
value-cell-header ; 00111010
symbol-header ; 00111110
- base-char ; 01000010
+ character ; 01000010
sap ; 01000110
unbound-marker ; 01001010
weak-pointer ; 01001110
(in-package "SB!VM")
\f
(defparameter *immediate-types*
- (list unbound-marker-widetag base-char-widetag))
+ (list unbound-marker-widetag character-widetag))
(defparameter *fun-header-widetags*
(list funcallable-instance-header-widetag
type)))
(defun make-character-descriptor (data)
- (make-other-immediate-descriptor data sb!vm:base-char-widetag))
+ (make-other-immediate-descriptor data sb!vm:character-widetag))
(defun descriptor-beyond (des offset type)
(let* ((low (logior (+ (logandc2 (descriptor-low des) sb!vm:lowtag-mask)
"Object is not a WEAK-POINTER.")
(object-not-instance
"Object is not a INSTANCE.")
- (object-not-base-char
- "Object is not of type BASE-CHAR.")
+ (object-not-character
+ "Object is not a CHARACTER.")
(nil-fun-returned
"A function with declared result type NIL returned.")
(nil-array-accessed
*specialized-array-element-type-properties*))))
(define-simple-array-type-vops))
-(!define-type-vops base-char-p check-base-char base-char
- object-not-base-char-error
- (base-char-widetag))
+(!define-type-vops characterp check-character character
+ object-not-character-error
+ (character-widetag))
(!define-type-vops system-area-pointer-p check-system-area-pointer
system-area-pointer
;;; other primitive immediate types
(/show0 "primtype.lisp 68")
-(!def-primitive-type base-char (base-char-reg any-reg))
+(!def-primitive-type character (character-reg any-reg))
;;; primitive pointer types
(/show0 "primtype.lisp 73")
(values (primitive-type-or-lose (classoid-name type)) t))
(funcallable-instance
(part-of function))
- (base-char
- (exactly base-char))
+ (character
+ (exactly character))
(cons-type
(part-of list))
(t
(nil #:mu 0 simple-array-nil
:complex-typecode #.sb!vm:complex-vector-nil-widetag
:importance 0)
- (base-char ,(code-char 0) 8 simple-base-string
+ (character ,(code-char 0) 8 simple-base-string
;; (SIMPLE-BASE-STRINGs are stored with an extra
;; trailing #\NULL for convenience in calling out
;; to C.)
;;;; character support
;;; In our implementation there are really only BASE-CHARs.
+#+nil
(define-source-transform characterp (obj)
`(base-char-p ,obj))
\f
;;; These type predicates are used to implement simple cases of TYPEP.
;;; They shouldn't be used explicitly.
-(define-type-predicate base-char-p base-char)
(define-type-predicate base-string-p base-string)
(define-type-predicate bignump bignum)
(define-type-predicate complex-double-float-p (complex double-float))
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
- (def-partial-data-vector-frobs simple-base-string base-char :byte nil base-char-reg)
+ (def-partial-data-vector-frobs simple-base-string character :byte nil character-reg)
(def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
:byte nil unsigned-reg signed-reg)
-(in-package "SB!VM")
+;;;; the HPPA VM definition of character 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
;;;; Moves and coercions:
;;; Move a tagged char to an untagged representation.
-;;;
-(define-vop (move-to-base-char)
+(define-vop (move-to-character)
(:args (x :scs (any-reg descriptor-reg)))
- (:results (y :scs (base-char-reg)))
+ (:results (y :scs (character-reg)))
(:generator 1
(inst srl x n-widetag-bits y)))
-;;;
-(define-move-vop move-to-base-char :move
- (any-reg descriptor-reg) (base-char-reg))
+(define-move-vop move-to-character :move
+ (any-reg descriptor-reg) (character-reg))
;;; Move an untagged char to a tagged representation.
-;;;
-(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg)))
+(define-vop (move-from-character)
+ (:args (x :scs (character-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:generator 1
(inst sll x n-widetag-bits y)
- (inst addi base-char-widetag y y)))
-;;;
-(define-move-vop move-from-base-char :move
- (base-char-reg) (any-reg descriptor-reg))
+ (inst addi character-widetag y y)))
+(define-move-vop move-from-character :move
+ (character-reg) (any-reg descriptor-reg))
-;;; Move untagged base-char values.
-;;;
-(define-vop (base-char-move)
+;;; Move untagged character values.
+(define-vop (character-move)
(:args (x :target y
- :scs (base-char-reg)
+ :scs (character-reg)
:load-if (not (location= x y))))
- (:results (y :scs (base-char-reg)
+ (:results (y :scs (character-reg)
:load-if (not (location= x y))))
(:effects)
(:affected)
(:generator 0
(move x y)))
-;;;
-(define-move-vop base-char-move :move
- (base-char-reg) (base-char-reg))
+(define-move-vop character-move :move
+ (character-reg) (character-reg))
-
-;;; Move untagged base-char arguments/return-values.
-;;;
-(define-vop (move-base-char-argument)
+;;; Move untagged character args/return-values.
+(define-vop (move-character-arg)
(:args (x :target y
- :scs (base-char-reg))
+ :scs (character-reg))
(fp :scs (any-reg)
- :load-if (not (sc-is y base-char-reg))))
+ :load-if (not (sc-is y character-reg))))
(:results (y))
(:generator 0
(sc-case y
- (base-char-reg
+ (character-reg
(move x y))
- (base-char-stack
+ (character-stack
(storew x fp (tn-offset y))))))
-;;;
-(define-move-vop move-base-char-argument :move-arg
- (any-reg base-char-reg) (base-char-reg))
-
-
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged base-char
-;;; to a descriptor passing location.
-;;;
-(define-move-vop move-argument :move-arg
- (base-char-reg) (any-reg descriptor-reg))
-
+(define-move-vop move-character-arg :move-arg
+ (any-reg character-reg) (character-reg))
+;;; Use standard MOVE-ARG + coercion to move an untagged character to
+;;; a descriptor passing location.
+(define-move-vop move-arg :move-arg
+ (character-reg) (any-reg descriptor-reg))
\f
;;;; Other operations:
-
(define-vop (char-code)
(:translate char-code)
(:policy :fast-safe)
- (:args (ch :scs (base-char-reg) :target res))
- (:arg-types base-char)
+ (:args (ch :scs (character-reg) :target res))
+ (:arg-types character)
(:results (res :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 1
(:policy :fast-safe)
(:args (code :scs (unsigned-reg) :target res))
(:arg-types positive-fixnum)
- (:results (res :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (res :scs (character-reg)))
+ (:result-types character)
(:generator 1
(move code res)))
-
\f
-;;; Comparison of base-chars.
-;;;
-(define-vop (base-char-compare)
- (:args (x :scs (base-char-reg))
- (y :scs (base-char-reg)))
- (:arg-types base-char base-char)
+;;; Comparison of characters.
+(define-vop (character-compare)
+ (:args (x :scs (character-reg))
+ (y :scs (character-reg)))
+ (:arg-types character character)
(:conditional)
(:info target not-p)
(:policy :fast-safe)
(:generator 3
(inst bc cond not-p x y target)))
-(define-vop (fast-char=/base-char base-char-compare)
+(define-vop (fast-char=/character character-compare)
(:translate char=)
(:variant :=))
-(define-vop (fast-char</base-char base-char-compare)
+(define-vop (fast-char</character character-compare)
(:translate char<)
(:variant :<<))
-(define-vop (fast-char>/base-char base-char-compare)
+(define-vop (fast-char>/character character-compare)
(:translate char>)
(:variant :>>))
-(in-package "SB!VM")
+;;;; the HPPA VM definition of floating point 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
;;;; Move functions.
-
(define-move-fun (load-fp-zero 1) (vop x y)
((fp-single-zero) (single-reg)
(fp-double-zero) (double-reg))
(double-reg) (double-stack))
(let ((offset (* (tn-offset y) n-word-bytes)))
(str-float x offset (current-nfp-tn vop))))
-
\f
;;;; Move VOPs
-
(define-vop (move-float)
(:args (x :scs (single-reg double-reg)
:target y
(:generator 0
(unless (location= y x)
(inst funop :copy x y))))
-
(define-move-vop move-float :move (single-reg) (single-reg))
(define-move-vop move-float :move (double-reg) (double-reg))
-
(define-vop (move-from-float)
(:args (x :to :save))
(:results (y :scs (descriptor-reg)))
(frob move-to-single single-reg single-float-value-slot)
(frob move-to-double double-reg double-float-value-slot))
-
-(define-vop (move-float-argument)
+(define-vop (move-float-arg)
(:args (x :scs (single-reg double-reg) :target y)
(nfp :scs (any-reg)
:load-if (not (sc-is y single-reg double-reg))))
((single-stack double-stack)
(let ((offset (* (tn-offset y) n-word-bytes)))
(str-float x offset nfp))))))
-
-(define-move-vop move-float-argument :move-arg
+(define-move-vop move-float-arg :move-arg
(single-reg descriptor-reg) (single-reg))
-(define-move-vop move-float-argument :move-arg
+(define-move-vop move-float-arg :move-arg
(double-reg descriptor-reg) (double-reg))
-
\f
;;;; Complex float move functions
-
(defun complex-single-reg-real-tn (x)
(make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
:offset (tn-offset x)))
(make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
:offset (1+ (tn-offset x))))
-
(define-move-fun (load-complex-single 2) (vop x y)
((complex-single-stack) (complex-single-reg))
(let ((nfp (current-nfp-tn vop))
(let ((imag-tn (complex-single-reg-imag-tn x)))
(str-float imag-tn (+ offset n-word-bytes) nfp))))
-
(define-move-fun (load-complex-double 4) (vop x y)
((complex-double-stack) (complex-double-reg))
(let ((nfp (current-nfp-tn vop))
(let ((imag-tn (complex-double-reg-imag-tn x)))
(str-float imag-tn (+ offset (* 2 n-word-bytes)) nfp))))
-;;;
;;; Complex float register to register moves.
-;;;
(define-vop (complex-single-move)
(:args (x :scs (complex-single-reg) :target y
:load-if (not (location= x y))))
(let ((x-imag (complex-single-reg-imag-tn x))
(y-imag (complex-single-reg-imag-tn y)))
(inst funop :copy x-imag y-imag)))))
-;;;
(define-move-vop complex-single-move :move
(complex-single-reg) (complex-single-reg))
(let ((x-imag (complex-double-reg-imag-tn x))
(y-imag (complex-double-reg-imag-tn y)))
(inst funop :copy x-imag y-imag)))))
-;;;
(define-move-vop complex-double-move :move
(complex-double-reg) (complex-double-reg))
-;;;
;;; Move from a complex float to a descriptor register allocating a
;;; new complex float object in the process.
-;;;
(define-vop (move-from-complex-single)
(:args (x :scs (complex-single-reg) :to :save))
(:results (y :scs (descriptor-reg)))
(inst fsts imag-tn (- (* complex-single-float-imag-slot n-word-bytes)
other-pointer-lowtag)
y))))
-;;;
(define-move-vop move-from-complex-single :move
(complex-single-reg) (descriptor-reg))
(inst fsts imag-tn (- (* complex-double-float-imag-slot n-word-bytes)
other-pointer-lowtag)
y))))
-;;;
(define-move-vop move-from-complex-double :move
(complex-double-reg) (descriptor-reg))
-;;;
;;; Move from a descriptor to a complex float register
-;;;
(define-vop (move-to-complex-single)
(:args (x :scs (descriptor-reg)))
(:results (y :scs (complex-single-reg)))
(define-move-vop move-to-complex-double :move
(descriptor-reg) (complex-double-reg))
-;;;
-;;; Complex float move-argument vop
-;;;
-(define-vop (move-complex-single-float-argument)
+;;; Complex float move-arg vop
+(define-vop (move-complex-single-float-arg)
(:args (x :scs (complex-single-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
(:results (y))
(str-float real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn x)))
(str-float imag-tn (+ offset n-word-bytes) nfp)))))))
-;;;
-(define-move-vop move-complex-single-float-argument :move-arg
+(define-move-vop move-complex-single-float-arg :move-arg
(complex-single-reg descriptor-reg) (complex-single-reg))
-(define-vop (move-complex-double-float-argument)
+(define-vop (move-complex-double-float-arg)
(:args (x :scs (complex-double-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
(:results (y))
(str-float real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn x)))
(str-float imag-tn (+ offset (* 2 n-word-bytes)) nfp)))))))
-;;;
-(define-move-vop move-complex-double-float-argument :move-arg
+(define-move-vop move-complex-double-float-arg :move-arg
(complex-double-reg descriptor-reg) (complex-double-reg))
-
-(define-move-vop move-argument :move-arg
+(define-move-vop move-arg :move-arg
(single-reg double-reg complex-single-reg complex-double-reg)
(descriptor-reg))
-
\f
;;;; Arithmetic VOPs.
+;;;; the HPPA VM definition of operand loading/saving and the Move VOP
+
+;;;; 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-move-fun (load-immediate 1) (vop x y)
(load-symbol y val))
(character
(inst li (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)
+ character-widetag)
y)))))
(define-move-fun (load-number 1) (vop x y)
(let ((x (tn-value x)))
(inst li (if (>= x (ash 1 31)) (logior (ash -1 32) x) x) y)))
-(define-move-fun (load-base-char 1) (vop x y)
- ((immediate) (base-char-reg))
+(define-move-fun (load-character 1) (vop x y)
+ ((immediate) (character-reg))
(inst li (char-code (tn-value x)) y))
(define-move-fun (load-system-area-pointer 1) (vop x y)
(load-stack-tn y x))
(define-move-fun (load-number-stack 5) (vop x y)
- ((base-char-stack) (base-char-reg)
+ ((character-stack) (character-reg)
(sap-stack) (sap-reg)
(signed-stack) (signed-reg)
(unsigned-stack) (unsigned-reg))
(store-stack-tn y x))
(define-move-fun (store-number-stack 5) (vop x y)
- ((base-char-reg) (base-char-stack)
+ ((character-reg) (character-stack)
(sap-reg) (sap-stack)
(signed-reg) (signed-stack)
(unsigned-reg) (unsigned-stack))
\f
;;;; The Move VOP:
-;;;
(define-vop (move)
(:args (x :target y
:scs (any-reg descriptor-reg)
(any-reg descriptor-reg)
(any-reg descriptor-reg))
-;;; Make Move the check VOP for T so that type check generation doesn't think
-;;; it is a hairy type. This also allows checking of a few of the values in a
-;;; continuation to fall out.
-;;;
+;;; Make MOVE the check VOP for T so that type check generation
+;;; doesn't think it is a hairy type. This also allows checking of a
+;;; few of the values in a continuation to fall out.
(primitive-type-vop move (:check) t)
-;;; The Move-Argument VOP is used for moving descriptor values into another
+;;; The MOVE-ARG VOP is used for moving descriptor values into another
;;; frame for argument or known value passing.
-;;;
-(define-vop (move-argument)
+(define-vop (move-arg)
(:args (x :target y
:scs (any-reg descriptor-reg))
(fp :scs (any-reg)
(move x y))
(control-stack
(storew x fp (tn-offset y))))))
-;;;
-(define-move-vop move-argument :move-arg
+(define-move-vop move-arg :move-arg
(any-reg descriptor-reg)
(any-reg descriptor-reg))
\f
;;;; ILLEGAL-MOVE
-;;; This VOP exists just to begin the lifetime of a TN that couldn't be written
-;;; legally due to a type error. An error is signalled before this VOP is
-;;; so we don't need to do anything (not that there would be anything sensible
-;;; to do anyway.)
-;;;
+;;; This VOP exists just to begin the lifetime of a TN that couldn't
+;;; be written legally due to a type error. An error is signalled
+;;; before this VOP is so we don't need to do anything (not that there
+;;; would be anything sensible to do anyway.)
(define-vop (illegal-move)
(:args (x) (type))
(:results (y))
(:save-p :compute-only)
(:generator 666
(error-call vop object-not-type-error x type)))
-
-
\f
;;;; Moves and coercions:
;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
;;; to a tagged bignum or fixnum.
-;;; Arg is a fixnum, so just shift it. We need a type restriction because some
-;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
-;;;
+;;; ARG is a fixnum, so just shift it. We need a type restriction
+;;; because some possible arg SCs (control-stack) overlap with
+;;; possible bignum arg SCs.
(define-vop (move-to-word/fixnum)
(:args (x :scs (any-reg descriptor-reg)))
(:results (y :scs (signed-reg unsigned-reg)))
(:note "fixnum untagging")
(:generator 1
(inst sra x 2 y)))
-;;;
(define-move-vop move-to-word/fixnum :move
(any-reg descriptor-reg) (signed-reg unsigned-reg))
-;;; Arg is a non-immediate constant, load it.
+;;; ARG is a non-immediate constant, load it.
(define-vop (move-to-word-c)
(:args (x :scs (constant)))
(:results (y :scs (signed-reg unsigned-reg)))
(:note "constant load")
(:generator 1
(inst li (tn-value x) y)))
-;;;
(define-move-vop move-to-word-c :move
(constant) (signed-reg unsigned-reg))
-;;; Arg is a fixnum or bignum, figure out which and load if necessary.
+;;; ARG is a fixnum or bignum, figure out which and load if necessary.
(define-vop (move-to-word/integer)
(:args (x :scs (descriptor-reg)))
(:results (y :scs (signed-reg unsigned-reg)))
(inst extru x 31 2 zero-tn :<>)
(inst sra x 2 y :tr)
(loadw y x bignum-digits-offset other-pointer-lowtag)))
-;;;
(define-move-vop move-to-word/integer :move
(descriptor-reg) (signed-reg unsigned-reg))
-;;; Result is a fixnum, so we can just shift. We need the result type
+;;; RESULT is a fixnum, so we can just shift. We need the result type
;;; restriction because of the control-stack ambiguity noted above.
-;;;
(define-vop (move-from-word/fixnum)
(:args (x :scs (signed-reg unsigned-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:note "fixnum tagging")
(:generator 1
(inst sll x 2 y)))
-;;;
(define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg))
-;;; Result may be a bignum, so we have to check. Use a worst-case cost to make
-;;; sure people know they may be number consing.
-;;;
+;;; RESULT may be a bignum, so we have to check. Use a worst-case
+;;; cost to make sure people know they may be number consing.
(define-vop (move-from-signed)
(:args (x :scs (signed-reg unsigned-reg) :to (:eval 1)))
(:results (y :scs (any-reg descriptor-reg) :from (:eval 0)))
(with-fixed-allocation (y temp bignum-widetag (1+ bignum-digits-offset))
(storew x y bignum-digits-offset other-pointer-lowtag))
DONE))
-;;;
(define-move-vop move-from-signed :move
(signed-reg) (descriptor-reg))
-
-;;; Check for fixnum, and possibly allocate one or two word bignum result. Use
-;;; a worst-case cost to make sure people know they may be number consing.
-;;;
+;;; Check for fixnum, and possibly allocate one or two word bignum
+;;; result. Use a worst-case cost to make sure people know they may
+;;; be number consing.
(define-vop (move-from-unsigned)
(:args (x :scs (signed-reg unsigned-reg) :to (:eval 1)))
(:results (y :scs (any-reg descriptor-reg) :from (:eval 0)))
(storew temp y 0 other-pointer-lowtag)
(storew x y bignum-digits-offset other-pointer-lowtag))
DONE))
-;;;
(define-move-vop move-from-unsigned :move
(unsigned-reg) (descriptor-reg))
-
;;; Move untagged numbers.
-;;;
(define-vop (word-move)
(:args (x :target y
:scs (signed-reg unsigned-reg)
(:note "word integer move")
(:generator 0
(move x y)))
-;;;
(define-move-vop word-move :move
(signed-reg unsigned-reg) (signed-reg unsigned-reg))
-
-;;; Move untagged number arguments/return-values.
-;;;
-(define-vop (move-word-argument)
+;;; Move untagged number args/return-values.
+(define-vop (move-word-arg)
(:args (x :target y
:scs (signed-reg unsigned-reg))
(fp :scs (any-reg)
(move x y))
((signed-stack unsigned-stack)
(storew x fp (tn-offset y))))))
-;;;
-(define-move-vop move-word-argument :move-arg
+(define-move-vop move-word-arg :move-arg
(descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
-
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
+;;; Use standard MOVE-ARG + coercion to move an untagged number to a
;;; descriptor passing location.
-;;;
-(define-move-vop move-argument :move-arg
+(define-move-vop move-arg :move-arg
(signed-reg unsigned-reg) (any-reg descriptor-reg))
-;;;; the MIPS VM definition of SAP operations
+;;;; the HPPA VM definition of SAP operations
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
(:note "system area pointer indirection")
(:generator 1
(loadw y x sap-pointer-slot other-pointer-lowtag)))
-
(define-move-vop move-to-sap :move
(descriptor-reg) (sap-reg))
-
;;; Move an untagged SAP to a tagged representation.
(define-vop (move-from-sap)
(:args (x :scs (sap-reg) :to (:eval 1)))
(:generator 20
(with-fixed-allocation (y ndescr sap-widetag sap-size)
(storew x y sap-pointer-slot other-pointer-lowtag))))
-
(define-move-vop move-from-sap :move
(sap-reg) (descriptor-reg))
(:affected)
(:generator 0
(move x y)))
-
(define-move-vop sap-move :move
(sap-reg) (sap-reg))
-;;; Move untagged sap arguments/return-values.
-(define-vop (move-sap-argument)
+;;; Move untagged sap args/return-values.
+(define-vop (move-sap-arg)
(:args (x :target y
:scs (sap-reg))
(fp :scs (any-reg)
(move x y))
(sap-stack
(storew x fp (tn-offset y))))))
-
-(define-move-vop move-sap-argument :move-arg
+(define-move-vop move-sap-arg :move-arg
(descriptor-reg sap-reg) (sap-reg))
;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
;;; descriptor passing location.
-(define-move-vop move-argument :move-arg
+(define-move-vop move-arg :move-arg
(sap-reg) (descriptor-reg))
\f
;;;; SAP-INT and INT-SAP
;; The non-descriptor stacks.
(signed-stack non-descriptor-stack) ; (signed-byte 32)
(unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
- (base-char-stack non-descriptor-stack) ; non-descriptor characters.
+ (character-stack non-descriptor-stack) ; non-descriptor characters.
(sap-stack non-descriptor-stack) ; System area pointers.
(single-stack non-descriptor-stack) ; single-floats
(double-stack non-descriptor-stack
:alternate-scs (control-stack))
;; Non-Descriptor characters
- (base-char-reg registers
+ (character-reg registers
:locations #.non-descriptor-regs
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; Non-Descriptor SAP's (arbitrary pointers into address space)
(sap-reg registers
-(in-package "SB!VM")
+;;;; the MIPS VM definition of character 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
;;;; Moves and coercions:
;;; Move a tagged char to an untagged representation.
-;;;
-(define-vop (move-to-base-char)
+(define-vop (move-to-character)
(:args (x :scs (any-reg descriptor-reg)))
- (:results (y :scs (base-char-reg)))
+ (:results (y :scs (character-reg)))
(:generator 1
(inst srl y x n-widetag-bits)))
-;;;
-(define-move-vop move-to-base-char :move
- (any-reg descriptor-reg) (base-char-reg))
+(define-move-vop move-to-character :move
+ (any-reg descriptor-reg) (character-reg))
;;; Move an untagged char to a tagged representation.
-;;;
-(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg)))
+(define-vop (move-from-character)
+ (:args (x :scs (character-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:generator 1
(inst sll y x n-widetag-bits)
- (inst or y y base-char-widetag)))
-;;;
-(define-move-vop move-from-base-char :move
- (base-char-reg) (any-reg descriptor-reg))
+ (inst or y y character-widetag)))
+(define-move-vop move-from-character :move
+ (character-reg) (any-reg descriptor-reg))
-;;; Move untagged base-char values.
-;;;
-(define-vop (base-char-move)
+;;; Move untagged character values.
+(define-vop (character-move)
(:args (x :target y
- :scs (base-char-reg)
+ :scs (character-reg)
:load-if (not (location= x y))))
- (:results (y :scs (base-char-reg)
+ (:results (y :scs (character-reg)
:load-if (not (location= x y))))
(:effects)
(:affected)
(:generator 0
(move y x)))
-;;;
-(define-move-vop base-char-move :move
- (base-char-reg) (base-char-reg))
+(define-move-vop character-move :move
+ (character-reg) (character-reg))
-
-;;; Move untagged base-char arguments/return-values.
-;;;
-(define-vop (move-base-char-arg)
+;;; Move untagged character arguments/return-values.
+(define-vop (move-character-arg)
(:args (x :target y
- :scs (base-char-reg))
+ :scs (character-reg))
(fp :scs (any-reg)
- :load-if (not (sc-is y base-char-reg))))
+ :load-if (not (sc-is y character-reg))))
(:results (y))
(:generator 0
(sc-case y
- (base-char-reg
+ (character-reg
(move y x))
- (base-char-stack
+ (character-stack
(storew x fp (tn-offset y))))))
-;;;
-(define-move-vop move-base-char-arg :move-arg
- (any-reg base-char-reg) (base-char-reg))
-
+(define-move-vop move-character-arg :move-arg
+ (any-reg character-reg) (character-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged base-char
-;;; to a descriptor passing location.
-;;;
+;;; Use standard MOVE-ARG + coercion to move an untagged character to
+;;; a descriptor passing location.
(define-move-vop move-arg :move-arg
- (base-char-reg) (any-reg descriptor-reg))
-
-
+ (character-reg) (any-reg descriptor-reg))
\f
;;;; Other operations:
-
(define-vop (char-code)
(:translate char-code)
(:policy :fast-safe)
- (:args (ch :scs (base-char-reg) :target res))
- (:arg-types base-char)
+ (:args (ch :scs (character-reg) :target res))
+ (:arg-types character)
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 1
(:policy :fast-safe)
(:args (code :scs (any-reg) :target res))
(:arg-types positive-fixnum)
- (:results (res :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (res :scs (character-reg)))
+ (:result-types character)
(:generator 1
(inst srl res code 2)))
\f
-;;; Comparison of base-chars.
+;;; Comparison of characters.
;;;
-(define-vop (base-char-compare pointer-compare)
- (:args (x :scs (base-char-reg))
- (y :scs (base-char-reg)))
- (:arg-types base-char base-char))
+(define-vop (character-compare pointer-compare)
+ (:args (x :scs (character-reg))
+ (y :scs (character-reg)))
+ (:arg-types character character))
-(define-vop (fast-char=/base-char base-char-compare)
+(define-vop (fast-char=/character character-compare)
(:translate char=)
(:variant :eq))
-(define-vop (fast-char</base-char base-char-compare)
+(define-vop (fast-char</character character-compare)
(:translate char<)
(:variant :lt))
-(define-vop (fast-char>/base-char base-char-compare)
+(define-vop (fast-char>/character character-compare)
(:translate char>)
(:variant :gt))
+;;;; the MIPS VM definition of floating point 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
;;;; Move functions:
-
-
(define-move-fun (load-single 1) (vop x y)
((single-stack) (single-reg))
(inst lwc1 y (current-nfp-tn vop) (* (tn-offset x) n-word-bytes))
((single-reg) (single-stack))
(inst swc1 x (current-nfp-tn vop) (* (tn-offset y) n-word-bytes)))
-
(defun ld-double (r base offset)
(ecase *backend-byte-order*
(:big-endian
(let ((nfp (current-nfp-tn vop))
(offset (* (tn-offset y) n-word-bytes)))
(str-double x nfp offset)))
-
-
\f
;;;; Move VOPs:
-
(macrolet ((frob (vop sc format)
`(progn
(define-vop (,vop)
(frob single-move single-reg :single)
(frob double-move double-reg :double))
-
(define-vop (move-from-float)
(:args (x :to :save))
(:results (y))
(frob move-from-double double-reg
t double-float-size double-float-widetag double-float-value-slot))
-
(macrolet ((frob (name sc double-p value)
`(progn
(define-vop (,name)
(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 format double-p)
`(progn
(define-vop (,name)
(,sc descriptor-reg) (,sc)))))
(frob move-single-float-arg single-reg single-stack :single nil)
(frob move-double-float-arg double-reg double-stack :double t))
-
\f
;;;; Complex float move functions
(make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
:offset (+ (tn-offset x) 2)))
-
(define-move-fun (load-complex-single 2) (vop x y)
((complex-single-stack) (complex-single-reg))
(let ((nfp (current-nfp-tn vop))
(let ((imag-tn (complex-single-reg-imag-tn x)))
(inst swc1 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))
(let ((imag-tn (complex-double-reg-imag-tn x)))
(str-double imag-tn nfp (+ offset (* 2 n-word-bytes))))))
-;;;
;;; Complex float register to register moves.
-;;;
(define-vop (complex-single-move)
(:args (x :scs (complex-single-reg) :target y
:load-if (not (location= x y))))
(let ((x-imag (complex-single-reg-imag-tn x))
(y-imag (complex-single-reg-imag-tn y)))
(inst fmove :single y-imag x-imag)))))
-;;;
(define-move-vop complex-single-move :move
(complex-single-reg) (complex-single-reg))
(let ((x-imag (complex-double-reg-imag-tn x))
(y-imag (complex-double-reg-imag-tn y)))
(inst fmove :double y-imag x-imag)))))
-;;;
(define-move-vop complex-double-move :move
(complex-double-reg) (complex-double-reg))
-;;;
;;; Move from a complex float to a descriptor register allocating a
;;; new complex float object in the process.
-;;;
(define-vop (move-from-complex-single)
(:args (x :scs (complex-single-reg) :to :save))
(:results (y :scs (descriptor-reg)))
(inst swc1 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))
(str-double 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))
-;;;
;;; Move from a descriptor to a complex float register
-;;;
(define-vop (move-to-complex-single)
(:args (x :scs (descriptor-reg)))
(:results (y :scs (complex-single-reg)))
(define-move-vop move-to-complex-double :move
(descriptor-reg) (complex-double-reg))
-;;;
-;;; Complex float move-argument vop
-;;;
+;;; complex float MOVE-ARG VOP
(define-vop (move-complex-single-float-arg)
(:args (x :scs (complex-single-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
(define-move-vop move-complex-double-float-arg :move-arg
(complex-double-reg descriptor-reg) (complex-double-reg))
-
(define-move-vop move-arg :move-arg
(single-reg double-reg complex-single-reg complex-double-reg)
(descriptor-reg))
\f
;;;; stuff for c-call float-in-int-register arguments
-
(define-vop (move-to-single-int-reg)
(:args (x :scs (single-reg descriptor-reg)))
(:results (y :scs (single-int-carg-reg) :load-if nil))
(load-symbol y val))
(character
(inst li y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag))))))
+ character-widetag))))))
(define-move-fun (load-number 1) (vop x y)
((zero immediate)
(signed-reg unsigned-reg))
(inst li y (tn-value x)))
-(define-move-fun (load-base-char 1) (vop x y)
- ((immediate) (base-char-reg))
+(define-move-fun (load-character 1) (vop x y)
+ ((immediate) (character-reg))
(inst li y (char-code (tn-value x))))
(define-move-fun (load-system-area-pointer 1) (vop x y)
(load-stack-tn y x))
(define-move-fun (load-number-stack 5) (vop x y)
- ((base-char-stack) (base-char-reg)
+ ((character-stack) (character-reg)
(sap-stack) (sap-reg)
(signed-stack) (signed-reg)
(unsigned-stack) (unsigned-reg))
(store-stack-tn y x))
(define-move-fun (store-number-stack 5) (vop x y)
- ((base-char-reg) (base-char-stack)
+ ((character-reg) (character-stack)
(sap-reg) (sap-stack)
(signed-reg) (signed-stack)
(unsigned-reg) (unsigned-stack))
;; The non-descriptor stacks.
(signed-stack non-descriptor-stack) ; (signed-byte 32)
(unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
- (base-char-stack non-descriptor-stack) ; non-descriptor characters.
+ (character-stack non-descriptor-stack) ; non-descriptor characters.
(sap-stack non-descriptor-stack) ; System area pointers.
(single-stack non-descriptor-stack) ; single-floats
(double-stack non-descriptor-stack :element-size 2) ; double floats.
:alternate-scs (control-stack))
;; Non-Descriptor characters
- (base-char-reg registers
+ (character-reg registers
:locations #.non-descriptor-regs
:reserve-locations #.reserve-non-descriptor-regs
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; Non-Descriptor SAP's (arbitrary pointers into address space)
(sap-reg registers
(:results (result :scs ,scs))
(:result-types ,element-type)))))
(def-data-vector-frobs simple-base-string byte-index
- base-char base-char-reg)
+ character character-reg)
(def-data-vector-frobs simple-vector word-index
* descriptor-reg any-reg)
;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-;;;
(!def-vm-support-routine standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(vector-push-extend nil
(ir2-component-constants (component-info component))))
(values))
-
\f
;;;; Frame hackery:
;;; Used for setting up the Old-FP in local call.
-;;;
(define-vop (current-fp)
(:results (val :scs (any-reg)))
(:generator 1
;;; Used for computing the caller's NFP for use in known-values return. Only
;;; works assuming there is no variable size stuff on the nstack.
-;;;
(define-vop (compute-old-nfp)
(:results (val :scs (any-reg)))
(:vop-var vop)
(when nfp
(inst addi val nfp (bytes-needed-for-non-descriptor-stack-frame))))))
-
(define-vop (xep-allocate-frame)
(:info start-lab copy-more-arg-follows)
(:ignore copy-more-arg-follows)
;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
;;; is the number of arguments passed. If no stack arguments are passed, then
;;; we don't have to do anything.
-;;;
(define-vop (allocate-full-call-frame)
(:info nargs)
(:results (res :scs (any-reg)))
(move res csp-tn)
(inst addi csp-tn csp-tn (* nargs n-word-bytes)))))
-
;;; Emit code needed at the return-point from an unknown-values call
;;; for a fixed number of values. Values is the head of the TN-REF
;;; list for the locations that the values are to be received into.
;;; Args and Nargs are TNs wired to the named locations. We must
;;; explicitly allocate these TNs, since their lifetimes overlap with the
;;; results Start and Count (also, it's nice to be able to target them).
-;;;
(defun receive-unknown-values (args nargs start count lra-label temp)
(declare (type tn args nargs start count temp))
(let ((variable-values (gen-label))
(values))
-;;; VOP that can be inherited by unknown values receivers. The main thing this
-;;; handles is allocation of the result temporaries.
-;;;
+;;; VOP that can be inherited by unknown values receivers. The main
+;;; thing this handles is allocation of the result temporaries.
(define-vop (unknown-values-receiver)
(:results
(start :scs (any-reg))
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (call-local)
(:args (fp)
(nfp)
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (multiple-call-local unknown-values-receiver)
(:args (fp)
(nfp)
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (known-call-local)
(:args (fp)
(nfp)
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (known-return)
(:args (old-fp :target old-fp-temp)
(return-pc :target return-pc-temp)
(define-full-call multiple-call-variable nil :unknown t)
-;;; Defined separately, since needs special code that BLT's the arguments
-;;; down.
-;;;
+;;; Defined separately, since needs special code that BLT's the
+;;; arguments down.
(define-vop (tail-call-variable)
(:args
(args-arg :scs (any-reg) :target args)
\f
;;;; Unknown values return:
-
;;; Return a single value using the unknown-values convention.
-;;;
(define-vop (return-single)
(:args (old-fp :scs (any-reg))
(return-pc :scs (descriptor-reg))
;;; When there are stack values, we must initialize the argument pointer to
;;; point to the beginning of the values block (which is the beginning of the
;;; current frame.)
-;;;
(define-vop (return)
(:args
(old-fp :scs (any-reg))
(lisp-return return-pc lip)))
(trace-table-entry trace-table-normal)))
-;;; Do unknown-values return of an arbitrary number of values (passed on the
-;;; stack.) We check for the common case of a single return value, and do that
-;;; inline using the normal single value return convention. Otherwise, we
-;;; branch off to code that calls an assembly-routine.
-;;;
+;;; Do unknown-values return of an arbitrary number of values (passed
+;;; on the stack.) We check for the common case of a single return
+;;; value, and do that inline using the normal single value return
+;;; convention. Otherwise, we branch off to code that calls an
+;;; assembly-routine.
(define-vop (return-multiple)
(:args
(old-fp-arg :scs (any-reg) :to (:eval 1))
(move nvals nvals-arg)
(inst ba (make-fixup 'return-multiple :assembly-routine)))
(trace-table-entry trace-table-normal)))
-
-
\f
;;;; XEP hackery:
-
;;; We don't need to do anything special for regular functions.
-;;;
(define-vop (setup-environment)
(:info label)
(:ignore label)
))
;;; Get the lexical environment from its passing location.
-;;;
(define-vop (setup-closure-environment)
(:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
:to (:result 0))
;;; Copy a more arg from the argument area to the end of the current frame.
;;; Fixed is the number of non-more arguments.
-;;;
(define-vop (copy-more-arg)
(:temporary (:sc any-reg :offset nl0-offset) result)
(:temporary (:sc any-reg :offset nl1-offset) count)
(emit-label done))))
-;;; More args are stored consecutively on the stack, starting immediately at
-;;; the context pointer. The context pointer is not typed, so the lowtag is 0.
-;;;
+;;; More args are stored consecutively on the stack, starting
+;;; immediately at the context pointer. The context pointer is not
+;;; typed, so the lowtag is 0.
(define-vop (more-arg word-index-ref)
(:variant 0 0)
(:translate %more-arg))
-
;;; Turn more arg (context, count) into a list.
-;;;
(define-vop (listify-rest-args)
(:args (context-arg :target context :scs (descriptor-reg))
(count-arg :target count :scs (any-reg)))
DONE))
-;;; Return the location and size of the more arg glob created by Copy-More-Arg.
-;;; Supplied is the total number of arguments supplied (originally passed in
-;;; NARGS.) Fixed is the number of non-rest arguments.
-;;;
-;;; We must duplicate some of the work done by Copy-More-Arg, since at that
-;;; time the environment is in a pretty brain-damaged state, preventing this
-;;; info from being returned as values. What we do is compute
-;;; supplied - fixed, and return a pointer that many words below the current
-;;; stack top.
+;;; Return the location and size of the more arg glob created by
+;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied
+;;; (originally passed in NARGS.) Fixed is the number of non-rest
+;;; arguments.
;;;
+;;; We must duplicate some of the work done by COPY-MORE-ARG, since at
+;;; that time the environment is in a pretty brain-damaged state,
+;;; preventing this info from being returned as values. What we do is
+;;; compute (- SUPPLIED FIXED), and return a pointer that many words
+;;; below the current stack top.
(define-vop (more-arg-context)
(:policy :fast-safe)
(:translate sb!c::%more-arg-context)
(inst subi count supplied (fixnumize fixed))
(inst sub context csp-tn count)))
-
-;;; Signal wrong argument count error if Nargs isn't = to Count.
-;;;
-#|
-(define-vop (verify-argument-count)
- (:policy :fast-safe)
- (:translate sb!c::%verify-argument-count)
- (:args (nargs :scs (any-reg)))
- (:arg-types positive-fixnum (:constant t))
- (:info count)
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 3
- (let ((err-lab
- (generate-error-code vop invalid-argument-count-error nargs)))
- (inst cmpwi nargs (fixnumize count))
- (inst bne err-lab))))
-|#
(define-vop (verify-arg-count)
(:policy :fast-safe)
(:translate sb!c::%verify-arg-count)
(:generator 3
(inst twi :ne nargs (fixnumize count))))
-
;;; Signal various errors.
-;;;
(macrolet ((frob (name error translate &rest args)
`(define-vop (,name)
,@(when translate
;;;; Moves and coercions:
;;; Move a tagged char to an untagged representation.
-(define-vop (move-to-base-char)
+(define-vop (move-to-character)
(:args (x :scs (any-reg descriptor-reg)))
- (:results (y :scs (base-char-reg)))
+ (:results (y :scs (character-reg)))
(:note "character untagging")
(:generator 1
(inst srwi y x n-widetag-bits)))
-
-(define-move-vop move-to-base-char :move
- (any-reg descriptor-reg) (base-char-reg))
-
+(define-move-vop move-to-character :move
+ (any-reg descriptor-reg) (character-reg))
;;; Move an untagged char to a tagged representation.
-(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg)))
+(define-vop (move-from-character)
+ (:args (x :scs (character-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:note "character tagging")
(:generator 1
(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))
+ (inst ori y y character-widetag)))
+(define-move-vop move-from-character :move
+ (character-reg) (any-reg descriptor-reg))
-;;; Move untagged base-char values.
-(define-vop (base-char-move)
+;;; Move untagged character values.
+(define-vop (character-move)
(:args (x :target y
- :scs (base-char-reg)
+ :scs (character-reg)
:load-if (not (location= x y))))
- (:results (y :scs (base-char-reg)
+ (:results (y :scs (character-reg)
:load-if (not (location= x y))))
(:note "character move")
(:effects)
(:affected)
(:generator 0
(move y x)))
+(define-move-vop character-move :move
+ (character-reg) (character-reg))
-(define-move-vop base-char-move :move
- (base-char-reg) (base-char-reg))
-
-;;; Move untagged base-char arguments/return-values.
-(define-vop (move-base-char-arg)
+;;; Move untagged character arguments/return-values.
+(define-vop (move-character-arg)
(:args (x :target y
- :scs (base-char-reg))
+ :scs (character-reg))
(fp :scs (any-reg)
- :load-if (not (sc-is y base-char-reg))))
+ :load-if (not (sc-is y character-reg))))
(:results (y))
(:note "character arg move")
(:generator 0
(sc-case y
- (base-char-reg
+ (character-reg
(move y x))
- (base-char-stack
+ (character-stack
(storew x fp (tn-offset y))))))
+(define-move-vop move-character-arg :move-arg
+ (any-reg character-reg) (character-reg))
-(define-move-vop move-base-char-arg :move-arg
- (any-reg base-char-reg) (base-char-reg))
-
-
-;;; Use standard MOVE-ARG + coercion to move an untagged base-char
+;;; Use standard MOVE-ARG + coercion to move an untagged character
;;; to a descriptor passing location.
(define-move-vop move-arg :move-arg
- (base-char-reg) (any-reg descriptor-reg))
-
-
+ (character-reg) (any-reg descriptor-reg))
\f
;;;; Other operations:
(define-vop (char-code)
(:translate char-code)
(:policy :fast-safe)
- (:args (ch :scs (base-char-reg) :target res))
- (:arg-types base-char)
+ (:args (ch :scs (character-reg) :target res))
+ (:arg-types character)
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 1
(:policy :fast-safe)
(:args (code :scs (any-reg) :target res))
(:arg-types positive-fixnum)
- (:results (res :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (res :scs (character-reg)))
+ (:result-types character)
(:generator 1
(inst srwi res code 2)))
-
\f
-;;; Comparison of base-chars.
-(define-vop (base-char-compare)
- (:args (x :scs (base-char-reg))
- (y :scs (base-char-reg)))
- (:arg-types base-char base-char)
+;;; Comparison of characters.
+(define-vop (character-compare)
+ (:args (x :scs (character-reg))
+ (y :scs (character-reg)))
+ (:arg-types character character)
(:conditional)
(:info target not-p)
(:policy :fast-safe)
(inst cmplw x y)
(inst b? (if not-p not-condition condition) target)))
-(define-vop (fast-char=/base-char base-char-compare)
+(define-vop (fast-char=/character character-compare)
(:translate char=)
(:variant :eq :ne))
-(define-vop (fast-char</base-char base-char-compare)
+(define-vop (fast-char</character character-compare)
(:translate char<)
(:variant :lt :ge))
-(define-vop (fast-char>/base-char base-char-compare)
+(define-vop (fast-char>/character character-compare)
(:translate char>)
(:variant :gt :le))
-(define-vop (base-char-compare/c)
- (:args (x :scs (base-char-reg)))
- (:arg-types base-char (:constant base-char))
+(define-vop (character-compare/c)
+ (:args (x :scs (character-reg)))
+ (:arg-types character (:constant character))
(:conditional)
(:info target not-p y)
(:policy :fast-safe)
(inst cmplwi x (sb!xc:char-code y))
(inst b? (if not-p not-condition condition) target)))
-(define-vop (fast-char=/base-char/c base-char-compare/c)
+(define-vop (fast-char=/character/c character-compare/c)
(:translate char=)
(:variant :eq :ne))
-(define-vop (fast-char</base-char/c base-char-compare/c)
+(define-vop (fast-char</character/c character-compare/c)
(:translate char<)
(:variant :lt :ge))
-(define-vop (fast-char>/base-char/c base-char-compare/c)
+(define-vop (fast-char>/character/c character-compare/c)
(:translate char>)
(:variant :gt :le))
-
-;;; Written by Rob MacLachlan.
-;;; SPARC conversion by William Lott.
-;;;
-(in-package "SB!VM")
+;;;; the PPC VM definition of operand loading/saving and the Move VOP
+;;;; 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-move-fun (load-immediate 1) (vop x y)
((null immediate zero)
(load-symbol y val))
(character
(inst lr y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag))))))
+ character-widetag))))))
(define-move-fun (load-number 1) (vop x y)
((immediate zero)
(signed-reg unsigned-reg))
(inst lr y (tn-value x)))
-(define-move-fun (load-base-char 1) (vop x y)
- ((immediate) (base-char-reg))
+(define-move-fun (load-character 1) (vop x y)
+ ((immediate) (character-reg))
(inst li y (char-code (tn-value x))))
(define-move-fun (load-system-area-pointer 1) (vop x y)
(load-stack-tn y x))
(define-move-fun (load-number-stack 5) (vop x y)
- ((base-char-stack) (base-char-reg)
+ ((character-stack) (character-reg)
(sap-stack) (sap-reg)
(signed-stack) (signed-reg)
(unsigned-stack) (unsigned-reg))
(store-stack-tn y x))
(define-move-fun (store-number-stack 5) (vop x y)
- ((base-char-reg) (base-char-stack)
+ ((character-reg) (character-stack)
(sap-reg) (sap-stack)
(signed-reg) (signed-stack)
(unsigned-reg) (unsigned-stack))
\f
;;;; The Move VOP:
-;;;
(define-vop (move)
(:args (x :target y
:scs (any-reg descriptor-reg zero null)
(any-reg descriptor-reg)
(any-reg descriptor-reg))
-;;; Make Move the check VOP for T so that type check generation doesn't think
-;;; it is a hairy type. This also allows checking of a few of the values in a
-;;; continuation to fall out.
-;;;
+;;; Make MOVE the check VOP for T so that type check generation
+;;; doesn't think it is a hairy type. This also allows checking of a
+;;; few of the values in a continuation to fall out.
(primitive-type-vop move (:check) t)
-;;; The Move-Argument VOP is used for moving descriptor values into another
+;;; The MOVE-ARG VOP is used for moving descriptor values into another
;;; frame for argument or known value passing.
-;;;
(define-vop (move-arg)
(:args (x :target y
:scs (any-reg descriptor-reg zero null))
\f
;;;; ILLEGAL-MOVE
-;;; This VOP exists just to begin the lifetime of a TN that couldn't be written
-;;; legally due to a type error. An error is signalled before this VOP is
-;;; so we don't need to do anything (not that there would be anything sensible
-;;; to do anyway.)
-;;;
+;;; This VOP exists just to begin the lifetime of a TN that couldn't
+;;; be written legally due to a type error. An error is signalled
+;;; before this VOP is so we don't need to do anything (not that there
+;;; would be anything sensible to do anyway.)
(define-vop (illegal-move)
(:args (x) (type))
(:results (y))
;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
;;; to a tagged bignum or fixnum.
-;;; Arg is a fixnum, so just shift it. We need a type restriction because some
+;;; ARG is a fixnum, so just shift it. We need a type restriction because some
;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
-;;;
(define-vop (move-to-word/fixnum)
(:args (x :scs (any-reg descriptor-reg)))
(:results (y :scs (signed-reg unsigned-reg)))
(:note "fixnum untagging")
(:generator 1
(inst srawi y x 2)))
-;;;
(define-move-vop move-to-word/fixnum :move
(any-reg descriptor-reg) (signed-reg unsigned-reg))
-;;; Arg is a non-immediate constant, load it.
+;;; ARG is a non-immediate constant; load it.
(define-vop (move-to-word-c)
(:args (x :scs (constant)))
(:results (y :scs (signed-reg unsigned-reg)))
(:note "constant load")
(:generator 1
(inst lr y (tn-value x))))
-;;;
(define-move-vop move-to-word-c :move
(constant) (signed-reg unsigned-reg))
-
-;;; Arg is a fixnum or bignum, figure out which and load if necessary.
+;;; ARG is a fixnum or bignum; figure out which and load if necessary.
(define-vop (move-to-word/integer)
(:args (x :scs (descriptor-reg)))
(:results (y :scs (signed-reg unsigned-reg)))
(loadw y x bignum-digits-offset other-pointer-lowtag)
(emit-label done))))
-;;;
(define-move-vop move-to-word/integer :move
(descriptor-reg) (signed-reg unsigned-reg))
-
-
-;;; Result is a fixnum, so we can just shift. We need the result type
+;;; RESULT is a fixnum, so we can just shift. We need the result type
;;; restriction because of the control-stack ambiguity noted above.
-;;;
(define-vop (move-from-word/fixnum)
(:args (x :scs (signed-reg unsigned-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:note "fixnum tagging")
(:generator 1
(inst slwi y x 2)))
-;;;
(define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg))
-
-;;; Result may be a bignum, so we have to check. Use a worst-case cost to make
-;;; sure people know they may be number consing.
-;;;
+;;; RESULT may be a bignum, so we have to check. Use a worst-case
+;;; cost to make sure people know they may be number consing.
(define-vop (move-from-signed)
(:args (arg :scs (signed-reg unsigned-reg) :target x))
(:results (y :scs (any-reg descriptor-reg)))
(with-fixed-allocation (y pa-flag temp bignum-widetag (1+ bignum-digits-offset))
(storew x y bignum-digits-offset other-pointer-lowtag))
(emit-label done))))
-;;;
(define-move-vop move-from-signed :move
(signed-reg) (descriptor-reg))
-
-;;; Check for fixnum, and possibly allocate one or two word bignum result. Use
-;;; a worst-case cost to make sure people know they may be number consing.
-;;;
+;;; Check for fixnum, and possibly allocate one or two word bignum
+;;; result. Use a worst-case cost to make sure people know they may
+;;; be number consing.
(define-vop (move-from-unsigned)
(:args (arg :scs (signed-reg unsigned-reg) :target x))
(:results (y :scs (any-reg descriptor-reg)))
(storew temp y 0 other-pointer-lowtag)
(storew x y bignum-digits-offset other-pointer-lowtag))
(emit-label done))))
-;;;
(define-move-vop move-from-unsigned :move
(unsigned-reg) (descriptor-reg))
;;; Move untagged numbers.
-;;;
(define-vop (word-move)
(:args (x :target y
:scs (signed-reg unsigned-reg)
(:note "word integer move")
(:generator 0
(move y x)))
-;;;
(define-move-vop word-move :move
(signed-reg unsigned-reg) (signed-reg unsigned-reg))
;;; Move untagged number arguments/return-values.
-;;;
(define-vop (move-word-arg)
(:args (x :target y
:scs (signed-reg unsigned-reg))
(move y x))
((signed-stack unsigned-stack)
(storew x fp (tn-offset y))))))
-;;;
(define-move-vop move-word-arg :move-arg
(descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
-
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
+;;; Use standard MOVE-ARG + coercion to move an untagged number to a
;;; descriptor passing location.
-;;;
(define-move-vop move-arg :move-arg
(signed-reg unsigned-reg) (any-reg descriptor-reg))
;; The non-descriptor stacks.
(signed-stack non-descriptor-stack) ; (signed-byte 32)
(unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
- (base-char-stack non-descriptor-stack) ; non-descriptor characters.
+ (character-stack non-descriptor-stack) ; non-descriptor characters.
(sap-stack non-descriptor-stack) ; System area pointers.
(single-stack non-descriptor-stack) ; single-floats
(double-stack non-descriptor-stack
:alternate-scs (control-stack))
;; Non-Descriptor characters
- (base-char-reg registers
+ (character-reg registers
:locations #.non-descriptor-regs
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; Non-Descriptor SAP's (arbitrary pointers into address space)
(sap-reg registers
(:result-types ,element-type)))))
(def-data-vector-frobs simple-base-string byte-index
- base-char base-char-reg)
+ character character-reg)
(def-data-vector-frobs simple-vector word-index
* descriptor-reg any-reg)
;;;; moves and coercions:
;;; Move a tagged char to an untagged representation.
-(define-vop (move-to-base-char)
+(define-vop (move-to-character)
(:args (x :scs (any-reg descriptor-reg)))
- (:results (y :scs (base-char-reg)))
+ (:results (y :scs (character-reg)))
(:note "character untagging")
(:generator 1
(inst srl y x n-widetag-bits)))
-(define-move-vop move-to-base-char :move
- (any-reg descriptor-reg) (base-char-reg))
+(define-move-vop move-to-character :move
+ (any-reg descriptor-reg) (character-reg))
;;; Move an untagged char to a tagged representation.
-(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg)))
+(define-vop (move-from-character)
+ (:args (x :scs (character-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:note "character tagging")
(:generator 1
(inst sll y x n-widetag-bits)
- (inst or y base-char-widetag)))
+ (inst or y character-widetag)))
-(define-move-vop move-from-base-char :move
- (base-char-reg) (any-reg descriptor-reg))
+(define-move-vop move-from-character :move
+ (character-reg) (any-reg descriptor-reg))
-;;; Move untagged base-char values.
-(define-vop (base-char-move)
+;;; Move untagged character values.
+(define-vop (character-move)
(:args (x :target y
- :scs (base-char-reg)
+ :scs (character-reg)
:load-if (not (location= x y))))
- (:results (y :scs (base-char-reg)
+ (:results (y :scs (character-reg)
:load-if (not (location= x y))))
(:note "character move")
(:effects)
(:generator 0
(move y x)))
-(define-move-vop base-char-move :move
- (base-char-reg) (base-char-reg))
+(define-move-vop character-move :move
+ (character-reg) (character-reg))
-;;; Move untagged base-char arguments/return-values.
-(define-vop (move-base-char-arg)
+;;; Move untagged character arguments/return-values.
+(define-vop (move-character-arg)
(:args (x :target y
- :scs (base-char-reg))
+ :scs (character-reg))
(fp :scs (any-reg)
- :load-if (not (sc-is y base-char-reg))))
+ :load-if (not (sc-is y character-reg))))
(:results (y))
(:note "character arg move")
(:generator 0
(sc-case y
- (base-char-reg
+ (character-reg
(move y x))
- (base-char-stack
+ (character-stack
(storew x fp (tn-offset y))))))
-(define-move-vop move-base-char-arg :move-arg
- (any-reg base-char-reg) (base-char-reg))
+(define-move-vop move-character-arg :move-arg
+ (any-reg character-reg) (character-reg))
-;;; Use standard MOVE-ARG + coercion to move an untagged base-char
+;;; Use standard MOVE-ARG + coercion to move an untagged character
;;; to a descriptor passing location.
(define-move-vop move-arg :move-arg
- (base-char-reg) (any-reg descriptor-reg))
+ (character-reg) (any-reg descriptor-reg))
\f
(define-vop (char-code)
(:translate char-code)
(:policy :fast-safe)
- (:args (ch :scs (base-char-reg) :target res))
- (:arg-types base-char)
+ (:args (ch :scs (character-reg) :target res))
+ (:arg-types character)
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 1
(:policy :fast-safe)
(:args (code :scs (any-reg) :target res))
(:arg-types positive-fixnum)
- (:results (res :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (res :scs (character-reg)))
+ (:result-types character)
(:generator 1
(inst srl res code n-fixnum-tag-bits)))
\f
-;;; Comparison of base-chars.
-(define-vop (base-char-compare)
- (:args (x :scs (base-char-reg))
- (y :scs (base-char-reg)))
- (:arg-types base-char base-char)
+;;; Comparison of characters.
+(define-vop (character-compare)
+ (:args (x :scs (character-reg))
+ (y :scs (character-reg)))
+ (:arg-types character character)
(:conditional)
(:info target not-p)
(:policy :fast-safe)
(inst b (if not-p not-condition condition) target)
(inst nop)))
-(define-vop (fast-char=/base-char base-char-compare)
+(define-vop (fast-char=/character character-compare)
(:translate char=)
(:variant :eq :ne))
-(define-vop (fast-char</base-char base-char-compare)
+(define-vop (fast-char</character character-compare)
(:translate char<)
(:variant :ltu :geu))
-(define-vop (fast-char>/base-char base-char-compare)
+(define-vop (fast-char>/character character-compare)
(:translate char>)
(:variant :gtu :leu))
-(define-vop (base-char-compare/c)
- (:args (x :scs (base-char-reg)))
- (:arg-types base-char (:constant base-char))
+(define-vop (character-compare/c)
+ (:args (x :scs (character-reg)))
+ (:arg-types character (:constant character))
(:conditional)
(:info target not-p y)
(:policy :fast-safe)
(inst b (if not-p not-condition condition) target)
(inst nop)))
-(define-vop (fast-char=/base-char/c base-char-compare/c)
+(define-vop (fast-char=/character/c character-compare/c)
(:translate char=)
(:variant :eq :ne))
-(define-vop (fast-char</base-char/c base-char-compare/c)
+(define-vop (fast-char</character/c character-compare/c)
(:translate char<)
(:variant :ltu :geu))
-(define-vop (fast-char>/base-char/c base-char-compare/c)
+(define-vop (fast-char>/character/c character-compare/c)
(:translate char>)
(:variant :gtu :leu))
(load-symbol y val))
(character
(inst li y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag))))))
+ character-widetag))))))
(define-move-fun (load-number 1) (vop x y)
((immediate zero)
(signed-reg unsigned-reg))
(inst li y (tn-value x)))
-(define-move-fun (load-base-char 1) (vop x y)
- ((immediate) (base-char-reg))
+(define-move-fun (load-character 1) (vop x y)
+ ((immediate) (character-reg))
(inst li y (char-code (tn-value x))))
(define-move-fun (load-system-area-pointer 1) (vop x y)
(load-stack-tn y x))
(define-move-fun (load-number-stack 5) (vop x y)
- ((base-char-stack) (base-char-reg)
+ ((character-stack) (character-reg)
(sap-stack) (sap-reg)
(signed-stack) (signed-reg)
(unsigned-stack) (unsigned-reg))
(store-stack-tn y x))
(define-move-fun (store-number-stack 5) (vop x y)
- ((base-char-reg) (base-char-stack)
+ ((character-reg) (character-stack)
(sap-reg) (sap-stack)
(signed-reg) (signed-stack)
(unsigned-reg) (unsigned-stack))
;; The non-descriptor stacks.
(signed-stack non-descriptor-stack) ; (signed-byte 32)
(unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
- (base-char-stack non-descriptor-stack) ; non-descriptor characters.
+ (character-stack non-descriptor-stack) ; non-descriptor characters.
(sap-stack non-descriptor-stack) ; System area pointers.
(single-stack non-descriptor-stack) ; single-floats
(double-stack non-descriptor-stack
:alternate-scs (control-stack))
;; Non-Descriptor characters
- (base-char-reg registers
+ (character-reg registers
:locations #.non-descriptor-regs
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; Non-Descriptor SAP's (arbitrary pointers into address space)
(sap-reg registers
(:args (object :scs (descriptor-reg))
(index :scs (unsigned-reg)))
(:arg-types simple-base-string positive-fixnum)
- (:results (value :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (value :scs (character-reg)))
+ (:result-types character)
(:generator 5
(inst mov value
(make-ea :byte :base object :index index :scale 1
(:args (object :scs (descriptor-reg)))
(:info index)
(:arg-types simple-base-string (:constant (signed-byte 30)))
- (:results (value :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (value :scs (character-reg)))
+ (:result-types character)
(:generator 4
(inst mov value
(make-ea :byte :base object
(:policy :fast-safe)
(:args (object :scs (descriptor-reg) :to (:eval 0))
(index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (base-char-reg) :target result))
- (:arg-types simple-base-string positive-fixnum base-char)
- (:results (result :scs (base-char-reg)))
- (:result-types base-char)
+ (value :scs (character-reg) :target result))
+ (:arg-types simple-base-string positive-fixnum character)
+ (:results (result :scs (character-reg)))
+ (:result-types character)
(:generator 5
(inst mov (make-ea :byte :base object :index index :scale 1
:disp (- (* vector-data-offset n-word-bytes)
(:translate data-vector-set)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (base-char-reg)))
+ (value :scs (character-reg)))
(:info index)
- (:arg-types simple-base-string (:constant (signed-byte 30)) base-char)
- (:results (result :scs (base-char-reg)))
- (:result-types base-char)
+ (:arg-types simple-base-string (:constant (signed-byte 30)) character)
+ (:results (result :scs (character-reg)))
+ (:result-types character)
(:generator 4
(inst mov (make-ea :byte :base object
:disp (- (+ (* vector-data-offset n-word-bytes) index)
(make-ea :dword :base object
:disp (- (* offset n-word-bytes) lowtag))
(logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)))))
+ character-widetag)))))
;; Else, value not immediate.
(storew value object offset lowtag))))
\f
;;;; moves and coercions
;;; Move a tagged char to an untagged representation.
-(define-vop (move-to-base-char)
+(define-vop (move-to-character)
(:args (x :scs (any-reg control-stack) :target al))
(:temporary (:sc byte-reg :offset al-offset
:from (:argument 0) :to (:eval 0)) al)
(:ignore al)
(:temporary (:sc byte-reg :offset ah-offset :target y
:from (:argument 0) :to (:result 0)) ah)
- (:results (y :scs (base-char-reg base-char-stack)))
+ (:results (y :scs (character-reg character-stack)))
(:note "character untagging")
(:generator 1
(move eax-tn x)
(move y ah)))
-(define-move-vop move-to-base-char :move
- (any-reg control-stack) (base-char-reg base-char-stack))
+(define-move-vop move-to-character :move
+ (any-reg control-stack) (character-reg character-stack))
;;; Move an untagged char to a tagged representation.
-(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg base-char-stack) :target ah))
+(define-vop (move-from-character)
+ (:args (x :scs (character-reg character-stack) :target ah))
(:temporary (:sc byte-reg :offset al-offset :target y
:from (:argument 0) :to (:result 0)) al)
(:temporary (:sc byte-reg :offset ah-offset
(:note "character tagging")
(:generator 1
(move ah x) ; Maybe move char byte.
- (inst mov al base-char-widetag) ; x86 to type bits
+ (inst mov al character-widetag) ; x86 to type bits
(inst and eax-tn #xffff) ; Remove any junk bits.
(move y eax-tn)))
-(define-move-vop move-from-base-char :move
- (base-char-reg base-char-stack) (any-reg descriptor-reg control-stack))
+(define-move-vop move-from-character :move
+ (character-reg character-stack) (any-reg descriptor-reg control-stack))
-;;; Move untagged base-char values.
-(define-vop (base-char-move)
+;;; Move untagged character values.
+(define-vop (character-move)
(:args (x :target y
- :scs (base-char-reg)
+ :scs (character-reg)
:load-if (not (location= x y))))
- (:results (y :scs (base-char-reg base-char-stack)
+ (:results (y :scs (character-reg character-stack)
:load-if (not (location= x y))))
(:note "character move")
(:effects)
(:affected)
(:generator 0
(move y x)))
-(define-move-vop base-char-move :move
- (base-char-reg) (base-char-reg base-char-stack))
+(define-move-vop character-move :move
+ (character-reg) (character-reg character-stack))
-;;; Move untagged base-char arguments/return-values.
-(define-vop (move-base-char-arg)
+;;; Move untagged character arguments/return-values.
+(define-vop (move-character-arg)
(:args (x :target y
- :scs (base-char-reg))
+ :scs (character-reg))
(fp :scs (any-reg)
- :load-if (not (sc-is y base-char-reg))))
+ :load-if (not (sc-is y character-reg))))
(:results (y))
(:note "character arg move")
(:generator 0
(sc-case y
- (base-char-reg
+ (character-reg
(move y x))
- (base-char-stack
+ (character-stack
(inst mov
(make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4)))
x)))))
-(define-move-vop move-base-char-arg :move-arg
- (any-reg base-char-reg) (base-char-reg))
+(define-move-vop move-character-arg :move-arg
+ (any-reg character-reg) (character-reg))
-;;; Use standard MOVE-ARG + coercion to move an untagged base-char
+;;; Use standard MOVE-ARG + coercion to move an untagged character
;;; to a descriptor passing location.
(define-move-vop move-arg :move-arg
- (base-char-reg) (any-reg descriptor-reg))
+ (character-reg) (any-reg descriptor-reg))
\f
;;;; other operations
(define-vop (char-code)
(:translate char-code)
(:policy :fast-safe)
- (:args (ch :scs (base-char-reg base-char-stack)))
- (:arg-types base-char)
+ (:args (ch :scs (character-reg character-stack)))
+ (:arg-types character)
(:results (res :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 1
(:temporary (:sc unsigned-reg :offset eax-offset :target res
:from (:argument 0) :to (:result 0))
eax)
- (:results (res :scs (base-char-reg)))
- (:result-types base-char)
+ (:results (res :scs (character-reg)))
+ (:result-types character)
(:generator 1
(move eax code)
(move res al-tn)))
\f
-;;; comparison of BASE-CHARs
-(define-vop (base-char-compare)
- (:args (x :scs (base-char-reg base-char-stack))
- (y :scs (base-char-reg)
- :load-if (not (and (sc-is x base-char-reg)
- (sc-is y base-char-stack)))))
- (:arg-types base-char base-char)
+;;; comparison of CHARACTERs
+(define-vop (character-compare)
+ (:args (x :scs (character-reg character-stack))
+ (y :scs (character-reg)
+ :load-if (not (and (sc-is x character-reg)
+ (sc-is y character-stack)))))
+ (:arg-types character character)
(:conditional)
(:info target not-p)
(:policy :fast-safe)
(inst cmp x y)
(inst jmp (if not-p not-condition condition) target)))
-(define-vop (fast-char=/base-char base-char-compare)
+(define-vop (fast-char=/character character-compare)
(:translate char=)
(:variant :e :ne))
-(define-vop (fast-char</base-char base-char-compare)
+(define-vop (fast-char</character character-compare)
(:translate char<)
(:variant :b :nb))
-(define-vop (fast-char>/base-char base-char-compare)
+(define-vop (fast-char>/character character-compare)
(:translate char>)
(:variant :a :na))
-(define-vop (base-char-compare/c)
- (:args (x :scs (base-char-reg base-char-stack)))
- (:arg-types base-char (:constant base-char))
+(define-vop (character-compare/c)
+ (:args (x :scs (character-reg character-stack)))
+ (:arg-types character (:constant character))
(:conditional)
(:info target not-p y)
(:policy :fast-safe)
(inst cmp x (sb!xc:char-code y))
(inst jmp (if not-p not-condition condition) target)))
-(define-vop (fast-char=/base-char/c base-char-compare/c)
+(define-vop (fast-char=/character/c character-compare/c)
(:translate char=)
(:variant :e :ne))
-(define-vop (fast-char</base-char/c base-char-compare/c)
+(define-vop (fast-char</character/c character-compare/c)
(:translate char<)
(:variant :b :nb))
-(define-vop (fast-char>/base-char/c base-char-compare/c)
+(define-vop (fast-char>/character/c character-compare/c)
(:translate char>)
(:variant :a :na))
(make-ea :dword :base object
:disp (- (* (+ base offset) n-word-bytes) lowtag))
(logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)))))
+ character-widetag)))))
;; Else, value not immediate.
(storew value object (+ base offset) lowtag))))
(load-symbol y val))
(character
(inst mov y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag))))))
+ character-widetag))))))
(define-move-fun (load-number 1) (vop x y)
((immediate) (signed-reg unsigned-reg))
(inst mov y (tn-value x)))
-(define-move-fun (load-base-char 1) (vop x y)
- ((immediate) (base-char-reg))
+(define-move-fun (load-character 1) (vop x y)
+ ((immediate) (character-reg))
(inst mov y (char-code (tn-value x))))
(define-move-fun (load-system-area-pointer 1) (vop x y)
(define-move-fun (load-stack 5) (vop x y)
((control-stack) (any-reg descriptor-reg)
- (base-char-stack) (base-char-reg)
+ (character-stack) (character-reg)
(sap-stack) (sap-reg)
(signed-stack) (signed-reg)
(unsigned-stack) (unsigned-reg))
(define-move-fun (store-stack 5) (vop x y)
((any-reg descriptor-reg) (control-stack)
- (base-char-reg) (base-char-stack)
+ (character-reg) (character-stack)
(sap-reg) (sap-stack)
(signed-reg) (signed-stack)
(unsigned-reg) (unsigned-stack))
(inst mov y (+ nil-value (static-symbol-offset val))))
(character
(inst mov y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)))))
+ character-widetag)))))
(move y x))))
(define-move-vop move :move
(load-symbol y val))
(character
(inst mov y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)))))
+ character-widetag)))))
(move y x)))
((control-stack)
(if (sc-is x immediate)
fp (tn-offset y)))
(character
(storew (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)
+ character-widetag)
fp (tn-offset y))))
;; Lisp stack
(etypecase val
fp (- (1+ (tn-offset y)))))
(character
(storew (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag)
+ character-widetag)
fp (- (1+ (tn-offset y))))))))
(if (= (tn-offset fp) esp-offset)
;; C-call
(inst cmp x (+ nil-value (static-symbol-offset val))))
(character
(inst cmp x (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag))))))
+ character-widetag))))))
((sc-is x immediate) ; and y not immediate
;; Swap the order to fit the compare instruction.
(let ((val (tn-value x)))
(inst cmp y (+ nil-value (static-symbol-offset val))))
(character
(inst cmp y (logior (ash (char-code val) n-widetag-bits)
- base-char-widetag))))))
+ character-widetag))))))
(t
(inst cmp x y)))
;; the non-descriptor stacks
(signed-stack stack) ; (signed-byte 32)
(unsigned-stack stack) ; (unsigned-byte 32)
- (base-char-stack stack) ; non-descriptor characters.
+ (character-stack stack) ; non-descriptor characters.
(sap-stack stack) ; System area pointers.
(single-stack stack) ; single-floats
(double-stack stack :element-size 2) ; double-floats.
:alternate-scs (control-stack))
;; non-descriptor characters
- (base-char-reg registers
+ (character-reg registers
:locations #.*byte-regs*
:reserve-locations (#.ah-offset #.al-offset)
:constant-scs (immediate)
:save-p t
- :alternate-scs (base-char-stack))
+ :alternate-scs (character-stack))
;; non-descriptor SAPs (arbitrary pointers into address space)
(sap-reg registers
(catch-block stack :element-size kludge-nondeterministic-catch-block-size))
(eval-when (:compile-toplevel :load-toplevel :execute)
-(defparameter *byte-sc-names* '(base-char-reg byte-reg base-char-stack))
+(defparameter *byte-sc-names* '(character-reg byte-reg character-stack))
(defparameter *word-sc-names* '(word-reg))
(defparameter *dword-sc-names*
'(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
#endif
scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
- scavtab[BASE_CHAR_WIDETAG] = scav_immediate;
+ scavtab[CHARACTER_WIDETAG] = scav_immediate;
scavtab[SAP_WIDETAG] = scav_unboxed;
scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed;
transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
- transother[BASE_CHAR_WIDETAG] = trans_immediate;
+ transother[CHARACTER_WIDETAG] = trans_immediate;
transother[SAP_WIDETAG] = trans_unboxed;
transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
- sizetab[BASE_CHAR_WIDETAG] = size_immediate;
+ sizetab[CHARACTER_WIDETAG] = size_immediate;
sizetab[SAP_WIDETAG] = size_unboxed;
sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
/* If thing is an immediate then this is a cons. */
if (is_lisp_pointer(thing)
|| (fixnump(thing))
- || (widetag_of(thing) == BASE_CHAR_WIDETAG)
+ || (widetag_of(thing) == CHARACTER_WIDETAG)
|| (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
count = 2;
else
/* Is it plausible cons? */
if ((is_lisp_pointer(start_addr[0])
|| (fixnump(start_addr[0]))
- || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG)
|| (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
&& (is_lisp_pointer(start_addr[1])
|| (fixnump(start_addr[1]))
- || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG)
|| (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG)))
break;
else {
}
switch (widetag_of(start_addr[0])) {
case UNBOUND_MARKER_WIDETAG:
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
if (gencgc_verbose)
FSHOW((stderr,
"*Wo3: %x %x %x\n",
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
case VALUE_CELL_HEADER_WIDETAG:
case SYMBOL_HEADER_WIDETAG:
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
case UNBOUND_MARKER_WIDETAG:
case INSTANCE_HEADER_WIDETAG:
case FDEFN_WIDETAG:
brief_print(*os_context_register_addr(context, offset));
break;
- case sc_BaseCharReg:
+ case sc_CharacterReg:
ch = *os_context_register_addr(context, offset);
#ifdef LISP_FEATURE_X86
if (offset&1)
type = widetag_of(obj);
switch (type) {
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
c = (obj>>8)&0xff;
switch (c) {
case '\0':
printf(", unknown type (0x%0x)", type);
switch (widetag_of(obj)) {
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
printf(": ");
brief_otherimm(obj);
break;
print_slots(weak_pointer_slots, 1, ptr);
break;
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
case UNBOUND_MARKER_WIDETAG:
NEWLINE_OR_RETURN;
printf("pointer to an immediate?");
/* Is it plausible cons? */
if ((is_lisp_pointer(start_addr[0])
|| ((start_addr[0] & 3) == 0) /* fixnum */
- || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG)
|| (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
&& (is_lisp_pointer(start_addr[1])
|| ((start_addr[1] & 3) == 0) /* fixnum */
- || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
+ || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG)
|| (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) {
break;
} else {
}
switch (widetag_of(start_addr[0])) {
case UNBOUND_MARKER_WIDETAG:
- case BASE_CHAR_WIDETAG:
+ case CHARACTER_WIDETAG:
if (pointer_filter_verbose) {
fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer,
(unsigned int) start_addr, *start_addr);
;;; 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.16.8"
+"0.8.16.9"
projects / sbcl.git / commitdiff