=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/print.c,v retrieving revision 1.15 retrieving revision 1.23 diff -u -p -r1.15 -r1.23 --- OpenXM_contrib2/asir2000/builtin/print.c 2003/11/08 01:12:02 1.15 +++ OpenXM_contrib2/asir2000/builtin/print.c 2007/11/07 19:26:17 1.23 @@ -45,36 +45,77 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/print.c,v 1.14 2001/10/09 01:36:07 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/print.c,v 1.22 2006/09/26 05:35:25 noro Exp $ */ #include "ca.h" #include "parse.h" +void Pprintf(); void Pprint(); void Pquotetolist(); +void Pobjtoquote(); void Peval_variables_in_quote(); void Pset_print_function(); struct ftab print_tab[] = { + {"printf",Pprintf,-99999999}, {"print",Pprint,-2}, + {"objtoquote",Pobjtoquote,1}, {"quotetolist",Pquotetolist,1}, {"eval_variables_in_quote",Peval_variables_in_quote,1}, {"set_print_function",Pset_print_function,-1}, {0,0,0}, }; +extern int I_am_server; + +int wfep_mode; + +void Pprintf(NODE arg,pointer *rp) +{ + STRING s; + if ( arg ) { + Psprintf(arg,&s); + /* engine for wfep */ + if ( wfep_mode ) { + print_to_wfep(s); + }else { + printexpr(CO,s); + /* XXX : if ox_asir, we have to fflush always */ + if ( I_am_server ) { + fflush(asir_out); + } + } + } + *rp = 0; + return; +} + void Pprint(NODE arg,pointer *rp) { Obj obj; - OPTLIST opt; + STRING nl; + Q opt; + /* engine for wfep */ + if ( wfep_mode ) { + if ( arg ) { + print_to_wfep((Obj)ARG0(arg)); + if ( !NEXT(arg) || ARG1(arg) ) { + MKSTR(nl,"\r\n"); + print_to_wfep((Obj)nl); + } + } + *rp = 0; + return; + } if ( arg ) { obj = (Obj)ARG0(arg); if ( NEXT(arg) ) { - opt = (OPTLIST)ARG1(arg); + opt = (Q)ARG1(arg); if ( INT(opt) ) { printexpr(CO,obj); - switch ( QTOS((Q)opt) ) { + switch ( QTOS(opt) ) { case 0: break; case 2: @@ -83,7 +124,6 @@ void Pprint(NODE arg,pointer *rp) case 1: default: putc('\n',asir_out); break; } - } else if ( OID(opt) == O_OPTLIST ) { } else error("print : invalid argument"); } else { @@ -91,9 +131,17 @@ void Pprint(NODE arg,pointer *rp) putc('\n',asir_out); } } + /* XXX : if ox_asir, we have to fflush always */ + if ( I_am_server ) + fflush(asir_out); *rp = 0; } +void Pobjtoquote(NODE arg,QUOTE *rp) +{ + objtoquote(ARG0(arg),rp); +} + void Pquotetolist(NODE arg,LIST *rp) { asir_assert(ARG0(arg),O_QUOTE,"quotetolist"); @@ -208,6 +256,21 @@ void fnodetotree(FNODE f,LIST *rp) MKLIST(*rp,n); break; + case I_NARYOP: + /* head */ + MKSTR(head,"n_op"); + n = (NODE)FA1(f); + for ( t0 = 0; n; n = NEXT(n) ) { + NEXTNODE(t0,t); + fnodetotree((FNODE)BDY(n),&a1); + BDY(t) = (pointer)a1; + } + MKSTR(op,((ARF)FA0(f))->name); + MKNODE(t,op,t0); + MKNODE(n,head,t); + MKLIST(*rp,n); + break; + /* ternary operators */ case I_CE: MKSTR(head,"t_op"); @@ -235,11 +298,11 @@ void fnodetotree(FNODE f,LIST *rp) break; /* function */ - case I_FUNC: case I_CAR: case I_CDR: case I_EV: + case I_FUNC: case I_FUNC_QARG: case I_CAR: case I_CDR: case I_EV: MKSTR(head,"function"); switch ( f->id ) { - case I_FUNC: - MKSTR(op,((FUNC)FA0(f))->name); + case I_FUNC: case I_FUNC_QARG: + MKSTR(op,((FUNC)FA0(f))->fullname); fnodetotree((FNODE)FA1(f),&a1); break; case I_CAR: