Got various things working on CE/ARM
parent
8d358ea370
commit
4d30644576
|
@ -17,14 +17,12 @@ big-endian off
|
||||||
: temp-reg R3 ;
|
: temp-reg R3 ;
|
||||||
: xt-reg R12 ;
|
: xt-reg R12 ;
|
||||||
|
|
||||||
: lr-save bootstrap-cell ;
|
|
||||||
|
|
||||||
: stack-frame 8 bootstrap-cells ;
|
: stack-frame 8 bootstrap-cells ;
|
||||||
|
|
||||||
: next-save stack-frame bootstrap-cell - ;
|
: next-save stack-frame 2 bootstrap-cells - ;
|
||||||
: xt-save stack-frame 2 bootstrap-cells - ;
|
: xt-save stack-frame 3 bootstrap-cells - ;
|
||||||
: array-save stack-frame 3 bootstrap-cells - ;
|
: array-save stack-frame 4 bootstrap-cells - ;
|
||||||
: scan-save stack-frame 4 bootstrap-cells - ;
|
: scan-save stack-frame 5 bootstrap-cells - ;
|
||||||
|
|
||||||
[
|
[
|
||||||
temp-reg quot-reg quot-array@ <+> LDR ! load array
|
temp-reg quot-reg quot-array@ <+> LDR ! load array
|
||||||
|
@ -32,12 +30,12 @@ big-endian off
|
||||||
] { } make jit-setup set
|
] { } make jit-setup set
|
||||||
|
|
||||||
[
|
[
|
||||||
|
LR SP 4 <-> STR ! save return address
|
||||||
SP SP stack-frame SUB
|
SP SP stack-frame SUB
|
||||||
xt-reg SP xt-save <+> STR ! save XT
|
xt-reg SP xt-save <+> STR ! save XT
|
||||||
xt-reg stack-frame MOV
|
xt-reg stack-frame MOV
|
||||||
xt-reg SP next-save <+> STR ! save frame size
|
xt-reg SP next-save <+> STR ! save frame size
|
||||||
temp-reg SP array-save <+> STR ! save array
|
temp-reg SP array-save <+> STR ! save array
|
||||||
LR SP lr-save stack-frame + <+> STR ! save return address
|
|
||||||
] { } make jit-prolog set
|
] { } make jit-prolog set
|
||||||
|
|
||||||
[
|
[
|
||||||
|
@ -52,11 +50,11 @@ big-endian off
|
||||||
] { } make jit-push-wrapper set
|
] { } 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
|
] { } 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
|
] { } make jit-word-primitive-call set
|
||||||
|
|
||||||
: load-word-xt ( -- )
|
: load-word-xt ( -- )
|
||||||
|
@ -81,10 +79,10 @@ big-endian off
|
||||||
xt-reg quot-reg quot-xt@ <+> LDR ;
|
xt-reg quot-reg quot-xt@ <+> LDR ;
|
||||||
|
|
||||||
: load-branch
|
: 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
|
temp-reg \ f tag-number CMP ! compare it with f
|
||||||
scan-reg quot-reg MOV ! point quot-reg at false branch
|
quot-reg scan-reg MOV ! point quot-reg at false branch
|
||||||
quot-reg dup 4 NE ADD ! point quot-reg at true branch
|
quot-reg dup 4 EQ ADD ! point quot-reg at true branch
|
||||||
quot-reg dup 4 <+> LDR ! load the branch
|
quot-reg dup 4 <+> LDR ! load the branch
|
||||||
scan-reg dup 12 ADD ! advance scan pointer
|
scan-reg dup 12 ADD ! advance scan pointer
|
||||||
load-quot-xt
|
load-quot-xt
|
||||||
|
@ -110,7 +108,7 @@ big-endian off
|
||||||
|
|
||||||
[
|
[
|
||||||
SP SP stack-frame ADD ! pop stack frame
|
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
|
] { } make jit-epilog set
|
||||||
|
|
||||||
[ PC LR MOV ] { } make jit-return set
|
[ PC LR MOV ] { } make jit-return set
|
||||||
|
|
57
vm/cpu-arm.S
57
vm/cpu-arm.S
|
@ -3,17 +3,18 @@
|
||||||
/* Note that the XT is passed to the quotation in r12 */
|
/* Note that the XT is passed to the quotation in r12 */
|
||||||
#define CALL_QUOT \
|
#define CALL_QUOT \
|
||||||
ldr r12,[r0, #9] /* load quotation-xt slot */ ; \
|
ldr r12,[r0, #9] /* load quotation-xt slot */ ; \
|
||||||
mov pc,lr ; \
|
mov lr,pc ; \
|
||||||
mov r11,pc
|
mov pc,r12
|
||||||
|
|
||||||
#define JUMP_QUOT \
|
#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 SAVED_REGS_SIZE 32
|
||||||
|
|
||||||
#define FRAME (RESERVED_SIZE + SAVED_REGS_SIZE + 8)
|
#define FRAME (RESERVED_SIZE + SAVED_REGS_SIZE + 8)
|
||||||
|
|
||||||
#define LR_SAVE [sp, #4]
|
#define LR_SAVE [sp, #-4]
|
||||||
#define RESERVED_SIZE 8
|
#define RESERVED_SIZE 8
|
||||||
|
|
||||||
#define SAVE_LR str lr,LR_SAVE
|
#define SAVE_LR str lr,LR_SAVE
|
||||||
|
@ -27,12 +28,12 @@
|
||||||
#define RESTORE(register,offset) ldr register,[sp, #SAVE_AT(offset)]
|
#define RESTORE(register,offset) ldr register,[sp, #SAVE_AT(offset)]
|
||||||
|
|
||||||
#define PROLOGUE \
|
#define PROLOGUE \
|
||||||
sub sp,sp,#FRAME ; \
|
SAVE_LR ; \
|
||||||
SAVE_LR
|
sub sp,sp,#FRAME
|
||||||
|
|
||||||
#define EPILOGUE \
|
#define EPILOGUE \
|
||||||
LOAD_LR ; \
|
add sp,sp,#FRAME ; \
|
||||||
sub sp,sp,#FRAME
|
LOAD_LR
|
||||||
|
|
||||||
DEF(void,c_to_factor,(CELL quot)):
|
DEF(void,c_to_factor,(CELL quot)):
|
||||||
PROLOGUE
|
PROLOGUE
|
||||||
|
@ -47,7 +48,7 @@ DEF(void,c_to_factor,(CELL quot)):
|
||||||
SAVE(r11,7)
|
SAVE(r11,7)
|
||||||
SAVE(r0,8) /* save quotation since we're about to mangle it */
|
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)
|
bl MANGLE(save_callstack_bottom)
|
||||||
|
|
||||||
RESTORE(r0,8) /* restore quotation */
|
RESTORE(r0,8) /* restore quotation */
|
||||||
|
@ -63,9 +64,9 @@ DEF(void,c_to_factor,(CELL quot)):
|
||||||
RESTORE(r4,0)
|
RESTORE(r4,0)
|
||||||
|
|
||||||
EPILOGUE
|
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
|
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,
|
lifetime of the image -- adding new primitives requires a bootstrap. However,
|
||||||
an undefined word can certainly become defined,
|
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
|
And calls to non-primitives do not have this one-instruction prologue, so we
|
||||||
set the XT of undefined words to this symbol. */
|
set the XT of undefined words to this symbol. */
|
||||||
DEF(void,undefined,(CELL word)):
|
DEF(void,undefined,(CELL word)):
|
||||||
mov sp,r1
|
mov r1,sp
|
||||||
b MANGLE(undefined_error)
|
b MANGLE(undefined_error)
|
||||||
|
|
||||||
DEF(void,dosym,(CELL word)):
|
DEF(void,dosym,(CELL word)):
|
||||||
str r0,[r5], #4 /* push word to stack */
|
str r0,[r5, #4]! /* push word to stack */
|
||||||
mov lr,pc /* return */
|
mov pc,lr /* return */
|
||||||
|
|
||||||
/* Here we have two entry points. The first one is taken when profiling is
|
/* Here we have two entry points. The first one is taken when profiling is
|
||||||
enabled */
|
enabled */
|
||||||
|
@ -94,32 +95,32 @@ DEF(void,docol,(CELL word)):
|
||||||
ldr r0,[r0, #13] /* load word-def slot */
|
ldr r0,[r0, #13] /* load word-def slot */
|
||||||
JUMP_QUOT
|
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)):
|
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
|
JUMP_QUOT
|
||||||
|
|
||||||
/* We must preserve r1 here in case we're calling a primitive */
|
/* We must preserve r1 here in case we're calling a primitive */
|
||||||
DEF(void,primitive_execute,(void)):
|
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 */
|
ldr pc,[r0, #29] /* jump to word-xt */
|
||||||
|
|
||||||
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length)):
|
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length)):
|
||||||
sub sp,r0,r2 /* compute new stack pointer */
|
sub sp,r0,r2 /* compute new stack pointer */
|
||||||
mov r0,r1 /* start of destination of memcpy() */
|
mov r0,sp /* start of destination of memcpy() */
|
||||||
str sp,[sp, #-64] /* setup fake stack frame for memcpy() */
|
sub sp,sp,#12 /* alignment */
|
||||||
bl MANGLE(memcpy) /* go */
|
bl MANGLE(memcpy) /* go */
|
||||||
ldr sp,[sp] /* tear down fake stack frame */
|
add sp,sp,#16 /* point SP at innermost frame */
|
||||||
ldr pc,LR_SAVE /* return */
|
ldr pc,LR_SAVE /* return */
|
||||||
|
|
||||||
DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
|
DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
|
||||||
mov r1,sp /* compute new stack pointer */
|
mov sp,r1 /* compute new stack pointer */
|
||||||
ldr lr,LR_SAVE /* we have rewound the stack; load return address */
|
ldr lr,LR_SAVE /* we have rewound the stack; load return address */
|
||||||
JUMP_QUOT /* call the quotation */
|
JUMP_QUOT /* call the quotation */
|
||||||
|
|
||||||
DEF(void,lazy_jit_compile,(CELL quot)):
|
DEF(void,lazy_jit_compile,(CELL quot)):
|
||||||
mov sp,r1 /* save stack pointer */
|
mov r1,sp /* save stack pointer */
|
||||||
PROLOGUE
|
PROLOGUE
|
||||||
bl MANGLE(primitive_jit_compile)
|
bl MANGLE(primitive_jit_compile)
|
||||||
EPILOGUE
|
EPILOGUE
|
||||||
JUMP_QUOT /* call the quotation */
|
JUMP_QUOT /* call the quotation */
|
||||||
|
|
24
vm/cpu-arm.h
24
vm/cpu-arm.h
|
@ -5,6 +5,28 @@ register CELL rs asm("r6");
|
||||||
|
|
||||||
#define F_FASTCALL
|
#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 c_to_factor(CELL quot);
|
||||||
void dosym(CELL word);
|
void dosym(CELL word);
|
||||||
void docol_profiling(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 throw_impl(CELL quot, F_STACK_FRAME *rewind);
|
||||||
void lazy_jit_compile(CELL quot);
|
void lazy_jit_compile(CELL quot);
|
||||||
void flush_icache(CELL start, CELL len);
|
void flush_icache(CELL start, CELL len);
|
||||||
|
|
||||||
#define FRAME_RETURN_ADDRESS(frame) *((XT *)(frame_successor(frame) + 1) + 1)
|
|
||||||
|
|
|
@ -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 FACTOR_CPU_STRING "ppc"
|
||||||
#define F_FASTCALL
|
#define F_FASTCALL
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,22 @@
|
||||||
#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
|
#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) {}
|
INLINE void flush_icache(CELL start, CELL len) {}
|
||||||
|
|
||||||
F_FASTCALL void c_to_factor(CELL quot);
|
F_FASTCALL void c_to_factor(CELL quot);
|
||||||
|
|
|
@ -134,7 +134,9 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
|
||||||
if(p.fep)
|
if(p.fep)
|
||||||
factorbug();
|
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();
|
unnest_stacks();
|
||||||
|
|
||||||
for(i = 0; i < argc; i++)
|
for(i = 0; i < argc; i++)
|
||||||
|
|
|
@ -239,20 +239,3 @@ typedef struct {
|
||||||
/* tagged */
|
/* tagged */
|
||||||
CELL length;
|
CELL length;
|
||||||
} F_CALLSTACK;
|
} 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;
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
.text
|
.text
|
||||||
|
|
||||||
.globl run_toplevel
|
.globl c_to_factor_toplevel
|
||||||
|
|
||||||
.word exception_handler
|
.word exception_handler
|
||||||
.word 0
|
.word 0
|
||||||
|
|
|
@ -37,14 +37,7 @@ char *getenv(char *name)
|
||||||
return 0; /* unreachable */
|
return 0; /* unreachable */
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
|
long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
|
||||||
{
|
{
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
void c_to_factor_toplevel(CELL quot)
|
|
||||||
{
|
|
||||||
c_to_factor(quot);
|
|
||||||
}
|
|
||||||
|
|
Loading…
Reference in New Issue