changes to support extended foreign interface (include slots, new exception
handling for C-code, and several fixes to calling foreign code). git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@470 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
5bad222cfa
commit
86e4a99d73
36
C/absmi.c
36
C/absmi.c
@ -332,6 +332,13 @@ absmi(int inp)
|
||||
#endif /* OS_HANDLES_TR_OVERFLOW */
|
||||
|
||||
BOp(Ystop, e);
|
||||
if (Y > (CELL *) B) {
|
||||
ASP = (CELL *) B;
|
||||
}
|
||||
else {
|
||||
ASP = Y;
|
||||
}
|
||||
*--ASP = MkIntTerm(0);
|
||||
saveregs();
|
||||
#if PUSH_REGS
|
||||
restore_absmi_regs(old_regs);
|
||||
@ -343,6 +350,13 @@ absmi(int inp)
|
||||
ENDBOp();
|
||||
|
||||
BOp(Nstop, e);
|
||||
if (Y > (CELL *) B) {
|
||||
ASP = (CELL *) B;
|
||||
}
|
||||
else {
|
||||
ASP = Y;
|
||||
}
|
||||
*--ASP = MkIntTerm(0);
|
||||
saveregs();
|
||||
#if PUSH_REGS
|
||||
restore_absmi_regs(old_regs);
|
||||
@ -5730,6 +5744,8 @@ absmi(int inp)
|
||||
else {
|
||||
ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
|
||||
}
|
||||
/* for slots to work */
|
||||
*--ASP = MkIntTerm(0);
|
||||
#endif /* FROZEN_STACKS */
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
if (do_low_level_trace)
|
||||
@ -7843,11 +7859,6 @@ absmi(int inp)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
pt0 = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
|
||||
DelayedB = pt0;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
@ -7896,11 +7907,6 @@ absmi(int inp)
|
||||
#else
|
||||
pt1 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt1)) {
|
||||
pt1 = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(pt1,DelayedB))
|
||||
DelayedB = pt1;
|
||||
}
|
||||
if (SHOULD_CUT_UP_TO(B,pt1)) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
#ifdef YAPOR
|
||||
@ -11660,11 +11666,6 @@ absmi(int inp)
|
||||
choiceptr pt0;
|
||||
|
||||
pt0 = (choiceptr)(ENV[E_CB]);
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
pt0 = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
|
||||
DelayedB = pt0;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
#ifdef YAPOR
|
||||
@ -11801,11 +11802,6 @@ absmi(int inp)
|
||||
choiceptr pt0;
|
||||
|
||||
pt0 = (choiceptr)(ENV[E_CB]);
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
pt0 = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
|
||||
DelayedB = pt0;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
#ifdef YAPOR
|
||||
|
||||
141
C/c_interface.c
141
C/c_interface.c
@ -59,6 +59,7 @@ X_API Atom STD_PROTO(YapLookupAtom,(char *));
|
||||
X_API Atom STD_PROTO(YapFullLookupAtom,(char *));
|
||||
X_API char *STD_PROTO(YapAtomName,(Atom));
|
||||
X_API Term STD_PROTO(YapMkPairTerm,(Term,Term));
|
||||
X_API Term STD_PROTO(YapMkNewPairTerm,(void));
|
||||
X_API Term STD_PROTO(YapHeadOfTerm,(Term));
|
||||
X_API Term STD_PROTO(YapTailOfTerm,(Term));
|
||||
X_API Term STD_PROTO(YapMkApplTerm,(Functor,unsigned int,Term *));
|
||||
@ -87,7 +88,9 @@ X_API Term STD_PROTO(YapBufferToAtomList, (char *));
|
||||
X_API void STD_PROTO(YapError,(char *));
|
||||
X_API int STD_PROTO(YapRunGoal,(Term));
|
||||
X_API int STD_PROTO(YapRestartGoal,(void));
|
||||
X_API int STD_PROTO(YapGoalHasException,(Term *));
|
||||
X_API int STD_PROTO(YapContinueGoal,(void));
|
||||
X_API void STD_PROTO(YapPruneGoal,(void));
|
||||
X_API void STD_PROTO(YapInitConsult,(int, char *));
|
||||
X_API void STD_PROTO(YapEndConsult,(void));
|
||||
X_API Term STD_PROTO(YapRead, (int (*)(void)));
|
||||
@ -102,7 +105,10 @@ X_API void STD_PROTO(YapSetOutputMessage, (void));
|
||||
X_API int STD_PROTO(YapStreamToFileNo, (Term));
|
||||
X_API void STD_PROTO(YapCloseAllOpenStreams,(void));
|
||||
X_API Term STD_PROTO(YapOpenStream,(void *, char *, Term, int));
|
||||
X_API Term *STD_PROTO(YapNewSlots,(int));
|
||||
X_API long STD_PROTO(YapNewSlots,(int));
|
||||
X_API Term STD_PROTO(YapGetFromSlot,(long));
|
||||
X_API Term *STD_PROTO(YapAddressFromSlot,(long));
|
||||
X_API void STD_PROTO(YapPutInSlot,(long, Term));
|
||||
X_API void STD_PROTO(YapRecoverSlots,(int));
|
||||
X_API void STD_PROTO(YapThrow,(Term));
|
||||
X_API int STD_PROTO(YapLookupModule,(Term));
|
||||
@ -111,6 +117,20 @@ X_API void STD_PROTO(YapHalt,(int));
|
||||
X_API Term *STD_PROTO(YapTopOfLocalStack,(void));
|
||||
X_API void *STD_PROTO(YapPredicate,(Atom,Int,Int));
|
||||
X_API void STD_PROTO(YapPredicateInfo,(void *,Atom *,Int *,Int *));
|
||||
X_API Int STD_PROTO(YapCurrentModule,(void));
|
||||
|
||||
static int (*do_getf)(void);
|
||||
|
||||
static int do_yap_getc(int streamno) {
|
||||
return(do_getf());
|
||||
}
|
||||
|
||||
static void (*do_putcf)(int);
|
||||
|
||||
static int do_yap_putc(int streamno,int ch) {
|
||||
do_putcf(ch);
|
||||
return(ch);
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YapA(int i)
|
||||
@ -270,6 +290,18 @@ YapMkPairTerm(Term t1, Term t2)
|
||||
return(t);
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YapMkNewPairTerm()
|
||||
{
|
||||
Term t;
|
||||
BACKUP_H();
|
||||
|
||||
t = MkNewPairTerm();
|
||||
|
||||
RECOVER_H();
|
||||
return(t);
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YapHeadOfTerm(Term t)
|
||||
{
|
||||
@ -398,10 +430,19 @@ X_API Int
|
||||
YapCallProlog(Term t)
|
||||
{
|
||||
Int out;
|
||||
SMALLUNSGN mod = CurrentModule;
|
||||
BACKUP_MACHINE_REGS();
|
||||
|
||||
out = execute_goal(t, 0, CurrentModule);
|
||||
|
||||
while (!IsVarTerm(t) &&
|
||||
IsApplTerm(t) &&
|
||||
FunctorOfTerm(t) == FunctorModule) {
|
||||
Term tmod = ArgOfTerm(1,t);
|
||||
if (IsVarTerm(tmod)) return(FALSE);
|
||||
if (!IsAtomTerm(tmod)) return(FALSE);
|
||||
mod = LookupModule(tmod);
|
||||
t = ArgOfTerm(2,t);
|
||||
}
|
||||
out = execute_goal(t, 0, mod);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return(out);
|
||||
}
|
||||
@ -504,14 +545,23 @@ YapError(char *buf)
|
||||
Error(SYSTEM_ERROR,TermNil,buf);
|
||||
}
|
||||
|
||||
static void myputc (int ch)
|
||||
{
|
||||
putc(ch,stderr);
|
||||
}
|
||||
|
||||
static Term told;
|
||||
static int counter=0;
|
||||
|
||||
X_API int
|
||||
YapRunGoal(Term t)
|
||||
{
|
||||
int out;
|
||||
BACKUP_MACHINE_REGS();
|
||||
|
||||
InitYaamRegs();
|
||||
do_putcf = myputc;
|
||||
out = RunTopGoal(t);
|
||||
told = t;
|
||||
|
||||
RECOVER_MACHINE_REGS();
|
||||
return(out);
|
||||
@ -524,7 +574,12 @@ YapRestartGoal(void)
|
||||
BACKUP_MACHINE_REGS();
|
||||
|
||||
P = (yamop *)FAILCODE;
|
||||
do_putcf = myputc;
|
||||
out = exec_absmi(TRUE);
|
||||
if (out == FALSE) {
|
||||
/* cleanup */
|
||||
trust_last();
|
||||
}
|
||||
|
||||
RECOVER_MACHINE_REGS();
|
||||
return(out);
|
||||
@ -542,6 +597,31 @@ YapContinueGoal(void)
|
||||
return(out);
|
||||
}
|
||||
|
||||
X_API void
|
||||
YapPruneGoal(void)
|
||||
{
|
||||
BACKUP_B();
|
||||
|
||||
while (B->cp_ap != NOCODE) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
|
||||
RECOVER_B();
|
||||
}
|
||||
|
||||
X_API int
|
||||
YapGoalHasException(Term *t)
|
||||
{
|
||||
int out = FALSE;
|
||||
BACKUP_MACHINE_REGS();
|
||||
if (EX) {
|
||||
*t = EX;
|
||||
out = TRUE;
|
||||
}
|
||||
RECOVER_MACHINE_REGS();
|
||||
return(out);
|
||||
}
|
||||
|
||||
X_API void
|
||||
YapInitConsult(int mode, char *filename)
|
||||
{
|
||||
@ -565,12 +645,6 @@ YapEndConsult(void)
|
||||
RECOVER_MACHINE_REGS();
|
||||
}
|
||||
|
||||
static int (*do_getf)(void);
|
||||
|
||||
static int do_yap_getc(int streamno) {
|
||||
return(do_getf());
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YapRead(int (*mygetc)(void))
|
||||
{
|
||||
@ -595,13 +669,6 @@ YapRead(int (*mygetc)(void))
|
||||
return(t);
|
||||
}
|
||||
|
||||
static void (*do_putcf)(int);
|
||||
|
||||
static int do_yap_putc(int streamno,int ch) {
|
||||
do_putcf(ch);
|
||||
return(ch);
|
||||
}
|
||||
|
||||
X_API void
|
||||
YapWrite(Term t, void (*myputc)(int), int flags)
|
||||
{
|
||||
@ -847,19 +914,43 @@ YapOpenStream(void *fh, char *name, Term nm, int flags)
|
||||
return retv;
|
||||
}
|
||||
|
||||
X_API Term *
|
||||
X_API long
|
||||
YapNewSlots(int n)
|
||||
{
|
||||
Term *slot;
|
||||
ASP -= n;
|
||||
slot = ASP;
|
||||
return(slot);
|
||||
Int old_slots = IntOfTerm(ASP[0]), oldn = n;
|
||||
while (n > 0) {
|
||||
RESET_VARIABLE(ASP);
|
||||
ASP--;
|
||||
n--;
|
||||
}
|
||||
ASP[0] = MkIntTerm(old_slots+oldn);
|
||||
return((ASP+1)-LCL0);
|
||||
}
|
||||
|
||||
X_API void
|
||||
YapRecoverSlots(int n)
|
||||
{
|
||||
Int old_slots = IntOfTerm(ASP[0]);
|
||||
ASP += n;
|
||||
ASP[0] = MkIntTerm(old_slots-n);
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YapGetFromSlot(long slot)
|
||||
{
|
||||
return(Deref(LCL0[slot]));
|
||||
}
|
||||
|
||||
X_API Term *
|
||||
YapAddressFromSlot(long slot)
|
||||
{
|
||||
return(LCL0+slot);
|
||||
}
|
||||
|
||||
X_API void
|
||||
YapPutInSlot(long slot, Term t)
|
||||
{
|
||||
LCL0[slot] = t;
|
||||
}
|
||||
|
||||
X_API void
|
||||
@ -918,3 +1009,9 @@ YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m)
|
||||
}
|
||||
*m = pd->ModuleOfPred;
|
||||
}
|
||||
|
||||
X_API Int
|
||||
YapCurrentModule(void)
|
||||
{
|
||||
return(CurrentModule);
|
||||
}
|
||||
|
||||
@ -3287,8 +3287,8 @@ MyEraseClause(Clause *clau)
|
||||
}
|
||||
if ( P == clau->ClCode) {
|
||||
yamop *nextto;
|
||||
P = (yamop *)(RTRYCODE);
|
||||
nextto = (yamop *)RTRYCODE;
|
||||
P = RTRYCODE;
|
||||
nextto = RTRYCODE;
|
||||
nextto->u.ld.d = clau->ClCode->u.ld.d;
|
||||
nextto->u.ld.s = clau->ClCode->u.ld.s;
|
||||
nextto->u.ld.p = clau->ClCode->u.ld.p;
|
||||
@ -3305,7 +3305,7 @@ MyEraseClause(Clause *clau)
|
||||
if (DBREF_IN_USE(ref))
|
||||
return;
|
||||
if ( P == clau->ClCode ) {
|
||||
yamop *np = (yamop *)RTRYCODE;
|
||||
yamop *np = RTRYCODE;
|
||||
/* make it the next alternative */
|
||||
np->u.ld.d = (CODEADDR)find_next_clause((DBRef)(NEXTOP(P,ld)->u.sla.l2));
|
||||
if (np->u.ld.d == NULL)
|
||||
|
||||
175
C/exec.c
175
C/exec.c
@ -229,8 +229,8 @@ do_execute(Term t, SMALLUNSGN mod)
|
||||
if (pen->PredFlags & MetaPredFlag) {
|
||||
if (f == FunctorModule) {
|
||||
Term tmod = ArgOfTerm(1,t);
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) &&
|
||||
mod == LookupModule(tmod)) {
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||||
mod = LookupModule(tmod);
|
||||
t = ArgOfTerm(2,t);
|
||||
goto restart_exec;
|
||||
}
|
||||
@ -337,8 +337,8 @@ p_execute_within(void)
|
||||
if (pen->PredFlags & MetaPredFlag) {
|
||||
if (f == FunctorModule) {
|
||||
Term tmod = ArgOfTerm(1,t);
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) &&
|
||||
mod == LookupModule(tmod)) {
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||||
mod = LookupModule(tmod);
|
||||
t = ArgOfTerm(2,t);
|
||||
goto restart_exec;
|
||||
}
|
||||
@ -371,11 +371,6 @@ p_execute_within(void)
|
||||
if (a == AtomTrue || a == AtomOtherwise)
|
||||
return(TRUE);
|
||||
else if (a == AtomCut) {
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,cut_pt)) {
|
||||
cut_pt = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(cut_pt,DelayedB))
|
||||
DelayedB = cut_pt;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
|
||||
#ifdef YAPOR
|
||||
@ -470,11 +465,6 @@ p_execute_within2(void)
|
||||
choiceptr pt0;
|
||||
|
||||
pt0 = (choiceptr)(ENV[E_CB]);
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
pt0 = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
|
||||
DelayedB = pt0;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
#ifdef YAPOR
|
||||
@ -796,8 +786,8 @@ p_at_execute(void)
|
||||
return(FALSE);
|
||||
if (f == FunctorModule) {
|
||||
Term tmod = ArgOfTerm(1,t);
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) &&
|
||||
mod == LookupModule(tmod)) {
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||||
mod = LookupModule(tmod);
|
||||
t = ArgOfTerm(2,t);
|
||||
goto restart_exec;
|
||||
}
|
||||
@ -880,6 +870,7 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
|
||||
/* create an initial pseudo environment so that when garbage
|
||||
collection is going up in the environment chain it doesn't get
|
||||
confused */
|
||||
EX = 0L;
|
||||
YENV = ASP;
|
||||
YENV[E_CP] = (CELL)P;
|
||||
YENV[E_CB] = (CELL)B;
|
||||
@ -890,15 +881,8 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
|
||||
ENV = YENV;
|
||||
ASP -= EnvSizeInCells;
|
||||
/* and now create a pseudo choicepoint for much the same reasons */
|
||||
CP = (yamop *) YESCODE;
|
||||
/* this is an hack to save the arguments */
|
||||
{
|
||||
CELL *pt1 = XREGS+1+args_to_save;
|
||||
|
||||
while (pt1 > XREGS+1)
|
||||
*--ASP = *--pt1;
|
||||
}
|
||||
*--ASP = MkIntTerm(args_to_save+1);
|
||||
/* CP = YESCODE; */
|
||||
/* keep a place where you can inform you had an exception */
|
||||
{
|
||||
int i;
|
||||
for (i = 0; i < arity; i++) {
|
||||
@ -915,7 +899,7 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
|
||||
B->cp_h = H;
|
||||
B->cp_tr = TR;
|
||||
B->cp_cp = CP;
|
||||
B->cp_ap = (yamop *) NOCODE;
|
||||
B->cp_ap = NOCODE;
|
||||
B->cp_env = ENV;
|
||||
B->cp_b = saved_b;
|
||||
#ifdef DEPTH_LIMIT
|
||||
@ -935,7 +919,6 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
|
||||
YENV[E_CB] = Unsigned (B);
|
||||
P = (yamop *) CodeAdr;
|
||||
S = CellPtr (RepPredProp (PredPropByFunc (MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
|
||||
TopB = B;
|
||||
|
||||
return(exec_absmi(top));
|
||||
}
|
||||
@ -953,14 +936,8 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
|
||||
/* preserve the current restart environment */
|
||||
/* visualc*/
|
||||
/* just keep the difference because of possible garbage collections */
|
||||
Int MyOldTopB = LCL0-(CELL *)TopB;
|
||||
Int MyOldDelayedB = LCL0-(CELL *)DelayedB;
|
||||
choiceptr OldTopB, OldDelayedB;
|
||||
|
||||
|
||||
DelayedB = NULL;
|
||||
/* forget we have a DelayedB to do, this is not a problem for the embedded computation to solve */
|
||||
|
||||
saved_p = P;
|
||||
saved_cp = CP;
|
||||
|
||||
@ -1015,105 +992,32 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
|
||||
#endif /* TABLING */
|
||||
/* find out where we have the old arguments */
|
||||
old_B = ((choiceptr)(ENV-(EnvSizeInCells+nargs+1)))-1;
|
||||
{
|
||||
int i;
|
||||
for (i=1; i<= nargs; i++) {
|
||||
#if MIN_ARRAY == 0
|
||||
XREGS[i] = old_B->cp_args[i];
|
||||
#else
|
||||
XREGS[i] = old_B->cp_last.cp_args[i];
|
||||
#endif
|
||||
}
|
||||
}
|
||||
CP = saved_cp;
|
||||
P = saved_p;
|
||||
ASP = ENV;
|
||||
ENV = (CELL *)(ENV[E_E]);
|
||||
*--ASP = MkIntTerm(0);
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH= ENV[E_DEPTH];
|
||||
#endif
|
||||
ENV = (CELL *)(ENV[E_E]);
|
||||
/* we have failed, and usually we would backtrack to this B,
|
||||
trouble is, we may also have a delayed cut to do */
|
||||
OldTopB = (choiceptr)(LCL0-MyOldTopB);
|
||||
OldDelayedB = (choiceptr)(LCL0-MyOldDelayedB);
|
||||
if (DelayedB != NULL) {
|
||||
if (YOUNGER_CP(B,DelayedB)) {
|
||||
/* we have a delayed cut to do */
|
||||
if (YOUNGER_CP(OldTopB,DelayedB)) {
|
||||
/* and this delayed cut is to before the c-code that actually called us */
|
||||
B = OldTopB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
/* did we have a cut which was cutting more than our current cut? */
|
||||
if (OldDelayedB != NULL && YOUNGER_CP(DelayedB,OldDelayedB))
|
||||
DelayedB = OldDelayedB;
|
||||
} else {
|
||||
/* just cut back to where we should cut */
|
||||
B = DelayedB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
DelayedB = OldDelayedB;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
DelayedB = OldDelayedB;
|
||||
}
|
||||
TopB = OldTopB;
|
||||
HB = B->cp_h;
|
||||
if (B != NULL)
|
||||
HB = B->cp_h;
|
||||
YENV = ENV;
|
||||
return(TRUE);
|
||||
} else if (out == 0) {
|
||||
ASP = B->cp_env;
|
||||
{
|
||||
int i;
|
||||
for (i=1; i<= nargs; i++) {
|
||||
#if MIN_ARRAY==0
|
||||
XREGS[i] = B->cp_args[i];
|
||||
#else
|
||||
XREGS[i] = B->cp_last.cp_args[i];
|
||||
#endif
|
||||
}
|
||||
}
|
||||
P = saved_p;
|
||||
CP = saved_cp;
|
||||
H = B->cp_h;
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH= B->cp_depth;
|
||||
#endif
|
||||
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
|
||||
YENV= ASP = B->cp_env;
|
||||
ENV = (CELL *)((B->cp_env)[E_E]);
|
||||
B = B->cp_b;
|
||||
SET_BB(B);
|
||||
/* we have failed, and usually we would backtrack to this B,
|
||||
trouble is, we may also have a delayed cut to do */
|
||||
OldTopB = (choiceptr)(LCL0-MyOldTopB);
|
||||
OldDelayedB = (choiceptr)(LCL0-MyOldDelayedB);
|
||||
if (DelayedB != NULL) {
|
||||
if (YOUNGER_CP(B,DelayedB)) {
|
||||
/* we have a delayed cut to do */
|
||||
if (YOUNGER_CP(OldTopB,DelayedB)) {
|
||||
/* and this delayed cut is to before the c-code that actually called us */
|
||||
B = OldTopB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
/* did we have a cut which was cutting more than our current cut? */
|
||||
if (OldDelayedB != NULL && YOUNGER_CP(DelayedB,OldDelayedB))
|
||||
DelayedB = OldDelayedB;
|
||||
} else {
|
||||
/* just cut back to where we should cut */
|
||||
B = DelayedB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
DelayedB = OldDelayedB;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
DelayedB = OldDelayedB;
|
||||
}
|
||||
TopB = OldTopB;
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
return(FALSE);
|
||||
} else {
|
||||
@ -1122,6 +1026,25 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
trust_last(void)
|
||||
{
|
||||
ASP = B->cp_env;
|
||||
P = (yamop *)(B->cp_env[E_CP]);
|
||||
CP = B->cp_cp;
|
||||
H = B->cp_h;
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH= B->cp_depth;
|
||||
#endif
|
||||
YENV= ASP = B->cp_env;
|
||||
ENV = (CELL *)((B->cp_env)[E_E]);
|
||||
B = B->cp_b;
|
||||
if (B) {
|
||||
SET_BB(B);
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
}
|
||||
|
||||
int
|
||||
RunTopGoal(Term t)
|
||||
{
|
||||
@ -1130,7 +1053,9 @@ RunTopGoal(Term t)
|
||||
PredEntry *ppe;
|
||||
CELL *pt;
|
||||
UInt arity;
|
||||
SMALLUNSGN mod = CurrentModule;
|
||||
|
||||
restart_runtopgoal:
|
||||
if (IsAtomTerm(t)) {
|
||||
Atom a = AtomOfTerm(t);
|
||||
pt = NULL;
|
||||
@ -1143,6 +1068,14 @@ RunTopGoal(Term t)
|
||||
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
||||
return(FALSE);
|
||||
}
|
||||
if (f == FunctorModule) {
|
||||
Term tmod = ArgOfTerm(1,t);
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||||
mod = LookupModule(tmod);
|
||||
t = ArgOfTerm(2,t);
|
||||
goto restart_runtopgoal;
|
||||
}
|
||||
}
|
||||
/* I cannot use the standard macro here because
|
||||
otherwise I would dereference the argument and
|
||||
might skip a svar */
|
||||
@ -1168,7 +1101,6 @@ RunTopGoal(Term t)
|
||||
return(FALSE);
|
||||
}
|
||||
CodeAdr = ppe->CodeOfPred;
|
||||
READ_UNLOCK(ppe->PRWLock);
|
||||
if (TrailTop - HeapTop < 2048) {
|
||||
PrologMode = BootMode;
|
||||
Error(SYSTEM_ERROR,TermNil,
|
||||
@ -1238,11 +1170,6 @@ p_restore_regs2(void)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
if (DelayedB == NULL || YOUNGER_CP(DelayedB,pt0))
|
||||
DelayedB = pt0;
|
||||
pt0 = TopB;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (pt0 > B) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
@ -1287,16 +1214,18 @@ JumpToEnv(Term t) {
|
||||
while (B != NULL && B->cp_ap != pos) {
|
||||
/* we are already doing a catch */
|
||||
if (B->cp_ap == (yamop *)(PredHandleThrow->LastClause)) {
|
||||
if (DelayedB == NULL || YOUNGER_CP(B,DelayedB))
|
||||
DelayedB = B;
|
||||
P = (yamop *)FAILCODE;
|
||||
if (first_func != NULL) {
|
||||
B = first_func;
|
||||
}
|
||||
return(FALSE);
|
||||
}
|
||||
if (B->cp_ap == (yamop *) NOCODE && first_func == NULL)
|
||||
first_func = B;
|
||||
if (B->cp_ap == NOCODE) {
|
||||
/* up to the C-code to deal with this! */
|
||||
B->cp_h = H;
|
||||
EX = t;
|
||||
return(FALSE);
|
||||
}
|
||||
B = B->cp_b;
|
||||
}
|
||||
/* uncaught throw */
|
||||
@ -1322,8 +1251,6 @@ JumpToEnv(Term t) {
|
||||
/* I could backtrack here, but it is easier to leave the unwinding
|
||||
to the emulator */
|
||||
B->cp_a3 = t;
|
||||
if (DelayedB == NULL || YOUNGER_CP(B,DelayedB))
|
||||
DelayedB = B;
|
||||
P = (yamop *)FAILCODE;
|
||||
if (first_func != NULL) {
|
||||
B = first_func;
|
||||
|
||||
8
C/grow.c
8
C/grow.c
@ -120,10 +120,6 @@ SetHeapRegs(void)
|
||||
H = PtoGloAdjust(H);
|
||||
HB = PtoGloAdjust(HB);
|
||||
B = ChoicePtrAdjust(B);
|
||||
if (TopB != NULL)
|
||||
TopB = ChoicePtrAdjust(TopB);
|
||||
if (DelayedB != NULL)
|
||||
DelayedB = ChoicePtrAdjust(DelayedB);
|
||||
#ifdef TABLING
|
||||
B_FZ = ChoicePtrAdjust(B_FZ);
|
||||
BB = ChoicePtrAdjust(BB);
|
||||
@ -168,10 +164,6 @@ SetStackRegs(void)
|
||||
ASP = PtoLocAdjust(ASP);
|
||||
LCL0 = PtoLocAdjust(LCL0);
|
||||
B = ChoicePtrAdjust(B);
|
||||
if (TopB != NULL)
|
||||
TopB = ChoicePtrAdjust(TopB);
|
||||
if (DelayedB != NULL)
|
||||
DelayedB = ChoicePtrAdjust(DelayedB);
|
||||
#ifdef TABLING
|
||||
B_FZ = ChoicePtrAdjust(B_FZ);
|
||||
BB = ChoicePtrAdjust(BB);
|
||||
|
||||
50
C/heapgc.c
50
C/heapgc.c
@ -1307,6 +1307,18 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
#endif
|
||||
|
||||
|
||||
static void
|
||||
mark_slots(CELL *ptr)
|
||||
{
|
||||
Int ns = IntOfTerm(*ptr);
|
||||
ptr++;
|
||||
while (ns > 0) {
|
||||
mark_external_reference(ptr);
|
||||
ptr++;
|
||||
ns--;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
{
|
||||
@ -1452,9 +1464,9 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
/* extended choice point */
|
||||
switch (opnum) {
|
||||
case _Nstop:
|
||||
mark_slots(gc_B->cp_env);
|
||||
if (gc_B->cp_b != NULL) {
|
||||
|
||||
nargs = IntOfTerm(gc_B->cp_a1);
|
||||
nargs = 0;
|
||||
break;
|
||||
} else {
|
||||
/* this is the last choice point, the work is done ;-) */
|
||||
@ -1977,6 +1989,25 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
sweep_slots(CELL *ptr)
|
||||
{
|
||||
Int ns = IntOfTerm(*ptr);
|
||||
ptr++;
|
||||
while (ns > 0) {
|
||||
CELL cp_cell = *ptr;
|
||||
if (MARKED(cp_cell)) {
|
||||
UNMARK(ptr);
|
||||
if (HEAP_PTR(cp_cell)) {
|
||||
into_relocation_chain(ptr, GET_NEXT(cp_cell));
|
||||
}
|
||||
}
|
||||
ptr++;
|
||||
ns--;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* insert cells of each choicepoint & its chain of environments which point
|
||||
* to heap objects into relocation chains
|
||||
@ -2021,21 +2052,8 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
sweep_environments(gc_B->cp_env,
|
||||
EnvSizeInCells,
|
||||
NULL);
|
||||
sweep_slots(gc_B->cp_env);
|
||||
if (gc_B->cp_b != NULL) {
|
||||
register CELL_PTR saved_reg;
|
||||
|
||||
/* for each saved register */
|
||||
for (saved_reg = &gc_B->cp_a1;
|
||||
saved_reg < &gc_B->cp_a1 + IntOfTerm(gc_B->cp_a1);
|
||||
saved_reg++) {
|
||||
CELL cp_cell = *saved_reg;
|
||||
if (MARKED(cp_cell)) {
|
||||
UNMARK(saved_reg);
|
||||
if (HEAP_PTR(cp_cell)) {
|
||||
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
} else
|
||||
return;
|
||||
|
||||
13
C/init.c
13
C/init.c
@ -809,16 +809,11 @@ InitCodes(void)
|
||||
heap_regs->env_for_yes_code.s = -Signed(RealEnvSize);
|
||||
heap_regs->env_for_yes_code.l = NULL;
|
||||
heap_regs->env_for_yes_code.l2 = NULL;
|
||||
heap_regs->yescode = opcode(_Ystop);
|
||||
heap_regs->yescode.opc = opcode(_Ystop);
|
||||
heap_regs->undef_op = opcode(_undef_p);
|
||||
heap_regs->index_op = opcode(_index_pred);
|
||||
|
||||
#ifdef YAPOR
|
||||
heap_regs->nocode.opc = opcode(_Nstop);
|
||||
INIT_YAMOP_LTT(&(heap_regs->nocode), 1);
|
||||
#else
|
||||
heap_regs->nocode = opcode(_Nstop);
|
||||
#endif /* YAPOR */
|
||||
|
||||
((yamop *)(&heap_regs->rtrycode))->opc = opcode(_retry_and_mark);
|
||||
((yamop *)(&heap_regs->rtrycode))->u.ld.s = 0;
|
||||
@ -1089,7 +1084,7 @@ InitYaamRegs(void)
|
||||
*must* be created since for the garbage collector to work */
|
||||
B = NULL;
|
||||
ENV = NULL;
|
||||
P = CP = (yamop *)YESCODE;
|
||||
P = CP = YESCODE;
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH = RESET_DEPTH();
|
||||
#endif
|
||||
@ -1103,7 +1098,9 @@ InitYaamRegs(void)
|
||||
TR = TR_FZ = TR_BASE;
|
||||
#endif /* FROZEN_STACKS */
|
||||
CreepFlag = CalculateStackGap();
|
||||
|
||||
EX = 0L;
|
||||
/* for slots to work */
|
||||
*--ASP = MkIntTerm(0);
|
||||
}
|
||||
|
||||
|
||||
|
||||
19
C/iopreds.c
19
C/iopreds.c
@ -2661,6 +2661,12 @@ static Int
|
||||
p_write (void)
|
||||
{ /* '$write'(+Flags,?Term) */
|
||||
plwrite (ARG2, Stream[c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG1)));
|
||||
if (EX != 0L) {
|
||||
Term ball = EX;
|
||||
EX = 0L;
|
||||
JumpToEnv(ball);
|
||||
return(FALSE);
|
||||
}
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
@ -2675,6 +2681,12 @@ p_write2 (void)
|
||||
}
|
||||
plwrite (ARG3, Stream[c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG2)));
|
||||
c_output_stream = old_output_stream;
|
||||
if (EX != 0L) {
|
||||
Term ball = EX;
|
||||
EX = 0L;
|
||||
JumpToEnv(ball);
|
||||
return(FALSE);
|
||||
}
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
@ -4239,6 +4251,13 @@ format(Term tail, Term args, int sno)
|
||||
arghd = HeadOfTerm (args);
|
||||
args = TailOfTerm (args);
|
||||
plwrite (arghd, format_putc, (int) 12);
|
||||
if (EX != 0L) {
|
||||
Term ball = EX;
|
||||
EX = 0L;
|
||||
FreeAtomSpace(format_base);
|
||||
JumpToEnv(ball);
|
||||
return(FALSE);
|
||||
}
|
||||
break;
|
||||
case 'q':
|
||||
if (size_args) {
|
||||
|
||||
12
C/other.c
12
C/other.c
@ -34,6 +34,18 @@ MkPairTerm(Term head, Term tail)
|
||||
}
|
||||
|
||||
|
||||
Term
|
||||
MkNewPairTerm(void)
|
||||
{
|
||||
register CELL *p = H;
|
||||
|
||||
RESET_VARIABLE(H);
|
||||
RESET_VARIABLE(H+1);
|
||||
H+=2;
|
||||
return (AbsPair(p));
|
||||
}
|
||||
|
||||
|
||||
Term
|
||||
MkApplTerm(Functor f, unsigned int n, register Term *a)
|
||||
/* build compound term with functor f and n
|
||||
|
||||
@ -112,7 +112,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
/* extern int gc_calls; */
|
||||
|
||||
vsc_count++;
|
||||
if (vsc_count < 618000) return;
|
||||
/* if (vsc_count < 618000) return; */
|
||||
/* if (vsc_count == 656) {
|
||||
printf("Here I go\n");
|
||||
}
|
||||
|
||||
@ -1679,11 +1679,6 @@ p_cut_by( void)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
if (DelayedB == NULL || YOUNGER_CP(DelayedB,pt0))
|
||||
DelayedB = pt0;
|
||||
pt0 = TopB;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (pt0 > B) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
|
||||
14
C/write.c
14
C/write.c
@ -359,6 +359,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
|
||||
putAtom(LookupAtom("..."));
|
||||
return;
|
||||
}
|
||||
if (EX != 0)
|
||||
return;
|
||||
t = Deref(t);
|
||||
if (IsVarTerm(t)) {
|
||||
write_var((CELL *)t);
|
||||
@ -386,9 +388,15 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
|
||||
|
||||
if (Use_portray) {
|
||||
Term targs[1];
|
||||
Term old_EX = 0L;
|
||||
|
||||
targs[0] = t;
|
||||
PutValue(AtomPortray, MkAtomTerm(AtomNil));
|
||||
if (EX != 0L) old_EX = EX;
|
||||
*--ASP = MkIntTerm(0);
|
||||
execute_goal(MkApplTerm(FunctorPortray, 1, targs), 0, 1);
|
||||
if (old_EX != 0L) EX = old_EX;
|
||||
Use_portray = TRUE;
|
||||
Use_portray = TRUE;
|
||||
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
|
||||
return;
|
||||
@ -463,11 +471,15 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
|
||||
#endif
|
||||
if (Use_portray) {
|
||||
Term targs[1];
|
||||
Term old_EX = 0L;
|
||||
targs[0] = t;
|
||||
PutValue(AtomPortray, MkAtomTerm(AtomNil));
|
||||
if (EX != 0L) old_EX = EX;
|
||||
*--ASP = MkIntTerm(0);
|
||||
execute_goal(MkApplTerm(FunctorPortray, 1, targs),0, 1);
|
||||
if (old_EX != 0L) EX = old_EX;
|
||||
Use_portray = TRUE;
|
||||
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
|
||||
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L)
|
||||
return;
|
||||
}
|
||||
if (!Ignore_ops &&
|
||||
|
||||
18
H/Heap.h
18
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.24 2002-02-26 15:51:54 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.25 2002-05-14 18:24:33 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -80,15 +80,9 @@ typedef struct various_codes {
|
||||
struct pred_entry *p;
|
||||
struct pred_entry *p0;
|
||||
} env_for_yes_code; /* sla */
|
||||
OPCODE yescode;
|
||||
#ifdef YAPOR
|
||||
yamop yescode;
|
||||
yamop nocode;
|
||||
yamop rtrycode;
|
||||
#else
|
||||
OPCODE nocode;
|
||||
/* yamop rtrycode; problem: we would have to publish yamop */
|
||||
CELL rtrycode[4];
|
||||
#endif /* YAPOR */
|
||||
struct {
|
||||
OPREG arity;
|
||||
CODEADDR clause;
|
||||
@ -317,10 +311,10 @@ typedef struct various_codes {
|
||||
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
|
||||
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
|
||||
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
|
||||
#define YESCODE ((CODEADDR)&(heap_regs->yescode ))
|
||||
#define NOCODE ((CODEADDR)&(heap_regs->nocode ))
|
||||
#define RTRYCODE ((CODEADDR)&(heap_regs->rtrycode ))
|
||||
#define DUMMYCODE ((CODEADDR)&(heap_regs->dummycode ))
|
||||
#define YESCODE (&(heap_regs->yescode ))
|
||||
#define NOCODE (&(heap_regs->nocode ))
|
||||
#define RTRYCODE (&(heap_regs->rtrycode ))
|
||||
#define DUMMYCODE (&(heap_regs->dummycode ))
|
||||
#define CLAUSECODE (&(heap_regs->clausecode ))
|
||||
#define INVISIBLECHAIN heap_regs->invisiblechain
|
||||
#define max_depth (&(heap_regs->maxdepth ))
|
||||
|
||||
6
H/Regs.h
6
H/Regs.h
@ -10,7 +10,7 @@
|
||||
* File: Regs.h *
|
||||
* mods: *
|
||||
* comments: YAP abstract machine registers *
|
||||
* version: $Id: Regs.h,v 1.14 2002-03-08 06:33:16 vsc Exp $ *
|
||||
* version: $Id: Regs.h,v 1.15 2002-05-14 18:24:33 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
|
||||
@ -84,9 +84,8 @@ typedef struct
|
||||
ADDR HeapPlus_; /* 11 To avoid collisions with HeapTop */
|
||||
tr_fr_ptr MyTR_; /* 12 */
|
||||
/* visualc*/
|
||||
choiceptr TopB_; /* 17 Top up to where we can cut to */
|
||||
choiceptr DelayedB_; /* 17 Cut Still To be Done */
|
||||
CELL FlipFlop_; /* 18 */
|
||||
CELL EX_; /* 18 */
|
||||
#ifdef COROUTINING
|
||||
Term DelayedVars_; /* maximum number of attributed variables */
|
||||
#endif
|
||||
@ -628,6 +627,7 @@ EXTERN inline void restore_B(void) {
|
||||
#define TopB REGS.TopB_
|
||||
#define DelayedB REGS.DelayedB_
|
||||
#define FlipFlop REGS.FlipFlop_
|
||||
#define EX REGS.EX_
|
||||
#define DEPTH REGS.DEPTH_
|
||||
#if (defined(YAPOR) && defined(SBA)) || defined(TABLING)
|
||||
#define H_FZ REGS.H_FZ_
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.16 2002-05-06 15:33:04 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.17 2002-05-14 18:24:33 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -43,6 +43,7 @@ Functor STD_PROTO(UnlockedMkFunctor,(AtomEntry *,unsigned int));
|
||||
Functor STD_PROTO(MkFunctor,(Atom,unsigned int));
|
||||
void STD_PROTO(MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
|
||||
Term STD_PROTO(MkPairTerm,(Term,Term));
|
||||
Term STD_PROTO(MkNewPairTerm,(void));
|
||||
void STD_PROTO(PutValue,(Atom,Term));
|
||||
void STD_PROTO(ReleaseAtom,(Atom));
|
||||
Term STD_PROTO(StringToList,(char *));
|
||||
@ -155,6 +156,7 @@ Int STD_PROTO(JumpToEnv,(Term));
|
||||
int STD_PROTO(RunTopGoal,(Term));
|
||||
Int STD_PROTO(execute_goal,(Term, int, SMALLUNSGN));
|
||||
int STD_PROTO(exec_absmi,(int));
|
||||
void STD_PROTO(trust_last,(void));
|
||||
|
||||
|
||||
/* grow.c */
|
||||
|
||||
12
docs/yap.tex
12
docs/yap.tex
@ -4672,21 +4672,23 @@ both static and dynamic predicates.
|
||||
@findex assert_static/1
|
||||
@snindex assert_static/1
|
||||
@cnindex assert_static/1
|
||||
Adds clause @var{C} to a static procedure.
|
||||
Adds clause @var{C} to a static procedure. Asserting a static clause
|
||||
for a predicate while choice-points for the predicate are availabe has
|
||||
undefined results.
|
||||
|
||||
@item asserta_static(+@var{C})
|
||||
@findex asserta_static/1
|
||||
@snindex asserta_static/1
|
||||
@cnindex asserta_static/1
|
||||
Adds clause @var{C} to the beginning of a static procedure. Note that
|
||||
the operation may fail if pointers to the procedure are in the stacks.
|
||||
Adds clause @var{C} to the beginning of a static procedure.
|
||||
|
||||
@item assertz_static(+@var{C})
|
||||
@findex assertz_static/1
|
||||
@snindex assertz_static/1
|
||||
@cnindex assertz_static/1
|
||||
Adds clause @var{C} to the end of a static procedure. Note that
|
||||
the operation may fail if pointers to the procedure are in the stacks.
|
||||
Adds clause @var{C} to the end of a static procedure. Asserting a
|
||||
static clause for a predicate while choice-points for the predicate are
|
||||
availabe has undefined results.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@ -235,6 +235,15 @@ static Term (*YapIMkPairTerm)() = YapMkPairTerm;
|
||||
#define MkPairTerm(T1,T2) YapMkPairTerm(T1,T2)
|
||||
#endif
|
||||
|
||||
/* Term MkNewPairTerm(void) */
|
||||
extern X_API Term PROTO(YapMkNewPairTerm,(void));
|
||||
#ifdef IndirectCalls
|
||||
static Term (*YapIMkNewPairTerm)() = YapMkNewPairTerm;
|
||||
#define MkNewPairTerm() (*YapIMkNewPairTerm)()
|
||||
#else
|
||||
#define MkNewPairTerm() YapMkNewPairTerm()
|
||||
#endif
|
||||
|
||||
/* Term HeadOfTerm(Term) */
|
||||
extern X_API Term PROTO(YapHeadOfTerm,(Term));
|
||||
#ifdef IndirectCalls
|
||||
@ -355,9 +364,9 @@ static void (*YapIUserBackCPredicate)() = UserBackCPredicate;
|
||||
#endif
|
||||
|
||||
/* void CallProlog(Term t) */
|
||||
extern X_API void PROTO(YapCallProlog,(Term t));
|
||||
extern X_API Int PROTO(YapCallProlog,(Term t));
|
||||
#ifdef IndirectCalls
|
||||
static void (*YapICallProlog)() = YapCallProlog;
|
||||
static Int (*YapICallProlog)() = YapCallProlog;
|
||||
#define CallProlog(t) (*YapICallProlog)(t)
|
||||
#else
|
||||
#define CallProlog(t) YapCallProlog(t)
|
||||
@ -420,6 +429,20 @@ static int (YapIContinueGoal)() = YapContinueGoal;
|
||||
#define YapContinueGoal() (*YapIContinueGoal)()
|
||||
#endif
|
||||
|
||||
/* void YapPruneGoal(void) */
|
||||
extern X_API void PROTO(YapPruneGoal,(void));
|
||||
#ifdef IndirectCalls
|
||||
static void (YapIPruneGoal)() = YapPruneGoal;
|
||||
#define YapPruneGoal() (*YapIPruneGoal)()
|
||||
#endif
|
||||
|
||||
/* int YapGoalHasException(void) */
|
||||
extern X_API int PROTO(YapGoalHasException,(Term *));
|
||||
#ifdef IndirectCalls
|
||||
static int (YapIGoalHasException)(TP) = YapGoalHasException;
|
||||
#define YapGoalHasException(TP) (*YapIGoalHasException)(TP)
|
||||
#endif
|
||||
|
||||
/* int YapReset(void) */
|
||||
extern X_API void PROTO(YapReset,(void));
|
||||
#ifdef IndirectCalls
|
||||
@ -592,12 +615,33 @@ static Term (*YapIOpenStream)() = YapOpenStream;
|
||||
#endif
|
||||
|
||||
/* Term *YapNewSlots() */
|
||||
extern X_API Term *PROTO(YapNewSlots,(int));
|
||||
extern X_API long PROTO(YapNewSlots,(int));
|
||||
#ifdef IndirectCalls
|
||||
static Term *(*YapINewSlots)(N) = YapNewSlots;
|
||||
static long (*YapINewSlots)(N) = YapNewSlots;
|
||||
#define YapNewSlots(N) (*YapINewSlots)(N)
|
||||
#endif
|
||||
|
||||
/* Term YapGetFromSlots(t) */
|
||||
extern X_API Term PROTO(YapGetFromSlot,(long));
|
||||
#ifdef IndirectCalls
|
||||
static Term (*YapIGetFromSlot)(N) = YapGetFromSlot;
|
||||
#define YapGetFromSlot(N) (*YapIGetFromSlot)(N)
|
||||
#endif
|
||||
|
||||
/* Term YapAddressFromSlots(t) */
|
||||
extern X_API Term *PROTO(YapAddressFromSlot,(long));
|
||||
#ifdef IndirectCalls
|
||||
static Term *(*YapIAddressFromSlot)(N) = YapAddressFromSlot;
|
||||
#define YapAddressFromSlot(N) (*YapIAddressFromSlot)(N)
|
||||
#endif
|
||||
|
||||
/* Term YapPutInSlots(t) */
|
||||
extern X_API void PROTO(YapPutInSlot,(long, Term));
|
||||
#ifdef IndirectCalls
|
||||
static void (*YapIPutInSlot)(N,T) = YapPutInSlot;
|
||||
#define YapPutInSlot(N,T) (*YapIPutInSlot)(N,T)
|
||||
#endif
|
||||
|
||||
/* void YapRecoverSlots() */
|
||||
extern X_API void PROTO(YapRecoverSlots,(int));
|
||||
#ifdef IndirectCalls
|
||||
@ -655,5 +699,13 @@ static void (*YapIPredicateInfo)(P,N,A,M) = YapPredicateInfo;
|
||||
#endif
|
||||
|
||||
|
||||
/* int YapPredicate() */
|
||||
extern X_API int PROTO(YapCurrentModule,(void));
|
||||
#ifdef IndirectCalls
|
||||
static int (*YapICurrentModule)() = YapCurrentModule;
|
||||
#define YapCurrentModule() (*YapICurrentModule)()
|
||||
#endif
|
||||
|
||||
|
||||
#define InitCPred(N,A,F) UserCPredicate(N,F,A)
|
||||
|
||||
|
||||
@ -24,6 +24,7 @@ YapLookupAtom
|
||||
YapFullLookupAtom
|
||||
YapAtomName
|
||||
YapMkPairTerm
|
||||
YapMkNewPairTerm
|
||||
YapHeadOfTerm
|
||||
YapTailOfTerm
|
||||
YapMkApplTerm
|
||||
@ -48,6 +49,8 @@ YapBufferToAtomList
|
||||
YapError
|
||||
YapRunGoal
|
||||
YapContinueGoal
|
||||
YapPruneGoal
|
||||
YapGoalHasException
|
||||
YapRead
|
||||
YapCompileClause
|
||||
YapInit
|
||||
@ -65,6 +68,9 @@ YapStreamToFileNo
|
||||
YapCloseAllOpenStreams
|
||||
YapOpenStream
|
||||
YapNewSlots
|
||||
YapGetFromSlot
|
||||
YapAddressFromSlot
|
||||
YapPutInSlot
|
||||
YapRecoverSlots
|
||||
YapThrow
|
||||
YapLookupModule
|
||||
@ -72,4 +78,5 @@ YapModuleName
|
||||
YapHalt
|
||||
YapTopOfLocalStack
|
||||
YapPredicate
|
||||
YapCurrentModule
|
||||
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
% so that the user will get a redefining system predicate
|
||||
otherwise.
|
||||
fail :- fail.
|
||||
false :- false.
|
||||
false :- fail.
|
||||
!.
|
||||
(:- G) :- '$execute'(G), !.
|
||||
'$$!'(CP) :- '$cut_by'(CP).
|
||||
@ -121,7 +121,6 @@ system_mode(verbose,off) :- '$set_value'('$verbose',off).
|
||||
|
||||
:- module(user).
|
||||
|
||||
|
||||
:- multifile goal_expansion/3.
|
||||
|
||||
:- dynamic_predicate(goal_expansion/3, logical).
|
||||
|
||||
Reference in New Issue
Block a user