From 25886ff453f414a0a39d72ae85c8e22aa8630f0f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 19:40:25 -0500 Subject: [PATCH 01/10] cpu.ppc.bootstrap: updates --- basis/cpu/ppc/bootstrap.factor | 42 ++++++++++++++++++++-------------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 6a00dec12f..b09938f4b9 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -21,43 +21,48 @@ CONSTANT: rs-reg 14 : xt-save ( -- n ) stack-frame 2 bootstrap-cells - ; [ - 0 6 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel - 11 6 profile-count-offset LWZ + 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel + 11 3 profile-count-offset LWZ 11 11 1 tag-fixnum ADDI - 11 6 profile-count-offset STW - 11 6 word-code-offset LWZ + 11 3 profile-count-offset STW + 11 3 word-code-offset LWZ 11 11 compiled-header-size ADDI 11 MTCTR BCTR ] jit-profiling jit-define [ - 0 6 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel + 0 3 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel 0 MFLR 1 1 stack-frame SUBI - 6 1 xt-save STW - stack-frame 6 LI - 6 1 next-save STW + 3 1 xt-save STW + stack-frame 3 LI + 3 1 next-save STW 0 1 lr-save stack-frame + STW ] jit-prolog jit-define [ - 0 6 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel - 6 ds-reg 4 STWU + 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel + 3 ds-reg 4 STWU ] jit-push-immediate jit-define [ - 0 6 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel - 7 6 0 LWZ - 1 7 0 STW - 0 6 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel - 6 MTCTR + 0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel + 4 3 0 LWZ + 1 4 0 STW + 0 3 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel + 3 MTCTR BCTR ] jit-primitive 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 +[ + 0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel + 0 B rc-relative-ppc-3 rt-xt-pic-tail jit-rel +] jit-word-jump jit-define + +[ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-special jit-define [ 3 ds-reg 0 LWZ @@ -152,6 +157,9 @@ CONSTANT: rs-reg 14 ! ! ! Polymorphic inline caches +! Don't touch r6 here; it's used to pass the tail call site +! address for tail PICs + ! Load a value from a stack position [ 4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel @@ -225,7 +233,7 @@ CONSTANT: rs-reg 14 ! if(get(cache) == class) 6 3 0 LWZ 6 0 4 CMP - 5 BNE + 10 BNE ! megamorphic_cache_hits++ 0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel 5 4 0 LWZ From a8231893ec73151cedfc56e5b298b0a51e649842 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 7 May 2009 19:46:42 -0500 Subject: [PATCH 02/10] un-private some useful words --- basis/opengl/textures/textures.factor | 26 ++++++++++++++------------ extra/noise/noise.factor | 6 +++--- 2 files changed, 17 insertions(+), 15 deletions(-) diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index d103e90bee..49725d2242 100755 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -39,6 +39,8 @@ SLOT: display-list GENERIC: draw-scaled-texture ( dim texture -- ) +DEFER: make-texture + > first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri glTexSubImage2D ; -: make-texture ( image -- id ) - #! We use glTexSubImage2D to work around the power of 2 texture size - #! limitation - gen-texture [ - GL_TEXTURE_BIT [ - GL_TEXTURE_2D swap glBindTexture - non-power-of-2-textures? get - [ dup bitmap>> (tex-image) ] - [ [ f (tex-image) ] [ (tex-sub-image) ] bi ] if - ] do-attribs - ] keep ; - : init-texture ( -- ) GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri @@ -176,6 +166,18 @@ CONSTANT: max-texture-size { 512 512 } PRIVATE> +: make-texture ( image -- id ) + #! We use glTexSubImage2D to work around the power of 2 texture size + #! limitation + gen-texture [ + GL_TEXTURE_BIT [ + GL_TEXTURE_2D swap glBindTexture + non-power-of-2-textures? get + [ dup bitmap>> (tex-image) ] + [ [ f (tex-image) ] [ (tex-sub-image) ] bi ] if + ] do-attribs + ] keep ; + : ( image loc -- texture ) over dim>> max-texture-size [ <= ] 2all? [ ] diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index f2ca8ad59b..c28768283c 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -7,6 +7,9 @@ IN: noise : ( -- table ) 256 iota >byte-array randomize dup append ; +: with-seed ( seed quot -- ) + [ ] dip with-random ; inline + ] dip with-random ; inline - : >byte-map ( floats -- bytes ) [ 255.0 * >fixnum ] B{ } map-as ; From 2ba187210eef72382a91f4eadc684dc14810ffa5 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 7 May 2009 19:47:05 -0500 Subject: [PATCH 03/10] fix some faux pas in bunny --- extra/bunny/model/model.factor | 2 +- extra/bunny/outlined/outlined.factor | 2 +- extra/opengl/demo-support/demo-support.factor | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 0009e39fa7..3871936902 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -89,7 +89,7 @@ M: bunny-buffers bunny-geom GL_FLOAT 0 0 buffer-offset glNormalPointer [ nv>> "float" heap-size * buffer-offset - 3 GL_FLOAT 0 roll glVertexPointer + [ 3 GL_FLOAT 0 ] dip glVertexPointer ] [ ni>> GL_TRIANGLES swap GL_UNSIGNED_INT 0 buffer-offset glDrawElements diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 0ad2a72100..7d614ff947 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -120,7 +120,7 @@ TUPLE: bunny-outlined : outlining-supported? ( -- ? ) "2.0" { - "GL_ARB_shading_objects" + "GL_ARB_shader_objects" "GL_ARB_draw_buffers" "GL_ARB_multitexture" } has-gl-version-or-extensions? { diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 35c64d4ad1..8afbd52647 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -1,9 +1,9 @@ USING: arrays kernel math math.functions math.order math.vectors namespaces opengl opengl.gl sequences ui ui.gadgets ui.gestures -ui.gadgets.worlds ui.render accessors combinators ; +ui.gadgets.worlds ui.render accessors combinators literals ; IN: opengl.demo-support -: FOV ( -- x ) 2.0 sqrt 1+ ; inline +CONSTANT: FOV $[ 2.0 sqrt 1+ ] CONSTANT: MOUSE-MOTION-SCALE 0.5 CONSTANT: KEY-ROTATE-STEP 10.0 From 01546acb1c81de595de2535e6ab25ca309aea34e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 7 May 2009 19:47:26 -0500 Subject: [PATCH 04/10] typo in cocoa pixel format stuff --- basis/ui/backend/cocoa/cocoa.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 5b1b4b0c2a..ef5c80dcdb 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -29,7 +29,7 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{ { fullscreen { $ NSOpenGLPFAFullScreen } } { windowed { $ NSOpenGLPFAWindow } } { accelerated { $ NSOpenGLPFAAccelerated } } - { software-rendered { $ NSOpenGLPFASingleRenderer $ kCGLRendererGenericFloatID } } + { software-rendered { $ NSOpenGLPFARendererID $ kCGLRendererGenericFloatID } } { backing-store { $ NSOpenGLPFABackingStore } } { multisampled { $ NSOpenGLPFAMultisample } } { supersampled { $ NSOpenGLPFASupersample } } From e833349ff8f2fdbf8221f020137953522e1fb8b4 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 7 May 2009 19:53:56 -0500 Subject: [PATCH 05/10] slow, ugly, unoptimized terrain generation demo --- extra/game-loop/game-loop.factor | 4 +- extra/terrain/generation/generation.factor | 60 +++++++ extra/terrain/shaders/shaders.factor | 46 +++++ extra/terrain/terrain.factor | 190 +++++++++++++++++++++ 4 files changed, 298 insertions(+), 2 deletions(-) create mode 100644 extra/terrain/generation/generation.factor create mode 100644 extra/terrain/shaders/shaders.factor create mode 100644 extra/terrain/terrain.factor diff --git a/extra/game-loop/game-loop.factor b/extra/game-loop/game-loop.factor index 8e7c7017d4..8abbe6ba25 100644 --- a/extra/game-loop/game-loop.factor +++ b/extra/game-loop/game-loop.factor @@ -1,4 +1,4 @@ -USING: accessors destructors kernel math math.order namespaces +USING: accessors calendar destructors kernel math math.order namespaces system threads ; IN: game-loop @@ -50,7 +50,7 @@ CONSTANT: MAX-FRAMES-TO-SKIP 5 : (run-loop) ( loop -- ) dup running?>> - [ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ yield (run-loop) ] tri ] + [ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ 1 milliseconds sleep (run-loop) ] tri ] [ drop ] if ; : run-loop ( loop -- ) diff --git a/extra/terrain/generation/generation.factor b/extra/terrain/generation/generation.factor new file mode 100644 index 0000000000..18f73e8e8b --- /dev/null +++ b/extra/terrain/generation/generation.factor @@ -0,0 +1,60 @@ +USING: accessors arrays byte-arrays combinators fry grouping +images kernel math math.affine-transforms math.order +math.vectors noise random sequences ; +IN: terrain.generation + +CONSTANT: terrain-segment-size { 512 512 } +CONSTANT: terrain-big-noise-scale { 0.002 0.002 } +CONSTANT: terrain-small-noise-scale { 0.05 0.05 } + +TUPLE: terrain big-noise-table small-noise-table tiny-noise-seed ; + +: ( -- terrain ) + + 32 random-bits terrain boa ; + +: seed-at ( seed at -- seed' ) + first2 [ + ] dip [ 32 random-bits + ] curry with-seed ; + +: big-noise-segment ( terrain at -- map ) + [ big-noise-table>> terrain-big-noise-scale first2 ] dip + terrain-segment-size [ v* a. ] keep perlin-noise-byte-map ; +: small-noise-segment ( terrain at -- map ) + [ small-noise-table>> terrain-small-noise-scale first2 ] dip + terrain-segment-size [ v* a. ] keep perlin-noise-byte-map ; +: tiny-noise-segment ( terrain at -- map ) + [ tiny-noise-seed>> ] dip seed-at 0.1 + terrain-segment-size normal-noise-byte-map ; + +: padding ( terrain at -- padding ) + 2drop terrain-segment-size product 255 ; + +TUPLE: segment image ; + +: terrain-segment ( terrain at -- image ) + { + [ big-noise-segment ] + [ small-noise-segment ] + [ tiny-noise-segment ] + [ padding ] + } 2cleave + 4array flip concat >byte-array + [ terrain-segment-size RGBA f ] dip image boa ; + +: 4max ( a b c d -- max ) + max max max ; inline + +: mipmap ( {{pixels}} quot: ( aa ab ba bb -- c ) -- pixels' ) + [ [ 2 ] map 2 ] dip + '[ first2 [ [ first2 ] bi@ @ ] 2map ] map ; inline + +: group-pixels ( bitmap dim -- scanlines ) + [ 4 ] [ first ] bi* ; + +: concat-pixels ( scanlines -- bitmap ) + [ concat ] map concat ; + +: segment-mipmap ( image -- image' ) + [ clone ] [ bitmap>> ] [ dim>> ] tri + group-pixels [ 4max ] mipmap concat-pixels >>bitmap + [ 2 v/n ] change-dim ; diff --git a/extra/terrain/shaders/shaders.factor b/extra/terrain/shaders/shaders.factor new file mode 100644 index 0000000000..2dc793f078 --- /dev/null +++ b/extra/terrain/shaders/shaders.factor @@ -0,0 +1,46 @@ +USING: multiline ; +IN: terrain.shaders + +STRING: terrain-vertex-shader + +uniform sampler2D heightmap; + +varying vec2 heightcoords; + +const vec4 COMPONENT_SCALE = vec4(0.5, 0.01, 0.002, 0.0); + +float height(sampler2D map, vec2 coords) +{ + vec4 v = texture2D(map, coords); + return dot(v, COMPONENT_SCALE); +} + +void main() +{ + gl_Position = gl_ModelViewProjectionMatrix + * (gl_Vertex + vec4(0, height(heightmap, gl_Vertex.xz), 0, 0)); + heightcoords = gl_Vertex.xz; +} + +; + +STRING: terrain-pixel-shader + +uniform sampler2D heightmap; + +varying vec2 heightcoords; + +const vec4 COMPONENT_SCALE = vec4(0.5, 0.01, 0.002, 0.0); + +float height(sampler2D map, vec2 coords) +{ + vec4 v = texture2D(map, coords); + return dot(v, COMPONENT_SCALE); +} + +void main() +{ + gl_FragColor = texture2D(heightmap, heightcoords); +} + +; diff --git a/extra/terrain/terrain.factor b/extra/terrain/terrain.factor new file mode 100644 index 0000000000..725848abb7 --- /dev/null +++ b/extra/terrain/terrain.factor @@ -0,0 +1,190 @@ +USING: accessors arrays combinators game-input +game-input.scancodes game-loop kernel literals locals math +math.constants math.functions math.matrices math.order +math.vectors opengl opengl.capabilities opengl.gl +opengl.shaders opengl.textures opengl.textures.private +sequences sequences.product specialized-arrays.float +terrain.generation terrain.shaders ui ui.gadgets +ui.gadgets.worlds ui.pixel-formats ; +IN: terrain + +CONSTANT: FOV $[ 2.0 sqrt 1+ ] +CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ] +CONSTANT: FAR-PLANE 1.0 +CONSTANT: EYE-START { 0.5 0.5 1.2 } +CONSTANT: TICK-LENGTH $[ 1000 30 /i ] +CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ] +CONSTANT: MOVEMENT-SPEED $[ 1.0 512.0 / ] + +CONSTANT: terrain-vertex-size { 512 512 } +CONSTANT: terrain-vertex-distance { $[ 1.0 512.0 / ] $[ 1.0 512.0 / ] } +CONSTANT: terrain-vertex-row-length $[ 512 1 + 2 * ] + +TUPLE: terrain-world < world + eye yaw pitch + terrain terrain-segment terrain-texture terrain-program + terrain-vertex-buffer + game-loop ; + +: frustum ( dim -- -x x -y y near far ) + dup first2 min v/n + NEAR-PLANE FOV / v*n first2 [ [ neg ] keep ] bi@ + NEAR-PLANE FAR-PLANE ; + +: set-modelview-matrix ( gadget -- ) + GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear + GL_MODELVIEW glMatrixMode + glLoadIdentity + [ pitch>> 1.0 0.0 0.0 glRotatef ] + [ yaw>> 0.0 1.0 0.0 glRotatef ] + [ eye>> vneg first3 glTranslatef ] tri ; + +: vertex-array-vertex ( x z -- vertex ) + [ terrain-vertex-distance first * ] + [ terrain-vertex-distance second * ] bi* + [ 0 ] dip float-array{ } 3sequence ; + +: vertex-array-row ( z -- vertices ) + dup 1 + 2array + terrain-vertex-size first 1 + iota + 2array [ first2 swap vertex-array-vertex ] product-map + concat ; + +: vertex-array ( -- vertices ) + terrain-vertex-size second iota + [ vertex-array-row ] map concat ; + +: >vertex-buffer ( bytes -- buffer ) + [ GL_ARRAY_BUFFER ] dip GL_STATIC_DRAW ; + +: draw-vertex-buffer-row ( i -- ) + [ GL_TRIANGLE_STRIP ] dip + terrain-vertex-row-length * terrain-vertex-row-length + glDrawArrays ; + +: draw-vertex-buffer ( buffer -- ) + [ GL_ARRAY_BUFFER ] dip [ + 3 GL_FLOAT 0 f glVertexPointer + terrain-vertex-size second iota [ draw-vertex-buffer-row ] each + ] with-gl-buffer ; + +: degrees ( deg -- rad ) + pi 180.0 / * ; + +:: eye-rotate ( yaw pitch v -- v' ) + yaw degrees neg :> y + pitch degrees neg :> p + y cos :> cosy + y sin :> siny + p cos :> cosp + p sin :> sinp + + cosy 0.0 siny neg 3array + siny sinp * cosp cosy sinp * 3array + siny cosp * sinp neg cosy cosp * 3array 3array + v swap v.m ; + +: forward-vector ( world -- v ) + [ yaw>> ] [ pitch>> ] bi + { 0.0 0.0 $ MOVEMENT-SPEED } vneg eye-rotate ; +: rightward-vector ( world -- v ) + [ yaw>> ] [ pitch>> ] bi + { $ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ; + +: move-forward ( world -- ) + dup forward-vector [ v+ ] curry change-eye drop ; +: move-backward ( world -- ) + dup forward-vector [ v- ] curry change-eye drop ; +: move-leftward ( world -- ) + dup rightward-vector [ v- ] curry change-eye drop ; +: move-rightward ( world -- ) + dup rightward-vector [ v+ ] curry change-eye drop ; + +: rotate-with-mouse ( world mouse -- ) + [ dx>> MOUSE-SCALE * [ + ] curry change-yaw ] + [ dy>> MOUSE-SCALE * [ + ] curry change-pitch ] bi + drop ; + +:: handle-input ( world -- ) + read-keyboard keys>> :> keys + key-w keys nth [ world move-forward ] when + key-s keys nth [ world move-backward ] when + key-a keys nth [ world move-leftward ] when + key-d keys nth [ world move-rightward ] when + world read-mouse rotate-with-mouse + reset-mouse ; + +M: terrain-world tick* + [ handle-input ] keep + ! [ eye>> ] [ yaw>> ] [ pitch>> ] tri 3array P ! debug + drop ; + +M: terrain-world draw* + nip draw-world ; + +: set-heightmap-texture-parameters ( texture -- ) + GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit + GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri ; + +M: terrain-world begin-world + "2.0" { "GL_ARB_vertex_buffer_object" "GL_ARB_shader_objects" } + require-gl-version-or-extensions + GL_DEPTH_TEST glEnable + GL_TEXTURE_2D glEnable + GL_VERTEX_ARRAY glEnableClientState + 0.5 0.5 0.5 1.0 glClearColor + EYE-START >>eye + 0.0 >>yaw + 0.0 >>pitch + [ >>terrain ] keep + { 0 0 } terrain-segment [ >>terrain-segment ] keep + make-texture [ set-heightmap-texture-parameters ] keep >>terrain-texture + terrain-vertex-shader terrain-pixel-shader + >>terrain-program + vertex-array >vertex-buffer >>terrain-vertex-buffer + TICK-LENGTH over [ >>game-loop ] keep start-loop + reset-mouse + drop ; + +M: terrain-world end-world + { + [ game-loop>> stop-loop ] + [ terrain-vertex-buffer>> delete-gl-buffer ] + [ terrain-program>> delete-gl-program ] + [ terrain-texture>> delete-texture ] + } cleave ; + +M: terrain-world resize-world + GL_PROJECTION glMatrixMode + glLoadIdentity + dim>> [ [ 0 0 ] dip first2 glViewport ] + [ frustum glFrustum ] bi ; + +M: terrain-world draw-world* + [ set-modelview-matrix ] + [ terrain-texture>> GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit ] + [ dup terrain-program>> [ + "heightmap" glGetUniformLocation 0 glUniform1i + terrain-vertex-buffer>> draw-vertex-buffer + ] with-gl-program ] + tri gl-error ; + +M: terrain-world focusable-child* drop t ; +M: terrain-world pref-dim* drop { 640 480 } ; + +: terrain-window ( -- ) + [ + open-game-input + f T{ world-attributes + { world-class terrain-world } + { title "Terrain" } + { pixel-format-attributes { + windowed + double-buffered + T{ depth-bits { value 24 } } + } } + } open-window + ] with-ui ; From 5099046f9fdcc85649d92b4866de7617b4708ef9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 20:52:16 -0500 Subject: [PATCH 06/10] math.miller-rabin: make some utilities not private since math.primes uses them --- basis/math/miller-rabin/miller-rabin.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor index 9fd604a003..88c01d5271 100755 --- a/basis/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -5,8 +5,6 @@ random sequences sets combinators.short-circuit math.bitwise math math.order ; IN: math.miller-rabin -odd ( n -- int ) 0 set-bit ; foldable : >even ( n -- int ) 0 clear-bit ; foldable @@ -15,7 +13,7 @@ IN: math.miller-rabin : next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; -TUPLE: positive-even-expected n ; + n-1 From cf9a09b933dcc999335377763631c19eba914248 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 20:52:39 -0500 Subject: [PATCH 07/10] images.viewer: you can now pass a pathname object to image-window and image. words --- extra/images/viewer/viewer.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor index b891142d5b..b41dae9b38 100644 --- a/extra/images/viewer/viewer.factor +++ b/extra/images/viewer/viewer.factor @@ -25,7 +25,7 @@ M: image M: string load-image ; -M: pathname load-image ; +M: pathname string>> load-image ; : image-window ( object -- ) "Image" open-window ; From 3f871d3bae8933197857a7afa891456e3a5fc0ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 21:25:55 -0500 Subject: [PATCH 08/10] io.launcher.windows.nt: update unit tests for recent changes to lines and contents words --- basis/io/launcher/windows/nt/nt-tests.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor index 53b3d3ce7e..4587556e0c 100755 --- a/basis/io/launcher/windows/nt/nt-tests.factor +++ b/basis/io/launcher/windows/nt/nt-tests.factor @@ -42,7 +42,7 @@ IN: io.launcher.windows.nt.tests console-vm "-run=listener" 2array >>command +closed+ >>stdin +stdout+ >>stderr - ascii [ input-stream get contents ] with-process-reader + ascii [ contents ] with-process-reader ] unit-test : launcher-test-path ( -- str ) @@ -85,7 +85,7 @@ IN: io.launcher.windows.nt.tests console-vm "-script" "stderr.factor" 3array >>command "err2.txt" temp-file >>stderr - ascii lines first + ascii stream-lines first ] with-directory ] unit-test @@ -97,7 +97,7 @@ IN: io.launcher.windows.nt.tests launcher-test-path [ console-vm "-script" "env.factor" 3array >>command - ascii contents + ascii stream-contents ] with-directory eval( -- alist ) os-envs = @@ -109,7 +109,7 @@ IN: io.launcher.windows.nt.tests console-vm "-script" "env.factor" 3array >>command +replace-environment+ >>environment-mode os-envs >>environment - ascii contents + ascii stream-contents ] with-directory eval( -- alist ) os-envs = @@ -120,7 +120,7 @@ IN: io.launcher.windows.nt.tests console-vm "-script" "env.factor" 3array >>command { { "A" "B" } } >>environment - ascii contents + ascii stream-contents ] with-directory eval( -- alist ) "A" swap at @@ -132,7 +132,7 @@ IN: io.launcher.windows.nt.tests console-vm "-script" "env.factor" 3array >>command { { "USERPROFILE" "XXX" } } >>environment +prepend-environment+ >>environment-mode - ascii contents + ascii stream-contents ] with-directory eval( -- alist ) "USERPROFILE" swap at "XXX" = From 9d2fb3378b30ce1e33c4143e1297bd42cda706a5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 21:26:29 -0500 Subject: [PATCH 09/10] io.backend.windows.privileges: clean up code and fix inference problem --- .../backend/windows/privileges/privileges-tests.factor | 4 ++++ basis/io/backend/windows/privileges/privileges.factor | 9 +++++---- 2 files changed, 9 insertions(+), 4 deletions(-) create mode 100755 basis/io/backend/windows/privileges/privileges-tests.factor mode change 100644 => 100755 basis/io/backend/windows/privileges/privileges.factor diff --git a/basis/io/backend/windows/privileges/privileges-tests.factor b/basis/io/backend/windows/privileges/privileges-tests.factor new file mode 100755 index 0000000000..7237651b80 --- /dev/null +++ b/basis/io/backend/windows/privileges/privileges-tests.factor @@ -0,0 +1,4 @@ +IN: io.backend.windows.privileges.tests +USING: io.backend.windows.privileges tools.test ; + +[ [ ] with-privileges ] must-infer diff --git a/basis/io/backend/windows/privileges/privileges.factor b/basis/io/backend/windows/privileges/privileges.factor old mode 100644 new mode 100755 index 8661ba99d9..58806cc4df --- a/basis/io/backend/windows/privileges/privileges.factor +++ b/basis/io/backend/windows/privileges/privileges.factor @@ -1,12 +1,13 @@ USING: io.backend kernel continuations sequences -system vocabs.loader combinators ; +system vocabs.loader combinators fry ; IN: io.backend.windows.privileges -HOOK: set-privilege io-backend ( name ? -- ) inline +HOOK: set-privilege io-backend ( name ? -- ) : with-privileges ( seq quot -- ) - over [ [ t set-privilege ] each ] curry compose - swap [ [ f set-privilege ] each ] curry [ ] cleanup ; inline + [ '[ _ [ t set-privilege ] each @ ] ] + [ drop '[ _ [ f set-privilege ] each ] ] + 2bi [ ] cleanup ; inline { { [ os winnt? ] [ "io.backend.windows.nt.privileges" require ] } From ff674dac22c0ce383738f9d1a156fbbf85b36bf4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 23:18:41 -0500 Subject: [PATCH 10/10] cpu.ppc: bools are 4 bytes on OS X/PowerPC --- basis/cpu/ppc/ppc.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index beee48e5ea..5a528ddd5a 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -713,3 +713,4 @@ USE: vocabs.loader } cond "complex-double" c-type t >>return-in-registers? drop +"bool" c-type 4 >>size 4 >>align drop \ No newline at end of file