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

Big code GC refactoring 

- Move code block-specific parts of code_gc.c to code_heap.c
- code_gc.c is now a generic malloc-style heap
- New code_block.c to split up large code_heap.c
- Clean up relocation code and remove some duplication
- Fix problems with code heap not being updated properly with uninterned words (bug re
ported by doublec)
- Remove boolean parameter from modify-code-heap primitive
- Less unnecessary fixup speeds up bootstrap slightly
db4
Slava Pestov 2009-01-24 20:13:17 -06:00
parent 670d0106d1
commit ed1a2855b5
19 changed files with 739 additions and 688 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Makefile
View File

@ -25,23 +25,24 @@ ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/alien.o \
vm/bignum.o \
vm/callstack.o \
vm/code_block.o \
vm/code_gc.o \
vm/code_heap.o \
vm/data_gc.o \
vm/debug.o \
vm/errors.o \
vm/factor.o \
vm/ffi_test.o \
vm/image.o \
vm/io.o \
vm/math.o \
vm/data_gc.o \
vm/code_gc.o \
vm/primitives.o \
vm/run.o \
vm/callstack.o \
vm/types.o \
vm/profiler.o \
vm/quotations.o \
vm/utilities.o \
vm/errors.o \
vm/profiler.o
vm/run.o \
vm/types.o \
vm/utilities.o
EXE_OBJS = $(PLAF_EXE_OBJS)

6
vm/callstack.c
View File

@ -90,9 +90,9 @@ void primitive_set_callstack(void)
critical_error("Bug in set_callstack()",0);
}
F_COMPILED *frame_code(F_STACK_FRAME *frame)
F_CODE_BLOCK *frame_code(F_STACK_FRAME *frame)
{
return (F_COMPILED *)frame->xt - 1;
return (F_CODE_BLOCK *)frame->xt - 1;
}
CELL frame_type(F_STACK_FRAME *frame)
@ -102,7 +102,7 @@ CELL frame_type(F_STACK_FRAME *frame)
CELL frame_executing(F_STACK_FRAME *frame)
{
F_COMPILED *compiled = frame_code(frame);
F_CODE_BLOCK *compiled = frame_code(frame);
if(compiled->literals == F)
return F;
else

2
vm/callstack.h
View File

@ -8,7 +8,7 @@ F_STACK_FRAME *fix_callstack_top(F_STACK_FRAME *top, F_STACK_FRAME *bottom);
void iterate_callstack(CELL top, CELL bottom, CALLSTACK_ITER iterator);
void iterate_callstack_object(F_CALLSTACK *stack, CALLSTACK_ITER iterator);
F_STACK_FRAME *frame_successor(F_STACK_FRAME *frame);
F_COMPILED *frame_code(F_STACK_FRAME *frame);
F_CODE_BLOCK *frame_code(F_STACK_FRAME *frame);
CELL frame_executing(F_STACK_FRAME *frame);
CELL frame_scan(F_STACK_FRAME *frame);
CELL frame_type(F_STACK_FRAME *frame);

390
vm/code_block.c Normal file
View File

@ -0,0 +1,390 @@
#include "master.h"
void flush_icache_for(F_CODE_BLOCK *compiled)
{
CELL start = (CELL)(compiled + 1);
flush_icache(start,compiled->code_length);
}
void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter)
{
if(compiled->relocation != F)
{
F_BYTE_ARRAY *relocation = untag_object(compiled->relocation);
F_REL *rel = (F_REL *)(relocation + 1);
F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation));
while(rel < rel_end)
{
iter(rel,compiled);
rel++;
}
}
}
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
INLINE void store_address_2_2(CELL cell, CELL value)
{
put(cell - CELLS,((get(cell - CELLS) & ~0xffff) | ((value >> 16) & 0xffff)));
put(cell,((get(cell) & ~0xffff) | (value & 0xffff)));
}
/* Store a value into a bitfield of a PowerPC instruction */
INLINE void store_address_masked(CELL cell, F_FIXNUM value, CELL mask, F_FIXNUM shift)
{
/* This is unaccurate but good enough */
F_FIXNUM test = (F_FIXNUM)mask >> 1;
if(value <= -test || value >= test)
critical_error("Value does not fit inside relocation",0);
u32 original = *(u32*)cell;
original &= ~mask;
*(u32*)cell = (original | ((value >> shift) & mask));
}
/* Perform a fixup on a code block */
void store_address_in_code_block(CELL class, CELL offset, F_FIXNUM absolute_value)
{
F_FIXNUM relative_value = absolute_value - offset;
switch(class)
{
case RC_ABSOLUTE_CELL:
put(offset,absolute_value);
break;
case RC_ABSOLUTE:
*(u32*)offset = absolute_value;
break;
case RC_RELATIVE:
*(u32*)offset = relative_value - sizeof(u32);
break;
case RC_ABSOLUTE_PPC_2_2:
store_address_2_2(offset,absolute_value);
break;
case RC_RELATIVE_PPC_2:
store_address_masked(offset,relative_value,REL_RELATIVE_PPC_2_MASK,0);
break;
case RC_RELATIVE_PPC_3:
store_address_masked(offset,relative_value,REL_RELATIVE_PPC_3_MASK,0);
break;
case RC_RELATIVE_ARM_3:
store_address_masked(offset,relative_value - CELLS * 2,
REL_RELATIVE_ARM_3_MASK,2);
break;
case RC_INDIRECT_ARM:
store_address_masked(offset,relative_value - CELLS,
REL_INDIRECT_ARM_MASK,0);
break;
case RC_INDIRECT_ARM_PC:
store_address_masked(offset,relative_value - CELLS * 2,
REL_INDIRECT_ARM_MASK,0);
break;
default:
critical_error("Bad rel class",class);
break;
}
}
void update_literal_references_step(F_REL *rel, F_CODE_BLOCK *compiled)
{
if(REL_TYPE(rel) == RT_IMMEDIATE)
{
CELL offset = rel->offset + (CELL)(compiled + 1);
F_ARRAY *literals = untag_object(compiled->literals);
F_FIXNUM absolute_value = array_nth(literals,REL_ARGUMENT(rel));
store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
}
}
/* Update pointers to literals from compiled code. */
void update_literal_references(F_CODE_BLOCK *compiled)
{
iterate_relocations(compiled,update_literal_references_step);
flush_icache_for(compiled);
}
/* Copy all literals referenced from a code block to newspace. Only for
aging and nursery collections */
void copy_literal_references(F_CODE_BLOCK *compiled)
{
if(collecting_gen >= compiled->last_scan)
{
if(collecting_accumulation_gen_p())
compiled->last_scan = collecting_gen;
else
compiled->last_scan = collecting_gen + 1;
/* initialize chase pointer */
CELL scan = newspace->here;
copy_handle(&compiled->literals);
copy_handle(&compiled->relocation);
/* do some tracing so that all reachable literals are now
at their final address */
copy_reachable_objects(scan,&newspace->here);
update_literal_references(compiled);
}
}
CELL object_xt(CELL obj)
{
if(type_of(obj) == WORD_TYPE)
return (CELL)untag_word(obj)->xt;
else
return (CELL)untag_quotation(obj)->xt;
}
void update_word_references_step(F_REL *rel, F_CODE_BLOCK *compiled)
{
if(REL_TYPE(rel) == RT_XT)
{
CELL offset = rel->offset + (CELL)(compiled + 1);
F_ARRAY *literals = untag_object(compiled->literals);
CELL xt = object_xt(array_nth(literals,REL_ARGUMENT(rel)));
store_address_in_code_block(REL_CLASS(rel),offset,xt);
}
}
/* Relocate new code blocks completely; updating references to literals,
dlsyms, and words. For all other words in the code heap, we only need
to update references to other words, without worrying about literals
or dlsyms. */
void update_word_references(F_CODE_BLOCK *compiled)
{
if(compiled->needs_fixup)
relocate_code_block(compiled);
else
{
iterate_relocations(compiled,update_word_references_step);
flush_icache_for(compiled);
}
}
/* Update references to words. This is done after a new code block
is added to the heap. */
/* Mark all literals referenced from a word XT. Only for tenured
collections */
void mark_code_block(F_CODE_BLOCK *compiled)
{
mark_block(compiled_to_block(compiled));
copy_handle(&compiled->literals);
copy_handle(&compiled->relocation);
flush_icache_for(compiled);
}
/* References to undefined symbols are patched up to call this function on
image load */
void undefined_symbol(void)
{
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
}
/* Look up an external library symbol referenced by a compiled code block */
void *get_rel_symbol(F_REL *rel, F_ARRAY *literals)
{
CELL arg = REL_ARGUMENT(rel);
CELL symbol = array_nth(literals,arg);
CELL library = array_nth(literals,arg + 1);
F_DLL *dll = (library == F ? NULL : untag_dll(library));
if(dll != NULL && !dll->dll)
return undefined_symbol;
if(type_of(symbol) == BYTE_ARRAY_TYPE)
{
F_SYMBOL *name = alien_offset(symbol);
void *sym = ffi_dlsym(dll,name);
if(sym)
return sym;
}
else if(type_of(symbol) == ARRAY_TYPE)
{
CELL i;
F_ARRAY *names = untag_object(symbol);
for(i = 0; i < array_capacity(names); i++)
{
F_SYMBOL *name = alien_offset(array_nth(names,i));
void *sym = ffi_dlsym(dll,name);
if(sym)
return sym;
}
}
return undefined_symbol;
}
/* Compute an address to store at a relocation */
void relocate_code_block_step(F_REL *rel, F_CODE_BLOCK *compiled)
{
CELL offset = rel->offset + (CELL)(compiled + 1);
F_ARRAY *literals = untag_object(compiled->literals);
F_FIXNUM absolute_value;
switch(REL_TYPE(rel))
{
case RT_PRIMITIVE:
absolute_value = (CELL)primitives[REL_ARGUMENT(rel)];
break;
case RT_DLSYM:
absolute_value = (CELL)get_rel_symbol(rel,literals);
break;
case RT_IMMEDIATE:
absolute_value = array_nth(literals,REL_ARGUMENT(rel));
break;
case RT_XT:
absolute_value = object_xt(array_nth(literals,REL_ARGUMENT(rel)));
break;
case RT_HERE:
absolute_value = rel->offset + (CELL)(compiled + 1) + (short)REL_ARGUMENT(rel);
break;
case RT_LABEL:
absolute_value = (CELL)(compiled + 1) + REL_ARGUMENT(rel);
break;
case RT_STACK_CHAIN:
absolute_value = (CELL)&stack_chain;
break;
default:
critical_error("Bad rel type",rel->type);
return; /* Can't happen */
}
store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
}
/* Perform all fixups on a code block */
void relocate_code_block(F_CODE_BLOCK *compiled)
{
compiled->last_scan = NURSERY;
compiled->needs_fixup = false;
iterate_relocations(compiled,relocate_code_block_step);
flush_icache_for(compiled);
}
/* Fixup labels. This is done at compile time, not image load time */
void fixup_labels(F_ARRAY *labels, CELL code_format, F_CODE_BLOCK *compiled)
{
CELL i;
CELL size = array_capacity(labels);
for(i = 0; i < size; i += 3)
{
CELL class = to_fixnum(array_nth(labels,i));
CELL offset = to_fixnum(array_nth(labels,i + 1));
CELL target = to_fixnum(array_nth(labels,i + 2));
store_address_in_code_block(class,
offset + (CELL)(compiled + 1),
target + (CELL)(compiled + 1));
}
}
/* Write a sequence of integers to memory, with 'format' bytes per integer */
void deposit_integers(CELL here, F_ARRAY *array, CELL format)
{
CELL count = array_capacity(array);
CELL i;
for(i = 0; i < count; i++)
{
F_FIXNUM value = to_fixnum(array_nth(array,i));
if(format == 1)
bput(here + i,value);
else if(format == sizeof(unsigned int))
*(unsigned int *)(here + format * i) = value;
else if(format == sizeof(CELL))
*(CELL *)(here + format * i) = value;
else
critical_error("Bad format in deposit_integers()",format);
}
}
bool stack_traces_p(void)
{
return to_boolean(userenv[STACK_TRACES_ENV]);
}
CELL compiled_code_format(void)
{
return untag_fixnum_fast(userenv[JIT_CODE_FORMAT]);
}
/* Might GC */
void *allot_code_block(CELL size)
{
void *start = heap_allot(&code_heap,size);
/* If allocation failed, do a code GC */
if(start == NULL)
{
gc();
start = heap_allot(&code_heap,size);
/* Insufficient room even after code GC, give up */
if(start == NULL)
{
CELL used, total_free, max_free;
heap_usage(&code_heap,&used,&total_free,&max_free);
print_string("Code heap stats:\n");
print_string("Used: "); print_cell(used); nl();
print_string("Total free space: "); print_cell(total_free); nl();
print_string("Largest free block: "); print_cell(max_free); nl();
fatal_error("Out of memory in add-compiled-block",0);
}
}
return start;
}
/* Might GC */
F_CODE_BLOCK *add_compiled_block(
CELL type,
F_ARRAY *code,
F_ARRAY *labels,
CELL relocation,
CELL literals)
{
CELL code_format = compiled_code_format();
CELL code_length = align8(array_capacity(code) * code_format);
REGISTER_ROOT(literals);
REGISTER_ROOT(relocation);
REGISTER_UNTAGGED(code);
REGISTER_UNTAGGED(labels);
F_CODE_BLOCK *compiled = allot_code_block(sizeof(F_CODE_BLOCK) + code_length);
UNREGISTER_UNTAGGED(labels);
UNREGISTER_UNTAGGED(code);
UNREGISTER_ROOT(relocation);
UNREGISTER_ROOT(literals);
/* compiled header */
compiled->type = type;
compiled->last_scan = NURSERY;
compiled->needs_fixup = true;
compiled->code_length = code_length;
compiled->literals = literals;
compiled->relocation = relocation;
/* code */
deposit_integers((CELL)(compiled + 1),code,code_format);
/* fixup labels */
if(labels) fixup_labels(labels,code_format,compiled);
/* next time we do a minor GC, we have to scan the code heap for
literals */
last_code_heap_scan = NURSERY;
return compiled;
}

87
vm/code_block.h Normal file
View File

@ -0,0 +1,87 @@
typedef enum {
/* arg is a primitive number */
RT_PRIMITIVE,
/* arg is a literal table index, holding an array pair (symbol/dll) */
RT_DLSYM,
/* a pointer to a compiled word reference */
RT_DISPATCH,
/* a compiled word reference */
RT_XT,
/* current offset */
RT_HERE,
/* a local label */
RT_LABEL,
/* immediate literal */
RT_IMMEDIATE,
/* address of stack_chain var */
RT_STACK_CHAIN
} F_RELTYPE;
typedef enum {
/* absolute address in a 64-bit location */
RC_ABSOLUTE_CELL,
/* absolute address in a 32-bit location */
RC_ABSOLUTE,
/* relative address in a 32-bit location */
RC_RELATIVE,
/* relative address in a PowerPC LIS/ORI sequence */
RC_ABSOLUTE_PPC_2_2,
/* relative address in a PowerPC LWZ/STW/BC instruction */
RC_RELATIVE_PPC_2,
/* relative address in a PowerPC B/BL instruction */
RC_RELATIVE_PPC_3,
/* relative address in an ARM B/BL instruction */
RC_RELATIVE_ARM_3,
/* pointer to address in an ARM LDR/STR instruction */
RC_INDIRECT_ARM,
/* pointer to address in an ARM LDR/STR instruction offset by 8 bytes */
RC_INDIRECT_ARM_PC
} F_RELCLASS;
#define REL_RELATIVE_PPC_2_MASK 0xfffc
#define REL_RELATIVE_PPC_3_MASK 0x3fffffc
#define REL_INDIRECT_ARM_MASK 0xfff
#define REL_RELATIVE_ARM_3_MASK 0xffffff
/* the rel type is built like a cell to avoid endian-specific code in
the compiler */
#define REL_TYPE(r) ((r)->type & 0x000000ff)
#define REL_CLASS(r) (((r)->type & 0x0000ff00) >> 8)
#define REL_ARGUMENT(r) (((r)->type & 0xffff0000) >> 16)
/* code relocation consists of a table of entries for each fixup */
typedef struct {
unsigned int type;
unsigned int offset;
} F_REL;
void flush_icache_for(F_CODE_BLOCK *compiled);
typedef void (*RELOCATION_ITERATOR)(F_REL *rel, F_CODE_BLOCK *compiled);
void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter);
void store_address_in_code_block(CELL class, CELL offset, F_FIXNUM absolute_value);
void relocate_code_block(F_CODE_BLOCK *compiled);
void update_literal_references(F_CODE_BLOCK *compiled);
void copy_literal_references(F_CODE_BLOCK *compiled);
void update_word_references(F_CODE_BLOCK *compiled);
void mark_code_block(F_CODE_BLOCK *compiled);
void relocate_code_block(F_CODE_BLOCK *relocating);
CELL compiled_code_format(void);
bool stack_traces_p(void);
F_CODE_BLOCK *add_compiled_block(
CELL type,
F_ARRAY *code,
F_ARRAY *labels,
CELL relocation,
CELL literals);

272
vm/code_gc.c
View File

@ -11,18 +11,6 @@ void new_heap(F_HEAP *heap, CELL size)
heap->free_list = NULL;
}
/* Allocate a code heap during startup */
void init_code_heap(CELL size)
{
new_heap(&code_heap,size);
}
bool in_code_heap_p(CELL ptr)
{
return (ptr >= code_heap.segment->start
&& ptr <= code_heap.segment->end);
}
/* If there is no previous block, next_free becomes the head of the free list,
else its linked in */
INLINE void update_free_list(F_HEAP *heap, F_BLOCK *prev, F_BLOCK *next_free)
@ -145,6 +133,22 @@ void *heap_allot(F_HEAP *heap, CELL size)
return NULL;
}
void mark_block(F_BLOCK *block)
{
/* If already marked, do nothing */
switch(block->status)
{
case B_MARKED:
return;
case B_ALLOCATED:
block->status = B_MARKED;
break;
default:
critical_error("Marking the wrong block",(CELL)block);
break;
}
}
/* If in the middle of code GC, we have to grow the heap, data GC restarts from
scratch, so we have to unmark any marked blocks. */
void unmark_marked(F_HEAP *heap)
@ -243,150 +247,6 @@ CELL heap_size(F_HEAP *heap)
return heap->segment->size;
}
/* Apply a function to every code block */
void iterate_code_heap(CODE_HEAP_ITERATOR iter)
{
F_BLOCK *scan = first_block(&code_heap);
while(scan)
{
if(scan->status != B_FREE)
iter(block_to_compiled(scan));
scan = next_block(&code_heap,scan);
}
}
void update_literal_references_step(F_REL *rel, F_COMPILED *compiled)
{
if(REL_TYPE(rel) == RT_IMMEDIATE)
{
CELL offset = rel->offset + (CELL)(compiled + 1);
F_ARRAY *literals = untag_object(compiled->literals);
F_FIXNUM absolute_value = array_nth(literals,REL_ARGUMENT(rel));
apply_relocation(REL_CLASS(rel),offset,absolute_value);
}
}
/* Update pointers to literals from compiled code. */
void update_literal_references(F_COMPILED *compiled)
{
iterate_relocations(compiled,update_literal_references_step);
flush_icache_for(compiled);
}
/* Copy all literals referenced from a code block to newspace. Only for
aging and nursery collections */
void copy_literal_references(F_COMPILED *compiled)
{
if(collecting_gen >= compiled->last_scan)
{
if(collecting_accumulation_gen_p())
compiled->last_scan = collecting_gen;
else
compiled->last_scan = collecting_gen + 1;
/* initialize chase pointer */
CELL scan = newspace->here;
copy_handle(&compiled->literals);
copy_handle(&compiled->relocation);
/* do some tracing so that all reachable literals are now
at their final address */
copy_reachable_objects(scan,&newspace->here);
update_literal_references(compiled);
}
}
/* Copy literals referenced from all code blocks to newspace. Only for
aging and nursery collections */
void copy_code_heap_roots(void)
{
iterate_code_heap(copy_literal_references);
}
/* Mark all XTs and literals referenced from a word XT. Only for tenured
collections */
void mark_block(F_BLOCK *block)
{
/* If already marked, do nothing */
switch(block->status)
{
case B_MARKED:
return;
case B_ALLOCATED:
block->status = B_MARKED;
break;
default:
critical_error("Marking the wrong block",(CELL)block);
break;
}
F_COMPILED *compiled = block_to_compiled(block);
copy_handle(&compiled->literals);
copy_handle(&compiled->relocation);
flush_icache_for(compiled);
}
/* Update literals referenced from all code blocks. Only for tenured
collections, done at the end. */
void update_code_heap_roots(void)
{
iterate_code_heap(update_literal_references);
}
/* Push the free space and total size of the code heap */
void primitive_code_room(void)
{
CELL used, total_free, max_free;
heap_usage(&code_heap,&used,&total_free,&max_free);
dpush(tag_fixnum((code_heap.segment->size) / 1024));
dpush(tag_fixnum(used / 1024));
dpush(tag_fixnum(total_free / 1024));
dpush(tag_fixnum(max_free / 1024));
}
/* Dump all code blocks for debugging */
void dump_heap(F_HEAP *heap)
{
CELL size = 0;
F_BLOCK *scan = first_block(heap);
while(scan)
{
char *status;
switch(scan->status)
{
case B_FREE:
status = "free";
break;
case B_ALLOCATED:
size += object_size(block_to_compiled(scan)->relocation);
status = "allocated";
break;
case B_MARKED:
size += object_size(block_to_compiled(scan)->relocation);
status = "marked";
break;
default:
status = "invalid";
break;
}
print_cell_hex((CELL)scan); print_string(" ");
print_cell_hex(scan->size); print_string(" ");
print_string(status); print_string("\n");
scan = next_block(heap,scan);
}
print_cell(size); print_string(" bytes of relocation data\n");
}
/* Compute where each block is going to go, after compaction */
CELL compute_heap_forwarding(F_HEAP *heap)
{
@ -409,80 +269,6 @@ CELL compute_heap_forwarding(F_HEAP *heap)
return address - heap->segment->start;
}
F_COMPILED *forward_xt(F_COMPILED *compiled)
{
return block_to_compiled(compiled_to_block(compiled)->forwarding);
}
void forward_frame_xt(F_STACK_FRAME *frame)
{
CELL offset = (CELL)FRAME_RETURN_ADDRESS(frame) - (CELL)frame_code(frame);
F_COMPILED *forwarded = forward_xt(frame_code(frame));
frame->xt = (XT)(forwarded + 1);
FRAME_RETURN_ADDRESS(frame) = (XT)((CELL)forwarded + offset);
}
void forward_object_xts(void)
{
begin_scan();
CELL obj;
while((obj = next_object()) != F)
{
if(type_of(obj) == WORD_TYPE)
{
F_WORD *word = untag_object(obj);
word->code = forward_xt(word->code);
if(word->profiling)
word->profiling = forward_xt(word->profiling);
}
else if(type_of(obj) == QUOTATION_TYPE)
{
F_QUOTATION *quot = untag_object(obj);
if(quot->compiledp != F)
quot->code = forward_xt(quot->code);
}
else if(type_of(obj) == CALLSTACK_TYPE)
{
F_CALLSTACK *stack = untag_object(obj);
iterate_callstack_object(stack,forward_frame_xt);
}
}
/* End the heap scan */
gc_off = false;
}
/* Set the XT fields now that the heap has been compacted */
void fixup_object_xts(void)
{
begin_scan();
CELL obj;
while((obj = next_object()) != F)
{
if(type_of(obj) == WORD_TYPE)
{
F_WORD *word = untag_object(obj);
update_word_xt(word);
}
else if(type_of(obj) == QUOTATION_TYPE)
{
F_QUOTATION *quot = untag_object(obj);
if(quot->compiledp != F)
set_quot_xt(quot,quot->code);
}
}
/* End the heap scan */
gc_off = false;
}
void compact_heap(F_HEAP *heap)
{
F_BLOCK *scan = first_block(heap);
@ -496,29 +282,3 @@ void compact_heap(F_HEAP *heap)
scan = next;
}
}
/* Move all free space to the end of the code heap. This is not very efficient,
since it makes several passes over the code and data heaps, but we only ever
do this before saving a deployed image and exiting, so performaance is not
critical here */
void compact_code_heap(void)
{
/* Free all unreachable code blocks */
gc();
/* Figure out where the code heap blocks are going to end up */
CELL size = compute_heap_forwarding(&code_heap);
/* Update word and quotation code pointers */
forward_object_xts();
/* Actually perform the compaction */
compact_heap(&code_heap);
/* Update word and quotation XTs */
fixup_object_xts();
/* Now update the free list; there will be a single free block at
the end */
build_free_list(&code_heap,size);
}

29
vm/code_gc.h
View File

@ -27,10 +27,13 @@ typedef struct {
void new_heap(F_HEAP *heap, CELL size);
void build_free_list(F_HEAP *heap, CELL size);
void *heap_allot(F_HEAP *heap, CELL size);
void mark_block(F_BLOCK *block);
void unmark_marked(F_HEAP *heap);
void free_unmarked(F_HEAP *heap);
void heap_usage(F_HEAP *heap, CELL *used, CELL *total_free, CELL *max_free);
CELL heap_size(F_HEAP *heap);
CELL compute_heap_forwarding(F_HEAP *heap);
void compact_heap(F_HEAP *heap);
INLINE F_BLOCK *next_block(F_HEAP *heap, F_BLOCK *block)
{
@ -41,21 +44,6 @@ INLINE F_BLOCK *next_block(F_HEAP *heap, F_BLOCK *block)
return (F_BLOCK *)next;
}
/* compiled code */
F_HEAP code_heap;
typedef void (*CODE_HEAP_ITERATOR)(F_COMPILED *compiled);
INLINE F_BLOCK *compiled_to_block(F_COMPILED *compiled)
{
return (F_BLOCK *)compiled - 1;
}
INLINE F_COMPILED *block_to_compiled(F_BLOCK *block)
{
return (F_COMPILED *)(block + 1);
}
INLINE F_BLOCK *first_block(F_HEAP *heap)
{
return (F_BLOCK *)heap->segment->start;
@ -65,14 +53,3 @@ INLINE F_BLOCK *last_block(F_HEAP *heap)
{
return (F_BLOCK *)heap->segment->end;
}
void init_code_heap(CELL size);
bool in_code_heap_p(CELL ptr);
void iterate_code_heap(CODE_HEAP_ITERATOR iter);
void copy_code_heap_roots(void);
void update_code_heap_roots(void);
void mark_block(F_BLOCK *block);
void dump_heap(F_HEAP *heap);
void compact_code_heap(void);
void primitive_code_room(void);

455
vm/code_heap.c
View File

@ -1,296 +1,18 @@
#include "master.h"
/* References to undefined symbols are patched up to call this function on
image load */
void undefined_symbol(void)
/* Allocate a code heap during startup */
void init_code_heap(CELL size)
{
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
new_heap(&code_heap,size);
}
/* Look up an external library symbol referenced by a compiled code block */
void *get_rel_symbol(F_REL *rel, F_ARRAY *literals)
bool in_code_heap_p(CELL ptr)
{
CELL arg = REL_ARGUMENT(rel);
CELL symbol = array_nth(literals,arg);
CELL library = array_nth(literals,arg + 1);
F_DLL *dll = (library == F ? NULL : untag_dll(library));
if(dll != NULL && !dll->dll)
return undefined_symbol;
if(type_of(symbol) == BYTE_ARRAY_TYPE)
{
F_SYMBOL *name = alien_offset(symbol);
void *sym = ffi_dlsym(dll,name);
if(sym)
return sym;
}
else if(type_of(symbol) == ARRAY_TYPE)
{
CELL i;
F_ARRAY *names = untag_object(symbol);
for(i = 0; i < array_capacity(names); i++)
{
F_SYMBOL *name = alien_offset(array_nth(names,i));
void *sym = ffi_dlsym(dll,name);
if(sym)
return sym;
}
}
return undefined_symbol;
return (ptr >= code_heap.segment->start
&& ptr <= code_heap.segment->end);
}
/* Compute an address to store at a relocation */
INLINE CELL compute_code_rel(F_REL *rel, F_COMPILED *compiled)
{
F_ARRAY *literals = untag_object(compiled->literals);
CELL obj;
switch(REL_TYPE(rel))
{
case RT_PRIMITIVE:
return (CELL)primitives[REL_ARGUMENT(rel)];
case RT_DLSYM:
return (CELL)get_rel_symbol(rel,literals);
case RT_IMMEDIATE:
return array_nth(literals,REL_ARGUMENT(rel));
case RT_XT:
obj = array_nth(literals,REL_ARGUMENT(rel));
if(type_of(obj) == WORD_TYPE)
return (CELL)untag_word(obj)->xt;
else
return (CELL)untag_quotation(obj)->xt;
case RT_HERE:
return rel->offset + (CELL)(compiled + 1) + (short)REL_ARGUMENT(rel);
case RT_LABEL:
return (CELL)(compiled + 1) + REL_ARGUMENT(rel);
case RT_STACK_CHAIN:
return (CELL)&stack_chain;
default:
critical_error("Bad rel type",rel->type);
return -1; /* Can't happen */
}
}
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
INLINE void reloc_set_2_2(CELL cell, CELL value)
{
put(cell - CELLS,((get(cell - CELLS) & ~0xffff) | ((value >> 16) & 0xffff)));
put(cell,((get(cell) & ~0xffff) | (value & 0xffff)));
}
/* Store a value into a bitfield of a PowerPC instruction */
INLINE void reloc_set_masked(CELL cell, F_FIXNUM value, CELL mask, F_FIXNUM shift)
{
/* This is unaccurate but good enough */
F_FIXNUM test = (F_FIXNUM)mask >> 1;
if(value <= -test || value >= test)
critical_error("Value does not fit inside relocation",0);
u32 original = *(u32*)cell;
original &= ~mask;
*(u32*)cell = (original | ((value >> shift) & mask));
}
/* Perform a fixup on a code block */
void apply_relocation(CELL class, CELL offset, F_FIXNUM absolute_value)
{
F_FIXNUM relative_value = absolute_value - offset;
switch(class)
{
case RC_ABSOLUTE_CELL:
put(offset,absolute_value);
break;
case RC_ABSOLUTE:
*(u32*)offset = absolute_value;
break;
case RC_RELATIVE:
*(u32*)offset = relative_value - sizeof(u32);
break;
case RC_ABSOLUTE_PPC_2_2:
reloc_set_2_2(offset,absolute_value);
break;
case RC_RELATIVE_PPC_2:
reloc_set_masked(offset,relative_value,REL_RELATIVE_PPC_2_MASK,0);
break;
case RC_RELATIVE_PPC_3:
reloc_set_masked(offset,relative_value,REL_RELATIVE_PPC_3_MASK,0);
break;
case RC_RELATIVE_ARM_3:
reloc_set_masked(offset,relative_value - CELLS * 2,
REL_RELATIVE_ARM_3_MASK,2);
break;
case RC_INDIRECT_ARM:
reloc_set_masked(offset,relative_value - CELLS,
REL_INDIRECT_ARM_MASK,0);
break;
case RC_INDIRECT_ARM_PC:
reloc_set_masked(offset,relative_value - CELLS * 2,
REL_INDIRECT_ARM_MASK,0);
break;
default:
critical_error("Bad rel class",class);
break;
}
}
void iterate_relocations(F_COMPILED *compiled, RELOCATION_ITERATOR iter)
{
if(compiled->relocation != F)
{
F_BYTE_ARRAY *relocation = untag_object(compiled->relocation);
F_REL *rel = (F_REL *)(relocation + 1);
F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation));
while(rel < rel_end)
{
iter(rel,compiled);
rel++;
}
}
}
void relocate_code_block_step(F_REL *rel, F_COMPILED *compiled)
{
CELL offset = rel->offset + (CELL)(compiled + 1);
F_FIXNUM absolute_value = compute_code_rel(rel,compiled);
apply_relocation(REL_CLASS(rel),offset,absolute_value);
}
/* Perform all fixups on a code block */
void relocate_code_block(F_COMPILED *compiled)
{
compiled->last_scan = NURSERY;
iterate_relocations(compiled,relocate_code_block_step);
flush_icache_for(compiled);
}
/* Fixup labels. This is done at compile time, not image load time */
void fixup_labels(F_ARRAY *labels, CELL code_format, F_COMPILED *compiled)
{
CELL i;
CELL size = array_capacity(labels);
for(i = 0; i < size; i += 3)
{
CELL class = to_fixnum(array_nth(labels,i));
CELL offset = to_fixnum(array_nth(labels,i + 1));
CELL target = to_fixnum(array_nth(labels,i + 2));
apply_relocation(class,
offset + (CELL)(compiled + 1),
target + (CELL)(compiled + 1));
}
}
/* Write a sequence of integers to memory, with 'format' bytes per integer */
void deposit_integers(CELL here, F_ARRAY *array, CELL format)
{
CELL count = array_capacity(array);
CELL i;
for(i = 0; i < count; i++)
{
F_FIXNUM value = to_fixnum(array_nth(array,i));
if(format == 1)
bput(here + i,value);
else if(format == sizeof(unsigned int))
*(unsigned int *)(here + format * i) = value;
else if(format == CELLS)
put(CREF(here,i),value);
else
critical_error("Bad format in deposit_integers()",format);
}
}
bool stack_traces_p(void)
{
return to_boolean(userenv[STACK_TRACES_ENV]);
}
CELL compiled_code_format(void)
{
return untag_fixnum_fast(userenv[JIT_CODE_FORMAT]);
}
void *allot_code_block(CELL size)
{
void *start = heap_allot(&code_heap,size);
/* If allocation failed, do a code GC */
if(start == NULL)
{
gc();
start = heap_allot(&code_heap,size);
/* Insufficient room even after code GC, give up */
if(start == NULL)
{
CELL used, total_free, max_free;
heap_usage(&code_heap,&used,&total_free,&max_free);
print_string("Code heap stats:\n");
print_string("Used: "); print_cell(used); nl();
print_string("Total free space: "); print_cell(total_free); nl();
print_string("Largest free block: "); print_cell(max_free); nl();
fatal_error("Out of memory in add-compiled-block",0);
}
}
return start;
}
/* Might GC */
F_COMPILED *add_compiled_block(
CELL type,
F_ARRAY *code,
F_ARRAY *labels,
CELL relocation,
CELL literals)
{
CELL code_format = compiled_code_format();
CELL code_length = align8(array_capacity(code) * code_format);
REGISTER_ROOT(literals);
REGISTER_ROOT(relocation);
REGISTER_UNTAGGED(code);
REGISTER_UNTAGGED(labels);
F_COMPILED *compiled = allot_code_block(sizeof(F_COMPILED) + code_length);
UNREGISTER_UNTAGGED(labels);
UNREGISTER_UNTAGGED(code);
UNREGISTER_ROOT(relocation);
UNREGISTER_ROOT(literals);
/* compiled header */
compiled->type = type;
compiled->last_scan = NURSERY;
compiled->code_length = code_length;
compiled->literals = literals;
compiled->relocation = relocation;
/* code */
deposit_integers((CELL)(compiled + 1),code,code_format);
/* fixup labels */
if(labels) fixup_labels(labels,code_format,compiled);
/* next time we do a minor GC, we have to scan the code heap for
literals */
last_code_heap_scan = NURSERY;
return compiled;
}
void set_word_code(F_WORD *word, F_COMPILED *compiled)
void set_word_code(F_WORD *word, F_CODE_BLOCK *compiled)
{
if(compiled->type != WORD_TYPE)
critical_error("bad param to set_word_xt",(CELL)compiled);
@ -310,12 +32,48 @@ void default_word_code(F_WORD *word, bool relocate)
word->optimizedp = F;
}
/* Apply a function to every code block */
void iterate_code_heap(CODE_HEAP_ITERATOR iter)
{
F_BLOCK *scan = first_block(&code_heap);
while(scan)
{
if(scan->status != B_FREE)
iter(block_to_compiled(scan));
scan = next_block(&code_heap,scan);
}
}
/* Copy literals referenced from all code blocks to newspace. Only for
aging and nursery collections */
void copy_code_heap_roots(void)
{
iterate_code_heap(copy_literal_references);
}
/* Update literals referenced from all code blocks. Only for tenured
collections, done at the end. */
void update_code_heap_roots(void)
{
iterate_code_heap(update_literal_references);
}
/* Update pointers to words referenced from all code blocks. Only after
defining a new word. */
void update_code_heap_words(void)
{
iterate_code_heap(update_word_references);
}
void primitive_modify_code_heap(void)
{
bool rescan_code_heap = to_boolean(dpop());
F_ARRAY *alist = untag_array(dpop());
CELL count = untag_fixnum_fast(alist->capacity);
if(count == 0)
return;
CELL i;
for(i = 0; i < count; i++)
{
@ -345,7 +103,7 @@ void primitive_modify_code_heap(void)
REGISTER_UNTAGGED(alist);
REGISTER_UNTAGGED(word);
F_COMPILED *compiled = add_compiled_block(
F_CODE_BLOCK *compiled = add_compiled_block(
WORD_TYPE,
code,
labels,
@ -363,27 +121,116 @@ void primitive_modify_code_heap(void)
UNREGISTER_UNTAGGED(alist);
}
/* If there were any interned words in the set, we relocate all XT
references in the entire code heap. But if all the words are
uninterned, it is impossible that other words reference them, so we
only have to relocate the new words. This makes compile-call much
more efficient */
if(rescan_code_heap)
iterate_code_heap(relocate_code_block);
else
{
for(i = 0; i < count; i++)
{
F_ARRAY *pair = untag_array(array_nth(alist,i));
F_WORD *word = untag_word(array_nth(pair,0));
update_code_heap_words();
}
relocate_code_block(word->code);
/* Push the free space and total size of the code heap */
void primitive_code_room(void)
{
CELL used, total_free, max_free;
heap_usage(&code_heap,&used,&total_free,&max_free);
dpush(tag_fixnum((code_heap.segment->size) / 1024));
dpush(tag_fixnum(used / 1024));
dpush(tag_fixnum(total_free / 1024));
dpush(tag_fixnum(max_free / 1024));
}
F_CODE_BLOCK *forward_xt(F_CODE_BLOCK *compiled)
{
return block_to_compiled(compiled_to_block(compiled)->forwarding);
}
void forward_frame_xt(F_STACK_FRAME *frame)
{
CELL offset = (CELL)FRAME_RETURN_ADDRESS(frame) - (CELL)frame_code(frame);
F_CODE_BLOCK *forwarded = forward_xt(frame_code(frame));
frame->xt = (XT)(forwarded + 1);
FRAME_RETURN_ADDRESS(frame) = (XT)((CELL)forwarded + offset);
}
void forward_object_xts(void)
{
begin_scan();
CELL obj;
while((obj = next_object()) != F)
{
if(type_of(obj) == WORD_TYPE)
{
F_WORD *word = untag_object(obj);
word->code = forward_xt(word->code);
if(word->profiling)
word->profiling = forward_xt(word->profiling);
}
else if(type_of(obj) == QUOTATION_TYPE)
{
F_QUOTATION *quot = untag_object(obj);
if(quot->compiledp != F)
quot->code = forward_xt(quot->code);
}
else if(type_of(obj) == CALLSTACK_TYPE)
{
F_CALLSTACK *stack = untag_object(obj);
iterate_callstack_object(stack,forward_frame_xt);
}
}
/* End the heap scan */
gc_off = false;
}
void flush_icache_for(F_COMPILED *compiled)
/* Set the XT fields now that the heap has been compacted */
void fixup_object_xts(void)
{
CELL start = (CELL)(compiled + 1);
flush_icache(start,compiled->code_length);
begin_scan();
CELL obj;
while((obj = next_object()) != F)
{
if(type_of(obj) == WORD_TYPE)
{
F_WORD *word = untag_object(obj);
update_word_xt(word);
}
else if(type_of(obj) == QUOTATION_TYPE)
{
F_QUOTATION *quot = untag_object(obj);
if(quot->compiledp != F)
set_quot_xt(quot,quot->code);
}
}
/* End the heap scan */
gc_off = false;
}
/* Move all free space to the end of the code heap. This is not very efficient,
since it makes several passes over the code and data heaps, but we only ever
do this before saving a deployed image and exiting, so performaance is not
critical here */
void compact_code_heap(void)
{
/* Free all unreachable code blocks */
gc();
/* Figure out where the code heap blocks are going to end up */
CELL size = compute_heap_forwarding(&code_heap);
/* Update word and quotation code pointers */
forward_object_xts();
/* Actually perform the compaction */
compact_heap(&code_heap);
/* Update word and quotation XTs */
fixup_object_xts();
/* Now update the free list; there will be a single free block at
the end */
build_free_list(&code_heap,size);
}

91
vm/code_heap.h
View File

@ -1,85 +1,34 @@
typedef enum {
/* arg is a primitive number */
RT_PRIMITIVE,
/* arg is a literal table index, holding an array pair (symbol/dll) */
RT_DLSYM,
/* a pointer to a compiled word reference */
RT_DISPATCH,
/* a compiled word reference */
RT_XT,
/* current offset */
RT_HERE,
/* a local label */
RT_LABEL,
/* immediate literal */
RT_IMMEDIATE,
/* address of stack_chain var */
RT_STACK_CHAIN
} F_RELTYPE;
/* compiled code */
F_HEAP code_heap;
typedef enum {
/* absolute address in a 64-bit location */
RC_ABSOLUTE_CELL,
/* absolute address in a 32-bit location */
RC_ABSOLUTE,
/* relative address in a 32-bit location */
RC_RELATIVE,
/* relative address in a PowerPC LIS/ORI sequence */
RC_ABSOLUTE_PPC_2_2,
/* relative address in a PowerPC LWZ/STW/BC instruction */
RC_RELATIVE_PPC_2,
/* relative address in a PowerPC B/BL instruction */
RC_RELATIVE_PPC_3,
/* relative address in an ARM B/BL instruction */
RC_RELATIVE_ARM_3,
/* pointer to address in an ARM LDR/STR instruction */
RC_INDIRECT_ARM,
/* pointer to address in an ARM LDR/STR instruction offset by 8 bytes */
RC_INDIRECT_ARM_PC
} F_RELCLASS;
INLINE F_BLOCK *compiled_to_block(F_CODE_BLOCK *compiled)
{
return (F_BLOCK *)compiled - 1;
}
#define REL_RELATIVE_PPC_2_MASK 0xfffc
#define REL_RELATIVE_PPC_3_MASK 0x3fffffc
#define REL_INDIRECT_ARM_MASK 0xfff
#define REL_RELATIVE_ARM_3_MASK 0xffffff
INLINE F_CODE_BLOCK *block_to_compiled(F_BLOCK *block)
{
return (F_CODE_BLOCK *)(block + 1);
}
/* the rel type is built like a cell to avoid endian-specific code in
the compiler */
#define REL_TYPE(r) ((r)->type & 0x000000ff)
#define REL_CLASS(r) (((r)->type & 0x0000ff00) >> 8)
#define REL_ARGUMENT(r) (((r)->type & 0xffff0000) >> 16)
void init_code_heap(CELL size);
/* code relocation consists of a table of entries for each fixup */
typedef struct {
unsigned int type;
unsigned int offset;
} F_REL;
#define CREF(array,i) ((CELL)(array) + CELLS * (i))
void apply_relocation(CELL class, CELL offset, F_FIXNUM absolute_value);
void relocate_code_block(F_COMPILED *relocating);
bool in_code_heap_p(CELL ptr);
void default_word_code(F_WORD *word, bool relocate);
void set_word_code(F_WORD *word, F_COMPILED *compiled);
void set_word_code(F_WORD *word, F_CODE_BLOCK *compiled);
F_COMPILED *add_compiled_block(
CELL type,
F_ARRAY *code,
F_ARRAY *labels,
CELL relocation,
CELL literals);
typedef void (*CODE_HEAP_ITERATOR)(F_CODE_BLOCK *compiled);
CELL compiled_code_format(void);
void iterate_code_heap(CODE_HEAP_ITERATOR iter);
bool stack_traces_p(void);
void copy_code_heap_roots(void);
void update_code_heap_roots(void);
void primitive_modify_code_heap(void);
void flush_icache_for(F_COMPILED *compiled);
void primitive_code_room(void);
typedef void (*RELOCATION_ITERATOR)(F_REL *rel, F_COMPILED *compiled);
void iterate_relocations(F_COMPILED *compiled, RELOCATION_ITERATOR iter);
void compact_code_heap(void);

8
vm/data_gc.c
View File

@ -426,7 +426,7 @@ void copy_stack_elements(F_SEGMENT *region, CELL top)
void copy_stack_frame_step(F_STACK_FRAME *frame)
{
mark_block(compiled_to_block(frame_code(frame)));
mark_code_block(frame_code(frame));
}
void copy_callstack_roots(F_CONTEXT *stacks)
@ -608,14 +608,14 @@ void do_code_slots(CELL scan)
{
case WORD_TYPE:
word = (F_WORD *)scan;
mark_block(compiled_to_block(word->code));
mark_code_block(word->code);
if(word->profiling)
mark_block(compiled_to_block(word->profiling));
mark_code_block(word->profiling);
break;
case QUOTATION_TYPE:
quot = (F_QUOTATION *)scan;
if(quot->compiledp != F)
mark_block(compiled_to_block(quot->code));
mark_code_block(quot->code);
break;
case CALLSTACK_TYPE:
stack = (F_CALLSTACK *)scan;

40
vm/debug.c
View File

@ -308,6 +308,44 @@ void find_data_references(CELL look_for_)
gc_off = false;
}
/* Dump all code blocks for debugging */
void dump_code_heap(void)
{
CELL size = 0;
F_BLOCK *scan = first_block(&code_heap);
while(scan)
{
char *status;
switch(scan->status)
{
case B_FREE:
status = "free";
break;
case B_ALLOCATED:
size += object_size(block_to_compiled(scan)->relocation);
status = "allocated";
break;
case B_MARKED:
size += object_size(block_to_compiled(scan)->relocation);
status = "marked";
break;
default:
status = "invalid";
break;
}
print_cell_hex((CELL)scan); print_string(" ");
print_cell_hex(scan->size); print_string(" ");
print_string(status); print_string("\n");
scan = next_block(&code_heap,scan);
}
print_cell(size); print_string(" bytes of relocation data\n");
}
void factorbug(void)
{
if(fep_disabled)
@ -446,7 +484,7 @@ void factorbug(void)
dpush(addr);
}
else if(strcmp(cmd,"code") == 0)
dump_heap(&code_heap);
dump_code_heap();
else
print_string("unknown command\n");
}

2
vm/image.c
View File

@ -311,7 +311,7 @@ void relocate_data()
}
}
void fixup_code_block(F_COMPILED *compiled)
void fixup_code_block(F_CODE_BLOCK *compiled)
{
/* relocate literal table data */
data_fixup(&compiled->relocation);

9
vm/layouts.h
View File

@ -106,10 +106,11 @@ typedef struct
{
char type; /* this is WORD_TYPE or QUOTATION_TYPE */
char last_scan; /* the youngest generation in which this block's literals may live */
char needs_fixup; /* is this a new block that needs full fixup? */
CELL code_length; /* # bytes */
CELL literals; /* # bytes */
CELL relocation; /* tagged pointer to byte-array or f */
} F_COMPILED;
} F_CODE_BLOCK;
/* Assembly code makes assumptions about the layout of this struct */
typedef struct {
@ -135,9 +136,9 @@ typedef struct {
/* UNTAGGED execution token: jump here to execute word */
XT xt;
/* UNTAGGED compiled code block */
F_COMPILED *code;
F_CODE_BLOCK *code;
/* UNTAGGED profiler stub */
F_COMPILED *profiling;
F_CODE_BLOCK *profiling;
} F_WORD;
/* Assembly code makes assumptions about the layout of this struct */
@ -174,7 +175,7 @@ typedef struct {
/* UNTAGGED */
XT xt;
/* UNTAGGED compiled code block */
F_COMPILED *code;
F_CODE_BLOCK *code;
} F_QUOTATION;
/* Assembly code makes assumptions about the layout of this struct */

1
vm/master.h
View File

@ -32,6 +32,7 @@
#include "float_bits.h"
#include "io.h"
#include "code_gc.h"
#include "code_block.h"
#include "code_heap.h"
#include "image.h"
#include "callstack.h"

4
vm/profiler.c
View File

@ -1,7 +1,7 @@
#include "master.h"
/* Allocates memory */
F_COMPILED *compile_profiling_stub(F_WORD *word)
F_CODE_BLOCK *compile_profiling_stub(F_WORD *word)
{
CELL literals = allot_array_1(tag_object(word));
REGISTER_ROOT(literals);
@ -37,7 +37,7 @@ void update_word_xt(F_WORD *word)
if(!word->profiling)
{
REGISTER_UNTAGGED(word);
F_COMPILED *profiling = compile_profiling_stub(word);
F_CODE_BLOCK *profiling = compile_profiling_stub(word);
UNREGISTER_UNTAGGED(word);
word->profiling = profiling;
}

2
vm/profiler.h
View File

@ -1,4 +1,4 @@
bool profiling_p;
void primitive_profiling(void);
F_COMPILED *compile_profiling_stub(F_WORD *word);
F_CODE_BLOCK *compile_profiling_stub(F_WORD *word);
void update_word_xt(F_WORD *word);

4
vm/quotations.c
View File

@ -155,7 +155,7 @@ bool jit_stack_frame_p(F_ARRAY *array)
return false;
}
void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code)
void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code)
{
if(code->type != QUOTATION_TYPE)
critical_error("bad param to set_quot_xt",(CELL)code);
@ -339,7 +339,7 @@ void jit_compile(CELL quot, bool relocate)
GROWABLE_ARRAY_TRIM(literals);
GROWABLE_BYTE_ARRAY_TRIM(relocation);
F_COMPILED *compiled = add_compiled_block(
F_CODE_BLOCK *compiled = add_compiled_block(
QUOTATION_TYPE,
untag_object(code),
NULL,

2
vm/quotations.h
View File

@ -1,4 +1,4 @@
void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code);
void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code);
void jit_compile(CELL quot, bool relocate);
F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack);
F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset);

6
vm/types.c
View File

@ -79,9 +79,9 @@ void primitive_word(void)
void primitive_word_xt(void)
{
F_WORD *word = untag_word(dpop());
F_COMPILED *code = (profiling_p ? word->profiling : word->code);
dpush(allot_cell((CELL)code + sizeof(F_COMPILED)));
dpush(allot_cell((CELL)code + sizeof(F_COMPILED) + code->code_length));
F_CODE_BLOCK *code = (profiling_p ? word->profiling : word->code);
dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK)));
dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK) + code->code_length));
}
void primitive_wrapper(void)