=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/file.c,v retrieving revision 1.22 retrieving revision 1.26 diff -u -p -r1.22 -r1.26 --- OpenXM_contrib2/asir2000/builtin/file.c 2006/02/08 02:11:19 1.22 +++ OpenXM_contrib2/asir2000/builtin/file.c 2008/11/19 13:12:43 1.26 @@ -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.21 2006/02/03 03:55:18 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/file.c,v 1.25 2008/11/18 09:17:31 ohara Exp $ */ #include "ca.h" #include "parse.h" @@ -76,18 +76,23 @@ 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 Pfprintf(); void Pimport(); extern int des_encryption; extern char *asir_libdir; struct ftab file_tab[] = { + {"fprintf",Pfprintf,-99999999}, {"purge_stdin",Ppurge_stdin,0}, {"open_file",Popen_file,-2}, {"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}, @@ -113,6 +118,25 @@ struct ftab file_tab[] = { static FILE *file_ptrs[BUFSIZ]; +void Pfprintf(NODE arg,pointer *rp) +{ + FILE *fp; + STRING s; + asir_assert(ARG0(arg),O_N,"fprintf"); + fp = file_ptrs[QTOS((Q)ARG0(arg))]; + if ( !fp ) { + error("fprintf : invalid argument"); + } + arg = NEXT(arg); + if ( arg ) { + Psprintf(arg,&s); + fputs(BDY(s),fp); + /* fflush(fp); */ + } + *rp = 0; + return; +} + void Ppurge_stdin(Q *rp) { purge_stdin(stdin); @@ -235,6 +259,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 +303,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: