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

Merge branch 'master' of git://factorcode.org/git/factor

release
Eduardo Cavazos 2007-09-23 13:29:42 -05:00
parent 5792ec4319 b0f931d038
commit 5546ca409c
6 changed files with 56 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/cpu/x86/architecture/architecture.factor
View File

@ -156,7 +156,7 @@ M: x86-backend small-enough? ( n -- ? )
[
stack-frame* cell + +
] [
temp@
\ stack-frame get swap -
] ?if ;
HOOK: %unbox-struct-1 compiler-backend ( -- )

67
core/cpu/x86/intrinsics/intrinsics.factor
View File

@ -71,29 +71,38 @@ IN: cpu.x86.intrinsics
} define-intrinsic
! Slots
: %slot-literal-known-tag
"obj" operand
"n" get cells
"obj" operand-tag - [+] ;
: %slot-literal-any-tag
"obj" operand %untag
"obj" operand "n" get cells [+] ;
: %slot-any
"obj" operand %untag
"n" operand fixnum>slot@
"obj" operand "n" operand [+] ;
\ slot {
! Slot number is literal and the tag is known
{
[ "obj" operand %slot-literal-known-tag MOV ] H{
{ +input+ { { f "obj" known-tag } { [ small-slot? ] "n" } } }
{ +output+ { "obj" } }
}
}
! Slot number is literal
{
[
"obj" operand %untag
! load slot value
"obj" operand dup "n" get cells [+] MOV
] H{
[ "obj" operand %slot-literal-any-tag MOV ] H{
{ +input+ { { f "obj" } { [ small-slot? ] "n" } } }
{ +output+ { "obj" } }
}
}
! Slot number in a register
{
[
"obj" operand %untag
! turn tagged fixnum slot # into an offset,
! multiple of 4
"n" operand fixnum>slot@
! load slot value
"obj" operand dup "n" operand [+] MOV
] H{
[ "obj" operand %slot-any MOV ] H{
{ +input+ { { f "obj" } { f "n" } } }
{ +output+ { "obj" } }
{ +clobber+ { "n" } }
@ -105,38 +114,28 @@ IN: cpu.x86.intrinsics
#! Mark the card pointed to by vreg.
"val" operand-immediate? "obj" get fresh-object? or [
"obj" operand card-bits SHR
"scratch" operand HEX: ffffffff MOV
"cards_offset" f rc-absolute-cell rel-dlsym
"scratch" operand dup [] MOV
"scratch" operand "obj" operand [+] card-mark OR
"cards_offset" f %alien-global
temp-reg v>operand "obj" operand [+] card-mark OR
] unless ;
\ set-slot {
! Slot number is literal and the tag is known
{
[ %slot-literal-known-tag "val" operand MOV ] H{
{ +input+ { { f "val" } { f "obj" known-tag } { [ small-slot? ] "n" } } }
{ +clobber+ { "obj" } }
}
}
! Slot number is literal
{
[
"obj" operand %untag
! store new slot value
"obj" operand "n" get cells [+] "val" operand MOV
generate-write-barrier
] H{
[ %slot-literal-any-tag "val" operand MOV generate-write-barrier ] H{
{ +input+ { { f "val" } { f "obj" } { [ small-slot? ] "n" } } }
{ +scratch+ { { f "scratch" } } }
{ +clobber+ { "obj" } }
}
}
! Slot number in a register
{
[
! turn tagged fixnum slot # into an offset
"n" operand fixnum>slot@
"obj" operand %untag
! store new slot value
"obj" operand "n" operand [+] "val" operand MOV
! reuse register
"n" get "scratch" set
generate-write-barrier
] H{
[ %slot-any "val" operand MOV generate-write-barrier ] H{
{ +input+ { { f "val" } { f "obj" } { f "n" } } }
{ +clobber+ { "obj" "n" } }
}

BIN
extra/factory/.factory-menus.swp
View File

Binary file not shown.

36
vm/image.c
View File

@ -81,19 +81,6 @@ void load_image(F_PARAMETERS *p)
userenv[IMAGE_ENV] = tag_object(from_native_string(p->image));
}
/* Compute total sum of sizes of free blocks */
void save_code_heap(FILE *file)
{
F_BLOCK *scan = first_block(&code_heap);
while(scan)
{
if(scan->status == B_ALLOCATED)
fwrite(scan,scan->size,1,file);
scan = next_block(&code_heap,scan);
}
}
/* Save the current image to disk */
bool save_image(const F_CHAR *filename)
{
@ -132,7 +119,6 @@ bool save_image(const F_CHAR *filename)
fwrite(&h,sizeof(F_HEADER),1,file);
fwrite((void*)tenured->start,h.data_size,1,file);
/* save_code_heap(file); */
fwrite(first_block(&code_heap),h.code_size,1,file);
fclose(file);
@ -187,6 +173,8 @@ void fixup_alien(F_ALIEN *d)
d->expired = T;
}
F_FIXNUM delta;
void fixup_stack_frame(F_STACK_FRAME *frame)
{
code_fixup(&frame->xt);
@ -198,7 +186,21 @@ void fixup_stack_frame(F_STACK_FRAME *frame)
frame->scan = scan + frame->array;
}
/* code_fixup(&frame->return_address); */
#ifdef CALLSTACK_UP_P
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta);
code_fixup((XT *)(next + 1));
#else
code_fixup(&frame->return_address);
#endif
}
void fixup_callstack_object(F_CALLSTACK *stack)
{
CELL top = (CELL)(stack + 1);
CELL bottom = top + untag_fixnum_fast(stack->length);
delta = (bottom - stack->bottom);
iterate_callstack_object(stack,fixup_stack_frame);
}
/* Initialize an object in a newly-loaded image */
@ -221,9 +223,7 @@ void relocate_object(CELL relocating)
fixup_alien((F_ALIEN *)relocating);
break;
case CALLSTACK_TYPE:
iterate_callstack_object(
(F_CALLSTACK *)relocating,
fixup_stack_frame);
fixup_callstack_object((F_CALLSTACK *)relocating);
break;
}
}

4
vm/stack.c
View File

@ -111,7 +111,7 @@ void iterate_callstack(CELL top, CELL bottom, CELL base, CALLSTACK_ITER iterator
while(ITERATING_P)
{
F_STACK_FRAME *next = (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta);
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta);
iterator(frame);
frame = next;
}
@ -344,7 +344,7 @@ static F_FIXNUM delta;
void adjust_stack_frame(F_STACK_FRAME *frame)
{
FRAME_SUCCESSOR(frame) = (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta);
FRAME_SUCCESSOR(frame) = REBASE_FRAME_SUCCESSOR(frame,delta);
}
void adjust_callstack(F_CALLSTACK *stack, CELL bottom)

2
vm/stack.h
View File

@ -56,6 +56,8 @@ void init_stacks(CELL ds_size, CELL rs_size);
#define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1)
#define REBASE_FRAME_SUCCESSOR(frame,delta) (F_STACK_FRAME *)((CELL)FRAME_SUCCESSOR(frame) + delta)
typedef void (*CALLSTACK_ITER)(F_STACK_FRAME *frame);
void iterate_callstack(CELL top, CELL bottom, CELL base, CALLSTACK_ITER iterator);