示例#1
0
文件: events.c 项目: sspider/etalis
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;
}
示例#2
0
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;
}
示例#3
0
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;
}
示例#5
0
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;
}
示例#6
0
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;
}
示例#7
0
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;
}
示例#8
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);
}
示例#9
0
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));
}
示例#10
0
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;
}
示例#11
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;
}
示例#12
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);
}
示例#13
0
文件: events.c 项目: sspider/etalis
/* 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;
}
示例#15
0
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;
}
示例#16
0
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;
}
示例#17
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;
}
示例#18
0
// ######################################################################
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;
}
示例#19
0
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);
  }
}
示例#20
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;
}
示例#21
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;	
	}
}
示例#22
0
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);
  }
}
示例#23
0
文件: events.c 项目: sspider/etalis
/* 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;
}
示例#24
0
文件: events.c 项目: sspider/etalis
/* 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);


}
示例#25
0
文件: events.c 项目: sspider/etalis
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;
    }




    ;
}
示例#26
0
文件: events.c 项目: sspider/etalis
/*
 * 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;
}
示例#28
0
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);
}
示例#29
0
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;
}