static word do_write2(term_t stream, term_t term, int flags) { GET_LD IOSTREAM *s; if ( getTextOutputStream(stream, &s) ) { write_options options; int rc; memset(&options, 0, sizeof(options)); options.flags = flags; options.out = s; options.module = MODULE_user; if ( options.module #ifndef __YAP_PROLOG__ && True(options.module, M_CHARESCAPE) #endif ) options.flags |= PL_WRT_CHARESCAPES; if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) ) options.flags |= PL_WRT_BACKQUOTED_STRING; PutOpenToken(EOF, s); /* reset this */ rc = writeTopTerm(term, 1200, &options); if ( rc && (flags&PL_WRT_NEWLINE) ) rc = Putc('\n', s); return streamStatus(s) && rc; } return FALSE; }
static int OpDec(int p, const char *type, Atom a, Term m) { int i; AtomEntry *ae = RepAtom(a); OpEntry *info; if (m == TermProlog) m = PROLOG_MODULE; else if (m == USER_MODULE) m = PROLOG_MODULE; for (i = 1; i <= 7; ++i) if (strcmp(type, optypes[i]) == 0) break; if (i > 7) { Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER,MkAtomTerm(Yap_LookupAtom(type)),"op/3"); return(FALSE); } if (p) { if (i == 1 || i == 2 || i == 4) p |= DcrlpFlag; if (i == 1 || i == 3 || i == 6) p |= DcrrpFlag; } WRITE_LOCK(ae->ARWLock); info = Yap_GetOpPropForAModuleHavingALock(ae, m); if (EndOfPAEntr(info)) { info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry)); info->KindOfPE = Ord(OpProperty); info->OpModule = m; info->OpName = a; //LOCK(OpListLock); info->OpNext = OpList; OpList = info; //UNLOCK(OpListLock); AddPropToAtom(ae, (PropEntry *)info); INIT_RWLOCK(info->OpRWLock); WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); info->Prefix = info->Infix = info->Posfix = 0; } else { WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); } if (i <= 3) { GET_LD if (truePrologFlag(PLFLAG_ISO) && info->Posfix != 0) /* there is a posfix operator */ { /* ISO dictates */ WRITE_UNLOCK(info->OpRWLock); Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3"); return FALSE; } info->Infix = p; } else if (i <= 5) {
word pl_write_term3(term_t stream, term_t term, term_t opts) { GET_LD bool quoted = FALSE; bool ignore_ops = FALSE; int numbervars = -1; /* not set */ bool portray = FALSE; term_t gportray = 0; bool bqstring = truePrologFlag(PLFLAG_BACKQUOTED_STRING); int charescape = -1; /* not set */ atom_t mname = ATOM_user; atom_t attr = ATOM_nil; atom_t blobs = ATOM_nil; int priority = 1200; bool partial = FALSE; bool cycles = TRUE; term_t varnames = 0; int local_varnames; IOSTREAM *s = NULL; write_options options; int rc; memset(&options, 0, sizeof(options)); options.spacing = ATOM_standard; if ( !scan_options(opts, 0, ATOM_write_option, write_term_options, "ed, &ignore_ops, &numbervars, &portray, &gportray, &charescape, &options.max_depth, &mname, &bqstring, &attr, &priority, &partial, &options.spacing, &blobs, &cycles, &varnames) ) fail; if ( attr == ATOM_nil ) { options.flags |= LD->prolog_flag.write_attributes; } else { int mask = writeAttributeMask(attr); if ( !mask ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_option, opts); options.flags |= mask; } if ( blobs != ATOM_nil ) { int mask = writeBlobMask(blobs); if ( mask < 0 ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_option, opts); options.flags |= mask; } if ( priority < 0 || priority > OP_MAXPRIORITY ) { term_t t = PL_new_term_ref(); PL_put_integer(t, priority); return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_operator_priority, t); } switch( options.spacing ) { case ATOM_standard: case ATOM_next_argument: break; default: { term_t t = PL_new_term_ref(); PL_put_atom(t, options.spacing); return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_spacing, t); } } options.module = lookupModule(mname); if ( charescape == TRUE || (charescape == -1 #ifndef __YAP_PROLOG__ && True(options.module, M_CHARESCAPE) #endif ) ) options.flags |= PL_WRT_CHARESCAPES; if ( gportray ) { options.portray_goal = gportray; if ( !put_write_options(opts, &options) || !PL_qualify(options.portray_goal, options.portray_goal) ) return FALSE; portray = TRUE; } if ( numbervars == -1 ) numbervars = (portray ? TRUE : FALSE); if ( quoted ) options.flags |= PL_WRT_QUOTED; if ( ignore_ops ) options.flags |= PL_WRT_IGNOREOPS; if ( numbervars ) options.flags |= PL_WRT_NUMBERVARS; if ( portray ) options.flags |= PL_WRT_PORTRAY; if ( bqstring ) options.flags |= PL_WRT_BACKQUOTED_STRING; if ( !cycles ) options.flags |= PL_WRT_NO_CYCLES; local_varnames = (varnames && False(&options, PL_WRT_NUMBERVARS)); BEGIN_NUMBERVARS(local_varnames); if ( varnames ) { if ( (rc=bind_varnames(varnames PASS_LD)) ) options.flags |= PL_WRT_VARNAMES; else goto out; } if ( !(rc=getTextOutputStream(stream, &s)) ) goto out; options.out = s; if ( !partial ) PutOpenToken(EOF, s); /* reset this */ if ( (options.flags & PL_WRT_QUOTED) && !(s->flags&SIO_REPPL) ) { s->flags |= SIO_REPPL; rc = writeTopTerm(term, priority, &options); s->flags &= ~SIO_REPPL; } else { rc = writeTopTerm(term, priority, &options); } out: END_NUMBERVARS(local_varnames); return (!s || streamStatus(s)) && rc; }
bool scan_options(term_t options, int flags, atom_t optype, const opt_spec *specs, ...) { GET_LD va_list args; const opt_spec *s; optvalue values[MAXOPTIONS]; term_t list = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t tmp = PL_new_term_ref(); term_t val = PL_new_term_ref(); int n; if ( truePrologFlag(PLFLAG_ISO) ) flags |= OPT_ALL; va_start(args, specs); for( n=0, s = specs; s->name; s++, n++ ) values[n].ptr = va_arg(args, void *); va_end(args); while ( PL_get_list(list, head, list) ) { atom_t name; int arity; if ( PL_get_name_arity(head, &name, &arity) ) { if ( name == ATOM_equals && arity == 2 ) { _PL_get_arg(1, head, tmp); if ( !PL_get_atom(tmp, &name) ) goto itemerror; _PL_get_arg(2, head, val); } else if ( arity == 1 ) { _PL_get_arg(1, head, val); } else if ( arity == 0 ) PL_put_atom(val, ATOM_true); } else if ( PL_is_variable(head) ) { return PL_error(NULL, 0, NULL, ERR_INSTANTIATION); } else { itemerror: return PL_error(NULL, 0, NULL, ERR_DOMAIN, optype, head); } for( n=0, s = specs; s->name; n++, s++ ) { if ( s->name == name ) { switch((s->type & OPT_TYPE_MASK)) { case OPT_BOOL: { int bval; if ( !PL_get_bool_ex(val, &bval) ) return FALSE; *values[n].b = bval; break; } case OPT_INT: { if ( !PL_get_integer_ex(val, values[n].i) ) return FALSE; break; } case OPT_LONG: { if ( (s->type & OPT_INF) && PL_is_inf(val) ) *values[n].l = LONG_MAX; else if ( !PL_get_long_ex(val, values[n].l) ) return FALSE; break; } case OPT_NATLONG: { if ( !PL_get_long_ex(val, values[n].l) ) return FALSE; if ( *(values[n].l) <= 0 ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_not_less_than_one, val); break; } case OPT_SIZE: { if ( (s->type & OPT_INF) && PL_is_inf(val) ) *values[n].sz = (size_t)-1; else if ( !PL_get_size_ex(val, values[n].sz) ) return FALSE; break; } case OPT_DOUBLE: { if ( !PL_get_float_ex(val, values[n].f) ) return FALSE; break; } case OPT_STRING: { char *str; if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */ return FALSE; *values[n].s = str; break; } case OPT_ATOM: { atom_t a; if ( !PL_get_atom_ex(val, &a) ) return FALSE; *values[n].a = a; break; } #ifdef O_LOCALE case OPT_LOCALE: { PL_locale *l; PL_locale **lp = values[n].ptr; if ( !getLocaleEx(val, &l) ) return FALSE; *lp = l; break; } #endif case OPT_TERM: { *values[n].t = val; val = PL_new_term_ref(); /* can't reuse anymore */ break; } default: assert(0); fail; } break; } } if ( !s->name && (flags & OPT_ALL) ) goto itemerror; } if ( !PL_get_nil(list) ) return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, list); succeed; }
int PL_error(const char *pred, int arity, const char *msg, PL_error_code id, ...) { GET_LD char msgbuf[50]; Definition caller; term_t except, formal, swi, msgterm=0; va_list args; int do_throw = FALSE; fid_t fid; int rc; if ( exception_term ) /* do not overrule older exception */ return FALSE; if ( environment_frame ) caller = environment_frame->predicate; else caller = NULL; if ( id == ERR_FILE_OPERATION && !truePrologFlag(PLFLAG_FILEERRORS) ) fail; if ( msg == MSG_ERRNO ) { if ( errno == EPLEXCEPTION ) return FALSE; msg = OsError(); } LD->exception.processing = TRUE; /* allow using spare stack */ if ( !(fid = PL_open_foreign_frame()) ) goto nomem; except = PL_new_term_ref(); formal = PL_new_term_ref(); swi = PL_new_term_ref(); /* build (ISO) formal part */ va_start(args, id); switch(id) { case ERR_INSTANTIATION: err_instantiation: rc = PL_unify_atom(formal, ATOM_instantiation_error); break; case ERR_UNINSTANTIATION: { int argn = va_arg(args, int); term_t bound = va_arg(args, term_t); if ( !msg && argn > 0 ) { Ssprintf(msgbuf, "%d-%s argument", argn, argn == 1 ? "st" : argn == 2 ? "nd" : "th"); msg = msgbuf; } rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_uninstantiation_error1, PL_TERM, bound); break; } case ERR_TYPE: /* ERR_INSTANTIATION if var(actual) */ { atom_t expected = va_arg(args, atom_t); term_t actual = va_arg(args, term_t); case_type_error: if ( expected == ATOM_callable ) rewrite_callable(&expected, actual); if ( PL_is_variable(actual) && expected != ATOM_variable ) goto err_instantiation; rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_type_error2, PL_ATOM, expected, PL_TERM, actual); break; case ERR_PTR_TYPE: /* atom_t, Word */ { Word ptr; expected = va_arg(args, atom_t); ptr = va_arg(args, Word); actual = PL_new_term_ref(); *valTermRef(actual) = *ptr; goto case_type_error; } } case ERR_CHARS_TYPE: /* ERR_INSTANTIATION if var(actual) */ { const char *expected = va_arg(args, const char*); term_t actual = va_arg(args, term_t); if ( PL_is_variable(actual) && !streq(expected, "variable") ) goto err_instantiation; rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_type_error2, PL_CHARS, expected, PL_TERM, actual); break; } case ERR_AR_TYPE: /* arithmetic type error */ { atom_t expected = va_arg(args, atom_t); Number num = va_arg(args, Number); term_t actual = PL_new_term_ref(); rc = (_PL_put_number(actual, num) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_type_error2, PL_ATOM, expected, PL_TERM, actual)); break; } case ERR_AR_DOMAIN: { atom_t domain = va_arg(args, atom_t); Number num = va_arg(args, Number); term_t actual = PL_new_term_ref(); rc = (_PL_put_number(actual, num) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_domain_error2, PL_ATOM, domain, PL_TERM, actual)); break; } case ERR_AR_UNDEF: { rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_evaluation_error1, PL_ATOM, ATOM_undefined); break; } case ERR_AR_OVERFLOW: { rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_evaluation_error1, PL_ATOM, ATOM_float_overflow); break; } case ERR_AR_UNDERFLOW: { rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_evaluation_error1, PL_ATOM, ATOM_float_underflow); break; } case ERR_DOMAIN: /* ERR_INSTANTIATION if var(arg) */ { atom_t domain = va_arg(args, atom_t); term_t arg = va_arg(args, term_t); if ( PL_is_variable(arg) ) goto err_instantiation; rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_domain_error2, PL_ATOM, domain, PL_TERM, arg); break; } case ERR_RANGE: /* domain_error(range(low,high), arg) */ { term_t low = va_arg(args, term_t); term_t high = va_arg(args, term_t); term_t arg = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_domain_error2, PL_FUNCTOR, FUNCTOR_range2, PL_TERM, low, PL_TERM, high, PL_TERM, arg); break; } case ERR_REPRESENTATION: { atom_t what = va_arg(args, atom_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_representation_error1, PL_ATOM, what); break; } { Definition def; /* shared variables */ Procedure proc; term_t pred; case ERR_MODIFY_STATIC_PROC: proc = va_arg(args, Procedure); def = proc->definition; goto modify_static; case ERR_MODIFY_STATIC_PREDICATE: def = va_arg(args, Definition); modify_static: rc = ((pred = PL_new_term_ref()) && unify_definition(MODULE_user, pred, def, 0, GP_NAMEARITY|GP_HIDESYSTEM) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_permission_error3, PL_ATOM, ATOM_modify, PL_ATOM, ATOM_static_procedure, PL_TERM, pred)); break; } case ERR_MODIFY_THREAD_LOCAL_PROC: { Procedure proc = va_arg(args, Procedure); term_t pred = PL_new_term_ref(); rc = (unify_definition(MODULE_user, pred, proc->definition, 0, GP_NAMEARITY|GP_HIDESYSTEM) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_permission_error3, PL_ATOM, ATOM_modify, PL_ATOM, ATOM_thread_local_procedure, PL_TERM, pred)); break; } case ERR_UNDEFINED_PROC: { Definition def = va_arg(args, Definition); Definition clr = va_arg(args, Definition); term_t pred = PL_new_term_ref(); if ( clr ) caller = clr; rc = (unify_definition(MODULE_user, pred, def, 0, GP_NAMEARITY) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_existence_error2, PL_ATOM, ATOM_procedure, PL_TERM, pred)); break; } case ERR_PERMISSION_PROC: { atom_t op = va_arg(args, atom_t); atom_t type = va_arg(args, atom_t); predicate_t pred = va_arg(args, predicate_t); term_t pi = PL_new_term_ref(); rc = ( PL_unify_predicate(pi, pred, GP_NAMEARITY|GP_HIDESYSTEM) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_permission_error3, PL_ATOM, op, PL_ATOM, type, PL_TERM, pi)); break; } case ERR_NOT_IMPLEMENTED_PROC: { const char *name = va_arg(args, const char *); int arity = va_arg(args, int); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_not_implemented2, PL_ATOM, ATOM_procedure, PL_FUNCTOR, FUNCTOR_divide2, PL_CHARS, name, PL_INT, arity); break; } case ERR_IMPORT_PROC: { predicate_t pred = va_arg(args, predicate_t); atom_t dest = va_arg(args, atom_t); atom_t old = va_arg(args, atom_t); term_t pi = PL_new_term_ref(); rc = ( PL_unify_predicate(pi, pred, GP_NAMEARITY) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_permission_error3, PL_FUNCTOR, FUNCTOR_import_into1, PL_ATOM, dest, PL_ATOM, ATOM_procedure, PL_TERM, pi)); if ( rc && old ) { rc = ( (msgterm = PL_new_term_ref()) && PL_unify_term(msgterm, PL_FUNCTOR_CHARS, "already_from", 1, PL_ATOM, old) ); } break; } case ERR_FAILED: { term_t goal = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_failure_error1, PL_TERM, goal); break; } case ERR_EVALUATION: { atom_t what = va_arg(args, atom_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_evaluation_error1, PL_ATOM, what); break; } case ERR_NOT_EVALUABLE: { functor_t f = va_arg(args, functor_t); term_t actual = PL_new_term_ref(); rc = (put_name_arity(actual, f) && PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_type_error2, PL_ATOM, ATOM_evaluable, PL_TERM, actual)); break; } case ERR_DIV_BY_ZERO: { rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_evaluation_error1, PL_ATOM, ATOM_zero_divisor); break; } case ERR_PERMISSION: { atom_t op = va_arg(args, atom_t); atom_t type = va_arg(args, atom_t); term_t obj = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_permission_error3, PL_ATOM, op, PL_ATOM, type, PL_TERM, obj); break; } case ERR_OCCURS_CHECK: { Word p1 = va_arg(args, Word); Word p2 = va_arg(args, Word); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_occurs_check2, PL_TERM, pushWordAsTermRef(p1), PL_TERM, pushWordAsTermRef(p2)); popTermRef(); popTermRef(); break; } case ERR_TIMEOUT: { atom_t op = va_arg(args, atom_t); term_t obj = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_timeout_error2, PL_ATOM, op, PL_TERM, obj); break; } case ERR_EXISTENCE: { atom_t type = va_arg(args, atom_t); term_t obj = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_existence_error2, PL_ATOM, type, PL_TERM, obj); break; } case ERR_EXISTENCE3: { atom_t type = va_arg(args, atom_t); term_t obj = va_arg(args, term_t); term_t in = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_existence_error3, PL_ATOM, type, PL_TERM, obj, PL_TERM, in); break; } case ERR_FILE_OPERATION: { atom_t action = va_arg(args, atom_t); atom_t type = va_arg(args, atom_t); term_t file = va_arg(args, term_t); switch(errno) { case EAGAIN: action = ATOM_lock; /* Hack for file-locking*/ /*FALLTHROUGH*/ case EACCES: rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_permission_error3, PL_ATOM, action, PL_ATOM, type, PL_TERM, file); break; case EMFILE: case ENFILE: rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_resource_error1, PL_ATOM, ATOM_max_files); break; #ifdef EPIPE case EPIPE: if ( !msg ) msg = "Broken pipe"; /*FALLTHROUGH*/ #endif default: /* what about the other cases? */ rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_existence_error2, PL_ATOM, type, PL_TERM, file); break; } break; } case ERR_STREAM_OP: { atom_t action = va_arg(args, atom_t); term_t stream = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_io_error2, PL_ATOM, action, PL_TERM, stream); break; } case ERR_DDE_OP: { const char *op = va_arg(args, const char *); const char *err = va_arg(args, const char *); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_dde_error2, PL_CHARS, op, PL_CHARS, err); break; } case ERR_SHARED_OBJECT_OP: { atom_t action = va_arg(args, atom_t); const char *err = va_arg(args, const char *); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_shared_object2, PL_ATOM, action, PL_CHARS, err); break; } case ERR_NOT_IMPLEMENTED: /* non-ISO */ { const char *what = va_arg(args, const char *); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_not_implemented2, PL_ATOM, ATOM_feature, PL_CHARS, what); break; } case ERR_RESOURCE: { atom_t what = va_arg(args, atom_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_resource_error1, PL_ATOM, what); break; } case ERR_SYNTAX: { const char *what = va_arg(args, const char *); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_syntax_error1, PL_CHARS, what); break; } case ERR_NOMEM: { rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_resource_error1, PL_ATOM, ATOM_no_memory); break; } case ERR_SYSCALL: { const char *op = va_arg(args, const char *); if ( !msg ) msg = op; switch(errno) { case ENOMEM: rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_resource_error1, PL_ATOM, ATOM_no_memory); break; default: rc = PL_unify_atom(formal, ATOM_system_error); break; } break; } case ERR_SHELL_FAILED: { term_t cmd = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_shell2, PL_ATOM, ATOM_execute, PL_TERM, cmd); break; } case ERR_SHELL_SIGNALLED: { term_t cmd = va_arg(args, term_t); int sig = va_arg(args, int); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_shell2, PL_FUNCTOR, FUNCTOR_signal1, PL_INT, sig, PL_TERM, cmd); break; } case ERR_SIGNALLED: { int sig = va_arg(args, int); char *signame = va_arg(args, char *); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_signal2, PL_CHARS, signame, PL_INT, sig); break; } case ERR_CLOSED_STREAM: { IOSTREAM *s = va_arg(args, IOSTREAM *); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_existence_error2, PL_ATOM, ATOM_stream, PL_POINTER, s); do_throw = TRUE; break; } case ERR_BUSY: { atom_t type = va_arg(args, atom_t); term_t mutex = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_busy2, type, mutex); break; } case ERR_FORMAT: { const char *s = va_arg(args, const char*); rc = PL_unify_term(formal, PL_FUNCTOR_CHARS, "format", 1, PL_CHARS, s); break; } case ERR_FORMAT_ARG: { const char *s = va_arg(args, const char*); term_t arg = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR_CHARS, "format_argument_type", 2, PL_CHARS, s, PL_TERM, arg); break; } case ERR_DUPLICATE_KEY: { term_t key = va_arg(args, term_t); rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_duplicate_key1, PL_TERM, key); break; } default: assert(0); } va_end(args); /* build SWI-Prolog context term */ if ( rc && (pred || msg || msgterm || caller) ) { term_t predterm = PL_new_term_ref(); if ( !msgterm ) msgterm = PL_new_term_ref(); if ( pred ) { rc = PL_unify_term(predterm, PL_FUNCTOR, FUNCTOR_divide2, PL_CHARS, pred, PL_INT, arity); } else if ( caller ) { rc = unify_definition(MODULE_user, predterm, caller, 0, GP_NAMEARITY); } if ( rc && msg ) { rc = PL_put_atom_chars(msgterm, msg); } if ( rc ) rc = PL_unify_term(swi, PL_FUNCTOR, FUNCTOR_context2, PL_TERM, predterm, PL_TERM, msgterm); } if ( rc ) rc = PL_unify_term(except, PL_FUNCTOR, FUNCTOR_error2, PL_TERM, formal, PL_TERM, swi); if ( !rc ) { nomem: fatalError("Cannot report error: no memory"); } if ( do_throw ) rc = PL_throw(except); else rc = PL_raise_exception(except); PL_close_foreign_frame(fid); return rc; }