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

Got various things working on CE/ARM

release
U-SLAVA-FB3999113\Slava 2007-10-13 17:57:29 -04:00
parent 8d358ea370
commit 4d30644576
12 changed files with 100 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
core/cpu/arm/bootstrap.factor
View File

@ -17,14 +17,12 @@ big-endian off
: temp-reg R3 ;
: xt-reg R12 ;
: lr-save bootstrap-cell ;
: stack-frame 8 bootstrap-cells ;
: next-save stack-frame bootstrap-cell - ;
: xt-save stack-frame 2 bootstrap-cells - ;
: array-save stack-frame 3 bootstrap-cells - ;
: scan-save stack-frame 4 bootstrap-cells - ;
: next-save stack-frame 2 bootstrap-cells - ;
: xt-save stack-frame 3 bootstrap-cells - ;
: array-save stack-frame 4 bootstrap-cells - ;
: scan-save stack-frame 5 bootstrap-cells - ;
[
temp-reg quot-reg quot-array@ <+> LDR ! load array
@ -32,12 +30,12 @@ big-endian off
] { } make jit-setup set
[
LR SP 4 <-> STR ! save return address
SP SP stack-frame SUB
xt-reg SP xt-save <+> STR ! save XT
xt-reg stack-frame MOV
xt-reg SP next-save <+> STR ! save frame size
temp-reg SP array-save <+> STR ! save array
LR SP lr-save stack-frame + <+> STR ! save return address
] { } make jit-prolog set
[
@ -52,11 +50,11 @@ big-endian off
] { } make jit-push-wrapper set
[
R1 SP MOV ! pass stack pointer to primitive
R1 SP 4 SUB ! pass stack pointer to primitive
] { } make jit-word-primitive-jump set
[
R1 SP MOV ! pass stack pointer to primitive
R1 SP 4 SUB ! pass stack pointer to primitive
] { } make jit-word-primitive-call set
: load-word-xt ( -- )
@ -81,10 +79,10 @@ big-endian off
xt-reg quot-reg quot-xt@ <+> LDR ;
: load-branch
temp-reg ds-reg -4 <-!> LDR ! pop boolean
temp-reg ds-reg 4 <-!> LDR ! pop boolean
temp-reg \ f tag-number CMP ! compare it with f
scan-reg quot-reg MOV ! point quot-reg at false branch
quot-reg dup 4 NE ADD ! point quot-reg at true branch
quot-reg scan-reg MOV ! point quot-reg at false branch
quot-reg dup 4 EQ ADD ! point quot-reg at true branch
quot-reg dup 4 <+> LDR ! load the branch
scan-reg dup 12 ADD ! advance scan pointer
load-quot-xt
@ -110,7 +108,7 @@ big-endian off
[
SP SP stack-frame ADD ! pop stack frame
LR SP lr-save stack-frame + <+> LDR ! load return address
LR SP 4 <-> LDR ! load return address
] { } make jit-epilog set
[ PC LR MOV ] { } make jit-return set

0
vm/callstack.c Normal file → Executable file
View File

57
vm/cpu-arm.S
View File

@ -3,17 +3,18 @@
/* Note that the XT is passed to the quotation in r12 */
#define CALL_QUOT \
ldr r12,[r0, #9] /* load quotation-xt slot */ ; \
mov pc,lr ; \
mov r11,pc
mov lr,pc ; \
mov pc,r12
#define JUMP_QUOT \
ldr pc,[r0, #9] /* load quotation-xt slot */
ldr r12,[r0, #9] /* load quotation-xt slot */ ; \
mov pc,r12
#define SAVED_REGS_SIZE 32
#define FRAME (RESERVED_SIZE + SAVED_REGS_SIZE + 8)
#define LR_SAVE [sp, #4]
#define LR_SAVE [sp, #-4]
#define RESERVED_SIZE 8
#define SAVE_LR str lr,LR_SAVE
@ -27,12 +28,12 @@
#define RESTORE(register,offset) ldr register,[sp, #SAVE_AT(offset)]
#define PROLOGUE \
sub sp,sp,#FRAME ; \
SAVE_LR
SAVE_LR ; \
sub sp,sp,#FRAME
#define EPILOGUE \
LOAD_LR ; \
sub sp,sp,#FRAME
add sp,sp,#FRAME ; \
LOAD_LR
DEF(void,c_to_factor,(CELL quot)):
PROLOGUE
@ -47,7 +48,7 @@ DEF(void,c_to_factor,(CELL quot)):
SAVE(r11,7)
SAVE(r0,8) /* save quotation since we're about to mangle it */
mov sp,r1 /* pass call stack pointer as an argument */
mov r0,sp /* pass call stack pointer as an argument */
bl MANGLE(save_callstack_bottom)
RESTORE(r0,8) /* restore quotation */
@ -63,9 +64,9 @@ DEF(void,c_to_factor,(CELL quot)):
RESTORE(r4,0)
EPILOGUE
mov lr,pc
mov pc,lr
/* The JIT compiles an 'mov sp,r1' in front of every primitive call, since a
/* The JIT compiles an 'mov r1',sp in front of every primitive call, since a
word which was defined as a primitive will not change its definition for the
lifetime of the image -- adding new primitives requires a bootstrap. However,
an undefined word can certainly become defined,
@ -77,12 +78,12 @@ DEFER: foo
And calls to non-primitives do not have this one-instruction prologue, so we
set the XT of undefined words to this symbol. */
DEF(void,undefined,(CELL word)):
mov sp,r1
mov r1,sp
b MANGLE(undefined_error)
DEF(void,dosym,(CELL word)):
str r0,[r5], #4 /* push word to stack */
mov lr,pc /* return */
str r0,[r5, #4]! /* push word to stack */
mov pc,lr /* return */
/* Here we have two entry points. The first one is taken when profiling is
enabled */
@ -94,32 +95,32 @@ DEF(void,docol,(CELL word)):
ldr r0,[r0, #13] /* load word-def slot */
JUMP_QUOT
/* We must pass the XT to the quotation in r11. */
/* We must pass the XT to the quotation in r12. */
DEF(void,primitive_call,(void)):
ldr r0,[r5, #-4]! /* load quotation from data stack */
ldr r0,[r5], #-4 /* load quotation from data stack */
JUMP_QUOT
/* We must preserve r1 here in case we're calling a primitive */
DEF(void,primitive_execute,(void)):
ldr r0,[r5, #-4]! /* load word from data stack */
ldr r0,[r5], #-4 /* load word from data stack */
ldr pc,[r0, #29] /* jump to word-xt */
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length)):
sub sp,r0,r2 /* compute new stack pointer */
mov r0,r1 /* start of destination of memcpy() */
str sp,[sp, #-64] /* setup fake stack frame for memcpy() */
bl MANGLE(memcpy) /* go */
ldr sp,[sp] /* tear down fake stack frame */
ldr pc,LR_SAVE /* return */
sub sp,r0,r2 /* compute new stack pointer */
mov r0,sp /* start of destination of memcpy() */
sub sp,sp,#12 /* alignment */
bl MANGLE(memcpy) /* go */
add sp,sp,#16 /* point SP at innermost frame */
ldr pc,LR_SAVE /* return */
DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
mov r1,sp /* compute new stack pointer */
ldr lr,LR_SAVE /* we have rewound the stack; load return address */
JUMP_QUOT /* call the quotation */
mov sp,r1 /* compute new stack pointer */
ldr lr,LR_SAVE /* we have rewound the stack; load return address */
JUMP_QUOT /* call the quotation */
DEF(void,lazy_jit_compile,(CELL quot)):
mov sp,r1 /* save stack pointer */
mov r1,sp /* save stack pointer */
PROLOGUE
bl MANGLE(primitive_jit_compile)
EPILOGUE
JUMP_QUOT /* call the quotation */
JUMP_QUOT /* call the quotation */

24
vm/cpu-arm.h
View File

@ -5,6 +5,28 @@ register CELL rs asm("r6");
#define F_FASTCALL
typedef struct
{
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In all compiled frames, the XT on entry. */
XT xt;
/* Frame size in bytes */
CELL size;
/* Return address */
XT return_address;
} F_STACK_FRAME;
#define FRAME_RETURN_ADDRESS(frame) (frame)->return_address
void c_to_factor(CELL quot);
void dosym(CELL word);
void docol_profiling(CELL word);
@ -14,5 +36,3 @@ void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *me
void throw_impl(CELL quot, F_STACK_FRAME *rewind);
void lazy_jit_compile(CELL quot);
void flush_icache(CELL start, CELL len);
#define FRAME_RETURN_ADDRESS(frame) *((XT *)(frame_successor(frame) + 1) + 1)

17
vm/cpu-ppc.h Normal file → Executable file
View File

@ -1,3 +1,20 @@
typedef struct
{
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In all compiled frames, the XT on entry. */
XT xt;
/* Frame size in bytes */
CELL size;
} F_STACK_FRAME;
#define FACTOR_CPU_STRING "ppc"
#define F_FASTCALL

17
vm/cpu-x86.h Normal file → Executable file
View File

@ -1,5 +1,22 @@
#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
typedef struct
{
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In all compiled frames, the XT on entry. */
XT xt;
/* Frame size in bytes */
CELL size;
} F_STACK_FRAME;
INLINE void flush_icache(CELL start, CELL len) {}
F_FASTCALL void c_to_factor(CELL quot);

0
vm/debug.c Normal file → Executable file
View File

0
vm/errors.c Normal file → Executable file
View File

4
vm/factor.c Normal file → Executable file
View File

@ -134,7 +134,9 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
if(p.fep)
factorbug();
c_to_factor_toplevel(userenv[BOOT_ENV]);
printf("about to call boot\n");
c_to_factor(userenv[BOOT_ENV]);
printf("return from call boot\n");
unnest_stacks();
for(i = 0; i < argc; i++)

17
vm/layouts.h Normal file → Executable file
View File

@ -239,20 +239,3 @@ typedef struct {
/* tagged */
CELL length;
} F_CALLSTACK;
typedef struct
{
/* In compiled quotation frames, position within the array.
In compiled word frames, unused. */
CELL scan;
/* In compiled quotation frames, the quot->array slot.
In compiled word frames, unused. */
CELL array;
/* In all compiled frames, the XT on entry. */
XT xt;
/* Frame size in bytes */
CELL size;
} F_STACK_FRAME;

2
vm/os-windows-ce-arm.S
View File

@ -1,6 +1,6 @@
.text
.globl run_toplevel
.globl c_to_factor_toplevel
.word exception_handler
.word 0

7
vm/os-windows-ce.c
View File

@ -37,14 +37,7 @@ char *getenv(char *name)
return 0; /* unreachable */
}
long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
{
return 0;
}
void c_to_factor_toplevel(CELL quot)
{
c_to_factor(quot);
}