/************************************************************************* * * * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: charcodes.c * * Last rev: 5/2/88 * * mods: * * comments: Character codes and character conversion * * * *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif /* * This file includes the definition of a pipe related IO. * */ #include "Yap.h" #include "Yatom.h" #include "YapHeap.h" #include "yapio.h" #include "YapText.h" #include #if HAVE_UNISTD_H #include #endif #if HAVE_STDARG_H #include #endif #ifdef _WIN32 #if HAVE_IO_H /* Windows */ #include #endif #if HAVE_SOCKET #include #endif #include #ifndef S_ISDIR #define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) #endif #endif #include "iopreds.h" #include "eval.h" #define FORMAT_MAX_SIZE 256 typedef struct { Int len, start; /* tab point */ Int filler; /* character to dump */ char *pad; /* ok, it's not standard english */ } pads; typedef struct format_status { char *mem; // direct access to stream fields int format_error; pads pad_entries[16]; int padders; } format_info; static int fill(int sno, int n, wchar_t nch) { int (* f_putc)(int, wchar_t); f_putc = GLOBAL_Stream[sno].stream_wputc; while (n--) f_putc(sno, nch); return nch; } static int f_puts(int sno, char *s, int n) { int (* f_putc)(int, wchar_t); f_putc = GLOBAL_Stream[sno].stream_wputc; while (n--) f_putc(sno, *s++); return *s; } // uses directly the buffer in the memory stream. static bool fill_pads(int sno, int nchars, format_info *fg USES_REGS) { int nfillers, fill_space, lfill_space; if (nchars < 0) nchars = 0; /* ignore */ nfillers =fg->padders; if (fg->padders == 0) { return fill( sno, nchars, ' ' ); } fill_space = nchars/nfillers; lfill_space = nchars%nfillers; pads *padi = fg->pad_entries; while (fg->padders--) { if (!fg->padders) fill_space += lfill_space; // give remainder to last block. fill( sno, fill_space, padi->filler); if (padi->pad) { f_puts( sno, padi->pad, padi->len); free(padi->pad); padi->pad = NULL; } padi++; } return true; } static int format_print_str (Int sno, Int size, Int has_size, Term args, int (* f_putc)(int, wchar_t)) { Term arghd; while (!has_size || size > 0) { if (IsVarTerm(args)) { Yap_Error(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } else if (args == TermNil) { return TRUE; } else if (!IsPairTerm (args)) { Yap_Error(TYPE_ERROR_LIST, args, "format/2"); return FALSE; } arghd = HeadOfTerm (args); args = TailOfTerm (args); if (IsVarTerm(arghd)) { Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); return FALSE; } else if (!IsIntTerm (arghd)) { Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); return FALSE; } f_putc(sno, (int) IntOfTerm (arghd)); size--; } return TRUE; } typedef enum { fst_ok, fst_error, fst_too_long } format_cp_res; static format_cp_res copy_format_string(Term inp, char *out, int max) { int i = 0; while (inp != TermNil) { Term hd; int ch; if (IsVarTerm(inp)) { Yap_Error(INSTANTIATION_ERROR,inp,"format/2"); return fst_error; } if (!IsPairTerm(inp)) { Yap_Error(TYPE_ERROR_LIST,inp,"format/2"); return fst_error; } hd = HeadOfTerm(inp); if (IsVarTerm(hd)) { Yap_Error(INSTANTIATION_ERROR,hd,"format/2"); return fst_error; } if (!IsIntTerm(hd)) { Yap_Error(TYPE_ERROR_INTEGER,hd,"format/2"); return fst_error; } ch = IntOfTerm(hd); if (ch < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,hd,"format/2"); return fst_error; } if (i+1 == max) { return fst_too_long; } /* we've got a character */ out[i++] = ch; /* done */ inp = TailOfTerm(inp); } out[i] = '\0'; return fst_ok; } #define FORMAT_COPY_ARGS_ERROR -1 #define FORMAT_COPY_ARGS_OVERFLOW -2 static Int format_copy_args(Term args, Term *targs, Int tsz) { Int n = 0; while (args != TermNil) { if (IsVarTerm(args)) { Yap_Error(INSTANTIATION_ERROR,args,"format/2"); return FORMAT_COPY_ARGS_ERROR; } if (!IsPairTerm(args)) { Yap_Error(TYPE_ERROR_LIST,args,"format/2"); return FORMAT_COPY_ARGS_ERROR; } if (n == tsz) return FORMAT_COPY_ARGS_OVERFLOW; targs[n] = HeadOfTerm(args); args = TailOfTerm(args); n++; } return n; } static void format_clean_up( int sno, const char *fstr, Term *targs) { if (fstr) Yap_FreeAtomSpace((void *)fstr); if (targs) Yap_FreeAtomSpace((char *)targs); } static Int fetch_index_from_args(Term t) { Int i; if (IsVarTerm(t)) return -1; if (!IsIntegerTerm(t)) return -1; i = IntegerOfTerm(t); if (i < 0) return -1; return i; } static wchar_t base_dig(Int dig, Int ch) { if (dig < 10) return dig+'0'; else if (ch == 'r') return (dig-10)+'a'; else /* ch == 'R' */ return (dig-10)+'A'; } #define TMP_STRING_SIZE 1024 static Int doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) { char tmp1[TMP_STRING_SIZE], *tmpbase; int ch; int column_boundary; Term mytargs[8], *targs; Int tnum, targ; const char *fstr = NULL, *fptr; Term args; Term tail; int (* f_putc)(int, wchar_t); int osno = 0; jmp_buf format_botch; volatile void *old_handler; volatile int old_pos; format_info finfo; char *bufp; Term fmod = CurrentModule; size_t sz; LOCAL_FormatInfo = &finfo; finfo.padders = 0; finfo.format_error = FALSE; if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { old_handler = GLOBAL_Stream[sno].u.mem_string.error_handler; GLOBAL_Stream[sno].u.mem_string.error_handler = (void *)&format_botch; old_pos = GLOBAL_Stream[sno].u.mem_string.pos; /* set up an error handler */ if (setjmp(format_botch)) { restore_machine_regs(); *HR++ = oargs; *HR++ = otail; if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR,otail,"format/2"); return FALSE; } oargs = HR[-2]; otail = HR[-1]; GLOBAL_Stream[sno].u.mem_string.pos = old_pos; HR -= 2; } } else { old_handler = NULL; } args = oargs; tail = otail; targ = 0; column_boundary = 0; if (IsVarTerm(tail)) { Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); return(FALSE); } else if (IsPairTerm (tail)) { int sz = 256; do { format_cp_res fr; char *fstr0; fstr = fptr = fstr0 = Yap_AllocAtomSpace(sz*sizeof(char)); if ((fr = copy_format_string(tail, fstr0, sz)) == fst_ok) break; if (fr == fst_error) return FALSE; sz += 256; Yap_FreeCodeSpace(fstr0); } while (TRUE); } else if (IsAtomTerm(tail)) { fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE; } else if (IsStringTerm(tail)) { fstr = fptr = StringOfTerm(tail); } else { Yap_Error(CONSISTENCY_ERROR, tail, "format/2"); return FALSE; } if (IsVarTerm(args)) { Yap_Error(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) { fmod = ArgOfTerm(1,args); args = ArgOfTerm(2,args); if (IsVarTerm(fmod)) { Yap_Error(INSTANTIATION_ERROR, fmod, "format/2"); return FALSE; } if (!IsAtomTerm(fmod)) { Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2"); return FALSE; } if (IsVarTerm(args)) { Yap_Error(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } } if (IsPairTerm(args)) { Int tsz = 8; targs = mytargs; do { tnum = format_copy_args(args, targs, tsz); if (tnum == FORMAT_COPY_ARGS_ERROR) return FALSE; else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) { if (mytargs != targs) { Yap_FreeCodeSpace((char *)targs); } tsz += 16; targs = (Term *)Yap_AllocAtomSpace(tsz*sizeof(Term)); } else { break; } } while (TRUE); } else if (args != TermNil) { tnum = 1; mytargs[0] = args; targs = mytargs; } else { tnum = 0; targs = mytargs; } finfo.format_error = FALSE; f_putc = GLOBAL_Stream[sno].stream_wputc; while ((ch = *fptr++)) { Term t = TermNil; int has_repeats = FALSE; int repeats = 0; if (ch == '~') { /* start command */ ch = *fptr++; if (ch == '*') { ch = *fptr++; has_repeats = TRUE; if (targ > tnum-1) { goto do_consistency_error; } repeats = fetch_index_from_args(targs[targ++]); if (repeats == -1) goto do_consistency_error; } else if (ch == '`') { /* next character is kept as code */ has_repeats = TRUE; repeats = *fptr++; ch = *fptr++; } else if (ch >= '0' && ch <= '9') { has_repeats = TRUE; repeats = 0; while (ch >= '0' && ch <= '9') { repeats = repeats*10+(ch-'0'); ch = *fptr++; } } switch (ch) { case 'a': /* print an atom */ if (has_repeats || targ > tnum-1) goto do_consistency_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (!IsAtomTerm(t)) goto do_type_atom_error; yhandle_t sl = Yap_StartSlots(); // stream is already locked. Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200); Yap_CloseSlots(sl); LOCAL_FormatInfo = &finfo; break; case 'c': { Int nch, i; if (targ > tnum-1) goto do_consistency_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (!IsIntegerTerm(t)) goto do_type_int_error; nch = IntegerOfTerm(t); if (nch < 0) goto do_domain_not_less_zero_error; if (!has_repeats) repeats = 1; for (i = 0; i < repeats; i++) f_putc(sno, nch); break; } case 'e': case 'E': case 'f': case 'g': case 'G': { Float fl; char *ptr; if (targ > tnum-1) goto do_consistency_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (!IsNumTerm(t)) goto do_type_number_error; if (IsIntegerTerm(t)) { fl = (Float)IntegerOfTerm(t); #ifdef HAVE_GMP } else if (IsBigIntTerm(t)) { fl = Yap_gmp_to_float(t); #endif } else { fl = FloatOfTerm(t); } if (!has_repeats) repeats = 6; tmp1[0] = '%'; tmp1[1] = '.'; ptr = tmp1+2; #if HAVE_SNPRINTF snprintf(ptr,256-5,"%d",repeats); #else sprintf(ptr,"%d",repeats); #endif while (*ptr) ptr++; ptr[0] = ch; ptr[1] = '\0'; { char *tmp2; if (!(tmp2 = Yap_AllocCodeSpace(repeats+10))) goto do_type_int_error; #if HAVE_SNPRINTF snprintf (tmp2, repeats+10, tmp1, fl); #else sprintf (tmp2, tmp1, fl); #endif ptr = tmp2; while ((ch = *ptr++) != 0) f_putc(sno, ch); Yap_FreeCodeSpace(tmp2); } break; case 'd': case 'D': /* print a decimal, using weird . stuff */ if (targ > tnum-1) goto do_consistency_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (!IsIntegerTerm(t) #ifdef HAVE_GMP && !IsBigIntTerm(t) #endif ) goto do_type_int_error; { Int siz = 0; char *ptr = tmp1; tmpbase = tmp1; if (IsIntegerTerm(t)) { Int il = IntegerOfTerm(t); #if HAVE_SNPRINTF snprintf(tmp1, 256, "%ld", (long int)il); #else sprintf(tmp1, "%ld", (long int)il); #endif siz = strlen(tmp1); if (il < 0) siz--; #ifdef HAVE_GMP } else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) { char *res; tmpbase = tmp1; while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) { if (tmpbase == tmp1) { tmpbase = NULL; } else { tmpbase = res; goto do_type_int_error; } } tmpbase = res; ptr = tmpbase; #endif siz = strlen(tmpbase); } else { goto do_type_int_error; } if (tmpbase[0] == '-') { f_putc(sno, (int) '-'); ptr++; } if (ch == 'D') { int first = TRUE; while (siz > repeats) { if ((siz-repeats) % 3 == 0 && !first) { f_putc(sno, (int) ','); } f_putc(sno, (int) (*ptr++)); first = FALSE; siz--; } } else { while (siz > repeats) { f_putc(sno, (int) (*ptr++)); siz--; } } if (repeats) { if (ptr == tmpbase || ptr[-1] == '-') { f_putc(sno, (int) '0'); } f_putc(sno, (int) '.'); while (repeats > siz) { f_putc(sno, (int) '0'); repeats--; } while (repeats) { f_putc(sno, (int) (*ptr++)); repeats--; } } if (tmpbase != tmp1) free(tmpbase); break; case 'r': case 'R': { Int numb, radix; UInt divfactor = 1, size = 1, i; wchar_t och; /* print a decimal, using weird . stuff */ if (targ > tnum-1) goto do_consistency_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (!has_repeats) radix = 8; else radix = repeats; if (radix > 36 || radix < 2) goto do_domain_error_radix; #ifdef HAVE_GMP if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) { char *pt, *res; tmpbase = tmp1; while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) { if (tmpbase == tmp1) { tmpbase = NULL; } else { tmpbase = res; goto do_type_int_error; } } tmpbase = res; pt = tmpbase; while ((ch = *pt++)) f_putc(sno, ch); if (tmpbase != tmp1) free(tmpbase); break; } #endif if (!IsIntegerTerm(t)) goto do_type_int_error; numb = IntegerOfTerm(t); if (numb < 0) { numb = -numb; f_putc(sno, (int) '-'); } while (numb/divfactor >= radix) { divfactor *= radix; size++; } for (i = 1; i < size; i++) { Int dig = numb/divfactor; och = base_dig(dig, ch); f_putc(sno, och); numb %= divfactor; divfactor /= radix; } och = base_dig(numb, ch); f_putc(sno, och); break; } case 's': if (targ > tnum-1) goto do_consistency_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (IsStringTerm(t)) { if (has_repeats) goto do_consistency_error; const char *pt = StringOfTerm(t); while(*pt) { int ch; pt = utf8_get_char(pt, &ch); f_putc(sno, ch); } } else if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) { goto do_default_error; } break; case 'i': if (targ > tnum-1 || has_repeats) goto do_consistency_error; targ++; break; case 'k': if (targ > tnum-1 || has_repeats) goto do_consistency_error; t = targs[targ++]; yhandle_t sl = Yap_StartSlots(); Yap_plwrite (t, GLOBAL_Stream+sno,0, Quote_illegal_f|Ignore_ops_f|To_heap_f , 1200); Yap_CloseSlots(sl); LOCAL_FormatInfo = &finfo; break; case '@': t = targs[targ++]; { yhandle_t sl0 = Yap_StartSlots(); Int sl = Yap_InitSlot(args); Int sl2; Int res; Term ta[2]; Term ts; ta[0] = fmod; ta[1] = t; ta[0] = Yap_MkApplTerm(FunctorModule, 2, ta); ta[1] = MkVarTerm(); sl2 = Yap_InitSlot(ta[1]); ts = Yap_MkApplTerm(FunctorGFormatAt, 2, ta); res = Yap_execute_goal(ts, 0, CurrentModule, true); LOCAL_FormatInfo = &finfo; args = Yap_GetFromSlot(sl); if (EX) goto ex_handler; if (!res) return FALSE; ts = Yap_GetFromSlot(sl2); Yap_CloseSlots(sl0); if (!format_print_str (sno, repeats, has_repeats, ts, f_putc)) { goto do_default_error; } } break; case 'p': if (targ > tnum-1 || has_repeats) goto do_consistency_error; t = targs[targ++]; { Int sl = Yap_InitSlot(args); Yap_plwrite(t, GLOBAL_Stream+sno, 0, Handle_vars_f|Use_portray_f|To_heap_f, 1200); LOCAL_FormatInfo = &finfo; args = Yap_GetFromSlot(sl); Yap_CloseSlots(sl); } if (EX != 0L) { Term ball; ex_handler: ball = Yap_PopTermFromDB(EX); EX = NULL; if (tnum <= 8) targs = NULL; if (IsAtomTerm(tail)) { fstr = NULL; } if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } format_clean_up( sno, fstr, targs); Yap_JumpToEnv(ball); return FALSE; } break; case 'q': if (targ > tnum-1 || has_repeats) goto do_consistency_error; t = targs[targ++]; yhandle_t sl0 = Yap_StartSlots(); Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|Quote_illegal_f|To_heap_f, 1200); Yap_CloseSlots(sl0); LOCAL_FormatInfo = &finfo; break; case 'w': if (targ > tnum-1 || has_repeats) goto do_consistency_error; t = targs[targ++]; yhandle_t slf = Yap_StartSlots(); Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200); Yap_CloseSlots(slf); LOCAL_FormatInfo = &finfo; break; case '~': if (has_repeats) goto do_consistency_error; f_putc(sno, (int) '~'); break; case 'n': if (!has_repeats) repeats = 1; while (repeats--) { f_putc(sno, (int) '\n'); } column_boundary = 0; finfo.padders = 0; break; case 'N': if (!has_repeats) has_repeats = 1; if (GLOBAL_Stream[sno].linepos != 0) { f_putc(sno, '\n'); column_boundary = 0; finfo.padders = 0; } if (repeats > 1) { Int i; for (i = 1; i < repeats; i++) f_putc(sno, '\n'); column_boundary = 0; finfo.padders = 0; } break; /* padding */ case '|': if (osno) { Yap_CloseStream(sno); sno = osno; osno = 0; } repeats -= GLOBAL_Stream[sno].linepos; repeats = (repeats < 0 ? 0 : repeats); fill_pads( sno, repeats, &finfo PASS_REGS); break; case '+': if (osno) { Yap_CloseStream(sno); sno = osno; osno = 0; } repeats = (repeats < 0 ? 0 : repeats); fill_pads( sno, repeats, &finfo PASS_REGS); break; case 't': { int nsno; finfo.pad_entries[finfo.padders].len = sz; finfo.pad_entries[finfo.padders].pad = bufp; bufp = NULL; sz = 0; nsno = Yap_open_buf_write_stream(bufp, sz, GLOBAL_Stream[sno].encoding, 0); if (osno) { GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos; GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount; GLOBAL_Stream[nsno].charcount = GLOBAL_Stream[sno].charcount; Yap_CloseStream(sno); } else { osno = sno; GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos; GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount; GLOBAL_Stream[nsno].charcount = GLOBAL_Stream[sno].charcount; } sno = nsno; finfo.padders++; finfo.pad_entries[finfo.padders].start = GLOBAL_Stream[sno].linepos; if (!has_repeats) finfo.pad_entries[finfo.padders].filler = ' '; else finfo.pad_entries[finfo.padders].filler = fptr[-2]; } break; do_instantiation_error: LOCAL_Error_TYPE = INSTANTIATION_ERROR; goto do_default_error; do_type_int_error: LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; goto do_default_error; do_type_number_error: LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; goto do_default_error; do_type_atom_error: LOCAL_Error_TYPE = TYPE_ERROR_ATOM; goto do_default_error; do_domain_not_less_zero_error: LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; goto do_default_error; do_domain_error_radix: LOCAL_Error_TYPE = DOMAIN_ERROR_RADIX; goto do_default_error; do_consistency_error: default: LOCAL_Error_TYPE = CONSISTENCY_ERROR; do_default_error: if (tnum <= 8) targs = NULL; if (IsAtomTerm(tail)) { fstr = NULL; } { Term ta[2]; ta[0] = otail; ta[1] = oargs; Yap_Error(LOCAL_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat,2),2,ta), "format/2"); } if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } format_clean_up( sno, fstr, targs); LOCAL_Error_TYPE = YAP_NO_ERROR; return FALSE; } } /* ok, now we should have a command */ } } else { f_putc(sno, ch); } } if (finfo.padders) { if (osno) { Yap_CloseStream(sno); sno = osno; } // fill_pads( sno, 0, &finfo); } if (IsAtomTerm(tail) || IsStringTerm(tail)) { fstr = NULL; } if (tnum <= 8) targs = NULL; if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } format_clean_up( sno, fstr, targs); return (TRUE); } /* * @pred with_output_to( + _Stream_ , 0:_Goal ) * * Evaluate goal _Goal, such that the output will be sent to _Stream_. * * As in format/3, we shall have the special streams `chars`/1, `codes/` and symbtw * */ static Int with_output_to( USES_REGS1 ) { int old_out = LOCAL_c_output_stream; int output_stream; Term tin = Deref(ARG1); Functor f; bool out; bool mem_stream = false; if (IsVarTerm(tin)) { Yap_Error(INSTANTIATION_ERROR,tin,"with_output_to/3"); return false; } if (IsApplTerm(tin) && (f = FunctorOfTerm(tin)) && (f == FunctorAtom || f == FunctorString || f == FunctorCodes1 || f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) ) { output_stream = Yap_OpenBufWriteStream( PASS_REGS1); } else { /* needs to change LOCAL_c_output_stream for write */ output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "format/3"); } if (output_stream == -1) { return false; } UNLOCK(GLOBAL_Stream[output_stream].streamlock); out = Yap_Execute( Deref(ARG2) PASS_REGS); LOCK(GLOBAL_Stream[output_stream].streamlock); LOCAL_c_output_stream = old_out; if (mem_stream) { Term tat; Term inp = Deref(ARG1); if (out) { char *s = GLOBAL_Stream[output_stream].nbuf; s[GLOBAL_Stream[output_stream].nsize] = '\0'; if (f == FunctorAtom) { tat = MkAtomTerm(Yap_LookupAtom(s)); } else if (f == FunctorCodes) { tat = Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2,inp) PASS_REGS); } else if (f == FunctorCodes1) { tat = Yap_CharsToListOfCodes(s PASS_REGS); } else if (f == FunctorChars) { tat = Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2,inp) PASS_REGS); } else if (f == FunctorChars1) { tat = Yap_CharsToListOfAtoms(s PASS_REGS); } else if (f == FunctorString1) { tat = MkStringTerm(s); } else { return false; } out = Yap_unify(tat,ArgOfTerm(1,inp)); } } return out; } static Int format(Term tout, Term tf, Term tas USES_REGS) { bool mem_stream = false; int output_stream; Functor f; Int out; if (IsVarTerm(tout)) { Yap_Error(INSTANTIATION_ERROR,tout,"format/3"); return false; } if (IsApplTerm(tout) && (f = FunctorOfTerm(tout)) && (f == FunctorAtom || f == FunctorString1 || f == FunctorCodes1 || f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) ) { output_stream = Yap_OpenBufWriteStream( PASS_REGS1); mem_stream = true; } else { /* needs to change LOCAL_c_output_stream for write */ output_stream = Yap_CheckStream (tout, Output_Stream_f, "format/3"); } if (output_stream == -1) { return false; UNLOCK(GLOBAL_Stream[output_stream].streamlock); } else { yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); out = doformat(tf,tas,output_stream PASS_REGS); Yap_CloseSlots( sls ); UNLOCK(GLOBAL_Stream[output_stream].streamlock); } if (mem_stream) { Term tat; Term inp = Deref(ARG1); if (out) { char *s = GLOBAL_Stream[output_stream].nbuf; s[GLOBAL_Stream[output_stream].nsize] = '\0'; if (f == FunctorAtom) { tat = MkAtomTerm(Yap_LookupAtom(s)); } else if (f == FunctorCodes) { tat = Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2,inp) PASS_REGS); } else if (f == FunctorCodes1) { tat = Yap_CharsToListOfCodes(s PASS_REGS); } else if (f == FunctorChars) { tat = Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2,inp) PASS_REGS); } else if (f == FunctorChars1) { tat = Yap_CharsToListOfAtoms(s PASS_REGS); } else if (f == FunctorString1) { tat = MkStringTerm(s); } else { return false; } if (!Yap_unify(tat,ArgOfTerm(1,inp))) return FALSE; } Yap_CloseStream(output_stream); } return out; } static Int format2( USES_REGS1 ) { /* 'format'(Stream,Control,Args) */ Int res; res = format(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS); return res; } static Int format3( USES_REGS1 ) { /* 'format'(Stream,Control,Args) */ Int res; res = format(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS); return res; } void Yap_InitFormat(void) { Yap_InitCPred ("format", 2, format2, SyncPredFlag); Yap_InitCPred ("format", 3, format3, SyncPredFlag); Yap_InitCPred ("with_output_to", 2, with_output_to, SyncPredFlag); }