Changeset 14897


Ignore:
Timestamp:
Jul 21, 2011, 3:17:53 AM (13 years ago)
Author:
Gary Byers
Message:

push/pop multiple FPRs.

Location:
trunk/source/compiler/ARM
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/compiler/ARM/arm-asm.lisp

    r14772 r14897  
    8181          (arm-constant-index quoted))))
    8282    (progn
    83       (unless (and (consp form) (eq (keywordize (car form)) :$))
     83      (unless (and (consp form) (eq (car form) :$))
    8484        (error "Invalid constant syntax in ~s" form))
    8585      (destructuring-bind (val) (cdr form)
    … …  
    124124    :fpux
    125125    :imm16
     126    :srcount                            ;single register count
     127    :drcount
    126128    ))
    127129
    … …  
    787789     #x0f300f00
    788790     ())
     791   (define-arm-instruction fstmdbs (:sd :rnw :srcount)
     792     #x0d200a00
     793     #x0fb00f00
     794     ())
     795   (define-arm-instruction fstmdbd (:dd :rnw :drcount)
     796     #x0d200b00
     797     #x0fb00f00
     798     ())
    789799   (define-arm-instruction fldd (:dd :fpaddr)
    790800     #x0d100b00
    … …  
    795805     #x0f300f00
    796806     ())
     807   (define-arm-instruction fldmias (:sd :rnw :srcount)
     808     #x0cb00a00
     809     #x0fb00f00
     810     ())
     811   (define-arm-instruction fldmiad (:dd :rnw :srcount)
     812     #x0cb00b00
     813     #x0fb00f00
     814     ())     
    797815   (define-arm-instruction ftosid (:sd :dm)
    798816     #x0ebd0b40
    … …  
    873891        (values nil nil nil)))))
    874892
    875 (defun keywordize (name)
    876   (if (typep name 'keyword)
    877     name
    878     (intern (string-upcase (string name)) "KEYWORD")))
     893
    879894
    880895(defun arm-rotate-left (u32 nbits)
    … …  
    11121127    (if (ccl::quoted-form-p form)
    11131128      (insert-shifter-constant (need-constant form) instruction)
    1114       (let* ((op (keywordize (car form))))
     1129      (let* ((op (car form)))
    11151130        (ecase op
    11161131          (:$ (destructuring-bind (value) (cdr form)
    … …  
    11281143                                        (ash (encode-arm-shift-type op) 5)
    11291144                                        (ash (need-arm-gpr count) 8)))
    1130                (ecase (keywordize (car count))
     1145               (ecase (car count)
    11311146                 (:$ (destructuring-bind (countval) (cdr count)
    11321147                       (set-field-value instruction (byte 12 0)
    … …  
    11971212  (if (atom form)
    11981213    (error "Invalid memory operand ~s" form)   
    1199     (let* ((mode (keywordize (car form))))
     1214    (let* ((mode (car form)))
    12001215      (if (eq mode :=)
    12011216        (destructuring-bind (label) (cdr form)
    … …  
    12111226          (set-field-value instruction (byte 4 16) (need-arm-gpr rn))
    12121227          (let* ((quoted (ccl::quoted-form-p index))
    1213                  (index-op (if quoted :quote (and (consp index) (keywordize (car index)))))
     1228                 (index-op (if quoted :quote (and (consp index) (car index))))
    12141229                 (constant-index (or quoted (eq index-op :$))))
    12151230            (cond (constant-index
    … …  
    12381253                       (destructuring-bind (rm shift-expr) (cdr index)
    12391254                         (unless (and (consp shift-expr)
    1240                                       (eq (keywordize (car shift-expr)) :$))
     1255                                      (eq (car shift-expr) :$))
    12411256                           (error "Shift count must be immediate : ~s" shift-expr))
    12421257                         (destructuring-bind (count-expr) (cdr shift-expr)
    … …  
    12631278  (if (atom form)
    12641279    (set-field-value instruction (byte 4 16) (need-arm-gpr form))
    1265     (if (eq (keywordize (car form)) :!)
     1280    (if (eq (car form) :!)
    12661281      (destructuring-bind (rn) (cdr form)
    12671282        (set-field-value instruction (byte 1 21) 1)
    … …  
    12841299  (let* ((regno (if (typep form '(unsigned-byte 4))
    12851300                  form
    1286                   (ecase (keywordize form)
     1301                  (ecase form
    12871302                    (:fpsid 0)
    12881303                    (:fpscr 1)
    … …  
    12921307(defun parse-imm16-operand (form instruction)
    12931308  (unless (and (consp form)
    1294                (eq (keywordize (car form)) :$)
     1309               (eq (car form) :$)
    12951310               (consp (cdr form))
    12961311               (null (cddr form)))
    … …  
    13001315    (set-field-value instruction (byte 4 16) (ldb (byte 4 12) val))))
    13011316   
     1317(defun parse-srcount-operand (form instruction)
     1318  (let* ((val (eval form)))
     1319    (unless (and (typep val 'fixnum)
     1320                 (> (the fixnum val) 0)
     1321                 (< (the fixnum val) 33))
     1322      (ccl::report-bad-arg form `(integer (0) (33))))
     1323    (set-field-value instruction (byte 8 0) val)))
     1324
     1325(defun parse-drcount-operand (form instruction)
     1326  (let* ((val (eval form)))
     1327    (unless (and (typep val 'fixnum)
     1328                 (> (the fixnum val) 0)
     1329                 (< (the fixnum val) 33))
     1330      (ccl::report-bad-arg form `(integer (0) (33))))
     1331    (set-field-value instruction (byte 7 1) val)))
    13021332
    13031333(defun parse-rm-operand (form instruction)
    … …  
    13261356  (if (atom form)
    13271357    (error "Invalid memory operand ~s." form)
    1328     (let* ((mode (keywordize (car form)))
     1358    (let* ((mode (car form))
    13291359           (constant-index nil))
    13301360      (destructuring-bind (rn index) (cdr form)
    … …  
    13321362        (cond ((atom index)
    13331363               (set-field-value instruction (byte 4 0) (need-arm-gpr index)))
    1334               (t (unless (eq (keywordize (car index)) :$)
     1364              (t (unless (eq (car index) :$)
    13351365                   (error "Invalid index: ~s." index))
    13361366                 (destructuring-bind (val) (cdr index)
    … …  
    13821412    (error "Invalid FP address: ~s" form)
    13831413    (destructuring-bind (op rn offset) form
    1384       (unless (eq (keywordize op) :@)
     1414      (unless (eq op :@)
    13851415        (error "Invalid FP addressing mode ~s in ~s." op form))
    13861416      (set-field-value instruction (byte 4 16) (need-arm-gpr rn))
    1387       (unless (and (consp offset) (eq (keywordize (car offset)) :$))
     1417      (unless (and (consp offset) (eq (car offset) :$))
    13881418        (error "Invalid FP address offset ~s in ~s." offset form))
    13891419      (destructuring-bind (offset-form) (cdr offset)
    … …  
    13981428(defun parse-@rn-operand (form instruction)
    13991429  (when (or (atom form)
    1400           (not (eq (keywordize (car form)) :@)))
     1430          (not (eq (car form) :@)))
    14011431    (error "Invalid register indirect operand: ~s" form))
    14021432  (destructuring-bind (rn) (cdr form)
    … …  
    14301460      parse-fpux-operand
    14311461      parse-imm16-operand
     1462      parse-srcount-operand
     1463      parse-drcount-operand
    14321464      ))
    14331465
    … …  
    14641496          (error "Unknown ARM instruction - ~s" form))
    14651497        (let* ((cond-indicator (and (consp (car opvals))
    1466                                     (keywordize (caar opvals)))))
     1498                                    (caar opvals))))
    14671499          (when (or (eq cond-indicator :?)
    14681500                    (eq cond-indicator :~))
    … …  
    17241756    :uuoC
    17251757    :imm16
     1758    :srcount
     1759    :drcount
    17261760    )))
    17271761
    … …  
    17571791      vinsn-parse-fpux-operand
    17581792      vinsn-parse-imm16-operand
     1793      vinsn-parse-srcount-operand
     1794      vinsn-parse-drcount-operand
    17591795      ))
    17601796
    … …  
    19521988  (let* ((regno (if (typep value '(unsigned-byte 4))
    19531989                  value
    1954                   (ecase (keywordize value)
     1990                  (ecase value
    19551991                    (:fpsid 0)
    19561992                    (:fpscr 1)
    … …  
    20772113      (set-avi-opcode-field avi (byte 4 16) (ldb (byte 4 12) val)))))
    20782114
     2115(defun vinsn-parse-srcount-operand (avi value vinsn-params)
     2116  (let* ((val (vinsn-arg-or-constant avi value vinsn-params (encode-vinsn-field-type :srcount) nil)))
     2117    (when val
     2118      (check-type val (integer 1 32))
     2119      (set-avi-opcode-field avi (byte 8 0) val))))
     2120
     2121(defun vinsn-parse-drcount-operand (avi value vinsn-params)
     2122  (let* ((val (vinsn-arg-or-constant avi value vinsn-params (encode-vinsn-field-type :drcount) nil)))
     2123    (when val
     2124      (check-type val (integer 1 32))
     2125      (set-avi-opcode-field avi (byte 7 1) val))))
    20792126
    20802127(defun vinsn-simplify-instruction (form vinsn-params)
    … …  
    20902137           (error "Unknown ARM instruction - ~s" form))
    20912138         (let* ((cond-indicator (and (consp (car opvals))
    2092                                      (keywordize (caar opvals))))
     2139                                     (caar opvals)))
    20932140                (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
    20942141           (when (or (eq cond-indicator :?)
    … …  
    21552202    vinsn-insert-uuoc-operand
    21562203    vinsn-insert-imm16-operand
     2204    vinsn-insert-srcount-operand
     2205    vinsn-insert-drcount-operand
    21572206    ))
    21582207
    … …  
    22692318  (set-field-value instruction (byte 4 16) (ldb (byte 4 12) value)))
    22702319
     2320(defun vinsn-insert-srcount-operand (instruction value)
     2321  (set-field-value instruction (byte 8 0) value))
     2322
     2323(defun vinsn-insert-drcount-operand (instruction value)
     2324  (set-field-value instruction (byte 7 1) value)) 
     2325
    22712326
    22722327

  • trunk/source/compiler/ARM/arm-disassemble.lisp

    r14843 r14897  
    287287                           (ldb (byte 1 7) opcode)))))
    288288
     289(defun extract-arm-srcount-operand (opcodes i)
     290  (let* ((opcode (adi-opcode (svref opcodes i))))
     291    (ldb (byte 8 0) opcode)))
     292
     293(defun extract-arm-drcount-operand (opcodes i)
     294  (let* ((opcode (adi-opcode (svref opcodes i))))
     295    (ldb (byte 7 1) opcode)))
    289296
    290297(defparameter *arm-operand-extract-functions*
    … …  
    315322    extract-arm-fpux-operand
    316323    extract-arm-imm16-operand
     324    extract-arm-srcount-operand
     325    extract-arm-drcount-operand
    317326    ))
    318327
Note: See TracChangeset for help on using the changeset viewer.