static Term lineCount(int sno) {
Term tout;
/* one has to be somewhat more careful because of terminals */
if (GLOBAL_Stream[sno].status & Tty_Stream_f) {
Int no = 1;
int i;
Atom my_stream;
#if HAVE_SOCKET
if (GLOBAL_Stream[sno].status & Socket_Stream_f)
my_stream = AtomSocket;
else
#endif
if (GLOBAL_Stream[sno].status & Pipe_Stream_f)
my_stream = AtomPipe;
else if (GLOBAL_Stream[sno].status & InMemory_Stream_f)
my_stream = AtomCharsio;
else
my_stream = GLOBAL_Stream[sno].name;
for (i = 0; i < MaxStreams; i++) {
if ((GLOBAL_Stream[i].status &
(Socket_Stream_f | Pipe_Stream_f | InMemory_Stream_f)) &&
!(GLOBAL_Stream[i].status & (Free_Stream_f)) &&
GLOBAL_Stream[i].name == my_stream)
no += GLOBAL_Stream[i].linecount - 1;
}
tout = MkIntTerm(no);
} else
tout = MkIntTerm(GLOBAL_Stream[sno].linecount);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return tout;
}
static void InitThreadHandle(int wid) {
REMOTE_ThreadHandle(wid).in_use = FALSE;
REMOTE_ThreadHandle(wid).zombie = FALSE;
REMOTE_ThreadHandle(wid).local_preds = NULL;
#ifdef LOW_LEVEL_TRACER
REMOTE_ThreadHandle(wid).thread_inst_count = 0LL;
#endif
pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock), NULL);
pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock_status), NULL);
REMOTE_ThreadHandle(wid).tdetach = (CELL)0;
REMOTE_ThreadHandle(wid).cmod = (CELL)0;
{
mbox_t *mboxp = &REMOTE_ThreadHandle(wid).mbox_handle;
pthread_mutex_t *mutexp;
pthread_cond_t *condp;
struct idb_queue *msgsp;
mboxp->name = MkIntTerm(0);
condp = &mboxp->cond;
pthread_cond_init(condp, NULL);
mutexp = &mboxp->mutex;
pthread_mutex_init(mutexp, NULL);
msgsp = &mboxp->msgs;
mboxp->nmsgs = 0;
mboxp->nclients = 0;
mboxp->open = true;
Yap_init_tqueue(msgsp);
}
}
static void InitAtoms(void) {
int i;
AtomHashTableSize = MaxHash;
HashChain =
(AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
if (HashChain == NULL) {
Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0),
"allocating initial atom table");
}
for (i = 0; i < MaxHash; ++i) {
INIT_RWLOCK(HashChain[i].AERWLock);
HashChain[i].Entry = NIL;
}
NOfAtoms = 0;
#if OLD_STYLE_INITIAL_ATOMS
Yap_LookupAtomWithAddress("**", (AtomEntry *)&(SF_STORE->AtFoundVar));
Yap_ReleaseAtom(AtomFoundVar);
Yap_LookupAtomWithAddress("?", (AtomEntry *)&(SF_STORE->AtFreeTerm));
Yap_ReleaseAtom(AtomFreeTerm);
Yap_LookupAtomWithAddress("[]", (AtomEntry *)&(SF_STORE->AtNil));
Yap_LookupAtomWithAddress(".", (AtomEntry *)&(SF_STORE->AtDot));
#else
SF_STORE->AtFoundVar = Yap_LookupAtom("**");
Yap_ReleaseAtom(AtomFoundVar);
SF_STORE->AtFreeTerm = Yap_LookupAtom("?");
Yap_ReleaseAtom(AtomFreeTerm);
SF_STORE->AtNil = Yap_LookupAtom("[]");
SF_STORE->AtDot = Yap_LookupAtom(".");
#endif
}
static Int
p_thread_sleep( USES_REGS1 )
{
UInt time = IntegerOfTerm(Deref(ARG1));
#if HAVE_NANOSLEEP
UInt ntime = IntegerOfTerm(Deref(ARG2));
struct timespec req, oreq ;
req.tv_sec = time;
req.tv_nsec = ntime;
if (nanosleep(&req, &oreq)) {
#if HAVE_STRERROR
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/1", strerror(errno));
#else
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/1", errno);
#endif
return FALSE;
}
return Yap_unify(ARG3,MkIntegerTerm(oreq.tv_sec)) &&
Yap_unify(ARG4,MkIntegerTerm(oreq.tv_nsec));
#elif HAVE_SLEEP
UInt rtime;
if ((rtime = sleep(time)) < 0) {
#if HAVE_STRERROR
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "%s in thread_sleep/1", strerror(errno));
#else
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "error %d in thread_sleep/1", errno);
#endif
}
return Yap_unify(ARG3,MkIntegerTerm(rtime)) &&
Yap_unify(ARG4,MkIntTerm(0L));
#else
Yap_Error(OPERATING_SYSTEM_ERROR, ARG1, "no support for thread_sleep/1 in this YAP configuration");
#endif
}
/// @memberof between/3
static Int cont_between( USES_REGS1 )
{
Term t1 = EXTRA_CBACK_ARG(3,1);
Term t2 = EXTRA_CBACK_ARG(3,2);
Yap_unify(ARG3, t1);
if (IsIntegerTerm(t1)) {
Int i1;
Term tn;
if (t1 == t2)
cut_succeed();
i1 = IntegerOfTerm(t1);
tn = add_int(i1, 1 PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn;
HB = B->cp_h = HR;
return TRUE;
} else {
Term t[2];
Term tn;
Int cmp;
cmp = Yap_acmp(t1, t2 PASS_REGS);
if (cmp == 0)
cut_succeed();
t[0] = t1;
t[1] = MkIntTerm(1);
tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn;
HB = B->cp_h = HR;
return TRUE;
}
}
static Int p_get_depth_limit( USES_REGS1 )
{
Int d = IntOfTerm(DEPTH);
if (d % 2 == 1)
return(Yap_unify(ARG1, MkFloatTerm(INFINITY)));
return(Yap_unify_constant(ARG1, MkIntTerm(d/2)));
}
static Term
p_mod(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int mod;
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1);
if (i1 == Int_MIN && i2 == -1) {
return MkIntTerm(0);
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
mod += i2;
RINT(mod);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
break;
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
{
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0");
return Yap_gmp_mod_big_int(t1, i2);
}
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_mod_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Int stream_flags(USES_REGS1) { /* '$stream_flags'(+N,-Flags) */
Term trm;
trm = Deref(ARG1);
if (IsVarTerm(trm) || !IsIntTerm(trm))
return (FALSE);
return (Yap_unify_constant(ARG2,
MkIntTerm(GLOBAL_Stream[IntOfTerm(trm)].status)));
}
static Int file_no(int sno, Term t2 USES_REGS) {
int f = Yap_GetStreamFd(sno);
Term rc = MkIntTerm(f);
if (!IsVarTerm(t2) && !IsIntTerm(t2)) {
return false;
}
return Yap_unify_constant(t2, rc);
}
static Term
p_rem(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1);
if (i1 == Int_MIN && i2 == -1) {
return MkIntTerm(0);
}
RINT(i1%i2);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
if (IntegerOfTerm(t2) == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0");
return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_rem_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static void InitDebug(void) {
Atom At;
#if DEBUG
int i;
for (i = 1; i < 20; ++i)
GLOBAL_Option[i] = 0;
if (Yap_output_msg) {
char ch;
#if _WIN32
if (!_isatty(_fileno(stdin))) {
return;
}
#elif HAVE_ISATTY
if (!isatty(0)) {
return;
}
#endif
fprintf(stderr, "absmi address:%p\n", FunAdr(Yap_absmi));
fprintf(stderr, "Set Trace Options:\n");
fprintf(stderr, "a getch\t\tb token\t\tc Lookup\td LookupVar\ti Index\n");
fprintf(stderr, "e SetOp\t\tf compile\tg icode\t\th boot\t\tl log\n");
fprintf(stderr, "m Machine\t p parser\n");
while ((ch = putchar(getchar())) != '\n' && ch != '\r') {
if (ch >= 'a' && ch <= 'z')
GLOBAL_Option[ch - 'a' + 1] = 1;
GLOBAL_Option[ch - 'a' + 1] = 1;
}
if (GLOBAL_Option['l' - 96]) {
GLOBAL_logfile = fopen(LOGFILE, "w");
if (GLOBAL_logfile == NULL) {
fprintf(stderr, "can not open %s\n", LOGFILE);
getchar();
exit(0);
}
fprintf(stderr, "logging session to file 'logfile'\n");
#ifdef MAC
Yap_SetTextFile(LOGFILE);
lp = my_line;
curfile = Nill;
#endif
}
}
#endif
/* Set at full leash */
At = AtomLeash;
Yap_PutValue(At, MkIntTerm(15));
}
static void InitPredHash(void) {
UInt i;
PredHash = (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) *
PredHashInitialSize);
PredHashTableSize = PredHashInitialSize;
if (PredHash == NULL) {
Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0),
"allocating initial predicate hash table");
}
for (i = 0; i < PredHashTableSize; ++i) {
PredHash[i] = NULL;
}
INIT_RWLOCK(PredHashRWLock);
}
static void InitWideAtoms(void) {
int i;
WideAtomHashTableSize = MaxWideHash;
WideHashChain =
(AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxWideHash);
if (WideHashChain == NULL) {
Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0), "allocating wide atom table");
}
for (i = 0; i < MaxWideHash; ++i) {
INIT_RWLOCK(WideHashChain[i].AERWLock);
WideHashChain[i].Entry = NIL;
}
NOfWideAtoms = 0;
}
static Int
p_binary_is(void)
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
}
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(1);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,2);
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
static Int p_set_depth_limit_for_next_call( USES_REGS1 )
{
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
d = MkIntTerm(IntegerOfTerm(d)*2);
DEPTH = d;
return(TRUE);
}
static Int
peek_mem_write_stream ( USES_REGS1 )
{ /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */
Int sno = Yap_CheckStream (ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2");
Int i;
Term tf = ARG2;
CELL *HI;
const char *ptr;
if (sno < 0)
return (FALSE);
restart:
HI = HR;
#if MAY_WRITE
if (fflush(GLOBAL_Stream[sno].file) == 0) {
ptr = GLOBAL_Stream[sno].nbuf;
i = GLOBAL_Stream[sno].nsize;
}
#else
ptr = GLOBAL_Stream[sno].u.mem_string.buf;
i = GLOBAL_Stream[sno].u.mem_string.pos;
#endif
while (i > 0) {
--i;
tf = MkPairTerm(MkIntTerm(ptr[i]),tf);
if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI;
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, Yap_gcP()) ) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
i = GLOBAL_Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(GLOBAL_Stream[sno].streamlock);
goto restart;
}
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify(ARG3,tf));
}
static Int p_set_depth_limit( USES_REGS1 )
{
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
d = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
}
d = MkIntTerm(IntegerOfTerm(d)*2);
YENV[E_DEPTH] = d;
DEPTH = d;
return(TRUE);
}
static Int
p_binary_op_as_integer(void)
{ /* X is Y */
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
if (IsIntTerm(t)) {
return Yap_unify_constant(ARG2,t);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
return Yap_unify(ARG1,ARG2);
}
return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
}
return(FALSE);
}
static Term
Eval(Term t USES_REGS)
{
if (IsVarTerm(t)) {
return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
} else if (IsNumTerm(t)) {
return t;
} else if (IsAtomTerm(t)) {
ExpEntry *p;
Atom name = AtomOfTerm(t);
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
/* error */
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(0);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"atom %s in arithmetic expression",
RepAtom(name)->StrOfAE);
}
return Yap_eval_atom(p->FOfEE);
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (fun == FunctorString) {
const char *s = StringOfTerm(t);
if (s[1] == '\0')
return MkIntegerTerm(s[0]);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"string in arithmetic expression");
} else if ((Atom)fun == AtomFoundVar) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil,
"cyclic term in arithmetic expression");
} else {
Int n = ArityOfFunctor(fun);
Atom name = NameOfFunctor(fun);
ExpEntry *p;
Term t1, t2;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(n);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
}
if (p->FOfEE == op_power && p->ArityOfEE == 2) {
t2 = ArgOfTerm(2, t);
if (IsPairTerm(t2)) {
return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
}
}
*RepAppl(t) = (CELL)AtomFoundVar;
t1 = Eval(ArgOfTerm(1,t) PASS_REGS);
if (t1 == 0L) {
*RepAppl(t) = (CELL)fun;
return FALSE;
}
if (n == 1) {
*RepAppl(t) = (CELL)fun;
return Yap_eval_unary(p->FOfEE, t1);
}
t2 = Eval(ArgOfTerm(2,t) PASS_REGS);
*RepAppl(t) = (CELL)fun;
if (t2 == 0L)
return FALSE;
return Yap_eval_binary(p->FOfEE,t1,t2);
}
} /* else if (IsPairTerm(t)) */ {
if (TailOfTerm(t) != TermNil) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"string must contain a single character to be evaluated as an arithmetic expression");
}
return Eval(HeadOfTerm(t) PASS_REGS);
}
}
static Int
p_socket_bind(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
int sno;
Functor fun;
socket_info status;
int fd;
if ((sno = Yap_CheckSocketStream(t1, "socket_bind/2")) < 0) {
return (FALSE);
}
status = Yap_GetSocketStatus(sno);
fd = Yap_GetStreamFd(sno);
if (status != new_socket) {
/* ok, this should be an error, as you are trying to bind */
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_bind/2");
return(FALSE);
}
if (!IsApplTerm(t2)) {
Yap_Error(DOMAIN_ERROR_STREAM,t2,"socket_bind/2");
return(FALSE);
}
fun = FunctorOfTerm(t2);
#if HAVE_SYS_UN_H
if (fun == FunctorAfUnix || fun == FunctorAfLocal) {
struct sockaddr_un sock;
Term taddr = ArgOfTerm(1, t2);
char *s;
int len;
if (IsVarTerm(taddr)) {
Yap_Error(INSTANTIATION_ERROR,t2,"socket_bind/2");
return(FALSE);
}
if (!IsAtomTerm(taddr)) {
Yap_Error(TYPE_ERROR_ATOM,taddr,"socket_bind/2");
return(FALSE);
}
s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
sock.sun_family = AF_UNIX;
if ((len = strlen(s)) > 107) /* hit me with a broomstick */ {
Yap_Error(DOMAIN_ERROR_STREAM,taddr,"socket_bind/2");
return(FALSE);
}
sock.sun_family=AF_UNIX;
strcpy(sock.sun_path,s);
if (bind(fd,
(struct sockaddr *)(&sock),
((size_t) (((struct sockaddr_un *) 0)->sun_path) + len))
< 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind)");
#endif
return(FALSE);
}
Yap_UpdateSocketStream(sno, server_socket, af_unix);
return(TRUE);
} else
#endif
if (fun == FunctorAfInet) {
Term thost = ArgOfTerm(1, t2);
Term tport = ArgOfTerm(2, t2);
char *shost;
struct hostent *he;
struct sockaddr_in saddr;
Int port;
memset((void *)&saddr,(int) 0, sizeof(saddr));
if (IsVarTerm(thost)) {
saddr.sin_addr.s_addr = INADDR_ANY;
} else if (!IsAtomTerm(thost)) {
Yap_Error(TYPE_ERROR_ATOM,thost,"socket_bind/2");
return(FALSE);
} else {
shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
if((he=gethostbyname(shost))==NULL) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (gethostbyname: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (gethostbyname)");
#endif
return(FALSE);
}
memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length);
}
if (IsVarTerm(tport)) {
port = 0;
} else {
port = IntOfTerm(tport);
}
saddr.sin_port = htons(port);
saddr.sin_family = AF_INET;
if(bind(fd,(struct sockaddr *)&saddr, sizeof(saddr))==-1) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (bind)");
#endif
return(FALSE);
}
if (IsVarTerm(tport)) {
/* get the port number */
#if _WIN32 || defined(__MINGW32__)
int namelen;
#else
unsigned int namelen;
#endif
Term t;
if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (getsockname: %s)", strerror(socket_errno));
#else
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"socket_bind/2 (getsockname)");
#endif
return(FALSE);
}
t = MkIntTerm(ntohs(saddr.sin_port));
Yap_unify(ArgOfTermCell(2, t2),t);
}
Yap_UpdateSocketStream(sno, server_socket, af_inet);
return(TRUE);
} else
return(FALSE);
}
/**
* Syntax Error Handler
*
* @par tokptr: the sequence of tokens
* @par sno: the stream numbet
*
* Implicit arguments:
* +
*/
Term Yap_syntax_error(TokEntry *errtok, int sno) {
CACHE_REGS
Term info;
Term startline, errline, endline;
Term tf[4];
Term *tailp = tf + 3;
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokPos;
startline = MkIntegerTerm(cline);
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos);
if (LOCAL_ErrorMessage)
tf[0] = MkStringTerm(LOCAL_ErrorMessage);
else
tf[0] = MkStringTerm("");
while (tok) {
Term ts[2];
if (HR > ASP - 1024) {
errline = MkIntegerTerm(0);
endline = MkIntegerTerm(0);
/* for some reason moving this earlier confuses gcc on solaris */
HR = Hi;
break;
}
if (tok->TokPos != cline) {
*tailp = MkPairTerm(TermNewLine, TermNil);
tailp = RepPair(*tailp) + 1;
cline = tok->TokPos;
}
if (tok == errtok && tok->Tok != Error_tok) {
*tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil);
tailp = RepPair(*tailp) + 1;
}
info = tok->TokInfo;
switch (tok->Tok) {
case Name_tok: {
Term t0[1];
if (info) {
t0[0] = MkAtomTerm((Atom)info);
} else {
t0[0] = TermNil;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case QuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case WQuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
break;
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
} break;
case String_tok: {
Term t0 =
Yap_CharsToTDQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case BQString_tok: {
Term t0 =
Yap_CharsToTBQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WBQString_tok: {
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, CurrentModule PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case Error_tok: {
ts[0] = MkAtomTerm(AtomError);
} break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
break;
case Ponctuation_tok: {
char s[2];
s[1] = '\0';
if ((info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
tok = tok->TokNext;
if (!tok)
break;
*tailp = MkPairTerm(ts[0], TermNil);
tailp = RepPair(*tailp) + 1;
}
{
Term t[3];
t[0] = startline;
t[1] = errline;
t[2] = endline;
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t);
}
/* 0: id */
/* 1: strat, error, end line */
/*2 msg */
/* file */
tf[2] = Yap_StreamUserName(sno);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
Term terr = Yap_MkApplTerm(FunctorSyntaxError, 4, tf);
Term tn[2];
tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &terr);
tn[1] = TermNil;
terr = Yap_MkApplTerm(FunctorError, 2, tn);
#if DEBUG
if (Yap_ExecutionMode == YAP_BOOT_MODE) {
fprintf(stderr, "SYNTAX ERROR while booting: ");
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
}
static Term
syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
{
CACHE_REGS
Term info;
int count = 0, out = 0;
Int start, err = 0, end;
Term tf[7];
Term *error = tf+3;
CELL *Hi = H;
/* make sure to globalise variable */
start = tokptr->TokPos;
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
while (1) {
Term ts[2];
if (H > ASP-1024) {
tf[3] = TermNil;
err = 0;
end = 0;
/* for some reason moving this earlier confuses gcc on solaris */
H = Hi;
break;
}
if (tokptr == LOCAL_toktide) {
err = tokptr->TokPos;
out = count;
}
info = tokptr->TokInfo;
switch (tokptr->Tok) {
case Name_tok:
{
Term t0[1];
t0[0] = MkAtomTerm((Atom)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0);
}
break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo));
break;
case Var_tok:
{
Term t[3];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_StringToList(varinfo->VarRep);
if (varinfo->VarAdr == TermNil) {
t[2] = varinfo->VarAdr = MkVarTerm();
} else {
t[2] = varinfo->VarAdr;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar,3),3,t);
}
break;
case String_tok:
{
Term t0 = Yap_StringToList((char *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok:
{
Term t0 = Yap_WideStringToList((wchar_t *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case Error_tok:
case eot_tok:
break;
case Ponctuation_tok:
{
char s[2];
s[1] = '\0';
if (Ord (info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
if (tokptr->Tok == Ord (eot_tok)) {
*error = TermNil;
end = tokptr->TokPos;
break;
} else if (tokptr->Tok != Ord (Error_tok)) {
ts[1] = MkIntegerTerm(tokptr->TokPos);
*error =
MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil);
error = RepPair(*error)+1;
count++;
}
tokptr = tokptr->TokNext;
}
/* now we can throw away tokens, so we can unify and possibly overwrite TR */
Yap_unify(*outp, MkVarTerm());
if (IsVarTerm(*outp) && (VarOfTerm(*outp) > H || VarOfTerm(*outp) < H0)) {
tf[0] = Yap_MkNewApplTerm(Yap_MkFunctor(AtomRead,1),1);
} else {
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,outp);
}
{
Term t[3];
t[0] = MkIntegerTerm(start);
t[1] = MkIntegerTerm(err);
t[2] = MkIntegerTerm(end);
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t);
}
tf[2] = MkAtomTerm(AtomHERE);
tf[4] = MkIntegerTerm(out);
tf[5] = MkIntegerTerm(err);
tf[6] = StreamName(st);
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
}
static Int p_get_depth_limit( USES_REGS1 )
{
return(Yap_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
}