Merge branch 'master' of git://factorcode.org/git/factor
commit
d51b351adf
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 [ <channel> ] |
|
||||
p prime to
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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.
|
||||
! <file-writer> [
|
||||
! "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 ;
|
||||
|
||||
|
|
|
@ -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 <array> parsed >> ;
|
||||
|
||||
: not-implemented ( <cpu> -- )
|
||||
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 )
|
||||
<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
|
||||
|
||||
|
|
|
@ -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 )
|
||||
<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.
|
||||
<file-writer> [
|
||||
"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 ;
|
|
@ -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 )
|
||||
;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue