Menu
▾
▴
[Forthy-cvs] forthy loadtest1.txt,NONE,1.1 loadtest2.txt,NONE,1.1 fsystem.c,1.9,1.10 ftype.h,1.4,1.5 fvalue.c,1.6,1.7 fvalue.h,1.3,1.4 main.c,1.14,1.15 test.txt,1.3,1.4
|
From: Paul P. <ppr...@us...> - 2004-07-25 20:25:57
|
Update of /cvsroot/forthy/forthy In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13071 Modified Files: fsystem.c ftype.h fvalue.c fvalue.h main.c test.txt Added Files: loadtest1.txt loadtest2.txt Log Message: - fixed input stack (it didn't work at all) - changed how strings are initialized internally - added a "load" word to main.c, and some test files for loading --- NEW FILE: loadtest1.txt --- load loadtest2.txt : loadtest1 "LOADTEST 1!" . ; loadtest1 Index: fvalue.c =================================================================== RCS file: /cvsroot/forthy/forthy/fvalue.c,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** fvalue.c 24 Jul 2004 07:21:17 -0000 1.6 --- fvalue.c 25 Jul 2004 20:25:47 -0000 1.7 *************** *** 106,118 **** val->type=FS_STRING; val->value.str=malloc(len+1); ! { ! int i, cnt; ! cnt=len; ! for(i=0; i<cnt; i++) ! { ! val->value.str[i]=string[i]; ! } ! val->value.str[i]=0; ! } val->back_ref=NULL; } --- 106,113 ---- val->type=FS_STRING; val->value.str=malloc(len+1); ! ! memcpy(val->value.str, string, len); ! val->value.str[len]=0; ! val->back_ref=NULL; } *************** *** 332,336 **** // Get rid of any invalid pointers, so cleaning an old stack cell on exit // doesn't corrupt the heap ! value->value.v=NULL; value->type=FS_NONE; --- 327,331 ---- // Get rid of any invalid pointers, so cleaning an old stack cell on exit // doesn't corrupt the heap ! value->value.v[0]=NULL; value->type=FS_NONE; --- NEW FILE: loadtest2.txt --- : loadtest2 "LOADTEST 2!!" . ; loadtest2 Index: fsystem.c =================================================================== RCS file: /cvsroot/forthy/forthy/fsystem.c,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** fsystem.c 24 Jul 2004 07:21:17 -0000 1.9 --- fsystem.c 25 Jul 2004 20:25:47 -0000 1.10 *************** *** 941,949 **** --- 941,953 ---- if(value_get_type(value)!=FS_WORDREF) + { VOID_THROW(sys, FS_BAD_TYPE); + } word=value_dewordref(value); if(!word) + { VOID_THROW(sys, FS_BAD_REF); + } // No next *************** *** 971,979 **** --- 975,987 ---- if(value_get_type(value)!=FS_WORDREF) + { VOID_THROW(sys, FS_BAD_TYPE); + } word=value_dewordref(value); if(!word) + { VOID_THROW(sys, FS_BAD_REF); + } // No prev *************** *** 1319,1322 **** --- 1327,1361 ---- + static void input_drop(FSYSTEM *sys) + { + // pop top string value from the stack (bye bye!) + stack_pop(sys, sys->istack); + + if(stack_depth(sys->istack)) + { + int offset; + FVALUE *value; + + // get string/offset from input stack + value=stack_get_value(sys, sys->istack, -1); + offset=(int)value->value.v[1]; + + // want direct access to avoid copying big strings + sys->in_load=(char*)value_get_void(value); + + sys->in_source=sys->in_load+offset; + sys->in_parse=NULL; + sys->in_token=NULL; + } + else + { + sys->in_load=NULL; + sys->in_source=NULL; + sys->in_parse=NULL; + sys->in_token=NULL; + } + } + + void do_interpret(FSYSTEM *sys) { *************** *** 1413,1448 **** } ! ! ! // pop top string value from the stack (bye bye!) ! stack_pop(sys, sys->istack); ! ! if(stack_depth(sys->istack)) ! { ! int offset; ! FVALUE *value; ! ! // get and pop the offset from stack, no longer need to store ! value=stack_get_value(sys, sys->stack, -1); ! offset=value_get_int(value); ! stack_pop(sys, sys->istack); ! ! // get input source start as void ! value=stack_get_value(sys, sys->stack, -1); ! ! // want direct access to avoid copying big strings ! sys->in_load=(char*)value_get_void(value); ! ! sys->in_source=sys->in_load+offset; ! sys->in_parse=NULL; ! sys->in_token=NULL; ! } ! else ! { ! sys->in_load=NULL; ! sys->in_source=NULL; ! sys->in_parse=NULL; ! sys->in_token=NULL; ! } VOID_THROW(sys, FS_READY); --- 1452,1456 ---- } ! input_drop(sys); VOID_THROW(sys, FS_READY); *************** *** 1524,1563 **** - /* - int fs_do_string(FSYSTEM *sys, char *str) - { - int ret; - - jmp_buf env; - - sys->vm_inner=vm_inner_loop; - sys->env=&env; - - ret=setjmp(env); - - switch(ret) - { - case FS_OK: - do_buffer(sys, str); - ret=FS_READY; - break; - - case FS_READY: - do_buffer(sys, sys->in_source); - // ret=FS_OK; - break; - - default: - if(ret<0) - vm_abort(sys); - } - - sys->env=NULL; - - return ret; - } - */ - - // Load word to be executed by run() or step() int fs_load_word(FSYSTEM *sys, int handle) --- 1532,1535 ---- *************** *** 1589,1604 **** // Attach a string to the string buffer ! int fs_load_input(FSYSTEM *sys, char *str) { FVALUE *value; // If we're already interpreting input if(sys->in_source) { ! value=stack_push(sys, sys->istack); ! if(!value) ! return FS_OVERFLOW; ! value_init_int(value, sys->in_source-sys->in_load); } --- 1561,1586 ---- // Attach a string to the string buffer ! int fs_load_input(FSYSTEM *sys, char *input) { FVALUE *value; + char *str; + + if(!input) + { + if(stack_depth(sys->istack)) + { + input_drop(sys); + } + return FS_OK; + } // If we're already interpreting input if(sys->in_source) { ! value=stack_get_value(sys, sys->istack, -1); ! // Store current offset in the super secret unused upper 32-bits of ! // the value ! value->value.v[1]=(void*)(sys->in_source-sys->in_load); } *************** *** 1606,1613 **** value=stack_push(sys, sys->istack); if(!value) return FS_OVERFLOW; ! value_init_string(value, str, strlen(str)); ! // Set input sources --- 1588,1597 ---- value=stack_push(sys, sys->istack); if(!value) + { return FS_OVERFLOW; + } ! value_init_string(value, input, strlen(input)); ! str=value_string_direct(value); // Set input sources *************** *** 1791,1795 **** --- 1775,1781 ---- if(!value) + { return FS_OK; + } // No jump set, so return *************** *** 1866,1870 **** --- 1852,1858 ---- // Must be a word if(value->type!=FS_WORDREF) + { VOID_THROW(sys, FS_BAD_TYPE); + } stack_push_value(sys, sys->vstack, value); *************** *** 1910,1914 **** --- 1898,1904 ---- if(value->type!=FS_WORDREF) + { VOID_THROW(sys, FS_BAD_TYPE); + } value_copy(sys, &sys->vcompile, value); *************** *** 1977,1982 **** --- 1967,1975 ---- if(sys->rstack) stack_delete(sys->rstack); + + value_clean(&sys->vcompile, FALSE); if(sys->vstack) stack_delete(sys->vstack); + if(sys->istack) stack_delete(sys->istack); Index: ftype.h =================================================================== RCS file: /cvsroot/forthy/forthy/ftype.h,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** ftype.h 24 Jul 2004 07:21:17 -0000 1.4 --- ftype.h 25 Jul 2004 20:25:47 -0000 1.5 *************** *** 109,113 **** char *str; // TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc. ! void *v; FCFUNC func; FSTACK *stack; --- 109,113 ---- char *str; // TODO: Userdata (void*)? Copy/clone/convert/delete interface, etc. ! void *v[2]; FCFUNC func; FSTACK *stack; Index: main.c =================================================================== RCS file: /cvsroot/forthy/forthy/main.c,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** main.c 24 Jul 2004 07:21:17 -0000 1.14 --- main.c 25 Jul 2004 20:25:47 -0000 1.15 *************** *** 56,59 **** --- 56,76 ---- + int load_script(FSYSTEM *sys, char *filename) + { + int ret; + char *script; + + script=load_text(filename); + + if(!script) + return FS_ERROR; + + ret=fs_load_input(sys, script); + free(script); + + return ret; + } + + void show_stack(FSYSTEM *sys) { *************** *** 1433,1439 **** fs_scan_word(sys); ! ! if(!(str=fs_get_string(sys, -1))) ! fs_throw(sys, FS_BAD_PARAMETER); fs_pop(sys); --- 1450,1454 ---- fs_scan_word(sys); ! str=fs_get_string(sys, -1); fs_pop(sys); *************** *** 1465,1468 **** --- 1480,1496 ---- + void word_load(FSYSTEM *sys) + { + char *str; + + fs_scan_word(sys); + str=fs_get_string(sys, -1); + + fs_pop(sys); + + fs_throw(sys, load_script(sys, str)); + } + + int load(FSYSTEM *sys) { *************** *** 1543,1547 **** fs_register_func(sys, "poke", word_poke, FS_DEFAULT); fs_register_func(sys, "pause", word_pause, FS_DEFAULT); - // fs_register_func(sys, "endif", word_endif, FS_IMMEDIATE); fs_register_func(sys, "exit", fs_exit, FS_IMMEDIATE); fs_register_func(sys, "immediate", word_immediate, FS_DEFAULT); --- 1571,1574 ---- *************** *** 1601,1604 **** --- 1628,1632 ---- fs_register_func(sys, "ncreate", word_ncreate, FS_DEFAULT); fs_register_func(sys, "int", word_int, FS_DEFAULT); + fs_register_func(sys, "load", word_load, FS_DEFAULT); fs_push_int(sys, '\n'); *************** *** 1616,1648 **** - /* - char *script= - { - "8 voc.new\n" - - ": also\n" - "0 voc.pick voc.push ;\n" - - ": definitions\n" - "voc.depth if 0 voc.pick current! else current.clear then ;\n" - - ": vocabulary\n" - "variable last last >data ! does> voc.depth if voc.pop drop then\n" - "@ voc.push ;\n" - - ": order\n" - "\"CONTEXT: \" . voc.depth dup for dup i - voc.pick name . next cr\n" - "\"CURRENT: \" . current@ dup datatype if name . else drop then cr drop ;\n" - - ": voc.path ( word -- )" - "\"/\" begin over >voc datatype while ( word str )\n" - "over >voc name swap cat ( word str )\n" - "swap >voc swap \"/\" swap cat ( word str )\n" - "repeat swap drop ;\n" - - ": which ' dup voc.path swap name cat . ; " - }; - */ - void word_root_1(FSYSTEM *sys) { --- 1644,1647 ---- *************** *** 1793,1825 **** - int load_script(FSYSTEM *sys, char *filename) - { - int ret; - char *script; - - script=load_text(filename); - - if(!script) - return FS_ERROR; - - fs_load_input(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; - } - - int main() { --- 1792,1795 ---- *************** *** 1858,1863 **** load(&sys); - ret=load_script(&sys, "test.txt"); - #ifdef _DEBUG test(&sys); --- 1828,1831 ---- *************** *** 1865,1886 **** #endif ! /* ! handle=fs_find_handle(&sys, "user"); ! if(handle) ! fs_execute(&sys, handle); ! */ ! ! ! /* ! fs_load_string(&sys, "variable 'ftest " ! ": ftest \n'ftest @ execute ; " ! ": test \npstart ftest pend / bye ; " ! ": mytest \n50000 for 1 dup + drop next ; " ! "' mytest \n'ftest ! "); ! ! fs_run(&sys); - // fs_do_string(&sys, ": test 100000 for next ; test"); - */ while(cont) { --- 1833,1839 ---- #endif ! load_script(&sys, "test.txt"); ! ret=fs_run(&sys); while(cont) { Index: test.txt =================================================================== RCS file: /cvsroot/forthy/forthy/test.txt,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** test.txt 23 Jul 2004 06:11:08 -0000 1.3 --- test.txt 25 Jul 2004 20:25:47 -0000 1.4 *************** *** 76,77 **** --- 76,79 ---- ; + load loadtest1.txt + Index: fvalue.h =================================================================== RCS file: /cvsroot/forthy/forthy/fvalue.h,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** fvalue.h 16 Nov 2003 16:24:58 -0000 1.3 --- fvalue.h 25 Jul 2004 20:25:47 -0000 1.4 *************** *** 59,63 **** #define value_init_user(val, user, subtype) \ (val)->type=FS_USER+subtype; \ ! (val)->value.v=(user); \ (val)->back_ref=NULL --- 59,63 ---- #define value_init_user(val, user, subtype) \ (val)->type=FS_USER+subtype; \ ! (val)->value.v[0]=(user); \ (val)->back_ref=NULL *************** *** 107,111 **** // DANGEROUS #define value_get_void(val) \ ! (val->value.v) --- 107,117 ---- // DANGEROUS #define value_get_void(val) \ ! (val->value.v[0]) ! ! #define value_get_void1(val) \ ! (val->value.v[1]) ! ! #define value_string_direct(val) \ ! (val->value.str) |
