Menu
▾
▴
[Forthy-cvs] forthy fsystem.c,1.7,1.8 fsystem.h,1.6,1.7 main.c,1.11,1.12 test.txt,1.2,1.3
|
From: Paul P. <ppr...@us...> - 2004-07-23 06:11:17
|
Update of /cvsroot/forthy/forthy In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12505 Modified Files: fsystem.c fsystem.h main.c test.txt Log Message: - changed fs_store() to use src and dest - added fs_is_dict_empty() - tweaked main.c Index: main.c =================================================================== RCS file: /cvsroot/forthy/forthy/main.c,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** main.c 17 Nov 2003 06:18:00 -0000 1.11 --- main.c 23 Jul 2004 06:11:08 -0000 1.12 *************** *** 83,87 **** case FS_INT: if(hex) ! printf("%x ", fs_get_int(sys, i+1)); else printf("%d ", fs_get_int(sys, i+1)); --- 83,87 ---- case FS_INT: if(hex) ! printf("0x%x ", fs_get_int(sys, i+1)); else printf("%d ", fs_get_int(sys, i+1)); *************** *** 473,478 **** void word_store(FSYSTEM *sys) { ! fs_swap(sys, -1, -2); ! fs_store(sys, -2); fs_remove(sys, 2); } --- 473,477 ---- void word_store(FSYSTEM *sys) { ! fs_store(sys, -2, -1); fs_remove(sys, 2); } *************** *** 645,655 **** - void word_paren(FSYSTEM *sys) - { - fs_scan_text(sys, NULL, ")\n"); - fs_pop(sys); - } - - void word_string(FSYSTEM *sys) { --- 644,647 ---- *************** *** 716,720 **** i=fs_get_int(sys, -1); if(hex) ! printf("%x ", i); else printf("%d ", i); --- 708,712 ---- i=fs_get_int(sys, -1); if(hex) ! printf("0x%x ", i); else printf("%d ", i); *************** *** 919,929 **** - void word_forget(FSYSTEM *sys) - { - word_tick(sys); - word_xtforget(sys); - } - - void word_find(FSYSTEM *sys) { --- 911,914 ---- *************** *** 1041,1045 **** ! void word_to_data(FSYSTEM *sys) { fs_push_word_data(sys, -1); --- 1026,1030 ---- ! void word_to_body(FSYSTEM *sys) { fs_push_word_data(sys, -1); *************** *** 1521,1530 **** fs_register_func(sys, ".swap", word_stackswap, FS_DEFAULT); fs_register_func(sys, ".swapout", word_stackswapout, FS_DEFAULT); ! fs_register_func(sys, "const", word_const, FS_DEFAULT); fs_register_func(sys, "variable", word_variable, FS_DEFAULT); fs_register_func(sys, "err", word_err, FS_DEFAULT); fs_register_func(sys, "retuser", word_retuser, FS_DEFAULT); fs_register_func(sys, "token", word_token, FS_DEFAULT); - fs_register_func(sys, "(", word_paren, FS_IMMEDIATE); fs_register_func(sys, "s\"", word_string, FS_DEFAULT); fs_register_func(sys, "parse", word_parse, FS_DEFAULT); --- 1506,1514 ---- fs_register_func(sys, ".swap", word_stackswap, FS_DEFAULT); fs_register_func(sys, ".swapout", word_stackswapout, FS_DEFAULT); ! fs_register_func(sys, "constant", word_const, FS_DEFAULT); fs_register_func(sys, "variable", word_variable, FS_DEFAULT); fs_register_func(sys, "err", word_err, FS_DEFAULT); fs_register_func(sys, "retuser", word_retuser, FS_DEFAULT); fs_register_func(sys, "token", word_token, FS_DEFAULT); fs_register_func(sys, "s\"", word_string, FS_DEFAULT); fs_register_func(sys, "parse", word_parse, FS_DEFAULT); *************** *** 1534,1539 **** fs_register_func(sys, ".", word_dot, FS_DEFAULT); fs_register_func(sys, "cr", word_cr, FS_DEFAULT); ! fs_register_func(sys, "xtforget", word_xtforget, FS_DEFAULT); ! fs_register_func(sys, "forget", word_forget, FS_DEFAULT); fs_register_func(sys, "recurse", fs_recurse, FS_IMMEDIATE); fs_register_func(sys, "literal", fs_literal, FS_IMMEDIATE); --- 1518,1522 ---- fs_register_func(sys, ".", word_dot, FS_DEFAULT); fs_register_func(sys, "cr", word_cr, FS_DEFAULT); ! fs_register_func(sys, "(forget)", word_xtforget, FS_DEFAULT); fs_register_func(sys, "recurse", fs_recurse, FS_IMMEDIATE); fs_register_func(sys, "literal", fs_literal, FS_IMMEDIATE); *************** *** 1579,1583 **** fs_register_func(sys, "bye", word_bye, FS_DEFAULT); fs_register_func(sys, "break", fs_break, FS_IMMEDIATE); ! fs_register_func(sys, ">data", word_to_data, FS_DEFAULT); fs_register_func(sys, "find", word_find, FS_DEFAULT); fs_register_func(sys, "does>", fs_does, FS_IMMEDIATE); --- 1562,1566 ---- fs_register_func(sys, "bye", word_bye, FS_DEFAULT); fs_register_func(sys, "break", fs_break, FS_IMMEDIATE); ! fs_register_func(sys, ">body", word_to_body, FS_DEFAULT); fs_register_func(sys, "find", word_find, FS_DEFAULT); fs_register_func(sys, "does>", fs_does, FS_IMMEDIATE); *************** *** 1619,1622 **** --- 1602,1609 ---- fs_register_func(sys, "int", word_int, FS_DEFAULT); + fs_push_int(sys, '\n'); + fs_register_const(sys, "eol", FS_DEFAULT); + fs_pop(sys); + fs_push_user(sys, (void*)&user_var, 1); fs_register_const(sys, "user", FS_DEFAULT); *************** *** 1806,1811 **** ! void load_script(FSYSTEM *sys, char *filename) { char *script; --- 1793,1799 ---- ! int load_script(FSYSTEM *sys, char *filename) { + int ret; char *script; *************** *** 1813,1821 **** if(!script) ! return; fs_load_string(sys, script); ! fs_run(sys); free(script); } --- 1801,1822 ---- if(!script) ! return FS_ERROR; fs_load_string(sys, script); ! ret=fs_run(sys); ! ! if(ret<FS_OK) ! { ! // Clear the stack ! fs_remove(sys, fs_depth(sys)); ! ! printf("ERROR line %d at '%s': ", fs_get_current_line_number(sys), ! fs_get_last_token(sys)); ! printf("%s\n", fs_get_result_string(sys, ret)); ! } ! free(script); + + return FS_OK; } *************** *** 1857,1861 **** load(&sys); ! load_script(&sys, "test.txt"); #ifdef _DEBUG --- 1858,1862 ---- load(&sys); ! ret=load_script(&sys, "test.txt"); #ifdef _DEBUG *************** *** 1885,1889 **** --- 1886,1917 ---- { if(!fs_is_compiling(&sys)) + { + if(ret<FS_OK) + { + // Clear the stack + fs_remove(&sys, fs_depth(&sys)); + + printf("ERROR at '%s': ", fs_get_last_token(&sys)); + printf("%s\n", fs_get_result_string(&sys, ret)); + } + else + { + if(ret==FS_BYE) + { + cont=FALSE; + break; + } + else if(ret!=FS_OK) + { + printf("RESULT at '%s': ", fs_get_last_token(&sys)); + } + + + printf("%s\n", fs_get_result_string(&sys, ret)); + } + + show_stack(&sys); printf("@ "); + } for(;;) *************** *** 1910,1945 **** ret=fs_run(&sys); - - if(!fs_is_compiling(&sys)) - { - if(ret<FS_OK) - { - // Clear the stack - fs_remove(&sys, fs_depth(&sys)); - - printf("ERROR at '%s': ", fs_get_last_token(&sys)); - printf("%s\n", fs_get_result_string(&sys, ret)); - } - else - { - if(ret==FS_BYE) - { - cont=FALSE; - break; - } - else if(ret!=FS_OK) - { - printf("RESULT at '%s': ", fs_get_last_token(&sys)); - } - - - printf("%s\n", fs_get_result_string(&sys, ret)); - } - } } - if(!fs_is_compiling(&sys)) - show_stack(&sys); - pos=0; break; --- 1938,1943 ---- Index: fsystem.h =================================================================== RCS file: /cvsroot/forthy/forthy/fsystem.h,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** fsystem.h 17 Nov 2003 06:18:00 -0000 1.6 --- fsystem.h 23 Jul 2004 06:11:08 -0000 1.7 *************** *** 115,121 **** void fs_pick(FSYSTEM *sys, int offset); void fs_pick_ref(FSYSTEM *sys, int offset); void fs_fetch(FSYSTEM *sys, int offset); // Change to just fetch() ! // fs_store() stores to top value; add another offset for dest? ! void fs_store(FSYSTEM *sys, int ref_offset); void fs_swap(FSYSTEM *sys, int off1, int off2); void fs_rotl(FSYSTEM *sys, int offset, int count); --- 115,121 ---- void fs_pick(FSYSTEM *sys, int offset); void fs_pick_ref(FSYSTEM *sys, int offset); + void fs_fetch(FSYSTEM *sys, int offset); // Change to just fetch() ! void fs_store(FSYSTEM *sys, int ref_offset, int src_offset); void fs_swap(FSYSTEM *sys, int off1, int off2); void fs_rotl(FSYSTEM *sys, int offset, int count); *************** *** 222,225 **** --- 222,226 ---- void fs_push_word_voc(FSYSTEM *sys, int offset); + int fs_is_dict_empty(FSYSTEM *sys); void fs_push_first_word(FSYSTEM *sys); void fs_push_next_word(FSYSTEM *sys, int offset); Index: test.txt =================================================================== RCS file: /cvsroot/forthy/forthy/test.txt,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** test.txt 18 Nov 2003 13:49:41 -0000 1.2 --- test.txt 23 Jul 2004 06:11:08 -0000 1.3 *************** *** 1,4 **** --- 1,14 ---- 8 voc.new + : \ eol word drop ; + + : ( + [ char ) ] literal word drop + ; immediate + + : forget + ' (forget) + ; + : also 0 voc.pick voc.push *************** *** 10,14 **** : vocabulary ! variable last last >data ! does> voc.depth if voc.pop drop then @ voc.push ; --- 20,24 ---- : vocabulary ! variable last last >body ! does> voc.depth if voc.pop drop then @ voc.push ; *************** *** 30,33 **** --- 40,62 ---- ; + : namespace + 32 word + "{" cat ncreate last last >body ! immediate + does> @ dup voc.push current! + ; + + ( ** Alternative namespace method + : namespace + 32 word + ncreate last dup >body ! immediate + does> @ + ; + + : { + dup voc.push current! + ; immediate + ** ) + + : } voc.pop drop *************** *** 38,47 **** ; immediate - : namespace - 32 word - "{" cat ncreate last last >data ! immediate - does> @ dup voc.push current! - ; - : maze [ 80 50 * ] literal --- 67,70 ---- *************** *** 52,53 **** --- 75,77 ---- then next cr ; + Index: fsystem.c =================================================================== RCS file: /cvsroot/forthy/forthy/fsystem.c,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** fsystem.c 17 Nov 2003 06:18:00 -0000 1.7 --- fsystem.c 23 Jul 2004 06:11:08 -0000 1.8 *************** *** 2,8 **** TODO:@ - Seperate primitives from C interface - Create FS_TRY/CATCH macros to allow use of primitives outside system ! - Some form of range-covering DO/LOOP - Better depth checking in system so user doesn't have to do it everywhere - macros for float/double interchange --- 2,17 ---- TODO:@ + - FVALUE interfaces, like in the Parrot VM's Parrot Magic Cookie (PMC) + - Can be used to handle user types, as well as complex built in + types such as stack, wordref. Can be used to unify these types + - (was) USER type hooks for copying and deleting... register_user_type() + - Other hooks? + - USER pointer in word definitions + - Input stack for scripts/text being evaluated + - Seperate primitives from C interface - Create FS_TRY/CATCH macros to allow use of primitives outside system ! - Some form of range-covering DO/LOOP? ! - Interpret compile to temporary buffer, then execute? - Better depth checking in system so user doesn't have to do it everywhere - macros for float/double interchange *************** *** 15,19 **** - Allow compilation with only previously defined words - Only successful compilation will replace old word ! - Tail-call recursion - API review and overhaul - WORDREF-based lookups for most things --- 24,28 ---- - Allow compilation with only previously defined words - Only successful compilation will replace old word ! - Tail calls and tail recursion - API review and overhaul - WORDREF-based lookups for most things *************** *** 22,28 **** re-parsing tokens and such... look at SOURCE also - EVALUATE a string - - USER type hooks for copying and deleting... register_user_type() - - Other hooks? - - USER pointer in word definitions - Decompile, return/data stack dump, etc. (for debug) - Also for return stack, random access decompile (decompile current) --- 31,34 ---- *************** *** 31,35 **** - Auto-remove data stack on abort? - Debug mode to save all stacks for analysis ! - Debug hooks for user intervention during execution of words in inner loop - Line/word/column counter to aid in debugging and error reporting - Move fs_push_* and fs_get_* back to fstack.c? This way multiple stacks --- 37,42 ---- - Auto-remove data stack on abort? - Debug mode to save all stacks for analysis ! - DEBUG hooks for user intervention during execution of words in inner loop ! - Check FICL and Lua for similarities - Line/word/column counter to aid in debugging and error reporting - Move fs_push_* and fs_get_* back to fstack.c? This way multiple stacks *************** *** 666,675 **** // TODO: Change to use source and dest-ref offset ! void fs_store(FSYSTEM *sys, int ref_offset/*, int src_offset*/) { FVALUE *dest, *src; dest=stack_get_value(sys, sys->stack, ref_offset); ! src=stack_get_value(sys, sys->stack, -1); value_store(sys, dest, src); } --- 673,682 ---- // TODO: Change to use source and dest-ref offset ! void fs_store(FSYSTEM *sys, int ref_offset, int src_offset) { FVALUE *dest, *src; dest=stack_get_value(sys, sys->stack, ref_offset); ! src=stack_get_value(sys, sys->stack, src_offset); value_store(sys, dest, src); } *************** *** 818,821 **** --- 825,839 ---- + int fs_is_dict_empty(FSYSTEM *sys) + { + if((dict_get_first(sys->table))) + { + return FALSE; + } + + return TRUE; + } + + int fs_get_shared_count(FSYSTEM *sys) { |
