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

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

db4
Slava 2008-01-17 17:19:25 -05:00
parent b0944cb3f8 cd25d968db
commit 6578757c83
36 changed files with 1881 additions and 1801 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/balloon-bomber/balloon-bomber-docs.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup cpu.8080 ; USING: help.syntax help.markup cpu.8080.emulator ;
IN: balloon-bomber IN: balloon-bomber
HELP: run HELP: run

33
extra/cpu/8080/8080-docs.factor
View File

@ -1,39 +1,8 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax sequences strings ; USING: help.markup help.syntax sequences strings cpu.8080.emulator ;
IN: cpu.8080 IN: cpu.8080
HELP: load-rom
{ $values { "filename" string } { "cpu" cpu } }
{ $description
"Read the ROM file into the cpu's memory starting at address 0000. "
"The filename is relative to the path stored in the " { $link rom-root }
" variable. An exception is thrown if this variable is not set."
}
{ $see-also load-rom* } ;
HELP: load-rom*
{ $values { "seq" sequence } { "cpu" cpu } }
{ $description
"Loads one or more ROM files into the cpu's memory. Each file is "
"loaded at a particular starting address. 'seq' is a sequence of "
"2 element arrays. The first element is the address and the second "
"element is the file to load at that address." $nl
"The filenames are relative to the path stored in the " { $link rom-root }
" variable. An exception is thrown if this variable is not set."
}
{ $examples
{ $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
}
{ $see-also load-rom } ;
HELP: rom-root
{ $description
"Holds the path where the ROM files are stored. Used for expanding "
"the relative filenames passed to " { $link load-rom } " and "
{ $link load-rom* } "."
}
{ $see-also load-rom load-rom* } ;
ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator" ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator"
"The cpu-8080 library provides an emulator for the Intel 8080 CPU" "The cpu-8080 library provides an emulator for the Intel 8080 CPU"

1596
extra/cpu/8080/8080.factor
View File

File diff suppressed because it is too large Load Diff

1
extra/cpu/8080/authors.txt Normal file
View File

@ -0,0 +1 @@
Chris Double

1
extra/cpu/8080/emulator/authors.txt Normal file
View File

@ -0,0 +1 @@
Chris Double

36
extra/cpu/8080/emulator/emulator-docs.factor Normal file
View File

@ -0,0 +1,36 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax sequences strings ;
IN: cpu.8080.emulator
HELP: load-rom
{ $values { "filename" string } { "cpu" cpu } }
{ $description
"Read the ROM file into the cpu's memory starting at address 0000. "
"The filename is relative to the path stored in the " { $link rom-root }
" variable. An exception is thrown if this variable is not set."
}
{ $see-also load-rom* } ;
HELP: load-rom*
{ $values { "seq" sequence } { "cpu" cpu } }
{ $description
"Loads one or more ROM files into the cpu's memory. Each file is "
"loaded at a particular starting address. 'seq' is a sequence of "
"2 element arrays. The first element is the address and the second "
"element is the file to load at that address." $nl
"The filenames are relative to the path stored in the " { $link rom-root }
" variable. An exception is thrown if this variable is not set."
}
{ $examples
{ $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
}
{ $see-also load-rom } ;
HELP: rom-root
{ $description
"Holds the path where the ROM files are stored. Used for expanding "
"the relative filenames passed to " { $link load-rom } " and "
{ $link load-rom* } "."
}
{ $see-also load-rom load-rom* } ;

1356
extra/cpu/8080/emulator/emulator.factor Normal file
View File

File diff suppressed because it is too large Load Diff

1
extra/cpu/8080/emulator/summary.txt Normal file
View File

@ -0,0 +1 @@
Intel 8080 CPU Emulator

1
extra/cpu/8080/emulator/tags.txt Normal file
View File

@ -0,0 +1 @@
emulator

250
extra/cpu/8080/instructions/instructions.factor
View File

@ -1,250 +0,0 @@
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: cpu.8080 ;
IN: cpu.8080.instructions
INSTRUCTION: NOP ; opcode 00 cycles 04
INSTRUCTION: LD BC,nn ; opcode 01 cycles 10
INSTRUCTION: LD (BC),A ; opcode 02 cycles 07
INSTRUCTION: INC BC ; opcode 03 cycles 06
INSTRUCTION: INC B ; opcode 04 cycles 05
INSTRUCTION: DEC B ; opcode 05 cycles 05
INSTRUCTION: LD B,n ; opcode 06 cycles 07
INSTRUCTION: RLCA ; opcode 07 cycles 04
! INSTRUCTION: NOP ; opcode 08 cycles 04
INSTRUCTION: ADD HL,BC ; opcode 09 cycles 11
INSTRUCTION: LD A,(BC) ; opcode 0A cycles 07
INSTRUCTION: DEC BC ; opcode 0B cycles 06
INSTRUCTION: INC C ; opcode 0C cycles 05
INSTRUCTION: DEC C ; opcode 0D cycles 05
INSTRUCTION: LD C,n ; opcode 0E cycles 07
INSTRUCTION: RRCA ; opcode 0F cycles 04
INSTRUCTION: LD DE,nn ; opcode 11 cycles 10
INSTRUCTION: LD (DE),A ; opcode 12 cycles 07
INSTRUCTION: INC DE ; opcode 13 cycles 06
INSTRUCTION: INC D ; opcode 14 cycles 05
INSTRUCTION: DEC D ; opcode 15 cycles 05
INSTRUCTION: LD D,n ; opcode 16 cycles 07
INSTRUCTION: RLA ; opcode 17 cycles 04
INSTRUCTION: ADD HL,DE ; opcode 19 cycles 11
INSTRUCTION: LD A,(DE) ; opcode 1A cycles 07
INSTRUCTION: DEC DE ; opcode 1B cycles 06
INSTRUCTION: INC E ; opcode 1C cycles 05
INSTRUCTION: DEC E ; opcode 1D cycles 05
INSTRUCTION: LD E,n ; opcode 1E cycles 07
INSTRUCTION: RRA ; opcode 1F cycles 04
INSTRUCTION: LD HL,nn ; opcode 21 cycles 10
INSTRUCTION: LD (nn),HL ; opcode 22 cycles 16
INSTRUCTION: INC HL ; opcode 23 cycles 06
INSTRUCTION: INC H ; opcode 24 cycles 05
INSTRUCTION: DEC H ; opcode 25 cycles 05
INSTRUCTION: LD H,n ; opcode 26 cycles 07
INSTRUCTION: DAA ; opcode 27 cycles 04
INSTRUCTION: ADD HL,HL ; opcode 29 cycles 11
INSTRUCTION: LD HL,(nn) ; opcode 2A cycles 16
INSTRUCTION: DEC HL ; opcode 2B cycles 06
INSTRUCTION: INC L ; opcode 2C cycles 05
INSTRUCTION: DEC L ; opcode 2D cycles 05
INSTRUCTION: LD L,n ; opcode 2E cycles 07
INSTRUCTION: CPL ; opcode 2F cycles 04
INSTRUCTION: LD SP,nn ; opcode 31 cycles 10
INSTRUCTION: LD (nn),A ; opcode 32 cycles 13
INSTRUCTION: INC SP ; opcode 33 cycles 06
INSTRUCTION: INC (HL) ; opcode 34 cycles 10
INSTRUCTION: DEC (HL) ; opcode 35 cycles 10
INSTRUCTION: LD (HL),n ; opcode 36 cycles 10
INSTRUCTION: SCF ; opcode 37 cycles 04
INSTRUCTION: ADD HL,SP ; opcode 39 cycles 11
INSTRUCTION: LD A,(nn) ; opcode 3A cycles 13
INSTRUCTION: DEC SP ; opcode 3B cycles 06
INSTRUCTION: INC A ; opcode 3C cycles 05
INSTRUCTION: DEC A ; opcode 3D cycles 05
INSTRUCTION: LD A,n ; opcode 3E cycles 07
INSTRUCTION: CCF ; opcode 3F cycles 04
INSTRUCTION: LD B,B ; opcode 40 cycles 05
INSTRUCTION: LD B,C ; opcode 41 cycles 05
INSTRUCTION: LD B,D ; opcode 42 cycles 05
INSTRUCTION: LD B,E ; opcode 43 cycles 05
INSTRUCTION: LD B,H ; opcode 44 cycles 05
INSTRUCTION: LD B,L ; opcode 45 cycles 05
INSTRUCTION: LD B,(HL) ; opcode 46 cycles 07
INSTRUCTION: LD B,A ; opcode 47 cycles 05
INSTRUCTION: LD C,B ; opcode 48 cycles 05
INSTRUCTION: LD C,C ; opcode 49 cycles 05
INSTRUCTION: LD C,D ; opcode 4A cycles 05
INSTRUCTION: LD C,E ; opcode 4B cycles 05
INSTRUCTION: LD C,H ; opcode 4C cycles 05
INSTRUCTION: LD C,L ; opcode 4D cycles 05
INSTRUCTION: LD C,(HL) ; opcode 4E cycles 07
INSTRUCTION: LD C,A ; opcode 4F cycles 05
INSTRUCTION: LD D,B ; opcode 50 cycles 05
INSTRUCTION: LD D,C ; opcode 51 cycles 05
INSTRUCTION: LD D,D ; opcode 52 cycles 05
INSTRUCTION: LD D,E ; opcode 53 cycles 05
INSTRUCTION: LD D,H ; opcode 54 cycles 05
INSTRUCTION: LD D,L ; opcode 55 cycles 05
INSTRUCTION: LD D,(HL) ; opcode 56 cycles 07
INSTRUCTION: LD D,A ; opcode 57 cycles 05
INSTRUCTION: LD E,B ; opcode 58 cycles 05
INSTRUCTION: LD E,C ; opcode 59 cycles 05
INSTRUCTION: LD E,D ; opcode 5A cycles 05
INSTRUCTION: LD E,E ; opcode 5B cycles 05
INSTRUCTION: LD E,H ; opcode 5C cycles 05
INSTRUCTION: LD E,L ; opcode 5D cycles 05
INSTRUCTION: LD E,(HL) ; opcode 5E cycles 07
INSTRUCTION: LD E,A ; opcode 5F cycles 05
INSTRUCTION: LD H,B ; opcode 60 cycles 05
INSTRUCTION: LD H,C ; opcode 61 cycles 05
INSTRUCTION: LD H,D ; opcode 62 cycles 05
INSTRUCTION: LD H,E ; opcode 63 cycles 05
INSTRUCTION: LD H,H ; opcode 64 cycles 05
INSTRUCTION: LD H,L ; opcode 65 cycles 05
INSTRUCTION: LD H,(HL) ; opcode 66 cycles 07
INSTRUCTION: LD H,A ; opcode 67 cycles 05
INSTRUCTION: LD L,B ; opcode 68 cycles 05
INSTRUCTION: LD L,C ; opcode 69 cycles 05
INSTRUCTION: LD L,D ; opcode 6A cycles 05
INSTRUCTION: LD L,E ; opcode 6B cycles 05
INSTRUCTION: LD L,H ; opcode 6C cycles 05
INSTRUCTION: LD L,L ; opcode 6D cycles 05
INSTRUCTION: LD L,(HL) ; opcode 6E cycles 07
INSTRUCTION: LD L,A ; opcode 6F cycles 05
INSTRUCTION: LD (HL),B ; opcode 70 cycles 07
INSTRUCTION: LD (HL),C ; opcode 71 cycles 07
INSTRUCTION: LD (HL),D ; opcode 72 cycles 07
INSTRUCTION: LD (HL),E ; opcode 73 cycles 07
INSTRUCTION: LD (HL),H ; opcode 74 cycles 07
INSTRUCTION: LD (HL),L ; opcode 75 cycles 07
INSTRUCTION: HALT ; opcode 76 cycles 07
INSTRUCTION: LD (HL),A ; opcode 77 cycles 07
INSTRUCTION: LD A,B ; opcode 78 cycles 05
INSTRUCTION: LD A,C ; opcode 79 cycles 05
INSTRUCTION: LD A,D ; opcode 7A cycles 05
INSTRUCTION: LD A,E ; opcode 7B cycles 05
INSTRUCTION: LD A,H ; opcode 7C cycles 05
INSTRUCTION: LD A,L ; opcode 7D cycles 05
INSTRUCTION: LD A,(HL) ; opcode 7E cycles 07
INSTRUCTION: LD A,A ; opcode 7F cycles 05
INSTRUCTION: ADD A,B ; opcode 80 cycles 04
INSTRUCTION: ADD A,C ; opcode 81 cycles 04
INSTRUCTION: ADD A,D ; opcode 82 cycles 04
INSTRUCTION: ADD A,E ; opcode 83 cycles 04
INSTRUCTION: ADD A,H ; opcode 84 cycles 04
INSTRUCTION: ADD A,L ; opcode 85 cycles 04
INSTRUCTION: ADD A,(HL) ; opcode 86 cycles 07
INSTRUCTION: ADD A,A ; opcode 87 cycles 04
INSTRUCTION: ADC A,B ; opcode 88 cycles 04
INSTRUCTION: ADC A,C ; opcode 89 cycles 04
INSTRUCTION: ADC A,D ; opcode 8A cycles 04
INSTRUCTION: ADC A,E ; opcode 8B cycles 04
INSTRUCTION: ADC A,H ; opcode 8C cycles 04
INSTRUCTION: ADC A,L ; opcode 8D cycles 04
INSTRUCTION: ADC A,(HL) ; opcode 8E cycles 07
INSTRUCTION: ADC A,A ; opcode 8F cycles 04
INSTRUCTION: SUB B ; opcode 90 cycles 04
INSTRUCTION: SUB C ; opcode 91 cycles 04
INSTRUCTION: SUB D ; opcode 92 cycles 04
INSTRUCTION: SUB E ; opcode 93 cycles 04
INSTRUCTION: SUB H ; opcode 94 cycles 04
INSTRUCTION: SUB L ; opcode 95 cycles 04
INSTRUCTION: SUB (HL) ; opcode 96 cycles 07
INSTRUCTION: SUB A ; opcode 97 cycles 04
INSTRUCTION: SBC A,B ; opcode 98 cycles 04
INSTRUCTION: SBC A,C ; opcode 99 cycles 04
INSTRUCTION: SBC A,D ; opcode 9A cycles 04
INSTRUCTION: SBC A,E ; opcode 9B cycles 04
INSTRUCTION: SBC A,H ; opcode 9C cycles 04
INSTRUCTION: SBC A,L ; opcode 9D cycles 04
INSTRUCTION: SBC A,(HL) ; opcode 9E cycles 07
INSTRUCTION: SBC A,A ; opcode 9F cycles 04
INSTRUCTION: AND B ; opcode A0 cycles 04
INSTRUCTION: AND C ; opcode A1 cycles 04
INSTRUCTION: AND D ; opcode A2 cycles 04
INSTRUCTION: AND E ; opcode A3 cycles 04
INSTRUCTION: AND H ; opcode A4 cycles 04
INSTRUCTION: AND L ; opcode A5 cycles 04
INSTRUCTION: AND (HL) ; opcode A6 cycles 07
INSTRUCTION: AND A ; opcode A7 cycles 04
INSTRUCTION: XOR B ; opcode A8 cycles 04
INSTRUCTION: XOR C ; opcode A9 cycles 04
INSTRUCTION: XOR D ; opcode AA cycles 04
INSTRUCTION: XOR E ; opcode AB cycles 04
INSTRUCTION: XOR H ; opcode AC cycles 04
INSTRUCTION: XOR L ; opcode AD cycles 04
INSTRUCTION: XOR (HL) ; opcode AE cycles 07
INSTRUCTION: XOR A ; opcode AF cycles 04
INSTRUCTION: OR B ; opcode B0 cycles 04
INSTRUCTION: OR C ; opcode B1 cycles 04
INSTRUCTION: OR D ; opcode B2 cycles 04
INSTRUCTION: OR E ; opcode B3 cycles 04
INSTRUCTION: OR H ; opcode B4 cycles 04
INSTRUCTION: OR L ; opcode B5 cycles 04
INSTRUCTION: OR (HL) ; opcode B6 cycles 07
INSTRUCTION: OR A ; opcode B7 cycles 04
INSTRUCTION: CP B ; opcode B8 cycles 04
INSTRUCTION: CP C ; opcode B9 cycles 04
INSTRUCTION: CP D ; opcode BA cycles 04
INSTRUCTION: CP E ; opcode BB cycles 04
INSTRUCTION: CP H ; opcode BC cycles 04
INSTRUCTION: CP L ; opcode BD cycles 04
INSTRUCTION: CP (HL) ; opcode BE cycles 07
INSTRUCTION: CP A ; opcode BF cycles 04
INSTRUCTION: RET NZ ; opcode C0 cycles 05
INSTRUCTION: POP BC ; opcode C1 cycles 10
INSTRUCTION: JP NZ,nn ; opcode C2 cycles 10
INSTRUCTION: JP nn ; opcode C3 cycles 10
INSTRUCTION: CALL NZ,nn ; opcode C4 cycles 11
INSTRUCTION: PUSH BC ; opcode C5 cycles 11
INSTRUCTION: ADD A,n ; opcode C6 cycles 07
INSTRUCTION: RST 0 ; opcode C7 cycles 11
INSTRUCTION: RET Z ; opcode C8 cycles 05
INSTRUCTION: RET nn ; opcode C9 cycles 10
INSTRUCTION: JP Z,nn ; opcode CA cycles 10
INSTRUCTION: CALL Z,nn ; opcode CC cycles 11
INSTRUCTION: CALL nn ; opcode CD cycles 17
INSTRUCTION: ADC A,n ; opcode CE cycles 07
INSTRUCTION: RST 8 ; opcode CF cycles 11
INSTRUCTION: RET NC ; opcode D0 cycles 05
INSTRUCTION: POP DE ; opcode D1 cycles 10
INSTRUCTION: JP NC,nn ; opcode D2 cycles 10
INSTRUCTION: OUT (n),A ; opcode D3 cycles 10
INSTRUCTION: CALL NC,nn ; opcode D4 cycles 11
INSTRUCTION: PUSH DE ; opcode D5 cycles 11
INSTRUCTION: SUB n ; opcode D6 cycles 07
INSTRUCTION: RST 10H ; opcode D7 cycles 11
INSTRUCTION: RET C ; opcode D8 cycles 05
INSTRUCTION: JP C,nn ; opcode DA cycles 10
INSTRUCTION: IN A,(n) ; opcode DB cycles 10
INSTRUCTION: CALL C,nn ; opcode DC cycles 11
INSTRUCTION: SBC A,n ; opcode DE cycles 07
INSTRUCTION: RST 18H ; opcode DF cycles 11
INSTRUCTION: RET PO ; opcode E0 cycles 05
INSTRUCTION: POP HL ; opcode E1 cycles 10
INSTRUCTION: JP PO,nn ; opcode E2 cycles 10
INSTRUCTION: EX (SP),HL ; opcode E3 cycles 04
INSTRUCTION: CALL PO,nn ; opcode E4 cycles 11
INSTRUCTION: PUSH HL ; opcode E5 cycles 11
INSTRUCTION: AND n ; opcode E6 cycles 07
INSTRUCTION: RST 20H ; opcode E7 cycles 11
INSTRUCTION: RET PE ; opcode E8 cycles 05
INSTRUCTION: JP (HL) ; opcode E9 cycles 04
INSTRUCTION: JP PE,nn ; opcode EA cycles 10
INSTRUCTION: EX DE,HL ; opcode EB cycles 04
INSTRUCTION: CALL PE,nn ; opcode EC cycles 11
INSTRUCTION: XOR n ; opcode EE cycles 07
INSTRUCTION: RST 28H ; opcode EF cycles 11
INSTRUCTION: RET P ; opcode F0 cycles 05
INSTRUCTION: POP AF ; opcode F1 cycles 10
INSTRUCTION: JP P,nn ; opcode F2 cycles 10
INSTRUCTION: DI ; opcode F3 cycles 04
INSTRUCTION: CALL P,nn ; opcode F4 cycles 11
INSTRUCTION: PUSH AF ; opcode F5 cycles 11
INSTRUCTION: OR n ; opcode F6 cycles 07
INSTRUCTION: RST 30H ; opcode F7 cycles 11
INSTRUCTION: RET M ; opcode F8 cycles 05
INSTRUCTION: LD SP,HL ; opcode F9 cycles 06
INSTRUCTION: JP M,nn ; opcode FA cycles 10
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

1
extra/cpu/8080/summary.txt Normal file
View File

@ -0,0 +1 @@
Intel 8080 CPU Emulator

1
extra/cpu/8080/tags.txt Normal file
View File

@ -0,0 +1 @@
emulator

2
extra/crypto/sha1/sha1.factor
View File

@ -78,7 +78,7 @@ SYMBOL: K
K get nth , K get nth ,
A get 5 bitroll-32 , A get 5 bitroll-32 ,
E get , E get ,
] { } make sum 4294967295 bitand ; inline ] { } make sum >32-bit ; inline
: set-vars ( temp -- ) : set-vars ( temp -- )
! E = D; D = C; C = S^30(B); B = A; A = TEMP; ! E = D; D = C; C = S^30(B); B = A; A = TEMP;

2
extra/io/sniffer/bsd/bsd.factor
View File

@ -17,7 +17,7 @@ TUPLE: sniffer-spec path ifname ;
C: <sniffer-spec> sniffer-spec C: <sniffer-spec> sniffer-spec
: IOCPARM_MASK HEX: 1fff ; inline : IOCPARM_MASK HEX: 1fff ; inline
: IOCPARM_MAX IOCPARM_MASK 1 + ; inline : IOCPARM_MAX IOCPARM_MASK 1+ ; inline
: IOC_VOID HEX: 20000000 ; inline : IOC_VOID HEX: 20000000 ; inline
: IOC_OUT HEX: 40000000 ; inline : IOC_OUT HEX: 40000000 ; inline
: IOC_IN HEX: 80000000 ; inline : IOC_IN HEX: 80000000 ; inline

2
extra/io/sniffer/filter/bsd/bsd.factor
View File

@ -9,7 +9,7 @@ IN: io.sniffer.filter.bsd
: bpf-align ( n -- n' ) : bpf-align ( n -- n' )
#! Align to next higher word size #! Align to next higher word size
"long" heap-size 1- [ + ] keep bitnot bitand ; "long" heap-size align ;
M: unix-io packet. ( string -- ) M: unix-io packet. ( string -- )
18 cut swap >byte-array bpfh. 18 cut swap >byte-array bpfh.

2
extra/lunar-rescue/lunar-rescue-docs.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup cpu.8080 ; USING: help.syntax help.markup cpu.8080.emulator ;
IN: lunar-rescue IN: lunar-rescue
HELP: run HELP: run

3
extra/match/match.factor
View File

@ -3,7 +3,7 @@
! !
! Based on pattern matching code from Paul Graham's book 'On Lisp'. ! Based on pattern matching code from Paul Graham's book 'On Lisp'.
USING: parser kernel words namespaces sequences tuples USING: parser kernel words namespaces sequences tuples
combinators macros assocs ; combinators macros assocs math ;
IN: match IN: match
SYMBOL: _ SYMBOL: _
@ -54,6 +54,7 @@ MACRO: match-cond ( assoc -- )
: replace-patterns ( object -- result ) : replace-patterns ( object -- result )
{ {
{ [ dup number? ] [ ] }
{ [ dup match-var? ] [ get ] } { [ dup match-var? ] [ get ] }
{ [ dup sequence? ] [ [ replace-patterns ] map ] } { [ dup sequence? ] [ [ replace-patterns ] map ] }
{ [ dup tuple? ] [ tuple>array replace-patterns >tuple ] } { [ dup tuple? ] [ tuple>array replace-patterns >tuple ] }

4
extra/math/polynomials/polynomials.factor
View File

@ -1,5 +1,5 @@
USING: arrays kernel sequences vectors math math.vectors namespaces USING: arrays kernel sequences vectors math math.vectors namespaces
shuffle splitting ; shuffle splitting sequences.lib ;
IN: math.polynomials IN: math.polynomials
! Polynomials are vectors with the highest powers on the right: ! Polynomials are vectors with the highest powers on the right:
@ -22,7 +22,7 @@ PRIVATE>
: p= ( p p -- ? ) pextend = ; : p= ( p p -- ? ) pextend = ;
: ptrim ( p -- p ) : ptrim ( p -- p )
dup length 1 = [ [ zero? ] right-trim ] unless ; dup singleton? [ [ zero? ] right-trim ] unless ;
: 2ptrim ( p p -- p p ) [ ptrim ] 2apply ; : 2ptrim ( p p -- p p ) [ ptrim ] 2apply ;
: p+ ( p p -- p ) pextend v+ ; : p+ ( p p -- p ) pextend v+ ;

15
extra/ogg/ogg.factor
View File

@ -4,14 +4,13 @@
USING: kernel system combinators alien alien.syntax ; USING: kernel system combinators alien alien.syntax ;
IN: ogg IN: ogg
: load-ogg-library ( -- ) <<
"ogg" { "ogg" {
{ [ win32? ] [ "ogg.dll" ] } { [ win32? ] [ "ogg.dll" ] }
{ [ macosx? ] [ "libogg.0.dylib" ] } { [ macosx? ] [ "libogg.0.dylib" ] }
{ [ unix? ] [ "libogg.so" ] } { [ unix? ] [ "libogg.so" ] }
} cond "cdecl" add-library ; parsing } cond "cdecl" add-library
>>
load-ogg-library
LIBRARY: ogg LIBRARY: ogg

15
extra/ogg/theora/theora.factor
View File

@ -4,14 +4,13 @@
USING: kernel system combinators alien alien.syntax ; USING: kernel system combinators alien alien.syntax ;
IN: ogg.theora IN: ogg.theora
: load-theora-library ( -- ) <<
"theora" { "theora" {
{ [ win32? ] [ "libtheora.dll" ] } { [ win32? ] [ "libtheora.dll" ] }
{ [ macosx? ] [ "libtheora.0.dylib" ] } { [ macosx? ] [ "libtheora.0.dylib" ] }
{ [ unix? ] [ "libtheora.so" ] } { [ unix? ] [ "libtheora.so" ] }
} cond "cdecl" add-library ; parsing } cond "cdecl" add-library
>>
load-theora-library
LIBRARY: theora LIBRARY: theora

15
extra/ogg/vorbis/vorbis.factor
View File

@ -4,14 +4,13 @@
USING: kernel system combinators alien alien.syntax ; USING: kernel system combinators alien alien.syntax ;
IN: ogg.vorbis IN: ogg.vorbis
: load-vorbis-library ( -- ) <<
"vorbis" { "vorbis" {
{ [ win32? ] [ "vorbis.dll" ] } { [ win32? ] [ "vorbis.dll" ] }
{ [ macosx? ] [ "libvorbis.0.dylib" ] } { [ macosx? ] [ "libvorbis.0.dylib" ] }
{ [ unix? ] [ "libvorbis.so" ] } { [ unix? ] [ "libvorbis.so" ] }
} cond "cdecl" add-library ; parsing } cond "cdecl" add-library
>>
load-vorbis-library
LIBRARY: vorbis LIBRARY: vorbis

9
extra/ori/ori.factor
View File

@ -1,7 +1,7 @@
USING: kernel namespaces USING: kernel namespaces
math math.constants math.functions math.matrices math.vectors math math.constants math.functions math.matrices math.vectors
sequences splitting self ; sequences splitting self math.trig ;
IN: ori IN: ori
@ -11,13 +11,6 @@ C: <ori> ori
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Temporarily defined here until math-contrib gets moved to extra/
: deg>rad pi * 180 / ; inline
: rad>deg 180 * pi / ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: ori> ( -- val ) self> ori-val ; : ori> ( -- val ) self> ori-val ;
: >ori ( val -- ) self> set-ori-val ; : >ori ( val -- ) self> set-ori-val ;

266
extra/peg/peg.factor
View File

@ -1,12 +1,16 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib memoize math.parser ; vectors arrays combinators.lib memoize math.parser match ;
IN: peg IN: peg
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;
GENERIC: (parse) ( state parser -- result ) GENERIC: compile ( parser -- quot )
: (parse) ( state parser -- result )
compile call ;
<PRIVATE <PRIVATE
@ -72,135 +76,199 @@ PRIVATE>
TUPLE: token-parser symbol ; TUPLE: token-parser symbol ;
M: token-parser (parse) ( input parser -- result ) MATCH-VARS: ?token ;
token-parser-symbol 2dup head? [
dup >r length tail-slice r> <parse-result>
] [
2drop f
] if ;
TUPLE: satisfy-parser quot ;
M: satisfy-parser (parse) ( state parser -- result ) : token-pattern ( -- quot )
over empty? [ [
2drop f ?token 2dup head? [
] [ dup >r length tail-slice r> <parse-result>
satisfy-parser-quot [ unclip-slice dup ] dip call [
<parse-result>
] [ ] [
2drop f 2drop f
] if ] if
] if ; ] ;
M: token-parser compile ( parser -- quot )
token-parser-symbol \ ?token token-pattern match-replace ;
TUPLE: satisfy-parser quot ;
MATCH-VARS: ?quot ;
: satisfy-pattern ( -- quot )
[
dup empty? [
drop f
] [
unclip-slice dup ?quot call [
<parse-result>
] [
2drop f
] if
] if
] ;
M: satisfy-parser compile ( parser -- quot )
satisfy-parser-quot \ ?quot satisfy-pattern match-replace ;
TUPLE: range-parser min max ; TUPLE: range-parser min max ;
M: range-parser (parse) ( state parser -- result ) MATCH-VARS: ?min ?max ;
over empty? [
2drop f : range-pattern ( -- quot )
] [ [
0 pick nth dup rot dup empty? [
{ range-parser-min range-parser-max } get-slots between? [ drop f
[ 1 tail-slice ] dip <parse-result>
] [ ] [
2drop f 0 over nth dup
] if ?min ?max between? [
] if ; [ 1 tail-slice ] dip <parse-result>
] [
2drop f
] if
] if
] ;
M: range-parser compile ( parser -- quot )
T{ range-parser _ ?min ?max } range-pattern match-replace ;
TUPLE: seq-parser parsers ; TUPLE: seq-parser parsers ;
: do-seq-parser ( result parser -- result ) : seq-pattern ( -- quot )
[ dup parse-result-remaining ] dip parse [ [
[ parse-result-remaining swap set-parse-result-remaining ] 2keep dup [
parse-result-ast dup ignore = [ drop ] [ swap [ parse-result-ast push ] keep ] if dup parse-result-remaining ?quot call [
] [ [ parse-result-remaining swap set-parse-result-remaining ] 2keep
drop f parse-result-ast dup ignore = [
] if* ; drop
] [
swap [ parse-result-ast push ] keep
] if
] [
drop f
] if*
] [
drop f
] if
] ;
: (seq-parser) ( result parsers -- result ) M: seq-parser compile ( parser -- quot )
dup empty? not pick and [ [
unclip swap [ do-seq-parser ] dip (seq-parser) [ V{ } clone <parse-result> ] %
] [ seq-parser-parsers [ compile \ ?quot seq-pattern match-replace % ] each
drop ] [ ] make ;
] if ;
M: seq-parser (parse) ( state parser -- result )
seq-parser-parsers [ V{ } clone <parse-result> ] dip (seq-parser) ;
TUPLE: choice-parser parsers ; TUPLE: choice-parser parsers ;
: (choice-parser) ( state parsers -- result )
dup empty? [
2drop f
] [
unclip pick swap parse [
2nip
] [
(choice-parser)
] if*
] if ;
M: choice-parser (parse) ( state parser -- result ) : choice-pattern ( -- quot )
choice-parser-parsers (choice-parser) ; [
dup [
] [
drop dup ?quot call
] if
] ;
M: choice-parser compile ( parser -- quot )
[
f ,
choice-parser-parsers [ compile \ ?quot choice-pattern match-replace % ] each
\ nip ,
] [ ] make ;
TUPLE: repeat0-parser p1 ; TUPLE: repeat0-parser p1 ;
: (repeat-parser) ( parser result -- result ) : (repeat0) ( quot result -- result )
2dup parse-result-remaining swap parse [ 2dup parse-result-remaining swap call [
[ parse-result-remaining swap set-parse-result-remaining ] 2keep [ parse-result-remaining swap set-parse-result-remaining ] 2keep
parse-result-ast swap [ parse-result-ast push ] keep parse-result-ast swap [ parse-result-ast push ] keep
(repeat-parser) (repeat0)
] [ ] [
nip nip
] if* ; ] if* ; inline
: clone-result ( result -- result ) : repeat0-pattern ( -- quot )
{ parse-result-remaining parse-result-ast } [
get-slots 1vector <parse-result> ; ?quot swap (repeat0)
] ;
M: repeat0-parser (parse) ( state parser -- result ) M: repeat0-parser compile ( parser -- quot )
repeat0-parser-p1 2dup parse [ [
nipd clone-result (repeat-parser) [ V{ } clone <parse-result> ] %
] [ repeat0-parser-p1 compile \ ?quot repeat0-pattern match-replace %
drop V{ } clone <parse-result> ] [ ] make ;
] if* ;
TUPLE: repeat1-parser p1 ; TUPLE: repeat1-parser p1 ;
M: repeat1-parser (parse) ( state parser -- result ) : repeat1-pattern ( -- quot )
repeat1-parser-p1 tuck parse dup [ clone-result (repeat-parser) ] [ nip ] if ; [
?quot swap (repeat0) [
dup parse-result-ast empty? [
drop f
] when
] [
f
] if*
] ;
M: repeat1-parser compile ( parser -- quot )
[
[ V{ } clone <parse-result> ] %
repeat1-parser-p1 compile \ ?quot repeat1-pattern match-replace %
] [ ] make ;
TUPLE: optional-parser p1 ; TUPLE: optional-parser p1 ;
M: optional-parser (parse) ( state parser -- result ) : optional-pattern ( -- quot )
dupd optional-parser-p1 parse swap f <parse-result> or ; [
dup ?quot call swap f <parse-result> or
] ;
M: optional-parser compile ( parser -- quot )
optional-parser-p1 compile \ ?quot optional-pattern match-replace ;
TUPLE: ensure-parser p1 ; TUPLE: ensure-parser p1 ;
M: ensure-parser (parse) ( state parser -- result ) : ensure-pattern ( -- quot )
dupd ensure-parser-p1 parse [ [
ignore <parse-result> dup ?quot call [
] [ ignore <parse-result>
drop f ] [
] if ; drop f
] if
] ;
M: ensure-parser compile ( parser -- quot )
ensure-parser-p1 compile \ ?quot ensure-pattern match-replace ;
TUPLE: ensure-not-parser p1 ; TUPLE: ensure-not-parser p1 ;
M: ensure-not-parser (parse) ( state parser -- result ) : ensure-not-pattern ( -- quot )
dupd ensure-not-parser-p1 parse [ [
drop f dup ?quot call [
] [ drop f
ignore <parse-result> ] [
] if ; ignore <parse-result>
] if
] ;
M: ensure-not-parser compile ( parser -- quot )
ensure-not-parser-p1 compile \ ?quot ensure-not-pattern match-replace ;
TUPLE: action-parser p1 quot ; TUPLE: action-parser p1 quot ;
M: action-parser (parse) ( state parser -- result ) MATCH-VARS: ?action ;
tuck action-parser-p1 parse dup [
dup parse-result-ast rot action-parser-quot call : action-pattern ( -- quot )
swap [ set-parse-result-ast ] keep [
] [ ?quot call dup [
nip dup parse-result-ast ?action call
] if ; swap [ set-parse-result-ast ] keep
] when
] ;
M: action-parser compile ( parser -- quot )
{ action-parser-p1 action-parser-quot } get-slots [ compile ] dip
2array { ?quot ?action } action-pattern match-replace ;
: left-trim-slice ( string -- string ) : left-trim-slice ( string -- string )
#! Return a new string without any leading whitespace #! Return a new string without any leading whitespace
@ -211,13 +279,17 @@ M: action-parser (parse) ( state parser -- result )
TUPLE: sp-parser p1 ; TUPLE: sp-parser p1 ;
M: sp-parser (parse) ( state parser -- result ) M: sp-parser compile ( parser -- quot )
[ left-trim-slice ] dip sp-parser-p1 parse ; [
\ left-trim-slice , sp-parser-p1 compile %
] [ ] make ;
TUPLE: delay-parser quot ; TUPLE: delay-parser quot ;
M: delay-parser (parse) ( state parser -- result ) M: delay-parser compile ( parser -- quot )
delay-parser-quot call parse ; [
delay-parser-quot % \ compile , \ call ,
] [ ] make ;
PRIVATE> PRIVATE>

3
extra/peg/search/search-docs.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup peg peg.search ; USING: help.syntax help.markup peg ;
IN: peg.search
HELP: tree-write HELP: tree-write
{ $values { $values

15
extra/postgresql/libpq/libpq.factor
View File

@ -8,14 +8,13 @@
USING: alien alien.syntax combinators system ; USING: alien alien.syntax combinators system ;
IN: postgresql.libpq IN: postgresql.libpq
: load-postgresql-library ( -- ) <<
"postgresql" { "postgresql" {
{ [ win32? ] [ "libpq.dll" ] } { [ win32? ] [ "libpq.dll" ] }
{ [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] } { [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
{ [ unix? ] [ "libpq.so" ] } { [ unix? ] [ "libpq.so" ] }
} cond "cdecl" add-library ; parsing } cond "cdecl" add-library
>>
load-postgresql-library
! ConnSatusType ! ConnSatusType
: CONNECTION_OK HEX: 0 ; inline : CONNECTION_OK HEX: 0 ; inline

2
extra/space-invaders/space-invaders-docs.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup cpu.8080 ; USING: help.syntax help.markup cpu.8080.emulator ;
IN: space-invaders IN: space-invaders
HELP: run HELP: run

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

@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: cpu.8080 openal math alien.c-types sequences kernel USING: cpu.8080 cpu.8080.emulator openal math alien.c-types sequences kernel
shuffle arrays io.files combinators kernel.private shuffle arrays io.files combinators kernel.private
ui.gestures ui.gadgets ui.render opengl.gl system ui.gestures ui.gadgets ui.render opengl.gl system
threads concurrency match ui byte-arrays combinators.lib threads concurrency match ui byte-arrays combinators.lib

15
extra/sqlite/lib/lib.factor
View File

@ -12,14 +12,13 @@ IN: sqlite.lib
USING: alien compiler kernel math namespaces sequences strings alien.syntax USING: alien compiler kernel math namespaces sequences strings alien.syntax
system combinators ; system combinators ;
: load-sqlite-library ( -- ) <<
"sqlite" { "sqlite" {
{ [ win32? ] [ "sqlite3.dll" ] } { [ win32? ] [ "sqlite3.dll" ] }
{ [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] } { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
{ [ unix? ] [ "libsqlite3.so" ] } { [ unix? ] [ "libsqlite3.so" ] }
} cond "cdecl" add-library ; parsing } cond "cdecl" add-library
>>
load-sqlite-library
! Return values from sqlite functions ! Return values from sqlite functions
: SQLITE_OK 0 ; inline ! Successful result : SQLITE_OK 0 ; inline ! Successful result

2
extra/sqlite/sqlite-docs.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help sqlite help.syntax help.markup ; USING: help help.syntax help.markup ;
IN: sqlite IN: sqlite
HELP: sqlite-open HELP: sqlite-open

2
extra/sqlite/tuple-db/tuple-db-docs.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help sqlite sqlite.tuple-db help.syntax help.markup ; USING: help sqlite help.syntax help.markup ;
IN: sqlite.tuple-db IN: sqlite.tuple-db
ARTICLE: { "sqlite" "tuple-db-loading" } "Loading" ARTICLE: { "sqlite" "tuple-db-loading" } "Loading"

4
extra/trees/avl/avl-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.syntax help.markup trees.avl assocs ; USING: help.syntax help.markup assocs ;
IN: trees.avl
HELP: AVL{ HELP: AVL{
{ $syntax "AVL{ { key value }... }" } { $syntax "AVL{ { key value }... }" }
@ -23,5 +24,4 @@ ARTICLE: { "avl" "intro" } "AVL trees"
{ $subsection >avl } { $subsection >avl }
{ $subsection POSTPONE: AVL{ } ; { $subsection POSTPONE: AVL{ } ;
IN: trees.avl
ABOUT: { "avl" "intro" } ABOUT: { "avl" "intro" }

4
extra/trees/splay/splay-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.syntax help.markup trees.splay assocs ; USING: help.syntax help.markup assocs ;
IN: trees.splay
HELP: SPLAY{ HELP: SPLAY{
{ $syntax "SPLAY{ { key value }... }" } { $syntax "SPLAY{ { key value }... }" }
@ -23,5 +24,4 @@ ARTICLE: { "splay" "intro" } "Splay trees"
{ $subsection >splay } { $subsection >splay }
{ $subsection POSTPONE: SPLAY{ } ; { $subsection POSTPONE: SPLAY{ } ;
IN: trees.splay
ABOUT: { "splay" "intro" } ABOUT: { "splay" "intro" }

3
extra/trees/trees-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.syntax help.markup trees assocs ; USING: help.syntax help.markup assocs ;
IN: trees
HELP: TREE{ HELP: TREE{
{ $syntax "TREE{ { key value }... }" } { $syntax "TREE{ { key value }... }" }

3
extra/tuple-syntax/tuple-syntax-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.markup help.syntax tuple-syntax ; USING: help.markup help.syntax ;
IN: tuple-syntax
HELP: TUPLE{ HELP: TUPLE{
{ $syntax "TUPLE{ class slot-name: value... }" } { $syntax "TUPLE{ class slot-name: value... }" }

10
extra/webapps/cgi/cgi.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs io.files combinators USING: namespaces kernel assocs io.files combinators
arrays io.launcher io http.server.responders webapps.file arrays io.launcher io http.server.responders webapps.file
sequences strings ; sequences strings math.parser ;
IN: webapps.cgi IN: webapps.cgi
SYMBOL: cgi-root SYMBOL: cgi-root
@ -12,6 +12,8 @@ SYMBOL: cgi-root
: cgi-variables ( name -- assoc ) : cgi-variables ( name -- assoc )
#! This needs some work. #! This needs some work.
[ [
cgi-root get over path+ "PATH_TRANSLATED" set
cgi-root get over path+ "SCRIPT_FILENAME" set
"SCRIPT_NAME" set "SCRIPT_NAME" set
"CGI/1.0" "GATEWAY_INTERFACE" set "CGI/1.0" "GATEWAY_INTERFACE" set
@ -29,13 +31,14 @@ SYMBOL: cgi-root
"method" get >upper "REQUEST_METHOD" set "method" get >upper "REQUEST_METHOD" set
"raw-query" get "QUERY_STRING" set "raw-query" get "QUERY_STRING" set
"Cookie" header-param "HTTP_COOKIE" set
"User-Agent" header-param "HTTP_USER_AGENT" set "User-Agent" header-param "HTTP_USER_AGENT" set
"Accept" header-param "HTTP_ACCEPT" set "Accept" header-param "HTTP_ACCEPT" set
post? [ post? [
"Content-Type" header-param "CONTENT_TYPE" set "Content-Type" header-param "CONTENT_TYPE" set
"raw-response" get length "CONTENT_LENGTH" set "raw-response" get length number>string "CONTENT_LENGTH" set
] when ] when
] H{ } make-assoc ; ] H{ } make-assoc ;
@ -49,8 +52,7 @@ SYMBOL: cgi-root
"200 CGI output follows" response "200 CGI output follows" response
stdio get swap cgi-descriptor <process-stream> [ stdio get swap cgi-descriptor <process-stream> [
post? [ post? [
"raw-response" get "raw-response" get write flush
stream-write stream-flush
] when ] when
stdio get swap (stream-copy) stdio get swap (stream-copy)
] with-stream ; ] with-stream ;

3
extra/yahoo/yahoo-docs.factor
View File

@ -1,4 +1,5 @@
USING: yahoo help.syntax help.markup ; USING: help.syntax help.markup ;
IN: yahoo
HELP: search-yahoo HELP: search-yahoo
{ $values { "search" "a string" } { "num" "a positive integer" } { "seq" "sequence of arrays of length 3" } } { $values { "search" "a string" } { "num" "a positive integer" } { "seq" "sequence of arrays of length 3" } }