float, double, char* struct fields
Slava Pestov
parent
5f681178c6
commit
3d71ca54e4
|
|
@ -4,6 +4,8 @@ Factor 0.75:
|
|||
The SO_OOBINLINE socket flag is now set. In 0.74, sending out-of-band
|
||||
data could fill up the buffer and cause a denial-of-service attack.
|
||||
|
||||
The alien interface now supports "float" and "double" types.
|
||||
|
||||
Factor 0.74:
|
||||
------------
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
- if external factor is down, don't add tons of random shit to the
|
||||
dictionary
|
||||
- faster layout
|
||||
- rotating cube demo
|
||||
- out parameter cleanup
|
||||
- SDL_Rect** type
|
||||
- get all-tests to run with -no-compile
|
||||
- fix i/o on generic x86/ppc unix
|
||||
|
|
@ -34,6 +32,7 @@
|
|||
- dipping seq-2nmap, seq-2each
|
||||
- array sort
|
||||
- tiled window manager
|
||||
- PPC #box-float #unbox-float
|
||||
|
||||
+ plugin:
|
||||
|
||||
|
|
@ -53,8 +52,8 @@
|
|||
|
||||
+ ffi:
|
||||
|
||||
- smarter out parameter handling
|
||||
- clarify powerpc passing of value struct parameters
|
||||
- char* struct members
|
||||
- box/unbox_signed/unsigned_8
|
||||
- ffi unicode strings: null char security hole
|
||||
- utf16 string boxing
|
||||
|
|
|
|||
325
doc/handbook.tex
325
doc/handbook.tex
|
|
@ -4128,7 +4128,330 @@ Key&Description\\
|
|||
|
||||
Hyperlinks to files and words point to the file and browser responders, respectively. These responders must be enabled for such links to function.
|
||||
|
||||
\section{C library interface}
|
||||
\section{Alien interface}
|
||||
|
||||
Factor's alien inteface provides a means of directly calling native libraries written in C and other languages. There are no
|
||||
wrappers to write, other than having to specify the return type and parameter types for
|
||||
the functions you wish to call.
|
||||
|
||||
\subsection{Loading native libraries}
|
||||
|
||||
A native library must be made available to Factor under a logical name before use. This is done via command line parameters, or the \verb|add-library| word.
|
||||
|
||||
The following two command line parameters can be specified for each library to load; the second parameter is optional.
|
||||
\begin{description}
|
||||
\item[\texttt{-libraries:\emph{logical}:name=\emph{name}}] associates a logical name with a system-specific native library name,
|
||||
\item[\texttt{-libraries:\emph{logical}:abi=\emph{type}}] specifies the calling convention to use; \verb|type| is either \verb|cdecl| or \verb|stdcall|. If not specified, the default is \verb|cdecl|. On Unix, all libraries follow the \verb|cdecl| convention. On Windows, most libraries (but not all) follow \verb|stdcall|.
|
||||
\end{description}
|
||||
|
||||
For example:
|
||||
\begin{alltt}
|
||||
\textbf{\$} ./f factor.image -libraries:sdl:name=libSDL-1.2.so
|
||||
\end{alltt}
|
||||
|
||||
Another option is to add libraries while Factor is running.
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{add-library}{add-library ( library name abi -- )}
|
||||
}
|
||||
Adds a logical library named \verb|library|. The underlying shared library name is \verb|name|, and the calling convention is \verb|abi| and must be either \verb|"cdecl"| or \verb|"stdcall"|.
|
||||
|
||||
For example:
|
||||
\begin{alltt}
|
||||
\textbf{ok} "kernel32" "kernel32.dll" "stdcall" add-library
|
||||
\end{alltt}
|
||||
The next word is used in the implementation of the alien interface, and it can also be used
|
||||
interactively to test if a library can be loaded.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{load-library}{load-library ( library -- dll )}
|
||||
}
|
||||
Attempts to load the library with the given logical name, and outputs a DLL handle. If the library is already loaded, the existing DLL is output.
|
||||
More will be said about DLL handles in \ref{alien-internals}.
|
||||
|
||||
\subsection{Calling native functions}
|
||||
|
||||
Native functions are called with the \verb|alien-invoke| word. This word can only be used
|
||||
from compiled definitions (\ref{compiler}). Executing it inside an interpreted quotation will throw an exception.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{alien-invoke}{alien-invoke ( return lib func parameters -- )}
|
||||
}
|
||||
Invokes the function named \verb|func| in the library with logical name \verb|lib|.
|
||||
|
||||
The \verb|return| value is a string naming a C type, and maybe set to \verb|void|, in the case of the native function not returning a value.
|
||||
|
||||
The \verb|parameters| value is a list
|
||||
of strings naming C types. C types are listed in table \ref{c-types}.
|
||||
|
||||
For example, suppose you have a \verb|foo| library exporting the following function:
|
||||
\begin{verbatim}
|
||||
void the_answer(char* question, int value) {
|
||||
printf("The answer to %s is %d.\n",question,value);
|
||||
}
|
||||
\end{verbatim}
|
||||
You can define a word for invoking it:
|
||||
\begin{verbatim}
|
||||
: the-answer ( question value -- answer )
|
||||
"void" "foo" "the_answer" [ "char*" "int" ]
|
||||
alien-invoke ;
|
||||
\end{verbatim}
|
||||
Now, after being compiled, the word can be executed with two parameters on the stack:
|
||||
\begin{alltt}
|
||||
\textbf{ok} \bs the-answer compile
|
||||
\textbf{Compiling the-answer}
|
||||
\textbf{ok} "the question" 42 the-answer
|
||||
\textbf{The answer to the question is 42.}
|
||||
\end{alltt}
|
||||
|
||||
\subsection{\label{aliens}Alien objects}
|
||||
|
||||
\glossary{
|
||||
name=alien,
|
||||
description={an instance of the \verb|alien| class, holding a pointer to native memory outside the Factor heap}}
|
||||
The alien interface can work with an assortment of native data types:
|
||||
\begin{itemize}
|
||||
\item integer and floating point values
|
||||
\item null-terminated strings
|
||||
\item structures (\ref{alien-structs})
|
||||
\item unions (\ref{alien-unions})
|
||||
\end{itemize}
|
||||
Table \ref{c-types} lists the built-in return value and parameter types. The sizes are given for a 32-bit system. Native numbers and strings are handled in a straight-forward way. Pointers are a bit more complicated, and are wrapped inside alien objects on the Factor side.
|
||||
|
||||
\begin{table}
|
||||
\caption{\label{c-types}Supported native types}
|
||||
\begin{tabular}{l|l|l}
|
||||
Name&Size&Representation\\
|
||||
\hline
|
||||
\texttt{char} &1& Signed integer\\
|
||||
\texttt{uchar} &1& Unsigned integer\\
|
||||
\texttt{short} &2& Signed integer\\
|
||||
\texttt{ushort} &2& Unsigned integer\\
|
||||
\texttt{int} &4& Signed integer\\
|
||||
\texttt{uint} &4& Unsigned integer\\
|
||||
\texttt{long} &4& Signed integer\\
|
||||
\texttt{ulong} &4& Unsigned integer\\
|
||||
\texttt{longlong} &8& Signed integer\\
|
||||
\texttt{ulonglong} &8& Unsigned integer\\
|
||||
\texttt{float} &4& Single-precision float\\
|
||||
\texttt{double} &8& Double-precision float\\
|
||||
\texttt{char*} &4& Pointer to null-terminated byte string\\
|
||||
\texttt{ushort*} &4& Pointer to null-terminated UTF16 string\\
|
||||
\texttt{void*} &4& Generic pointer
|
||||
\end{tabular}
|
||||
\end{table}
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{c-size}{c-size ( type -- n )}
|
||||
}
|
||||
Outputs the size of the given C type. This is just like the \verb|sizeof| operator in C.
|
||||
Many native functions expect you to specify sizes for input and output parameters, and
|
||||
this word can be used for that purpose.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\classword{alien}
|
||||
}
|
||||
Pointers to native memory, including \verb|void*| and other types, are represented as objects of the \verb|alien| class.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\predword{alien?}
|
||||
}
|
||||
Tests if the object at the top of the stack is an alien pointer.
|
||||
|
||||
\subsubsection{\label{alien-structs}Structures}
|
||||
|
||||
One way to think of a C-style \verb|struct| is that it abstracts reading and writing field values stored at a range of memory given a pointer, by associating a type and offset with each field. This is the view taken by the alien interface, where defining a C structure creates a set of words for reading and writing fields of various types, offset from a base pointer given by an alien object.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\parsingword{BEGIN-STRUCT:}{BEGIN-STRUCT: \emph{name}}
|
||||
}
|
||||
Begins reading a C structure definition.
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\parsingword{FIELD:}{FIELD: \emph{type} \emph{name}}
|
||||
}
|
||||
Adds a field to the structure. The \verb|type| token identifies a C type, and \verb|name| gives a name to the field. A pair of words is defined, where \verb|structure| and \verb|field| are names, respectively:
|
||||
\begin{alltt}
|
||||
\emph{structure}-\emph{field} ( alien -- value )
|
||||
set-\emph{structure}-\emph{field} ( value alien -- )
|
||||
\end{alltt}
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\parsingword{END-STRUCT}{END-STRUCT}
|
||||
}
|
||||
Ends a structure definition.
|
||||
|
||||
Defining a structure adds two new C types, where \verb|name| is the name of the structure:
|
||||
\begin{description}
|
||||
\item[\texttt{\emph{name}}] the type of the structure itself; structure and union definitions can define members to be of this type.
|
||||
\item[\texttt{\emph{name}*}] the type of a pointer to the structure; this type can be used with return values and parameters, and in fact it is an alias for \texttt{void*}.
|
||||
\end{description}
|
||||
Additionally, the following two words are defined:
|
||||
\begin{description}
|
||||
\item[\texttt{<\emph{name}> ( -- byte-array )}] allocates a byte array large enough to hold the structure in the Factor heap. The field accessor words can then be used to work with this byte array. This feature allows calling native functions that expect pointers to caller-allocated structures\footnote{
|
||||
There is an important restriction, however; the function must not retain the pointer in a global variable after it returns. Since the structure is allocated in the Factor heap, the garbage collector is free to move it between native function calls. If this behavior is undesirable, memory can be managed manually instead (\ref{malloc}).}.
|
||||
\item[\texttt{\emph{name}-nth ( n alien -- alien )}] given a pointer and index into an array of structures, returns a pointer to the structure at that index.
|
||||
\end{description}
|
||||
|
||||
Here is an example of a structure with various fields:
|
||||
\begin{verbatim}
|
||||
BEGIN-STRUCT: surface
|
||||
FIELD: uint flags
|
||||
FIELD: format* format
|
||||
FIELD: int w
|
||||
FIELD: int h
|
||||
FIELD: ushort pitch
|
||||
FIELD: void* pixels
|
||||
FIELD: int offset
|
||||
FIELD: void* hwdata
|
||||
FIELD: short clip-x
|
||||
FIELD: short clip-y
|
||||
FIELD: ushort clip-w
|
||||
FIELD: ushort clip-h
|
||||
FIELD: uint unused1
|
||||
FIELD: uint locked
|
||||
FIELD: int map
|
||||
FIELD: uint format_version
|
||||
FIELD: int refcount
|
||||
END-STRUCT
|
||||
\end{verbatim}
|
||||
|
||||
\subsubsection{\label{alien-unions}Unions}
|
||||
|
||||
A C-style \verb|union| type allocates enough space for its largest member. In the alien interface, unions are used to allocate byte arrays in the Factor heap that may hold any one of the union's members.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\parsingword{BEGIN-STRUCT:}{BEGIN-STRUCT: \emph{name}}
|
||||
}
|
||||
Begins reading a C union definition.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\parsingword{MEMBER:}{MEMBER: \emph{type}}
|
||||
}
|
||||
Adds a member type to the union.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\parsingword{END-UNION}{END-UNION}
|
||||
}
|
||||
Ends a union definition.
|
||||
|
||||
Unions define C types and words analogous to those for structures; see \ref{alien-structs}.
|
||||
|
||||
Here is an example:
|
||||
\begin{verbatim}
|
||||
BEGIN-UNION: event
|
||||
MEMBER: event
|
||||
MEMBER: active-event
|
||||
MEMBER: keyboard-event
|
||||
MEMBER: motion-event
|
||||
MEMBER: button-event
|
||||
END-UNION
|
||||
\end{verbatim}
|
||||
|
||||
\subsubsection{Out parameters}
|
||||
|
||||
\subsection{\label{alien-internals}Low-level interface}
|
||||
|
||||
The alien interface is built on top of a handful of primitives. Sometimes, it is
|
||||
useful to call these primitives directly for debugging purposes.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\classword{dll}
|
||||
}
|
||||
Instances of this class are handles to native libraries.
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{dlopen}{dlopen ( path -- dll )}
|
||||
}
|
||||
Opens the specified native library and returns a DLL object. The input parameter is the
|
||||
name of a native library file,
|
||||
\emph{not} a logical library name.
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{dlsym}{dlsym ( symbol dll -- address )}
|
||||
}
|
||||
Looks up a named symbol in a native library, and outputs it address. If the \verb|dll| is \verb|f|, the lookup is performed in the runtime executable itself.
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{dlclose}{dlclose ( dll -- )}
|
||||
}
|
||||
Closes a native library and frees associated native resources.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{alien-address}{alien-address ( alien -- address )}
|
||||
}
|
||||
Outputs the address of an alien, as an integer.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{<alien>}{<alien> ( address -- alien )}
|
||||
}
|
||||
Creates an alien pointing to the specified address.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{<displaced-alien>}{<displaced-alien> ( offset alien -- alien )}
|
||||
}
|
||||
Outputs an alien pointing at an offset from the base pointer of the input alien. Displaced aliens are used to access nested structures and native arrays.
|
||||
|
||||
\wordtable{
|
||||
\vocabulary{alien}
|
||||
\ordinaryword{alien-signed-cell}{alien-signed-cell ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-signed-cell}{set-alien-signed-cell ( n alien offset -- )}
|
||||
\ordinaryword{alien-unsigned-cell}{alien-unsigned-cell ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-unsigned-cell}{set-alien-unsigned-cell( n alien offset -- )}
|
||||
\ordinaryword{alien-signed-8}{alien-signed-8 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-signed-8}{set-alien-signed-8 ( n alien offset -- )}
|
||||
\ordinaryword{alien-unsigned-8}{alien-unsigned-8 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-unsigned-8}{set-alien-unsigned-8 ( n alien offset -- )}
|
||||
\ordinaryword{alien-signed-4}{alien-signed-4 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-signed-4}{set-alien-signed-4 ( n alien offset -- )}
|
||||
\ordinaryword{alien-unsigned-4}{alien-unsigned-4 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-unsigned-4}{set-alien-unsigned-4 ( n alien offset -- )}
|
||||
\ordinaryword{alien-signed-2}{alien-signed-2 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-signed-2}{set-alien-signed-2 ( n alien offset -- )}
|
||||
\ordinaryword{alien-unsigned-2}{alien-unsigned-2 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-unsigned-2}{set-alien-unsigned-2 ( n alien offset -- )}
|
||||
\ordinaryword{alien-signed-1}{alien-signed-1 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-signed-1}{set-alien-signed-1 ( n alien offset -- )}
|
||||
\ordinaryword{alien-unsigned-1}{alien-unsigned-1 ( alien offset -- n )}
|
||||
\ordinaryword{set-alien-unsigned-1}{set-alien-unsigned-1 ( n alien offset -- )}
|
||||
\ordinaryword{alien-value-string}{alien-value-string ( alien offset -- string )}
|
||||
}
|
||||
These primitives read and write native memory. They can be given an alien, displaced alien, or byte array. No bounds checking of any kind is performed.
|
||||
|
||||
\subsection{\label{malloc}Manual memory management}
|
||||
|
||||
If for whatever reason Factor's memory management is unsuitable for a certain task, you can
|
||||
directly call the standard C memory management routines. These words are very raw and deal with addresses directly, and of course it is easy to corrupt memory or crash the runtime
|
||||
this way.
|
||||
\wordtable{
|
||||
\vocabulary{kernel-internals}
|
||||
\ordinaryword{malloc}{malloc ( size -- address )}
|
||||
}
|
||||
Allocate a block of size \verb|size| and output a pointer to it.
|
||||
\wordtable{
|
||||
\vocabulary{kernel-internals}
|
||||
\ordinaryword{realloc}{realloc ( address size -- address )}
|
||||
}
|
||||
Resize a block previously allocated with \verb|malloc|.
|
||||
\wordtable{
|
||||
\vocabulary{kernel-internals}
|
||||
\ordinaryword{free}{free ( address -- )}
|
||||
}
|
||||
Deallocate a block previously allocated with \verb|malloc|.
|
||||
|
||||
\chapter{Development tools}
|
||||
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ M: alien = ( obj obj -- ? )
|
|||
: library ( name -- object )
|
||||
dup [ "libraries" get hash ] when ;
|
||||
|
||||
: load-dll ( name -- dll )
|
||||
: load-library ( name -- dll )
|
||||
#! Higher level wrapper around dlopen primitive.
|
||||
library dup [
|
||||
[
|
||||
|
|
|
|||
|
|
@ -137,8 +137,8 @@ global [ c-types nest drop ] bind
|
|||
] "uchar" define-primitive-type
|
||||
|
||||
[
|
||||
[ alien-unsigned-4 ] "getter" set
|
||||
[ set-alien-unsigned-4 ] "setter" set
|
||||
[ alien-c-string ] "getter" set
|
||||
[ set-alien-c-string ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
"box_c_string" "boxer" set
|
||||
|
|
@ -164,6 +164,8 @@ global [ c-types nest drop ] bind
|
|||
] "bool" define-primitive-type
|
||||
|
||||
[
|
||||
[ alien-float ] "getter" set
|
||||
[ set-alien-float ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
"box_float" "boxer" set
|
||||
|
|
@ -173,6 +175,8 @@ global [ c-types nest drop ] bind
|
|||
] "float" define-primitive-type
|
||||
|
||||
[
|
||||
[ alien-double ] "getter" set
|
||||
[ set-alien-double ] "setter" set
|
||||
cell 2 * "width" set
|
||||
cell 2 * "align" set
|
||||
"box_double" "boxer" set
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ M: alien-error error. ( error -- )
|
|||
[ drop object ] map dup dup ensure-d
|
||||
length 0 node-inputs consume-d ;
|
||||
|
||||
: ensure-dlsym ( symbol library -- ) load-dll dlsym drop ;
|
||||
: ensure-dlsym ( symbol library -- ) load-library dlsym drop ;
|
||||
|
||||
: alien-invoke-node ( returns params function library -- )
|
||||
#! We should fail if the library does not exist, so that
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
! Copyright (C) 2004, 2005 Mackenzie Straight.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: kernel-internals
|
||||
USING: alien errors kernel math ;
|
||||
|
||||
: malloc ( size -- address )
|
||||
"ulong" "libc" "malloc" [ "ulong" ] alien-invoke ;
|
||||
|
||||
: free ( address -- )
|
||||
"void" "libc" "free" [ "ulong" ] alien-invoke ;
|
||||
|
||||
: realloc ( address size -- address )
|
||||
"ulong" "libc" "realloc" [ "ulong" "ulong" ] alien-invoke ;
|
||||
|
||||
: memcpy ( dst src size -- )
|
||||
"void" "libc" "memcpy" [ "ulong" "ulong" "ulong" ] alien-invoke ;
|
||||
|
||||
: check-ptr ( ptr -- ptr )
|
||||
dup 0 number= [ "Out of memory" throw ] when ;
|
||||
|
|
@ -27,6 +27,7 @@ recrossref
|
|||
! These are loaded here until bootstrap gets some fixes
|
||||
t [
|
||||
"/library/alien/compiler.factor"
|
||||
"/library/alien/malloc.factor"
|
||||
"/library/io/buffer.factor"
|
||||
] pull-in
|
||||
|
||||
|
|
@ -75,8 +76,8 @@ init-assembler
|
|||
|
||||
compile? [
|
||||
\ car compile
|
||||
\ = compile
|
||||
\ length compile
|
||||
\ = compile
|
||||
\ unparse compile
|
||||
\ scan compile
|
||||
] when
|
||||
|
|
|
|||
|
|
@ -182,7 +182,12 @@ vocabularies get [
|
|||
[ "set-alien-signed-1" "alien" [ [ integer alien integer ] [ ] ] ]
|
||||
[ "alien-unsigned-1" "alien" [ [ alien integer ] [ integer ] ] ]
|
||||
[ "set-alien-unsigned-1" "alien" [ [ integer alien integer ] [ ] ] ]
|
||||
[ "alien-value-string" "alien" [ [ alien integer ] [ string ] ] ]
|
||||
[ "alien-float" "alien" [ [ alien integer ] [ float ] ] ]
|
||||
[ "set-alien-float" "alien" [ [ float alien integer ] [ ] ] ]
|
||||
[ "alien-double" "alien" [ [ alien integer ] [ float ] ] ]
|
||||
[ "set-alien-double" "alien" [ [ float alien integer ] [ ] ] ]
|
||||
[ "alien-c-string" "alien" [ [ alien integer ] [ string ] ] ]
|
||||
[ "set-alien-c-string" "alien" [ [ string alien integer ] [ ] ] ]
|
||||
[ "throw" "errors" [ [ object ] [ ] ] ]
|
||||
[ "string>memory" "kernel-internals" [ [ string integer ] [ ] ] ]
|
||||
[ "memory>string" "kernel-internals" [ [ integer integer ] [ string ] ] ]
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ USING: alien compiler inference kernel kernel-internals lists
|
|||
math memory namespaces words ;
|
||||
|
||||
\ alien-invoke [
|
||||
uncons load-dll 2dup rel-dlsym-16/16 dlsym compile-call-far
|
||||
uncons load-library 2dup rel-dlsym-16/16 dlsym compile-call-far
|
||||
] "generator" set-word-prop
|
||||
|
||||
: stack-size 8 + 16 align ;
|
||||
|
|
|
|||
|
|
@ -5,11 +5,11 @@ USING: alien assembler inference kernel kernel-internals lists
|
|||
math memory namespaces words ;
|
||||
|
||||
\ alien-invoke [
|
||||
uncons load-dll 2dup dlsym CALL t rel-dlsym
|
||||
uncons load-library 2dup dlsym CALL t rel-dlsym
|
||||
] "generator" set-word-prop
|
||||
|
||||
\ alien-global [
|
||||
uncons load-dll 2dup dlsym EAX swap unit MOV f rel-dlsym
|
||||
uncons load-library 2dup dlsym EAX swap unit MOV f rel-dlsym
|
||||
] "generator" set-word-prop
|
||||
|
||||
#parameters [
|
||||
|
|
|
|||
|
|
@ -6,21 +6,6 @@ strings ;
|
|||
|
||||
TUPLE: buffer size ptr fill pos ;
|
||||
|
||||
: malloc ( size -- address )
|
||||
"ulong" "libc" "malloc" [ "ulong" ] alien-invoke ;
|
||||
|
||||
: free ( address -- )
|
||||
"void" "libc" "free" [ "ulong" ] alien-invoke ;
|
||||
|
||||
: realloc ( address size -- address )
|
||||
"ulong" "libc" "realloc" [ "ulong" "ulong" ] alien-invoke ;
|
||||
|
||||
: memcpy ( dst src size -- )
|
||||
"void" "libc" "memcpy" [ "ulong" "ulong" "ulong" ] alien-invoke ;
|
||||
|
||||
: check-ptr ( ptr -- ptr )
|
||||
dup 0 = [ "Out of memory" throw ] when ;
|
||||
|
||||
C: buffer ( size -- buffer )
|
||||
2dup set-buffer-size
|
||||
swap malloc check-ptr swap [ set-buffer-ptr ] keep
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ USE: alien
|
|||
"char*" "sdl-ttf" "TTF_FontFaceStyleName" [ "void*" ] alien-invoke ;
|
||||
|
||||
: TTF_SizeUNICODE ( font text w h -- ? )
|
||||
"bool" "sdl-ttf" "TTF_SizeUNICODE" [ "void*" "ushort*" "int-box*" "int-box*" ] alien-invoke ;
|
||||
"bool" "sdl-ttf" "TTF_SizeUNICODE" [ "void*" "ushort*" "void*" "void*" ] alien-invoke ;
|
||||
|
||||
: TTF_RenderUNICODE_Solid ( font text fg -- surface )
|
||||
"surface*" "sdl-ttf" "TTF_RenderUNICODE_Solid" [ "void*" "ushort*" "int" ] alien-invoke ;
|
||||
|
|
|
|||
|
|
@ -55,16 +55,12 @@ global [
|
|||
[ dup CHAR: \0 = [ drop CHAR: \s ] when ] seq-map
|
||||
] when ;
|
||||
|
||||
BEGIN-STRUCT: int-box
|
||||
FIELD: int i
|
||||
END-STRUCT
|
||||
|
||||
: size-string ( font text -- w h )
|
||||
>r lookup-font r> filter-nulls dup empty? [
|
||||
drop TTF_FontHeight 0 swap
|
||||
] [
|
||||
<int-box> <int-box> [ TTF_SizeUNICODE drop ] 2keep
|
||||
swap int-box-i swap int-box-i
|
||||
0 <int> 0 <int> [ TTF_SizeUNICODE drop ] 2keep
|
||||
swap *int swap *int
|
||||
] ifte ;
|
||||
|
||||
global [ <namespace> fonts set ] bind
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ M: accept-task io-task-events ( task -- events )
|
|||
|
||||
: do-accept ( fd -- fd host port )
|
||||
<sockaddr-in>
|
||||
[ "sockaddr-in" c-size box-int accept dup io-error ] keep
|
||||
[ "sockaddr-in" c-size <int> accept dup io-error ] keep
|
||||
dup sockaddr-in-addr inet-ntoa
|
||||
swap sockaddr-in-port ntohs ;
|
||||
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ END-STRUCT
|
|||
"int" "libc" "listen" [ "int" "int" ] alien-invoke ;
|
||||
|
||||
: accept ( s sockaddr socklen -- n )
|
||||
"int" "libc" "accept" [ "int" "sockaddr-in*" "int-box*" ] alien-invoke ;
|
||||
"int" "libc" "accept" [ "int" "sockaddr-in*" "void*" ] alien-invoke ;
|
||||
|
||||
: htonl ( n -- n )
|
||||
"uint" "libc" "htonl" [ "uint" ] alien-invoke ;
|
||||
|
|
|
|||
|
|
@ -112,8 +112,6 @@ DEF_ALIEN_SLOT(signed_2,s16,signed_2)
|
|||
DEF_ALIEN_SLOT(unsigned_2,u16,unsigned_2)
|
||||
DEF_ALIEN_SLOT(signed_1,BYTE,signed_1)
|
||||
DEF_ALIEN_SLOT(unsigned_1,BYTE,unsigned_1)
|
||||
|
||||
void primitive_alien_value_string(void)
|
||||
{
|
||||
box_c_string(alien_pointer());
|
||||
}
|
||||
DEF_ALIEN_SLOT(float,float,float)
|
||||
DEF_ALIEN_SLOT(double,double,double)
|
||||
DEF_ALIEN_SLOT(c_string,char*,c_string)
|
||||
|
|
|
|||
|
|
@ -52,4 +52,9 @@ void primitive_alien_signed_1(void);
|
|||
void primitive_set_alien_signed_1(void);
|
||||
void primitive_alien_unsigned_1(void);
|
||||
void primitive_set_alien_unsigned_1(void);
|
||||
void primitive_alien_value_string(void);
|
||||
void primitive_alien_float(void);
|
||||
void primitive_set_alien_float(void);
|
||||
void primitive_alien_double(void);
|
||||
void primitive_set_alien_double(void);
|
||||
void primitive_alien_c_string(void);
|
||||
void primitive_set_alien_c_string(void);
|
||||
|
|
|
|||
|
|
@ -148,7 +148,12 @@ void* primitives[] = {
|
|||
primitive_set_alien_signed_1,
|
||||
primitive_alien_unsigned_1,
|
||||
primitive_set_alien_unsigned_1,
|
||||
primitive_alien_value_string,
|
||||
primitive_alien_float,
|
||||
primitive_set_alien_float,
|
||||
primitive_alien_double,
|
||||
primitive_set_alien_double,
|
||||
primitive_alien_c_string,
|
||||
primitive_set_alien_c_string,
|
||||
primitive_throw,
|
||||
primitive_string_to_memory,
|
||||
primitive_memory_to_string,
|
||||
|
|
|
|||
Loading…
Reference in New Issue