X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Faliencomp.lisp;h=85f2b1afb3c80bd606f5790348a31cf6b23779a5;hb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;hp=7c2fbc0b6b1fc23b33211b1c046f689ded5a6dbf;hpb=a18f0a95bc9a457e4d2d00c702b746f29c2662b1;p=sbcl.git diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index 7c2fbc0..85f2b1a 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -68,7 +68,6 @@ (defknown alien-funcall (alien-value &rest *) * (any recursive)) -(defknown %alien-funcall (system-area-pointer alien-type &rest *) *) ;;;; cosmetic transforms @@ -157,7 +156,7 @@ (multiple-value-bind (slot-offset slot-type) (find-slot-offset-and-type alien slot) (/noshow "in DEFTRANSFORM %SLOT-ADDR, creating %SAP-ALIEN") - `(%sap-alien (sap+ (alien-sap alien) (/ ,slot-offset sb!vm:byte-bits)) + `(%sap-alien (sap+ (alien-sap alien) (/ ,slot-offset sb!vm:n-byte-bits)) ',(make-alien-pointer-type :to slot-type)))) ;;;; DEREF support @@ -186,7 +185,7 @@ (typecase alien-type (alien-pointer-type (when (cdr indices) - (abort-ir1-transform "too many indices for pointer deref: ~D" + (abort-ir1-transform "too many indices for pointer deref: ~W" (length indices))) (let ((element-type (alien-pointer-type-to alien-type))) (if indices @@ -280,7 +279,7 @@ (compute-deref-guts alien indices) (/noshow "in DEFTRANSFORM %DEREF-ADDR, creating (LAMBDA .. %SAP-ALIEN)") `(lambda (alien ,@indices-args) - (%sap-alien (sap+ (alien-sap alien) (/ ,offset-expr sb!vm:byte-bits)) + (%sap-alien (sap+ (alien-sap alien) (/ ,offset-expr sb!vm:n-byte-bits)) ',(make-alien-pointer-type :to element-type))))) ;;;; support for aliens on the heap @@ -350,11 +349,11 @@ #!+x86 `(truly-the system-area-pointer (%primitive alloc-alien-stack-space ,(ceiling (alien-type-bits alien-type) - sb!vm:byte-bits))) + sb!vm:n-byte-bits))) #!-x86 `(truly-the system-area-pointer (%primitive alloc-number-stack-space ,(ceiling (alien-type-bits alien-type) - sb!vm:byte-bits))) + sb!vm:n-byte-bits))) (let* ((alien-rep-type-spec (compute-alien-rep-type alien-type)) (alien-rep-type (specifier-type alien-rep-type-spec))) (cond ((csubtypep (specifier-type 'system-area-pointer) @@ -437,10 +436,10 @@ (if (local-alien-info-force-to-memory-p info) #!+x86 `(%primitive dealloc-alien-stack-space ,(ceiling (alien-type-bits alien-type) - sb!vm:byte-bits)) + sb!vm:n-byte-bits)) #!-x86 `(%primitive dealloc-number-stack-space ,(ceiling (alien-type-bits alien-type) - sb!vm:byte-bits)) + sb!vm:n-byte-bits)) nil))) ;;;; %CAST @@ -459,7 +458,7 @@ (let ((target-type (continuation-value target-type))) (cond ((or (alien-pointer-type-p target-type) (alien-array-type-p target-type) - (alien-function-type-p target-type)) + (alien-fun-type-p target-type)) `(naturalize (alien-sap alien) ',target-type)) (t (abort-ir1-transform "cannot cast to alien type ~S" target-type))))) @@ -470,7 +469,7 @@ (let ((alien-node (continuation-use alien))) (typecase alien-node (combination - (extract-function-args alien '%sap-alien 2) + (extract-fun-args alien '%sap-alien 2) '(lambda (sap type) (declare (ignore type)) sap)) @@ -521,7 +520,7 @@ (count-low-order-zeros (continuation-value thing)) (count-low-order-zeros (continuation-use thing)))) (combination - (case (continuation-function-name (combination-fun thing)) + (case (continuation-fun-name (combination-fun thing)) ((+ -) (let ((min most-positive-fixnum) (itype (specifier-type 'integer))) @@ -572,7 +571,7 @@ (deftransform ash ((value amount)) (let ((value-node (continuation-use value))) (unless (and (combination-p value-node) - (eq (continuation-function-name (combination-fun value-node)) + (eq (continuation-fun-name (combination-fun value-node)) 'ash)) (give-up-ir1-transform)) (let ((inside-args (combination-args value-node))) @@ -582,7 +581,7 @@ (unless (and (constant-continuation-p inside-amount) (not (minusp (continuation-value inside-amount)))) (give-up-ir1-transform))))) - (extract-function-args value 'ash 2) + (extract-fun-args value 'ash 2) '(lambda (value amount1 amount2) (ash value (+ amount1 amount2)))) @@ -602,12 +601,12 @@ (give-up-ir1-transform "can't tell function type at compile time")) (/noshow "entering second DEFTRANSFORM ALIEN-FUNCALL" function) (let ((alien-type (alien-type-type-alien-type type))) - (unless (alien-function-type-p alien-type) + (unless (alien-fun-type-p alien-type) (give-up-ir1-transform)) - (let ((arg-types (alien-function-type-arg-types alien-type))) + (let ((arg-types (alien-fun-type-arg-types alien-type))) (unless (= (length args) (length arg-types)) (abort-ir1-transform - "wrong number of arguments; expected ~D, got ~D" + "wrong number of arguments; expected ~W, got ~W" (length arg-types) (length args))) (collect ((params) (deports)) @@ -615,7 +614,7 @@ (let ((param (gensym))) (params param) (deports `(deport ,param ',arg-type)))) - (let ((return-type (alien-function-type-result-type alien-type)) + (let ((return-type (alien-fun-type-result-type alien-type)) (body `(%alien-funcall (deport function ',alien-type) ',alien-type ,@(deports)))) @@ -638,11 +637,11 @@ (unless (constant-continuation-p type) (error "Something is broken.")) (let ((type (continuation-value type))) - (unless (alien-function-type-p type) + (unless (alien-fun-type-p type) (error "Something is broken.")) (specifier-type (compute-alien-rep-type - (alien-function-type-result-type type))))) + (alien-fun-type-result-type type))))) (defoptimizer (%alien-funcall ltn-annotate) ((function type &rest args) node ltn-policy)