Commit b13d7756 authored by cshapiro's avatar cshapiro
Browse files

Redefine the base-char-reg SC to use 32-bit registers instead of 8-bit

registers.  Adjust the base-char VOPs accordingly.  Lastly, define the
simple-string VOPs using the same macro used by all other partial word
array VOPs.
parent 744ca6f4
Loading
Loading
Loading
Loading
+4 −84
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.22 2008/04/17 09:05:02 cshapiro Exp $")
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.23 2008/04/21 23:59:12 cshapiro Exp $")
;;;
;;; **********************************************************************
;;;
@@ -142,6 +142,9 @@

(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)

(def-partial-data-vector-frobs simple-string base-char :byte nil
  base-char-reg)

(def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
  :byte nil unsigned-reg signed-reg)

@@ -1078,89 +1081,6 @@
	(inst fstd result-imag))
      (inst fxch value-imag))))


;;;;
;;;; dtc expanded and fixed the following:



;;; simple-string

(define-vop (data-vector-ref/simple-string)
  (:translate data-vector-ref)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
	 (index :scs (unsigned-reg)))
  (:arg-types simple-string positive-fixnum)
  (:temporary (:sc unsigned-reg ; byte-reg
		   :offset eax-offset ; al-offset
		   :target value
		   :from (:eval 0) :to (:result 0))
	      eax)
  (:ignore eax)
  (:results (value :scs (base-char-reg)))
  (:result-types base-char)
  (:generator 5
    (inst mov al-tn
	  (make-ea :byte :base object :index index :scale 1
		   :disp (- (* vector-data-offset word-bytes)
			    other-pointer-type)))
    (move value al-tn)))

(define-vop (data-vector-ref-c/simple-string)
  (:translate data-vector-ref)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg)))
  (:info index)
  (:arg-types simple-string (:constant (signed-byte 30)))
  (:temporary (:sc unsigned-reg :offset eax-offset :target value
		   :from (:eval 0) :to (:result 0))
	      eax)
  (:ignore eax)
  (:results (value :scs (base-char-reg)))
  (:result-types base-char)
  (:generator 4
    (inst mov al-tn
	  (make-ea :byte :base object
		   :disp (- (+ (* vector-data-offset word-bytes) index)
			    other-pointer-type)))
    (move value al-tn)))


(define-vop (data-vector-set/simple-string)
  (:translate data-vector-set)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg) :to (:eval 0))
	 (index :scs (unsigned-reg) :to (:eval 0))
	 (value :scs (base-char-reg)))
  (:arg-types simple-string positive-fixnum base-char)
  (:results (result :scs (base-char-reg)))
  (:result-types base-char)
  (:generator 5 
    (inst mov (make-ea :byte :base object :index index :scale 1
		       :disp (- (* vector-data-offset word-bytes)
				other-pointer-type))
	  value)
    (move result value)))


(define-vop (data-vector-set/simple-string-c)
  (:translate data-vector-set)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg) :to (:eval 0))
	 (value :scs (base-char-reg)))
  (:info index)
  (:arg-types simple-string (:constant (signed-byte 30)) base-char)
  (:results (result :scs (base-char-reg)))
  (:result-types base-char)
  (:generator 4
   (inst mov (make-ea :byte :base object
		      :disp (- (+ (* vector-data-offset word-bytes) index)
			       other-pointer-type))
	 value)
   (move result value)))



;;; These VOPs are used for implementing float slots in structures (whose raw
;;; data is an unsigned-32 vector.
+17 −33
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.7 2003/07/08 13:50:36 toy Exp $")
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.8 2008/04/21 23:59:12 cshapiro Rel $")
;;;
;;; **********************************************************************
;;; 
@@ -30,41 +30,31 @@
;;; Move a tagged char to an untagged representation.
;;;
(define-vop (move-to-base-char)
  (: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)))
  (:args (x :scs (any-reg control-stack) :target y))
  (:results (y :scs (base-char-reg)))
  (:note "character untagging")
  (:generator 1
    (move eax-tn x)
    (move y ah)))
    (move y x)
    (inst shr y type-bits)))
;;;
(define-move-vop move-to-base-char :move
  (any-reg control-stack) (base-char-reg base-char-stack))
  (any-reg control-stack) (base-char-reg))


;;; 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))
  (:temporary (:sc byte-reg :offset al-offset :target y
		   :from (:argument 0) :to (:result 0)) al)
  (:temporary (:sc byte-reg :offset ah-offset
		   :from (:argument 0) :to (:result 0)) ah)
  (:results (y :scs (any-reg descriptor-reg control-stack)))
  (:args (x :scs (base-char-reg base-char-stack) :target y))
  (:results (y :scs (any-reg descriptor-reg)))
  (:note "character tagging")
  (:generator 1
    (move ah x)				; maybe move char byte
    (inst mov al base-char-type)	; #x86 to type bits
    (inst and eax-tn #xffff)		; remove any junk bits
    (move y eax-tn)))
    (move y x)
    (inst shl y type-bits)
    (inst or y base-char-type)))

;;;
(define-move-vop move-from-base-char :move
  (base-char-reg base-char-stack) (any-reg descriptor-reg control-stack))
  (base-char-reg base-char-stack) (any-reg descriptor-reg))

;;; Move untagged base-char values.
;;;
@@ -98,9 +88,7 @@
      (base-char-reg
       (move y x))
      (base-char-stack
       (inst mov
	     (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4)))
	     x)))))
       (storew x fp (- (1+ (tn-offset y))))))))
;;;
(define-move-vop move-base-char-argument :move-argument
  (any-reg base-char-reg) (base-char-reg))
@@ -119,26 +107,22 @@
(define-vop (char-code)
  (:translate char-code)
  (:policy :fast-safe)
  (:args (ch :scs (base-char-reg base-char-stack)))
  (:args (ch :scs (base-char-reg base-char-stack) :target res))
  (:arg-types base-char)
  (:results (res :scs (unsigned-reg)))
  (:result-types positive-fixnum)
  (:generator 1
    (inst movzx res ch)))
    (move res ch)))

(define-vop (code-char)
  (:translate code-char)
  (:policy :fast-safe)
  (:args (code :scs (unsigned-reg unsigned-stack) :target eax))
  (:args (code :scs (unsigned-reg control-stack) :target res))
  (:arg-types positive-fixnum)
  (: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)
  (:generator 1
    (move eax code)
    (move res al-tn)))
    (move res code)))


;;; Comparison of base-chars.
+6 −5
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.12 2008/04/15 19:55:25 cshapiro Exp $")
 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.13 2008/04/21 23:59:12 cshapiro Exp $")
;;;
;;; **********************************************************************
;;;
@@ -216,8 +216,8 @@

  ;; Non-Descriptor characters
  (base-char-reg registers
		 :locations #.byte-regs
		 :reserve-locations (#.ah-offset #.al-offset)
		 :locations #.dword-regs
		 :element-size 2
		 :constant-scs (immediate)
		 :save-p t
		 :alternate-scs (base-char-stack))
@@ -320,11 +320,12 @@

(eval-when (compile load eval)

(defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack))
(defconstant byte-sc-names '(byte-reg))
(defconstant word-sc-names '(word-reg))
(defconstant dword-sc-names
  '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
    signed-stack unsigned-stack sap-stack single-stack constant))
    signed-stack unsigned-stack sap-stack single-stack constant
    base-char-reg base-char-stack))

;;;
;;; added by jrd.  I guess the right thing to do is to treat floats