start FFI

Makefile

@@ -1,11 +1,13 @@
 CC = gcc
 
+# On FreeBSD, to use SDL and other libc_r libs:
+CFLAGS = -Os -g -Wall -pthread
 # On PowerPC G5:
 # CFLAGS = -mcpu=970 -mtune=970 -mpowerpc64 -ffast-math -O3
 # On Pentium 4:
 # CFLAGS = -march=pentium4 -ffast-math -O3 -fomit-frame-pointer
 # Add -fomit-frame-pointer if you don't care about debugging
-CFLAGS = -Os -g -Wall
+# CFLAGS = -Os -g -Wall
 
 # On Solaris:
 # LIBS = -lsocket -lnsl -lm
@@ -24,7 +26,8 @@ OBJS = native/arithmetic.o native/array.o native/bignum.o \
 	native/run.o \
 	native/sbuf.o native/socket.o native/stack.o \
 	native/string.o native/types.o native/vector.o \
-	native/write.o native/word.o native/compiler.o
+	native/write.o native/word.o native/compiler.o \
+	native/ffi.o
 
 f: $(OBJS)
 	$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)

README.txt

@@ -41,8 +41,8 @@ exactly one primitive for performing conditional execution:
 
     USE: combinators
 
-    1 10 < [ "10 is less than 1." print ] [ "whoa!" print ] ifte
+    1 10 < [ "1 is less than 10." print ] [ "whoa!" print ] ifte
-    ==> 10 is less than 1.
+    ==> 1 is less than 10.
 
 Here is an example of a word that uses these two concepts:
 

TODO.FACTOR.txt

@@ -42,7 +42,7 @@
 - finish namespaces docs
 - mention word accessors/mutators
 - to document:
-  >r r> (earlier on?)
+  >r r> example
   continuations
   streams
   multitasking

doc/devel-guide.tex

@@ -967,25 +967,50 @@ USE: stack
 
 \section{Sequences}
 
+Factor supports two primary types for storing sequential data; lists and vectors.
+Lists are stored in a linked manner, with each node of the list holding an
+element and a reference to the next node. Vectors, on the other hand, are contiguous sets of cells in memory, with each cell holding an element. Strings and string buffers can be considered as vectors specialized to holding characters, with the additional restriction that strings are immutable.
+
+Vectors are applicable to a different class of problems than lists.
+Compare the relative performance of common operations on vectors and
+lists:
+
+\begin{tabular}{|r|l|l|}
+\hline 
+&
+Lists&
+Vectors\tabularnewline
+\hline
+\hline 
+Random access of an index&
+linear time&
+constant time\tabularnewline
+\hline 
+Add new element at start&
+constant time&
+linear time\tabularnewline
+\hline 
+Add new element at end&
+linear time&
+constant time\tabularnewline
+\hline
+\end{tabular}
+
+Vectors and lists can be converted back and forth using the \texttt{vector>list}
+word \texttt{( vector -{}- list )} and the \texttt{list>vector} word
+\texttt{( list -{}- vector )}.
+
 \subsection{Lists and cons cells}
 
-A list of objects is realized as a set of pairs; each pair holds a list element,
+A \emph{cons cell} is a compound object holding references to two other objects. The order matters; the first is called the \emph{car},
-and a reference to the next pair. These pairs are known as \emph{cons cells}. All words relating to cons cells and lists are found in the \texttt{lists}
-vocabulary. Lists have the following literal
-syntax:
-
-\begin{alltt}
-{[} "CEO" 5 "CFO" -4 f {]}
-\end{alltt}
-
-A cons cell is an object that holds a reference to two other objects.
-The order of the two objects matters -- the first is called the \emph{car},
 the second is called the \emph{cdr}.
 
 The words \texttt{cons}, \texttt{car} and \texttt{cdr}%
 \footnote{These infamous names originate from the Lisp language. Originally,
 {}``Lisp'' stood for {}``List Processing''.%
-} construct and deconstruct cons cells:
+} construct and deconstruct cons cells.
+All words relating to cons cells and lists are found in the \texttt{lists}
+vocabulary.
 
 \begin{alltt}
 1 2 cons .
@@ -995,6 +1020,7 @@ The words \texttt{cons}, \texttt{car} and \texttt{cdr}%
 5 6 cons cdr .
 \emph{6}
 \end{alltt}
+
 The output of the first expression suggests a literal syntax for cons
 cells:
 
@@ -1006,18 +1032,18 @@ cells:
 {[} "first" | {[} "second" | f {]} {]} cdr car .
 \emph{"second"}
 \end{alltt}
-The last two examples make it clear how nested cons cells represent
+
-a list. Since this {}``nested cons cell'' syntax is extremely cumbersome,
+A \emph{proper list} (or often, just a \emph{list}) is a cons cell whose car is the first element, and the cdr is the \emph{rest of the list}. The car of the last cons cell in the list is the last element, and the cdr is \texttt{f}.
-the parser provides an easier way:
+
+Lists have the following literal
+syntax:
 
 \begin{alltt}
 {[} 1 2 3 4 {]} cdr cdr car .
 \emph{3}
 \end{alltt}
 
-A \emph{proper list} is a set of cons cells linked by their cdr, where the last cons cell has a cdr set to \texttt{f}. Also, the object \texttt{f} by itself
+An \emph{improper list} is one where the cdr of the last cons cell is not \texttt{f}. Improper lists are input with the following syntax:
-is a proper list, and in fact it is equivalent to the empty list \texttt{{[}
-{]}}. An \emph{improper list} is a set of cons cells that does not terminate with \texttt{f}. Improper lists are input with the following syntax:
 
 \begin{verbatim}
 [ 1 2 3 | 4 ]
@@ -1049,7 +1075,7 @@ It is worth mentioning a few words closely related to and defined in terms of \t
 : uncons dup car swap cdr ;
 \end{alltt}
 
-\texttt{unswons ( cons -{}- cdr car)} is just a swapped version of \texttt{uncons}. It is defined as thus:
+\texttt{unswons ( cons -{}- cdr car )} is just a swapped version of \texttt{uncons}. It is defined as thus:
 
 \begin{alltt}
 : unswons dup cdr swap car ;
@@ -1081,9 +1107,10 @@ the original list, and a new element added at the end:
 1 {[} 2 3 4 {]} cons .
 \emph{{[} 1 2 3 4 {]}}
 \end{alltt}
+
 While \texttt{cons} and \texttt{add} appear to have similar effects,
 they are quite different -- \texttt{cons} is a very cheap operation,
-while \texttt{add} has to copy the entire list first! If you need to add to the end of a sequence frequently, consider either using a vector, or adding to the beginning of a list and reversing the list when done. For information about lists, see \ref{sub:Vectors}.
+while \texttt{add} has to copy the entire list first! If you need to add to the end of a sequence frequently, consider either using a vector, or adding to the beginning of a list and reversing the list when done.
 
 \texttt{append ( list list -{}- list )} Append two lists at the
 top of the stack:
@@ -1094,6 +1121,7 @@ top of the stack:
 {[} 1 2 3 {]} dup {[} 4 5 6 {]} append .s
 \emph{\{ {[} 1 2 3 {]} {[} 1 2 3 4 5 6 {]} \}}
 \end{alltt}
+
 The first list is copied, and the cdr of its last cons cell is set
 to point to the second list. The second example above shows that the original
 parameter was not modified. Interestingly, if the second parameter
@@ -1103,6 +1131,7 @@ is not a proper list, \texttt{append} returns an improper list:
 {[} 1 2 3 {]} 4 append .
 \emph{{[} 1 2 3 | 4 {]}}
 \end{alltt}
+
 \texttt{length ( list -{}- n )} Iterate down the cdr of the list until
 it reaches \texttt{f}, counting the number of elements in the list:
 
@@ -1112,6 +1141,7 @@ it reaches \texttt{f}, counting the number of elements in the list:
 {[} {[} {[} "Hey" {]} 5 {]} length .
 \emph{2}
 \end{alltt}
+
 \texttt{nth ( index list -{}- obj )} Look up an element specified
 by a zero-based index, by successively iterating down the cdr of the
 list:
@@ -1120,6 +1150,7 @@ list:
 1 {[} "Hamster" "Bagpipe" "Beam" {]} nth .
 \emph{"Bagpipe"}
 \end{alltt}
+
 This word runs in linear time proportional to the list index. If you
 need constant time lookups, use a vector instead.
 
@@ -1128,10 +1159,11 @@ identical to the original list except the element at the specified
 index is replaced:
 
 \begin{alltt}
-{}``Done'' 1 {[} {}``Not started'' {}``Incomplete'' {]} set-nth .
+"Done" 1 {[} "Not started" "Incomplete" {]} set-nth .
 
-\emph{{[} {}``Done'' {}``Incomplete'' {]}}
+\emph{{[} "Done" "Incomplete" {]}}
 \end{alltt}
+
 \texttt{remove ( obj list -{}- list )} Push a new list, with all occurrences
 of the object removed. All other elements are in the same order:
 
@@ -1140,6 +1172,7 @@ of the object removed. All other elements are in the same order:
 {[} "Canada" "New Zealand" "Australia" "Russia" {]} australia- .
 \emph{{[} "Canada" "New Zealand" "Russia" {]}}
 \end{alltt}
+
 \texttt{remove-nth ( index list -{}- list )} Push a new list, with
 an index removed:
 
@@ -1148,6 +1181,7 @@ an index removed:
 {[} "Canada" "New Zealand" "Australia" "Russia" {]} remove-1 .
 \emph{{[} "Canada" "Australia" "Russia" {]}}
 \end{alltt}
+
 \texttt{reverse ( list -{}- list )} Push a new list which has the
 same elements as the original one, but in reverse order:
 
@@ -1155,6 +1189,7 @@ same elements as the original one, but in reverse order:
 {[} 4 3 2 1 {]} reverse .
 \emph{{[} 1 2 3 4 {]}}
 \end{alltt}
+
 \texttt{contains ( obj list -{}- list )} Look for an occurrence of
 an object in a list. The remainder of the list starting from the first
 occurrence is returned. If the object does not occur in the list,
@@ -1170,22 +1205,24 @@ f is returned:
 "Pakistan" lived-in? .
 \emph{f}
 \end{alltt}
-For now, assume {}``occurs'' means {}``contains an object that
-looks like''. The issue of object equality is covered later.
 
-\texttt{unique ( list -{}- list )} Return a new list with all duplicate
+For now, assume {}``occurs'' means {}``contains an object that
-elements removed. This word executes in quadratic time, so should
+looks like''. The concept of object equality is covered later.
-not be used with large lists. For example:
+
+\texttt{unique ( elem list -{}- list )} Return a new list containing the new element. If the list already contains the element, the same list is returned, otherwise the element is consed onto the list. This word executes in linear time, so its use in loops can be a potential performance bottleneck.
 
 \begin{alltt}
-{[} 1 2 1 4 1 8 {]} unique .
+1 {[} 1 2 4 8 {]} unique .
 \emph{{[} 1 2 4 8 {]}}
+3 {[} 1 2 4 8 {]} unique .
+\emph{{[} 3 1 2 4 8 {]}}
 \end{alltt}
+
 \texttt{unit ( obj -{}- list )} Make a list of one element:
 
 \begin{alltt}
-{}``Unit 18'' unit .
+"Unit 18" unit .
-\emph{{[} {}``Unit 18'' {]}}
+\emph{{[} "Unit 18" {]}}
 \end{alltt}
 
 \subsection{\label{sub:Destructively-modifying-lists}Destructively modifying lists}
@@ -1210,6 +1247,7 @@ the original list, and the original list has been destroyed:
 {[} 1 2 3 4 {]} dup nreverse .s
 \emph{\{ {[} 1 {]} {[} 4 3 2 1 {]} \}}
 \end{alltt}
+
 Compare the second stack element (which is what remains of the original
 list) and the top stack element (the list returned by \texttt{nreverse}).
 
@@ -1229,6 +1267,7 @@ it is unchanged, otherwise, it is equal to the return value:
 {[} 1 2 {]} {[} 3 4 {]} nappend .
 \emph{{[} 1 2 3 4 {]}}
 \end{alltt}
+
 Note in the above examples, we use literal list parameters to \texttt{nreverse}
 and \texttt{nappend}. This is actually a very bad idea, since the same literal
 list may be used more than once! For example, lets make a colon definition:
@@ -1238,11 +1277,12 @@ list may be used more than once! For example, lets make a colon definition:
 very-bad-idea .
 \emph{{[} 4 3 2 1 {]}}
 very-bad-idea .
-\emph{{[} 4 {]}}
+\emph{{[} 1 {]}}
-{}``very-bad-idea'' see
+"very-bad-idea" see
 \emph{: very-bad-idea}
- \emph{   {[} 4 {]} nreverse ;}
+ \emph{   {[} 1 {]} nreverse ;}
 \end{alltt}
+
 As you can see, the word definition itself was ruined!
 
 Sometimes it is desirable make a copy of a list, so that the copy
@@ -1262,7 +1302,7 @@ itself.
 
 \subsection{\label{sub:Vectors}Vectors}
 
-A \emph{vector} is a contiguous chunk of memory cells which hold references to arbitrary
+A \emph{vector} is a contiguous chunk of memory cells holding references to arbitrary
 objects. Vectors have the following literal syntax:
 
 \begin{alltt}
@@ -1286,9 +1326,10 @@ at a zero-based index of a vector:
 2 \{ 1 2 \} vector-nth .
 \emph{ERROR: Out of bounds}
 \end{alltt}
+
 \texttt{set-vector-nth ( obj index vector -{}- )} stores a value into
 a vector:%
-\footnote{The words \texttt{get} and \texttt{set} used in this example will
+\footnote{The words \texttt{get} and \texttt{set} used in this example refer to variables and will
 be formally introduced later.%
 }
 
@@ -1301,6 +1342,7 @@ be formally introduced later.%
 "v" get .
 \emph{\{ "math" "philosophy" f f "CS" \}}
 \end{alltt}
+
 \texttt{vector-length ( vector -{}- length )} pushes the number of
 elements in a vector. As the previous two examples demonstrate, attempting
 to fetch beyond the end of the vector will raise an error, while storing
@@ -1334,47 +1376,6 @@ pop-state .
 \emph{12}
 \end{alltt}
 
-\subsection{Vectors versus lists}
-
-Vectors are applicable to a different class of problems than lists.
-Compare the relative performance of common operations on vectors and
-lists:
-
-\begin{tabular}{|r|l|l|}
-\hline 
-&
-Lists&
-Vectors\tabularnewline
-\hline
-\hline 
-Random access of an index&
-linear time&
-constant time\tabularnewline
-\hline 
-Add new element at start&
-constant time&
-linear time\tabularnewline
-\hline 
-Add new element at end&
-linear time&
-constant time\tabularnewline
-\hline
-\end{tabular}
-
-When using vectors, you need to pass around a vector and an index
--- when working with lists, often only a list head is passed around.
-For this reason, if you need a sequence for iteration only, a list
-is a better choice because the list vocabulary contains a rich collection
-of recursive words.
-
-On the other hand, when you need to maintain your own {}``stack''-like
-collection, a vector is the obvious choice, since most pushes and
-pops can then avoid allocating memory.
-
-Vectors and lists can be converted back and forth using the \texttt{vector>list}
-word \texttt{( vector -{}- list )} and the \texttt{list>vector} word
-\texttt{( list -{}- vector )}.
-
 \subsection{Strings}
 
 A \emph{string} is a sequence of 16-bit Unicode characters (conventionally,
@@ -1589,6 +1590,26 @@ new character positions are automatically filled with zeroes.
 
 \section{Control flow}
 
+Recall the syntax for a conditional statement from the first chapter:
+
+\begin{alltt}
+1 2 < {[} "1 is less than 2." print {]} {[} "bug!" print {]} ifte
+\end{alltt}
+
+The syntax for the quotations there looks an aweful lot like the syntax for literal lists. In fact, code quotations \emph{are} lists. Factor code is data, and vice versa.
+
+Essentially, the interpreter iterates through code quotations, pushing literals and executing words. When a word is executed, one of two things happen -- either the word has a colon definition, and the interpreter is invoked recursively on the definition, or the word is primitive, and it is executed by the underlying virtual machine.
+
+\subsection{The call stack}
+
+So far, we have seen what we called ``the stack'' store intermediate values between computations. In fact Factor maintains a number of other stacks, and the formal name for the stack we've been dealing with so far is the \emph{data stack}.
+
+Another fundamental stack is the \emph{call stack}. When invoking an inner colon definition, the interpreter pushes the current execution state on the call stack so that it can be restored later.
+
+The call stack also serves a dual purpose as a temporary storage area. Sometimes, juggling values on the data stack becomes ackward, and in that case \texttt{>r} and \texttt{r>} can be used to move a value from the data stack to the call stack, and vice versa, respectively.
+
+give an example here
+
 \subsection{Recursion}
 
 The idea of \emph{recursion} is key to understanding Factor. A \emph{recursive} word definition is one that refers to itself, usually in one branch of a conditional. The general form of a recursive word looks as follows:
@@ -1602,9 +1623,11 @@ The idea of \emph{recursion} is key to understanding Factor. A \emph{recursive}
     {]} ifte ;
 \end{alltt}
 
-The recursive case contains one more more calls to the original word. When a recursive call is made, the current execution state is saved on the \emph{call stack}, so that when the recursive call returns execution continues where it left off.
+The recursive case contains one or more calls to the original word.
 
-There are a few things worth noting about the stack flow inside a recursive word. The condition must take care to preserve any input parameters needed for the base case and recursive case. The base case must consume all inputs, and leave the final return values on the stack. The recursive case should also be coded such that the stack effect of the total definition is the same regardless of how many iterations are preformed; words that consume or produce different numbers of paramters depending on circumstances are very hard to debug.
+There are a few things worth noting about the stack flow inside a recursive word. The condition must take care to preserve any input parameters needed for the base case and recursive case. The base case must consume all inputs, and leave the final return values on the stack. The recursive case should somehow reduce one of the parameters. This could mean incrementing or decrementing an integer, taking the \texttt{cdr} of a list, and so on. Parameters must eventually reduce to a state where the condition returns \texttt{f}, to avoid an infinite recursion.
+
+The recursive case should also be coded such that the stack effect of the total definition is the same regardless of how many iterations are preformed; words that consume or produce different numbers of paramters depending on circumstances are very hard to debug.
 
 In a programming language such as Java\footnote{Although by the time you read this, Java implementations might be doing tail-call optimization.}, using recursion to iterate through a long list is highly undesirable because it risks overflowing the (finite) call stack depth. However, Factor performs \emph{tail call optimization}, which is based on the observation that if the recursive call is made at a point right before the word being defined would return, there is \emph{actually nothing to save} on the call stack, so recursion call nesting can occur to arbitrary depth. Such recursion is known as \emph{tail recursion}.
 
@@ -2377,11 +2400,7 @@ The scope created by \texttt{<\%} and \texttt{\%>} is \emph{dynamic}; that is, a
 
 \subsection{The name stack}
 
-So far, we have seen what we called ``the stack'' store intermediate values between computations. In fact Factor maintains a number of other stacks, and the formal name for the stack we've been dealing with so far is the \emph{data stack}.
+The \texttt{bind} combinator creates dynamic scope by pushing and popping namespaces on the so-called \emph{name stack}. Its definition is simpler than one would expect:
-
-Another stack is the \emph{call stack}. When a colon definition is invoked, the position within the current colon definition is pushed on the stack. This ensures that calling words return to the caller, just as in any other language with subroutines.\footnote{Factor supports a variety of structures for implementing non-local word exits, such as exceptions, co-routines, continuations, and so on. They all rely on manipulating the call stack and are described in later sections.}
-
-The \emph{name stack} is the focus of this section. The \texttt{bind} combinator creates dynamic scope by pushing and popping namespaces on the name stack. Its definition is simpler than one would expect:
 
 \begin{alltt}
 : bind ( namespace quot -- )

library/compiler/assembly-x86.factor

@@ -44,12 +44,18 @@ USE: combinators
 : MOD-R/M ( r/m reg/opcode mod -- )
     6 shift swap 3 shift bitor bitor compile-byte ;
 
-: PUSH ( reg -- )
+: PUSH-R ( reg -- )
     HEX: 50 + compile-byte ;
 
-: POP ( reg -- )
+: PUSH-I ( imm -- )
+    HEX: 68 compile-byte compile-cell ;
+
+: POP-R ( reg -- )
     HEX: 58 + compile-byte ;
 
+: LEAVE ( -- )
+    HEX: c9 compile-byte ;
+
 : I>R ( imm reg -- )
     #! MOV <imm> TO <reg>
     HEX: b8 + compile-byte  compile-cell ;
@@ -68,8 +74,7 @@ USE: combinators
     HEX: c7 compile-byte  compile-byte  compile-cell ;
 
 : R>[I] ( reg imm -- )
-    #! MOV INDIRECT <imm> TO <reg>.
+    #! MOV <reg> TO INDIRECT <imm>.
-    #! Actually only works with EAX.
     over EAX = [
         nip HEX: a3 compile-byte
     ] [
@@ -77,6 +82,10 @@ USE: combinators
         swap BIN: 101 swap 0 MOD-R/M
     ] ifte compile-cell ;
 
+: R>R ( reg reg -- )
+    #! MOV <reg> TO <reg>.
+    HEX: 89 compile-byte  swap BIN: 11 MOD-R/M ;
+
 : [R]>R ( reg reg -- )
     #! MOV INDIRECT <reg> TO <reg>.
     HEX: 8b compile-byte  swap 0 MOD-R/M ;
@@ -92,6 +101,22 @@ USE: combinators
     compile-cell
     compile-cell ;
 
+: R+I ( imm reg -- )
+    #! ADD <imm> TO <reg>, STORE RESULT IN <reg>
+    over -128 127 between? [
+        HEX: 83 compile-byte
+        0 BIN: 11 MOD-R/M
+        compile-byte
+    ] [
+        dup EAX = [
+            drop HEX: 05 compile-byte
+        ] [
+            HEX: 81 compile-byte
+            0 BIN: 11 MOD-R/M
+        ] ifte
+        compile-cell
+    ] ifte ;
+
 : R-I ( imm reg -- )
     #! SUBTRACT <imm> FROM <reg>, STORE RESULT IN <reg>
     over -128 127 between? [
@@ -132,12 +157,20 @@ USE: combinators
 : [LITERAL] ( cell -- )
     #! Push complex literal on data stack by following an
     #! indirect pointer.
-    ECX PUSH
+    ECX PUSH-R
     ( cell -- ) ECX [I]>R
     DATASTACK EAX [I]>R
     ECX EAX R>[R]
     4 DATASTACK I+[I]
-    ECX POP ;
+    ECX POP-R ;
+
+: PUSH-DS ( -- )
+    #! Push contents of EAX onto datastack.
+    ECX PUSH-R
+    DATASTACK ECX [I]>R
+    EAX ECX R>[R]
+    4 DATASTACK I+[I]
+    ECX POP-R ;
 
 : POP-DS ( -- )
     #! Pop datastack, store pointer to datastack top in EAX.

library/cross-compiler.factor

@@ -40,6 +40,12 @@ USE: vectors
 USE: vectors
 USE: words
 
+IN: alien
+DEFER: dlopen
+DEFER: dlsym
+DEFER: dlsym-self
+DEFER: dlclose
+
 IN: compiler
 DEFER: set-compiled-byte
 DEFER: set-compiled-cell
@@ -288,6 +294,10 @@ IN: image
         literal-top
         set-literal-top
         address-of
+        dlopen
+        dlsym
+        dlsym-self
+        dlclose
     ] [
         swap succ tuck primitive,
     ] each drop ;

library/httpd/httpd.factor

@@ -113,11 +113,10 @@ USE: url-encoding
     global [ "httpd-quit" off ] bind ;
 
 : httpd-loop ( server -- server )
-    [
+    quit-flag [
-        quit-flag not
-    ] [
         dup dup accept httpd-connection
-    ] while ;
+        httpd-loop
+    ] unless ;
 
 : (httpd) ( port -- )
     <server> [

library/interpreter.factor

@@ -102,8 +102,11 @@ USE: vectors
     ] ifte ;
 
 : interpreter-loop ( -- )
-    [ "quit-flag" get not ] [ interpret ] while
+    "quit-flag" get [
-    "quit-flag" off ;
+        "quit-flag" off
+    ] [
+        interpret interpreter-loop
+    ] ifte ;
 
 : room. ( -- )
     room

library/lists.factor

@@ -104,7 +104,7 @@ USE: vectors
     #! For example, given a proper list, pushes a cons cell
     #! whose car is the last element of the list, and whose cdr
     #! is f.
-    [ dup cdr cons? ] [ cdr ] while ;
+    dup cdr cons? [ cdr last* ] when ;
 
 : last ( list -- last )
     #! Pushes last element of a list. Since this pushes the

library/math/trig-hyp.factor

@@ -38,8 +38,8 @@ USE: stack
 ! Hyperbolic functions:
 !    cosh sech sinh cosech tanh coth
 
-: deg2rad pi * 180 / ;
+: deg>rad pi * 180 / ;
-: rad2deg 180 * pi / ;
+: rad>deg 180 * pi / ;
 
 : cos ( z -- cos )
     >rect 2dup

library/platform/jvm/stream.factor

@@ -232,9 +232,10 @@ USE: strings
 : <socket-stream> ( socket -- stream )
     #! Wraps a socket inside a byte-stream.
     dup
-    [ [ ] "java.net.Socket" "getInputStream"  jinvoke <bin> ]
+    dup
-    [ [ ] "java.net.Socket" "getOutputStream" jinvoke <bout> ]
+    [ ] "java.net.Socket" "getInputStream"  jinvoke <bin>
-    cleave
+    swap
+    [ ] "java.net.Socket" "getOutputStream" jinvoke <bout>
     <byte-stream> [
         dup >str "client" set "socket" set
 

library/platform/native/debugger.factor

@@ -84,7 +84,7 @@ USE: words
     "Operating system signal " write . ;
 
 : profiling-disabled-error ( obj -- )
-    drop "Recompile with the FACTOR_PROFILER flag." print ;
+    drop "Recompile with #define FACTOR_PROFILER." print ;
 
 : negative-array-size-error ( obj -- )
     "Cannot allocate array with negative size " write . ;
@@ -95,6 +95,12 @@ USE: words
 : c-string-error ( obj -- )
     "Cannot convert to C string: " write . ;
 
+: ffi-disabled-error ( obj -- )
+    drop "Recompile Factor with #define FFI." print ;
+
+: ffi-error ( obj -- )
+    "FFI: " write print ;
+
 : kernel-error. ( obj n -- str )
     {
         expired-port-error
@@ -112,6 +118,8 @@ USE: words
         negative-array-size-error
         bad-primitive-error
         c-string-error
+        ffi-disabled-error
+        ffi-error
     } vector-nth execute ;
 
 : kernel-error? ( obj -- ? )

library/platform/native/kernel.factor

@@ -29,6 +29,7 @@ IN: vectors
 DEFER: vector=
 
 IN: kernel
+
 USE: combinators
 USE: errors
 USE: io-internals
@@ -69,6 +70,7 @@ USE: vectors
         [ drop 0 ]
         [ >fixnum ]
         [ >fixnum ]
+        [ drop 0 ]
     } generic ;
 
 : equal? ( obj obj -- ? )
@@ -89,6 +91,7 @@ USE: vectors
         [ eq? ]
         [ number= ]
         [ number= ]
+        [ eq? ]
     } generic ;
 
 : = ( obj obj -- ? )
@@ -118,6 +121,7 @@ USE: vectors
         [ 12 | "port" ]
         [ 13 | "bignum" ]
         [ 14 | "float" ]
+        [ 15 | "dll" ]
         ! These values are only used by the kernel for error
         ! reporting.
         [ 100 | "fixnum/bignum" ]

library/platform/native/math.factor

@@ -30,6 +30,9 @@ USE: combinators
 USE: kernel
 USE: stack
 
+: bignum? ( obj -- ? ) type-of 13 eq? ;
+: complex? ( obj -- ? ) type-of 5 eq? ;
+
 : (gcd) ( x y -- z )
     dup 0 = [ drop ] [ tuck mod (gcd) ] ifte ;
 

library/platform/native/primitives.factor

@@ -26,21 +26,22 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 USE: combinators
+USE: alien
+USE: compiler
 USE: files
 USE: io-internals
-USE: lists
 USE: kernel
+USE: lists
 USE: math
-USE: strings
-USE: random
-USE: real-math
 USE: parser
 USE: profiler
+USE: random
+USE: real-math
 USE: stack
+USE: strings
+USE: unparser
 USE: vectors
 USE: words
-USE: unparser
-USE: compiler
 
 [
     [ execute                | " word -- " ]
@@ -196,6 +197,10 @@ USE: compiler
     [ set-compiled-offset    | " ptr -- " ]
     [ literal-top            | " -- ptr " ]
     [ set-literal-top        | " ptr -- " ]
+    [ dlopen                 | " path -- dll " ]
+    [ dlsym                  | " name dll -- ptr " ]
+    [ dlsym-self             | " name -- ptr " ]
+    [ dlclose                | " dll -- " ]
 ] [
     unswons "stack-effect" swap set-word-property
 ] each

library/strings.factor

@@ -41,7 +41,7 @@ USE: stack
 
 : str-length< ( str str -- boolean )
     #! Compare string lengths.
-    [ str-length ] 2apply < ;
+    swap str-length swap str-length < ;
 
 : cat ( [ "a" "b" "c" ] -- "abc" )
     ! If f appears in the list, it is not appended to the

library/telnetd.factor

@@ -61,11 +61,10 @@ USE: threads
     global [ f "telnetd-quit-flag" set ] bind ;
 
 : telnetd-loop ( server -- server )
-    [
+    quit-flag [
-        quit-flag not
-    ] [
         dup >r accept telnet-connection r>
-    ] while ;
+        telnetd-loop
+    ] unless ;
 
 : telnetd ( port -- )
     [

library/test/jvm-compiler/miscellaneous.factor

@@ -30,7 +30,7 @@ USE: words
 [ f           ] [                 ] [ gensym-test       ] test-word
 
 : intern-test ( 1 2 -- ? )
-    [ intern ] 2apply = ;
+    swap intern swap intern = ;
 
 [ f ] [ "#:a" "#:a" ] [ intern-test ] test-word
 [ t ] [ "#:" "#:" ] [ intern-test ] test-word

library/test/x86-compiler/asm-test.factor

@@ -25,3 +25,13 @@ ECX ECX R>[R]
 
 4 0 I+[I]
 0 4 I+[I]
+
+4 EAX R+I
+4 ECX R+I
+65535 EAX R+I
+65535 ECX R+I
+
+4 EAX R-I
+4 ECX R-I
+65535 EAX R-I
+65535 ECX R-I

native/bignum.c

@@ -1,10 +1,5 @@
 #include "factor.h"
 
-void primitive_bignump(void)
-{
-	drepl(tag_boolean(typep(BIGNUM_TYPE,dpeek())));
-}
-
 ARRAY* to_bignum(CELL tagged)
 {
 	RATIO* r;

native/bignum.h

@@ -8,7 +8,6 @@ INLINE ARRAY* untag_bignum(CELL tagged)
 	return (ARRAY*)UNTAG(tagged);
 }
 
-void primitive_bignump(void);
 ARRAY* to_bignum(CELL tagged);
 void primitive_to_bignum(void);
 CELL number_eq_bignum(ARRAY* x, ARRAY* y);

native/complex.c

@@ -33,11 +33,6 @@ CELL possibly_complex(CELL real, CELL imaginary)
 		return tag_complex(complex(real,imaginary));
 }
 
-void primitive_complexp(void)
-{
-	drepl(tag_boolean(typep(COMPLEX_TYPE,dpeek())));
-}
-
 void primitive_real(void)
 {
 	switch(type_of(dpeek()))

native/complex.h

@@ -18,7 +18,6 @@ COMPLEX* complex(CELL real, CELL imaginary);
 COMPLEX* to_complex(CELL x);
 CELL possibly_complex(CELL real, CELL imaginary);
 
-void primitive_complexp(void);
 void primitive_real(void);
 void primitive_imaginary(void);
 void primitive_to_rect(void);

native/error.c

@@ -45,10 +45,12 @@ void general_error(CELL error, CELL tagged)
 		fprintf(stderr,"Error #%ld\n",to_fixnum(error));
 		if(error == ERROR_TYPE)
 		{
+			CELL obj = untag_cons(untag_cons(tagged)->cdr)->car;
+
 			fprintf(stderr,"Type #%ld\n",to_fixnum(
 				untag_cons(tagged)->car));
-			fprintf(stderr,"Got type #%ld\n",type_of(
+			fprintf(stderr,"Object %ld\n",obj);
-				untag_cons(tagged)->cdr));
+			fprintf(stderr,"Got type #%ld\n",type_of(obj));
 		}
 		fflush(stderr);
 		exit(1);

native/error.h

@@ -13,6 +13,8 @@
 #define ERROR_NEGATIVE_ARRAY_SIZE (12<<3)
 #define ERROR_BAD_PRIMITIVE (13<<3)
 #define ERROR_C_STRING (14<<3)
+#define ERROR_FFI_DISABLED (15<<3)
+#define ERROR_FFI (16<<3)
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);

native/factor.h

@@ -23,6 +23,12 @@
 #include <sys/time.h>
 #include <netdb.h>
 
+#define FFI
+
+#ifdef FFI
+#include <dlfcn.h>
+#endif /* FFI */
+
 #define INLINE inline static
 
 /* CELL must be 32 bits and your system must have 32-bit pointers */
@@ -81,5 +87,6 @@ and allows profiling. */
 #include "vector.h"
 #include "stack.h"
 #include "compiler.h"
+#include "ffi.h"
 
 #endif /* __FACTOR_H__ */

native/ffi.c

@@ -0,0 +1,68 @@
+#include "factor.h"
+
+void primitive_dlopen(void)
+{
+#ifdef FFI
+	char* path = to_c_string(untag_string(dpop()));
+	void* dllptr = dlopen(path,RTLD_NOW);
+	DLL* dll;
+
+	if(dllptr == NULL)
+	{
+		general_error(ERROR_FFI,tag_object(
+			from_c_string(dlerror())));
+	}
+
+	dll = allot_object(DLL_TYPE,sizeof(DLL));
+	dll->dll = dllptr;
+	dpush(tag_object(dll));
+#else
+	general_error(ERROR_FFI_DISABLED,F);
+#endif
+}
+
+void primitive_dlsym(void)
+{
+#ifdef FFI
+	DLL* dll = untag_dll(dpop());
+	void* sym = dlsym(dll->dll,to_c_string(untag_string(dpop())));
+	if(sym == NULL)
+	{
+		general_error(ERROR_FFI,tag_object(
+			from_c_string(dlerror())));
+	}
+	dpush(tag_cell((CELL)sym));
+#else
+	general_error(ERROR_FFI_DISABLED,F);
+#endif
+}
+
+void primitive_dlsym_self(void)
+{
+#ifdef FFI
+	void* sym = dlsym(NULL,to_c_string(untag_string(dpop())));
+	if(sym == NULL)
+	{
+		general_error(ERROR_FFI,tag_object(
+			from_c_string(dlerror())));
+	}
+	dpush(tag_cell((CELL)sym));
+#else
+	general_error(ERROR_FFI_DISABLED,F);
+#endif
+}
+
+void primitive_dlclose(void)
+{
+#ifdef FFI
+	DLL* dll = untag_dll(dpop());
+	if(dlclose(dll->dll) == -1)
+	{
+		general_error(ERROR_FFI,tag_object(
+			from_c_string(dlerror())));
+	}
+	dll->dll = NULL;
+#else
+	general_error(ERROR_FFI_DISABLED,F);
+#endif
+}

native/ffi.h

@@ -0,0 +1,15 @@
+typedef struct {
+	CELL header;
+	void* dll;
+} DLL;
+
+INLINE DLL* untag_dll(CELL tagged)
+{
+	type_check(DLL_TYPE,tagged);
+	return (DLL*)UNTAG(tagged);
+}
+
+void primitive_dlopen(void);
+void primitive_dlsym(void);
+void primitive_dlsym_self(void);
+void primitive_dlclose(void);

native/primitives.c

@@ -160,7 +160,11 @@ XT primitives[] = {
 	primitive_set_compiled_offset,
 	primitive_literal_top,
 	primitive_set_literal_top,
-	primitive_address_of
+	primitive_address_of,
+	primitive_dlopen,
+	primitive_dlsym,
+	primitive_dlsym_self,
+	primitive_dlclose
 };
 
 CELL primitive_to_xt(CELL primitive)

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 160
+#define PRIMITIVE_COUNT 163
 
 CELL primitive_to_xt(CELL primitive);

native/types.c

@@ -103,6 +103,9 @@ CELL untagged_object_size(CELL pointer)
 	case PORT_TYPE:
 		size = sizeof(PORT);
 		break;
+	case DLL_TYPE:
+		size = sizeof(DLL);
+		break;
 	default:
 		critical_error("Cannot determine size",relocating);
 		size = -1;/* can't happen */

native/types.h

@@ -31,6 +31,7 @@ CELL T;
 #define PORT_TYPE 12
 #define BIGNUM_TYPE 13
 #define FLOAT_TYPE 14
+#define DLL_TYPE 15
 
 /* Pseudo-types. For error reporting only. */
 #define INTEGER_TYPE 100 /* FIXNUM or BIGNUM */
@@ -60,9 +61,12 @@ INLINE CELL tag_header(CELL cell)
 
 INLINE CELL untag_header(CELL cell)
 {
+	CELL type = cell >> TAG_BITS;
 	if(TAG(cell) != HEADER_TYPE)
 		critical_error("header type check",cell);
-	return cell >> TAG_BITS;
+	if(type <= HEADER_TYPE && type != WORD_TYPE)
+		critical_error("header invariant check",cell);
+	return type;
 }
 
 INLINE CELL tag_object(void* cell)