Index: /trunk/source/compiler/ARM/arm-asm.lisp =================================================================== --- /trunk/source/compiler/ARM/arm-asm.lisp (revision 14896) +++ /trunk/source/compiler/ARM/arm-asm.lisp (revision 14897) @@ -81,5 +81,5 @@ (arm-constant-index quoted)))) (progn - (unless (and (consp form) (eq (keywordize (car form)) :$)) + (unless (and (consp form) (eq (car form) :$)) (error "Invalid constant syntax in ~s" form)) (destructuring-bind (val) (cdr form) @@ -124,4 +124,6 @@ :fpux :imm16 + :srcount ;single register count + :drcount )) @@ -787,4 +789,12 @@ #x0f300f00 ()) + (define-arm-instruction fstmdbs (:sd :rnw :srcount) + #x0d200a00 + #x0fb00f00 + ()) + (define-arm-instruction fstmdbd (:dd :rnw :drcount) + #x0d200b00 + #x0fb00f00 + ()) (define-arm-instruction fldd (:dd :fpaddr) #x0d100b00 @@ -795,4 +805,12 @@ #x0f300f00 ()) + (define-arm-instruction fldmias (:sd :rnw :srcount) + #x0cb00a00 + #x0fb00f00 + ()) + (define-arm-instruction fldmiad (:dd :rnw :srcount) + #x0cb00b00 + #x0fb00f00 + ()) (define-arm-instruction ftosid (:sd :dm) #x0ebd0b40 @@ -873,8 +891,5 @@ (values nil nil nil))))) -(defun keywordize (name) - (if (typep name 'keyword) - name - (intern (string-upcase (string name)) "KEYWORD"))) + (defun arm-rotate-left (u32 nbits) @@ -1112,5 +1127,5 @@ (if (ccl::quoted-form-p form) (insert-shifter-constant (need-constant form) instruction) - (let* ((op (keywordize (car form)))) + (let* ((op (car form))) (ecase op (:$ (destructuring-bind (value) (cdr form) @@ -1128,5 +1143,5 @@ (ash (encode-arm-shift-type op) 5) (ash (need-arm-gpr count) 8))) - (ecase (keywordize (car count)) + (ecase (car count) (:$ (destructuring-bind (countval) (cdr count) (set-field-value instruction (byte 12 0) @@ -1197,5 +1212,5 @@ (if (atom form) (error "Invalid memory operand ~s" form) - (let* ((mode (keywordize (car form)))) + (let* ((mode (car form))) (if (eq mode :=) (destructuring-bind (label) (cdr form) @@ -1211,5 +1226,5 @@ (set-field-value instruction (byte 4 16) (need-arm-gpr rn)) (let* ((quoted (ccl::quoted-form-p index)) - (index-op (if quoted :quote (and (consp index) (keywordize (car index))))) + (index-op (if quoted :quote (and (consp index) (car index)))) (constant-index (or quoted (eq index-op :$)))) (cond (constant-index @@ -1238,5 +1253,5 @@ (destructuring-bind (rm shift-expr) (cdr index) (unless (and (consp shift-expr) - (eq (keywordize (car shift-expr)) :$)) + (eq (car shift-expr) :$)) (error "Shift count must be immediate : ~s" shift-expr)) (destructuring-bind (count-expr) (cdr shift-expr) @@ -1263,5 +1278,5 @@ (if (atom form) (set-field-value instruction (byte 4 16) (need-arm-gpr form)) - (if (eq (keywordize (car form)) :!) + (if (eq (car form) :!) (destructuring-bind (rn) (cdr form) (set-field-value instruction (byte 1 21) 1) @@ -1284,5 +1299,5 @@ (let* ((regno (if (typep form '(unsigned-byte 4)) form - (ecase (keywordize form) + (ecase form (:fpsid 0) (:fpscr 1) @@ -1292,5 +1307,5 @@ (defun parse-imm16-operand (form instruction) (unless (and (consp form) - (eq (keywordize (car form)) :$) + (eq (car form) :$) (consp (cdr form)) (null (cddr form))) @@ -1300,4 +1315,19 @@ (set-field-value instruction (byte 4 16) (ldb (byte 4 12) val)))) +(defun parse-srcount-operand (form instruction) + (let* ((val (eval form))) + (unless (and (typep val 'fixnum) + (> (the fixnum val) 0) + (< (the fixnum val) 33)) + (ccl::report-bad-arg form `(integer (0) (33)))) + (set-field-value instruction (byte 8 0) val))) + +(defun parse-drcount-operand (form instruction) + (let* ((val (eval form))) + (unless (and (typep val 'fixnum) + (> (the fixnum val) 0) + (< (the fixnum val) 33)) + (ccl::report-bad-arg form `(integer (0) (33)))) + (set-field-value instruction (byte 7 1) val))) (defun parse-rm-operand (form instruction) @@ -1326,5 +1356,5 @@ (if (atom form) (error "Invalid memory operand ~s." form) - (let* ((mode (keywordize (car form))) + (let* ((mode (car form)) (constant-index nil)) (destructuring-bind (rn index) (cdr form) @@ -1332,5 +1362,5 @@ (cond ((atom index) (set-field-value instruction (byte 4 0) (need-arm-gpr index))) - (t (unless (eq (keywordize (car index)) :$) + (t (unless (eq (car index) :$) (error "Invalid index: ~s." index)) (destructuring-bind (val) (cdr index) @@ -1382,8 +1412,8 @@ (error "Invalid FP address: ~s" form) (destructuring-bind (op rn offset) form - (unless (eq (keywordize op) :@) + (unless (eq op :@) (error "Invalid FP addressing mode ~s in ~s." op form)) (set-field-value instruction (byte 4 16) (need-arm-gpr rn)) - (unless (and (consp offset) (eq (keywordize (car offset)) :$)) + (unless (and (consp offset) (eq (car offset) :$)) (error "Invalid FP address offset ~s in ~s." offset form)) (destructuring-bind (offset-form) (cdr offset) @@ -1398,5 +1428,5 @@ (defun parse-@rn-operand (form instruction) (when (or (atom form) - (not (eq (keywordize (car form)) :@))) + (not (eq (car form) :@))) (error "Invalid register indirect operand: ~s" form)) (destructuring-bind (rn) (cdr form) @@ -1430,4 +1460,6 @@ parse-fpux-operand parse-imm16-operand + parse-srcount-operand + parse-drcount-operand )) @@ -1464,5 +1496,5 @@ (error "Unknown ARM instruction - ~s" form)) (let* ((cond-indicator (and (consp (car opvals)) - (keywordize (caar opvals))))) + (caar opvals)))) (when (or (eq cond-indicator :?) (eq cond-indicator :~)) @@ -1724,4 +1756,6 @@ :uuoC :imm16 + :srcount + :drcount ))) @@ -1757,4 +1791,6 @@ vinsn-parse-fpux-operand vinsn-parse-imm16-operand + vinsn-parse-srcount-operand + vinsn-parse-drcount-operand )) @@ -1952,5 +1988,5 @@ (let* ((regno (if (typep value '(unsigned-byte 4)) value - (ecase (keywordize value) + (ecase value (:fpsid 0) (:fpscr 1) @@ -2077,4 +2113,15 @@ (set-avi-opcode-field avi (byte 4 16) (ldb (byte 4 12) val))))) +(defun vinsn-parse-srcount-operand (avi value vinsn-params) + (let* ((val (vinsn-arg-or-constant avi value vinsn-params (encode-vinsn-field-type :srcount) nil))) + (when val + (check-type val (integer 1 32)) + (set-avi-opcode-field avi (byte 8 0) val)))) + +(defun vinsn-parse-drcount-operand (avi value vinsn-params) + (let* ((val (vinsn-arg-or-constant avi value vinsn-params (encode-vinsn-field-type :drcount) nil))) + (when val + (check-type val (integer 1 32)) + (set-avi-opcode-field avi (byte 7 1) val)))) (defun vinsn-simplify-instruction (form vinsn-params) @@ -2090,5 +2137,5 @@ (error "Unknown ARM instruction - ~s" form)) (let* ((cond-indicator (and (consp (car opvals)) - (keywordize (caar opvals)))) + (caar opvals))) (avi (make-arm-vinsn-instruction (arm-instruction-template-val template)))) (when (or (eq cond-indicator :?) @@ -2155,4 +2202,6 @@ vinsn-insert-uuoc-operand vinsn-insert-imm16-operand + vinsn-insert-srcount-operand + vinsn-insert-drcount-operand )) @@ -2269,4 +2318,10 @@ (set-field-value instruction (byte 4 16) (ldb (byte 4 12) value))) +(defun vinsn-insert-srcount-operand (instruction value) + (set-field-value instruction (byte 8 0) value)) + +(defun vinsn-insert-drcount-operand (instruction value) + (set-field-value instruction (byte 7 1) value)) + Index: /trunk/source/compiler/ARM/arm-disassemble.lisp =================================================================== --- /trunk/source/compiler/ARM/arm-disassemble.lisp (revision 14896) +++ /trunk/source/compiler/ARM/arm-disassemble.lisp (revision 14897) @@ -287,4 +287,11 @@ (ldb (byte 1 7) opcode))))) +(defun extract-arm-srcount-operand (opcodes i) + (let* ((opcode (adi-opcode (svref opcodes i)))) + (ldb (byte 8 0) opcode))) + +(defun extract-arm-drcount-operand (opcodes i) + (let* ((opcode (adi-opcode (svref opcodes i)))) + (ldb (byte 7 1) opcode))) (defparameter *arm-operand-extract-functions* @@ -315,4 +322,6 @@ extract-arm-fpux-operand extract-arm-imm16-operand + extract-arm-srcount-operand + extract-arm-drcount-operand ))