Listener auto-compiles; more smart recompile work in progress
parent
51992905b2
commit
308cf5aef7
|
@ -5,50 +5,46 @@ optimizer arrays definitions sequences assocs
|
|||
continuations generator compiler ;
|
||||
IN: compiler.batch
|
||||
|
||||
! SYMBOL: compile-queue
|
||||
! SYMBOL: compile-results
|
||||
!
|
||||
! TUPLE: compiled literals words rel labels code ;
|
||||
!
|
||||
! C: <compiled> compiled
|
||||
!
|
||||
! : queue-compile ( word -- )
|
||||
! compile-queue get push-front ;
|
||||
!
|
||||
! : word-dataflow ( word -- effect dataflow )
|
||||
! [
|
||||
! dup "no-effect" word-prop [ no-effect ] when
|
||||
! dup specialized-def over dup 2array 1array infer-quot
|
||||
! finish-word
|
||||
! ] with-infer ;
|
||||
!
|
||||
! : compiled-usage usage [ word? ] subset ;
|
||||
!
|
||||
! : ripple-up ( effect word -- )
|
||||
! tuck "compiled-effect" word-prop =
|
||||
! [ drop ] [ compiled-usage [ queue-compile ] each ] if ;
|
||||
!
|
||||
! : save-effect ( effect word -- )
|
||||
! swap "compiled-effect" set-word-prop ;
|
||||
!
|
||||
! : add-compiled ( word -- )
|
||||
! >r f f f f f <compiled> r> compile-results get set-at ;
|
||||
!
|
||||
! : compile-1 ( word -- )
|
||||
! dup compile-results get at [ drop ] [
|
||||
! [ [ word-dataflow drop ] [ 2drop f ] recover ] keep
|
||||
! 2dup ripple-up
|
||||
! tuck save-effect
|
||||
! add-compiled
|
||||
! ] if ;
|
||||
!
|
||||
! : compile-batch ( words -- )
|
||||
! [
|
||||
! <dlist> compile-queue set
|
||||
! [ queue-compile ] each
|
||||
! H{ } clone compile-results set
|
||||
! compile-queue get [ compile-1 ] dlist-slurp
|
||||
! compile-results get
|
||||
! ] with-scope ;
|
||||
: with-compilation-unit ( quot -- )
|
||||
H{ } clone
|
||||
[ compiled-xts swap with-variable ] keep
|
||||
[ swap add* ] { } assoc>map modify-code-heap ;
|
||||
|
||||
: compile-batch ( words -- )
|
||||
[ [ (compile) ] curry [ print-error ] recover ] each ;
|
||||
|
||||
SYMBOL: compile-queue
|
||||
|
||||
: queue-compile ( word -- )
|
||||
compile-queue get push-front ;
|
||||
|
||||
: compiled-usage ( word -- seq )
|
||||
#! XXX
|
||||
usage [ word? ] subset ;
|
||||
|
||||
: ripple-up ( effect word -- )
|
||||
tuck "compiled-effect" word-prop =
|
||||
[ drop ] [ compiled-usage [ queue-compile ] each ] if ;
|
||||
|
||||
: save-effect ( effect word -- )
|
||||
swap "compiled-effect" set-word-prop ;
|
||||
|
||||
: add-compiled ( word -- )
|
||||
>r f f f f f <compiled> r> compile-results get set-at ;
|
||||
|
||||
: compile-1 ( word -- )
|
||||
dup compile-results get at [ drop ] [
|
||||
[ [ word-dataflow drop ] [ 2drop f ] recover ] keep
|
||||
2dup ripple-up
|
||||
tuck save-effect
|
||||
add-compiled
|
||||
] if ;
|
||||
|
||||
: compile-batch ( words -- )
|
||||
[
|
||||
<dlist> compile-queue set
|
||||
[ queue-compile ] each
|
||||
H{ } clone compile-results set
|
||||
compile-queue get [ compile-1 ] dlist-slurp
|
||||
compile-results get
|
||||
] with-scope ;
|
||||
|
|
|
@ -2,23 +2,49 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces arrays sequences io inference.backend
|
||||
generator debugger math.parser prettyprint words continuations
|
||||
vocabs assocs alien.compiler ;
|
||||
vocabs assocs alien.compiler dlists optimizer ;
|
||||
IN: compiler
|
||||
|
||||
SYMBOL: compiler-hook
|
||||
|
||||
: compile-begins ( word -- )
|
||||
compiler-hook get [ call ] when*
|
||||
"quiet" get [ drop ] [ "Compiling " write . flush ] if ;
|
||||
|
||||
: (compile) ( word -- )
|
||||
dup compiling? not over compound? and [
|
||||
[
|
||||
dup compile-begins
|
||||
dup dup word-dataflow nip optimize generate
|
||||
] curry [ print-error ] recover
|
||||
] [ drop ] if ;
|
||||
|
||||
: finish-compilation-unit ( assoc -- )
|
||||
[ swap add* ] { } assoc>map modify-code-heap ;
|
||||
|
||||
: with-compilation-unit ( quot -- )
|
||||
[
|
||||
<dlist> compile-queue set
|
||||
H{ } clone compiled-xts set
|
||||
call
|
||||
compile-queue get [ (compile) ] dlist-slurp
|
||||
compiled-xts get finish-compilation-unit
|
||||
] with-scope ; inline
|
||||
|
||||
: compile-batch ( words -- )
|
||||
H{ } clone [
|
||||
compiled-xts [
|
||||
[ [ (compile) ] curry [ print-error ] recover ] each
|
||||
] with-variable
|
||||
] keep [ swap add* ] { } assoc>map modify-code-heap ;
|
||||
[ [ queue-compile ] each ] with-compilation-unit ;
|
||||
|
||||
: compile ( word -- ) 1array compile-batch ;
|
||||
: compile ( word -- )
|
||||
[ queue-compile ] with-compilation-unit ;
|
||||
|
||||
: compile-vocabs ( seq -- ) [ words ] map concat compile-batch ;
|
||||
: compile-vocabs ( seq -- )
|
||||
[ words ] map concat compile-batch ;
|
||||
|
||||
: compile-quot ( quot -- word ) define-temp dup compile ;
|
||||
: compile-quot ( quot -- word )
|
||||
define-temp dup compile ;
|
||||
|
||||
: compile-1 ( quot -- ) compile-quot execute ;
|
||||
: compile-1 ( quot -- )
|
||||
compile-quot execute ;
|
||||
|
||||
: recompile ( -- )
|
||||
changed-words get [
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax words debugger generator.fixup
|
||||
generator.registers quotations kernel vectors arrays ;
|
||||
generator.registers quotations kernel vectors arrays effects ;
|
||||
IN: generator
|
||||
|
||||
ARTICLE: "generator" "Compiled code generator"
|
||||
|
@ -64,7 +64,7 @@ HELP: generate
|
|||
{ $description "Generates machine code for " { $snippet "label" } " from " { $snippet "node" } ". The value of " { $snippet "word" } " is retained for debugging purposes; it is the word which will appear in a call stack trace if this compiled code block throws an error when run." } ;
|
||||
|
||||
HELP: word-dataflow
|
||||
{ $values { "word" word } { "dataflow" "a dataflow graph" } }
|
||||
{ $values { "word" word } { "effect" effect } { "dataflow" "a dataflow graph" } }
|
||||
{ $description "Outputs the dataflow graph of a word, taking specializers into account (see " { $link "specializers" } ")." } ;
|
||||
|
||||
HELP: define-intrinsics
|
||||
|
|
|
@ -4,13 +4,20 @@ USING: arrays assocs classes combinators cpu.architecture
|
|||
effects generator.fixup generator.registers generic hashtables
|
||||
inference inference.backend inference.dataflow io kernel
|
||||
kernel.private layouts math namespaces optimizer prettyprint
|
||||
quotations sequences system threads words ;
|
||||
quotations sequences system threads words dlists ;
|
||||
IN: generator
|
||||
|
||||
SYMBOL: compile-queue
|
||||
|
||||
SYMBOL: compiled-xts
|
||||
|
||||
: save-xt ( word xt -- )
|
||||
swap dup unchanged-word compiled-xts get set-at ;
|
||||
: 6array 3array >r 3array r> append ;
|
||||
|
||||
: begin-compiling ( word -- )
|
||||
f swap compiled-xts get set-at ;
|
||||
|
||||
: finish-compiling ( word literals words rel labels code -- )
|
||||
6array swap dup unchanged-word compiled-xts get set-at ;
|
||||
|
||||
: compiling? ( word -- ? )
|
||||
{
|
||||
|
@ -19,6 +26,9 @@ SYMBOL: compiled-xts
|
|||
{ [ t ] [ compiled? ] }
|
||||
} cond ;
|
||||
|
||||
: queue-compile ( word -- )
|
||||
compile-queue get push-front ;
|
||||
|
||||
SYMBOL: compiling-word
|
||||
|
||||
SYMBOL: compiling-label
|
||||
|
@ -36,17 +46,15 @@ t compiled-stack-traces? set-global
|
|||
compiled-stack-traces? get compiling-word get f ?
|
||||
literal-table get push ;
|
||||
|
||||
: 6array 3array >r 3array r> append ;
|
||||
|
||||
: generate-1 ( word label node quot -- )
|
||||
pick f save-xt [
|
||||
pick begin-compiling [
|
||||
roll compiling-word set
|
||||
pick compiling-label set
|
||||
init-generator
|
||||
call
|
||||
literal-table get >array
|
||||
word-table get >array
|
||||
] { } make fixup 6array save-xt ;
|
||||
] { } make fixup finish-compiling ;
|
||||
|
||||
: generate-profiler-prologue ( -- )
|
||||
compiled-stack-traces? get [
|
||||
|
@ -70,30 +78,12 @@ GENERIC: generate-node ( node -- next )
|
|||
profiler-prologue get
|
||||
] generate-1 ;
|
||||
|
||||
: word-dataflow ( word -- dataflow )
|
||||
: word-dataflow ( word -- effect dataflow )
|
||||
[
|
||||
dup "no-effect" word-prop [ no-effect ] when
|
||||
dup specialized-def over dup 2array 1array infer-quot
|
||||
finish-word
|
||||
] with-infer nip ;
|
||||
|
||||
SYMBOL: compiler-hook
|
||||
|
||||
[ ] compiler-hook set-global
|
||||
|
||||
SYMBOL: compile-errors
|
||||
|
||||
: compile-begins ( word -- )
|
||||
compiler-hook get call
|
||||
"quiet" get [ drop ] [ "Compiling " write . flush ] if ;
|
||||
|
||||
: (compile) ( word -- )
|
||||
dup compiling? not over compound? and [
|
||||
dup compile-begins
|
||||
dup dup word-dataflow optimize generate
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
] with-infer ;
|
||||
|
||||
: intrinsics ( #call -- quot )
|
||||
node-param "intrinsics" word-prop ;
|
||||
|
@ -140,7 +130,7 @@ M: node generate-node drop iterate-next ;
|
|||
} cond ;
|
||||
|
||||
: generate-call ( label -- next )
|
||||
dup (compile)
|
||||
dup queue-compile
|
||||
end-basic-block
|
||||
tail-call? [
|
||||
%jump f
|
||||
|
|
|
@ -48,7 +48,7 @@ M: duplex-stream parse-interactive
|
|||
listener-hook get call prompt.
|
||||
[
|
||||
stdio get parse-interactive
|
||||
[ do-parse-hook call ] [ bye ] if*
|
||||
[ call ] [ bye ] if*
|
||||
] try ;
|
||||
|
||||
: until-quit ( -- )
|
||||
|
|
|
@ -443,8 +443,8 @@ SYMBOL: parse-hook
|
|||
\ contents get string-lines parse-fresh
|
||||
dup finish-parsing
|
||||
do-parse-hook
|
||||
] with-scope
|
||||
] [ ] [ undo-parsing ] cleanup ;
|
||||
] [ ] [ undo-parsing ] cleanup
|
||||
] with-scope ;
|
||||
|
||||
: parse-file-restarts ( file -- restarts )
|
||||
"Load " swap " again" 3append t 2array 1array ;
|
||||
|
|
|
@ -38,6 +38,11 @@ void *get_rel_symbol(F_REL *rel, CELL literals_start)
|
|||
|
||||
static CELL xt_offset;
|
||||
|
||||
void incompatible_call_error(void)
|
||||
{
|
||||
critical_error("Calling non-optimized word from optimized word",0);
|
||||
}
|
||||
|
||||
/* Compute an address to store at a relocation */
|
||||
INLINE CELL compute_code_rel(F_REL *rel,
|
||||
CELL code_start, CELL literals_start, CELL words_start)
|
||||
|
@ -56,10 +61,16 @@ INLINE CELL compute_code_rel(F_REL *rel,
|
|||
return CREF(words_start,REL_ARGUMENT(rel));
|
||||
case RT_XT:
|
||||
word = untag_word(get(CREF(words_start,REL_ARGUMENT(rel))));
|
||||
return (CELL)word->code + sizeof(F_COMPILED) + xt_offset;
|
||||
if(word->compiledp == F)
|
||||
return (CELL)incompatible_call_error;
|
||||
else
|
||||
return (CELL)word->code + sizeof(F_COMPILED) + xt_offset;
|
||||
case RT_XT_PROFILING:
|
||||
word = untag_word(get(CREF(words_start,REL_ARGUMENT(rel))));
|
||||
return (CELL)word->code + sizeof(F_COMPILED);
|
||||
if(word->compiledp == F)
|
||||
return (CELL)incompatible_call_error;
|
||||
else
|
||||
return (CELL)word->code + sizeof(F_COMPILED);
|
||||
case RT_LABEL:
|
||||
return code_start + REL_ARGUMENT(rel);
|
||||
default:
|
||||
|
@ -365,5 +376,6 @@ DEFINE_PRIMITIVE(modify_code_heap)
|
|||
set_word_xt(word,compiled);
|
||||
}
|
||||
|
||||
iterate_code_heap(finalize_code_block);
|
||||
if(count != 0)
|
||||
iterate_code_heap(finalize_code_block);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue