int
query_loop(atom_t goal, int loop)
{ GET_LD
int rc;
int clear_stacks = (LD->query == NULL);
do
{ fid_t fid;
qid_t qid = 0;
term_t except = 0;
predicate_t p;
if ( !resetProlog(clear_stacks) )
goto error;
if ( !(fid = PL_open_foreign_frame()) )
goto error;
p = PL_pred(PL_new_functor(goal, 0), MODULE_system);
if ( (qid = PL_open_query(MODULE_system, PL_Q_NORMAL, p, 0)) )
{ rc = PL_next_solution(qid);
} else
{ error:
except = exception_term;
rc = FALSE; /* Won't get any better */
break;
}
if ( !rc && (except = PL_exception(qid)) )
{ atom_t a;
tracemode(FALSE, NULL);
debugmode(DBG_OFF, NULL);
setPrologFlagMask(PLFLAG_LASTCALL);
if ( PL_get_atom(except, &a) && a == ATOM_aborted )
{
#ifdef O_DEBUGGER
callEventHook(PLEV_ABORT);
#endif
printMessage(ATOM_informational, PL_ATOM, ATOM_aborted);
}
}
if ( qid ) PL_close_query(qid);
if ( fid ) PL_discard_foreign_frame(fid);
if ( !except )
break;
} while(loop);
return rc;
}
int
query_loop(atom_t goal, int loop)
{ GET_LD
int rc;
int clear_stacks = (LD->query == NULL);
do
{ fid_t fid;
qid_t qid = 0;
term_t except = 0;
predicate_t p;
if ( !resetProlog(clear_stacks) )
goto error;
if ( !(fid = PL_open_foreign_frame()) )
goto error;
p = PL_pred(PL_new_functor(goal, 0), MODULE_system);
if ( (qid = PL_open_query(MODULE_system, PL_Q_NORMAL, p, 0)) )
{ rc = PL_next_solution(qid);
} else
{ error:
except = exception_term;
rc = -1; /* Won't get any better */
break;
}
if ( !rc && (except = PL_exception(qid)) )
{ restore_after_exception(except);
rc = -1;
}
if ( qid ) PL_close_query(qid);
if ( fid ) PL_discard_foreign_frame(fid);
if ( !except )
break;
} while(loop);
return rc;
}
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 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;
}
