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-22 00:32:34 -05:00
parent 545e58873e 7b45efc69d
commit 80dfa4b950
44 changed files with 333 additions and 285 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -9,3 +9,4 @@ Factor/factor
*.lib
*.image
*.dylib
factor

0
Factor.app/Contents/MacOS/.dummy Normal file
View File

64
Makefile
View File

@ -44,21 +44,20 @@ EXE_OBJS = $(PLAF_EXE_OBJS)
default:
@echo "Run 'make' with one of the following parameters:"
@echo ""
@echo "freebsd-x86"
@echo "freebsd-amd64"
@echo "linux-x86"
@echo "linux-amd64"
@echo "freebsd-x86-32"
@echo "freebsd-x86-64"
@echo "linux-x86-32"
@echo "linux-x86-64"
@echo "linux-ppc"
@echo "linux-arm"
@echo "openbsd-x86"
@echo "openbsd-amd64"
@echo "macosx-x86"
@echo "openbsd-x86-32"
@echo "openbsd-x86-64"
@echo "macosx-x86-32"
@echo "macosx-ppc"
@echo "solaris-x86"
@echo "solaris-amd64"
@echo "solaris-x86-32"
@echo "solaris-x86-64"
@echo "windows-ce-arm"
@echo "windows-ce-x86"
@echo "windows-nt-x86"
@echo "windows-nt-x86-32"
@echo ""
@echo "Additional modifiers:"
@echo ""
@ -67,17 +66,17 @@ default:
@echo "NO_UI=1 don't link with X11 libraries (ignored on Mac OS X)"
@echo "X11=1 force link with X11 libraries instead of Cocoa (only on Mac OS X)"
openbsd-x86:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.openbsd.x86
openbsd-x86-32:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.openbsd.x86.32
openbsd-amd64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.openbsd.amd64
openbsd-x86-64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.openbsd.x86.64
freebsd-x86:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.x86
freebsd-x86-32:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.x86.32
freebsd-amd64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.amd64
freebsd-x86-64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.x86.64
macosx-freetype:
ln -sf libfreetype.6.dylib \
@ -86,14 +85,14 @@ macosx-freetype:
macosx-ppc: macosx-freetype
$(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.ppc
macosx-x86: macosx-freetype
$(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.x86
macosx-x86-32: macosx-freetype
$(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.x86.32
linux-x86:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.x86
linux-x86-32:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.x86.32
linux-amd64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.amd64
linux-x86-64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.x86.64
linux-ppc:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.ppc
@ -101,21 +100,18 @@ linux-ppc:
linux-arm:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.arm
solaris-x86:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86
solaris-x86-32:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.32
solaris-amd64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.amd64
solaris-x86-64:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
windows-nt-x86:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86
windows-nt-x86-32:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
windows-ce-arm:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm
windows-ce-x86:
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.x86
macosx.app: factor
mkdir -p $(BUNDLE)/Contents/MacOS
cp $(EXECUTABLE) $(BUNDLE)/Contents/MacOS/factor

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

@ -1,106 +1,17 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.x86.assembler layouts vocabs ;
IN: bootstrap.x86.32
cpu.x86.assembler layouts vocabs parser ;
IN: bootstrap.x86
4 \ cell set
big-endian off
1 jit-code-format set
: arg0 EAX ;
: arg1 EDX ;
: stack-reg ESP ;
: ds-reg ESI ;
: scan-reg EBX ;
: xt-reg ECX ;
: scan-save ESP 12 [+] ;
: fixnum>slot@ arg0 1 SAR ;
[
EAX EAX quot-array@ [+] MOV ! load array
scan-reg EAX 1 [+] LEA ! initialize scan pointer
] { } make jit-setup set
[
xt-reg PUSH ! save XT
xt-reg ESP -44 [+] LEA ! compute forward chain pointer
xt-reg PUSH ! save forward chain pointer
EAX PUSH ! save array
ESP 16 SUB ! reserve space for scan-save
] { } make jit-prolog set
: advance-scan scan-reg 4 ADD ;
[
advance-scan
ds-reg 4 ADD ! increment datastack pointer
EAX scan-reg [] MOV ! load literal
ds-reg [] EAX MOV ! store literal on datastack
] { } make jit-push-literal set
[
advance-scan
ds-reg 4 ADD ! increment datastack pointer
EAX scan-reg [] MOV ! load wrapper
EAX dup wrapper@ [+] MOV ! load wrapper-obj slot
ds-reg [] EAX MOV ! store literal on datastack
] { } make jit-push-wrapper set
[
EDX ESP MOV ! pass callstack pointer as arg 2
] { } make jit-word-primitive-jump set
[
EDX ESP -4 [+] LEA ! pass callstack pointer as arg 2
] { } make jit-word-primitive-call set
[
EAX scan-reg 4 [+] MOV ! load word
EAX word-xt@ [+] JMP ! jump to word XT
] { } make jit-word-jump set
[
advance-scan
scan-save scan-reg MOV ! save scan pointer
EAX scan-reg [] MOV ! load word
EAX word-xt@ [+] CALL ! call word XT
scan-reg scan-save MOV ! restore scan pointer
] { } make jit-word-call set
: load-branch
EAX ds-reg [] MOV ! load boolean
ds-reg 4 SUB ! pop boolean
EAX \ f tag-number CMP ! compare it with f
EAX scan-reg 8 [+] CMOVE ! load false branch if equal
EAX scan-reg 4 [+] CMOVNE ! load true branch if not equal
scan-reg 12 ADD ! advance scan pointer
xt-reg EAX quot-xt@ [+] MOV ! load quotation-xt
;
[
load-branch
xt-reg JMP
] { } make jit-if-jump set
[
load-branch
ESP [] scan-reg MOV ! save scan pointer
xt-reg CALL ! call quotation
scan-reg ESP [] MOV ! restore scan pointer
] { } make jit-if-call set
[
EAX ds-reg [] MOV ! load index
EAX 1 SAR ! turn it into an array offset
ds-reg 4 SUB ! pop index
EAX scan-reg 4 [+] ADD ! compute quotation location
EAX EAX array-start [+] MOV ! load quotation
xt-reg EAX quot-xt@ [+] MOV ! load quotation-xt
xt-reg JMP ! execute quotation
] { } make jit-dispatch set
[
ESP 28 ADD ! unwind stack frame
] { } make jit-epilog set
[ 0 RET ] { } make jit-return set
"bootstrap.x86.32" forget-vocab
"resource:core/cpu/x86/bootstrap.factor" run-file

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

@ -14,10 +14,10 @@ M: amd64-backend ds-reg R14 ;
M: amd64-backend rs-reg R15 ;
M: amd64-backend stack-reg RSP ;
M: temp-reg v>operand drop R11 ;
M: temp-reg v>operand drop R13 ;
M: int-regs return-reg drop RAX ;
M: int-regs vregs drop { RAX RCX RDX RSI RDI RBP R8 R9 R10 } ;
M: int-regs vregs drop { RAX RBX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 } ;
M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
M: float-regs return-reg drop XMM0 ;

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

@ -1,4 +1,17 @@
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.x86.assembler layouts vocabs parser ;
IN: bootstrap.x86
8 \ cell set
big-endian off
: arg0 RDI ;
: arg1 RSI ;
: stack-reg RSP ;
: ds-reg R14 ;
: scan-reg RBX ;
: xt-reg RCX ;
: fixnum>slot@ ;
"resource:core/cpu/x86/bootstrap.factor" run-file

102
core/cpu/x86/bootstrap.factor Normal file
View File

@ -0,0 +1,102 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.x86.assembler layouts vocabs math ;
IN: bootstrap.x86
big-endian off
1 jit-code-format set
: scan-save stack-reg 3 bootstrap-cells [+] ;
[
arg0 arg0 quot-array@ [+] MOV ! load array
scan-reg arg0 scan@ [+] LEA ! initialize scan pointer
] { } make jit-setup set
[
xt-reg PUSH ! save XT
xt-reg stack-reg -44 [+] 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
] { } make jit-prolog set
: advance-scan scan-reg bootstrap-cell ADD ;
[
advance-scan
ds-reg bootstrap-cell ADD ! increment datastack pointer
arg0 scan-reg [] MOV ! load literal
ds-reg [] arg0 MOV ! store literal on datastack
] { } make jit-push-literal set
[
advance-scan
ds-reg bootstrap-cell ADD ! increment datastack pointer
arg0 scan-reg [] MOV ! load wrapper
arg0 dup wrapper@ [+] MOV ! load wrapper-obj slot
ds-reg [] arg0 MOV ! store literal on datastack
] { } make jit-push-wrapper set
[
arg1 stack-reg MOV ! pass callstack pointer as arg 2
] { } make jit-word-primitive-jump set
[
arg1 stack-reg bootstrap-cell neg [+] LEA ! pass callstack pointer as arg 2
] { } make jit-word-primitive-call set
[
arg0 scan-reg bootstrap-cell [+] MOV ! load word
arg0 word-xt@ [+] JMP ! jump to word XT
] { } make jit-word-jump set
[
advance-scan
scan-save scan-reg MOV ! save scan pointer
arg0 scan-reg [] MOV ! load word
arg0 word-xt@ [+] CALL ! call word XT
scan-reg scan-save MOV ! restore scan pointer
] { } make jit-word-call set
: load-branch
arg0 ds-reg [] MOV ! load boolean
ds-reg bootstrap-cell SUB ! pop boolean
arg0 \ f tag-number CMP ! compare it with f
arg0 scan-reg 2 bootstrap-cells [+] CMOVE ! load false branch if equal
arg0 scan-reg 1 bootstrap-cells [+] CMOVNE ! load true branch if not equal
scan-reg 3 bootstrap-cells ADD ! advance scan pointer
xt-reg arg0 quot-xt@ [+] MOV ! load quotation-xt
;
[
load-branch
xt-reg JMP
] { } make jit-if-jump set
[
load-branch
stack-reg [] scan-reg MOV ! save scan pointer
xt-reg CALL ! call quotation
scan-reg stack-reg [] MOV ! restore scan pointer
] { } make jit-if-call set
[
arg0 ds-reg [] MOV ! load index
fixnum>slot@ ! turn it into an array offset
ds-reg bootstrap-cell SUB ! pop index
arg0 scan-reg bootstrap-cell [+] ADD ! compute quotation location
arg0 arg0 array-start [+] MOV ! load quotation
xt-reg arg0 quot-xt@ [+] MOV ! load quotation-xt
xt-reg JMP ! execute quotation
] { } make jit-dispatch set
[
stack-reg 7 bootstrap-cells ADD ! unwind stack frame
] { } make jit-epilog set
[ 0 RET ] { } make jit-return set
"bootstrap.x86" forget-vocab

18
extra/http/server/responders/responders.factor
View File

@ -126,13 +126,7 @@ SYMBOL: max-post-request
#! Add a responder object to the list.
"responder" over at responders get set-at ;
: add-simple-responder ( name quot -- )
[
[ drop ] swap append dup "get" set "post" set
"responder" set
] H{ } make-assoc add-responder ;
: make-responder ( quot -- responder )
: make-responder ( quot -- )
#! quot has stack effect ( url -- )
[
[
@ -151,6 +145,12 @@ SYMBOL: max-post-request
call
] H{ } make-assoc add-responder ;
: add-simple-responder ( name quot -- )
[
[ drop ] swap append dup "get" set "post" set
"responder" set
] make-responder ;
: vhost ( name -- vhost )
vhosts get at [ "default" vhost ] unless* ;
@ -175,7 +175,7 @@ SYMBOL: max-post-request
"/" ?head drop ;
: serve-explicit-responder ( method url -- )
"/" split1
"/" split1
"/responder/" pick "/" 3append "responder-url" set
dup [
swap responder call-responder
@ -200,7 +200,7 @@ SYMBOL: max-post-request
"404 No such responder" httpd-error ;
! create a responders hash if it doesn't already exist
global [
global [
responders [ H{ } assoc-like ] change
! 404 error message pages are served by this guy

2
vm/Config.amd64
View File

@ -1,2 +0,0 @@
BOOT_ARCH = amd64
PLAF_DLL_OBJS += vm/cpu-amd64.o

1
vm/Config.arm
View File

@ -1,2 +1 @@
BOOT_ARCH = arm
PLAF_DLL_OBJS += vm/cpu-arm.o

2
vm/Config.freebsd.amd64 → vm/Config.freebsd.x86.32
View File

@ -1,2 +1,2 @@
include vm/Config.freebsd
include vm/Config.amd64
include vm/Config.x86.32

2
vm/Config.freebsd.x86 → vm/Config.freebsd.x86.64
View File

@ -1,2 +1,2 @@
include vm/Config.freebsd
include vm/Config.x86
include vm/Config.x86.64

2
vm/Config.linux.x86
View File

@ -1,2 +0,0 @@
include vm/Config.linux
include vm/Config.x86

2
vm/Config.linux.x86.32 Normal file
View File

@ -0,0 +1,2 @@
include vm/Config.linux
include vm/Config.x86.32

2
vm/Config.linux.amd64 → vm/Config.linux.x86.64
View File

@ -1,3 +1,3 @@
include vm/Config.linux
include vm/Config.amd64
include vm/Config.x86.64
LIBPATH = -L/usr/X11R6/lib64 -L/usr/X11R6/lib

2
vm/Config.macosx.x86 → vm/Config.macosx.x86.32
View File

@ -1,2 +1,2 @@
include vm/Config.macosx
include vm/Config.x86
include vm/Config.x86.32

2
vm/Config.openbsd.amd64 → vm/Config.openbsd.x86.32
View File

@ -1,2 +1,2 @@
include vm/Config.openbsd
include vm/Config.amd64
include vm/Config.x86.32

2
vm/Config.openbsd.x86 → vm/Config.openbsd.x86.64
View File

@ -1,2 +1,2 @@
include vm/Config.openbsd
include vm/Config.x86
include vm/Config.x86.64

1
vm/Config.ppc
View File

@ -1,2 +1 @@
BOOT_ARCH = ppc
PLAF_DLL_OBJS += vm/cpu-ppc.o

2
vm/Config.solaris.amd64 → vm/Config.solaris.x86.32
View File

@ -1,2 +1,2 @@
include vm/Config.solaris
include vm/Config.amd64
include vm/Config.x86.32

2
vm/Config.solaris.x86 → vm/Config.solaris.x86.64
View File

@ -1,2 +1,2 @@
include vm/Config.solaris
include vm/Config.x86
include vm/Config.x86.64

2
vm/Config.windows.ce.x86
View File

@ -1,2 +0,0 @@
#CC = x86-wince-mingw32ce-gcc
include vm/Config.windows.ce vm/Config.x86

2
vm/Config.windows.nt.x86 → vm/Config.windows.nt.x86.32
View File

@ -4,4 +4,4 @@ DLL_SUFFIX=-nt
PLAF_DLL_OBJS += vm/os-windows-nt.o
PLAF_EXE_OBJS += vm/resources.o
PLAF_EXE_OBJS += vm/main-windows-nt.o
include vm/Config.x86 vm/Config.windows
include vm/Config.x86.32 vm/Config.windows

2
vm/Config.x86 → vm/Config.x86.32
View File

@ -1,5 +1,5 @@
BOOT_ARCH = x86
PLAF_DLL_OBJS += vm/cpu-x86.o
PLAF_DLL_OBJS += vm/cpu-x86.32.o
# gcc bug workaround
CFLAGS += -fno-builtin-strlen -fno-builtin-strcat -mtune=pentium4

1
vm/Config.x86.64 Normal file
View File

@ -0,0 +1 @@
PLAF_DLL_OBJS += vm/cpu-x86.64.o

8
vm/cpu-amd64.S
View File

@ -1,8 +0,0 @@
#include "asm.h"
/* Callable from C as
void *native_stack_pointer(void) */
.globl MANGLE(native_stack_pointer)
MANGLE(native_stack_pointer):
mov %rsp,%rax
ret

20
vm/cpu-amd64.h
View File

@ -1,20 +0,0 @@
#define FACTOR_CPU_STRING "x86.64"
register CELL ds asm("r14");
register CELL rs asm("r15");
void **primitives;
INLINE void flush_icache(CELL start, CELL len) {}
void *native_stack_pointer(void);
typedef CELL F_COMPILED_FRAME;
#define PREVIOUS_FRAME(frame) (frame + 1)
#define RETURN_ADDRESS(frame) (*(frame))
INLINE void execute(CELL word)
{
F_WORD *untagged = untag_object(word);
untagged->xt(word);
}

45
vm/cpu-x86.32.S Normal file
View File

@ -0,0 +1,45 @@
#include "asm.h"
/* Note that primitive word definitions are compiled with
__attribute__((regparm 2), so the pointer to the word object is passed in EAX,
and the callstack top is passed in EDX */
#define ARG0 %eax
#define ARG1 %edx
#define XT_REG %ecx
#define STACK_REG %esp
#define DS_REG %esi
#define CELL_SIZE 4
#define PUSH_NONVOLATILE \
push %ebx ; \
push %ebp
#define POP_NONVOLATILE \
pop %ebp ; \
pop %ebx
#define QUOT_XT_OFFSET 5
#define PROFILING_OFFSET 25
#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
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)):
mov 4(%esp),%ebp /* to */
mov 8(%esp),%edx /* from */
mov 12(%esp),%ecx /* length */
mov 16(%esp),%eax /* memcpy */
sub %ecx,%ebp /* compute new stack pointer */
mov %ebp,%esp
push %ecx /* pass length */
push %edx /* pass src */
push %ebp /* pass dst */
call *%eax /* call memcpy */
add $12,%esp /* pop args from the stack */
ret /* return _with new stack_ */
#include "cpu-x86.S"

6
vm/cpu-x86.32.h Normal file
View File

@ -0,0 +1,6 @@
#define FACTOR_CPU_STRING "x86.32"
register CELL ds asm("esi");
register CELL rs asm("edi");
#define FASTCALL __attribute__ ((regparm (2)))

37
vm/cpu-x86.64.S Normal file
View File

@ -0,0 +1,37 @@
#include "asm.h"
#define ARG0 %rdi
#define ARG1 %rsi
#define XT_REG %rcx
#define STACK_REG %rsp
#define DS_REG %r14
#define CELL_SIZE 8
#define PUSH_NONVOLATILE \
push %rbx ; \
push %rbp ; \
push %r12 ; \
push %r13 ;
#define POP_NONVOLATILE \
pop %r13 ; \
pop %r12 ; \
pop %rbp ; \
pop %rbx
#define QUOT_XT_OFFSET 13
#define PROFILING_OFFSET 53
#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
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)):
sub %rdx,%rdi /* compute new stack pointer */
mov %rdi,%rsp
call *%rcx /* call memcpy */
ret /* return _with new stack_ */
#include "cpu-x86.S"

6
vm/cpu-x86.64.h Normal file
View File

@ -0,0 +1,6 @@
#define FACTOR_CPU_STRING "x86.64"
register CELL ds asm("r14");
register CELL rs asm("r15");
#define FASTCALL

92
vm/cpu-x86.S
View File

@ -1,83 +1,53 @@
#include "asm.h"
/* Note that primitive word definitions are compiled with
__attribute__((regparm 2), so the pointer to the word object is passed in EAX,
and the callstack top is passed in EDX */
/* When calling a quotation, we pass the XT in ECX */
#define JUMP_QUOT \
mov 5(%eax),%ecx ; /* Load quot-xt */ \
jmp *%ecx /* Jump to quot-xt */
mov QUOT_XT_OFFSET(ARG0),XT_REG ; /* Load quot-xt */ \
jmp *XT_REG /* Jump to quot-xt */
DEF(void,c_to_factor,(CELL quot)):
push %ebp /* Save non-volatile registers */
push %ebx
DEF(FASTCALL void,c_to_factor,(CELL quot)):
PUSH_NONVOLATILE
push ARG0 /* Save quot */
lea -8(%esp),%eax /* Save stack pointer */
push %eax /* This 16-byte aligns the stack */
lea -CELL_SIZE(STACK_REG),ARG0 /* Save stack pointer */
call MANGLE(save_callstack_bottom)
mov 16(%esp),%eax /* Pass quot as arg 1 */
mov 5(%eax),%ecx /* Pass quot-xt */
call *%ecx /* Call quot-xt */
mov (STACK_REG),ARG0 /* Pass quot as arg 1 */
mov QUOT_XT_OFFSET(ARG0),XT_REG
call *XT_REG /* Call quot-xt */
pop %eax /* Clobber */
pop %ebx /* Restore non-volatile registers */
pop %ebp
POP ARG0
POP_NONVOLATILE
ret
DEF(void,undefined,(CELL word)):
mov %esp,%ecx /* Save stack pointer before we mess with it */
sub $12,%esp /* Alignment */
mov %eax,4(%esp) /* Pass word as arg 1 (not fastcall) */
mov %ecx,8(%esp) /* Pass callstack pointer as arg 2 (not fastcall) */
jmp MANGLE(undefined_error) /* This throws an error */
DEF(FASTCALL void,undefined,(CELL word)):
mov STACK_REG,ARG1 /* Pass callstack pointer */
jmp MANGLE(undefined_error) /* This throws an error */
DEF(void,dosym,(CELL word)):
add $4,%esi /* Increment stack pointer */
mov %eax,(%esi) /* Store word on stack */
DEF(FASTCALL void,dosym,(CELL word)):
add $CELL_SIZE,DS_REG /* Increment stack pointer */
mov ARG0,(DS_REG) /* Store word on stack */
ret
/* Here we have two entry points. The first one is taken when profiling is
enabled */
DEF(void,docol_profiling,(CELL word)):
add $8,25(%eax) /* Increment profile-count slot */
DEF(void,docol,(CELL word)):
mov 13(%eax),%eax /* Load word-def slot */
DEF(FASTCALL void,docol_profiling,(CELL word)):
add $CELL_SIZE,PROFILING_OFFSET(%eax) /* Increment profile-count slot */
DEF(FASTCALL void,docol,(CELL word)):
mov WORD_DEF_OFFSET(ARG0),ARG0 /* Load word-def slot */
JUMP_QUOT
/* We must pass the XT to the quotation in ECX. */
DEF(void,primitive_call,(void)):
mov (%esi),%eax /* Load quotation from data stack */
sub $4,%esi /* Pop data stack */
DEF(FASTCALL void,primitive_call,(void)):
mov (DS_REG),ARG0 /* Load quotation from data stack */
sub $CELL_SIZE,DS_REG /* Pop data stack */
JUMP_QUOT
/* We pass the word in EAX and the XT in ECX. Don't mess up EDX, it's the
callstack top parameter to primitives. */
DEF(void,primitive_execute,(void)):
mov (%esi),%eax /* Load word from data stack */
sub $4,%esi /* Pop data stack */
mov 29(%eax),%ecx /* Load word-xt slot */
jmp *%ecx /* Go */
DEF(FASTCALL void,primitive_execute,(void)):
mov (DS_REG),ARG0 /* Load word from data stack */
sub $CELL_SIZE,DS_REG /* Pop data stack */
mov WORD_XT_OFFSET(ARG0),XT_REG /* Load word-xt slot */
jmp *XT_REG /* Go */
/* We pass a function pointer to memcpy in 16(%esp) 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)):
mov 4(%esp),%ebp /* to */
mov 8(%esp),%edx /* from */
mov 12(%esp),%ecx /* length */
mov 16(%esp),%eax /* memcpy */
sub %ecx,%ebp /* compute new stack pointer */
mov %ebp,%esp
push %ecx /* pass length */
push %edx /* pass src */
push %ebp /* pass dst */
call *%eax /* call memcpy */
add $12,%esp /* pop args from the stack */
ret /* return _with new stack_ */
DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
mov 4(%esp),%eax /* quot */
mov 8(%esp),%esp /* rewind_to */
DEF(FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
mov ARG1,STACK_REG /* rewind_to */
JUMP_QUOT

22
vm/cpu-x86.h
View File

@ -1,10 +1,3 @@
#define FACTOR_CPU_STRING "x86.32"
register CELL ds asm("esi");
register CELL rs asm("edi");
#define FASTCALL __attribute__ ((regparm (2)))
typedef struct _F_STACK_FRAME
{
/* In compiled quotation frames, position within the array.
@ -29,14 +22,11 @@ typedef struct _F_STACK_FRAME
INLINE void flush_icache(CELL start, CELL len) {}
void c_to_factor(CELL quot);
FASTCALL void c_to_factor(CELL quot);
FASTCALL void throw_impl(CELL quot, F_STACK_FRAME *rewind_to);
FASTCALL void undefined(CELL word);
FASTCALL void dosym(CELL word);
FASTCALL void docol_profiling(CELL word);
FASTCALL void docol(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_to);
/* Defined in cpu-x86.S and only called from Factor-compiled code. They all
use funny calling convention. */
void undefined(CELL word);
void dosym(CELL word);
void docol_profiling(CELL word);
void docol(CELL word);

2
vm/layouts.h
View File

@ -88,7 +88,7 @@ INLINE void *untag_object(CELL tagged)
return (void *)UNTAG(tagged);
}
typedef void (*XT)(CELL arg);
typedef void *XT;
/* Assembly code makes assumptions about the layout of this struct */
typedef struct {

1
vm/os-freebsd-x86.32.h Normal file
View File

@ -0,0 +1 @@
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_eip)

0
vm/os-macosx-x86.h → vm/os-macosx-x86.32.h
View File

10
vm/os-macosx.m
View File

@ -4,11 +4,11 @@
void c_to_factor_toplevel(CELL quot)
{
/* for(;;)
for(;;)
{
NS_DURING */
NS_DURING
c_to_factor(quot);
/* NS_VOIDRETURN;
NS_VOIDRETURN;
NS_HANDLER
dpush(allot_alien(F,(CELL)localException));
quot = userenv[COCOA_EXCEPTION_ENV];
@ -16,11 +16,11 @@ NS_HANDLER
{
/* No Cocoa exception handler was registered, so
extra/cocoa/ is not loaded. So we pass the exception
along. *
along. */
[localException raise];
}
NS_ENDHANDLER
} */
}
}
void early_init(void)

0
vm/os-openbsd-x86.h → vm/os-openbsd-x86.32.h
View File

0
vm/os-openbsd-amd64.h → vm/os-openbsd-x86.64.h
View File

20
vm/platform.h
View File

@ -13,10 +13,8 @@
#if defined(WINDOWS)
#if defined(WINCE)
#include "os-windows-ce.h"
#elif defined (__i386)
#include "os-windows-nt.h"
#else
#error "Unsupported Windows flavor"
#include "os-windows-nt.h"
#endif
#include "os-windows.h"
@ -29,7 +27,7 @@
#include "mach_signal.h"
#ifdef FACTOR_X86
#include "os-macosx-x86.h"
#include "os-macosx-x86.32.h"
#elif defined(FACTOR_PPC)
#include "os-macosx-ppc.h"
#else
@ -44,7 +42,7 @@
#include "os-unix-ucontext.h"
#if defined(FACTOR_X86)
#include "os-freebsd-x86.h"
#include "os-freebsd-x86.32.h"
#else
#error "Unsupported FreeBSD flavor"
#endif
@ -53,9 +51,9 @@
#include "os-openbsd.h"
#if defined(FACTOR_X86)
#include "os-openbsd-x86.h"
#include "os-openbsd-x86.32.h"
#elif defined(FACTOR_AMD64)
#include "os-openbsd-amd64.h"
#include "os-openbsd-x86.64.h"
#else
#error "Unsupported OpenBSD flavor"
#endif
@ -65,6 +63,7 @@
#if defined(FACTOR_X86)
#include "os-unix-ucontext.h"
#include "os-linux-x86-32.h"
#elif defined(FACTOR_PPC)
#include "os-unix-ucontext.h"
#include "os-linux-ppc.h"
@ -72,6 +71,7 @@
#include "os-linux-arm.h"
#elif defined(FACTOR_AMD64)
#include "os-unix-ucontext.h"
#include "os-linux-x86-64.h"
#else
#error "Unsupported Linux flavor"
#endif
@ -86,11 +86,13 @@
#endif
#if defined(FACTOR_X86)
#include "cpu-x86.32.h"
#include "cpu-x86.h"
#elif defined(FACTOR_AMD64)
#include "cpu-x86.64.h"
#include "cpu-x86.h"
#elif defined(FACTOR_PPC)
#include "cpu-ppc.h"
#elif defined(FACTOR_AMD64)
#include "cpu-amd64.h"
#elif defined(FACTOR_ARM)
#include "cpu-arm.h"
#else

2
vm/run.c
View File

@ -199,7 +199,7 @@ void not_implemented_error(void)
}
/* This function is called from the undefined function in cpu_*.S */
void undefined_error(CELL word, F_STACK_FRAME *callstack_top)
FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top)
{
stack_chain->callstack_top = callstack_top;
general_error(ERROR_UNDEFINED_WORD,word,F,NULL);

3
vm/run.h
View File

@ -196,7 +196,8 @@ void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack);
void signal_error(int signal, F_STACK_FRAME *native_stack);
void type_error(CELL type, CELL tagged);
void not_implemented_error(void);
void undefined_error(CELL word, F_STACK_FRAME *callstack_top);
FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top);
DECLARE_PRIMITIVE(throw);

2
vm/stack.c
View File

@ -19,7 +19,7 @@ void fix_stacks(void)
}
/* called before entry into Factor code. */
void save_callstack_bottom(F_STACK_FRAME *callstack_bottom)
FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom)
{
stack_chain->callstack_bottom = callstack_bottom;
}

2
vm/stack.h
View File

@ -48,7 +48,7 @@ CELL ds_size, rs_size;
void reset_datastack(void);
void reset_retainstack(void);
void fix_stacks(void);
void save_callstack_bottom(F_STACK_FRAME *callstack_bottom);
FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom);
DLLEXPORT void save_stacks(void);
DLLEXPORT void nest_stacks(void);
DLLEXPORT void unnest_stacks(void);