Changeset 14095
- Timestamp:
- Aug 1, 2010, 5:18:39 AM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/arm/compiler/ARM/arm-asm.lisp
r14069 r14095 44 44 (defvar *arm-constants* ()) 45 45 (defvar *lap-labels* ()) 46 (defvar *called-subprim-jmp-labels* ())47 46 (defvar *last-constant-pool-origin* ()) 48 47 … … 475 474 476 475 477 ;; (ba subprim-name) -> (mov pc ($ subprim-address)) 478 (define-arm-instruction ba (:subprim) 479 #x03a0f000 480 #x0ffff000 481 ()) 482 476 483 477 (define-arm-instruction mov (:rd :shifter) 484 478 #x01a00000 … … 865 859 ;;; by an even number of bits if u32 can be encoded that way, nil 866 860 ;;; otherwise. 861 #-arm-target 867 862 (defun encode-arm-immediate (u32) 868 863 (do* ((u32 (logand #xffffffff u32)) … … 873 868 (return (logior (ash rot 7) a)))))) 874 869 870 #+arm-target 871 (ccl::defarmlapfunction encode-arm-immediate ((u32 arg_z)) 872 (check-nargs 1) 873 (extract-typecode imm0 u32) 874 (cmp imm0 (:$ arm::tag-fixnum)) 875 (moveq imm0 (:asr u32 (:$ arm::fixnumshift))) 876 (beq @got) 877 (cmp imm0 (:$ arm::subtag-bignum)) 878 (uuo-error-reg-not-xtype (:? ne) u32 (:$ arm::xtype-integer)) 879 (ldr imm0 (:@ u32 (:$ arm::misc-data-offset))) 880 @got 881 (mov imm1 (:$ 32)) 882 (mov imm2 imm0) 883 @loop 884 (cmp imm2 (:$ 256)) 885 (blo @win) 886 (subs imm1 imm1 (:$ 2)) 887 (moveq arg_z 'nil) 888 (bxeq lr) 889 (mov imm2 (:ror imm0 imm1)) 890 (b @loop) 891 @win 892 (rsb imm1 imm1 (:$ 32)) 893 (orr imm0 imm2 (:lsl imm1 (:$ 7))) 894 (box-fixnum arg_z imm0) 895 (bx lr)) 875 896 876 897 (eval-when (:execute :load-toplevel) … … 1251 1272 1252 1273 (defun parse-b-operand (form instruction) 1253 (let* ((address (arm-subprimitive-address form))) 1254 (if address 1255 (let* ((lab (or (find-lap-label form) 1256 (make-lap-label form)))) 1257 (pushnew lab *called-subprim-jmp-labels*) 1258 (push (cons instruction :b) (lap-label-refs lab))) 1259 (lap-note-label-reference form instruction :b)))) 1274 (lap-note-label-reference form instruction :b)) 1260 1275 1261 1276 (defun parse-subprim-operand (form instruction) … … 1555 1570 (return))) 1556 1571 (return)))) 1557 (dolist (lab *called-subprim-jmp-labels*) 1558 (unless (lap-label-emitted-p lab) 1559 (emit-lap-instruction-element lab primary) 1560 (assemble-instruction primary `(ba ,(lap-label-name lab))))) 1572 1561 1573 (let* ((constants-size (section-size constant-pool))) 1562 1574 (unless (eql constants-size 0) … … 2194 2206 (ccl::vinsn-label 2195 2207 (or (find-lap-label value) 2196 (make-lap-label value))) 2197 (fixnum (let* ((lab (or (find-lap-label value) 2198 (make-lap-label value)))) 2199 (pushnew lab *called-subprim-jmp-labels*) 2200 lab))))) 2208 (make-lap-label value)))))) 2201 2209 (push (cons instruction :b) (lap-label-refs label)))) 2202 2210
Note: See TracChangeset
for help on using the changeset viewer.