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

Fix trailing whitespace

release
U-SLAVA-FB3999113\Slava 2007-10-13 00:57:24 -04:00
parent c5f760da65
commit de7e596622
13 changed files with 1403 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/cpu/arm/architecture/architecture.factor Normal file → Executable file
View File

@ -22,7 +22,7 @@ M: temp-reg v>operand drop R12 ;
M: int-regs return-reg drop R0 ;
M: int-regs param-regs drop { R0 R1 R2 R3 } ;
M: int-regs vregs drop { R0 R1 R2 R3 } ;
M: int-regs vregs drop { R0 R1 R2 R3 R4 R7 R8 R9 R10 R11 } ;
! No FPU support yet
M: float-regs param-regs drop { } ;

116
core/cpu/arm/bootstrap.factor Normal file → Executable file
View File

@ -1,4 +1,118 @@
USING: bootstrap.image.private kernel namespaces system ;
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.arm.assembler math math.functions layouts words vocabs ;
IN: bootstrap.arm
4 \ cell set
big-endian off
4 jit-code-format set
: ds-reg R5 ;
: word-reg R0 ;
: quot-reg R0 ;
: scan-reg R2 ;
: 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 - ;
[
temp-reg quot-reg quot-array@ <+> LDR ! load array
scan-reg temp-reg scan@ ADD ! initialize scan pointer
] { } make jit-setup set
[
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
[
temp-reg scan-reg 4 <!+> LDR ! load literal and advance
temp-reg ds-reg 4 <!+> STR ! push literal
] { } make jit-push-literal set
[
temp-reg scan-reg 4 <!+> LDR ! load wrapper and advance
temp-reg dup wrapper@ <+> LDR ! load wrapped object
temp-reg ds-reg 4 <!+> STR ! push wrapped object
] { } make jit-push-wrapper set
[
R1 SP MOV ! pass stack pointer to primitive
] { } make jit-word-primitive-jump set
[
R1 SP MOV ! pass stack pointer to primitive
] { } make jit-word-primitive-call set
: load-word-xt ( -- )
word-reg scan-reg 4 <!+> LDR ! load word and advance
xt-reg word-reg word-xt@ <+> LDR ;
: jit-call
scan-reg SP scan-save <+> STR ! save scan pointer
LR PC MOV ! save return address
PC xt-reg MOV ! call
scan-reg SP scan-save <+> LDR ! restore scan pointer
;
: jit-jump
PC xt-reg MOV ;
[ load-word-xt jit-call ] { } make jit-word-call set
[ load-word-xt jit-jump ] { } make jit-word-jump set
: load-quot-xt
xt-reg quot-reg quot-xt@ <+> LDR ;
: load-branch
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 dup 4 <+> LDR ! load the branch
scan-reg dup 12 ADD ! advance scan pointer
load-quot-xt
;
[
load-branch jit-jump
] { } make jit-if-jump set
[
load-branch jit-call
] { } make jit-if-call set
[
temp-reg ds-reg 4 <-!> LDR ! pop index
temp-reg dup 1 <LSR> MOV ! turn it into an array offset
scan-reg dup 4 <+> LDR ! load array
temp-reg dup scan-reg ADD ! compute quotation location
quot-reg temp-reg array-start <+> LDR ! load quotation
load-quot-xt
jit-jump
] { } make jit-dispatch set
[
SP SP stack-frame ADD ! pop stack frame
LR SP lr-save stack-frame + <+> LDR ! load return address
] { } make jit-epilog set
[ PC LR MOV ] { } make jit-return set
"bootstrap.arm" forget-vocab

129
vm/cpu-arm.S Normal file → Executable file
View File

@ -1,8 +1,125 @@
#include "asm.h"
/* Callable from C as
void *native_stack_pointer(void) */
.globl MANGLE(native_stack_pointer)
MANGLE(native_stack_pointer):
mov r0,sp
mov pc,lr
/* 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
#define JUMP_QUOT \
ldr pc,[r0, #9] /* load quotation-xt slot */
#define SAVED_REGS_SIZE 32
#define FRAME (RESERVED_SIZE + SAVED_REGS_SIZE + 8)
#define LR_SAVE [sp, #4]
#define RESERVED_SIZE 8
#define SAVE_LR str lr,LR_SAVE
#define LOAD_LR ldr lr,LR_SAVE
#define SAVE_AT(offset) (RESERVED_SIZE + 4 * offset)
#define SAVE(register,offset) str register,[sp, #SAVE_AT(offset)]
#define RESTORE(register,offset) ldr register,[sp, #SAVE_AT(offset)]
#define PROLOGUE \
sub sp,sp,#FRAME ; \
SAVE_LR
#define EPILOGUE \
LOAD_LR ; \
sub sp,sp,#FRAME
DEF(void,c_to_factor,(CELL quot)):
PROLOGUE
SAVE(r4,0) /* save GPRs */
/* don't save ds pointer */
/* don't save rs pointer */
SAVE(r7,3)
SAVE(r8,4)
SAVE(r9,5)
SAVE(r10,6)
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 */
bl MANGLE(save_callstack_bottom)
RESTORE(r0,8) /* restore quotation */
CALL_QUOT
RESTORE(r11,7) /* restore GPRs */
RESTORE(r10,6)
RESTORE(r9,5)
RESTORE(r8,4)
RESTORE(r7,3)
/* don't restore rs pointer */
/* don't restore ds pointer */
RESTORE(r4,0)
EPILOGUE
mov lr,pc
/* The JIT compiles an 'mov sp,r1' 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,
DEFER: foo
...
: 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
b MANGLE(undefined_error)
DEF(void,dosym,(CELL word)):
str r0,[r5], #4 /* push word to stack */
mov lr,pc /* return */
/* Here we have two entry points. The first one is taken when profiling is
enabled */
DEF(void,docol_profiling,(CELL word)):
ldr r1,[r0, #25] /* load profile-count slot */
add r1,r1,#8 /* increment count */
str r1,[r0, #25] /* store profile-count slot */
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. */
DEF(void,primitive_call,(void)):
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 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 */
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 */
DEF(void,lazy_jit_compile,(CELL quot)):
mov sp,r1 /* save stack pointer */
PROLOGUE
bl MANGLE(primitive_jit_compile)
EPILOGUE
JUMP_QUOT /* call the quotation */

21
vm/cpu-arm.h Normal file → Executable file
View File

@ -2,16 +2,17 @@
register CELL ds asm("r5");
register CELL rs asm("r6");
register void **primitives asm("r7");
void *native_stack_pointer(void);
#define F_FASTCALL
typedef CELL F_COMPILED_FRAME;
void c_to_factor(CELL quot);
void dosym(CELL word);
void docol_profiling(CELL word);
void docol(CELL word);
void undefined(CELL word);
void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy);
void throw_impl(CELL quot, F_STACK_FRAME *rewind);
void lazy_jit_compile(CELL quot);
void flush_icache(CELL start, CELL len);
#define PREVIOUS_FRAME(frame) (frame + 1)
#define RETURN_ADDRESS(frame) (*(frame))
INLINE void execute(CELL word)
{
untag_object(word)->xt(word);
}
#define FRAME_RETURN_ADDRESS(frame) *((XT *)(frame_successor(frame) + 1) + 1)

6
vm/errors.h Normal file → Executable file
View File

@ -41,3 +41,9 @@ INLINE void type_check(CELL type, CELL tagged)
{
if(type_of(tagged) != type) type_error(type,tagged);
}
/* Global variables used to pass fault handler state from signal handler to
user-space */
CELL signal_number;
CELL signal_fault_addr;
void *signal_callstack_top;

6
vm/os-unix.h Normal file → Executable file
View File

@ -40,11 +40,5 @@ void sleep_millis(CELL msec);
void reset_stdio(void);
/* Global variables used to pass fault handler state from signal handler to
user-space */
CELL signal_number;
CELL signal_fault_addr;
void *signal_callstack_top;
void memory_signal_handler_impl(void);
void misc_signal_handler_impl(void);

11
vm/os-windows-ce-arm.S Normal file → Executable file
View File

@ -2,17 +2,18 @@
.globl run_toplevel
.word exception_handler
.word exception_handler
.word 0
run_toplevel:
ldr pc, _Prun
c_to_factor_toplevel:
ldr pc, _Pc_to_factor
_Prun: .word run
_Pc_to_factor:
.word c_to_factor
.section .pdata
.word run_toplevel
.word c_to_factor_toplevel
.word 0xc0000002 | (0xFFFFF << 8)

16
vm/os-windows-ce.c Normal file → Executable file
View File

@ -23,10 +23,10 @@ DEFINE_PRIMITIVE(cd)
char *strerror(int err)
{
/* strerror() is not defined on WinCE */
return "strerror() is not defined on WinCE. Use native io";
return "strerror() is not defined on WinCE. Use native I/O.";
}
void flush_icache()
void flush_icache(CELL start, CELL end)
{
FlushInstructionCache(GetCurrentProcess(), 0, 0);
}
@ -37,10 +37,14 @@ char *getenv(char *name)
return 0; /* unreachable */
}
long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
{
memory_protection_error(
rec->ExceptionInformation[1] & 0x1ffffff,
native_stack_pointer());
return -1; /* unreachable */
return 0;
}
void c_to_factor_toplevel(CELL quot)
{
c_to_factor(quot);
}

6
vm/os-windows-ce.h Normal file → Executable file
View File

@ -2,6 +2,7 @@
#define UNICODE
#endif
#include <windows.h>
#include <ctype.h>
typedef wchar_t F_SYMBOL;
@ -23,7 +24,4 @@ char *getenv(char *name);
#define EINTR 0
s64 current_millis(void);
DECLARE_PRIMITIVE(cwd);
DECLARE_PRIMITIVE(cd);
void c_to_factor_toplevel(CELL quot);

8
vm/os-windows-nt.h Normal file → Executable file
View File

@ -5,6 +5,8 @@
#define UNICODE
#endif
#include <windows.h>
typedef char F_SYMBOL;
#define unbox_symbol_string unbox_char_string
@ -16,10 +18,8 @@ typedef char F_SYMBOL;
void c_to_factor_toplevel(CELL quot);
CELL signal_number;
CELL signal_fault_addr;
void *signal_callstack_top;
void memory_signal_handler_impl(void);
void divide_by_zero_signal_handler_impl(void);
void misc_signal_handler_impl(void);
long exception_handler(PEXCEPTION_POINTERS pe);

12
vm/os-windows.c Normal file → Executable file
View File

@ -1,6 +1,6 @@
#include "master.h"
F_STRING *get_error_message()
F_STRING *get_error_message(void)
{
DWORD id = GetLastError();
F_CHAR *msg = error_message(id);
@ -36,7 +36,7 @@ F_CHAR *error_message(DWORD id)
HMODULE hFactorDll;
void init_ffi()
void init_ffi(void)
{
hFactorDll = GetModuleHandle(FACTOR_DLL);
if(!hFactorDll)
@ -120,8 +120,12 @@ DEFINE_PRIMITIVE(stat)
dpush(tag_fixnum(0));
box_unsigned_8(
(u64)st.nFileSizeLow | (u64)st.nFileSizeHigh << 32);
box_unsigned_8(
((*(u64*)&st.ftLastWriteTime - EPOCH_OFFSET) / 10000000));
u64 lo = st.ftLastWriteTime.dwLowDateTime;
u64 hi = st.ftLastWriteTime.dwHighDateTime;
u64 modTime = (hi << 32) + lo;
box_unsigned_8((modTime - EPOCH_OFFSET) / 10000000);
FindClose(h);
}
}

3
vm/os-windows.h Normal file → Executable file
View File

@ -1,4 +1,3 @@
#include <windows.h>
#include <ctype.h>
#ifndef wcslen
@ -49,5 +48,3 @@ s64 current_millis(void);
INLINE void reset_stdio(void) {}
long exception_handler(PEXCEPTION_POINTERS pe);

1117
vm/run.s Normal file
View File

File diff suppressed because it is too large Load Diff