0.7.1.32:

[sbcl.git] / src / compiler / x86 / c-call.lisp

diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp
index a30c30c..ca820a6 100644 (file)
--- a/src/compiler/x86/c-call.lisp
+++ b/src/compiler/x86/c-call.lisp
@@ -12,7 +12,7 @@
 
 (in-package "SB!VM")
 
-;; The move-argument vop is going to store args on the stack for
+;; The MOVE-ARG vop is going to store args on the stack for
 ;; call-out. These tn's will be used for that. move-arg is normally
 ;; used for things going down the stack but C wants to have args
 ;; indexed in the positive direction.
@@ -22,10 +22,10 @@
                 (sc-number-or-lose sc-name)
                 offset))
 
-(defstruct arg-state
+(defstruct (arg-state (:copier nil))
   (stack-frame-size 0))
 
-(def-alien-type-method (integer :arg-tn) (type state)
+(define-alien-type-method (integer :arg-tn) (type state)
   (let ((stack-frame-size (arg-state-stack-frame-size state)))
     (setf (arg-state-stack-frame-size state) (1+ stack-frame-size))
     (multiple-value-bind (ptype stack-sc)
@@ -34,7 +34,7 @@
            (values 'unsigned-byte-32 'unsigned-stack))
       (my-make-wired-tn ptype stack-sc stack-frame-size))))
 
-(def-alien-type-method (system-area-pointer :arg-tn) (type state)
+(define-alien-type-method (system-area-pointer :arg-tn) (type state)
   (declare (ignore type))
   (let ((stack-frame-size (arg-state-stack-frame-size state)))
     (setf (arg-state-stack-frame-size state) (1+ stack-frame-size))
@@ -43,25 +43,25 @@
                      stack-frame-size)))
 
 #!+long-float
-(def-alien-type-method (long-float :arg-tn) (type state)
+(define-alien-type-method (long-float :arg-tn) (type state)
   (declare (ignore type))
   (let ((stack-frame-size (arg-state-stack-frame-size state)))
     (setf (arg-state-stack-frame-size state) (+ stack-frame-size 3))
     (my-make-wired-tn 'long-float 'long-stack stack-frame-size)))
 
-(def-alien-type-method (double-float :arg-tn) (type state)
+(define-alien-type-method (double-float :arg-tn) (type state)
   (declare (ignore type))
   (let ((stack-frame-size (arg-state-stack-frame-size state)))
     (setf (arg-state-stack-frame-size state) (+ stack-frame-size 2))
     (my-make-wired-tn 'double-float 'double-stack stack-frame-size)))
 
-(def-alien-type-method (single-float :arg-tn) (type state)
+(define-alien-type-method (single-float :arg-tn) (type state)
   (declare (ignore type))
   (let ((stack-frame-size (arg-state-stack-frame-size state)))
     (setf (arg-state-stack-frame-size state) (1+ stack-frame-size))
     (my-make-wired-tn 'single-float 'single-stack stack-frame-size)))
 
-(defstruct result-state
+(defstruct (result-state (:copier nil))
   (num-results 0))
 
 (defun result-reg-offset (slot)
@@ -69,7 +69,7 @@
     (0 eax-offset)
     (1 edx-offset)))
 
-(def-alien-type-method (integer :result-tn) (type state)
+(define-alien-type-method (integer :result-tn) (type state)
   (let ((num-results (result-state-num-results state)))
     (setf (result-state-num-results state) (1+ num-results))
     (multiple-value-bind (ptype reg-sc)
@@ -78,7 +78,7 @@
            (values 'unsigned-byte-32 'unsigned-reg))
       (my-make-wired-tn ptype reg-sc (result-reg-offset num-results)))))
 
-(def-alien-type-method (system-area-pointer :result-tn) (type state)
+(define-alien-type-method (system-area-pointer :result-tn) (type state)
   (declare (ignore type))
   (let ((num-results (result-state-num-results state)))
     (setf (result-state-num-results state) (1+ num-results))
@@ -86,50 +86,50 @@
                      (result-reg-offset num-results))))
 
 #!+long-float
-(def-alien-type-method (long-float :result-tn) (type state)
+(define-alien-type-method (long-float :result-tn) (type state)
   (declare (ignore type))
   (let ((num-results (result-state-num-results state)))
     (setf (result-state-num-results state) (1+ num-results))
     (my-make-wired-tn 'long-float 'long-reg (* num-results 2))))
 
-(def-alien-type-method (double-float :result-tn) (type state)
+(define-alien-type-method (double-float :result-tn) (type state)
   (declare (ignore type))
   (let ((num-results (result-state-num-results state)))
     (setf (result-state-num-results state) (1+ num-results))
     (my-make-wired-tn 'double-float 'double-reg (* num-results 2))))
 
-(def-alien-type-method (single-float :result-tn) (type state)
+(define-alien-type-method (single-float :result-tn) (type state)
   (declare (ignore type))
   (let ((num-results (result-state-num-results state)))
     (setf (result-state-num-results state) (1+ num-results))
     (my-make-wired-tn 'single-float 'single-reg (* num-results 2))))
 
 #+nil ;;pfw obsolete now?
-(def-alien-type-method (values :result-tn) (type state)
-  (mapcar #'(lambda (type)
-             (invoke-alien-type-method :result-tn type state))
+(define-alien-type-method (values :result-tn) (type state)
+  (mapcar (lambda (type)
+           (invoke-alien-type-method :result-tn type state))
          (alien-values-type-values type)))
 
 ;;; pfw - from alpha
-(def-alien-type-method (values :result-tn) (type state)
+(define-alien-type-method (values :result-tn) (type state)
   (let ((values (alien-values-type-values type)))
     (when (cdr values)
       (error "Too many result values from c-call."))
     (when values
       (invoke-alien-type-method :result-tn (car values) state))))
 
-(def-vm-support-routine make-call-out-tns (type)
+(!def-vm-support-routine make-call-out-tns (type)
   (let ((arg-state (make-arg-state)))
     (collect ((arg-tns))
       (dolist #+nil ;; this reversed list seems to cause the alien botches!!
-       (arg-type (reverse (alien-function-type-arg-types type)))
-       (arg-type (alien-function-type-arg-types type))
+       (arg-type (reverse (alien-fun-type-arg-types type)))
+       (arg-type (alien-fun-type-arg-types type))
        (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state)))
       (values (my-make-wired-tn 'positive-fixnum 'any-reg esp-offset)
-             (* (arg-state-stack-frame-size arg-state) word-bytes)
+             (* (arg-state-stack-frame-size arg-state) n-word-bytes)
              (arg-tns)
              (invoke-alien-type-method :result-tn
-                                       (alien-function-type-result-type type)
+                                       (alien-fun-type-result-type type)
                                        (make-result-state))))))
 
 (define-vop (foreign-symbol-address)
@@ -194,7 +194,7 @@
   (:info amount)
   (:results (result :scs (sap-reg any-reg)))
   (:generator 0
-    (assert (location= result esp-tn))
+    (aver (location= result esp-tn))
     (unless (zerop amount)
       (let ((delta (logandc2 (+ amount 3) 3)))
        (inst sub esp-tn delta)))
@@ -211,14 +211,14 @@
   (:info amount)
   (:results (result :scs (sap-reg any-reg)))
   (:generator 0
-    (assert (not (location= result esp-tn)))
+    (aver (not (location= result esp-tn)))
     (unless (zerop amount)
       (let ((delta (logandc2 (+ amount 3) 3)))
        (inst sub (make-ea :dword
                           :disp (+ nil-value
                                    (static-symbol-offset '*alien-stack*)
                                    (ash symbol-value-slot word-shift)
-                                   (- other-pointer-type)))
+                                   (- other-pointer-lowtag)))
              delta)))
     (load-symbol-value result *alien-stack*)))
 
@@ -231,5 +231,5 @@
                           :disp (+ nil-value
                                    (static-symbol-offset '*alien-stack*)
                                    (ash symbol-value-slot word-shift)
-                                   (- other-pointer-type)))
+                                   (- other-pointer-lowtag)))
              delta)))))