From 16c95ca373f97114b9c7ae6c38cafed8dc20336b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 11 May 2005 02:30:58 +0000 Subject: [PATCH] starting generational GC --- Makefile | 20 +++-- TODO.FACTOR.txt | 25 ++++-- factor/FactorWord.java | 10 ++- library/bootstrap/image.factor | 21 +++-- library/test/test.factor | 2 +- native/bignum.c | 7 -- native/bignum.h | 1 - native/compiler.c | 5 +- native/factor.c | 18 ++-- native/gc.c | 57 ++++++++---- native/gc.h | 15 ++++ native/image.c | 25 +++++- native/image.h | 9 ++ native/memory.c | 96 ++++++++++---------- native/memory.h | 159 ++++++++++++++++++++++++++------- native/relocate.c | 26 +++--- native/run.c | 9 -- native/run.h | 2 - native/types.c | 11 +-- native/unix/memory.c | 19 ++++ native/win32/memory.c | 19 ++++ 21 files changed, 381 insertions(+), 175 deletions(-) create mode 100644 native/unix/memory.c create mode 100644 native/win32/memory.c diff --git a/Makefile b/Makefile index e315c7dd7c..ece0aa04ee 100644 --- a/Makefile +++ b/Makefile @@ -1,16 +1,22 @@ 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) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index e1c03c1385..47dc28fcfc 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,6 +1,18 @@ +- faster layout +- tiled window manager +- c primitive arrays: or just specialized arrays + float, complex, byte, char, cell... +- generational gc +- add a socket timeout +- virtual hosts +- keep alive +- sleep word +- update docs +- redo new compiler backend for PowerPC + +- plugin: supportsBackspace - if external factor is down, don't add tons of random shit to the dictionary -- faster layout - SDL_Rect** type - get all-tests to run with -no-compile - fix i/o on generic x86/ppc unix @@ -8,6 +20,7 @@ - 2map slow with lists - nappend: instead of using push, enlarge the sequence with set-length then add set the elements with set-nth +- faster sequence operations - generic each some? all? memq? all=? index? subseq? map - index and index* are very slow with lists - unsafe-sbuf>string @@ -15,22 +28,16 @@ - GENERIC: map - list impl same as now - code walker & exceptions -- generational gc - if two tasks write to a unix stream, the buffer can overflow - rename prettyprint to pprint - reader syntax for arrays, byte arrays, displaced aliens -- add a socket timeout -- virtual hosts -- keep alive - dipping seq-2nmap, seq-2each - array sort -- tiled window manager -- redo new compiler backend for PowerPC -- weird bug uncovered during bootstrap stress-test - images saved from plugin do not work - making an image from plugin hangs - generic skip - inference needs to be more robust with heavily recursive code +- investigate orphans + plugin: @@ -61,6 +68,8 @@ + compiler: +- [ EAX 0 ] --> [ EAX ] +- intrinsic char-slot set-char-slot integer-slot set-integer-slot - optimize the generic word prologue - [ [ dup call ] dup call ] infer hangs - more accurate types for various words diff --git a/factor/FactorWord.java b/factor/FactorWord.java index bcfddc0a6d..670f4d1df7 100644 --- a/factor/FactorWord.java +++ b/factor/FactorWord.java @@ -107,6 +107,14 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable, //{{{ 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; } //}}} } diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 414f6b36f5..9150699579 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -65,12 +65,20 @@ SYMBOL: boot-quot ( 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. @@ -117,7 +125,8 @@ M: bignum ' ( bignum -- tagged ) ! 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 ; @@ -126,9 +135,9 @@ M: f ' ( obj -- ptr ) #! 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, diff --git a/library/test/test.factor b/library/test/test.factor index 6dff74bd02..6aced11881 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -11,7 +11,7 @@ M: assert error. "Got: " write assert-got . ; : assert= ( a b -- ) - 2dup = [ throw ] unless ; + 2dup = [ 2drop ] [ throw ] ifte ; : print-test ( input output -- ) "--> " write 2list . flush ; diff --git a/native/bignum.c b/native/bignum.c index f316891658..371f87379e 100644 --- a/native/bignum.c +++ b/native/bignum.c @@ -207,13 +207,6 @@ void primitive_bignum_not(void) 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)); diff --git a/native/bignum.h b/native/bignum.h index 0c5e1f9396..2475b9faa3 100644 --- a/native/bignum.h +++ b/native/bignum.h @@ -32,7 +32,6 @@ void primitive_bignum_lesseq(void); 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) { diff --git a/native/compiler.c b/native/compiler.c index 6ffdf42418..c381f9ffe9 100644 --- a/native/compiler.c +++ b/native/compiler.c @@ -2,7 +2,10 @@ 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; } diff --git a/native/factor.c b/native/factor.c index a36661361f..04e76635ed 100644 --- a/native/factor.c +++ b/native/factor.c @@ -1,11 +1,12 @@ #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); @@ -32,7 +33,8 @@ int main(int argc, char** argv) { 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; @@ -44,7 +46,9 @@ int main(int argc, char** argv) 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"); @@ -57,7 +61,8 @@ int main(int argc, char** argv) { 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; @@ -71,7 +76,8 @@ int main(int argc, char** argv) 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); diff --git a/native/gc.c b/native/gc.c index 3017417651..a6284f799d 100644 --- a/native/gc.c +++ b/native/gc.c @@ -1,26 +1,23 @@ #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) @@ -33,6 +30,32 @@ void collect_roots(void) 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 @@ -43,11 +66,6 @@ CELL copy_object_impl(CELL pointer) { 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)); @@ -120,7 +138,10 @@ void primitive_gc(void) flip_zones(); scan = active.base; + collect_roots(); + collect_cards(); + /* collect literal objects referenced from compiled code */ collect_literals(); diff --git a/native/gc.h b/native/gc.h index 42e4f6a808..6ed8665a4a 100644 --- a/native/gc.h +++ b/native/gc.h @@ -16,12 +16,22 @@ INLINE void* copy_untagged_object(void* pointer, CELL size) 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; @@ -33,7 +43,10 @@ INLINE CELL copy_object(CELL pointer) 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); } @@ -46,6 +59,8 @@ INLINE void copy_handle(CELL* handle) } 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); diff --git a/native/image.c b/native/image.c index 5dcacd81a8..857f89d8e9 100644 --- a/native/image.c +++ b/native/image.c @@ -1,5 +1,21 @@ #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; @@ -67,10 +83,7 @@ void load_image(char* filename, int literal_table) printf(" relocating..."); fflush(stdout); - clear_environment(); - - userenv[GLOBAL_ENV] = h.global; - userenv[BOOT_ENV] = h.boot; + init_objects(&h); relocate_data(); relocate_code(); @@ -97,6 +110,10 @@ bool save_image(char* filename) 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; diff --git a/native/image.h b/native/image.h index eb2acbffe1..f422a73fcf 100644 --- a/native/image.h +++ b/native/image.h @@ -12,6 +12,14 @@ typedef struct { 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; @@ -28,6 +36,7 @@ typedef struct EXT_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); diff --git a/native/memory.c b/native/memory.c index 3d42a00580..87cdf0d2a8 100644 --- a/native/memory.c +++ b/native/memory.c @@ -1,64 +1,65 @@ #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; + 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); + } - GetSystemInfo(&si); - mem = (char *)VirtualAlloc(NULL, si.dwPageSize*2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE); + fprintf(stderr,"Semispace: base=%d, size=%d, here=%d\n", + prior.base, + prior.limit - prior.base, + prior.here); - 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; + fprintf(stderr,"Cards: base=%d, size=%d\n",cards,cards_end - cards); } -#else -void* alloc_guarded(CELL size) + +CELL init_zone(ZONE *z, CELL size, CELL base) { - 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; -} -#endif - -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->base = z->here = base; z->limit = z->base + size; z->alarm = z->base + (size * 3) / 4; - z->base = align8(z->base); + return z->limit; } -void init_arena(CELL size) +/* input parameters must be 8 byte aligned */ +void init_arena(CELL young_size, CELL aging_size) { - init_zone(&active,size); - init_zone(&prior,size); + 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(); + + int i; + CELL alloter = heap_start; + + if(heap_start == 0) + fatal_error("Cannot allocate data heap",total_size); + + alloter = init_zone(&generations[TENURED],aging_size,alloter); + alloter = init_zone(&prior,aging_size,alloter); + + for(i = 0; i < GC_GENERATIONS - 1; i++) + alloter = init_zone(&generations[i],young_size,alloter); + + if(alloter != heap_start + total_size) + fatal_error("Oops",alloter); + allot_profiling = false; gc_in_progress = false; heap_scan = false; gc_time = 0; + + dump_generations(); } void allot_profile_step(CELL a) @@ -90,11 +91,6 @@ void flip_zones() 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); diff --git a/native/memory.h b/native/memory.h index 8c18044fbd..c9e981d337 100644 --- a/native/memory.h +++ b/native/memory.h @@ -1,36 +1,5 @@ -typedef struct { - CELL base; - CELL here; - CELL alarm; - CELL limit; -} ZONE; - -ZONE active; -ZONE prior; - -bool allot_profiling; - -void* alloc_guarded(CELL size); -void init_zone(ZONE* zone, CELL size); -void init_arena(CELL size); -void flip_zones(); - -void allot_profile_step(CELL a); - -INLINE CELL align8(CELL a) -{ - return ((a & 7) == 0) ? a : ((a + 8) & ~7); -} - -INLINE void* allot(CELL a) -{ - CELL h = active.here; - active.here += align8(a); - if(allot_profiling) - allot_profile_step(align8(a)); - return (void*)h; -} - +/* macros for reading/writing memory, useful when working around +C's type system */ INLINE CELL get(CELL where) { return *((CELL*)where); @@ -61,6 +30,130 @@ 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; + +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; + +/* 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. + +the mark flag is set by the write barrier when an object in the +card has a slot written to. + +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; + +/* 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 c & CARD_MARK_MASK; +} + +INLINE void clear_card(CARD *c) +{ + *c = CARD_BASE_MASK; +} + +INLINE u8 card_base(CARD c) +{ + return c & CARD_BASE_MASK; +} + +INLINE void rebase_card(CARD *c, u8 base) +{ + *c = base; +} + +#define ADDR_TO_CARD(a) (CARD*)(((a-heap_start)>>CARD_BITS)+(CELL)cards) +#define CARD_TO_ADDR(c) (CELL*)(((c-(CELL)cards)<xt))(word); diff --git a/native/run.h b/native/run.h index 090374bfa9..5abd78da3c 100644 --- a/native/run.h +++ b/native/run.h @@ -85,8 +85,6 @@ INLINE void call(CELL quot) callframe = quot; } -void clear_environment(void); - void run(void); void platform_run(void); void undefined(F_WORD* word); diff --git a/native/types.c b/native/types.c index d752e2fb32..ddc5ed7bc5 100644 --- a/native/types.c +++ b/native/types.c @@ -96,34 +96,35 @@ void primitive_type(void) 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); } diff --git a/native/unix/memory.c b/native/unix/memory.c new file mode 100644 index 0000000000..d57c37a4a4 --- /dev/null +++ b/native/unix/memory.c @@ -0,0 +1,19 @@ +#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; +} diff --git a/native/win32/memory.c b/native/win32/memory.c new file mode 100644 index 0000000000..285d72de7f --- /dev/null +++ b/native/win32/memory.c @@ -0,0 +1,19 @@ +#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; +}