/************************* * 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; }
/******************** * swi_set_trace ********************/ int swi_set_trace(int state) { predicate_t pred = PL_predicate(state ? "trace" : "notrace", 0, NULL); return PL_call_predicate(NULL, PL_Q_NORMAL, pred, 0); }
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); }
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; }
static bool clearSourceAdmin(SourceFile sf) { GET_LD int rc = FALSE; fid_t fid = PL_open_foreign_frame(); term_t name = PL_new_term_ref(); static predicate_t pred = NULL; if ( !pred ) pred = PL_predicate("$clear_source_admin", 1, "system"); PL_put_atom(name, sf->name); rc = PL_call_predicate(MODULE_system, PL_Q_NORMAL, pred, name); PL_discard_foreign_frame(fid); return rc; }
/************************* * 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 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; }
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 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; }
static void on_alarm(int sig) { Event ev; schedule *sched = TheSchedule(); pthread_t self = pthread_self(); DEBUG(1, Sdprintf("Signal received in %d\n", PL_thread_self())); #ifdef BACKTRACE DEBUG(10, print_trace()); #endif for(;;) { struct timeval now; term_t goal = 0; module_t module = NULL; gettimeofday(&now, NULL); LOCK(); for(ev = sched->first; ev; ev=ev->next) { struct timeval left; assert(ev->magic == EV_MAGIC); if ( (ev->flags & (EV_DONE|EV_FIRED)) || !pthread_equal(self, ev->thread_id) ) continue; left.tv_sec = ev->at.tv_sec - now.tv_sec; left.tv_usec = ev->at.tv_usec - now.tv_usec; if ( left.tv_usec < 0 ) { left.tv_sec--; left.tv_usec += 1000000; } if ( left.tv_sec < 0 || (left.tv_sec == 0 && left.tv_usec == 0) ) { DEBUG(1, Sdprintf("Calling event\n")); ev->flags |= EV_DONE; module = ev->module; goal = PL_new_term_ref(); PL_recorded(ev->goal, goal); if ( ev->flags & EV_REMOVE ) freeEvent(ev); break; } } UNLOCK(); if ( goal ) { PL_call_predicate(module, PL_Q_PASS_EXCEPTION, PREDICATE_call1, goal); } else break; } DEBUG(1, Sdprintf("Processed pending events; signalling scheduler\n")); pthread_cond_signal(&cond); }