rb_red_blk_tree* buildEventMap()
{
printf("--- Generating Event Rule Map ... \n");
rb_red_blk_tree* EventTree = RBTreeCreate(Compare_EventType,DestroyEventType,DestroyInfoEventKey,PrintEventKey,PrintInfoEventKey);
if(!EventTree)
{
printf("Error Building the Event Rule Map.\n");
return NULL;
}
int i=0;
term_t a0 = PL_new_term_refs(3);
term_t b0 = PL_new_term_refs(2);
static predicate_t p;
static functor_t event_functor;
char myEvents[256][256];
int arity;
eventType* temp=NULL;
if ( !event_functor )
event_functor = PL_new_functor(PL_new_atom("event"), 2);
PL_cons_functor(a0+1,event_functor,b0,b0+1);
if ( !p )
p = PL_predicate("trClause", 3, NULL);
qid_t qid = PL_open_query(NULL, PL_Q_NORMAL, p, a0);
while(PL_next_solution(qid) != FALSE)
{
//termToString(b0,myEvents[i]);
atom_t name;
PL_get_name_arity(b0, &name, &arity);
sprintf(myEvents[i],"%s",PL_atom_chars(name));
temp=(eventType*)calloc(1,sizeof(eventType));
trClause* trc=(trClause*)calloc(1,sizeof(trClause));
strcpy(temp->name,PL_atom_chars(name));
temp->arity = arity;
RBTreeInsert(EventTree,temp,trc);
temp=NULL;
trc=NULL;
padding(' ',4);
printf("+New Event Signature : %s/%d\n",myEvents[i],arity);
i++;
}
PL_close_query(qid);
#if DEBUG
RBTreePrint(EventTree);
#endif
printf("--- Done!\n");
return EventTree;
}
static int
syntax_error(IOSTREAM *in, const char *msg)
{ term_t ex = PL_new_term_refs(2);
IOPOS *pos;
if ( !PL_unify_term(ex+0, PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_CHARS, msg) )
return FALSE;
if ( (pos=in->position) )
{ term_t stream;
if ( !(stream = PL_new_term_ref()) ||
!PL_unify_stream(stream, in) ||
!PL_unify_term(ex+1,
PL_FUNCTOR, FUNCTOR_stream4,
PL_TERM, stream,
PL_INT, (int)pos->lineno,
PL_INT, (int)(pos->linepos-1), /* one too late */
PL_INT64, (int64_t)(pos->charno-1)) )
return FALSE;
}
if ( PL_cons_functor_v(ex, FUNCTOR_error2, ex) )
{ int c;
do
{ c = Sgetcode(in);
} while(c != '\n' && c != -1);
return PL_raise_exception(ex);
}
return FALSE;
}
static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
if (_PL_rd->qq_tail) {
term_t av;
int rc;
if (!PL_unify_nil(_PL_rd->qq_tail))
return FALSE;
if (!_PL_rd->quasi_quotations) {
if ((av = PL_new_term_refs(2)) && PL_put_term(av + 0, _PL_rd->qq) &&
#if __YAP_PROLOG__
PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) &&
#else
PL_put_atom(av + 1, _PL_rd->module->name) &&
#endif
PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av)) {
term_t ex;
rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex);
if (rc)
return TRUE;
_PL_rd->exception = ex;
_PL_rd->has_exception = TRUE;
}
return FALSE;
} else
return TRUE;
} else if (_PL_rd->quasi_quotations) /* user option, but no quotes */
{
return PL_unify_nil(_PL_rd->quasi_quotations);
} else
return TRUE;
}
/*************************
* swi_list_length
*************************/
int
swi_list_length(term_t pl_list)
{
fid_t frame;
predicate_t pr_length;
term_t pl_args, pl_length;
int length;
frame = PL_open_foreign_frame();
pr_length = PL_predicate("length", 2, NULL);
pl_args = PL_new_term_refs(2);
pl_length = pl_args + 1;
length = -1;
if (!PL_unify(pl_args, pl_list) ||
!PL_call_predicate(NULL, PL_Q_NORMAL, pr_length, pl_args))
goto out;
PL_get_integer(pl_length, &length);
out:
PL_discard_foreign_frame(frame);
return length;
}
static foreign_t
uri_query_components(term_t string, term_t list)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ return unify_query_string_components(list, len, s);
} else if ( PL_is_list(list) )
{ term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t nv = PL_new_term_refs(2);
charbuf out;
int rc;
fill_flags();
init_charbuf(&out);
while( PL_get_list(tail, head, tail) )
{ atom_t fname;
int arity;
if ( PL_is_functor(head, FUNCTOR_equal2) ||
PL_is_functor(head, FUNCTOR_pair2) )
{ _PL_get_arg(1, head, nv+0);
_PL_get_arg(2, head, nv+1);
} else if ( PL_get_name_arity(head, &fname, &arity) && arity == 1 )
{ PL_put_atom(nv+0, fname);
_PL_get_arg(1, head, nv+1);
} else
{ free_charbuf(&out);
return type_error("name_value", head);
}
if ( out.here != out.base )
add_charbuf(&out, '&');
if ( !add_encoded_term_charbuf(&out, nv+0, ESC_QNAME) )
{ free_charbuf(&out);
return FALSE;
}
add_charbuf(&out, '=');
if ( !add_encoded_term_charbuf(&out, nv+1, ESC_QVALUE) )
{ free_charbuf(&out);
return FALSE;
}
}
rc = PL_unify_wchars(string, PL_ATOM, out.here-out.base, out.base);
free_charbuf(&out);
return rc;
} else
{ return PL_get_wchars(string, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
return FALSE;
}
static bool call_function(clingo_location_t loc, char const *name,
clingo_symbol_t const *in, size_t ilen, void *closure,
clingo_symbol_callback_t *cb, void *cb_closure) {
(void)loc;
(void)closure;
static predicate_t pred = 0;
fid_t fid = 0;
qid_t qid = 0;
term_t av;
bool rc = true;
if (!pred) {
pred = PL_predicate("inject_values", 3, "clingo");
}
if (!(fid = PL_open_foreign_frame())) {
rc = false;
clingo_set_error(clingo_error_runtime, "prolog error");
goto out;
}
av = PL_new_term_refs(3);
PL_put_atom_chars(av + 0, name);
if (!(rc = unify_list_from_span(av + 1, in, ilen))) {
clingo_set_error(clingo_error_runtime, "prolog error");
goto out;
}
if ((qid = PL_open_query(NULL, PL_Q_PASS_EXCEPTION, pred, av))) {
while (PL_next_solution(qid)) {
clingo_symbol_t value;
if (!(rc = get_value(av + 2, &value, FALSE))) {
goto out;
}
if (!(rc = cb(&value, 1, cb_closure))) {
goto out;
}
}
if (PL_exception(0)) {
rc = false;
clingo_set_error(clingo_error_runtime, "prolog error");
goto out;
}
}
out:
if (qid) {
PL_close_query(qid);
}
if (fid) {
PL_close_foreign_frame(fid);
}
return rc;
}
int main()
{
char *ancestor(const char *me)
term_t a0 = PL_new_term_refs(3);
term_t a1 = PL_new_term_refs(3);
term_t a2 = PL_new_term_refs(3);
static predicate_t p;
if ( !p )
p = PL_predicate("pere", 3, "teste.pl");
PL_put_atom_chars(a0, me);
PL_open_query(NULL, PL_Q_NORMAL, p, a0);
PL_open_query(NULL, PL_Q_NORMAL, p, a1);
printf("%s", me);
return 0;
}
static int
unify_address(term_t t, struct sockaddr_in *addr)
{ term_t av = PL_new_term_refs(2);
if ( !nbio_unify_ip4(av+0, ntohl(addr->sin_addr.s_addr)) ||
!PL_unify_integer(av+1, ntohs(addr->sin_port)) )
return FALSE;
return PL_unify_term(t, PL_FUNCTOR_CHARS, ":", 2,
PL_TERM, av+0,
PL_TERM, av+1);
}
static int
unify_uri_authority_components(term_t components,
size_t len, const pl_wchar_t *s)
{ const pl_wchar_t *end = &s[len];
const pl_wchar_t *e;
range user = {0};
range passwd = {0};
range host = {0};
range port = {0};
term_t t = PL_new_term_refs(5);
term_t av = t+1;
if ( (e=skip_not(s, end, L"@")) && e<end )
{ user.start = s;
user.end = e;
s = e+1;
if ( (e=skip_not(user.start, user.end, L":")) && e<user.end )
{ passwd.start = e+1;
passwd.end = user.end;
user.end = e;
}
}
host.start = s;
host.end = skip_not(s, end, L":");
if ( host.end < end )
{ port.start = host.end+1;
port.end = end;
}
if ( user.start )
unify_decoded_atom(av+0, &user, ESC_USER);
if ( passwd.start )
unify_decoded_atom(av+1, &passwd, ESC_PASSWD);
unify_decoded_atom(av+2, &host, ESC_HOST);
if ( port.start )
{ wchar_t *ep;
long pn = wcstol(port.start, &ep, 10);
if ( ep == port.end )
{ if ( !PL_put_integer(av+3, pn) )
return FALSE;
} else
{ unify_decoded_atom(av+3, &port, ESC_PORT);
}
}
return (PL_cons_functor_v(t, FUNCTOR_uri_authority4, av) &&
PL_unify(components, t));
}
static int
put_name_arity(term_t t, functor_t f)
{ GET_LD
FunctorDef fdef = valueFunctor(f);
term_t a;
if ( (a=PL_new_term_refs(2)) )
{ PL_put_atom(a+0, fdef->name);
return (PL_put_integer(a+1, fdef->arity) &&
PL_cons_functor(t, FUNCTOR_divide2, a+0, a+1));
}
return FALSE;
}
static char *prolog_ciclo(modulo_t *modulo, const char *puerto, const void *dato)
{
predicate_t pred;
term_t h0;
double f = 0.0f;
prolog_dato_t *prolog = (prolog_dato_t*)modulo->m_dato;
if(!strcmp(PUERTO, puerto)) {
char *cadena = (char *)dato;
if(cadena) {
char *cadena_aux = prolog_mayusculas(cadena);
if(!strcmp(cadena_aux, "AVANZAR")) {
printf("jajajaj");
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "avanzar");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "media");
}
else if(!strcmp(cadena_aux, "RETROCEDER")) {
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "avanzar");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "nula");
}
else if(!strcmp(cadena_aux, "GIRAR IZQUIERDA")) {
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "girar");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "alta");
}
else if(!strcmp(cadena_aux, "GIRAR DERECHA")) {
g_hash_table_insert(modulo->m_tabla, PUERTO_ORDEN, "girar_negativo");
g_hash_table_insert(modulo->m_tabla, PUERTO_PARAMETRO, "alta");
}
else {
pred = PL_predicate("camaron", 2, "dcg");
h0 = PL_new_term_refs(2);
PL_put_list_codes(h0, cadena);
if(PL_call_predicate(NULL, PL_Q_NORMAL, pred, h0)) {
PL_get_float(h0 + 1, &f);
sprintf(prolog->m_buffer_salida, "Resultado: %f.", f);
g_hash_table_insert(modulo->m_tabla, PUERTO_SALIDA, prolog->m_buffer_salida);
}
else {
g_hash_table_insert(modulo->m_tabla, PUERTO_SALIDA, 0);
}
}
free(cadena_aux);
}
}
return 0;
}
// handle OSC message by calling the associated Prolog goal
static int prolog_handler(const char *path, const char *types, lo_arg **argv,
int argc, lo_message msg, void *user_data)
{
term_t goal = PL_new_term_ref();
term_t term0 = PL_new_term_refs(3);
term_t term1 = term0+1;
term_t term2 = term0+2;
term_t list;
int i, rc=0;
PL_recorded((record_t)user_data,goal); // retrieve the goal term
PL_put_term(term0,goal); // term_t goal encoded in user_data
PL_put_atom_chars(term1,path);
list = PL_copy_term_ref(term2);
for (i=0; i<argc; i++) {
term_t head=PL_new_term_ref();
term_t tail=PL_new_term_ref();
if (!PL_unify_list(list,head,tail)) PL_fail;
switch (types[i]) {
case 'c': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"char",1,PL_INT,(int)argv[i]->c); break;
case 'i': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int",1,PL_INT,argv[i]->i); break;
case 'h': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int64",1,PL_INT64,argv[i]->h); break;
case 'f': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"float",1,PL_FLOAT,(double)argv[i]->f); break;
case 'd': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"double",1,PL_DOUBLE,argv[i]->d); break;
case 's': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"string",1,PL_CHARS,&argv[i]->s); break;
case 'S': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"symbol",1,PL_CHARS,&argv[i]->S); break;
case 'T': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"true",0); break;
case 'F': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"false",0); break;
case 'N': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"nil",0); break;
case 'I': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"inf",0); break;
case 'b': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"blob",0); break;
case 't': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"timetag",2,
PL_INT64,(int64_t)argv[i]->t.sec,
PL_INT64,(int64_t)argv[i]->t.frac);
break;
case 'm': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"midi",4,
PL_INT,(int)argv[i]->m[0], PL_INT,(int)argv[i]->m[1],
PL_INT,(int)argv[i]->m[2], PL_INT,(int)argv[i]->m[3]);
break;
}
if (!rc) PL_fail;
list=tail;
}
return PL_unify_nil(list) && PL_call_predicate(NULL,PL_Q_NORMAL,call3,term0);
}
/* todo */
void parse_validate_args(term_t args, EtalisEvent* event)
{
event->args = malloc(sizeof(int)*event->RootModel->event.arity);
int arity;
PL_get_name_arity(args, NULL, &arity);
term_t arg_terms = PL_new_term_refs(arity);
/* assuming that all arguments are ints */ /* todo implement for other types */
size_t arg_iterator;
for(arg_iterator=0;arg_iterator<event->RootModel->event.arity;arg_iterator++)
{
PL_get_arg(arg_iterator+1,args,arg_terms+arg_iterator);
PL_get_integer(arg_terms+arg_iterator,(int*)event->args+arg_iterator);
}
}
/*************************
* list_length
*************************/
static int
list_length(term_t pl_list)
{
predicate_t pr_length;
term_t pl_args, pl_length;
int length;
pr_length = PL_predicate("length", 2, NULL);
pl_args = PL_new_term_refs(2);
pl_length = pl_args + 1;
if (!PL_unify(pl_args, pl_list) ||
!PL_call_predicate(NULL, PL_Q_NORMAL, pr_length, pl_args))
length = -1;
else
PL_get_integer(pl_length, &length);
return length;
}
int
printMessage(atom_t severity, ...)
{ GET_LD
wakeup_state wstate;
term_t av;
predicate_t pred = PROCEDURE_print_message2;
va_list args;
int rc;
if ( ++LD->in_print_message >= OK_RECURSIVE*3 )
fatalError("printMessage(): recursive call\n");
if ( !saveWakeup(&wstate, TRUE PASS_LD) )
{ LD->in_print_message--;
return FALSE;
}
av = PL_new_term_refs(2);
va_start(args, severity);
PL_put_atom(av+0, severity);
rc = PL_unify_termv(av+1, args);
va_end(args);
if ( rc )
{ if ( isDefinedProcedure(pred) && LD->in_print_message <= OK_RECURSIVE )
{ rc = PL_call_predicate(NULL, PL_Q_NODEBUG|PL_Q_CATCH_EXCEPTION,
pred, av);
} else if ( LD->in_print_message <= OK_RECURSIVE*2 )
{ Sfprintf(Serror, "Message: ");
if ( ReadingSource )
Sfprintf(Serror, "%s:%d ",
PL_atom_chars(source_file_name), (int)source_line_no);
rc = PL_write_term(Serror, av+1, 1200, 0);
Sfprintf(Serror, "\n");
} else /* in_print_message == 2 */
{ Sfprintf(Serror, "printMessage(): recursive call\n");
}
}
restoreWakeup(&wstate PASS_LD);
LD->in_print_message--;
return rc;
}
int
main(int argc, char **argv)
{ char expression[MAXLINE];
char *e = expression;
char *program = argv[0];
char *plav[2];
int n;
/* combine all the arguments in a single string */
for(n=1; n<argc; n++)
{ if ( n != 1 )
*e++ = ' ';
strcpy(e, argv[n]);
e += strlen(e);
}
/* make the argument vector for Prolog */
plav[0] = program;
plav[1] = NULL;
/* initialise Prolog */
if ( !PL_initialise(1, plav) )
PL_halt(1);
/* Lookup calc/1 and make the arguments and call */
{ predicate_t pred = PL_predicate("calc", 1, "user");
term_t h0 = PL_new_term_refs(1);
int rval;
PL_put_atom_chars(h0, expression);
rval = PL_call_predicate(NULL, PL_Q_NORMAL, pred, h0);
PL_halt(rval ? 0 : 1);
}
return 0;
}
// ######################################################################
bool SWIProlog::query(const char *predicate, std::vector<std::string> &args)
{
bool ret=false;
#ifdef HAVE_SWI_PROLOG_H
term_t a0 = PL_new_term_refs(args.size());
predicate_t p = NULL;
p = PL_predicate(predicate, args.size(), NULL);
for(uint i=0; i<args.size(); i++)
{
if (args[i].size() != 0)
PL_put_atom_chars(a0+i, args[i].c_str());
}
qid_t query_id= PL_open_query(NULL, (PL_Q_NORMAL|PL_Q_CATCH_EXCEPTION), p, a0);
ret = PL_next_solution(query_id);
if (ret)
{
//fill in the results in the place holdes
for(uint i=0; i<args.size(); i++)
{
if (args[i].size() == 0)
{
char *data;
PL_get_atom_chars(a0+i, &data);
args[i] = std::string(data);
}
}
}
PL_close_query(query_id);
#else
LINFO("SWI prolog not found");
#endif
return ret;
}
// ######################################################################
bool SWIProlog::consult(const char *filename)
{
bool ret = false;
#ifdef HAVE_SWI_PROLOG_H
term_t a0 = PL_new_term_refs(1);
predicate_t p = NULL;
p = PL_predicate("consult", 1, NULL);
PL_put_atom_chars(a0, filename);
qid_t query_id= PL_open_query(NULL, (PL_Q_NORMAL|PL_Q_CATCH_EXCEPTION), p, a0);
ret = PL_next_solution(query_id);
PL_close_query(query_id);
#else
LINFO("SWI prolog not found");
#endif
return ret;
}
static int
unify_query_string_components(term_t list, size_t len, const pl_wchar_t *qs)
{ if ( len == 0 )
{ return PL_unify_nil(list);
} else
{ term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t eq = PL_new_term_refs(3);
term_t nv = eq+1;
const pl_wchar_t *end = &qs[len];
while(qs < end)
{ range name, value;
name.start = qs;
name.end = skip_not(qs, end, L"=");
if ( name.end < end )
{ value.start = name.end+1;
value.end = skip_not(value.start, end, L"&;");
qs = value.end+1;
} else
{ return syntax_error("illegal_uri_query");
}
PL_put_variable(nv+0);
PL_put_variable(nv+1);
unify_decoded_atom(nv+0, &name, ESC_QNAME);
unify_decoded_atom(nv+1, &value, ESC_QVALUE);
if ( !PL_cons_functor_v(eq, FUNCTOR_equal2, nv) ||
!PL_unify_list(tail, head, tail) ||
!PL_unify(head, eq) )
return FALSE;
}
return PL_unify_nil(tail);
}
}
int main(int argc, char **argv)
{
char *program = argv[0];
char *plav[2];
char problem[MAXLINE];
char *p = problem;
/* make the argument vector for Prolog */
plav[0] = program;
plav[1] = NULL;
/* initialize Prolog */
if ( !PL_initialise(1, plav) )
PL_halt(1);
/* initialize the input planning problem */
strcpy(p, argv[1]);
printf("%s\n", p);
/* Lookup solve/1 and make the arguments and call */
predicate_t pred = PL_predicate("solve", 1, "user");
term_t h0 = PL_new_term_refs(1);
int rval;
PL_put_atom_chars(h0, problem);
rval = PL_call_predicate(NULL, PL_Q_NORMAL, pred, h0);
PL_halt(rval ? 0 : 1);
return 0;
}
static PyObject* pyswipl_run(PyObject* self_Py, PyObject* args_Py) {
char* goalString;
char* answer;
int answerCount;
PyObject* answerList_Py;
PyObject* answerString_Py;
PyObject* bindingList_Py;
PyObject* binding_Py;
term_t swipl_args;
term_t swipl_goalCharList;
term_t swipl_bindingList;
term_t swipl_head;
term_t swipl_list;
predicate_t swipl_predicate;
qid_t swipl_qid;
fid_t swipl_fid;
/**********************************************************/
/* The queryString_C should be a python string represting */
/* the query to be executed on the prolog system. */
/**********************************************************/
if(!PyArg_ParseTuple(args_Py, "s", &goalString))
return NULL;
else {
/**********************************************************/
/* Create a Python list to hold the lists of bindings. */
/**********************************************************/
//if ( answerList_Py != NULL )
// Py_DECREF(answerList_Py);
answerList_Py=PyList_New(0);
/**********************************************************/
/* Open a foreign frame and initialize the term refs. */
/**********************************************************/
swipl_fid=PL_open_foreign_frame();
swipl_head=PL_new_term_ref(); /* Used in unpacking the binding List */
swipl_args=PL_new_term_refs(2); /* The compound term for arguments to run/2 */
swipl_goalCharList=swipl_args; /* Alias for arg 1 */
swipl_bindingList=swipl_args+1; /* Alias for arg 2 */
/**********************************************************/
/* Pack the query string into the argument compund term. */
/**********************************************************/
PL_put_list_chars(swipl_goalCharList,goalString);
/**********************************************************/
/* Generate a predicate to pyrun/2 */
/**********************************************************/
swipl_predicate=PL_predicate("pyrun",2,NULL);
/**********************************************************/
/* Open the query, and iterate through the solutions. */
/**********************************************************/
swipl_qid=PL_open_query(NULL,PL_Q_NORMAL,swipl_predicate, swipl_args);
while(PL_next_solution(swipl_qid)) {
/**********************************************************/
/* Create a Python list to hold the bindings. */
/**********************************************************/
bindingList_Py=PyList_New(0);
/**********************************************************/
/* Step through the bindings and add each to the list. */
/**********************************************************/
swipl_list=PL_copy_term_ref(swipl_bindingList);
while(PL_get_list(swipl_list, swipl_head, swipl_list)) {
PL_get_chars(swipl_head, &answer, CVT_ALL|CVT_WRITE|BUF_RING);
answerString_Py = PyString_FromString(answer);
PyList_Append(bindingList_Py, answerString_Py);
Py_DECREF(answerString_Py);
}
/**********************************************************/
/* Add this binding list to the list of all solutions. */
/**********************************************************/
PyList_Append(answerList_Py, bindingList_Py);
Py_DECREF(bindingList_Py);
}
/**********************************************************/
/* Free this foreign frame... */
/* Added by Nathan Denny, July 18, 2001. */
/* Fixes a bug with running out of global stack when */
/* asserting _lots_ of facts. */
/**********************************************************/
PL_close_query(swipl_qid);
PL_discard_foreign_frame(swipl_fid);
/**********************************************************/
/* Return the list of solutions. */
/**********************************************************/
return answerList_Py;
}
}
static foreign_t
uri_components(term_t URI, term_t components)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(URI, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ uri_component_ranges ranges;
term_t rt = PL_new_term_refs(6);
term_t av = rt+1;
parse_uri(&ranges, len, s);
unify_range(av+0, &ranges.scheme);
unify_range(av+1, &ranges.authority);
unify_range(av+2, &ranges.path);
unify_range(av+3, &ranges.query);
unify_range(av+4, &ranges.fragment);
return (PL_cons_functor_v(rt, FUNCTOR_uri_components5, av) &&
PL_unify(components, rt));
} else if ( PL_is_functor(components, FUNCTOR_uri_components5) )
{ charbuf b;
int rc;
init_charbuf(&b);
/* schema */
if ( (rc=get_text_arg(components, 1, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
add_charbuf(&b, ':');
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* authority */
if ( (rc=get_text_arg(components, 2, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '/');
add_charbuf(&b, '/');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* path */
if ( (rc=get_text_arg(components, 3, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* query */
if ( (rc=get_text_arg(components, 4, &len, &s, TXT_EX_TEXT)) == TRUE )
{ if ( len > 0 )
{ add_charbuf(&b, '?');
add_nchars_charbuf(&b, len, s);
}
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* fragment */
if ( (rc=get_text_arg(components, 5, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '#');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
rc = PL_unify_wchars(URI, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
} else /* generate an error */
{ return PL_get_wchars(URI, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
}
/* compile all rules */
EtalisExecTree* buildExecTree()
{
printf("--- Generating Rule Tree ...\n");
EtalisExecTree* tree = calloc(1,sizeof(EtalisExecTree));
tree->size=3; /* TODO (hafsi#4#): fixme */ /*if more than one rule, find out how many complex events*/
tree->exec=print_event;
tree->complexEvents = (EtalisExecNode*)calloc(tree->size,sizeof(EtalisExecNode));
EtalisBatch* temp_batch = (EtalisBatch*)malloc(sizeof(EtalisBatch));
int i=0;
static predicate_t p;
term_t _args_binary_event_rule = PL_new_term_refs(3);
atom_t name;
int temp_arity;
if ( !p )
p = PL_predicate("binary_event_rule", 3, NULL);
qid_t qid = PL_open_query(NULL, PL_Q_NORMAL, p, _args_binary_event_rule);
while(PL_next_solution(qid) != FALSE)
{
EtalisEventNode* temp_event = tree->complexEvents+i; /* next complex event */
EtalisExecNode* temp_operator =(EtalisExecNode*)malloc(sizeof(EtalisExecNode));
memset(temp_operator,0,sizeof(EtalisExecNode));
assert( temp_event != NULL && temp_operator != NULL);
temp_event->parentNode=NULL; /*a complex event does not have a parent*/
temp_event->childNode=temp_operator;
temp_event->trigger=_cep_print_event; /* by default, triggering a complx event would print it */
temp_operator->parentEvent=temp_event;
temp_batch->batchSize=1;
temp_batch->nodes=temp_operator;
/*get label*/
PL_get_name_arity(_args_binary_event_rule, &name, &temp_arity);
strcpy(temp_batch->label,PL_atom_chars(name));
/*get complex event*/
PL_get_name_arity(_args_binary_event_rule+1, &name, &temp_arity);
strcpy(temp_event->event.name,PL_atom_chars(name));
temp_event->event.arity = temp_arity;
/*get rule*/
construct_rule(temp_batch,_args_binary_event_rule+2);
/* init a stack for each event*/
/* query the tree in the depth */
EtalisEventNode* temp_event_index = temp_operator->leftChild;
for (temp_event_index = temp_operator->leftChild;temp_event_index->childNode != NULL;temp_event_index = temp_event_index->childNode->leftChild)
{
temp_event_index->eventStack = StackCreate();
if(temp_event_index->parentNode->op_type == binary)
temp_event_index->parentNode->rightChild->eventStack = StackCreate();
}
/* Create stack for leaf nodes*/
temp_event_index->eventStack = StackCreate();
if(temp_event_index->parentNode->op_type == binary)
temp_event_index->parentNode->rightChild->eventStack = StackCreate();
/* build argument logical models */
/*
if(temp_operator->has_condition == ETALIS_TRUE)
{
;
build_args_map(temp_operator,_args_binary_event_rule+1,_args_binary_event_rule+2);
}
else
{
build_args_map(temp_operator,_args_binary_event_rule+1,_args_binary_event_rule+2);
}
*/
/*print the rule*/ /* only if debugging */
#ifdef DEBUG
/*print_rule(temp_event);*/
#endif
/*add to event hash*/
addToEventHash(temp_operator);
i++; /*next rule*/
};
PL_close_query(qid);
/*from the rules build the tree*/
printf("--- Done!\n");
return tree;
}
/* General structure of a rule :
[Rule_Label] ComplexEvent <- CEP_Clause [WHERE_Clause] [WITHIN_Clause]
*/
void construct_rule(EtalisBatch* batch,term_t term)
{
EtalisExecNode* NodeRule = batch->nodes;
assert(NodeRule != NULL);
atom_t cep_name;
int temp_arity;
int i=0;
int LUT_Size=2;
#ifdef DEBUG
printf("--- Constructing rule: \n");
#endif
/* WITHIN Clause */
parse_within_op_(NodeRule,term); /*TODO Add a check that a within is explicitely stated in the rule */
/* WHERE Clause */
parse_where_op_(NodeRule,term);
/* CEP Clause */
term_t cep_term = PL_new_term_refs(2);
if(NodeRule->has_condition == ETALIS_TRUE)
{
term_t first_level_term = PL_new_term_refs(2);
PL_get_arg(1,term,first_level_term);
PL_get_arg(1,first_level_term,cep_term);
}
else
PL_get_arg(1,term,cep_term);
PL_get_name_arity(cep_term, &cep_name, &temp_arity);
char* aaa = PL_atom_chars(cep_name);
/* find the right CEP operator */
while(strcmp(CEP_LUT_[i].CEP_name,PL_atom_chars(cep_name)) != 0 && i<LUT_Size) i++;
NodeRule->left_exec.exec_1=CEP_LUT_[i].exec1.exec_1;
NodeRule->right_exec.exec_1=CEP_LUT_[i].exec2.exec_1;
if(i != LUT_Size) /*The operator is found in the CEP_LUT_*/
{
switch (CEP_LUT_[i].CEP_arity)
{
case 1:
NodeRule->op_type=unary;
strcpy(NodeRule->name,CEP_LUT_[i].CEP_name);
NodeRule->left_exec.exec_1=CEP_LUT_[i].exec1.exec_1;
break;
case 2:
NodeRule->op_type=binary;
strcpy(NodeRule->name,CEP_LUT_[i].CEP_name);
NodeRule->left_exec.exec_1=CEP_LUT_[i].exec1.exec_1;
NodeRule->right_exec.exec_1=CEP_LUT_[i].exec2.exec_1;
CEP_LUT_[i].parser_func(NodeRule,cep_term);
break;
default:
printf("error compiling the rules\n");
}
}
else /*no operator is found : identity operator is assumed*/
{
NodeRule->op_type=unary;
strcpy(NodeRule->name,"identity");
NodeRule->left_exec.exec_1=_cep_identity;
default_op_parser(NodeRule,cep_term);
}
/* triggering an event should execute the correct function*/ /* deprecated */
/*
NodeRule->leftChild->trigger=NodeRule->left_exec.exec_1;
if(NodeRule->op_type == binary)
NodeRule->rightChild->trigger=NodeRule->right_exec.exec_1;
*/
/* setting the tree connections between the events and the CEP operator */
NodeRule->leftChild->parentNode=NodeRule;
if(NodeRule->op_type == binary)
NodeRule->rightChild->parentNode=NodeRule;
/** Propagate the WHERE Clauses */
where_binarization(NodeRule);
}
void parse_seq_op_ (EtalisExecNode* operatorNode,term_t t)
{
assert(operatorNode != NULL);
fid_t fid = PL_open_foreign_frame();
/*get components of the operator*/
term_t _level_1 = PL_new_term_refs(2);
term_t _left_event=_level_1;
term_t _right_event=_level_1+1;
atom_t _left_event_name,_right_event_name;
int temp_arity,i=0;
/* TODO check for embedded operators, if operator -> parse right function ; else get atomic events */
PL_get_arg(1,t,_left_event);
PL_get_name_arity(_left_event,&_left_event_name,&temp_arity);
char * tt = PL_atom_chars(_left_event_name);
i=0;
while(strcmp(CEP_LUT_[i].CEP_name,PL_atom_chars(_left_event_name)) != 0 && i<LUT_Size) i++; /* #CONT */
if(i != LUT_Size) /*The operator is found in the CEP_LUT_*/ /* create a temp event */
{
EtalisEventNode* TempEvent = (EtalisEventNode*)calloc(1,sizeof(EtalisEventNode)); /* this temp event is the complex event of the embedded operation */
TempEvent->event.arity = 0;
strcpy(TempEvent->event.name,"temp_"); /* TODO Temp Events */ /* Temp Events have no arguments */
TempEvent->parentNode = operatorNode;
strcpy(TempEvent->parentNode->name,tt);
TempEvent->is_temp = ETALIS_TRUE;
operatorNode->leftChild = TempEvent;
EtalisExecNode* NewNodeRule = (EtalisExecNode*)calloc(1,sizeof(EtalisExecNode)); /* binarization and allocation of the embedded operator */
TempEvent->childNode = NewNodeRule;
NewNodeRule->parentEvent = TempEvent;
TempEvent->trigger = _seq_win_cep_l;
switch (CEP_LUT_[i].CEP_arity)
{
case 1:
break;
case 2:
/* found embedded */
CEP_LUT_[i].parser_func(NewNodeRule,_left_event);
break;
default:
printf("error compiling the rules\n");
}
}
else /* an atomic event has been found */
{
operatorNode->leftChild = (EtalisEventNode*) calloc(1,sizeof(EtalisEventNode));
PL_get_name_arity(_left_event,&_left_event_name,(int *)&((operatorNode->leftChild)->event.arity));
strcpy(operatorNode->leftChild->event.name,PL_atom_chars(_left_event_name));
operatorNode->leftChild->childNode = NULL;
operatorNode->leftChild->parentNode=operatorNode;
operatorNode->leftChild->is_temp = ETALIS_FALSE;
if (operatorNode->parentEvent->is_temp)
strcat(operatorNode->parentEvent->event.name,operatorNode->leftChild->event.name);
operatorNode->leftChild->trigger = _seq_win_cep_l;
}
PL_get_arg(2,t,_right_event);
operatorNode->rightChild = (EtalisEventNode*) calloc(1,sizeof(EtalisEventNode));
PL_get_name_arity(_right_event,&_right_event_name,(int *)&(operatorNode->rightChild->event.arity));
strcpy(operatorNode->rightChild->event.name,PL_atom_chars(_right_event_name));
operatorNode->rightChild->childNode = NULL;
operatorNode->rightChild->parentNode = operatorNode;
operatorNode->rightChild->is_temp = ETALIS_FALSE;
PL_discard_foreign_frame(fid);
if (operatorNode->parentEvent->is_temp)
{
strcat(operatorNode->parentEvent->event.name,operatorNode->rightChild->event.name);
operatorNode->rightChild->trigger = _seq_win_cep_l;
}
else /* event is latest event in the call list */
{
operatorNode->rightChild->trigger = _seq_batch_r;
}
;
}
/*
* parse a where clause and add the information into the ExecNode.
* TODO #hafsi#5#
* TODO implement a non binary, rule wide WHERE clause parser and interpreter.
*
*/
void parse_where_op_(EtalisExecNode* operatorNode, term_t t)
{
/* find out whether a where clause is used */
term_t constraints = PL_new_term_refs(3);
atom_t wheref;
int arr;
ETALIS_BOOL where_available=0;
PL_get_arg(1,t,constraints);
PL_get_name_arity(constraints,&wheref,&arr);
char* gg = (char*)malloc(sizeof(char)*256);
memset(gg,0,256);
gg = PL_atom_chars(wheref);
if(!strcmp(gg,"wheref")) where_available = ETALIS_TRUE;
if(where_available)
{
/* process where clause */
/*
A = eventClause(unlabeled, e2(_G321, _G322, _G323, _G324), withinop(wheref(seqf(a(_G321, _G322), d(_G323, _G324)), conditions), 2.0))
*/
operatorNode->whereNode =(EtalisWhereNode*)malloc(sizeof(EtalisWhereNode));
memset(operatorNode->whereNode,0,sizeof(EtalisWhereNode));
term_t _where_level_1 = PL_new_term_refs(2);
term_t rule_gut_term = _where_level_1+1;
term_t constraints_term = _where_level_1+2;
PL_get_arg(1,t,_where_level_1);
PL_get_arg(1,_where_level_1,rule_gut_term);
PL_get_arg(2,_where_level_1,constraints_term);
#ifdef DEBUG
char* testing = (char*)malloc(sizeof(char)*256);
char* args = (char*)malloc(sizeof(char)*256);
*args="\0";
memset(testing,0,256);
int size_contraints,idx=0;
PL_get_name_arity(constraints_term,NULL,&size_contraints);
termToStringVerbatim(_where_level_1,testing,args);
/*
wheref(seqf(seqf(a(_G1776),b(_G1778)),c(_G1780)),,(>(_G1776,1),<(_G1778,2)))
*/
int j=strlen(testing);
int num_=0;
for (j=strlen(testing)-2;j>0;j--)
{
if (testing[j] == ')') num_++;
if (testing[j] == '(') num_--;
/*printf("%c : %d : %d\n",testing[j],j,num_);*/
if(num_ == 0 ) break;
}
char* real_constr = testing + j ;
printf("--- WHERE Block detected | Constraints: %s \n",real_constr);
#endif
operatorNode->has_condition=ETALIS_TRUE;
}
else /* no constraints are detected */
{
/*get atomic events of the operator*/
/*
A = eventClause(unlabeled, e2(_G321, _G322, _G323, _G324), withinop(seqf(a(_G321, _G322), d(_G323, _G324)), 2.0)).
*/
operatorNode->has_condition=ETALIS_FALSE;
}
}
static HDDEDATA CALLBACK
DdeCallback(UINT type, UINT fmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
switch(type)
{ case XTYP_CONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect3, MODULE_dde);
int rval;
PL_put_atom( argv+0, hszToAtom(hsz2)); /* topic */
PL_put_atom( argv+1, hszToAtom(hsz1)); /* service */
PL_put_integer(argv+2, dwData2 ? 1 : 0); /* same instance */
rval = PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return (void *)rval;
}
case XTYP_CONNECT_CONFIRM:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
int plhandle;
if ( (plhandle = allocServerHandle(hconv)) >= 0 )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
PL_put_atom( argv+0, hszToAtom(hsz2)); /* topic */
PL_put_atom( argv+1, hszToAtom(hsz1)); /* service */
PL_put_integer(argv+2, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
}
return NULL;
}
case XTYP_DISCONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(1);
predicate_t pred = PL_pred(FUNCTOR_dde_disconnect1, MODULE_dde);
int plhandle = findServerHandle(hconv);
if ( plhandle >= 0 && plhandle < MAX_CONVERSATIONS )
server_handle[plhandle] = (HCONV)NULL;
PL_put_integer(argv+0, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return NULL;
}
case XTYP_EXECUTE:
{ int plhandle = findServerHandle(hconv);
HDDEDATA rval = DDE_FNOTPROCESSED;
fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_execute3, MODULE_dde);
DEBUG(0, Sdprintf("Got XTYP_EXECUTE request\n"));
PL_put_integer(argv+0, plhandle);
PL_put_atom( argv+1, hszToAtom(hsz1));
unify_hdata( argv+2, hData);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
rval = (void *) DDE_FACK;
PL_discard_foreign_frame(cid);
DdeFreeDataHandle(hData);
return rval;
}
case XTYP_REQUEST:
{ HDDEDATA data = (HDDEDATA) NULL;
if ( fmt == CF_TEXT )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(4);
predicate_t pred = PL_pred(FUNCTOR_dde_request4, MODULE_dde);
int plhandle = findServerHandle(hconv);
PL_put_integer( argv+0, plhandle);
PL_put_atom( argv+1, hszToAtom(hsz1)); /* topic */
PL_put_atom( argv+2, hszToAtom(hsz2)); /* item */
PL_put_variable(argv+3);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
{ char *s;
if ( PL_get_chars(argv+3, &s, CVT_ALL) )
data = DdeCreateDataHandle(ddeInst, s, strlen(s)+1,
0, hsz2, CF_TEXT, 0);
}
PL_discard_foreign_frame(cid);
}
return data;
}
default:
;
}
return (HDDEDATA)NULL;
}
static foreign_t
current_alarms(term_t time, term_t goal, term_t id, term_t status,
term_t matching)
{ Event ev;
term_t next = PL_new_term_ref();
term_t g = PL_new_term_ref();
term_t tail = PL_copy_term_ref(matching);
term_t head = PL_new_term_ref();
term_t av = PL_new_term_refs(4);
pthread_t self = pthread_self();
LOCK();
ev = TheSchedule()->first;
for(; ev; ev = ev->next)
{ atom_t s;
double at;
fid_t fid;
if ( !pthread_equal(self, ev->thread_id) )
continue;
fid = PL_open_foreign_frame();
if ( ev->flags & EV_DONE )
s = ATOM_done;
else if ( ev == TheSchedule()->scheduled )
s = ATOM_next;
else
s = ATOM_scheduled;
if ( !PL_unify_atom(status, s) )
goto nomatch;
PL_recorded(ev->goal, g);
if ( !PL_unify_term(goal,
PL_FUNCTOR, FUNCTOR_module2,
PL_ATOM, PL_module_name(ev->module),
PL_TERM, g) )
goto nomatch;
at = (double)ev->at.tv_sec + (double)ev->at.tv_usec / 1000000.0;
if ( !PL_unify_float(time, at) )
goto nomatch;
if ( !unify_timer(id, ev) )
goto nomatch;
PL_discard_foreign_frame(fid);
if ( !PL_put_float(av+0, at) || /* time */
!PL_recorded(ev->goal, av+1) || /* goal */
!PL_put_variable(av+2) || /* id */
!unify_timer(av+2, ev) ||
!PL_put_atom(av+3, s) || /* status */
!PL_cons_functor_v(next, FUNCTOR_alarm4, av) )
{ PL_close_foreign_frame(fid);
UNLOCK();
return FALSE;
}
if ( PL_unify_list(tail, head, tail) &&
PL_unify(head, next) )
{ continue;
} else
{ PL_close_foreign_frame(fid);
UNLOCK();
return FALSE;
}
nomatch:
PL_discard_foreign_frame(fid);
}
UNLOCK();
return PL_unify_nil(tail);
}
static HDDEDATA CALLBACK
DdeCallback(UINT type, UINT fmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{ GET_LD
DWORD ddeInst = LD->os.dde_instance;
switch(type)
{ case XTYP_CONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect3, MODULE_dde);
int rval;
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, dwData2 ? 1 : 0) ) /* same instance */
{ rval = PL_call_predicate(MODULE_dde, TRUE, pred, argv);
} else
{ rval = FALSE;
}
PL_discard_foreign_frame(cid);
return (void *)(intptr_t)rval;
}
case XTYP_CONNECT_CONFIRM:
{ int plhandle;
if ( (plhandle = allocServerHandle(hconv)) >= 0 )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, plhandle) )
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
}
return NULL;
}
case XTYP_DISCONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(1);
predicate_t pred = PL_pred(FUNCTOR_dde_disconnect1, MODULE_dde);
int plhandle = findServerHandle(hconv);
if ( plhandle >= 0 && plhandle < MAX_CONVERSATIONS )
server_handle[plhandle] = (HCONV)NULL;
PL_put_integer(argv+0, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return NULL;
}
case XTYP_EXECUTE:
{ int plhandle = findServerHandle(hconv);
HDDEDATA rval = DDE_FNOTPROCESSED;
fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_execute3, MODULE_dde);
DEBUG(1, Sdprintf("Got XTYP_EXECUTE request\n"));
PL_put_integer(argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1);
unify_hdata( argv+2, hData);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
rval = (void *) DDE_FACK;
PL_discard_foreign_frame(cid);
DdeFreeDataHandle(hData);
return rval;
}
case XTYP_REQUEST:
{ HDDEDATA data = (HDDEDATA) NULL;
if ( fmt == CF_UNICODETEXT )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(4);
predicate_t pred = PL_pred(FUNCTOR_dde_request4, MODULE_dde);
int plhandle = findServerHandle(hconv);
PL_put_integer( argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1); /* topic */
unify_hsz(ddeInst, argv+2, hsz2); /* item */
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
{ wchar_t *s;
size_t len;
/* TBD: error handling */
if ( PL_get_wchars(argv+3, &len, &s, CVT_ALL) )
data = DdeCreateDataHandle(ddeInst,
(unsigned char*) s,
(DWORD)(len+1)*sizeof(wchar_t),
0, hsz2, CF_UNICODETEXT, 0);
}
PL_discard_foreign_frame(cid);
}
return data;
}
default:
;
}
return (HDDEDATA)NULL;
}