Skip to content
Snippets Groups Projects
Commit 8eca8d5b authored by wlott's avatar wlott
Browse files

typo.

parent c926a09c
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/c-call.lisp,v 1.6 1992/03/10 09:39:59 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/c-call.lisp,v 1.7 1992/03/10 12:24:36 wlott Exp $
;;; ;;;
;;; This file contains the VOPs and other necessary machine specific support ;;; This file contains the VOPs and other necessary machine specific support
;;; routines for call-out to C. ;;; routines for call-out to C.
...@@ -31,20 +31,20 @@ ...@@ -31,20 +31,20 @@
(defstruct arg-state (defstruct arg-state
(stack-frame-size 0)) (offset 0))
(defun int-arg (state prim-type stack-sc) (defun int-arg (state prim-type stack-sc)
;; C expects 4 register args and the 5th arg at the top of the stack. ;; C expects 4 register args and the 5th arg at the top of the stack.
;; We can't put args in registers, because we need those registers ;; We can't put args in registers, because we need those registers
;; for something else. So we put them just beyond the end of the ;; for something else. So we put them just beyond the end of the
;; stack and the trampoline code will move them into place. ;; stack and the trampoline code will move them into place.
(let ((frame-size (arg-state-stack-frame-size state))) (let ((frame-size (arg-state-offset state)))
(setf (arg-state-stack-frame-size state) (1+ frame-size)) (setf (arg-state-offset state) (1+ frame-size))
(c-call-wired-tn prim-type stack-sc frame-size))) (c-call-wired-tn prim-type stack-sc frame-size)))
(defun int-result (state prim-type reg-sc) (defun int-result (state prim-type reg-sc)
(let ((reg-num (arg-state-stack-frame-size state))) (let ((reg-num (arg-state-offset state)))
(setf (arg-state-stack-frame-size state) (1+ reg-num)) (setf (arg-state-offset state) (1+ reg-num))
(c-call-wired-tn prim-type reg-sc reg-num))) (c-call-wired-tn prim-type reg-sc reg-num)))
(def-alien-type-method (integer :arg-tn) (type state) (def-alien-type-method (integer :arg-tn) (type state)
...@@ -57,11 +57,11 @@ ...@@ -57,11 +57,11 @@
(int-result state 'signed-byte-32 'signed-reg) (int-result state 'signed-byte-32 'signed-reg)
(int-result state 'unsigned-byte-32 'unsigned-reg))) (int-result state 'unsigned-byte-32 'unsigned-reg)))
(def-alien-type-method (alien::sap :arg-tn) (type state) (def-alien-type-method (sap :arg-tn) (type state)
(declare (ignore type)) (declare (ignore type))
(int-arg state 'system-area-pointer 'sap-stack)) (int-arg state 'system-area-pointer 'sap-stack))
(def-alien-type-method (alien::sap :result-tn) (type state) (def-alien-type-method (sap :result-tn) (type state)
(declare (ignore type)) (declare (ignore type))
(int-result state 'system-area-pointer 'sap-reg)) (int-result state 'system-area-pointer 'sap-reg))
...@@ -77,12 +77,12 @@ ...@@ -77,12 +77,12 @@
(dolist (arg-type (alien-function-type-arg-types type)) (dolist (arg-type (alien-function-type-arg-types type))
(arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state))) (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state)))
(values (c-call-wired-tn 'positive-fixnum 'word-pointer-reg nsp-offset) (values (c-call-wired-tn 'positive-fixnum 'word-pointer-reg nsp-offset)
(* (arg-state-stack-frame-size arg-state) word-bytes) (* (arg-state-offset arg-state) word-bytes)
(arg-tns) (arg-tns)
(invoke-alien-type-method (invoke-alien-type-method
:result-tn :result-tn
(alien-function-type-result-type type) (alien-function-type-result-type type)
(make-arg-state :frame-size nl0-offset)))))) (make-arg-state :offset nl0-offset))))))
;;;; Deftransforms to convert uses of %alien-funcall into cononical form. ;;;; Deftransforms to convert uses of %alien-funcall into cononical form.
...@@ -94,13 +94,13 @@ ...@@ -94,13 +94,13 @@
(arg-types (alien-function-type-arg-types type)) (arg-types (alien-function-type-arg-types type))
(result-type (alien-function-type-result-type type))) (result-type (alien-function-type-result-type type)))
(assert (= (length arg-types) (length args))) (assert (= (length arg-types) (length args)))
(if (some #'alien::alien-double-float-type-p arg-types) (if (some #'alien-double-float-type-p arg-types)
(collect ((new-args) (lambda-vars) (new-arg-types)) (collect ((new-args) (lambda-vars) (new-arg-types))
(dolist (type arg-types) (dolist (type arg-types)
(let ((arg (gensym))) (let ((arg (gensym)))
(lambda-vars arg) (lambda-vars arg)
(typecase type (typecase type
(alien::alien-double-float-type (alien-double-float-type
(new-args `(double-float-high-bits ,arg)) (new-args `(double-float-high-bits ,arg))
(new-args `(double-float-low-bits ,arg)) (new-args `(double-float-low-bits ,arg))
(new-arg-types (parse-alien-type '(signed 32))) (new-arg-types (parse-alien-type '(signed 32)))
...@@ -111,7 +111,7 @@ ...@@ -111,7 +111,7 @@
`(lambda (function type ,@(lambda-vars)) `(lambda (function type ,@(lambda-vars))
(declare (ignore type)) (declare (ignore type))
(%alien-funcall function (%alien-funcall function
',(alien::make-alien-function-type ',(make-alien-function-type
:arg-types (new-arg-types) :arg-types (new-arg-types)
:result-type result-type) :result-type result-type)
,@(new-args)))) ,@(new-args))))
...@@ -128,20 +128,23 @@ ...@@ -128,20 +128,23 @@
(mapcar #'(lambda (x) (declare (ignore x)) (gensym)) (mapcar #'(lambda (x) (declare (ignore x)) (gensym))
arg-types))) arg-types)))
(typecase result-type (typecase result-type
(alien::alien-double-float-type (alien-double-float-type
(let ((arg-names (make-arg-name-list))) (let ((arg-names (make-arg-name-list)))
`(lambda (function type ,@arg-names) `(lambda (function type ,@arg-names)
(declare (ignore type)) (declare (ignore type))
(multiple-value-bind (multiple-value-bind
(hi lo) (hi lo)
(%alien-funcall function (%alien-funcall function
',(parse-alien-type (make-alien-function-type
`(function (values (signed 32) :arg-types arg-types
(unsigned 32)) :result-type
,@arg-types)) (let ((*values-type-okay*))
(parse-alien-type
'(values (signed 32)
(unsigned 32)))))
,@arg-names) ,@arg-names)
(make-double-float hi lo))))) (make-double-float hi lo)))))
(alien::alien-single-float-type (alien-single-float-type
(let ((arg-names (make-arg-name-list))) (let ((arg-names (make-arg-name-list)))
`(lambda (function type ,@arg-names) `(lambda (function type ,@arg-names)
(declare (ignore type)) (declare (ignore type))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment