- added (ikarus foreign) library that should be used instead of
(ikarus system $foreign). - changed the names of some of the pointer primitives - changed the name of the procedure make-ffi to make-callout - updated examples and libraries to conform with new names - updated the users guide to provide a complete description of the (ikarus foreign) library - updated list of missing R6RS features in the users guide
This commit is contained in:
parent
997c75fabb
commit
1e5e516b08
Binary file not shown.
|
@ -2065,7 +2065,7 @@ displayed.
|
|||
no collections
|
||||
0 ms elapsed cpu time, including 0 ms collecting
|
||||
0 ms elapsed real time, including 0 ms collecting
|
||||
56 bytes allocated
|
||||
24 bytes allocated
|
||||
1
|
||||
2
|
||||
3
|
||||
|
@ -2075,10 +2075,686 @@ displayed.
|
|||
no collections
|
||||
0 ms elapsed cpu time, including 0 ms collecting
|
||||
0 ms elapsed real time, including 0 ms collecting
|
||||
32 bytes allocated
|
||||
0 bytes allocated
|
||||
12
|
||||
\end{verbatim}
|
||||
|
||||
\chapter{\label{chapter:foreign}The \texttt{(ikarus foreign)} Library}
|
||||
|
||||
This chapter describes the facilities through which Ikarus
|
||||
interfaces with the host operating system and other external
|
||||
libraries. The facilities of the \texttt{(ikarus~foreign)}
|
||||
library give the Scheme program unrestricted access to the computer
|
||||
memory, allowing one to allocate, access, modify, and free memory as
|
||||
needed. The facilities also allow the Scheme program to \emph{call
|
||||
out} to system procedures as well as allow the native procedures to
|
||||
\emph{call back} into Scheme.
|
||||
|
||||
This chapter is organized as follows: Section~\ref{sec:ffi-overview}
|
||||
gives an overview of the basic concepts such as shared libraries,
|
||||
external symbols, foreign data types, pointers, and procedures.
|
||||
Section~\ref{sec:ffi-memory} describes the primitives that
|
||||
\texttt{(ikarus~foreign)} provides for direct manipulation of
|
||||
memory. Section~\ref{sec:ffi-procedures} deals with loading
|
||||
external libraries and calling out to native library procedures and
|
||||
calling back into Scheme. To demonstrate the usefulness of the
|
||||
foreign facilities, Ikarus ships with two libraries that also serve
|
||||
as extended examples for using the system.
|
||||
Section~\ref{sec:ffi-opengl} describes The OpenGL library
|
||||
\texttt{(ikarus~opengl)} which allows the programmer to produce 2D
|
||||
and 3D computer graphics. Section~\ref{sec:ffi-objc} describes the
|
||||
\texttt{(ikarus~objc)} which allows the programmer to access
|
||||
libraries and frameworks written in the Objective-C programming
|
||||
language and thus provides full access to the Mac OS X system
|
||||
(e.g.,~making graphical user interfaces with Cocoa and drawing
|
||||
graphics with Quartz all from Scheme).
|
||||
|
||||
Ikarus version \texttt{0.0.4} is the first version of Ikarus to
|
||||
support the described foreign interfaces.
|
||||
\newpage
|
||||
|
||||
\section{\label{sec:ffi-overview}Overview}
|
||||
|
||||
In order to make full use of the computer, it is important for a
|
||||
programming environment (e.g., Ikarus Scheme) to facilitate access
|
||||
to the underlying architecture on which it runs. The underlying
|
||||
architecture includes the API provided by the host operating system
|
||||
kernel (e.g., Linux), the system libraries (e.g., \texttt{libc}),
|
||||
and other site-installed libraries (e.g., \texttt{sqlite3}).
|
||||
Providing direct access to such API from within Scheme allows the
|
||||
programmer to write Scheme libraries that have few or no
|
||||
dependencies on external programs (such as \texttt{C} development
|
||||
toolchain). When dealing with system libraries, the programmer
|
||||
must have a thorough understanding of many aspects of the targetted
|
||||
system. This section attempts to provide answers to many questions
|
||||
that are frequently encountered when interfacing to external
|
||||
libraries.
|
||||
|
||||
|
||||
\section{Memory management}
|
||||
|
||||
Ikarus Scheme is a managed environment. Like in many programming
|
||||
environments, Ikarus manages its own memory. Scheme objects are
|
||||
allocated in a special memory region (the Scheme heap) and have
|
||||
type-specific object layout that allows the run time system to
|
||||
distinguish object types and allows the garbage collector to locate
|
||||
all potentially live objects and reclaim the memory of dead objects.
|
||||
Scheme objects are also \emph{opaque} in the sense that the data
|
||||
structures used to represent Scheme objects (e.g., pairs) are not
|
||||
exposed to the programmer, who can only interact with objects
|
||||
through an interface (e.g., \texttt{car}, \texttt{cdr}).
|
||||
|
||||
Unmanaged environments, such as the operating system on which Ikarus
|
||||
runs, require that the programmer manages the allocation and
|
||||
deallocation of system resources herself. Memory regions, file
|
||||
handles, external devices, the screen, etc., are all examples of
|
||||
resources whose management must be coordinated among the different
|
||||
parts of the system, and this becomes the responsibility of the
|
||||
programmer who is wiring the different subsystems together.
|
||||
|
||||
Memory, from a system's point of view, is \emph{transparent}. A
|
||||
pointer is an integer denoting an address of memory. This memory
|
||||
address may contain a value that requires interpretation. At the
|
||||
lowest-level, each byte of memory contains eight bits, each of which
|
||||
may be toggled on or off. A level higher, contiguous sequences of
|
||||
bytes are grouped together and are interpreted as integers, floating
|
||||
point numbers, or pointers to other memory addresses. These are the
|
||||
basic data types that are often interpreted atomically. Yet a level
|
||||
higher, groups of basic types form data structures such as arrays,
|
||||
linked lists, trees, and so on. Objects, as found in
|
||||
object-oriented programming languages, are at an even higher level
|
||||
of abstraction since they are treated as opaque references that
|
||||
retain state and know how to respond to messages.
|
||||
|
||||
The procedures in the \texttt{(ikarus~foreign)} library are meant to
|
||||
provide a way to interface with the low level memory operations such
|
||||
as setting and getting bytes from specific locations in memory.
|
||||
Although they do not provide high-level operations, the basic
|
||||
procdures make implementing high-level operations (such as the
|
||||
Objective-C system presented in Chapter~\ref{chapter:objc})
|
||||
possible. Programmers are encouraged to define their own
|
||||
abstractions that are most suitable for the specific target library
|
||||
rather than using the low-level operations directly. This results
|
||||
in writing more robust and more easily maintainable libraries. To
|
||||
put it more boldly: \textbf{Do not sprinkle your code with low-level
|
||||
memory operations}.
|
||||
|
||||
|
||||
\section{\label{sec:ffi-memory}Memory operations}
|
||||
|
||||
\defun{malloc}{procedure}
|
||||
\texttt{(malloc n)}
|
||||
|
||||
The \texttt{malloc} procedure allocates \texttt{n} bytes of memory
|
||||
and returns a pointer to the allocated memory. The \texttt{malloc}
|
||||
Scheme procedure is implemented using the host-provided
|
||||
\texttt{malloc} system procedure (often found in \texttt{libc}).
|
||||
The number of bytes, \texttt{n}, must be a positive exact integer.
|
||||
|
||||
\begin{verbatim}
|
||||
> (malloc 10)
|
||||
#<pointer #x00300320>
|
||||
> (malloc 10000)
|
||||
#<pointer #x01800400>
|
||||
\end{verbatim}
|
||||
|
||||
\newpage
|
||||
\defun{free}{procedure}
|
||||
\texttt{(free p)}
|
||||
|
||||
The \texttt{free} procedure takes a pointer and frees the memory
|
||||
region at the given address. The memory region must be allocated
|
||||
with \texttt{malloc}, \texttt{calloc}, or a similar system
|
||||
procedure. Once freed, memory operations on the given address are
|
||||
invalid and may cause the system to crash at unpredictable times.
|
||||
Ikarus cannot check for such errors since the memory may be freed by
|
||||
procedures that are external to Ikarus.
|
||||
|
||||
|
||||
|
||||
\defun{pointer->integer}{procedure}
|
||||
\texttt{(pointer->integer p)}
|
||||
|
||||
The procedure \texttt{pointer->integer} converts the value of the
|
||||
pointer \texttt{p} to an exact integer value. The result may be a
|
||||
fixnum or a bignum depending on the pointer.
|
||||
|
||||
\defun{integer->pointer}{procedure}
|
||||
\texttt{(integer->pointer n)}
|
||||
|
||||
The procedure \texttt{integer->pointer} converts the exact integer
|
||||
\texttt{n} to a pointer value. The lower 32 bits (or 64 bits on
|
||||
64-bit systems) of the value of \texttt{n} are significant in
|
||||
computing the pointer value. It is guaranteed that
|
||||
\texttt{(integer->pointer (pointer->integer p))} points to the same
|
||||
address as \texttt{p}.
|
||||
|
||||
\defun{pointer?}{procedure}
|
||||
\texttt{(pointer? x)}
|
||||
|
||||
The predicate \texttt{pointer?} returns \texttt{\#t} if the value
|
||||
of \texttt{x} is a pointer, and returns \texttt{\#f} otherwise.
|
||||
|
||||
\BoxedText{Note:}{The result of calling the procedures
|
||||
\texttt{eq?}, \texttt{eqv?} and \texttt{equal?} on pointer values is
|
||||
unspecified.}
|
||||
|
||||
|
||||
\newpage
|
||||
|
||||
\defun{pointer-set-char}{procedure}
|
||||
\texttt{(pointer-set-char p i n)}
|
||||
|
||||
The procedure \texttt{pointer-set-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
|
||||
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)}
|
||||
|
||||
The procedure \texttt{pointer-set-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
|
||||
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)}
|
||||
|
||||
The procedure \texttt{pointer-set-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}.
|
||||
|
||||
|
||||
\defun{pointer-set-long}{procedure}
|
||||
\texttt{(pointer-set-long p i n)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-set-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}.
|
||||
|
||||
|
||||
\defun{pointer-set-float}{procedure}
|
||||
\texttt{(pointer-set-float p i fl)}
|
||||
|
||||
The procedure \texttt{pointer-set-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)}
|
||||
|
||||
The procedure \texttt{pointer-set-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)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-set-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
|
||||
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}.
|
||||
|
||||
|
||||
|
||||
\defun{pointer-ref-signed-char}{procedure}
|
||||
\texttt{(pointer-ref-signed-char p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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}.
|
||||
|
||||
|
||||
\begin{verbatim}
|
||||
> (let ([p (malloc 3)])
|
||||
(pointer-set-char p 0 #b01111111)
|
||||
(pointer-set-char p 1 #b10000000)
|
||||
(pointer-set-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))])
|
||||
(free p)
|
||||
result))
|
||||
(127 -128 -1 127 128 255)
|
||||
\end{verbatim}
|
||||
|
||||
\defun{pointer-ref-signed-short}{procedure}
|
||||
\texttt{(pointer-ref-signed-short p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-ref-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}.
|
||||
|
||||
|
||||
\defun{pointer-ref-unsigned-long}{procedure}
|
||||
\texttt{(pointer-ref-unsigned-long p i)}
|
||||
|
||||
On 64-bit systems, the procedure \texttt{pointer-ref-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}.
|
||||
|
||||
|
||||
\defun{pointer-ref-float}{procedure}
|
||||
\texttt{(pointer-ref-float p i)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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)}
|
||||
|
||||
The procedure \texttt{pointer-ref-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
|
||||
systems.
|
||||
|
||||
\section{\label{sec:foreign-objects}Accessing foreign objects from
|
||||
Scheme}
|
||||
|
||||
|
||||
\defun{dlopen}{procedure}
|
||||
\texttt{(dlopen)}\\
|
||||
\texttt{(dlopen library-name)}\\
|
||||
\texttt{(dlopen library-name lazy? global?)}
|
||||
|
||||
The procedure \texttt{dlopen} takes a string \texttt{library-name}
|
||||
represented a system library and calls the system procedure
|
||||
\texttt{dlopen} which dynamically loads the given library into the
|
||||
running process. The name of the library is system-dependent and
|
||||
must include the appropriate suffix (e.g., \texttt{*.so} on Linux,
|
||||
\texttt{*.dylib} on Darwin and \texttt{*.dll} on Cygwin). The
|
||||
\texttt{library-name} may include a full path which identifies the
|
||||
location of the library, or may be just the name of the library in
|
||||
which case the system will lookup the library name using the
|
||||
\texttt{LD\_LIBRARY\_PATH} environment variable.
|
||||
|
||||
The argument \texttt{lazy?} specifies how library dependencies are
|
||||
loaded. If true, \texttt{dlopen} delays the resolution and loading
|
||||
of dependent libraries until they are actually used. If false, all
|
||||
library dependencies are loaded before the call to \texttt{dlopen}
|
||||
returns.
|
||||
|
||||
The argument \texttt{global?} specifies how the scope of the symbols
|
||||
exported from the loaded library. If true, all exported symbols
|
||||
become part of the running image, and subsequent \texttt{dlsym}
|
||||
calls may not need to specify the library from which the symbol is
|
||||
loaded. If false, the exported symbols are not global and the
|
||||
library pointer needs to be specified for \texttt{dlsym}.
|
||||
|
||||
Calling \texttt{(dlopen library-name)} is equivalent to
|
||||
\texttt{(dlopen library-name \#f \#f)}. Calling \texttt{(dlopen)}
|
||||
without arguments returns a pointer to the current process.
|
||||
|
||||
If succesful, \texttt{dlopen} returns a pointer to the external
|
||||
library which can be used subsequently by \texttt{dlsym} and
|
||||
\texttt{dlclose}. If the library cannot be loaded, \texttt{dlopen}
|
||||
returns \texttt{\#f} and the procedure \texttt{dlerror} can be used
|
||||
to obtain the cause of the failure.
|
||||
|
||||
Consult the \texttt{dlopen(3)} page in your system manual for
|
||||
further details.
|
||||
|
||||
\defun{dlclose}{procedure}
|
||||
\texttt{(dlclose library-pointer)}
|
||||
|
||||
The procedure \texttt{dlclose} is a wrapped around the system
|
||||
procedure with the same name. It receives a library pointer
|
||||
(e.g.,~one obtained from \texttt{dlopen}) and releases the resources
|
||||
loaded from that library. Closing a library renders all symbols and
|
||||
static data structures that the library exports invalid and the
|
||||
program may crash or corrupt its memory if such symbols are used
|
||||
after a library is closed.
|
||||
|
||||
Most system implementations of dynamic loading employ reference
|
||||
counting for \texttt{dlopen} and \texttt{dlclose} in that library
|
||||
resources are not freed until the number of calls to
|
||||
\texttt{dlclose} matches the number of calls to \texttt{dlopen}.
|
||||
|
||||
The procedure \texttt{dlclose} returns a boolean value indicating
|
||||
whether the success status of the operation. If \texttt{dlclose}
|
||||
returns \texttt{\#f}, the procedure \texttt{dlerror} can be used to
|
||||
obtain the cause of the error.
|
||||
|
||||
Consult the \texttt{dlclose(3)} page in your system manual for
|
||||
further details.
|
||||
|
||||
\defun{dlerror}{procedure}
|
||||
\texttt{(dlerror)}
|
||||
|
||||
If any of the dynamic loading operations (i.e., \texttt{dlopen},
|
||||
\texttt{dlclose}, \texttt{dlsym}) fails, the cause of the error can
|
||||
be obtained by calling \texttt{dlerror} which returns a string
|
||||
describing the error. The procedure \texttt{dlerror} returns
|
||||
\texttt{\#f} if there was no dynamic loading error.
|
||||
|
||||
Consult the \texttt{dlerror(3)} page in your system manual for
|
||||
further details.
|
||||
|
||||
\defun{dlsym}{procedure}
|
||||
\texttt{(dlsym library-pointer string)}
|
||||
|
||||
The procedure \texttt{dlsym} takes a library pointer (e.g., one
|
||||
obtained by a call to \texttt{dlopen}) and a string representing the
|
||||
name of a symbol that the library exports and returns a pointer to
|
||||
the location of that symbol in memory. If \texttt{dlsym} fails, it
|
||||
returns \texttt{\#f} and the cause of the error can be obtained
|
||||
using the procedure \texttt{dlerror}.
|
||||
|
||||
Consult the \texttt{dlsym(3)} page in your system manual for
|
||||
further details.
|
||||
|
||||
|
||||
\section{\label{sec:callout}Calling out to foreign procedures}
|
||||
|
||||
Ikarus provides the means to call out from Scheme to foreign
|
||||
procedures. This allows the programmers to extend Ikarus to access
|
||||
system-specific facilities that is available on the host machine.
|
||||
|
||||
In order to call out to a foreign procedure, one must provide two
|
||||
pieces of information: the signature of the foreign procedure (e.g.,
|
||||
its type declaration if it is a \texttt{C} procedure) and the
|
||||
address of the procedure in memory. The address of the procedure
|
||||
can be easily obtained using \texttt{dlsym} if the name of the
|
||||
procedure and its exporting library are known. The signature of the
|
||||
procedure cannot, in general, be obtained dynamically, and therefore
|
||||
must be hard coded into the program.
|
||||
|
||||
The signature of the foreign procedure is required for proper
|
||||
linkeage between the Scheme system and the foreign system. Using
|
||||
the signature, Ikarus determines how Scheme values are converted
|
||||
into native values, and where (e.g., in which registers and stack
|
||||
slots) to put these arguments. The signature also determines where
|
||||
the returned values are placed and how they are converted from the
|
||||
system data types to the corresponding Scheme data types.
|
||||
|
||||
A procedure's signature is composed of two parts: the return type
|
||||
and the parameter types. The return type is a symbol that can be
|
||||
any one of the type specifiers listed in
|
||||
Figure~\ref{fig:foreign-types}, page~\pageref{fig:foreign-types}.
|
||||
The parameter types is a list of type specifier symbols. The symbol
|
||||
\texttt{void} can appear as a return type but cannot appear as a
|
||||
parameter type.
|
||||
|
||||
|
||||
|
||||
\defun{make-callout}{procedure}
|
||||
\texttt{((make-callout return-type parameter-types) native-pointer)}
|
||||
|
||||
The procedure \texttt{make-callout} is the primary facility for
|
||||
making foreign procedures callable from Scheme. It works as
|
||||
follows. First, \texttt{make-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
|
||||
$p_1$. Second, the procedure $p_1$ accepts a pointer to a foreign
|
||||
procedure (e.g., one obtained from \texttt{dlsym}) and returns a
|
||||
Scheme procedure $p_2$ that encapsulates the foreign procedure. The
|
||||
final procedure $p_2$ can be called with as many arguments as the
|
||||
ones specified in the \texttt{parameter-types}. The parameters
|
||||
supplies to $p_2$ must match the types supplied as the
|
||||
\texttt{parameter-types} according to the ``Valid Scheme types''
|
||||
column in the table in Figure~\ref{fig:foreign-types}. The
|
||||
procedure $p_2$ converts the parameters from Scheme types to native
|
||||
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
|
||||
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
|
||||
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
|
||||
times.
|
||||
|
||||
The types listed in Figure~\ref{fig:foreign-types} are restricted to
|
||||
basic types and provide no automatic conversion from composite
|
||||
Scheme data structures (such as strings, symbols, vectors, and
|
||||
lists) to native types. The restriction is intentional in order for
|
||||
Ikarus to avoid making invalid assumptions about the memory
|
||||
management of the targeted library. For example, while Ikarus
|
||||
\emph{can} convert a Scheme string to a native byte array (e.g.,
|
||||
using \texttt{string->bytevector} to decode the string, then using
|
||||
\texttt{malloc} to allocate a temporary buffer, and copying the
|
||||
bytes from the bytevector to the allocated memory), it cannot decide
|
||||
when this allocated byte array is no longer needed and should be
|
||||
freed. This knowledge is library-dependent and is often
|
||||
procedure-dependent. Therefore, Ikarus leaves it to the programmer
|
||||
to manage all memory related issues.
|
||||
|
||||
Outgoing parameters to foreign procedures are checked against the
|
||||
declared types. For example, if a callback is prepared to expect a
|
||||
parameter of type \texttt{signed-int}, only exact integers are
|
||||
allowed to be passed out. For integer types, only a fixed number of
|
||||
bits is used and the remaining bits are ignored. For floating point
|
||||
types, the argument is checked to be a Scheme flonum. No implicit
|
||||
conversion between exact and inexact numbers is performed.
|
||||
{
|
||||
\begin{figure}[b!]
|
||||
\begin{center}
|
||||
\begin{tabular}{@{}llll@{}}
|
||||
\hline
|
||||
Type specifier & Size & Valid Scheme types & Corresponding \texttt{C} types\\
|
||||
\hline
|
||||
\texttt{signed-char} & 1 byte & exact integer & \texttt{char}\\
|
||||
\texttt{unsigned-char} & 1 byte & exact integer & \texttt{unsigned char}\\
|
||||
\texttt{signed-short} & 2 bytes & exact integer & \texttt{short}\\
|
||||
\texttt{unsigned-short} & 2 bytes & exact integer & \texttt{unsigned short}\\
|
||||
\texttt{signed-int} & 4 bytes & exact integer & \texttt{int}\\
|
||||
\texttt{unsigned-int} & 4 bytes & exact integer & \texttt{unsigned int}\\
|
||||
\texttt{signed-long} & 4/8 bytes & exact integer & \texttt{long}\\
|
||||
\texttt{unsigned-long} & 4/8 bytes & exact integer & \texttt{unsigned long}\\
|
||||
\texttt{float} & 4 bytes & flonum & \texttt{float}\\
|
||||
\texttt{double} & 8 bytes & flonum & \texttt{double}\\
|
||||
\texttt{pointer} & 4/8 bytes & pointer &
|
||||
\texttt{void*}, \texttt{char*}, \texttt{int*}, \texttt{int**}, \\
|
||||
&&& \texttt{int(*)(int,int,int)}, etc. \\
|
||||
\texttt{void} & -- & -- & \texttt{void}\\
|
||||
\hline
|
||||
\end{tabular}
|
||||
\end{center}
|
||||
\caption{\label{fig:foreign-types}The above table lists valid type
|
||||
specifiers that can be used in callout and callback signatures.
|
||||
Specifiers with ``4/8 bytes'' have size that depends on the system:
|
||||
it is 4 bytes on 32-bit systems and 8 bytes on 64-bit systems. The
|
||||
\texttt{void} specifier can only be used as a return value
|
||||
specifier to mean ``no useful value is returned''.}
|
||||
\end{figure}
|
||||
}
|
||||
|
||||
|
||||
The following example illustrates the use of the
|
||||
\texttt{make-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}.
|
||||
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}
|
||||
value which is converted to the Scheme flonum with value
|
||||
\texttt{0.7853981633974483}.
|
||||
|
||||
\begin{verbatim}
|
||||
> (import (ikarus foreign))
|
||||
> (define libc (dlopen "libc.dylib"))
|
||||
> libc
|
||||
#<pointer #x00100770>
|
||||
> (define libc-atan-ptr (dlsym libc "atan"))
|
||||
> libc-atan-ptr
|
||||
#<pointer #x9006CB1F>
|
||||
> (define libc-atan
|
||||
((make-callout 'double '(double)) libc-atan-ptr))
|
||||
> libc-atan
|
||||
#<procedure>
|
||||
> (libc-atan 1.0)
|
||||
0.7853981633974483
|
||||
> (libc-atan 1)
|
||||
Unhandled exception
|
||||
Condition components:
|
||||
1. &assertion
|
||||
2. &who: callout-procedure
|
||||
3. &message: "argument does not match type double"
|
||||
4. &irritants: (1)
|
||||
\end{verbatim}
|
||||
|
||||
|
||||
\section{\label{sec:callback}Calling back to Scheme}
|
||||
|
||||
In order to provide full interoperability with native procedures,
|
||||
Ikarus allows native procedures to call back into Scheme just as it
|
||||
allows Scheme to call out to native procedures. This is important
|
||||
for many system libraries that provide graphical user interfaces
|
||||
with event handling (e.g., Cocoa, GTK+, GLUT, etc.), database
|
||||
engines (e.g., libsqlite, libmysql, etc.), among others.
|
||||
|
||||
The native calling site for the call back is compiled with a
|
||||
specific callback signature encoding the expected parameter types
|
||||
and return type. Therefore, a Scheme procedure used for a call back
|
||||
must be wrapped with a proper adapter that converts the incoming
|
||||
parameters from native format to Scheme values as well as convert
|
||||
the value that the Scheme procedure returns back to native format.
|
||||
The signature format is similar to the one used for call outs (see
|
||||
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)}
|
||||
|
||||
The procedure \texttt{make-callback} is similar to the procedure
|
||||
\texttt{make-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
|
||||
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
|
||||
is called with these parameters, and the returned value is converted
|
||||
back into native format (according to \texttt{return-type}) before
|
||||
control returns to the native call site.
|
||||
|
||||
|
||||
Note that the native procedure pointer obtained from
|
||||
\texttt{make-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
|
||||
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))
|
||||
values))
|
||||
#xfedcba09876543210fedcba09876543210))
|
||||
"76543210"
|
||||
\end{verbatim}
|
||||
|
||||
\BoxedText{Caveat emptor:}{Preparing each call out and call back
|
||||
procedure leaks a small amount of memory. This is because the
|
||||
system cannot track such pointers that go into native code
|
||||
(which may retain such pointers indefinitely). Use judiciously.}
|
||||
|
||||
% \chapter{\label{chapter:objc}The \texttt{(ikarus~objc)} Library}
|
||||
% \newpage
|
||||
|
||||
\chapter{\label{chapter:contributed}Contributed Libraries}
|
||||
|
||||
We try to keep Ikarus Scheme small and its complexity manageable.
|
||||
|
@ -2166,7 +2842,15 @@ following lines:
|
|||
export IKARUS_LIBRARY_PATH
|
||||
\end{verbatim}
|
||||
|
||||
|
||||
\newpage
|
||||
|
||||
|
||||
\section{\label{sec:aux-opengl}\texttt{(gl)} and \texttt{(glut)}}
|
||||
FIXME
|
||||
\newpage
|
||||
|
||||
|
||||
\section{\texttt{(srfi *)}}
|
||||
|
||||
Ported by: Derick Eddington
|
||||
|
@ -2253,15 +2937,14 @@ URL: \url{https://launchpad.net/r6rs-clos}
|
|||
|
||||
|
||||
\rnrs{6}-clos is a port of tiny-clos to the latest
|
||||
(6$^{\textrm{th}}$) revision
|
||||
of the language standard for scheme. It uses the library
|
||||
system that is new in \rnrs{6} to structure the code based on
|
||||
functionality (bootstrap of core classes and generic functions,
|
||||
actual implementation of the standard protocols, class layout
|
||||
and slot access \ldots).
|
||||
(6$^{\mathrm{th}}$) revision of the language standard for scheme. It
|
||||
uses the library system that is new in \rnrs{6} to structure the
|
||||
code based on functionality (bootstrap of core classes and generic
|
||||
functions, actual implementation of the standard protocols, class
|
||||
layout and slot access \ldots).
|
||||
|
||||
The homepage for now is \url{https://launchpad.net/r6rs-clos},
|
||||
where my current development branch can be found.
|
||||
The homepage for now is \url{https://launchpad.net/r6rs-clos}, where
|
||||
my current development branch can be found.
|
||||
|
||||
% Currently the code in my repository will only work with the
|
||||
% 0.0.2 release of Ikarus and uses a private copy of two
|
||||
|
@ -2313,77 +2996,48 @@ To load both stream libraries, say:
|
|||
\chapter{Missing Features}
|
||||
|
||||
Ikarus does not fully conform to \rnrs{6} yet. Although it
|
||||
implements more than 94\% of \rnrs{6}'s macros and procedures, some
|
||||
are still missing. This section summarizes the set of missing
|
||||
features and procedures.
|
||||
implements most of \rnrs{6}'s macros and procedures, some are still
|
||||
missing. This section summarizes the set of missing features and
|
||||
procedures.
|
||||
|
||||
|
||||
\begin{itemize}
|
||||
\item Numeric tower is complete except for complex numbers.\\
|
||||
Consequences: \\
|
||||
-- Reader does not recognize complex number notation
|
||||
(e.g.~\texttt{5-7i}).\\
|
||||
-- Procedures that may construct complex numbers from non-complex
|
||||
arguments may signal an error or return an incorrect value
|
||||
(e.g., \texttt{(sqrt~-1)} should return \verb|+i| instead
|
||||
of signaling an error).
|
||||
\item The procedure \texttt{equal?}\ may not terminate on
|
||||
\texttt{equal?}\ infinite (circular) input.
|
||||
\item \texttt{number->string} does not accept the third argument
|
||||
(precision). Similarly, \texttt{string->number} and the reader do
|
||||
not recognize the \texttt{|p} notation.
|
||||
\end{itemize}
|
||||
\newpage
|
||||
\section{List of missing \rnrs{6} procedures}
|
||||
|
||||
The following procedures are missing from \texttt{(rnrs base)}:
|
||||
|
||||
\item The following procedures are missing from \texttt{(rnrs unicode)}:
|
||||
\begin{Verbatim}
|
||||
angle make-polar make-rectangular
|
||||
\end{Verbatim}
|
||||
|
||||
% magnitude
|
||||
% string->utf16
|
||||
% string->utf32
|
||||
% utf16->string
|
||||
% utf32->string
|
||||
|
||||
|
||||
The following procedures are missing from \texttt{(rnrs unicode)}:
|
||||
\begin{Verbatim}
|
||||
string-downcase string-titlecase string-upcase
|
||||
string-titlecase
|
||||
string-normalize-nfc string-normalize-nfd
|
||||
string-normalize-nfkc string-normalize-nfkd
|
||||
\end{Verbatim}
|
||||
|
||||
|
||||
The following procedures are missing from \texttt{(rnrs arithmetic
|
||||
\item The following procedures are missing from \texttt{(rnrs arithmetic
|
||||
bitwise)}:
|
||||
\begin{Verbatim}
|
||||
bitwise-ior bitwise-xor bitwise-if bitwise-copy-bit-field
|
||||
bitwise-reverse-bit-field bitwise-rotate-bit-field
|
||||
\end{Verbatim}
|
||||
% bitwise-bit-field
|
||||
% bitwise-copy-bit
|
||||
% bitwise-length
|
||||
|
||||
The following procedures are missing from \texttt{(rnrs arithmetic
|
||||
\item The following procedures are missing from \texttt{(rnrs arithmetic
|
||||
fixnum)}:
|
||||
\begin{Verbatim}
|
||||
fxreverse-bit-field fxrotate-bit-field
|
||||
\end{Verbatim}
|
||||
|
||||
|
||||
The following procedures are missing from \texttt{(rnrs hashtables)}:
|
||||
\item The following procedures are missing from \texttt{(rnrs hashtables)}:
|
||||
\begin{Verbatim}
|
||||
make-eqv-hashtable make-hashtable equal-hash
|
||||
hashtable-hash-function hashtable-equivalence-function
|
||||
\end{Verbatim}
|
||||
|
||||
|
||||
|
||||
The following procedures are missing from \texttt{(rnrs io ports)}:
|
||||
\item The following procedures are missing from \texttt{(rnrs io ports)}:
|
||||
\begin{Verbatim}
|
||||
string->bytevector bytevector->string
|
||||
port-has-port-position? port-position
|
||||
port-has-set-port-position!? set-port-position!
|
||||
make-custom-binary-input/output-port
|
||||
|
@ -2391,31 +3045,7 @@ make-custom-textual-input/output-port
|
|||
open-file-input/output-port
|
||||
\end{Verbatim}
|
||||
|
||||
|
||||
% get-bytevector-some
|
||||
% call-with-bytevector-output-port
|
||||
% call-with-string-output-port
|
||||
% binary-port?
|
||||
% textual-port?
|
||||
% port-eof?
|
||||
% call-with-port
|
||||
% lookahead-char
|
||||
% lookahead-u8
|
||||
% get-bytevector-all
|
||||
% get-bytevector-some
|
||||
% get-string-all
|
||||
% make-custom-binary-input-port
|
||||
% make-custom-binary-output-port
|
||||
% make-custom-textual-input-port
|
||||
% make-custom-textual-output-port
|
||||
% open-bytevector-input-port
|
||||
% open-bytevector-output-port
|
||||
% open-file-input-port
|
||||
% open-file-output-port
|
||||
% transcoded-port
|
||||
% port-transcoder
|
||||
% put-bytevector
|
||||
% output-port-buffer-mode
|
||||
\end{itemize}
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -14,4 +14,13 @@
|
|||
1
|
||||
(* n [$ self fact: (sub1 n)]))))
|
||||
|
||||
(class-add-class-method IKFact 'fact:ac: 'int '(class selector int int)
|
||||
(trace-lambda fact (self sel n ac)
|
||||
(if (zero? n)
|
||||
ac
|
||||
[$ self fact: (sub1 n) ac: (* n ac)])))
|
||||
|
||||
(printf "(fact 5) = ~s\n" [$ IKFact fact: 5])
|
||||
|
||||
(printf "(fact 5) = ~s\n" [$ IKFact fact: 5 ac: 1])
|
||||
|
||||
|
|
|
@ -4,15 +4,15 @@
|
|||
|
||||
(define (make-app)
|
||||
(define kProcessTransformToForegroundApplication 1)
|
||||
(define self (dlopen #f))
|
||||
(define self (dlopen))
|
||||
(define get-current-process
|
||||
((make-ffi 'void '(pointer))
|
||||
((make-callout 'void '(pointer))
|
||||
(dlsym self "GetCurrentProcess")))
|
||||
(define transform-process-type
|
||||
((make-ffi 'void '(pointer sint32))
|
||||
((make-callout 'void '(pointer signed-int))
|
||||
(dlsym self "TransformProcessType")))
|
||||
(define set-front-process
|
||||
((make-ffi 'void '(pointer))
|
||||
((make-callout 'void '(pointer))
|
||||
(dlsym self "SetFrontProcess")))
|
||||
(let ([p (malloc 16)])
|
||||
(get-current-process p)
|
||||
|
|
|
@ -1,8 +1,11 @@
|
|||
libstreamsdir=$(pkglibdir)/streams
|
||||
dist_libstreams_DATA=streams/primitive.ss streams/derived.ss
|
||||
libikarusdir=$(pkglibdir)/ikarus
|
||||
dist_libikarus_DATA=ikarus/foreign.ss
|
||||
libCocoadir=$(pkglibdir)/Cocoa
|
||||
dist_libCocoa_DATA=Cocoa/helpers.ss
|
||||
|
||||
|
||||
dist_pkglib_DATA= streams.ss match.ss pregexp.ss gl.ss glut.ss \
|
||||
ypsilon-compat.ikarus.ss ypsilon-compat.ypsilon.ss \
|
||||
objc.ss Cocoa.ss
|
||||
|
|
|
@ -34,9 +34,9 @@ build_triplet = @build@
|
|||
host_triplet = @host@
|
||||
target_triplet = @target@
|
||||
subdir = lib
|
||||
DIST_COMMON = $(dist_libCocoa_DATA) $(dist_libstreams_DATA) \
|
||||
$(dist_pkglib_DATA) $(srcdir)/Makefile.am \
|
||||
$(srcdir)/Makefile.in
|
||||
DIST_COMMON = $(dist_libCocoa_DATA) $(dist_libikarus_DATA) \
|
||||
$(dist_libstreams_DATA) $(dist_pkglib_DATA) \
|
||||
$(srcdir)/Makefile.am $(srcdir)/Makefile.in
|
||||
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
||||
am__aclocal_m4_deps = $(top_srcdir)/configure.ac
|
||||
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
|
||||
|
@ -53,12 +53,14 @@ am__vpath_adj = case $$p in \
|
|||
esac;
|
||||
am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
|
||||
am__installdirs = "$(DESTDIR)$(libCocoadir)" \
|
||||
"$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"
|
||||
"$(DESTDIR)$(libikarusdir)" "$(DESTDIR)$(libstreamsdir)" \
|
||||
"$(DESTDIR)$(pkglibdir)"
|
||||
dist_libCocoaDATA_INSTALL = $(INSTALL_DATA)
|
||||
dist_libikarusDATA_INSTALL = $(INSTALL_DATA)
|
||||
dist_libstreamsDATA_INSTALL = $(INSTALL_DATA)
|
||||
dist_pkglibDATA_INSTALL = $(INSTALL_DATA)
|
||||
DATA = $(dist_libCocoa_DATA) $(dist_libstreams_DATA) \
|
||||
$(dist_pkglib_DATA)
|
||||
DATA = $(dist_libCocoa_DATA) $(dist_libikarus_DATA) \
|
||||
$(dist_libstreams_DATA) $(dist_pkglib_DATA)
|
||||
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
|
||||
ACLOCAL = @ACLOCAL@
|
||||
AMTAR = @AMTAR@
|
||||
|
@ -163,6 +165,8 @@ top_builddir = @top_builddir@
|
|||
top_srcdir = @top_srcdir@
|
||||
libstreamsdir = $(pkglibdir)/streams
|
||||
dist_libstreams_DATA = streams/primitive.ss streams/derived.ss
|
||||
libikarusdir = $(pkglibdir)/ikarus
|
||||
dist_libikarus_DATA = ikarus/foreign.ss
|
||||
libCocoadir = $(pkglibdir)/Cocoa
|
||||
dist_libCocoa_DATA = Cocoa/helpers.ss
|
||||
dist_pkglib_DATA = streams.ss match.ss pregexp.ss gl.ss glut.ss \
|
||||
|
@ -218,6 +222,23 @@ uninstall-dist_libCocoaDATA:
|
|||
echo " rm -f '$(DESTDIR)$(libCocoadir)/$$f'"; \
|
||||
rm -f "$(DESTDIR)$(libCocoadir)/$$f"; \
|
||||
done
|
||||
install-dist_libikarusDATA: $(dist_libikarus_DATA)
|
||||
@$(NORMAL_INSTALL)
|
||||
test -z "$(libikarusdir)" || $(MKDIR_P) "$(DESTDIR)$(libikarusdir)"
|
||||
@list='$(dist_libikarus_DATA)'; for p in $$list; do \
|
||||
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
|
||||
f=$(am__strip_dir) \
|
||||
echo " $(dist_libikarusDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(libikarusdir)/$$f'"; \
|
||||
$(dist_libikarusDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(libikarusdir)/$$f"; \
|
||||
done
|
||||
|
||||
uninstall-dist_libikarusDATA:
|
||||
@$(NORMAL_UNINSTALL)
|
||||
@list='$(dist_libikarus_DATA)'; for p in $$list; do \
|
||||
f=$(am__strip_dir) \
|
||||
echo " rm -f '$(DESTDIR)$(libikarusdir)/$$f'"; \
|
||||
rm -f "$(DESTDIR)$(libikarusdir)/$$f"; \
|
||||
done
|
||||
install-dist_libstreamsDATA: $(dist_libstreams_DATA)
|
||||
@$(NORMAL_INSTALL)
|
||||
test -z "$(libstreamsdir)" || $(MKDIR_P) "$(DESTDIR)$(libstreamsdir)"
|
||||
|
@ -289,7 +310,7 @@ check-am: all-am
|
|||
check: check-am
|
||||
all-am: Makefile $(DATA)
|
||||
installdirs:
|
||||
for dir in "$(DESTDIR)$(libCocoadir)" "$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"; do \
|
||||
for dir in "$(DESTDIR)$(libCocoadir)" "$(DESTDIR)$(libikarusdir)" "$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"; do \
|
||||
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
|
||||
done
|
||||
install: install-am
|
||||
|
@ -334,7 +355,8 @@ info: info-am
|
|||
|
||||
info-am:
|
||||
|
||||
install-data-am: install-dist_libCocoaDATA install-dist_libstreamsDATA
|
||||
install-data-am: install-dist_libCocoaDATA install-dist_libikarusDATA \
|
||||
install-dist_libstreamsDATA
|
||||
|
||||
install-dvi: install-dvi-am
|
||||
|
||||
|
@ -368,7 +390,7 @@ ps: ps-am
|
|||
|
||||
ps-am:
|
||||
|
||||
uninstall-am: uninstall-dist_libCocoaDATA \
|
||||
uninstall-am: uninstall-dist_libCocoaDATA uninstall-dist_libikarusDATA \
|
||||
uninstall-dist_libstreamsDATA uninstall-dist_pkglibDATA
|
||||
|
||||
.MAKE: install-am install-strip
|
||||
|
@ -376,15 +398,16 @@ uninstall-am: uninstall-dist_libCocoaDATA \
|
|||
.PHONY: all all-am check check-am clean clean-generic distclean \
|
||||
distclean-generic distdir dvi dvi-am html html-am info info-am \
|
||||
install install-am install-data install-data-am \
|
||||
install-dist_libCocoaDATA install-dist_libstreamsDATA \
|
||||
install-dist_pkglibDATA install-dvi install-dvi-am \
|
||||
install-exec install-exec-am install-html install-html-am \
|
||||
install-info install-info-am install-man install-pdf \
|
||||
install-pdf-am install-ps install-ps-am install-strip \
|
||||
installcheck installcheck-am installdirs maintainer-clean \
|
||||
maintainer-clean-generic mostlyclean mostlyclean-generic pdf \
|
||||
pdf-am ps ps-am uninstall uninstall-am \
|
||||
uninstall-dist_libCocoaDATA uninstall-dist_libstreamsDATA \
|
||||
install-dist_libCocoaDATA install-dist_libikarusDATA \
|
||||
install-dist_libstreamsDATA install-dist_pkglibDATA \
|
||||
install-dvi install-dvi-am install-exec install-exec-am \
|
||||
install-html install-html-am install-info install-info-am \
|
||||
install-man install-pdf install-pdf-am install-ps \
|
||||
install-ps-am install-strip installcheck installcheck-am \
|
||||
installdirs maintainer-clean maintainer-clean-generic \
|
||||
mostlyclean mostlyclean-generic pdf pdf-am ps ps-am uninstall \
|
||||
uninstall-am uninstall-dist_libCocoaDATA \
|
||||
uninstall-dist_libikarusDATA uninstall-dist_libstreamsDATA \
|
||||
uninstall-dist_pkglibDATA
|
||||
|
||||
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
||||
|
|
|
@ -0,0 +1,17 @@
|
|||
|
||||
(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
|
||||
pointer->integer integer->pointer pointer? dlopen dlsym
|
||||
dlclose dlerror
|
||||
make-callout make-callback)
|
||||
|
||||
(import (ikarus system $foreign)))
|
||||
|
26
lib/objc.ss
26
lib/objc.ss
|
@ -61,7 +61,7 @@
|
|||
|
||||
(define (pointer-ref addr offset)
|
||||
(assert (pointer? addr))
|
||||
(integer->pointer (pointer-ref-long addr offset)))
|
||||
(integer->pointer (pointer-ref-signed-long addr offset)))
|
||||
|
||||
(define (offset? x) (or (fixnum? x) (bignum? x)))
|
||||
|
||||
|
@ -75,7 +75,7 @@
|
|||
(define (char*len x)
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(zero? (pointer-ref-uchar x i)) i]
|
||||
[(zero? (pointer-ref-unsigned-char x i)) i]
|
||||
[else (f (+ i 1))])))
|
||||
|
||||
(define (char*->bv x)
|
||||
|
@ -85,7 +85,7 @@
|
|||
(cond
|
||||
[(= i n) bv]
|
||||
[else
|
||||
(bytevector-u8-set! bv i (pointer-ref-uchar x i))
|
||||
(bytevector-u8-set! bv i (pointer-ref-unsigned-char x i))
|
||||
(f (+ i 1))])))))
|
||||
|
||||
(define (bv->char* x)
|
||||
|
@ -183,7 +183,7 @@
|
|||
|
||||
(define (class-instance-size x)
|
||||
(check 'class-instance-size class? x)
|
||||
(pointer-ref-long (class-ptr x) objc-class-instance-size-offset))
|
||||
(pointer-ref-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-int (ivar-ptr x) (* 2 ptrsize)))
|
||||
(pointer-ref-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-long p 0)])
|
||||
(let ([n (pointer-ref-signed-long p 0)])
|
||||
(let f ([i 0] [off objc-ivarlist-ivars-offset])
|
||||
(if (= i n)
|
||||
'()
|
||||
|
@ -312,11 +312,11 @@
|
|||
(cond
|
||||
[(assq what alist) => cadr]
|
||||
[else (error 'class-is? "invalid what" what)])])
|
||||
(= mask (bitwise-and mask (pointer-ref-long (class-ptr x) (* ptrsize 4))))))
|
||||
(= mask (bitwise-and mask (pointer-ref-signed-long (class-ptr x) (* ptrsize 4))))))
|
||||
|
||||
(define (class-methods x)
|
||||
(define (methods x)
|
||||
(let ([n (pointer-ref-int x ptrsize)]
|
||||
(let ([n (pointer-ref-signed-int x ptrsize)]
|
||||
[array (integer->pointer (+ (pointer->integer x) (* 2 ptrsize)))])
|
||||
(let f ([i 0])
|
||||
(if (= i n)
|
||||
|
@ -354,7 +354,7 @@
|
|||
(cons
|
||||
(make-class
|
||||
(integer->pointer
|
||||
(pointer-ref-long buffer (* ptrsize i))))
|
||||
(pointer-ref-signed-long buffer (* ptrsize i))))
|
||||
ac)))))))))
|
||||
|
||||
(define (nil? x)
|
||||
|
@ -569,9 +569,9 @@
|
|||
[(class) 'pointer]
|
||||
[(void) 'void]
|
||||
[(float) 'float]
|
||||
[(uint) 'uint32]
|
||||
[(int) 'sint32]
|
||||
[(char) 'sint8]
|
||||
[(uint) 'unsigned-int]
|
||||
[(int) 'signed-int]
|
||||
[(char) 'signed-char]
|
||||
[(char*) 'pointer]
|
||||
[else (error 'objc-type->ikarus-type "invalid type" x)])]))
|
||||
|
||||
|
@ -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-ffi
|
||||
(let ([ffi (make-callout
|
||||
(objc-type->ikarus-type rtype)
|
||||
(map objc-type->ikarus-type argtypes))])
|
||||
(let ([proc (ffi mptr)])
|
||||
|
|
|
@ -54,6 +54,9 @@
|
|||
(define-record-type library (fields name pointer))
|
||||
|
||||
(define (load-shared-object libname)
|
||||
(unless (string? libname)
|
||||
(error 'load-shared-object "library name must be a string"
|
||||
libname))
|
||||
(make-library libname
|
||||
(or (dlopen libname)
|
||||
(error 'load-shared-object (dlerror) libname))))
|
||||
|
@ -184,7 +187,7 @@
|
|||
(define (strlen x)
|
||||
(let f ([i 0])
|
||||
(cond
|
||||
[(= 0 (pointer-ref-uchar x i)) i]
|
||||
[(= 0 (pointer-ref-unsigned-char x i)) i]
|
||||
[else (f (+ i 1))])))
|
||||
(let ([n (strlen x)])
|
||||
(let ([s (make-string n)])
|
||||
|
@ -192,7 +195,8 @@
|
|||
(if (= i n)
|
||||
s
|
||||
(begin
|
||||
(string-set! s i (integer->char (pointer-ref-uchar x i)))
|
||||
(string-set! s i
|
||||
(integer->char (pointer-ref-unsigned-char x i)))
|
||||
(f (+ i 1))))))))
|
||||
|
||||
(define-syntax convert-return
|
||||
|
@ -213,7 +217,7 @@
|
|||
[double double]
|
||||
[void* pointer]
|
||||
[byte* pointer]
|
||||
[int sint32]))
|
||||
[int signed-int]))
|
||||
(define (valid x)
|
||||
(cond
|
||||
[(and (list? x) (= (length x) 3) (eq? (car x) 'c-callback))
|
||||
|
@ -250,7 +254,7 @@
|
|||
(with-syntax ([x x]
|
||||
[(t* ...) (generate-temporaries #'(arg-type* ...))])
|
||||
#'(let ([callout
|
||||
((make-ffi
|
||||
((make-callout
|
||||
(convert-type return-type)
|
||||
(list (convert-type arg-type*) ...))
|
||||
(lookup-shared-object lib 'foreign-name))])
|
||||
|
|
|
@ -2,10 +2,19 @@
|
|||
(library (ikarus.pointers)
|
||||
(export pointer? integer->pointer pointer->integer
|
||||
dlopen dlerror dlclose dlsym malloc free
|
||||
pointer-ref-char pointer-ref-short pointer-ref-int pointer-ref-long
|
||||
pointer-ref-uchar pointer-ref-ushort pointer-ref-uint pointer-ref-ulong
|
||||
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
|
||||
make-ffi make-callback)
|
||||
pointer-set-pointer pointer-ref-pointer
|
||||
pointer-set-float pointer-ref-float
|
||||
pointer-set-double pointer-ref-double
|
||||
make-callout make-callback)
|
||||
(import
|
||||
(except (ikarus)
|
||||
pointer?
|
||||
|
@ -41,15 +50,18 @@
|
|||
(and p (utf8->string p)))))
|
||||
|
||||
(define dlopen
|
||||
(case-lambda
|
||||
[(x) (dlopen x #t #t)]
|
||||
[(x lazy? global?)
|
||||
(define (open x)
|
||||
(foreign-call "ikrt_dlopen" x lazy? global?))
|
||||
(cond
|
||||
[(not x) (open #f)]
|
||||
[(string? x) (open (string->utf8 x))]
|
||||
[else (die 'dlopen "name should be a string or #f" x)])]))
|
||||
(let ()
|
||||
(define (open x lazy? global?)
|
||||
(foreign-call "ikrt_dlopen" x lazy? global?))
|
||||
(case-lambda
|
||||
[()
|
||||
(open #f #f #f)]
|
||||
[(x)
|
||||
(dlopen x #f #f)]
|
||||
[(x lazy? global?)
|
||||
(cond
|
||||
[(string? x) (open (string->utf8 x) lazy? global?)]
|
||||
[else (die 'dlopen "library name must be a string" x)])])))
|
||||
|
||||
(define dlclose
|
||||
(lambda (x)
|
||||
|
@ -93,34 +105,74 @@
|
|||
|
||||
(define-syntax define-setter
|
||||
(syntax-rules ()
|
||||
[(_ name foreign-name)
|
||||
[(_ name pred? foreign-name)
|
||||
(define name
|
||||
(lambda (p i v)
|
||||
(if (pointer? p)
|
||||
(if (fixnum? i)
|
||||
(if (or (fixnum? v) (bignum? v))
|
||||
(if (pred? v)
|
||||
(foreign-call foreign-name p i v)
|
||||
(die 'name "value must be a fixnum or bignum" v))
|
||||
(die 'name
|
||||
(format "value must satisfy the predicate ~a" 'pred?)
|
||||
v))
|
||||
(die 'name "index is not a fixnum" i))
|
||||
(die 'name "not a pointer" p))))]))
|
||||
|
||||
(define-getter pointer-ref-char "ikrt_ref_char")
|
||||
(define-getter pointer-ref-short "ikrt_ref_short")
|
||||
(define-getter pointer-ref-int "ikrt_ref_int")
|
||||
(define-getter pointer-ref-long "ikrt_ref_long")
|
||||
|
||||
(define-getter pointer-ref-uchar "ikrt_ref_uchar")
|
||||
(define-getter pointer-ref-ushort "ikrt_ref_ushort")
|
||||
(define-getter pointer-ref-uint "ikrt_ref_uint")
|
||||
(define-getter pointer-ref-ulong "ikrt_ref_ulong")
|
||||
(define (int? x) (or (fixnum? x) (bignum? x)))
|
||||
|
||||
(define-setter pointer-set-char "ikrt_set_char")
|
||||
(define-setter pointer-set-short "ikrt_set_short")
|
||||
(define-setter pointer-set-int "ikrt_set_int")
|
||||
(define-setter pointer-set-long "ikrt_set_long")
|
||||
(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-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")
|
||||
|
||||
;;; libffi interface
|
||||
|
||||
(define (checker who)
|
||||
(define (checker t)
|
||||
(cond
|
||||
[(vector? t)
|
||||
(let ([t* (vector-map checker t)])
|
||||
(lambda (v)
|
||||
(and (vector? v)
|
||||
(let ([n (vector-length v)])
|
||||
(and (= n (vector-length t))
|
||||
(let f ([i 0])
|
||||
(or (= i n)
|
||||
(and ((vector-ref t* i) (vector-ref v i))
|
||||
(f (+ i 1))))))))))]
|
||||
[else
|
||||
(case t
|
||||
[(unsigned-char) int?]
|
||||
[(signed-char) int?]
|
||||
[(unsigned-short) int?]
|
||||
[(signed-short) int?]
|
||||
[(unsigned-int) int?]
|
||||
[(signed-int) int?]
|
||||
[(unsigned-long) int?]
|
||||
[(signed-long) int?]
|
||||
[(float) flonum?]
|
||||
[(double) flonum?]
|
||||
[(pointer) pointer?]
|
||||
[else (die who "invalid type" t)])]))
|
||||
checker)
|
||||
|
||||
|
||||
|
||||
(define (ffi-prep-cif rtype argtypes)
|
||||
(define who 'ffi-prep-cif)
|
||||
(define (convert x)
|
||||
|
@ -128,18 +180,18 @@
|
|||
[(vector? x) (vector-map convert x)]
|
||||
[else
|
||||
(case x
|
||||
[(void) 1]
|
||||
[(uint8) 2]
|
||||
[(sint8) 3]
|
||||
[(uint16) 4]
|
||||
[(sint16) 5]
|
||||
[(uint32) 6]
|
||||
[(sint32) 7]
|
||||
[(uint64) 8]
|
||||
[(sint64) 9]
|
||||
[(float) 10]
|
||||
[(double) 11]
|
||||
[(pointer) 12]
|
||||
[(void) 1]
|
||||
[(unsigned-char) 2]
|
||||
[(signed-char) 3]
|
||||
[(unsigned-short) 4]
|
||||
[(signed-short) 5]
|
||||
[(unsigned-int) 6]
|
||||
[(signed-int) 7]
|
||||
[(unsigned-long) 8]
|
||||
[(signed-long) 9]
|
||||
[(float) 10]
|
||||
[(double) 11]
|
||||
[(pointer) 12]
|
||||
[else (die who "invalid type" x)])]))
|
||||
(unless (list? argtypes)
|
||||
(die who "arg types is not a list" argtypes))
|
||||
|
@ -150,31 +202,55 @@
|
|||
argtypes-n
|
||||
rtype-n)))
|
||||
|
||||
(define (make-ffi rtype argtypes)
|
||||
(define who 'make-ffi)
|
||||
(define (make-callout rtype argtypes)
|
||||
(define who 'make-callout)
|
||||
(let-values ([(cif argtypes-n rtype-n)
|
||||
(ffi-prep-cif rtype argtypes)])
|
||||
(lambda (cfun)
|
||||
(define data (vector cif cfun argtypes-n rtype-n))
|
||||
(unless (pointer? cfun)
|
||||
(die 'ffi "not a pointer" cfun))
|
||||
(lambda args
|
||||
(let ([argsvec (list->vector args)])
|
||||
(unless (= (vector-length argsvec)
|
||||
(vector-length argtypes-n))
|
||||
(error 'ffi "args mismatch" argtypes args))
|
||||
(foreign-call "ikrt_ffi_call" data argsvec))))))
|
||||
(let* ([argtypes-vec (list->vector argtypes)]
|
||||
[checkers (vector-map (checker who) argtypes-vec)])
|
||||
(lambda (cfun)
|
||||
(define data (vector cif cfun argtypes-n rtype-n))
|
||||
(unless (pointer? cfun)
|
||||
(die who "not a pointer" cfun))
|
||||
(lambda args
|
||||
(let ([argsvec (list->vector args)])
|
||||
(unless (= (vector-length argsvec)
|
||||
(vector-length argtypes-vec))
|
||||
(error 'callout-procedure "arg length mismatch"
|
||||
(vector->list argtypes-vec)
|
||||
args))
|
||||
(vector-for-each
|
||||
(lambda (p? t x)
|
||||
(unless (p? x)
|
||||
(die 'callout-procedure
|
||||
(format "argument does not match type ~a" t)
|
||||
x)))
|
||||
checkers argtypes-vec argsvec)
|
||||
(foreign-call "ikrt_ffi_call" data argsvec)))))))
|
||||
|
||||
(define (make-callback rtype argtypes)
|
||||
(let-values ([(cif argtypes-n rtype-n)
|
||||
(ffi-prep-cif rtype argtypes)])
|
||||
(lambda (proc)
|
||||
(define who 'make-callback)
|
||||
(define data (vector cif proc argtypes-n rtype-n))
|
||||
(unless (procedure? proc)
|
||||
(die who "not a procedure"))
|
||||
(or (foreign-call "ikrt_prepare_callback" data)
|
||||
(die who "cannot prepare foreign callback")))))
|
||||
(let ([proc
|
||||
(cond
|
||||
[(eq? rtype 'void) proc]
|
||||
[else
|
||||
(let ([p? ((checker who) rtype)])
|
||||
(lambda args
|
||||
(let ([v (apply proc args)])
|
||||
(unless (p? v)
|
||||
(die 'callback
|
||||
(format "returned value does not match type ~a"
|
||||
rtype)
|
||||
v))
|
||||
v)))])])
|
||||
(let ([data (vector cif proc argtypes-n rtype-n)])
|
||||
(or (foreign-call "ikrt_prepare_callback" data)
|
||||
(die who "cannot prepare foreign callback")))))))
|
||||
|
||||
)
|
||||
|
||||
|
|
|
@ -1 +1 @@
|
|||
1617
|
||||
1620
|
||||
|
|
|
@ -1455,29 +1455,35 @@
|
|||
[cp0-effort-limit i]
|
||||
[tag-analysis-output i]
|
||||
[perform-tag-analysis i]
|
||||
[pointer? $for]
|
||||
[pointer->integer $for]
|
||||
[integer->pointer $for]
|
||||
[dlopen $for]
|
||||
[dlerror $for]
|
||||
[dlclose $for]
|
||||
[dlsym $for]
|
||||
[malloc $for]
|
||||
[free $for]
|
||||
[pointer-ref-char $for]
|
||||
[pointer-ref-short $for]
|
||||
[pointer-ref-int $for]
|
||||
[pointer-ref-long $for]
|
||||
[pointer-ref-uchar $for]
|
||||
[pointer-ref-ushort $for]
|
||||
[pointer-ref-uint $for]
|
||||
[pointer-ref-ulong $for]
|
||||
[pointer-set-char $for]
|
||||
[pointer-set-short $for]
|
||||
[pointer-set-int $for]
|
||||
[pointer-set-long $for]
|
||||