Merge git://factorcode.org/git/factor

core/compiler/constants/constants.factor

@@ -19,4 +19,4 @@ IN: compiler.constants
 : class-hash-offset bootstrap-cell object tag-number - ;
 : word-xt-offset 8 bootstrap-cells object tag-number - ;
 : word-code-offset 9 bootstrap-cells object tag-number - ;
-: compiled-header-size 8 bootstrap-cells ;
+: compiled-header-size 4 bootstrap-cells ;

core/compiler/test/templates-early.factor

@@ -44,7 +44,7 @@ words kernel math effects definitions compiler.units ;
 [
     [ ] [ init-templates ] unit-test
 
-    [ ] [ \ + init-generator ] unit-test
+    [ ] [ init-generator ] unit-test
 
     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 

core/cpu/architecture/architecture.factor

@@ -72,8 +72,6 @@ HOOK: %jump-dispatch compiler-backend ( -- )
 
 HOOK: %dispatch-label compiler-backend ( word -- )
 
-HOOK: %end-dispatch compiler-backend ( label -- )
-
 ! Return to caller
 HOOK: %return compiler-backend ( -- )
 

core/cpu/ppc/architecture/architecture.factor

@@ -144,9 +144,6 @@ M: ppc-backend %jump-dispatch ( -- )
 M: ppc-backend %dispatch-label ( word -- )
     0 , rc-absolute-cell rel-word ;
 
-M: ppc-backend %end-dispatch ( label -- )
-    resolve-label ;
-
 M: ppc-backend %return ( -- ) %epilogue-later BLR ;
 
 M: ppc-backend %unwind drop %return ;

core/generator/fixup/fixup-docs.factor

@@ -13,13 +13,6 @@ HELP: add-literal
 { $values { "obj" object } { "n" integer } }
 { $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;
 
-HELP: word-table
-{ $var-description "Holds a vector of words called from the currently compiling word." } ;
-
-HELP: add-word
-{ $values { "word" word } { "n" integer } }
-{ $description "Adds a word to the " { $link word-table } ", if it is not already there, and outputs the index of the word in the table. This literal can then be used as an argument for a " { $link rt-xt } " relocation with " { $link rel-fixup } "." } ;
-
 HELP: string>symbol
 { $values { "str" string } { "alien" alien } }
 { $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."

core/generator/fixup/fixup.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables
 kernel kernel.private math namespaces sequences words
@@ -110,10 +110,6 @@ SYMBOL: literal-table
 
 : add-literal ( obj -- n ) literal-table get push-new* ;
 
-SYMBOL: word-table
-
-: add-word ( word -- n ) word-table get push-new* ;
-
 : string>symbol ( str -- alien )
     wince? [ string>u16-alien ] [ string>char-alien ] if ;
 
@@ -125,10 +121,8 @@ SYMBOL: word-table
     add-dlsym-literals
     r> r> rt-dlsym rel-fixup ;
 
-: rel-dispatch ( word-table# class -- ) rt-dispatch rel-fixup ;
-
 : rel-word ( word class -- )
-    >r add-word r> rt-xt rel-fixup ;
+    >r add-literal r> rt-xt rel-fixup ;
 
 : rel-primitive ( word class -- )
     >r word-def first r> rt-primitive rel-fixup ;

core/generator/generator.factor

@@ -1,22 +1,20 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes combinators cpu.architecture
 effects generator.fixup generator.registers generic hashtables
 inference inference.backend inference.dataflow io kernel
 kernel.private layouts math namespaces optimizer prettyprint
-quotations sequences system threads words ;
+quotations sequences system threads words vectors ;
 IN: generator
 
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: 5array 3array >r 2array r> append ;
-
 : begin-compiling ( word -- )
     f swap compiled get set-at ;
 
-: finish-compiling ( word literals words relocation labels code -- )
+: finish-compiling ( word literals relocation labels code -- )
-    5array swap compiled get set-at ;
+    4array swap compiled get set-at ;
 
 : queue-compile ( word -- )
     {
@@ -38,20 +36,18 @@ SYMBOL: current-label-start
 
 : compiled-stack-traces? ( -- ? ) 36 getenv ;
 
-: init-generator ( compiling -- )
+: init-generator ( -- )
-    V{ } clone literal-table set
+    compiled-stack-traces?
-    V{ } clone word-table set
+    compiling-word get  f ?
-    compiled-stack-traces? swap f ?
+    1vector literal-table set ;
-    literal-table get push ;
 
 : generate-1 ( word label node quot -- )
     pick begin-compiling [
         roll compiling-word set
         pick compiling-label set
-        compiling-word get init-generator
+        init-generator
         call
         literal-table get >array
-        word-table get >array
     ] { } make fixup finish-compiling ;
 
 GENERIC: generate-node ( node -- next )
@@ -182,7 +178,7 @@ M: #dispatch generate-node
         %jump-dispatch dispatch-branches
     ] [
         0 frame-required
-        %call-dispatch >r dispatch-branches r> %end-dispatch
+        %call-dispatch >r dispatch-branches r> resolve-label
     ] if
     init-templates iterate-next ;
 

extra/balloon-bomber/balloon-bomber-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! 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
 
 HELP: run 

extra/cpu/8080/8080-docs.factor

@@ -1,39 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! 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
 
-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"
 "The cpu-8080 library provides an emulator for the Intel 8080 CPU"

extra/cpu/8080/authors.txt

@@ -0,0 +1 @@
+Chris Double

extra/cpu/8080/emulator/authors.txt

@@ -0,0 +1 @@
+Chris Double

extra/cpu/8080/emulator/emulator-docs.factor

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

extra/cpu/8080/emulator/summary.txt

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

extra/cpu/8080/emulator/tags.txt

@@ -0,0 +1 @@
+emulator

extra/cpu/8080/instructions/instructions.factor

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

extra/cpu/8080/summary.txt

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

extra/cpu/8080/tags.txt

@@ -0,0 +1 @@
+emulator

extra/lunar-rescue/lunar-rescue-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! 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 
 
 HELP: run 

extra/match/match.factor

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

extra/multiline/multiline-docs.factor

@@ -1,4 +1,6 @@
-USING: help.markup help.syntax multiline ;
+USING: help.markup help.syntax ;
+
+IN: multiline
 
 HELP: STRING:
 { $syntax "STRING: name\nfoo\n;" }

extra/multiline/multiline.factor

@@ -16,7 +16,7 @@ IN: multiline
 
 : STRING:
     CREATE dup reset-generic
-    parse-here 1quotation define-compound ; parsing
+    parse-here 1quotation define ; parsing
 
 : (parse-multiline-string) ( start-index end-text -- end-index )
     lexer get line-text 2dup start

extra/odbc/odbc-docs.factor

@@ -1,6 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup odbc threads ;
+USING: help.syntax help.markup threads ;
+
+IN: odbc
 
 HELP: odbc-init 
 { $values { "env" "an ODBC environment handle" } } 

extra/ogg/ogg.factor

@@ -4,14 +4,13 @@
 USING: kernel system combinators alien alien.syntax ;
 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
 

extra/ogg/theora/theora.factor

@@ -4,14 +4,13 @@
 USING: kernel system combinators alien alien.syntax ;
 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
 

extra/ogg/vorbis/vorbis.factor

@@ -4,14 +4,13 @@
 USING: kernel system combinators alien alien.syntax ;
 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
 

extra/peg/peg.factor

@@ -1,12 +1,16 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 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
 
 TUPLE: parse-result remaining ast ;
 
-GENERIC: (parse) ( state parser -- result )
+GENERIC: compile ( parser -- quot )
+
+: (parse) ( state parser -- result )
+  compile call ;
+
 
 <PRIVATE
 
@@ -72,135 +76,199 @@ PRIVATE>
 
 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
-    ] 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 ;
 
-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 ;
 
-: 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 ;
-  
-: (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 ;
 
-: (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-ast swap [ parse-result-ast push ] keep
-    (repeat-parser) 
+    (repeat0) 
  ] [
     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 ;
 
-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 ;
 
-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 ;
 
-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 ;
 
-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 ;
 
-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 )
   #! Return a new string without any leading whitespace
@@ -211,13 +279,17 @@ M: action-parser (parse) ( state parser -- result )
 
 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 ;
 
-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>
 

extra/peg/search/search-docs.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! 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
 { $values

extra/postgresql/libpq/libpq.factor

@@ -8,14 +8,13 @@
 USING: alien alien.syntax combinators system ;
 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
 : CONNECTION_OK 					HEX: 0 ; inline

extra/space-invaders/space-invaders-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! 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 
 
 HELP: run 

extra/space-invaders/space-invaders.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! 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
        ui.gestures ui.gadgets ui.render opengl.gl system 
        threads concurrency match ui byte-arrays combinators.lib

extra/sqlite/lib/lib.factor

@@ -12,14 +12,13 @@ IN: sqlite.lib
 USING: alien compiler kernel math namespaces sequences strings alien.syntax
     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
 : SQLITE_OK           0   ; inline ! Successful result

extra/sqlite/sqlite-docs.factor

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

extra/sqlite/tuple-db/tuple-db-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006 Chris Double.
 ! 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
 
 ARTICLE: { "sqlite" "tuple-db-loading" } "Loading"

extra/trees/avl/avl-docs.factor

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

extra/trees/splay/splay-docs.factor

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

extra/trees/trees-docs.factor

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

extra/tuple-syntax/tuple-syntax-docs.factor

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

extra/webapps/cgi/cgi.factor

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

extra/yahoo/yahoo-docs.factor

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

misc/factor.el

@@ -102,7 +102,7 @@
   (setq font-lock-defaults
 	'(factor-font-lock-keywords nil nil nil nil))
   (set-syntax-table factor-mode-syntax-table)
-  (run-hooks 'factor-mode-hooks))
+  (run-hooks 'factor-mode-hook))
 
 (add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
 

vm/code_gc.c

@@ -245,17 +245,13 @@ void iterate_code_heap(CODE_HEAP_ITERATOR iter)
 
 /* Copy all literals referenced from a code block to newspace */
 void collect_literals_step(F_COMPILED *compiled, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
+	CELL reloc_start, CELL literals_start)
 {
 	CELL scan;
-
 	CELL literal_end = literals_start + compiled->literals_length;
 
 	for(scan = literals_start; scan < literal_end; scan += CELLS)
 		copy_handle((CELL*)scan);
-
-	for(scan = words_start; scan < words_end; scan += CELLS)
-		copy_handle((CELL*)scan);
 }
 
 /* Copy literals referenced from all code blocks to newspace */

vm/code_gc.h

@@ -48,17 +48,15 @@ INLINE F_BLOCK *next_block(F_HEAP *heap, F_BLOCK *block)
 F_HEAP code_heap;
 
 typedef void (*CODE_HEAP_ITERATOR)(F_COMPILED *compiled, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end);
+	CELL reloc_start, CELL literals_start);
 
 INLINE void iterate_code_heap_step(F_COMPILED *compiled, CODE_HEAP_ITERATOR iter)
 {
 	CELL code_start = (CELL)(compiled + 1);
 	CELL reloc_start = code_start + compiled->code_length;
 	CELL literals_start = reloc_start + compiled->reloc_length;
-	CELL words_start = literals_start + compiled->literals_length;
-	CELL words_end = words_start + compiled->words_length;
 
-	iter(compiled,code_start,reloc_start,literals_start,words_start,words_end);
+	iter(compiled,code_start,reloc_start,literals_start);
 }
 
 INLINE F_BLOCK *compiled_to_block(F_COMPILED *compiled)

vm/code_heap.c

@@ -38,7 +38,7 @@ void *get_rel_symbol(F_REL *rel, CELL literals_start)
 
 /* Compute an address to store at a relocation */
 INLINE CELL compute_code_rel(F_REL *rel,
-	CELL code_start, CELL literals_start, CELL words_start)
+	CELL code_start, CELL literals_start)
 {
 	switch(REL_TYPE(rel))
 	{
@@ -48,10 +48,8 @@ INLINE CELL compute_code_rel(F_REL *rel,
 		return (CELL)get_rel_symbol(rel,literals_start);
 	case RT_LITERAL:
 		return CREF(literals_start,REL_ARGUMENT(rel));
-	case RT_DISPATCH:
-		return CREF(words_start,REL_ARGUMENT(rel));
 	case RT_XT:
-		return (CELL)untag_word(get(CREF(words_start,REL_ARGUMENT(rel))))->xt;
+		return (CELL)untag_word(get(CREF(literals_start,REL_ARGUMENT(rel))))->xt;
 	case RT_HERE:
 		return rel->offset + code_start;
 	case RT_LABEL:
@@ -127,7 +125,7 @@ void apply_relocation(CELL class, CELL offset, F_FIXNUM absolute_value)
 
 /* Perform all fixups on a code block */
 void relocate_code_block(F_COMPILED *relocating, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
+	CELL reloc_start, CELL literals_start)
 {
 	if(reloc_start != literals_start)
 	{
@@ -138,8 +136,8 @@ void relocate_code_block(F_COMPILED *relocating, CELL code_start,
 		{
 			CELL offset = rel->offset + code_start;
 
-			F_FIXNUM absolute_value = compute_code_rel(rel,
+			F_FIXNUM absolute_value = compute_code_rel(
-				code_start,literals_start,words_start);
+				rel,code_start,literals_start);
 
 			apply_relocation(REL_CLASS(rel),offset,absolute_value);
 
@@ -228,27 +226,23 @@ F_COMPILED *add_compiled_block(
 	F_ARRAY *code,
 	F_ARRAY *labels,
 	F_ARRAY *relocation,
-	F_ARRAY *words,
 	F_ARRAY *literals)
 {
 	CELL code_format = compiled_code_format();
 
 	CELL code_length = align8(array_capacity(code) * code_format);
 	CELL rel_length = array_capacity(relocation) * sizeof(unsigned int);
-	CELL words_length = (words ? array_capacity(words) * CELLS : 0);
 	CELL literals_length = array_capacity(literals) * CELLS;
 
 	REGISTER_UNTAGGED(code);
 	REGISTER_UNTAGGED(labels);
 	REGISTER_UNTAGGED(relocation);
-	REGISTER_UNTAGGED(words);
 	REGISTER_UNTAGGED(literals);
 
 	CELL here = allot_code_block(sizeof(F_COMPILED) + code_length
-		+ rel_length + literals_length + words_length);
+		+ rel_length + literals_length);
 
 	UNREGISTER_UNTAGGED(literals);
-	UNREGISTER_UNTAGGED(words);
 	UNREGISTER_UNTAGGED(relocation);
 	UNREGISTER_UNTAGGED(labels);
 	UNREGISTER_UNTAGGED(code);
@@ -259,7 +253,6 @@ F_COMPILED *add_compiled_block(
 	header->code_length = code_length;
 	header->reloc_length = rel_length;
 	header->literals_length = literals_length;
-	header->words_length = words_length;
 
 	here += sizeof(F_COMPILED);
 
@@ -277,13 +270,6 @@ F_COMPILED *add_compiled_block(
 	deposit_objects(here,literals);
 	here += literals_length;
 
-	/* words */
-	if(words)
-	{
-		deposit_objects(here,words);
-		here += words_length;
-	}
-
 	/* fixup labels */
 	if(labels)
 		fixup_labels(labels,code_format,code_start);
@@ -347,10 +333,9 @@ DEFINE_PRIMITIVE(modify_code_heap)
 			F_ARRAY *compiled_code = untag_array(data);
 
 			F_ARRAY *literals = untag_array(array_nth(compiled_code,0));
-			F_ARRAY *words = untag_array(array_nth(compiled_code,1));
+			F_ARRAY *relocation = untag_array(array_nth(compiled_code,1));
-			F_ARRAY *relocation = untag_array(array_nth(compiled_code,2));
+			F_ARRAY *labels = untag_array(array_nth(compiled_code,2));
-			F_ARRAY *labels = untag_array(array_nth(compiled_code,3));
+			F_ARRAY *code = untag_array(array_nth(compiled_code,3));
-			F_ARRAY *code = untag_array(array_nth(compiled_code,4));
 
 			REGISTER_UNTAGGED(alist);
 			REGISTER_UNTAGGED(word);
@@ -360,7 +345,6 @@ DEFINE_PRIMITIVE(modify_code_heap)
 				code,
 				labels,
 				relocation,
-				words,
 				literals);
 
 			UNREGISTER_UNTAGGED(word);

vm/code_heap.h

@@ -54,7 +54,7 @@ typedef struct {
 } F_REL;
 
 void relocate_code_block(F_COMPILED *relocating, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end);
+	CELL reloc_start, CELL literals_start);
 
 void default_word_code(F_WORD *word, bool relocate);
 
@@ -65,7 +65,6 @@ F_COMPILED *add_compiled_block(
 	F_ARRAY *code,
 	F_ARRAY *labels,
 	F_ARRAY *rel,
-	F_ARRAY *words,
 	F_ARRAY *literals);
 
 CELL compiled_code_format(void);

vm/image.c

@@ -179,7 +179,7 @@ void fixup_word(F_WORD *word)
 	{
 		code_fixup((CELL)&word->code);
 		if(word->profiling) code_fixup((CELL)&word->profiling);
-		update_word_xt(word);
+		code_fixup((CELL)&word->xt);
 	}
 }
 
@@ -262,7 +262,7 @@ void relocate_data()
 }
 
 void fixup_code_block(F_COMPILED *relocating, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
+	CELL reloc_start, CELL literals_start)
 {
 	/* relocate literal table data */
 	CELL scan;
@@ -271,14 +271,8 @@ void fixup_code_block(F_COMPILED *relocating, CELL code_start,
 	for(scan = literals_start; scan < literal_end; scan += CELLS)
 		data_fixup((CELL*)scan);
 
-	for(scan = words_start; scan < words_end; scan += CELLS)
-		data_fixup((CELL*)scan);
-
 	if(reloc_start != literals_start)
-	{
+		relocate_code_block(relocating,code_start,reloc_start,literals_start);
-		relocate_code_block(relocating,code_start,reloc_start,
-			literals_start,words_start,words_end);
-	}
 }
 
 void relocate_code()

vm/layouts.h

@@ -151,8 +151,6 @@ typedef struct
 	CELL code_length; /* # bytes */
 	CELL reloc_length; /* # bytes */
 	CELL literals_length; /* # bytes */
-	CELL words_length; /* # bytes */
-	CELL padding[3];
 } F_COMPILED;
 
 /* Assembly code makes assumptions about the layout of this struct */

vm/profiler.c

@@ -25,7 +25,6 @@ F_COMPILED *compile_profiling_stub(F_WORD *word)
 		untag_object(code),
 		NULL, /* no labels */
 		untag_object(relocation),
-		NULL, /* no words */
 		untag_object(literals));
 }
 

vm/quotations.c

@@ -116,9 +116,6 @@ void jit_compile(CELL quot, bool relocate)
 	GROWABLE_ARRAY(literals);
 	REGISTER_ROOT(literals);
 
-	GROWABLE_ARRAY(words);
-	REGISTER_ROOT(words);
-
 	GROWABLE_ADD(literals,stack_traces_p() ? quot : F);
 
 	bool stack_frame = jit_stack_frame_p(untag_object(array));
@@ -144,19 +141,19 @@ void jit_compile(CELL quot, bool relocate)
 			current stack frame. */
 			word = untag_object(obj);
 
-			GROWABLE_ADD(words,array_nth(untag_object(array),i));
+			GROWABLE_ADD(literals,array_nth(untag_object(array),i));
 
 			if(i == length - 1)
 			{
 				if(stack_frame)
 					EMIT(JIT_EPILOG,0);
 
-				EMIT(JIT_WORD_JUMP,words_count - 1);
+				EMIT(JIT_WORD_JUMP,literals_count - 1);
 
 				tail_call = true;
 			}
 			else
-				EMIT(JIT_WORD_CALL,words_count - 1);
+				EMIT(JIT_WORD_CALL,literals_count - 1);
 			break;
 		case WRAPPER_TYPE:
 			wrapper = untag_object(obj);
@@ -220,14 +217,12 @@ void jit_compile(CELL quot, bool relocate)
 	GROWABLE_TRIM(code);
 	GROWABLE_TRIM(relocation);
 	GROWABLE_TRIM(literals);
-	GROWABLE_TRIM(words);
 
 	F_COMPILED *compiled = add_compiled_block(
 		QUOTATION_TYPE,
 		untag_object(code),
 		NULL,
 		untag_object(relocation),
-		untag_object(words),
 		untag_object(literals));
 
 	set_quot_xt(untag_object(quot),compiled);
@@ -235,7 +230,6 @@ void jit_compile(CELL quot, bool relocate)
 	if(relocate)
 		iterate_code_heap_step(compiled,relocate_code_block);
 
-	UNREGISTER_ROOT(words);
 	UNREGISTER_ROOT(literals);
 	UNREGISTER_ROOT(relocation);
 	UNREGISTER_ROOT(code);