diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index ea123425c2..27b1c8f1b5 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,6 @@ should fix in 0.82: - another i/o bug: on factorcode eventually all i/o times out -- clean up fp-scratch - update amd64 backend - when generating a 32-bit image on a 64-bit system, large numbers which should be bignums become fixnums diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor index 0fa40bf02a..088f1851bd 100644 --- a/library/compiler/generator/generator.factor +++ b/library/compiler/generator/generator.factor @@ -194,9 +194,9 @@ M: #dispatch generate-node ( node -- next ) UNION: immediate fixnum POSTPONE: f ; : generate-push ( node -- ) - >#push< dup length f - dup requested-vregs ensure-vregs - [ spec>vreg [ load-literal ] keep ] 2map + >#push< + dup length ?fp-scratch + 0 ensure-vregs + [ f spec>vreg [ load-literal ] keep ] map 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 5f95e17e0f..54ef930aac 100644 --- a/library/compiler/generator/templates.factor +++ b/library/compiler/generator/templates.factor @@ -242,13 +242,6 @@ SYMBOL: +clobber : requested-vregs ( template -- int# float# ) dup length swap [ float eq? ] subset length [ - ] keep ; -: (holds-class?) ( class phantom -- ? ) - [ delegate class eq? ] contains-with? ; - -: holds-class? ( class -- ? ) - dup phantom-d get (holds-class?) swap - phantom-r get (holds-class?) or ; - : (requests-class?) ( class template -- ) [ second reg-spec>class eq? ] contains-with? ; @@ -257,8 +250,7 @@ SYMBOL: +clobber +scratch get (requests-class?) or ; : ?fp-scratch ( -- n ) - T{ float-regs f 8 } dup holds-class? >r requests-class? r> - or 1 0 ? ; + T{ float-regs f 8 } requests-class? 1 0 ? ; : fp-scratch ( -- vreg ) "fp-scratch" get [ diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor index f0eee28761..42087dcbc2 100644 --- a/library/compiler/ppc/architecture.factor +++ b/library/compiler/ppc/architecture.factor @@ -5,15 +5,15 @@ USING: alien assembler generic kernel kernel-internals math memory namespaces sequences words ; ! PowerPC register assignments -! r3-r11 integer vregs +! r3-r10 integer vregs ! f0-f13 float vregs -! r12 linkage +! r11, r12 scratch ! r14 data stack ! r15 call stack M: int-regs return-reg drop 3 ; M: int-regs fastcall-regs drop { 3 4 5 6 7 8 9 10 } ; -M: int-regs vregs drop { 3 4 5 6 7 8 9 10 11 } ; +M: int-regs vregs drop { 3 4 5 6 7 8 9 10 } ; M: float-regs return-reg drop 1 ; M: float-regs fastcall-regs drop { 1 2 3 4 5 6 7 8 } ; @@ -112,20 +112,20 @@ M: int-regs (%replace) ( vreg loc -- ) 12 load-zone-ptr 12 12 cell LWZ ; : save-allot-ptr ( -- ) - fp-scratch v>operand [ load-zone-ptr 12 ] keep cell STW ; + 11 [ load-zone-ptr 12 ] keep cell STW ; : with-inline-alloc ( prequot postquot spec -- ) load-allot-ptr [ - \ tag-header get call tag-header fp-scratch v>operand LI - fp-scratch v>operand 12 0 STW - >r call 12 fp-scratch v>operand \ tag get call ORI + \ tag-header get call tag-header 11 LI + 11 12 0 STW + >r call 12 11 \ tag get call ORI r> call 12 12 \ size get call ADDI ] bind save-allot-ptr ; inline M: float-regs (%replace) ( vreg loc reg-class -- ) - drop swap fp-scratch drop + drop swap [ v>operand 12 8 STFD ] - [ fp-scratch v>operand swap loc>operand STW ] H{ + [ 11 swap loc>operand STW ] H{ { tag-header [ float-tag ] } { tag [ float-tag ] } { size [ 16 ] } diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor index 2ad0b19643..f360098522 100644 --- a/library/compiler/x86/intrinsics-sse2.factor +++ b/library/compiler/x86/intrinsics-sse2.factor @@ -20,19 +20,21 @@ M: float-regs (%peek) ( vreg loc reg-class -- ) : inc-allot-ptr ( vreg n -- ) >r dup load-zone-ptr cell [+] r> ADD ; -: with-inline-alloc ( vreg prequot postquot spec -- ) +: with-inline-alloc ( prequot postquot spec -- ) #! both quotations are called with the vreg [ - >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 + EBX PUSH + EBX load-allot-ptr + EBX [] \ tag-header get call tag-header MOV + >r call EBX \ tag get call OR + r> call EBX \ size get call inc-allot-ptr + EBX POP ] bind ; inline M: float-regs (%replace) ( vreg loc reg-class -- ) - drop fp-scratch - [ 8 [+] rot v>operand MOVSD ] - [ >r v>operand r> MOV ] H{ + drop + [ EBX 8 [+] rot v>operand MOVSD ] + [ v>operand EBX MOV ] H{ { tag-header [ float-tag ] } { tag [ float-tag ] } { size [ 16 ] }