Esempio n. 1
0
static void
call_prolog_goal(prolog_goal *g)
{ fid_t fid;
  static predicate_t pred = NULL;
  int rc;

  if ( !pred )
    pred = PL_predicate("call", 1, "user");

  if ( (fid = PL_open_foreign_frame()) )
  { term_t t = PL_new_term_ref();
    term_t vars;
    rc = PL_recorded(g->goal, t);
    PL_erase(g->goal);
    g->goal = 0;
    g->state = G_RUNNING;
    if ( rc )
    { qid_t qid;
      int flags = PL_Q_NORMAL;

      if ( g->acknowledge )
      { flags |= PL_Q_CATCH_EXCEPTION;
	vars = PL_new_term_ref();
	if ( !PL_get_arg(2, t, vars) ||		/* Goal-Vars */
	     !PL_get_arg(1, t, t) )
	{ PL_warning("ERROR: in_pce_thread: bad goal-vars term");
	}
      } else
      { vars = 0;
      }

      if ( (qid = PL_open_query(g->module, flags, pred, t)) )
      { rc = PL_next_solution(qid);

	if ( rc )
	{ g->state = G_TRUE;
	  if ( vars )
	    g->result = PL_record(vars);
	} else
	{ term_t ex;

	  if ( g->acknowledge && (ex=PL_exception(qid)) )
	  { g->result = PL_record(ex);
	    g->state = G_ERROR;
	  } else
	  { g->state = G_FALSE;
	  }
	}

	PL_cut_query(qid);
      } else
	PL_warning("ERROR: pce: out of global stack");
    }
    PL_discard_foreign_frame(fid);
  } else
    PL_warning("ERROR: pce: out of global stack");
}
Esempio n. 2
0
static int
set_term(record_t *r, term_t t)
{ if ( *r )
    PL_erase(*r);
  *r = PL_record(t);

  return TRUE;
}
Esempio n. 3
0
static int
init_prolog_goal(prolog_goal *g, term_t goal, int acknowledge)
{ term_t plain = PL_new_term_ref();

  g->module	 = NULL;
  g->acknowledge = acknowledge;
  g->state       = G_WAITING;
  if ( !PL_strip_module(goal, &g->module, plain) )
    return FALSE;
  if ( !(PL_is_compound(plain) || PL_is_atom(plain)) )
    return type_error(goal, "callable");
  g->goal = PL_record(plain);

  return TRUE;
}
Esempio n. 4
0
foreign_t add_handler(term_t server, term_t msg, term_t types, term_t goal)
{
	my_server_thread s;
	lo_method method;
	char	*pattern, *typespec;
	char	buffer[256]; // !! space for up to 255 arguments
	int	rc;

	rc = get_server(server,&s) 
		&& get_msg(msg,&pattern) 
		&& get_types(types,buffer,256,&typespec);

	if (rc) {
		record_t goal_record=PL_record(goal);
		method = lo_server_add_method(s->s, pattern, typespec, prolog_handler, (void *)goal_record);
	} 
	return rc;
}
Esempio n. 5
0
static foreign_t
alarm4_gen(time_abs_rel abs_rel, term_t time, term_t callable,
	   term_t id, term_t options)
{ Event ev;
  double t;
  module_t m = NULL;
  unsigned long flags = 0L;

  if ( options )
  { term_t tail = PL_copy_term_ref(options);
    term_t head = PL_new_term_ref();

    while( PL_get_list(tail, head, tail) )
    { atom_t name;
      int arity;

      if ( PL_get_name_arity(head, &name, &arity) )
      { if ( arity == 1 )
	{ term_t arg = PL_new_term_ref();

	  _PL_get_arg(1, head, arg);

	  if ( name == ATOM_remove )
	  { int t = FALSE;

	    if ( !pl_get_bool_ex(arg, &t) )
	      return FALSE;
	    if ( t )
	      flags |= EV_REMOVE;
	  } else if ( name == ATOM_install )
	  { int t = TRUE;

	    if ( !pl_get_bool_ex(arg, &t) )
	      return FALSE;
	    if ( !t )
	      flags |= EV_NOINSTALL;
	  }
	}
      }
    }
    if ( !PL_get_nil(tail) )
      return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 4, options, "list");
  }

  if ( !PL_get_float(time, &t) )
    return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
		    time, "number");


  if ( !(ev = allocEvent()) )
    return FALSE;

  if (abs_rel==TIME_REL)
	  setTimeEvent(ev, t);
  else
	  setTimeEventAbs(ev,t);

  if ( !unify_timer(id, ev) )
  { freeEvent(ev);			/* not linked: no need to lock */
    return FALSE;
  }

  ev->flags = flags;
  PL_strip_module(callable, &m, callable);
  ev->module = m;
  ev->goal = PL_record(callable);

  if ( !(ev->flags & EV_NOINSTALL) )
  { int rc;

    if ( (rc=installEvent(ev)) != TRUE )
    { freeEvent(ev);			/* not linked: no need to lock */
      return alarm_error(id, rc);
    }
  }

  return TRUE;
}