Changeset 13892

Timestamp:

Jun 26, 2010, 1:06:47 AM (14 years ago)

Author:

Gary Byers

Message:

arm-asm.lisp: change handling of non-conditional instructions (like "clrex").

arm-vinsns.lisp: EXTRACT-TAG-FIXNUM: shift first, then mask.

arm-utils.lisp: %WALK-DYNAMIC-AREA: more sanity checks, more sane.

l0-misc.lisp: %THREAD-STACK-SPACE: no temp stack on ARM.

arm-exceptions.c : callback_to_lisp(): don't assume that TCR is in rcontext.
handle_exception(): punt if in foreign code. handle_uuo(): break.

arm-spentry.s : _SPtfuncalllgen: push the right register.
_SPatomic_incf_node: preserve unboxed offset in case we loop.

arm-subprims.s: toplevel_loop, call _SPfuncall since the macro just
jumps.

Can read toplevel forms, but TOPLEVEL-EVAL uses PROGV which isn't all
there yet.

Location:

branches/arm

Files:

• compiler/ARM/arm-asm.lisp (modified) (3 diffs)
• compiler/ARM/arm-vinsns.lisp (modified) (1 diff)
• level-0/ARM/arm-utils.lisp (modified) (4 diffs)
• level-0/l0-misc.lisp (modified) (1 diff)
• lisp-kernel/arm-exceptions.c (modified) (3 diffs)
• lisp-kernel/arm-spentry.s (modified) (2 diffs)

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

@@ -171 +171 @@
   (vector
 
+   (define-arm-instruction clrex ()
+     #xf57ff01f
+     #xffffffff
+     (:non-conditional))
+   
 ;;; UUOs.
 
@@ -748 +753 @@
      #x0ff00ff0
      ())
-   (define-arm-instruction clrex ()
-     #xf57ff01f
-     #xffffffff
-     (:non-conditional))
    (define-arm-instruction clz (:rd :rm)
      #x016f0f10
@@ -776 +777 @@
          (template (if ordinal (aref *arm-instruction-table* ordinal))))
     (if template
-      (values template (unless (logbitp (encode-arm-instruction-flag :non-conditional) (arm-instruction-template-flags template)) cond-value) nil)
+      (if (logtest (encode-arm-instruction-flag :non-conditional) (arm-instruction-template-flags template))
+        (let* ((cond (ldb (byte 4 28) (arm-instruction-template-val template))))
+          (values template cond cond))
+        (values template cond-value nil))
       (if (> len 2)
         (let* ((cond-name (make-string 2)))

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

@@ -774 +774 @@
 (define-arm-vinsn extract-tag-fixnum (((tag :imm))
                                       ((object :lisp)))
-  (and tag object (:$ arm::tagmask))
-  (mov tag (:lsl tag (:$ arm::fixnumshift))))
+  (mov tag (:lsl object (:$ arm::fixnumshift)))
+  (and tag object (:$ (ash arm::tagmask arm::fixnumshift))))
 
 (define-arm-vinsn extract-fulltag (((tag :u8))

branches/arm/level-0/ARM/arm-utils.lisp

@@ -195 +195 @@
     (b @test)
     @loop
+    (test-fixnum obj)
+    (uuo-debug-trap (:? ne))
     (ldr header (:@ obj (:$ 0)))
     (extract-fulltag tag header)
@@ -208 +210 @@
     (bl .SPFuncall)
     (ldmia (:! vsp) (obj fun sentinel))
-    (add obj obj (:$ arm::cons.size))
+    (add obj obj (:$ (- arm::cons.size arm::fulltag-cons)))
     (b @test)
     @misc
@@ -217 +219 @@
     (bl .SPFuncall)
     (ldmia (:! vsp) (obj fun sentinel))
-    (add obj obj (:$ arm::fulltag-misc))
+    (sub obj obj (:$ arm::fulltag-misc))
     (ldr header (:@ obj (:$ 0)))
     (extract-fulltag tag header)
@@ -240 +242 @@
     (mov header (:lsr header (:$ 3)))
     @bump
+    (mov imm2 obj)
     (add header header (:$ (+ 4 7)))
     (bic header header (:$ arm::fulltagmask))

branches/arm/level-0/l0-misc.lisp

@@ -272 +272 @@
         (multiple-value-bind (cf cu) (free-and-used (%fixnum-ref tcr target::tcr.cs-area))
           (multiple-value-bind (vf vu) (free-and-used (%fixnum-ref tcr target::tcr.vs-area))
+            #+arm-target
+            (values cf cu vf vu)
+            #-arm-target
             (multiple-value-bind (tf tu) (free-and-used (%fixnum-ref tcr target::tcr.ts-area ))
               (values cf cu vf vu tf tu))))))))

branches/arm/lisp-kernel/arm-exceptions.c

@@ -983 +983 @@
   opcode instruction = 0;
 
+  if (old_valence != TCR_STATE_LISP) {
+    return false;
+  }
 
   program_counter = xpPC(xp);
@@ -1122 +1125 @@
       break;
     }
+    break;
+
 
   case uuo_format_error_lisptag:
@@ -1184 +1189 @@
                                                
 
-  TCR *tcr = TCR_FROM_TSD(xpGPR(xp, rcontext));
+  TCR *tcr = get_tcr(true);
 
   /* Put the active stack pointer where .SPcallback expects it */

branches/arm/lisp-kernel/arm-spentry.s

@@ -1500 +1500 @@
         __(ldr temp0,[imm1,#-node_size]!)
         __(cmp imm1,vsp)
-        __(push1(temp2,imm0))
+        __(push1(temp0,imm0))
         __(bne 1b)
         __(mov vsp,imm0)
@@ -1816 +1816 @@
    support because of the locative */
 _spentry(atomic_incf_node)
-        __(unbox_fixnum(imm0,arg_z))
-0:      __(add imm2,arg_y,imm0)
+        __(unbox_fixnum(imm1,arg_z))
+0:      __(add imm2,arg_y,imm1)
         __(ldrex arg_z,[imm2])
         __(add arg_z,arg_z,arg_x)