From 05b49e15e0dfef5cc2e542c55fe4bc2558f6bfe3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 14:56:50 -0500 Subject: [PATCH 1/8] tools.time: remove unneeded math.vectors dependency --- basis/tools/time/time.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/tools/time/time.factor b/basis/tools/time/time.factor index 65e87f976f..948c0d482d 100644 --- a/basis/tools/time/time.factor +++ b/basis/tools/time/time.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.vectors memory io io.styles prettyprint +USING: kernel math memory io io.styles prettyprint namespaces system sequences splitting grouping assocs strings generic.single combinators ; IN: tools.time From 867ff51b83701440274f30b418aa4428903236f5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 14:57:17 -0500 Subject: [PATCH 2/8] Remove some unused constants and update an obsolete comment --- basis/cpu/x86/bootstrap.factor | 2 +- vm/cpu-x86.32.S | 1 - vm/cpu-x86.64.S | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index fcd8ed0eee..fc7fbc88b9 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -194,7 +194,7 @@ big-endian off [ ! Untag temp0 temp0 tag-mask get bitnot AND - ! Set temp1 to 0 for objects, and 8 for tuples + ! Set temp1 to 0 for objects, and bootstrap-cell for tuples temp1 1 tag-fixnum AND bootstrap-cell 4 = [ temp1 1 SHR ] when ! Load header cell or tuple layout cell diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index 3c0db36935..0c08ea7b46 100755 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -30,7 +30,6 @@ and the callstack top is passed in EDX */ pop %ebx #define QUOT_XT_OFFSET 16 -#define WORD_XT_OFFSET 30 /* We pass a function pointer to memcpy to work around a Mac OS X ABI limitation which would otherwise require us to do a bizzaro PC-relative diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S index a110bf1d51..5a70280ddf 100644 --- a/vm/cpu-x86.64.S +++ b/vm/cpu-x86.64.S @@ -62,7 +62,6 @@ #endif #define QUOT_XT_OFFSET 36 -#define WORD_XT_OFFSET 66 /* We pass a function pointer to memcpy to work around a Mac OS X ABI limitation which would otherwise require us to do a bizzaro PC-relative From 688cd9b79bacba079313a3a8aa91f61117c6a656 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 15:30:30 -0500 Subject: [PATCH 3/8] hashtables: use each-integer instead of iota ... each in >alist --- core/hashtables/hashtables.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 0914134bb6..03bc3e01fd 100644 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -139,14 +139,14 @@ M: hashtable set-at ( value key hash -- ) PRIVATE> M: hashtable >alist - [ array>> [ length 2/ iota ] keep ] [ assoc-size ] bi [ + [ array>> [ length 2/ ] keep ] [ assoc-size ] bi [ [ [ [ 1 fixnum-shift-fast ] dip [ array-nth ] [ [ 1 fixnum+fast ] dip array-nth ] 2bi ] dip pick tombstone? [ 3drop ] [ [ 2array ] dip push-unsafe ] if - ] 2curry each + ] 2curry each-integer ] keep { } like ; M: hashtable clone From bf887cf02854083cd2433aa9ce289d22cc70dc79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 15:30:52 -0500 Subject: [PATCH 4/8] cpu.ppc.bootstrap: working on polymorphic inline caching for PowerPC --- basis/cpu/ppc/bootstrap.factor | 108 +++++++++++++++++++++++++++++---- 1 file changed, 97 insertions(+), 11 deletions(-) diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 7278fd2092..5451cf2b79 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -9,8 +9,8 @@ IN: bootstrap.ppc 4 \ cell set big-endian on -CONSTANT: ds-reg 29 -CONSTANT: rs-reg 30 +CONSTANT: ds-reg 13 +CONSTANT: rs-reg 14 : factor-area-size ( -- n ) 4 bootstrap-cells ; @@ -138,6 +138,16 @@ CONSTANT: rs-reg 30 jit-3r> ] jit-3dip jit-define +: prepare-(execute) ( -- operand ) + 3 ds-reg 0 LWZ + ds-reg dup 4 SUBI + 4 3 word-xt-offset LWZ + 4 ; + +[ prepare-(execute) MTCTR BCTR ] jit-execute-jump jit-define + +[ prepare-(execute) MTLR BLRL ] jit-execute-call jit-define + [ 0 1 lr-save stack-frame + LWZ 1 1 stack-frame ADDI @@ -146,7 +156,91 @@ CONSTANT: rs-reg 30 [ BLR ] jit-return jit-define -! Sub-primitives +! ! ! Polymorphic inline caches + +! Load a value from a stack position +[ + 4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel +] pic-load jit-define + +! Tag +: load-tag ( -- ) + 4 4 tag-mask get ANDI + 4 4 tag-bits get SLWI ; + +[ load-tag ] pic-tag jit-define + +! Hi-tag +[ + 3 4 MR + load-tag + 0 4 object tag-number tag-fixnum CMPI + 2 BNE + 4 3 object tag-number neg LWZ +] pic-hi-tag jit-define + +! Tuple +[ + 3 4 MR + load-tag + 0 4 tuple tag-number tag-fixnum CMPI + 2 BNE + 4 3 tuple tag-number neg bootstrap-cell + LWZ +] pic-tuple jit-define + +! Hi-tag and tuple +[ + 3 4 MR + load-tag + ! If bits 2 and 3 are set, the tag is either 6 (object) or 7 (tuple) + 0 4 BIN: 110 tag-fixnum CMPI + 5 BLT + ! Untag r3 + 3 3 0 0 31 tag-bits get - RLWINM + ! Set r4 to 0 for objects, and bootstrap-cell for tuples + 4 4 1 tag-fixnum ANDI + 4 4 1 SRAWI + ! Load header cell or tuple layout cell + 4 4 3 LWZX +] pic-hi-tag-tuple jit-define + +[ + 0 4 0 CMPI rc-absolute-ppc-2 rt-immediate jit-rel +] pic-check-tag jit-define + +[ + 0 5 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel + 4 0 5 CMP +] pic-check jit-define + +[ 2 BNE 0 B rc-relative-ppc-3 rt-xt jit-rel ] pic-hit jit-define + +! ! ! Megamorphic caches + +[ + ! cache = ... + 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel + ! key = class + 5 4 MR + ! key &= cache.length - 1 + 5 5 mega-cache-size get 1- bootstrap-cell * ANDI + ! cache += array-start-offset + 3 3 array-start-offset ADDI + ! cache += key + 3 3 5 ADD + ! if(get(cache) == class) + 6 3 0 LWZ + 6 0 4 CMP + 5 BNE + ! ... goto get(cache + bootstrap-cell) + 3 3 4 LWZ + 3 3 word-xt-offset LWZ + 3 MTCTR + BCTR + ! fall-through on miss +] mega-lookup jit-define + +! ! ! Sub-primitives ! Quotations and words [ @@ -157,14 +251,6 @@ CONSTANT: rs-reg 30 BCTR ] \ (call) define-sub-primitive -[ - 3 ds-reg 0 LWZ - ds-reg dup 4 SUBI - 4 3 word-xt-offset LWZ - 4 MTCTR - BCTR -] \ (execute) define-sub-primitive - ! Objects [ 3 ds-reg 0 LWZ From 49409b4d8cf10ee7f11fed366f8800e7593758e3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 15:39:03 -0500 Subject: [PATCH 5/8] Working on PowerPC backend --- basis/cpu/ppc/ppc.factor | 25 +++++++------ vm/cpu-ppc.S | 76 ++++++++++++++++++++++------------------ vm/cpu-ppc.hpp | 60 ++++++++++++++++++++++++++----- vm/inline_cache.cpp | 2 ++ 4 files changed, 107 insertions(+), 56 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 85bf188bb8..a6beb42399 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -1,20 +1,19 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs sequences kernel combinators make math math.order math.ranges system namespaces locals layouts words -alien alien.c-types cpu.architecture cpu.ppc.assembler -compiler.cfg.registers compiler.cfg.instructions +alien alien.c-types literals cpu.architecture cpu.ppc.assembler +literals compiler.cfg.registers compiler.cfg.instructions compiler.constants compiler.codegen compiler.codegen.fixup compiler.cfg.intrinsics compiler.cfg.stack-frame ; IN: cpu.ppc ! PowerPC register assignments: -! r2-r27: integer vregs -! r28: integer scratch -! r29: data stack -! r30: retain stack +! r2-r12: integer vregs +! r15-r29 +! r30: integer scratch ! f0-f29: float vregs -! f30, f31: float scratch +! f30: float scratch enable-float-intrinsics @@ -23,11 +22,11 @@ enable-float-intrinsics M: ppc machine-registers { - { int-regs T{ range f 2 26 1 } } - { double-float-regs T{ range f 0 29 1 } } + { int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] } + { double-float-regs $[ 0 29 [a,b] ] } } ; -CONSTANT: scratch-reg 28 +CONSTANT: scratch-reg 30 CONSTANT: fp-scratch-reg 30 M: ppc two-operand? f ; @@ -40,8 +39,8 @@ M: ppc %load-reference ( reg obj -- ) M: ppc %alien-global ( register symbol dll -- ) [ 0 swap LOAD32 ] 2dip rc-absolute-ppc-2/2 rel-dlsym ; -CONSTANT: ds-reg 29 -CONSTANT: rs-reg 30 +CONSTANT: ds-reg 13 +CONSTANT: rs-reg 14 GENERIC: loc-reg ( loc -- reg ) diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S index 5e77c004aa..f8dad4b2b2 100755 --- a/vm/cpu-ppc.S +++ b/vm/cpu-ppc.S @@ -2,7 +2,7 @@ in the public domain. */ #include "asm.h" -#define DS_REG r29 +#define DS_REG r13 DEF(void,primitive_fixnum_add,(void)): lwz r3,0(DS_REG) @@ -45,7 +45,7 @@ multiply_overflow: /* Note that the XT is passed to the quotation in r11 */ #define CALL_OR_JUMP_QUOT \ - lwz r11,14(r3) /* load quotation-xt slot */ XX \ + lwz r11,16(r3) /* load quotation-xt slot */ XX \ #define CALL_QUOT \ CALL_OR_JUMP_QUOT XX \ @@ -100,22 +100,22 @@ the Factor compiler treats the entire register file as volatile. */ DEF(void,c_to_factor,(CELL quot)): PROLOGUE - SAVE_INT(r13,0) /* save GPRs */ - SAVE_INT(r14,1) - SAVE_INT(r15,2) - SAVE_INT(r16,3) - SAVE_INT(r17,4) - SAVE_INT(r18,5) - SAVE_INT(r19,6) - SAVE_INT(r20,7) - SAVE_INT(r21,8) - SAVE_INT(r22,9) - SAVE_INT(r23,10) - SAVE_INT(r24,11) - SAVE_INT(r25,12) - SAVE_INT(r26,13) - SAVE_INT(r27,14) - SAVE_INT(r28,15) + SAVE_INT(r15,0) /* save GPRs */ + SAVE_INT(r16,1) + SAVE_INT(r17,2) + SAVE_INT(r18,3) + SAVE_INT(r19,4) + SAVE_INT(r20,5) + SAVE_INT(r21,6) + SAVE_INT(r22,7) + SAVE_INT(r23,8) + SAVE_INT(r24,9) + SAVE_INT(r25,10) + SAVE_INT(r26,11) + SAVE_INT(r27,12) + SAVE_INT(r28,13) + SAVE_INT(r29,14) + SAVE_INT(r30,15) SAVE_INT(r31,16) SAVE_FP(f14,20) /* save FPRs */ @@ -165,22 +165,22 @@ DEF(void,c_to_factor,(CELL quot)): RESTORE_FP(f14,20) /* save FPRs */ RESTORE_INT(r31,16) /* restore GPRs */ - RESTORE_INT(r28,15) - RESTORE_INT(r27,14) - RESTORE_INT(r26,13) - RESTORE_INT(r25,12) - RESTORE_INT(r24,11) - RESTORE_INT(r23,10) - RESTORE_INT(r22,9) - RESTORE_INT(r21,8) - RESTORE_INT(r20,7) - RESTORE_INT(r19,6) - RESTORE_INT(r18,5) - RESTORE_INT(r17,4) - RESTORE_INT(r16,3) - RESTORE_INT(r15,2) - RESTORE_INT(r14,1) - RESTORE_INT(r13,0) + RESTORE_INT(r30,15) + RESTORE_INT(r29,14) + RESTORE_INT(r28,13) + RESTORE_INT(r27,12) + RESTORE_INT(r26,11) + RESTORE_INT(r25,10) + RESTORE_INT(r24,9) + RESTORE_INT(r23,8) + RESTORE_INT(r22,7) + RESTORE_INT(r21,6) + RESTORE_INT(r20,5) + RESTORE_INT(r19,4) + RESTORE_INT(r18,3) + RESTORE_INT(r17,2) + RESTORE_INT(r16,1) + RESTORE_INT(r15,0) EPILOGUE blr @@ -234,3 +234,11 @@ DEF(void,flush_icache,(void *start, int len)): sync /* finish up */ isync blr + +DEF(void,primitive_inline_cache_miss,(void)): + mflr r3 + PROLOGUE + bl MANGLE(inline_cache_miss) + EPILOGUE + mtctr r3 + bctr diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp index 7e8ae05fac..d393223d8d 100755 --- a/vm/cpu-ppc.hpp +++ b/vm/cpu-ppc.hpp @@ -2,16 +2,58 @@ namespace factor { #define FACTOR_CPU_STRING "ppc" -#define VM_ASM_API +#define VM_ASM_API VM_C_API -register cell ds asm("r29"); -register cell rs asm("r30"); +register cell ds asm("r13"); +register cell rs asm("r14"); -void c_to_factor(cell quot); -void undefined(cell word); -void set_callstack(stack_frame *to, stack_frame *from, cell length, void *memcpy); -void throw_impl(cell quot, stack_frame *rewind); -void lazy_jit_compile(cell quot); -void flush_icache(cell start, cell len); +inline static void check_call_site(cell return_address) +{ +#ifdef FACTOR_DEBUG + cell insn = *(cell *)return_address; + assert((insn & 0x3) == 0x1); + assert((insn >> 26) == 0x12); +#endif +} + +#define B_MASK 0x3fffffc + +inline static void *get_call_target(cell return_address) +{ + return_address -= sizeof(cell); + + check_call_site(return_address); + cell insn = *(cell *)return_address; + cell unsigned_addr = (insn & B_MASK); + fixnum signed_addr = (fixnum)(unsigned_addr << 6) >> 6; + return (void *)(signed_addr + return_address); +} + +inline static void set_call_target(cell return_address, void *target) +{ + return_address -= sizeof(cell); + +#ifdef FACTOR_DEBUG + assert((return_address & ~B_MASK) == 0); + check_call_site(return_address); +#endif + cell insn = *(cell *)return_address; + insn = ((insn & ~B_MASK) | (((cell)target - return_address) & B_MASK)); + *(cell *)return_address = insn; + + /* Flush the cache line containing the call we just patched */ + __asm__ __volatile__ ("icbi 0, %0\n" "sync\n"::"r" (return_address):); +} + +/* Defined in assembly */ +VM_ASM_API void c_to_factor(cell quot); +VM_ASM_API void throw_impl(cell quot, stack_frame *rewind); +VM_ASM_API void lazy_jit_compile(cell quot); +VM_ASM_API void flush_icache(cell start, cell len); + +VM_ASM_API void set_callstack(stack_frame *to, + stack_frame *from, + cell length, + void *(*memcpy)(void*,const void*, size_t)); } diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 259a3e0c77..59632c4185 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -21,6 +21,8 @@ void deallocate_inline_cache(cell return_address) { /* Find the call target. */ void *old_xt = get_call_target(return_address); + check_code_pointer((cell)old_xt); + code_block *old_block = (code_block *)old_xt - 1; cell old_type = old_block->type; From 215d21c2bd0104a71da7da0cc37406c52266ae16 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 6 May 2009 15:49:29 -0500 Subject: [PATCH 6/8] rename perlin-noise to noise; add words for uniform and normal noise --- .../noise.factor} | 62 +++++++++++++++---- 1 file changed, 50 insertions(+), 12 deletions(-) rename extra/{perlin-noise/perlin-noise.factor => noise/noise.factor} (55%) diff --git a/extra/perlin-noise/perlin-noise.factor b/extra/noise/noise.factor similarity index 55% rename from extra/perlin-noise/perlin-noise.factor rename to extra/noise/noise.factor index 0a12eef12c..f2ca8ad59b 100644 --- a/extra/perlin-noise/perlin-noise.factor +++ b/extra/noise/noise.factor @@ -1,11 +1,14 @@ -USING: byte-arrays combinators images kernel locals math math.affine-transforms -math.functions math.polynomials math.vectors random sequences -sequences.product ; -IN: perlin-noise +USING: byte-arrays combinators fry images kernel locals math +math.affine-transforms math.functions math.order +math.polynomials math.vectors random random.mersenne-twister +sequences sequences.product ; +IN: noise -: ( -- table ) +: ( -- table ) 256 iota >byte-array randomize dup append ; + ] dip with-random ; inline + +: >byte-map ( floats -- bytes ) + [ 255.0 * >fixnum ] B{ } map-as ; + +: >image ( bytes dim -- image ) + swap [ L f ] dip image boa ; + +PRIVATE> + +:: perlin-noise ( table point -- value ) point unit-cube :> cube point dup vfloor v- :> gradients gradients fade :> faded @@ -70,14 +84,38 @@ IN: perlin-noise [ faded second lerp ] 2bi@ faded third lerp ; -: noise-map ( table transform dim -- map ) - [ iota ] map [ a.v 0.0 suffix noise ] with with product-map ; - : normalize-0-1 ( sequence -- sequence' ) [ supremum ] [ infimum [ - ] keep ] [ ] tri [ swap - ] with map [ swap / ] with map ; -: noise-image ( table transform dim -- image ) - [ noise-map normalize-0-1 [ 255.0 * >fixnum ] B{ } map-as ] - [ swap [ L f ] dip image boa ] bi ; +: clamp-0-1 ( sequence -- sequence' ) + [ 0.0 max 1.0 min ] map ; +: perlin-noise-map ( table transform dim -- map ) + [ iota ] map [ a.v 0.0 suffix perlin-noise ] with with product-map ; + +: perlin-noise-byte-map ( table transform dim -- map ) + perlin-noise-map normalize-0-1 >byte-map ; + +: perlin-noise-image ( table transform dim -- image ) + [ perlin-noise-byte-map ] [ >image ] bi ; + +: uniform-noise-map ( seed dim -- map ) + [ product [ 0.0 1.0 uniform-random-float ] replicate ] + curry with-seed ; + +: uniform-noise-byte-map ( seed dim -- map ) + uniform-noise-map >byte-map ; + +: uniform-noise-image ( seed dim -- image ) + [ uniform-noise-byte-map ] [ >image ] bi ; + +: normal-noise-map ( seed sigma dim -- map ) + swap '[ _ product [ 0.5 _ normal-random-float ] replicate ] + with-seed ; + +: normal-noise-byte-map ( seed sigma dim -- map ) + normal-noise-map clamp-0-1 >byte-map ; + +: normal-noise-image ( seed sigma dim -- image ) + [ normal-noise-byte-map ] [ >image ] bi ; From c93d8760752ad31937ea2a19ce4f2c6da63ad43d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 16:14:53 -0500 Subject: [PATCH 7/8] Better separation of concerns: cpu.{x86,ppc}.assembler no longer depends on compiler.codegen.fixup and cpu.architecture. Rename rt-xt-direct to rt-xt-pic to better explain its purpose --- basis/compiler/codegen/codegen.factor | 2 +- basis/compiler/codegen/fixup/fixup.factor | 4 +-- basis/compiler/constants/constants.factor | 2 +- basis/cpu/architecture/architecture.factor | 1 + basis/cpu/ppc/assembler/assembler.factor | 4 +-- .../cpu/ppc/assembler/backend/backend.factor | 14 +++------ basis/cpu/ppc/bootstrap.factor | 2 +- basis/cpu/ppc/ppc.factor | 13 ++++++-- basis/cpu/x86/32/32.factor | 4 +-- basis/cpu/x86/32/bootstrap.factor | 2 +- basis/cpu/x86/assembler/assembler.factor | 30 +++++-------------- basis/cpu/x86/bootstrap.factor | 16 +++++----- basis/cpu/x86/x86.factor | 9 ++++-- 13 files changed, 48 insertions(+), 55 deletions(-) diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 826fa87b73..47593878fa 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -88,7 +88,7 @@ M: ##call generate-insn word>> dup sub-primitive>> [ first % ] [ [ add-call ] [ %call ] bi ] ?if ; -M: ##jump generate-insn word>> [ add-call ] [ %jump-label ] bi ; +M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ; M: ##return generate-insn drop %return ; diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index 99f258d93c..b52bb51b26 100755 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -56,8 +56,8 @@ SYMBOL: literal-table : rel-word ( word class -- ) [ add-literal ] dip rt-xt rel-fixup ; -: rel-word-direct ( word class -- ) - [ add-literal ] dip rt-xt-direct rel-fixup ; +: rel-word-pic ( word class -- ) + [ add-literal ] dip rt-xt-pic rel-fixup ; : rel-primitive ( word class -- ) [ def>> first add-literal ] dip rt-primitive rel-fixup ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index e30cc10ee2..886933b5cd 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -42,7 +42,7 @@ CONSTANT: rt-primitive 0 CONSTANT: rt-dlsym 1 CONSTANT: rt-dispatch 2 CONSTANT: rt-xt 3 -CONSTANT: rt-xt-direct 4 +CONSTANT: rt-xt-pic 4 CONSTANT: rt-here 5 CONSTANT: rt-this 6 CONSTANT: rt-immediate 7 diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 2c9675426b..de5d1da4e0 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -47,6 +47,7 @@ HOOK: %inc-r cpu ( n -- ) HOOK: stack-frame-size cpu ( stack-frame -- n ) HOOK: %call cpu ( word -- ) +HOOK: %jump cpu ( word -- ) HOOK: %jump-label cpu ( label -- ) HOOK: %return cpu ( -- ) diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index fbb878a888..2daf3678ce 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: compiler.codegen.fixup kernel namespaces words -io.binary math math.order cpu.ppc.assembler.backend ; +USING: kernel namespaces words io.binary math math.order +cpu.ppc.assembler.backend ; IN: cpu.ppc.assembler ! See the Motorola or IBM documentation for details. The opcode diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor index 946aca6990..1e6365b1e7 100644 --- a/basis/cpu/ppc/assembler/backend/backend.factor +++ b/basis/cpu/ppc/assembler/backend/backend.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: compiler.codegen.fixup cpu.architecture -compiler.constants kernel namespaces make sequences words math -math.bitwise io.binary parser lexer ; +USING: kernel namespaces make sequences words math +math.bitwise io.binary parser lexer fry ; IN: cpu.ppc.assembler.backend : insn ( operand opcode -- ) { 26 0 } bitfield 4 >be % ; @@ -74,21 +73,16 @@ SYNTAX: XO1: (XO) (1) (( a s -- )) define-declared ; GENERIC# (B) 2 ( dest aa lk -- ) M: integer (B) 18 i-insn ; -M: word (B) [ 0 ] 2dip (B) rc-relative-ppc-3 rel-word ; -M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ; GENERIC: BC ( a b c -- ) M: integer BC 0 0 16 b-insn ; -M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ; -M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ; : CREATE-B ( -- word ) scan "B" prepend create-in ; SYNTAX: BC: CREATE-B scan-word scan-word - [ rot BC ] 2curry (( c -- )) define-declared ; + '[ [ _ _ ] dip BC ] (( c -- )) define-declared ; SYNTAX: B: CREATE-B scan-word scan-word scan-word scan-word scan-word - [ b-insn ] curry curry curry curry curry - (( bo -- )) define-declared ; + '[ _ _ _ _ _ b-insn ] (( bo -- )) define-declared ; diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 5451cf2b79..8001868e0c 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -58,7 +58,7 @@ CONSTANT: rs-reg 14 BCTR ] jit-primitive jit-define -[ 0 BL rc-relative-ppc-3 rt-xt-direct jit-rel ] jit-word-call jit-define +[ 0 BL rc-relative-ppc-3 rt-xt-pic jit-rel ] jit-word-call jit-define [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-jump jit-define diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index a6beb42399..c239bacbc0 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -15,10 +15,16 @@ IN: cpu.ppc ! f0-f29: float vregs ! f30: float scratch +! Add some methods to the assembler that are useful to us +M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ; +M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ; + enable-float-intrinsics -<< \ ##integer>float t frame-required? set-word-prop -\ ##float>integer t frame-required? set-word-prop >> +<< +\ ##integer>float t frame-required? set-word-prop +\ ##float>integer t frame-required? set-word-prop +>> M: ppc machine-registers { @@ -107,7 +113,8 @@ M: ppc stack-frame-size ( stack-frame -- i ) factor-area-size + 4 cells align ; -M: ppc %call ( label -- ) BL ; +M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ; +M: ppc %jump ( word -- ) 0 B rc-relative-ppc-3 rel-word ; M: ppc %jump-label ( label -- ) B ; M: ppc %return ( -- ) BLR ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 10cd9c8657..376edeb202 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -44,9 +44,9 @@ M: x86.32 param-reg-2 EDX ; M: x86.32 reserved-area-size 0 ; -M: x86.32 %alien-invoke (CALL) rel-dlsym ; +M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; -M: x86.32 %alien-invoke-tail (JMP) rel-dlsym ; +M: x86.32 %alien-invoke-tail 0 JMP rc-relative rel-dlsym ; M: x86.32 return-struct-in-registers? ( c-type -- ? ) c-type diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index be21344815..660a428dfb 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -29,7 +29,7 @@ IN: bootstrap.x86 ] jit-save-stack jit-define [ - (JMP) drop rc-relative rt-primitive jit-rel + 0 JMP rc-relative rt-primitive jit-rel ] jit-primitive jit-define << "vocab:cpu/x86/bootstrap.factor" parse-file parsed >> diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index 5560d17a1e..2b40aa2053 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -1,12 +1,11 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays cpu.architecture compiler.constants -compiler.codegen.fixup io.binary kernel combinators -kernel.private math namespaces make sequences words system -layouts math.order accessors cpu.x86.assembler.syntax ; +USING: arrays io.binary kernel combinators +kernel.private math namespaces make sequences words system layouts +math.order accessors cpu.x86.assembler.syntax ; IN: cpu.x86.assembler -! A postfix assembler for x86 and AMD64. +! A postfix assembler for x86-32 and x86-64. ! In 32-bit mode, { 1234 } is absolute indirect addressing. ! In 64-bit mode, { 1234 } is RIP-relative. @@ -296,36 +295,23 @@ M: operand (MOV-I) { BIN: 000 t HEX: c6 } pick byte? [ immediate-1 ] [ immediate-4 ] if ; -PREDICATE: callable < word register? not ; - GENERIC: MOV ( dst src -- ) M: immediate MOV swap (MOV-I) ; -M: callable MOV [ 0 ] 2dip (MOV-I) rc-absolute-cell rel-word ; M: operand MOV HEX: 88 2-operand ; : LEA ( dst src -- ) swap HEX: 8d 2-operand ; ! Control flow GENERIC: JMP ( op -- ) -: (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ; -M: f JMP (JMP) 2drop ; -M: callable JMP (JMP) rel-word ; -M: label JMP (JMP) label-fixup ; +M: integer JMP HEX: e9 , 4, ; M: operand JMP { BIN: 100 t HEX: ff } 1-operand ; GENERIC: CALL ( op -- ) -: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ; -M: f CALL (CALL) 2drop ; -M: callable CALL (CALL) rel-word-direct ; -M: label CALL (CALL) label-fixup ; +M: integer CALL HEX: e8 , 4, ; M: operand CALL { BIN: 010 t HEX: ff } 1-operand ; GENERIC# JUMPcc 1 ( addr opcode -- ) -: (JUMPcc) ( addr n -- rel-class ) extended-opcode, 4, rc-relative ; -M: f JUMPcc [ 0 ] dip (JUMPcc) 2drop ; -M: integer JUMPcc (JUMPcc) drop ; -M: callable JUMPcc [ 0 ] dip (JUMPcc) rel-word ; -M: label JUMPcc [ 0 ] dip (JUMPcc) label-fixup ; +M: integer JUMPcc extended-opcode, 4, ; : JO ( dst -- ) HEX: 80 JUMPcc ; : JNO ( dst -- ) HEX: 81 JUMPcc ; diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index fc7fbc88b9..4b409102c9 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -42,11 +42,11 @@ big-endian off ] jit-push-immediate jit-define [ - f JMP rc-relative rt-xt jit-rel + 0 JMP rc-relative rt-xt jit-rel ] jit-word-jump jit-define [ - f CALL rc-relative rt-xt-direct jit-rel + 0 CALL rc-relative rt-xt-pic jit-rel ] jit-word-call jit-define [ @@ -57,12 +57,12 @@ big-endian off ! compare boolean with f temp0 \ f tag-number CMP ! jump to true branch if not equal - f JNE rc-relative rt-xt jit-rel + 0 JNE rc-relative rt-xt jit-rel ] jit-if-1 jit-define [ ! jump to false branch if equal - f JMP rc-relative rt-xt jit-rel + 0 JMP rc-relative rt-xt jit-rel ] jit-if-2 jit-define : jit->r ( -- ) @@ -115,19 +115,19 @@ big-endian off [ jit->r - f CALL rc-relative rt-xt jit-rel + 0 CALL rc-relative rt-xt jit-rel jit-r> ] jit-dip jit-define [ jit-2>r - f CALL rc-relative rt-xt jit-rel + 0 CALL rc-relative rt-xt jit-rel jit-2r> ] jit-2dip jit-define [ jit-3>r - f CALL rc-relative rt-xt jit-rel + 0 CALL rc-relative rt-xt jit-rel jit-3r> ] jit-3dip jit-define @@ -211,7 +211,7 @@ big-endian off temp1 temp2 CMP ] pic-check jit-define -[ f JE rc-relative rt-xt jit-rel ] pic-hit jit-define +[ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define ! ! ! Megamorphic caches diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 2859e71be2..d508d7740b 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -11,6 +11,10 @@ IN: cpu.x86 << enable-fixnum-log2 >> +! Add some methods to the assembler to be more useful to the backend +M: label JMP 0 JMP rc-relative label-fixup ; +M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ; + M: x86 two-operand? t ; HOOK: temp-reg-1 cpu ( -- reg ) @@ -53,8 +57,9 @@ M: x86 stack-frame-size ( stack-frame -- i ) reserved-area-size + align-stack ; -M: x86 %call ( label -- ) CALL ; -M: x86 %jump-label ( label -- ) JMP ; +M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ; +M: x86 %jump ( word -- ) 0 JMP rc-relative rel-word ; +M: x86 %jump-label ( label -- ) 0 JMP rc-relative label-fixup ; M: x86 %return ( -- ) 0 RET ; : code-alignment ( align -- n ) From fbb17ea7afcd7187297528846be0eae1c20d465d Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 6 May 2009 17:26:21 -0500 Subject: [PATCH 8/8] uniform-random-float speed --- basis/random/random.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/random/random.factor b/basis/random/random.factor index e3f1ecccb9..6b02c8a3e8 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -3,7 +3,7 @@ USING: alien.c-types kernel math namespaces sequences io.backend io.binary combinators system vocabs.loader summary math.bitwise byte-vectors fry byte-arrays -math.ranges math.constants math.functions ; +math.ranges math.constants math.functions accessors ; IN: random SYMBOL: system-random-generator @@ -70,8 +70,11 @@ PRIVATE> secure-random-generator get swap with-random ; inline : uniform-random-float ( min max -- n ) - 64 random-bits >float [ over - 2.0 -64 ^ * ] dip - * + ; + 4 random-bytes underlying>> *uint >float + 4 random-bytes underlying>> *uint >float + 2.0 32 ^ * + + [ over - 2.0 -64 ^ * ] dip + * + ; inline : normal-random-float ( mean sigma -- n ) 0.0 1.0 uniform-random-float