diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index d7acafcbb4..c2a6d56013 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,21 +1,17 @@ should fix in 0.82: -- constant branch folding -- fast-slot stuff -- 3 >n fep +- callback segv +- generate-push should not do anything without sse2 +- get literals working +- get loads from stack working +- get boxing working +- straighten out "fp-scratch" +- clean up/rewrite register allocation + - amd64 %box-struct -- get factor running on mac intel - when generating a 32-bit image on a 64-bit system, large numbers which should be bignums become fixnums -- clicks sent twice -- speed up ideas: - - only do clipping for certain gadgets - - use glRect - -+ portability: - -- win64 port -- amd64 %unbox-struct +- get factor running on mac intel + io: @@ -23,9 +19,14 @@ should fix in 0.82: - better i/o scheduler - yield in a loop starves i/o - "localhost" 50 won't fail +- issues with timeouts + ui/help: +- clicks sent twice +- speed up ideas: + - only do clipping for certain gadgets + - use glRect - polish OS X menu bar code - help search - reimplement clicking input @@ -54,16 +55,16 @@ should fix in 0.82: + compiler/ffi: +- win64 port +- amd64 %unbox-struct +- constant branch folding - core foundation should use unicode strings - alien>utf16-string, utf16-string>alien words - can only be called with an alien? - remove , , set-char*-nth, set-ushort*-nth since they have incorrect semantics -- improve callback efficiency -- float intrinsics - complex float type - complex float intrinsics -- out of memory from overflow check - remove literal table - C functions returning structs by value - FIELD: char key_vector[32]; @@ -73,10 +74,11 @@ should fix in 0.82: - [ [ dup call ] dup call ] infer hangs - the invalid recursion form case needs to be fixed, for inlines too - code gc -- compiled gc check slows things down +- fix compiled gc check + misc: +- 3 >n fep - code walker & exceptions - slice: if sequence or seq start is changed, abstraction violation - make 3.4 bits>double an error diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index bb217acdf6..041bc8be1e 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -10,7 +10,7 @@ vectors words ; "/library/bootstrap/primitives.factor" run-resource : if-arch ( arch seq -- ) - architecture rot member? + architecture get rot member? [ [ parse-resource % ] each ] [ drop ] if ; ! The [ ] make form creates a boot quotation diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index a0ee4204cf..5d6f02f281 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -62,9 +62,6 @@ SYMBOL: architecture : word-type 16 ; inline : tuple-type 17 ; inline -: immediate ( x tag -- tagged ) swap tag-bits shift bitor ; -: >header ( id -- tagged ) object-tag immediate ; - ( Image header ) : base 1024 ; @@ -106,9 +103,9 @@ GENERIC: ' ( obj -- ptr ) ( Fixnums ) -: emit-fixnum ( n -- ) fixnum-tag immediate emit ; +: emit-fixnum ( n -- ) fixnum-tag tag-address emit ; -M: fixnum ' ( n -- tagged ) fixnum-tag immediate ; +M: fixnum ' ( n -- tagged ) fixnum-tag tag-address ; ( Bignums ) @@ -136,14 +133,14 @@ M: fixnum ' ( n -- tagged ) fixnum-tag immediate ; M: bignum ' ( bignum -- tagged ) #! This can only emit 0, -1 and 1. bignum-tag here-as >r - bignum-tag >header emit + bignum-tag tag-header emit emit-bignum align-here r> ; ( Floats ) M: float ' ( float -- tagged ) float-tag here-as >r - float-tag >header emit + float-tag tag-header emit align-here double>bits emit-64 r> ; @@ -177,7 +174,7 @@ M: f ' ( obj -- ptr ) dup word-vocabulary ' >r dup word-name ' >r object-tag here-as over objects get set-hash - word-type >header emit + word-type tag-header emit hashcode emit-fixnum r> emit r> emit @@ -209,7 +206,7 @@ M: word ' ( word -- pointer ) ; M: wrapper ' ( wrapper -- pointer ) wrapped ' object-tag here-as >r - wrapper-type >header emit + wrapper-type tag-header emit emit r> ; ( Conses ) @@ -234,7 +231,7 @@ M: complex ' ( c -- tagged ) >rect complex-tag emit-cons ; : emit-string ( string -- ptr ) object-tag here-as swap - string-type >header emit + string-type tag-header emit dup length emit-fixnum dup hashcode emit-fixnum pack-string emit-chars @@ -250,7 +247,7 @@ M: string ' ( string -- pointer ) : emit-array ( list type -- pointer ) >r [ ' ] map r> object-tag here-as >r - >header emit + tag-header emit dup length emit-fixnum ( elements -- ) emit-seq align-here r> ; @@ -270,7 +267,7 @@ M: array ' ( array -- pointer ) M: vector ' ( vector -- pointer ) dup underlying ' swap length object-tag here-as >r - vector-type >header emit + vector-type tag-header emit emit-fixnum ( length ) emit ( array ptr ) align-here r> ; @@ -278,7 +275,7 @@ M: vector ' ( vector -- pointer ) M: sbuf ' ( sbuf -- pointer ) dup underlying ' swap length object-tag here-as >r - sbuf-type >header emit + sbuf-type tag-header emit emit-fixnum ( length ) emit ( array ptr ) align-here r> ; @@ -288,7 +285,7 @@ M: sbuf ' ( sbuf -- pointer ) M: hashtable ' ( hashtable -- pointer ) [ hash-array ' ] keep object-tag here-as >r - hashtable-type >header emit + hashtable-type tag-header emit dup hash-count emit-fixnum hash-deleted emit-fixnum emit ( array ptr ) diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor index e464b8e443..3a3f7f3649 100644 --- a/library/compiler/generator/architecture.factor +++ b/library/compiler/generator/architecture.factor @@ -27,6 +27,9 @@ GENERIC: fastcall-regs ( register-class -- regs ) ! Sequence mapping vreg-n to native assembler registers GENERIC: vregs ( register-class -- regs ) +! Map a sequence of literals to f or float +DEFER: literal-template ( literals -- template ) + ! Load a literal (immediate or indirect) G: load-literal ( obj vreg -- ) 1 standard-combination ; diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor index 435dcecb4a..70e067ced4 100644 --- a/library/compiler/generator/generator.factor +++ b/library/compiler/generator/generator.factor @@ -195,14 +195,10 @@ UNION: immediate fixnum POSTPONE: f ; : alloc-literal-reg ( literal -- vreg ) float? T{ float-regs f 8 } T{ int-regs } ? alloc-reg ; -! : generate-push ( node -- ) -! >#push< dup [ class ] map requested-vregs ensure-vregs -! [ dup alloc-literal-reg [ load-literal ] keep ] map -! phantom-d get phantom-append ; - : generate-push ( node -- ) - >#push< dup length 0 ensure-vregs - [ T{ int-regs } alloc-reg [ load-literal ] keep ] map + >#push< dup literal-template + dup requested-vregs ensure-vregs + alloc-vregs [ [ load-literal ] 2each ] keep phantom-d get phantom-append ; M: #push generate-node ( #push -- ) diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor index 1e7982fd17..d089ce1ec5 100644 --- a/library/compiler/generator/templates.factor +++ b/library/compiler/generator/templates.factor @@ -15,7 +15,7 @@ namespaces prettyprint sequences vectors words ; : alloc-vregs ( template -- template ) [ - first dup + dup H{ { f T{ int-regs } } { float T{ float-regs f 8 } } } hash [ alloc-reg ] [ dup take-reg ] ?if ] map ; @@ -179,7 +179,7 @@ SYMBOL: phantom-r : stack>vregs ( phantom template -- values ) [ - alloc-vregs dup length rot phantom-locs + [ first ] map alloc-vregs dup length rot phantom-locs [ dupd %peek ] 2map ] 2keep length neg swap adjust-phantom ; @@ -258,10 +258,11 @@ SYMBOL: +clobber : guess-vregs ( -- int# float# ) +input get { } additional-vregs# - +scratch get requested-vregs >r + r> ; + +scratch get [ first ] map requested-vregs >r + r> ; : alloc-scratch ( -- ) - +scratch get [ alloc-vregs ] keep phantom-vregs ; + +scratch get + [ [ first ] map alloc-vregs ] keep phantom-vregs ; : template-inputs ( -- ) ! Ensure we have enough to hold any new stack elements we diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor index 676a6a2801..1a3c030224 100644 --- a/library/compiler/x86/architecture.factor +++ b/library/compiler/x86/architecture.factor @@ -46,16 +46,26 @@ M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ; : prepare-division CDQ ; inline +: fp-scratch ( -- vreg ) + "fp-scratch" get [ + T{ int-regs } alloc-reg dup "fp-scratch" set + ] unless* ; + : unboxify-float ( obj vreg quot -- | quot: obj int-vreg ) #! The SSE2 code here will never be generated unless SSE2 #! intrinsics are loaded. over [ float-regs? ] is? [ - swap >r T{ int-regs } alloc-reg [ swap call ] keep + swap >r fp-scratch [ swap call ] keep r> swap [ v>operand ] 2apply float-offset [+] MOVSD ] [ call ] if ; inline +: literal-template + #! All literals go into integer registers unless SSE2 + #! intrinsics are loaded. + length f ; + M: immediate load-literal ( literal vreg -- ) v>operand swap v>operand MOV ; @@ -98,24 +108,16 @@ M: object load-literal ( literal vreg -- ) : %return ( -- ) %epilogue RET ; -: vreg-mov [ v>operand ] 2apply MOV ; +: vreg-mov swap [ v>operand ] 2apply MOV ; : %peek ( vreg loc -- ) - swap [ swap vreg-mov ] unboxify-float ; + swap [ vreg-mov ] unboxify-float ; -: %replace ( vreg loc -- ) - #! The SSE2 code here will never be generated unless SSE2 - #! intrinsics are loaded. - over [ float-regs? ] is? [ - ! >r - ! "fp-scratch" operand "allot.here" f dlsym [] MOV - ! "fp-scratch" operand [] float-tag >header MOV - ! "fp-scratch" operand 8 [+] r> MOVSD - ! "allot.here" f dlsym [] 16 ADD - vreg-mov - ] [ - vreg-mov - ] if ; +GENERIC: (%replace) ( vreg loc reg-class -- ) + +M: int-regs (%replace) drop vreg-mov ; + +: %replace ( vreg loc -- ) over (%replace) ; : (%inc) swap cells dup 0 > [ ADD ] [ neg SUB ] if ; diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor index 51a493ceef..ca56945b84 100644 --- a/library/compiler/x86/assembler.factor +++ b/library/compiler/x86/assembler.factor @@ -376,7 +376,7 @@ M: operand CMP OCT: 071 2-operand ; : 2-operand-sse ( dst src op1 op2 -- ) #! We swap the operands here to make everything consistent #! with the integer instructions. - swap assemble-1 swapd + swap assemble-1 pick register-128? [ swapd ] [ 1 bitor ] if >r 2dup t prefix HEX: 0f assemble-1 r> assemble-1 reg-code swap addressing ; diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor index 239d63e456..8e43378169 100644 --- a/library/compiler/x86/intrinsics-sse2.factor +++ b/library/compiler/x86/intrinsics-sse2.factor @@ -1,9 +1,41 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays assembler kernel kernel-internals lists math -math-internals namespaces sequences words ; +USING: alien arrays assembler generic kernel kernel-internals +lists math math-internals memory namespaces sequences words ; IN: compiler +: literal-template + #! floats map to 'float' so we put float literals in float + #! vregs + [ class ] map ; + +: load-zone-ptr ( vreg -- ) + #! Load pointer to start of zone array + "generations" f dlsym [] MOV ; + +: load-allot-ptr ( vreg -- ) + dup load-zone-ptr dup cell [+] MOV ; + +: inc-allot-ptr ( vreg n -- ) + >r dup load-zone-ptr cell [+] r> ADD ; + +: with-inline-alloc ( vreg spec prequot postquot -- ) + #! both quotations are called with the vreg + rot [ + >r >r v>operand dup load-allot-ptr + dup [] \ tag-header get call tag-header MOV + r> over slip dup \ tag get call OR + r> over slip \ size get call inc-allot-ptr + ] bind ; inline + +M: float-regs (%replace) ( vreg loc reg-class -- ) + drop fp-scratch H{ + { tag-header [ float-tag ] } + { tag [ float-tag ] } + { size [ 16 ] } + } [ 8 [+] rot v>operand MOVSD ] + [ >r v>operand r> MOV ] with-inline-alloc ; + ! Floats : define-float-op ( word op -- ) [ [ "x" operand "y" operand ] % , ] [ ] make H{ diff --git a/library/kernel.factor b/library/kernel.factor index c18ff92ce1..8c54939ab3 100644 --- a/library/kernel.factor +++ b/library/kernel.factor @@ -102,6 +102,9 @@ IN: kernel-internals : cell 17 getenv ; foldable +: tag-address ( x tag -- tagged ) swap tag-bits shift bitor ; +: tag-header ( id -- tagged ) object-tag tag-address ; + IN: kernel : win32? windows? cell 4 = and ; inline diff --git a/library/math/float.factor b/library/math/float.factor index 9af3f3bbf1..b17fc6c0fd 100644 --- a/library/math/float.factor +++ b/library/math/float.factor @@ -1,7 +1,13 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +IN: math-internals +USING: math kernel ; + +: float= ( n n -- ) + #! The compiler replaces this with a better intrinsic. + [ double>bits ] 2apply number= ; + IN: math -USING: generic kernel math-internals ; UNION: real rational float ; @@ -17,12 +23,11 @@ M: real <=> - ; M: float zero? double>bits HEX: 8000000000000000 [ bitor ] keep number= ; -M: float number= [ double>bits ] 2apply number= ; - M: float < float< ; M: float <= float<= ; M: float > float> ; M: float >= float>= ; +M: float number= float= ; M: float + float+ ; M: float - float- ; diff --git a/library/test/compiler/float.factor b/library/test/compiler/float.factor new file mode 100644 index 0000000000..e23da1fbd8 --- /dev/null +++ b/library/test/compiler/float.factor @@ -0,0 +1,25 @@ +IN: temporary +USING: compiler kernel memory math math-internals test ; + +[ 5.0 ] [ [ 5.0 ] compile-1 full-gc full-gc full-gc ] unit-test +[ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-1 ] unit-test + +[ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-1 ] unit-test +[ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-1 ] unit-test +[ 3.0 ] [ 1.0 2.0 [ float+ ] compile-1 ] unit-test +[ 3.0 ] [ 1.0 2.0 [ swap float+ ] compile-1 ] unit-test + +[ -1.0 ] [ 1.0 [ 2.0 float- ] compile-1 ] unit-test +[ 1.0 ] [ 1.0 [ 2.0 swap float- ] compile-1 ] unit-test +[ -1.0 ] [ 1.0 2.0 [ float- ] compile-1 ] unit-test +[ 1.0 ] [ 1.0 2.0 [ swap float- ] compile-1 ] unit-test + +[ 6.0 ] [ 3.0 [ 2.0 float* ] compile-1 ] unit-test +[ 6.0 ] [ 3.0 [ 2.0 swap float* ] compile-1 ] unit-test +[ 6.0 ] [ 3.0 2.0 [ float* ] compile-1 ] unit-test +[ 6.0 ] [ 3.0 2.0 [ swap float* ] compile-1 ] unit-test + +[ 0.5 ] [ 1.0 [ 2.0 float/f ] compile-1 ] unit-test +[ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-1 ] unit-test +[ 0.5 ] [ 1.0 2.0 [ float/f ] compile-1 ] unit-test +[ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-1 ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index b579bb0e0c..2d6a0389d5 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -104,7 +104,7 @@ SYMBOL: failures "compiler/simple" "compiler/templates" "compiler/stack" "compiler/ifte" "compiler/generic" "compiler/bail-out" - "compiler/intrinsics" + "compiler/intrinsics" "compiler/float" "compiler/identities" "compiler/optimizer" "compiler/alien" "compiler/callbacks" } run-tests ; diff --git a/native/gc.h b/native/gc.h index 07482fcbdb..0151aa9b95 100644 --- a/native/gc.h +++ b/native/gc.h @@ -18,7 +18,7 @@ CELL gen_count; /* the oldest generation */ #define TENURED (gen_count-1) -ZONE *generations; +DLLEXPORT ZONE *generations; /* used during garbage collection only */ ZONE *newspace;