Changeset 14095

Timestamp:

Aug 1, 2010, 5:18:39 AM (9 years ago)

Author:

gb

Message:

Stop supporting the "BA" pseudoinstruction (which was really a
"mov pc,#subprim-address" instruction.) Apparently such instructions
cause the pipeline to be flushed on the Cortex A8, and some tests
reveal that "mov reg,#subprim-address / bx reg" is indeed faster (though
a bit larger for jumps.)

Native LAP code for ENCODE-ARM-IMMEDIATE; conses less, can't hurt.

File:

• branches/arm/compiler/ARM/arm-asm.lisp (modified) (7 diffs)

branches/arm/compiler/ARM/arm-asm.lisp

@@ -44 +44 @@
 (defvar *arm-constants* ())
 (defvar *lap-labels* ())
-(defvar *called-subprim-jmp-labels* ())
 (defvar *last-constant-pool-origin* ())
 
@@ -475 +474 @@
    
 
-   ;; (ba subprim-name) -> (mov pc ($ subprim-address))
-   (define-arm-instruction ba (:subprim)
-     #x03a0f000
-     #x0ffff000
-     ())
-   
+  
    (define-arm-instruction mov (:rd :shifter)
      #x01a00000
@@ -865 +859 @@
 ;;; by an even number of bits if u32 can be encoded that way, nil
 ;;; otherwise.
+#-arm-target
 (defun encode-arm-immediate (u32)
   (do* ((u32 (logand #xffffffff u32))
@@ -873 +868 @@
         (return (logior (ash rot 7) a))))))
 
+#+arm-target
+(ccl::defarmlapfunction encode-arm-immediate ((u32 arg_z))
+  (check-nargs 1)
+  (extract-typecode imm0 u32)
+  (cmp imm0 (:$ arm::tag-fixnum))
+  (moveq imm0 (:asr u32 (:$ arm::fixnumshift)))
+  (beq @got)
+  (cmp imm0 (:$ arm::subtag-bignum))
+  (uuo-error-reg-not-xtype (:? ne) u32 (:$ arm::xtype-integer))
+  (ldr imm0 (:@ u32 (:$ arm::misc-data-offset)))
+  @got
+  (mov imm1 (:$ 32))
+  (mov imm2 imm0)
+  @loop
+  (cmp imm2 (:$ 256))
+  (blo @win)
+  (subs imm1 imm1 (:$ 2))
+  (moveq arg_z 'nil)
+  (bxeq lr)
+  (mov imm2 (:ror imm0 imm1))
+  (b @loop)
+  @win
+  (rsb imm1 imm1 (:$ 32))
+  (orr imm0 imm2 (:lsl imm1 (:$ 7)))
+  (box-fixnum arg_z imm0)
+  (bx lr))
 
 (eval-when (:execute :load-toplevel)
@@ -1251 +1272 @@
 
 (defun parse-b-operand (form instruction)
-  (let* ((address (arm-subprimitive-address form)))
-    (if address
-      (let* ((lab (or (find-lap-label form)
-                      (make-lap-label form))))
-        (pushnew lab *called-subprim-jmp-labels*)
-        (push (cons instruction :b) (lap-label-refs lab)))
-      (lap-note-label-reference form instruction :b))))
+  (lap-note-label-reference form instruction :b))
 
 (defun parse-subprim-operand (form instruction) 
@@ -1555 +1570 @@
                 (return)))
         (return))))
-  (dolist (lab *called-subprim-jmp-labels*)
-    (unless (lap-label-emitted-p lab)
-      (emit-lap-instruction-element lab primary)
-      (assemble-instruction primary `(ba ,(lap-label-name lab)))))
+
   (let* ((constants-size (section-size constant-pool)))
     (unless (eql constants-size 0)
@@ -2194 +2206 @@
                   (ccl::vinsn-label
                    (or (find-lap-label value)
-                       (make-lap-label value)))
-                  (fixnum (let* ((lab (or (find-lap-label value)
-                                          (make-lap-label value))))
-                            (pushnew lab *called-subprim-jmp-labels*)
-                            lab)))))
+                       (make-lap-label value))))))
     (push (cons instruction :b) (lap-label-refs label))))