From c7bc67be8b1d08acf6e32dc6655b67012e0a111f Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Wed, 14 May 2003 14:38:39 +0000 Subject: [PATCH] Remove some unused code left over from earlier experiments. --- code/alieneval.lisp | 43 +------------------------------ compiler/sparc/c-call.lisp | 52 ++------------------------------------ compiler/x86/c-call.lisp | 42 +----------------------------- 3 files changed, 4 insertions(+), 133 deletions(-) diff --git a/code/alieneval.lisp b/code/alieneval.lisp index f658f9390..ac1fc87aa 100644 --- a/code/alieneval.lisp +++ b/code/alieneval.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.54 2003/05/14 13:22:16 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.55 2003/05/14 14:38:38 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2139,10 +2139,6 @@ incompatible redefinitions." (vector-push-extend cb *callbacks*) cb)) -#+nil -(defun address-of-call-into-lisp () - (sys:sap-int (alien-sap (extern-alien "call_into_lisp" (function (* t)))))) - (defun address-of-call-callback () (kernel:get-lisp-obj-address #'call-callback)) @@ -2263,43 +2259,6 @@ Create new trampoline (old trampoline calls old lisp function)."))) (store spec)) (t (error "Unsupported return type: ~A" spec)))))) -#+nil -(defmacro def-callback (name (return-type &rest arg-specs) &body body) - "(defcallback NAME (RETURN-TYPE {(ARG-NAME ARG-TYPE)}*) {FORM}*) - -Define a function which can be called by foreign code. The pointer -returned by (callback NAME), when called by foreign code, invokes the -lisp function. The lisp function expects alien arguments of the -specified ARG-TYPEs and returns an alien of type RETURN-TYPE. - -If (callback NAME) is already a callback function pointer, its value -is not changed (though it's arranged that an updated version of the -lisp callback function will be called). This feature allows for -incremental redefinition of callback functions." - (let ((sp-fixnum (gensym (string :sp-fixnum))) - (ret-addr (gensym (string :ret-addr))) - (sp (gensym (string :sp)))) - `(progn - (defun ,name (,sp-fixnum ,ret-addr) - (declare (type fixnum ,sp-fixnum) - (type fixnum ,ret-addr)) - ;; We assume sp-fixnum is word aligned and pass it untagged to - ;; this function. The shift compensates this. - (let ((,sp (sys:int-sap (ldb (byte vm:word-bits 0) (ash ,sp-fixnum 2))))) - (declare (ignorable ,sp)) - ;; Copy all arguments to local variables. - (with-alien ,(loop for offset = 0 then (+ offset - (argument-size type)) - for (name type) in arg-specs - collect `(,name ,type - :local (deref (sap-alien - (sys:sap+ ,sp ,offset) - (* ,type))))) - ,(return-exp return-type `(sys:sap+ ,ret-addr 0) `(progn ,@body)) - (values)))) - (define-callback-function - ',name #',name ',(parse-return-type return-type))))) - (defmacro def-callback (name (return-type &rest arg-specs) &body body) "(defcallback NAME (RETURN-TYPE {(ARG-NAME ARG-TYPE)}*) {FORM}*) diff --git a/compiler/sparc/c-call.lisp b/compiler/sparc/c-call.lisp index 2188ce470..a85a93ba4 100644 --- a/compiler/sparc/c-call.lisp +++ b/compiler/sparc/c-call.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/c-call.lisp,v 1.17 2003/05/14 13:22:17 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/c-call.lisp,v 1.18 2003/05/14 14:38:39 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -288,18 +288,6 @@ ;;; Support for callbacks to Lisp. (export '(make-callback-trampoline callback-accessor-form)) -#+nil -(defun compute-accessor (type sp offset) - (cond ((eq type 'double) - ;; Due to sparc calling conventions, a double doesn't have to - ;; be aligned on a double word boundary. We have to get the - ;; two words separately and create the double from them. - `(kernel:make-double-float (alien:deref (sap-alien (sys:sap+ ,sp ,offset) (* int))) - (alien:deref (sap-alien (sys:sap+ ,sp (+ ,offset 4)) - (* c-call:unsigned-int))))) - (t - `(deref (sap-alien (sys:sap+ ,sp ,offset) (* ,type)))))) - (defun callback-accessor-form (type sp offset) (cond ((eq type 'double) ;; Due to sparc calling conventions, a double doesn't have to @@ -311,42 +299,6 @@ (t `(deref (sap-alien (sys:sap+ ,sp ,offset) (* ,type)))))) -#+nil -(defmacro def-callback (name (return-type &rest arg-specs) &body body) - "(defcallback NAME (RETURN-TYPE {(ARG-NAME ARG-TYPE)}*) {FORM}*) - -Define a function which can be called by foreign code. The pointer -returned by (callback NAME), when called by foreign code, invokes the -lisp function. The lisp function expects alien arguments of the -specified ARG-TYPEs and returns an alien of type RETURN-TYPE. - -If (callback NAME) is already a callback function pointer, its value -is not changed (though it's arranged that an updated version of the -lisp callback function will be called). This feature allows for -incremental redefinition of callback functions." - (let ((sp-fixnum (gensym (string :sp-fixnum-))) - (ret-addr (gensym (string :ret-addr-))) - (sp (gensym (string :sp-))) - (ret (gensym (string :ret-)))) - `(progn - (defun ,name (,sp-fixnum ,ret-addr) - (declare (type fixnum ,sp-fixnum ,ret-addr)) - ;; We assume sp-fixnum is word aligned and pass it untagged to - ;; this function. The shift compensates this. - (let ((,sp (sys:int-sap (ldb (byte vm:word-bits 0) (ash ,sp-fixnum 2)))) - (,ret (sys:int-sap (ldb (byte vm:word-bits 0) (ash ,ret-addr 2))))) - (declare (ignorable ,sp)) - ;; Copy all arguments to local variables. - (with-alien ,(loop for offset = 0 then (+ offset - (alien::argument-size type)) - for (name type) in arg-specs - collect `(,name ,type - :local ,(compute-accessor type sp offset))) - ,(alien::return-exp return-type `(sys:sap+ ,ret 0) `(progn ,@body)) - (values)))) - (alien::define-callback-function - ',name #',name ',(alien::parse-return-type return-type))))) - (defun make-callback-trampoline (index return-type) "Cons up a piece of code which calls call-callback with INDEX and a pointer to the arguments." @@ -386,7 +338,7 @@ pointer to the arguments." (%i3 (def-reg-tn vm::nfp-offset)) (%i4 (def-reg-tn vm::cfunc-offset)) (%i5 (def-reg-tn vm::code-offset)) - (%fp (def-reg-tn 30 #+nil vm::fp-offset)) + (%fp (def-reg-tn 30)) (%i7 (def-reg-tn vm::lip-offset)) (f0-s (c:make-random-tn :kind :normal :sc (c:sc-or-lose 'vm::single-reg) diff --git a/compiler/x86/c-call.lisp b/compiler/x86/c-call.lisp index 1783b423d..276d61c70 100644 --- a/compiler/x86/c-call.lisp +++ b/compiler/x86/c-call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.13 2003/05/14 13:22:17 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.14 2003/05/14 14:38:39 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -308,46 +308,6 @@ (sys:sap+ ,sp ,offset) (* ,type)))) -#+nil -(defmacro def-callback (name (return-type &rest arg-specs) &body body) - "(defcallback NAME (RETURN-TYPE {(ARG-NAME ARG-TYPE)}*) {FORM}*) - -Define a function which can be called by foreign code. The pointer -returned by (callback NAME), when called by foreign code, invokes the -lisp function. The lisp function expects alien arguments of the -specified ARG-TYPEs and returns an alien of type RETURN-TYPE. - -If (callback NAME) is already a callback function pointer, its value -is not changed (though it's arranged that an updated version of the -lisp callback function will be called). This feature allows for -incremental redefinition of callback functions." - (let ((sp-fixnum (gensym (string :sp-fixnum-))) - (ret-addr (gensym (string :ret-addr-))) - (sp (gensym (string :sp-))) - (ret (gensym (string :ret-)))) - `(progn - (defun ,name (,sp-fixnum ,ret-addr) - (declare (type fixnum ,sp-fixnum) - (type fixnum ,ret-addr)) - ;; We assume sp-fixnum is word aligned and pass it untagged to - ;; this function. The shift compensates this. - (let ((,sp (sys:int-sap (ldb (byte vm:word-bits 0) (ash ,sp-fixnum 2)))) - (,ret (sys:int-sap (ldb (byte vm:word-bits 0) (ash ,ret-addr 2))))) - (declare (ignorable ,sp)) - ;; Copy all arguments to local variables. - (with-alien ,(loop for offset = 0 then (+ offset - (alien::argument-size type)) - for (name type) in arg-specs - collect `(,name ,type - :local (alien:deref (sap-alien - (sys:sap+ ,sp ,offset) - (* ,type))))) - ,(alien::return-exp return-type `(sys:sap+ ,ret 0) `(progn ,@body)) - (values)))) - (alien::define-callback-function - ',name #',name ',(alien::parse-return-type return-type))))) - - (defun make-callback-trampoline (index return-type) "Cons up a piece of code which calls call-callback with INDEX and a pointer to the arguments." -- GitLab