CC = gcc
-DEFAULT_CFLAGS = -Wall -O3 -fomit-frame-pointer $(SITE_CFLAGS)
-#DEFAULT_CFLAGS = -g $(SITE_CFLAGS)
+#DEFAULT_CFLAGS = -Wall -O3 -fomit-frame-pointer $(SITE_CFLAGS)
+DEFAULT_CFLAGS = -g
DEFAULT_LIBS = -lm
-STRIP = strip
+#STRIP = strip
+STRIP = touch
-UNIX_OBJS = native/unix/file.o native/unix/signal.o \
- native/unix/ffi.o native/unix/run.o
+UNIX_OBJS = native/unix/file.o \
+ native/unix/signal.o \
+ native/unix/ffi.o \
+ native/unix/run.o \
+ native/unix/memory.o
-WIN32_OBJS = native/win32/ffi.o native/win32/file.o \
+WIN32_OBJS = native/win32/ffi.o \
+ native/win32/file.o \
native/win32/misc.o \
- native/win32/run.o
+ native/win32/run.o \
+ native/win32/memory.o
ifdef WIN32
PLAF_OBJS = $(WIN32_OBJS)
+- faster layout\r
+- tiled window manager\r
+- c primitive arrays: or just specialized arrays\r
+ float, complex, byte, char, cell...\r
+- generational gc\r
+- add a socket timeout\r
+- virtual hosts\r
+- keep alive\r
+- sleep word\r
+- update docs\r
+- redo new compiler backend for PowerPC\r
+\r
+- plugin: supportsBackspace\r
- if external factor is down, don't add tons of random shit to the \r
dictionary\r
-- faster layout\r
- SDL_Rect** type\r
- get all-tests to run with -no-compile\r
- fix i/o on generic x86/ppc unix\r
- 2map slow with lists\r
- nappend: instead of using push, enlarge the sequence with set-length\r
then add set the elements with set-nth\r
+- faster sequence operations\r
- generic each some? all? memq? all=? index? subseq? map\r
- index and index* are very slow with lists\r
- unsafe-sbuf>string\r
- GENERIC: map\r
- list impl same as now\r
- code walker & exceptions\r
-- generational gc\r
- if two tasks write to a unix stream, the buffer can overflow\r
- rename prettyprint to pprint\r
- reader syntax for arrays, byte arrays, displaced aliens\r
-- add a socket timeout\r
-- virtual hosts\r
-- keep alive\r
- dipping seq-2nmap, seq-2each\r
- array sort\r
-- tiled window manager\r
-- redo new compiler backend for PowerPC\r
-- weird bug uncovered during bootstrap stress-test\r
- images saved from plugin do not work\r
- making an image from plugin hangs\r
- generic skip\r
- inference needs to be more robust with heavily recursive code\r
+- investigate orphans\r
\r
+ plugin:\r
\r
\r
+ compiler:\r
\r
+- [ EAX 0 ] --> [ EAX ]\r
+- intrinsic char-slot set-char-slot integer-slot set-integer-slot\r
- optimize the generic word prologue\r
- [ [ dup call ] dup call ] infer hangs\r
- more accurate types for various words\r
//{{{ compareTo() method
public int compareTo(Object o)
{
- return name.compareTo(((FactorWord)o).name);
+ int c = name.compareTo(((FactorWord)o).name);
+ if(c == 0)
+ {
+ return String.valueOf(vocabulary)
+ .compareTo(String.valueOf(
+ ((FactorWord)o).vocabulary));
+ }
+ else
+ return c;
} //}}}
}
( relocation base at end of header ) base emit
( bootstrap quotation set later ) 0 emit
( global namespace set later ) 0 emit
+ ( pointer to t object ) 0 emit
+ ( pointer to bignum 0 ) 0 emit
+ ( pointer to bignum 1 ) 0 emit
+ ( pointer to bignum -1 ) 0 emit
( size of heap set later ) 0 emit ;
: boot-quot-offset 3 ;
: global-offset 4 ;
-: heap-size-offset 5 ;
-: header-size 6 ;
+: t-offset 5 ;
+: 0-offset 6 ;
+: 1-offset 7 ;
+: -1-offset 8 ;
+: heap-size-offset 9 ;
+: header-size 10 ;
GENERIC: ' ( obj -- ptr )
#! Write an object to the image.
! Padded with fixnums for 8-byte alignment
: t,
- object-tag here-as "t" set
+ object-tag here-as
+ dup t-offset fixup "t" set
t-type >header emit
0 ' emit ;
#! f is #define F RETAG(0,OBJECT_TYPE)
drop object-tag ;
-: 0, 0 >bignum ' drop ;
-: 1, 1 >bignum ' drop ;
-: -1, -1 >bignum ' drop ;
+: 0, 0 >bignum ' 0-offset fixup ;
+: 1, 1 >bignum ' 1-offset fixup ;
+: -1, -1 >bignum ' -1-offset fixup ;
( Beginning of the image )
! The image begins with the header, then T,
"Got: " write assert-got . ;
: assert= ( a b -- )
- 2dup = [ <assert> throw ] unless ;
+ 2dup = [ 2drop ] [ <assert> throw ] ifte ;
: print-test ( input output -- )
"--> " write 2list . flush ;
untag_bignum_fast(dpeek()))));
}
-void copy_bignum_constants(void)
-{
- COPY_OBJECT(bignum_zero);
- COPY_OBJECT(bignum_pos_one);
- COPY_OBJECT(bignum_neg_one);
-}
-
void box_signed_cell(F_FIXNUM integer)
{
dpush(tag_integer(integer));
void primitive_bignum_greater(void);
void primitive_bignum_greatereq(void);
void primitive_bignum_not(void);
-void copy_bignum_constants(void);
INLINE CELL tag_integer(F_FIXNUM x)
{
void init_compiler(CELL size)
{
- init_zone(&compiling,size);
+ compiling.base = compiling.here = (CELL)alloc_guarded(size);
+ if(compiling.base == 0)
+ fatal_error("Cannot allocate code heap",size);
+ compiling.limit = compiling.base + size;
last_flush = compiling.base;
}
#include "factor.h"
void init_factor(char* image, CELL ds_size, CELL cs_size,
- CELL data_size, CELL code_size, CELL literal_size)
+ CELL young_size, CELL aging_size,
+ CELL code_size, CELL literal_size)
{
srand((unsigned)time(NULL)); /* initialize random number generator */
init_ffi();
- init_arena(data_size);
+ init_arena(young_size,aging_size);
init_compiler(code_size);
load_image(image,literal_size);
init_stacks(ds_size,cs_size);
{
CELL ds_size = 2048;
CELL cs_size = 2048;
- CELL data_size = 16;
+ CELL young_size = 4;
+ CELL aging_size = 8;
CELL code_size = 2;
CELL literal_size = 64;
CELL args;
printf("Runtime options -- n is a number:\n");
printf(" +Dn Data stack size, kilobytes\n");
printf(" +Cn Call stack size, kilobytes\n");
- printf(" +Mn Data heap size, megabytes\n");
+ printf(" +Yn Size of %d youngest generations, megabytes\n",
+ GC_GENERATIONS-1);
+ printf(" +An Size of tenured and semi-spaces, megabytes\n");
printf(" +Xn Code heap size, megabytes\n");
printf(" +Ln Literal table size, kilobytes. Only for bootstrapping\n");
printf("Other options are handled by the Factor library.\n");
{
if(factor_arg(argv[i],"+D%d",&ds_size)) continue;
if(factor_arg(argv[i],"+C%d",&cs_size)) continue;
- if(factor_arg(argv[i],"+M%d",&data_size)) continue;
+ if(factor_arg(argv[i],"+Y%d",&young_size)) continue;
+ if(factor_arg(argv[i],"+A%d",&aging_size)) continue;
if(factor_arg(argv[i],"+X%d",&code_size)) continue;
if(factor_arg(argv[i],"+L%d",&literal_size)) continue;
init_factor(argv[1],
ds_size * 1024,
cs_size * 1024,
- data_size * 1024 * 1024,
+ young_size * 1024 * 1024,
+ aging_size * 1024 * 1024,
code_size * 1024 * 1024,
literal_size * 1024);
#include "factor.h"
-/* Stop-and-copy garbage collection using Cheney's algorithm. */
-
-/* #define GC_DEBUG */
-
-INLINE void gc_debug(char* msg, CELL x) {
-#ifdef GC_DEBUG
- printf("%s %d\n",msg,x);
-#endif
-}
+/* Generational copying garbage collector */
void collect_roots(void)
{
int i;
-
CELL ptr;
- /*T must be the first in the heap */
+ gc_debug("root: t",T);
COPY_OBJECT(T);
- /* the bignum 0 1 -1 constants must be the next three */
- copy_bignum_constants();
+ gc_debug("root: bignum_zero",bignum_zero);
+ COPY_OBJECT(bignum_zero);
+ gc_debug("root: bignum_pos_one",bignum_pos_one);
+ COPY_OBJECT(bignum_pos_one);
+ gc_debug("root: bignum_neg_one",bignum_neg_one);
+ COPY_OBJECT(bignum_neg_one);
+ gc_debug("root: callframe",callframe);
COPY_OBJECT(callframe);
+ gc_debug("root: executing",executing);
COPY_OBJECT(executing);
for(ptr = ds_bot; ptr <= ds; ptr += CELLS)
copy_handle(&userenv[i]);
}
+void clear_cards(void)
+{
+ BYTE *ptr;
+ for(ptr = cards; ptr < cards_end; ptr++)
+ clear_card(ptr);
+}
+
+void collect_cards(void)
+{
+ BYTE *ptr;
+ for(ptr = cards; ptr < cards_end; ptr++)
+ {
+ CARD c = *ptr;
+ if(card_marked(*ptr))
+ {
+ CELL offset = (c & CARD_BASE_MASK);
+ if(offset == 0x7f)
+ critical_error("bad card",c);
+ CELL ea = (CELL)CARD_TO_ADDR(c) + offset;
+ printf("write barrier hit %d\n",offset);
+ printf("object header: %x\n",get(ea));
+ clear_card(ptr);
+ }
+ }
+}
+
/*
Given a pointer to a tagged pointer to oldspace, copy it to newspace.
If the object has already been copied, return the forwarding
{
CELL newpointer;
-#ifdef GC_DEBUG
- if(in_zone(&active,pointer))
- critical_error("copy_object given newspace ptr",pointer);
-#endif
-
gc_debug("copy_object",pointer);
newpointer = (CELL)copy_untagged_object((void*)UNTAG(pointer),
object_size(pointer));
flip_zones();
scan = active.base;
+
collect_roots();
+ collect_cards();
+
/* collect literal objects referenced from compiled code */
collect_literals();
CELL copy_object_impl(CELL pointer);
+/* #define GC_DEBUG */
+
+INLINE void gc_debug(char* msg, CELL x) {
+#ifdef GC_DEBUG
+ printf("%s %d\n",msg,x);
+#endif
+}
+
INLINE CELL copy_object(CELL pointer)
{
CELL tag;
CELL header;
CELL untagged;
+ gc_debug("copy object",pointer);
+
if(pointer == F)
return F;
header = get(UNTAG(pointer));
untagged = UNTAG(header);
if(TAG(header) != FIXNUM_TYPE && in_zone(&active,untagged))
+ {
+ gc_debug("forwarding",untagged);
return RETAG(untagged,tag);
+ }
else
return RETAG(copy_object_impl(pointer),tag);
}
}
void collect_roots(void);
+void collect_cards(void);
+void clear_cards(void);
void primitive_gc(void);
void maybe_garbage_collection(void);
void primitive_gc_time(void);
#include "factor.h"
+void init_objects(HEADER *h)
+{
+ int i;
+ for(i = 0; i < USER_ENV; i++)
+ userenv[i] = F;
+ profile_depth = 0;
+ executing = F;
+
+ userenv[GLOBAL_ENV] = h->global;
+ userenv[BOOT_ENV] = h->boot;
+ T = h->t;
+ bignum_zero = h->bignum_zero;
+ bignum_pos_one = h->bignum_pos_one;
+ bignum_neg_one = h->bignum_neg_one;
+}
+
void load_image(char* filename, int literal_table)
{
FILE* file;
printf(" relocating...");
fflush(stdout);
- clear_environment();
-
- userenv[GLOBAL_ENV] = h.global;
- userenv[BOOT_ENV] = h.boot;
+ init_objects(&h);
relocate_data();
relocate_code();
h.boot = userenv[BOOT_ENV];
h.size = active.here - active.base;
h.global = userenv[GLOBAL_ENV];
+ h.t = T;
+ h.bignum_zero = bignum_zero;
+ h.bignum_pos_one = bignum_pos_one;
+ h.bignum_neg_one = bignum_neg_one;
fwrite(&h,sizeof(HEADER),1,file);
ext_h.size = compiling.here - compiling.base;
CELL boot;
/* tagged pointer to global namespace */
CELL global;
+ /* tagged pointer to t singleton */
+ CELL t;
+ /* tagged pointer to bignum 0 */
+ CELL bignum_zero;
+ /* tagged pointer to bignum 1 */
+ CELL bignum_pos_one;
+ /* tagged pointer to bignum -1 */
+ CELL bignum_neg_one;
/* size of heap */
CELL size;
} HEADER;
CELL literal_max;
} HEADER_2;
+void init_objects(HEADER *h);
void load_image(char* file, int literal_size);
bool save_image(char* file);
void primitive_save_image(void);
#include "factor.h"
-/* set up guard pages to check for under/overflow.
-size must be a multiple of the page size */
-
-#ifdef WIN32
-void *alloc_guarded(CELL size)
+void dump_generations(void)
{
- SYSTEM_INFO si;
- char *mem;
- DWORD ignore;
-
- GetSystemInfo(&si);
- mem = (char *)VirtualAlloc(NULL, si.dwPageSize*2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
+ int i;
+ for(i = 0; i < GC_GENERATIONS; i++)
+ {
+ fprintf(stderr,"Generation %d: base=%d, size=%d, here=%d\n",
+ i,
+ generations[i].base,
+ generations[i].limit - generations[i].base,
+ generations[i].here);
+ }
- if (!VirtualProtect(mem, si.dwPageSize, PAGE_NOACCESS, &ignore))
- fatal_error("Cannot allocate low guard page", (CELL)mem);
+ fprintf(stderr,"Semispace: base=%d, size=%d, here=%d\n",
+ prior.base,
+ prior.limit - prior.base,
+ prior.here);
- if (!VirtualProtect(mem+size+si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &ignore))
- fatal_error("Cannot allocate high guard page", (CELL)mem);
+ fprintf(stderr,"Cards: base=%d, size=%d\n",cards,cards_end - cards);
+}
- return mem + si.dwPageSize;
+CELL init_zone(ZONE *z, CELL size, CELL base)
+{
+ z->base = z->here = base;
+ z->limit = z->base + size;
+ z->alarm = z->base + (size * 3) / 4;
+ return z->limit;
}
-#else
-void* alloc_guarded(CELL size)
+
+/* input parameters must be 8 byte aligned */
+void init_arena(CELL young_size, CELL aging_size)
{
- int pagesize = getpagesize();
+ CELL total_size = (GC_GENERATIONS - 1) * young_size + 2 * aging_size;
+ CELL cards_size = total_size / CARD_SIZE;
+
+ heap_start = (CELL)alloc_guarded(total_size);
+ cards = alloc_guarded(cards_size);
+ cards_end = cards + cards_size;
+ clear_cards();
- char* array = mmap((void*)0,pagesize + size + pagesize,
- PROT_READ | PROT_WRITE | PROT_EXEC,
- MAP_ANON | MAP_PRIVATE,-1,0);
+ int i;
+ CELL alloter = heap_start;
- if(mprotect(array,pagesize,PROT_NONE) == -1)
- fatal_error("Cannot allocate low guard page",(CELL)array);
+ if(heap_start == 0)
+ fatal_error("Cannot allocate data heap",total_size);
- if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1)
- fatal_error("Cannot allocate high guard page",(CELL)array);
+ alloter = init_zone(&generations[TENURED],aging_size,alloter);
+ alloter = init_zone(&prior,aging_size,alloter);
- /* return bottom of actual array */
- return array + pagesize;
-}
-#endif
+ for(i = 0; i < GC_GENERATIONS - 1; i++)
+ alloter = init_zone(&generations[i],young_size,alloter);
-void init_zone(ZONE* z, CELL size)
-{
- z->base = z->here = align8((CELL)alloc_guarded(size));
- if(z->base == 0)
- fatal_error("Cannot allocate zone",size);
- z->limit = z->base + size;
- z->alarm = z->base + (size * 3) / 4;
- z->base = align8(z->base);
-}
+ if(alloter != heap_start + total_size)
+ fatal_error("Oops",alloter);
-void init_arena(CELL size)
-{
- init_zone(&active,size);
- init_zone(&prior,size);
allot_profiling = false;
gc_in_progress = false;
heap_scan = false;
gc_time = 0;
+
+ dump_generations();
}
void allot_profile_step(CELL a)
active.here = active.base;
}
-bool in_zone(ZONE* z, CELL pointer)
-{
- return pointer >= z->base && pointer < z->limit;
-}
-
void primitive_room(void)
{
box_signed_cell(compiling.limit - compiling.here);
+/* macros for reading/writing memory, useful when working around
+C's type system */
+INLINE CELL get(CELL where)
+{
+ return *((CELL*)where);
+}
+
+INLINE void put(CELL where, CELL what)
+{
+ *((CELL*)where) = what;
+}
+
+INLINE u16 cget(CELL where)
+{
+ return *((u16*)where);
+}
+
+INLINE void cput(CELL where, u16 what)
+{
+ *((u16*)where) = what;
+}
+
+INLINE BYTE bget(CELL where)
+{
+ return *((BYTE*)where);
+}
+
+INLINE void bput(CELL where, BYTE what)
+{
+ *((BYTE*)where) = what;
+}
+
+/* generational copying GC divides memory into zones */
typedef struct {
+ /* start of zone */
CELL base;
+ /* allocation pointer */
CELL here;
+ /* only for nursery: when it gets this full, call GC */
CELL alarm;
+ /* end of zone */
CELL limit;
} ZONE;
-ZONE active;
+INLINE bool in_zone(ZONE* z, CELL pointer)
+{
+ return pointer >= z->base && pointer < z->limit;
+}
+
+/* total number of generations. */
+#define GC_GENERATIONS 3
+/* the 0th generation is where new objects are allocated. */
+#define NURSERY 0
+/* the oldest generation */
+#define TENURED (GC_GENERATIONS-1)
+
+ZONE generations[GC_GENERATIONS];
+
+CELL heap_start;
+
+#define active generations[TENURED]
+
+/* spare semi-space; rotates with generations[TENURED]. */
ZONE prior;
-bool allot_profiling;
+/* card marking write barrier. a card is a byte storing a mark flag,
+and the offset (in cells) of the first object in the card.
-void* alloc_guarded(CELL size);
-void init_zone(ZONE* zone, CELL size);
-void init_arena(CELL size);
-void flip_zones();
+the mark flag is set by the write barrier when an object in the
+card has a slot written to.
-void allot_profile_step(CELL a);
+the offset of the first object is set by the allocator.
+*/
+#define CARD_MARK_MASK 0x80
+#define CARD_BASE_MASK 0x7f
+typedef u8 CARD;
+CARD *cards;
+CARD *cards_end;
-INLINE CELL align8(CELL a)
+/* A card is 16 bytes (128 bits), 5 address bits per card.
+it is important that 7 bits is sufficient to represent every
+offset within the card */
+#define CARD_SIZE 16
+#define CARD_BITS 4
+#define CARD_MASK CARD_SIZE-1
+
+INLINE CARD card_marked(CARD c)
{
- return ((a & 7) == 0) ? a : ((a + 8) & ~7);
+ return c & CARD_MARK_MASK;
}
-INLINE void* allot(CELL a)
+INLINE void clear_card(CARD *c)
{
- CELL h = active.here;
- active.here += align8(a);
- if(allot_profiling)
- allot_profile_step(align8(a));
- return (void*)h;
+ *c = CARD_BASE_MASK;
}
-INLINE CELL get(CELL where)
+INLINE u8 card_base(CARD c)
{
- return *((CELL*)where);
+ return c & CARD_BASE_MASK;
}
-INLINE void put(CELL where, CELL what)
+INLINE void rebase_card(CARD *c, u8 base)
{
- *((CELL*)where) = what;
+ *c = base;
}
-INLINE u16 cget(CELL where)
+#define ADDR_TO_CARD(a) (CARD*)(((a-heap_start)>>CARD_BITS)+(CELL)cards)
+#define CARD_TO_ADDR(c) (CELL*)(((c-(CELL)cards)<<CARD_BITS)+heap_start)
+
+/* this is an inefficient write barrier. compiled definitions use a more
+efficient one hand-coded in assembly. the write barrier must be called
+any time we are potentially storing a pointer from an older generation
+to a younger one */
+INLINE void write_barrier(CELL address)
{
- return *((u16*)where);
+ CARD *c = ADDR_TO_CARD(address);
+ *c |= CARD_MARK_MASK;
}
-INLINE void cput(CELL where, u16 what)
+/* we need to remember the first object allocated in the card */
+INLINE void allot_barrier(CELL address)
{
- *((u16*)where) = what;
+ CARD *c = ADDR_TO_CARD(address);
+ /* we need to remember the first object allocated in the
+ card */
+ rebase_card(c,MIN(card_base(*c),address & CARD_MASK));
}
-INLINE BYTE bget(CELL where)
+bool allot_profiling;
+
+/* set up guard pages to check for under/overflow.
+size must be a multiple of the page size */
+void* alloc_guarded(CELL size);
+
+void dump_generations(void);
+CELL init_zone(ZONE *z, CELL size, CELL base);
+void init_arena(CELL young_size, CELL aging_size);
+void flip_zones();
+
+void allot_profile_step(CELL a);
+
+INLINE CELL align8(CELL a)
{
- return *((BYTE*)where);
+ return ((a & 7) == 0) ? a : ((a + 8) & ~7);
}
-INLINE void bput(CELL where, BYTE what)
+INLINE void* allot(CELL a)
{
- *((BYTE*)where) = what;
+ CELL h = active.here;
+ allot_barrier(h);
+ active.here += align8(a);
+ if(allot_profiling)
+ allot_profile_step(align8(a));
+ return (void*)h;
}
bool in_zone(ZONE* z, CELL pointer);
void relocate_object(CELL relocating)
{
+ allot_barrier(relocating);
+
switch(untag_header(get(relocating)))
{
case WORD_TYPE:
return relocating + size;
}
-INLINE CELL init_object(CELL relocating, CELL* handle, CELL type)
-{
- if(untag_header(get(relocating)) != type)
- fatal_error("init_object() failed",get(relocating));
- *handle = tag_object((CELL*)relocating);
- return relocate_data_next(relocating);
-}
-
void relocate_data()
{
CELL relocating = active.base;
data_fixup(&userenv[BOOT_ENV]);
data_fixup(&userenv[GLOBAL_ENV]);
-
- /* The first object in the image must always T */
- relocating = init_object(relocating,&T,T_TYPE);
-
- /* The next three must be bignum 0, 1, -1 */
- relocating = init_object(relocating,&bignum_zero,BIGNUM_TYPE);
- relocating = init_object(relocating,&bignum_pos_one,BIGNUM_TYPE);
- relocating = init_object(relocating,&bignum_neg_one,BIGNUM_TYPE);
+ printf("%d\n",T);
+ printf("%d\n",bignum_zero);
+ printf("%d\n",bignum_pos_one);
+ printf("%d\n",bignum_neg_one);
+ data_fixup(&T);
+ data_fixup(&bignum_zero);
+ data_fixup(&bignum_pos_one);
+ data_fixup(&bignum_neg_one);
for(;;)
{
#include "factor.h"
-void clear_environment(void)
-{
- int i;
- for(i = 0; i < USER_ENV; i++)
- userenv[i] = F;
- profile_depth = 0;
- executing = F;
-}
-
INLINE void execute(F_WORD* word)
{
((XT)(word->xt))(word);
callframe = quot;
}
-void clear_environment(void);
-
void run(void);
void platform_run(void);
void undefined(F_WORD* word);
drepl(tag_fixnum(type_of(dpeek())));
}
-#define SLOT(obj,slot) UNTAG(obj) + slot * CELLS
+#define SLOT(obj,slot) ((obj) + (slot) * CELLS)
void primitive_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
- CELL obj = dpop();
+ CELL obj = UNTAG(dpop());
dpush(get(SLOT(obj,slot)));
}
void primitive_set_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
- CELL obj = dpop();
+ CELL obj = UNTAG(dpop());
CELL value = dpop();
put(SLOT(obj,slot),value);
+ write_barrier(obj);
}
void primitive_integer_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
- CELL obj = dpop();
+ CELL obj = UNTAG(dpop());
dpush(tag_integer(get(SLOT(obj,slot))));
}
void primitive_set_integer_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
- CELL obj = dpop();
+ CELL obj = UNTAG(dpop());
F_FIXNUM value = to_fixnum(dpop());
put(SLOT(obj,slot),value);
}
--- /dev/null
+#include "../factor.h"
+
+void *alloc_guarded(CELL size)
+{
+ int pagesize = getpagesize();
+
+ char* array = mmap((void*)0,pagesize + size + pagesize,
+ PROT_READ | PROT_WRITE | PROT_EXEC,
+ MAP_ANON | MAP_PRIVATE,-1,0);
+
+ if(mprotect(array,pagesize,PROT_NONE) == -1)
+ fatal_error("Cannot allocate low guard page",(CELL)array);
+
+ if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1)
+ fatal_error("Cannot allocate high guard page",(CELL)array);
+
+ /* return bottom of actual array */
+ return array + pagesize;
+}
--- /dev/null
+#include "../factor.h"
+
+void *alloc_guarded(CELL size)
+{
+ SYSTEM_INFO si;
+ char *mem;
+ DWORD ignore;
+
+ GetSystemInfo(&si);
+ mem = (char *)VirtualAlloc(NULL, si.dwPageSize*2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
+
+ if (!VirtualProtect(mem, si.dwPageSize, PAGE_NOACCESS, &ignore))
+ fatal_error("Cannot allocate low guard page", (CELL)mem);
+
+ if (!VirtualProtect(mem+size+si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &ignore))
+ fatal_error("Cannot allocate high guard page", (CELL)mem);
+
+ return mem + si.dwPageSize;
+}
projects / factor.git / commitdiff