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

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

db4
Joe Groff 2008-01-17 20:44:18 -08:00
parent 7e53f873d6 1e265b001c
commit 0455603cbd
66 changed files with 2068 additions and 2055 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/compiler/constants/constants.factor
View File

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

4
core/compiler/test/redefine.factor
View File

@ -17,7 +17,7 @@ DEFER: x-2
{ x-1 } compile
\ x-2 word-xt eq?
\ x-2 word-xt =
] unit-test
] with-variable
@ -115,7 +115,7 @@ DEFER: g-test-3
"IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 3 + ;" eval
\ g-test-3 word-xt eq?
\ g-test-3 word-xt =
] unit-test
DEFER: g-test-5

2
core/compiler/test/templates-early.factor
View File

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

2
core/cpu/architecture/architecture.factor
View File

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

3
core/cpu/ppc/architecture/architecture.factor
View File

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

10
core/cpu/x86/architecture/architecture.factor
View File

@ -85,7 +85,7 @@ M: x86-backend %jump-label ( label -- ) JMP ;
M: x86-backend %jump-t ( label -- )
"flag" operand f v>operand CMP JNE ;
: (%dispatch) ( -- operand )
: (%dispatch) ( n -- operand )
! Load jump table base. We use a temporary register
! since on AMD64 we have to load a 64-bit immediate. On
! x86, this is redundant.
@ -94,18 +94,20 @@ M: x86-backend %jump-t ( label -- )
! Add jump table base
"offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
"n" operand "offset" operand ADD
"n" operand bootstrap-cell 8 = 14 9 ? [+] ;
"n" operand swap bootstrap-cell 8 = 14 9 ? + [+] ;
M: x86-backend %call-dispatch ( word-table# -- )
[ (%dispatch) CALL <label> dup JMP ] H{
[ 5 (%dispatch) CALL <label> dup JMP ] H{
{ +input+ { { f "n" } } }
{ +scratch+ { { f "offset" } } }
{ +clobber+ { "n" } }
} with-template ;
M: x86-backend %jump-dispatch ( -- )
[ %epilogue-later (%dispatch) JMP ] H{
[ %epilogue-later 0 (%dispatch) JMP ] H{
{ +input+ { { f "n" } } }
{ +scratch+ { { f "offset" } } }
{ +clobber+ { "n" } }
} with-template ;
M: x86-backend %dispatch-label ( word -- )

7
core/generator/fixup/fixup-docs.factor
View File

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

10
core/generator/fixup/fixup.factor
View File

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

24
core/generator/generator.factor
View File

@ -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 -- )
5array swap compiled get set-at ;
: finish-compiling ( word literals relocation labels code -- )
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 -- )
V{ } clone literal-table set
V{ } clone word-table set
compiled-stack-traces? swap f ?
literal-table get push ;
: init-generator ( -- )
compiled-stack-traces?
compiling-word get f ?
1vector literal-table set ;
: 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 ;

3
core/generic/standard/standard.factor
View File

@ -139,7 +139,8 @@ TUPLE: no-method object generic ;
M: standard-combination perform-combination
standard-combination-# (dispatch#) [
standard-methods single-combination
[ standard-methods ] keep "inline" word-prop
[ small-generic ] [ single-combination ] if
] with-variable ;
: default-hook-method ( word -- pair )

2
core/kernel/kernel-tests.factor
View File

@ -1,6 +1,6 @@
USING: arrays byte-arrays kernel kernel.private math memory
namespaces sequences tools.test math.private quotations
continuations prettyprint io.streams.string debugger ;
continuations prettyprint io.streams.string debugger assocs ;
IN: temporary
[ 0 ] [ f size ] unit-test

4
core/optimizer/known-words/known-words.factor
View File

@ -14,8 +14,8 @@ float-arrays combinators.private combinators ;
! its second-to-last input
{ <tuple> <tuple-boa> } [
[
node-in-d dup length 2 - swap nth dup value?
[ value-literal ] [ drop tuple ] if 1array f
dup node-in-d dup length 2 - swap nth node-literal
dup class? [ drop tuple ] unless 1array f
] "output-classes" set-word-prop
] each

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

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

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

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

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 ,
A get 5 bitroll-32 ,
E get ,
] { } make sum 4294967295 bitand ; inline
] { } make sum >32-bit ; inline
: set-vars ( temp -- )
! E = D; D = C; C = S^30(B); B = A; A = TEMP;

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

@ -9,7 +9,7 @@ IN: io.sniffer.filter.bsd
: bpf-align ( n -- n' )
#! Align to next higher word size
"long" heap-size 1- [ + ] keep bitnot bitand ;
"long" heap-size align ;
M: unix-io packet. ( string -- )
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.
! 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

3
extra/match/match.factor
View File

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

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

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

2
extra/multiline/multiline.factor
View File

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

4
extra/odbc/odbc-docs.factor
View File

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

7
extra/ogg/ogg.factor
View File

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

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

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

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

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

9
extra/ori/ori.factor
View File

@ -1,7 +1,7 @@
USING: kernel namespaces
math math.constants math.functions math.matrices math.vectors
sequences splitting self ;
sequences splitting self math.trig ;
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> set-ori-val ;

218
extra/peg/peg.factor
View File

@ -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 )
token-parser-symbol 2dup head? [
MATCH-VARS: ?token ;
: token-pattern ( -- quot )
[
?token 2dup head? [
dup >r length tail-slice r> <parse-result>
] [
2drop f
] if ;
] if
] ;
M: token-parser compile ( parser -- quot )
token-parser-symbol \ ?token token-pattern match-replace ;
TUPLE: satisfy-parser quot ;
M: satisfy-parser (parse) ( state parser -- result )
over empty? [
2drop f
MATCH-VARS: ?quot ;
: satisfy-pattern ( -- quot )
[
dup empty? [
drop f
] [
satisfy-parser-quot [ unclip-slice dup ] dip call [
unclip-slice dup ?quot call [
<parse-result>
] [
2drop f
] if
] 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 )
over empty? [
2drop f
MATCH-VARS: ?min ?max ;
: range-pattern ( -- quot )
[
dup empty? [
drop f
] [
0 pick nth dup rot
{ range-parser-min range-parser-max } get-slots between? [
0 over nth dup
?min ?max between? [
[ 1 tail-slice ] dip <parse-result>
] [
2drop f
] if
] 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 )
[ dup parse-result-remaining ] dip parse [
: seq-pattern ( -- quot )
[
dup [
dup parse-result-remaining ?quot call [
[ parse-result-remaining swap set-parse-result-remaining ] 2keep
parse-result-ast dup ignore = [ drop ] [ swap [ parse-result-ast push ] keep ] if
parse-result-ast dup ignore = [
drop
] [
swap [ parse-result-ast push ] keep
] if
] [
drop f
] if* ;
: (seq-parser) ( result parsers -- result )
dup empty? not pick and [
unclip swap [ do-seq-parser ] dip (seq-parser)
] if*
] [
drop
] if ;
drop f
] if
] ;
M: seq-parser (parse) ( state parser -- result )
seq-parser-parsers [ V{ } clone <parse-result> ] dip (seq-parser) ;
M: seq-parser compile ( parser -- quot )
[
[ V{ } clone <parse-result> ] %
seq-parser-parsers [ compile \ ?quot seq-pattern match-replace % ] each
] [ ] make ;
TUPLE: choice-parser parsers ;
: (choice-parser) ( state parsers -- result )
dup empty? [
2drop f
] [
unclip pick swap parse [
2nip
] [
(choice-parser)
] if*
] if ;
: choice-pattern ( -- quot )
[
dup [
M: choice-parser (parse) ( state parser -- result )
choice-parser-parsers (choice-parser) ;
] [
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 )
2dup parse-result-remaining swap parse [
: (repeat0) ( quot result -- result )
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 )
{ parse-result-remaining parse-result-ast }
get-slots 1vector <parse-result> ;
: repeat0-pattern ( -- quot )
[
?quot swap (repeat0)
] ;
M: repeat0-parser (parse) ( state parser -- result )
repeat0-parser-p1 2dup parse [
nipd clone-result (repeat-parser)
] [
drop V{ } clone <parse-result>
] if* ;
M: repeat0-parser compile ( parser -- quot )
[
[ V{ } clone <parse-result> ] %
repeat0-parser-p1 compile \ ?quot repeat0-pattern match-replace %
] [ ] make ;
TUPLE: repeat1-parser p1 ;
M: repeat1-parser (parse) ( state parser -- result )
repeat1-parser-p1 tuck parse dup [ clone-result (repeat-parser) ] [ nip ] if ;
: repeat1-pattern ( -- quot )
[
?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 )
dupd optional-parser-p1 parse swap f <parse-result> or ;
: optional-pattern ( -- quot )
[
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 )
dupd ensure-parser-p1 parse [
: ensure-pattern ( -- quot )
[
dup ?quot call [
ignore <parse-result>
] [
drop f
] if ;
] 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 )
dupd ensure-not-parser-p1 parse [
: ensure-not-pattern ( -- quot )
[
dup ?quot call [
drop f
] [
ignore <parse-result>
] if ;
] 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 )
tuck action-parser-p1 parse dup [
dup parse-result-ast rot action-parser-quot call
MATCH-VARS: ?action ;
: action-pattern ( -- quot )
[
?quot call dup [
dup parse-result-ast ?action call
swap [ set-parse-result-ast ] keep
] [
nip
] if ;
] 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 )
[ left-trim-slice ] dip sp-parser-p1 parse ;
M: sp-parser compile ( parser -- quot )
[
\ left-trim-slice , sp-parser-p1 compile %
] [ ] make ;
TUPLE: delay-parser quot ;
M: delay-parser (parse) ( state parser -- result )
delay-parser-quot call parse ;
M: delay-parser compile ( parser -- quot )
[
delay-parser-quot % \ compile , \ call ,
] [ ] make ;
PRIVATE>

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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{
{ $syntax "AVL{ { key value }... }" }
@ -23,5 +24,4 @@ ARTICLE: { "avl" "intro" } "AVL trees"
{ $subsection >avl }
{ $subsection POSTPONE: AVL{ } ;
IN: trees.avl
ABOUT: { "avl" "intro" }

12
extra/trees/avl/avl.factor
View File

@ -6,10 +6,10 @@ IN: trees.avl
TUPLE: avl ;
INSTANCE: avl assoc
INSTANCE: avl tree-mixin
: <avl> ( -- tree )
avl construct-empty <tree> over set-delegate ;
avl construct-tree ;
TUPLE: avl-node balance ;
@ -148,11 +148,3 @@ M: avl assoc-like
\ } [ >avl ] parse-literal ; parsing
M: avl pprint-delims drop \ AVL{ \ } ;
! When tuple inheritance is used, the following lines won't be necessary
M: avl assoc-size tree-count ;
M: avl clear-assoc delegate clear-assoc ;
M: avl assoc-find >r tree-root r> find-node ;
M: avl clone dup assoc-clone-like ;
M: avl >pprint-sequence >alist ;
M: avl pprint-narrow? drop t ;

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{
{ $syntax "SPLAY{ { key value }... }" }
@ -23,5 +24,4 @@ ARTICLE: { "splay" "intro" } "Splay trees"
{ $subsection >splay }
{ $subsection POSTPONE: SPLAY{ } ;
IN: trees.splay
ABOUT: { "splay" "intro" }

19
extra/trees/splay/splay.factor
View File

@ -1,5 +1,5 @@
! Copyright (c) 2005 Mackenzie Straight.
! See http://factor.sf.net/license.txt for BSD license.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math namespaces sequences assocs parser
prettyprint.backend trees generic ;
IN: trees.splay
@ -7,10 +7,9 @@ IN: trees.splay
TUPLE: splay ;
: <splay> ( -- splay-tree )
\ splay construct-empty
<tree> over set-delegate ;
splay construct-tree ;
INSTANCE: splay assoc
INSTANCE: splay tree-mixin
: rotate-right ( node -- node )
dup node-left
@ -138,16 +137,6 @@ M: splay new-assoc
\ } [ >splay ] parse-literal ; parsing
M: splay assoc-like
drop dup splay? [
dup tree? [ <splay> tuck set-delegate ] [ >splay ] if
] unless ;
drop dup splay? [ >splay ] unless ;
M: splay pprint-delims drop \ SPLAY{ \ } ;
! When tuple inheritance is used, the following lines won't be necessary
M: splay assoc-size tree-count ;
M: splay clear-assoc delegate clear-assoc ;
M: splay assoc-find >r tree-root r> find-node ;
M: splay clone dup assoc-clone-like ;
M: splay >pprint-sequence >alist ;
M: splay pprint-narrow? drop t ;

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{
{ $syntax "TREE{ { key value }... }" }

31
extra/trees/trees.factor
View File

@ -5,11 +5,19 @@ prettyprint.private kernel.private assocs random combinators
parser prettyprint.backend ;
IN: trees
MIXIN: tree-mixin
TUPLE: tree root count ;
: <tree> ( -- tree )
f 0 tree construct-boa ;
INSTANCE: tree assoc
: construct-tree ( class -- tree )
construct-empty <tree> over set-delegate ; inline
INSTANCE: tree tree-mixin
INSTANCE: tree-mixin assoc
TUPLE: node key value left right ;
: <node> ( key value -- node )
@ -111,16 +119,13 @@ M: tree set-at ( value key tree -- )
{ [ t ] [ >r node-right r> find-node ] }
} cond ; inline
M: tree assoc-find ( tree quot -- key value ? )
M: tree-mixin assoc-find ( tree quot -- key value ? )
>r tree-root r> find-node ;
M: tree clear-assoc
M: tree-mixin clear-assoc
0 over set-tree-count
f swap set-tree-root ;
M: tree assoc-size
tree-count ;
: copy-node-contents ( new old -- )
dup node-key pick set-node-key node-value swap set-node-value ;
@ -189,16 +194,14 @@ M: tree clone dup assoc-clone-like ;
: >tree ( assoc -- tree )
T{ tree f f 0 } assoc-clone-like ;
GENERIC: tree-assoc-like ( assoc -- tree )
M: tuple tree-assoc-like ! will need changes for tuple inheritance
dup delegate dup tree? [ nip ] [ drop >tree ] if ;
M: tree tree-assoc-like ;
M: assoc tree-assoc-like >tree ;
M: tree assoc-like drop tree-assoc-like ;
M: tree-mixin assoc-like drop dup tree? [ >tree ] unless ;
: TREE{
\ } [ >tree ] parse-literal ; parsing
M: tree pprint-delims drop \ TREE{ \ } ;
M: tree >pprint-sequence >alist ;
M: tree pprint-narrow? drop t ;
M: tree-mixin assoc-size tree-count ;
M: tree-mixin clone dup assoc-clone-like ;
M: tree-mixin >pprint-sequence >alist ;
M: tree-mixin pprint-narrow? drop t ;

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{
{ $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.
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
stream-write stream-flush
"raw-response" get write flush
] when
stdio get swap (stream-copy)
] with-stream ;

103
extra/xmode/loader/loader.factor
View File

@ -1,59 +1,11 @@
USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
xml.utilities xml assocs kernel combinators sequences
math.parser namespaces parser xmode.utilities regexp io.files ;
USING: xmode.loader.syntax xmode.tokens xmode.rules
xmode.keyword-map xml.data xml.utilities xml assocs kernel
combinators sequences math.parser namespaces parser
xmode.utilities regexp io.files ;
IN: xmode.loader
! Based on org.gjt.sp.jedit.XModeHandler
SYMBOL: ignore-case?
! Attribute utilities
: string>boolean ( string -- ? ) "TRUE" = ;
: string>match-type ( string -- obj )
{
{ "RULE" [ f ] }
{ "CONTEXT" [ t ] }
[ string>token ]
} case ;
: string>rule-set-name "MAIN" or ;
! PROP, PROPS
: parse-prop-tag ( tag -- key value )
"NAME" over at "VALUE" rot at ;
: parse-props-tag ( tag -- assoc )
child-tags
[ parse-prop-tag ] H{ } map>assoc ;
: position-attrs ( tag -- at-line-start? at-whitespace-end? at-word-start? )
! XXX Wrong logic!
{ "AT_LINE_START" "AT_WHITESPACE_END" "AT_WORD_START" }
swap [ at string>boolean ] curry map first3 ;
: parse-literal-matcher ( tag -- matcher )
dup children>string
ignore-case? get <string-matcher>
swap position-attrs <matcher> ;
: parse-regexp-matcher ( tag -- matcher )
dup children>string ignore-case? get <regexp>
swap position-attrs <matcher> ;
! SPAN's children
<TAGS: parse-begin/end-tag
TAG: BEGIN
! XXX
parse-literal-matcher swap set-rule-start ;
TAG: END
! XXX
parse-literal-matcher swap set-rule-end ;
TAGS>
! RULES and its children
<TAGS: parse-rule-tag
@ -66,56 +18,12 @@ TAG: IMPORT ( rule-set tag -- )
TAG: TERMINATE ( rule-set tag -- )
"AT_CHAR" swap at string>number swap set-rule-set-terminate-char ;
: (parse-rule-tag) ( rule-set tag specs class -- )
construct-rule swap init-from-tag swap add-rule ; inline
: RULE:
scan scan-word
parse-definition { } make
swap [ (parse-rule-tag) ] 2curry (TAG:) ; parsing
: shared-tag-attrs
{ "TYPE" string>token set-rule-body-token } , ; inline
: delegate-attr
{ "DELEGATE" f set-rule-delegate } , ;
: regexp-attr
{ "HASH_CHAR" f set-rule-chars } , ;
: match-type-attr
{ "MATCH_TYPE" string>match-type set-rule-match-token } , ;
: span-attrs
{ "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } ,
{ "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } ,
{ "NO_ESCAPE" string>boolean set-rule-no-escape? } , ;
: literal-start
[ parse-literal-matcher swap set-rule-start ] , ;
: regexp-start
[ parse-regexp-matcher swap set-rule-start ] , ;
: literal-end
[ parse-literal-matcher swap set-rule-end ] , ;
RULE: SEQ seq-rule
shared-tag-attrs delegate-attr literal-start ;
RULE: SEQ_REGEXP seq-rule
shared-tag-attrs delegate-attr regexp-attr regexp-start ;
: parse-begin/end-tags
[
! XXX: handle position attrs on span tag itself
child-tags [ parse-begin/end-tag ] with each
] , ;
: init-span-tag [ drop init-span ] , ;
: init-eol-span-tag [ drop init-eol-span ] , ;
RULE: SPAN span-rule
shared-tag-attrs delegate-attr match-type-attr span-attrs parse-begin/end-tags init-span-tag ;
@ -134,9 +42,6 @@ RULE: MARK_FOLLOWING mark-following-rule
RULE: MARK_PREVIOUS mark-previous-rule
shared-tag-attrs match-type-attr literal-start ;
: parse-keyword-tag ( tag keyword-map -- )
>r dup name-tag string>token swap children>string r> set-at ;
TAG: KEYWORDS ( rule-set tag -- key value )
ignore-case? get <keyword-map>
swap child-tags [ over parse-keyword-tag ] each

101
extra/xmode/loader/syntax/syntax.factor Normal file
View File

@ -0,0 +1,101 @@
USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
xml.utilities xml assocs kernel combinators sequences
math.parser namespaces parser xmode.utilities regexp io.files ;
IN: xmode.loader.syntax
SYMBOL: ignore-case?
! Rule tag parsing utilities
: (parse-rule-tag) ( rule-set tag specs class -- )
construct-rule swap init-from-tag swap add-rule ; inline
: RULE:
scan scan-word
parse-definition { } make
swap [ (parse-rule-tag) ] 2curry (TAG:) ; parsing
! Attribute utilities
: string>boolean ( string -- ? ) "TRUE" = ;
: string>match-type ( string -- obj )
{
{ "RULE" [ f ] }
{ "CONTEXT" [ t ] }
[ string>token ]
} case ;
: string>rule-set-name "MAIN" or ;
! PROP, PROPS
: parse-prop-tag ( tag -- key value )
"NAME" over at "VALUE" rot at ;
: parse-props-tag ( tag -- assoc )
child-tags
[ parse-prop-tag ] H{ } map>assoc ;
: position-attrs ( tag -- at-line-start? at-whitespace-end? at-word-start? )
! XXX Wrong logic!
{ "AT_LINE_START" "AT_WHITESPACE_END" "AT_WORD_START" }
swap [ at string>boolean ] curry map first3 ;
: parse-literal-matcher ( tag -- matcher )
dup children>string
ignore-case? get <string-matcher>
swap position-attrs <matcher> ;
: parse-regexp-matcher ( tag -- matcher )
dup children>string ignore-case? get <regexp>
swap position-attrs <matcher> ;
: shared-tag-attrs
{ "TYPE" string>token set-rule-body-token } , ; inline
: delegate-attr
{ "DELEGATE" f set-rule-delegate } , ;
: regexp-attr
{ "HASH_CHAR" f set-rule-chars } , ;
: match-type-attr
{ "MATCH_TYPE" string>match-type set-rule-match-token } , ;
: span-attrs
{ "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } ,
{ "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } ,
{ "NO_ESCAPE" string>boolean set-rule-no-escape? } , ;
: literal-start
[ parse-literal-matcher swap set-rule-start ] , ;
: regexp-start
[ parse-regexp-matcher swap set-rule-start ] , ;
: literal-end
[ parse-literal-matcher swap set-rule-end ] , ;
! SPAN's children
<TAGS: parse-begin/end-tag
TAG: BEGIN
! XXX
parse-literal-matcher swap set-rule-start ;
TAG: END
! XXX
parse-literal-matcher swap set-rule-end ;
TAGS>
: parse-begin/end-tags
[
! XXX: handle position attrs on span tag itself
child-tags [ parse-begin/end-tag ] with each
] , ;
: init-span-tag [ drop init-span ] , ;
: init-eol-span-tag [ drop init-eol-span ] , ;
: parse-keyword-tag ( tag keyword-map -- )
>r dup name-tag string>token swap children>string r> set-at ;

16
extra/xmode/tokens/tokens.factor
View File

@ -1,20 +1,18 @@
USING: parser words sequences namespaces kernel assocs ;
USING: parser words sequences namespaces kernel assocs
compiler.units ;
IN: xmode.tokens
! Based on org.gjt.sp.jedit.syntax.Token
SYMBOL: tokens
: string>token ( string -- id ) tokens get at ;
: TOKENS:
";" parse-tokens [
[
{ "COMMENT1" "COMMENT2" "COMMENT3" "COMMENT4" "DIGIT" "FUNCTION" "INVALID" "KEYWORD1" "KEYWORD2" "KEYWORD3" "KEYWORD4" "LABEL" "LITERAL1" "LITERAL2" "LITERAL3" "LITERAL4" "MARKUP" "OPERATOR" "END" "NULL" } [
create-in dup define-symbol
dup word-name swap
] H{ } map>assoc tokens set-global ; parsing
] H{ } map>assoc tokens set-global
] with-compilation-unit
TOKENS: COMMENT1 COMMENT2 COMMENT3 COMMENT4 DIGIT FUNCTION
INVALID KEYWORD1 KEYWORD2 KEYWORD3 KEYWORD4 LABEL LITERAL1
LITERAL2 LITERAL3 LITERAL4 MARKUP OPERATOR END NULL ;
: string>token ( string -- id ) tokens get at ;
TUPLE: token str id ;

2
extra/xmode/utilities/utilities.factor
View File

@ -55,4 +55,4 @@ SYMBOL: tag-handler-word
: TAGS>
tag-handler-word get
tag-handlers get >alist [ >r dup name-tag r> case ] curry
define-compound ; parsing
define ; parsing

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
{ $values { "search" "a string" } { "num" "a positive integer" } { "seq" "sequence of arrays of length 3" } }

2
misc/factor.el
View File

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

6
vm/code_gc.c
View File

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

6
vm/code_gc.h
View File

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

34
vm/code_heap.c
View File

@ -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,
code_start,literals_start,words_start);
F_FIXNUM absolute_value = compute_code_rel(
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,2));
F_ARRAY *labels = untag_array(array_nth(compiled_code,3));
F_ARRAY *code = untag_array(array_nth(compiled_code,4));
F_ARRAY *relocation = untag_array(array_nth(compiled_code,1));
F_ARRAY *labels = untag_array(array_nth(compiled_code,2));
F_ARRAY *code = untag_array(array_nth(compiled_code,3));
REGISTER_UNTAGGED(alist);
REGISTER_UNTAGGED(word);
@ -360,7 +345,6 @@ DEFINE_PRIMITIVE(modify_code_heap)
code,
labels,
relocation,
words,
literals);
UNREGISTER_UNTAGGED(word);

3
vm/code_heap.h
View File

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

12
vm/image.c
View File

@ -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,words_start,words_end);
}
relocate_code_block(relocating,code_start,reloc_start,literals_start);
}
void relocate_code()

2
vm/layouts.h
View File

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

1
vm/profiler.c
View File

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

12
vm/quotations.c
View File

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