diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 9420a213ff..3ae4c2acc8 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,8 @@ should fix in 0.82: -- clean up/rewrite register allocation +- clean up fp-scratch - intrinsic fixnum>float float>fixnum +- update amd64 backend - amd64 %box-struct - when generating a 32-bit image on a 64-bit system, large numbers which should @@ -10,6 +11,7 @@ should fix in 0.82: + io: +- gdb triggers 'mutliple i/o ops on port' error - stream server can hang because of exception handler limitations - better i/o scheduler - yield in a loop starves i/o diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 348d5c208c..cbb2d3b72c 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -12,8 +12,7 @@ vectors words ; : parse-resource* ( path -- ) [ parse-resource ] catch [ dup error. - "Try again? [yn]" print - readln "yY" subseq? + "Try again? [yn]" print flush readln "yY" subseq? [ drop parse-resource* ] [ rethrow ] if ] when* ; diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor index f93b5e80c3..987cd6265a 100644 --- a/library/compiler/generator/architecture.factor +++ b/library/compiler/generator/architecture.factor @@ -64,10 +64,12 @@ DEFER: %inc-d ( n -- ) DEFER: %inc-r ( n -- ) ! Load stack into vreg -DEFER: %peek ( vreg loc -- ) +GENERIC: (%peek) ( vreg loc reg-class -- ) +: %peek ( vreg loc -- ) over (%peek) ; ! Store vreg to stack -DEFER: %replace ( vreg loc -- ) +GENERIC: (%replace) ( vreg loc reg-class -- ) +: %replace ( vreg loc -- ) over (%replace) ; ! Move one vreg to another DEFER: %move-int>int ( dst src -- ) diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor index 910acf2532..35f8fcf475 100644 --- a/library/compiler/generator/generator.factor +++ b/library/compiler/generator/generator.factor @@ -196,9 +196,8 @@ UNION: immediate fixnum POSTPONE: f ; : generate-push ( node -- ) >#push< dup length f dup requested-vregs ensure-vregs - alloc-vregs [ [ load-literal ] 2each ] keep - phantom-d get phantom-append - "fp-scratch" off ; + [ spec>vreg [ load-literal ] keep ] 2map + phantom-d get phantom-append ; M: #push generate-node ( #push -- ) generate-push iterate-next ; @@ -221,7 +220,7 @@ M: #push generate-node ( #push -- ) shuffle-in-r length neg phantom-r get adjust-phantom ; : shuffle-vregs# ( shuffle -- n ) - dup shuffle-in-d swap shuffle-in-r additional-vregs# ; + dup shuffle-in-d swap shuffle-in-r additional-vregs ; : phantom-shuffle ( shuffle -- ) dup shuffle-vregs# 0 ensure-vregs @@ -241,3 +240,8 @@ M: #return generate-node drop end-basic-block %return f ; : float-offset 8 float-tag - ; : string-offset 3 cells object-tag - ; + +: fp-scratch ( -- vreg ) + "fp-scratch" get [ + T{ int-regs } alloc-reg dup "fp-scratch" set + ] unless* ; diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor index 7e44856f60..88532d0299 100644 --- a/library/compiler/ppc/architecture.factor +++ b/library/compiler/ppc/architecture.factor @@ -5,7 +5,8 @@ USING: alien assembler generic kernel kernel-internals math memory namespaces sequences words ; ! PowerPC register assignments -! r3-r10 vregs +! r3-r10 integer vregs +! f0-f13 float vregs ! r11 linkage ! r14 data stack ! r15 call stack @@ -16,6 +17,7 @@ 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 } ; +M: float-regs vregs drop { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 } ; ! Mach-O -vs- Linux/PPC : stack@ macosx? 24 8 ? + ; @@ -27,7 +29,7 @@ M: ds-loc loc>operand ds-loc-n cells neg 14 swap ; M: cs-loc loc>operand cs-loc-n cells neg 15 swap ; M: immediate load-literal ( literal vreg -- ) - >r address r> v>operand LOAD ; + [ v>operand ] 2apply LOAD ; M: object load-literal ( literal vreg -- ) v>operand swap @@ -84,9 +86,50 @@ M: object load-literal ( literal vreg -- ) : %return ( -- ) %epilogue BLR ; -: %peek ( vreg loc -- ) >r v>operand r> loc>operand LWZ ; +: compile-dlsym ( symbol dll register -- ) + >r 2dup dlsym r> LOAD32 rel-2/2 rel-dlsym ; -: %replace ( vreg loc -- ) >r v>operand r> loc>operand STW ; +M: int-regs (%peek) ( vreg loc -- ) + drop >r v>operand r> loc>operand LWZ ; + +M: float-regs (%peek) ( vreg loc -- ) + drop 11 swap loc>operand LWZ + v>operand 11 float-offset LFD ; + +M: int-regs (%replace) ( vreg loc -- ) + drop >r v>operand r> loc>operand STW ; + +: %move-int>int ( dst src -- ) + [ v>operand ] 2apply MR ; + +: %move-int>float ( dst src -- ) + [ v>operand ] 2apply float-offset LFD ; + +: load-zone-ptr ( reg -- ) + "generations" f pick compile-dlsym dup 0 LWZ ; + +: load-allot-ptr ( -- ) 12 load-zone-ptr 12 12 cell LWZ ; + +: save-allot-ptr ( -- ) 11 load-zone-ptr 12 11 cell STW ; + +: with-inline-alloc ( vreg prequot postquot spec -- ) + #! both quotations are called with the vreg + load-allot-ptr [ + >r >r v>operand dup 12 MR + \ tag-header get call tag-header 11 LI + 11 12 0 STW + r> over slip dup dup \ 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 + [ >r v>operand r> 8 STFD ] + [ swap loc>operand STW ] H{ + { tag-header [ float-tag ] } + { tag [ float-tag ] } + { size [ 16 ] } + } with-inline-alloc ; : %inc-d ( n -- ) 14 14 rot cells ADDI ; @@ -118,11 +161,11 @@ M: stack-params stack>freg M: stack-params freg>stack >r stack-increment + swap r> stack>freg ; -: (%move) [ fastcall-regs nth ] keep ; +: %stack>freg ( n reg reg-class -- ) + [ fastcall-regs nth ] keep stack>freg ; -: %stack>freg ( n reg reg-class -- ) (%move) stack>freg ; - -: %freg>stack ( n reg reg-class -- ) (%move) freg>stack ; +: %freg>stack ( n reg reg-class -- ) + [ fastcall-regs nth ] keep freg>stack ; : %unbox ( n reg-class func -- ) ! Call the unboxer @@ -155,9 +198,6 @@ M: stack-params freg>stack : %box-struct ( n reg-class size -- ) "box_value_struct" struct-ptr/size ; -: compile-dlsym ( symbol dll register -- ) - >r 2dup dlsym r> LOAD32 rel-2/2 rel-dlsym ; - : %alien-invoke ( symbol dll -- ) 11 [ compile-dlsym ] keep MTLR BLRL ; diff --git a/library/compiler/ppc/assembler.factor b/library/compiler/ppc/assembler.factor index 2c64e2b6c8..30e5067675 100644 --- a/library/compiler/ppc/assembler.factor +++ b/library/compiler/ppc/assembler.factor @@ -16,6 +16,10 @@ USING: compiler errors generic kernel math memory words ; : insn ( operand opcode -- ) 26 shift bitor assemble-cell ; +: a-form ( d a b c xo rc -- n ) + >r 1 shift >r 6 shift >r 11 shift >r 16 shift >r 21 shift + r> bitor r> bitor r> bitor r> bitor r> bitor ; + : b-form ( bo bi bd aa lk -- n ) >r 1 shift >r 2 shift >r 16 shift >r 21 shift r> bitor r> bitor r> bitor r> bitor ; @@ -26,10 +30,6 @@ USING: compiler errors generic kernel math memory words ; : i-form ( li aa lk -- n ) >r 1 shift bitor r> bitor ; -: m-form ( s a b mb me -- n ) - >r 1 shift >r 6 shift >r 11 shift >r 16 shift >r 21 shift - r> bitor r> bitor r> bitor r> bitor r> bitor ; - : x-form ( a s b xo rc -- n ) swap >r 1 shift >r 11 shift >r swap 16 shift >r 21 shift @@ -144,7 +144,7 @@ USING: compiler errors generic kernel math memory words ; : CMP 0 0 x-form 31 insn ; : CMPL 0 32 x-form 31 insn ; -: (RLWINM) m-form 21 insn ; +: (RLWINM) a-form 21 insn ; : RLWINM 0 (RLWINM) ; : RLWINM. 1 (RLWINM) ; : SLWI 0 31 pick - RLWINM ; : SLWI. 0 31 pick - RLWINM. ; @@ -193,10 +193,31 @@ M: word BC >r 0 BC r> relative-2 ; >r dup -32768 32767 between? [ r> LI ] [ r> LOAD32 ] if ; ! Floating point -: (FMR) >r 0 -rot 72 r> x-form 63 insn ; -: FMR 0 (FMR) ; : FMR. 1 (FMR) ; - : LFS d-form 48 insn ; : LFSU d-form 49 insn ; : LFD d-form 50 insn ; : LFDU d-form 51 insn ; : STFS d-form 52 insn ; : STFSU d-form 53 insn ; : STFD d-form 54 insn ; : STFDU d-form 55 insn ; + +: (FMR) >r 0 -rot 72 r> x-form 63 insn ; +: FMR 0 (FMR) ; : FMR. 1 (FMR) ; + +: (FCTIWZ) >r 0 -rot 15 r> x-form 63 insn ; +: FCTIWZ 0 (FCTIWZ) ; : FCTIWZ. 1 (FCTIWZ) ; + +: (FADD) >r 0 21 r> a-form 63 insn ; +: FADD 0 (FADD) ; : FADD. 1 (FADD) ; + +: (FSUB) >r 0 20 r> a-form 63 insn ; +: FSUB 0 (FSUB) ; : FSUB. 1 (FSUB) ; + +: (FMUL) >r 0 swap 25 r> a-form 63 insn ; +: FMUL 0 (FMUL) ; : FMUL. 1 (FMUL) ; + +: (FDIV) >r 0 18 r> a-form 63 insn ; +: FDIV 0 (FDIV) ; : FDIV. 1 (FDIV) ; + +: (FSQRT) >r 0 swap 0 22 r> a-form 63 insn ; +: FSQRT 0 (FSQRT) ; : FSQRT. 1 (FSQRT) ; + +: FCMPU 0 0 x-form 63 insn ; +: FCMPO 0 32 x-form 63 insn ; diff --git a/library/compiler/ppc/intrinsics.factor b/library/compiler/ppc/intrinsics.factor index 9432aee2eb..b6da21f4bb 100644 --- a/library/compiler/ppc/intrinsics.factor +++ b/library/compiler/ppc/intrinsics.factor @@ -10,15 +10,6 @@ math-internals namespaces sequences words ; : untag-fixnum ( src dest -- ) tag-bits SRAWI ; -\ tag [ - "in" operand "out" operand tag-mask ANDI - "out" operand dup tag-fixnum -] H{ - { +input { { f "in" } } } - { +scratch { { f "out" } } } - { +output { "out" } } -} define-intrinsic - : generate-slot ( size quot -- ) >r >r ! turn tagged fixnum slot # into an offset, multiple of 4 @@ -80,7 +71,7 @@ math-internals namespaces sequences words ; { +clobber { "val" "slot" "obj" } } } define-intrinsic -: define-binary-op ( word op -- ) +: define-fixnum-op ( word op -- ) [ [ "x" operand "y" operand "x" operand ] % , ] [ ] make H{ { +input { { f "x" } { f "y" } } } { +output { "x" } } @@ -93,7 +84,7 @@ math-internals namespaces sequences words ; { fixnum-bitor OR } { fixnum-bitxor XOR } } [ - first2 define-binary-op + first2 define-fixnum-op ] each : generate-fixnum-mod @@ -120,7 +111,7 @@ math-internals namespaces sequences words ; { +output { "x" } } } define-intrinsic -: define-binary-jump ( word op -- ) +: define-fixnum-jump ( word op -- ) [ [ end-basic-block "x" operand 0 "y" operand CMP ] % , ] [ ] make H{ { +input { { f "x" } { f "y" } } } } @@ -133,38 +124,9 @@ math-internals namespaces sequences words ; { fixnum>= BGE } { eq? BEQ } } [ - first2 define-binary-jump + first2 define-fixnum-jump ] each -\ type [ -