diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor index 54348e47f9..282a849c34 100755 --- a/core/alien/compiler/compiler.factor +++ b/core/alien/compiler/compiler.factor @@ -398,7 +398,7 @@ TUPLE: callback-context ; callback-unwind %unwind ; : generate-callback ( node -- ) - dup alien-callback-xt dup rot [ + dup alien-callback-xt dup [ init-templates %save-word-xt %prologue-later @@ -407,7 +407,7 @@ TUPLE: callback-context ; dup wrap-callback-quot %alien-callback %callback-return ] with-stack-frame - ] generate-1 ; + ] with-generator ; M: alien-callback generate-node end-basic-block generate-callback iterate-next ; diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 2674734483..f44e6c1387 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -30,7 +30,7 @@ IN: compiler : compile-succeeded ( word -- effect dependencies ) [ - dup word-dataflow >r swap dup r> optimize generate + [ word-dataflow optimize ] keep dup generate ] computing-dependencies ; : compile-failed ( word error -- ) diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor index 17c0c64bf1..25e2f8222b 100755 --- a/core/generator/fixup/fixup.factor +++ b/core/generator/fixup/fixup.factor @@ -140,17 +140,19 @@ SYMBOL: literal-table V{ } clone relocation-table set V{ } clone label-table set ; -: generate-labels ( -- labels ) - label-table get [ +: resolve-labels ( labels -- labels' ) + [ first3 label-offset [ "Unresolved label" throw ] unless* 3array ] map concat ; -: fixup ( code -- relocation-table label-table code ) +: fixup ( code -- literals relocation labels code ) [ init-fixup dup stack-frame-size swap [ fixup* ] each drop + + literal-table get >array relocation-table get >array - generate-labels + label-table get resolve-labels ] { } make ; diff --git a/core/generator/generator-docs.factor b/core/generator/generator-docs.factor index 029749180e..4473df7277 100755 --- a/core/generator/generator-docs.factor +++ b/core/generator/generator-docs.factor @@ -22,34 +22,35 @@ HELP: compiled { $var-description "During compilation, holds a hashtable mapping words to 5-element arrays holding compiled code." } ; HELP: compiling-word -{ $var-description "The word currently being compiled, set by " { $link generate-1 } "." } ; +{ $var-description "The word currently being compiled, set by " { $link with-generator } "." } ; HELP: compiling-label -{ $var-description "The label currently being compiled, set by " { $link generate-1 } "." } ; +{ $var-description "The label currently being compiled, set by " { $link with-generator } "." } ; HELP: compiled-stack-traces? { $values { "?" "a boolean" } } { $description "Iftrue, compiled code blocks will retain what word they were compiled from. This information is used by " { $link :c } " to display call stack traces after an error is thrown from compiled code. This is on by default; the deployment tool switches it off to save some space in the deployed image." } ; HELP: literal-table -{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link init-generator } " ensures that the first entry is the word being compiled." } ; +{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link begin-compiling } " ensures that the first entry is the word being compiled." } ; -HELP: init-generator +HELP: begin-compiling +{ $values { "word" word } { "label" word } } { $description "Prepares to generate machine code for a word." } ; -HELP: generate-1 -{ $values { "word" word } { "label" word } { "node" "a dataflow node" } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } } +HELP: with-generator +{ $values { "node" "a dataflow node" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } } { $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the dataflow node." } ; HELP: generate-node { $values { "node" "a dataflow node" } { "next" "a dataflow node" } } { $contract "Generates machine code for a dataflow node, and outputs the next node to generate machine code for." } -{ $notes "This word can only be called from inside the quotation passed to " { $link generate-1 } "." } ; +{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ; HELP: generate-nodes { $values { "node" "a dataflow node" } } { $description "Recursively generate machine code for a dataflow graph." } -{ $notes "This word can only be called from inside the quotation passed to " { $link generate-1 } "." } ; +{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ; HELP: generate { $values { "word" word } { "label" word } { "node" "a dataflow node" } } diff --git a/core/generator/generator.factor b/core/generator/generator.factor index 7d3cbf9330..8f1dec55ab 100755 --- a/core/generator/generator.factor +++ b/core/generator/generator.factor @@ -11,12 +11,6 @@ IN: generator SYMBOL: compile-queue SYMBOL: compiled -: begin-compiling ( word -- ) - f swap compiled get set-at ; - -: finish-compiling ( word literals relocation labels code -- ) - 4array swap compiled get set-at ; - : queue-compile ( word -- ) { { [ dup compiled get key? ] [ drop ] } @@ -32,24 +26,31 @@ SYMBOL: compiling-word SYMBOL: compiling-label +SYMBOL: compiling-loop? + ! Label of current word, after prologue, makes recursion faster SYMBOL: current-label-start : compiled-stack-traces? ( -- ? ) 36 getenv ; -: init-generator ( -- ) +: begin-compiling ( word label -- ) + compiling-loop? off + compiling-label set + compiling-word set compiled-stack-traces? - compiling-word get f ? - 1vector literal-table set ; + compiling-word get f ? + 1vector literal-table set + f compiling-word get compiled get set-at ; -: generate-1 ( word label node quot -- ) - pick begin-compiling [ - roll compiling-word set - pick compiling-label set - init-generator - call - literal-table get >array - ] { } make fixup finish-compiling ; +: finish-compiling ( literals relocation labels code -- ) + 4array compiling-label get compiled get set-at ; + +: with-generator ( node word label quot -- ) + [ + >r begin-compiling r> + { } make fixup + finish-compiling + ] with-scope ; inline GENERIC: generate-node ( node -- next ) @@ -63,11 +64,11 @@ GENERIC: generate-node ( node -- next ) current-label-start define-label current-label-start resolve-label ; -: generate ( word label node -- ) +: generate ( node word label -- ) [ init-generate-nodes [ generate-nodes ] with-node-iterator - ] generate-1 ; + ] with-generator ; : word-dataflow ( word -- effect dataflow ) [ @@ -93,23 +94,25 @@ M: node generate-node drop iterate-next ; : generate-call ( label -- next ) dup maybe-compile end-basic-block - tail-call? [ - %jump f + dup compiling-label get eq? compiling-loop? get and [ + drop current-label-start get %jump-label f ] [ - 0 frame-required - %call - iterate-next + tail-call? [ + %jump f + ] [ + 0 frame-required + %call + iterate-next + ] if ] if ; ! #label M: #label generate-node dup node-param generate-call >r - dup #label-word over node-param rot node-child generate + dup node-child over node-param rot #label-word generate r> ; ! #loop -SYMBOL: compiling-loop? - M: #loop generate-node end-basic-block [ @@ -118,8 +121,10 @@ M: #loop generate-node current-label-start resolve-label compiling-loop? on node-child generate-nodes + end-basic-block ] with-scope - end-basic-block ; + init-templates + iterate-next ; ! #if : end-false-branch ( label -- ) @@ -145,12 +150,12 @@ M: #if generate-node ! #dispatch : dispatch-branch ( node word -- label ) gensym [ - rot [ + [ copy-templates %save-dispatch-xt %prologue-later [ generate-nodes ] with-node-iterator - ] generate-1 + ] with-generator ] keep ; : tail-dispatch? ( node -- ? ) @@ -177,10 +182,10 @@ M: #dispatch generate-node generate-dispatch iterate-next ] [ compiling-word get gensym [ - rot [ + [ init-generate-nodes generate-dispatch - ] generate-1 + ] with-generator ] keep generate-call ] if ; diff --git a/core/optimizer/optimizer.factor b/core/optimizer/optimizer.factor index 1ef10a926e..8b05af691d 100755 --- a/core/optimizer/optimizer.factor +++ b/core/optimizer/optimizer.factor @@ -12,7 +12,7 @@ IN: optimizer H{ } clone value-substitutions set dup compute-def-use kill-values - "detect-loops" get [ dup detect-loops ] when + ! dup detect-loops dup infer-classes optimizer-changed off optimize-nodes