bits>float bits>double primitives'

CHANGES.txt

@@ -57,6 +57,8 @@ Factor 0.75:
 
 - OpenGL binding in contrib/gl/ (Alex Chapman).
 
+- PostgreSQL binding in contrib/postgresql/ (Doug Coleman).
+
 - HTTP server now supports virtual hosting.
 
 - The Factor plugin now supports connecting to Factor instances on

doc/handbook.tex

@@ -1911,8 +1911,9 @@ Tests if the sequence contains any elements. The default implementation of this
 \wordtable{
 \vocabulary{sequences}
 \ordinaryword{index}{index ( obj seq -- n )}
+\ordinaryword{index*}{index* ( obj i seq -- n )}
 }
-Outputs the index of the first element in the sequence equal to \texttt{obj}. If no element is found, outputs $-1$.
+Outputs the index of the first element in the sequence equal to \texttt{obj}. If no element is found, outputs $-1$. The \verb|index*| form allows a start index to be specified.
 \wordtable{
 \vocabulary{sequences}
 \ordinaryword{contains?}{contains?~( elt seq -- ?~)}
@@ -1920,6 +1921,12 @@ Outputs the index of the first element in the sequence equal to \texttt{obj}. If
 Tests if \texttt{seq} contains an element equal to \texttt{elt}.
 \wordtable{
 \vocabulary{sequences}
+\ordinaryword{start}{start ( subseq seq -- n )}
+\ordinaryword{start*}{start* ( subseq i seq -- n )}
+}
+Outputs the start index of a subsequence, or $-1$ if the subsequence does not occur in the sequence. The \verb|start*| form allows a start index to be specified.
+\wordtable{
+\vocabulary{sequences}
 \ordinaryword{subseq?}{subseq?~( s1 s2 -- ?~)}
 }
 Tests if \texttt{s2} contains \texttt{s1} as a subsequence.
@@ -1930,11 +1937,7 @@ Tests if \texttt{s2} contains \texttt{s1} as a subsequence.
 
 }
 Tests if \texttt{s1} starts or ends with \texttt{s1}. If \texttt{s1} is longer than \texttt{s2}, outputs \texttt{f}.
-\wordtable{
-\vocabulary{sequences}
-\ordinaryword{index*}{index* ( obj i seq -- n )}
-}
-Outputs the index of the first element in the sequence equal to \texttt{obj}, starting from \texttt{i}. If no element is found, outputs $-1$.
+
 \wordtable{
 \vocabulary{sequences}
 \ordinaryword{peek}{peek ( sequence -- element )}
@@ -3259,7 +3262,7 @@ Deconstructs rational numbers into their numerator and denominator. The denomina
 \textbf{12}
 \end{alltt}
 
-\section{Floating point numbers}\label{floats}
+\section{Floats}\label{floats}
 
 \wordtable{
 \vocabulary{math}
@@ -3299,6 +3302,24 @@ Tests if the top of the stack is a floating point number.
 }
 Turn any real number into a floating point approximation.
 
+\subsection{Binary representation of floats}\label{float-bits}
+
+Floating point numbers are represented internally in IEEE 754 double-precision format. This internal representation can be accessed for advanced operations and input/output purposes.
+
+\wordtable{
+\vocabulary{math}
+\ordinaryword{float>bits}{float>bits ( x -- n )}
+\ordinaryword{double>bits}{double>bits ( x -- n )}
+}
+Converts the floating point number $x$ into IEEE 754 single or double precision form, and outputs an integer holding the binary representation of the result.
+
+\wordtable{
+\vocabulary{math}
+\ordinaryword{bits>float}{float>bits ( n -- x )}
+\ordinaryword{bits>double}{double>bits ( n -- x )}
+}
+Converts an integer representation $n$ of an IEEE 754 single or double precision float into a \verb|float| object.
+
 \section{Complex numbers}\label{complex-numbers}
 
 \wordtable{
@@ -3870,7 +3891,7 @@ a string and returned.
 description={a representation of an integer as a sequence of bytes, ordered from most significant to least significant. This is the native byte ordering for PowerPC, SPARC, Alpha and ARM processors}}
 \glossary{name=little endian,
 description={a representation of an integer as a sequence of bytes, ordered from least significant to most significant. This is the native byte ordering for x86 and x86-64 processors}}
-The core stream words read and write strings. Packed binary integers can be read and written by converting to and from sequences of bytes.
+The core stream words read and write strings. Packed binary integers can be read and written by converting to and from sequences of bytes. Floating point numbers can be read and written by converting them into a their bitwise integer representation (\ref{float-bits}).
 
 There are two ways to order the bytes making up an integer; \emph{little endian} byte order outputs the least significant byte first, and the most significant byte last, whereas \emph{big endian} is the other way around.
 
@@ -4541,6 +4562,8 @@ This word is used to implement end-of-line comments:
 
 \chapter{Web framework}
 
+Factor includes facilities for interoperating with web-based services. This includes an HTTP client, and an HTTP server with a continuation-based web application framework.
+
 \section{HTTP client}
 
 \wordtable{
@@ -4554,6 +4577,58 @@ Attempts to connect to the server specified in the URL. If the connection fails,
 \item[\texttt{stream}] a stream for reading the resource.
 \end{description}
 
+\section{HTTP server}\label{httpd}
+
+The HTTP server listens for requests on a port and hands them off to responders. A responder takes action based on the type of request.
+
+\wordtable{
+\vocabulary{httpd}
+\ordinaryword{httpd}{httpd ( port -- )}
+}
+Starts listening for HTTP requests on \verb|port|.
+
+The HTTP server is usually started with a phrase like the following:
+\begin{alltt}
+\textbf{ok} USING: httpd threads ;
+\textbf{ok} [ 8888 httpd ] in-thread
+\end{alltt}
+
+\wordtable{
+\vocabulary{httpd}
+\ordinaryword{stop-httpd}{stop-httpd ( -- )}
+}
+Stops the HTTP server.
+
+A useful application of the HTTP server is the built-in vocabulary browser. You can use it simply by starting the HTTP server then visiting the following location:
+
+\begin{verbatim}
+http://localhost:8888/responder/browser/
+\end{verbatim}
+
+\subsection{Serving static content}
+
+Static content may be served by setting the \verb|"doc-root"| variable to a directory holding the content. This variable may be set in the global namespace, or indeed, individually on each virtual host.
+\begin{verbatim}
+"/var/www/" "doc-root" set
+\end{verbatim}
+
+If a directory holds an \verb|index.html| file, the file is served when the directory is requested, otherwise a directory listing is produced. The directory listing references icons sent via the resource responder. The icons are located in the Factor source tree, and the \verb|"resource-path"| variable may be set to the root of the source tree in order for the icons to be located:
+\begin{verbatim}
+"/home/slava/work/Factor/" "resource-path" set
+\end{verbatim}
+A facility for ad-hoc server-side scripting exists. If a file with the \verb|.factsp| filename extension is requested, the file is run with \verb|run-file| and any output it sends to the default stream is sent to the client (\ref{stdio}). These ``Factor server pages'' are slower and less powerful than responders, so it is recommended that responders be used instead.
+
+\subsection{Responders}
+
+\glossary{name=responder,
+description={A named handler for HTTP requests, installed in the \texttt{responders} variable}}
+\glossary{name=HTTP responder,
+description={See responder}}
+
+The HTTP server listens on a port number for HTTP requests and issues requests to \emph{responders}.
+
+\subsection{Virtual hosts}
+
 \section{HTML output}\label{html}
 
 An HTML stream wraps an existing stream. Strings written to the HTML stream have their special characters converted to HTML entities before being passed on to the wrapped stream. Also, the \texttt{attrs} parameter to the \texttt{stream-write-attr} word may be filled out to wrap the text being written in various HTML tags.
@@ -5256,25 +5331,6 @@ M: list prettyprint*
     ] check-recursion ;}
 \end{alltt}
 
-\section{Browsing via the HTTP server}
-
-
-A more sophisticated way to browse the library is using the integrated HTTP server. You can start the HTTP server using the following pair of commands:
-
-\begin{alltt}
-\textbf{ok} USE: httpd
-\textbf{ok} USE: threads
-\textbf{ok} [ 8888 httpd ] in-thread
-\end{alltt}
-
-Then, point your browser to the following URL, and start browsing:
-
-\begin{quote}
-\texttt{http://localhost:8888/responder/inspect/vocabularies}
-\end{quote}
-
-To stop the HTTP server, evaluate the \verb|stop-httpd| word.
-
 \chapter{Dealing with runtime errors}
 
 \section{Looking at stacks}

library/alien/aliens.factor

@@ -18,9 +18,6 @@ BUILTIN: displaced-alien 20 displaced-alien? ;
 
 : null? ( alien -- ? ) dup alien? [ alien-address 0 = ] when ;
 
-: null>f ( alien -- alien/f )
-    dup alien-address 0 = [ drop f ] when ;
-
 M: alien hashcode ( obj -- n )
     alien-address >fixnum ;
 

library/bootstrap/boot-stage1.factor

@@ -107,7 +107,6 @@ parser prettyprint sequences stdio vectors words ;
     ] pull-in
 ] make-list
 
-"delegate" [ "generic" ] search
 "object" [ "generic" ] search
 "typemap" [ "generic" ] search
 "builtins" [ "generic" ] search
@@ -117,7 +116,6 @@ vocabularies get [ "generic" off ] bind
 reveal
 reveal
 reveal
-reveal
 
 [
     [
@@ -146,8 +144,6 @@ reveal
     
         "/library/bootstrap/init.factor"
     ] pull-in
-    
-    ! uncomment this if type numbers change. it takes a long time...
 
     [
         "Building generics..." print

library/bootstrap/primitives.factor

@@ -55,8 +55,10 @@ vocabularies get [
     [ "(fraction>)" "math-internals"          [ [ integer integer ] [ rational ] ] ]
     [ "str>float" "parser"                    [ [ string ] [ float ] ] ]
     [ "(unparse-float)" "unparser"            [ [ float ] [ string ] ] ]
-    [ "float-bits" "math"                     [ [ real ] [ integer ] ] ]
-    [ "double-bits" "math"                    [ [ real ] [ integer ] ] ]
+    [ "float>bits" "math"                     [ [ real ] [ integer ] ] ]
+    [ "double>bits" "math"                    [ [ real ] [ integer ] ] ]
+    [ "bits>float" "math"                     [ [ integer ] [ float ] ] ]
+    [ "bits>double" "math"                    [ [ integer ] [ float ] ] ]
     [ "<complex>" "math-internals"            [ [ real real ] [ number ] ] ]
     [ "fixnum+" "math-internals"              [ [ fixnum fixnum ] [ integer ] ] ]
     [ "fixnum-" "math-internals"              [ [ fixnum fixnum ] [ integer ] ] ]

library/generic/generic.factor

@@ -22,6 +22,14 @@ math-internals ;
 ! properties: "builtin-supertypes" "priority" "add-method"
 ! "class<"
 
+! So far, only tuples can have delegates, which also must be
+! tuples (the UI uses numbers as delegates in a couple of places
+! but this is Unsupported(tm)).
+GENERIC: delegate
+GENERIC: set-delegate
+
+M: object delegate drop f ;
+
 ! Metaclasses have priority -- this induces an order in which
 ! methods are added to the vtable.
 

library/generic/tuple.factor

@@ -25,14 +25,6 @@ IN: generic
 DEFER: tuple?
 BUILTIN: tuple 18 tuple? ;
 
-! So far, only tuples can have delegates, which also must be
-! tuples (the UI uses numbers as delegates in a couple of places
-! but this is Unsupported(tm)).
-GENERIC: delegate
-GENERIC: set-delegate
-
-M: object delegate drop f ;
-
 M: tuple delegate 3 slot ;
 M: tuple set-delegate 3 set-slot ;
 

library/test/alien.factor

@@ -1,19 +1,34 @@
 IN: temporary
-USE: alien
-USE: kernel
-USE: test
-USE: inference
+USING: alien kernel kernel-internals namespaces test ;
 
 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test
 [ f ] [ "hello" 1024 <alien> = ] unit-test
 
-! : alien-inference-1
-!     "void" "foobar" "boo" [ "short" "short" ] alien-invoke ;
-! 
-! [ [[ 2 0 ]] ] [ [ alien-inference-1 ] infer old-effect ] unit-test
-! 
-! : alien-inference-2
-!     "int" "foobar" "boo" [ "short" "short" ] alien-invoke ;
-! 
-! [ [[ 2 1 ]] ] [ [ alien-inference-2 ] infer old-effect ] unit-test
+! Testing the various bignum accessor
+10 <byte-array> "dump" set
+
+[ 123 ] [
+    123 "dump" get 0 set-alien-signed-1
+    "dump" get 0 alien-signed-1
+] unit-test
+
+[ 12345 ] [
+    12345 "dump" get 0 set-alien-signed-2
+    "dump" get 0 alien-signed-2
+] unit-test
+
+[ 12345678 ] [
+    12345678 "dump" get 0 set-alien-signed-4
+    "dump" get 0 alien-signed-4
+] unit-test
+
+[ 12345678901234567 ] [
+    12345678901234567 "dump" get 0 set-alien-signed-8
+    "dump" get 0 alien-signed-8
+] unit-test
+
+[ -1 ] [
+    -1 "dump" get 0 set-alien-signed-8
+    "dump" get 0 alien-signed-8
+] unit-test

library/test/image.factor

@@ -23,7 +23,7 @@ USE: math
 
 [ "\0\0\0\0\u000f\u000e\r\u000c" ]
 [
-    [ image-magic write-be64 ] with-string
+    [ image-magic write-be8 ] with-string
 ] unit-test
 
 [

library/test/math/float.factor

@@ -29,3 +29,6 @@ USE: test
 
 [ t ] [ pi 3 > ] unit-test
 [ f ] [ e 2 <= ] unit-test
+
+[ t ] [ pi double>bits bits>double pi = ] unit-test
+[ t ] [ e double>bits bits>double e = ] unit-test

library/tools/debugger.factor

@@ -69,7 +69,7 @@ M: no-method error. ( error -- )
     
     dup parse-error-text dup string? [ print ] [ drop ] ifte
     
-    parse-error-col CHAR: \s fill write "^" print ;
+    parse-error-col [ 0 ] unless* CHAR: \s fill write "^" print ;
 
 M: parse-error error. ( error -- )
     dup parse-dump  delegate error. ;

native/bignum.c

@@ -236,15 +236,15 @@ void box_signed_8(s64 n)
 
 s64 unbox_signed_8(void)
 {
-	return 0; /* s48_bignum_to_long_long(to_bignum(dpop())); */
+	return s48_bignum_to_long_long(to_bignum(dpop()));
 }
 
 void box_unsigned_8(u64 n)
 {
-	dpush(tag_bignum(s48_long_long_to_bignum(n)));
+	dpush(tag_bignum(s48_ulong_long_to_bignum(n)));
 }
 
 u64 unbox_unsigned_8(void)
 {
-	return 0; /* s48_bignum_to_long_long(to_bignum(dpop())); */
+	return s48_bignum_to_ulong_long(to_bignum(dpop()));
 }

native/debug.c

@@ -315,7 +315,7 @@ void factorbug(void)
 			throw_error(T,true);
 		else if(strcmp(cmd,"x") == 0)
 			return;
-		else if(strcmp(cmd,"y") == 0)
+		else if(strcmp(cmd,"im") == 0)
 			save_image("factor.crash.image");
 		else
 			fprintf(stderr,"unknown command\n");

native/float.c

@@ -205,11 +205,25 @@ void primitive_float_bits(void)
 	drepl(tag_cell(x_bits));
 }
 
+void primitive_bits_float(void)
+{
+	CELL x_ = unbox_unsigned_4();
+	float x = *(float*)(&x_);
+	dpush(tag_float(x));
+}
+
 void primitive_double_bits(void)
 {
-	double x = to_float(dpeek());
+	double x = to_float(dpop());
 	u64 x_bits = *(u64*)(&x);
-	drepl(tag_bignum(s48_long_long_to_bignum(x_bits)));
+	box_unsigned_8(x_bits);
+}
+
+void primitive_bits_double(void)
+{
+	u64 x_ = unbox_unsigned_8();
+	double x = *(double*)(&x_);
+	dpush(tag_float(x));
 }
 
 #define DEFBOX(name,type)                                                      \

native/float.h

@@ -50,7 +50,9 @@ void primitive_fsinh(void);
 void primitive_fsqrt(void);
 
 void primitive_float_bits(void);
+void primitive_bits_float(void);
 void primitive_double_bits(void);
+void primitive_bits_double(void);
 
 void box_float(float flo);
 float unbox_float(void);

native/gc.h

@@ -69,7 +69,7 @@ INLINE bool should_copy(CELL untagged)
 }
 
 CELL copy_object(CELL pointer);
-#define COPY_OBJECT(lvalue) if(COLLECTING_GEN(lvalue)) lvalue = copy_object(lvalue)
+#define COPY_OBJECT(lvalue) if(should_copy(lvalue)) lvalue = copy_object(lvalue)
 
 INLINE void copy_handle(CELL *handle)
 {

native/primitives.c

@@ -23,6 +23,8 @@ void* primitives[] = {
 	primitive_float_to_str,
 	primitive_float_bits,
 	primitive_double_bits,
+	primitive_bits_float,
+	primitive_bits_double,
 	primitive_from_rect,
 	primitive_fixnum_add,
 	primitive_fixnum_subtract,

native/s48_bignum.h

@@ -71,6 +71,8 @@ DLLEXPORT bignum_type s48_ulong_long_to_bignum(u64 n);
 DLLEXPORT bignum_type s48_ulong_to_bignum(unsigned long);
 long s48_bignum_to_long(bignum_type);
 unsigned long s48_bignum_to_ulong(bignum_type);
+s64 s48_bignum_to_long_long(bignum_type);
+u64 s48_bignum_to_ulong_long(bignum_type);
 bignum_type s48_double_to_bignum(double);
 double s48_bignum_to_double(bignum_type);
 int s48_bignum_fits_in_word_p(bignum_type, long word_length,

native/s48_bignumint.h

@@ -114,11 +114,8 @@ typedef long bignum_length_type;
 #define BIGNUM_BITS_TO_DIGITS(n)					\
   (((n) + (BIGNUM_DIGIT_LENGTH - 1)) / BIGNUM_DIGIT_LENGTH)
 
-#define BIGNUM_DIGITS_FOR_LONG						\
-  (BIGNUM_BITS_TO_DIGITS ((sizeof (long)) * CHAR_BIT))
-
-#define BIGNUM_DIGITS_FOR_LONG_LONG					\
-  (BIGNUM_BITS_TO_DIGITS ((sizeof (s64)) * CHAR_BIT))
+#define BIGNUM_DIGITS_FOR(type) \
+  (BIGNUM_BITS_TO_DIGITS ((sizeof (type)) * CHAR_BIT))
 
 #ifndef BIGNUM_DISABLE_ASSERTION_CHECKS