messing around with ffi, various other fixes

TODO.FACTOR.txt

@@ -1,4 +1,3 @@
-- word preview for parsing words
 - set 'end' of artifacts/assets accurately
 - faster layout
 - faster repaint
@@ -11,13 +10,13 @@
 - make-image: use a list not a vector
 - powerpc has weird callstack residue
 - make-vector and make-string should not need a reverse step
-- faster completion
 - console with presentations
 - ui browser
 - method doc strings
 
 + ui:
 
+- word preview for parsing words
 - mouse enter onto overlapping with interior, but not child, gadget
 - menu dragging
 - fix up the min thumb size hack
@@ -25,6 +24,10 @@
 
 + compiler/ffi:
 
+- ffi global variables, and get rid of factor_str_error hack
+- box/unbox_signed/unsigned_8
+- unsigned versions of all alien accessors and setters
+
 - [ [ dup call ] dup call ] infer hangs
 - ffi unicode strings: null char security hole
 - utf16 string boxing
@@ -48,6 +51,7 @@
 
 + kernel:
 
+- clean up metaclasses
 - unify unparse and prettyprint
 - condition system with restarts
 - nicer way to combine two paths

factor/DefaultVocabularyLookup.java

@@ -136,6 +136,14 @@ public class DefaultVocabularyLookup implements VocabularyLookup
 		tuple.parsing = new Tuple(tuple);
 		FactorWord primitive = define("syntax","PRIMITIVE:");
 		primitive.parsing = new Primitive(primitive);
+		
+		/* Alien */
+		FactorWord beginStruct = define("alien","BEGIN-STRUCT:");
+		beginStruct.parsing = new BeginStruct(beginStruct);
+		FactorWord endStruct = define("alien","END-STRUCT");
+		endStruct.parsing = new EndStruct(beginStruct,endStruct);
+		FactorWord field = define("alien","FIELD:");
+		field.parsing = new Field(field);
 	} //}}}
 
 	//{{{ getVocabulary() method

factor/jedit/FactorPlugin.java

@@ -537,6 +537,7 @@ public class FactorPlugin extends EditPlugin
 			{
 				offset = buffer.getLineEndOffset(i) - 1;
 				leadingNewline = true;
+				break;
 			}
 			else if(text.startsWith("!"))
 			{

factor/jedit/FactorWordRenderer.java

@@ -45,9 +45,7 @@ public class FactorWordRenderer extends DefaultListCellRenderer
 		if(showIn)
 		{
 			str = jEdit.getProperty("factor.completion.in",
-				new Object[] {
+				new Object[] { word.vocabulary }) + str;
-					MiscUtilities.charsToEntities(word.vocabulary)
-				}) + str;
 		}
 
 		if(word.stackEffect != null)

factor/parser/BeginStruct.java

@@ -0,0 +1,53 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2005 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.parser;
+
+import factor.*;
+
+public class BeginStruct extends FactorParsingDefinition
+{
+	public BeginStruct(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorReader reader) throws Exception
+	{
+		Object next = reader.nextNonEOL(false,false);
+		if(!(next instanceof String))
+		{
+			reader.getScanner().error("Missing struct name");
+			return;
+		}
+		String structName = (String)next;
+		reader.intern("<" + structName + ">",true);
+		reader.pushState(word,null);
+	}
+}

factor/parser/EndStruct.java

@@ -0,0 +1,48 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2005 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.parser;
+
+import factor.*;
+
+public class EndStruct extends FactorParsingDefinition
+{
+	private FactorWord start;
+
+	public EndStruct(FactorWord start, FactorWord word)
+	{
+		super(word);
+		this.start = start;
+	}
+
+	public void eval(FactorReader reader) throws FactorParseException
+	{
+		reader.popState(start,null);
+	}
+}

factor/parser/Field.java

@@ -0,0 +1,58 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2005 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class Field extends FactorParsingDefinition
+{
+	public Field(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorReader reader)
+		throws IOException, FactorParseException
+	{
+		Object type = reader.nextNonEOL(false,false);
+		if(!(type instanceof String))
+		{
+			reader.getScanner().error("Missing field type");
+			return;
+		}
+		Object name = reader.nextNonEOL(false,false);
+		if(!(name instanceof String))
+		{
+			reader.getScanner().error("Missing field name");
+			return;
+		}
+	}
+}

library/bootstrap/boot-stage1.factor

@@ -56,12 +56,14 @@ hashtables ;
     "delegate" [ "generic" ] search
     "object" [ "generic" ] search
     "classes" [ "generic" ] search
+    "builtins" [ "generic" ] search
 
     vocabularies get [ "generic" off ] bind
 
     reveal
     reveal
     reveal
+    reveal
 
     [
         "/library/generic/generic.factor"

library/bootstrap/image.factor

@@ -1,29 +1,5 @@
-! :folding=none:collapseFolds=1:
-
-! $Id$
-!
 ! Copyright (C) 2004, 2005 Slava Pestov.
-! 
+! See http://factor.sf.net/license.txt for BSD license.
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 ! This library allows one to generate a new set of bootstrap
 ! images (boot.image.{le32,le64,be32,be64}.
@@ -39,24 +15,8 @@
 ! run platform/native/boot-stage2.factor.
 
 IN: image
-USE: errors
+USING: errors generic hashtables kernel lists math namespaces
-USE: generic
+parser prettyprint stdio streams strings vectors words ;
-USE: kernel-internals
-USE: hashtables
-USE: kernel
-USE: lists
-USE: math
-USE: namespaces
-USE: prettyprint
-USE: random
-USE: stdio
-USE: streams
-USE: strings
-USE: test
-USE: vectors
-USE: unparser
-USE: words
-USE: parser
 
 ! The image being constructed; a vector of word-size integers
 SYMBOL: image
@@ -285,14 +245,6 @@ M: string ' ( string -- pointer )
 M: vector ' ( vector -- pointer )
     emit-vector ;
 
-! : rehash ( hashtable -- )
-!     ! Now make a rehashing boot quotation
-!     dup hash>alist [
-!         over hash-clear
-!         [ unswons rot set-hash ] each-with
-!     ] cons cons
-!     boot-quot [ append ] change ;
-
 : emit-hashtable ( hash -- pointer )
     dup buckets>list emit-array swap hash>alist length
     object-tag here-as >r
@@ -324,7 +276,9 @@ M: hashtable ' ( hashtable -- pointer )
     vocabularies get
     dup vocabularies,
     <namespace> [
-        classes [ ] change  vocabularies set
+        vocabularies set
+        classes [ ] change
+        builtins [ ] change
     ] extend '
     global-offset fixup ;
 
@@ -361,9 +315,6 @@ M: hashtable ' ( hashtable -- pointer )
     [
         300000 <vector> image set
         <namespace> "objects" set
-        ! Note that this is a vector that we can side-effect,
-        ! since ; ends up using this variable from nested
-        ! parser namespaces.
         call
         image get
     ] with-scope ;

library/bootstrap/primitives.factor

@@ -18,6 +18,7 @@ classes
 
 <namespace> vocabularies set
 <namespace> classes set
+num-types <vector> builtins set
 <namespace> crossref set
 
 vocabularies get [
@@ -170,14 +171,27 @@ vocabularies get [
     [ "dlclose" "alien"                       [ [ dll ] [ ] ] ]
     [ "<alien>" "alien"                       [ [ integer ] [ alien ] ] ]
     [ "<local-alien>" "alien"                 [ [ integer ] [ alien ] ] ]
-    [ "alien-cell" "alien"                    [ [ alien integer ] [ integer ] ] ]
+    [ "alien-signed-cell" "alien"             [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-cell" "alien"                [ [ integer alien integer ] [ ] ] ]
+    [ "set-alien-signed-cell" "alien"         [ [ integer alien integer ] [ ] ] ]
-    [ "alien-4" "alien"                       [ [ alien integer ] [ integer ] ] ]
+    [ "alien-unsigned-cell" "alien"           [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-4" "alien"                   [ [ integer alien integer ] [ ] ] ]
+    [ "set-alien-unsigned-cell" "alien"       [ [ integer alien integer ] [ ] ] ]
-    [ "alien-2" "alien"                       [ [ alien integer ] [ fixnum ] ] ]
+    [ "alien-signed-8" "alien"                [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-2" "alien"                   [ [ integer alien integer ] [ ] ] ]
+    [ "set-alien-signed-8" "alien"            [ [ integer alien integer ] [ ] ] ]
-    [ "alien-1" "alien"                       [ [ alien integer ] [ fixnum ] ] ]
+    [ "alien-unsigned-8" "alien"              [ [ alien integer ] [ integer ] ] ]
-    [ "set-alien-1" "alien"                   [ [ integer alien integer ] [ ] ] ]
+    [ "set-alien-unsigned-8" "alien"          [ [ integer alien integer ] [ ] ] ]
+    [ "alien-signed-4" "alien"                [ [ alien integer ] [ integer ] ] ]
+    [ "set-alien-signed-4" "alien"            [ [ integer alien integer ] [ ] ] ]
+    [ "alien-unsigned-4" "alien"              [ [ alien integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-4" "alien"          [ [ integer alien integer ] [ ] ] ]
+    [ "alien-signed-2" "alien"                [ [ alien integer ] [ integer ] ] ]
+    [ "set-alien-signed-2" "alien"            [ [ integer alien integer ] [ ] ] ]
+    [ "alien-unsigned-2" "alien"              [ [ alien integer ] [ integer ] ] ]
+    [ "set-alien-unsigned-2" "alien"          [ [ integer alien integer ] [ ] ] ]
+    [ "alien-signed-1" "alien"                [ [ alien integer ] [ integer ] ] ]
+    [ "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 ] ] ]
     [ "throw" "errors"                        [ [ object ] [ ] ] ]
     [ "string>memory" "kernel-internals"      [ [ string integer ] [ ] ] ]
     [ "memory>string" "kernel-internals"      [ [ integer integer ] [ string ] ] ]

library/compiler/alien-types.factor

@@ -34,21 +34,18 @@ namespaces parser strings words ;
         0 "width" set
     ] extend ;
 
-: c-types ( -- ns )
+SYMBOL: c-types
-    global [ "c-types" get ] bind ;
 
 : c-type ( name -- type )
-    global [
+    dup c-types get hash [ ] [
-        dup "c-types" get hash [ ] [
         "No such C type: " swap cat2 throw f
-        ] ?ifte
+    ] ?ifte ;
-    ] bind ;
 
 : size ( name -- size )
     c-type [ "width" get ] bind ;
 
 : define-c-type ( quot name -- )
-    c-types [ >r <c-type> swap extend r> set ] bind ; inline
+    c-types get [ >r <c-type> swap extend r> set ] bind ; inline
 
 : define-getter ( offset type name -- )
     #! Define a word with stack effect ( alien -- obj ) in the
@@ -63,7 +60,7 @@ namespaces parser strings words ;
     [ "setter" get ] bind cons r> swap define-compound ;
 
 : define-field ( offset type name -- offset )
-    >r c-type dup >r [ "width" get ] bind align r> r>
+    >r c-type dup >r [ "align" get ] bind align r> r>
     "struct-name" get swap "-" swap cat3
     ( offset type name -- )
     3dup define-getter 3dup define-setter
@@ -85,7 +82,8 @@ namespaces parser strings words ;
     #! Define inline and pointer type for the struct. Pointer
     #! type is exactly like void*.
     [ "width" set ] "struct-name" get define-c-type
-    "void*" c-type "struct-name" get "*" cat2 c-types set-hash ;
+    "void*" c-type "struct-name" get "*" cat2
+    c-types get set-hash ;
 
 : BEGIN-STRUCT: ( -- offset )
     scan "struct-name" set  0 ; parsing
@@ -109,93 +107,126 @@ namespaces parser strings words ;
     #! C null value.
     0 <alien> ;
 
-global [ <namespace> "c-types" set ] bind
+global [ <namespace> c-types set ] bind
 
 [
-    [ alien-cell <alien> ] "getter" set
+    [ alien-unsigned-cell <alien> ] "getter" set
-    [ set-alien-cell ] "setter" set
+    [ alien-address set-alien-unsigned-cell ] "setter" set
     cell "width" set
+    cell "align" set
     "box_alien" "boxer" set
     "unbox_alien" "unboxer" set
 ] "void*" define-c-type
 
-! FIXME
 [
-    [ alien-4 ] "getter" set
+    [ alien-signed-8 ] "getter" set
-    [ set-alien-4 ] "setter" set
+    [ set-alien-signed-8 ] "setter" set
-    4 "width" set
+    8 "width" set
-    "box_integer" "boxer" set
+    8 "align" set
-    "unbox_integer" "unboxer" set
+    "box_signed_8" "boxer" set
-] "long" define-c-type
+    "unbox_signed_8" "unboxer" set
+] "longlong" define-c-type
 
 [
-    [ alien-4 ] "getter" set
+    [ alien-unsigned-8 ] "getter" set
-    [ set-alien-4 ] "setter" set
+    [ set-alien-unsigned-8 ] "setter" set
+    8 "width" set
+    8 "align" set
+    "box_unsinged_8" "boxer" set
+    "unbox_unsigned_8" "unboxer" set
+] "ulonglong" define-c-type
+
+[
+    [ alien-signed-4 ] "getter" set
+    [ set-alien-signed-4 ] "setter" set
     4 "width" set
-    "box_integer" "boxer" set
+    4 "align" set
-    "unbox_integer" "unboxer" set
+    "box_signed_4" "boxer" set
+    "unbox_signed_4" "unboxer" set
 ] "int" define-c-type
 
 [
-    [ alien-4 ] "getter" set
+    [ alien-unsigned-4 ] "getter" set
-    [ set-alien-4 ] "setter" set
+    [ set-alien-unsigned-4 ] "setter" set
     4 "width" set
-    "box_cell" "boxer" set
+    4 "align" set
-    "unbox_cell" "unboxer" set
+    "box_unsigned_4" "boxer" set
+    "unbox_unsigned_4" "unboxer" set
 ] "uint" define-c-type
 
 [
-    [ alien-2 ] "getter" set
+    [ alien-signed-2 ] "getter" set
-    [ set-alien-2 ] "setter" set
+    [ set-alien-signed-2 ] "setter" set
     2 "width" set
+    2 "align" set
     "box_signed_2" "boxer" set
     "unbox_signed_2" "unboxer" set
 ] "short" define-c-type
 
 [
-    [ alien-2 ] "getter" set
+    [ alien-unsigned-2 ] "getter" set
-    [ set-alien-2 ] "setter" set
+    [ set-alien-unsigned-2 ] "setter" set
     2 "width" set
+    2 "align" set
     "box_unsigned_2" "boxer" set
     "unbox_unsigned_2" "unboxer" set
 ] "ushort" define-c-type
 
 [
-    [ alien-1 ] "getter" set
+    [ alien-signed-1 ] "getter" set
-    [ set-alien-1 ] "setter" set
+    [ set-alien-signed-1 ] "setter" set
     1 "width" set
+    1 "align" set
     "box_signed_1" "boxer" set
     "unbox_signed_1" "unboxer" set
 ] "char" define-c-type
 
 [
-    [ alien-1 ] "getter" set
+    [ alien-unsigned-1 ] "getter" set
-    [ set-alien-1 ] "setter" set
+    [ set-alien-unsigned-1 ] "setter" set
     1 "width" set
+    1 "align" set
     "box_unsigned_1" "boxer" set
     "unbox_unsigned_1" "unboxer" set
 ] "uchar" define-c-type
 
 [
-    [ alien-4 ] "getter" set
+    [ alien-unsigned-4 ] "getter" set
-    [ set-alien-4 ] "setter" set
+    [ set-alien-unsigned-4 ] "setter" set
     cell "width" set
+    cell "align" set
     "box_c_string" "boxer" set
     "unbox_c_string" "unboxer" set
 ] "char*" define-c-type
 
+! This is not the best way to do it.
 [
-    [ alien-4 ] "getter" set
+    [ alien-value-string ] "getter" set
-    [ set-alien-4 ] "setter" set
+    256 "width" set
+    cell "align" set
+] "uchar256" define-c-type
+
+[
+    [ alien-unsigned-4 ] "getter" set
+    [ set-alien-unsigned-4 ] "setter" set
     cell "width" set
+    cell "align" set
     "box_utf16_string" "boxer" set
     "unbox_utf16_string" "unboxer" set
 ] "ushort*" define-c-type
 
 [
-    [ alien-4 0 = not ] "getter" set
+    [ alien-unsigned-4 0 = not ] "getter" set
-    [ 1 0 ? set-alien-4 ] "setter" set
+    [ 1 0 ? set-alien-unsigned-4 ] "setter" set
     cell "width" set
+    cell "align" set
     "box_boolean" "boxer" set
     "unbox_boolean" "unboxer" set
 ] "bool" define-c-type
+
+: alias-c-type ( old new -- )
+    c-types get [ >r get r> set ] bind ;
+
+! FIXME for 64-bit platforms
+"int" "long" alias-c-type
+"uint" "ulong" alias-c-type

library/compiler/alien.factor

@@ -26,6 +26,9 @@ unparser words ;
 
 : null? ( alien -- ? ) dup [ 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/compiler/assembler.factor

@@ -8,10 +8,14 @@ SYMBOL: interned-literals
 : cell 4 ; inline
 : compiled-header HEX: 01c3babe ; inline
 
-: compiled-byte ( a -- n ) <alien> 0 alien-1 ; inline
+: compiled-byte ( a -- n )
-: set-compiled-byte ( n a -- ) <alien> 0 set-alien-1 ; inline
+    <alien> 0 alien-signed-1 ; inline
-: compiled-cell ( a -- n ) <alien> 0 alien-cell ; inline
+: set-compiled-byte ( n a -- )
-: set-compiled-cell ( n a -- ) <alien> 0 set-alien-cell ; inline
+    <alien> 0 set-alien-signed-1 ; inline
+: compiled-cell ( a -- n )
+    <alien> 0 alien-signed-cell ; inline
+: set-compiled-cell ( n a -- )
+    <alien> 0 set-alien-signed-cell ; inline
 
 : compile-aligned ( n -- )
     compiled-offset cell 2 * align set-compiled-offset ; inline

library/generic/builtin.factor

@@ -7,6 +7,9 @@ words vectors ;
 ! Builtin metaclass for builtin types: fixnum, word, cons, etc.
 SYMBOL: builtin
 
+! Global vector mapping type numbers to builtin class objects.
+SYMBOL: builtins
+
 builtin [
     "builtin-type" word-prop unit
 ] "builtin-supertypes" set-word-prop
@@ -38,13 +41,13 @@ builtin [ 2drop t ] "class<" set-word-prop
     ] ifte ;
 
 : builtin-class ( symbol type# slotspec -- )
+    >r 2dup builtins get set-vector-nth r>
     >r swap
     dup intern-symbol
     2dup builtin-predicate
     [ swap "builtin-type" set-word-prop ] keep
     dup builtin define-class r> define-slots ;
 
-: builtin-type ( n -- symbol )
+: builtin-type ( n -- symbol ) builtins get vector-nth ;
-    unit classes get hash ;
 
 PREDICATE: word builtin metaclass builtin = ;

library/generic/tuple.factor

@@ -18,7 +18,7 @@ hashtables errors vectors ;
     #! specifying an incorrect size.
     <tuple> [ 0 swap set-array-nth ] keep ;
 
-: tuple-class 2 slot ; inline
+: class-tuple 2 slot ; inline
 
 IN: generic
 
@@ -42,7 +42,7 @@ UNION: arrayed array tuple ;
 
 : class ( obj -- class )
     #! The class of an object.
-    dup tuple? [ tuple-class ] [ type builtin-type ] ifte ;
+    dup tuple? [ class-tuple ] [ type builtin-type ] ifte ;
 
 : (literal-tuple) ( list size -- tuple )
     dup <tuple> swap [
@@ -154,7 +154,7 @@ UNION: arrayed array tuple ;
     #! for methods defined on the given generic.
     dup default-tuple-method \ drop swons
     swap "methods" word-prop hash>quot
-    [ dup tuple-class ] swap append ;
+    [ dup class-tuple ] swap append ;
 
 : add-tuple-dispatch ( word vtable -- )
     >r tuple-dispatch-quot tuple r> set-vtable ;
@@ -173,7 +173,7 @@ M: tuple clone ( tuple -- tuple )
 
 M: tuple = ( obj tuple -- ? )
     over tuple? [
-        over class over class = [
+        over class-tuple over class-tuple eq? [
             swap tuple>list swap tuple>list =
         ] [
             2drop f

library/inference/words.factor

@@ -107,14 +107,14 @@ M: compound apply-word ( word -- )
     "Dynamic dispatch for " swap word-name cat2
     inference-warning ;
 
-M: generic apply-word ( word -- )
+! M: generic apply-word ( word -- )
-    #! If the type of the value at the top of the stack is
+!     #! If the type of the value at the top of the stack is
-    #! known, inline the method body.
+!     #! known, inline the method body.
-    [ object ] ensure-d
+!     [ object ] ensure-d
 !    literal-type? branches-can-fail? not and [
 !        inline-compound 2drop
 !    ] [
-        dup dynamic-dispatch-warning apply-default ;
+!        dup dynamic-dispatch-warning apply-default ;
 !    ] ifte ;
 
 : with-recursion ( quot -- )
@@ -171,7 +171,8 @@ M: word apply-object ( word -- )
 \ * [ [ number number ] [ number ] ] "infer-effect" set-word-prop
 \ - [ [ number number ] [ number ] ] "infer-effect" set-word-prop
 \ + [ [ number number ] [ number ] ] "infer-effect" set-word-prop
-\ = [ [ object object ] [ object ] ] "infer-effect" set-word-prop
+\ = [ [ object object ] [ boolean ] ] "infer-effect" set-word-prop
+\ <no-method> [ [ object object ] [ tuple ] ] "infer-effect" set-word-prop
 
 \ no-method t "terminator" set-word-prop
 \ no-method [ [ object word ] [ ] ] "infer-effect" set-word-prop

library/test/alien.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: alien
 USE: kernel
 USE: test

library/test/annotate.factor

@@ -0,0 +1,7 @@
+IN: temporary
+USING: words ;
+
+: foo ;
+\ foo watch
+
+[ ] [ foo ] unit-test

library/test/benchmark/continuations.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/benchmark/empty-loop.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: kernel
 USE: math

library/test/benchmark/fac.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: math
 USE: test
 USE: compiler

library/test/benchmark/fib.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: kernel
 USE: math

library/test/benchmark/sort.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: lists
 USE: kernel
 USE: math

library/test/buffer.factor

@@ -1,4 +1,4 @@
-IN: scratchpad USING: test kernel kernel-internals ;
+IN: temporary USING: test kernel kernel-internals ;
 
 : with-buffer ( size quot -- )
     >r <buffer> r> keep buffer-free ;

library/test/combinators.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/compiler/bail-out.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: errors
 USE: math

library/test/compiler/generic.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: generic
 USE: test

library/test/compiler/ifte.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: test
 USE: math

library/test/compiler/linearizer.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: test
 USE: kernel
 USE: compiler

library/test/compiler/optimizer.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: test
 USE: compiler
 USE: inference

library/test/compiler/simple.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: test
 USE: math

library/test/compiler/simplifier.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: test
 USE: inference

library/test/compiler/stack.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: compiler
 USE: test
 USE: words

library/test/continuations.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: lists
 USE: math

library/test/crashes.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 
 ! Various things that broke CFactor at various times.
 USING: errors kernel lists math memory namespaces parser

library/test/dataflow.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: inference
 USE: lists
 USE: math

library/test/errors.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: errors
 USE: kernel
 USE: namespaces

library/test/files.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: files
 USE: httpd
 USE: lists

library/test/gadgets.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: gadgets kernel lists math namespaces test ;
 
 [ t ] [

library/test/generic.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: parser prettyprint stdio ;
 
 USE: hashtables
@@ -122,12 +122,12 @@ TUPLE: another-one ;
 [ << another-one f >> ] [ <another-one> empty-method-test ] unit-test
 
 ! Test generic see and parsing
-[ "IN: scratchpad\nSYMBOL: bah \nUNION: bah fixnum alien ;\n" ]
+[ "IN: temporary\nSYMBOL: bah \nUNION: bah fixnum alien ;\n" ]
 [ [ \ bah see ] with-string ] unit-test
 
 [ t ] [
     DEFER: not-fixnum
-    "IN: scratchpad\nSYMBOL: not-fixnum \nCOMPLEMENT: not-fixnum fixnum\n"
+    "IN: temporary\nSYMBOL: not-fixnum \nCOMPLEMENT: not-fixnum fixnum\n"
     dup eval
     [ \ not-fixnum see ] with-string =
 ] unit-test

library/test/hashtables.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: hashtables
 USE: kernel
 USE: lists

library/test/httpd/html.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: html
 USE: namespaces
 USE: stdio

library/test/httpd/httpd.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: file-responder
 USE: httpd
 USE: httpd-responder

library/test/httpd/url-encoding.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: url-encoding
 USE: test
 

library/test/inference.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: test
 USE: inference
 USE: math

library/test/init.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: command-line
 USE: namespaces
 USE: test

library/test/interpreter.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: vectors
 USE: interpreter
 USE: test

library/test/io/io.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: namespaces
 USE: parser
 USE: streams

library/test/line-editor.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: namespaces
 USE: line-editor
 USE: test

library/test/listener.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: namespaces
 USE: stdio
 USE: test

library/test/lists/assoc.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: lists
 USE: math
 USE: namespaces

library/test/lists/combinators.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: lists
 USE: math

library/test/lists/cons.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: lists
 USE: test
 

library/test/lists/lists.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: lists
 USE: math

library/test/lists/namespaces.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: lists
 USE: namespaces
 USE: test

library/test/lists/queues.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: kernel lists test ;
 
 [ [ 1 2 3 4 5 ] ] [

library/test/math/bignum.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: math
 USE: test
 USE: unparser

library/test/math/bitops.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/math/complex.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/math/float.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/math/gcd.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: math
 USE: test
 

library/test/math/irrational.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: math-internals

library/test/math/math-combinators.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/math/rational.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: math
 USE: test

library/test/memory.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: generic kernel lists math memory words ;
 
 num-types [

library/test/namespaces.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: namespaces
 USE: test

library/test/parse-number.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: math
 USE: parser
 USE: strings

library/test/parser.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: parser
 USE: test
 USE: unparser
@@ -37,7 +37,7 @@ unit-test
 
 [ "hello world" ]
 [
-    "IN: scratchpad : hello \"hello world\" ;"
+    "IN: temporary : hello \"hello world\" ;"
     parse call "USE: scratchpad hello" eval
 ] unit-test
 

library/test/parsing-word.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 
 USE: parser
 USE: test

library/test/prettyprint.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: lists
 USE: prettyprint
 USE: test

library/test/random.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: kernel
 USE: lists
 USE: math

library/test/redefine.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: compiler inference math ;
 
 USE: test

library/test/sbuf.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: errors
 USE: kernel
 USE: math

library/test/stream.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: namespaces
 USE: streams
 USE: stdio

library/test/strings.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: errors
 USE: kernel
 USE: math

library/test/test.factor

@@ -43,7 +43,7 @@ prettyprint stdio strings words vectors unparser ;
 
 : all-tests ( -- )
     "Running Factor test suite..." print
-    vocabularies get [ "scratchpad" off ] bind
+    vocabularies get [ "temporary" off ] bind
     [
         "lists/cons"
         "lists/lists"
@@ -94,6 +94,7 @@ prettyprint stdio strings words vectors unparser ;
         "gadgets"
         "memory"
         "redefine"
+        "annotate"
     ] [
         test
     ] each

library/test/threads.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 
 USE: namespaces
 USE: stdio

library/test/tuple.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: generic kernel test math parser ;
 
 TUPLE: rect x y w h ;

library/test/unparser.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USE: lists
 USE: math
 USE: parser

library/test/words.factor

@@ -1,4 +1,4 @@
-IN: scratchpad
+IN: temporary
 USING: generic kernel lists math namespaces test words ;
 
 [ 4 ] [

library/tools/annotations.factor

@@ -6,10 +6,10 @@ IN: words
 ! or single-stepping. Note that currently, words referring to
 ! annotated words cannot be compiled; and annotating a word has
 ! no effect of compiled calls to that word.
-USING: interpreter kernel lists stdio strings ;
+USING: interpreter kernel lists stdio strings test ;
 
 : annotate ( word quot -- ) #! Quotation: ( word def -- def )
-    over [ word-def swap call ] keep (define-compound) ;
+    >r dup dup word-def r> call (define-compound) ; inline
 
 : (watch) >r "==> " swap word-name cat2 \ print r> cons cons ;
 
@@ -19,8 +19,10 @@ USING: interpreter kernel lists stdio strings ;
     #! word with \ foo reload.
     [ (watch) ] annotate ;
 
-: (break) [ walk ] cons ;
-
 : break ( word -- )
     #! Cause the word to start the code walker when executed.
-    [ nip (break) ] annotate ;
+    [ nip [ walk ] cons ] annotate ;
+
+: timer ( word -- )
+    #! Print the time taken to execute the word when it's called.
+    [ nip [ time ] cons ] annotate ;

native/bignum.c

@@ -1,23 +1,5 @@
 #include "factor.h"
 
-/* FFI calls this */
-void box_integer(F_FIXNUM integer)
-{
-	dpush(tag_integer(integer));
-}
-
-/* FFI calls this */
-void box_cell(CELL cell)
-{
-	dpush(tag_cell(cell));
-}
-
-/* FFI calls this */
-F_FIXNUM unbox_integer(void)
-{
-	return to_fixnum(dpop());
-}
-
 CELL to_cell(CELL x)
 {
 	F_FIXNUM fixnum;
@@ -50,12 +32,6 @@ CELL to_cell(CELL x)
 	}
 }
 
-/* FFI calls this */
-CELL unbox_cell(void)
-{
-	return to_cell(dpop());
-}
-
 F_ARRAY* to_bignum(CELL tagged)
 {
 	F_RATIO* r;
@@ -238,3 +214,63 @@ void copy_bignum_constants(void)
 	COPY_OBJECT(bignum_pos_one);
 	COPY_OBJECT(bignum_neg_one);
 }
+
+void box_signed_cell(F_FIXNUM integer)
+{
+	dpush(tag_integer(integer));
+}
+
+F_FIXNUM unbox_signed_cell(void)
+{
+	return to_fixnum(dpop());
+}
+
+void box_unsigned_cell(CELL cell)
+{
+	dpush(tag_cell(cell));
+}
+
+F_FIXNUM unbox_unsigned_cell(void)
+{
+	return to_cell(dpop());
+}
+
+void box_signed_4(s32 n)
+{
+	dpush(tag_bignum(s48_long_to_bignum(n)));
+}
+
+s32 unbox_signed_4(void)
+{
+	return s48_bignum_to_long(to_bignum(dpop()));
+}
+
+void box_unsigned_4(u32 n)
+{
+	dpush(tag_bignum(s48_ulong_to_bignum(n)));
+}
+
+u32 unbox_unsigned_4(void)
+{
+	return s48_bignum_to_ulong(to_bignum(dpop()));
+}
+
+void box_signed_8(s64 n)
+{
+	dpush(tag_bignum(s48_long_long_to_bignum(n)));
+}
+
+s64 unbox_signed_8(void)
+{
+	return 0; /* s48_bignum_to_long_long(to_bignum(dpop())); */
+}
+
+void box_unsigned_8(u64 n)
+{
+	dpush(tag_bignum(s48_long_long_to_bignum(n)));
+}
+
+u64 unbox_unsigned_8(void)
+{
+	return 0; /* s48_bignum_to_long_long(to_bignum(dpop())); */
+}

native/bignum.h

@@ -20,11 +20,7 @@ INLINE CELL tag_bignum(F_ARRAY* bignum)
 
 CELL to_cell(CELL x);
 
-DLLEXPORT void box_integer(F_FIXNUM integer);
-DLLEXPORT void box_cell(CELL cell);
-DLLEXPORT F_FIXNUM unbox_integer(void);
 CELL to_cell(CELL x);
-DLLEXPORT CELL unbox_cell(void);
 F_ARRAY* to_bignum(CELL tagged);
 void primitive_to_bignum(void);
 void primitive_bignum_eq(void);
@@ -45,7 +41,6 @@ void primitive_bignum_greater(void);
 void primitive_bignum_greatereq(void);
 void primitive_bignum_not(void);
 void copy_bignum_constants(void);
-CELL three_test(void* x, unsigned char r, unsigned char g, unsigned char b);
 
 INLINE CELL tag_integer(F_FIXNUM x)
 {
@@ -62,3 +57,22 @@ INLINE CELL tag_cell(CELL x)
 	else
 		return tag_fixnum(x);
 }
+
+/* FFI calls this */
+void box_signed_cell(F_FIXNUM integer);
+DLLEXPORT F_FIXNUM unbox_signed_cell(void);
+
+DLLEXPORT void box_unsigned_cell(CELL cell);
+DLLEXPORT F_FIXNUM unbox_unsigned_cell(void);
+
+DLLEXPORT void box_signed_4(s32 n);
+DLLEXPORT s32 unbox_signed_4(void);
+
+DLLEXPORT void box_unsigned_4(u32 n);
+DLLEXPORT u32 unbox_unsigned_4(void);
+
+DLLEXPORT void box_signed_8(s64 n);
+DLLEXPORT s64 unbox_signed_8(void);
+
+DLLEXPORT void box_unsigned_8(u64 n);
+DLLEXPORT u64 unbox_unsigned_8(void);

native/compiler.c

@@ -8,23 +8,23 @@ void init_compiler(CELL size)
 
 void primitive_compiled_offset(void)
 {
-	box_integer(compiling.here);
+	box_unsigned_cell(compiling.here);
 }
 
 void primitive_set_compiled_offset(void)
 {
-	CELL offset = unbox_integer();
+	CELL offset = unbox_unsigned_cell();
 	compiling.here = offset;
 }
 
 void primitive_literal_top(void)
 {
-	box_integer(literal_top);
+	box_unsigned_cell(literal_top);
 }
 
 void primitive_set_literal_top(void)
 {
-	CELL offset = unbox_integer();
+	CELL offset = unbox_unsigned_cell();
 	if(offset >= literal_max)
 		critical_error("Too many compiled literals",offset);
 	literal_top = offset;

native/ffi.c

@@ -60,7 +60,7 @@ void box_alien(void* ptr)
 
 INLINE void* alien_pointer(void)
 {
-	F_FIXNUM offset = unbox_integer();
+	F_FIXNUM offset = unbox_signed_cell();
 	ALIEN* alien = untag_alien(dpop());
 	void* ptr = alien->ptr;
 
@@ -72,14 +72,14 @@ INLINE void* alien_pointer(void)
 
 void primitive_alien(void)
 {
-	void* ptr = (void*)unbox_integer();
+	void* ptr = (void*)unbox_signed_cell();
 	maybe_garbage_collection();
 	box_alien(ptr);
 }
 
 void primitive_local_alien(void)
 {
-	F_FIXNUM length = unbox_integer();
+	F_FIXNUM length = unbox_signed_cell();
 	ALIEN* alien;
 	F_STRING* local;
 	if(length < 0)
@@ -99,57 +99,7 @@ void primitive_local_alienp(void)
 
 void primitive_alien_address(void)
 {
-	box_cell((CELL)untag_alien(dpop())->ptr);
+	box_unsigned_cell((CELL)untag_alien(dpop())->ptr);
-}
-
-void primitive_alien_cell(void)
-{
-	box_integer(*(int*)alien_pointer());
-}
-
-void primitive_set_alien_cell(void)
-{
-	CELL* ptr = alien_pointer();
-	CELL value = unbox_integer();
-	*ptr = value;
-}
-
-void primitive_alien_4(void)
-{
-	int* ptr = alien_pointer();
-	box_integer(*ptr);
-}
-
-void primitive_set_alien_4(void)
-{
-	int* ptr = alien_pointer();
-	int value = unbox_integer();
-	*ptr = value;
-}
-
-void primitive_alien_2(void)
-{
-	u16* ptr = alien_pointer();
-	box_signed_2(*ptr);
-}
-
-void primitive_set_alien_2(void)
-{
-	u16* ptr = alien_pointer();
-	CELL value = unbox_signed_2();
-	*ptr = value;
-}
-
-void primitive_alien_1(void)
-{
-	box_signed_1(*(BYTE*)alien_pointer());
-}
-
-void primitive_set_alien_1(void)
-{
-	BYTE* ptr = alien_pointer();
-	BYTE value = value = unbox_signed_1();
-	*ptr = value;
 }
 
 void fixup_dll(DLL* dll)
@@ -177,3 +127,31 @@ void collect_alien(ALIEN* alien)
 		alien->ptr = (void*)(ptr + 1);
 	}
 }
+
+#define DEF_ALIEN_SLOT(name,type,boxer) \
+void primitive_alien_##name (void) \
+{ \
+	box_##boxer (*(type*)alien_pointer()); \
+} \
+void primitive_set_alien_##name (void) \
+{ \
+	type* ptr = alien_pointer(); \
+	type value = unbox_##boxer (); \
+	*ptr = value; \
+}
+
+DEF_ALIEN_SLOT(signed_cell,int,signed_cell)
+DEF_ALIEN_SLOT(unsigned_cell,CELL,unsigned_cell)
+DEF_ALIEN_SLOT(signed_8,s64,signed_8)
+DEF_ALIEN_SLOT(unsigned_8,u64,unsigned_8)
+DEF_ALIEN_SLOT(signed_4,s32,signed_4)
+DEF_ALIEN_SLOT(unsigned_4,u32,unsigned_4)
+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());
+}

native/ffi.h

@@ -30,19 +30,32 @@ void primitive_dlsym(void);
 void primitive_dlclose(void);
 void primitive_alien(void);
 void primitive_local_alien(void);
-DLLEXPORT void* unbox_alien(void);
-DLLEXPORT void box_alien(void* ptr);
-void primitive_local_alienp(void);
-void primitive_alien_address(void);
-void primitive_alien_cell(void);
-void primitive_set_alien_cell(void);
-void primitive_alien_4(void);
-void primitive_set_alien_4(void);
-void primitive_alien_2(void);
-void primitive_set_alien_2(void);
-void primitive_alien_1(void);
-void primitive_set_alien_1(void);
 void fixup_dll(DLL* dll);
 void collect_dll(DLL* dll);
 void fixup_alien(ALIEN* alien);
 void collect_alien(ALIEN* alien);
+DLLEXPORT void* unbox_alien(void);
+DLLEXPORT void box_alien(void* ptr);
+void primitive_local_alienp(void);
+void primitive_alien_address(void);
+void primitive_alien_signed_cell(void);
+void primitive_set_alien_signed_cell(void);
+void primitive_alien_unsigned_cell(void);
+void primitive_set_alien_unsigned_cell(void);
+void primitive_alien_signed_8(void);
+void primitive_set_alien_signed_8(void);
+void primitive_alien_unsigned_8(void);
+void primitive_set_alien_unsigned_8(void);
+void primitive_alien_signed_4(void);
+void primitive_set_alien_signed_4(void);
+void primitive_alien_unsigned_4(void);
+void primitive_set_alien_unsigned_4(void);
+void primitive_alien_signed_2(void);
+void primitive_set_alien_signed_2(void);
+void primitive_alien_unsigned_2(void);
+void primitive_set_alien_unsigned_2(void);
+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);

native/fixnum.c

@@ -36,14 +36,14 @@ void primitive_fixnum_add(void)
 {
 	F_FIXNUM y = untag_fixnum_fast(dpop());
 	F_FIXNUM x = untag_fixnum_fast(dpop());
-	box_integer(x + y);
+	box_signed_cell(x + y);
 }
 
 void primitive_fixnum_subtract(void)
 {
 	F_FIXNUM y = untag_fixnum_fast(dpop());
 	F_FIXNUM x = untag_fixnum_fast(dpop());
-	box_integer(x - y);
+	box_signed_cell(x - y);
 }
 
 /**
@@ -62,7 +62,7 @@ void primitive_fixnum_multiply(void)
 		F_FIXNUM prod = x * y;
 		/* if this is not equal, we have overflow */
 		if(prod / x == y)
-			box_integer(prod);
+			box_signed_cell(prod);
 		else
 		{
 			dpush(tag_bignum(
@@ -77,7 +77,7 @@ void primitive_fixnum_divint(void)
 {
 	F_FIXNUM y = untag_fixnum_fast(dpop());
 	F_FIXNUM x = untag_fixnum_fast(dpop());
-	box_integer(x / y);
+	box_signed_cell(x / y);
 }
 
 void primitive_fixnum_divfloat(void)
@@ -91,8 +91,8 @@ void primitive_fixnum_divmod(void)
 {
 	F_FIXNUM y = untag_fixnum_fast(dpop());
 	F_FIXNUM x = untag_fixnum_fast(dpop());
-	box_integer(x / y);
+	box_signed_cell(x / y);
-	box_integer(x % y);
+	box_signed_cell(x % y);
 }
 
 void primitive_fixnum_mod(void)
@@ -216,4 +216,3 @@ DEFUNBOX(unbox_signed_1, signed char)
 DEFUNBOX(unbox_signed_2, signed short)
 DEFUNBOX(unbox_unsigned_1, unsigned char)
 DEFUNBOX(unbox_unsigned_2, unsigned short) 
-

native/io.h

@@ -63,5 +63,6 @@ bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks,
 CELL perform_io_task(IO_TASK* io_task, IO_TASK* io_tasks, int* fd_count);
 CELL perform_io_tasks(fd_set* fdset, IO_TASK* io_tasks, int* fd_count);
 CELL next_io_task(void);
+char* factor_str_error(void);
 
 #endif

native/memory.c

@@ -97,10 +97,10 @@ bool in_zone(ZONE* z, CELL pointer)
 
 void primitive_room(void)
 {
-	box_integer(compiling.limit - compiling.here);
+	box_signed_cell(compiling.limit - compiling.here);
-	box_integer(compiling.limit - compiling.base);
+	box_signed_cell(compiling.limit - compiling.base);
-	box_integer(active.limit - active.here);
+	box_signed_cell(active.limit - active.here);
-	box_integer(active.limit - active.base);
+	box_signed_cell(active.limit - active.base);
 }
 
 void primitive_allot_profiling(void)

native/primitives.c

@@ -146,14 +146,27 @@ void* primitives[] = {
 	primitive_dlclose,
 	primitive_alien,
 	primitive_local_alien,
-	primitive_alien_cell,
+	primitive_alien_signed_cell,
-	primitive_set_alien_cell,
+	primitive_set_alien_signed_cell,
-	primitive_alien_4,
+	primitive_alien_unsigned_cell,
-	primitive_set_alien_4,
+	primitive_set_alien_unsigned_cell,
-	primitive_alien_2,
+	primitive_alien_signed_8,
-	primitive_set_alien_2,
+	primitive_set_alien_signed_8,
-	primitive_alien_1,
+	primitive_alien_unsigned_8,
-	primitive_set_alien_1,
+	primitive_set_alien_unsigned_8,
+	primitive_alien_signed_4,
+	primitive_set_alien_signed_4,
+	primitive_alien_unsigned_4,
+	primitive_set_alien_unsigned_4,
+	primitive_alien_signed_2,
+	primitive_set_alien_signed_2,
+	primitive_alien_unsigned_2,
+	primitive_set_alien_unsigned_2,
+	primitive_alien_signed_1,
+	primitive_set_alien_signed_1,
+	primitive_alien_unsigned_1,
+	primitive_set_alien_unsigned_1,
+	primitive_alien_value_string,
 	primitive_throw,
 	primitive_string_to_memory,
 	primitive_memory_to_string,

native/primitives.h

@@ -1,4 +1,4 @@
 extern void* primitives[];
-#define PRIMITIVE_COUNT 194
+#define PRIMITIVE_COUNT 186
 
 CELL primitive_to_xt(CELL primitive);

native/string.c

@@ -74,8 +74,8 @@ INLINE F_STRING* memory_to_string(const BYTE* string, CELL length)
 
 void primitive_memory_to_string(void)
 {
-	CELL length = unbox_cell();
+	CELL length = unbox_unsigned_cell();
-	BYTE* string = (BYTE*)unbox_cell();
+	BYTE* string = (BYTE*)unbox_unsigned_cell();
 	dpush(tag_object(memory_to_string(string,length)));
 }
 
@@ -116,7 +116,7 @@ INLINE void string_to_memory(F_STRING* s, BYTE* string)
 
 void primitive_string_to_memory(void)
 {
-	BYTE* address = (BYTE*)unbox_cell();
+	BYTE* address = (BYTE*)unbox_unsigned_cell();
 	F_STRING* str = untag_string(dpop());
 	string_to_memory(str,address);
 }

native/unix/io.c

@@ -303,3 +303,9 @@ void collect_io_tasks(void)
 		COPY_OBJECT(write_io_tasks[i].callbacks);
 	}
 }
+
+/* FFI calls this */
+char* factor_str_error(void)
+{
+	return strerror(errno);
+}