X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fvm.lisp;h=2782b4d594e99e928bc1d28b5e79bc805b8b1c81;hb=4d7a5bc91750cf24fe0002c5210891846f53351a;hp=bfadc743bd597dadcd1c5ebd22d885300804cdd7;hpb=52cfe54802db8736f1f4e2b67764c43bba9b78b3;p=sbcl.git diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index bfadc74..2782b4d 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -74,14 +74,14 @@ (defreg a3 27) (defreg l0 28) (defreg l1 29) - (defreg l2 30) + (defreg #!-sb-thread l2 #!+sb-thread thread 30) (defreg lip 31) (defregset non-descriptor-regs nl0 nl1 nl2 nl3 nl4 nl5 nl6 #+nil nl7 cfunc nargs nfp) (defregset descriptor-regs - fdefn a0 a1 a2 a3 ocfp lra cname lexenv l0 l1 l2 ) + fdefn a0 a1 a2 a3 ocfp lra cname lexenv l0 l1 #!-sb-thread l2 ) (defregset *register-arg-offsets* a0 a1 a2 a3) @@ -118,7 +118,7 @@ ((null classes) (nreverse forms)))) -(def!constant kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 6) (define-storage-classes @@ -138,19 +138,10 @@ ;; 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). @@ -168,6 +159,20 @@ :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 @@ -256,6 +261,8 @@ (defregtn null descriptor-reg) (defregtn code descriptor-reg) (defregtn alloc any-reg) + (defregtn lra descriptor-reg) + (defregtn lexenv descriptor-reg) (defregtn nargs any-reg) (defregtn bsp any-reg) @@ -273,12 +280,25 @@ (null (sc-number-or-lose 'null)) ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) - system-area-pointer character) + character) (sc-number-or-lose 'immediate)) (symbol (if (static-symbol-p value) (sc-number-or-lose 'immediate) nil)))) + +(!def-vm-support-routine 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)))) + +;;; A predicate to see if a character can be used as an inline +;;; constant (the immediate field in the instruction used is sixteen +;;; bits wide, which is not the same as any defined subtype of +;;; CHARACTER). +(defun inlinable-character-constant-p (char) + (and (characterp char) + (< (char-code char) #x10000))) ;;;; function call parameters @@ -312,6 +332,11 @@ :offset n)) *register-arg-offsets*)) +#!+sb-thread +(defparameter thread-base-tn + (make-random-tn :kind :normal :sc (sc-or-lose 'unsigned-reg) + :offset thread-offset)) + (export 'single-value-return-byte-offset) ;;; This is used by the debugger. @@ -332,3 +357,49 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) +(!def-vm-support-routine combination-implementation-style (node) + (declare (type sb!c::combination node)) + (flet ((valid-funtype (args result) + (sb!c::valid-fun-use node + (sb!c::specifier-type + `(function ,args ,result))))) + (case (sb!c::combination-fun-source-name node) + (logtest + (cond + ((or (valid-funtype '(fixnum fixnum) '*) + (valid-funtype '((signed-byte 32) (signed-byte 32)) '*) + (valid-funtype '((unsigned-byte 32) (unsigned-byte 32)) '*)) + (values :direct nil)) + (t (values :default nil)))) + (logbitp + (cond + ((or (valid-funtype '((constant-arg (integer 0 29)) fixnum) '*) + (valid-funtype '((constant-arg (integer 0 31)) (signed-byte 32)) '*) + (valid-funtype '((constant-arg (integer 0 31)) (unsigned-byte 32)) '*)) + (values :transform '(lambda (index integer) + (%logbitp integer index)))) + (t (values :default nil)))) + ;; FIXME: can handle MIN and MAX here + (sb!kernel:%ldb + (cond + ((or (valid-funtype '((constant-arg (integer 1 29)) + (constant-arg (integer 0 29)) + fixnum) + 'fixnum) + (valid-funtype '((constant-arg (integer 1 29)) + (constant-arg (integer 0 29)) + (signed-byte 32)) + 'fixnum) + (valid-funtype '((constant-arg (integer 1 29)) + (constant-arg (integer 0 29)) + (unsigned-byte 32)) + 'fixnum)) + (values :transform + '(lambda (size posn integer) + (%%ldb integer size posn)))) + (t (values :default nil)))) + (t (values :default nil))))) + +(defun primitive-type-indirect-cell-type (ptype) + (declare (ignore ptype)) + nil)