diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index b239d07f46..3799014220 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -6,13 +6,14 @@ http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup +- make head? tail? more efficient with slices - fix ceiling - single-stepper and variable access: wrong namespace? - investigate if COPYING_GEN needs a fix - faster layout - keep alive - sleep word -- redo new compiler backend for PowerPC +- fix fixnum<< overflow on PowerPC - fix i/o on generic x86/ppc unix - alien primitives need a more general input type - 2map slow with lists @@ -66,7 +67,6 @@ + compiler: - simplifier: - - kill tag-fixnum/untag-fixnum - kill replace after a peek - merge inc-d's across VOPs that don't touch the stack - [ EAX 0 ] --> [ EAX ] diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index dd3250f512..fc993b9792 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -134,31 +134,49 @@ sequences words ; 1 %dec-d , ] "intrinsic" set-word-prop -: binary-op-reg ( op out -- ) - >r in-2 - 1 %dec-d , - >r 1 0 0 r> execute , - r> 0 %replace-d , ; +GENERIC: load-value ( vreg n value -- ) + +M: computed load-value ( vreg n value -- ) + drop %peek-d , ; + +M: literal load-value ( vreg n value -- ) + nip literal-value %immediate , ; + +: value/vreg-list ( in -- list ) + [ 0 swap length 1 - ] keep + [ >r 2dup r> 3list >r 1 - >r 1 + r> r> ] map 2nip ; + +: values>vregs ( in -- in ) + value/vreg-list + dup [ 3unlist load-value ] each + [ car ] map ; + +: load-inputs ( node -- in ) + dup node-in-d values>vregs + [ length swap node-out-d length - %dec-d , ] keep ; + +: binary-op-reg ( node op -- ) + >r load-inputs 2unlist swap dup r> execute , + 0 0 %replace-d , ; inline : literal-fixnum? ( value -- ? ) dup literal? [ literal-value fixnum? ] [ drop f ] ifte ; -: binary-op-imm ( node imm op out -- ) - >r >r 1 %dec-d , - in-1 - 0 dup r> execute , - r> 0 %replace-d , ; +: binary-op-imm ( imm op -- ) + 1 %dec-d , in-1 + >r 0 dup r> execute , + 0 0 %replace-d , ; inline -: binary-op ( node op out -- ) +: binary-op ( node op -- ) #! out is a vreg where the vop stores the result. fixnum-imm? [ - >r >r node-peek dup literal-fixnum? [ - literal-value r> r> binary-op-imm + >r dup node-peek dup literal-fixnum? [ + literal-value r> binary-op-imm drop ] [ - drop r> r> binary-op-reg + drop r> binary-op-reg ] ifte ] [ - binary-op-reg drop + binary-op-reg ] ifte ; [ @@ -173,20 +191,23 @@ sequences words ; [[ fixnum> %fixnum> ]] [[ eq? %eq? ]] ] [ - uncons [ literal, 0 , \ binary-op , ] make-list + uncons [ literal, \ binary-op , ] make-list "intrinsic" set-word-prop ] each -: slow-fixnum* \ %fixnum* 0 binary-op-reg ; +: fast-fixnum* ( n -- ) + 1 %dec-d , + in-1 + log2 0 0 %fixnum<< , + 0 0 %replace-d , ; + +: slow-fixnum* ( node -- ) \ %fixnum* binary-op-reg ; \ fixnum* [ ! Turn multiplication by a power of two into a left shift. - node-peek dup literal-fixnum? [ + dup node-peek dup literal-fixnum? [ literal-value dup power-of-2? [ - 1 %dec-d , - in-1 - log2 0 0 %fixnum<< , - 0 0 %replace-d , + nip fast-fixnum* ] [ drop slow-fixnum* ] ifte @@ -209,7 +230,7 @@ sequences words ; \ fixnum/i t "intrinsic" set-word-prop \ fixnum/i [ - drop \ %fixnum/i 0 binary-op-reg + \ %fixnum/i binary-op-reg ] "intrinsic" set-word-prop \ fixnum/mod [ diff --git a/library/compiler/ppc/assembler.factor b/library/compiler/ppc/assembler.factor index 9f500b5ed2..637c096a82 100644 --- a/library/compiler/ppc/assembler.factor +++ b/library/compiler/ppc/assembler.factor @@ -195,9 +195,9 @@ USING: compiler errors kernel math memory words ; G: (B) ( dest aa lk -- ) [ pick ] [ type ] ; M: integer (B) i-form 18 insn ; -M: word (B) 0 (B) relative-24 ; +M: word (B) 0 -rot (B) relative-24 ; -: B 0 0 (B) ; : BA 1 0 (B) ; : BL 0 1 (B) ; : BLA 1 1 (B) ; +: B 0 0 (B) ; : BL 0 1 (B) ; GENERIC: BC M: integer BC 0 0 b-form 16 insn ; diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor index 56a4b3739d..b3f4d3a243 100644 --- a/library/compiler/ppc/generator.factor +++ b/library/compiler/ppc/generator.factor @@ -10,7 +10,7 @@ kernel-internals lists math memory namespaces words ; ! r16-r30 vregs : compile-c-call ( symbol dll -- ) - 2dup 1 1 rel-dlsym dlsym 19 LOAD32 19 MTLR BLRL ; + 2dup dlsym 19 LOAD32 0 1 rel-dlsym 19 MTLR BLRL ; M: integer v>operand tag-bits shift ; M: vreg v>operand vreg-n 17 + ; @@ -135,7 +135,7 @@ M: %arithmetic-type generate-node ( vop -- ) 3 3 tag-mask ANDI 4 4 tag-mask ANDI ! Are the tags equal? - 0 3 3 CMPL + 0 3 4 CMPL "end" get BEQ ! No, they are not equal. Call a runtime function to ! coerce the integers to a higher type. diff --git a/library/compiler/simplifier.factor b/library/compiler/simplifier.factor index 48cdd4db12..f1885884ae 100644 --- a/library/compiler/simplifier.factor +++ b/library/compiler/simplifier.factor @@ -62,6 +62,18 @@ M: %inc-d simplify-node ( linear vop -- linear ? ) ] ifte ] ifte ; +: operands= ( vop vop -- ? ) + over vop-inputs over vop-inputs = + >r swap vop-outputs swap vop-outputs = r> and ; + +: cancel ( linear class -- linear ? ) + dupd next-physical? + [ over first operands= [ cdr cdr t ] [ f ] ifte ] + [ drop f ] ifte ; + +M: %tag-fixnum simplify-node ( linear vop -- linear ? ) + drop \ %untag-fixnum cancel ; + : basic-block ( linear quot -- | quot: vop -- ? ) #! Keep applying the quotation to each VOP until either a #! VOP answering f to basic-block?, or the quotation answers