X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fvm.lisp;h=cc2d8443dad3ab2d012a1d9f55b1edc07a23643e;hb=31f072311935e32751508ecf824905c6b58a1d95;hp=f06177075793e2391e3eb84f740c07d73d31b4fc;hpb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;p=sbcl.git diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index f061770..cc2d844 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -18,45 +18,56 @@ (defvar *register-names* (make-array 32 :initial-element nil))) (macrolet ((defreg (name offset) - (let ((offset-sym (symbolicate name "-OFFSET"))) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant ,offset-sym ,offset) - (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) - - (defregset (name &rest regs) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter ,name - (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs)))))) - (defreg zero 0) - (defreg nl3 1) - (defreg cfunc 2) - (defreg nl4 3) - (defreg nl0 4) ; First C argument reg. - (defreg nl1 5) - (defreg nl2 6) - (defreg nargs 7) - (defreg a0 8) - (defreg a1 9) - (defreg a2 10) - (defreg a3 11) - (defreg a4 12) - (defreg a5 13) - (defreg fdefn 14) - (defreg lexenv 15) - ;; First saved reg - (defreg nfp 16) - (defreg ocfp 17) - (defreg lra 18) - (defreg l0 19) - (defreg null 20) - (defreg bsp 21) - (defreg cfp 22) - (defreg csp 23) - (defreg l1 24) - (defreg alloc 25) - (defreg nsp 29) - (defreg code 30) - (defreg lip 31) + (let ((offset-sym (symbolicate name "-OFFSET"))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (def!constant ,offset-sym ,offset) + (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) + + (defregset (name &rest regs) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter ,name + (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs)))))) + ;; Wired zero register. + (defreg zero 0) ; NULL + ;; Reserved for assembler use. + (defreg nl3 1) ; untagged temporary 3 + ;; C return registers. + (defreg cfunc 2) ; FF function address, wastes a register + (defreg nl4 3) ; PA flag + ;; C argument registers. + (defreg nl0 4) ; untagged temporary 0 + (defreg nl1 5) ; untagged temporary 1 + (defreg nl2 6) ; untagged temporary 2 + (defreg nargs 7) ; number of function arguments + ;; C unsaved temporaries. + (defreg a0 8) ; function arg 0 + (defreg a1 9) ; function arg 1 + (defreg a2 10) ; function arg 2 + (defreg a3 11) ; function arg 3 + (defreg a4 12) ; function arg 4 + (defreg a5 13) ; function arg 5 + (defreg fdefn 14) ; ? + (defreg lexenv 15) ; wastes a register + ;; C saved registers. + (defreg nfp 16) ; non-lisp frame pointer + (defreg ocfp 17) ; caller's control frame pointer + (defreg lra 18) ; tagged Lisp return address + (defreg l0 19) ; tagged temporary 0 + (defreg null 20) ; NIL + (defreg bsp 21) ; binding stack pointer + (defreg cfp 22) ; control frame pointer + (defreg csp 23) ; control stack pointer + ;; More C unsaved temporaries. + (defreg l1 24) ; tagged temporary 1 + (defreg alloc 25) ; ALLOC pointer + ;; 26 and 27 are used by the system kernel. + ;; 28 is the global pointer of our C runtime, and used for + ;; jump/branch relaxation in Lisp. + (defreg nsp 29) ; number (native) stack pointer + ;; C frame pointer, or additional saved register. + (defreg code 30) ; current function object + ;; Return link register. + (defreg lip 31) ; Lisp interior pointer (defregset non-descriptor-regs nl0 nl1 nl2 nl3 nl4 cfunc nargs) @@ -86,19 +97,19 @@ ;;; ;;; Handy macro so we don't have to keep changing all the numbers whenever ;;; we insert a new storage class. -;;; +;;; (defmacro !define-storage-classes (&rest classes) (do ((forms (list 'progn) - (let* ((class (car classes)) - (sc-name (car class)) - (constant-name (intern (concatenate 'simple-string - (string sc-name) - "-SC-NUMBER")))) - (list* `(define-storage-class ,sc-name ,index - ,@(cdr class)) - `(defconstant ,constant-name ,index) - `(export ',constant-name) - forms))) + (let* ((class (car classes)) + (sc-name (car class)) + (constant-name (intern (concatenate 'simple-string + (string sc-name) + "-SC-NUMBER")))) + (list* `(define-storage-class ,sc-name ,index + ,@(cdr class)) + `(defconstant ,constant-name ,index) + `(export ',constant-name) + forms))) (index 0 (1+ index)) (classes classes (cdr classes))) ((null classes) @@ -124,7 +135,7 @@ ;; The non-descriptor stacks. (signed-stack non-descriptor-stack) ; (signed-byte 32) (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32) - (base-char-stack non-descriptor-stack) ; non-descriptor characters. + (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) ; double floats. @@ -142,7 +153,7 @@ registers :locations #.(append non-descriptor-regs descriptor-regs) :reserve-locations #.(append reserve-non-descriptor-regs - reserve-descriptor-regs) + reserve-descriptor-regs) :constant-scs (constant zero immediate) :save-p t :alternate-scs (control-stack)) @@ -156,12 +167,12 @@ :alternate-scs (control-stack)) ;; Non-Descriptor characters - (base-char-reg registers + (character-reg registers :locations #.non-descriptor-regs :reserve-locations #.reserve-non-descriptor-regs :constant-scs (immediate) :save-p t - :alternate-scs (base-char-stack)) + :alternate-scs (character-stack)) ;; Non-Descriptor SAP's (arbitrary pointers into address space) (sap-reg registers @@ -251,28 +262,31 @@ ;;;; Random TNs for interesting registers (macrolet ((defregtn (name sc) - (let ((offset-sym (symbolicate name "-OFFSET")) - (tn-sym (symbolicate name "-TN"))) - `(defparameter ,tn-sym - (make-random-tn :kind :normal - :sc (sc-or-lose ',sc) - :offset ,offset-sym))))) + (let ((offset-sym (symbolicate name "-OFFSET")) + (tn-sym (symbolicate name "-TN"))) + `(defparameter ,tn-sym + (make-random-tn :kind :normal + :sc (sc-or-lose ',sc) + :offset ,offset-sym))))) (defregtn zero any-reg) - (defregtn lip interior-reg) - (defregtn code descriptor-reg) - (defregtn alloc any-reg) - (defregtn null descriptor-reg) - (defregtn nargs any-reg) + (defregtn fdefn descriptor-reg) (defregtn lexenv descriptor-reg) + (defregtn nfp any-reg) + (defregtn ocfp any-reg) + + (defregtn null descriptor-reg) + (defregtn bsp any-reg) - (defregtn csp any-reg) (defregtn cfp any-reg) - (defregtn ocfp any-reg) + (defregtn csp any-reg) + (defregtn alloc any-reg) (defregtn nsp any-reg) - (defregtn nfp any-reg)) + + (defregtn code descriptor-reg) + (defregtn lip interior-reg)) ;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. @@ -284,9 +298,10 @@ (sc-number-or-lose 'null)) (symbol (if (static-symbol-p value) - (sc-number-or-lose 'immediate) - nil)) - ((signed-byte 30) + (sc-number-or-lose 'immediate) + nil)) + ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) + system-area-pointer character) (sc-number-or-lose 'immediate)) (system-area-pointer (sc-number-or-lose 'immediate)) @@ -318,7 +333,7 @@ ;;; ;;; Names to use for the argument registers. -;;; +;;; (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal) ) ; EVAL-WHEN @@ -326,12 +341,12 @@ ;;; A list of TN's describing the register arguments. ;;; -(defparameter register-arg-tns +(defparameter *register-arg-tns* (mapcar #'(lambda (n) - (make-random-tn :kind :normal - :sc (sc-or-lose 'descriptor-reg) - :offset n)) - *register-arg-offsets*)) + (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 8) @@ -341,16 +356,14 @@ (!def-vm-support-routine location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) - (offset (tn-offset tn))) + (offset (tn-offset tn))) (ecase sb (registers (or (svref *register-names* offset) - (format nil "R~D" offset))) + (format nil "R~D" offset))) (float-registers (format nil "F~D" offset)) (control-stack (format nil "CS~D" offset)) (non-descriptor-stack (format nil "NS~D" offset)) (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) -(defun extern-alien-name (name) - (declare (type simple-base-string name)) - name) +