New calling convention for VM primitives:
instead of the Factor side passing the stack pointer as the first parameter, and having the VM save it to stack_chain->top, we instead have the Factor side save it. Eliminates a lot of crud in the VMdb4
							parent
							
								
									3723b2e640
								
							
						
					
					
						commit
						cfa82cb474
					
				| 
						 | 
					@ -134,6 +134,7 @@ SYMBOL: jit-epilog
 | 
				
			||||||
SYMBOL: jit-return
 | 
					SYMBOL: jit-return
 | 
				
			||||||
SYMBOL: jit-profiling
 | 
					SYMBOL: jit-profiling
 | 
				
			||||||
SYMBOL: jit-declare-word
 | 
					SYMBOL: jit-declare-word
 | 
				
			||||||
 | 
					SYMBOL: jit-save-stack
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! Default definition for undefined words
 | 
					! Default definition for undefined words
 | 
				
			||||||
SYMBOL: undefined-quot
 | 
					SYMBOL: undefined-quot
 | 
				
			||||||
| 
						 | 
					@ -158,6 +159,7 @@ SYMBOL: undefined-quot
 | 
				
			||||||
        { jit-profiling 35 }
 | 
					        { jit-profiling 35 }
 | 
				
			||||||
        { jit-push-immediate 36 }
 | 
					        { jit-push-immediate 36 }
 | 
				
			||||||
        { jit-declare-word 42 }
 | 
					        { jit-declare-word 42 }
 | 
				
			||||||
 | 
					        { jit-save-stack 43 }
 | 
				
			||||||
        { undefined-quot 60 }
 | 
					        { undefined-quot 60 }
 | 
				
			||||||
    } at header-size + ;
 | 
					    } at header-size + ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -459,6 +461,7 @@ M: quotation '
 | 
				
			||||||
        jit-return
 | 
					        jit-return
 | 
				
			||||||
        jit-profiling
 | 
					        jit-profiling
 | 
				
			||||||
        jit-declare-word
 | 
					        jit-declare-word
 | 
				
			||||||
 | 
					        jit-save-stack
 | 
				
			||||||
        undefined-quot
 | 
					        undefined-quot
 | 
				
			||||||
    } [ emit-userenv ] each ;
 | 
					    } [ emit-userenv ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -57,7 +57,12 @@ big-endian on
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[
 | 
					[
 | 
				
			||||||
    0 6 LOAD32
 | 
					    0 6 LOAD32
 | 
				
			||||||
    4 1 MR
 | 
					    7 6 0 LWZ
 | 
				
			||||||
 | 
					    1 7 0 STW
 | 
				
			||||||
 | 
					] rc-absolute-ppc-2/2 rt-primitive 1 jit-save-stack jit-define
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[
 | 
				
			||||||
 | 
					    0 6 LOAD32
 | 
				
			||||||
    6 MTCTR
 | 
					    6 MTCTR
 | 
				
			||||||
    BCTR
 | 
					    BCTR
 | 
				
			||||||
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
 | 
					] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
! Copyright (C) 2007 Slava Pestov.
 | 
					! Copyright (C) 2007 Slava Pestov.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: bootstrap.image.private kernel namespaces system
 | 
					USING: bootstrap.image.private kernel namespaces system
 | 
				
			||||||
cpu.x86.assembler layouts vocabs parser ;
 | 
					cpu.x86.assembler layouts vocabs parser compiler.constants ;
 | 
				
			||||||
IN: bootstrap.x86
 | 
					IN: bootstrap.x86
 | 
				
			||||||
 | 
					
 | 
				
			||||||
4 \ cell set
 | 
					4 \ cell set
 | 
				
			||||||
| 
						 | 
					@ -19,5 +19,14 @@ IN: bootstrap.x86
 | 
				
			||||||
: fixnum>slot@ ( -- ) arg0 1 SAR ;
 | 
					: fixnum>slot@ ( -- ) arg0 1 SAR ;
 | 
				
			||||||
: rex-length ( -- n ) 0 ;
 | 
					: rex-length ( -- n ) 0 ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[
 | 
				
			||||||
 | 
					    arg0 0 [] MOV                              ! load stack_chain
 | 
				
			||||||
 | 
					    arg0 [] stack-reg MOV                      ! save stack pointer
 | 
				
			||||||
 | 
					] rc-absolute-cell rt-stack-chain 2 jit-save-stack jit-define
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[
 | 
				
			||||||
 | 
					    (JMP) drop
 | 
				
			||||||
 | 
					] rc-relative rt-primitive 1 jit-primitive jit-define
 | 
				
			||||||
 | 
					
 | 
				
			||||||
<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>
 | 
					<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>
 | 
				
			||||||
call
 | 
					call
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
! Copyright (C) 2007 Slava Pestov.
 | 
					! Copyright (C) 2007 Slava Pestov.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: bootstrap.image.private kernel namespaces system
 | 
					USING: bootstrap.image.private kernel namespaces system
 | 
				
			||||||
cpu.x86.assembler layouts vocabs parser ;
 | 
					cpu.x86.assembler layouts vocabs parser compiler.constants math ;
 | 
				
			||||||
IN: bootstrap.x86
 | 
					IN: bootstrap.x86
 | 
				
			||||||
 | 
					
 | 
				
			||||||
8 \ cell set
 | 
					8 \ cell set
 | 
				
			||||||
| 
						 | 
					@ -16,5 +16,16 @@ IN: bootstrap.x86
 | 
				
			||||||
: fixnum>slot@ ( -- ) ;
 | 
					: fixnum>slot@ ( -- ) ;
 | 
				
			||||||
: rex-length ( -- n ) 1 ;
 | 
					: rex-length ( -- n ) 1 ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[
 | 
				
			||||||
 | 
					    arg0 0 MOV                                 ! load stack_chain
 | 
				
			||||||
 | 
					    arg0 arg0 [] MOV
 | 
				
			||||||
 | 
					    arg0 [] stack-reg MOV                      ! save stack pointer
 | 
				
			||||||
 | 
					] rc-absolute-cell rt-stack-chain 1 rex-length + jit-save-stack jit-define
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[
 | 
				
			||||||
 | 
					    arg1 0 MOV                                 ! load XT
 | 
				
			||||||
 | 
					    arg1 JMP                                   ! go
 | 
				
			||||||
 | 
					] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
 | 
				
			||||||
 | 
					
 | 
				
			||||||
<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>
 | 
					<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>
 | 
				
			||||||
call
 | 
					call
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -44,12 +44,6 @@ big-endian off
 | 
				
			||||||
    ds-reg [] arg0 MOV                         ! store literal on datastack
 | 
					    ds-reg [] arg0 MOV                         ! store literal on datastack
 | 
				
			||||||
] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
 | 
					] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[
 | 
					 | 
				
			||||||
    arg0 0 MOV                                 ! load XT
 | 
					 | 
				
			||||||
    arg1 stack-reg MOV                         ! pass callstack pointer as arg 2
 | 
					 | 
				
			||||||
    arg0 JMP                                   ! go
 | 
					 | 
				
			||||||
] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
[
 | 
					[
 | 
				
			||||||
    (JMP) drop
 | 
					    (JMP) drop
 | 
				
			||||||
] rc-relative rt-xt 1 jit-word-jump jit-define
 | 
					] rc-relative rt-xt 1 jit-word-jump jit-define
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										16
									
								
								vm/alien.c
								
								
								
								
							
							
						
						
									
										16
									
								
								vm/alien.c
								
								
								
								
							| 
						 | 
					@ -82,7 +82,7 @@ void box_alien(void *ptr)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* make an alien pointing at an offset of another alien */
 | 
					/* make an alien pointing at an offset of another alien */
 | 
				
			||||||
DEFINE_PRIMITIVE(displaced_alien)
 | 
					void primitive_displaced_alien(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL alien = dpop();
 | 
						CELL alien = dpop();
 | 
				
			||||||
	CELL displacement = to_cell(dpop());
 | 
						CELL displacement = to_cell(dpop());
 | 
				
			||||||
| 
						 | 
					@ -107,7 +107,7 @@ DEFINE_PRIMITIVE(displaced_alien)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* address of an object representing a C pointer. Explicitly throw an error
 | 
					/* address of an object representing a C pointer. Explicitly throw an error
 | 
				
			||||||
if the object is a byte array, as a sanity check. */
 | 
					if the object is a byte array, as a sanity check. */
 | 
				
			||||||
DEFINE_PRIMITIVE(alien_address)
 | 
					void primitive_alien_address(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_unsigned_cell((CELL)pinned_alien_offset(dpop()));
 | 
						box_unsigned_cell((CELL)pinned_alien_offset(dpop()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -121,11 +121,11 @@ INLINE void *alien_pointer(void)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* define words to read/write values at an alien address */
 | 
					/* define words to read/write values at an alien address */
 | 
				
			||||||
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
 | 
					#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
 | 
				
			||||||
	DEFINE_PRIMITIVE(alien_##name) \
 | 
						void primitive_alien_##name(void) \
 | 
				
			||||||
	{ \
 | 
						{ \
 | 
				
			||||||
		boxer(*(type*)alien_pointer()); \
 | 
							boxer(*(type*)alien_pointer()); \
 | 
				
			||||||
	} \
 | 
						} \
 | 
				
			||||||
	DEFINE_PRIMITIVE(set_alien_##name) \
 | 
						void primitive_set_alien_##name(void) \
 | 
				
			||||||
	{ \
 | 
						{ \
 | 
				
			||||||
		type* ptr = alien_pointer(); \
 | 
							type* ptr = alien_pointer(); \
 | 
				
			||||||
		type value = to(dpop()); \
 | 
							type value = to(dpop()); \
 | 
				
			||||||
| 
						 | 
					@ -170,7 +170,7 @@ void box_small_struct(CELL x, CELL y, CELL size)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* open a native library and push a handle */
 | 
					/* open a native library and push a handle */
 | 
				
			||||||
DEFINE_PRIMITIVE(dlopen)
 | 
					void primitive_dlopen(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL path = tag_object(string_to_native_alien(
 | 
						CELL path = tag_object(string_to_native_alien(
 | 
				
			||||||
		untag_string(dpop())));
 | 
							untag_string(dpop())));
 | 
				
			||||||
| 
						 | 
					@ -183,7 +183,7 @@ DEFINE_PRIMITIVE(dlopen)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* look up a symbol in a native library */
 | 
					/* look up a symbol in a native library */
 | 
				
			||||||
DEFINE_PRIMITIVE(dlsym)
 | 
					void primitive_dlsym(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL dll = dpop();
 | 
						CELL dll = dpop();
 | 
				
			||||||
	REGISTER_ROOT(dll);
 | 
						REGISTER_ROOT(dll);
 | 
				
			||||||
| 
						 | 
					@ -205,12 +205,12 @@ DEFINE_PRIMITIVE(dlsym)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* close a native library handle */
 | 
					/* close a native library handle */
 | 
				
			||||||
DEFINE_PRIMITIVE(dlclose)
 | 
					void primitive_dlclose(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	ffi_dlclose(untag_dll(dpop()));
 | 
						ffi_dlclose(untag_dll(dpop()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(dll_validp)
 | 
					void primitive_dll_validp(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL dll = dpop();
 | 
						CELL dll = dpop();
 | 
				
			||||||
	if(dll == F)
 | 
						if(dll == F)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										64
									
								
								vm/alien.h
								
								
								
								
							
							
						
						
									
										64
									
								
								vm/alien.h
								
								
								
								
							| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
CELL allot_alien(CELL delegate, CELL displacement);
 | 
					CELL allot_alien(CELL delegate, CELL displacement);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(displaced_alien);
 | 
					void primitive_displaced_alien(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_address);
 | 
					void primitive_alien_address(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DLLEXPORT void *alien_offset(CELL object);
 | 
					DLLEXPORT void *alien_offset(CELL object);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -10,32 +10,32 @@ void fixup_alien(F_ALIEN* d);
 | 
				
			||||||
DLLEXPORT void *unbox_alien(void);
 | 
					DLLEXPORT void *unbox_alien(void);
 | 
				
			||||||
DLLEXPORT void box_alien(void *ptr);
 | 
					DLLEXPORT void box_alien(void *ptr);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_signed_cell);
 | 
					void primitive_alien_signed_cell(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_signed_cell);
 | 
					void primitive_set_alien_signed_cell(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_unsigned_cell);
 | 
					void primitive_alien_unsigned_cell(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_unsigned_cell);
 | 
					void primitive_set_alien_unsigned_cell(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_signed_8);
 | 
					void primitive_alien_signed_8(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_signed_8);
 | 
					void primitive_set_alien_signed_8(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_unsigned_8);
 | 
					void primitive_alien_unsigned_8(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_unsigned_8);
 | 
					void primitive_set_alien_unsigned_8(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_signed_4);
 | 
					void primitive_alien_signed_4(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_signed_4);
 | 
					void primitive_set_alien_signed_4(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_unsigned_4);
 | 
					void primitive_alien_unsigned_4(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_unsigned_4);
 | 
					void primitive_set_alien_unsigned_4(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_signed_2);
 | 
					void primitive_alien_signed_2(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_signed_2);
 | 
					void primitive_set_alien_signed_2(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_unsigned_2);
 | 
					void primitive_alien_unsigned_2(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_unsigned_2);
 | 
					void primitive_set_alien_unsigned_2(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_signed_1);
 | 
					void primitive_alien_signed_1(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_signed_1);
 | 
					void primitive_set_alien_signed_1(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_unsigned_1);
 | 
					void primitive_alien_unsigned_1(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_unsigned_1);
 | 
					void primitive_set_alien_unsigned_1(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_float);
 | 
					void primitive_alien_float(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_float);
 | 
					void primitive_set_alien_float(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_double);
 | 
					void primitive_alien_double(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_double);
 | 
					void primitive_set_alien_double(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(alien_cell);
 | 
					void primitive_alien_cell(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_alien_cell);
 | 
					void primitive_set_alien_cell(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size);
 | 
					DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size);
 | 
				
			||||||
DLLEXPORT void box_value_struct(void *src, CELL size);
 | 
					DLLEXPORT void box_value_struct(void *src, CELL size);
 | 
				
			||||||
| 
						 | 
					@ -43,7 +43,7 @@ DLLEXPORT void box_small_struct(CELL x, CELL y, CELL size);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_UNTAG(F_DLL,DLL_TYPE,dll)
 | 
					DEFINE_UNTAG(F_DLL,DLL_TYPE,dll)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(dlopen);
 | 
					void primitive_dlopen(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(dlsym);
 | 
					void primitive_dlsym(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(dlclose);
 | 
					void primitive_dlclose(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(dll_validp);
 | 
					void primitive_dll_validp(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -6,11 +6,6 @@ F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom)
 | 
				
			||||||
	stack_chain->callstack_bottom = callstack_bottom;
 | 
						stack_chain->callstack_bottom = callstack_bottom;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
F_FASTCALL __attribute__((noinline)) void save_callstack_top(F_STACK_FRAME *callstack_top)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
	stack_chain->callstack_top = callstack_top;
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
void iterate_callstack(CELL top, CELL bottom, CALLSTACK_ITER iterator)
 | 
					void iterate_callstack(CELL top, CELL bottom, CALLSTACK_ITER iterator)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1;
 | 
						F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1;
 | 
				
			||||||
| 
						 | 
					@ -68,7 +63,7 @@ F_STACK_FRAME *capture_start(void)
 | 
				
			||||||
	return frame + 1;
 | 
						return frame + 1;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(callstack)
 | 
					void primitive_callstack(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STACK_FRAME *top = capture_start();
 | 
						F_STACK_FRAME *top = capture_start();
 | 
				
			||||||
	F_STACK_FRAME *bottom = stack_chain->callstack_bottom;
 | 
						F_STACK_FRAME *bottom = stack_chain->callstack_bottom;
 | 
				
			||||||
| 
						 | 
					@ -82,7 +77,7 @@ DEFINE_PRIMITIVE(callstack)
 | 
				
			||||||
	dpush(tag_object(callstack));
 | 
						dpush(tag_object(callstack));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(set_callstack)
 | 
					void primitive_set_callstack(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_CALLSTACK *stack = untag_callstack(dpop());
 | 
						F_CALLSTACK *stack = untag_callstack(dpop());
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -158,7 +153,7 @@ void stack_frame_to_array(F_STACK_FRAME *frame)
 | 
				
			||||||
	set_array_nth(array,frame_index++,frame_scan(frame));
 | 
						set_array_nth(array,frame_index++,frame_scan(frame));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(callstack_to_array)
 | 
					void primitive_callstack_to_array(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_CALLSTACK *stack = untag_callstack(dpop());
 | 
						F_CALLSTACK *stack = untag_callstack(dpop());
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -190,7 +185,7 @@ F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Some primitives implementing a limited form of callstack mutation.
 | 
					/* Some primitives implementing a limited form of callstack mutation.
 | 
				
			||||||
Used by the single stepper. */
 | 
					Used by the single stepper. */
 | 
				
			||||||
DEFINE_PRIMITIVE(innermost_stack_frame_quot)
 | 
					void primitive_innermost_stack_frame_quot(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STACK_FRAME *inner = innermost_stack_frame(
 | 
						F_STACK_FRAME *inner = innermost_stack_frame(
 | 
				
			||||||
		untag_callstack(dpop()));
 | 
							untag_callstack(dpop()));
 | 
				
			||||||
| 
						 | 
					@ -199,7 +194,7 @@ DEFINE_PRIMITIVE(innermost_stack_frame_quot)
 | 
				
			||||||
	dpush(frame_executing(inner));
 | 
						dpush(frame_executing(inner));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(innermost_stack_frame_scan)
 | 
					void primitive_innermost_stack_frame_scan(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STACK_FRAME *inner = innermost_stack_frame(
 | 
						F_STACK_FRAME *inner = innermost_stack_frame(
 | 
				
			||||||
		untag_callstack(dpop()));
 | 
							untag_callstack(dpop()));
 | 
				
			||||||
| 
						 | 
					@ -208,7 +203,7 @@ DEFINE_PRIMITIVE(innermost_stack_frame_scan)
 | 
				
			||||||
	dpush(frame_scan(inner));
 | 
						dpush(frame_scan(inner));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
 | 
					void primitive_set_innermost_stack_frame_quot(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_CALLSTACK *callstack = untag_callstack(dpop());
 | 
						F_CALLSTACK *callstack = untag_callstack(dpop());
 | 
				
			||||||
	F_QUOTATION *quot = untag_quotation(dpop());
 | 
						F_QUOTATION *quot = untag_quotation(dpop());
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,5 +1,4 @@
 | 
				
			||||||
F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom);
 | 
					F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom);
 | 
				
			||||||
F_FASTCALL __attribute__((noinline)) void save_callstack_top(F_STACK_FRAME *callstack_top);
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
#define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1)
 | 
					#define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -14,11 +13,11 @@ CELL frame_executing(F_STACK_FRAME *frame);
 | 
				
			||||||
CELL frame_scan(F_STACK_FRAME *frame);
 | 
					CELL frame_scan(F_STACK_FRAME *frame);
 | 
				
			||||||
CELL frame_type(F_STACK_FRAME *frame);
 | 
					CELL frame_type(F_STACK_FRAME *frame);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(callstack);
 | 
					void primitive_callstack(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_datastack);
 | 
					void primitive_set_datastack(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_retainstack);
 | 
					void primitive_set_retainstack(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_callstack);
 | 
					void primitive_set_callstack(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(callstack_to_array);
 | 
					void primitive_callstack_to_array(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(innermost_stack_frame_quot);
 | 
					void primitive_innermost_stack_frame_quot(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(innermost_stack_frame_scan);
 | 
					void primitive_innermost_stack_frame_scan(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_innermost_stack_frame_quot);
 | 
					void primitive_set_innermost_stack_frame_quot(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -295,7 +295,7 @@ void recursive_mark(F_BLOCK *block)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Push the free space and total size of the code heap */
 | 
					/* Push the free space and total size of the code heap */
 | 
				
			||||||
DEFINE_PRIMITIVE(code_room)
 | 
					void primitive_code_room(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL used, total_free, max_free;
 | 
						CELL used, total_free, max_free;
 | 
				
			||||||
	heap_usage(&code_heap,&used,&total_free,&max_free);
 | 
						heap_usage(&code_heap,&used,&total_free,&max_free);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -82,4 +82,4 @@ void recursive_mark(F_BLOCK *block);
 | 
				
			||||||
void dump_heap(F_HEAP *heap);
 | 
					void dump_heap(F_HEAP *heap);
 | 
				
			||||||
void compact_code_heap(void);
 | 
					void compact_code_heap(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(code_room);
 | 
					void primitive_code_room(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -68,9 +68,11 @@ INLINE CELL compute_code_rel(F_REL *rel,
 | 
				
			||||||
	case RT_XT:
 | 
						case RT_XT:
 | 
				
			||||||
		return (CELL)untag_word(get(CREF(literals_start,REL_ARGUMENT(rel))))->xt;
 | 
							return (CELL)untag_word(get(CREF(literals_start,REL_ARGUMENT(rel))))->xt;
 | 
				
			||||||
	case RT_HERE:
 | 
						case RT_HERE:
 | 
				
			||||||
		return rel->offset + code_start;
 | 
							return rel->offset + code_start + (short)REL_ARGUMENT(rel);
 | 
				
			||||||
	case RT_LABEL:
 | 
						case RT_LABEL:
 | 
				
			||||||
		return code_start + REL_ARGUMENT(rel);
 | 
							return code_start + REL_ARGUMENT(rel);
 | 
				
			||||||
 | 
						case RT_STACK_CHAIN:
 | 
				
			||||||
 | 
							return (CELL)&stack_chain;
 | 
				
			||||||
	default:
 | 
						default:
 | 
				
			||||||
		critical_error("Bad rel type",rel->type);
 | 
							critical_error("Bad rel type",rel->type);
 | 
				
			||||||
		return -1; /* Can't happen */
 | 
							return -1; /* Can't happen */
 | 
				
			||||||
| 
						 | 
					@ -322,7 +324,7 @@ void default_word_code(F_WORD *word, bool relocate)
 | 
				
			||||||
	word->compiledp = F;
 | 
						word->compiledp = F;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(modify_code_heap)
 | 
					void primitive_modify_code_heap(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	bool rescan_code_heap = to_boolean(dpop());
 | 
						bool rescan_code_heap = to_boolean(dpop());
 | 
				
			||||||
	F_ARRAY *alist = untag_array(dpop());
 | 
						F_ARRAY *alist = untag_array(dpop());
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -13,8 +13,10 @@ typedef enum {
 | 
				
			||||||
	RT_HERE,
 | 
						RT_HERE,
 | 
				
			||||||
	/* a local label */
 | 
						/* a local label */
 | 
				
			||||||
	RT_LABEL,
 | 
						RT_LABEL,
 | 
				
			||||||
	/* immeditae literal */
 | 
						/* immediate literal */
 | 
				
			||||||
	RT_IMMEDIATE
 | 
						RT_IMMEDIATE,
 | 
				
			||||||
 | 
						/* address of stack_chain var */
 | 
				
			||||||
 | 
						RT_STACK_CHAIN
 | 
				
			||||||
} F_RELTYPE;
 | 
					} F_RELTYPE;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
typedef enum {
 | 
					typedef enum {
 | 
				
			||||||
| 
						 | 
					@ -71,4 +73,4 @@ F_COMPILED *add_compiled_block(
 | 
				
			||||||
CELL compiled_code_format(void);
 | 
					CELL compiled_code_format(void);
 | 
				
			||||||
bool stack_traces_p(void);
 | 
					bool stack_traces_p(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(modify_code_heap);
 | 
					void primitive_modify_code_heap(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										18
									
								
								vm/data_gc.c
								
								
								
								
							
							
						
						
									
										18
									
								
								vm/data_gc.c
								
								
								
								
							| 
						 | 
					@ -250,13 +250,13 @@ CELL unaligned_object_size(CELL pointer)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(size)
 | 
					void primitive_size(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_unsigned_cell(object_size(dpop()));
 | 
						box_unsigned_cell(object_size(dpop()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Push memory usage statistics in data heap */
 | 
					/* Push memory usage statistics in data heap */
 | 
				
			||||||
DEFINE_PRIMITIVE(data_room)
 | 
					void primitive_data_room(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_ARRAY *a = allot_array(ARRAY_TYPE,data_heap->gen_count * 2,F);
 | 
						F_ARRAY *a = allot_array(ARRAY_TYPE,data_heap->gen_count * 2,F);
 | 
				
			||||||
	int gen;
 | 
						int gen;
 | 
				
			||||||
| 
						 | 
					@ -281,7 +281,7 @@ void begin_scan(void)
 | 
				
			||||||
	gc_off = true;
 | 
						gc_off = true;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(begin_scan)
 | 
					void primitive_begin_scan(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	gc();
 | 
						gc();
 | 
				
			||||||
	begin_scan();
 | 
						begin_scan();
 | 
				
			||||||
| 
						 | 
					@ -306,13 +306,13 @@ CELL next_object(void)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Push object at heap scan cursor and advance; pushes f when done */
 | 
					/* Push object at heap scan cursor and advance; pushes f when done */
 | 
				
			||||||
DEFINE_PRIMITIVE(next_object)
 | 
					void primitive_next_object(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	dpush(next_object());
 | 
						dpush(next_object());
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Re-enables GC */
 | 
					/* Re-enables GC */
 | 
				
			||||||
DEFINE_PRIMITIVE(end_scan)
 | 
					void primitive_end_scan(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	gc_off = false;
 | 
						gc_off = false;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -911,12 +911,12 @@ void minor_gc(void)
 | 
				
			||||||
	garbage_collection(NURSERY,false,0);
 | 
						garbage_collection(NURSERY,false,0);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(gc)
 | 
					void primitive_gc(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	gc();
 | 
						gc();
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(gc_stats)
 | 
					void primitive_gc_stats(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	GROWABLE_ARRAY(stats);
 | 
						GROWABLE_ARRAY(stats);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -945,12 +945,12 @@ DEFINE_PRIMITIVE(gc_stats)
 | 
				
			||||||
	dpush(stats);
 | 
						dpush(stats);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(gc_reset)
 | 
					void primitive_gc_reset(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	gc_reset();
 | 
						gc_reset();
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(become)
 | 
					void primitive_become(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_ARRAY *new_objects = untag_array(dpop());
 | 
						F_ARRAY *new_objects = untag_array(dpop());
 | 
				
			||||||
	F_ARRAY *old_objects = untag_array(dpop());
 | 
						F_ARRAY *old_objects = untag_array(dpop());
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										18
									
								
								vm/data_gc.h
								
								
								
								
							
							
						
						
									
										18
									
								
								vm/data_gc.h
								
								
								
								
							| 
						 | 
					@ -13,11 +13,11 @@ CELL binary_payload_start(CELL pointer);
 | 
				
			||||||
void begin_scan(void);
 | 
					void begin_scan(void);
 | 
				
			||||||
CELL next_object(void);
 | 
					CELL next_object(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(data_room);
 | 
					void primitive_data_room(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(size);
 | 
					void primitive_size(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(begin_scan);
 | 
					void primitive_begin_scan(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(next_object);
 | 
					void primitive_next_object(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(end_scan);
 | 
					void primitive_end_scan(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void gc(void);
 | 
					void gc(void);
 | 
				
			||||||
DLLEXPORT void minor_gc(void);
 | 
					DLLEXPORT void minor_gc(void);
 | 
				
			||||||
| 
						 | 
					@ -388,9 +388,9 @@ INLINE void* allot_object(CELL type, CELL a)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
CELL collect_next(CELL scan);
 | 
					CELL collect_next(CELL scan);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(gc);
 | 
					void primitive_gc(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(gc_stats);
 | 
					void primitive_gc_stats(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(gc_reset);
 | 
					void primitive_gc_reset(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(become);
 | 
					void primitive_become(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
CELL find_all_words(void);
 | 
					CELL find_all_words(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -474,7 +474,7 @@ void factorbug(void)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(die)
 | 
					void primitive_die(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	fprintf(stderr,"The die word was called by the library. Unless you called it yourself,\n");
 | 
						fprintf(stderr,"The die word was called by the library. Unless you called it yourself,\n");
 | 
				
			||||||
	fprintf(stderr,"you have triggered a bug in Factor. Please report.\n");
 | 
						fprintf(stderr,"you have triggered a bug in Factor. Please report.\n");
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -6,4 +6,4 @@ void dump_zone(F_ZONE *z);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
bool fep_disabled;
 | 
					bool fep_disabled;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(die);
 | 
					void primitive_die(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -142,19 +142,19 @@ void misc_signal_handler_impl(void)
 | 
				
			||||||
	signal_error(signal_number,signal_callstack_top);
 | 
						signal_error(signal_number,signal_callstack_top);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(throw)
 | 
					void primitive_throw(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	dpop();
 | 
						dpop();
 | 
				
			||||||
	throw_impl(dpop(),stack_chain->callstack_top);
 | 
						throw_impl(dpop(),stack_chain->callstack_top);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(call_clear)
 | 
					void primitive_call_clear(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	throw_impl(dpop(),stack_chain->callstack_bottom);
 | 
						throw_impl(dpop(),stack_chain->callstack_bottom);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* For testing purposes */
 | 
					/* For testing purposes */
 | 
				
			||||||
DEFINE_PRIMITIVE(unimplemented)
 | 
					void primitive_unimplemented(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	not_implemented_error();
 | 
						not_implemented_error();
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -22,7 +22,7 @@ typedef enum
 | 
				
			||||||
void out_of_memory(void);
 | 
					void out_of_memory(void);
 | 
				
			||||||
void fatal_error(char* msg, CELL tagged);
 | 
					void fatal_error(char* msg, CELL tagged);
 | 
				
			||||||
void critical_error(char* msg, CELL tagged);
 | 
					void critical_error(char* msg, CELL tagged);
 | 
				
			||||||
DECLARE_PRIMITIVE(die);
 | 
					void primitive_die(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void throw_error(CELL error, F_STACK_FRAME *native_stack);
 | 
					void throw_error(CELL error, F_STACK_FRAME *native_stack);
 | 
				
			||||||
void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, F_STACK_FRAME *native_stack);
 | 
					void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, F_STACK_FRAME *native_stack);
 | 
				
			||||||
| 
						 | 
					@ -32,8 +32,8 @@ void signal_error(int signal, F_STACK_FRAME *native_stack);
 | 
				
			||||||
void type_error(CELL type, CELL tagged);
 | 
					void type_error(CELL type, CELL tagged);
 | 
				
			||||||
void not_implemented_error(void);
 | 
					void not_implemented_error(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(throw);
 | 
					void primitive_throw(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(call_clear);
 | 
					void primitive_call_clear(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
INLINE void type_check(CELL type, CELL tagged)
 | 
					INLINE void type_check(CELL type, CELL tagged)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
| 
						 | 
					@ -57,4 +57,4 @@ void memory_signal_handler_impl(void);
 | 
				
			||||||
void divide_by_zero_signal_handler_impl(void);
 | 
					void divide_by_zero_signal_handler_impl(void);
 | 
				
			||||||
void misc_signal_handler_impl(void);
 | 
					void misc_signal_handler_impl(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(unimplemented);
 | 
					void primitive_unimplemented(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -161,7 +161,7 @@ bool save_image(const F_CHAR *filename)
 | 
				
			||||||
	return true;
 | 
						return true;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(save_image)
 | 
					void primitive_save_image(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	/* do a full GC to push everything into tenured space */
 | 
						/* do a full GC to push everything into tenured space */
 | 
				
			||||||
	gc();
 | 
						gc();
 | 
				
			||||||
| 
						 | 
					@ -184,7 +184,7 @@ void strip_compiled_quotations(void)
 | 
				
			||||||
	gc_off = false;
 | 
						gc_off = false;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(save_image_and_exit)
 | 
					void primitive_save_image_and_exit(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	/* We unbox this before doing anything else. This is the only point
 | 
						/* We unbox this before doing anything else. This is the only point
 | 
				
			||||||
	where we might throw an error, so we have to throw an error here since
 | 
						where we might throw an error, so we have to throw an error here since
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -40,8 +40,8 @@ void load_image(F_PARAMETERS *p);
 | 
				
			||||||
void init_objects(F_HEADER *h);
 | 
					void init_objects(F_HEADER *h);
 | 
				
			||||||
bool save_image(const F_CHAR *file);
 | 
					bool save_image(const F_CHAR *file);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(save_image);
 | 
					void primitive_save_image(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(save_image_and_exit);
 | 
					void primitive_save_image_and_exit(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* relocation base of currently loaded image's data heap */
 | 
					/* relocation base of currently loaded image's data heap */
 | 
				
			||||||
CELL data_relocation_base;
 | 
					CELL data_relocation_base;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										14
									
								
								vm/io.c
								
								
								
								
							
							
						
						
									
										14
									
								
								vm/io.c
								
								
								
								
							| 
						 | 
					@ -29,7 +29,7 @@ void io_error(void)
 | 
				
			||||||
	general_error(ERROR_IO,error,F,NULL);
 | 
						general_error(ERROR_IO,error,F,NULL);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fopen)
 | 
					void primitive_fopen(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	char *mode = unbox_char_string();
 | 
						char *mode = unbox_char_string();
 | 
				
			||||||
	REGISTER_C_STRING(mode);
 | 
						REGISTER_C_STRING(mode);
 | 
				
			||||||
| 
						 | 
					@ -49,7 +49,7 @@ DEFINE_PRIMITIVE(fopen)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fgetc)
 | 
					void primitive_fgetc(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	FILE* file = unbox_alien();
 | 
						FILE* file = unbox_alien();
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -74,7 +74,7 @@ DEFINE_PRIMITIVE(fgetc)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fread)
 | 
					void primitive_fread(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	FILE* file = unbox_alien();
 | 
						FILE* file = unbox_alien();
 | 
				
			||||||
	CELL size = unbox_array_size();
 | 
						CELL size = unbox_array_size();
 | 
				
			||||||
| 
						 | 
					@ -116,7 +116,7 @@ DEFINE_PRIMITIVE(fread)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fputc)
 | 
					void primitive_fputc(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	FILE *file = unbox_alien();
 | 
						FILE *file = unbox_alien();
 | 
				
			||||||
	F_FIXNUM ch = to_fixnum(dpop());
 | 
						F_FIXNUM ch = to_fixnum(dpop());
 | 
				
			||||||
| 
						 | 
					@ -134,7 +134,7 @@ DEFINE_PRIMITIVE(fputc)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fwrite)
 | 
					void primitive_fwrite(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	FILE *file = unbox_alien();
 | 
						FILE *file = unbox_alien();
 | 
				
			||||||
	F_BYTE_ARRAY *text = untag_byte_array(dpop());
 | 
						F_BYTE_ARRAY *text = untag_byte_array(dpop());
 | 
				
			||||||
| 
						 | 
					@ -163,7 +163,7 @@ DEFINE_PRIMITIVE(fwrite)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fflush)
 | 
					void primitive_fflush(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	FILE *file = unbox_alien();
 | 
						FILE *file = unbox_alien();
 | 
				
			||||||
	for(;;)
 | 
						for(;;)
 | 
				
			||||||
| 
						 | 
					@ -175,7 +175,7 @@ DEFINE_PRIMITIVE(fflush)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fclose)
 | 
					void primitive_fclose(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	FILE *file = unbox_alien();
 | 
						FILE *file = unbox_alien();
 | 
				
			||||||
	for(;;)
 | 
						for(;;)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										20
									
								
								vm/io.h
								
								
								
								
							
							
						
						
									
										20
									
								
								vm/io.h
								
								
								
								
							| 
						 | 
					@ -3,15 +3,15 @@ void io_error(void);
 | 
				
			||||||
int err_no(void);
 | 
					int err_no(void);
 | 
				
			||||||
void clear_err_no(void);
 | 
					void clear_err_no(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(fopen);
 | 
					void primitive_fopen(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fgetc);
 | 
					void primitive_fgetc(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fread);
 | 
					void primitive_fread(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fputc);
 | 
					void primitive_fputc(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fwrite);
 | 
					void primitive_fwrite(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fflush);
 | 
					void primitive_fflush(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fclose);
 | 
					void primitive_fclose(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Platform specific primitives */
 | 
					/* Platform specific primitives */
 | 
				
			||||||
DECLARE_PRIMITIVE(open_file);
 | 
					void primitive_open_file(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(existsp);
 | 
					void primitive_existsp(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(read_dir);
 | 
					void primitive_read_dir(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										98
									
								
								vm/math.c
								
								
								
								
							
							
						
						
									
										98
									
								
								vm/math.c
								
								
								
								
							| 
						 | 
					@ -21,12 +21,12 @@ CELL to_cell(CELL tagged)
 | 
				
			||||||
	return (CELL)to_fixnum(tagged);
 | 
						return (CELL)to_fixnum(tagged);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_to_fixnum)
 | 
					void primitive_bignum_to_fixnum(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(tag_fixnum(bignum_to_fixnum(untag_object(dpeek()))));
 | 
						drepl(tag_fixnum(bignum_to_fixnum(untag_object(dpeek()))));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_to_fixnum)
 | 
					void primitive_float_to_fixnum(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(tag_fixnum(float_to_fixnum(dpeek())));
 | 
						drepl(tag_fixnum(float_to_fixnum(dpeek())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -35,13 +35,13 @@ DEFINE_PRIMITIVE(float_to_fixnum)
 | 
				
			||||||
	F_FIXNUM y = untag_fixnum_fast(dpop()); \
 | 
						F_FIXNUM y = untag_fixnum_fast(dpop()); \
 | 
				
			||||||
	F_FIXNUM x = untag_fixnum_fast(dpop());
 | 
						F_FIXNUM x = untag_fixnum_fast(dpop());
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_add)
 | 
					void primitive_fixnum_add(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FIXNUMS(x,y)
 | 
						POP_FIXNUMS(x,y)
 | 
				
			||||||
	box_signed_cell(x + y);
 | 
						box_signed_cell(x + y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_subtract)
 | 
					void primitive_fixnum_subtract(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FIXNUMS(x,y)
 | 
						POP_FIXNUMS(x,y)
 | 
				
			||||||
	box_signed_cell(x - y);
 | 
						box_signed_cell(x - y);
 | 
				
			||||||
| 
						 | 
					@ -49,7 +49,7 @@ DEFINE_PRIMITIVE(fixnum_subtract)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Multiply two integers, and trap overflow.
 | 
					/* Multiply two integers, and trap overflow.
 | 
				
			||||||
Thanks to David Blaikie (The_Vulture from freenode #java) for the hint. */
 | 
					Thanks to David Blaikie (The_Vulture from freenode #java) for the hint. */
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_multiply)
 | 
					void primitive_fixnum_multiply(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FIXNUMS(x,y)
 | 
						POP_FIXNUMS(x,y)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -72,13 +72,13 @@ DEFINE_PRIMITIVE(fixnum_multiply)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_divint)
 | 
					void primitive_fixnum_divint(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FIXNUMS(x,y)
 | 
						POP_FIXNUMS(x,y)
 | 
				
			||||||
	box_signed_cell(x / y);
 | 
						box_signed_cell(x / y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_divmod)
 | 
					void primitive_fixnum_divmod(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FIXNUMS(x,y)
 | 
						POP_FIXNUMS(x,y)
 | 
				
			||||||
	box_signed_cell(x / y);
 | 
						box_signed_cell(x / y);
 | 
				
			||||||
| 
						 | 
					@ -90,7 +90,7 @@ DEFINE_PRIMITIVE(fixnum_divmod)
 | 
				
			||||||
 * If we're shifting right by n bits, we won't overflow as long as none of the
 | 
					 * If we're shifting right by n bits, we won't overflow as long as none of the
 | 
				
			||||||
 * high WORD_SIZE-TAG_BITS-n bits are set.
 | 
					 * high WORD_SIZE-TAG_BITS-n bits are set.
 | 
				
			||||||
 */
 | 
					 */
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_shift)
 | 
					void primitive_fixnum_shift(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FIXNUMS(x,y)
 | 
						POP_FIXNUMS(x,y)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -122,12 +122,12 @@ DEFINE_PRIMITIVE(fixnum_shift)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Bignums */
 | 
					/* Bignums */
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_to_bignum)
 | 
					void primitive_fixnum_to_bignum(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(tag_bignum(fixnum_to_bignum(untag_fixnum_fast(dpeek()))));
 | 
						drepl(tag_bignum(fixnum_to_bignum(untag_fixnum_fast(dpeek()))));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_to_bignum)
 | 
					void primitive_float_to_bignum(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(tag_bignum(float_to_bignum(dpeek())));
 | 
						drepl(tag_bignum(float_to_bignum(dpeek())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -136,37 +136,37 @@ DEFINE_PRIMITIVE(float_to_bignum)
 | 
				
			||||||
	F_ARRAY *y = untag_object(dpop()); \
 | 
						F_ARRAY *y = untag_object(dpop()); \
 | 
				
			||||||
	F_ARRAY *x = untag_object(dpop());
 | 
						F_ARRAY *x = untag_object(dpop());
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_eq)
 | 
					void primitive_bignum_eq(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	box_boolean(bignum_equal_p(x,y));
 | 
						box_boolean(bignum_equal_p(x,y));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_add)
 | 
					void primitive_bignum_add(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_add(x,y)));
 | 
						dpush(tag_bignum(bignum_add(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_subtract)
 | 
					void primitive_bignum_subtract(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_subtract(x,y)));
 | 
						dpush(tag_bignum(bignum_subtract(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_multiply)
 | 
					void primitive_bignum_multiply(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_multiply(x,y)));
 | 
						dpush(tag_bignum(bignum_multiply(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_divint)
 | 
					void primitive_bignum_divint(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_quotient(x,y)));
 | 
						dpush(tag_bignum(bignum_quotient(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_divmod)
 | 
					void primitive_bignum_divmod(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_ARRAY *q, *r;
 | 
						F_ARRAY *q, *r;
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
| 
						 | 
					@ -175,74 +175,74 @@ DEFINE_PRIMITIVE(bignum_divmod)
 | 
				
			||||||
	dpush(tag_bignum(r));
 | 
						dpush(tag_bignum(r));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_mod)
 | 
					void primitive_bignum_mod(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_remainder(x,y)));
 | 
						dpush(tag_bignum(bignum_remainder(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_and)
 | 
					void primitive_bignum_and(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_bitwise_and(x,y)));
 | 
						dpush(tag_bignum(bignum_bitwise_and(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_or)
 | 
					void primitive_bignum_or(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_bitwise_ior(x,y)));
 | 
						dpush(tag_bignum(bignum_bitwise_ior(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_xor)
 | 
					void primitive_bignum_xor(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	dpush(tag_bignum(bignum_bitwise_xor(x,y)));
 | 
						dpush(tag_bignum(bignum_bitwise_xor(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_shift)
 | 
					void primitive_bignum_shift(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_FIXNUM y = to_fixnum(dpop());
 | 
						F_FIXNUM y = to_fixnum(dpop());
 | 
				
			||||||
        F_ARRAY* x = untag_object(dpop());
 | 
					        F_ARRAY* x = untag_object(dpop());
 | 
				
			||||||
	dpush(tag_bignum(bignum_arithmetic_shift(x,y)));
 | 
						dpush(tag_bignum(bignum_arithmetic_shift(x,y)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_less)
 | 
					void primitive_bignum_less(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	box_boolean(bignum_compare(x,y) == bignum_comparison_less);
 | 
						box_boolean(bignum_compare(x,y) == bignum_comparison_less);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_lesseq)
 | 
					void primitive_bignum_lesseq(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
 | 
						box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_greater)
 | 
					void primitive_bignum_greater(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
 | 
						box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_greatereq)
 | 
					void primitive_bignum_greatereq(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_BIGNUMS(x,y);
 | 
						POP_BIGNUMS(x,y);
 | 
				
			||||||
	box_boolean(bignum_compare(x,y) != bignum_comparison_less);
 | 
						box_boolean(bignum_compare(x,y) != bignum_comparison_less);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_not)
 | 
					void primitive_bignum_not(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(tag_bignum(bignum_bitwise_not(untag_object(dpeek()))));
 | 
						drepl(tag_bignum(bignum_bitwise_not(untag_object(dpeek()))));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_bitp)
 | 
					void primitive_bignum_bitp(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_FIXNUM bit = to_fixnum(dpop());
 | 
						F_FIXNUM bit = to_fixnum(dpop());
 | 
				
			||||||
	F_ARRAY *x = untag_object(dpop());
 | 
						F_ARRAY *x = untag_object(dpop());
 | 
				
			||||||
	box_boolean(bignum_logbitp(bit,x));
 | 
						box_boolean(bignum_logbitp(bit,x));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_log2)
 | 
					void primitive_bignum_log2(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(tag_bignum(bignum_integer_length(untag_object(dpeek()))));
 | 
						drepl(tag_bignum(bignum_integer_length(untag_object(dpeek()))));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -253,7 +253,7 @@ unsigned int bignum_producer(unsigned int digit)
 | 
				
			||||||
	return *(ptr + digit);
 | 
						return *(ptr + digit);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(byte_array_to_bignum)
 | 
					void primitive_byte_array_to_bignum(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	type_check(BYTE_ARRAY_TYPE,dpeek());
 | 
						type_check(BYTE_ARRAY_TYPE,dpeek());
 | 
				
			||||||
	CELL n_digits = array_capacity(untag_object(dpeek()));
 | 
						CELL n_digits = array_capacity(untag_object(dpeek()));
 | 
				
			||||||
| 
						 | 
					@ -383,7 +383,7 @@ CELL unbox_array_size(void)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Does not reduce to lowest terms, so should only be used by math
 | 
					/* Does not reduce to lowest terms, so should only be used by math
 | 
				
			||||||
library implementation, to avoid breaking invariants. */
 | 
					library implementation, to avoid breaking invariants. */
 | 
				
			||||||
DEFINE_PRIMITIVE(from_fraction)
 | 
					void primitive_from_fraction(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_RATIO* ratio = allot_object(RATIO_TYPE,sizeof(F_RATIO));
 | 
						F_RATIO* ratio = allot_object(RATIO_TYPE,sizeof(F_RATIO));
 | 
				
			||||||
	ratio->denominator = dpop();
 | 
						ratio->denominator = dpop();
 | 
				
			||||||
| 
						 | 
					@ -392,17 +392,17 @@ DEFINE_PRIMITIVE(from_fraction)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Floats */
 | 
					/* Floats */
 | 
				
			||||||
DEFINE_PRIMITIVE(fixnum_to_float)
 | 
					void primitive_fixnum_to_float(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(allot_float(fixnum_to_float(dpeek())));
 | 
						drepl(allot_float(fixnum_to_float(dpeek())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bignum_to_float)
 | 
					void primitive_bignum_to_float(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(allot_float(bignum_to_float(dpeek())));
 | 
						drepl(allot_float(bignum_to_float(dpeek())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(str_to_float)
 | 
					void primitive_str_to_float(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	char *c_str, *end;
 | 
						char *c_str, *end;
 | 
				
			||||||
	double f;
 | 
						double f;
 | 
				
			||||||
| 
						 | 
					@ -418,7 +418,7 @@ DEFINE_PRIMITIVE(str_to_float)
 | 
				
			||||||
		drepl(allot_float(f));
 | 
							drepl(allot_float(f));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_to_str)
 | 
					void primitive_float_to_str(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	char tmp[33];
 | 
						char tmp[33];
 | 
				
			||||||
	snprintf(tmp,32,"%.16g",untag_float(dpop()));
 | 
						snprintf(tmp,32,"%.16g",untag_float(dpop()));
 | 
				
			||||||
| 
						 | 
					@ -430,82 +430,82 @@ DEFINE_PRIMITIVE(float_to_str)
 | 
				
			||||||
	double y = untag_float_fast(dpop()); \
 | 
						double y = untag_float_fast(dpop()); \
 | 
				
			||||||
	double x = untag_float_fast(dpop());
 | 
						double x = untag_float_fast(dpop());
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_eq)
 | 
					void primitive_float_eq(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_boolean(x == y);
 | 
						box_boolean(x == y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_add)
 | 
					void primitive_float_add(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_double(x + y);
 | 
						box_double(x + y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_subtract)
 | 
					void primitive_float_subtract(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_double(x - y);
 | 
						box_double(x - y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_multiply)
 | 
					void primitive_float_multiply(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_double(x * y);
 | 
						box_double(x * y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_divfloat)
 | 
					void primitive_float_divfloat(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_double(x / y);
 | 
						box_double(x / y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_mod)
 | 
					void primitive_float_mod(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_double(fmod(x,y));
 | 
						box_double(fmod(x,y));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_less)
 | 
					void primitive_float_less(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_boolean(x < y);
 | 
						box_boolean(x < y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_lesseq)
 | 
					void primitive_float_lesseq(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_boolean(x <= y);
 | 
						box_boolean(x <= y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_greater)
 | 
					void primitive_float_greater(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_boolean(x > y);
 | 
						box_boolean(x > y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_greatereq)
 | 
					void primitive_float_greatereq(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	POP_FLOATS(x,y);
 | 
						POP_FLOATS(x,y);
 | 
				
			||||||
	box_boolean(x >= y);
 | 
						box_boolean(x >= y);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(float_bits)
 | 
					void primitive_float_bits(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_unsigned_4(float_bits(untag_float(dpop())));
 | 
						box_unsigned_4(float_bits(untag_float(dpop())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bits_float)
 | 
					void primitive_bits_float(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_float(bits_float(to_cell(dpop())));
 | 
						box_float(bits_float(to_cell(dpop())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(double_bits)
 | 
					void primitive_double_bits(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_unsigned_8(double_bits(untag_float(dpop())));
 | 
						box_unsigned_8(double_bits(untag_float(dpop())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(bits_double)
 | 
					void primitive_bits_double(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_double(bits_double(to_unsigned_8(dpop())));
 | 
						box_double(bits_double(to_unsigned_8(dpop())));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -532,7 +532,7 @@ void box_double(double flo)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Complex numbers */
 | 
					/* Complex numbers */
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(from_rect)
 | 
					void primitive_from_rect(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_COMPLEX* complex = allot_object(COMPLEX_TYPE,sizeof(F_COMPLEX));
 | 
						F_COMPLEX* complex = allot_object(COMPLEX_TYPE,sizeof(F_COMPLEX));
 | 
				
			||||||
	complex->imaginary = dpop();
 | 
						complex->imaginary = dpop();
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										100
									
								
								vm/math.h
								
								
								
								
							
							
						
						
									
										100
									
								
								vm/math.h
								
								
								
								
							| 
						 | 
					@ -6,15 +6,15 @@
 | 
				
			||||||
DLLEXPORT F_FIXNUM to_fixnum(CELL tagged);
 | 
					DLLEXPORT F_FIXNUM to_fixnum(CELL tagged);
 | 
				
			||||||
DLLEXPORT CELL to_cell(CELL tagged);
 | 
					DLLEXPORT CELL to_cell(CELL tagged);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_to_fixnum);
 | 
					void primitive_bignum_to_fixnum(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_to_fixnum);
 | 
					void primitive_float_to_fixnum(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_add);
 | 
					void primitive_fixnum_add(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_subtract);
 | 
					void primitive_fixnum_subtract(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_multiply);
 | 
					void primitive_fixnum_multiply(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_divint);
 | 
					void primitive_fixnum_divint(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_divmod);
 | 
					void primitive_fixnum_divmod(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_shift);
 | 
					void primitive_fixnum_shift(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
CELL bignum_zero;
 | 
					CELL bignum_zero;
 | 
				
			||||||
CELL bignum_pos_one;
 | 
					CELL bignum_pos_one;
 | 
				
			||||||
| 
						 | 
					@ -25,27 +25,27 @@ INLINE CELL tag_bignum(F_ARRAY* bignum)
 | 
				
			||||||
	return RETAG(bignum,BIGNUM_TYPE);
 | 
						return RETAG(bignum,BIGNUM_TYPE);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_to_bignum);
 | 
					void primitive_fixnum_to_bignum(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_to_bignum);
 | 
					void primitive_float_to_bignum(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_eq);
 | 
					void primitive_bignum_eq(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_add);
 | 
					void primitive_bignum_add(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_subtract);
 | 
					void primitive_bignum_subtract(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_multiply);
 | 
					void primitive_bignum_multiply(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_divint);
 | 
					void primitive_bignum_divint(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_divmod);
 | 
					void primitive_bignum_divmod(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_mod);
 | 
					void primitive_bignum_mod(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_and);
 | 
					void primitive_bignum_and(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_or);
 | 
					void primitive_bignum_or(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_xor);
 | 
					void primitive_bignum_xor(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_shift);
 | 
					void primitive_bignum_shift(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_less);
 | 
					void primitive_bignum_less(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_lesseq);
 | 
					void primitive_bignum_lesseq(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_greater);
 | 
					void primitive_bignum_greater(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_greatereq);
 | 
					void primitive_bignum_greatereq(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_not);
 | 
					void primitive_bignum_not(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_bitp);
 | 
					void primitive_bignum_bitp(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_log2);
 | 
					void primitive_bignum_log2(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(byte_array_to_bignum);
 | 
					void primitive_byte_array_to_bignum(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
INLINE CELL allot_integer(F_FIXNUM x)
 | 
					INLINE CELL allot_integer(F_FIXNUM x)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
| 
						 | 
					@ -80,7 +80,7 @@ DLLEXPORT u64 to_unsigned_8(CELL obj);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
CELL unbox_array_size(void);
 | 
					CELL unbox_array_size(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(from_fraction);
 | 
					void primitive_from_fraction(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
INLINE double untag_float_fast(CELL tagged)
 | 
					INLINE double untag_float_fast(CELL tagged)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
| 
						 | 
					@ -125,26 +125,26 @@ DLLEXPORT float to_float(CELL value);
 | 
				
			||||||
DLLEXPORT void box_double(double flo);
 | 
					DLLEXPORT void box_double(double flo);
 | 
				
			||||||
DLLEXPORT double to_double(CELL value);
 | 
					DLLEXPORT double to_double(CELL value);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(fixnum_to_float);
 | 
					void primitive_fixnum_to_float(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bignum_to_float);
 | 
					void primitive_bignum_to_float(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(str_to_float);
 | 
					void primitive_str_to_float(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_to_str);
 | 
					void primitive_float_to_str(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_to_bits);
 | 
					void primitive_float_to_bits(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(float_eq);
 | 
					void primitive_float_eq(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_add);
 | 
					void primitive_float_add(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_subtract);
 | 
					void primitive_float_subtract(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_multiply);
 | 
					void primitive_float_multiply(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_divfloat);
 | 
					void primitive_float_divfloat(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_mod);
 | 
					void primitive_float_mod(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_less);
 | 
					void primitive_float_less(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_lesseq);
 | 
					void primitive_float_lesseq(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_greater);
 | 
					void primitive_float_greater(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(float_greatereq);
 | 
					void primitive_float_greatereq(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(float_bits);
 | 
					void primitive_float_bits(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bits_float);
 | 
					void primitive_bits_float(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(double_bits);
 | 
					void primitive_double_bits(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(bits_double);
 | 
					void primitive_bits_double(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(from_rect);
 | 
					void primitive_from_rect(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -55,7 +55,7 @@ void ffi_dlclose(F_DLL *dll)
 | 
				
			||||||
	dll->dll = NULL;
 | 
						dll->dll = NULL;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(existsp)
 | 
					void primitive_existsp(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	struct stat sb;
 | 
						struct stat sb;
 | 
				
			||||||
	box_boolean(stat(unbox_char_string(),&sb) >= 0);
 | 
						box_boolean(stat(unbox_char_string(),&sb) >= 0);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -27,7 +27,7 @@ char *getenv(char *name)
 | 
				
			||||||
	return 0; /* unreachable */
 | 
						return 0; /* unreachable */
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(os_envs)
 | 
					void primitive_os_envs(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	not_implemented_error();
 | 
						not_implemented_error();
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -87,7 +87,7 @@ const F_CHAR *vm_executable_path(void)
 | 
				
			||||||
	return safe_strdup(full_path);
 | 
						return safe_strdup(full_path);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(existsp)
 | 
					void primitive_existsp(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	BY_HANDLE_FILE_INFORMATION bhfi;
 | 
						BY_HANDLE_FILE_INFORMATION bhfi;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,42 +1 @@
 | 
				
			||||||
extern void *primitives[];
 | 
					extern void *primitives[];
 | 
				
			||||||
 | 
					 | 
				
			||||||
/* Primitives are called with two parameters, the word itself and the current
 | 
					 | 
				
			||||||
callstack pointer. The DEFINE_PRIMITIVE() macro takes care of boilerplate to
 | 
					 | 
				
			||||||
save the current callstack pointer so that GC and other facilities can proceed
 | 
					 | 
				
			||||||
to inspect Factor stack frames below the primitive's C stack frame.
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
Usage:
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
DEFINE_PRIMITIVE(name)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
	... CODE ...
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
Becomes
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
F_FASTCALL void primitive_name(CELL word, F_STACK_FRAME *callstack_top)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
	save_callstack_top(callstack_top);
 | 
					 | 
				
			||||||
	... CODE ...
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
On x86, F_FASTCALL expands into a GCC declaration which forces the two
 | 
					 | 
				
			||||||
parameters to be passed in registers. This simplifies the quotation compiler
 | 
					 | 
				
			||||||
and support code in cpu-x86.S.
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
We do the assignment of stack_chain->callstack_top in a ``noinline'' function
 | 
					 | 
				
			||||||
to inhibit assignment re-ordering. */
 | 
					 | 
				
			||||||
#define DEFINE_PRIMITIVE(name) \
 | 
					 | 
				
			||||||
	INLINE void primitive_##name##_impl(void); \
 | 
					 | 
				
			||||||
	\
 | 
					 | 
				
			||||||
	F_FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) \
 | 
					 | 
				
			||||||
	{ \
 | 
					 | 
				
			||||||
		save_callstack_top(callstack_top); \
 | 
					 | 
				
			||||||
		primitive_##name##_impl(); \
 | 
					 | 
				
			||||||
	} \
 | 
					 | 
				
			||||||
	\
 | 
					 | 
				
			||||||
	INLINE void primitive_##name##_impl(void) \
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
/* Prototype for header files */
 | 
					 | 
				
			||||||
#define DECLARE_PRIMITIVE(name) \
 | 
					 | 
				
			||||||
	F_FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top)
 | 
					 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -79,7 +79,7 @@ void set_profiling(bool profiling)
 | 
				
			||||||
	iterate_code_heap(relocate_code_block);
 | 
						iterate_code_heap(relocate_code_block);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(profiling)
 | 
					void primitive_profiling(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	set_profiling(to_boolean(dpop()));
 | 
						set_profiling(to_boolean(dpop()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,4 +1,4 @@
 | 
				
			||||||
bool profiling_p;
 | 
					bool profiling_p;
 | 
				
			||||||
DECLARE_PRIMITIVE(profiling);
 | 
					void primitive_profiling(void);
 | 
				
			||||||
F_COMPILED *compile_profiling_stub(F_WORD *word);
 | 
					F_COMPILED *compile_profiling_stub(F_WORD *word);
 | 
				
			||||||
void update_word_xt(F_WORD *word);
 | 
					void update_word_xt(F_WORD *word);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -209,6 +209,7 @@ void jit_compile(CELL quot, bool relocate)
 | 
				
			||||||
		case FIXNUM_TYPE:
 | 
							case FIXNUM_TYPE:
 | 
				
			||||||
			if(jit_primitive_call_p(untag_object(array),i))
 | 
								if(jit_primitive_call_p(untag_object(array),i))
 | 
				
			||||||
			{
 | 
								{
 | 
				
			||||||
 | 
									EMIT(userenv[JIT_SAVE_STACK],0);
 | 
				
			||||||
				EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj));
 | 
									EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj));
 | 
				
			||||||
 | 
					
 | 
				
			||||||
				i++;
 | 
									i++;
 | 
				
			||||||
| 
						 | 
					@ -344,6 +345,7 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 | 
				
			||||||
		case FIXNUM_TYPE:
 | 
							case FIXNUM_TYPE:
 | 
				
			||||||
			if(jit_primitive_call_p(untag_object(array),i))
 | 
								if(jit_primitive_call_p(untag_object(array),i))
 | 
				
			||||||
			{
 | 
								{
 | 
				
			||||||
 | 
									COUNT(userenv[JIT_SAVE_STACK],i);
 | 
				
			||||||
				COUNT(userenv[JIT_PRIMITIVE],i);
 | 
									COUNT(userenv[JIT_PRIMITIVE],i);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
				i++;
 | 
									i++;
 | 
				
			||||||
| 
						 | 
					@ -412,7 +414,7 @@ F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* push a new quotation on the stack */
 | 
					/* push a new quotation on the stack */
 | 
				
			||||||
DEFINE_PRIMITIVE(array_to_quotation)
 | 
					void primitive_array_to_quotation(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
 | 
						F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
 | 
				
			||||||
	quot->array = dpeek();
 | 
						quot->array = dpeek();
 | 
				
			||||||
| 
						 | 
					@ -421,7 +423,7 @@ DEFINE_PRIMITIVE(array_to_quotation)
 | 
				
			||||||
	drepl(tag_object(quot));
 | 
						drepl(tag_object(quot));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(quotation_xt)
 | 
					void primitive_quotation_xt(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_QUOTATION *quot = untag_quotation(dpeek());
 | 
						F_QUOTATION *quot = untag_quotation(dpeek());
 | 
				
			||||||
	drepl(allot_cell((CELL)quot->xt));
 | 
						drepl(allot_cell((CELL)quot->xt));
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,5 +2,5 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code);
 | 
				
			||||||
void jit_compile(CELL quot, bool relocate);
 | 
					void jit_compile(CELL quot, bool relocate);
 | 
				
			||||||
F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack);
 | 
					F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack);
 | 
				
			||||||
F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset);
 | 
					F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset);
 | 
				
			||||||
DECLARE_PRIMITIVE(array_to_quotation);
 | 
					void primitive_array_to_quotation(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(quotation_xt);
 | 
					void primitive_quotation_xt(void);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										20
									
								
								vm/run.c
								
								
								
								
							
							
						
						
									
										20
									
								
								vm/run.c
								
								
								
								
							| 
						 | 
					@ -105,13 +105,13 @@ bool stack_to_array(CELL bottom, CELL top)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(datastack)
 | 
					void primitive_datastack(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	if(!stack_to_array(ds_bot,ds))
 | 
						if(!stack_to_array(ds_bot,ds))
 | 
				
			||||||
		general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
 | 
							general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(retainstack)
 | 
					void primitive_retainstack(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	if(!stack_to_array(rs_bot,rs))
 | 
						if(!stack_to_array(rs_bot,rs))
 | 
				
			||||||
		general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
 | 
							general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
 | 
				
			||||||
| 
						 | 
					@ -125,45 +125,45 @@ CELL array_to_stack(F_ARRAY *array, CELL bottom)
 | 
				
			||||||
	return bottom + depth - CELLS;
 | 
						return bottom + depth - CELLS;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(set_datastack)
 | 
					void primitive_set_datastack(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	ds = array_to_stack(untag_array(dpop()),ds_bot);
 | 
						ds = array_to_stack(untag_array(dpop()),ds_bot);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(set_retainstack)
 | 
					void primitive_set_retainstack(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	rs = array_to_stack(untag_array(dpop()),rs_bot);
 | 
						rs = array_to_stack(untag_array(dpop()),rs_bot);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(getenv)
 | 
					void primitive_getenv(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_FIXNUM e = untag_fixnum_fast(dpeek());
 | 
						F_FIXNUM e = untag_fixnum_fast(dpeek());
 | 
				
			||||||
	drepl(userenv[e]);
 | 
						drepl(userenv[e]);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(setenv)
 | 
					void primitive_setenv(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_FIXNUM e = untag_fixnum_fast(dpop());
 | 
						F_FIXNUM e = untag_fixnum_fast(dpop());
 | 
				
			||||||
	CELL value = dpop();
 | 
						CELL value = dpop();
 | 
				
			||||||
	userenv[e] = value;
 | 
						userenv[e] = value;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(exit)
 | 
					void primitive_exit(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	exit(to_fixnum(dpop()));
 | 
						exit(to_fixnum(dpop()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(millis)
 | 
					void primitive_millis(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	box_unsigned_8(current_millis());
 | 
						box_unsigned_8(current_millis());
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(sleep)
 | 
					void primitive_sleep(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	sleep_millis(to_cell(dpop()));
 | 
						sleep_millis(to_cell(dpop()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(set_slot)
 | 
					void primitive_set_slot(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_FIXNUM slot = untag_fixnum_fast(dpop());
 | 
						F_FIXNUM slot = untag_fixnum_fast(dpop());
 | 
				
			||||||
	CELL obj = dpop();
 | 
						CELL obj = dpop();
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										28
									
								
								vm/run.h
								
								
								
								
							
							
						
						
									
										28
									
								
								vm/run.h
								
								
								
								
							| 
						 | 
					@ -48,8 +48,8 @@ typedef enum {
 | 
				
			||||||
	JIT_RETURN,
 | 
						JIT_RETURN,
 | 
				
			||||||
	JIT_PROFILING,
 | 
						JIT_PROFILING,
 | 
				
			||||||
	JIT_PUSH_IMMEDIATE,
 | 
						JIT_PUSH_IMMEDIATE,
 | 
				
			||||||
 | 
					 | 
				
			||||||
	JIT_DECLARE_WORD    = 42,
 | 
						JIT_DECLARE_WORD    = 42,
 | 
				
			||||||
 | 
						JIT_SAVE_STACK,
 | 
				
			||||||
 | 
					
 | 
				
			||||||
	STACK_TRACES_ENV    = 59,
 | 
						STACK_TRACES_ENV    = 59,
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -226,18 +226,18 @@ DLLEXPORT void nest_stacks(void);
 | 
				
			||||||
DLLEXPORT void unnest_stacks(void);
 | 
					DLLEXPORT void unnest_stacks(void);
 | 
				
			||||||
void init_stacks(CELL ds_size, CELL rs_size);
 | 
					void init_stacks(CELL ds_size, CELL rs_size);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(datastack);
 | 
					void primitive_datastack(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(retainstack);
 | 
					void primitive_retainstack(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(getenv);
 | 
					void primitive_getenv(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(setenv);
 | 
					void primitive_setenv(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(exit);
 | 
					void primitive_exit(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(os_env);
 | 
					void primitive_os_env(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(os_envs);
 | 
					void primitive_os_envs(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_os_env);
 | 
					void primitive_set_os_env(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(unset_os_env);
 | 
					void primitive_unset_os_env(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_os_envs);
 | 
					void primitive_set_os_envs(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(millis);
 | 
					void primitive_millis(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(sleep);
 | 
					void primitive_sleep(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_slot);
 | 
					void primitive_set_slot(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
bool stage2;
 | 
					bool stage2;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										30
									
								
								vm/types.c
								
								
								
								
							
							
						
						
									
										30
									
								
								vm/types.c
								
								
								
								
							| 
						 | 
					@ -29,7 +29,7 @@ CELL clone_object(CELL object)
 | 
				
			||||||
	}
 | 
						}
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(clone)
 | 
					void primitive_clone(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	drepl(clone_object(dpeek()));
 | 
						drepl(clone_object(dpeek()));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -68,7 +68,7 @@ F_WORD *allot_word(CELL vocab, CELL name)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* <word> ( name vocabulary -- word ) */
 | 
					/* <word> ( name vocabulary -- word ) */
 | 
				
			||||||
DEFINE_PRIMITIVE(word)
 | 
					void primitive_word(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL vocab = dpop();
 | 
						CELL vocab = dpop();
 | 
				
			||||||
	CELL name = dpop();
 | 
						CELL name = dpop();
 | 
				
			||||||
| 
						 | 
					@ -76,7 +76,7 @@ DEFINE_PRIMITIVE(word)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* word-xt ( word -- start end ) */
 | 
					/* word-xt ( word -- start end ) */
 | 
				
			||||||
DEFINE_PRIMITIVE(word_xt)
 | 
					void primitive_word_xt(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_WORD *word = untag_word(dpop());
 | 
						F_WORD *word = untag_word(dpop());
 | 
				
			||||||
	F_COMPILED *code = (profiling_p ? word->profiling : word->code);
 | 
						F_COMPILED *code = (profiling_p ? word->profiling : word->code);
 | 
				
			||||||
| 
						 | 
					@ -84,7 +84,7 @@ DEFINE_PRIMITIVE(word_xt)
 | 
				
			||||||
	dpush(allot_cell((CELL)code + sizeof(F_COMPILED) + code->code_length));
 | 
						dpush(allot_cell((CELL)code + sizeof(F_COMPILED) + code->code_length));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(wrapper)
 | 
					void primitive_wrapper(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_WRAPPER *wrapper = allot_object(WRAPPER_TYPE,sizeof(F_WRAPPER));
 | 
						F_WRAPPER *wrapper = allot_object(WRAPPER_TYPE,sizeof(F_WRAPPER));
 | 
				
			||||||
	wrapper->object = dpeek();
 | 
						wrapper->object = dpeek();
 | 
				
			||||||
| 
						 | 
					@ -123,7 +123,7 @@ F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* push a new array on the stack */
 | 
					/* push a new array on the stack */
 | 
				
			||||||
DEFINE_PRIMITIVE(array)
 | 
					void primitive_array(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL initial = dpop();
 | 
						CELL initial = dpop();
 | 
				
			||||||
	CELL size = unbox_array_size();
 | 
						CELL size = unbox_array_size();
 | 
				
			||||||
| 
						 | 
					@ -194,7 +194,7 @@ F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill)
 | 
				
			||||||
	return new_array;
 | 
						return new_array;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(resize_array)
 | 
					void primitive_resize_array(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_ARRAY* array = untag_array(dpop());
 | 
						F_ARRAY* array = untag_array(dpop());
 | 
				
			||||||
	CELL capacity = unbox_array_size();
 | 
						CELL capacity = unbox_array_size();
 | 
				
			||||||
| 
						 | 
					@ -259,7 +259,7 @@ F_BYTE_ARRAY *allot_byte_array(CELL size)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* push a new byte array on the stack */
 | 
					/* push a new byte array on the stack */
 | 
				
			||||||
DEFINE_PRIMITIVE(byte_array)
 | 
					void primitive_byte_array(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL size = unbox_array_size();
 | 
						CELL size = unbox_array_size();
 | 
				
			||||||
	dpush(tag_object(allot_byte_array(size)));
 | 
						dpush(tag_object(allot_byte_array(size)));
 | 
				
			||||||
| 
						 | 
					@ -280,7 +280,7 @@ F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity)
 | 
				
			||||||
	return new_array;
 | 
						return new_array;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(resize_byte_array)
 | 
					void primitive_resize_byte_array(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_BYTE_ARRAY* array = untag_byte_array(dpop());
 | 
						F_BYTE_ARRAY* array = untag_byte_array(dpop());
 | 
				
			||||||
	CELL capacity = unbox_array_size();
 | 
						CELL capacity = unbox_array_size();
 | 
				
			||||||
| 
						 | 
					@ -313,7 +313,7 @@ F_TUPLE *allot_tuple(F_TUPLE_LAYOUT *layout)
 | 
				
			||||||
	return tuple;
 | 
						return tuple;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(tuple)
 | 
					void primitive_tuple(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_TUPLE_LAYOUT *layout = untag_object(dpop());
 | 
						F_TUPLE_LAYOUT *layout = untag_object(dpop());
 | 
				
			||||||
	F_FIXNUM size = untag_fixnum_fast(layout->size);
 | 
						F_FIXNUM size = untag_fixnum_fast(layout->size);
 | 
				
			||||||
| 
						 | 
					@ -327,7 +327,7 @@ DEFINE_PRIMITIVE(tuple)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* push a new tuple on the stack, filling its slots from the stack */
 | 
					/* push a new tuple on the stack, filling its slots from the stack */
 | 
				
			||||||
DEFINE_PRIMITIVE(tuple_boa)
 | 
					void primitive_tuple_boa(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_TUPLE_LAYOUT *layout = untag_object(dpop());
 | 
						F_TUPLE_LAYOUT *layout = untag_object(dpop());
 | 
				
			||||||
	F_FIXNUM size = untag_fixnum_fast(layout->size);
 | 
						F_FIXNUM size = untag_fixnum_fast(layout->size);
 | 
				
			||||||
| 
						 | 
					@ -434,7 +434,7 @@ F_STRING *allot_string(CELL capacity, CELL fill)
 | 
				
			||||||
	return string;
 | 
						return string;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(string)
 | 
					void primitive_string(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	CELL initial = to_cell(dpop());
 | 
						CELL initial = to_cell(dpop());
 | 
				
			||||||
	CELL length = unbox_array_size();
 | 
						CELL length = unbox_array_size();
 | 
				
			||||||
| 
						 | 
					@ -477,7 +477,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
 | 
				
			||||||
	return new_string;
 | 
						return new_string;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(resize_string)
 | 
					void primitive_resize_string(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STRING* string = untag_string(dpop());
 | 
						F_STRING* string = untag_string(dpop());
 | 
				
			||||||
	CELL capacity = unbox_array_size();
 | 
						CELL capacity = unbox_array_size();
 | 
				
			||||||
| 
						 | 
					@ -544,7 +544,7 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size)
 | 
				
			||||||
		for(i = 0; i < capacity; i++) \
 | 
							for(i = 0; i < capacity; i++) \
 | 
				
			||||||
			string[i] = string_nth(s,i); \
 | 
								string[i] = string_nth(s,i); \
 | 
				
			||||||
	} \
 | 
						} \
 | 
				
			||||||
	DEFINE_PRIMITIVE(type##_string_to_memory) \
 | 
						void primitive_##type##_string_to_memory(void) \
 | 
				
			||||||
	{ \
 | 
						{ \
 | 
				
			||||||
		type *address = unbox_alien(); \
 | 
							type *address = unbox_alien(); \
 | 
				
			||||||
		F_STRING *str = untag_string(dpop()); \
 | 
							F_STRING *str = untag_string(dpop()); \
 | 
				
			||||||
| 
						 | 
					@ -576,14 +576,14 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size)
 | 
				
			||||||
STRING_TO_MEMORY(char);
 | 
					STRING_TO_MEMORY(char);
 | 
				
			||||||
STRING_TO_MEMORY(u16);
 | 
					STRING_TO_MEMORY(u16);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(string_nth)
 | 
					void primitive_string_nth(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STRING *string = untag_object(dpop());
 | 
						F_STRING *string = untag_object(dpop());
 | 
				
			||||||
	CELL index = untag_fixnum_fast(dpop());
 | 
						CELL index = untag_fixnum_fast(dpop());
 | 
				
			||||||
	dpush(tag_fixnum(string_nth(string,index)));
 | 
						dpush(tag_fixnum(string_nth(string,index)));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DEFINE_PRIMITIVE(set_string_nth)
 | 
					void primitive_set_string_nth(void)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
	F_STRING *string = untag_object(dpop());
 | 
						F_STRING *string = untag_object(dpop());
 | 
				
			||||||
	CELL index = untag_fixnum_fast(dpop());
 | 
						CELL index = untag_fixnum_fast(dpop());
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										30
									
								
								vm/types.h
								
								
								
								
							
							
						
						
									
										30
									
								
								vm/types.h
								
								
								
								
							| 
						 | 
					@ -112,23 +112,23 @@ CELL allot_array_1(CELL obj);
 | 
				
			||||||
CELL allot_array_2(CELL v1, CELL v2);
 | 
					CELL allot_array_2(CELL v1, CELL v2);
 | 
				
			||||||
CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
 | 
					CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(array);
 | 
					void primitive_array(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(tuple);
 | 
					void primitive_tuple(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(tuple_boa);
 | 
					void primitive_tuple_boa(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(tuple_layout);
 | 
					void primitive_tuple_layout(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(byte_array);
 | 
					void primitive_byte_array(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(clone);
 | 
					void primitive_clone(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill);
 | 
					F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill);
 | 
				
			||||||
F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity);
 | 
					F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity);
 | 
				
			||||||
DECLARE_PRIMITIVE(resize_array);
 | 
					void primitive_resize_array(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(resize_byte_array);
 | 
					void primitive_resize_byte_array(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
F_STRING* allot_string_internal(CELL capacity);
 | 
					F_STRING* allot_string_internal(CELL capacity);
 | 
				
			||||||
F_STRING* allot_string(CELL capacity, CELL fill);
 | 
					F_STRING* allot_string(CELL capacity, CELL fill);
 | 
				
			||||||
DECLARE_PRIMITIVE(string);
 | 
					void primitive_string(void);
 | 
				
			||||||
F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill);
 | 
					F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill);
 | 
				
			||||||
DECLARE_PRIMITIVE(resize_string);
 | 
					void primitive_resize_string(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
F_STRING *memory_to_char_string(const char *string, CELL length);
 | 
					F_STRING *memory_to_char_string(const char *string, CELL length);
 | 
				
			||||||
F_STRING *from_char_string(const char *c_string);
 | 
					F_STRING *from_char_string(const char *c_string);
 | 
				
			||||||
| 
						 | 
					@ -152,14 +152,14 @@ DLLEXPORT u16 *unbox_u16_string(void);
 | 
				
			||||||
CELL string_nth(F_STRING* string, CELL index);
 | 
					CELL string_nth(F_STRING* string, CELL index);
 | 
				
			||||||
void set_string_nth(F_STRING* string, CELL index, CELL value);
 | 
					void set_string_nth(F_STRING* string, CELL index, CELL value);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(string_nth);
 | 
					void primitive_string_nth(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(set_string_nth);
 | 
					void primitive_set_string_nth(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
F_WORD *allot_word(CELL vocab, CELL name);
 | 
					F_WORD *allot_word(CELL vocab, CELL name);
 | 
				
			||||||
DECLARE_PRIMITIVE(word);
 | 
					void primitive_word(void);
 | 
				
			||||||
DECLARE_PRIMITIVE(word_xt);
 | 
					void primitive_word_xt(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
DECLARE_PRIMITIVE(wrapper);
 | 
					void primitive_wrapper(void);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* Macros to simulate a vector in C */
 | 
					/* Macros to simulate a vector in C */
 | 
				
			||||||
#define GROWABLE_ARRAY(result) \
 | 
					#define GROWABLE_ARRAY(result) \
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue