working on native image output

diff --git a/build.sh b/build.sh
index 410462d4b6004727c32492edbf457b0bb97c55d9..cb1bece2dc9c293007f3e62bf70cda06fa87d759 100644 (file)
--- a/build.sh
+++ b/build.sh
@@ -1,7 +1,7 @@
 rm *.o
 
 export CC=gcc34
-export CFLAGS="-pedantic -Wall -Winline -O3 -march=pentium4 -fomit-frame-pointer"
+export CFLAGS="-pedantic -Wall -Winline -Os -march=pentium4 -fomit-frame-pointer"
 
 $CC $CFLAGS -o f native/*.c
 

diff --git a/library/platform/native/cross-compiler.factor b/library/platform/native/cross-compiler.factor
index 067d9784d8a5f56caa798aff0a6715464ae81417..632443b2d27b717065f73e679a418bb2223b5505 100644 (file)
--- a/library/platform/native/cross-compiler.factor
+++ b/library/platform/native/cross-compiler.factor
@@ -116,8 +116,8 @@ IN: cross-compiler
         bitor
         bitxor
         bitnot
-        shift>
         shift<
+        shift>
         <
         <=
         >

diff --git a/library/platform/native/image.factor b/library/platform/native/image.factor
index 2de5187439fcf8a27bb8207eda7905b5e5da9b63..3c1ed9826a8dde974c5911b299afcb368e8c13cb 100644 (file)
--- a/library/platform/native/image.factor
+++ b/library/platform/native/image.factor
@@ -69,6 +69,7 @@ USE: words
 : object-tag BIN: 011 ;
 : header-tag BIN: 100 ;
 
+: fixnum-mask HEX: 1fffffff ;
 : immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
 : >header ( id -- tagged ) header-tag immediate ;
 
@@ -183,7 +184,7 @@ DEFER: '
     object-tag here-as swap
     11 >header emit
     dup str-length emit
-    dup hashcode emit
+    dup hashcode fixnum-mask bitand emit
     pack-string
     pad ;
 

diff --git a/library/platform/native/init.factor b/library/platform/native/init.factor
index 8f261a6ae916e841973517584af8782f3513a246..cc63066229f3c6cd5cd16145143f11f56be3735d 100644 (file)
--- a/library/platform/native/init.factor
+++ b/library/platform/native/init.factor
@@ -49,14 +49,12 @@ USE: vocabularies
 USE: words
 USE: unparser
 
+: init-gc ( -- )
+    [ garbage-collection ] 7 setenv ;
+
 : boot ( -- )
+    init-gc
     init-namespaces
-
-    ! Some flags are *on* by default, unless user specifies
-    ! -no-<flag> CLI switch
-    t "user-init" set
-    t "interactive" set
-    
     init-stdio
     "stdio" get <ansi-stream> "stdio" set
     init-errors
@@ -64,6 +62,12 @@ USE: unparser
     init-scratchpad
     init-styles
     init-vocab-styles
+
+    ! Some flags are *on* by default, unless user specifies
+    ! -no-<flag> CLI switch
+    t "user-init" set
+    t "interactive" set
+
     10 "base" set
     print-banner
     room.

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 7f00b9cd64d3bbd232990baa1eb9319c54688da8..340b2c6ecfe6e49d6b8217a31f574aebe7ed8350 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -1,13 +1,37 @@
 #include "factor.h"
 
+FIXNUM to_fixnum(CELL tagged)
+{
+       switch(type_of(tagged))
+       {
+       case FIXNUM_TYPE:
+               return untag_fixnum_fast(tagged);
+       case BIGNUM_TYPE:
+               return bignum_to_fixnum(tagged);
+       default:
+               type_error(FIXNUM_TYPE,tagged);
+               return -1; /* can't happen */
+       }
+}
+
+#define CELL_TO_INTEGER(result) \
+       FIXNUM _result = (result); \
+       if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
+               env.dt = tag_bignum(fixnum_to_bignum(_result)); \
+       else \
+               env.dt = tag_fixnum(_result);
+
+#define BIGNUM_2_TO_INTEGER(result) \
+       BIGNUM_2 _result = (result); \
+       if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
+               env.dt = tag_bignum(bignum(_result)); \
+       else \
+               env.dt = tag_fixnum(_result);
+
 /* ADDITION */
 INLINE void add_fixnum(CELL x, CELL y)
 {
-       FIXNUM result = untag_fixnum_fast(x) + untag_fixnum_fast(y);
-       if(result < FIXNUM_MIN || result > FIXNUM_MAX)
-               env.dt = tag_bignum(fixnum_to_bignum(result));
-       else
-               env.dt = tag_fixnum(result);
+       CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y));
 }
 
 INLINE void add_bignum(CELL x, CELL y)
@@ -21,11 +45,7 @@ BINARY_OP(add)
 /* SUBTRACTION */
 INLINE void subtract_fixnum(CELL x, CELL y)
 {
-       FIXNUM result = untag_fixnum_fast(x) - untag_fixnum_fast(y);
-       if(result < FIXNUM_MIN || result > FIXNUM_MAX)
-               env.dt = tag_bignum(fixnum_to_bignum(result));
-       else
-               env.dt = tag_fixnum(result);
+       CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
 }
 
 INLINE void subtract_bignum(CELL x, CELL y)
@@ -39,12 +59,8 @@ BINARY_OP(subtract)
 /* MULTIPLICATION */
 INLINE void multiply_fixnum(CELL x, CELL y)
 {
-       BIGNUM_2 result = (BIGNUM_2)untag_fixnum_fast(x)
-               * (BIGNUM_2)untag_fixnum_fast(y);
-       if(result < FIXNUM_MIN || result > FIXNUM_MAX)
-               env.dt = tag_bignum(bignum(result));
-       else
-               env.dt = tag_fixnum(result);
+       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               * (BIGNUM_2)untag_fixnum_fast(y));
 }
 
 INLINE void multiply_bignum(CELL x, CELL y)
@@ -74,6 +90,92 @@ INLINE void divmod_bignum(CELL x, CELL y)
 
 BINARY_OP(divmod)
 
+/* MOD */
+INLINE void mod_fixnum(CELL x, CELL y)
+{
+       env.dt = x % y;
+}
+
+INLINE void mod_bignum(CELL x, CELL y)
+{
+       env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               % ((BIGNUM*)UNTAG(y))->n));
+}
+
+BINARY_OP(mod)
+
+/* AND */
+INLINE void and_fixnum(CELL x, CELL y)
+{
+       env.dt = x & y;
+}
+
+INLINE void and_bignum(CELL x, CELL y)
+{
+       env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               & ((BIGNUM*)UNTAG(y))->n));
+}
+
+BINARY_OP(and)
+
+/* OR */
+INLINE void or_fixnum(CELL x, CELL y)
+{
+       env.dt = x | y;
+}
+
+INLINE void or_bignum(CELL x, CELL y)
+{
+       env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               | ((BIGNUM*)UNTAG(y))->n));
+}
+
+BINARY_OP(or)
+
+/* XOR */
+INLINE void xor_fixnum(CELL x, CELL y)
+{
+       env.dt = x ^ y;
+}
+
+INLINE void xor_bignum(CELL x, CELL y)
+{
+       env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               ^ ((BIGNUM*)UNTAG(y))->n));
+}
+
+BINARY_OP(xor)
+
+/* SHIFTLEFT */
+INLINE void shiftleft_fixnum(CELL x, CELL y)
+{
+       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               << (BIGNUM_2)untag_fixnum_fast(y));
+}
+
+INLINE void shiftleft_bignum(CELL x, CELL y)
+{
+       env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               << ((BIGNUM*)UNTAG(y))->n));
+}
+
+BINARY_OP(shiftleft)
+
+/* SHIFTRIGHT */
+INLINE void shiftright_fixnum(CELL x, CELL y)
+{
+       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               >> (BIGNUM_2)untag_fixnum_fast(y));
+}
+
+INLINE void shiftright_bignum(CELL x, CELL y)
+{
+       env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               >> ((BIGNUM*)UNTAG(y))->n));
+}
+
+BINARY_OP(shiftright)
+
 /* LESS */
 INLINE void less_fixnum(CELL x, CELL y)
 {

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 1df8bdd59536ca1a1dbcd6fdd0e0497eafdeb98c..81a850516e8d311edbaceae7b89344751ccd3573 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -28,7 +28,7 @@ void primitive_##OP(void) \
                        switch(object_type(y)) \
                        { \
                        case BIGNUM_TYPE: \
-                               OP##_bignum(fixnum_to_bignum(x),y); \
+                               OP##_bignum((CELL)fixnum_to_bignum(x),y); \
                                break; \
                        default: \
                                type_error(FIXNUM_TYPE,y); \
@@ -52,7 +52,7 @@ void primitive_##OP(void) \
                        switch(TAG(y)) \
                        { \
                        case FIXNUM_TYPE: \
-                               OP##_bignum(x,fixnum_to_bignum(y)); \
+                               OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
                                break; \
                        case OBJECT_TYPE: \
 \
@@ -87,6 +87,8 @@ void primitive_##OP(void) \
        } \
 }
 
+FIXNUM to_fixnum(CELL tagged);
+
 void primitive_add(void);
 void primitive_subtract(void);
 void primitive_multiply(void);
@@ -95,3 +97,9 @@ void primitive_less(void);
 void primitive_lesseq(void);
 void primitive_greater(void);
 void primitive_greatereq(void);
+void primitive_mod(void);
+void primitive_and(void);
+void primitive_or(void);
+void primitive_xor(void);
+void primitive_shiftleft(void);
+void primitive_shiftright(void);

diff --git a/native/fd.c b/native/fd.c
index bb6cb1a0ee790cbd5fa9d7830ec2850bae83c1fc..87d0d9b6cfe94c335f82a113cf53cd90cc9acf59 100644 (file)
--- a/native/fd.c
+++ b/native/fd.c
@@ -115,7 +115,7 @@ void primitive_write_fd_8(void)
        switch(type)
        {
        case FIXNUM_TYPE:
-               write_fd_char_8(h,untag_fixnum(text));
+               write_fd_char_8(h,to_fixnum(text));
                break;
        case STRING_TYPE:
                write_fd_string_8(h,untag_string(text));
@@ -147,10 +147,10 @@ void primitive_flush_fd(void)
 
 void primitive_shutdown_fd(void)
 {
-       HANDLE* h = untag_handle(HANDLE_FD,env.dt);
+       /* HANDLE* h = untag_handle(HANDLE_FD,env.dt);
        int fd = h->object;
 
-       /* if(shutdown(fd,SHUT_RDWR) < 0)
+       if(shutdown(fd,SHUT_RDWR) < 0)
                io_error(__FUNCTION__); */
 
        env.dt = dpop();

diff --git a/native/fixnum.c b/native/fixnum.c
index 3f59f88186ea68d7212bc81b1518e56fc8ff4e2c..81d3bd32fa20e0528bb48dc80e30fc2d7e29c5a1 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -20,44 +20,8 @@ void primitive_divide(void)
        env.dt = tag_fixnum(x / y);
 }
 
-void primitive_mod(void)
-{
-       BINARY_OP(x,y);
-       env.dt = x % y;
-}
-
-void primitive_and(void)
-{
-       BINARY_OP(x,y);
-       env.dt = x & y;
-}
-
-void primitive_or(void)
-{
-       BINARY_OP(x,y);
-       env.dt = x | y;
-}
-
-void primitive_xor(void)
-{
-       BINARY_OP(x,y);
-       env.dt = x ^ y;
-}
-
 void primitive_not(void)
 {
        type_check(FIXNUM_TYPE,env.dt);
        env.dt = RETAG(UNTAG(~env.dt),FIXNUM_TYPE);
 }
-
-void primitive_shiftleft(void)
-{
-       BINARY_OP(x,y);
-       env.dt = UNTAG(x >> (y >> TAG_BITS));
-}
-
-void primitive_shiftright(void)
-{
-       BINARY_OP(x,y);
-       env.dt = x << (y >> TAG_BITS);
-}

diff --git a/native/fixnum.h b/native/fixnum.h
index 8661d65df09149630bb9c4eb4aaace7aceb2de3b..a76c74b7610793b19e912aa2df65cf7395e91d7f 100644 (file)
--- a/native/fixnum.h
+++ b/native/fixnum.h
@@ -1,4 +1,3 @@
-
 #define FIXNUM_MAX (LONG_MAX >> TAG_BITS)
 #define FIXNUM_MIN (LONG_MIN >> TAG_BITS)
 
@@ -9,12 +8,6 @@ INLINE FIXNUM untag_fixnum_fast(CELL tagged)
        return ((FIXNUM)tagged) >> TAG_BITS;
 }
 
-INLINE FIXNUM untag_fixnum(CELL tagged)
-{
-       type_check(FIXNUM_TYPE,tagged);
-       return untag_fixnum_fast(tagged);
-}
-
 INLINE CELL tag_fixnum(FIXNUM untagged)
 {
        return RETAG(untagged << TAG_BITS,FIXNUM_TYPE);
@@ -22,10 +15,4 @@ INLINE CELL tag_fixnum(FIXNUM untagged)
 
 void primitive_fixnump(void);
 void primitive_divide(void);
-void primitive_mod(void);
-void primitive_and(void);
-void primitive_or(void);
-void primitive_xor(void);
 void primitive_not(void);
-void primitive_shiftleft(void);
-void primitive_shiftright(void);

diff --git a/native/memory.c b/native/memory.c
index 3218bcf1ce883f24dab8dd6ccaabacedd7d3d5e0..7fc9b4c11e721eb4de5ff9924e8ec7b5fcaf0c3d 100644 (file)
--- a/native/memory.c
+++ b/native/memory.c
@@ -9,6 +9,7 @@ static ZONE* zalloc(CELL size)
        if(z->base == 0)
                fatal_error("Cannot allocate zone",size);
        z->limit = z->base + size;
+       z->alarm = z->base + (size * 3) / 4;
        z->base = align8(z->base);
        return z;
 }
@@ -24,6 +25,7 @@ CELL allot(CELL a)
 {
        CELL h = active->here;
        active->here = align8(active->here + a);
+
        if(active->here > active->limit)
        {
                printf("Out of memory\n");
@@ -33,6 +35,13 @@ CELL allot(CELL a)
                printf("request       = %ld\n",a);
                exit(1);
        }
+       else if(active->here > active->alarm)
+       {
+               /* Execute the 'garbage-collection' word */
+               cpush(env.cf);
+               env.cf = env.user[GC_ENV];
+       }
+
        return h;
 }
 

diff --git a/native/memory.h b/native/memory.h
index 450eb593d2777b14eb6174fc9722cd2b72e318f3..0538b64479968d9002823d5bdb8227ea37520baf 100644 (file)
--- a/native/memory.h
+++ b/native/memory.h
@@ -1,6 +1,7 @@
 typedef struct {
        CELL base;
        CELL here;
+       CELL alarm;
        CELL limit;
 } ZONE;
 

diff --git a/native/primitives.c b/native/primitives.c
index eef4bd40942d6ba36d4e1449b459cfb70b70415d..175532fde355bc09a505746eefef3e20fa85308a 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -97,7 +97,7 @@ CELL primitive_to_xt(CELL primitive)
        if(primitive < 0 || primitive >= PRIMITIVE_COUNT)
                general_error(ERROR_BAD_PRIMITIVE,tag_fixnum(primitive));
        
-       return primitives[primitive];
+       return (CELL)primitives[primitive];
 }
 
 void primitive_eq(void)

diff --git a/native/run.c b/native/run.c
index 26050fcc3b25c23f2c66224ec24103943b008866..716d63ff4833d8d6b749b039d64f86cc552733d7 100644 (file)
--- a/native/run.c
+++ b/native/run.c
@@ -45,10 +45,12 @@ void run(void)
                if(TAG(next) == WORD_TYPE)
                {
                        env.w = (WORD*)UNTAG(next);
+                       /* printf("EXECUTE %d\n",env.w->primitive); */
                        EXECUTE(env.w);
                }
                else
                {
+                       /* printf("DPUSH %d\n",type_of(next)); */
                        dpush(env.dt);
                        env.dt = next;
                }
@@ -103,7 +105,7 @@ void primitive_ifte(void)
 
 void primitive_getenv(void)
 {
-       FIXNUM e = untag_fixnum(env.dt);
+       FIXNUM e = to_fixnum(env.dt);
        if(e < 0 || e >= USER_ENV)
                range_error(F,e,USER_ENV);
        env.dt = env.user[e];
@@ -111,7 +113,7 @@ void primitive_getenv(void)
 
 void primitive_setenv(void)
 {
-       FIXNUM e = untag_fixnum(env.dt);
+       FIXNUM e = to_fixnum(env.dt);
        CELL value = dpop();
        if(e < 0 || e >= USER_ENV)
                range_error(F,e,USER_ENV);
@@ -122,5 +124,5 @@ void primitive_setenv(void)
 
 void primitive_exit(void)
 {
-       exit(untag_fixnum(env.dt));
+       exit(to_fixnum(env.dt));
 }

diff --git a/native/run.h b/native/run.h
index 75d6e7aea75656a46f4ce5af1df92d8aba572f63..6459f513bb0f0e7a965730cde960527f7613d37a 100644 (file)
--- a/native/run.h
+++ b/native/run.h
@@ -1,11 +1,13 @@
 #define USER_ENV 16
 
-#define STDIN_ENV     0
-#define STDOUT_ENV    1
-#define STDERR_ENV    2
-#define NAMESTACK_ENV 3
-#define GLOBAL_ENV    4
-#define BREAK_ENV     5
+#define STDIN_ENV      0
+#define STDOUT_ENV     1
+#define STDERR_ENV     2
+#define NAMESTACK_ENV  3
+#define GLOBAL_ENV     4
+#define BREAK_ENV      5
+#define CATCHSTACK_ENV 6
+#define GC_ENV         7
 
 /* Error handlers restore this */
 jmp_buf toplevel;

diff --git a/native/sbuf.c b/native/sbuf.c
index 3b3bda6e032f8b660def4e73238e68adfa95a42d..03cf879a6c9d28d66c255acb46a0956ec0969996 100644 (file)
--- a/native/sbuf.c
+++ b/native/sbuf.c
@@ -16,7 +16,7 @@ void primitive_sbufp(void)
 
 void primitive_sbuf(void)
 {
-       env.dt = tag_object(sbuf(untag_fixnum(env.dt)));
+       env.dt = tag_object(sbuf(to_fixnum(env.dt)));
 }
 
 void primitive_sbuf_length(void)
@@ -27,7 +27,7 @@ void primitive_sbuf_length(void)
 void primitive_set_sbuf_length(void)
 {
        SBUF* sbuf = untag_sbuf(env.dt);
-       FIXNUM length = untag_fixnum(dpop());
+       FIXNUM length = to_fixnum(dpop());
        sbuf->top = length;
        if(length < 0)
                range_error(env.dt,length,sbuf->top);
@@ -39,7 +39,7 @@ void primitive_set_sbuf_length(void)
 void primitive_sbuf_nth(void)
 {
        SBUF* sbuf = untag_sbuf(env.dt);
-       CELL index = untag_fixnum(dpop());
+       CELL index = to_fixnum(dpop());
 
        if(index < 0 || index >= sbuf->top)
                range_error(env.dt,index,sbuf->top);
@@ -69,7 +69,7 @@ void set_sbuf_nth(SBUF* sbuf, CELL index, CHAR value)
 void primitive_set_sbuf_nth(void)
 {
        SBUF* sbuf = untag_sbuf(env.dt);
-       FIXNUM index = untag_fixnum(dpop());
+       FIXNUM index = to_fixnum(dpop());
        CELL value = dpop();
        check_non_empty(value);
 
@@ -96,7 +96,8 @@ void primitive_sbuf_append(void)
        switch(type_of(object))
        {
        case FIXNUM_TYPE:
-               set_sbuf_nth(sbuf,sbuf->top,untag_fixnum(object));
+       case BIGNUM_TYPE:
+               set_sbuf_nth(sbuf,sbuf->top,to_fixnum(object));
                break;
        case STRING_TYPE:
                sbuf_append_string(sbuf,untag_string(object));

diff --git a/native/socket.c b/native/socket.c
index 912c45e21eaf052be2841fa4efd1bf3a2bce5887..c07355673ce3c72267a8c815cd943a6cf84eb42f 100644 (file)
--- a/native/socket.c
+++ b/native/socket.c
@@ -39,7 +39,7 @@ int make_server_socket(CHAR port)
 
 void primitive_server_socket(void)
 {
-       CHAR port = (CHAR)untag_fixnum(env.dt);
+       CHAR port = (CHAR)to_fixnum(env.dt);
        env.dt = handle(HANDLE_FD,make_server_socket(port));
 }
 

diff --git a/native/string.c b/native/string.c
index 553240a16f6d95cb1ad9ac61baadc0ee59c9df82..882fbd4b169f51e189d3dafd445dc300d87f03b0 100644 (file)
--- a/native/string.c
+++ b/native/string.c
@@ -98,7 +98,7 @@ void primitive_string_length(void)
 void primitive_string_nth(void)
 {
        STRING* string = untag_string(env.dt);
-       CELL index = untag_fixnum(dpop());
+       CELL index = to_fixnum(dpop());
 
        if(index < 0 || index >= string->capacity)
                range_error(tag_object(string),index,string->capacity);
@@ -189,9 +189,9 @@ void primitive_index_of(void)
        CELL result;
        check_non_empty(ch);
        string = untag_string(dpop());
-       index = untag_fixnum(dpop());
+       index = to_fixnum(dpop());
        if(TAG(ch) == FIXNUM_TYPE)
-               result = index_of_ch(index,string,untag_fixnum(ch));
+               result = index_of_ch(index,string,to_fixnum(ch));
        else
                result = index_of_str(index,string,untag_string(ch));
        env.dt = tag_fixnum(result);
@@ -220,7 +220,7 @@ INLINE STRING* substring(CELL start, CELL end, STRING* string)
 void primitive_substring(void)
 {
        STRING* string = untag_string(env.dt);
-       CELL end = untag_fixnum(dpop());
-       CELL start = untag_fixnum(dpop());
+       CELL end = to_fixnum(dpop());
+       CELL start = to_fixnum(dpop());
        env.dt = tag_object(substring(start,end,string));
 }

diff --git a/native/vector.c b/native/vector.c
index 77eeebabe64bed730e6d1ede0f5200e30f332735..a2ea50409b1ed49a76fd320260fae53f484f120d 100644 (file)
--- a/native/vector.c
+++ b/native/vector.c
@@ -16,7 +16,7 @@ void primitive_vectorp(void)
 
 void primitive_vector(void)
 {
-       env.dt = tag_object(vector(untag_fixnum(env.dt)));
+       env.dt = tag_object(vector(to_fixnum(env.dt)));
 }
 
 void primitive_vector_length(void)
@@ -27,7 +27,7 @@ void primitive_vector_length(void)
 void primitive_set_vector_length(void)
 {
        VECTOR* vector = untag_vector(env.dt);
-       FIXNUM length = untag_fixnum(dpop());
+       FIXNUM length = to_fixnum(dpop());
        vector->top = length;
        if(length < 0)
                range_error(tag_object(vector),length,vector->top);
@@ -39,7 +39,7 @@ void primitive_set_vector_length(void)
 void primitive_vector_nth(void)
 {
        VECTOR* vector = untag_vector(env.dt);
-       CELL index = untag_fixnum(dpop());
+       CELL index = to_fixnum(dpop());
 
        if(index < 0 || index >= vector->top)
                range_error(tag_object(vector),index,vector->top);
@@ -59,7 +59,7 @@ void vector_ensure_capacity(VECTOR* vector, int index)
 void primitive_set_vector_nth(void)
 {
        VECTOR* vector = untag_vector(env.dt);
-       FIXNUM index = untag_fixnum(dpop());
+       FIXNUM index = to_fixnum(dpop());
        CELL value = dpop();
        check_non_empty(value);
 

diff --git a/native/word.c b/native/word.c
index 49e157d91c0291191c89969d81b267af5c223127..715e9aeb0ead05696a971e2a8b84b881ba956fb4 100644 (file)
--- a/native/word.c
+++ b/native/word.c
@@ -33,7 +33,7 @@ void primitive_word(void)
        CELL parameter = dpop();
        check_non_empty(plist);
        check_non_empty(parameter);
-       primitive = untag_fixnum(dpop());
+       primitive = to_fixnum(dpop());
        env.dt = tag_word(word(primitive,parameter,plist));
 }
 
@@ -45,7 +45,7 @@ void primitive_word_primitive(void)
 void primitive_set_word_primitive(void)
 {
        WORD* word = untag_word(env.dt);
-       word->primitive = untag_fixnum(dpop());
+       word->primitive = to_fixnum(dpop());
        update_xt(word);
        env.dt = dpop();
 }