=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/file.c,v retrieving revision 1.20 retrieving revision 1.24 diff -u -p -r1.20 -r1.24 --- OpenXM_contrib2/asir2000/builtin/file.c 2004/04/26 05:28:40 1.20 +++ OpenXM_contrib2/asir2000/builtin/file.c 2006/11/08 07:34:33 1.24 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/file.c,v 1.19 2003/11/12 07:48:50 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/file.c,v 1.23 2006/09/13 02:26:13 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -76,8 +76,9 @@ void Pbsave(), Pbload(), Pbload27(); void Pbsave_compat(), Pbload_compat(); void Pbsave_cmo(), Pbload_cmo(); void Popen_file(), Pclose_file(), Pget_line(), Pget_byte(), Pput_byte(); +void Pput_word(), Pget_word(); void Ppurge_stdin(); -void Pexec(); +void Pimport(); extern int des_encryption; extern char *asir_libdir; @@ -88,11 +89,13 @@ struct ftab file_tab[] = { {"close_file",Pclose_file,1}, {"get_byte",Pget_byte,1}, {"put_byte",Pput_byte,2}, + {"get_word",Pget_word,1}, + {"put_word",Pput_word,2}, {"get_line",Pget_line,-1}, {"remove_file",Premove_file,1}, {"access",Paccess,1}, {"load",Pload,-1}, - {"exec",Pexec,1}, + {"import",Pimport,-1}, {"which",Pwhich,1}, {"loadfiles",Ploadfiles,1}, {"output",Poutput,-1}, @@ -235,6 +238,24 @@ void Pget_byte(NODE arg,Q *rp) error("get_byte : invalid argument"); } +void Pget_word(NODE arg,Q *rp) +{ + int i,c; + FILE *fp; + + asir_assert(ARG0(arg),O_N,"get_word"); + i = QTOS((Q)ARG0(arg)); + if ( fp = file_ptrs[i] ) { + if ( feof(fp) ) { + error("get_word : end of file"); + return; + } + read_int(fp,&c); + STOQ(c,*rp); + } else + error("get_word : invalid argument"); +} + void Pput_byte(NODE arg,Obj *rp) { int i,j,c; @@ -261,12 +282,31 @@ void Pput_byte(NODE arg,Obj *rp) *rp = obj; } +void Pput_word(NODE arg,Obj *rp) +{ + int i,c; + FILE *fp; + Obj obj; + + asir_assert(ARG0(arg),O_N,"put_word"); + asir_assert(ARG1(arg),O_N,"put_word"); + i = QTOS((Q)ARG0(arg)); + if ( !(fp = file_ptrs[i]) ) + error("put_word : invalid argument"); + + obj = (Q)ARG1(arg); + c = QTOS((Q)obj); + write_int(fp,&c); + *rp = obj; +} + void Pload(NODE arg,Q *rp) { int ret = 0; char *name,*name0; char errbuf[BUFSIZ]; + if ( !arg ) error("load : invalid argument"); if ( ARG0(arg) ) { switch (OID(ARG0(arg))) { case O_STR: @@ -276,11 +316,7 @@ void Pload(NODE arg,Q *rp) sprintf(errbuf,"load : \"%s\" not found in the search path",name0); error(errbuf); } - ret = loadfile(name); - if ( !ret ) { - sprintf(errbuf,"load : \"%s\" could not be loaded",name); - error(errbuf); - } + execasirfile(name); break; default: error("load : invalid argument"); @@ -290,20 +326,31 @@ void Pload(NODE arg,Q *rp) STOQ(ret,*rp); } -void Pexec(NODE arg,Q *rp) +NODE imported_files; + +void Pimport(NODE arg,Q *rp) { - int ret; - char *name0,*name; + char *name; + NODE t,p,opt; - name0 = BDY((STRING)ARG0(arg)); - searchasirpath(name0,&name); - if ( !name ) - ret = -1; - else { - execasirfile(name); - ret = 0; + name = BDY((STRING)ARG0(arg)); + for ( t = imported_files; t; t = NEXT(t) ) + if ( !strcmp((char *)BDY(t),name) ) break; + if ( !t ) { + Pload(arg,rp); + MKNODE(t,name,imported_files); + imported_files = t; + return; + } else if ( current_option ) { + for ( opt = current_option; opt; opt = NEXT(opt) ) { + p = BDY((LIST)BDY(opt)); + if ( !strcmp(BDY((STRING)BDY(p)),"reimport") && BDY(NEXT(p)) ) { + Pload(arg,rp); + return; + } + } } - STOQ(ret,*rp); + *rp = 0; } void Pwhich(NODE arg,STRING *rp)