Skip to content
Snippets Groups Projects
Commit 42accb9a authored by ram's avatar ram
Browse files

Changed stuff to use the new non-descriptor stuff for move/coerce.

parent ca2602af
No related branches found
No related tags found
No related merge requests found
...@@ -13,53 +13,71 @@ ...@@ -13,53 +13,71 @@
;;; ;;;
(in-package 'c) (in-package 'c)
;;;; Moves and coercions:
;;; Move untagged string-char values.
;;;
(define-vop (string-char-move) (define-vop (string-char-move)
(:args (x :target y (:args (x :target y
:scs (string-char-reg) :scs (string-char-reg)
:load nil)) :load-if (not (location= x y))))
(:results (y :scs (string-char-reg) (:results (y :scs (string-char-reg)
:load nil)) :load-if (not (location= x y))))
(:temporary (:scs (string-char-reg) :type string-char
:from :argument :to :result)
temp)
(:effects) (:effects)
(:affected) (:affected)
(:generator 0 (:generator 0
(sc-case x ((string-char-reg string-char-stack immediate-string-char (unless (location= x y)
descriptor-reg any-reg stack))) (inst lr y x))))
(sc-case y ((string-char-reg string-char-stack ;;;
descriptor-reg any-reg stack))) (define-move-vop string-char-move :move (string-char-reg) (string-char-reg))
(let* ((x-char (sc-is x string-char-reg string-char-stack
immediate-string-char)) ;;; Move untagged string-char arguments/return-values.
(y-char (sc-is y string-char-reg string-char-stack)) ;;;
(same-rep (if x-char y-char (not y-char))) (define-vop (move-string-char-argument)
(src (if (sc-is x stack string-char-stack immediate-string-char) (:args (x :target y
temp x)) :scs (string-char-reg))
(dest (if (sc-is y stack string-char-stack) temp y))) (fp :scs (descriptor-reg)
:load-if (not (sc-is y string-char-reg))))
(unless (and same-rep (location= x y)) (:results (y))
(:generator 0
(unless (eq x src) (sc-case y
(sc-case x (string-char-reg
((string-char-stack stack) (unless (location= x y)
(load-stack-tn src x)) (inst lr y x)))
(immediate-string-char (string-char-stack
(loadi src (char-code (tn-value x)))))) (storew x fp (tn-offset y))))))
;;;
(if same-rep (define-move-vop move-string-char-argument :move-argument
(unless (location= src dest) (string-char-reg) (string-char-reg))
(inst lr dest src))
(if x-char
(inst oiu dest src (ash system:%string-char-type ;;; Move a tagged string char to an untagged representation.
clc::type-shift-16)) ;;;
(inst nilz dest src system:%character-code-mask))) (define-vop (move-to-string-char)
(:args (x :scs (any-reg descriptor-reg)))
(unless (eq y dest) (:results (y :scs (string-char-reg)))
(store-stack-tn y dest)))))) (:generator 1
(inst nilz y x system:%character-code-mask)))
(primitive-type-vop string-char-move (:coerce-to-t :coerce-from-t :move) ;;;
string-char) (define-move-vop move-to-string-char :move
(any-reg descriptor-reg) (string-char-reg))
;;; Move an untagged string char to a tagged representation.
;;;
(define-vop (move-from-string-char)
(:args (x :scs (string-char-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(:generator 1
(inst oiu y x (ash system:%string-char-type clc::type-shift-16))))
;;;
(define-move-vop move-from-string-char :move
(string-char-reg) (any-reg descriptor-reg))
;;;; Other operations:
(define-vop (char-code) (define-vop (char-code)
(:args (ch :scs (string-char-reg) :target res)) (:args (ch :scs (string-char-reg) :target res))
...@@ -74,7 +92,6 @@ ...@@ -74,7 +92,6 @@
(define-vop (code-char) (define-vop (code-char)
(:args (code :scs (any-reg descriptor-reg) :target res)) (:args (code :scs (any-reg descriptor-reg) :target res))
(:results (res :scs (string-char-reg))) (:results (res :scs (string-char-reg)))
(:result-types string-char)
(:translate code-char) (:translate code-char)
(:policy :fast-safe) (:policy :fast-safe)
(:generator 0 (:generator 0
......
...@@ -14,83 +14,62 @@ ...@@ -14,83 +14,62 @@
;;; ;;;
(in-package 'c) (in-package 'c)
;;; Load-Constant-TN -- Internal
;;; ;;;; Move functions:
;;; Load the Constant or immediate constant TN X into Y. Temp is a
;;; descriptor register temp or NIL, if none is available. Temp must be (define-move-function (load-immediate 1) (node x y)
;;; supplied if Y may be in memory. Node is for souce context. ((short-immediate unsigned-immediate immediate random-immediate)
;;; (any-reg descriptor-reg))
(defun load-constant-tn (x y temp node) (let ((val (tn-value x)))
(declare (type tn x y) (type (or tn null temp)) (type node node)) (etypecase val
(assemble node (integer
(sc-case x (loadi y val))
((short-immediate unsigned-immediate immediate random-immediate (null
immediate-string-char) (inst cau y zero-tn clc::nil-16))
(let ((val (tn-value x)) ((member t)
(dest (sc-case y (inst cau y zero-tn clc::t-16)))))
((any-reg descriptor-reg string-char-reg) y)
(stack temp)))) (define-move-function (load-string-char 1) (node x y)
(etypecase val ((immediate-string-char) (string-char-reg))
(integer (loadi y (char-code (tn-value x))))
(loadi dest val))
(null (define-move-function (load-tagged-string-char 2) (node x y)
(inst cau dest zero-tn clc::nil-16)) ((immediate-string-char) (any-reg descriptor-reg))
((member t) (loadi y (char-code (tn-value x)))
(inst cau dest zero-tn clc::t-16)) (inst oiu y y (ash system:%string-char-type clc::type-shift-16)))
(string-char
(let ((code (char-code val))) (define-move-function (load-constant 5) (node x y)
(loadi dest code) ((constant) (any-reg descriptor-reg))
(unless (sc-is y string-char-reg) (load-slot y env-tn (tn-offset x)))
(inst oiu dest dest (ash system:%string-char-type
clc::type-shift-16)))))) (define-move-function (load-stack 5) (node x y)
(unless (eq dest y) ((stack) (any-reg descriptor-reg)
(store-stack-tn y temp)))) (string-char-stack) (string-char-reg))
(constant (load-stack-tn y x))
(sc-case y
((any-reg descriptor-reg) (define-move-function (store-stack 5) (node x y)
(load-slot y env-tn (tn-offset x))) ((any-reg descriptor-reg) (stack)
(stack (string-char-reg) (string-char-stack))
(load-slot temp env-tn (tn-offset x)) (store-stack-tn y x))
(store-stack-tn y temp)))))))
;;;; The Move VOP: ;;;; Move and Move-Argument VOPs:
;;;
;;; The Move VOP is used for doing arbitrary moves when there is no ;;; The Move VOP is used for doing arbitrary moves when there is no
;;; type-specific move/coerce operation. ;;; type-specific move/coerce operation.
;;; We need a register to do a memory-memory move.
;;; ;;;
(define-vop (move) (define-vop (move)
(:args (x :target y (:args (x :target y
:scs (any-reg descriptor-reg) :scs (any-reg descriptor-reg)
:load nil)) :load-if (not (location= x y))))
(:results (y :scs (any-reg descriptor-reg) (:results (y :scs (any-reg descriptor-reg)
:load nil)) :load-if (not (location= x y))))
(:temporary (:scs (descriptor-reg)
:from :argument :to :result)
temp)
(:node-var node)
(:effects) (:effects)
(:affected) (:affected)
(:generator 0 (:generator 0
(unless (location= x y) (unless (location= x y)
(sc-case x (inst lr y x))))
((any-reg descriptor-reg)
(sc-case y
((any-reg descriptor-reg)
(inst lr y x))
(stack
(store-stack-tn y x))))
(stack
(sc-case y
((any-reg descriptor-reg)
(load-stack-tn y x))
(stack
(load-stack-tn temp x)
(store-stack-tn y temp))))
(t
(unassemble (load-constant-tn x y temp node)))))))
;;; Make Move the check VOP for T so that type check generation doesn't think ;;; Make Move the check VOP for T so that type check generation doesn't think
...@@ -99,84 +78,23 @@ ...@@ -99,84 +78,23 @@
;;; ;;;
(primitive-type-vop move (:check) t) (primitive-type-vop move (:check) t)
;;;; ILLEGAL-MOVE
;;; This VOP is emitted when we attempt to do a move between incompatible ;;; The Move-Argument VOP is used for moving descriptor values into another
;;; primitive types. We signal an error, and ignore the result (which is ;;; frame for argument or known value passing.
;;; specified only to terminate its lifetime.)
;;; ;;;
(define-vop (illegal-move three-arg-miscop) (define-vop (move-argument)
(:args (x :scs (any-reg descriptor-reg) :target a1) (:args (x :target y
(y-type :scs (any-reg descriptor-reg) :target a2)) :scs (any-reg descriptor-reg))
(:variant-vars) (fp :scs (descriptor-reg)
(:ignore r a3 nl0 nl1 misc-pc) :load-if (not (sc-is y any-reg descriptor-reg))))
(:generator 666
(loadi a0 clc::error-object-not-type)
(unless (location= x a1)
(inst lr a1 x))
(unless (location= y-type a2)
(inst lr a2 y-type))
(inst miscop 'clc::error2)
(note-this-location vop :internal-error)))
;;;; Operand loading and saving:
;;;
;;; These are the VOPs used for loading or saving Load-TNs. They cannot
;;; allocate any temporaries since packing has already been done by the time
;;; that these VOPs are emitted. It can be assumed that the loaded (saved) TN
;;; is free before (after) the load (save) (so may be used as a temporary.)
;;;
(define-vop (load-operand)
(:args (x))
(:results (y))
(:node-var node)
(:generator 5
(sc-case x
(stack
(sc-case y
((any-reg descriptor-reg)
(load-stack-tn y x))
(string-char-reg
(load-stack-tn y x)
(inst nilz y y system:%character-code-mask))))
(string-char-stack
(sc-case y
(string-char-reg
(load-stack-tn y x))))
(t
(unassemble (load-constant-tn x y nil node))))))
(define-vop (store-operand)
(:args (x))
(:results (y)) (:results (y))
(:generator 5 (:generator 0
(sc-case y (sc-case y
((any-reg descriptor-reg)
(unless (location= x y)
(inst lr y x)))
(stack (stack
(sc-case x (storew x fp (tn-offset y))))))
((any-reg descriptor-reg) ;;;
(store-stack-tn y x)) (define-move-vop move-argument :move-argument
(string-char-reg (any-reg descriptor-reg) (any-reg descriptor-reg))
(inst oiu x x (ash system:%string-char-type clc::type-shift-16))
(store-stack-tn y x))))
(string-char-stack
(sc-case x
(string-char-reg
(store-stack-tn y x)))))))
;;;; Register saving and restoring VOPs.
(define-vop (save-reg)
(:args (reg))
(:results (stack))
(:generator 5
(store-stack-tn stack reg)))
(define-vop (restore-reg)
(:args (stack))
(:results (reg))
(:generator 5
(load-stack-tn reg stack)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment