Changeset 13962 for branches

Timestamp:

Jul 14, 2010, 5:24:29 PM (14 years ago)

Author:

Gary Byers

Message:

arm-arch.lisp: artist's conception of fake-stack-frame.
arm-backend.lisp: require armenv, nxenv. WITH-FAKE-STACK-FRAME.
arm-vinsns.lisp: fix u32->integer.
arm-utils.lisp: LAP for other gc-trap functions.
arm-thread-utils.lisp: start to sketch out fake-stack-frame stuff, no TSP on ARM.
l1-io.lisp: no TSP on ARM.
l1-lisp-threads.lisp: no TSP on ARM.
arm-backtrace.lisp: fake-stack-frame stuff.
backtrace: no *fake-stack-frames* list on ARM.
edit-callers.lisp: ARM changes.
nfcomp.lisp: in FASL-SCAN-DISPATCH, don't assume that TYPECODE returns target::FULLTAG-CONS (which may not be the same as TARGET::TAG-LIST.)
arm-asmutils.s: flush_cache_lines is Linux-specific.
area.h: larger pure spaces on ARM; small static space on all platforms.
arm-exceptions.h: different magic number in is_write_fault.
arm-gc.c: purify() mostly working.
arm-subprims.s: fix comment
platform-linuxarm.h, xarmfasload.lisp: map more memory at higher address on ARM linux.

Location:

branches/arm

Files:

• compiler/ARM/arm-arch.lisp (modified) (1 diff)
• compiler/ARM/arm-backend.lisp (modified) (2 diffs)
• compiler/ARM/arm-vinsns.lisp (modified) (1 diff)
• level-0/ARM/arm-utils.lisp (modified) (9 diffs)
• level-1/arm-threads-utils.lisp (modified) (3 diffs)
• level-1/l1-io.lisp (modified) (1 diff)
• level-1/l1-lisp-threads.lisp (modified) (2 diffs)
• lib/arm-backtrace.lisp (modified) (2 diffs)
• lib/backtrace.lisp (modified) (1 diff)
• lib/edit-callers.lisp (modified) (2 diffs)
• lib/nfcomp.lisp (modified) (1 diff)
• lisp-kernel/area.h (modified) (2 diffs)
• lisp-kernel/arm-asmutils.s (modified) (2 diffs)
• lisp-kernel/arm-exceptions.c (modified) (1 diff)
• lisp-kernel/arm-gc.c (modified) (1 diff)
• lisp-kernel/arm-subprims.s (modified) (1 diff)
• lisp-kernel/platform-linuxarm.h (modified) (1 diff)
• xdump/xarmfasload.lisp (modified) (1 diff)

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

@@ -1383 +1383 @@
 (defconstant *function-initial-entrypoint* (ash *arm-subprims-base* (- arm::fixnumshift)))
 
-  
+;;; These are always stack-allocated, "near" where the missing lisp frame
+;;; that they represent would be.
+
+(define-storage-layout fake-stack-frame 0
+  header
+  type                                  ; 'arm::fake-stack-frame
+  sp
+  next-sp
+  fn
+  lr
+  vsp
+  xp)
+
+
+
 (provide "ARM-ARCH")

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

@@ -17 +17 @@
 
 (in-package "CCL")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require "NXENV")
+  (require "ARMENV"))
 
 (next-nx-defops)
@@ -314 +318 @@
 (pushnew *arm-backend* *known-backends* :key #'backend-name)
 
+
+(defmacro with-fake-stack-frame ((var sp next-sp fn lr vsp xp) &body body)
+  `(let* ((,var (ccl::%istruct 'arm::fake-stack-frame ,sp ,next-sp ,fn ,lr ,vsp ,xp)))
+    (declare (dynamic-extent ,var) (ignorable ,var))
+    ,@body))
+
 (require "ARM-VINSNS")
 

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

@@ -2183 +2183 @@
   (cmp src (:$ 0))
   (mov temp (:$ arm::subtag-bignum))
-  (movgt size (:$ (- (* 2 arm::dnode-size) arm::fulltag-misc)))
-  (orrgt temp temp (:$ (ash 2 arm::num-subtag-bits)))
-  (movlt size (:$ (- (* 1 arm::dnode-size) arm::fulltag-misc)))
-  (orrlt temp temp (:$ (ash 1 arm::num-subtag-bits)))
+  (movgt size (:$ (- (* 1 arm::dnode-size) arm::fulltag-misc)))
+  (orrgt temp temp (:$ (ash 1 arm::num-subtag-bits)))
+  (movlt size (:$ (- (* 2 arm::dnode-size) arm::fulltag-misc)))
+  (orrlt temp temp (:$ (ash 2 arm::num-subtag-bits)))
   (sub allocptr allocptr size)
   (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))

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

@@ -332 +332 @@
   (ba .SPnvalret))
 
-#+notyet                                ;trap encoding
-(progn
-
 
 
@@ -343 +340 @@
 of sense to be turning the EGC on and off from multiple threads ..."
   (check-nargs 1)
-  (subi imm1 arg nil)
-  (li imm0 arch::gc-trap-function-egc-control)
-  (trlgei allocptr 0)
+  (sub imm1 arg 'nil)
+  (mov imm0 (:$ arch::gc-trap-function-egc-control))
+  (uuo-gc-trap (:? al))
   (bx lr))
 
@@ -354 +351 @@
                                    (e2size arg_z))
   (check-nargs 3)
-  (li imm0 arch::gc-trap-function-configure-egc)
-  (trlgei allocptr 0)
+  (mov imm0 (:$ arch::gc-trap-function-configure-egc))
+  (uuo-gc-trap (:? al))
   (bx lr))
 
 (defarmlapfunction purify ()
-  (li imm0 arch::gc-trap-function-purify)
-  (trlgei allocptr 0)
-  (li arg_z nil)
+  (mov imm0 (:$ arch::gc-trap-function-purify))
+  (uuo-gc-trap (:? al))
+  (mov arg_z 'nil)
   (bx lr))
 
 
 (defarmlapfunction impurify ()
-  (li imm0 arch::gc-trap-function-impurify)
-  (trlgei allocptr 0)
-  (li arg_z nil)
+  (mov imm0 (:$ arch::gc-trap-function-impurify))
+  (uuo-gc-trap (:? al))
+  (mov arg_z 'nil)
   (bx lr))
 
@@ -375 +372 @@
 of free space to leave in the heap after full GC."
   (check-nargs 0)
-  (li imm0 arch::gc-trap-function-get-lisp-heap-threshold)
-  (trlgei allocptr 0)
-  #+arm32-target
-  (ba .SPmakeu32)
-  #+arm64-target
-  (ba .SPmakeu64))
+  (mov imm0 (:$ arch::gc-trap-function-get-lisp-heap-threshold))
+  (uuo-gc-trap (:? al))
+  (ba .SPmakeu32))
 
 (defarmlapfunction set-lisp-heap-gc-threshold ((new arg_z))
@@ -388 +382 @@
 be somewhat larger than what was specified)."
   (check-nargs 1)
-  (mflr loc-pc)
-  #+arm32-target
-  (bla .SPgetu32)
-  #+arm64-target
-  (bla .SPgetu64)
-  (mtlr loc-pc)
+  (build-lisp-frame)
+  (bl .SPgetu32)
   (mov imm1 imm0)
-  (li imm0 arch::gc-trap-function-set-lisp-heap-threshold)
-  (trlgei allocptr 0)
-  #+arm32-target
-  (ba .SPmakeu32)
-  #+arm64-target
-  (ba .SPmakeu64))
+  (mov imm0 (:$ arch::gc-trap-function-set-lisp-heap-threshold))
+  (uuo-gc-trap (:? al))
+  (restore-lisp-frame imm1)
+  (ba .SPmakeu32))
 
 
@@ -406 +394 @@
   "Try to grow or shrink lisp's heap space, so that the free space is(approximately) equal to the current heap threshold. Return NIL"
   (check-nargs 0) 
-  (li imm0 arch::gc-trap-function-use-lisp-heap-threshold)
-  (trlgei allocptr 0)
-  (li arg_z nil)
+  (mov imm0 (:$ arch::gc-trap-function-use-lisp-heap-threshold))
+  (uuo-gc-trap (:? al))
+  (mov arg_z 'nil)
   (bx lr))
 
@@ -415 +403 @@
   "Do a full GC, then consider all heap-allocated objects which survive to be non-relocatable."
   (check-nargs 0)
-  (li imm0 arch::gc-trap-function-freeze)
-  (trlgei allocptr 0)
-  #+64-bit-target
-  (ba .SPmakeu64)
-  #+32-bit-target
+  (mov imm0 (:$ arch::gc-trap-function-freeze))
+  (uuo-gc-trap (:? al))
   (ba .SPmakeu32))
 
@@ -425 +410 @@
   "Like FREEZE, but don't GC first."
   (check-nargs 0)
-  (li imm0 arch::gc-trap-function-flash-freeze)
-  (trlgei allocptr 0)
-  #+64-bit-target
-  (ba .SPmakeu64)
-  #+32-bit-target
+  (mov imm0 (:$ arch::gc-trap-function-flash-freeze))
+  (uuo-gc-trap (:? al))
   (ba .SPmakeu32))
 
@@ -444 +426 @@
 (defarmlapfunction %ensure-static-conses ()
   (check-nargs 0)
-  (li imm0 arch::gc-trap-function-ensure-static-conses)
-  (trlgei allocptr 0)
-  (li arg_z nil)
-  (bx lr))
-)
+  (mov imm0 (:$ arch::gc-trap-function-ensure-static-conses))
+  (uuo-gc-trap (:? al))
+  (mov arg_z 'nil)
+  (bx lr))
+
 
 ;;; offset is a fixnum, one of the arm::kernel-import-xxx constants.

branches/arm/level-1/arm-threads-utils.lisp

@@ -19 +19 @@
 (defun %frame-backlink (p &optional context)
   (cond ((fake-stack-frame-p p)
-         (%fake-stack-frame.next-sp p))
+         (%fixnum-ref p arm::fake-stack-frame.next-sp))
         ((fixnump p) (%%frame-backlink p))
         (t (error "~s is not a valid stack frame" p))))
@@ -31 +31 @@
 
 (defun fake-stack-frame-p (x)
-  nil)
+  (and (typep x 'fixnum)
+       (evenp x)
+       (eql (%fixnum-ref-natural x)
+            (logior (ash (ash (- arm::fake-stack-frame.size arm::node-size)
+                              (- arm::word-shift))
+                         arm::num-subtag-bits)
+                    arm::subtag-istruct))
+       (eq (%fixnum-ref-natural x arm::node-size)
+           'arm::fake-stack-frame)))
+
 
 (defun bottom-of-stack-p (p context)
@@ -92 +101 @@
                               (on-any-vstack x))
                              (t
-                              (on-any-tsp-stack x)))
+                              (on-any-csp-stack x)))
                            (%heap-ivector-p x)))))))))
 

branches/arm/level-1/l1-io.lisp

@@ -1600 +1600 @@
 (defun %macptr-allocation-string (macptr)
   (if (or (on-any-csp-stack macptr)
+          #-arm-target
           (on-any-tsp-stack macptr))
     "[stack-allocated]"

branches/arm/level-1/l1-lisp-threads.lisp

@@ -703 +703 @@
       (return t))))
 
-
+#-arm-target
 (defun on-any-tsp-stack (object)
   (or (%on-tsp-stack (%current-tcr) object)
@@ -720 +720 @@
   (and (consp x)
        (not (null (or (on-any-vstack x)
-                      (on-any-tsp-stack x))))))
+                      #-arm-target
+                      (on-any-tsp-stack x)
+                      #+arm-target
+                      (on-any-csp-stack x))))))
 
 

branches/arm/lib/arm-backtrace.lisp

@@ -51 +51 @@
 (defun index->address (p)
   (when (fake-stack-frame-p p)
-    (setq p (%fake-stack-frame.sp p)))
+    (setq p (%fixnum-ref p arm::fake-stack-frame.sp)))
   (ldb (byte  32 0)  (ash p arm::fixnumshift)))
 
@@ -114 +114 @@
 (defun %frame-savevsp (p)
   (if (fake-stack-frame-p p)
-    (%fake-stack-frame.vsp p)
+    (%fixnum-ref p arm::fake-stack-frame.vsp)
     (%%frame-savevsp p)))

branches/arm/lib/backtrace.lisp

@@ -42 +42 @@
                         nil       ;; condition - not used
                         frame-ptr ;; current
-                        #+(or ppc-target arm-target) *fake-stack-frames*
-                        #+x86-target frame-ptr
+                        #+ppc-target *fake-stack-frames*
+                        #+(or x86-target arm-target) frame-ptr
                         (%fixnum-ref tcr target::tcr.db-link)
                         0         ;; break level - not used

branches/arm/lib/edit-callers.lisp

@@ -226 +226 @@
 (defun %map-lfimms (function-object f)
   (let* ((lfv (function-to-function-vector function-object))
-         (n (- (uvsize lfv) #+arm-target 3 #-arm-target 2)))
+         (n (- (uvsize lfv) 2)))
     (declare (fixnum n))
     #+ppc-target
@@ -238 +238 @@
     #+arm-target
     (do* ((i 2 (1+ i)))
-         ((= i n))
+         ((>= i n))
       (declare (fixnum i))
-      (funcall f (%svref lfv i)))
+      (funcall f (uvref lfv i)))
     ))
          

branches/arm/lib/nfcomp.lisp

@@ -1207 +1207 @@
         (#.target::tag-fixnum
          (fasl-scan-fixnum exp))
-        (#.target::fulltag-cons (fasl-scan-list exp))
+        (#.target::tag-list (fasl-scan-list exp))
         #+ppc32-target
         (#.ppc32::tag-imm)

branches/arm/lisp-kernel/area.h

@@ -154 +154 @@
 #else
 #ifdef ARM
-#define PURESPACE_RESERVE (8<<20)
-#define PURESPACE_SIZE (4<<20)
+#define PURESPACE_RESERVE (64<<20)
+#define PURESPACE_SIZE (32<<20)
 #else
 #define PURESPACE_RESERVE (128<<20) /* MB */
@@ -162 +162 @@
 #endif
 
-#define STATIC_RESERVE heap_segment_size
+#define STATIC_RESERVE (1<<12)
 
 

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

@@ -24 +24 @@
 /* Force data from r0 to r1 into the icache */        
 _exportfn(C(flush_cache_lines))
+        __ifdef(`LINUX')
         __(mov r2,#0)           /* options.  Pass as 0 until we know better */
         __(mov r12,r7)          /* preserve r7 ;  r12 saved by syscall */
@@ -30 +31 @@
         __(svc #0)
         __(mov r7,r12)
+        __endif
         __(bx lr)
 

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

@@ -816 +816 @@
   /* Based on experiments with a small sample size; need to R TFM. */
   return ((xp->uc_mcontext.trap_no == 0xe) &&
-          (xp->uc_mcontext.error_code == 0x817));
+          (xp->uc_mcontext.error_code == 0x81f));
 #endif
 }

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

@@ -1668 +1668 @@
         }
         start++;
-        copy_ivector_reference(start, low, high, to);
+        if (header_subtag(header) == subtag_function) {
+          LispObj entrypt = *start;
+          if ((entrypt > (LispObj)low) && 
+              (entrypt < (LispObj)high) &&
+              (fulltag_of(entrypt) == fulltag_odd_fixnum)) {
+            *start = untag(entrypt) + fulltag_misc;
+            copy_ivector_reference(start, low, high, to);
+            *start = untag(*start)+fulltag_odd_fixnum;
+          } else {
+            copy_ivector_reference(start, low, high, to);
+          }
+        } else {
+          copy_ivector_reference(start, low, high, to);
+        }
         start++;
       }

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

@@ -54 +54 @@
 
 
-/* This gets called with R3 pointing to the current TCR. */
-/* r4 is 0 if we want to start the whole thing rolling, */
+/* This gets called with R0 pointing to the current TCR. */
+/* r1 is 0 if we want to start the whole thing rolling, */
 /* non-zero if we want to reset the current process */
 /* by throwing to toplevel */

branches/arm/lisp-kernel/platform-linuxarm.h

@@ -26 +26 @@
 
 
-#define MAXIMUM_MAPPABLE_MEMORY (256<<20) /* uh, no */
-#define IMAGE_BASE_ADDRESS 0x04001000
+#define MAXIMUM_MAPPABLE_MEMORY (5<<28)
+#define IMAGE_BASE_ADDRESS 0x50000000
 
 #include "lisptypes.h"

branches/arm/xdump/xarmfasload.lisp

@@ -87 +87 @@
    :subdirs '("ccl:level-0;ARM;")
    :compiler-target-name :linuxarm
-   :image-base-address (+ (- arm::nil-value arm::fulltag-nil) (ash 1 12))
+   :image-base-address #x50000000
    :nil-relative-symbols arm::*arm-nil-relative-symbols*
    :static-space-init-function 'arm-initialize-static-space
-   :purespace-reserve (ash 8 20)
+   :purespace-reserve (ash 64 20)
    :static-space-address (- (- arm::nil-value arm::fulltag-nil) (ash 1 12))
 ))