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

Merge git://factorcode.org/git/factor

release
U-C4\Administrator 2007-09-23 13:56:24 -05:00
parent 80dfa4b950 94bfbbde2f
commit 17ebe7fe47
21 changed files with 89 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/bootstrap/image/image.factor
View File

@ -32,7 +32,7 @@ IN: bootstrap.image
: -1-offset 9 ; inline
: array-start 2 bootstrap-cells object tag-number - ;
: scan@ array-start 4 - ;
: scan@ array-start bootstrap-cell - ;
: wrapper@ bootstrap-cell object tag-number - ;
: word-xt@ 8 bootstrap-cells object tag-number - ;
: quot-array@ bootstrap-cell object tag-number - ;

4
core/cpu/x86/32/32.factor
View File

@ -206,10 +206,10 @@ M: x86-backend %box-small-struct ( size -- )
M: x86-backend %prepare-alien-indirect ( -- )
"unbox_alien" f %alien-invoke
ESP cell temp@ [+] EAX MOV ;
cell temp@ EAX MOV ;
M: x86-backend %alien-indirect ( -- )
ESP cell temp@ [+] CALL ;
cell temp@ CALL ;
M: x86-backend %alien-callback ( quot -- )
4 [

1
core/cpu/x86/32/bootstrap.factor
View File

@ -13,5 +13,6 @@ IN: bootstrap.x86
: scan-reg EBX ;
: xt-reg ECX ;
: fixnum>slot@ arg0 1 SAR ;
: next-frame@ -44 ;
"resource:core/cpu/x86/bootstrap.factor" run-file

12
core/cpu/x86/64/64.factor
View File

@ -13,11 +13,13 @@ PREDICATE: x86-backend amd64-backend
M: amd64-backend ds-reg R14 ;
M: amd64-backend rs-reg R15 ;
M: amd64-backend stack-reg RSP ;
M: x86-backend xt-reg RCX ;
M: x86-backend stack-save-reg RSI ;
M: temp-reg v>operand drop R13 ;
M: temp-reg v>operand drop RBX ;
M: int-regs return-reg drop RAX ;
M: int-regs vregs drop { RAX RBX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 } ;
M: int-regs vregs drop { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } ;
M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
M: float-regs return-reg drop XMM0 ;
@ -144,17 +146,17 @@ M: amd64-backend %alien-indirect ( -- )
cell temp@ CALL ;
M: amd64-backend %alien-callback ( quot -- )
RDI load-indirect "run_callback" f compile-c-call ;
RDI load-indirect "c_to_factor" f compile-c-call ;
M: amd64-backend %callback-value ( ctype -- )
! Save top of data stack
%prepare-unbox
! Put former top of data stack in RDI
temp@ RDI MOV
cell temp@ RDI MOV
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Put former top of data stack in RDI
RDI temp@ MOV
RDI cell temp@ MOV
! Unbox former top of data stack to return registers
unbox-return ;

1
core/cpu/x86/64/bootstrap.factor
View File

@ -13,5 +13,6 @@ IN: bootstrap.x86
: scan-reg RBX ;
: xt-reg RCX ;
: fixnum>slot@ ;
: next-frame@ -88 ;
"resource:core/cpu/x86/bootstrap.factor" run-file

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

@ -150,13 +150,13 @@ M: x86-backend small-enough? ( n -- ? )
: %tag-fixnum ( reg -- ) tag-bits get SHL ;
: temp@ \ stack-frame get swap - ;
: temp@ stack-reg \ stack-frame get rot - [+] ;
: struct-return@ ( size n -- n )
[
stack-frame* cell + +
] [
temp@
\ stack-frame get swap -
] ?if ;
HOOK: %unbox-struct-1 compiler-backend ( -- )

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

@ -17,7 +17,7 @@ big-endian off
[
xt-reg PUSH ! save XT
xt-reg stack-reg -44 [+] LEA ! compute forward chain pointer
xt-reg stack-reg next-frame@ [+] LEA ! compute forward chain pointer
xt-reg PUSH ! save forward chain pointer
arg0 PUSH ! save array
stack-reg 4 bootstrap-cells SUB ! reserve space for scan-save

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 generate-write-barrier ] 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" } }
}

3
extra/factory/factory-menus
View File

@ -1,7 +1,8 @@
! -*-factor-*-
USING: kernel unix vars mortar slot-accessors
x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu ;
x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu
factory.commands factory.load ;
IN: factory

1
extra/factory/factory-rc
View File

@ -4,6 +4,7 @@ USING: kernel mortar x
x.widgets.wm.root
x.widgets.wm.workspace
x.widgets.wm.unmapped-frames-menu
factory.load
tty-server ;
IN: factory

7
extra/io/unix/launcher/launcher.factor
View File

@ -9,16 +9,15 @@ USE: unix
: with-fork ( quot -- pid )
fork [ zero? -rot if ] keep ; inline
: prepare-execve ( args -- cmd args envp )
: prepare-execvp ( args -- cmd args )
#! Doesn't free any memory, so we only call this word
#! after forking.
[ malloc-char-string ] map
[ first ] keep
f add >c-void*-array
f ;
f add >c-void*-array ;
: (spawn-process) ( args -- )
[ prepare-execve execve ] catch 1 exit ;
[ prepare-execvp execvp ] catch 1 exit ;
: spawn-process ( args -- pid )
[ (spawn-process) ] [ drop ] with-fork ;

5
extra/json/writer/writer.factor
View File

@ -21,6 +21,11 @@ M: string json-print ( obj -- )
M: number json-print ( num -- )
number>string write ;
! sequence and number overlap, we provide an explicit
! disambiguation method
M: integer json-print ( num -- )
number>string write ;
M: sequence json-print ( array -- string )
CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;

1
extra/unix/unix.factor
View File

@ -107,6 +107,7 @@ FUNCTION: void close ( int fd ) ;
FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ;
FUNCTION: int dup2 ( int oldd, int newd ) ;
! FUNCTION: int dup ( int oldd ) ;
FUNCTION: int execvp ( char* path, char** argv ) ;
FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
FUNCTION: int fchdir ( int fd ) ;
FUNCTION: int fchmod ( int fd, mode_t mode ) ;

2
vm/cpu-x86.32.S
View File

@ -25,7 +25,7 @@ and the callstack top is passed in EDX */
#define WORD_DEF_OFFSET 13
#define WORD_XT_OFFSET 29
/* We pass a function pointer to memcpy in 16(%esp) to work around a Mac OS X
/* We pass a function pointer to memcpy to work around a Mac OS X
ABI limitation which would otherwise require us to do a bizzaro PC-relative
trampoline to retrieve the function address */
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):

2
vm/cpu-x86.64.S
View File

@ -25,7 +25,7 @@
#define WORD_DEF_OFFSET 29
#define WORD_XT_OFFSET 61
/* We pass a function pointer to memcpy in 16(%esp) to work around a Mac OS X
/* We pass a function pointer to memcpy to work around a Mac OS X
ABI limitation which would otherwise require us to do a bizzaro PC-relative
trampoline to retrieve the function address */
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):

2
vm/cpu-x86.S
View File

@ -29,7 +29,7 @@ DEF(FASTCALL void,dosym,(CELL word)):
/* Here we have two entry points. The first one is taken when profiling is
enabled */
DEF(FASTCALL void,docol_profiling,(CELL word)):
add $CELL_SIZE,PROFILING_OFFSET(%eax) /* Increment profile-count slot */
add $CELL_SIZE,PROFILING_OFFSET(ARG0) /* Increment profile-count slot */
DEF(FASTCALL void,docol,(CELL word)):
mov WORD_DEF_OFFSET(ARG0),ARG0 /* Load word-def slot */
JUMP_QUOT

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;
}
}

2
vm/os-linux-x86-32.h Normal file
View File

@ -0,0 +1,2 @@
#define UAP_PROGRAM_COUNTER(ucontext) \
(((ucontext_t *)(ucontext))->uc_mcontext.gregs[14])

2
vm/os-linux-x86-64.h Normal file
View File

@ -0,0 +1,2 @@
#define UAP_PROGRAM_COUNTER(ucontext) \
(((ucontext_t *)(ucontext))->uc_mcontext.gregs[16])

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);