alien fixes, sdl fixes, lotsa other stuff

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 8f1c7ccada93486d0f75577f6ab1f542869968fe..ebc7af5d939b8da21c1ba123b5bd102ed75a1408 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,13 +1,14 @@
 FFI:\r
 - is signed -vs- unsigned pointers an issue?\r
 - bitfields in C structs\r
-- unsigned types\r
 - SDL_Rect** type\r
 - struct membres that are not *\r
 - float types\r
+- SDL_MapRGB broken\r
 \r
 - command line parsing cleanup\r
 - > 1 ( ) inside word def\r
+- parsing-word test fails\r
 \r
 - when* compilation in jvm\r
 - compile word twice; no more 'cannot compile' error!\r

diff --git a/library/compiler/alien-types.factor b/library/compiler/alien-types.factor
index 2bbd84b965ca095f457a59a1193284da22c54e1f..2ea4c0948d7b1e34c6e7df96b229a32e2350ffaf 100644 (file)
--- a/library/compiler/alien-types.factor
+++ b/library/compiler/alien-types.factor
@@ -119,6 +119,10 @@ USE: words
 : END-UNION ( max -- )
     dup define-constructor define-struct-type ; parsing
 
+: NULL ( -- null )
+    #! C null value.
+    0 <alien> ;
+
 global [ <namespace> "c-types" set ] bind
 
 [
@@ -141,40 +145,40 @@ global [ <namespace> "c-types" set ] bind
     [ alien-4 ] "getter" set
     [ set-alien-4 ] "setter" set
     4 "width" set
-    "box_integer" "boxer" set
-    "unbox_integer" "unboxer" set
+    "box_cell" "boxer" set
+    "unbox_cell" "unboxer" set
 ] "uint" define-c-type
 
 [
     [ alien-2 ] "getter" set
     [ set-alien-2 ] "setter" set
     2 "width" set
-    "box_integer" "boxer" set
-    "unbox_integer" "unboxer" set
+    "box_signed_2" "boxer" set
+    "unbox_signed_2" "unboxer" set
 ] "short" define-c-type
 
 [
     [ alien-2 ] "getter" set
     [ set-alien-2 ] "setter" set
     2 "width" set
-    "box_integer" "boxer" set
-    "unbox_integer" "unboxer" set
+    "box_cell" "boxer" set
+    "unbox_cell" "unboxer" set
 ] "ushort" define-c-type
 
 [
     [ alien-1 ] "getter" set
     [ set-alien-1 ] "setter" set
     1 "width" set
-    "box_integer" "boxer" set
-    "unbox_integer" "unboxer" set
+    "box_signed_1" "boxer" set
+    "unbox_signed_1" "unboxer" set
 ] "char" define-c-type
 
 [
     [ alien-1 ] "getter" set
     [ set-alien-1 ] "setter" set
     1 "width" set
-    "box_integer" "boxer" set
-    "unbox_integer" "unboxer" set
+    "box_cell" "boxer" set
+    "unbox_cell" "unboxer" set
 ] "uchar" define-c-type
 
 [

diff --git a/library/math/arithmetic.factor b/library/math/arithmetic.factor
index 389e6e6716aaa692e55ac6ac1627a09ea65d8b87..9011f28277e0f1e0bd1eecf2937f888e777af0dc 100644 (file)
--- a/library/math/arithmetic.factor
+++ b/library/math/arithmetic.factor
@@ -53,8 +53,9 @@ USE: stack
     2dup < [ drop ] [ nip ] ifte ;
 
 : between? ( x min max -- ? )
-    #! Push if min <= x <= max.
-    >r dupd max r> min = ;
+    #! Push if min <= x <= max. Handles case where min > max
+    #! by swapping them.
+    2dup > [ swap ] when  >r dupd max r> min = ;
 
 : sq dup * ; inline
 

diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor
index 12f0b821111445395fbab3c9c3d7daa692c45e36..279b90f521b1483a37735c142e20d20faffb3a2f 100644 (file)
--- a/library/platform/native/parse-syntax.factor
+++ b/library/platform/native/parse-syntax.factor
@@ -120,7 +120,7 @@ IN: syntax
 : f f parsed ; parsing
 
 ! Lists
-: [ [ ] ; parsing
+: [ f ; parsing
 : ] reverse parsed ; parsing
 
 : | ( syntax: | cdr ] )

diff --git a/library/platform/native/words.factor b/library/platform/native/words.factor
index e0e160995bc9a3eed5fc31247575070613a41e09..097d4dd4c0b861d16a7c6930e9b9fe42ced89350 100644 (file)
--- a/library/platform/native/words.factor
+++ b/library/platform/native/words.factor
@@ -59,6 +59,7 @@ USE: stack
 
 : define-compound ( word def -- )
     over set-word-parameter
+    ( dup f "parsing" set-word-property )
     1 swap set-word-primitive ;
 
 : define-symbol ( word -- )

diff --git a/library/sdl/sdl-event.factor b/library/sdl/sdl-event.factor
index 9bbb7359c1f5710b9d1d52f883ba06a495b64de9..72d992a31734ab71f39a21e0b643bfae83a580d8 100644 (file)
--- a/library/sdl/sdl-event.factor
+++ b/library/sdl/sdl-event.factor
@@ -143,7 +143,7 @@ BEGIN-STRUCT: joy-hat-event
         ! SDL_HAT_LEFT     SDL_HAT_CENTERED SDL_HAT_RIGHT
         ! SDL_HAT_LEFTDOWN SDL_HAT_DOWN     SDL_HAT_RIGHTDOWN
         ! Note that zero means the POV is centered.
-END-STRUCT       
+END-STRUCT
 
 BEGIN-STRUCT: joy-button-event
        FIELD: uchar type   ! SDL_JOYBUTTONDOWN or SDL_JOYBUTTONUP

diff --git a/library/sdl/sdl-video.factor b/library/sdl/sdl-video.factor
index 21de4e2b76682fc17a6ec530562f4a4e8aba0d9b..98f619b566bb5ce9b76f5ac0f3690b3ea6321ff1 100644 (file)
--- a/library/sdl/sdl-video.factor
+++ b/library/sdl/sdl-video.factor
@@ -152,8 +152,9 @@ END-STRUCT
 ! SDL_SetGamma: float types
 
 : SDL_FillRect ( surface rect color -- n )
+    #! If rect is null, fills entire surface.
     "int" "sdl" "SDL_FillRect"
-    [ "surface*" "rect*" "unint" ] alien-call ;
+    [ "surface*" "rect*" "uint" ] alien-call ;
 
 : SDL_LockSurface ( surface -- )
     "int" "sdl" "SDL_LockSurface" [ "surface*" ] alien-call ;
@@ -162,5 +163,5 @@ END-STRUCT
     "void" "sdl" "SDL_UnlockSurface" [ "surface*" ] alien-call ;
 
 : SDL_MapRGB ( surface r g b -- )
-    "int" "sdl" "SDL_MapRGB"
-    [ "surface*" "char" "char" "char" ] alien-call ;
+    "uint" "sdl" "SDL_MapRGB"
+    [ "surface*" "uchar" "uchar" "uchar" ] alien-call ;

diff --git a/library/test/combinators.factor b/library/test/combinators.factor
index 5d977e495b24ca81fffe04a75babc3829651c2db..edae9aa96d70c08d568d7c0709127c29d8d41285 100644 (file)
--- a/library/test/combinators.factor
+++ b/library/test/combinators.factor
@@ -5,12 +5,22 @@ USE: math
 USE: stack
 USE: test
 
+[ slip ] unit-test-fails
+[ 1 slip ] unit-test-fails
+[ 1 2 slip ] unit-test-fails
+[ 1 2 3 slip ] unit-test-fails
+
 [ 5 ] [ [ 2 2 + ] 1 slip + ] unit-test
 [ 6 ] [ [ 2 2 + ] 1 1 2slip + + ] unit-test
 [ 6 ] [ [ 2 1 + ] 1 1 1 3slip + + + ] unit-test
 
+[ [ ] keep ] unit-test-fails
+
 [ 6 ] [ 2 [ sq ] keep + ] unit-test
 
+[ cond ] unit-test-fails
+[ [ [ 1 = ] [ ] ] cond ] unit-test-fails
+
 [   ] [ 3 [ ] cond ] unit-test
 [ t ] [ 4 [ [ 1 = ] [ ] [ 4 = ] [ drop t ] [ 2 = ] [ ] ] cond ] unit-test
 

diff --git a/library/test/parsing-word.factor b/library/test/parsing-word.factor
new file mode 100644 (file)
index 0000000..3f68d79
--- /dev/null
+++ b/library/test/parsing-word.factor
@@ -0,0 +1,14 @@
+IN: scratchpad
+
+USE: parser
+USE: test
+
+DEFER: foo
+
+": foo 2 2 + . ; parsing" eval
+
+[ [ ] ] [ "foo" parse ] unit-test
+
+": foo 2 2 + . ;" eval
+
+[ [ foo ] ] [ "foo" parse ] unit-test

diff --git a/library/test/test.factor b/library/test/test.factor
index 86f704a9217fda5ef70e93dcf63bf4ac7ab8f8fe..374ac0f978ebb960790ceb60a97d64fd965f44ee 100644 (file)
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -113,6 +113,7 @@ USE: unparser
         "crashes" test
         "sbuf" test
         "threads" test
+        "parsing-word" test
 
         cpu "x86" = [
             [

diff --git a/native/bignum.c b/native/bignum.c
index dde761395d0425f6b96128683c6417e20d986b4d..3f01c8e494852d513ef2da8f12ad427713513427 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -20,12 +20,24 @@ void box_integer(FIXNUM integer)
        dpush(tag_integer(integer));
 }
 
+/* FFI calls this */
+void box_cell(CELL cell)
+{
+       dpush(tag_cell(cell));
+}
+
 /* FFI calls this */
 FIXNUM unbox_integer(void)
 {
        return to_integer(dpop());
 }
 
+/* FFI calls this */
+CELL unbox_cell(void)
+{
+       return to_integer(dpop());
+}
+
 ARRAY* to_bignum(CELL tagged)
 {
        RATIO* r;

diff --git a/native/bignum.h b/native/bignum.h
index 143d6fc6d7c1afe605f5260c44a40d40b2aeadf8..d779e962b7a3ce93450eb3833f596a72a827129f 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -10,7 +10,9 @@ INLINE ARRAY* untag_bignum(CELL tagged)
 
 FIXNUM to_integer(CELL x);
 void box_integer(FIXNUM integer);
+void box_cell(CELL cell);
 FIXNUM unbox_integer(void);
+CELL unbox_cell(void);
 ARRAY* to_bignum(CELL tagged);
 void primitive_to_bignum(void);
 void primitive_bignum_eq(void);

diff --git a/native/ffi.c b/native/ffi.c
index 8ae3daabadf42f39b0f4c0eb9bf012d486463150..e7eb2ecbd5cb543da307d2f9b5b89119c7f18c28 100644 (file)
--- a/native/ffi.c
+++ b/native/ffi.c
@@ -181,7 +181,7 @@ void primitive_alien_2(void)
 {
 #ifdef FFI
        CELL ptr = alien_pointer();
-       box_integer(*(CHAR*)ptr);
+       box_signed_2(*(CHAR*)ptr);
 #else
        general_error(ERROR_FFI_DISABLED,F);
 #endif
@@ -191,7 +191,7 @@ void primitive_set_alien_2(void)
 {
 #ifdef FFI
        CELL ptr = alien_pointer();
-       CELL value = unbox_integer();
+       CELL value = unbox_signed_2();
        *(CHAR*)ptr = value;
 #else
        general_error(ERROR_FFI_DISABLED,F);
@@ -201,7 +201,7 @@ void primitive_set_alien_2(void)
 void primitive_alien_1(void)
 {
 #ifdef FFI
-       box_integer(bget(alien_pointer()));
+       box_signed_1(bget(alien_pointer()));
 #else
        general_error(ERROR_FFI_DISABLED,F);
 #endif
@@ -211,7 +211,7 @@ void primitive_set_alien_1(void)
 {
 #ifdef FFI
        CELL ptr = alien_pointer();
-       BYTE value = value = unbox_integer();
+       BYTE value = value = unbox_signed_1();
        bput(ptr,value);
 #else
        general_error(ERROR_FFI_DISABLED,F);

diff --git a/native/fixnum.c b/native/fixnum.c
index f8c4a14e4705384458ab5af6003bbb46b00321a7..95449da51a97cfee7c03c7d4e6c2ddd64ef1d3d0 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -202,3 +202,27 @@ void primitive_fixnum_not(void)
 {
        drepl(tag_fixnum(~to_fixnum(dpeek())));
 }
+
+/* FFI calls this */
+void box_signed_1(signed char integer)
+{
+       dpush(tag_integer(integer));
+}
+
+/* FFI calls this */
+void box_signed_2(signed short integer)
+{
+       dpush(tag_integer(integer));
+}
+
+/* FFI calls this */
+signed char unbox_signed_1(void)
+{
+       return to_integer(dpop());
+}
+
+/* FFI calls this */
+signed short unbox_signed_2(void)
+{
+       return to_integer(dpop());
+}

diff --git a/native/fixnum.h b/native/fixnum.h
index 933f3936b16e1c1296f42a8939aea88ed498b030..08e84998f6947741059dbb1a290eb19f53b7ef2f 100644 (file)
--- a/native/fixnum.h
+++ b/native/fixnum.h
@@ -28,3 +28,7 @@ void primitive_fixnum_lesseq(void);
 void primitive_fixnum_greater(void);
 void primitive_fixnum_greatereq(void);
 void primitive_fixnum_not(void);
+void box_signed_1(signed char integer);
+void box_signed_2(signed short integer);
+signed char unbox_signed_1(void);
+signed short unbox_signed_2(void);