Changeset 13699

Timestamp:

May 13, 2010, 9:49:03 PM (15 years ago)

Author:

Gary Byers

Message:

It's early, still.

Location:

branches/arm

Files:

• compiler/ARM/arm-arch.lisp (modified) (8 diffs)
• compiler/ARM/arm-asm.lisp (added)
• compiler/ARM/arm-backend.lisp (added)
• compiler/ARM/arm-lap.lisp (added)
• compiler/ARM/arm-lapmacros.lisp (added)
• level-0/ARM (added)
• level-0/ARM/arm-clos.lisp (added)
• level-0/ARM/arm-misc.lisp (added)

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

@@ -21 +21 @@
 
 (in-package "ARM")
+
+
 ;;; Lisp registers.
-(eval-when (:compile-toplevel :execute)
-  (defmacro defregs (&body regs)
-    `(progn
-       (ccl::defenum () ,@regs)
-       (defparameter *gpr-register-names* ,(coerce (mapcar #'string regs) 'vector))))
-  (defmacro deffpregs (&body regs)
-    `(progn
-       (ccl::defenum () ,@regs)
-       (defparameter *fpr-register-names* ,(coerce (mapcar #'string regs) 'vector))))
-  (defmacro defvregs (&body regs)
-    `(progn
-      (ccl::defenum () ,@regs)
-      (defparameter *vector-register-names* ,(coerce (mapcar #'string regs) 'vector))
-      )))
-
-(defregs
-  imm0                                  ; unboxed, immediate register
-  imm1
-  imm2                                  ; doubles as nargs
-  rcontext                              ; TCR when running lisp
-  arg_z                                 ; tagged, last arg, primary return value
-  arg_y                                 ;
-  arg_x
-  temp0                                 ; volatile tagged regs
-  temp1
-  temp2
-  vsp                                   ; value stack pointer
-  fn                                    ; current function
-  allocptr                              ; for consing
-  sp                                    ; conventional sp
-  lr
-  pc
-  )
-
-(deffpregs 
-  fp0
-  fp1
-  fp2
-  fp3
-  fp4
-  fp5
-  fp6
-  fp7
-  fp8
-  fp9
-  fp10
-  fp11
-  fp12
-  fp13
-  fp14
-  fp15
-  fp16
-  fp17
-  fp18
-  fp19
-  fp20
-  fp21
-  fp22
-  fp23
-  fp24
-  fp25
-  fp26
-  fp27
-  fp28
-  fp29
-  fp30
-  fp31)
-
-
-
-
+
+
+
+(defvar *arm-gprs* (make-hash-table :test #'equalp))
+
+(defun get-arm-gpr (name)
+  (values (gethash (string name)  *arm-gprs*)))
+
+
+(defun define-arm-gpr (name val)
+  (etypecase val
+    ((mod 16) (setf (gethash (string name) *arm-gprs*) val))
+    (symbol (let* ((defined (get-arm-gpr val)))
+              (if defined
+                (setf (gethash (string name) *arm-gprs*) defined)
+                (error "ARM register value ~s not defined" val))))))
+
+(defmacro defarmgpr (name val)
+  `(define-arm-gpr ',name ',val))
+
+(defarmgpr r0 0)
+(defarmgpr r1 1)
+(defarmgpr r2 2)
+(defarmgpr r3 3)
+(defarmgpr r4 4)
+(defarmgpr r5 5)
+(defarmgpr r6 6)
+(defarmgpr r7 7)
+(defarmgpr r8 8)
+(defarmgpr r9 9)
+(defarmgpr r10 10)
+(defarmgpr r11 11)
+(defarmgpr r12 12)
+(defarmgpr r13 13)
+(defarmgpr r14 14)
+(defarmgpr r15 15)
+
+(defarmgpr imm0 r0)
+(defarmgpr imm1 r1)
+(defarmgpr imm2 r2)
+(defarmgpr rcontext r3)
+(defarmgpr arg_z r4)
+(defarmgpr arg_y r5)
+(defarmgpr arg_x r6)
+(defarmgpr temp0 r7)
+(defarmgpr temp1 r8)
+(defarmgpr temp2 r9)
+(defarmgpr vsp r10)
+(defarmgpr fn r11)
+(defarmgpr allocptr r12)
+(defarmgpr sp r13)
+(defarmgpr lr r14)
+(defarmgpr pc r15)
 
 ;;; Calling sequence may pass additional arguments in temp registers.
 ;;; "nfn" (new function) is always passed; it's the new value of "fn".
-(defconstant nfn temp2)
-
+(defarmgpr nfn temp2)
 ;;; CLOS may pass the context for, e.g.., CALL-NEXT-METHOD in 
 ;;;; the "next-method-context" register.
-(defconstant next-method-context temp1)
-
-
-
-(defconstant fname temp3)
+(defarmgpr next-method-context temp1)
+
+(defarmgpr fname temp1)
+
 
 
@@ -413 +395 @@
 
   
-)
+
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -586 +568 @@
 (defconstant max-non-array-node-subtag (logior (ash 18 ntagbits) fulltag-nodeheader))
 
+(define-subtag lisp-frame-marker fulltag-imm 2)
 (define-subtag character fulltag-imm 9)
-(define-subtag vsp-protect fulltag-imm 7)
 (define-subtag slot-unbound fulltag-imm 10)
 (defconstant slot-unbound-marker subtag-slot-unbound)
@@ -598 +580 @@
 (defconstant unbound-marker subtag-unbound)
 (defconstant undefined unbound-marker)
-
-
-(defconstant max-64-bit-constant-index (ash (+ #x7fff arm::misc-dfloat-offset) -3))
-(defconstant max-32-bit-constant-index (ash (+ #x7fff arm::misc-data-offset) -2))
-(defconstant max-16-bit-constant-index (ash (+ #x7fff arm::misc-data-offset) -1))
-(defconstant max-8-bit-constant-index (+ #x7fff arm::misc-data-offset))
-(defconstant max-1-bit-constant-index (ash (+ #x7fff arm::misc-data-offset) 5))
+(defconstant lisp-frame-marker subtag-lisp-frame-marker)
+
+(defconstant max-64-bit-constant-index (ash (+ #xfff arm::misc-dfloat-offset) -3))
+(defconstant max-32-bit-constant-index (ash (+ #xfff arm::misc-data-offset) -2))
+(defconstant max-16-bit-constant-index (ash (+ #xfff arm::misc-data-offset) -1))
+(defconstant max-8-bit-constant-index (+ #xfff arm::misc-data-offset))
+(defconstant max-1-bit-constant-index (ash (+ #xfff arm::misc-data-offset) 5))
 
 
@@ -683 +665 @@
   binding-index
 )
+
+(define-fixedsized-object function
+  entrypoint
+  codevector
+  )
+
 
 
@@ -860 +848 @@
 
 (defun %kernel-global (sym)
+  ;; Returns index relative to (- nil-value fulltag-nil)
   (let* ((pos (position sym arm::*arm-kernel-globals* :test #'string=)))
     (if pos
-      (- (+ fulltag-nil (* (1+ pos) 4)))
+      (- (* (1+ pos) 4))
       (error "Unknown kernel global : ~s ." sym))))
 
@@ -868 +857 @@
   (let* ((pos (position sym arm::*arm-kernel-globals* :test #'string=)))
     (if pos
-      (- (+ fulltag-nil (* (1+ pos) 4)))
+      (- (* (1+ pos) 4))
       (error "Unknown kernel global : ~s ." sym))))
 
@@ -1249 +1238 @@
 (defconstant arg-check-trap-pc-limit 8)
 
+;;; UUO encoding
+(defconstant uuo-format-nullary 0)      ; 12 bits of code 
+(defconstant uuo-format-unary 1)        ; 8 bits of info - NOT type info - 4-bit reg 
+(defconstant uuo-format-error-lisptag 2) ; 2 bits of lisptag info, 4-bit reg 
+(defconstant uuo-format-error-fulltag 3) ; 3 bits of fulltag info, 4 bit reg 
+
+(defconstant uuo-format-error-xtype 4)  ; 8 bits of extended type/subtag info, 4 bit reg 
+(defconstant uuo-format-cerror-lisptag 10) ; continuable, lisptag, reg 
+(defconstant uuo-format-cerror-fulltag 11) ; continuable, fulltag, reg 
+(defconstant uuo-format-cerror-xtype 12) ; continuable, xtype, reg         
+(defconstant uuo-format-binary 15)      ;  4 bits of code, r1, r0 
+
   
 (provide "ARM-ARCH")