faster generic arithmetic, messing around with inference

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index eb605a9ec8cd1636979486919d0bdbae0493d38f..dba461a37a3ea60829d611900f75fb1cbe0ef99e 100644 (file)
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -42,6 +42,7 @@ USE: namespaces
 [\r
     "/library/generic/generic.factor"\r
     "/library/generic/object.factor"\r
+    "/library/generic/null.factor"\r
     "/library/generic/builtin.factor"\r
     "/library/generic/predicate.factor"\r
     "/library/generic/union.factor"\r

diff --git a/library/bootstrap/boot.factor b/library/bootstrap/boot.factor
index 380948ced2266c960b17ea3740d997282a93745a..c16f80af3ebd74d716c3598ff211cbd9f60ffcf3 100644 (file)
--- a/library/bootstrap/boot.factor
+++ b/library/bootstrap/boot.factor
@@ -72,16 +72,15 @@ USE: hashtables
 
     "traits" [ "generic" ] search
     "delegate" [ "generic" ] search
-    "object" [ "generic" ] search
 
     vocabularies get [ "generic" off ] bind
 
-    reveal
     reveal
     reveal
 
     "/library/generic/generic.factor" parse-resource append,
     "/library/generic/object.factor" parse-resource append,
+    "/library/generic/null.factor" parse-resource append,
     "/library/generic/builtin.factor" parse-resource append,
     "/library/generic/predicate.factor" parse-resource append,
     "/library/generic/union.factor" parse-resource append,

diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index ff4f01be7ca1614638ef271dc40cdec28089967c..820c63283e5219956933eeca6b3db9f9837b69a5 100644 (file)
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -82,22 +82,15 @@ SYMBOL: boot-quot
 : tag ( cell -- tag ) tag-mask bitand ;
 
 : fixnum-tag  BIN: 000 ; inline
+: bignum-tag  BIN: 001 ; inline
 : cons-tag    BIN: 010 ; inline
 : object-tag  BIN: 011 ; inline
-: ratio-tag   BIN: 100 ; inline
-: complex-tag BIN: 101 ; inline
 
 : f-type      6  ; inline
 : t-type      7  ; inline
 : array-type  8  ; inline
-: bignum-type 9  ; inline
-: float-type  10 ; inline
 : vector-type 11 ; inline
 : string-type 12 ; inline
-: sbuf-type   13 ; inline
-: port-type   14 ; inline
-: dll-type    15 ; inline
-: alien-type  16 ; inline
 : word-type   17 ; inline
 
 : immediate ( x tag -- tagged ) swap tag-bits shift bitor ;
@@ -155,8 +148,8 @@ M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
 
 M: bignum ' ( bignum -- tagged )
     #! This can only emit 0, -1 and 1.
-    object-tag here-as >r
-    bignum-type >header emit
+    bignum-tag here-as >r
+    bignum-tag >header emit
     [
         [[ 0  [ 1 0   ] ]]
         [[ -1 [ 2 1 1 ] ]]

diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor
index 01e8f8d91c33cbc1c2c7152303744d61507fa532..16bc572e212ad8a43f96912db5006ef67436949e 100644 (file)
--- a/library/compiler/x86/assembler.factor
+++ b/library/compiler/x86/assembler.factor
@@ -251,6 +251,10 @@ GENERIC: SUB ( dst src -- )
 M: integer SUB HEX: 81 BIN: 101 immediate-8/32 ;
 M: operand SUB HEX: 29 2-operand ;
 
+GENERIC: AND ( dst src -- )
+M: integer AND HEX: 81 BIN: 100 immediate-8/32 ;
+M: operand AND HEX: 21 2-operand ;
+
 : IMUL ( dst src -- )
     HEX: 0f compile-byte HEX: af 2-operand ;
 

diff --git a/library/compiler/x86/fixnum.factor b/library/compiler/x86/fixnum.factor
index b8e341897bcfd13472c8b42697cb1bba9782761c..08ae3d23b5ba382221785c7c2a869a138c8648fa 100644 (file)
--- a/library/compiler/x86/fixnum.factor
+++ b/library/compiler/x86/fixnum.factor
@@ -145,3 +145,22 @@ USE: math-internals
 ] "generator" set-word-property
 
 \ fixnum/mod [ \ fixnum/mod self ] "infer" set-word-property
+
+\ arithmetic-type [
+    drop
+    ECX DS>
+    EAX [ ECX -4 ] MOV
+    EAX BIN: 111 AND
+    EDX [ ECX ] MOV
+    EDX BIN: 111 AND
+    EAX EDX CMP
+    0 JE fixup >r
+    \ arithmetic-type compile-call
+    0 JMP fixup
+    compiled-offset r> patch
+    EAX 3 SHL
+    PUSH-DS
+    compiled-offset swap patch
+] "generator" set-word-property
+
+\ arithmetic-type [ \ arithmetic-type self ] "infer" set-word-property

diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor
index 987f40996b5b7161897d5e5085ca052e18c3c85d..9d53bb2f143e922d7e26498e355bdd84432aa5ab 100644 (file)
--- a/library/generic/builtin.factor
+++ b/library/generic/builtin.factor
@@ -54,10 +54,13 @@ builtin 50 "priority" set-word-property
 builtin [ 2drop t ] "class<" set-word-property
 
 : builtin-predicate ( type# symbol -- )
-    over f type = [
+    #! We call search here because we have to know if the symbol
+    #! is t or f, and cannot compare type numbers or symbol
+    #! identity during bootstrapping.
+    dup "f" [ "syntax" ] search = [
         nip [ not ] "predicate" set-word-property
     ] [
-        over t type = [
+        dup "t" [ "syntax" ] search = [
             nip [ ] "predicate" set-word-property
         ] [
             dup predicate-word

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index fa3062bf721d1b6d15119c398a70d17203f84c2b..abfe9ee63e1dce9ee7d363e8076a8812f2b15d24 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -190,16 +190,8 @@ SYMBOL: object
 : class-and ( class class -- class )
     #! Return a class that is a subclass of both, or raise an
     #! error if this is impossible.
-    over builtin-supertypes
-    over builtin-supertypes
-    intersection [
-        nip lookup-union
-    ] [
-        [
-            word-name , " and " , word-name ,
-            " do not intersect" ,
-        ] make-string throw
-    ] ?ifte ;
+    swap builtin-supertypes swap builtin-supertypes
+    intersection lookup-union ;
 
 : define-promise ( class -- )
     #! A promise is a word that has no effect during

diff --git a/library/generic/null.factor b/library/generic/null.factor
new file mode 100644 (file)
index 0000000..d6c9f6c
--- /dev/null
+++ b/library/generic/null.factor
@@ -0,0 +1,39 @@
+! :folding=indent: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.
+
+IN: generic
+USE: kernel
+USE: words
+
+! Null metaclass with no instances.
+SYMBOL: null
+null [ drop [ ] ] "builtin-supertypes" set-word-property
+null [ 2drop 2drop ] "add-method" set-word-property
+null [ drop f ] "predicate" set-word-property
+null 100 "priority" set-word-property
+null [ 2drop t ] "class<" set-word-property
+null null define-class

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index d245b89c6246c1d0aa6804896ab6292711a9551a..c54e1c07a8c05d76968de81c6587d8ec0f3423d3 100644 (file)
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -154,19 +154,14 @@ SYMBOL: cloned
     ] extend ;
 
 : (infer-branches) ( branchlist -- list )
-    #! The branchlist is a list of pairs:
-    #! [[ value typeprop ]]
+    #! The branchlist is a list of pairs: [[ value typeprop ]]
     #! value is either a literal or computed instance; typeprop
     #! is a pair [[ value class ]] indicating a type propagation
     #! for the given branch.
     [
         [
-            inferring-base-case get 0 > [
-                [
-                    infer-branch ,
-                ] [
-                    [ drop ] when
-                ] catch
+            branches-can-fail? [
+                [ infer-branch , ] [ [ drop ] when ] catch
             ] [
                 infer-branch ,
             ] ifte
@@ -184,7 +179,7 @@ SYMBOL: cloned
     #! parameter is a vector.
     (infer-branches) dup unify-effects unify-dataflow ;
 
-: (with-block) ( label quot -- )
+: (with-block) ( label quot -- node )
     #! Call a quotation in a new namespace, and transfer
     #! inference state from the outer scope.
     swap >r [
@@ -192,8 +187,8 @@ SYMBOL: cloned
         call
         d-in get meta-d get meta-r get get-dataflow
     ] with-scope
-    r> swap #label dataflow, [ node-label set ] bind
-    meta-r set meta-d set d-in set ;
+    r> swap #label dataflow, [ node-label set ] extend >r
+    meta-r set meta-d set d-in set r> ;
 
 : boolean-value? ( value -- ? )
     #! Return if the value's boolean valuation is known.
@@ -208,7 +203,8 @@ SYMBOL: cloned
     value-class \ f = not ;
 
 : static-branch? ( value -- ? )
-    boolean-value? branches-can-fail? not and ;
+    drop f ;
+!    boolean-value? branches-can-fail? not and ;
 
 : static-ifte ( true false -- )
     #! If the branch taken is statically known, just infer
@@ -217,7 +213,7 @@ SYMBOL: cloned
     gensym [
         dup value-recursion recursive-state set
         literal-value infer-quot
-    ] (with-block) ;
+    ] (with-block) drop ;
 
 : dynamic-ifte ( true false -- )
     #! If branch taken is computed, infer along both paths and

diff --git a/library/inference/inference.factor b/library/inference/inference.factor
index 3d47425787b04d72220981859a628f0bd8924c49..076832d913c7b07f33d5f4b16555fa9d8dea7d44 100644 (file)
--- a/library/inference/inference.factor
+++ b/library/inference/inference.factor
@@ -39,13 +39,13 @@ USE: hashtables
 USE: generic
 USE: prettyprint
 
-: max-recursion 1 ;
+: max-recursion 0 ;
 
 ! This variable takes a value from 0 up to max-recursion.
 SYMBOL: inferring-base-case
 
 : branches-can-fail? ( -- ? )
-    inferring-base-case get max-recursion >= ;
+    inferring-base-case get max-recursion > ;
 
 ! Word properties that affect inference:
 ! - infer-effect -- must be set. controls number of inputs
@@ -149,6 +149,10 @@ M: literal set-value-class ( class value -- )
     #! After inference is finished, collect information.
     uncons >r (present-effect) r> (present-effect) 2list ;
 
+: simple-effect ( [[ d-in meta-d ]] -- [[ in# out# ]] )
+    #! After inference is finished, collect information.
+    uncons vector-length >r vector-length r> cons ;
+
 : effect ( -- [[ d-in meta-d ]] )
     d-in get meta-d get cons ;
 

diff --git a/library/inference/stack.factor b/library/inference/stack.factor
index 3179ddaf270795ed21c10d46f25f72c8c3a03333..80fac97c556f759fb0ac1598d2cb90a8bc26b446 100644 (file)
--- a/library/inference/stack.factor
+++ b/library/inference/stack.factor
@@ -48,7 +48,7 @@ USE: words
     #! Partially evaluate a word.
     f over dup
     "infer-effect" word-property
-    [ drop host-word ] with-dataflow ;
+    [ host-word ] with-dataflow ;
 
 \ drop [ \ drop partial-eval ] "infer" set-word-property
 \ dup  [ \ dup  partial-eval ] "infer" set-word-property

diff --git a/library/inference/words.factor b/library/inference/words.factor
index c06fc8d1005d5b4b4173764fa74742769945b6b9..6af8a9336fb5709d08855a100bae0adac9cfaeb8 100644 (file)
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -40,15 +40,15 @@ USE: hashtables
 USE: parser
 USE: prettyprint
 
-: with-dataflow ( param op [ intypes outtypes ] quot -- )
+: with-dataflow ( param op [[ in# out# ]] quot -- )
     #! Take input parameters, execute quotation, take output
     #! parameters, add node. The quotation is called with the
     #! stack effect.
     >r dup car ensure-d
     >r dataflow, r> r> rot
-    [ pick car swap dataflow-inputs ] keep
-    pick 2slip cdr car swap
-    dataflow-outputs ; inline
+    [ pick car swap [ length 0 node-inputs ] bind ] keep
+    pick >r >r nip call r> r> cdr car swap
+    [ length 0 node-outputs ] bind ; inline
 
 : consume-d ( typelist -- )
     [ pop-d 2drop ] each ;
@@ -57,6 +57,7 @@ USE: prettyprint
     [ <computed> push-d ] each ;
 
 : (consume/produce) ( param op effect )
+    dup >r -rot r>
     [ unswons consume-d car produce-d ] with-dataflow ;
 
 : consume/produce ( word [ in-types out-types ] -- )
@@ -78,7 +79,7 @@ USE: prettyprint
 : no-effect ( word -- )
     "Unknown stack effect: " swap word-name cat2 throw ;
 
-: with-block ( word label quot -- )
+: with-block ( word label quot -- node )
     #! Execute a quotation with the word on the stack, and add
     #! its dataflow contribution to a new block node in the IR.
     over [
@@ -91,7 +92,7 @@ USE: prettyprint
 : recursive? ( word -- ? )
     dup word-parameter tree-contains? ;
 
-: inline-compound ( word -- effect )
+: inline-compound ( word -- effect node )
     #! Infer the stack effect of a compound word in the current
     #! inferencer instance. If the word in question is recursive
     #! we infer its stack effect inside a new block.
@@ -102,7 +103,7 @@ USE: prettyprint
     #! instance.
     [
         recursive-state get init-inference
-        dup dup inline-compound present-effect
+        dup dup inline-compound drop present-effect
         [ "infer-effect" set-word-property ] keep
     ] with-scope consume/produce ;
 
@@ -111,7 +112,7 @@ GENERIC: (apply-word)
 M: compound (apply-word) ( word -- )
     #! Infer a compound word's stack effect.
     dup "inline" word-property [
-        inline-compound drop
+        inline-compound 2drop
     ] [
         infer-compound
     ] ifte ;
@@ -139,13 +140,6 @@ M: symbol (apply-word) ( word -- )
         ] when
     ] when ;
 
-: decompose ( x y -- [[ d-in meta-d ]] )
-    #! Return a stack effect such that x*effect = y.
-    uncons >r swap uncons >r
-    over vector-length over vector-length -
-    swap vector-head nip
-    r> vector-append r> cons ;
-
 : with-recursion ( quot -- )
     [
         inferring-base-case inc
@@ -155,15 +149,14 @@ M: symbol (apply-word) ( word -- )
         rethrow
     ] catch ;
 
-: base-case ( word -- [[ d-in meta-d ]] )
+: base-case ( word label -- )
     [
-        [
-            copy-inference
-            inline-compound
-        ] with-scope effect swap decompose
-        present-effect
-        >r [ #call-label ] [ #call ] ?ifte r>
-        (consume/produce)
+        over inline-compound [
+            drop
+            [ #call-label ] [ #call ] ?ifte
+            node-op set
+            node-param set
+        ] bind
     ] with-recursion ;
 
 : no-base-case ( word -- )
@@ -177,11 +170,9 @@ M: symbol (apply-word) ( word -- )
         drop no-base-case
     ] [
         inferring-base-case get max-recursion = [
-            over base-case
+            base-case
         ] [
-            [
-                drop inline-compound drop
-            ] with-recursion
+            [ drop inline-compound 2drop ] with-recursion
         ] ifte
     ] ifte ;
 
@@ -204,12 +195,13 @@ M: symbol (apply-word) ( word -- )
         drop pop-d dup
         value-recursion recursive-state set
         literal-value infer-quot
-    ] with-block ;
+    ] with-block drop ;
 
 \ call [ infer-call ] "infer" set-word-property
 
 ! These hacks will go away soon
 \ * [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
 
 \ undefined-method t "terminator" set-word-property
 \ not-a-number t "terminator" set-word-property

diff --git a/library/kernel.factor b/library/kernel.factor
index 57702518f27366410ff44fb81ba0081409de91e0..fe3753350265ed9b2585a005bf1ea35efc747d50 100644 (file)
--- a/library/kernel.factor
+++ b/library/kernel.factor
@@ -71,9 +71,16 @@ M: object = eq? ;
 : xor ( a b -- a^b ) dup not swap ? ; inline
 
 IN: syntax
-BUILTIN: f 6
+
+! The canonical t is a heap-allocated dummy object. It is always
+! the first in the image.
 BUILTIN: t 7
 
+! In the runtime, the canonical f is represented as a null
+! pointer with tag 3. So
+! f address . ==> 3
+BUILTIN: f 9
+
 IN: kernel
 UNION: boolean f t ;
 COMPLEMENT: general-t f

diff --git a/library/math/math.factor b/library/math/math.factor
index 9b713d4d5daa8cffaf3046bda55708488037a34a..6e733352b2ff10cf0e445022cc7499c11fd6057d 100644 (file)
--- a/library/math/math.factor
+++ b/library/math/math.factor
@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2003, 2004 Slava Pestov.
+! Copyright (C) 2003, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -58,16 +58,16 @@ GENERIC: bitnot ( n -- n )
 
 ! Math types
 BUILTIN: fixnum 0
-BUILTIN: bignum 9
+BUILTIN: bignum 1
 UNION: integer fixnum bignum ;
 
 BUILTIN: ratio 4
 UNION: rational integer ratio ;
 
-BUILTIN: float 10
+BUILTIN: float 5
 UNION: real rational float ;
 
-BUILTIN: complex 5
+BUILTIN: complex 6
 UNION: number real complex ;
 
 M: real hashcode ( n -- n ) >fixnum ;

diff --git a/library/test/compiler/generic.factor b/library/test/compiler/generic.factor
index 320d3a1016e873643e52627aa719b7578fee8562..0e7e36d10642ca08631f8c3ef6d5f36b718bc6f4 100644 (file)
--- a/library/test/compiler/generic.factor
+++ b/library/test/compiler/generic.factor
@@ -6,107 +6,31 @@ USE: math
 USE: kernel
 USE: words
 
-: single-combination-test
-    {
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ nip  ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-    } single-combination ; compiled
+GENERIC: single-combination-test
+
+M: object single-combination-test drop ;
+M: f single-combination-test nip ;
+
+\ single-combination-test compile
 
 [ 2 3 ] [ 2 3 t single-combination-test ] unit-test
 [ 2 3 ] [ 2 3 4 single-combination-test ] unit-test
 [ 2 f ] [ 2 3 f single-combination-test ] unit-test
 
-: single-combination-literal-test
-    4 {
-        [ drop ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-        [ nip  ]
-    } single-combination ; compiled
-
-[ ] [ single-combination-literal-test ] unit-test
-
-: single-combination-test-alt
-    {
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ nip  ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-        [ drop ]
-    } single-combination ; compiled
-
-[ 5 ] [ 2 3 4 single-combination-test-alt + ] unit-test
-[ 7/2 ] [ 2 3 3/2 single-combination-test-alt + ] unit-test
-
 DEFER: single-combination-test-2
 
 : single-combination-test-4
-    not single-combination-test-2 ;
+    dup [ single-combination-test-2 ] when ;
 
 : single-combination-test-3
     drop 3 ;
 
-: single-combination-test-2
-    {
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-4 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-        [ single-combination-test-3 ]
-    } single-combination ;
+GENERIC: single-combination-test-2
+M: object single-combination-test-2 single-combination-test-3 ;
+M: f single-combination-test-2 single-combination-test-4 ;
+
+\ single-combination-test-2 compile
 
 [ 3 ] [ t single-combination-test-2 ] unit-test
 [ 3 ] [ 3 single-combination-test-2 ] unit-test
-[ 3 ] [ f single-combination-test-2 ] unit-test
+[ f ] [ f single-combination-test-2 ] unit-test

diff --git a/library/test/generic.factor b/library/test/generic.factor
index 8dafd24d5ee03b4ba9f3100d206c01896fdc46ba..08b1f95e23dfc432151452f0de70dc99dfac511b 100644 (file)
--- a/library/test/generic.factor
+++ b/library/test/generic.factor
@@ -133,7 +133,7 @@ M: very-funny gooey sq ;
 [ fixnum ] [ fixnum fixnum class-and ] unit-test
 [ fixnum ] [ fixnum integer class-and ] unit-test
 [ fixnum ] [ integer fixnum class-and ] unit-test
-[ vector fixnum class-and ] unit-test-fails
+[ null ] [ vector fixnum class-and ] unit-test
 [ integer ] [ fixnum bignum class-or ] unit-test
 [ integer ] [ fixnum integer class-or ] unit-test
 [ rational ] [ ratio integer class-or ] unit-test

diff --git a/library/test/inference.factor b/library/test/inference.factor
index a042efab5ce34e93210150adf7492a00d9521ec0..eb06775ab915eda15cd4d093cf2edbda83f2cde7 100644 (file)
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -223,8 +223,8 @@ SYMBOL: sym-test
 ! [ [ [ number number number ] [ number ] ] ] [ [ digit+ ] infer ] unit-test
 [ [ [ number ] [ real real ] ] ] [ [ >rect ] infer ] unit-test
 
-[ [ [ ] [ POSTPONE: t ] ] ] [ [ f not ] infer ] unit-test
-[ [ [ ] [ POSTPONE: f ] ] ] [ [ t not ] infer ] unit-test
-[ [ [ ] [ POSTPONE: f ] ] ] [ [ 5 not ] infer ] unit-test
-
-[ [ [ object ] [ general-t ] ] ] [ [ dup [ not ] unless ] infer ] unit-test
+! [ [ [ ] [ POSTPONE: t ] ] ] [ [ f not ] infer ] unit-test
+! [ [ [ ] [ POSTPONE: f ] ] ] [ [ t not ] infer ] unit-test
+! [ [ [ ] [ POSTPONE: f ] ] ] [ [ 5 not ] infer ] unit-test
+! 
+! [ [ [ object ] [ general-t ] ] ] [ [ dup [ not ] unless ] infer ] unit-test

diff --git a/library/test/math/complex.factor b/library/test/math/complex.factor
index 4e084394d5ea72f9238bee23152319a4ab45f548..1c509a5b43f9e690a79160809e7c154ccdd8823d 100644 (file)
--- a/library/test/math/complex.factor
+++ b/library/test/math/complex.factor
@@ -3,6 +3,9 @@ USE: kernel
 USE: math
 USE: test
 
+[ 1 #{ 0 1 }# rect> ] unit-test-fails
+[ #{ 0 1 }# 1 rect> ] unit-test-fails
+
 [ f ] [ #{ 5 12.5 }# 5 ] [ = ] test-word
 [ t ] [ #{ 1.0 2.0 }# #{ 1 2 }# ] [ = ] test-word
 [ f ] [ #{ 1.0 2.3 }# #{ 1 2 }# ] [ = ] test-word

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 24caa1e9fcab4f78de8425a4c436247c3406f46d..6d6b1f50b4e8d7f03e28b4d7d79a14c8b0ff54cc 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -5,8 +5,8 @@ void primitive_arithmetic_type(void)
        CELL obj1 = dpeek();
        CELL obj2 = get(ds - CELLS);
 
-       CELL type1 = type_of(obj1);
-       CELL type2 = type_of(obj2);
+       CELL type1 = TAG(obj1);
+       CELL type2 = TAG(obj2);
 
        CELL type;
 
@@ -16,10 +16,10 @@ void primitive_arithmetic_type(void)
                switch(type1)
                {
                case BIGNUM_TYPE:
-                       put(ds - CELLS,tag_object(to_bignum(obj2)));
+                       put(ds - CELLS,tag_bignum(to_bignum(obj2)));
                        break;
                case FLOAT_TYPE:
-                       put(ds - CELLS,tag_object(make_float(to_float((obj2)))));
+                       put(ds - CELLS,tag_float(to_float((obj2))));
                        break;
                }
                type = type1;
@@ -28,11 +28,11 @@ void primitive_arithmetic_type(void)
                switch(type1)
                {
                case FIXNUM_TYPE:
-                       drepl(tag_object(to_bignum(obj1)));
+                       drepl(tag_bignum(to_bignum(obj1)));
                        type = type2;
                        break;
                case FLOAT_TYPE:
-                       put(ds - CELLS,tag_object(make_float(to_float((obj2)))));
+                       put(ds - CELLS,tag_float(to_float((obj2))));
                        type = type1;
                        break;
                default:
@@ -48,7 +48,7 @@ void primitive_arithmetic_type(void)
                        type = type2;
                        break;
                case FLOAT_TYPE:
-                       put(ds - CELLS,tag_object(make_float(to_float((obj2)))));
+                       put(ds - CELLS,tag_float(to_float((obj2))));
                        type = type1;
                        break;
                default:
@@ -62,7 +62,7 @@ void primitive_arithmetic_type(void)
                case FIXNUM_TYPE:
                case BIGNUM_TYPE:
                case RATIO_TYPE:
-                       drepl(tag_object(make_float(to_float(obj1))));
+                       drepl(tag_float(to_float(obj1)));
                        type = type2;
                        break;
                default:
@@ -88,6 +88,6 @@ void primitive_arithmetic_type(void)
                type = type2;
                break;
        }
-
+       
        dpush(tag_fixnum(type));
 }

diff --git a/native/bignum.c b/native/bignum.c
index c80ab81ec99bbf38b21bb8ec3780ad317a91b5b5..2347778a947cbad77c03c2e95ec19f341a6c895d 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -53,7 +53,7 @@ CELL to_cell(CELL x)
                bignum = to_bignum(x);
                if(BIGNUM_NEGATIVE_P(bignum))
                {
-                       range_error(F,0,tag_object(bignum),FIXNUM_MAX);
+                       range_error(F,0,tag_bignum(bignum),FIXNUM_MAX);
                        return -1;
                }
                else
@@ -100,7 +100,7 @@ F_ARRAY* to_bignum(CELL tagged)
 void primitive_to_bignum(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(to_bignum(dpeek())));
+       drepl(tag_bignum(to_bignum(dpeek())));
 }
 
 void primitive_bignum_eq(void)
@@ -119,33 +119,33 @@ void primitive_bignum_eq(void)
 void primitive_bignum_add(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_add(x,y)));
+       dpush(tag_bignum(s48_bignum_add(x,y)));
 }
 
 void primitive_bignum_subtract(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_subtract(x,y)));
+       dpush(tag_bignum(s48_bignum_subtract(x,y)));
 }
 
 void primitive_bignum_multiply(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_multiply(x,y)));
+       dpush(tag_bignum(s48_bignum_multiply(x,y)));
 }
 
 void primitive_bignum_divint(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_quotient(x,y)));
+       dpush(tag_bignum(s48_bignum_quotient(x,y)));
 }
 
 void primitive_bignum_divfloat(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(make_float(
+       dpush(tag_float(
                s48_bignum_to_double(x) /
-               s48_bignum_to_double(y))));
+               s48_bignum_to_double(y)));
 }
 
 void primitive_bignum_divmod(void)
@@ -153,32 +153,32 @@ void primitive_bignum_divmod(void)
        F_ARRAY *q, *r;
        GC_AND_POP_BIGNUMS(x,y);
        s48_bignum_divide(x,y,&q,&r);
-       dpush(tag_object(q));
-       dpush(tag_object(r));
+       dpush(tag_bignum(q));
+       dpush(tag_bignum(r));
 }
 
 void primitive_bignum_mod(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_remainder(x,y)));
+       dpush(tag_bignum(s48_bignum_remainder(x,y)));
 }
 
 void primitive_bignum_and(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_bitwise_and(x,y)));
+       dpush(tag_bignum(s48_bignum_bitwise_and(x,y)));
 }
 
 void primitive_bignum_or(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_bitwise_ior(x,y)));
+       dpush(tag_bignum(s48_bignum_bitwise_ior(x,y)));
 }
 
 void primitive_bignum_xor(void)
 {
        GC_AND_POP_BIGNUMS(x,y);
-       dpush(tag_object(s48_bignum_bitwise_xor(x,y)));
+       dpush(tag_bignum(s48_bignum_bitwise_xor(x,y)));
 }
 
 void primitive_bignum_shift(void)
@@ -188,7 +188,7 @@ void primitive_bignum_shift(void)
        maybe_garbage_collection();
        y = to_fixnum(dpop());
        x = to_bignum(dpop());
-       dpush(tag_object(s48_bignum_arithmetic_shift(x,y)));
+       dpush(tag_bignum(s48_bignum_arithmetic_shift(x,y)));
 }
 
 void primitive_bignum_less(void)
@@ -248,7 +248,7 @@ void primitive_bignum_greatereq(void)
 void primitive_bignum_not(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(s48_bignum_bitwise_not(
+       drepl(tag_bignum(s48_bignum_bitwise_not(
                untag_bignum(dpeek()))));
 }
 

diff --git a/native/bignum.h b/native/bignum.h
index 4b865ee17a53fd5587dc7736f23a4aae16864a9b..c5ac7b514a77658787b76db265950067a0941da6 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -13,6 +13,11 @@ INLINE F_ARRAY* untag_bignum(CELL tagged)
        return untag_bignum_fast(tagged);
 }
 
+INLINE CELL tag_bignum(F_ARRAY* bignum)
+{
+       return RETAG(bignum,BIGNUM_TYPE);
+}
+
 F_FIXNUM to_integer(CELL x);
 CELL to_cell(CELL x);
 
@@ -46,7 +51,7 @@ CELL three_test(void* x, unsigned char r, unsigned char g, unsigned char b);
 INLINE CELL tag_integer(F_FIXNUM x)
 {
        if(x < FIXNUM_MIN || x > FIXNUM_MAX)
-               return tag_object(s48_long_to_bignum(x));
+               return tag_bignum(s48_long_to_bignum(x));
        else
                return tag_fixnum(x);
 }
@@ -54,7 +59,7 @@ INLINE CELL tag_integer(F_FIXNUM x)
 INLINE CELL tag_cell(CELL x)
 {
        if(x > FIXNUM_MAX)
-               return tag_object(s48_ulong_to_bignum(x));
+               return tag_bignum(s48_ulong_to_bignum(x));
        else
                return tag_fixnum(x);
 }

diff --git a/native/fixnum.c b/native/fixnum.c
index d14109497e78a62c8add0ad416a630b89f32724b..9f9d5fb2728bab8844af00a4c6dcb4bad1522e24 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -17,7 +17,7 @@ F_FIXNUM to_fixnum(CELL tagged)
                r = (F_RATIO*)UNTAG(tagged);
                x = to_bignum(r->numerator);
                y = to_bignum(r->denominator);
-               return to_fixnum(tag_object(s48_bignum_quotient(x,y)));
+               return to_fixnum(tag_bignum(s48_bignum_quotient(x,y)));
        case FLOAT_TYPE:
                f = (F_FLOAT*)UNTAG(tagged);
                return (F_FIXNUM)f->n;
@@ -72,7 +72,7 @@ void primitive_fixnum_multiply(void)
                        box_integer(prod);
                else
                {
-                       dpush(tag_object(
+                       dpush(tag_bignum(
                                s48_bignum_multiply(
                                        s48_long_to_bignum(x),
                                        s48_long_to_bignum(y))));
@@ -91,7 +91,7 @@ void primitive_fixnum_divfloat(void)
 {
        F_FIXNUM y = untag_fixnum_fast(dpop());
        F_FIXNUM x = untag_fixnum_fast(dpop());
-       dpush(tag_object(make_float((double)x / (double)y)));
+       dpush(tag_float((double)x / (double)y));
 }
 
 void primitive_fixnum_divmod(void)
@@ -166,7 +166,7 @@ void primitive_fixnum_shift(void)
                }
        }
 
-       dpush(tag_object(s48_bignum_arithmetic_shift(
+       dpush(tag_bignum(s48_bignum_arithmetic_shift(
                s48_long_to_bignum(x),y)));
 }
 

diff --git a/native/float.c b/native/float.c
index b6b8b00e166715f244391bdccf5c7282c84e6f6d..3a5f2498703e26aad0949402869277144b23cdac 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -28,7 +28,7 @@ double to_float(CELL tagged)
 void primitive_to_float(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(to_float(dpeek()))));
+       drepl(tag_float(to_float(dpeek())));
 }
 
 void primitive_str_to_float(void)
@@ -45,7 +45,7 @@ void primitive_str_to_float(void)
        f = strtod(c_str,&end);
        if(end != c_str + str->capacity)
                general_error(ERROR_FLOAT_FORMAT,tag_object(str));
-       drepl(tag_object(make_float(f)));
+       drepl(tag_float(f));
 }
 
 void primitive_float_to_str(void)
@@ -74,25 +74,25 @@ void primitive_float_eq(void)
 void primitive_float_add(void)
 {
        GC_AND_POP_FLOATS(x,y);
-       dpush(tag_object(make_float(x + y)));
+       dpush(tag_float(x + y));
 }
 
 void primitive_float_subtract(void)
 {
        GC_AND_POP_FLOATS(x,y);
-       dpush(tag_object(make_float(x - y)));
+       dpush(tag_float(x - y));
 }
 
 void primitive_float_multiply(void)
 {
        GC_AND_POP_FLOATS(x,y);
-       dpush(tag_object(make_float(x * y)));
+       dpush(tag_float(x * y));
 }
 
 void primitive_float_divfloat(void)
 {
        GC_AND_POP_FLOATS(x,y);
-       dpush(tag_object(make_float(x / y)));
+       dpush(tag_float(x / y));
 }
 
 void primitive_float_less(void)
@@ -122,19 +122,19 @@ void primitive_float_greatereq(void)
 void primitive_facos(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(acos(to_float(dpeek())))));
+       drepl(tag_float(acos(to_float(dpeek()))));
 }
 
 void primitive_fasin(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(asin(to_float(dpeek())))));
+       drepl(tag_float(asin(to_float(dpeek()))));
 }
 
 void primitive_fatan(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(atan(to_float(dpeek())))));
+       drepl(tag_float(atan(to_float(dpeek()))));
 }
 
 void primitive_fatan2(void)
@@ -143,31 +143,31 @@ void primitive_fatan2(void)
        maybe_garbage_collection();
        y = to_float(dpop());
        x = to_float(dpop());
-       dpush(tag_object(make_float(atan2(x,y))));
+       dpush(tag_float(atan2(x,y)));
 }
 
 void primitive_fcos(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(cos(to_float(dpeek())))));
+       drepl(tag_float(cos(to_float(dpeek()))));
 }
 
 void primitive_fexp(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(exp(to_float(dpeek())))));
+       drepl(tag_float(exp(to_float(dpeek()))));
 }
 
 void primitive_fcosh(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(cosh(to_float(dpeek())))));
+       drepl(tag_float(cosh(to_float(dpeek()))));
 }
 
 void primitive_flog(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(log(to_float(dpeek())))));
+       drepl(tag_float(log(to_float(dpeek()))));
 }
 
 void primitive_fpow(void)
@@ -176,23 +176,23 @@ void primitive_fpow(void)
        maybe_garbage_collection();
        y = to_float(dpop());
        x = to_float(dpop());
-       dpush(tag_object(make_float(pow(x,y))));
+       dpush(tag_float(pow(x,y)));
 }
 
 void primitive_fsin(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(sin(to_float(dpeek())))));
+       drepl(tag_float(sin(to_float(dpeek()))));
 }
 
 void primitive_fsinh(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(sinh(to_float(dpeek())))));
+       drepl(tag_float(sinh(to_float(dpeek()))));
 }
 
 void primitive_fsqrt(void)
 {
        maybe_garbage_collection();
-       drepl(tag_object(make_float(sqrt(to_float(dpeek())))));
+       drepl(tag_float(sqrt(to_float(dpeek()))));
 }

diff --git a/native/float.h b/native/float.h
index c643be6380ca7bb58ef83ee4d2e3210b5baaed8b..139fe3ca8e2e6301efbd62ba2ea70a4e1c19cdeb 100644 (file)
--- a/native/float.h
+++ b/native/float.h
@@ -21,6 +21,11 @@ INLINE double untag_float(CELL tagged)
        return untag_float_fast(tagged);
 }
 
+INLINE CELL tag_float(double flo)
+{
+       return RETAG(make_float(flo),FLOAT_TYPE);
+}
+
 double to_float(CELL tagged);
 void primitive_to_float(void);
 void primitive_str_to_float(void);

diff --git a/native/gc.c b/native/gc.c
index 72fc513f64ee22a0d9492daa1ded90f644ed9513..784677928cf7871e71e767c7f45d929251e75008 100644 (file)
--- a/native/gc.c
+++ b/native/gc.c
@@ -148,5 +148,5 @@ void maybe_garbage_collection(void)
 void primitive_gc_time(void)
 {
        maybe_garbage_collection();
-       dpush(tag_object(s48_long_long_to_bignum(gc_time)));
+       dpush(tag_bignum(s48_long_long_to_bignum(gc_time)));
 }

diff --git a/native/memory.c b/native/memory.c
index e99eb09ac2bb5ab26aef83140cfc95fa24e90ca7..8173732863faf64028f2a9979db32b6e18976ebe 100644 (file)
--- a/native/memory.c
+++ b/native/memory.c
@@ -116,7 +116,7 @@ void primitive_allot_profiling(void)
 
 void primitive_address(void)
 {
-       dpush(tag_object(s48_ulong_to_bignum(dpop())));
+       dpush(tag_bignum(s48_ulong_to_bignum(dpop())));
 }
 
 void primitive_heap_stats(void)

diff --git a/native/misc.c b/native/misc.c
index cc64f52ba74f348941a0218af789f8237e10ef53..1ff79aa035bae928aa0198c733fe9515047d6b57 100644 (file)
--- a/native/misc.c
+++ b/native/misc.c
@@ -44,7 +44,7 @@ int64_t current_millis(void)
 void primitive_millis(void)
 {
        maybe_garbage_collection();
-       dpush(tag_object(s48_long_long_to_bignum(current_millis())));
+       dpush(tag_bignum(s48_long_long_to_bignum(current_millis())));
 }
 
 void primitive_init_random(void)
@@ -55,7 +55,7 @@ void primitive_init_random(void)
 void primitive_random_int(void)
 {
        maybe_garbage_collection();
-       dpush(tag_object(s48_long_to_bignum(rand())));
+       dpush(tag_bignum(s48_long_to_bignum(rand())));
 }
 
 #ifdef WIN32

diff --git a/native/types.c b/native/types.c
index 16063e4051e6c5a1e1e3f99a8f28574cd7900aaa..4f31e6e39d798e116adc8e4138c6ca726e14e4fb 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -20,12 +20,18 @@ CELL object_size(CELL pointer)
        case FIXNUM_TYPE:
                size = 0;
                break;
+       case BIGNUM_TYPE:
+               size = ASIZE(UNTAG(pointer));
+               break;
        case CONS_TYPE:
                size = sizeof(F_CONS);
                break;
        case RATIO_TYPE:
                size = sizeof(F_RATIO);
                break;
+       case FLOAT_TYPE:
+               size = sizeof(F_FLOAT);
+               break;
        case COMPLEX_TYPE:
                size = sizeof(F_COMPLEX);
                break;

diff --git a/native/types.h b/native/types.h
index fdc37d4bbfe2a34de74b83109e2795e2bd34c767..5660a1ea5e17a91fa8189f23533bccb20af889f8 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -6,26 +6,27 @@
 
 /*** Tags ***/
 #define FIXNUM_TYPE 0
+#define BIGNUM_TYPE 1
 #define CONS_TYPE 2
 #define OBJECT_TYPE 3
 #define RATIO_TYPE 4
-#define COMPLEX_TYPE 5
-#define HEADER_TYPE 6
+#define FLOAT_TYPE 5
+#define COMPLEX_TYPE 6
+#define HEADER_TYPE 7
 #define GC_COLLECTED 7 /* See gc.c */
 
 /*** Header types ***/
 
-/* Canonical F object */
-#define F_TYPE 6
-#define F RETAG(0,OBJECT_TYPE)
-
 /* Canonical T object */
 #define T_TYPE 7
 CELL T;
 
 #define ARRAY_TYPE 8
-#define BIGNUM_TYPE 9
-#define FLOAT_TYPE 10
+
+/* Canonical F object */
+#define F_TYPE 9
+#define F RETAG(0,OBJECT_TYPE)
+
 #define VECTOR_TYPE 11
 #define STRING_TYPE 12
 #define SBUF_TYPE 13
@@ -48,18 +49,9 @@ INLINE CELL tag_header(CELL cell)
        return RETAG(cell << TAG_BITS,OBJECT_TYPE);
 }
 
-#define HEADER_DEBUG
-
 INLINE CELL untag_header(CELL cell)
 {
-       CELL type = cell >> TAG_BITS;
-#ifdef HEADER_DEBUG
-       if(!headerp(cell))
-               critical_error("header type check",cell);
-       if(type <= HEADER_TYPE)
-               critical_error("header invariant check",cell);
-#endif
-       return type;
+       return cell >> TAG_BITS;
 }
 
 INLINE CELL tag_object(void* cell)
@@ -69,7 +61,10 @@ INLINE CELL tag_object(void* cell)
 
 INLINE CELL object_type(CELL tagged)
 {
-       return untag_header(get(UNTAG(tagged)));
+       if(tagged == F)
+               return F_TYPE;
+       else
+               return untag_header(get(UNTAG(tagged)));
 }
 
 INLINE void type_check(CELL type, CELL tagged)
@@ -79,11 +74,6 @@ INLINE void type_check(CELL type, CELL tagged)
                if(TAG(tagged) == type)
                        return;
        }
-       else if(tagged == F)
-       {
-               if(type == F_TYPE)
-                       return;
-       }
        else if(TAG(tagged) == OBJECT_TYPE
                && object_type(tagged) == type)
        {
@@ -102,12 +92,7 @@ INLINE CELL type_of(CELL tagged)
 {
        CELL tag = TAG(tagged);
        if(tag == OBJECT_TYPE)
-       {
-               if(tagged == F)
-                       return F_TYPE;
-               else
-                       return untag_header(get(UNTAG(tagged)));
-       }
+               return object_type(tagged);
        else
                return tag;
 }

diff --git a/native/unix/file.c b/native/unix/file.c
index 52183e24c120b2c41fe40130c0d6b1e7d7d4d1ef..1d49a146126b8aefaec47630067abc1c467d01c0 100644 (file)
--- a/native/unix/file.c
+++ b/native/unix/file.c
@@ -43,7 +43,7 @@ void primitive_stat(void)
        {
                CELL dirp = tag_boolean(S_ISDIR(sb.st_mode));
                CELL mode = tag_fixnum(sb.st_mode & ~S_IFMT);
-               CELL size = tag_object(s48_long_long_to_bignum(sb.st_size));
+               CELL size = tag_bignum(s48_long_long_to_bignum(sb.st_size));
                CELL mtime = tag_integer(sb.st_mtime);
                dpush(cons(
                        dirp,

diff --git a/native/win32/file.c b/native/win32/file.c
index 748a24e63311a8359dbcc5fc87dc47a0bff9ddef..c1afb420db4bac9c3896309bd7cab24d8d98eedf 100644 (file)
--- a/native/win32/file.c
+++ b/native/win32/file.c
@@ -60,7 +60,7 @@ void primitive_stat(void)
        else 
        {
                CELL dirp = tag_boolean(st.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
-               CELL size = tag_object(s48_long_long_to_bignum(
+               CELL size = tag_bignum(s48_long_long_to_bignum(
                        (int64_t)st.nFileSizeLow | (int64_t)st.nFileSizeHigh << 32));
                CELL mtime = tag_integer((int)
                        ((*(int64_t*)&st.ftLastWriteTime - EPOCH_OFFSET) / 10000000));