From 91c665935996033e77798865dd7a893798d8a7ba Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 15 May 2006 02:03:01 +0000 Subject: [PATCH 001/468] Start 0.83 --- version.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/version.factor b/version.factor index 2f8468adf4..4d45846e74 100644 --- a/version.factor +++ b/version.factor @@ -1,2 +1,2 @@ IN: kernel -: version "0.82" ; +: version "0.83" ; From 63825f92096f5875b6f9d4c4760f90437b30b2c9 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 15 May 2006 03:09:47 +0000 Subject: [PATCH 002/468] >r and r> now use their own stack --- Makefile | 2 +- library/bootstrap/primitives.factor | 2 ++ library/continuations.factor | 13 +++++++--- library/threads.factor | 4 ++- library/tools/debugger.factor | 6 +++-- library/tools/describe.factor | 3 ++- native/debug.c | 8 ++++-- native/error.c | 1 + native/error.h | 7 +++-- native/factor.c | 12 ++++++--- native/factor.h | 34 +++++++----------------- native/gc.c | 24 ++++++++--------- native/primitives.c | 2 ++ native/run.c | 1 + native/run.h | 13 ++++++++++ native/stack.c | 40 ++++++++++++++++++++++++----- native/stack.h | 14 ++++++++-- 17 files changed, 124 insertions(+), 62 deletions(-) diff --git a/Makefile b/Makefile index e0ae857600..0a1f820663 100644 --- a/Makefile +++ b/Makefile @@ -165,7 +165,7 @@ f: $(OBJS) $(CC) $(LIBS) $(CFLAGS) -o $@$(PLAF_SUFFIX) $(OBJS) clean: - rm -f $(OBJS) + rm -f $(OBJS) $(UNIX_OBJS) $(WINDOWS_OBJS) $(MACOSX_OBJS) .c.o: $(CC) -c $(CFLAGS) -o $@ $< diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index 7b2757e9cb..0d7f1ff61d 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -145,8 +145,10 @@ call { "gc-time" "memory" } { "save-image" "memory" } { "datastack" "kernel" } + { "retainstack" "kernel" } { "callstack" "kernel" } { "set-datastack" "kernel" } + { "set-retainstack" "kernel" } { "set-callstack" "kernel" } { "exit" "kernel" } { "room" "memory" } diff --git a/library/continuations.factor b/library/continuations.factor index fd897ca8ae..b55ac5da92 100644 --- a/library/continuations.factor +++ b/library/continuations.factor @@ -14,14 +14,15 @@ USING: kernel kernel-internals ; IN: kernel USING: namespaces sequences ; -TUPLE: continuation data call name catch ; +TUPLE: continuation data retain call name catch ; : continuation ( -- interp ) - datastack callstack dup pop* dup pop* + datastack retainstack callstack dup pop* dup pop* namestack catchstack ; inline -: >continuation< ( continuation -- data call name catch ) +: >continuation< ( continuation -- data retain call name catch ) [ continuation-data ] keep + [ continuation-retain ] keep [ continuation-call ] keep [ continuation-name ] keep continuation-catch ; inline @@ -36,7 +37,11 @@ TUPLE: continuation data call name catch ; : continue ( continuation -- ) >continuation< - set-catchstack set-namestack set-callstack set-datastack ; + set-catchstack + set-namestack + set-callstack + set-retainstack + set-datastack ; inline : (continue-with) 9 getenv ; diff --git a/library/threads.factor b/library/threads.factor index 1534c9a42e..d78c135cdb 100644 --- a/library/threads.factor +++ b/library/threads.factor @@ -38,7 +38,9 @@ DEFER: next-thread : in-thread ( quot -- ) [ schedule-thread - V{ } set-catchstack V{ } set-callstack + V{ } set-catchstack + V{ } set-callstack + V{ } set-retainstack try stop ] callcc0 drop ; diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 6aa4d5b68e..bfd702ed65 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -124,13 +124,15 @@ M: object error. ( error -- ) . ; : :s ( -- ) error-continuation get continuation-data stack. ; -: :r ( -- ) error-continuation get continuation-call stack. ; +: :r ( -- ) error-continuation get continuation-retain stack. ; + +: :c ( -- ) error-continuation get continuation-call stack. ; : :get ( var -- value ) error-continuation get continuation-name hash-stack ; : debug-help ( -- ) - ":s :r show stacks at time of error" print + ":s :r :c show stacks at time of error" print ":get ( var -- value ) accesses variables at time of error" print ":error starts the inspector with the error" print ":cc starts the inspector with the error continuation" print diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 69c5a66632..987e848197 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -108,4 +108,5 @@ DEFER: describe : stack. ( seq -- seq ) reverse-slice >array describe ; : .s datastack stack. ; -: .r callstack stack. ; +: .r retainstack stack. ; +: .c callstack stack. ; diff --git a/native/debug.c b/native/debug.c index 677a68e885..7aab3e2ae4 100644 --- a/native/debug.c +++ b/native/debug.c @@ -174,8 +174,8 @@ void factorbug(void) fprintf(stderr,"d -- dump memory\n"); fprintf(stderr,"u -- dump object at tagged \n"); fprintf(stderr,". -- print object at tagged \n"); - fprintf(stderr,"s s -- dump data and return stacks\n"); - fprintf(stderr,".s .r -- print data and return stacks\n"); + fprintf(stderr,"s r c -- dump data, retain, call stacks\n"); + fprintf(stderr,".s .r .c -- print data, retain, call stacks\n"); fprintf(stderr,"i -- dump interpreter state\n"); fprintf(stderr,"e -- dump environment\n"); fprintf(stderr,"g -- dump generations\n"); @@ -216,10 +216,14 @@ void factorbug(void) else if(strcmp(cmd,"s") == 0) dump_memory(ds_bot,ds); else if(strcmp(cmd,"r") == 0) + dump_memory(rs_bot,rs); + else if(strcmp(cmd,"c") == 0) dump_memory(cs_bot,cs); else if(strcmp(cmd,".s") == 0) print_objects(ds_bot,ds); else if(strcmp(cmd,".r") == 0) + print_objects(rs_bot,rs); + else if(strcmp(cmd,".c") == 0) print_objects(cs_bot,cs); else if(strcmp(cmd,"i") == 0) { diff --git a/native/error.c b/native/error.c index ed31428110..b098fc1767 100644 --- a/native/error.c +++ b/native/error.c @@ -32,6 +32,7 @@ void throw_error(CELL error, bool keep_stacks) thrown_error = error; thrown_keep_stacks = keep_stacks; thrown_ds = ds; + thrown_rs = rs; thrown_cs = cs; thrown_callframe = callframe; thrown_executing = executing; diff --git a/native/error.h b/native/error.h index 274f7fa5a5..faa3b8f2f0 100644 --- a/native/error.h +++ b/native/error.h @@ -13,8 +13,10 @@ #define ERROR_DS_UNDERFLOW (12<<3) #define ERROR_DS_OVERFLOW (13<<3) #define ERROR_CS_UNDERFLOW (14<<3) -#define ERROR_CS_OVERFLOW (15<<3) -#define ERROR_OBJECTIVE_C (16<<3) +#define ERROR_RS_OVERFLOW (15<<3) +#define ERROR_RS_UNDERFLOW (16<<3) +#define ERROR_CS_OVERFLOW (17<<3) +#define ERROR_OBJECTIVE_C (18<<3) /* Are we throwing an error? */ bool throwing; @@ -25,6 +27,7 @@ CELL thrown_keep_stacks; /* Since longjmp restores registers, we must save all these values. On x86, only the first is in a register; on PowerPC, all are. */ CELL thrown_ds; +CELL thrown_rs; CELL thrown_cs; CELL thrown_callframe; CELL thrown_executing; diff --git a/native/factor.c b/native/factor.c index 4ddac15031..e6f8b8ba40 100644 --- a/native/factor.c +++ b/native/factor.c @@ -1,14 +1,14 @@ #include "factor.h" -void init_factor(const char* image, CELL ds_size, CELL cs_size, - CELL gen_count, - CELL young_size, CELL aging_size, +void init_factor(const char* image, + CELL ds_size, CELL rs_size, CELL cs_size, + CELL gen_count, CELL young_size, CELL aging_size, CELL code_size, CELL literal_size) { init_ffi(); init_arena(gen_count,young_size,aging_size); init_compiler(code_size); - init_stacks(ds_size,cs_size); + init_stacks(ds_size,rs_size,cs_size); /* callframe must be valid in case load_image() does GC */ callframe = F; thrown_error = F; @@ -42,6 +42,7 @@ void usage(void) printf("Usage: factor [ parameters ... ]\n"); printf("Runtime options -- n is a number:\n"); printf(" +Dn Data stack size, kilobytes\n"); + printf(" +Rn Retain stack size, kilobytes\n"); printf(" +Cn Call stack size, kilobytes\n"); printf(" +Gn Number of generations, must be >= 2\n"); printf(" +Yn Size of n-1 youngest generations, megabytes\n"); @@ -56,6 +57,7 @@ int main(int argc, char** argv) { const char *image = NULL; CELL ds_size = 128; + CELL rs_size = 128; CELL cs_size = 128; CELL generations = 2; CELL young_size = 2 * CELLS; @@ -71,6 +73,7 @@ int main(int argc, char** argv) for(i = 1; i < argc; i++) { if(factor_arg(argv[i],"+D%d",&ds_size)) continue; + if(factor_arg(argv[i],"+R%d",&rs_size)) continue; if(factor_arg(argv[i],"+C%d",&cs_size)) continue; if(factor_arg(argv[i],"+G%d",&generations)) continue; if(factor_arg(argv[i],"+Y%d",&young_size)) continue; @@ -96,6 +99,7 @@ int main(int argc, char** argv) init_factor(image, ds_size * 1024, + rs_size * 1024, cs_size * 1024, generations, young_size * 1024 * 1024, diff --git a/native/factor.h b/native/factor.h index 5e46d5319a..ff3ad2dac2 100644 --- a/native/factor.h +++ b/native/factor.h @@ -35,39 +35,23 @@ typedef signed long long s64; /* must always be 8 bits */ typedef unsigned char BYTE; -/* raw pointer to datastack bottom */ -CELL ds_bot; +CELL cs; -/* raw pointer to datastack top */ #if defined(FACTOR_X86) register CELL ds asm("esi"); + register CELL rs asm("ebx"); + CELL cards_offset; #elif defined(FACTOR_PPC) register CELL ds asm("r14"); -#elif defined(FACTOR_AMD64) - register CELL ds asm("r14"); -#else - CELL ds; -#endif - -/* raw pointer to callstack bottom */ -CELL cs_bot; - -/* raw pointer to callstack top */ -#if defined(FACTOR_X86) - register CELL cs asm("ebx"); -#elif defined(FACTOR_PPC) - register CELL cs asm("r15"); -#elif defined(FACTOR_AMD64) - register CELL cs asm("r15"); -#else - CELL cs; -#endif - -#if defined(FACTOR_PPC) + register CELL rs asm("r15"); register CELL cards_offset asm("r16"); #elif defined(FACTOR_AMD64) + register CELL ds asm("r14"); + register CELL rs asm("r15"); register CELL cards_offset asm("r13"); #else + CELL ds; + CELL rs; CELL cards_offset; #endif @@ -104,7 +88,7 @@ CELL executing; #include #include #include - #include + #include #endif #include "debug.h" diff --git a/native/gc.c b/native/gc.c index c166cd934a..316984fbb0 100644 --- a/native/gc.c +++ b/native/gc.c @@ -64,10 +64,18 @@ void init_arena(CELL gens, CELL young_size, CELL aging_size) cards_scanned = 0; } +void collect_stack(BOUNDED_BLOCK *region, CELL top) +{ + CELL bottom = region->start; + CELL ptr; + + for(ptr = bottom; ptr <= top; ptr += CELLS) + copy_handle((CELL*)ptr); +} + void collect_roots(void) { int i; - CELL ptr; STACKS *stacks; copy_handle(&T); @@ -82,17 +90,9 @@ void collect_roots(void) while(stacks) { - CELL bottom = stacks->data_region->start; - CELL top = stacks->data; - - for(ptr = bottom; ptr <= top; ptr += CELLS) - copy_handle((CELL*)ptr); - - bottom = stacks->call_region->start; - top = stacks->call; - - for(ptr = bottom; ptr <= top; ptr += CELLS) - copy_handle((CELL*)ptr); + collect_stack(stacks->data_region,stacks->data); + collect_stack(stacks->retain_region,stacks->retain); + collect_stack(stacks->call_region,stacks->call); copy_handle(&stacks->callframe); copy_handle(&stacks->catch_save); diff --git a/native/primitives.c b/native/primitives.c index bd2ea1226d..ed3a37da61 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -109,8 +109,10 @@ void* primitives[] = { primitive_gc_time, primitive_save_image, primitive_datastack, + primitive_retainstack, primitive_callstack, primitive_set_datastack, + primitive_set_retainstack, primitive_set_callstack, primitive_exit, primitive_room, diff --git a/native/run.c b/native/run.c index 0e6a0fd866..819c98a0c9 100644 --- a/native/run.c +++ b/native/run.c @@ -14,6 +14,7 @@ void handle_error(void) { ds = thrown_ds; cs = thrown_cs; + rs = thrown_rs; callframe = thrown_callframe; executing = thrown_executing; } diff --git a/native/run.h b/native/run.h index 4a1b4a9251..12a48020b3 100644 --- a/native/run.h +++ b/native/run.h @@ -63,6 +63,19 @@ INLINE void cpush(CELL top) put(cs,top); } +INLINE CELL rpop(void) +{ + CELL value = get(rs); + rs -= CELLS; + return value; +} + +INLINE void rpush(CELL top) +{ + rs += CELLS; + put(rs,top); +} + INLINE void call(CELL quot) { /* tail call optimization */ diff --git a/native/stack.c b/native/stack.c index ca3f925cad..392975769a 100644 --- a/native/stack.c +++ b/native/stack.c @@ -5,6 +5,11 @@ void reset_datastack(void) ds = ds_bot - CELLS; } +void reset_retainstack(void) +{ + rs = rs_bot - CELLS; +} + void reset_callstack(void) { cs = cs_bot - CELLS; @@ -16,17 +21,22 @@ void fix_stacks(void) reset_datastack(); else if(STACK_OVERFLOW(ds,stack_chain->data_region)) reset_datastack(); + else if(STACK_UNDERFLOW(rs,stack_chain->retain_region)) + reset_retainstack(); + else if(STACK_OVERFLOW(rs,stack_chain->retain_region)) + reset_retainstack(); else if(STACK_UNDERFLOW(cs,stack_chain->call_region)) reset_callstack(); else if(STACK_OVERFLOW(cs,stack_chain->call_region)) reset_callstack(); } -/* called before entry into foreign C code. Note that ds and cs are stored -in registers, so callbacks must save and restore the correct values */ +/* called before entry into foreign C code. Note that ds, rs and cs might +be stored in registers, so callbacks must save and restore the correct values */ void save_stacks(void) { stack_chain->data = ds; + stack_chain->retain = rs; stack_chain->call = cs; } @@ -46,6 +56,7 @@ void nest_stacks(void) - C function restores registers - C function returns to Factor code */ new_stacks->data_save = ds; + new_stacks->retain_save = rs; new_stacks->call_save = cs; new_stacks->cards_offset = cards_offset; @@ -53,12 +64,15 @@ void nest_stacks(void) new_stacks->catch_save = userenv[CATCHSTACK_ENV]; new_stacks->data_region = alloc_bounded_block(ds_size); + new_stacks->retain_region = alloc_bounded_block(rs_size); new_stacks->call_region = alloc_bounded_block(cs_size); + new_stacks->next = stack_chain; stack_chain = new_stacks; callframe = F; reset_datastack(); + reset_retainstack(); reset_callstack(); update_cards_offset(); } @@ -69,9 +83,11 @@ void unnest_stacks(void) STACKS *old_stacks = stack_chain; dealloc_bounded_block(stack_chain->data_region); + dealloc_bounded_block(stack_chain->retain_region); dealloc_bounded_block(stack_chain->call_region); ds = old_stacks->data_save; + rs = old_stacks->retain_save; cs = old_stacks->call_save; cards_offset = old_stacks->cards_offset; @@ -79,14 +95,15 @@ void unnest_stacks(void) userenv[CATCHSTACK_ENV] = old_stacks->catch_save; stack_chain = old_stacks->next; - + free(old_stacks); } /* called on startup */ -void init_stacks(CELL ds_size_, CELL cs_size_) +void init_stacks(CELL ds_size_, CELL rs_size_, CELL cs_size_) { ds_size = ds_size_; + rs_size = rs_size_; cs_size = cs_size_; stack_chain = NULL; nest_stacks(); @@ -211,12 +228,12 @@ void primitive_swap(void) void primitive_to_r(void) { - cpush(dpop()); + rpush(dpop()); } void primitive_from_r(void) { - dpush(cpop()); + dpush(rpop()); } F_VECTOR* stack_to_vector(CELL bottom, CELL top) @@ -235,6 +252,12 @@ void primitive_datastack(void) dpush(tag_object(stack_to_vector(ds_bot,ds))); } +void primitive_retainstack(void) +{ + maybe_gc(0); + dpush(tag_object(stack_to_vector(rs_bot,rs))); +} + void primitive_callstack(void) { maybe_gc(0); @@ -255,6 +278,11 @@ void primitive_set_datastack(void) ds = vector_to_stack(untag_vector(dpop()),ds_bot); } +void primitive_set_retainstack(void) +{ + rs = vector_to_stack(untag_vector(dpop()),rs_bot); +} + void primitive_set_callstack(void) { cs = vector_to_stack(untag_vector(dpop()),cs_bot); diff --git a/native/stack.h b/native/stack.h index 082089ddbc..d5383b62f5 100644 --- a/native/stack.h +++ b/native/stack.h @@ -5,6 +5,12 @@ typedef struct _STACKS { CELL data_save; /* memory region holding current datastack */ BOUNDED_BLOCK *data_region; + /* current retain stack top pointer */ + CELL retain; + /* saved contents of rs register on entry to callback */ + CELL retain_save; + /* memory region holding current retain stack */ + BOUNDED_BLOCK *retain_region; /* current callstack top pointer */ CELL call; /* saved contents of cs register on entry to callback */ @@ -25,21 +31,23 @@ typedef struct _STACKS { STACKS *stack_chain; -CELL ds_size, cs_size; +CELL ds_size, rs_size, cs_size; #define ds_bot ((CELL)(stack_chain->data_region->start)) +#define rs_bot ((CELL)(stack_chain->retain_region->start)) #define cs_bot ((CELL)(stack_chain->call_region->start)) #define STACK_UNDERFLOW(stack,region) ((stack) + CELLS < (region)->start) #define STACK_OVERFLOW(stack,region) ((stack) + CELLS >= (region)->start + (region)->size) void reset_datastack(void); +void reset_retainstack(void); void reset_callstack(void); void fix_stacks(void); DLLEXPORT void save_stacks(void); DLLEXPORT void nest_stacks(void); DLLEXPORT void unnest_stacks(void); -void init_stacks(CELL ds_size, CELL cs_size); +void init_stacks(CELL ds_size, CELL rs_size, CELL cs_size); void primitive_drop(void); void primitive_2drop(void); @@ -61,7 +69,9 @@ void primitive_to_r(void); void primitive_from_r(void); F_VECTOR* stack_to_vector(CELL bottom, CELL top); void primitive_datastack(void); +void primitive_retainstack(void); void primitive_callstack(void); CELL vector_to_stack(F_VECTOR* vector, CELL bottom); void primitive_set_datastack(void); +void primitive_set_retainstack(void); void primitive_set_callstack(void); From a7be80d994581791c2183ec893f42944ee78e4eb Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 15 May 2006 03:10:54 +0000 Subject: [PATCH 003/468] Parser no longer calls 'swons' --- library/compiler/alien/syntax.factor | 4 ++-- library/syntax/parse-stream.factor | 2 +- library/syntax/parse-syntax.factor | 22 +++++++++++----------- library/syntax/parser.factor | 6 ++++-- library/tools/listener.factor | 2 +- library/windows/win32-errors.factor | 2 +- 6 files changed, 20 insertions(+), 18 deletions(-) diff --git a/library/compiler/alien/syntax.factor b/library/compiler/alien/syntax.factor index 20787bda36..8947c5410b 100644 --- a/library/compiler/alien/syntax.factor +++ b/library/compiler/alien/syntax.factor @@ -4,9 +4,9 @@ IN: !syntax USING: alien compiler kernel lists math namespaces parser sequences syntax words ; -: DLL" skip-blank parse-string dlopen swons ; parsing +: DLL" skip-blank parse-string dlopen parsed ; parsing -: ALIEN: scan-word swons ; parsing +: ALIEN: scan-word parsed ; parsing : LIBRARY: scan "c-library" set ; parsing diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor index 5ff4590073..b6ee65773e 100644 --- a/library/syntax/parse-stream.factor +++ b/library/syntax/parse-stream.factor @@ -12,7 +12,7 @@ words ; : parse-lines ( lines -- quot ) [ dup length [ ] [ 1+ line-number set (parse) ] 2reduce - reverse + >list ] with-parser ; : parse ( str -- code ) lines parse-lines ; diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index 9ea405b51b..61f43228b4 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -18,29 +18,29 @@ words ; : IN: scan set-in ; parsing : USE: scan use+ ; parsing : USING: string-mode on [ string-mode off add-use ] f ; parsing -: (BASE) scan swap base> swons ; +: (BASE) scan swap base> parsed ; : HEX: 16 (BASE) ; parsing : OCT: 8 (BASE) ; parsing : BIN: 2 (BASE) ; parsing SYMBOL: t -: f f swons ; parsing -: CHAR: 0 scan next-char nip swons ; parsing -: " parse-string swons ; parsing -: SBUF" skip-blank parse-string >sbuf swons ; parsing +: f f parsed ; parsing +: CHAR: 0 scan next-char nip parsed ; parsing +: " parse-string parsed ; parsing +: SBUF" skip-blank parse-string >sbuf parsed ; parsing : [ f ; parsing -: ] reverse swons ; parsing +: ] >list parsed ; parsing : [[ f ; parsing -: ]] first2 swons swons ; parsing -: ; reverse swap call ; parsing -: } POSTPONE: ; swons ; parsing +: ]] first2 parsed parsed ; parsing +: ; >list swap call ; parsing +: } swap call parsed ; parsing : { [ >array ] [ ] ; parsing : V{ [ >vector ] [ ] ; parsing : H{ [ alist>hash ] [ ] ; parsing : C{ [ first2 rect> ] [ ] ; parsing : T{ [ >tuple ] [ ] ; parsing : W{ [ first ] [ ] ; parsing -: POSTPONE: scan-word swons ; parsing -: \ scan-word literalize swons ; parsing +: POSTPONE: scan-word parsed ; parsing +: \ scan-word literalize parsed ; parsing : parsing word t "parsing" set-word-prop ; parsing : inline word t "inline" set-word-prop ; parsing : flushable word t "flushable" set-word-prop ; parsing diff --git a/library/syntax/parser.factor b/library/syntax/parser.factor index c98cd79172..da6616c760 100644 --- a/library/syntax/parser.factor +++ b/library/syntax/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: parser -USING: errors generic hashtables kernel lists math namespaces +USING: errors generic hashtables kernel math namespaces sequences strings vectors words ; SYMBOL: use @@ -76,9 +76,11 @@ SYMBOL: string-mode ] unless ] when ; +: parsed ( parse-tree obj -- parse-tree ) swap ?push ; + : parse-loop ( -- ) scan-word [ - dup parsing? [ execute ] [ swons ] if parse-loop + dup parsing? [ execute ] [ parsed ] if parse-loop ] when* ; : (parse) ( str -- ) line-text set 0 column set parse-loop ; diff --git a/library/tools/listener.factor b/library/tools/listener.factor index d37d1b0c40..4db2a4fa23 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -28,7 +28,7 @@ SYMBOL: error-hook ] if ; : read-multiline ( -- quot ? ) - [ f depth (read-multiline) >r reverse r> ] with-parser ; + [ f depth (read-multiline) >r >list r> ] with-parser ; : listen-try [ diff --git a/library/windows/win32-errors.factor b/library/windows/win32-errors.factor index acf93cd251..15549ae27a 100644 --- a/library/windows/win32-errors.factor +++ b/library/windows/win32-errors.factor @@ -37,7 +37,7 @@ USE: words USE: sequences : CONSTANT: CREATE - [ [ [ swons ] each ] cons define-compound POSTPONE: parsing ] + [ [ [ parsed ] each ] cons define-compound POSTPONE: parsing ] [ ] ; parsing CONSTANT: ERROR_SUCCESS 0 ; From 307bc73f5e095587f184670225fa0aded4f34e81 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 15 May 2006 03:25:34 +0000 Subject: [PATCH 004/468] reverse-slice ==> --- doc/handbook/sequences.facts | 2 +- library/bootstrap/image.factor | 2 +- library/collections/lists.factor | 5 ----- library/collections/sequences-epilogue.factor | 4 ---- library/collections/sequences.factor | 2 -- library/collections/sequences.facts | 8 -------- library/collections/virtual-sequences.factor | 2 ++ library/collections/virtual-sequences.facts | 8 ++++++++ library/compiler/alien/compiler.factor | 2 +- library/compiler/generator/templates.factor | 4 ++-- library/compiler/inference/known-words.factor | 2 +- library/compiler/optimizer/class-infer.factor | 2 +- library/compiler/optimizer/specializers.factor | 2 +- library/compiler/x86/architecture.factor | 2 +- library/generic/tuple.factor | 2 +- library/io/binary.factor | 2 +- library/test/collections/sequences.factor | 2 +- library/tools/describe.factor | 4 ++-- library/ui/gadgets.factor | 2 +- library/ui/gestures.factor | 6 +++--- library/ui/listener.factor | 2 +- library/ui/world.factor | 2 +- 22 files changed, 30 insertions(+), 39 deletions(-) diff --git a/doc/handbook/sequences.facts b/doc/handbook/sequences.facts index 68a35edc7b..89b66c6010 100644 --- a/doc/handbook/sequences.facts +++ b/doc/handbook/sequences.facts @@ -36,7 +36,7 @@ ARTICLE: "sequence-implementations" "Sequence implementations" { $subsection "sbufs" } "Virtual sequences wrap an underlying sequence to present an alternative view of its elements:" { $subsection } -{ $subsection reverse-slice } +{ $subsection } "Integers support the sequence protocol:" { $subsection "sequences-integers" } ; diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 79bfff5635..bb930098a4 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -230,7 +230,7 @@ M: complex ' ( c -- tagged ) >rect complex-tag emit-cons ; ( Strings ) : emit-chars ( seq -- ) - big-endian get [ [ reverse-slice ] map ] unless + big-endian get [ [ ] map ] unless [ 0 [ swap 16 shift + ] reduce emit ] each ; : pack-string ( string -- seq ) diff --git a/library/collections/lists.factor b/library/collections/lists.factor index f8017a7a29..126ea8ef56 100644 --- a/library/collections/lists.factor +++ b/library/collections/lists.factor @@ -61,11 +61,6 @@ M: general-list map ( list quot -- list ) (list-map) ; M: general-list find ( list quot -- i elt ) 0 (list-find) ; -M: general-list reverse-slice ( list -- list ) - [ ] [ swons ] reduce ; - -M: general-list reverse reverse-slice ; - M: general-list nth ( n list -- element ) over 0 <= [ nip car ] [ >r 1- r> cdr nth ] if ; diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index e2450e434e..eba8a2b391 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -103,10 +103,6 @@ M: object like drop ; : pop ( sequence -- element ) dup peek swap pop* ; -M: object reverse-slice ( seq -- seq ) ; - -M: object reverse ( seq -- seq ) [ ] keep like ; - : all-equal? ( seq -- ? ) [ = ] monotonic? ; : all-eq? ( seq -- ? ) [ eq? ] monotonic? ; diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor index fbcd04dfbb..cc2d49a4f4 100644 --- a/library/collections/sequences.factor +++ b/library/collections/sequences.factor @@ -9,8 +9,6 @@ GENERIC: nth ( n sequence -- obj ) flushable GENERIC: set-nth ( value n sequence -- obj ) GENERIC: thaw ( seq -- mutable-seq ) flushable GENERIC: like ( seq seq -- seq ) flushable -GENERIC: reverse ( seq -- seq ) flushable -GENERIC: reverse-slice ( seq -- seq ) flushable : empty? ( seq -- ? ) length zero? ; inline diff --git a/library/collections/sequences.facts b/library/collections/sequences.facts index 7872f839cd..dfd31a0634 100644 --- a/library/collections/sequences.facts +++ b/library/collections/sequences.facts @@ -44,14 +44,6 @@ HELP: like "( seq prototype -- newseq )" $terpri "This generic word is flushable, so user-defined methods must satisfy the flushable contract (see " { $link "declarations" } ")." } ; -HELP: reverse "( seq -- reversed )" -{ $values { "seq" "a sequence" } { "reversed" "a sequence" } } -{ $description "Outputs a new sequence with the reverse element order." } ; - -HELP: reverse-slice "( seq -- reversed )" -{ $values { "seq" "a sequence" } { "reversed" "a sequence" } } -{ $description "Outputs a virtual sequence sharing storage with " { $snippet "seq" } " but with reverse element order." } ; - HELP: peek "( seq -- elt )" { $values { "seq" "a sequence" } { "elt" "an object" } } { $description "Outputs the last element of the sequence." } diff --git a/library/collections/virtual-sequences.factor b/library/collections/virtual-sequences.factor index ad9b82e295..f3db9a63aa 100644 --- a/library/collections/virtual-sequences.factor +++ b/library/collections/virtual-sequences.factor @@ -23,6 +23,8 @@ M: reversed like ( seq reversed -- seq ) delegate like ; M: reversed thaw ( seq -- seq ) delegate thaw ; +: reverse ( seq -- seq ) [ ] keep like ; + ! A slice of another sequence. TUPLE: slice seq from to ; diff --git a/library/collections/virtual-sequences.facts b/library/collections/virtual-sequences.facts index 54e8154ba6..08546dab7e 100644 --- a/library/collections/virtual-sequences.facts +++ b/library/collections/virtual-sequences.facts @@ -4,3 +4,11 @@ HELP: "( m n seq -- slice )" { $values { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "seq" "a sequence" } { "slice" "a slice" } } { $description "Outputs a new virtual sequence sharing storage with the subrange of elements in " { $snippet "seq" } " with indices starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." } { $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } ; + +HELP: reverse "( seq -- reversed )" +{ $values { "seq" "a sequence" } { "reversed" "a sequence" } } +{ $description "Outputs a new sequence with the reverse element order." } ; + +HELP: "( seq -- reversed )" +{ $values { "seq" "a sequence" } { "reversed" "a sequence" } } +{ $description "Outputs a virtual sequence sharing storage with " { $snippet "seq" } " but with reverse element order." } ; diff --git a/library/compiler/alien/compiler.factor b/library/compiler/alien/compiler.factor index 76898257fe..eed7e88313 100644 --- a/library/compiler/alien/compiler.factor +++ b/library/compiler/alien/compiler.factor @@ -42,7 +42,7 @@ kernel-internals math namespaces sequences words ; : reverse-each-parameter ( parameters quot -- ) >r [ parameter-sizes ] keep - [ reverse-slice ] 2apply r> 2each ; inline + [ ] 2apply r> 2each ; inline : reset-freg-counts ( -- ) 0 { int-regs float-regs stack-params } [ set ] each-with ; diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor index 54ef930aac..d4ba92401a 100644 --- a/library/compiler/generator/templates.factor +++ b/library/compiler/generator/templates.factor @@ -77,7 +77,7 @@ M: phantom-callstack finalize-height : phantom-locs ( n phantom -- locs ) #! A sequence of n ds-locs or cs-locs indexing the stack. - swap reverse-slice [ swap ] map-with ; + swap [ swap ] map-with ; : phantom-locs* ( phantom -- locs ) dup length swap phantom-locs ; @@ -188,7 +188,7 @@ SYMBOL: phantom-r } cond ; : template-match? ( template phantom -- ? ) - [ reverse-slice ] 2apply + [ ] 2apply t [ swap first compatible-values? and ] 2reduce ; : split-template ( template phantom -- slow fast ) diff --git a/library/compiler/inference/known-words.factor b/library/compiler/inference/known-words.factor index 7ae0d7b8c8..2964ebf6cf 100644 --- a/library/compiler/inference/known-words.factor +++ b/library/compiler/inference/known-words.factor @@ -53,7 +53,7 @@ sequences strings vectors words prettyprint ; \ cond [ [ object ] [ ] ] "infer-effect" set-word-prop \ cond [ - pop-literal reverse-slice + pop-literal [ no-cond ] swap alist>quot infer-quot-value ] "infer" set-word-prop diff --git a/library/compiler/optimizer/class-infer.factor b/library/compiler/optimizer/class-infer.factor index 444c34298c..ede6170ff1 100644 --- a/library/compiler/optimizer/class-infer.factor +++ b/library/compiler/optimizer/class-infer.factor @@ -10,7 +10,7 @@ kernel-internals math namespaces sequences words ; node-classes ?hash [ object ] unless* ; : node-class# ( node n -- class ) - swap [ node-in-d reverse-slice ?nth ] keep node-class ; + swap [ node-in-d ?nth ] keep node-class ; ! Variables used by the class inferencer diff --git a/library/compiler/optimizer/specializers.factor b/library/compiler/optimizer/specializers.factor index 47c38a63db..cb528f3da9 100644 --- a/library/compiler/optimizer/specializers.factor +++ b/library/compiler/optimizer/specializers.factor @@ -27,7 +27,7 @@ namespaces sequences vectors words ; : specialized-def ( word -- quot ) dup word-def swap "specializer" word-prop [ - reverse-slice { dup over pick } [ + { dup over pick } [ make-specializer ] 2each ] when* ; diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor index aeb4c52030..aa7eb087f9 100644 --- a/library/compiler/x86/architecture.factor +++ b/library/compiler/x86/architecture.factor @@ -26,7 +26,7 @@ M: cs-loc v>operand cs-loc-n cs-reg reg-stack ; 2dup dlsym CALL rel-relative rel-dlsym ; : compile-c-call* ( symbol dll args -- operands ) - reverse-slice + [ [ PUSH ] each %alien-invoke ] keep [ drop EDX POP ] each ; diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 1a30491092..43c7110ef2 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -64,7 +64,7 @@ PREDICATE: word tuple-class "tuple-size" word-prop ; : default-constructor ( tuple -- ) [ create-constructor ] keep dup [ - "slots" word-prop 1 swap tail-slice reverse-slice + "slots" word-prop 1 swap tail-slice [ peek unit , \ keep , ] each ] [ ] make define-constructor ; diff --git a/library/io/binary.factor b/library/io/binary.factor index cc28f1b27d..9a0cfff127 100644 --- a/library/io/binary.factor +++ b/library/io/binary.factor @@ -4,7 +4,7 @@ IN: io USING: kernel lists math sequences strings ; : be> ( seq -- x ) 0 [ >r 8 shift r> bitor ] reduce ; -: le> ( seq -- x ) reverse-slice be> ; +: le> ( seq -- x ) be> ; : nth-byte ( x n -- b ) -8 * shift HEX: ff bitand ; diff --git a/library/test/collections/sequences.factor b/library/test/collections/sequences.factor index 1a230152c8..d386094fe7 100644 --- a/library/test/collections/sequences.factor +++ b/library/test/collections/sequences.factor @@ -207,6 +207,6 @@ unit-test [ { } ] [ 0 { } group ] unit-test ! Pathological case -[ "ihbye" ] [ "hi" reverse-slice "bye" append ] unit-test +[ "ihbye" ] [ "hi" "bye" append ] unit-test [ 10 "hi" "bye" copy-into ] unit-test-fails diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 987e848197..cc509d9ff6 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -75,7 +75,7 @@ M: word summary ( word -- ) : format-sheet ( sheet -- list ) #! We use an idiom to notify format-column if it is #! formatting the last column. - dup length reverse-slice [ zero? format-column ] 2map + dup length [ zero? format-column ] 2map flip [ " " join ] map ; DEFER: describe @@ -105,7 +105,7 @@ DEFER: describe : uses. ( word -- ) uses [ uses. ] sequence-outliner ; -: stack. ( seq -- seq ) reverse-slice >array describe ; +: stack. ( seq -- seq ) >array describe ; : .s datastack stack. ; : .r retainstack stack. ; diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index 6591bcc8bb..81fbf7c449 100644 --- a/library/ui/gadgets.factor +++ b/library/ui/gadgets.factor @@ -73,7 +73,7 @@ M: gadget children-on ( rect/point gadget -- list ) [ >absolute intersects? ] [ 2drop f ] if ; : pick-up-list ( rect/point gadget -- gadget/f ) - dupd children-on reverse-slice [ inside? ] find-with nip ; + dupd children-on [ inside? ] find-with nip ; : translate ( rect/point -- new-origin ) rect-loc origin [ v+ dup ] change ; diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index 3806771521..ff7a34e503 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -81,13 +81,13 @@ V{ } clone hand-buttons set-global [ handle-gesture* drop ] each-with ; : hand-gestures ( new old -- ) - drop-prefix reverse-slice + drop-prefix [ mouse-leave ] swap each-gesture fire-motion [ mouse-enter ] swap each-gesture ; : focus-gestures ( new old -- ) - drop-prefix reverse-slice + drop-prefix [ lose-focus ] swap each-gesture [ gain-focus ] swap each-gesture ; @@ -124,7 +124,7 @@ V{ } clone hand-buttons set-global : under-hand ( -- seq ) #! A sequence whose first element is the world and last is #! the current gadget, with all parents in between. - hand-gadget get-global parents reverse-slice ; + hand-gadget get-global parents ; : move-hand ( loc world -- ) under-hand >r over hand-loc set-global diff --git a/library/ui/listener.factor b/library/ui/listener.factor index 248a491db3..0a73ae4a84 100644 --- a/library/ui/listener.factor +++ b/library/ui/listener.factor @@ -20,7 +20,7 @@ TUPLE: listener-gadget pane stack ; dup empty? [ "Empty stack" write drop ] [ - "Stack top: " write reverse-slice + "Stack top: " write [ [ unparse-short ] keep simple-object bl ] each bl ] if ] with-stream* ; diff --git a/library/ui/world.factor b/library/ui/world.factor index 3e0f3edcac..511679d8b1 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -44,7 +44,7 @@ M: world pref-dim* ( world -- dim ) delegate pref-dim* { 1024 768 0 } vmin ; : focused-ancestors ( world -- seq ) - world-focus parents reverse-slice ; + world-focus parents ; : draw-string ( open-fonts string -- ) >r dup world get font-sprites r> (draw-string) ; From be16e301d635c87407ff0a7797c46b119f7284ef Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 15 May 2006 03:26:05 +0000 Subject: [PATCH 005/468] New queue implementation not using conses --- library/collections/queues.factor | 45 ++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/library/collections/queues.factor b/library/collections/queues.factor index e82b7c664d..16bd8aa5fc 100644 --- a/library/collections/queues.factor +++ b/library/collections/queues.factor @@ -1,26 +1,41 @@ -! Copyright (C) 2005 Slava Pestov. +! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: queues -USING: errors kernel lists math sequences vectors ; +USING: errors kernel ; -TUPLE: queue in out ; +TUPLE: entry obj next ; + +C: entry ( obj -- entry ) [ set-entry-obj ] keep ; + +TUPLE: queue head tail ; C: queue ( -- queue ) ; -: queue-empty? ( queue -- ? ) - dup queue-in swap queue-out or not ; +: queue-empty? ( queue -- ? ) queue-head not ; + +: clear-queue ( queue -- ) + f over set-queue-head f swap set-queue-tail ; + +: enque-first ( entry queue -- ) + [ set-queue-head ] 2keep set-queue-tail ; : enque ( obj queue -- ) - [ queue-in cons ] keep set-queue-in ; + >r r> dup queue-empty? [ + enque-first + ] [ + [ queue-tail set-entry-next ] 2keep set-queue-tail + ] if ; + +: (deque) ( queue -- ) + dup queue-head over queue-tail eq? [ + clear-queue + ] [ + dup queue-head entry-next swap set-queue-head + ] if ; : deque ( queue -- obj ) - dup queue-out [ - uncons rot set-queue-out + dup queue-empty? [ + "Empty queue" throw ] [ - dup queue-in [ - reverse uncons pick set-queue-out - f rot set-queue-in - ] [ - "Empty queue" throw - ] if* - ] if* ; + dup queue-head entry-obj >r (deque) r> + ] if ; From fbfad839573273d74384b78bcf14417dcaf557dc Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 15 May 2006 04:03:55 +0000 Subject: [PATCH 006/468] Remove cons usage from runtime --- library/compiler/generator/xt.factor | 10 ++--- library/io/files.factor | 6 +-- library/tools/debugger.factor | 58 +++++++++++++--------------- library/tools/memory.factor | 2 +- native/alien.c | 2 +- native/array.c | 22 ++++++++++- native/array.h | 5 ++- native/debug.c | 2 +- native/dll.c | 2 +- native/error.c | 20 ++-------- native/error.h | 3 +- native/factor.c | 13 ++++--- native/float.c | 2 +- native/io.c | 2 +- native/macosx/run.m | 2 +- native/memory.c | 13 +++---- native/relocate.c | 8 ++-- native/run.c | 2 +- native/sbuf.c | 2 +- native/string.c | 6 +-- native/unix/ffi.c | 6 +-- native/unix/file.c | 32 ++++++++------- native/unix/signal.c | 12 ++++-- native/windows/file.c | 30 +++++++++----- 24 files changed, 143 insertions(+), 119 deletions(-) diff --git a/library/compiler/generator/xt.factor b/library/compiler/generator/xt.factor index c2962af6b7..f2f70e34fe 100644 --- a/library/compiler/generator/xt.factor +++ b/library/compiler/generator/xt.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2004, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: compiler -USING: assembler errors generic hashtables kernel -kernel-internals lists math namespaces prettyprint queues +USING: arrays assembler errors generic hashtables kernel +kernel-internals math namespaces prettyprint queues sequences strings vectors words ; :