steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-02-16 18:50:30 -06:00
parent 8c9966b17c 544fc7db34
commit d51b351adf
11 changed files with 90 additions and 118 deletions
core/inference/class
extra
benchmark/sockets
builder
channels/examples
concurrency
cpu/8080
db/mysql
space-invaders

5
core/inference/class/class-tests.factor
View File

@ -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

5
extra/benchmark/sockets/sockets.factor
View File

@ -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

10
extra/builder/builder.factor
View File

@ -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

4
extra/builder/util/util.factor
View File

@ -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

2
extra/channels/examples/examples.factor Normal file → Executable file
View File

@ -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

6
extra/concurrency/concurrency.factor
View File

@ -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 ;

29
extra/cpu/8080/8080.factor Normal file → Executable file
View File

@ -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 ;

75
extra/cpu/8080/emulator/emulator.factor
View File

@ -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

51
extra/cpu/8080/test/test.factor Executable file
View File

@ -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 ;

6
extra/db/mysql/mysql.factor
View File

@ -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 )
;

15
extra/space-invaders/space-invaders.factor
View File

@ -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