Fix undefined function errors on PPC and MIPS.
[sbcl.git] / src / compiler / hppa / vm.lisp
index a11f5ce..28f1db2 100644 (file)
 (in-package "SB!VM")
 
 \f
-;;;; Define the registers
+;;;; Registers
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defvar *register-names* (make-array 32 :initial-element nil)))
 
-;;; FIXME: These want to turn into macrolets.
 (macrolet ((defreg (name offset)
                (let ((offset-sym (symbolicate name "-OFFSET")))
                  `(eval-when (:compile-toplevel :load-toplevel :execute)
                `(eval-when (:compile-toplevel :load-toplevel :execute)
                  (defparameter ,name
                    (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs))))))
-
   ;; Wired-zero
   (defreg zero 0)
   ;; This gets trashed by the C call convention.
-  (defreg nfp 1)
+  (defreg nfp 1) ;; and saved by lisp before calling C
   (defreg cfunc 2)
   ;; These are the callee saves, so these registers are stay live over
   ;; call-out.
   (defreg lip 31)
 
   (defregset non-descriptor-regs
-      nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc)
+    nl0 nl1 nl2 nl3 nl4 nl5 cfunc nargs nfp)
 
   (defregset descriptor-regs
-      fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2)
+    a0 a1 a2 a3 a4 a5 fdefn lexenv ocfp lra l0 l1 l2)
 
   (defregset *register-arg-offsets*
-      a0 a1 a2 a3 a4 a5))
+    a0 a1 a2 a3 a4 a5)
+
+  (defregset reserve-descriptor-regs
+             fdefn lexenv)
 
+  (defregset reserve-non-descriptor-regs
+             cfunc))
 
 (define-storage-base registers :finite :size 32)
 (define-storage-base float-registers :finite :size 64)
@@ -92,7 +95,7 @@
 ;;;
 ;;; Handy macro so we don't have to keep changing all the numbers whenever
 ;;; we insert a new storage class.
-;;;
+;;; FIXME-lav: move this into arch-generic-helpers.lisp and rip out from arches
 (defmacro !define-storage-classes (&rest classes)
   (do ((forms (list 'progn)
               (let* ((class (car classes))
                                                          "-SC-NUMBER"))))
                 (list* `(define-storage-class ,sc-name ,index
                           ,@(cdr class))
-                       `(defconstant ,constant-name ,index)
-                       `(export ',constant-name)
+                       `(def!constant ,constant-name ,index)
                        forms)))
        (index 0 (1+ index))
        (classes classes (cdr classes)))
       ((null classes)
        (nreverse forms))))
 
-(def!constant kludge-nondeterministic-catch-block-size 7)
+(def!constant kludge-nondeterministic-catch-block-size 6)
 
 (!define-storage-classes
 
-  ;; Non-immediate contstants in the constant pool
+  ;; Non-immediate constants in the constant pool
   (constant constant)
 
   ;; ZERO and NULL are in registers.
   ;; The control stack.  (Scanned by GC)
   (control-stack control-stack)
 
-  ;; The non-descriptor stacks.
-  (signed-stack non-descriptor-stack) ; (signed-byte 32)
-  (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
-  (character-stack non-descriptor-stack) ; non-descriptor characters.
-  (sap-stack non-descriptor-stack) ; System area pointers.
-  (single-stack non-descriptor-stack) ; single-floats
-  (double-stack non-descriptor-stack
-                :element-size 2 :alignment 2) ; double floats.
-  (complex-single-stack non-descriptor-stack :element-size 2)
-  (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
-
-
-  ;; **** Things that can go in the integer registers.
+  ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
+  ;; is small and therefore the error trap information is smaller.
+  ;; Moving them up here from their previous place down below saves
+  ;; ~250K in core file size.  --njf, 2006-01-27
 
   ;; Immediate descriptor objects.  Don't have to be seen by GC, but nothing
   ;; bad will happen if they are.  (fixnums, characters, header values, etc).
   (any-reg
    registers
    :locations #.(append non-descriptor-regs descriptor-regs)
-   :constant-scs (zero immediate)
+   :reserve-locations #.(append reserve-non-descriptor-regs
+                                reserve-descriptor-regs)
+   :constant-scs (constant zero immediate)
    :save-p t
    :alternate-scs (control-stack))
 
   ;; Pointer descriptor objects.  Must be seen by GC.
   (descriptor-reg registers
    :locations #.descriptor-regs
+   :reserve-locations #.reserve-descriptor-regs
    :constant-scs (constant null immediate)
    :save-p t
    :alternate-scs (control-stack))
 
+  ;; The non-descriptor stacks.
+  (signed-stack non-descriptor-stack) ; (signed-byte 32)
+  (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
+  (character-stack non-descriptor-stack) ; non-descriptor characters.
+  (sap-stack non-descriptor-stack) ; System area pointers.
+  (single-stack non-descriptor-stack) ; single-floats
+  (double-stack non-descriptor-stack
+                :element-size 2 :alignment 2) ; double floats.
+  (complex-single-stack non-descriptor-stack :element-size 2)
+  (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
+
+  ;; **** Things that can go in the integer registers.
+
   ;; Non-Descriptor characters
   (character-reg registers
    :locations #.non-descriptor-regs
+   :reserve-locations #.reserve-non-descriptor-regs
    :constant-scs (immediate)
    :save-p t
    :alternate-scs (character-stack))
   ;; Non-Descriptor SAP's (arbitrary pointers into address space)
   (sap-reg registers
    :locations #.non-descriptor-regs
+   :reserve-locations #.reserve-non-descriptor-regs
    :constant-scs (immediate)
    :save-p t
    :alternate-scs (sap-stack))
   ;; Non-Descriptor (signed or unsigned) numbers.
   (signed-reg registers
    :locations #.non-descriptor-regs
+   :reserve-locations #.reserve-non-descriptor-regs
    :constant-scs (zero immediate)
    :save-p t
    :alternate-scs (signed-stack))
   (unsigned-reg registers
    :locations #.non-descriptor-regs
+   :reserve-locations #.reserve-non-descriptor-regs
    :constant-scs (zero immediate)
    :save-p t
    :alternate-scs (unsigned-stack))
    :alternate-scs (complex-double-stack))
 
   ;; A catch or unwind block.
-  (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size))
+  (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)
+
+
+  ;; floating point numbers temporarily stuck in integer registers for c-call
+  (single-int-carg-reg registers
+                       :locations (26 25 24 23)
+                       :alternate-scs ()
+                       :constant-scs ())
+  (double-int-carg-reg registers
+                       :locations (25 23)
+                       :constant-scs ()
+                       :alternate-scs ()
+;                       :alignment 2          ;is this needed?
+;                       :element-size 2
+                       ))
 
 \f
 ;;;; Make some random tns for important registers.
 
+;;; how can we address reg L0 through L0-offset when it is not
+;;; defined here ? do all registers have an -offset and this is
+;;; redundant work ?
+;;;
+;;; FIXME-lav: move this into arch-generic-helpers
 (macrolet ((defregtn (name sc)
                (let ((offset-sym (symbolicate name "-OFFSET"))
                      (tn-sym (symbolicate name "-TN")))
   ;; These, we access by foo-TN only
 
   (defregtn zero any-reg)
+  (defregtn nargs any-reg)
+  ;; FIXME-lav: 20080820: not a fix, but fdefn and lexenv is used in assembly-rtns
+  (defregtn fdefn descriptor-reg) ; FIXME-lav, not used
+  (defregtn lexenv descriptor-reg) ; FIXME-lav, not used
+
+  (defregtn nfp descriptor-reg) ; why not descriptor-reg ?
+  (defregtn ocfp any-reg) ; why not descriptor-reg ?
+
   (defregtn null descriptor-reg)
-  (defregtn code descriptor-reg)
-  (defregtn alloc any-reg)
+
   (defregtn bsp any-reg)
-  (defregtn csp any-reg)
   (defregtn cfp any-reg)
+  (defregtn csp any-reg)
+  (defregtn alloc any-reg)
   (defregtn nsp any-reg)
 
-  ;; These alias regular locations, so we have to make sure we don't bypass
-  ;; the register allocator when using them.
-  (defregtn nargs any-reg)
-  (defregtn ocfp any-reg)
+  (defregtn code descriptor-reg)
   (defregtn lip interior-reg))
 
 ;; And some floating point values.
 \f
 ;;; If VALUE can be represented as an immediate constant, then return
 ;;; the appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
   (typecase value
     ((integer 0 0)
      (sc-number-or-lose 'zero))
          (sc-number-or-lose 'fp-double-zero)
          nil))))
 
+(defun boxed-immediate-sc-p (sc)
+  (or (eql sc (sc-number-or-lose 'zero))
+      (eql sc (sc-number-or-lose 'null))
+      (eql sc (sc-number-or-lose 'immediate))))
 \f
 ;;;; Function Call Parameters
 
 ;;; The SC numbers for register and stack arguments/return values.
 ;;;
-(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
-(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
-(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
+(def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
+(def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
+(def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;;; Offsets of special stack frame locations
-(defconstant ocfp-save-offset 0)
-(defconstant lra-save-offset 1)
-(defconstant nfp-save-offset 2)
+(def!constant ocfp-save-offset 0)
+(def!constant lra-save-offset 1)
+(def!constant nfp-save-offset 2)
 
 ;;; The number of arguments/return values passed in registers.
 ;;;
-(defconstant register-arg-count 6)
+(def!constant register-arg-count 6)
 
 ;;; Names to use for the argument registers.
 ;;;
 
 ;;; A list of TN's describing the register arguments.
 ;;;
-(defparameter register-arg-tns
-  (mapcar #'(lambda (n)
-              (make-random-tn :kind :normal
-                              :sc (sc-or-lose 'descriptor-reg)
-                              :offset n))
+(defparameter *register-arg-tns*
+  (mapcar (lambda (n)
+            (make-random-tn :kind :normal
+                            :sc (sc-or-lose 'descriptor-reg)
+                            :offset n))
           *register-arg-offsets*))
 
 ;;; This is used by the debugger.
-(defconstant single-value-return-byte-offset 4)
+(def!constant single-value-return-byte-offset 4)
 \f
 ;;; This function is called by debug output routines that want a pretty name
 ;;; for a TN's location.  It returns a thing that can be printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
   (declare (type tn tn))
   (let ((sb (sb-name (sc-sb (tn-sc tn))))
         (offset (tn-offset tn)))
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed"))))
 
+(defun combination-implementation-style (node)
+  (declare (type sb!c::combination node) (ignore node))
+  (values :default nil))
 
+(defun primitive-type-indirect-cell-type (ptype)
+  (declare (ignore ptype))
+  nil)