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 2009-10-03 10:02:26 -05:00
parent 4e024cbbc2 24ba367ca0
commit 74f15cfe8c
46 changed files with 882 additions and 702 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/command-line/command-line-docs.factor
View File

@ -25,7 +25,7 @@ HELP: (command-line)
{ $description "Outputs the command line parameters which were passed to the Factor VM on startup." } ; { $description "Outputs the command line parameters which were passed to the Factor VM on startup." } ;
HELP: command-line HELP: command-line
{ $var-description "The command line parameters which follow the name of the script on the command line." } ; { $var-description "When Factor is run with a script, this variable contains command line parameters which follow the name of the script on the command line. In deployed applications, it contains the entire command line. In all other cases it is set to " { $link f } "." } ;
HELP: main-vocab-hook HELP: main-vocab-hook
{ $var-description "Global variable holding a quotation which outputs a vocabulary name. UI backends set this so that the UI can automatically start if the prerequisites are met (for example, " { $snippet "$DISPLAY" } " being set on X11)." } ; { $var-description "Global variable holding a quotation which outputs a vocabulary name. UI backends set this so that the UI can automatically start if the prerequisites are met (for example, " { $snippet "$DISPLAY" } " being set on X11)." } ;
@ -129,18 +129,16 @@ $nl
"\"factor-rc\" rc-path print" "\"factor-rc\" rc-path print"
"\"factor-boot-rc\" rc-path print" "\"factor-boot-rc\" rc-path print"
} }
"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration, adds an additional vocabulary root (see " { $link "vocabs.roots" } "), and increases the font size in the UI by setting the DPI (dots-per-inch) variable:" "Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration:"
{ $code { $code
"USING: editors.gvim vocabs.loader ui.freetype namespaces sequences ;" "USING: editors.gvim namespaces ;"
"\"/opt/local/bin\" \\ gvim-path set-global" "\"/opt/local/bin\" \\ gvim-path set-global"
"\"/home/jane/src/\" vocab-roots get push"
"100 dpi set-global"
} ; } ;
ARTICLE: "cli" "Command line arguments" ARTICLE: "cli" "Command line arguments"
"Factor command line usage:" "Factor command line usage:"
{ $code "factor [system switches...] [script args...]" } { $code "factor [VM args...] [script] [args...]" }
"Zero or more system switches can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup, any arguments after the script file are stored in a variable, with no further processing by Factor itself:" "Zero or more VM arguments can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup, any arguments after the script file are stored in the following variable, with no further processing by Factor itself:"
{ $subsections command-line } { $subsections command-line }
"Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link POSTPONE: MAIN: } " word:" "Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link POSTPONE: MAIN: } " word:"
{ $code "factor [system switches...] -run=<vocab name>" } { $code "factor [system switches...] -run=<vocab name>" }

7
unmaintained/arm/assembler/assembler-tests.factor → basis/cpu/arm/assembler/assembler-tests.factor
View File

@ -1,8 +1,9 @@
IN: cpu.arm.assembler.tests IN: cpu.arm.assembler.tests
USING: assembler-arm math test namespaces sequences kernel USING: cpu.arm.assembler math tools.test namespaces make
quotations ; sequences kernel quotations ;
FROM: cpu.arm.assembler => B ;
: test-opcode [ { } make first ] curry unit-test ; : test-opcode ( expect quot -- ) [ { } make first ] curry unit-test ;
[ HEX: ea000000 ] [ 0 B ] test-opcode [ HEX: ea000000 ] [ 0 B ] test-opcode
[ HEX: eb000000 ] [ 0 BL ] test-opcode [ HEX: eb000000 ] [ 0 BL ] test-opcode

269
unmaintained/arm/assembler/assembler.factor → basis/cpu/arm/assembler/assembler.factor
View File

@ -1,31 +1,46 @@
! Copyright (C) 2007 Slava Pestov. ! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generator generator.fixup kernel sequences words USING: accessors arrays combinators kernel make math math.bitwise
namespaces math math.bitfields ; namespaces sequences words words.symbol parser ;
IN: cpu.arm.assembler IN: cpu.arm.assembler
: define-registers ( seq -- ) ! Registers
dup length [ "register" set-word-prop ] 2each ; <<
SYMBOL: R0 SYMBOL: registers
SYMBOL: R1
SYMBOL: R2
SYMBOL: R3
SYMBOL: R4
SYMBOL: R5
SYMBOL: R6
SYMBOL: R7
SYMBOL: R8
SYMBOL: R9
SYMBOL: R10
SYMBOL: R11
SYMBOL: R12
SYMBOL: R13
SYMBOL: R14
SYMBOL: R15
{ R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 R15 } V{ } registers set-global
define-registers
SYNTAX: REGISTER:
CREATE-WORD
[ define-symbol ]
[ registers get length "register" set-word-prop ]
[ registers get push ]
tri ;
>>
REGISTER: R0
REGISTER: R1
REGISTER: R2
REGISTER: R3
REGISTER: R4
REGISTER: R5
REGISTER: R6
REGISTER: R7
REGISTER: R8
REGISTER: R9
REGISTER: R10
REGISTER: R11
REGISTER: R12
REGISTER: R13
REGISTER: R14
REGISTER: R15
ALIAS: SL R10 ALIAS: FP R11 ALIAS: IP R12
ALIAS: SP R13 ALIAS: LR R14 ALIAS: PC R15
<PRIVATE
PREDICATE: register < word register >boolean ; PREDICATE: register < word register >boolean ;
@ -33,8 +48,7 @@ GENERIC: register ( register -- n )
M: word register "register" word-prop ; M: word register "register" word-prop ;
M: f register drop 0 ; M: f register drop 0 ;
: SL R10 ; inline : FP R11 ; inline : IP R12 ; inline PRIVATE>
: SP R13 ; inline : LR R14 ; inline : PC R15 ; inline
! Condition codes ! Condition codes
SYMBOL: cond-code SYMBOL: cond-code
@ -46,43 +60,52 @@ SYMBOL: cond-code
#! Default value is BIN: 1110 AL (= always) #! Default value is BIN: 1110 AL (= always)
cond-code [ f ] change BIN: 1110 or ; cond-code [ f ] change BIN: 1110 or ;
: EQ BIN: 0000 >CC ; : EQ ( -- ) BIN: 0000 >CC ;
: NE BIN: 0001 >CC ; : NE ( -- ) BIN: 0001 >CC ;
: CS BIN: 0010 >CC ; : CS ( -- ) BIN: 0010 >CC ;
: CC BIN: 0011 >CC ; : CC ( -- ) BIN: 0011 >CC ;
: LO BIN: 0100 >CC ; : LO ( -- ) BIN: 0100 >CC ;
: PL BIN: 0101 >CC ; : PL ( -- ) BIN: 0101 >CC ;
: VS BIN: 0110 >CC ; : VS ( -- ) BIN: 0110 >CC ;
: VC BIN: 0111 >CC ; : VC ( -- ) BIN: 0111 >CC ;
: HI BIN: 1000 >CC ; : HI ( -- ) BIN: 1000 >CC ;
: LS BIN: 1001 >CC ; : LS ( -- ) BIN: 1001 >CC ;
: GE BIN: 1010 >CC ; : GE ( -- ) BIN: 1010 >CC ;
: LT BIN: 1011 >CC ; : LT ( -- ) BIN: 1011 >CC ;
: GT BIN: 1100 >CC ; : GT ( -- ) BIN: 1100 >CC ;
: LE BIN: 1101 >CC ; : LE ( -- ) BIN: 1101 >CC ;
: AL BIN: 1110 >CC ; : AL ( -- ) BIN: 1110 >CC ;
: NV BIN: 1111 >CC ; : NV ( -- ) BIN: 1111 >CC ;
<PRIVATE
: (insn) ( n -- ) CC> 28 shift bitor , ; : (insn) ( n -- ) CC> 28 shift bitor , ;
: insn ( bitspec -- ) bitfield (insn) ; inline : insn ( bitspec -- ) bitfield (insn) ; inline
! Branching instructions ! Branching instructions
GENERIC# (B) 1 ( signed-imm-24 l -- ) GENERIC# (B) 1 ( target l -- )
M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ; M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ;
M: word (B) 0 swap (B) rc-relative-arm-3 rel-word ;
M: label (B) 0 swap (B) rc-relative-arm-3 label-fixup ;
: B 0 (B) ; : BL 1 (B) ; PRIVATE>
: B ( target -- ) 0 (B) ;
: BL ( target -- ) 1 (B) ;
! Data processing instructions ! Data processing instructions
<PRIVATE
SYMBOL: updates-cond-code SYMBOL: updates-cond-code
PRIVATE>
: S ( -- ) updates-cond-code on ; : S ( -- ) updates-cond-code on ;
: S> ( -- ? ) updates-cond-code [ f ] change ; : S> ( -- ? ) updates-cond-code [ f ] change ;
<PRIVATE
: sinsn ( bitspec -- ) : sinsn ( bitspec -- )
bitfield S> [ 20 2^ bitor ] when (insn) ; inline bitfield S> [ 20 2^ bitor ] when (insn) ; inline
@ -100,21 +123,25 @@ M: register shift-imm/reg ( Rs Rm shift -- n )
{ register 0 } { register 0 }
} bitfield ; } bitfield ;
GENERIC: shifter-op ( shifter-op -- n ) PRIVATE>
TUPLE: IMM immed rotate ; TUPLE: IMM immed rotate ;
C: <IMM> IMM C: <IMM> IMM
M: IMM shifter-op
dup IMM-immed swap IMM-rotate
{ { 1 25 } 8 0 } bitfield ;
TUPLE: shifter Rm by shift ; TUPLE: shifter Rm by shift ;
C: <shifter> shifter C: <shifter> shifter
<PRIVATE
GENERIC: shifter-op ( shifter-op -- n )
M: IMM shifter-op
[ immed>> ] [ rotate>> ] bi { { 1 25 } 8 0 } bitfield ;
M: shifter shifter-op M: shifter shifter-op
dup shifter-by over shifter-Rm rot shifter-shift [ by>> ] [ Rm>> ] [ shift>> ] tri shift-imm/reg ;
shift-imm/reg ;
PRIVATE>
: <LSL> ( Rm shift-imm/Rs -- shifter-op ) BIN: 00 <shifter> ; : <LSL> ( Rm shift-imm/Rs -- shifter-op ) BIN: 00 <shifter> ;
: <LSR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 01 <shifter> ; : <LSR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 01 <shifter> ;
@ -123,9 +150,10 @@ M: shifter shifter-op
: <RRX> ( Rm -- shifter-op ) 0 <ROR> ; : <RRX> ( Rm -- shifter-op ) 0 <ROR> ;
M: register shifter-op 0 <LSL> shifter-op ; M: register shifter-op 0 <LSL> shifter-op ;
M: integer shifter-op 0 <IMM> shifter-op ; M: integer shifter-op 0 <IMM> shifter-op ;
<PRIVATE
: addr1 ( Rd Rn shifter-op opcode -- ) : addr1 ( Rd Rn shifter-op opcode -- )
{ {
21 ! opcode 21 ! opcode
@ -134,29 +162,37 @@ M: integer shifter-op 0 <IMM> shifter-op ;
{ register 12 } ! Rd { register 12 } ! Rd
} sinsn ; } sinsn ;
: AND BIN: 0000 addr1 ; PRIVATE>
: EOR BIN: 0001 addr1 ;
: SUB BIN: 0010 addr1 ;
: RSB BIN: 0011 addr1 ;
: ADD BIN: 0100 addr1 ;
: ADC BIN: 0101 addr1 ;
: SBC BIN: 0110 addr1 ;
: RSC BIN: 0111 addr1 ;
: ORR BIN: 1100 addr1 ;
: BIC BIN: 1110 addr1 ;
: MOV f swap BIN: 1101 addr1 ; : AND ( Rd Rn shifter-op -- ) BIN: 0000 addr1 ;
: MVN f swap BIN: 1111 addr1 ; : EOR ( Rd Rn shifter-op -- ) BIN: 0001 addr1 ;
: SUB ( Rd Rn shifter-op -- ) BIN: 0010 addr1 ;
: RSB ( Rd Rn shifter-op -- ) BIN: 0011 addr1 ;
: ADD ( Rd Rn shifter-op -- ) BIN: 0100 addr1 ;
: ADC ( Rd Rn shifter-op -- ) BIN: 0101 addr1 ;
: SBC ( Rd Rn shifter-op -- ) BIN: 0110 addr1 ;
: RSC ( Rd Rn shifter-op -- ) BIN: 0111 addr1 ;
: ORR ( Rd Rn shifter-op -- ) BIN: 1100 addr1 ;
: BIC ( Rd Rn shifter-op -- ) BIN: 1110 addr1 ;
: MOV ( Rd shifter-op -- ) [ f ] dip BIN: 1101 addr1 ;
: MVN ( Rd shifter-op -- ) [ f ] dip BIN: 1111 addr1 ;
! These always update the condition code flags ! These always update the condition code flags
: (CMP) >r f -rot r> S addr1 ; <PRIVATE
: TST BIN: 1000 (CMP) ; : (CMP) ( Rn shifter-op opcode -- ) [ f ] 3dip S addr1 ;
: TEQ BIN: 1001 (CMP) ;
: CMP BIN: 1010 (CMP) ; PRIVATE>
: CMN BIN: 1011 (CMP) ;
: TST ( Rn shifter-op -- ) BIN: 1000 (CMP) ;
: TEQ ( Rn shifter-op -- ) BIN: 1001 (CMP) ;
: CMP ( Rn shifter-op -- ) BIN: 1010 (CMP) ;
: CMN ( Rn shifter-op -- ) BIN: 1011 (CMP) ;
! Multiply instructions ! Multiply instructions
<PRIVATE
: (MLA) ( Rd Rm Rs Rn a -- ) : (MLA) ( Rd Rm Rs Rn a -- )
{ {
21 21
@ -168,9 +204,6 @@ M: integer shifter-op 0 <IMM> shifter-op ;
{ 1 4 } { 1 4 }
} sinsn ; } sinsn ;
: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
: (S/UMLAL) ( RdLo RdHi Rm Rs s a -- ) : (S/UMLAL) ( RdLo RdHi Rm Rs s a -- )
{ {
{ 1 23 } { 1 23 }
@ -184,8 +217,15 @@ M: integer shifter-op 0 <IMM> shifter-op ;
{ 1 4 } { 1 4 }
} sinsn ; } sinsn ;
: SMLAL 1 1 (S/UMLAL) ; : SMULL 1 0 (S/UMLAL) ; PRIVATE>
: UMLAL 0 1 (S/UMLAL) ; : UMULL 0 0 (S/UMLAL) ;
: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
: SMLAL ( RdLo RdHi Rm Rs -- ) 1 1 (S/UMLAL) ;
: SMULL ( RdLo RdHi Rm Rs -- ) 1 0 (S/UMLAL) ;
: UMLAL ( RdLo RdHi Rm Rs -- ) 0 1 (S/UMLAL) ;
: UMULL ( RdLo RdHi Rm Rs -- ) 0 0 (S/UMLAL) ;
! Miscellaneous arithmetic instructions ! Miscellaneous arithmetic instructions
: CLZ ( Rd Rm -- ) : CLZ ( Rd Rm -- )
@ -203,39 +243,21 @@ M: integer shifter-op 0 <IMM> shifter-op ;
! Status register acess instructions ! Status register acess instructions
! Load and store instructions ! Load and store instructions
<PRIVATE
GENERIC: addressing-mode-2 ( addressing-mode -- n ) GENERIC: addressing-mode-2 ( addressing-mode -- n )
TUPLE: addressing p u w ; TUPLE: addressing base p u w ;
: <addressing> ( delegate p u w -- addressing ) C: <addressing> addressing
{
set-delegate
set-addressing-p
set-addressing-u
set-addressing-w
} addressing construct ;
M: addressing addressing-mode-2 M: addressing addressing-mode-2
{ { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-2 ] } cleave
addressing-p addressing-u addressing-w delegate
} get-slots addressing-mode-2
{ 0 21 23 24 } bitfield ; { 0 21 23 24 } bitfield ;
M: integer addressing-mode-2 ; M: integer addressing-mode-2 ;
M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ; M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
! Offset
: <+> 1 1 0 <addressing> ;
: <-> 1 0 0 <addressing> ;
! Pre-indexed
: <!+> 1 1 1 <addressing> ;
: <!-> 1 0 1 <addressing> ;
! Post-indexed
: <+!> 0 1 0 <addressing> ;
: <-!> 0 0 0 <addressing> ;
: addr2 ( Rd Rn addressing-mode b l -- ) : addr2 ( Rd Rn addressing-mode b l -- )
{ {
{ 1 26 } { 1 26 }
@ -246,16 +268,32 @@ M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
{ register 12 } { register 12 }
} insn ; } insn ;
: LDR 0 1 addr2 ; PRIVATE>
: LDRB 1 1 addr2 ;
: STR 0 0 addr2 ; ! Offset
: STRB 1 0 addr2 ; : <+> ( base -- addressing ) 1 1 0 <addressing> ;
: <-> ( base -- addressing ) 1 0 0 <addressing> ;
! Pre-indexed
: <!+> ( base -- addressing ) 1 1 1 <addressing> ;
: <!-> ( base -- addressing ) 1 0 1 <addressing> ;
! Post-indexed
: <+!> ( base -- addressing ) 0 1 0 <addressing> ;
: <-!> ( base -- addressing ) 0 0 0 <addressing> ;
: LDR ( Rd Rn addressing-mode -- ) 0 1 addr2 ;
: LDRB ( Rd Rn addressing-mode -- ) 1 1 addr2 ;
: STR ( Rd Rn addressing-mode -- ) 0 0 addr2 ;
: STRB ( Rd Rn addressing-mode -- ) 1 0 addr2 ;
! We might have to simulate these instructions since older ARM ! We might have to simulate these instructions since older ARM
! chips don't have them. ! chips don't have them.
SYMBOL: have-BX? SYMBOL: have-BX?
SYMBOL: have-BLX? SYMBOL: have-BLX?
<PRIVATE
GENERIC# (BX) 1 ( Rm l -- ) GENERIC# (BX) 1 ( Rm l -- )
M: register (BX) ( Rm l -- ) M: register (BX) ( Rm l -- )
@ -270,24 +308,21 @@ M: register (BX) ( Rm l -- )
{ register 0 } { register 0 }
} insn ; } insn ;
M: word (BX) 0 swap (BX) rc-relative-arm-3 rel-word ; PRIVATE>
M: label (BX) 0 swap (BX) rc-relative-arm-3 label-fixup ; : BX ( Rm -- ) have-BX? get [ 0 (BX) ] [ [ PC ] dip MOV ] if ;
: BX have-BX? get [ 0 (BX) ] [ PC swap MOV ] if ; : BLX ( Rm -- ) have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
: BLX have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
! More load and store instructions ! More load and store instructions
<PRIVATE
GENERIC: addressing-mode-3 ( addressing-mode -- n ) GENERIC: addressing-mode-3 ( addressing-mode -- n )
: b>n/n ( b -- n n ) dup -4 shift swap HEX: f bitand ; : b>n/n ( b -- n n ) [ -4 shift ] [ HEX: f bitand ] bi ;
M: addressing addressing-mode-3 M: addressing addressing-mode-3
[ addressing-p ] keep { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-3 ] } cleave
[ addressing-u ] keep
[ addressing-w ] keep
delegate addressing-mode-3
{ 0 21 23 24 } bitfield ; { 0 21 23 24 } bitfield ;
M: integer addressing-mode-3 M: integer addressing-mode-3
@ -318,10 +353,12 @@ M: object addressing-mode-3
{ register 12 } { register 12 }
} insn ; } insn ;
: LDRH 1 1 0 addr3 ; PRIVATE>
: LDRSB 0 1 1 addr3 ;
: LDRSH 1 1 1 addr3 ; : LDRH ( Rn Rd addressing-mode -- ) 1 1 0 addr3 ;
: STRH 1 0 0 addr3 ; : LDRSB ( Rn Rd addressing-mode -- ) 0 1 1 addr3 ;
: LDRSH ( Rn Rd addressing-mode -- ) 1 1 1 addr3 ;
: STRH ( Rn Rd addressing-mode -- ) 1 0 0 addr3 ;
! Load and store multiple instructions ! Load and store multiple instructions

0
unmaintained/arm/assembler/authors.txt → basis/cpu/arm/assembler/authors.txt
View File

17
basis/tools/deploy/deploy-tests.factor
View File

@ -1,9 +1,9 @@
USING: tools.test system io io.encodings.ascii io.pathnames
io.files io.files.info io.files.temp kernel tools.deploy.config
tools.deploy.config.editor tools.deploy.backend math sequences
io.launcher arrays namespaces continuations layouts accessors
urls math.parser io.directories tools.deploy.test ;
IN: tools.deploy.tests IN: tools.deploy.tests
USING: tools.test system io.pathnames io.files io.files.info
io.files.temp kernel tools.deploy.config tools.deploy.config.editor
tools.deploy.backend math sequences io.launcher arrays namespaces
continuations layouts accessors io.encodings.ascii urls math.parser
io.directories tools.deploy.test ;
[ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test [ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test
@ -106,3 +106,10 @@ os windows? os macosx? or [
os macosx? [ os macosx? [
[ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test [ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test
] when ] when
[ { "a" "b" "c" } ] [
"tools.deploy.test.15" shake-and-bake deploy-test-command
{ "a" "b" "c" } append
ascii [ lines ] with-process-reader
rest
] unit-test

11
basis/tools/deploy/shaker/shaker.factor
View File

@ -7,9 +7,8 @@ words memory kernel.private continuations io vocabs.loader
system strings sets vectors quotations byte-arrays sorting system strings sets vectors quotations byte-arrays sorting
compiler.units definitions generic generic.standard compiler.units definitions generic generic.standard
generic.single tools.deploy.config combinators classes generic.single tools.deploy.config combinators classes
classes.builtin slots.private grouping ; classes.builtin slots.private grouping command-line ;
QUALIFIED: bootstrap.stage2 QUALIFIED: bootstrap.stage2
QUALIFIED: command-line
QUALIFIED: compiler.errors QUALIFIED: compiler.errors
QUALIFIED: continuations QUALIFIED: continuations
QUALIFIED: definitions QUALIFIED: definitions
@ -22,11 +21,14 @@ IN: tools.deploy.shaker
! This file is some hairy shit. ! This file is some hairy shit.
: add-command-line-hook ( -- )
[ (command-line) command-line set-global ] "command-line"
init-hooks get set-at ;
: strip-init-hooks ( -- ) : strip-init-hooks ( -- )
"Stripping startup hooks" show "Stripping startup hooks" show
{ {
"alien.strings" "alien.strings"
"command-line"
"cpu.x86" "cpu.x86"
"destructors" "destructors"
"environment" "environment"
@ -328,7 +330,7 @@ IN: tools.deploy.shaker
classes-intersect-cache classes-intersect-cache
implementors-map implementors-map
update-map update-map
command-line:main-vocab-hook main-vocab-hook
compiled-crossref compiled-crossref
compiled-generic-crossref compiled-generic-crossref
compiler-impl compiler-impl
@ -503,6 +505,7 @@ SYMBOL: deploy-vocab
strip-debugger strip-debugger
compute-next-methods compute-next-methods
strip-init-hooks strip-init-hooks
add-command-line-hook
strip-c-io strip-c-io
strip-default-methods strip-default-methods
strip-compiler-classes strip-compiler-classes

8
basis/tools/deploy/test/15/15.factor Normal file
View File

@ -0,0 +1,8 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: command-line io namespaces sequences ;
IN: tools.deploy.test.15
: main ( -- ) command-line get [ print ] each ;
MAIN: main

7
basis/tools/deploy/test/test.factor
View File

@ -19,7 +19,10 @@ IN: tools.deploy.test
] bi* ] bi*
<= ; <= ;
: run-temp-image ( -- ) : deploy-test-command ( -- args )
os macosx? os macosx?
"resource:Factor.app/Contents/MacOS/factor" normalize-path vm ? "resource:Factor.app/Contents/MacOS/factor" normalize-path vm ?
"-i=" "test.image" temp-file append 2array try-output-process ; "-i=" "test.image" temp-file append 2array ;
: run-temp-image ( -- )
deploy-test-command try-output-process ;

2
vm/arrays.hpp
View File

@ -25,7 +25,7 @@ struct growable_array {
cell count; cell count;
gc_root<array> elements; gc_root<array> elements;
growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {} explicit growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
void add(cell elt); void add(cell elt);
void trim(); void trim();

1
vm/bignum.hpp
View File

@ -44,7 +44,6 @@ enum bignum_comparison
bignum_comparison_greater = 1 bignum_comparison_greater = 1
}; };
struct factor_vm;
bignum * digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int,factor_vm*), unsigned int radix, int negative_p); bignum * digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int,factor_vm*), unsigned int radix, int negative_p);
} }

2
vm/byte_arrays.hpp
View File

@ -5,7 +5,7 @@ struct growable_byte_array {
cell count; cell count;
gc_root<byte_array> elements; gc_root<byte_array> elements;
growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { } explicit growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
void append_bytes(void *elts, cell len); void append_bytes(void *elts, cell len);
void append_byte_array(cell elts); void append_byte_array(cell elts);

11
vm/callstack.cpp
View File

@ -116,7 +116,7 @@ cell factor_vm::frame_scan(stack_frame *frame)
return F; return F;
else else
{ {
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame); char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
char *quot_xt = (char *)(frame_code(frame) + 1); char *quot_xt = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan( return tag_fixnum(quot_code_offset_to_scan(
@ -135,11 +135,12 @@ namespace
{ {
struct stack_frame_accumulator { struct stack_frame_accumulator {
factor_vm *myvm;
growable_array frames; growable_array frames;
stack_frame_accumulator(factor_vm *vm) : frames(vm) {} explicit stack_frame_accumulator(factor_vm *myvm_) : myvm(myvm_), frames(myvm_) {}
void operator()(stack_frame *frame, factor_vm *myvm) void operator()(stack_frame *frame)
{ {
gc_root<object> executing(myvm->frame_executing(frame),myvm); gc_root<object> executing(myvm->frame_executing(frame),myvm);
gc_root<object> scan(myvm->frame_scan(frame),myvm); gc_root<object> scan(myvm->frame_scan(frame),myvm);
@ -204,9 +205,9 @@ void factor_vm::primitive_set_innermost_stack_frame_quot()
jit_compile(quot.value(),true); jit_compile(quot.value(),true);
stack_frame *inner = innermost_stack_frame_quot(callstack.untagged()); stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt; cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
inner->xt = quot->xt; inner->xt = quot->xt;
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset; FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
} }
/* called before entry into Factor code. */ /* called before entry into Factor code. */

27
vm/callstack.hpp
View File

@ -10,7 +10,7 @@ VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *
/* This is a little tricky. The iterator may allocate memory, so we /* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */ keep the callstack in a GC root and use relative offsets */
template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stack_, TYPE &iterator) template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
{ {
gc_root<callstack> stack(stack_,this); gc_root<callstack> stack(stack_,this);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame); fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
@ -19,38 +19,19 @@ template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stac
{ {
stack_frame *frame = stack->frame_at(frame_offset); stack_frame *frame = stack->frame_at(frame_offset);
frame_offset -= frame->size; frame_offset -= frame->size;
iterator(frame,this); iterator(frame);
} }
} }
template<typename TYPE> void factor_vm::iterate_callstack(cell top, cell bottom, TYPE &iterator) template<typename Iterator> void factor_vm::iterate_callstack(cell top, cell bottom, Iterator &iterator)
{ {
stack_frame *frame = (stack_frame *)bottom - 1; stack_frame *frame = (stack_frame *)bottom - 1;
while((cell)frame >= top) while((cell)frame >= top)
{ {
iterator(frame,this); iterator(frame);
frame = frame_successor(frame); frame = frame_successor(frame);
} }
} }
/* Every object has a regular representation in the runtime, which makes GC
much simpler. Every slot of the object until binary_payload_start is a pointer
to some other object. */
struct factor_vm;
inline void factor_vm::do_slots(cell obj, void (* iter)(cell *,factor_vm*))
{
cell scan = obj;
cell payload_start = binary_payload_start((object *)obj);
cell end = obj + payload_start;
scan += sizeof(cell);
while(scan < end)
{
iter((cell *)scan,this);
scan += sizeof(cell);
}
}
} }

146
vm/code_block.cpp
View File

@ -188,7 +188,7 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
#undef ARG #undef ARG
} }
void factor_vm::iterate_relocations(code_block *compiled, relocation_iterator iter) template<typename Iterator> void factor_vm::iterate_relocations(code_block *compiled, Iterator &iter)
{ {
if(compiled->relocation != F) if(compiled->relocation != F)
{ {
@ -200,7 +200,7 @@ void factor_vm::iterate_relocations(code_block *compiled, relocation_iterator it
for(cell i = 0; i < length; i++) for(cell i = 0; i < length; i++)
{ {
relocation_entry rel = relocation->data<relocation_entry>()[i]; relocation_entry rel = relocation->data<relocation_entry>()[i];
(this->*iter)(rel,index,compiled); iter(rel,index,compiled);
index += number_of_parameters(relocation_type_of(rel)); index += number_of_parameters(relocation_type_of(rel));
} }
} }
@ -270,54 +270,51 @@ void factor_vm::store_address_in_code_block(cell klass, cell offset, fixnum abso
} }
} }
void factor_vm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled) struct literal_references_updater {
{ factor_vm *myvm;
if(relocation_type_of(rel) == RT_IMMEDIATE)
{
cell offset = relocation_offset_of(rel) + (cell)(compiled + 1);
array *literals = untag<array>(compiled->literals);
fixnum absolute_value = array_nth(literals,index);
store_address_in_code_block(relocation_class_of(rel),offset,absolute_value);
}
}
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm) explicit literal_references_updater(factor_vm *myvm_) : myvm(myvm_) {}
{
return myvm->update_literal_references_step(rel,index,compiled); void operator()(relocation_entry rel, cell index, code_block *compiled)
} {
if(myvm->relocation_type_of(rel) == RT_IMMEDIATE)
{
cell offset = myvm->relocation_offset_of(rel) + (cell)(compiled + 1);
array *literals = myvm->untag<array>(compiled->literals);
fixnum absolute_value = array_nth(literals,index);
myvm->store_address_in_code_block(myvm->relocation_class_of(rel),offset,absolute_value);
}
}
};
/* Update pointers to literals from compiled code. */ /* Update pointers to literals from compiled code. */
void factor_vm::update_literal_references(code_block *compiled) void factor_vm::update_literal_references(code_block *compiled)
{ {
if(!compiled->needs_fixup) if(!compiled->needs_fixup)
{ {
iterate_relocations(compiled,&factor_vm::update_literal_references_step); literal_references_updater updater(this);
iterate_relocations(compiled,updater);
flush_icache_for(compiled); flush_icache_for(compiled);
} }
} }
/* Copy all literals referenced from a code block to newspace. Only for /* Copy all literals referenced from a code block to newspace. Only for
aging and nursery collections */ aging and nursery collections */
void factor_vm::copy_literal_references(code_block *compiled) void factor_vm::trace_literal_references(code_block *compiled)
{ {
if(collecting_gen >= compiled->last_scan) if(current_gc->collecting_gen >= compiled->last_scan)
{ {
if(collecting_accumulation_gen_p()) if(current_gc->collecting_accumulation_gen_p())
compiled->last_scan = collecting_gen; compiled->last_scan = current_gc->collecting_gen;
else else
compiled->last_scan = collecting_gen + 1; compiled->last_scan = current_gc->collecting_gen + 1;
/* initialize chase pointer */ trace_handle(&compiled->literals);
cell scan = newspace->here; trace_handle(&compiled->relocation);
copy_handle(&compiled->literals); /* once we finish tracing, re-visit this code block and update
copy_handle(&compiled->relocation); literals */
current_gc->dirty_code_blocks.insert(compiled);
/* do some tracing so that all reachable literals are now
at their final address */
copy_reachable_objects(scan,&newspace->here);
update_literal_references(compiled);
} }
} }
@ -336,22 +333,17 @@ void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_
compute_relocation(rel,index,compiled)); compute_relocation(rel,index,compiled));
} }
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm) struct word_references_updater {
{ factor_vm *myvm;
return myvm->relocate_code_block_step(rel,index,compiled);
}
void factor_vm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled) explicit word_references_updater(factor_vm *myvm_) : myvm(myvm_) {}
{ void operator()(relocation_entry rel, cell index, code_block *compiled)
relocation_type type = relocation_type_of(rel); {
relocation_type type = myvm->relocation_type_of(rel);
if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL) if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
relocate_code_block_step(rel,index,compiled); myvm->relocate_code_block_step(rel,index,compiled);
} }
};
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
{
return myvm->update_word_references_step(rel,index,compiled);
}
/* Relocate new code blocks completely; updating references to literals, /* Relocate new code blocks completely; updating references to literals,
dlsyms, and words. For all other words in the code heap, we only need dlsyms, and words. For all other words in the code heap, we only need
@ -372,27 +364,12 @@ void factor_vm::update_word_references(code_block *compiled)
code->heap_free(compiled); code->heap_free(compiled);
else else
{ {
iterate_relocations(compiled,&factor_vm::update_word_references_step); word_references_updater updater(this);
iterate_relocations(compiled,updater);
flush_icache_for(compiled); flush_icache_for(compiled);
} }
} }
void update_word_references(code_block *compiled, factor_vm *myvm)
{
return myvm->update_word_references(compiled);
}
void factor_vm::update_literal_and_word_references(code_block *compiled)
{
update_literal_references(compiled);
update_word_references(compiled);
}
void update_literal_and_word_references(code_block *compiled, factor_vm *myvm)
{
return myvm->update_literal_and_word_references(compiled);
}
void factor_vm::check_code_address(cell address) void factor_vm::check_code_address(cell address)
{ {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
@ -411,29 +388,30 @@ void factor_vm::mark_code_block(code_block *compiled)
code->mark_block(compiled); code->mark_block(compiled);
copy_handle(&compiled->literals); trace_handle(&compiled->literals);
copy_handle(&compiled->relocation); trace_handle(&compiled->relocation);
} }
void factor_vm::mark_stack_frame_step(stack_frame *frame) struct stack_frame_marker {
{ factor_vm *myvm;
mark_code_block(frame_code(frame));
}
void mark_stack_frame_step(stack_frame *frame, factor_vm *myvm) explicit stack_frame_marker(factor_vm *myvm_) : myvm(myvm_) {}
{ void operator()(stack_frame *frame)
return myvm->mark_stack_frame_step(frame); {
} myvm->mark_code_block(myvm->frame_code(frame));
}
};
/* Mark code blocks executing in currently active stack frames. */ /* Mark code blocks executing in currently active stack frames. */
void factor_vm::mark_active_blocks(context *stacks) void factor_vm::mark_active_blocks(context *stacks)
{ {
if(collecting_gen == data->tenured()) if(current_gc->collecting_tenured_p())
{ {
cell top = (cell)stacks->callstack_top; cell top = (cell)stacks->callstack_top;
cell bottom = (cell)stacks->callstack_bottom; cell bottom = (cell)stacks->callstack_bottom;
iterate_callstack(top,bottom,factor::mark_stack_frame_step); stack_frame_marker marker(this);
iterate_callstack(top,bottom,marker);
} }
} }
@ -460,18 +438,32 @@ void factor_vm::mark_object_code_block(object *object)
case CALLSTACK_TYPE: case CALLSTACK_TYPE:
{ {
callstack *stack = (callstack *)object; callstack *stack = (callstack *)object;
iterate_callstack_object(stack,factor::mark_stack_frame_step); stack_frame_marker marker(this);
iterate_callstack_object(stack,marker);
break; break;
} }
} }
} }
struct code_block_relocator {
factor_vm *myvm;
explicit code_block_relocator(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(relocation_entry rel, cell index, code_block *compiled)
{
myvm->relocate_code_block_step(rel,index,compiled);
}
};
/* Perform all fixups on a code block */ /* Perform all fixups on a code block */
void factor_vm::relocate_code_block(code_block *compiled) void factor_vm::relocate_code_block(code_block *compiled)
{ {
compiled->last_scan = data->nursery(); compiled->last_scan = data->nursery();
compiled->needs_fixup = false; compiled->needs_fixup = false;
iterate_relocations(compiled,&factor_vm::relocate_code_block_step); code_block_relocator relocator(this);
iterate_relocations(compiled,relocator);
flush_icache_for(compiled); flush_icache_for(compiled);
} }

60
vm/code_heap.cpp
View File

@ -28,31 +28,37 @@ void factor_vm::jit_compile_word(cell word_, cell def_, bool relocate)
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate); if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
} }
/* Apply a function to every code block */ struct literal_reference_tracer {
void factor_vm::iterate_code_heap(code_heap_iterator iter) factor_vm *myvm;
{
heap_block *scan = code->first_block();
while(scan) explicit literal_reference_tracer(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(code_block *compiled)
{ {
if(scan->status != B_FREE) myvm->trace_literal_references(compiled);
(this->*iter)((code_block *)scan);
scan = code->next_block(scan);
} }
} };
/* Copy literals referenced from all code blocks to newspace. Only for /* Copy literals referenced from all code blocks to newspace. Only for
aging and nursery collections */ aging and nursery collections */
void factor_vm::copy_code_heap_roots() void factor_vm::trace_code_heap_roots()
{ {
iterate_code_heap(&factor_vm::copy_literal_references); code_heap_scans++;
literal_reference_tracer tracer(this);
iterate_code_heap(tracer);
if(current_gc->collecting_accumulation_gen_p())
last_code_heap_scan = current_gc->collecting_gen;
else
last_code_heap_scan = current_gc->collecting_gen + 1;
} }
/* Update pointers to words referenced from all code blocks. Only after /* Update pointers to words referenced from all code blocks. Only after
defining a new word. */ defining a new word. */
void factor_vm::update_code_heap_words() void factor_vm::update_code_heap_words()
{ {
iterate_code_heap(&factor_vm::update_word_references); word_updater updater(this);
iterate_code_heap(updater);
} }
void factor_vm::primitive_modify_code_heap() void factor_vm::primitive_modify_code_heap()
@ -122,18 +128,19 @@ code_block *factor_vm::forward_xt(code_block *compiled)
return (code_block *)forwarding[compiled]; return (code_block *)forwarding[compiled];
} }
void factor_vm::forward_frame_xt(stack_frame *frame) struct xt_forwarder {
{ factor_vm *myvm;
cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
code_block *forwarded = forward_xt(frame_code(frame));
frame->xt = forwarded->xt();
FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
}
void forward_frame_xt(stack_frame *frame,factor_vm *myvm) explicit xt_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
{
return myvm->forward_frame_xt(frame); void operator()(stack_frame *frame)
} {
cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)myvm->frame_code(frame);
code_block *forwarded = myvm->forward_xt(myvm->frame_code(frame));
frame->xt = forwarded->xt();
FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)forwarded + offset);
}
};
void factor_vm::forward_object_xts() void factor_vm::forward_object_xts()
{ {
@ -166,7 +173,8 @@ void factor_vm::forward_object_xts()
case CALLSTACK_TYPE: case CALLSTACK_TYPE:
{ {
callstack *stack = untag<callstack>(obj); callstack *stack = untag<callstack>(obj);
iterate_callstack_object(stack,factor::forward_frame_xt); xt_forwarder forwarder(this);
iterate_callstack_object(stack,forwarder);
} }
break; break;
default: default:
@ -212,8 +220,8 @@ do this before saving a deployed image and exiting, so performaance is not
critical here */ critical here */
void factor_vm::compact_code_heap() void factor_vm::compact_code_heap()
{ {
/* Free all unreachable code blocks */ /* Free all unreachable code blocks, don't trace contexts */
gc(); garbage_collection(data->tenured(),false,false,0);
/* Figure out where the code heap blocks are going to end up */ /* Figure out where the code heap blocks are going to end up */
cell size = code->compute_heap_forwarding(forwarding); cell size = code->compute_heap_forwarding(forwarding);

10
vm/code_heap.hpp
View File

@ -8,4 +8,14 @@ inline void factor_vm::check_code_pointer(cell ptr)
#endif #endif
} }
struct word_updater {
factor_vm *myvm;
explicit word_updater(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(code_block *compiled)
{
myvm->update_word_references(compiled);
}
};
} }

1
vm/contexts.hpp
View File

@ -44,7 +44,6 @@ struct context {
DEFPUSHPOP(d,ds) DEFPUSHPOP(d,ds)
DEFPUSHPOP(r,rs) DEFPUSHPOP(r,rs)
struct factor_vm;
VM_C_API void nest_stacks(factor_vm *vm); VM_C_API void nest_stacks(factor_vm *vm);
VM_C_API void unnest_stacks(factor_vm *vm); VM_C_API void unnest_stacks(factor_vm *vm);

2
vm/cpu-arm.hpp
View File

@ -6,7 +6,7 @@ namespace factor
register cell ds asm("r5"); register cell ds asm("r5");
register cell rs asm("r6"); register cell rs asm("r6");
#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1) #define FRAME_RETURN_ADDRESS(frame,vm) *(XT *)(vm->frame_successor(frame) + 1)
void c_to_factor(cell quot); void c_to_factor(cell quot);
void set_callstack(stack_frame *to, stack_frame *from, cell length, void *memcpy); void set_callstack(stack_frame *to, stack_frame *from, cell length, void *memcpy);

2
vm/cpu-x86.hpp
View File

@ -3,7 +3,7 @@
namespace factor namespace factor
{ {
#define FRAME_RETURN_ADDRESS(frame) *(void **)(frame_successor(frame) + 1) #define FRAME_RETURN_ADDRESS(frame,vm) *(void **)(vm->frame_successor(frame) + 1)
inline static void flush_icache(cell start, cell len) {} inline static void flush_icache(cell start, cell len) {}

351
vm/data_gc.cpp
View File

@ -5,19 +5,29 @@ namespace factor
void factor_vm::init_data_gc() void factor_vm::init_data_gc()
{ {
performing_gc = false;
last_code_heap_scan = data->nursery(); last_code_heap_scan = data->nursery();
collecting_aging_again = false;
} }
gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_) :
data(data_),
growing_data_heap(growing_data_heap_),
collecting_gen(collecting_gen_),
start_time(current_micros()) { }
gc_state::~gc_state() { }
/* If a generation fills up, throw this error. It is caught in garbage_collection() */
struct generation_full_condition { };
/* Given a pointer to oldspace, copy it to newspace */ /* Given a pointer to oldspace, copy it to newspace */
object *factor_vm::copy_untagged_object_impl(object *pointer, cell size) object *factor_vm::copy_untagged_object_impl(object *pointer, cell size)
{ {
if(newspace->here + size >= newspace->end) if(current_gc->newspace->here + size >= current_gc->newspace->end)
longjmp(gc_jmp,1); throw generation_full_condition();
object *newpointer = allot_zone(newspace,size);
gc_stats *s = &stats[collecting_gen]; object *newpointer = allot_zone(current_gc->newspace,size);
gc_stats *s = &stats[current_gc->collecting_gen];
s->object_count++; s->object_count++;
s->bytes_copied += size; s->bytes_copied += size;
@ -34,13 +44,13 @@ object *factor_vm::copy_object_impl(object *untagged)
bool factor_vm::should_copy_p(object *untagged) bool factor_vm::should_copy_p(object *untagged)
{ {
if(in_zone(newspace,untagged)) if(in_zone(current_gc->newspace,untagged))
return false; return false;
if(collecting_gen == data->tenured()) if(current_gc->collecting_tenured_p())
return true; return true;
else if(data->have_aging_p() && collecting_gen == data->aging()) else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
return !in_zone(&data->generations[data->tenured()],untagged); return !in_zone(&data->generations[data->tenured()],untagged);
else if(collecting_gen == data->nursery()) else if(current_gc->collecting_nursery_p())
return in_zone(&nursery,untagged); return in_zone(&nursery,untagged);
else else
{ {
@ -68,16 +78,16 @@ object *factor_vm::resolve_forwarding(object *untagged)
} }
} }
template <typename TYPE> TYPE *factor_vm::copy_untagged_object(TYPE *untagged) template<typename Type> Type *factor_vm::copy_untagged_object(Type *untagged)
{ {
check_data_pointer(untagged); check_data_pointer(untagged);
if(untagged->h.forwarding_pointer_p()) if(untagged->h.forwarding_pointer_p())
untagged = (TYPE *)resolve_forwarding(untagged->h.forwarding_pointer()); untagged = (Type *)resolve_forwarding(untagged->h.forwarding_pointer());
else else
{ {
untagged->h.check_header(); untagged->h.check_header();
untagged = (TYPE *)copy_object_impl(untagged); untagged = (Type *)copy_object_impl(untagged);
} }
return untagged; return untagged;
@ -88,7 +98,7 @@ cell factor_vm::copy_object(cell pointer)
return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer)); return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer));
} }
void factor_vm::copy_handle(cell *handle) void factor_vm::trace_handle(cell *handle)
{ {
cell pointer = *handle; cell pointer = *handle;
@ -102,7 +112,7 @@ void factor_vm::copy_handle(cell *handle)
} }
/* Scan all the objects in the card */ /* Scan all the objects in the card */
void factor_vm::copy_card(card *ptr, cell gen, cell here) void factor_vm::trace_card(card *ptr, cell gen, cell here)
{ {
cell card_scan = card_to_addr(ptr) + card_offset(ptr); cell card_scan = card_to_addr(ptr) + card_offset(ptr);
cell card_end = card_to_addr(ptr + 1); cell card_end = card_to_addr(ptr + 1);
@ -115,7 +125,7 @@ void factor_vm::copy_card(card *ptr, cell gen, cell here)
cards_scanned++; cards_scanned++;
} }
void factor_vm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask) void factor_vm::trace_card_deck(card_deck *deck, cell gen, card mask, card unmask)
{ {
card *first_card = deck_to_card(deck); card *first_card = deck_to_card(deck);
card *last_card = deck_to_card(deck + 1); card *last_card = deck_to_card(deck + 1);
@ -136,7 +146,7 @@ void factor_vm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask
{ {
if(ptr[card] & mask) if(ptr[card] & mask)
{ {
copy_card(&ptr[card],gen,here); trace_card(&ptr[card],gen,here);
ptr[card] &= ~unmask; ptr[card] &= ~unmask;
} }
} }
@ -147,7 +157,7 @@ void factor_vm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask
} }
/* Copy all newspace objects referenced from marked cards to the destination */ /* Copy all newspace objects referenced from marked cards to the destination */
void factor_vm::copy_gen_cards(cell gen) void factor_vm::trace_generation_cards(cell gen)
{ {
card_deck *first_deck = addr_to_deck(data->generations[gen].start); card_deck *first_deck = addr_to_deck(data->generations[gen].start);
card_deck *last_deck = addr_to_deck(data->generations[gen].end); card_deck *last_deck = addr_to_deck(data->generations[gen].end);
@ -156,7 +166,7 @@ void factor_vm::copy_gen_cards(cell gen)
/* if we are collecting the nursery, we care about old->nursery pointers /* if we are collecting the nursery, we care about old->nursery pointers
but not old->aging pointers */ but not old->aging pointers */
if(collecting_gen == data->nursery()) if(current_gc->collecting_nursery_p())
{ {
mask = card_points_to_nursery; mask = card_points_to_nursery;
@ -171,16 +181,16 @@ void factor_vm::copy_gen_cards(cell gen)
unmask = card_mark_mask; unmask = card_mark_mask;
else else
{ {
critical_error("bug in copy_gen_cards",gen); critical_error("bug in trace_generation_cards",gen);
return; return;
} }
} }
/* if we are collecting aging space into tenured space, we care about /* if we are collecting aging space into tenured space, we care about
all old->nursery and old->aging pointers. no old->aging pointers can all old->nursery and old->aging pointers. no old->aging pointers can
remain */ remain */
else if(data->have_aging_p() && collecting_gen == data->aging()) else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
{ {
if(collecting_aging_again) if(current_gc->collecting_aging_again)
{ {
mask = card_points_to_aging; mask = card_points_to_aging;
unmask = card_mark_mask; unmask = card_mark_mask;
@ -196,7 +206,7 @@ void factor_vm::copy_gen_cards(cell gen)
} }
else else
{ {
critical_error("bug in copy_gen_cards",gen); critical_error("bug in trace_generation_cards",gen);
return; return;
} }
@ -206,7 +216,7 @@ void factor_vm::copy_gen_cards(cell gen)
{ {
if(*ptr & mask) if(*ptr & mask)
{ {
copy_card_deck(ptr,gen,mask,unmask); trace_card_deck(ptr,gen,mask,unmask);
*ptr &= ~unmask; *ptr &= ~unmask;
} }
} }
@ -214,36 +224,36 @@ void factor_vm::copy_gen_cards(cell gen)
/* Scan cards in all generations older than the one being collected, copying /* Scan cards in all generations older than the one being collected, copying
old->new references */ old->new references */
void factor_vm::copy_cards() void factor_vm::trace_cards()
{ {
u64 start = current_micros(); u64 start = current_micros();
cell i; cell i;
for(i = collecting_gen + 1; i < data->gen_count; i++) for(i = current_gc->collecting_gen + 1; i < data->gen_count; i++)
copy_gen_cards(i); trace_generation_cards(i);
card_scan_time += (current_micros() - start); card_scan_time += (current_micros() - start);
} }
/* Copy all tagged pointers in a range of memory */ /* Copy all tagged pointers in a range of memory */
void factor_vm::copy_stack_elements(segment *region, cell top) void factor_vm::trace_stack_elements(segment *region, cell top)
{ {
cell ptr = region->start; cell ptr = region->start;
for(; ptr <= top; ptr += sizeof(cell)) for(; ptr <= top; ptr += sizeof(cell))
copy_handle((cell*)ptr); trace_handle((cell*)ptr);
} }
void factor_vm::copy_registered_locals() void factor_vm::trace_registered_locals()
{ {
std::vector<cell>::const_iterator iter = gc_locals.begin(); std::vector<cell>::const_iterator iter = gc_locals.begin();
std::vector<cell>::const_iterator end = gc_locals.end(); std::vector<cell>::const_iterator end = gc_locals.end();
for(; iter < end; iter++) for(; iter < end; iter++)
copy_handle((cell *)(*iter)); trace_handle((cell *)(*iter));
} }
void factor_vm::copy_registered_bignums() void factor_vm::trace_registered_bignums()
{ {
std::vector<cell>::const_iterator iter = gc_bignums.begin(); std::vector<cell>::const_iterator iter = gc_bignums.begin();
std::vector<cell>::const_iterator end = gc_bignums.end(); std::vector<cell>::const_iterator end = gc_bignums.end();
@ -267,38 +277,38 @@ void factor_vm::copy_registered_bignums()
/* Copy roots over at the start of GC, namely various constants, stacks, /* Copy roots over at the start of GC, namely various constants, stacks,
the user environment and extra roots registered by local_roots.hpp */ the user environment and extra roots registered by local_roots.hpp */
void factor_vm::copy_roots() void factor_vm::trace_roots()
{ {
copy_handle(&T); trace_handle(&T);
copy_handle(&bignum_zero); trace_handle(&bignum_zero);
copy_handle(&bignum_pos_one); trace_handle(&bignum_pos_one);
copy_handle(&bignum_neg_one); trace_handle(&bignum_neg_one);
copy_registered_locals(); trace_registered_locals();
copy_registered_bignums(); trace_registered_bignums();
if(!performing_compaction) int i;
{ for(i = 0; i < USER_ENV; i++)
trace_handle(&userenv[i]);
}
void factor_vm::trace_contexts()
{
save_stacks(); save_stacks();
context *stacks = stack_chain; context *stacks = stack_chain;
while(stacks) while(stacks)
{ {
copy_stack_elements(stacks->datastack_region,stacks->datastack); trace_stack_elements(stacks->datastack_region,stacks->datastack);
copy_stack_elements(stacks->retainstack_region,stacks->retainstack); trace_stack_elements(stacks->retainstack_region,stacks->retainstack);
copy_handle(&stacks->catchstack_save); trace_handle(&stacks->catchstack_save);
copy_handle(&stacks->current_callback_save); trace_handle(&stacks->current_callback_save);
mark_active_blocks(stacks); mark_active_blocks(stacks);
stacks = stacks->next; stacks = stacks->next;
} }
}
int i;
for(i = 0; i < USER_ENV; i++)
copy_handle(&userenv[i]);
} }
cell factor_vm::copy_next_from_nursery(cell scan) cell factor_vm::copy_next_from_nursery(cell scan)
@ -341,8 +351,8 @@ cell factor_vm::copy_next_from_aging(cell scan)
cell tenured_start = data->generations[data->tenured()].start; cell tenured_start = data->generations[data->tenured()].start;
cell tenured_end = data->generations[data->tenured()].end; cell tenured_end = data->generations[data->tenured()].end;
cell newspace_start = newspace->start; cell newspace_start = current_gc->newspace->start;
cell newspace_end = newspace->end; cell newspace_end = current_gc->newspace->end;
for(; obj < end; obj++) for(; obj < end; obj++)
{ {
@ -370,8 +380,8 @@ cell factor_vm::copy_next_from_tenured(cell scan)
{ {
obj++; obj++;
cell newspace_start = newspace->start; cell newspace_start = current_gc->newspace->start;
cell newspace_end = newspace->end; cell newspace_end = current_gc->newspace->end;
for(; obj < end; obj++) for(; obj < end; obj++)
{ {
@ -393,120 +403,199 @@ cell factor_vm::copy_next_from_tenured(cell scan)
void factor_vm::copy_reachable_objects(cell scan, cell *end) void factor_vm::copy_reachable_objects(cell scan, cell *end)
{ {
if(collecting_gen == data->nursery()) if(current_gc->collecting_nursery_p())
{ {
while(scan < *end) while(scan < *end)
scan = copy_next_from_nursery(scan); scan = copy_next_from_nursery(scan);
} }
else if(data->have_aging_p() && collecting_gen == data->aging()) else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
{ {
while(scan < *end) while(scan < *end)
scan = copy_next_from_aging(scan); scan = copy_next_from_aging(scan);
} }
else if(collecting_gen == data->tenured()) else if(current_gc->collecting_tenured_p())
{ {
while(scan < *end) while(scan < *end)
scan = copy_next_from_tenured(scan); scan = copy_next_from_tenured(scan);
} }
} }
void factor_vm::update_code_heap_roots()
{
if(current_gc->collecting_gen >= last_code_heap_scan)
{
code_heap_scans++;
trace_code_heap_roots();
if(current_gc->collecting_accumulation_gen_p())
last_code_heap_scan = current_gc->collecting_gen;
else
last_code_heap_scan = current_gc->collecting_gen + 1;
}
}
struct literal_and_word_reference_updater {
factor_vm *myvm;
literal_and_word_reference_updater(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(heap_block *block)
{
code_block *compiled = (code_block *)block;
myvm->update_literal_references(compiled);
myvm->update_word_references(compiled);
}
};
void factor_vm::free_unmarked_code_blocks()
{
literal_and_word_reference_updater updater(this);
code->free_unmarked(updater);
last_code_heap_scan = current_gc->collecting_gen;
}
void factor_vm::update_dirty_code_blocks()
{
std::set<code_block *> dirty_code_blocks = current_gc->dirty_code_blocks;
std::set<code_block *>::const_iterator iter = dirty_code_blocks.begin();
std::set<code_block *>::const_iterator end = dirty_code_blocks.end();
for(; iter != end; iter++)
update_literal_references(*iter);
dirty_code_blocks.clear();
}
/* Prepare to start copying reachable objects into an unused zone */ /* Prepare to start copying reachable objects into an unused zone */
void factor_vm::begin_gc(cell requested_bytes) void factor_vm::begin_gc(cell requested_bytes)
{ {
if(growing_data_heap) if(current_gc->growing_data_heap)
{ {
if(collecting_gen != data->tenured()) assert(current_gc->collecting_tenured_p());
critical_error("Invalid parameters to begin_gc",0);
old_data_heap = data; current_gc->old_data_heap = data;
set_data_heap(grow_data_heap(old_data_heap,requested_bytes)); set_data_heap(grow_data_heap(current_gc->old_data_heap,requested_bytes));
newspace = &data->generations[data->tenured()]; current_gc->newspace = &data->generations[data->tenured()];
} }
else if(collecting_accumulation_gen_p()) else if(current_gc->collecting_accumulation_gen_p())
{ {
/* when collecting one of these generations, rotate it /* when collecting one of these generations, rotate it
with the semispace */ with the semispace */
zone z = data->generations[collecting_gen]; zone z = data->generations[current_gc->collecting_gen];
data->generations[collecting_gen] = data->semispaces[collecting_gen]; data->generations[current_gc->collecting_gen] = data->semispaces[current_gc->collecting_gen];
data->semispaces[collecting_gen] = z; data->semispaces[current_gc->collecting_gen] = z;
reset_generation(collecting_gen); reset_generation(current_gc->collecting_gen);
newspace = &data->generations[collecting_gen]; current_gc->newspace = &data->generations[current_gc->collecting_gen];
clear_cards(collecting_gen,collecting_gen); clear_cards(current_gc->collecting_gen,current_gc->collecting_gen);
clear_decks(collecting_gen,collecting_gen); clear_decks(current_gc->collecting_gen,current_gc->collecting_gen);
clear_allot_markers(collecting_gen,collecting_gen); clear_allot_markers(current_gc->collecting_gen,current_gc->collecting_gen);
} }
else else
{ {
/* when collecting a younger generation, we copy /* when collecting a younger generation, we copy
reachable objects to the next oldest generation, reachable objects to the next oldest generation,
so we set the newspace so the next generation. */ so we set the newspace so the next generation. */
newspace = &data->generations[collecting_gen + 1]; current_gc->newspace = &data->generations[current_gc->collecting_gen + 1];
} }
} }
void factor_vm::end_gc(cell gc_elapsed) void factor_vm::end_gc()
{ {
gc_stats *s = &stats[collecting_gen];
gc_stats *s = &stats[current_gc->collecting_gen];
cell gc_elapsed = (current_micros() - current_gc->start_time);
s->collections++; s->collections++;
s->gc_time += gc_elapsed; s->gc_time += gc_elapsed;
if(s->max_gc_time < gc_elapsed) if(s->max_gc_time < gc_elapsed)
s->max_gc_time = gc_elapsed; s->max_gc_time = gc_elapsed;
if(growing_data_heap) if(current_gc->growing_data_heap)
{ delete current_gc->old_data_heap;
delete old_data_heap;
old_data_heap = NULL;
growing_data_heap = false;
}
if(collecting_accumulation_gen_p()) if(current_gc->collecting_nursery_p())
{
/* all younger generations except are now empty.
if collecting_gen == data->nursery() here, we only have 1 generation;
old-school Cheney collector */
if(collecting_gen != data->nursery())
reset_generations(data->nursery(),collecting_gen - 1);
}
else if(collecting_gen == data->nursery())
{ {
nursery.here = nursery.start; nursery.here = nursery.start;
} }
else if(current_gc->collecting_accumulation_gen_p())
{
reset_generations(data->nursery(),current_gc->collecting_gen - 1);
}
else else
{ {
/* all generations up to and including the one /* all generations up to and including the one
collected are now empty */ collected are now empty */
reset_generations(data->nursery(),collecting_gen); reset_generations(data->nursery(),current_gc->collecting_gen);
} }
collecting_aging_again = false;
} }
/* Collect gen and all younger generations. /* Collect gen and all younger generations.
If growing_data_heap_ is true, we must grow the data heap to such a size that If growing_data_heap_ is true, we must grow the data heap to such a size that
an allocation of requested_bytes won't fail */ an allocation of requested_bytes won't fail */
void factor_vm::garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes) void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_, bool trace_contexts_, cell requested_bytes)
{ {
if(gc_off) if(gc_off)
{ {
critical_error("GC disabled",gen); critical_error("GC disabled",collecting_gen_);
return; return;
} }
u64 start = current_micros(); current_gc = new gc_state(data,growing_data_heap_,collecting_gen_);
performing_gc = true; /* Keep trying to GC higher and higher generations until we don't run out
growing_data_heap = growing_data_heap_; of space */
collecting_gen = gen; for(;;)
/* we come back here if a generation is full */
if(setjmp(gc_jmp))
{ {
try
{
begin_gc(requested_bytes);
/* Initialize chase pointer */
cell scan = current_gc->newspace->here;
/* Trace objects referenced from global environment */
trace_roots();
/* Trace objects referenced from stacks, unless we're doing
save-image-and-exit in which case stack objects are irrelevant */
if(trace_contexts_) trace_contexts();
/* Trace objects referenced from older generations */
trace_cards();
/* On minor GC, trace code heap roots if it has pointers
to this generation or younger. Otherwise, tracing data heap objects
will mark all reachable code blocks, and we free the unmarked ones
after. */
if(!current_gc->collecting_tenured_p() && current_gc->collecting_gen >= last_code_heap_scan)
{
update_code_heap_roots();
}
/* do some copying -- this is where most of the work is done */
copy_reachable_objects(scan,&current_gc->newspace->here);
/* On minor GC, update literal references in code blocks, now that all
data heap objects are in their final location. On a major GC,
free all code blocks that did not get marked during tracing. */
if(current_gc->collecting_tenured_p())
free_unmarked_code_blocks();
else
update_dirty_code_blocks();
/* GC completed without any generations filling up; finish up */
break;
}
catch(const generation_full_condition &c)
{
/* We come back here if a generation is full */
/* We have no older generations we can try collecting, so we /* We have no older generations we can try collecting, so we
resort to growing the data heap */ resort to growing the data heap */
if(collecting_gen == data->tenured()) if(current_gc->collecting_tenured_p())
{ {
growing_data_heap = true; current_gc->growing_data_heap = true;
/* see the comment in unmark_marked() */ /* see the comment in unmark_marked() */
code->unmark_marked(); code->unmark_marked();
@ -514,58 +603,28 @@ void factor_vm::garbage_collection(cell gen,bool growing_data_heap_,cell request
/* we try collecting aging space twice before going on to /* we try collecting aging space twice before going on to
collect tenured */ collect tenured */
else if(data->have_aging_p() else if(data->have_aging_p()
&& collecting_gen == data->aging() && current_gc->collecting_gen == data->aging()
&& !collecting_aging_again) && !current_gc->collecting_aging_again)
{ {
collecting_aging_again = true; current_gc->collecting_aging_again = true;
} }
/* Collect the next oldest generation */ /* Collect the next oldest generation */
else else
{ {
collecting_gen++; current_gc->collecting_gen++;
}
} }
} }
begin_gc(requested_bytes); end_gc();
/* initialize chase pointer */ delete current_gc;
cell scan = newspace->here; current_gc = NULL;
/* collect objects referenced from stacks and environment */
copy_roots();
/* collect objects referenced from older generations */
copy_cards();
/* do some tracing */
copy_reachable_objects(scan,&newspace->here);
/* don't scan code heap unless it has pointers to this
generation or younger */
if(collecting_gen >= last_code_heap_scan)
{
code_heap_scans++;
if(collecting_gen == data->tenured())
code->free_unmarked((heap_iterator)&factor_vm::update_literal_and_word_references);
else
copy_code_heap_roots();
if(collecting_accumulation_gen_p())
last_code_heap_scan = collecting_gen;
else
last_code_heap_scan = collecting_gen + 1;
}
cell gc_elapsed = (current_micros() - start);
end_gc(gc_elapsed);
performing_gc = false;
} }
void factor_vm::gc() void factor_vm::gc()
{ {
garbage_collection(data->tenured(),false,0); garbage_collection(data->tenured(),false,true,0);
} }
void factor_vm::primitive_gc() void factor_vm::primitive_gc()
@ -655,7 +714,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
for(cell i = 0; i < gc_roots_size; i++) for(cell i = 0; i < gc_roots_size; i++)
gc_locals.push_back((cell)&gc_roots_base[i]); gc_locals.push_back((cell)&gc_roots_base[i]);
garbage_collection(data->nursery(),false,0); garbage_collection(data->nursery(),false,true,0);
for(cell i = 0; i < gc_roots_size; i++) for(cell i = 0; i < gc_roots_size; i++)
gc_locals.pop_back(); gc_locals.pop_back();
@ -693,7 +752,7 @@ object *factor_vm::allot_object(header header, cell size)
{ {
/* If there is insufficient room, collect the nursery */ /* If there is insufficient room, collect the nursery */
if(nursery.here + allot_buffer_zone + size > nursery.end) if(nursery.here + allot_buffer_zone + size > nursery.end)
garbage_collection(data->nursery(),false,0); garbage_collection(data->nursery(),false,true,0);
cell h = nursery.here; cell h = nursery.here;
nursery.here = h + align8(size); nursery.here = h + align8(size);
@ -715,7 +774,7 @@ object *factor_vm::allot_object(header header, cell size)
/* If it still won't fit, grow the heap */ /* If it still won't fit, grow the heap */
if(tenured->here + size > tenured->end) if(tenured->here + size > tenured->end)
{ {
garbage_collection(data->tenured(),true,size); garbage_collection(data->tenured(),true,true,size);
tenured = &data->generations[data->tenured()]; tenured = &data->generations[data->tenured()];
} }

47
vm/data_gc.hpp
View File

@ -10,12 +10,57 @@ struct gc_stats {
u64 bytes_copied; u64 bytes_copied;
}; };
struct gc_state {
/* The data heap we're collecting */
data_heap *data;
/* New objects are copied here */
zone *newspace;
/* sometimes we grow the heap */
bool growing_data_heap;
data_heap *old_data_heap;
/* Which generation is being collected */
cell collecting_gen;
/* If true, we are collecting aging space for the second time, so if it is still
full, we go on to collect tenured */
bool collecting_aging_again;
/* A set of code blocks which need to have their literals updated */
std::set<code_block *> dirty_code_blocks;
/* GC start time, for benchmarking */
u64 start_time;
explicit gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_);
~gc_state();
inline bool collecting_nursery_p()
{
return collecting_gen == data->nursery();
}
inline bool collecting_tenured_p()
{
return collecting_gen == data->tenured();
}
inline bool collecting_accumulation_gen_p()
{
return ((data->have_aging_p()
&& collecting_gen == data->aging()
&& !collecting_aging_again)
|| collecting_gen == data->tenured());
}
};
/* We leave this many bytes free at the top of the nursery so that inline /* We leave this many bytes free at the top of the nursery so that inline
allocation (which does not call GC because of possible roots in volatile allocation (which does not call GC because of possible roots in volatile
registers) does not run out of memory */ registers) does not run out of memory */
static const cell allot_buffer_zone = 1024; static const cell allot_buffer_zone = 1024;
struct factor_vm;
VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm); VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
} }

8
vm/data_heap.cpp
View File

@ -310,12 +310,12 @@ void factor_vm::primitive_end_scan()
gc_off = false; gc_off = false;
} }
template<typename TYPE> void factor_vm::each_object(TYPE &functor) template<typename Iterator> void factor_vm::each_object(Iterator &iterator)
{ {
begin_scan(); begin_scan();
cell obj; cell obj;
while((obj = next_object()) != F) while((obj = next_object()) != F)
functor(tagged<object>(obj)); iterator(tagged<object>(obj));
end_scan(); end_scan();
} }
@ -324,13 +324,13 @@ namespace
struct word_counter { struct word_counter {
cell count; cell count;
word_counter() : count(0) {} explicit word_counter() : count(0) {}
void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) count++; } void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) count++; }
}; };
struct word_accumulator { struct word_accumulator {
growable_array words; growable_array words;
word_accumulator(int count,factor_vm *vm) : words(vm,count) {} explicit word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); } void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); }
}; };

2
vm/data_heap.hpp
View File

@ -51,7 +51,7 @@ struct data_heap {
bool have_aging_p() { return gen_count > 2; } bool have_aging_p() { return gen_count > 2; }
data_heap(factor_vm *myvm, cell gen_count, cell young_size, cell aging_size, cell tenured_size); explicit data_heap(factor_vm *myvm, cell gen_count, cell young_size, cell aging_size, cell tenured_size);
~data_heap(); ~data_heap();
}; };

59
vm/debug.cpp
View File

@ -164,34 +164,35 @@ void factor_vm::print_retainstack()
print_objects((cell *)rs_bot,(cell *)rs); print_objects((cell *)rs_bot,(cell *)rs);
} }
void factor_vm::print_stack_frame(stack_frame *frame) struct stack_frame_printer {
{ factor_vm *myvm;
print_obj(frame_executing(frame));
explicit stack_frame_printer(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(stack_frame *frame)
{
myvm->print_obj(myvm->frame_executing(frame));
print_string("\n"); print_string("\n");
print_obj(frame_scan(frame)); myvm->print_obj(myvm->frame_scan(frame));
print_string("\n"); print_string("\n");
print_string("word/quot addr: "); print_string("word/quot addr: ");
print_cell_hex((cell)frame_executing(frame)); print_cell_hex((cell)myvm->frame_executing(frame));
print_string("\n"); print_string("\n");
print_string("word/quot xt: "); print_string("word/quot xt: ");
print_cell_hex((cell)frame->xt); print_cell_hex((cell)frame->xt);
print_string("\n"); print_string("\n");
print_string("return address: "); print_string("return address: ");
print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame)); print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame,myvm));
print_string("\n"); print_string("\n");
} }
};
void print_stack_frame(stack_frame *frame, factor_vm *myvm)
{
return myvm->print_stack_frame(frame);
}
void factor_vm::print_callstack() void factor_vm::print_callstack()
{ {
print_string("==== CALL STACK:\n"); print_string("==== CALL STACK:\n");
cell bottom = (cell)stack_chain->callstack_bottom; cell bottom = (cell)stack_chain->callstack_bottom;
cell top = (cell)stack_chain->callstack_top; cell top = (cell)stack_chain->callstack_top;
iterate_callstack(top,bottom,factor::print_stack_frame); stack_frame_printer printer(this);
iterate_callstack(top,bottom,printer);
} }
void factor_vm::dump_cell(cell x) void factor_vm::dump_cell(cell x)
@ -263,30 +264,36 @@ void factor_vm::dump_objects(cell type)
end_scan(); end_scan();
} }
void factor_vm::find_data_references_step(cell *scan) struct data_references_finder {
{ cell look_for, obj;
factor_vm *myvm;
explicit data_references_finder(cell look_for_, cell obj_, factor_vm *myvm_)
: look_for(look_for_), obj(obj_), myvm(myvm_) { }
void operator()(cell *scan)
{
if(look_for == *scan) if(look_for == *scan)
{ {
print_cell_hex_pad(obj); print_cell_hex_pad(obj);
print_string(" "); print_string(" ");
print_nested_obj(obj,2); myvm->print_nested_obj(obj,2);
nl(); nl();
} }
} }
};
void find_data_references_step(cell *scan,factor_vm *myvm) void factor_vm::find_data_references(cell look_for)
{ {
return myvm->find_data_references_step(scan);
}
void factor_vm::find_data_references(cell look_for_)
{
look_for = look_for_;
begin_scan(); begin_scan();
cell obj;
while((obj = next_object()) != F) while((obj = next_object()) != F)
do_slots(UNTAG(obj),factor::find_data_references_step); {
data_references_finder finder(look_for,obj,this);
do_slots(UNTAG(obj),finder);
}
end_scan(); end_scan();
} }

2
vm/factor.cpp
View File

@ -222,7 +222,7 @@ struct startargs {
vm_char **argv; vm_char **argv;
}; };
factor_vm * new_factor_vm() factor_vm *new_factor_vm()
{ {
factor_vm *newvm = new factor_vm; factor_vm *newvm = new factor_vm;
register_vm_with_thread(newvm); register_vm_with_thread(newvm);

28
vm/generic_arrays.hpp
View File

@ -1,7 +1,7 @@
namespace factor namespace factor
{ {
template<typename T> cell array_capacity(T *array) template<typename Array> cell array_capacity(Array *array)
{ {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
assert(array->h.hi_tag() == T::type_number); assert(array->h.hi_tag() == T::type_number);
@ -9,31 +9,31 @@ template<typename T> cell array_capacity(T *array)
return array->capacity >> TAG_BITS; return array->capacity >> TAG_BITS;
} }
template <typename T> cell array_size(cell capacity) template<typename Array> cell array_size(cell capacity)
{ {
return sizeof(T) + capacity * T::element_size; return sizeof(Array) + capacity * Array::element_size;
} }
template <typename T> cell array_size(T *array) template<typename Array> cell array_size(Array *array)
{ {
return array_size<T>(array_capacity(array)); return array_size<Array>(array_capacity(array));
} }
template <typename TYPE> TYPE *factor_vm::allot_array_internal(cell capacity) template<typename Array> Array *factor_vm::allot_array_internal(cell capacity)
{ {
TYPE *array = allot<TYPE>(array_size<TYPE>(capacity)); Array *array = allot<Array>(array_size<Array>(capacity));
array->capacity = tag_fixnum(capacity); array->capacity = tag_fixnum(capacity);
return array; return array;
} }
template <typename TYPE> bool factor_vm::reallot_array_in_place_p(TYPE *array, cell capacity) template<typename Array> bool factor_vm::reallot_array_in_place_p(Array *array, cell capacity)
{ {
return in_zone(&nursery,array) && capacity <= array_capacity(array); return in_zone(&nursery,array) && capacity <= array_capacity(array);
} }
template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capacity) template<typename Array> Array *factor_vm::reallot_array(Array *array_, cell capacity)
{ {
gc_root<TYPE> array(array_,this); gc_root<Array> array(array_,this);
if(reallot_array_in_place_p(array.untagged(),capacity)) if(reallot_array_in_place_p(array.untagged(),capacity))
{ {
@ -46,11 +46,11 @@ template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capac
if(capacity < to_copy) if(capacity < to_copy)
to_copy = capacity; to_copy = capacity;
TYPE *new_array = allot_array_internal<TYPE>(capacity); Array *new_array = allot_array_internal<Array>(capacity);
memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size); memcpy(new_array + 1,array.untagged() + 1,to_copy * Array::element_size);
memset((char *)(new_array + 1) + to_copy * TYPE::element_size, memset((char *)(new_array + 1) + to_copy * Array::element_size,
0,(capacity - to_copy) * TYPE::element_size); 0,(capacity - to_copy) * Array::element_size);
return new_array; return new_array;
} }

66
vm/heap.cpp
View File

@ -208,55 +208,6 @@ void heap::unmark_marked()
} }
} }
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
which are allocated and not marked can be reclaimed. */
void heap::free_unmarked(heap_iterator iter)
{
clear_free_list();
heap_block *prev = NULL;
heap_block *scan = first_block();
while(scan)
{
switch(scan->status)
{
case B_ALLOCATED:
if(myvm->secure_gc)
memset(scan + 1,0,scan->size - sizeof(heap_block));
if(prev && prev->status == B_FREE)
prev->size += scan->size;
else
{
scan->status = B_FREE;
prev = scan;
}
break;
case B_FREE:
if(prev && prev->status == B_FREE)
prev->size += scan->size;
else
prev = scan;
break;
case B_MARKED:
if(prev && prev->status == B_FREE)
add_to_free_list((free_heap_block *)prev);
scan->status = B_ALLOCATED;
prev = scan;
(myvm->*iter)(scan);
break;
default:
myvm->critical_error("Invalid scan->status",(cell)scan);
}
scan = next_block(scan);
}
if(prev && prev->status == B_FREE)
add_to_free_list((free_heap_block *)prev);
}
/* Compute total sum of sizes of free blocks, and size of largest free block */ /* Compute total sum of sizes of free blocks, and size of largest free block */
void heap::heap_usage(cell *used, cell *total_free, cell *max_free) void heap::heap_usage(cell *used, cell *total_free, cell *max_free)
{ {
@ -338,4 +289,21 @@ void heap::compact_heap(unordered_map<heap_block *,char *> &forwarding)
} }
} }
heap_block *heap::free_allocated(heap_block *prev, heap_block *scan)
{
if(myvm->secure_gc)
memset(scan + 1,0,scan->size - sizeof(heap_block));
if(prev && prev->status == B_FREE)
{
prev->size += scan->size;
return prev;
}
else
{
scan->status = B_FREE;
return scan;
}
}
} }

44
vm/heap.hpp
View File

@ -9,14 +9,12 @@ struct heap_free_list {
free_heap_block *large_blocks; free_heap_block *large_blocks;
}; };
typedef void (factor_vm::*heap_iterator)(heap_block *compiled);
struct heap { struct heap {
factor_vm *myvm; factor_vm *myvm;
segment *seg; segment *seg;
heap_free_list free; heap_free_list free;
heap(factor_vm *myvm, cell size); explicit heap(factor_vm *myvm, cell size);
inline heap_block *next_block(heap_block *block) inline heap_block *next_block(heap_block *block)
{ {
@ -48,12 +46,50 @@ struct heap {
void heap_free(heap_block *block); void heap_free(heap_block *block);
void mark_block(heap_block *block); void mark_block(heap_block *block);
void unmark_marked(); void unmark_marked();
void free_unmarked(heap_iterator iter);
void heap_usage(cell *used, cell *total_free, cell *max_free); void heap_usage(cell *used, cell *total_free, cell *max_free);
cell heap_size(); cell heap_size();
cell compute_heap_forwarding(unordered_map<heap_block *,char *> &forwarding); cell compute_heap_forwarding(unordered_map<heap_block *,char *> &forwarding);
void compact_heap(unordered_map<heap_block *,char *> &forwarding); void compact_heap(unordered_map<heap_block *,char *> &forwarding);
heap_block *free_allocated(heap_block *prev, heap_block *scan);
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
which are allocated and not marked can be reclaimed. */
template<typename Iterator> void free_unmarked(Iterator &iter)
{
clear_free_list();
heap_block *prev = NULL;
heap_block *scan = first_block();
while(scan)
{
switch(scan->status)
{
case B_ALLOCATED:
prev = free_allocated(prev,scan);
break;
case B_FREE:
if(prev && prev->status == B_FREE)
prev->size += scan->size;
else
prev = scan;
break;
case B_MARKED:
if(prev && prev->status == B_FREE)
add_to_free_list((free_heap_block *)prev);
scan->status = B_ALLOCATED;
prev = scan;
iter(scan);
break;
}
scan = next_block(scan);
}
if(prev && prev->status == B_FREE)
add_to_free_list((free_heap_block *)prev);
}
}; };
} }

65
vm/image.cpp
View File

@ -143,9 +143,7 @@ void factor_vm::primitive_save_image_and_exit()
} }
/* do a full GC + code heap compaction */ /* do a full GC + code heap compaction */
performing_compaction = true;
compact_code_heap(); compact_code_heap();
performing_compaction = false;
/* Save the image */ /* Save the image */
if(save_image((vm_char *)(path.untagged() + 1))) if(save_image((vm_char *)(path.untagged() + 1)))
@ -163,15 +161,10 @@ void factor_vm::data_fixup(cell *cell)
*cell += (tenured->start - data_relocation_base); *cell += (tenured->start - data_relocation_base);
} }
void data_fixup(cell *cell, factor_vm *myvm) template<typename Type> void factor_vm::code_fixup(Type **handle)
{ {
return myvm->data_fixup(cell); Type *ptr = *handle;
} Type *new_ptr = (Type *)(((cell)ptr) + (code->seg->start - code_relocation_base));
template <typename TYPE> void factor_vm::code_fixup(TYPE **handle)
{
TYPE *ptr = *handle;
TYPE *new_ptr = (TYPE *)(((cell)ptr) + (code->seg->start - code_relocation_base));
*handle = new_ptr; *handle = new_ptr;
} }
@ -200,22 +193,34 @@ void factor_vm::fixup_alien(alien *d)
d->expired = T; d->expired = T;
} }
void factor_vm::fixup_stack_frame(stack_frame *frame) struct stack_frame_fixupper {
{ factor_vm *myvm;
code_fixup(&frame->xt);
code_fixup(&FRAME_RETURN_ADDRESS(frame));
}
void fixup_stack_frame(stack_frame *frame, factor_vm *myvm) explicit stack_frame_fixupper(factor_vm *myvm_) : myvm(myvm_) {}
{ void operator()(stack_frame *frame)
return myvm->fixup_stack_frame(frame); {
} myvm->code_fixup(&frame->xt);
myvm->code_fixup(&FRAME_RETURN_ADDRESS(frame,myvm));
}
};
void factor_vm::fixup_callstack_object(callstack *stack) void factor_vm::fixup_callstack_object(callstack *stack)
{ {
iterate_callstack_object(stack,factor::fixup_stack_frame); stack_frame_fixupper fixupper(this);
iterate_callstack_object(stack,fixupper);
} }
struct object_fixupper {
factor_vm *myvm;
explicit object_fixupper(factor_vm *myvm_) : myvm(myvm_) { }
void operator()(cell *scan)
{
myvm->data_fixup(scan);
}
};
/* Initialize an object in a newly-loaded image */ /* Initialize an object in a newly-loaded image */
void factor_vm::relocate_object(object *object) void factor_vm::relocate_object(object *object)
{ {
@ -237,7 +242,8 @@ void factor_vm::relocate_object(object *object)
} }
else else
{ {
do_slots((cell)object,factor::data_fixup); object_fixupper fixupper(this);
do_slots((cell)object,fixupper);
switch(hi_tag) switch(hi_tag)
{ {
@ -296,14 +302,21 @@ void factor_vm::fixup_code_block(code_block *compiled)
relocate_code_block(compiled); relocate_code_block(compiled);
} }
void fixup_code_block(code_block *compiled, factor_vm *myvm) struct code_block_fixupper {
{ factor_vm *myvm;
return myvm->fixup_code_block(compiled);
} code_block_fixupper(factor_vm *myvm_) : myvm(myvm_) { }
void operator()(code_block *compiled)
{
myvm->fixup_code_block(compiled);
}
};
void factor_vm::relocate_code() void factor_vm::relocate_code()
{ {
iterate_code_heap(&factor_vm::fixup_code_block); code_block_fixupper fixupper(this);
iterate_code_heap(fixupper);
} }
/* Read an image file from disk, only done once during startup */ /* Read an image file from disk, only done once during startup */

2
vm/inline_cache.cpp
View File

@ -74,7 +74,7 @@ void factor_vm::update_pic_count(cell type)
struct inline_cache_jit : public jit { struct inline_cache_jit : public jit {
fixnum index; fixnum index;
inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(PIC_TYPE,generic_word_,vm) {}; explicit inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(PIC_TYPE,generic_word_,vm) {};
void emit_check(cell klass); void emit_check(cell klass);
void compile_inline_cache(fixnum index, void compile_inline_cache(fixnum index,

2
vm/jit.hpp
View File

@ -12,7 +12,7 @@ struct jit {
cell offset; cell offset;
factor_vm *parent_vm; factor_vm *parent_vm;
jit(cell jit_type, cell owner, factor_vm *vm); explicit jit(cell jit_type, cell owner, factor_vm *vm);
void compute_position(cell offset); void compute_position(cell offset);
void emit_relocation(cell code_template); void emit_relocation(cell code_template);

6
vm/layouts.hpp
View File

@ -106,9 +106,9 @@ struct header {
cell value; cell value;
/* Default ctor to make gcc 3.x happy */ /* Default ctor to make gcc 3.x happy */
header() { abort(); } explicit header() { abort(); }
header(cell value_) : value(value_ << TAG_BITS) {} explicit header(cell value_) : value(value_ << TAG_BITS) {}
void check_header() { void check_header() {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
@ -179,7 +179,7 @@ struct byte_array : public object {
/* tagged */ /* tagged */
cell capacity; cell capacity;
template<typename T> T *data() { return (T *)(this + 1); } template<typename Scalar> Scalar *data() { return (Scalar *)(this + 1); }
}; };
/* Assembly code makes assumptions about the layout of this struct */ /* Assembly code makes assumptions about the layout of this struct */

14
vm/local_roots.hpp
View File

@ -1,18 +1,18 @@
namespace factor namespace factor
{ {
template <typename TYPE> template<typename Type>
struct gc_root : public tagged<TYPE> struct gc_root : public tagged<Type>
{ {
factor_vm *parent_vm; factor_vm *parent_vm;
void push() { parent_vm->check_tagged_pointer(tagged<TYPE>::value()); parent_vm->gc_locals.push_back((cell)this); } void push() { parent_vm->check_tagged_pointer(tagged<Type>::value()); parent_vm->gc_locals.push_back((cell)this); }
explicit gc_root(cell value_,factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); } explicit gc_root(cell value_,factor_vm *vm) : tagged<Type>(value_),parent_vm(vm) { push(); }
explicit gc_root(TYPE *value_, factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); } explicit gc_root(Type *value_, factor_vm *vm) : tagged<Type>(value_),parent_vm(vm) { push(); }
const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; } const gc_root<Type>& operator=(const Type *x) { tagged<Type>::operator=(x); return *this; }
const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; } const gc_root<Type>& operator=(const cell &x) { tagged<Type>::operator=(x); return *this; }
~gc_root() { ~gc_root() {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG

17
vm/master.hpp
View File

@ -25,23 +25,32 @@
/* C++ headers */ /* C++ headers */
#include <vector> #include <vector>
#include <set>
#if __GNUC__ == 4 #if __GNUC__ == 4
#include <tr1/unordered_map> #include <tr1/unordered_map>
namespace factor { namespace factor
{
using std::tr1::unordered_map; using std::tr1::unordered_map;
} }
#elif __GNUC__ == 3 #elif __GNUC__ == 3
#include <boost/unordered_map.hpp> #include <boost/unordered_map.hpp>
namespace factor { namespace factor
{
using boost::unordered_map; using boost::unordered_map;
} }
#else #else
#error Factor requires GCC 3.x or later #error Factor requires GCC 3.x or later
#endif #endif
/* Forward-declare this since it comes up in function prototypes */
namespace factor
{
struct factor_vm;
}
/* Factor headers */ /* Factor headers */
#include "layouts.hpp" #include "layouts.hpp"
#include "platform.hpp" #include "platform.hpp"

7
vm/os-genunix.cpp
View File

@ -26,12 +26,7 @@ const char *default_image_path()
if(!path) if(!path)
return "factor.image"; return "factor.image";
/* We can't call strlen() here because with gcc 4.1.2 this int len = strlen(path);
causes an internal compiler error. */
int len = 0;
const char *iter = path;
while(*iter) { len++; iter++; }
char *new_path = new char[PATH_MAX + SUFFIX_LEN + 1]; char *new_path = new char[PATH_MAX + SUFFIX_LEN + 1];
memcpy(new_path,path,len + 1); memcpy(new_path,path,len + 1);
memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1); memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1);

2
vm/os-linux-ppc.hpp
View File

@ -3,7 +3,7 @@
namespace factor namespace factor
{ {
#define FRAME_RETURN_ADDRESS(frame) *((void **)(frame_successor(frame) + 1) + 1) #define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
inline static void *ucontext_stack_pointer(void *uap) inline static void *ucontext_stack_pointer(void *uap)
{ {

2
vm/os-macosx-ppc.hpp
View File

@ -13,7 +13,7 @@ Used under BSD license with permission from Paolo Bonzini and Bruno Haible,
http://sourceforge.net/mailarchive/message.php?msg_name=200503102200.32002.bruno%40clisp.org http://sourceforge.net/mailarchive/message.php?msg_name=200503102200.32002.bruno%40clisp.org
Modified for Factor by Slava Pestov */ Modified for Factor by Slava Pestov */
#define FRAME_RETURN_ADDRESS(frame) *((void **)(frame_successor(frame) + 1) + 2) #define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 2)
#define MACH_EXC_STATE_TYPE ppc_exception_state_t #define MACH_EXC_STATE_TYPE ppc_exception_state_t
#define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE #define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE

3
vm/os-unix.hpp
View File

@ -55,8 +55,9 @@ s64 current_micros();
void sleep_micros(cell usec); void sleep_micros(cell usec);
void init_platform_globals(); void init_platform_globals();
struct factor_vm;
void register_vm_with_thread(factor_vm *vm); void register_vm_with_thread(factor_vm *vm);
factor_vm *tls_vm(); factor_vm *tls_vm();
void open_console(); void open_console();
} }

1
vm/os-windows-nt.hpp
View File

@ -32,7 +32,6 @@ THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
inline static THREADHANDLE thread_id() { return GetCurrentThread(); } inline static THREADHANDLE thread_id() { return GetCurrentThread(); }
void init_platform_globals(); void init_platform_globals();
struct factor_vm;
void register_vm_with_thread(factor_vm *vm); void register_vm_with_thread(factor_vm *vm);
factor_vm *tls_vm(); factor_vm *tls_vm();

3
vm/profiler.cpp
View File

@ -44,7 +44,8 @@ void factor_vm::set_profiling(bool profiling)
} }
/* Update XTs in code heap */ /* Update XTs in code heap */
iterate_code_heap(&factor_vm::relocate_code_block); word_updater updater(this);
iterate_code_heap(updater);
} }
void factor_vm::primitive_profiling() void factor_vm::primitive_profiling()

4
vm/quotations.cpp
View File

@ -330,7 +330,9 @@ void factor_vm::compile_all_words()
} }
iterate_code_heap(&factor_vm::relocate_code_block); /* Update XTs in code heap */
word_updater updater(this);
iterate_code_heap(updater);
} }
/* Allocates memory */ /* Allocates memory */

2
vm/quotations.hpp
View File

@ -5,7 +5,7 @@ struct quotation_jit : public jit {
gc_root<array> elements; gc_root<array> elements;
bool compiling, relocate; bool compiling, relocate;
quotation_jit(cell quot, bool compiling_, bool relocate_, factor_vm *vm) explicit quotation_jit(cell quot, bool compiling_, bool relocate_, factor_vm *vm)
: jit(QUOTATION_TYPE,quot,vm), : jit(QUOTATION_TYPE,quot,vm),
elements(owner.as<quotation>().untagged()->array,vm), elements(owner.as<quotation>().untagged()->array,vm),
compiling(compiling_), compiling(compiling_),

2
vm/run.cpp
View File

@ -58,7 +58,7 @@ cell factor_vm::clone_object(cell obj_)
else else
{ {
cell size = object_size(obj.value()); cell size = object_size(obj.value());
object *new_obj = allot_object(obj.type(),size); object *new_obj = allot_object(header(obj.type()),size);
memcpy(new_obj,obj.untagged(),size); memcpy(new_obj,obj.untagged(),size);
return tag_dynamic(new_obj); return tag_dynamic(new_obj);
} }

4
vm/segments.hpp
View File

@ -1,8 +1,6 @@
namespace factor namespace factor
{ {
struct factor_vm;
inline cell align_page(cell a) inline cell align_page(cell a)
{ {
return align(a,getpagesize()); return align(a,getpagesize());
@ -16,7 +14,7 @@ struct segment {
cell size; cell size;
cell end; cell end;
segment(factor_vm *myvm, cell size); explicit segment(factor_vm *myvm, cell size);
~segment(); ~segment();
}; };

36
vm/tagged.hpp
View File

@ -1,9 +1,9 @@
namespace factor namespace factor
{ {
template <typename TYPE> cell tag(TYPE *value) template<typename Type> cell tag(Type *value)
{ {
return RETAG(value,tag_for(TYPE::type_number)); return RETAG(value,tag_for(Type::type_number));
} }
inline static cell tag_dynamic(object *value) inline static cell tag_dynamic(object *value)
@ -11,13 +11,13 @@ inline static cell tag_dynamic(object *value)
return RETAG(value,tag_for(value->h.hi_tag())); return RETAG(value,tag_for(value->h.hi_tag()));
} }
template <typename TYPE> template<typename Type>
struct tagged struct tagged
{ {
cell value_; cell value_;
cell value() const { return value_; } cell value() const { return value_; }
TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); } Type *untagged() const { return (Type *)(UNTAG(value_)); }
cell type() const { cell type() const {
cell tag = TAG(value_); cell tag = TAG(value_);
@ -29,9 +29,9 @@ struct tagged
bool type_p(cell type_) const { return type() == type_; } bool type_p(cell type_) const { return type() == type_; }
TYPE *untag_check(factor_vm *myvm) const { Type *untag_check(factor_vm *myvm) const {
if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number)) if(Type::type_number != TYPE_COUNT && !type_p(Type::type_number))
myvm->type_error(TYPE::type_number,value_); myvm->type_error(Type::type_number,value_);
return untagged(); return untagged();
} }
@ -41,32 +41,32 @@ struct tagged
#endif #endif
} }
explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) { explicit tagged(Type *untagged) : value_(factor::tag(untagged)) {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
untag_check(SIGNAL_VM_PTR()); untag_check(SIGNAL_VM_PTR());
#endif #endif
} }
TYPE *operator->() const { return untagged(); } Type *operator->() const { return untagged(); }
cell *operator&() const { return &value_; } cell *operator&() const { return &value_; }
const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; } const tagged<Type> &operator=(const Type *x) { value_ = tag(x); return *this; }
const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; } const tagged<Type> &operator=(const cell &x) { value_ = x; return *this; }
bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; } bool operator==(const tagged<Type> &x) { return value_ == x.value_; }
bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; } bool operator!=(const tagged<Type> &x) { return value_ != x.value_; }
template<typename X> tagged<X> as() { return tagged<X>(value_); } template<typename NewType> tagged<NewType> as() { return tagged<NewType>(value_); }
}; };
template <typename TYPE> TYPE *factor_vm::untag_check(cell value) template<typename Type> Type *factor_vm::untag_check(cell value)
{ {
return tagged<TYPE>(value).untag_check(this); return tagged<Type>(value).untag_check(this);
} }
template <typename TYPE> TYPE *factor_vm::untag(cell value) template<typename Type> Type *factor_vm::untag(cell value)
{ {
return tagged<TYPE>(value).untagged(); return tagged<Type>(value).untagged();
} }
} }

136
vm/vm.hpp
View File

@ -32,7 +32,8 @@ struct factor_vm
void primitive_check_datastack(); void primitive_check_datastack();
// run // run
cell T; /* Canonical T object. It's just a word */ /* Canonical T object. It's just a word */
cell T;
void primitive_getenv(); void primitive_getenv();
void primitive_setenv(); void primitive_setenv();
@ -168,7 +169,7 @@ struct factor_vm
cell next_object(); cell next_object();
void primitive_next_object(); void primitive_next_object();
void primitive_end_scan(); void primitive_end_scan();
template<typename T> void each_object(T &functor); template<typename Iterator> void each_object(Iterator &iterator);
cell find_all_words(); cell find_all_words();
cell object_size(cell tagged); cell object_size(cell tagged);
@ -228,53 +229,46 @@ struct factor_vm
// data_gc // data_gc
/* used during garbage collection only */ /* used during garbage collection only */
zone *newspace; gc_state *current_gc;
bool performing_gc; /* statistics */
bool performing_compaction;
cell collecting_gen;
/* if true, we are collecting aging space for the second time, so if it is still
full, we go on to collect tenured */
bool collecting_aging_again;
/* in case a generation fills up in the middle of a gc, we jump back
up to try collecting the next generation. */
jmp_buf gc_jmp;
gc_stats stats[max_gen_count]; gc_stats stats[max_gen_count];
u64 cards_scanned; u64 cards_scanned;
u64 decks_scanned; u64 decks_scanned;
u64 card_scan_time; u64 card_scan_time;
cell code_heap_scans; cell code_heap_scans;
/* What generation was being collected when copy_code_heap_roots() was last /* What generation was being collected when trace_code_heap_roots() was last
called? Until the next call to add_code_block(), future called? Until the next call to add_code_block(), future
collections of younger generations don't have to touch the code collections of younger generations don't have to touch the code
heap. */ heap. */
cell last_code_heap_scan; cell last_code_heap_scan;
/* sometimes we grow the heap */
bool growing_data_heap;
data_heap *old_data_heap;
void init_data_gc(); void init_data_gc();
object *copy_untagged_object_impl(object *pointer, cell size); object *copy_untagged_object_impl(object *pointer, cell size);
object *copy_object_impl(object *untagged); object *copy_object_impl(object *untagged);
bool should_copy_p(object *untagged); bool should_copy_p(object *untagged);
object *resolve_forwarding(object *untagged); object *resolve_forwarding(object *untagged);
template <typename T> T *copy_untagged_object(T *untagged); template<typename Type> Type *copy_untagged_object(Type *untagged);
cell copy_object(cell pointer); cell copy_object(cell pointer);
void copy_handle(cell *handle); void trace_handle(cell *handle);
void copy_card(card *ptr, cell gen, cell here); void trace_card(card *ptr, cell gen, cell here);
void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask); void trace_card_deck(card_deck *deck, cell gen, card mask, card unmask);
void copy_gen_cards(cell gen); void trace_generation_cards(cell gen);
void copy_cards(); void trace_cards();
void copy_stack_elements(segment *region, cell top); void trace_stack_elements(segment *region, cell top);
void copy_registered_locals(); void trace_registered_locals();
void copy_registered_bignums(); void trace_registered_bignums();
void copy_roots(); void trace_roots();
void trace_contexts();
void update_code_heap_roots();
cell copy_next_from_nursery(cell scan); cell copy_next_from_nursery(cell scan);
cell copy_next_from_aging(cell scan); cell copy_next_from_aging(cell scan);
cell copy_next_from_tenured(cell scan); cell copy_next_from_tenured(cell scan);
void copy_reachable_objects(cell scan, cell *end); void copy_reachable_objects(cell scan, cell *end);
void free_unmarked_code_blocks();
void update_dirty_code_blocks();
void begin_gc(cell requested_bytes); void begin_gc(cell requested_bytes);
void end_gc(cell gc_elapsed); void end_gc();
void garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes); void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts, cell requested_bytes);
void gc(); void gc();
void primitive_gc(); void primitive_gc();
void primitive_gc_stats(); void primitive_gc_stats();
@ -285,23 +279,15 @@ struct factor_vm
object *allot_object(header header, cell size); object *allot_object(header header, cell size);
void primitive_clear_gc_stats(); void primitive_clear_gc_stats();
template<typename TYPE> TYPE *allot(cell size) template<typename Type> Type *allot(cell size)
{ {
return (TYPE *)allot_object(header(TYPE::type_number),size); return (Type *)allot_object(header(Type::type_number),size);
}
inline bool collecting_accumulation_gen_p()
{
return ((data->have_aging_p()
&& collecting_gen == data->aging()
&& !collecting_aging_again)
|| collecting_gen == data->tenured());
} }
inline void check_data_pointer(object *pointer) inline void check_data_pointer(object *pointer)
{ {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
if(!growing_data_heap) if(!(current_gc && current_gc->growing_data_heap))
{ {
assert((cell)pointer >= data->seg->start assert((cell)pointer >= data->seg->start
&& (cell)pointer < data->seg->end); && (cell)pointer < data->seg->end);
@ -329,15 +315,13 @@ struct factor_vm
std::vector<cell> gc_bignums; std::vector<cell> gc_bignums;
// generic arrays // generic arrays
template <typename T> T *allot_array_internal(cell capacity); template<typename Array> Array *allot_array_internal(cell capacity);
template <typename T> bool reallot_array_in_place_p(T *array, cell capacity); template<typename Array> bool reallot_array_in_place_p(Array *array, cell capacity);
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity); template<typename Array> Array *reallot_array(Array *array_, cell capacity);
//debug //debug
bool fep_disabled; bool fep_disabled;
bool full_output; bool full_output;
cell look_for;
cell obj;
void print_chars(string* str); void print_chars(string* str);
void print_word(word* word, cell nesting); void print_word(word* word, cell nesting);
@ -349,7 +333,6 @@ struct factor_vm
void print_objects(cell *start, cell *end); void print_objects(cell *start, cell *end);
void print_datastack(); void print_datastack();
void print_retainstack(); void print_retainstack();
void print_stack_frame(stack_frame *frame);
void print_callstack(); void print_callstack();
void dump_cell(cell x); void dump_cell(cell x);
void dump_memory(cell from, cell to); void dump_memory(cell from, cell to);
@ -499,8 +482,8 @@ struct factor_vm
inline double untag_float_check(cell tagged); inline double untag_float_check(cell tagged);
inline fixnum float_to_fixnum(cell tagged); inline fixnum float_to_fixnum(cell tagged);
inline double fixnum_to_float(cell tagged); inline double fixnum_to_float(cell tagged);
template <typename T> T *untag_check(cell value); template<typename Type> Type *untag_check(cell value);
template <typename T> T *untag(cell value); template<typename Type> Type *untag(cell value);
//io //io
void init_c_io(); void init_c_io();
@ -515,8 +498,6 @@ struct factor_vm
void primitive_fclose(); void primitive_fclose();
//code_block //code_block
typedef void (factor_vm::*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
relocation_type relocation_type_of(relocation_entry r); relocation_type relocation_type_of(relocation_entry r);
relocation_class relocation_class_of(relocation_entry r); relocation_class relocation_class_of(relocation_entry r);
cell relocation_offset_of(relocation_entry r); cell relocation_offset_of(relocation_entry r);
@ -529,20 +510,16 @@ struct factor_vm
void undefined_symbol(); void undefined_symbol();
void *get_rel_symbol(array *literals, cell index); void *get_rel_symbol(array *literals, cell index);
cell compute_relocation(relocation_entry rel, cell index, code_block *compiled); cell compute_relocation(relocation_entry rel, cell index, code_block *compiled);
void iterate_relocations(code_block *compiled, relocation_iterator iter); template<typename Iterator> void iterate_relocations(code_block *compiled, Iterator &iter);
void store_address_2_2(cell *ptr, cell value); void store_address_2_2(cell *ptr, cell value);
void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift); void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift);
void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value); void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled);
void update_literal_references(code_block *compiled); void update_literal_references(code_block *compiled);
void copy_literal_references(code_block *compiled); void trace_literal_references(code_block *compiled);
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled); void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled);
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled);
void update_word_references(code_block *compiled); void update_word_references(code_block *compiled);
void update_literal_and_word_references(code_block *compiled);
void check_code_address(cell address); void check_code_address(cell address);
void mark_code_block(code_block *compiled); void mark_code_block(code_block *compiled);
void mark_stack_frame_step(stack_frame *frame);
void mark_active_blocks(context *stacks); void mark_active_blocks(context *stacks);
void mark_object_code_block(object *object); void mark_object_code_block(object *object);
void relocate_code_block(code_block *compiled); void relocate_code_block(code_block *compiled);
@ -562,18 +539,29 @@ struct factor_vm
void init_code_heap(cell size); void init_code_heap(cell size);
bool in_code_heap_p(cell ptr); bool in_code_heap_p(cell ptr);
void jit_compile_word(cell word_, cell def_, bool relocate); void jit_compile_word(cell word_, cell def_, bool relocate);
void iterate_code_heap(code_heap_iterator iter); void trace_code_heap_roots();
void copy_code_heap_roots();
void update_code_heap_words(); void update_code_heap_words();
void primitive_modify_code_heap(); void primitive_modify_code_heap();
void primitive_code_room(); void primitive_code_room();
code_block *forward_xt(code_block *compiled); code_block *forward_xt(code_block *compiled);
void forward_frame_xt(stack_frame *frame);
void forward_object_xts(); void forward_object_xts();
void fixup_object_xts(); void fixup_object_xts();
void compact_code_heap(); void compact_code_heap();
inline void check_code_pointer(cell ptr); inline void check_code_pointer(cell ptr);
/* Apply a function to every code block */
template<typename Iterator> void iterate_code_heap(Iterator &iter)
{
heap_block *scan = code->first_block();
while(scan)
{
if(scan->status != B_FREE)
iter((code_block *)scan);
scan = code->next_block(scan);
}
}
//image //image
cell code_relocation_base; cell code_relocation_base;
cell data_relocation_base; cell data_relocation_base;
@ -585,11 +573,10 @@ struct factor_vm
void primitive_save_image(); void primitive_save_image();
void primitive_save_image_and_exit(); void primitive_save_image_and_exit();
void data_fixup(cell *cell); void data_fixup(cell *cell);
template <typename T> void code_fixup(T **handle); template<typename Type> void code_fixup(Type **handle);
void fixup_word(word *word); void fixup_word(word *word);
void fixup_quotation(quotation *quot); void fixup_quotation(quotation *quot);
void fixup_alien(alien *d); void fixup_alien(alien *d);
void fixup_stack_frame(stack_frame *frame);
void fixup_callstack_object(callstack *stack); void fixup_callstack_object(callstack *stack);
void relocate_object(object *object); void relocate_object(object *object);
void relocate_data(); void relocate_data();
@ -598,7 +585,7 @@ struct factor_vm
void load_image(vm_parameters *p); void load_image(vm_parameters *p);
//callstack //callstack
template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator); template<typename Iterator> void iterate_callstack_object(callstack *stack_, Iterator &iterator);
void check_frame(stack_frame *frame); void check_frame(stack_frame *frame);
callstack *allot_callstack(cell size); callstack *allot_callstack(cell size);
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom); stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
@ -617,8 +604,25 @@ struct factor_vm
void primitive_innermost_stack_frame_scan(); void primitive_innermost_stack_frame_scan();
void primitive_set_innermost_stack_frame_quot(); void primitive_set_innermost_stack_frame_quot();
void save_callstack_bottom(stack_frame *callstack_bottom); void save_callstack_bottom(stack_frame *callstack_bottom);
template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator); template<typename Iterator> void iterate_callstack(cell top, cell bottom, Iterator &iterator);
inline void do_slots(cell obj, void (* iter)(cell *,factor_vm*));
/* Every object has a regular representation in the runtime, which makes GC
much simpler. Every slot of the object until binary_payload_start is a pointer
to some other object. */
template<typename Iterator> void do_slots(cell obj, Iterator &iter)
{
cell scan = obj;
cell payload_start = binary_payload_start((object *)obj);
cell end = obj + payload_start;
scan += sizeof(cell);
while(scan < end)
{
iter((cell *)scan);
scan += sizeof(cell);
}
}
//alien //alien
char *pinned_alien_offset(cell obj); char *pinned_alien_offset(cell obj);
@ -742,10 +746,6 @@ struct factor_vm
: profiling_p(false), : profiling_p(false),
secure_gc(false), secure_gc(false),
gc_off(false), gc_off(false),
performing_gc(false),
performing_compaction(false),
collecting_aging_again(false),
growing_data_heap(false),
fep_disabled(false), fep_disabled(false),
full_output(false), full_output(false),
max_pic_size(0) max_pic_size(0)
@ -796,6 +796,6 @@ struct factor_vm
#define SIGNAL_VM_PTR() tls_vm() #define SIGNAL_VM_PTR() tls_vm()
#endif #endif
extern unordered_map<THREADHANDLE, factor_vm*> thread_vms; extern unordered_map<THREADHANDLE, factor_vm *> thread_vms;
} }