- changed foreign accessors and mutator names to have '-c-' in their
names as suggested by Ken Dickey.
This commit is contained in:
Abdulaziz Ghuloum
parent
811c94361b
commit
1be0f2af6e
|
|
@ -18,5 +18,8 @@ all:
|
|||
|
||||
docs: ikarus-scheme-users-guide.pdf
|
||||
|
||||
fast:
|
||||
$(TEX) ikarus-scheme-users-guide
|
||||
|
||||
clean:
|
||||
rm -f *.aux *.log *.toc *.out *.idx *.ind *.ilg *.blg *.bbl
|
||||
|
|
|
|||
|
|
@ -352,6 +352,9 @@ all:
|
|||
|
||||
docs: ikarus-scheme-users-guide.pdf
|
||||
|
||||
fast:
|
||||
$(TEX) ikarus-scheme-users-guide
|
||||
|
||||
clean:
|
||||
rm -f *.aux *.log *.toc *.out *.idx *.ind *.ilg *.blg *.bbl
|
||||
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -2242,10 +2242,10 @@ unspecified.}
|
|||
|
||||
\newpage
|
||||
|
||||
\defun{pointer-set-char}{procedure}
|
||||
\texttt{(pointer-set-char p i n)}
|
||||
\defun{pointer-set-c-char!}{procedure}
|
||||
\texttt{(pointer-set-c-char! p i n)}
|
||||
|
||||
The procedure \texttt{pointer-set-char} sets a single byte of memory
|
||||
The procedure \texttt{pointer-set-c-char!} sets a single byte of memory
|
||||
located at offset \texttt{i} from the pointer \texttt{p} to the
|
||||
value of \texttt{n}. The pointer \texttt{p} must be a valid
|
||||
pointer. The index \texttt{i} must be an exact integer. The value
|
||||
|
|
@ -2253,186 +2253,186 @@ of \texttt{n} must be an exact integer. Only the 8 lowermost
|
|||
bits of \texttt{n} are used in the operation and the remaining bits
|
||||
are ignored.
|
||||
|
||||
\defun{pointer-set-short}{procedure}
|
||||
\texttt{(pointer-set-short p i n)}
|
||||
\defun{pointer-set-c-short!}{procedure}
|
||||
\texttt{(pointer-set-c-short! p i n)}
|
||||
|
||||
The procedure \texttt{pointer-set-char} sets two bytes located at
|
||||
The procedure \texttt{pointer-set-c-char!!} sets two bytes located at
|
||||
offset \texttt{i} and \texttt{(+ i 1)} to the 16 lowermost bits of
|
||||
the exact integer \texttt{n}. Note that the offset \texttt{i} is a
|
||||
byte offset; \texttt{pointer-set-short} does not perform any pointer
|
||||
byte offset; \texttt{pointer-set-c-short!} does not perform any pointer
|
||||
arithmetic such as scaling the offset by the size of the memory
|
||||
location.
|
||||
|
||||
|
||||
\defun{pointer-set-int}{procedure}
|
||||
\texttt{(pointer-set-int p i n)}
|
||||
\defun{pointer-set-c-int!}{procedure}
|
||||
\texttt{(pointer-set-c-int! p i n)}
|
||||
|
||||
The procedure \texttt{pointer-set-int} sets four bytes located at
|
||||
The procedure \texttt{pointer-set-c-int!} sets four bytes located at
|
||||
offset \texttt{i} to \texttt{(+ i 3)} to the 32 lowermost bits of
|
||||
the exact integer \texttt{n}. Like \texttt{pointer-set-short},
|
||||
\texttt{pointer-set-int} does not scale the offset \texttt{i}.
|
||||
the exact integer \texttt{n}. Like \texttt{pointer-set-c-short!},
|
||||
\texttt{pointer-set-c-int!} does not scale the offset \texttt{i}.
|
||||
|
||||
|
||||
\defun{pointer-set-long}{procedure}
|
||||
\texttt{(pointer-set-long p i n)}
|
||||
\defun{pointer-set-c-long!}{procedure}
|
||||
\texttt{(pointer-set-c-long! p i n)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-set-long} sets
|
||||
On 64-bit systems, the procedure \texttt{pointer-set-c-long!} sets
|
||||
eight bytes located at offset \texttt{i} to \texttt{(+ i 7)} to the
|
||||
64 lowermost bits of the exact integer \texttt{n}. Like the
|
||||
previous procedures, \texttt{pointer-set-long} does not scale the
|
||||
offset \texttt{i}. On 32-bit systems, \texttt{pointer-set-long}
|
||||
performs the same task as \texttt{pointer-set-int}.
|
||||
previous procedures, \texttt{pointer-set-c-long!} does not scale the
|
||||
offset \texttt{i}. On 32-bit systems, \texttt{pointer-set-c-long!}
|
||||
performs the same task as \texttt{pointer-set-c-int!}.
|
||||
|
||||
|
||||
\defun{pointer-set-float}{procedure}
|
||||
\texttt{(pointer-set-float p i fl)}
|
||||
\defun{pointer-set-c-float!}{procedure}
|
||||
\texttt{(pointer-set-c-float! p i fl)}
|
||||
|
||||
The procedure \texttt{pointer-set-float} converts the Scheme
|
||||
The procedure \texttt{pointer-set-c-float!} converts the Scheme
|
||||
floating point number \texttt{fl} (represented in Ikarus as an
|
||||
IEEE-754 double precision floating point number) to a float (an
|
||||
IEEE-754 single precision floating point number) and stores the
|
||||
result in the four bytes at offset \texttt{i} of the pointer
|
||||
\texttt{p}.
|
||||
|
||||
\defun{pointer-set-double}{procedure}
|
||||
\texttt{(pointer-set-double p i fl)}
|
||||
\defun{pointer-set-c-double!}{procedure}
|
||||
\texttt{(pointer-set-c-double! p i fl)}
|
||||
|
||||
The procedure \texttt{pointer-set-double} stores the double
|
||||
The procedure \texttt{pointer-set-c-double!} stores the double
|
||||
precision IEEE-754 floating point value of the Scheme flonum
|
||||
\texttt{fl} in the eight bytes at offset \texttt{i} of the pointer
|
||||
\texttt{p}.
|
||||
|
||||
\defun{pointer-set-pointer}{procedure}
|
||||
\texttt{(pointer-set-pointer p i pv)}
|
||||
\defun{pointer-set-c-pointer!}{procedure}
|
||||
\texttt{(pointer-set-c-pointer! p i pv)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-set-pointer} sets
|
||||
On 64-bit systems, the procedure \texttt{pointer-set-c-pointer!} sets
|
||||
eight bytes located at offset \texttt{i} to \texttt{(+ i 7)} to the
|
||||
64-bit pointer value of \texttt{pv}. On 32-bit systems, the
|
||||
procedure \texttt{pointer-set-pointer} sets four bytes located at
|
||||
procedure \texttt{pointer-set-c-pointer!} sets four bytes located at
|
||||
offset \texttt{i} to \texttt{(+ i 3)} to the 32-bit pointer value of
|
||||
\texttt{pv}. Like the previous procedures,
|
||||
\texttt{pointer-set-pointer} does not scale the offset \texttt{i}.
|
||||
\texttt{pointer-set-c-pointer!} does not scale the offset \texttt{i}.
|
||||
|
||||
|
||||
|
||||
\defun{pointer-ref-signed-char}{procedure}
|
||||
\texttt{(pointer-ref-signed-char p i)}
|
||||
\defun{pointer-ref-c-signed-char}{procedure}
|
||||
\texttt{(pointer-ref-c-signed-char p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-signed-char} loads a single byte located
|
||||
The procedure \texttt{pointer-ref-c-signed-char} loads a single byte located
|
||||
at offset \texttt{i} from the pointer \texttt{p} and returns an
|
||||
exact integer representing the sign-extended integer value of that
|
||||
byte. The resulting value is in the range of $[-128, 127]$ inclusive.
|
||||
|
||||
\defun{pointer-ref-unsigned-char}{procedure}
|
||||
\texttt{(pointer-ref-unsigned-char p i)}
|
||||
\defun{pointer-ref-c-unsigned-char}{procedure}
|
||||
\texttt{(pointer-ref-c-unsigned-char p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-unsigned-char} loads a single byte
|
||||
The procedure \texttt{pointer-ref-c-unsigned-char} loads a single byte
|
||||
located at offset \texttt{i} from the pointer \texttt{p} and returns
|
||||
an exact integer representing the unsigned integer value of that
|
||||
byte. The resulting value is in the range $[0, 255]$ inclusive.
|
||||
|
||||
|
||||
The following example shows the difference between
|
||||
\texttt{pointer-ref-signed-char} and
|
||||
\texttt{pointer-ref-unsigned-char}.
|
||||
\texttt{pointer-ref-c-signed-char} and
|
||||
\texttt{pointer-ref-c-unsigned-char}.
|
||||
|
||||
|
||||
\begin{verbatim}
|
||||
> (let ([p (malloc 3)])
|
||||
(pointer-set-char p 0 #b01111111)
|
||||
(pointer-set-char p 1 #b10000000)
|
||||
(pointer-set-char p 2 #b11111111)
|
||||
(pointer-set-c-char! p 0 #b01111111)
|
||||
(pointer-set-c-char! p 1 #b10000000)
|
||||
(pointer-set-c-char! p 2 #b11111111)
|
||||
(let ([result
|
||||
(list (pointer-ref-signed-char p 0)
|
||||
(pointer-ref-signed-char p 1)
|
||||
(pointer-ref-signed-char p 2)
|
||||
(pointer-ref-unsigned-char p 0)
|
||||
(pointer-ref-unsigned-char p 1)
|
||||
(pointer-ref-unsigned-char p 2))])
|
||||
(list (pointer-ref-c-signed-char p 0)
|
||||
(pointer-ref-c-signed-char p 1)
|
||||
(pointer-ref-c-signed-char p 2)
|
||||
(pointer-ref-c-unsigned-char p 0)
|
||||
(pointer-ref-c-unsigned-char p 1)
|
||||
(pointer-ref-c-unsigned-char p 2))])
|
||||
(free p)
|
||||
result))
|
||||
(127 -128 -1 127 128 255)
|
||||
\end{verbatim}
|
||||
|
||||
\defun{pointer-ref-signed-short}{procedure}
|
||||
\texttt{(pointer-ref-signed-short p i)}
|
||||
\defun{pointer-ref-c-signed-short}{procedure}
|
||||
\texttt{(pointer-ref-c-signed-short p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-signed-short} loads two bytes
|
||||
The procedure \texttt{pointer-ref-c-signed-short} loads two bytes
|
||||
located at offsets \texttt{i} and \texttt{(+ i 1)} from the pointer
|
||||
\texttt{p} and returns an exact integer representing the
|
||||
sign-extended
|
||||
integer value of the sequence. The resulting value is in the range
|
||||
$[-32768, 32767]$ inclusive.
|
||||
|
||||
\defun{pointer-ref-unsigned-short}{procedure}
|
||||
\texttt{(pointer-ref-unsigned-short p i)}
|
||||
\defun{pointer-ref-c-unsigned-short}{procedure}
|
||||
\texttt{(pointer-ref-c-unsigned-short p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-unsigned-short} loads two bytes
|
||||
The procedure \texttt{pointer-ref-c-unsigned-short} loads two bytes
|
||||
located at offsets \texttt{i} and \texttt{(+ i 1)} from the pointer
|
||||
\texttt{p} and returns an exact integer representing the unsigned
|
||||
integer value of the sequence. The resulting value is in the range
|
||||
$[0, 65535]$ inclusive.
|
||||
|
||||
\newpage
|
||||
\defun{pointer-ref-signed-int}{procedure}
|
||||
\texttt{(pointer-ref-signed-int p i)}
|
||||
\defun{pointer-ref-c-signed-int}{procedure}
|
||||
\texttt{(pointer-ref-c-signed-int p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-signed-int} loads four bytes
|
||||
The procedure \texttt{pointer-ref-c-signed-int} loads four bytes
|
||||
starting at offset \texttt{i} of pointer \texttt{p} and returns an
|
||||
exact integer in the range of $[-2^{31},2^{31}-1]$ inclusive.
|
||||
|
||||
|
||||
\defun{pointer-ref-unsigned-int}{procedure}
|
||||
\texttt{(pointer-ref-unsigned-int p i)}
|
||||
\defun{pointer-ref-c-unsigned-int}{procedure}
|
||||
\texttt{(pointer-ref-c-unsigned-int p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-unsigned-int} loads four bytes
|
||||
The procedure \texttt{pointer-ref-c-unsigned-int} loads four bytes
|
||||
starting at offset \texttt{i} of pointer \texttt{p} and returns an
|
||||
exact integer in the range of $[0,2^{32}-1]$ inclusive.
|
||||
|
||||
|
||||
\defun{pointer-ref-signed-long}{procedure}
|
||||
\texttt{(pointer-ref-signed-long p i)}
|
||||
\defun{pointer-ref-c-signed-long}{procedure}
|
||||
\texttt{(pointer-ref-c-signed-long p i)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-ref-signed-long}
|
||||
On 64-bit systems, the procedure \texttt{pointer-ref-c-signed-long}
|
||||
loads eight bytes starting at offset \texttt{i} of pointer
|
||||
\texttt{p} and returns an integer in the range of
|
||||
$[-2^{63},2^{63}-1]$ inclusive. On 32-bit systems, the procedure
|
||||
\texttt{pointer-ref-signed-long} performs the same task as
|
||||
\texttt{pointer-ref-signed-int}.
|
||||
\texttt{pointer-ref-c-signed-long} performs the same task as
|
||||
\texttt{pointer-ref-c-signed-int}.
|
||||
|
||||
|
||||
\defun{pointer-ref-unsigned-long}{procedure}
|
||||
\texttt{(pointer-ref-unsigned-long p i)}
|
||||
\defun{pointer-ref-c-unsigned-long}{procedure}
|
||||
\texttt{(pointer-ref-c-unsigned-long p i)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-ref-unsigned-long}
|
||||
On 64-bit systems, the procedure \texttt{pointer-ref-c-unsigned-long}
|
||||
loads eight bytes starting at offset \texttt{i} of pointer
|
||||
\texttt{p} and returns an integer in the range of
|
||||
$[0,2^{64}-1]$ inclusive. On 32-bit systems, the procedure
|
||||
\texttt{pointer-ref-unsigned-long} performs the same task as
|
||||
\texttt{pointer-ref-unsigned-int}.
|
||||
\texttt{pointer-ref-c-unsigned-long} performs the same task as
|
||||
\texttt{pointer-ref-c-unsigned-int}.
|
||||
|
||||
|
||||
\defun{pointer-ref-float}{procedure}
|
||||
\texttt{(pointer-ref-float p i)}
|
||||
\defun{pointer-ref-c-float}{procedure}
|
||||
\texttt{(pointer-ref-c-float p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-float} returns the four-byte
|
||||
The procedure \texttt{pointer-ref-c-float} returns the four-byte
|
||||
float (represented as IEEE-754 single precision floating point
|
||||
number) stored at offset \texttt{i} of the pointer \texttt{p}.
|
||||
The value is extended to an IEEE-754 double precision floating
|
||||
point number that Ikarus uses to represent inexact numbers.
|
||||
|
||||
\defun{pointer-ref-double}{procedure}
|
||||
\texttt{(pointer-ref-double p i)}
|
||||
\defun{pointer-ref-c-double}{procedure}
|
||||
\texttt{(pointer-ref-c-double p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-double} returns the eight-byte
|
||||
The procedure \texttt{pointer-ref-c-double} returns the eight-byte
|
||||
float (represented as IEEE-754 double precision floating point
|
||||
number) stored at offset \texttt{i} of the pointer \texttt{p}.
|
||||
|
||||
|
||||
\defun{pointer-ref-pointer}{procedure}
|
||||
\texttt{(pointer-ref-pointer p i)}
|
||||
\defun{pointer-ref-c-pointer}{procedure}
|
||||
\texttt{(pointer-ref-c-pointer p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-pointer} returns the pointer
|
||||
The procedure \texttt{pointer-ref-c-pointer} returns the pointer
|
||||
stored at offset \texttt{i} from the pointer \texttt{p}. The size
|
||||
of the pointer (also the number of bytes loaded) depends on the
|
||||
architecture: it is 4 bytes on 32-bit systems and 8 bytes on 64-bit
|
||||
|
|
@ -2567,12 +2567,12 @@ parameter type.
|
|||
|
||||
|
||||
|
||||
\defun{make-callout}{procedure}
|
||||
\texttt{((make-callout return-type parameter-types) native-pointer)}
|
||||
\defun{make-c-callout}{procedure}
|
||||
\texttt{((make-c-callout return-type parameter-types) native-pointer)}
|
||||
|
||||
The procedure \texttt{make-callout} is the primary facility for
|
||||
The procedure \texttt{make-c-callout} is the primary facility for
|
||||
making foreign procedures callable from Scheme. It works as
|
||||
follows. First, \texttt{make-callout} receives two arguments
|
||||
follows. First, \texttt{make-c-callout} receives two arguments
|
||||
denoting the signature of the procedure to be called. It prepares a
|
||||
bridge that converts from Scheme's calling conventions and data
|
||||
structures to their foreign counterparts. It returns a procedure
|
||||
|
|
@ -2589,10 +2589,10 @@ types, calls the foreign procedure, obtains the result, and converts
|
|||
it to the appropriate Scheme value (depending on the
|
||||
\texttt{return-type}).
|
||||
|
||||
The interface of \texttt{make-callout} is broken down into three
|
||||
The interface of \texttt{make-c-callout} is broken down into three
|
||||
stages in order to accomodate common usage patterns. Often types, a
|
||||
function signature can be used by many foreign procedures and
|
||||
therefore, \texttt{make-callout} can be called once per signature
|
||||
therefore, \texttt{make-c-callout} can be called once per signature
|
||||
and each signature can be used multiple times. Similarly,
|
||||
separating the foreign procedure preparation from parameter passing
|
||||
allows for preparing the foreign procedure once and calling it many
|
||||
|
|
@ -2655,14 +2655,14 @@ specifier to mean ``no useful value is returned''.}
|
|||
|
||||
|
||||
The following example illustrates the use of the
|
||||
\texttt{make-callout} procedure in combination with \texttt{dlopen}
|
||||
\texttt{make-c-callout} procedure in combination with \texttt{dlopen}
|
||||
and \texttt{dlsym}. The session was run on a 32-bit Ikarus running
|
||||
under Mac OS X 10.4. First, the \texttt{libc.dylib} foreign library
|
||||
is loaded and is bound to the variable \texttt{libc}. Next, we
|
||||
obtain a pointer to the \texttt{atan} foreign procedure that is
|
||||
defined in \texttt{libc}. The native procedure \texttt{atan} takes
|
||||
a \texttt{double} as an argument and returns a \texttt{double} and
|
||||
that's the signature that we use for \texttt{make-callout}.
|
||||
that's the signature that we use for \texttt{make-c-callout}.
|
||||
Finally, we call the foreign procedure interface with one argument,
|
||||
\texttt{1.0}, which is a flonum and thus matches the required
|
||||
parameter type. The native procedure returns a \texttt{double}
|
||||
|
|
@ -2678,7 +2678,7 @@ value which is converted to the Scheme flonum with value
|
|||
> libc-atan-ptr
|
||||
#<pointer #x9006CB1F>
|
||||
> (define libc-atan
|
||||
((make-callout 'double '(double)) libc-atan-ptr))
|
||||
((make-c-callout 'double '(double)) libc-atan-ptr))
|
||||
> libc-atan
|
||||
#<procedure>
|
||||
> (libc-atan 1.0)
|
||||
|
|
@ -2713,14 +2713,14 @@ Figure~\ref{fig:foreign-types} on page~\pageref{fig:foreign-types} for
|
|||
details).
|
||||
|
||||
|
||||
\defun{make-callback}{procedure}
|
||||
\texttt{((make-callback return-type parameter-types) scheme-procedure)}
|
||||
\defun{make-c-callback}{procedure}
|
||||
\texttt{((make-c-callback return-type parameter-types) scheme-procedure)}
|
||||
|
||||
The procedure \texttt{make-callback} is similar to the procedure
|
||||
\texttt{make-callout} except that it provides a bridge from native
|
||||
The procedure \texttt{make-c-callback} is similar to the procedure
|
||||
\texttt{make-c-callout} except that it provides a bridge from native
|
||||
procedures back into Scheme. While the procedure
|
||||
\texttt{make-callout} takes a native pointer and returns a Scheme
|
||||
procedure, \texttt{make-callback} takes a Scheme procedure and
|
||||
\texttt{make-c-callout} takes a native pointer and returns a Scheme
|
||||
procedure, \texttt{make-c-callback} takes a Scheme procedure and
|
||||
returns a native pointer. The native pointer can be called by
|
||||
foreign procedures. The native parameters are converted to Scheme
|
||||
data (according to \texttt{parameter-types}), the Scheme procedure
|
||||
|
|
@ -2730,18 +2730,18 @@ control returns to the native call site.
|
|||
|
||||
|
||||
Note that the native procedure pointer obtained from
|
||||
\texttt{make-callback} is indistinguishable from other native
|
||||
\texttt{make-c-callback} is indistinguishable from other native
|
||||
procedures that are obtained using \texttt{dlsym} or similar means.
|
||||
In particular, such native pointers can be used as arguments to
|
||||
\texttt{make-callout} resulting in a Scheme procedure that calls out
|
||||
In particular, such native pointers can be passed to
|
||||
\texttt{make-c-callout} resulting in a Scheme procedure that calls out
|
||||
to the native procedure that in turn calls back into Scheme. The
|
||||
following segment illustrates a very inefficient way of extracting
|
||||
the lowermost 32 bits from an exact integer.
|
||||
|
||||
\begin{verbatim}
|
||||
> (format "~x"
|
||||
(((make-callout 'unsigned-int '(unsigned-int))
|
||||
((make-callback 'unsigned-int '(unsigned-int))
|
||||
(((make-c-callout 'unsigned-int '(unsigned-int))
|
||||
((make-c-callback 'unsigned-int '(unsigned-int))
|
||||
values))
|
||||
#xfedcba09876543210fedcba09876543210))
|
||||
"76543210"
|
||||
|
|
|
|||
|
|
@ -20,22 +20,22 @@
|
|||
(define hosym (dlsym self "ho"))
|
||||
|
||||
(define ho
|
||||
((make-callout 'signed-int '(pointer signed-int)) hosym))
|
||||
((make-c-callout 'signed-int '(pointer signed-int)) hosym))
|
||||
|
||||
(define traced-foradd1
|
||||
((make-callback 'signed-int '(signed-int))
|
||||
((make-c-callback 'signed-int '(signed-int))
|
||||
(trace-lambda add1 (n)
|
||||
(collect)
|
||||
(add1 n))))
|
||||
|
||||
(define foradd1
|
||||
((make-callback 'signed-int '(signed-int))
|
||||
((make-c-callback 'signed-int '(signed-int))
|
||||
(lambda (n)
|
||||
(collect)
|
||||
(add1 n))))
|
||||
|
||||
(define foradd1-by-foreign-call
|
||||
((make-callback 'signed-int '(signed-int))
|
||||
((make-c-callback 'signed-int '(signed-int))
|
||||
(trace-lambda foradd1-by-foreign-call (n)
|
||||
(/ (ho traced-foradd1 n) 2))))
|
||||
|
||||
|
|
@ -46,11 +46,11 @@
|
|||
|
||||
|
||||
(define test_I_I
|
||||
((make-callout 'signed-int '(pointer signed-int)) (dlsym self "test_I_I")))
|
||||
((make-c-callout 'signed-int '(pointer signed-int)) (dlsym self "test_I_I")))
|
||||
(define test_I_II
|
||||
((make-callout 'signed-int '(pointer signed-int signed-int)) (dlsym self "test_I_II")))
|
||||
((make-c-callout 'signed-int '(pointer signed-int signed-int)) (dlsym self "test_I_II")))
|
||||
(define test_I_III
|
||||
((make-callout 'signed-int '(pointer signed-int signed-int signed-int)) (dlsym self "test_I_III")))
|
||||
((make-c-callout 'signed-int '(pointer signed-int signed-int signed-int)) (dlsym self "test_I_III")))
|
||||
|
||||
(define C_add_I_I (dlsym self "add_I_I"))
|
||||
(define C_add_I_II (dlsym self "add_I_II"))
|
||||
|
|
@ -60,10 +60,10 @@
|
|||
(check = (test_I_II C_add_I_II 12 13) (+ 12 13))
|
||||
(check = (test_I_III C_add_I_III 12 13 14) (+ 12 13 14))
|
||||
|
||||
(define S_add_I_I ((make-callback 'signed-int '(signed-int)) +))
|
||||
(define S_add_I_II ((make-callback 'signed-int '(signed-int
|
||||
(define S_add_I_I ((make-c-callback 'signed-int '(signed-int)) +))
|
||||
(define S_add_I_II ((make-c-callback 'signed-int '(signed-int
|
||||
signed-int)) +))
|
||||
(define S_add_I_III ((make-callback 'signed-int '(signed-int
|
||||
(define S_add_I_III ((make-c-callback 'signed-int '(signed-int
|
||||
signed-int
|
||||
signed-int)) +))
|
||||
|
||||
|
|
@ -73,11 +73,11 @@
|
|||
|
||||
|
||||
(define test_D_D
|
||||
((make-callout 'double '(pointer double)) (dlsym self "test_D_D")))
|
||||
((make-c-callout 'double '(pointer double)) (dlsym self "test_D_D")))
|
||||
(define test_D_DD
|
||||
((make-callout 'double '(pointer double double)) (dlsym self "test_D_DD")))
|
||||
((make-c-callout 'double '(pointer double double)) (dlsym self "test_D_DD")))
|
||||
(define test_D_DDD
|
||||
((make-callout 'double '(pointer double double double)) (dlsym self "test_D_DDD")))
|
||||
((make-c-callout 'double '(pointer double double double)) (dlsym self "test_D_DDD")))
|
||||
|
||||
(define C_add_D_D (dlsym self "add_D_D"))
|
||||
(define C_add_D_DD (dlsym self "add_D_DD"))
|
||||
|
|
@ -87,9 +87,9 @@
|
|||
(check = (test_D_DD C_add_D_DD 12.0 13.0) (+ 12.0 13.0))
|
||||
(check = (test_D_DDD C_add_D_DDD 12.0 13.0 14.0) (+ 12.0 13.0 14.0))
|
||||
|
||||
(define S_add_D_D ((make-callback 'double '(double)) +))
|
||||
(define S_add_D_DD ((make-callback 'double '(double double)) +))
|
||||
(define S_add_D_DDD ((make-callback 'double '(double double double)) +))
|
||||
(define S_add_D_D ((make-c-callback 'double '(double)) +))
|
||||
(define S_add_D_DD ((make-c-callback 'double '(double double)) +))
|
||||
(define S_add_D_DDD ((make-c-callback 'double '(double double double)) +))
|
||||
|
||||
(check = (test_D_D S_add_D_D 12.0) (+ 12.0))
|
||||
(check = (test_D_DD S_add_D_DD 12.0 13.0) (+ 12.0 13.0))
|
||||
|
|
@ -97,7 +97,7 @@
|
|||
|
||||
|
||||
(define RectArea
|
||||
((make-callout 'float '(#(#(float float) #(float float))))
|
||||
((make-c-callout 'float '(#(#(float float) #(float float))))
|
||||
(dlsym self "test_area_F_R")))
|
||||
|
||||
(check = (RectArea '#(#(0.0 0.0) #(10.0 10.0))) 100.0)
|
||||
|
|
|
|||
|
|
@ -6,13 +6,13 @@
|
|||
(define kProcessTransformToForegroundApplication 1)
|
||||
(define self (dlopen))
|
||||
(define get-current-process
|
||||
((make-callout 'void '(pointer))
|
||||
((make-c-callout 'void '(pointer))
|
||||
(dlsym self "GetCurrentProcess")))
|
||||
(define transform-process-type
|
||||
((make-callout 'void '(pointer signed-int))
|
||||
((make-c-callout 'void '(pointer signed-int))
|
||||
(dlsym self "TransformProcessType")))
|
||||
(define set-front-process
|
||||
((make-callout 'void '(pointer))
|
||||
((make-c-callout 'void '(pointer))
|
||||
(dlsym self "SetFrontProcess")))
|
||||
(let ([p (malloc 16)])
|
||||
(get-current-process p)
|
||||
|
|
|
|||
|
|
@ -1,17 +1,29 @@
|
|||
|
||||
(library (ikarus foreign)
|
||||
|
||||
(export malloc free pointer-set-char pointer-set-short
|
||||
pointer-set-int pointer-set-long pointer-set-pointer
|
||||
pointer-set-float pointer-set-double
|
||||
pointer-ref-signed-char pointer-ref-signed-short
|
||||
pointer-ref-signed-int pointer-ref-signed-long
|
||||
pointer-ref-unsigned-char pointer-ref-unsigned-short
|
||||
pointer-ref-unsigned-int pointer-ref-unsigned-long
|
||||
pointer-ref-pointer pointer-ref-float pointer-ref-double
|
||||
(export
|
||||
pointer-set-c-char!
|
||||
pointer-set-c-short!
|
||||
pointer-set-c-int!
|
||||
pointer-set-c-long!
|
||||
pointer-set-c-pointer!
|
||||
pointer-set-c-float!
|
||||
pointer-set-c-double!
|
||||
pointer-ref-c-signed-char
|
||||
pointer-ref-c-signed-short
|
||||
pointer-ref-c-signed-int
|
||||
pointer-ref-c-signed-long
|
||||
pointer-ref-c-unsigned-char
|
||||
pointer-ref-c-unsigned-short
|
||||
pointer-ref-c-unsigned-int
|
||||
pointer-ref-c-unsigned-long
|
||||
pointer-ref-c-pointer
|
||||
pointer-ref-c-float
|
||||
pointer-ref-c-double
|
||||
malloc free
|
||||
pointer->integer integer->pointer pointer? dlopen dlsym
|
||||
dlclose dlerror
|
||||
make-callout make-callback)
|
||||
make-c-callout make-c-callback)
|
||||
|
||||
(import (ikarus system $foreign)))
|
||||
|
||||
|
|
|
|||
44
lib/objc.ss
44
lib/objc.ss
|
|
@ -61,7 +61,7 @@
|
|||
|
||||
(define (pointer-ref addr offset)
|
||||
(assert (pointer? addr))
|
||||
(integer->pointer (pointer-ref-signed-long addr offset)))
|
||||
(pointer-ref-c-pointer addr offset))
|
||||
|
||||
(define (offset? x) (or (fixnum? x) (bignum? x)))
|
||||
|
||||
|
|
@ -70,12 +70,12 @@
|
|||
(check who pointer? addr)
|
||||
(check who pointer? val)
|
||||
(check who offset? offset)
|
||||
(pointer-set-long addr offset (pointer->integer val)))
|
||||
(pointer-set-c-pointer! addr offset val))
|
||||
|
||||
(define (char*len x)
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(zero? (pointer-ref-unsigned-char x i)) i]
|
||||
[(zero? (pointer-ref-c-unsigned-char x i)) i]
|
||||
[else (f (+ i 1))])))
|
||||
|
||||
(define (char*->bv x)
|
||||
|
|
@ -85,18 +85,18 @@
|
|||
(cond
|
||||
[(= i n) bv]
|
||||
[else
|
||||
(bytevector-u8-set! bv i (pointer-ref-unsigned-char x i))
|
||||
(bytevector-u8-set! bv i (pointer-ref-c-unsigned-char x i))
|
||||
(f (+ i 1))])))))
|
||||
|
||||
(define (bv->char* x)
|
||||
(let ([n (bytevector-length x)])
|
||||
(let ([p (malloc (+ n 1))])
|
||||
(pointer-set-char p n 0)
|
||||
(pointer-set-c-char! p n 0)
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-char p i (bytevector-s8-ref x i))
|
||||
(pointer-set-c-char! p i (bytevector-s8-ref x i))
|
||||
(f (+ i 1))])))))
|
||||
|
||||
(define (bv->u8* x)
|
||||
|
|
@ -108,7 +108,7 @@
|
|||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-char p i (bytevector-s8-ref x i))
|
||||
(pointer-set-c-char! p i (bytevector-s8-ref x i))
|
||||
(f (+ i 1))]))))))
|
||||
|
||||
(define (char*->string x)
|
||||
|
|
@ -183,7 +183,7 @@
|
|||
|
||||
(define (class-instance-size x)
|
||||
(check 'class-instance-size class? x)
|
||||
(pointer-ref-signed-long (class-ptr x) objc-class-instance-size-offset))
|
||||
(pointer-ref-c-signed-long (class-ptr x) objc-class-instance-size-offset))
|
||||
|
||||
(define (ivar-name x)
|
||||
(check 'ivar-name ivar? x)
|
||||
|
|
@ -195,14 +195,14 @@
|
|||
|
||||
(define (ivar-offset x)
|
||||
(check 'ivar-offset ivar? x)
|
||||
(pointer-ref-signed-int (ivar-ptr x) (* 2 ptrsize)))
|
||||
(pointer-ref-c-signed-int (ivar-ptr x) (* 2 ptrsize)))
|
||||
|
||||
(define (class-ivars x)
|
||||
(check 'class-ivars class? x)
|
||||
(let ([p (pointer-ref (class-ptr x) objc-class-ivars-offset)])
|
||||
(if (nil? p)
|
||||
'()
|
||||
(let ([n (pointer-ref-signed-long p 0)])
|
||||
(let ([n (pointer-ref-c-signed-long p 0)])
|
||||
(let f ([i 0] [off objc-ivarlist-ivars-offset])
|
||||
(if (= i n)
|
||||
'()
|
||||
|
|
@ -223,7 +223,7 @@
|
|||
[class (malloc objc-class-struct-size)]
|
||||
[meta (malloc objc-class-struct-size)])
|
||||
;;; init meta class
|
||||
(pointer-set-long meta objc-class-info-offset CLS_META)
|
||||
(pointer-set-c-long! meta objc-class-info-offset CLS_META)
|
||||
(pointer-set meta objc-class-name-offset (string->char* name))
|
||||
(pointer-set meta objc-class-methodlists-offset
|
||||
(malloc objc-methodlist-methods-offset))
|
||||
|
|
@ -232,14 +232,14 @@
|
|||
(pointer-set meta objc-class-isa-offset
|
||||
(pointer-ref (class-ptr root-class) objc-class-isa-offset))
|
||||
;;; init class
|
||||
(pointer-set-long class objc-class-info-offset CLS_CLASS)
|
||||
(pointer-set-c-long! class objc-class-info-offset CLS_CLASS)
|
||||
(pointer-set class objc-class-name-offset (string->char* name))
|
||||
(pointer-set class objc-class-methodlists-offset
|
||||
(malloc objc-methodlist-methods-offset))
|
||||
(pointer-set class objc-class-superclass-offset
|
||||
(class-ptr super-class))
|
||||
(pointer-set class objc-class-ivars-offset ivars-ptr)
|
||||
(pointer-set-long class objc-class-instance-size-offset instance-size)
|
||||
(pointer-set-c-long! class objc-class-instance-size-offset instance-size)
|
||||
;;; wire up
|
||||
(pointer-set class objc-class-isa-offset meta)
|
||||
(when intern? (objc_addClass class))
|
||||
|
|
@ -251,7 +251,7 @@
|
|||
(check who procedure? proc)
|
||||
(let ([type (make-objc-type (cons rtype argtypes))])
|
||||
(let ([callback
|
||||
(make-callback
|
||||
(make-c-callback
|
||||
(objc-type->ikarus-type rtype)
|
||||
(map objc-type->ikarus-type argtypes))])
|
||||
(let ([imp (callback
|
||||
|
|
@ -260,7 +260,7 @@
|
|||
(apply proc (map convert-incoming argtypes args)))))])
|
||||
(let ([p (malloc (+ objc-methodlist-methods-offset
|
||||
objc-method-size))])
|
||||
(pointer-set-int p objc-methodlist-count-offset 1)
|
||||
(pointer-set-c-int! p objc-methodlist-count-offset 1)
|
||||
(pointer-set p
|
||||
(+ objc-methodlist-methods-offset objc-method-sel-offset)
|
||||
(selector-ptr
|
||||
|
|
@ -312,11 +312,11 @@
|
|||
(cond
|
||||
[(assq what alist) => cadr]
|
||||
[else (error 'class-is? "invalid what" what)])])
|
||||
(= mask (bitwise-and mask (pointer-ref-signed-long (class-ptr x) (* ptrsize 4))))))
|
||||
(= mask (bitwise-and mask (pointer-ref-c-signed-long (class-ptr x) (* ptrsize 4))))))
|
||||
|
||||
(define (class-methods x)
|
||||
(define (methods x)
|
||||
(let ([n (pointer-ref-signed-int x ptrsize)]
|
||||
(let ([n (pointer-ref-c-signed-int x ptrsize)]
|
||||
[array (integer->pointer (+ (pointer->integer x) (* 2 ptrsize)))])
|
||||
(let f ([i 0])
|
||||
(if (= i n)
|
||||
|
|
@ -330,7 +330,7 @@
|
|||
(when (class-is? x 'method-array)
|
||||
(error 'class-methods "BUG: not yet for method arrays"))
|
||||
(let ([iterator (malloc ptrsize)])
|
||||
(pointer-set-long iterator 0 0)
|
||||
(pointer-set-c-long! iterator 0 0)
|
||||
(let f ()
|
||||
(let ([methodlist (class_nextMethodList (class-ptr x) iterator)])
|
||||
(cond
|
||||
|
|
@ -354,7 +354,7 @@
|
|||
(cons
|
||||
(make-class
|
||||
(integer->pointer
|
||||
(pointer-ref-signed-long buffer (* ptrsize i))))
|
||||
(pointer-ref-c-signed-long buffer (* ptrsize i))))
|
||||
ac)))))))))
|
||||
|
||||
(define (nil? x)
|
||||
|
|
@ -475,7 +475,7 @@
|
|||
(define count (length ivars))
|
||||
(define p
|
||||
(malloc (+ objc-ivarlist-ivars-offset (* count objc-ivar-size))))
|
||||
(pointer-set-int p objc-ivarlist-count-offset count)
|
||||
(pointer-set-c-int! p objc-ivarlist-count-offset count)
|
||||
(let f ([ivars ivars]
|
||||
[poff objc-ivarlist-ivars-offset]
|
||||
[ivaroff (class-instance-size super-class)])
|
||||
|
|
@ -489,7 +489,7 @@
|
|||
(string->char* (symbol->string name)))
|
||||
(pointer-set p (+ poff objc-ivar-type-offset)
|
||||
(string->char* ivar-type))
|
||||
(pointer-set-int p (+ poff objc-ivar-offset-offset) ivaroff)
|
||||
(pointer-set-c-int! p (+ poff objc-ivar-offset-offset) ivaroff)
|
||||
(f (cdr ivars)
|
||||
(+ poff objc-ivar-size)
|
||||
(+ ivaroff ivar-size)))))])))
|
||||
|
|
@ -643,7 +643,7 @@
|
|||
(let ([rtype (car sig)] [argtypes (cdr sig)])
|
||||
(unless (= (length args) (length argtypes))
|
||||
(error 'call-with-sig "incorrect number of args" args argtypes))
|
||||
(let ([ffi (make-callout
|
||||
(let ([ffi (make-c-callout
|
||||
(objc-type->ikarus-type rtype)
|
||||
(map objc-type->ikarus-type argtypes))])
|
||||
(let ([proc (ffi mptr)])
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@
|
|||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-int p (* i 4) (vector-ref x i))
|
||||
(pointer-set-c-int! p (* i 4) (vector-ref x i))
|
||||
(f (+ i 1))]))))]
|
||||
[else (die who "not an int*" x)]))
|
||||
|
||||
|
|
@ -104,7 +104,7 @@
|
|||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-int p (* i pointer-size)
|
||||
(pointer-set-c-int! p (* i pointer-size)
|
||||
(pointer->integer (check-char* who (vector-ref x i))))
|
||||
(f (+ i 1))]))))]
|
||||
[else (die who "not a char**" x)]))
|
||||
|
|
@ -114,12 +114,12 @@
|
|||
[(bytevector? x)
|
||||
(let ([n (bytevector-length x)])
|
||||
(let ([p (malloc (+ n 1))])
|
||||
(pointer-set-char p n 0)
|
||||
(pointer-set-c-char! p n 0)
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(= i n) p]
|
||||
[else
|
||||
(pointer-set-char p i (bytevector-u8-ref x i))
|
||||
(pointer-set-c-char! p i (bytevector-u8-ref x i))
|
||||
(f (+ i 1))]))))]
|
||||
[else (die who "not a byte*" x)]))
|
||||
|
||||
|
|
@ -139,7 +139,7 @@
|
|||
[(_ foreign-name val return-type (arg-type* ...))
|
||||
#'(let ([t val])
|
||||
(if (procedure? t)
|
||||
((make-callback
|
||||
((make-c-callback
|
||||
(convert-type return-type)
|
||||
(list (convert-type arg-type*) ...))
|
||||
t)
|
||||
|
|
@ -187,7 +187,7 @@
|
|||
(define (strlen x)
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(= 0 (pointer-ref-unsigned-char x i)) i]
|
||||
[(= 0 (pointer-ref-c-unsigned-char x i)) i]
|
||||
[else (f (+ i 1))])))
|
||||
(let ([n (strlen x)])
|
||||
(let ([s (make-string n)])
|
||||
|
|
@ -196,7 +196,7 @@
|
|||
s
|
||||
(begin
|
||||
(string-set! s i
|
||||
(integer->char (pointer-ref-unsigned-char x i)))
|
||||
(integer->char (pointer-ref-c-unsigned-char x i)))
|
||||
(f (+ i 1))))))))
|
||||
|
||||
(define-syntax convert-return
|
||||
|
|
@ -254,7 +254,7 @@
|
|||
(with-syntax ([x x]
|
||||
[(t* ...) (generate-temporaries #'(arg-type* ...))])
|
||||
#'(let ([callout
|
||||
((make-callout
|
||||
((make-c-callout
|
||||
(convert-type return-type)
|
||||
(list (convert-type arg-type*) ...))
|
||||
(lookup-shared-object lib 'foreign-name))])
|
||||
|
|
|
|||
|
|
@ -2,19 +2,25 @@
|
|||
(library (ikarus.pointers)
|
||||
(export pointer? integer->pointer pointer->integer
|
||||
dlopen dlerror dlclose dlsym malloc free
|
||||
pointer-ref-signed-char
|
||||
pointer-ref-signed-short
|
||||
pointer-ref-signed-int
|
||||
pointer-ref-signed-long
|
||||
pointer-ref-unsigned-char
|
||||
pointer-ref-unsigned-short
|
||||
pointer-ref-unsigned-int
|
||||
pointer-ref-unsigned-long
|
||||
pointer-set-char pointer-set-short pointer-set-int pointer-set-long
|
||||
pointer-set-pointer pointer-ref-pointer
|
||||
pointer-set-float pointer-ref-float
|
||||
pointer-set-double pointer-ref-double
|
||||
make-callout make-callback)
|
||||
pointer-ref-c-signed-char
|
||||
pointer-ref-c-signed-short
|
||||
pointer-ref-c-signed-int
|
||||
pointer-ref-c-signed-long
|
||||
pointer-ref-c-unsigned-char
|
||||
pointer-ref-c-unsigned-short
|
||||
pointer-ref-c-unsigned-int
|
||||
pointer-ref-c-unsigned-long
|
||||
pointer-ref-c-float
|
||||
pointer-ref-c-double
|
||||
pointer-ref-c-pointer
|
||||
pointer-set-c-char!
|
||||
pointer-set-c-short!
|
||||
pointer-set-c-int!
|
||||
pointer-set-c-long!
|
||||
pointer-set-c-pointer!
|
||||
pointer-set-c-float!
|
||||
pointer-set-c-double!
|
||||
make-c-callout make-c-callback)
|
||||
(import
|
||||
(except (ikarus)
|
||||
pointer?
|
||||
|
|
@ -120,25 +126,25 @@
|
|||
|
||||
(define (int? x) (or (fixnum? x) (bignum? x)))
|
||||
|
||||
(define-getter pointer-ref-signed-char "ikrt_ref_char")
|
||||
(define-getter pointer-ref-signed-short "ikrt_ref_short")
|
||||
(define-getter pointer-ref-signed-int "ikrt_ref_int")
|
||||
(define-getter pointer-ref-signed-long "ikrt_ref_long")
|
||||
(define-getter pointer-ref-unsigned-char "ikrt_ref_uchar")
|
||||
(define-getter pointer-ref-unsigned-short "ikrt_ref_ushort")
|
||||
(define-getter pointer-ref-unsigned-int "ikrt_ref_uint")
|
||||
(define-getter pointer-ref-unsigned-long "ikrt_ref_ulong")
|
||||
(define-getter pointer-ref-float "ikrt_ref_float")
|
||||
(define-getter pointer-ref-double "ikrt_ref_double")
|
||||
(define-getter pointer-ref-pointer "ikrt_ref_pointer")
|
||||
(define-getter pointer-ref-c-signed-char "ikrt_ref_char")
|
||||
(define-getter pointer-ref-c-signed-short "ikrt_ref_short")
|
||||
(define-getter pointer-ref-c-signed-int "ikrt_ref_int")
|
||||
(define-getter pointer-ref-c-signed-long "ikrt_ref_long")
|
||||
(define-getter pointer-ref-c-unsigned-char "ikrt_ref_uchar")
|
||||
(define-getter pointer-ref-c-unsigned-short "ikrt_ref_ushort")
|
||||
(define-getter pointer-ref-c-unsigned-int "ikrt_ref_uint")
|
||||
(define-getter pointer-ref-c-unsigned-long "ikrt_ref_ulong")
|
||||
(define-getter pointer-ref-c-float "ikrt_ref_float")
|
||||
(define-getter pointer-ref-c-double "ikrt_ref_double")
|
||||
(define-getter pointer-ref-c-pointer "ikrt_ref_pointer")
|
||||
|
||||
(define-setter pointer-set-char int? "ikrt_set_char")
|
||||
(define-setter pointer-set-short int? "ikrt_set_short")
|
||||
(define-setter pointer-set-int int? "ikrt_set_int")
|
||||
(define-setter pointer-set-long int? "ikrt_set_long")
|
||||
(define-setter pointer-set-float flonum? "ikrt_set_float")
|
||||
(define-setter pointer-set-double flonum? "ikrt_set_double")
|
||||
(define-setter pointer-set-pointer pointer? "ikrt_set_pointer")
|
||||
(define-setter pointer-set-c-char! int? "ikrt_set_char")
|
||||
(define-setter pointer-set-c-short! int? "ikrt_set_short")
|
||||
(define-setter pointer-set-c-int! int? "ikrt_set_int")
|
||||
(define-setter pointer-set-c-long! int? "ikrt_set_long")
|
||||
(define-setter pointer-set-c-float! flonum? "ikrt_set_float")
|
||||
(define-setter pointer-set-c-double! flonum? "ikrt_set_double")
|
||||
(define-setter pointer-set-c-pointer! pointer? "ikrt_set_pointer")
|
||||
|
||||
;;; libffi interface
|
||||
|
||||
|
|
@ -202,8 +208,8 @@
|
|||
argtypes-n
|
||||
rtype-n)))
|
||||
|
||||
(define (make-callout rtype argtypes)
|
||||
(define who 'make-callout)
|
||||
(define (make-c-callout rtype argtypes)
|
||||
(define who 'make-c-callout)
|
||||
(let-values ([(cif argtypes-n rtype-n)
|
||||
(ffi-prep-cif rtype argtypes)])
|
||||
(let* ([argtypes-vec (list->vector argtypes)]
|
||||
|
|
@ -228,11 +234,11 @@
|
|||
checkers argtypes-vec argsvec)
|
||||
(foreign-call "ikrt_ffi_call" data argsvec)))))))
|
||||
|
||||
(define (make-callback rtype argtypes)
|
||||
(define (make-c-callback rtype argtypes)
|
||||
(let-values ([(cif argtypes-n rtype-n)
|
||||
(ffi-prep-cif rtype argtypes)])
|
||||
(lambda (proc)
|
||||
(define who 'make-callback)
|
||||
(define who 'make-c-callback)
|
||||
(unless (procedure? proc)
|
||||
(die who "not a procedure"))
|
||||
(let ([proc
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1622
|
||||
1623
|
||||
|
|
|
|||
|
|
@ -1464,26 +1464,26 @@
|
|||
[dlsym $for]
|
||||
[malloc $for]
|
||||
[free $for]
|
||||
[pointer-ref-signed-char $for]
|
||||
[pointer-ref-signed-short $for]
|
||||
[pointer-ref-signed-int $for]
|
||||
[pointer-ref-signed-long $for]
|
||||
[pointer-ref-unsigned-char $for]
|
||||
[pointer-ref-unsigned-short $for]
|
||||
[pointer-ref-unsigned-int $for]
|
||||
[pointer-ref-unsigned-long $for]
|
||||
[pointer-set-char $for]
|
||||
[pointer-set-short $for]
|
||||
[pointer-set-int $for]
|
||||
[pointer-set-long $for]
|
||||
[pointer-set-pointer $for]
|
||||
[pointer-ref-pointer $for]
|
||||
[pointer-set-float $for]
|
||||
[pointer-ref-float $for]
|
||||
[pointer-set-double $for]
|
||||
[pointer-ref-double $for]
|
||||
[make-callout $for]
|
||||
[make-callback $for]
|
||||
[pointer-ref-c-signed-char $for]
|
||||
[pointer-ref-c-signed-short $for]
|
||||
[pointer-ref-c-signed-int $for]
|
||||
[pointer-ref-c-signed-long $for]
|
||||
[pointer-ref-c-unsigned-char $for]
|
||||
[pointer-ref-c-unsigned-short $for]
|
||||
[pointer-ref-c-unsigned-int $for]
|
||||
[pointer-ref-c-unsigned-long $for]
|
||||
[pointer-ref-c-float $for]
|
||||
[pointer-ref-c-double $for]
|
||||
[pointer-ref-c-pointer $for]
|
||||
[pointer-set-c-char! $for]
|
||||
[pointer-set-c-short! $for]
|
||||
[pointer-set-c-int! $for]
|
||||
[pointer-set-c-long! $for]
|
||||
[pointer-set-c-pointer! $for]
|
||||
[pointer-set-c-float! $for]
|
||||
[pointer-set-c-double! $for]
|
||||
[make-c-callout $for]
|
||||
[make-c-callback $for]
|
||||
[host-info i]
|
||||
|
||||
))
|
||||
|
|
|
|||
Loading…
Reference in New Issue