void Yap_ConsoleOps(StreamDesc *s) {
/* the putc routine only has to check it is putting out a newline */
s->stream_putc = ConsolePutc;
s->stream_getc = ConsoleGetc;
#if USE_READLINE
/* if a tty have a special routine to call readline */
if ((s->status & Readline_Stream_f) && trueGlobalPrologFlag(READLINE_FLAG)) {
if (Yap_ReadlineOps(s))
return;
}
#endif
}
int Yap_GetCharForSIGINT(void) {
CACHE_REGS
int ch;
#if USE_READLINE
if (trueGlobalPrologFlag(READLINE_FLAG) ||
(ch = Yap_ReadlineForSIGINT()) == 0)
#endif
{ /* ask for a new line */
fprintf(stderr, "Action (h for help): ");
ch = getc(stdin);
/* first process up to end of line */
while ((fgetc(stdin)) != '\n')
;
}
LOCAL_newline = TRUE;
return ch;
}
/* fe is supposed to be locked */
Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) {
PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p));
if (p == NULL) {
WRITE_UNLOCK(fe->FRWLock);
return NULL;
}
if (cur_mod == TermProlog || cur_mod == 0L) {
p->ModuleOfPred = 0L;
} else
p->ModuleOfPred = cur_mod;
// TRUE_FUNC_WRITE_LOCK(fe);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = fe->ArityOfFE;
p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
p->cs.p_code.NOfClauses = 0;
p->PredFlags = 0L;
p->src.OwnerFile = Yap_source_file_name();
p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
p->TimeStampOfPred = 0L;
p->LastCallOfPred = LUCALL_ASSERT;
if (cur_mod == TermProlog)
p->ModuleOfPred = 0L;
else
p->ModuleOfPred = cur_mod;
Yap_NewModulePred(cur_mod, p);
#ifdef TABLING
p->TableOfPred = NULL;
#endif /* TABLING */
#ifdef BEAM
p->beamTable = NULL;
#endif /* BEAM */
/* careful that they don't cross MkFunctor */
if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) {
p->PredFlags |= NoTracePredFlag;
}
p->FunctorOfPred = fe;
if (fe->PropsOfFE) {
UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
WRITE_LOCK(PredHashRWLock);
if (10 * (PredsInHashTable + 1) > 6 * PredHashTableSize) {
if (!ExpandPredHash()) {
Yap_FreeCodeSpace((ADDR)p);
WRITE_UNLOCK(PredHashRWLock);
FUNC_WRITE_UNLOCK(fe);
return NULL;
}
/* retry hashing */
hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
}
PredsInHashTable++;
if (p->ModuleOfPred == 0L) {
PredEntry *pe = RepPredProp(fe->PropsOfFE);
hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize);
/* should be the first one */
pe->NextPredOfHash = PredHash[hsh];
PredHash[hsh] = pe;
fe->PropsOfFE = AbsPredProp(p);
p->NextOfPE = AbsPredProp(pe);
} else {
p->NextPredOfHash = PredHash[hsh];
PredHash[hsh] = p;
p->NextOfPE = fe->PropsOfFE->NextOfPE;
fe->PropsOfFE->NextOfPE = AbsPredProp(p);
}
WRITE_UNLOCK(PredHashRWLock);
} else {
fe->PropsOfFE = AbsPredProp(p);
p->NextOfPE = NIL;
}
FUNC_WRITE_UNLOCK(fe);
{
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p,
GPROF_NEW_PRED_FUNC);
if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode),
&(p->cs.p_code.ExpandCode) + 1, p,
GPROF_NEW_PRED_FUNC);
}
}
return AbsPredProp(p);
}
static int OpDec(int p, const char *type, Atom a, Term m) {
int i;
AtomEntry *ae = RepAtom(a);
OpEntry *info;
#if defined(MODULE_INDEPENDENT_OPERATORS_FLAG)
if (booleanFlag(MODULE_INDEPENDENT_OPERATORS_FLAG)) {
m = PROLOG_MODULE;
} else
#endif
{
if (m == TermProlog)
m = PROLOG_MODULE;
else if (m == USER_MODULE)
m = PROLOG_MODULE;
}
for (i = 1; i <= 7; ++i)
if (strcmp(type, optypes[i]) == 0)
break;
if (i > 7) {
Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER, MkAtomTerm(Yap_LookupAtom(type)),
"op/3");
return (FALSE);
}
if (p) {
if (i == 1 || i == 2 || i == 4)
p |= DcrlpFlag;
if (i == 1 || i == 3 || i == 6)
p |= DcrrpFlag;
}
WRITE_LOCK(ae->ARWLock);
info = Yap_GetOpPropForAModuleHavingALock(ae, m);
if (EndOfPAEntr(info)) {
ModEntry *me;
info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
if (!info)
return false;
info->KindOfPE = Ord(OpProperty);
info->NextForME = (me = Yap_GetModuleEntry(m))->OpForME;
me->OpForME = info;
info->OpModule = m;
info->OpName = a;
// LOCK(OpListLock);
info->OpNext = OpList;
OpList = info;
// UNLOCK(OpListLock);
AddPropToAtom(ae, (PropEntry *)info);
INIT_RWLOCK(info->OpRWLock);
WRITE_LOCK(info->OpRWLock);
WRITE_UNLOCK(ae->ARWLock);
info->Prefix = info->Infix = info->Posfix = 0;
} else {
WRITE_LOCK(info->OpRWLock);
WRITE_UNLOCK(ae->ARWLock);
}
if (i <= 3) {
if (trueGlobalPrologFlag(ISO_FLAG) &&
info->Posfix != 0) /* there is a posfix operator */ {
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR, MkAtomTerm(a), "op/3");
return false;
}
info->Infix = p;
} else if (i <= 5) {
if (trueGlobalPrologFlag(ISO_FLAG) &&
info->Infix != 0) /* there is an infix operator */ {
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR, MkAtomTerm(a), "op/3");
return false;
}
info->Posfix = p;
} else {
info->Prefix = p;
}
WRITE_UNLOCK(info->OpRWLock);
return true;
}