Merge branch 'smart_recompile' of slava@10.0.0.2:factor into smart_recompile
Slava Pestov
commit
53f5994893
|
|
@ -387,7 +387,6 @@ TUPLE: callback-context ;
|
|||
: generate-callback ( node -- )
|
||||
dup alien-callback-xt dup rot [
|
||||
init-templates
|
||||
generate-profiler-prologue
|
||||
%save-word-xt
|
||||
%prologue-later
|
||||
dup alien-stack-frame [
|
||||
|
|
@ -395,6 +394,7 @@ TUPLE: callback-context ;
|
|||
dup wrap-callback-quot %alien-callback
|
||||
%callback-return
|
||||
] with-stack-frame
|
||||
0
|
||||
] generate-1 ;
|
||||
|
||||
M: alien-callback generate-node
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ global [ { "compiler" } add-use ] bind
|
|||
|
||||
"-no-stack-traces" cli-args member? [
|
||||
f compiled-stack-traces? set-global
|
||||
0 set-profiler-prologues
|
||||
0 profiler-prologue set-global
|
||||
] when
|
||||
|
||||
! Compile a set of words ahead of our general
|
||||
|
|
@ -33,12 +33,14 @@ global [ { "compiler" } add-use ] bind
|
|||
|
||||
delegate
|
||||
|
||||
underlying
|
||||
underlying2
|
||||
|
||||
find-pair-next namestack*
|
||||
|
||||
bitand bitor bitxor bitnot
|
||||
} compile-batch
|
||||
|
||||
{
|
||||
+ 1+ 1- 2/ < <= > >= shift min
|
||||
|
||||
new nth push pop peek hashcode* = get set
|
||||
|
|
|
|||
|
|
@ -189,7 +189,7 @@ H{ } clone update-map set
|
|||
{ "tag" "kernel.private" }
|
||||
{ "cwd" "io.files" }
|
||||
{ "cd" "io.files" }
|
||||
{ "add-compiled-block" "generator" }
|
||||
{ "modify-code-heap" "generator" }
|
||||
{ "dlopen" "alien" }
|
||||
{ "dlsym" "alien" }
|
||||
{ "dlclose" "alien" }
|
||||
|
|
@ -243,7 +243,6 @@ H{ } clone update-map set
|
|||
{ "end-scan" "memory" }
|
||||
{ "size" "memory" }
|
||||
{ "die" "kernel" }
|
||||
{ "finalize-compile" "generator" }
|
||||
{ "fopen" "io.streams.c" }
|
||||
{ "fgetc" "io.streams.c" }
|
||||
{ "fread" "io.streams.c" }
|
||||
|
|
|
|||
|
|
@ -0,0 +1,54 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces dlists kernel words inference.backend
|
||||
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 ;
|
||||
|
||||
|
||||
|
|
@ -5,8 +5,6 @@ IN: compiler
|
|||
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
||||
"The main entry point to the optimizing compiler is a single word taking a word as input:"
|
||||
{ $subsection compile }
|
||||
"The above word throws an error if the word did not compile. Another variant simply prints the error and returns:"
|
||||
{ $subsection try-compile }
|
||||
"The optimizing compiler can also compile a single quotation:"
|
||||
{ $subsection compile-quot }
|
||||
{ $subsection compile-1 }
|
||||
|
|
@ -76,18 +74,12 @@ $low-level-note ;
|
|||
|
||||
HELP: compile
|
||||
{ $values { "word" word } }
|
||||
{ $description "Compiles a word together with any uncompiled dependencies. Does nothing if the word is already compiled." }
|
||||
{ $errors "If compilation fails, this word can throw an error. In particular, if the word's stack effect cannot be inferred, this word will throw an error. The related " { $link try-compile } " word logs errors and returns rather than throwing." } ;
|
||||
{ $description "Compiles a word together with any uncompiled dependencies. Does nothing if the word is already compiled." } ;
|
||||
|
||||
HELP: compile-failed
|
||||
{ $values { "word" word } { "error" "an error" } }
|
||||
{ $description "Called when the optimizing compiler fails to compile a word. The word is removed from the set of words pending compilation, and it's un-optimized compiled definition will be used. The error is reported by calling " { $link compile-error } "." } ;
|
||||
|
||||
HELP: try-compile
|
||||
{ $values { "word" word } }
|
||||
{ $description "Compiles a word together with any uncompiled dependencies. Does nothing if the word is already compiled." }
|
||||
{ $errors "If compilation fails, this calls " { $link compile-failed } "." } ;
|
||||
|
||||
HELP: forget-errors
|
||||
{ $values { "seq" "a sequence of words" } }
|
||||
{ $description "If any of the words in the sequence previously failed to compile, removes the marker indicating such."
|
||||
|
|
|
|||
|
|
@ -14,12 +14,8 @@ M: object inference-error-major? drop t ;
|
|||
"quiet" get [ drop ] [ print-error flush ] if drop
|
||||
] if ;
|
||||
|
||||
: begin-batch ( seq -- )
|
||||
: begin-batch ( -- )
|
||||
batch-mode on
|
||||
"quiet" get [ drop ] [
|
||||
[ "Compiling " % length # " words..." % ] "" make
|
||||
print flush
|
||||
] if
|
||||
V{ } clone compile-errors set-global ;
|
||||
|
||||
: compile-error. ( pair -- )
|
||||
|
|
@ -55,24 +51,30 @@ M: object inference-error-major? drop t ;
|
|||
: compile ( word -- )
|
||||
H{ } clone [
|
||||
compiled-xts [ (compile) ] with-variable
|
||||
] keep >alist finalize-compile ;
|
||||
] keep [ swap add* ] { } assoc>map modify-code-heap ;
|
||||
|
||||
: compile-failed ( word error -- )
|
||||
dupd compile-error dup update-xt unchanged-word ;
|
||||
|
||||
: try-compile ( word -- )
|
||||
[ compile ] [ compile-failed ] recover ;
|
||||
|
||||
: forget-errors ( seq -- )
|
||||
[ f "no-effect" set-word-prop ] each ;
|
||||
|
||||
: (compile-batch) ( words -- )
|
||||
H{ } clone [
|
||||
compiled-xts [
|
||||
[
|
||||
[ (compile) ] [ compile-failed ] recover
|
||||
] each
|
||||
] with-variable
|
||||
] keep [ swap add* ] { } assoc>map modify-code-heap ;
|
||||
|
||||
: compile-batch ( seq -- )
|
||||
dup empty? [
|
||||
drop
|
||||
] [
|
||||
dup begin-batch
|
||||
dup forget-errors
|
||||
[ try-compile ] each
|
||||
(compile-batch)
|
||||
end-batch
|
||||
] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -5,8 +5,7 @@ namespaces sequences layouts system hashtables classes alien
|
|||
byte-arrays bit-arrays float-arrays combinators words ;
|
||||
IN: cpu.architecture
|
||||
|
||||
: set-profiler-prologues ( n -- )
|
||||
39 setenv ;
|
||||
SYMBOL: profiler-prologue
|
||||
|
||||
SYMBOL: compiler-backend
|
||||
|
||||
|
|
|
|||
|
|
@ -53,4 +53,4 @@ T{ arm-backend } compiler-backend set-global
|
|||
t have-BLX? set-global
|
||||
] when
|
||||
|
||||
7 cells set-profiler-prologues
|
||||
7 cells profiler-prologues set-global
|
||||
|
|
|
|||
|
|
@ -134,7 +134,7 @@ M: ppc-backend %jump-t ( label -- )
|
|||
"offset" operand "n" operand 1 SRAWI
|
||||
0 11 LOAD32 rc-absolute-ppc-2/2 rel-dispatch
|
||||
11 dup "offset" operand LWZX
|
||||
11 dup compiled-header-size ADDI
|
||||
11 dup word-xt-offset LWZ
|
||||
r> call
|
||||
] H{
|
||||
{ +input+ { { f "n" } } }
|
||||
|
|
|
|||
|
|
@ -14,4 +14,4 @@ namespaces alien.c-types kernel system combinators ;
|
|||
|
||||
T{ ppc-backend } compiler-backend set-global
|
||||
|
||||
6 cells set-profiler-prologues
|
||||
6 cells profiler-prologue set-global
|
||||
|
|
|
|||
|
|
@ -275,7 +275,7 @@ T{ x86-backend f 4 } compiler-backend set-global
|
|||
JNE
|
||||
] { } define-if-intrinsic
|
||||
|
||||
10 set-profiler-prologues
|
||||
10 profiler-prologue set-global
|
||||
|
||||
"-no-sse2" cli-args member? [
|
||||
"Checking if your CPU supports SSE2..." print flush
|
||||
|
|
|
|||
|
|
@ -201,4 +201,4 @@ M: struct-type flatten-value-type ( type -- seq )
|
|||
] each
|
||||
] if ;
|
||||
|
||||
12 set-profiler-prologues
|
||||
12 profiler-prologue set-global
|
||||
|
|
|
|||
|
|
@ -15,25 +15,20 @@ $nl
|
|||
"The main entry point into the code generator:"
|
||||
{ $subsection generate }
|
||||
"Primitive compiler interface exported by the Factor VM:"
|
||||
{ $subsection add-compiled-block }
|
||||
{ $subsection finalize-compile } ;
|
||||
{ $subsection modify-code-heap } ;
|
||||
|
||||
ABOUT: "generator"
|
||||
|
||||
HELP: compiled-xts
|
||||
{ $var-description "During compilation, holds a hashtable mapping words to temporary uninterned words. The XT of each value points to the compiled code block of each key; at the end of compilation, the XT of each key is set to the XT of the value." } ;
|
||||
{ $var-description "During compilation, holds a hashtable mapping words to 5-element arrays holding compiled code." } ;
|
||||
|
||||
HELP: compiling?
|
||||
{ $values { "word" word } { "?" "a boolean" } }
|
||||
{ $description "Tests if a word is going to be or already is compiled." } ;
|
||||
|
||||
HELP: finalize-compile ( xts -- )
|
||||
{ $values { "xts" "an association list mapping words to uninterned words" } }
|
||||
{ $description "Performs relocation, atomically changes the XT of each key to the XT of each value, and flushes the CPU instruction cache on architectures where this has to be done manually." } ;
|
||||
|
||||
HELP: add-compiled-block ( literals words rel labels code -- xt )
|
||||
{ $values { "literals" vector } { "words" "a vector of words" } { "rel" "a vector of integers" } { "labels" "an array of integers" } { "code" "a vector of integers" } { "xt" "an uninterned word" } }
|
||||
{ $description "Adds a new compiled block and outputs an uninterned word whose XT points at this block. This uninterned word can then be passed to " { $link finalize-compile } "." } ;
|
||||
HELP: modify-code-heap ( array -- )
|
||||
{ $values { "array" "an array of 6-element arrays having shape " { $snippet "{ word code labels rel words literals }" } } }
|
||||
{ $description "Stores compiled code definitions in the code heap and updates words to point at those definitions." } ;
|
||||
|
||||
HELP: compiling-word
|
||||
{ $var-description "The word currently being compiled, set by " { $link generate-1 } "." } ;
|
||||
|
|
|
|||
|
|
@ -36,6 +36,8 @@ 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 [
|
||||
roll compiling-word set
|
||||
|
|
@ -44,7 +46,7 @@ t compiled-stack-traces? set-global
|
|||
call
|
||||
literal-table get >array
|
||||
word-table get >array
|
||||
] { } make fixup add-compiled-block save-xt ;
|
||||
] { } make fixup 6array save-xt ;
|
||||
|
||||
: generate-profiler-prologue ( -- )
|
||||
compiled-stack-traces? get [
|
||||
|
|
@ -65,6 +67,7 @@ GENERIC: generate-node ( node -- next )
|
|||
current-label-start define-label
|
||||
current-label-start resolve-label
|
||||
[ generate-nodes ] with-node-iterator
|
||||
profiler-prologue get
|
||||
] generate-1 ;
|
||||
|
||||
: word-dataflow ( word -- dataflow )
|
||||
|
|
@ -84,11 +87,7 @@ SYMBOL: batch-mode
|
|||
|
||||
: compile-begins ( word -- )
|
||||
compiler-hook get call
|
||||
"quiet" get batch-mode get or [
|
||||
drop
|
||||
] [
|
||||
"Compiling " write . flush
|
||||
] if ;
|
||||
"quiet" get [ drop ] [ "Compiling " write . flush ] if ;
|
||||
|
||||
: (compile) ( word -- )
|
||||
dup compiling? not over compound? and [
|
||||
|
|
@ -192,6 +191,7 @@ M: #if generate-node
|
|||
%save-dispatch-xt
|
||||
%prologue-later
|
||||
[ generate-nodes ] with-node-iterator
|
||||
0
|
||||
] generate-1
|
||||
] keep ;
|
||||
|
||||
|
|
|
|||
|
|
@ -94,7 +94,6 @@ M: word uses ( word -- seq )
|
|||
word-def quot-uses keys ;
|
||||
|
||||
M: compound redefined* ( word -- )
|
||||
dup changed-word
|
||||
{ "inferred-effect" "base-case" "no-effect" } reset-props ;
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
27
vm/code_gc.c
27
vm/code_gc.c
|
|
@ -254,19 +254,8 @@ void collect_literals_step(F_COMPILED *compiled, CELL code_start,
|
|||
for(scan = literals_start; scan < literal_end; scan += CELLS)
|
||||
copy_handle((CELL*)scan);
|
||||
|
||||
/* If the block is not finalized, the words area contains pointers to
|
||||
words in the data heap rather than XTs in the code heap */
|
||||
switch(compiled->finalized)
|
||||
{
|
||||
case false:
|
||||
for(scan = words_start; scan < words_end; scan += CELLS)
|
||||
copy_handle((CELL*)scan);
|
||||
break;
|
||||
case true:
|
||||
break;
|
||||
default:
|
||||
critical_error("Invalid compiled->finalized",(CELL)compiled);
|
||||
}
|
||||
for(scan = words_start; scan < words_end; scan += CELLS)
|
||||
copy_handle((CELL*)scan);
|
||||
}
|
||||
|
||||
/* Copy literals referenced from all code blocks to newspace */
|
||||
|
|
@ -305,18 +294,6 @@ void recursive_mark(F_BLOCK *block)
|
|||
|
||||
F_COMPILED *compiled = block_to_compiled(block);
|
||||
iterate_code_heap_step(compiled,collect_literals_step);
|
||||
|
||||
switch(compiled->finalized)
|
||||
{
|
||||
case false:
|
||||
break;
|
||||
case true:
|
||||
iterate_code_heap_step(compiled,mark_sweep_step);
|
||||
break;
|
||||
default:
|
||||
critical_error("Invalid compiled->finalized",(CELL)compiled);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/* Push the free space and total size of the code heap */
|
||||
|
|
|
|||
|
|
@ -42,6 +42,8 @@ static CELL xt_offset;
|
|||
INLINE CELL compute_code_rel(F_REL *rel,
|
||||
CELL code_start, CELL literals_start, CELL words_start)
|
||||
{
|
||||
F_WORD *word;
|
||||
|
||||
switch(REL_TYPE(rel))
|
||||
{
|
||||
case RT_PRIMITIVE:
|
||||
|
|
@ -53,11 +55,11 @@ INLINE CELL compute_code_rel(F_REL *rel,
|
|||
case RT_DISPATCH:
|
||||
return CREF(words_start,REL_ARGUMENT(rel));
|
||||
case RT_XT:
|
||||
return get(CREF(words_start,REL_ARGUMENT(rel)))
|
||||
+ sizeof(F_COMPILED) + xt_offset;
|
||||
word = untag_word(get(CREF(words_start,REL_ARGUMENT(rel))));
|
||||
return (CELL)word->code + sizeof(F_COMPILED) + xt_offset;
|
||||
case RT_XT_PROFILING:
|
||||
return get(CREF(words_start,REL_ARGUMENT(rel)))
|
||||
+ sizeof(F_COMPILED);
|
||||
word = untag_word(get(CREF(words_start,REL_ARGUMENT(rel))));
|
||||
return (CELL)word->code + sizeof(F_COMPILED);
|
||||
case RT_LABEL:
|
||||
return code_start + REL_ARGUMENT(rel);
|
||||
default:
|
||||
|
|
@ -133,7 +135,7 @@ void apply_relocation(CELL class, CELL offset, F_FIXNUM absolute_value)
|
|||
void relocate_code_block(F_COMPILED *relocating, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
|
||||
{
|
||||
xt_offset = (profiling_p() ? 0 : profiler_prologue());
|
||||
xt_offset = (profiling_p() ? 0 : relocating->profiler_prologue);
|
||||
|
||||
F_REL *rel = (F_REL *)reloc_start;
|
||||
F_REL *rel_end = (F_REL *)literals_start;
|
||||
|
|
@ -174,16 +176,6 @@ direct XT references, and perform fixups */
|
|||
void finalize_code_block(F_COMPILED *relocating, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
|
||||
{
|
||||
CELL scan;
|
||||
|
||||
if(relocating->finalized != false)
|
||||
critical_error("Finalizing a finalized block",(CELL)relocating);
|
||||
|
||||
for(scan = words_start; scan < words_end; scan += CELLS)
|
||||
put(scan,(CELL)(untag_word(get(scan))->code));
|
||||
|
||||
relocating->finalized = true;
|
||||
|
||||
if(reloc_start != literals_start)
|
||||
{
|
||||
relocate_code_block(relocating,code_start,reloc_start,
|
||||
|
|
@ -242,8 +234,10 @@ CELL allot_code_block(CELL size)
|
|||
return start;
|
||||
}
|
||||
|
||||
/* Might GC */
|
||||
F_COMPILED *add_compiled_block(
|
||||
CELL type,
|
||||
CELL profiler_prologue,
|
||||
F_ARRAY *code,
|
||||
F_ARRAY *labels,
|
||||
F_ARRAY *rel,
|
||||
|
|
@ -279,7 +273,7 @@ F_COMPILED *add_compiled_block(
|
|||
header->reloc_length = rel_length;
|
||||
header->literals_length = literals_length;
|
||||
header->words_length = words_length;
|
||||
header->finalized = false;
|
||||
header->profiler_prologue = profiler_prologue;
|
||||
|
||||
here += sizeof(F_COMPILED);
|
||||
|
||||
|
|
@ -327,49 +321,46 @@ void set_word_xt(F_WORD *word, F_COMPILED *compiled)
|
|||
word->xt = (XT)(compiled + 1);
|
||||
|
||||
if(!profiling_p())
|
||||
word->xt += profiler_prologue();
|
||||
word->xt += compiled->profiler_prologue;
|
||||
|
||||
word->compiledp = T;
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(add_compiled_block)
|
||||
DEFINE_PRIMITIVE(modify_code_heap)
|
||||
{
|
||||
F_ARRAY *code = untag_array(dpop());
|
||||
F_ARRAY *labels = untag_array(dpop());
|
||||
F_ARRAY *rel = untag_array(dpop());
|
||||
F_ARRAY *words = untag_array(dpop());
|
||||
F_ARRAY *literals = untag_array(dpop());
|
||||
F_ARRAY *alist = untag_array(dpop());
|
||||
|
||||
F_COMPILED *compiled = add_compiled_block(WORD_TYPE,code,labels,rel,words,literals);
|
||||
|
||||
/* push a new word whose XT points to this code block on the stack */
|
||||
F_WORD *word = allot_word(F,F);
|
||||
set_word_xt(word,compiled);
|
||||
dpush(tag_object(word));
|
||||
}
|
||||
|
||||
/* After batch compiling a bunch of words, perform various fixups to make them
|
||||
executable */
|
||||
DEFINE_PRIMITIVE(finalize_compile)
|
||||
{
|
||||
F_ARRAY *array = untag_array(dpop());
|
||||
|
||||
/* set word XT's */
|
||||
CELL count = untag_fixnum_fast(array->capacity);
|
||||
CELL count = untag_fixnum_fast(alist->capacity);
|
||||
CELL i;
|
||||
for(i = 0; i < count; i++)
|
||||
{
|
||||
F_ARRAY *pair = untag_array(array_nth(array,i));
|
||||
F_WORD *word = untag_word(array_nth(pair,0));
|
||||
F_COMPILED *compiled = untag_word(array_nth(pair,1))->code;
|
||||
F_ARRAY *data = untag_array(array_nth(alist,i));
|
||||
|
||||
F_WORD *word = untag_word(array_nth(data,0));
|
||||
CELL profiler_prologue = to_cell(array_nth(data,1));
|
||||
F_ARRAY *literals = untag_array(array_nth(data,2));
|
||||
F_ARRAY *words = untag_array(array_nth(data,3));
|
||||
F_ARRAY *rel = untag_array(array_nth(data,4));
|
||||
F_ARRAY *labels = untag_array(array_nth(data,5));
|
||||
F_ARRAY *code = untag_array(array_nth(data,6));
|
||||
|
||||
REGISTER_UNTAGGED(alist);
|
||||
REGISTER_UNTAGGED(word);
|
||||
|
||||
F_COMPILED *compiled = add_compiled_block(
|
||||
WORD_TYPE,
|
||||
profiler_prologue,
|
||||
code,
|
||||
labels,
|
||||
rel,
|
||||
words,
|
||||
literals);
|
||||
|
||||
UNREGISTER_UNTAGGED(word);
|
||||
UNREGISTER_UNTAGGED(alist);
|
||||
|
||||
set_word_xt(word,compiled);
|
||||
}
|
||||
|
||||
/* perform relocation */
|
||||
for(i = 0; i < count; i++)
|
||||
{
|
||||
F_ARRAY *pair = untag_array(array_nth(array,i));
|
||||
F_WORD *word = untag_word(array_nth(pair,0));
|
||||
iterate_code_heap_step(word->code,finalize_code_block);
|
||||
}
|
||||
iterate_code_heap(finalize_code_block);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,6 +63,7 @@ void set_word_xt(F_WORD *word, F_COMPILED *compiled);
|
|||
|
||||
F_COMPILED *add_compiled_block(
|
||||
CELL type,
|
||||
CELL profiler_prologue,
|
||||
F_ARRAY *code,
|
||||
F_ARRAY *labels,
|
||||
F_ARRAY *rel,
|
||||
|
|
@ -71,5 +72,4 @@ F_COMPILED *add_compiled_block(
|
|||
|
||||
CELL compiled_code_format(void);
|
||||
|
||||
DECLARE_PRIMITIVE(add_compiled_block);
|
||||
DECLARE_PRIMITIVE(finalize_compile);
|
||||
DECLARE_PRIMITIVE(modify_code_heap);
|
||||
|
|
|
|||
|
|
@ -275,12 +275,7 @@ void fixup_code_block(F_COMPILED *relocating, CELL code_start,
|
|||
data_fixup((CELL*)scan);
|
||||
|
||||
for(scan = words_start; scan < words_end; scan += CELLS)
|
||||
{
|
||||
if(relocating->finalized)
|
||||
code_fixup(scan);
|
||||
else
|
||||
data_fixup((CELL*)scan);
|
||||
}
|
||||
data_fixup((CELL*)scan);
|
||||
|
||||
if(reloc_start != literals_start)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -152,7 +152,7 @@ typedef struct
|
|||
CELL reloc_length; /* # bytes */
|
||||
CELL literals_length; /* # bytes */
|
||||
CELL words_length; /* # bytes */
|
||||
CELL finalized; /* has finalize_code_block() been called on this yet? */
|
||||
CELL profiler_prologue; /* # bytes */
|
||||
CELL padding[2];
|
||||
} F_COMPILED;
|
||||
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ void *primitives[] = {
|
|||
primitive_tag,
|
||||
primitive_cwd,
|
||||
primitive_cd,
|
||||
primitive_add_compiled_block,
|
||||
primitive_modify_code_heap,
|
||||
primitive_dlopen,
|
||||
primitive_dlsym,
|
||||
primitive_dlclose,
|
||||
|
|
@ -166,7 +166,6 @@ void *primitives[] = {
|
|||
primitive_end_scan,
|
||||
primitive_size,
|
||||
primitive_die,
|
||||
primitive_finalize_compile,
|
||||
primitive_fopen,
|
||||
primitive_fgetc,
|
||||
primitive_fread,
|
||||
|
|
|
|||
|
|
@ -5,11 +5,6 @@ bool profiling_p(void)
|
|||
return to_boolean(userenv[PROFILING_ENV]);
|
||||
}
|
||||
|
||||
F_FIXNUM profiler_prologue(void)
|
||||
{
|
||||
return to_fixnum(userenv[PROFILER_PROLOGUE_ENV]);
|
||||
}
|
||||
|
||||
void profiling_word(F_WORD *word)
|
||||
{
|
||||
/* If we just enabled the profiler, reset call count */
|
||||
|
|
|
|||
|
|
@ -1,3 +1,2 @@
|
|||
bool profiling_p(void);
|
||||
F_FIXNUM profiler_prologue(void);
|
||||
DECLARE_PRIMITIVE(profiling);
|
||||
|
|
|
|||
|
|
@ -155,7 +155,7 @@ void jit_compile(F_QUOTATION *quot)
|
|||
F_ARRAY *literals = allot_array(ARRAY_TYPE,1,tag_object(quot));
|
||||
UNREGISTER_UNTAGGED(result);
|
||||
|
||||
F_COMPILED *compiled = add_compiled_block(QUOTATION_TYPE,result,NULL,NULL,NULL,literals);
|
||||
F_COMPILED *compiled = add_compiled_block(QUOTATION_TYPE,0,result,NULL,NULL,NULL,literals);
|
||||
iterate_code_heap_step(compiled,finalize_code_block);
|
||||
|
||||
UNREGISTER_UNTAGGED(quot);
|
||||
|
|
|
|||
Loading…
Reference in New Issue