int
error_func(int type, const char *pred, int argi, intptr_t argl)
{ switch(type)
{ case ERR_INSTANTIATION:
{ char buf[1024];
sprintf(buf, "%s: instantiation error on argument %d", pred, argi);
return PL_warning(buf);
}
case ERR_IO:
{ char buf[1024];
#ifdef __WINDOWS__
char *msg = winerror(argi);
sprintf(buf, "%s: IO error %s", pred, msg);
free(msg);
#else
sprintf(buf, "%s: IO error %s", pred, strerror(argi));
#endif
return PL_warning(buf);
}
}
return PL_warning("Table package: unknown error");
}
static void
call_prolog_goal(prolog_goal *g)
{ fid_t fid;
static predicate_t pred = NULL;
int rc;
if ( !pred )
pred = PL_predicate("call", 1, "user");
if ( (fid = PL_open_foreign_frame()) )
{ term_t t = PL_new_term_ref();
term_t vars;
rc = PL_recorded(g->goal, t);
PL_erase(g->goal);
g->goal = 0;
g->state = G_RUNNING;
if ( rc )
{ qid_t qid;
int flags = PL_Q_NORMAL;
if ( g->acknowledge )
{ flags |= PL_Q_CATCH_EXCEPTION;
vars = PL_new_term_ref();
if ( !PL_get_arg(2, t, vars) || /* Goal-Vars */
!PL_get_arg(1, t, t) )
{ PL_warning("ERROR: in_pce_thread: bad goal-vars term");
}
} else
{ vars = 0;
}
if ( (qid = PL_open_query(g->module, flags, pred, t)) )
{ rc = PL_next_solution(qid);
if ( rc )
{ g->state = G_TRUE;
if ( vars )
g->result = PL_record(vars);
} else
{ term_t ex;
if ( g->acknowledge && (ex=PL_exception(qid)) )
{ g->result = PL_record(ex);
g->state = G_ERROR;
} else
{ g->state = G_FALSE;
}
}
PL_cut_query(qid);
} else
PL_warning("ERROR: pce: out of global stack");
}
PL_discard_foreign_frame(fid);
} else
PL_warning("ERROR: pce: out of global stack");
}
static int
save_clause_ref(atom_t aref, IOSTREAM *fd)
{ clref *ref = PL_blob_data(aref, NULL, NULL);
(void)fd;
return PL_warning("Cannot save reference to <clause>(%p)", ref->clause);
}
static foreign_t
pl_pwmSetRange (term_t range_){
unsigned int range;
if (!PL_get_integer(range_,&range)) {
PL_warning("Argument `range` not number!\n");
PL_fail;
}
if (range<0)
{
PL_warning("Argument 'range' not unsigned one!\n");
PL_fail;
}
pwmSetRange(range);
PL_succeed;
}
static int
format_error(const char *pred, size_t pos, Field f)
{ char buf[1024];
sprintf(buf, "%s: bad record, field %d (%s), char-index %ld",
pred, f->index, PL_atom_chars(f->name), (long)pos);
return PL_warning(buf);
}
static foreign_t
pl_setPadDrive (term_t group_, term_t value_){
int group,value;
if (!PL_get_integer(group,&group))
{
PL_warning("Argument 'group' not number");
PL_fail;
}
if (!PL_get_integer(value,&value))
{
PL_warning("Argument 'value' not number");
PL_fail;
}
setPadDrive(group,value);
PL_succeed;
}
static foreign_t
pl_get_ps_parameters(term_t file, term_t iseps, term_t bb)
{ char *fname;
FILE *fd;
if ( !PL_get_chars(file, &fname, CVT_ALL) )
return PL_warning("get_ps_parameters/3: invalid filename");
if ( (fd = fopen(fname, "r")) )
{ char buf[MAXLINE];
char *s;
if ( (s=fgets(buf, sizeof(buf), fd)) )
{ if ( substr(s, "EPSF") )
PL_unify_atom_chars(iseps, "eps");
else
PL_unify_atom_chars(iseps, "ps");
}
do
{ double a1, a2, a3, a4;
if ( sscanf(buf, "%%%%BoundingBox: %lf %lf %lf %lf", &a1, &a2, &a3, &a4) == 4 )
{ fclose(fd);
return PL_unify_term(bb,
PL_FUNCTOR, PL_new_functor(PL_new_atom("bb"), 4),
PL_FLOAT, a1,
PL_FLOAT, a2,
PL_FLOAT, a3,
PL_FLOAT, a4);
}
} while( (s=fgets(buf, sizeof(buf), fd)) );
fclose(fd);
PL_warning("get_ps_parameters/3: could not find %%%%BoundingBox in %s",
fname);
PL_fail;
}
PL_warning("get_ps_parameters/3: could not open %s", fname);
PL_fail;
}
static foreign_t
pl_wpiPinToGpio (term_t wPiPin_,term_t t){
int wPiPin;
if (!PL_get_integer(wPiPin_,&wPiPin))
{
PL_warning("Argument 'wPiPin' not number");
PL_fail;
}
return PL_unify_integer(t,wpiPinToGpio(wPiPin));
}
static foreign_t
pl_physPinToGpio (term_t physPin_,term_t t){
int physPin;
if (!PL_get_integer(physPin_,&physPin))
{
PL_warning("Argument 'physPin' not number");
PL_fail;
}
return PL_unify_integer(t,physPinToGpio(physPin));
}
foreign_t pl_getPresumedLoc(term_t DeclT, term_t FilenameT,
term_t LineT, term_t ColT) {
const Decl *D;
if ( !PL_get_pointer(DeclT, (void **) &D))
return PL_warning("getPresumedLoc/4: instantiation fault on first arg");
const SourceManager &SM = getCompilationInfo()->getSourceManager();
const PresumedLoc PL = SM.getPresumedLoc(D->getLocation());
if ( !PL_unify_atom_chars(FilenameT, PL.getFilename())) return FALSE;
if ( !PL_unify_int64(LineT, (int64_t) PL.getLine())) return FALSE;
return PL_unify_int64(ColT, (int64_t) PL.getColumn());
}
static foreign_t
pl_digitalWriteByte(term_t t){
int value;
if (!PL_get_integer(t,&value)) {
PL_warning("Argument `value` not number!\n");
PL_fail;
}
digitalWriteByte(value);
PL_succeed;
}
static foreign_t
pl_pwmSetClock (term_t divisor_){
int divisor;
if (!PL_get_integer(divisor_,&divisor)) {
PL_warning("Argument `divisor` not number!\n");
PL_fail;
}
pwmSetClock(divisor);
PL_succeed;
}
static foreign_t
pl_pwmSetMode (term_t mode_){
int mode;
if (!PL_get_integer(mode_,&mode)) {
PL_warning("Argument `mode` not number!\n");
PL_fail;
}
pwmSetMode(mode);
PL_succeed;
}
foreign_t pl_number_of_words_of_length(term_t word_length,
term_t nwordsSize_t)
{
int n;
if(!PL_is_integer(word_length))
{
PL_warning("word_length should be a bound integer");
}
else
PL_get_integer(word_length,&n);
int nWordsSize = number_of_words_of_length(n);
return PL_unify_integer(nwordsSize_t,nWordsSize);
}
foreign_t pl_read_dictionary(term_t filepath_term)
{
size_t length;
char* filename;
if(PL_is_string(filepath_term))
return PL_warning("please input a valid string");
PL_get_chars(filepath_term,&filename,CVT_ALL|BUF_DISCARDABLE);
printf("reading the file for list of words %s\n",filename);
if(read_dictionary(filename)==0)
PL_succeed;
else
PL_fail;
}
static void
standard_table(atom_t name, void (*func)(OrdTable))
{ OrdTable t = malloc(sizeof(ordtable));
if ( t )
{ exact_table(t);
t->name = name;
if ( func )
(*func)(t);
register_table(t);
} else
PL_warning("Could not allocate table");
}
static foreign_t
pl_host_to_address(term_t Host, term_t Ip)
{ struct in_addr ip;
char *host_name;
if ( PL_get_atom_chars(Host, &host_name) )
{ struct addrinfo hints;
struct addrinfo *res;
memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_INET;
if ( getaddrinfo(host_name, NULL, &hints, &res) == 0 )
{ int rc;
switch( res->ai_family )
{
case AF_INET:
{ struct sockaddr_in *addr = (struct sockaddr_in*)res->ai_addr;
rc = nbio_unify_ip4(Ip, ntohl(addr->sin_addr.s_addr));
break;
}
case AF_INET6:
{ rc = PL_warning("tcp_host_to_address/2: IPv6 address not supported");
break;
}
default:
assert(0);
rc = FALSE;
}
freeaddrinfo(res);
return rc;
} else
{ return nbio_error(h_errno, TCP_HERRNO);
}
} else if ( nbio_get_ip(Ip, &ip) )
{ struct hostent *host;
if ( (host = gethostbyaddr((char *)&ip, sizeof(ip), AF_INET)) )
return PL_unify_atom_chars(Host, host->h_name);
else
return nbio_error(h_errno, TCP_HERRNO);
}
return FALSE;
}
foreign_t
pl_lowercase(term_t u, term_t l)
{ char *copy;
char *s, *q;
atom_t la;
if ( !PL_get_atom_chars(u, &s) )
return PL_warning("lowercase/2: instantiation fault");
copy = malloc(strlen(s)+1);
for( q=copy; *s; q++, s++)
*q = (isupper(*s) ? tolower(*s) : *s);
*q = '\0';
la = PL_new_atom(copy);
free(copy);
return PL_unify_atom(l, la);
}
static foreign_t
pl_host_to_address(term_t Host, term_t Ip)
{ struct in_addr ip;
struct hostent *host;
char *host_name;
if ( PL_get_atom_chars(Host, &host_name) )
{ if ( (host = gethostbyname(host_name)) )
{ if ( sizeof(ip) == host->h_length )
{ memcpy(&ip, host->h_addr, host->h_length);
return nbio_unify_ip4(Ip, ntohl(ip.s_addr));
} else
return PL_warning("tcp_host_to_address/2: length mismatch in address");
} else
return nbio_error(h_errno, TCP_HERRNO);
} else if ( nbio_get_ip(Ip, &ip) )
{ if ( (host = gethostbyaddr((char *)&ip, sizeof(ip), AF_INET)) )
return PL_unify_atom_chars(Host, host->h_name);
else
return nbio_error(h_errno, TCP_HERRNO);
}
return FALSE;
}
static foreign_t
pl_uuid(term_t UUID, term_t options)
{ unsigned int mode = UUID_MAKE_V1;
atom_t format = ATOM_atom;
uuid_t *uuid;
char *ns = NULL;
char *str = NULL;
int rc;
uuid_rc_t urc;
if ( !PL_get_nil(options) )
{ term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t arg = PL_new_term_ref();
while( PL_get_list(tail, head, tail) )
{ atom_t name;
size_t arity;
if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 )
return PL_type_error("option", head);
_PL_get_arg(1, head, arg);
if ( name == ATOM_version )
{ int v;
if ( !PL_get_integer_ex(arg, &v) )
return FALSE;
switch(v)
{ case 1: mode = UUID_MAKE_V1; break;
case 2: mode = UUID_MAKE_MC; break;
case 3: mode = UUID_MAKE_V3; break;
case 4: mode = UUID_MAKE_V4; break;
case 5: mode = UUID_MAKE_V5; break;
default: return PL_domain_error("uuid_version", arg);
}
} else if ( name == ATOM_format )
{ if ( !PL_get_atom_ex(arg, &format) )
return FALSE;
if ( format != ATOM_atom && format != ATOM_integer )
return PL_domain_error("uuid_format", arg);
} else
{ char *newns = NULL;
if ( name == ATOM_dns )
{ newns = "ns:DNS";
} else if ( name == ATOM_url )
{ newns = "ns:URL";
} else if ( name == ATOM_oid )
{ newns = "ns:OID";
} else if ( name == ATOM_x500 )
{ newns = "ns:X500";
}
if ( newns )
{ ns = newns;
if ( !PL_get_chars(arg, &str, CVT_ATOM|CVT_EXCEPTION) )
return FALSE;
if ( mode == UUID_MAKE_V1 )
mode = UUID_MAKE_V3;
}
}
}
if ( !PL_get_nil_ex(tail) )
return FALSE;
}
switch(mode)
{ case UUID_MAKE_V1:
case UUID_MAKE_MC:
case UUID_MAKE_V4:
uuid_create(&uuid);
if ( (urc=uuid_make(uuid, mode)) != UUID_RC_OK )
return PL_warning("UUID: make: %s\n", uuid_error(urc));
break;
case UUID_MAKE_V3:
case UUID_MAKE_V5:
{ uuid_t *uuid_ns;
if ( !ns )
return PL_existence_error("uuid_context", options);
uuid_create(&uuid);
uuid_create(&uuid_ns);
uuid_load(uuid_ns, ns);
if ( (urc=uuid_make(uuid, mode, uuid_ns, str)) != UUID_RC_OK )
return PL_warning("UUID: make: %s\n", uuid_error(urc));
uuid_destroy(uuid_ns);
break;
}
default:
assert(0);
return FALSE;
}
if ( format == ATOM_atom )
{ char buf[UUID_LEN_STR+1];
void *ptr = buf;
size_t datalen = sizeof(buf);
if ( (urc=uuid_export(uuid, UUID_FMT_STR, &ptr, &datalen)) != UUID_RC_OK )
return PL_warning("UUID: export: %s\n", uuid_error(urc));
rc = PL_unify_chars(UUID, PL_ATOM|REP_ISO_LATIN_1, (size_t)-1, buf);
} else if ( format == ATOM_integer )
{ char buf[UUID_LEN_SIV+1];
void *ptr = buf;
size_t datalen = sizeof(buf);
term_t tmp = PL_new_term_ref();
if ( (urc=uuid_export(uuid, UUID_FMT_SIV, &ptr, &datalen)) != UUID_RC_OK )
return PL_warning("UUID: export: %s\n", uuid_error(urc));
rc = ( PL_chars_to_term(buf, tmp) &&
PL_unify(UUID, tmp)
);
} else
{ assert(0);
return FALSE;
}
uuid_destroy(uuid);
return rc;
}
