Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
c7bc67be
Commit
c7bc67be
authored
21 years ago
by
toy
Browse files
Options
Downloads
Patches
Plain Diff
Remove some unused code left over from earlier experiments.
parent
fa908129
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
code/alieneval.lisp
+1
-42
1 addition, 42 deletions
code/alieneval.lisp
compiler/sparc/c-call.lisp
+2
-50
2 additions, 50 deletions
compiler/sparc/c-call.lisp
compiler/x86/c-call.lisp
+1
-41
1 addition, 41 deletions
compiler/x86/c-call.lisp
with
4 additions
and
133 deletions
code/alieneval.lisp
+
1
−
42
View file @
c7bc67be
...
...
@@ -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.5
4
2003/05/14 1
3:22:16
toy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.5
5
2003/05/14 1
4: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}*)
...
...
This diff is collapsed.
Click to expand it.
compiler/sparc/c-call.lisp
+
2
−
50
View file @
c7bc67be
...
...
@@ -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.1
7
2003/05/14 1
3:22:17
toy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/c-call.lisp,v 1.1
8
2003/05/14 1
4: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
)
...
...
This diff is collapsed.
Click to expand it.
compiler/x86/c-call.lisp
+
1
−
41
View file @
c7bc67be
...
...
@@ -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.1
3
2003/05/14 1
3:22:17
toy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.1
4
2003/05/14 1
4: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."
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment