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; }