diff --git a/core/inference/class/class-tests.factor b/core/inference/class/class-tests.factor index b77661b899..691010e9ca 100755 --- a/core/inference/class/class-tests.factor +++ b/core/inference/class/class-tests.factor @@ -283,3 +283,8 @@ cell-bits 32 = [ [ B{ 1 0 } *short dup number? [ 0 number= ] [ drop f ] if ] \ number= inlined? ] unit-test + +[ t ] [ + [ HEX: ff bitand 0 HEX: ff between? ] + \ >= inlined? +] unit-test diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index f19a2127a5..a621331968 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -23,10 +23,9 @@ IN: benchmark.sockets ] with-stream ; : clients ( n -- ) - dup pprint " clients: " write - [ + dup pprint " clients: " write [ [ simple-server ] in-thread - 100 sleep + yield yield [ drop simple-client ] parallel-each stop-server yield yield diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index e28510ccea..0c9f4ab099 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -1,11 +1,7 @@ -USING: kernel parser io io.files io.launcher io.sockets hashtables math threads - arrays system continuations namespaces sequences splitting math.parser - prettyprint tools.time calendar bake vars http.client - combinators bootstrap.image bootstrap.image.download - combinators.cleave benchmark - classes strings quotations words parser-combinators new-slots accessors - assocs.lib smtp builder.util ; +USING: kernel namespaces sequences splitting system combinators continuations + parser io io.files io.launcher io.sockets prettyprint threads + bootstrap.image benchmark vars bake smtp builder.util accessors ; IN: builder diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor index 9f2c76778f..f9eb17c565 100644 --- a/extra/builder/util/util.factor +++ b/extra/builder/util/util.factor @@ -3,8 +3,8 @@ USING: kernel words namespaces classes parser continuations io io.files io.launcher io.sockets math math.parser combinators sequences splitting quotations arrays strings tools.time - parser-combinators accessors assocs.lib - combinators.cleave bake calendar new-slots ; + parser-combinators new-slots accessors assocs.lib + combinators.cleave bake calendar ; IN: builder.util diff --git a/extra/channels/examples/examples.factor b/extra/channels/examples/examples.factor old mode 100644 new mode 100755 index 3c87680cd5..87b755614a --- a/extra/channels/examples/examples.factor +++ b/extra/channels/examples/examples.factor @@ -24,7 +24,7 @@ IN: channels.examples from swap dupd mod zero? not [ swap to ] [ 2drop ] if ] 3keep filter ; -:: (sieve) | prime c | +:: (sieve) | prime c | ( prime c -- ) [let | p [ c from ] newc [ ] | p prime to diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index 1c5f6322a8..b0abac8f5b 100755 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -145,12 +145,12 @@ M: process send ( message process -- ) : receive ( -- message ) self process-mailbox mailbox-get dup linked-exception? [ - linked-exception-error throw + linked-exception-error rethrow ] when ; : receive-if ( pred -- message ) self process-mailbox mailbox-get? dup linked-exception? [ - linked-exception-error throw + linked-exception-error rethrow ] when ; inline : rethrow-linked ( error -- ) @@ -285,7 +285,7 @@ TUPLE: future value processes ; #! place the result on the stack. Return the result #! immediately if the future has completed. dup future-value [ - first2 [ throw ] unless + first2 [ rethrow ] unless ] [ dup [ future-processes push stop ] curry callcc0 ?future ] ?if ; diff --git a/extra/cpu/8080/8080.factor b/extra/cpu/8080/8080.factor old mode 100644 new mode 100755 index fa88cf6c6a..45a5129a72 --- a/extra/cpu/8080/8080.factor +++ b/extra/cpu/8080/8080.factor @@ -249,32 +249,3 @@ INSTRUCTION: EI ; opcode FB cycles 04 INSTRUCTION: CALL M,nn ; opcode FC cycles 11 INSTRUCTION: CP n ; opcode FE cycles 07 INSTRUCTION: RST 38H ; opcode FF cycles 11 - -! : each-8bit ( n quot -- ) -! 8 [ ! n quot bit -! pick over -1 * shift 1 bitand pick call -! ] repeat 2drop ; -! -! : >ppm ( cpu filename -- cpu ) -! #! Dump the current screen image to a ppm image file with the given name. -! [ -! "P3" print -! "256 224" print -! "1" print -! 224 [ -! 32 [ -! over 32 * over + HEX: 2400 + ! cpu h w addr -! >r pick r> swap cpu-ram nth [ -! 0 = [ -! " 0 0 0" write -! ] [ -! " 1 1 1" write -! ] if -! ] each-8bit -! ] repeat nl -! ] repeat -! ] with-stream ; - -: time-test ( -- ) - test-cpu [ 1000000 run-n ] time ; - diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 9499ff8dff..187297d0a0 100755 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel math sequences words arrays io - io.files namespaces math.parser kernel.private - assocs quotations parser parser-combinators tools.time - sequences.private compiler.units ; +USING: kernel math sequences words arrays io io.files namespaces +math.parser assocs quotations parser parser-combinators +tools.time ; IN: cpu.8080.emulator TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ; @@ -396,39 +395,18 @@ M: cpu write-port ( value port cpu -- ) : instruction-cycles ( -- vector ) #! Return a 256 element vector containing the cycles for #! each opcode in the 8080 instruction set. - { - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f } ; - -: instructions ( -- vector ) - #! Return a 256 element vector containing the emulation words for - #! each opcode in the 8080 instruction set. - { - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f - f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f } ; + << 256 f parsed >> ; : not-implemented ( -- ) drop ; -instructions length [ - dup instructions nth [ - drop - ] [ - [ not-implemented ] swap instructions set-nth - ] if -] each +: instructions ( -- vector ) + #! Return a 256 element vector containing the emulation words for + #! each opcode in the 8080 instruction set. + << 256 [ [ not-implemented ] 2array ] map parsed >> ; inline + +: set-instruction ( quot n -- ) + tuck >r 2array r> instructions set-nth ; M: cpu reset ( cpu -- ) #! Reset the CPU to its poweron state @@ -517,15 +495,6 @@ SYMBOL: rom-root ] if ] if ; -: step ( cpu -- ) - #! Run a single 8080 instruction - [ read-instruction ] keep ! n cpu - over get-cycles over inc-cycles - [ swap instructions dispatch ] keep - [ cpu-pc HEX: FFFF bitand ] keep - [ set-cpu-pc ] keep - process-interrupts ; - : peek-instruction ( cpu -- word ) #! Return the next instruction from the cpu's program #! counter, but don't increment the counter. @@ -560,18 +529,6 @@ SYMBOL: rom-root [ " cycles: " write cpu-cycles number>string 5 CHAR: \s pad-left write ] keep nl drop ; -: test-step ( cpu -- cpu ) - [ step ] keep dup cpu. ; - -: test-cpu ( -- cpu ) - "invaders.rom" over load-rom dup cpu. ; - -: test-n ( n -- ) - test-cpu swap [ test-step ] times ; - -: run-n ( cpu n -- cpu ) - [ dup step ] times ; - : register-lookup ( string -- vector ) #! Given a string containing a register name, return a vector #! where the 1st item is the getter and the 2nd is the setter @@ -1337,11 +1294,9 @@ SYMBOL: last-opcode #! Process the list of strings, which should make #! up an 8080 instruction, and output a quotation #! that would implement that instruction. - [ - dup " " join instruction-quotations - >r "_" join [ "emulate-" % % ] "" make create-in dup last-instruction global set-at - r> define - ] with-compilation-unit ; + dup " " join instruction-quotations + >r "_" join [ "emulate-" % % ] "" make create-in dup last-instruction global set-at + r> define ; : INSTRUCTION: ";" parse-tokens parse-instructions ; parsing @@ -1352,5 +1307,5 @@ SYMBOL: last-opcode : opcode ( -- ) #! Set the opcode number for the last instruction that was defined. last-instruction global at 1quotation scan 16 base> - dup last-opcode global set-at instructions set-nth ; parsing + dup last-opcode global set-at set-instruction ; parsing diff --git a/extra/cpu/8080/test/test.factor b/extra/cpu/8080/test/test.factor new file mode 100755 index 0000000000..85f27d7e40 --- /dev/null +++ b/extra/cpu/8080/test/test.factor @@ -0,0 +1,51 @@ +USING: kernel cpu.8080 cpu.8080.emulator math math io +tools.time combinators sequences io.files ; +IN: cpu.8080.test + +: step ( cpu -- ) + #! Run a single 8080 instruction + [ read-instruction ] keep ! n cpu + over get-cycles over inc-cycles + [ swap instructions case ] keep + [ cpu-pc HEX: FFFF bitand ] keep + [ set-cpu-pc ] keep + process-interrupts ; + + +: test-step ( cpu -- cpu ) + [ step ] keep dup cpu. ; + +: test-cpu ( -- cpu ) + "invaders.rom" over load-rom dup cpu. ; + +: test-n ( n -- ) + test-cpu swap [ test-step ] times drop ; + +: run-n ( cpu n -- cpu ) + [ dup step ] times ; + +: each-8bit ( n quot -- ) + 8 -rot [ >r bit? r> call ] 2curry each ; inline + +: >ppm ( cpu filename -- cpu ) + #! Dump the current screen image to a ppm image file with the given name. + [ + "P3" print + "256 224" print + "1" print + 224 [ + 32 [ + over 32 * over + HEX: 2400 + ! cpu h w addr + >r pick r> swap cpu-ram nth [ + 0 = [ + " 0 0 0" write + ] [ + " 1 1 1" write + ] if + ] each-8bit drop + ] each drop nl + ] each + ] with-stream ; + +: time-test ( -- ) + test-cpu [ 1000000 run-n drop ] time ; diff --git a/extra/db/mysql/mysql.factor b/extra/db/mysql/mysql.factor index 040b87c977..91562e89ff 100644 --- a/extra/db/mysql/mysql.factor +++ b/extra/db/mysql/mysql.factor @@ -26,12 +26,6 @@ M: mysql-statement prepare-statement ( statement -- ) M: mysql-statement bind-statement* ( statement -- ) ; -M: mysql-statement rebind-statement ( statement -- ) - ; - -M: mysql-statement execute-statement ( statement -- ) - ; - M: mysql-statement query-results ( query -- result-set ) ; diff --git a/extra/space-invaders/space-invaders.factor b/extra/space-invaders/space-invaders.factor index f5c518865d..57c6b23d19 100755 --- a/extra/space-invaders/space-invaders.factor +++ b/extra/space-invaders/space-invaders.factor @@ -1,11 +1,10 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: cpu.8080 cpu.8080.emulator openal math alien.c-types sequences kernel - shuffle arrays io.files combinators kernel.private - ui.gestures ui.gadgets ui.render opengl.gl system - threads concurrency match ui byte-arrays combinators.lib - sequences.private ; +USING: cpu.8080 cpu.8080.emulator openal math alien.c-types +sequences kernel shuffle arrays io.files combinators ui.gestures +ui.gadgets ui.render opengl.gl system threads concurrency match +ui byte-arrays combinators.lib ; IN: space-invaders TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ; @@ -191,7 +190,7 @@ M: space-invaders reset ( cpu -- ) : gui-step ( cpu -- ) [ read-instruction ] keep ! n cpu over get-cycles over inc-cycles - [ swap instructions dispatch ] keep + [ swap instructions case ] keep [ cpu-pc HEX: FFFF bitand ] keep set-cpu-pc ; @@ -345,11 +344,13 @@ M: space-invaders update-video ( value addr cpu -- ) #! concurrent process. Messages can be sent to #! signal key presses, etc. dup invaders-gadget-quit? [ + 2drop + ] [ [ sync-frame ] dip [ invaders-gadget-cpu gui-frame ] keep [ relayout-1 ] keep invaders-process - ] unless ; + ] if ; M: invaders-gadget graft* ( gadget -- ) dup invaders-gadget-cpu init-sounds