int Yap_SWIHandleError(const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
if (s) {
serr = (char *)s;
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, serr);
return (FALSE);
}
return TRUE;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
}
return true;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(false, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return false;
}
default:
Yap_Error(err, TermNil, serr);
return false;
}
}
bool Yap_HandleError__(const char *file, const char *function, int lineno,
const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
const char *serr;
arity_t arity = 2;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = s;
}
if (P != FAILCODE) {
if (P->opc == Yap_opcode(_try_c) || P->opc == Yap_opcode(_try_userc) ||
P->opc == Yap_opcode(_retry_c) || P->opc == Yap_opcode(_retry_userc)) {
arity = P->y_u.OtapFs.p->ArityOfPE;
} else {
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
}
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(arity, ENV, gc_P(P, CP))) {
Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_STACK, ARG1,
serr);
return false;
}
LOCAL_PrologMode = UserMode;
return true;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK,
ARG1, serr);
return false;
}
LOCAL_PrologMode = UserMode;
return true;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_HEAP, ARG2,
serr);
return false;
}
default:
if (LOCAL_PrologMode == UserMode)
Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr);
else
LOCAL_PrologMode &= ~InErrorMode;
return false;
}
}
static char *Yap_AlwaysAllocCodeSpace(UInt size) {
char *out;
while (!(out = Yap_AllocCodeSpace(size))) {
if (!Yap_growheap(FALSE, size, NULL)) {
return NULL;
}
}
return out;
}
int
Yap_OpenBufWriteStream( USES_REGS1 )
{
char *nbuf;
size_t sz = Yap_page_size;
while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return -1;
}
}
return Yap_open_buf_write_stream(nbuf, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0);
}
static Int
open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */
{
Term t, ti;
int sno;
Int sl = 0, nchars = 0;
char *nbuf;
ti = Deref(ARG1);
while (ti != TermNil) {
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
return (FALSE);
} else if (!IsPairTerm(ti)) {
Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
return (FALSE);
} else {
sl++;
ti = TailOfTerm(ti);
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
}
ti = Deref(ARG1);
while (ti != TermNil) {
Term ts = HeadOfTerm(ti);
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
return (FALSE);
} else if (!IsIntTerm(ts)) {
Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
return (FALSE);
}
nbuf[nchars++] = IntOfTerm(ts);
ti = TailOfTerm(ti);
}
nbuf[nchars] = '\0';
sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE);
t = Yap_MkStream (sno);
return (Yap_unify (ARG2, t));
}
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
ADDR
Yap_InitPreAllocCodeSpace(void)
{
char *ptr;
UInt sz = ScratchPad.msz;
if (ScratchPad.ptr == NULL) {
#if USE_DL_MALLOC
LOCK(DLMallocLock);
#endif
Yap_PrologMode |= MallocMode;
#if INSTRUMENT_MALLOC
mallocs++;
tmalloc += sz;
sz += sizeof(CELL);
#endif
while (!(ptr = my_malloc(sz))) {
Yap_PrologMode &= ~MallocMode;
#if USE_DL_MALLOC
UNLOCK(DLMallocLock);
#endif
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(NULL);
}
#if INSTRUMENT_MALLOC
sz -= sizeof(CELL);
*(CELL*)ptr = sz;
ptr += sizeof(CELL);
#endif
#if USE_DL_MALLOC
LOCK(DLMallocLock);
#endif
Yap_PrologMode |= MallocMode;
}
Yap_PrologMode &= ~MallocMode;
#if USE_DL_MALLOC
UNLOCK(DLMallocLock);
#endif
ScratchPad.ptr = ptr;
} else {
ptr = ScratchPad.ptr;
}
AuxBase = (ADDR)(ptr);
AuxSp = (CELL *)(AuxTop = AuxBase+ScratchPad.sz);
return ptr;
}
static char * my_realloc(char *ptr, UInt sz, UInt osz, int safe)
{
char *nptr;
restart:
/* simple case */
if (ptr < Yap_HeapBase || ptr > HeapTop) {
/* we have enough room */
nptr = Yap_dlmalloc(sz);
if (nptr) {
memmove(nptr, ptr, osz);
free(ptr);
}
} else {
nptr = Yap_dlrealloc(ptr, sz);
}
if (nptr) {
return nptr;
}
/* we do not have enough room */
if (safe) {
if (Yap_growheap(FALSE, sz, NULL)) {
/* now, we have room */
goto restart;
}
}
/* no room in Heap, gosh */
if (ptr < Yap_HeapBase || ptr > HeapTop) {
/* try expanding outside the heap */
nptr = realloc(ptr, sz);
if (nptr) {
memmove(nptr, ptr, osz);
}
} else {
/* try calling the outside world for help */
nptr = malloc(sz);
if (!nptr)
return NULL;
memmove(nptr, ptr, osz);
Yap_dlfree(ptr);
}
/* did we suceed? at this point we could not care less */
return nptr;
}
/* mask a hash table that allows for fast reverse translation from
instruction address to corresponding opcode */
static void
InitReverseLookupOpcode(void)
{
op_entry *opeptr;
op_numbers i;
/* 2 K should be OK */
int hash_size_mask = OP_HASH_SIZE-1;
UInt sz = OP_HASH_SIZE*sizeof(struct opcode_tab_entry);
while (OP_RTABLE == NULL) {
if ((OP_RTABLE = (op_entry *)Yap_AllocCodeSpace(sz)) == NULL) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"Couldn't obtain space for the reverse translation opcode table");
}
}
}
memset(OP_RTABLE, 0, sz);
opeptr = OP_RTABLE;
/* clear up table */
{
int j;
for (j=0; j<OP_HASH_SIZE; j++) {
opeptr[j].opc = 0;
opeptr[j].opnum = _Ystop;
}
}
opeptr = OP_RTABLE;
opeptr[rtable_hash_op(Yap_opcode(_Ystop),hash_size_mask)].opc
= Yap_opcode(_Ystop);
/* now place entries */
for (i = _std_top; i > _Ystop; i--) {
OPCODE opc = Yap_opcode(i);
int j = rtable_hash_op(opc,hash_size_mask);
while (opeptr[j].opc) {
if (++j > hash_size_mask)
j = 0;
}
/* clear entry, no conflict */
opeptr[j].opnum = i;
opeptr[j].opc = opc;
}
}
int Yap_SWIHandleError( const char *s, ... )
{
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = (char *)s;
}
switch (err) {
case OUT_OF_STACK_ERROR:
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
return(FALSE);
}
return TRUE;
case OUT_OF_AUXSPACE_ERROR:
if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
return FALSE;
}
return TRUE;
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return(FALSE);
}
}
bool Yap_HandleError__(const char *file, const char *function, int lineno,
const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
const char *serr;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = s;
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error__(file, function, lineno, RESOURCE_ERROR_STACK, ARG1, serr);
return false;
}
return true;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error__(file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK, ARG1,
serr);
return false;
}
return true;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error__(file, function, lineno, RESOURCE_ERROR_HEAP, ARG2, serr);
return false;
}
default:
Yap_Error__(file, function, lineno, err, TermNil, serr);
return false;
}
}
void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Start, CPredicate Cont, CPredicate Cut,
pred_flags_t flags) {
CACHE_REGS
PredEntry *pe = NULL;
Atom atom = NIL;
Functor f = NULL;
while (atom == NIL) {
atom = Yap_FullLookupAtom(Name);
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (Arity) {
while (!f) {
f = Yap_MkFunctor(atom, Arity);
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
}
while (pe == NULL) {
if (Arity)
pe = RepPredProp(PredPropByFunc(f, CurrentModule));
else
pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (pe->cs.p_code.FirstClause != NIL) {
flags = update_flags_from_prolog(flags, pe);
CleanBack(pe, Start, Cont, Cut);
} else {
StaticClause *cl;
yamop *code = ((StaticClause *)NULL)->ClCode;
UInt sz =
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code, OtapFs), OtapFs), OtapFs), l);
if (flags & UserCPredFlag)
pe->PredFlags = UserCPredFlag | BackCPredFlag | CompiledPredFlag | flags;
else
pe->PredFlags = CompiledPredFlag | StandardPredFlag | BackCPredFlag;
#ifdef YAPOR
pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
if (cl == NULL) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitCPredBack");
return;
}
cl->ClFlags = StaticMask;
cl->ClNext = NULL;
Yap_ClauseSpace += sz;
cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code, OtapFs), OtapFs), OtapFs), e);
cl->usc.ClLine = Yap_source_line_no();
code = cl->ClCode;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = pe->cs.p_code.FirstClause =
pe->cs.p_code.LastClause = code;
if (flags & UserCPredFlag)
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
else
pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
code->y_u.OtapFs.f = Start;
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.s = Arity;
code->y_u.OtapFs.extra = Extra;
#ifdef YAPOR
INIT_YAMOP_LTT(code, 2);
PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
code = NEXTOP(code, OtapFs);
if (flags & UserCPredFlag)
code->opc = Yap_opcode(_retry_userc);
else
code->opc = Yap_opcode(_retry_c);
code->y_u.OtapFs.f = Cont;
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.s = Arity;
code->y_u.OtapFs.extra = Extra;
#ifdef YAPOR
INIT_YAMOP_LTT(code, 1);
PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
code = NEXTOP(code, OtapFs);
if (flags & UserCPredFlag)
code->opc = Yap_opcode(_cut_userc);
else
code->opc = Yap_opcode(_cut_c);
code->y_u.OtapFs.f = Cut;
code->y_u.OtapFs.p = pe;
code->y_u.OtapFs.s = Arity;
code->y_u.OtapFs.extra = Extra;
code = NEXTOP(code, OtapFs);
code->opc = Yap_opcode(_Ystop);
code->y_u.l.l = cl->ClCode;
}
}
void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def,
pred_flags_t flags) {
CACHE_REGS
Atom atom = NIL;
PredEntry *pe = NULL;
Functor f = NULL;
while (atom == NIL) {
atom = Yap_FullLookupAtom(Name);
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (Arity) {
while (!f) {
f = Yap_MkFunctor(atom, Arity);
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
}
while (pe == NULL) {
if (Arity)
pe = RepPredProp(PredPropByFunc(f, CurrentModule));
else
pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
flags |= AsmPredFlag | StandardPredFlag | (code);
if (pe->PredFlags & AsmPredFlag) {
flags = update_flags_from_prolog(flags, pe);
/* already exists */
}
pe->PredFlags = flags;
pe->cs.f_code = def;
pe->ModuleOfPred = CurrentModule;
if (def != NULL) {
yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl;
if (pe->CodeOfPred == (yamop *)(&(pe->OpcodeOfPred))) {
if (flags & SafePredFlag) {
cl = (StaticClause *)Yap_AllocCodeSpace(
(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l));
} else {
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(
NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), p),
l));
}
if (!cl) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitAsmPred");
return;
}
Yap_ClauseSpace +=
(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l);
} else {
cl = ClauseCodeToStaticClause(pe->CodeOfPred);
}
cl->ClFlags = StaticMask;
cl->ClNext = NULL;
if (flags & SafePredFlag) {
cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), e), e);
} else {
cl->ClSize = (CELL)NEXTOP(
NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), e), e);
}
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
pe->CodeOfPred = p_code;
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_allocate);
p_code = NEXTOP(p_code, e);
}
p_code->opc = Yap_opcode(_call_cpred);
p_code->y_u.Osbpp.bmap = NULL;
p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
p_code = NEXTOP(p_code, Osbpp);
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_deallocate);
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code, p);
}
p_code->opc = Yap_opcode(_procceed);
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code, p);
p_code->opc = Yap_opcode(_Ystop);
p_code->y_u.l.l = cl->ClCode;
pe->OpcodeOfPred = pe->CodeOfPred->opc;
} else {
pe->OpcodeOfPred = Yap_opcode(_undef_p);
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
}
}
void Yap_InitCmpPred(const char *Name, arity_t Arity, CmpPredicate cmp_code,
pred_flags_t flags) {
CACHE_REGS
Atom atom = NIL;
PredEntry *pe = NULL;
yamop *p_code = NULL;
StaticClause *cl = NULL;
Functor f = NULL;
while (atom == NIL) {
atom = Yap_FullLookupAtom(Name);
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (Arity) {
while (!f) {
f = Yap_MkFunctor(atom, Arity);
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
}
while (pe == NULL) {
if (Arity)
pe = RepPredProp(PredPropByFunc(f, CurrentModule));
else
pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (pe->PredFlags & BinaryPredFlag) {
flags = update_flags_from_prolog(flags, pe);
p_code = pe->CodeOfPred;
/* already exists */
} else {
while (!cl) {
UInt sz = sizeof(StaticClause) +
(CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL), plxxs), p), l);
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
if (!cl) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s",
Name);
return;
}
} else {
Yap_ClauseSpace += sz;
cl->ClFlags = StaticMask | StandardPredFlag;
cl->ClNext = NULL;
cl->ClSize = sz;
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
break;
}
}
}
// pe->PredFlags = flags | StandardPredFlag;
pe->CodeOfPred = p_code;
pe->cs.d_code = cmp_code;
pe->ModuleOfPred = CurrentModule;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
p_code->y_u.plxxs.p = pe;
p_code->y_u.plxxs.f = FAILCODE;
p_code->y_u.plxxs.x1 = Yap_emit_x(1);
p_code->y_u.plxxs.x2 = Yap_emit_x(2);
p_code->y_u.plxxs.flags = Yap_compile_cmp_flags(pe);
p_code = NEXTOP(p_code, plxxs);
p_code->opc = Yap_opcode(_procceed);
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code, p);
p_code->opc = Yap_opcode(_Ystop);
p_code->y_u.l.l = cl->ClCode;
}
void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code,
pred_flags_t flags) {
CACHE_REGS
Atom atom = NIL;
PredEntry *pe = NULL;
yamop *p_code;
StaticClause *cl = NULL;
Functor f = NULL;
while (atom == NIL) {
if (flags & UserCPredFlag)
atom = Yap_LookupAtom(Name);
else
atom = Yap_FullLookupAtom(Name);
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (Arity) {
while (!f) {
f = Yap_MkFunctor(atom, Arity);
if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
}
while (pe == NULL) {
if (Arity)
pe = RepPredProp(PredPropByFunc(f, CurrentModule));
else
pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
}
if (pe->PredFlags & CPredFlag) {
/* already exists */
flags = update_flags_from_prolog(flags, pe);
cl = ClauseCodeToStaticClause(pe->CodeOfPred);
if ((flags | StandardPredFlag | CPredFlag) != pe->PredFlags) {
Yap_ClauseSpace -= cl->ClSize;
Yap_FreeCodeSpace((ADDR)cl);
cl = NULL;
}
}
p_code = cl->ClCode;
while (!cl) {
UInt sz;
if (flags & SafePredFlag) {
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code, Osbpp), p), l);
} else {
sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code, e), p), Osbpp), p),
l);
}
cl = (StaticClause *)Yap_AllocCodeSpace(sz);
if (!cl) {
if (!Yap_growheap(FALSE, sz, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
return;
}
} else {
Yap_ClauseSpace += sz;
cl->ClFlags = StaticMask;
cl->ClNext = NULL;
cl->ClSize = sz;
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
}
}
pe->CodeOfPred = p_code;
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
pe->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
pe->cs.f_code = code;
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_allocate);
p_code = NEXTOP(p_code, e);
}
if (flags & UserCPredFlag)
p_code->opc = Yap_opcode(_call_usercpred);
else
p_code->opc = Yap_opcode(_call_cpred);
p_code->y_u.Osbpp.bmap = NULL;
p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
p_code = NEXTOP(p_code, Osbpp);
if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_deallocate);
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code, p);
}
p_code->opc = Yap_opcode(_procceed);
p_code->y_u.p.p = pe;
p_code = NEXTOP(p_code, p);
p_code->opc = Yap_opcode(_Ystop);
p_code->y_u.l.l = cl->ClCode;
pe->OpcodeOfPred = pe->CodeOfPred->opc;
}
