sveral updates
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1415 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
16970726b8
commit
1fa46c6051
245
C/absmi.c
245
C/absmi.c
@ -10,8 +10,38 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2005-10-18 17:04:43 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-28 17:38:49 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.179 2005/10/18 17:04:43 vsc
|
||||
* 5.1:
|
||||
* - improvements to GC
|
||||
* 2 generations
|
||||
* generic speedups
|
||||
* - new scheme for attvars
|
||||
* - hProlog like interface also supported
|
||||
* - SWI compatibility layer
|
||||
* - extra predicates
|
||||
* - global variables
|
||||
* - moved to Prolog module
|
||||
* - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart
|
||||
* Demoen and Jan Wielemacker
|
||||
* - load_files/2
|
||||
*
|
||||
* from 5.0.1
|
||||
*
|
||||
* - WIN32 missing include files (untested)
|
||||
* - -L trouble (my thanks to Takeyuchi Shiramoto-san)!
|
||||
* - debugging of backtrable user-C preds would core dump.
|
||||
* - redeclaring a C-predicate as Prolog core dumps.
|
||||
* - badly protected YapInterface.h.
|
||||
* - break/0 was failing at exit.
|
||||
* - YAP_cut_fail and YAP_cut_succeed were different from manual.
|
||||
* - tracing through data-bases could core dump.
|
||||
* - cut could break on very large computations.
|
||||
* - first pass at BigNum issues (reported by Roberto).
|
||||
* - debugger could get go awol after fail port.
|
||||
* - weird message on wrong debugger option.
|
||||
*
|
||||
* Revision 1.178 2005/10/15 17:05:23 rslopes
|
||||
* enable profiling on amd64
|
||||
*
|
||||
@ -2055,7 +2085,7 @@ Yap_absmi(int inp)
|
||||
check_stack(NoStackExecute, H);
|
||||
#endif
|
||||
PREG = pt0->CodeOfPred;
|
||||
E_YREG[E_CB] = d0;
|
||||
ENV_YREG[E_CB] = d0;
|
||||
ENDD(d0);
|
||||
#ifdef DEPTH_LIMIT
|
||||
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
||||
@ -2117,29 +2147,29 @@ Yap_absmi(int inp)
|
||||
PREG = pt0->CodeOfPred;
|
||||
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
|
||||
/* do deallocate */
|
||||
CPREG = (yamop *) E_YREG[E_CP];
|
||||
E_YREG = ENV = (CELL *) E_YREG[E_E];
|
||||
CPREG = (yamop *) ENV_YREG[E_CP];
|
||||
ENV_YREG = ENV = (CELL *) ENV_YREG[E_E];
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif /* SBA */
|
||||
else E_YREG = (CELL *)((CELL)E_YREG + ENV_Size(CPREG));
|
||||
else ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CPREG));
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *)B) {
|
||||
E_YREG = (CELL *)B;
|
||||
if (ENV_YREG > (CELL *)B) {
|
||||
ENV_YREG = (CELL *)B;
|
||||
}
|
||||
else {
|
||||
E_YREG = (CELL *) ((CELL) E_YREG + ENV_Size(CPREG));
|
||||
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
/* setup GB */
|
||||
E_YREG[E_CB] = (CELL) B;
|
||||
ENV_YREG[E_CB] = (CELL) B;
|
||||
ALWAYS_GONext();
|
||||
ALWAYS_END_PREFETCH();
|
||||
}
|
||||
@ -2148,10 +2178,10 @@ Yap_absmi(int inp)
|
||||
|
||||
BOp(fcall, sla);
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
E_YREG[E_CP] = (CELL) CPREG;
|
||||
E_YREG[E_E] = (CELL) ENV;
|
||||
ENV_YREG[E_CP] = (CELL) CPREG;
|
||||
ENV_YREG[E_E] = (CELL) ENV;
|
||||
#ifdef DEPTH_LIMIT
|
||||
E_YREG[E_DEPTH] = DEPTH;
|
||||
ENV_YREG[E_DEPTH] = DEPTH;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
ENDBOp();
|
||||
@ -2169,9 +2199,9 @@ Yap_absmi(int inp)
|
||||
#ifndef NO_CHECKING
|
||||
check_stack(NoStackCall, H);
|
||||
#endif
|
||||
ENV = E_YREG;
|
||||
ENV = ENV_YREG;
|
||||
/* Try to preserve the environment */
|
||||
E_YREG = (CELL *) (((char *) E_YREG) + PREG->u.sla.s);
|
||||
ENV_YREG = (CELL *) (((char *) ENV_YREG) + PREG->u.sla.s);
|
||||
CPREG = NEXTOP(PREG, sla);
|
||||
ALWAYS_LOOKAHEAD(pt->OpcodeOfPred);
|
||||
PREG = pt->CodeOfPred;
|
||||
@ -2189,19 +2219,19 @@ Yap_absmi(int inp)
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif /* SBA */
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *) B) {
|
||||
E_YREG = (CELL *) B;
|
||||
if (ENV_YREG > (CELL *) B) {
|
||||
ENV_YREG = (CELL *) B;
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
/* setup GB */
|
||||
E_YREG[E_CB] = (CELL) B;
|
||||
ENV_YREG[E_CB] = (CELL) B;
|
||||
#ifdef YAPOR
|
||||
SCH_check_requests();
|
||||
#endif /* YAPOR */
|
||||
@ -2218,9 +2248,9 @@ Yap_absmi(int inp)
|
||||
if (ap->PredFlags & HiddenPredFlag) {
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
CACHE_A1();
|
||||
ENV = E_YREG;
|
||||
ENV = ENV_YREG;
|
||||
/* Try to preserve the environment */
|
||||
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
|
||||
ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
|
||||
CPREG = NEXTOP(PREG, sla);
|
||||
ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
|
||||
PREG = ap->CodeOfPred;
|
||||
@ -2229,19 +2259,19 @@ Yap_absmi(int inp)
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *) B) {
|
||||
E_YREG = (CELL *) B;
|
||||
if (ENV_YREG > (CELL *) B) {
|
||||
ENV_YREG = (CELL *) B;
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
/* setup GB */
|
||||
E_YREG[E_CB] = (CELL) B;
|
||||
ENV_YREG[E_CB] = (CELL) B;
|
||||
#ifdef YAPOR
|
||||
SCH_check_requests();
|
||||
#endif /* YAPOR */
|
||||
@ -2341,10 +2371,10 @@ Yap_absmi(int inp)
|
||||
{
|
||||
/* fill it up */
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
E_YREG[E_CP] = (CELL) CPREG;
|
||||
E_YREG[E_E] = (CELL) ENV;
|
||||
ENV_YREG[E_CP] = (CELL) CPREG;
|
||||
ENV_YREG[E_E] = (CELL) ENV;
|
||||
#ifdef DEPTH_LIMIT
|
||||
E_YREG[E_DEPTH] = DEPTH;
|
||||
ENV_YREG[E_DEPTH] = DEPTH;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
}
|
||||
@ -2443,29 +2473,29 @@ Yap_absmi(int inp)
|
||||
PREG = ap->CodeOfPred;
|
||||
ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
|
||||
/* do deallocate */
|
||||
CPREG = (yamop *) E_YREG[E_CP];
|
||||
E_YREG = ENV = (CELL *) E_YREG[E_E];
|
||||
CPREG = (yamop *) ENV_YREG[E_CP];
|
||||
ENV_YREG = ENV = (CELL *) ENV_YREG[E_E];
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif
|
||||
else E_YREG = (CELL *)((CELL)E_YREG + ENV_Size(CPREG));
|
||||
else ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CPREG));
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *)B) {
|
||||
E_YREG = (CELL *)B;
|
||||
if (ENV_YREG > (CELL *)B) {
|
||||
ENV_YREG = (CELL *)B;
|
||||
} else {
|
||||
E_YREG = (CELL *) ((CELL) E_YREG + ENV_Size(CPREG));
|
||||
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
/* setup GB */
|
||||
E_YREG[E_CB] = (CELL) B;
|
||||
ENV_YREG[E_CB] = (CELL) B;
|
||||
ALWAYS_GONext();
|
||||
ALWAYS_END_PREFETCH();
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
@ -2640,9 +2670,9 @@ Yap_absmi(int inp)
|
||||
BOp(procceed, e);
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
PREG = CPREG;
|
||||
E_YREG = ENV;
|
||||
ENV_YREG = ENV;
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH = E_YREG[E_DEPTH];
|
||||
DEPTH = ENV_YREG[E_DEPTH];
|
||||
#endif
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
JMPNext();
|
||||
@ -2652,12 +2682,12 @@ Yap_absmi(int inp)
|
||||
Op(allocate, e);
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
PREG = NEXTOP(PREG, e);
|
||||
E_YREG[E_CP] = (CELL) CPREG;
|
||||
E_YREG[E_E] = (CELL) ENV;
|
||||
ENV_YREG[E_CP] = (CELL) CPREG;
|
||||
ENV_YREG[E_E] = (CELL) ENV;
|
||||
#ifdef DEPTH_LIMIT
|
||||
E_YREG[E_DEPTH] = DEPTH;
|
||||
ENV_YREG[E_DEPTH] = DEPTH;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
ENV = E_YREG;
|
||||
ENV = ENV_YREG;
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
GONext();
|
||||
ENDOp();
|
||||
@ -2668,26 +2698,26 @@ Yap_absmi(int inp)
|
||||
/* other instructions do depend on S being set by deallocate
|
||||
:-( */
|
||||
SREG = YREG;
|
||||
CPREG = (yamop *) E_YREG[E_CP];
|
||||
ENV = E_YREG = (CELL *) E_YREG[E_E];
|
||||
CPREG = (yamop *) ENV_YREG[E_CP];
|
||||
ENV = ENV_YREG = (CELL *) ENV_YREG[E_E];
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH = E_YREG[E_DEPTH];
|
||||
DEPTH = ENV_YREG[E_DEPTH];
|
||||
#endif /* DEPTH_LIMIT */
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif /* SBA */
|
||||
else E_YREG = (CELL *)((CELL) E_YREG + ENV_Size(CPREG));
|
||||
else ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CPREG));
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *) B)
|
||||
E_YREG = (CELL *) B;
|
||||
if (ENV_YREG > (CELL *) B)
|
||||
ENV_YREG = (CELL *) B;
|
||||
else
|
||||
E_YREG = (CELL *) ((CELL) E_YREG + ENV_Size(CPREG));
|
||||
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
|
||||
#endif /* FROZEN_STACKS */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
#ifndef NO_CHECKING
|
||||
@ -6682,6 +6712,12 @@ Yap_absmi(int inp)
|
||||
|
||||
BOp(call_cpred, sla);
|
||||
|
||||
|
||||
if (!(P->u.sla.sla_u.p->PredFlags & ( SafePredFlag|HiddenPredFlag))) {
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackCall, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
@ -6724,6 +6760,11 @@ Yap_absmi(int inp)
|
||||
/* guarantee that *all* machine registers are saved and */
|
||||
/* restored */
|
||||
BOp(call_usercpred, sla);
|
||||
#ifdef COROUTINING
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackCall, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
#endif
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
@ -10364,10 +10405,17 @@ Yap_absmi(int inp)
|
||||
B = (choiceptr) H;
|
||||
SET_BB(B);
|
||||
save_hb();
|
||||
if (Yap_IUnify(d0, d1) == TRUE) {
|
||||
if (Yap_IUnify(d0, d1)) {
|
||||
/* restore B, no need to restore HB */
|
||||
PREG = PREG->u.l.l;
|
||||
B = pt1;
|
||||
#ifdef COROUTINING
|
||||
/* now restore Woken Goals to its old value */
|
||||
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals);
|
||||
if (OldWokenGoals == TermNil) {
|
||||
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
|
||||
}
|
||||
#endif
|
||||
GONext();
|
||||
}
|
||||
/* restore B, and later HB */
|
||||
@ -10409,6 +10457,9 @@ Yap_absmi(int inp)
|
||||
#ifdef COROUTINING
|
||||
/* now restore Woken Goals to its old value */
|
||||
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals);
|
||||
if (OldWokenGoals == TermNil) {
|
||||
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
GONext();
|
||||
@ -12103,19 +12154,19 @@ Yap_absmi(int inp)
|
||||
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
/* Try to preserve the environment */
|
||||
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
|
||||
ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif /* SBA */
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *) B) {
|
||||
E_YREG = (CELL *) B;
|
||||
if (ENV_YREG > (CELL *) B) {
|
||||
ENV_YREG = (CELL *) B;
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
BEGD(d0);
|
||||
@ -12145,29 +12196,29 @@ Yap_absmi(int inp)
|
||||
deref_head(d1, execute_comma_unk);
|
||||
execute_comma_nvar:
|
||||
if (IsAtomTerm(d1)) {
|
||||
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
|
||||
E_YREG[-EnvSizeInCells-3] = mod;
|
||||
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
|
||||
ENV_YREG[-EnvSizeInCells-3] = mod;
|
||||
} else if (IsApplTerm(d1)) {
|
||||
Functor f = FunctorOfTerm(d1);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
goto execute_metacall;
|
||||
} else {
|
||||
if (f == FunctorModule) goto execute_metacall;
|
||||
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
|
||||
E_YREG[-EnvSizeInCells-3] = mod;
|
||||
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
|
||||
ENV_YREG[-EnvSizeInCells-3] = mod;
|
||||
}
|
||||
} else {
|
||||
goto execute_metacall;
|
||||
}
|
||||
E_YREG[E_CP] = (CELL)NEXTOP(PREG,sla);
|
||||
E_YREG[E_CB] = (CELL)B;
|
||||
E_YREG[E_E] = (CELL)ENV;
|
||||
ENV_YREG[E_CP] = (CELL)NEXTOP(PREG,sla);
|
||||
ENV_YREG[E_CB] = (CELL)B;
|
||||
ENV_YREG[E_E] = (CELL)ENV;
|
||||
#ifdef DEPTH_LIMIT
|
||||
E_YREG[E_DEPTH] = DEPTH;
|
||||
ENV_YREG[E_DEPTH] = DEPTH;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
E_YREG[-EnvSizeInCells-1] = d1;
|
||||
ENV = E_YREG;
|
||||
E_YREG -= EnvSizeInCells+3;
|
||||
ENV_YREG[-EnvSizeInCells-1] = d1;
|
||||
ENV = ENV_YREG;
|
||||
ENV_YREG -= EnvSizeInCells+3;
|
||||
PREG = COMMA_CODE;
|
||||
d0 = SREG[1];
|
||||
goto restart_execute;
|
||||
@ -12238,7 +12289,7 @@ Yap_absmi(int inp)
|
||||
#endif /* LOW_LEVEL_TRACER */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
/* setup GB */
|
||||
E_YREG[E_CB] = (CELL) B;
|
||||
ENV_YREG[E_CB] = (CELL) B;
|
||||
#ifdef YAPOR
|
||||
SCH_check_requests();
|
||||
#endif /* YAPOR */
|
||||
@ -12262,7 +12313,7 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
NoStackPExecute:
|
||||
SREG = (CELL *) pen;
|
||||
ASP = E_YREG;
|
||||
ASP = ENV_YREG;
|
||||
/* setup GB */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
YREG[E_CB] = (CELL) B;
|
||||
@ -12292,27 +12343,27 @@ Yap_absmi(int inp)
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
BEGP(pt0);
|
||||
BEGD(d0);
|
||||
d0 = E_YREG[-EnvSizeInCells-1];
|
||||
pen = RepPredProp((Prop)IntegerOfTerm(E_YREG[-EnvSizeInCells-2]));
|
||||
CPREG = (yamop *) E_YREG[E_CP];
|
||||
pt0 = E_YREG;
|
||||
E_YREG = ENV = (CELL *) E_YREG[E_E];
|
||||
d0 = ENV_YREG[-EnvSizeInCells-1];
|
||||
pen = RepPredProp((Prop)IntegerOfTerm(ENV_YREG[-EnvSizeInCells-2]));
|
||||
CPREG = (yamop *) ENV_YREG[E_CP];
|
||||
pt0 = ENV_YREG;
|
||||
ENV_YREG = ENV = (CELL *) ENV_YREG[E_E];
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
|
||||
#ifdef SBA
|
||||
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
||||
#else
|
||||
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
|
||||
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||||
#endif /* SBA */
|
||||
else E_YREG = (CELL *)((CELL)E_YREG + ENV_Size(CPREG));
|
||||
else ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CPREG));
|
||||
}
|
||||
#else
|
||||
if (E_YREG > (CELL *)B) {
|
||||
E_YREG = (CELL *)B;
|
||||
if (ENV_YREG > (CELL *)B) {
|
||||
ENV_YREG = (CELL *)B;
|
||||
} else {
|
||||
E_YREG = (CELL *) ((CELL) E_YREG+ ENV_Size(CPREG));
|
||||
ENV_YREG = (CELL *) ((CELL) ENV_YREG+ ENV_Size(CPREG));
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
arity = pen->ArityOfPE;
|
||||
@ -12326,9 +12377,9 @@ Yap_absmi(int inp)
|
||||
/* create an to execute the call */
|
||||
deref_head(d1, execute_comma_comma_unk);
|
||||
execute_comma_comma_nvar:
|
||||
E_YREG[E_CB] = (CELL)pt0[E_CB];
|
||||
ENV_YREG[E_CB] = (CELL)pt0[E_CB];
|
||||
if (IsAtomTerm(d1)) {
|
||||
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
|
||||
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
|
||||
} else if (IsApplTerm(d1)) {
|
||||
Functor f = FunctorOfTerm(d1);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
@ -12341,20 +12392,20 @@ Yap_absmi(int inp)
|
||||
d1 = RepAppl(d1)[2];
|
||||
goto execute_comma_comma;
|
||||
} else {
|
||||
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
|
||||
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
|
||||
}
|
||||
} else {
|
||||
goto execute_metacall_after_comma;
|
||||
}
|
||||
E_YREG[E_CP] = (CELL)CPREG;
|
||||
E_YREG[E_E] = (CELL)ENV;
|
||||
ENV_YREG[E_CP] = (CELL)CPREG;
|
||||
ENV_YREG[E_E] = (CELL)ENV;
|
||||
#ifdef DEPTH_LIMIT
|
||||
E_YREG[E_DEPTH] = DEPTH;
|
||||
ENV_YREG[E_DEPTH] = DEPTH;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
E_YREG[-EnvSizeInCells-1] = d1;
|
||||
E_YREG[-EnvSizeInCells-3] = mod;
|
||||
ENV = E_YREG;
|
||||
E_YREG -= EnvSizeInCells+3;
|
||||
ENV_YREG[-EnvSizeInCells-1] = d1;
|
||||
ENV_YREG[-EnvSizeInCells-3] = mod;
|
||||
ENV = ENV_YREG;
|
||||
ENV_YREG -= EnvSizeInCells+3;
|
||||
d0 = SREG[1];
|
||||
CPREG = NEXTOP(COMMA_CODE,sla);
|
||||
execute_comma_comma2:
|
||||
@ -12480,7 +12531,7 @@ Yap_absmi(int inp)
|
||||
#endif
|
||||
PREG = pen->CodeOfPred;
|
||||
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
|
||||
E_YREG[E_CB] = (CELL)B;
|
||||
ENV_YREG[E_CB] = (CELL)B;
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
if (Yap_do_low_level_trace)
|
||||
low_level_trace(enter_pred,pen,XREGS+1);
|
||||
@ -12506,7 +12557,7 @@ Yap_absmi(int inp)
|
||||
NoStackPTExecute:
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
SREG = (CELL *) pen;
|
||||
ASP = E_YREG;
|
||||
ASP = ENV_YREG;
|
||||
if (ASP > (CELL *)B)
|
||||
ASP = (CELL *)B;
|
||||
LOCK(SignalLock);
|
||||
|
@ -231,6 +231,7 @@ Yap_LookupAtomWithAddress(char *atom, AtomEntry *ae)
|
||||
return;
|
||||
}
|
||||
/* add new atom to start of chain */
|
||||
NOfAtoms++;
|
||||
ae->NextOfAE = a;
|
||||
HashChain[hash].Entry = AbsAtom(ae);
|
||||
ae->PropsOfAE = NIL;
|
||||
|
1
C/agc.c
1
C/agc.c
@ -133,6 +133,7 @@ AtomAdjust(Atom a)
|
||||
#define PtoLUCAdjust(P) (P)
|
||||
#define PtoStCAdjust(P) (P)
|
||||
#define PtoArrayEAdjust(P) (P)
|
||||
#define PtoArraySAdjust(P) (P)
|
||||
#define PtoDelayAdjust(P) (P)
|
||||
#define PtoGloAdjust(P) (P)
|
||||
#define PtoLocAdjust(P) (P)
|
||||
|
199
C/arrays.c
199
C/arrays.c
@ -140,6 +140,7 @@ STATIC_PROTO(Int p_resize_static_array, (void));
|
||||
STATIC_PROTO(Int p_close_static_array, (void));
|
||||
STATIC_PROTO(Int p_access_array, (void));
|
||||
STATIC_PROTO(Int p_assign_static, (void));
|
||||
STATIC_PROTO(Int p_assign_dynamic, (void));
|
||||
|
||||
static Term
|
||||
GetTermFromArray(DBTerm *ref)
|
||||
@ -156,7 +157,7 @@ GetTermFromArray(DBTerm *ref)
|
||||
}
|
||||
} else {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_gc(3, ENV, CP)) {
|
||||
if (!Yap_gc(3, ENV, P)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return TermNil;
|
||||
}
|
||||
@ -174,25 +175,32 @@ GetNBTerm(live_term *ar, Int indx)
|
||||
{
|
||||
/* The object is now in use */
|
||||
Term livet = ar[indx].tlive;
|
||||
Term termt = ar[indx].tstore;
|
||||
|
||||
if (!IsVarTerm(livet)
|
||||
|| !IsUnboundVar(&(ar[indx].tlive))) {
|
||||
return livet;
|
||||
}
|
||||
if (IsVarTerm(termt)) {
|
||||
Term livet = MkVarTerm();
|
||||
MaBind(&(ar[indx].tlive), livet);
|
||||
return livet;
|
||||
} else if (IsAtomicTerm(termt)) {
|
||||
MaBind(&(ar[indx].tlive), termt);
|
||||
return termt;
|
||||
} else {
|
||||
DBTerm *ref = (DBTerm *)RepAppl(termt);
|
||||
if ((livet = GetTermFromArray(ref)) == TermNil) {
|
||||
return TermNil;
|
||||
if (!IsVarTerm(livet)) {
|
||||
if (!IsApplTerm(livet)) {
|
||||
return livet;
|
||||
} else if (FunctorOfTerm(livet) == FunctorAtFoundOne) {
|
||||
return Yap_ReadTimedVar(livet);
|
||||
} else {
|
||||
return livet;
|
||||
}
|
||||
MaBind(&(ar[indx].tlive), livet);
|
||||
} else {
|
||||
Term termt = ar[indx].tstore;
|
||||
|
||||
if (!IsUnboundVar(&(ar[indx].tlive))) {
|
||||
return livet;
|
||||
}
|
||||
if (IsVarTerm(termt)) {
|
||||
livet = MkVarTerm();
|
||||
} else if (IsAtomicTerm(termt)) {
|
||||
livet = termt;
|
||||
} else {
|
||||
DBTerm *ref = (DBTerm *)RepAppl(termt);
|
||||
if ((livet = GetTermFromArray(ref)) == TermNil) {
|
||||
return TermNil;
|
||||
}
|
||||
}
|
||||
Bind(&(ar[indx].tlive), livet);
|
||||
return livet;
|
||||
}
|
||||
}
|
||||
@ -395,7 +403,7 @@ p_access_array(void)
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"access_array");
|
||||
return(FALSE);
|
||||
}
|
||||
return (Yap_unify(tf, ARG3));
|
||||
return Yap_unify(tf, ARG3);
|
||||
}
|
||||
|
||||
static Int
|
||||
@ -478,9 +486,9 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae)
|
||||
#if THREADS
|
||||
p->owner_id = worker_id;
|
||||
#endif
|
||||
p->NextAE = DynamicArrays;
|
||||
DynamicArrays = p;
|
||||
InitNamedArray(p, dim);
|
||||
p->NextArrayE = DynArrayList;
|
||||
DynArrayList = p;
|
||||
|
||||
}
|
||||
|
||||
@ -542,6 +550,8 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
|
||||
p->ArrayEArity = -dim;
|
||||
p->ArrayType = type;
|
||||
ae->PropsOfAE = AbsArrayProp((ArrayEntry *)p);
|
||||
p->NextAE = StaticArrays;
|
||||
StaticArrays = p;
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
if (start_addr == NULL) {
|
||||
int i;
|
||||
@ -761,7 +771,8 @@ p_create_array(void)
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
if (!IsVarTerm(app->ValueOfVE)
|
||||
|| !IsUnboundVar(&app->ValueOfVE)) {
|
||||
if (size == app->ArrayEArity)
|
||||
if (size == app->ArrayEArity ||
|
||||
size == -app->ArrayEArity)
|
||||
return TRUE;
|
||||
Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array",
|
||||
ae->StrOfAE);
|
||||
@ -1723,7 +1734,7 @@ p_assign_static(void)
|
||||
Term told = ptr->ValueOfVE.lterms[indx].tstore;
|
||||
|
||||
CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive);
|
||||
MaBind(livep,(CELL)livep);
|
||||
RESET_VARIABLE(livep);
|
||||
/* recover space */
|
||||
if (IsApplTerm(told)) {
|
||||
Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
|
||||
@ -1763,6 +1774,147 @@ p_assign_static(void)
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_assign_dynamic(void)
|
||||
{
|
||||
Term t1, t2, t3;
|
||||
StaticArrayEntry *ptr;
|
||||
Int indx;
|
||||
|
||||
t2 = Deref(ARG2);
|
||||
if (IsNonVarTerm(t2)) {
|
||||
if (IsIntTerm(t2))
|
||||
indx = IntOfTerm(t2);
|
||||
else {
|
||||
union arith_ret v;
|
||||
if (Yap_Eval(t2, &v) == long_int_e) {
|
||||
indx = v.Int;
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array");
|
||||
return (FALSE);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
Yap_Error(INSTANTIATION_ERROR,t2,"update_array");
|
||||
return (FALSE);
|
||||
}
|
||||
t3 = Deref(ARG3);
|
||||
|
||||
t1 = Deref(ARG1);
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t1,"update_array");
|
||||
return(FALSE);
|
||||
}
|
||||
if (!IsAtomTerm(t1)) {
|
||||
if (IsApplTerm(t1)) {
|
||||
CELL *ptr;
|
||||
Functor f = FunctorOfTerm(t1);
|
||||
/* store the terms to visit */
|
||||
if (IsExtensionFunctor(f)) {
|
||||
Yap_Error(TYPE_ERROR_ARRAY,t1,"update_array");
|
||||
return(FALSE);
|
||||
}
|
||||
if (indx > 0 && indx > ArityOfFunctor(f)) {
|
||||
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"update_array");
|
||||
return(FALSE);
|
||||
}
|
||||
ptr = RepAppl(t1)+indx+1;
|
||||
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
||||
MaBind(ptr, t3);
|
||||
return(TRUE);
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR,t2,"update_array");
|
||||
return(FALSE);
|
||||
#endif
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t1,"update_array");
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
{
|
||||
AtomEntry *ae = RepAtom(AtomOfTerm(t1));
|
||||
|
||||
READ_LOCK(ae->ARWLock);
|
||||
ptr = RepStaticArrayProp(ae->PropsOfAE);
|
||||
while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
|
||||
ptr = RepStaticArrayProp(ptr->NextOfPE);
|
||||
READ_UNLOCK(ae->ARWLock);
|
||||
}
|
||||
|
||||
if (EndOfPAEntr(ptr)) {
|
||||
Yap_Error(EXISTENCE_ERROR_ARRAY,t1,"assign_static %s", RepAtom(AtomOfTerm(t1))->StrOfAE);
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
WRITE_LOCK(ptr->ArRWLock);
|
||||
if (ArrayIsDynamic((ArrayEntry *)ptr)) {
|
||||
ArrayEntry *pp = (ArrayEntry *)ptr;
|
||||
CELL *pt;
|
||||
if (indx < 0 || indx >= pp->ArrayEArity) {
|
||||
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
|
||||
READ_UNLOCK(((ArrayEntry *)ptr)->ArRWLock);
|
||||
return(FALSE);
|
||||
}
|
||||
pt = RepAppl(pp->ValueOfVE) + indx + 1;
|
||||
WRITE_UNLOCK(((ArrayEntry *)ptr)->ArRWLock);
|
||||
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
||||
/* the evil deed is to be done now */
|
||||
MaBind(pt, t3);
|
||||
return(TRUE);
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR,t2,"update_array");
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* a static array */
|
||||
if (indx < 0 || indx >= - ptr->ArrayEArity) {
|
||||
WRITE_UNLOCK(ptr->ArRWLock);
|
||||
Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
|
||||
return(FALSE);
|
||||
}
|
||||
switch (ptr->ArrayType) {
|
||||
case array_of_ints:
|
||||
case array_of_chars:
|
||||
case array_of_uchars:
|
||||
case array_of_doubles:
|
||||
case array_of_ptrs:
|
||||
case array_of_atoms:
|
||||
case array_of_dbrefs:
|
||||
case array_of_terms:
|
||||
WRITE_UNLOCK(ptr->ArRWLock);
|
||||
Yap_Error(DOMAIN_ERROR_ARRAY_TYPE, t3, "assign_static");
|
||||
return FALSE;
|
||||
|
||||
case array_of_nb_terms:
|
||||
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
||||
{
|
||||
Term t = ptr->ValueOfVE.lterms[indx].tlive;
|
||||
Functor f;
|
||||
/* we have a mutable term there */
|
||||
|
||||
if (IsVarTerm(t) ||
|
||||
!IsApplTerm(t) ||
|
||||
(f = FunctorOfTerm(t)) != FunctorAtFoundOne) {
|
||||
Term tn = Yap_NewTimedVar(t3);
|
||||
CELL *sp = RepAppl(tn);
|
||||
*sp = (CELL)FunctorAtFoundOne;
|
||||
Bind(&(ptr->ValueOfVE.lterms[indx].tlive),tn);
|
||||
} else {
|
||||
Yap_UpdateTimedVar(t, t3);
|
||||
}
|
||||
}
|
||||
return TRUE;
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR,t2,"update_array");
|
||||
return FALSE;
|
||||
#endif
|
||||
|
||||
}
|
||||
WRITE_UNLOCK(ptr->ArRWLock);
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_add_to_array_element(void)
|
||||
{
|
||||
@ -2190,6 +2342,7 @@ Yap_InitArrayPreds(void)
|
||||
Yap_InitCPred("resize_static_array", 3, p_resize_static_array, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("mmapped_array", 4, p_create_mmapped_array, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("update_array", 3, p_assign_static, SafePredFlag);
|
||||
Yap_InitCPred("dynamic_update_array", 3, p_assign_dynamic, SafePredFlag);
|
||||
Yap_InitCPred("add_to_array_element", 4, p_add_to_array_element, SafePredFlag);
|
||||
Yap_InitCPred("array_element", 3, p_access_array, 0);
|
||||
Yap_InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag);
|
||||
|
@ -82,7 +82,13 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
|
||||
vt = &(attv->Atts);
|
||||
to_visit[0] = vt-1;
|
||||
to_visit[1] = vt;
|
||||
to_visit[2] = &(newv->Atts);
|
||||
if (IsVarTerm(attv->Atts)) {
|
||||
newv->Atts = (CELL)H;
|
||||
to_visit[2] = H;
|
||||
H++;
|
||||
} else {
|
||||
to_visit[2] = &(newv->Atts);
|
||||
}
|
||||
to_visit[3] = (CELL *)vt[-1];
|
||||
*to_visit_ptr = to_visit+4;
|
||||
*res = (CELL)&(newv->Done);
|
||||
|
@ -10,8 +10,11 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2005-10-21 16:07:07 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-28 17:38:49 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.74 2005/10/21 16:07:07 vsc
|
||||
* fix tabling
|
||||
*
|
||||
* Revision 1.73 2005/10/18 17:04:43 vsc
|
||||
* 5.1:
|
||||
* - improvements to GC
|
||||
@ -1255,6 +1258,9 @@ YAP_Init(YAP_init_args *yap_init)
|
||||
if (yap_init->YapPrologGoal) {
|
||||
Yap_PutValue(Yap_FullLookupAtom("$init_goal"), MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologGoal)));
|
||||
}
|
||||
if (yap_init->YapPrologAddPath) {
|
||||
Yap_PutValue(Yap_FullLookupAtom("$extend_file_search_path"), MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologAddPath)));
|
||||
}
|
||||
if (yap_init->SavedState != NULL ||
|
||||
yap_init->YapPrologBootFile == NULL) {
|
||||
if (restore_result == FAIL_RESTORE) {
|
||||
@ -1287,6 +1293,7 @@ YAP_FastInit(char saved_state[])
|
||||
init_args.YapPrologRCFile = NULL;
|
||||
init_args.YapPrologGoal = NULL;
|
||||
init_args.YapPrologTopLevelGoal = NULL;
|
||||
init_args.YapPrologAddPath = NULL;
|
||||
init_args.HaltAfterConsult = FALSE;
|
||||
init_args.FastBoot = FALSE;
|
||||
init_args.NumberWorkers = 1;
|
||||
|
24
C/dbase.c
24
C/dbase.c
@ -265,6 +265,16 @@ STATIC_PROTO(DBProp find_int_key, (Int));
|
||||
}
|
||||
#endif
|
||||
|
||||
static UInt new_trail_size(void)
|
||||
{
|
||||
UInt sz = (Yap_TrailTop-(ADDR)TR)/2;
|
||||
if (sz < 64 * 1024L)
|
||||
return 64 * 1024L;
|
||||
if (sz > 1024*1024L)
|
||||
return 1024*1024L;
|
||||
return sz;
|
||||
}
|
||||
|
||||
static int
|
||||
recover_from_record_error(int nargs)
|
||||
{
|
||||
@ -276,7 +286,7 @@ recover_from_record_error(int nargs)
|
||||
}
|
||||
goto recover_record;
|
||||
case OUT_OF_TRAIL_ERROR:
|
||||
if (!Yap_growtrail(64 * 1024L, FALSE)) {
|
||||
if (!Yap_growtrail(new_trail_size(), FALSE)) {
|
||||
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
|
||||
return FALSE;
|
||||
}
|
||||
@ -1005,9 +1015,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#ifdef COROUTINING
|
||||
/* we still may have constraints to do */
|
||||
if (ConstraintsTerm != TermNil &&
|
||||
!(RepAppl(ConstraintsTerm) >= tbase &&
|
||||
RepAppl(ConstraintsTerm) < StoPoint)
|
||||
) {
|
||||
!IN_BETWEEN(tbase,RepAppl(ConstraintsTerm),CodeMax)) {
|
||||
*attachmentsp = (CELL)(CodeMax+1);
|
||||
pt0 = RepAppl(ConstraintsTerm)+1;
|
||||
pt0_end = RepAppl(ConstraintsTerm)+4;
|
||||
@ -1025,7 +1033,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#ifdef COROUTINING
|
||||
H = origH;
|
||||
#endif
|
||||
return(CodeMax);
|
||||
return CodeMax;
|
||||
|
||||
error:
|
||||
Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
|
||||
@ -1044,7 +1052,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#ifdef COROUTINING
|
||||
H = origH;
|
||||
#endif
|
||||
return(NULL);
|
||||
return NULL;
|
||||
|
||||
error2:
|
||||
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
|
||||
@ -1062,7 +1070,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#ifdef COROUTINING
|
||||
H = origH;
|
||||
#endif
|
||||
return(NULL);
|
||||
return NULL;
|
||||
|
||||
error_tr_overflow:
|
||||
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
|
||||
@ -1080,7 +1088,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#ifdef COROUTINING
|
||||
H = origH;
|
||||
#endif
|
||||
return(NULL);
|
||||
return NULL;
|
||||
#if THREADS
|
||||
#undef Yap_REGS
|
||||
#define Yap_REGS (*Yap_regp)
|
||||
|
165
C/exec.c
165
C/exec.c
@ -214,6 +214,125 @@ do_execute(Term t, Term mod)
|
||||
}
|
||||
}
|
||||
|
||||
static Term
|
||||
copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, unsigned int arity, Term mod)
|
||||
{
|
||||
CELL *h0 = H;
|
||||
Term tf;
|
||||
unsigned int i;
|
||||
|
||||
if (arity == 2 &&
|
||||
NameOfFunctor(f) == AtomDot) {
|
||||
for (i = 0; i<arity-n;i++) {
|
||||
*H++ = pt[i];
|
||||
}
|
||||
for (i=0; i< n; i++) {
|
||||
*H++ = h0[i-n];
|
||||
}
|
||||
tf = AbsPair(h0);
|
||||
} else {
|
||||
*H++ = (CELL)f;
|
||||
for (i = 0; i<arity-n;i++) {
|
||||
*H++ = pt[i];
|
||||
}
|
||||
for (i=0; i< n; i++) {
|
||||
*H++ = h0[i-n];
|
||||
}
|
||||
tf = AbsAppl(h0);
|
||||
}
|
||||
if (mod != CurrentModule) {
|
||||
CELL *h0 = H;
|
||||
*H++ = (CELL)FunctorModule;
|
||||
*H++ = mod;
|
||||
*H++ = tf;
|
||||
tf = AbsAppl(h0);
|
||||
}
|
||||
return tf;
|
||||
}
|
||||
|
||||
inline static Int
|
||||
do_execute_n(Term t, Term mod, unsigned int n)
|
||||
{
|
||||
Functor f;
|
||||
Atom Name;
|
||||
register CELL *pt;
|
||||
PredEntry *pen;
|
||||
unsigned int i, arity, j = -n;
|
||||
|
||||
restart_exec:
|
||||
if (IsVarTerm(t)) {
|
||||
return CallError(INSTANTIATION_ERROR, mod);
|
||||
} else if (IsAtomTerm(t)) {
|
||||
arity = n;
|
||||
Name = AtomOfTerm(t);
|
||||
pt = NULL;
|
||||
} else if (IsIntTerm(t)) {
|
||||
return CallError(TYPE_ERROR_CALLABLE, mod);
|
||||
} else if (IsPairTerm(t)) {
|
||||
arity = n+2;
|
||||
pt = RepPair(t);
|
||||
Name = AtomOfTerm(TermNil);
|
||||
} else /* if (IsApplTerm(t)) */ {
|
||||
f = FunctorOfTerm(t);
|
||||
while (f == FunctorModule) {
|
||||
Term tmod = ArgOfTerm(1,t);
|
||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||||
mod = tmod;
|
||||
t = ArgOfTerm(2,t);
|
||||
goto restart_exec;
|
||||
}
|
||||
}
|
||||
arity = ArityOfFunctor(f)+n;
|
||||
Name = NameOfFunctor(f);
|
||||
pt = RepAppl(t)+1;
|
||||
}
|
||||
f = Yap_MkFunctor(Name,arity);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
return CallError(TYPE_ERROR_CALLABLE, mod);
|
||||
}
|
||||
arity = ArityOfFunctor(f);
|
||||
|
||||
if (PRED_GOAL_EXPANSION_ALL) {
|
||||
LOCK(SignalLock);
|
||||
/* disable creeping when we do goal expansion */
|
||||
if (ActiveSignals & YAP_CREEP_SIGNAL) {
|
||||
ActiveSignals &= ~YAP_CREEP_SIGNAL;
|
||||
CreepFlag = CalculateStackGap();
|
||||
}
|
||||
UNLOCK(SignalLock);
|
||||
ARG1 = copy_execn_to_heap(f, pt, n, arity, mod);
|
||||
return CallMetaCall(mod);
|
||||
} else if (ActiveSignals) {
|
||||
return EnterCreepMode(copy_execn_to_heap(f, pt, n, arity, CurrentModule), mod);
|
||||
}
|
||||
pen = RepPredProp(PredPropByFunc(f, mod));
|
||||
/* You thought we would be over by now */
|
||||
/* but no meta calls require special preprocessing */
|
||||
if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) {
|
||||
ARG1 = copy_execn_to_heap(f, pt, n, arity, mod);
|
||||
return(CallMetaCall(mod));
|
||||
}
|
||||
/* now let us do what we wanted to do from the beginning !! */
|
||||
/* I cannot use the standard macro here because
|
||||
otherwise I would dereference the argument and
|
||||
might skip a svar */
|
||||
for (i = 1; i <= arity-n; i++) {
|
||||
#if SBA
|
||||
Term d0 = *pt++;
|
||||
if (d0 == 0)
|
||||
XREGS[i] = (CELL)(pt-1);
|
||||
else
|
||||
XREGS[i] = d0;
|
||||
#else
|
||||
XREGS[i] = *pt++;
|
||||
#endif
|
||||
}
|
||||
for (i = arity-n+1; i <= arity; i++,j++) {
|
||||
XREGS[i] = H[j];
|
||||
}
|
||||
return (CallPredicate(pen, B, pen->CodeOfPred));
|
||||
}
|
||||
|
||||
static Int
|
||||
EnterCreepMode(Term t, Term mod) {
|
||||
PredEntry *PredCreep;
|
||||
@ -248,6 +367,49 @@ p_execute(void)
|
||||
return(do_execute(t, CurrentModule));
|
||||
}
|
||||
|
||||
static void
|
||||
heap_store(Term t)
|
||||
{
|
||||
if (IsVarTerm(t)) {
|
||||
if (VarOfTerm(t) < H) {
|
||||
*H++ = t;
|
||||
} else {
|
||||
RESET_VARIABLE(H);
|
||||
Bind_Local(VarOfTerm(t), (CELL)H);
|
||||
H++;
|
||||
}
|
||||
} else {
|
||||
*H++ = t;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_execute2(void)
|
||||
{ /* '$execute'(Goal) */
|
||||
Term t = Deref(ARG1);
|
||||
heap_store(Deref(ARG2));
|
||||
return(do_execute_n(t, CurrentModule, 1));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_execute3(void)
|
||||
{ /* '$execute'(Goal) */
|
||||
Term t = Deref(ARG1);
|
||||
heap_store(Deref(ARG2));
|
||||
heap_store(Deref(ARG3));
|
||||
return(do_execute_n(t, CurrentModule, 2));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_execute4(void)
|
||||
{ /* '$execute'(Goal) */
|
||||
Term t = Deref(ARG1);
|
||||
heap_store(Deref(ARG2));
|
||||
heap_store(Deref(ARG3));
|
||||
heap_store(Deref(ARG4));
|
||||
return(do_execute_n(t, CurrentModule, 3));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_execute_clause(void)
|
||||
{ /* '$execute_clause'(Goal) */
|
||||
@ -1634,6 +1796,9 @@ Yap_InitExecFs(void)
|
||||
{
|
||||
Yap_InitComma();
|
||||
Yap_InitCPred("$execute", 1, p_execute, HiddenPredFlag);
|
||||
Yap_InitCPred("$execute", 2, p_execute2, HiddenPredFlag);
|
||||
Yap_InitCPred("$execute", 3, p_execute3, HiddenPredFlag);
|
||||
Yap_InitCPred("$execute", 4, p_execute4, HiddenPredFlag);
|
||||
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, HiddenPredFlag);
|
||||
Yap_InitCPred("$call_with_args", 2, p_execute_0, HiddenPredFlag);
|
||||
Yap_InitCPred("$call_with_args", 3, p_execute_1, HiddenPredFlag);
|
||||
|
61
C/grow.c
61
C/grow.c
@ -324,20 +324,6 @@ AdjustTrail(int adjusting_heap)
|
||||
TrailTerm(ptt) = DelayAdjust(reg);
|
||||
else if (IsOldTrail(reg))
|
||||
TrailTerm(ptt) = TrailAdjust(reg);
|
||||
else if (IsOldCode(reg)) {
|
||||
CELL *ptr;
|
||||
TrailTerm(ptt) = reg = CodeAdjust(reg);
|
||||
ptr = (CELL *)reg;
|
||||
if (IsApplTerm(*ptr)) {
|
||||
*ptr = AdjustAppl(*ptr);
|
||||
} else if (IsPairTerm(*ptr)) {
|
||||
*ptr = AdjustAppl(*ptr);
|
||||
}
|
||||
#ifdef DEBUG_STRONG
|
||||
else
|
||||
fprintf(Yap_stderr,"%% garbage heap ptr %p to %lx found in trail at %p by stack shifter\n", ptr, (unsigned long int)*ptr, ptt);
|
||||
#endif
|
||||
}
|
||||
} else if (IsPairTerm(reg)) {
|
||||
TrailTerm(ptt) = AdjustPair(reg);
|
||||
#ifdef MULTI_ASSIGNMENT_VARIABLES /* does not work with new structures */
|
||||
@ -357,8 +343,6 @@ AdjustTrail(int adjusting_heap)
|
||||
TrailVal(ptt) = DelayAdjust(reg2);
|
||||
else if (IsOldTrail(reg2))
|
||||
TrailVal(ptt) = TrailAdjust(reg2);
|
||||
else if (IsOldCode(reg2))
|
||||
TrailVal(ptt) = CodeAdjust(reg2);
|
||||
} else if (IsApplTerm(reg2)) {
|
||||
TrailVal(ptt) = AdjustAppl(reg2);
|
||||
} else if (IsPairTerm(reg2)) {
|
||||
@ -398,10 +382,51 @@ AdjustLocal(void)
|
||||
|
||||
}
|
||||
|
||||
static Term
|
||||
AdjustGlobTerm(Term reg)
|
||||
{
|
||||
if (IsVarTerm(reg)) {
|
||||
if (IsOldGlobal(reg))
|
||||
return GlobalAdjust(reg);
|
||||
else if (IsOldDelay(reg))
|
||||
return DelayAdjust(reg);
|
||||
else if (IsOldLocal(reg))
|
||||
return LocalAdjust(reg);
|
||||
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
||||
else if (IsOldTrail(reg))
|
||||
return TrailAdjust(reg);
|
||||
#endif
|
||||
} else if (IsApplTerm(reg))
|
||||
return AdjustAppl(reg);
|
||||
else if (IsPairTerm(reg))
|
||||
return AdjustPair(reg);
|
||||
return AtomTermAdjust(reg);
|
||||
}
|
||||
|
||||
static void
|
||||
AdjustGlobal(void)
|
||||
{
|
||||
register CELL *pt;
|
||||
CELL *pt;
|
||||
ArrayEntry *al = DynamicArrays;
|
||||
StaticArrayEntry *sal = StaticArrays;
|
||||
|
||||
while (al) {
|
||||
al->ValueOfVE = AdjustGlobTerm(al->ValueOfVE);
|
||||
al = al->NextAE;
|
||||
}
|
||||
while (sal) {
|
||||
if (sal->ArrayType == array_of_nb_terms) {
|
||||
UInt arity = -sal->ArrayEArity, i;
|
||||
for (i=0; i < arity; i++) {
|
||||
/* sal->ValueOfVE.lterms[i].tlive = AdjustGlobTerm(sal->ValueOfVE.lterms[i].tlive); */
|
||||
Term tlive = sal->ValueOfVE.lterms[i].tlive;
|
||||
if (!IsVarTerm(tlive) || !IsUnboundVar(&sal->ValueOfVE.lterms[i].tlive)) {
|
||||
sal->ValueOfVE.lterms[i].tlive = AdjustGlobTerm(sal->ValueOfVE.lterms[i].tlive);
|
||||
}
|
||||
}
|
||||
}
|
||||
sal = sal->NextAE;
|
||||
}
|
||||
|
||||
/*
|
||||
* to clean the global now that functors are just variables pointing to
|
||||
@ -415,7 +440,7 @@ AdjustGlobal(void)
|
||||
if (IsVarTerm(reg)) {
|
||||
if (IsOldGlobal(reg))
|
||||
*pt = GlobalAdjust(reg);
|
||||
if (IsOldDelay(reg))
|
||||
else if (IsOldDelay(reg))
|
||||
*pt = DelayAdjust(reg);
|
||||
else if (IsOldLocal(reg))
|
||||
*pt = LocalAdjust(reg);
|
||||
|
83
C/heapgc.c
83
C/heapgc.c
@ -372,14 +372,25 @@ static void
|
||||
push_registers(Int num_regs, yamop *nextop)
|
||||
{
|
||||
int i;
|
||||
StaticArrayEntry *sal = StaticArrays;
|
||||
|
||||
/* push array entries first */
|
||||
ArrayEntry *al = DynArrayList;
|
||||
while (al != NULL) {
|
||||
if (al->ArrayEArity > 0) {
|
||||
TrailTerm(TR++) = al->ValueOfVE;
|
||||
ArrayEntry *al = DynamicArrays;
|
||||
while (al) {
|
||||
TrailTerm(TR++) = al->ValueOfVE;
|
||||
al = al->NextAE;
|
||||
}
|
||||
while (sal) {
|
||||
if (sal->ArrayType == array_of_nb_terms) {
|
||||
UInt arity = -sal->ArrayEArity, i;
|
||||
for (i=0; i < arity; i++) {
|
||||
Term tlive = sal->ValueOfVE.lterms[i].tlive;
|
||||
if (!IsVarTerm(tlive) || !IsUnboundVar(&sal->ValueOfVE.lterms[i].tlive)) {
|
||||
TrailTerm(TR++) = tlive;
|
||||
}
|
||||
}
|
||||
}
|
||||
al = al->NextArrayE;
|
||||
sal = sal->NextAE;
|
||||
}
|
||||
TrailTerm(TR) = GcGeneration;
|
||||
TR++;
|
||||
@ -424,14 +435,26 @@ pop_registers(Int num_regs, yamop *nextop)
|
||||
{
|
||||
int i;
|
||||
tr_fr_ptr ptr = TR;
|
||||
StaticArrayEntry *sal = StaticArrays;
|
||||
|
||||
/* pop array entries first */
|
||||
ArrayEntry *al = DynArrayList;
|
||||
while (al != NULL) {
|
||||
if (al->ArrayEArity > 0) {
|
||||
al->ValueOfVE = TrailTerm(ptr++);
|
||||
ArrayEntry *al = DynamicArrays;
|
||||
while (al) {
|
||||
al->ValueOfVE = TrailTerm(ptr++);
|
||||
al = al->NextAE;
|
||||
}
|
||||
sal = StaticArrays;
|
||||
while (sal) {
|
||||
if (sal->ArrayType == array_of_nb_terms) {
|
||||
UInt arity = -sal->ArrayEArity;
|
||||
for (i=0; i < arity; i++) {
|
||||
Term tlive = sal->ValueOfVE.lterms[i].tlive;
|
||||
if (!IsVarTerm(tlive) || !IsUnboundVar(&sal->ValueOfVE.lterms[i].tlive)) {
|
||||
sal->ValueOfVE.lterms[i].tlive = TrailTerm(ptr++);
|
||||
}
|
||||
}
|
||||
}
|
||||
al = al->NextArrayE;
|
||||
sal = sal->NextAE;
|
||||
}
|
||||
GcGeneration = TrailTerm(ptr++);
|
||||
#ifdef COROUTINING
|
||||
@ -1342,10 +1365,10 @@ mark_external_reference(CELL *ptr) {
|
||||
|
||||
if (ONHEAP(next)) {
|
||||
#ifdef HYBRID_SCHEME
|
||||
CELL_PTR *old = iptop;
|
||||
#endif
|
||||
mark_variable(ptr);
|
||||
POPSWAP_POINTER(old);
|
||||
CELL_PTR *old = iptop;
|
||||
#endif
|
||||
mark_variable(ptr);
|
||||
POPSWAP_POINTER(old);
|
||||
} else {
|
||||
MARK(ptr);
|
||||
mark_code(ptr, next);
|
||||
@ -1556,9 +1579,8 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
UNMARK(&TrailTerm(trail_base));
|
||||
#endif /* EARLY_RESET */
|
||||
} else if (hp < (CELL *)Yap_GlobalBase || hp > (CELL *)Yap_TrailTop) {
|
||||
/* I decided to allow pointers from the Heap back into the trail.
|
||||
The point of doing so is to have dynamic arrays */
|
||||
mark_external_reference(hp);
|
||||
/* pointers from the Heap back into the trail are process in mark_regs. */
|
||||
/* do nothing !!! */
|
||||
} else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)Yap_TrailBase) {
|
||||
/* clean the trail, avoid dangling pointers! */
|
||||
RESET_VARIABLE(&TrailTerm(trail_base));
|
||||
@ -2106,7 +2128,8 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
/* first, whatever we dumped on the trail. Easier just to do
|
||||
the registers separately? */
|
||||
for (trail_ptr = old_TR; trail_ptr < TR; trail_ptr++) {
|
||||
if (MARKED_PTR(&TrailTerm(trail_ptr))) {
|
||||
if (IN_BETWEEN(Yap_GlobalBase,TrailTerm(trail_ptr),Yap_TrailTop) &&
|
||||
MARKED_PTR(&TrailTerm(trail_ptr))) {
|
||||
UNMARK(&TrailTerm(trail_ptr));
|
||||
if (HEAP_PTR(TrailTerm(trail_ptr))) {
|
||||
into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(TrailTerm(trail_ptr)));
|
||||
@ -2134,7 +2157,8 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
TrailTerm(dest) = trail_cell;
|
||||
if (IsVarTerm(trail_cell)) {
|
||||
/* we need to check whether this is a honest to god trail entry */
|
||||
if ((CELL *)trail_cell < H && MARKED_PTR((CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
|
||||
/* make sure it is a heap cell before we test whether it has been marked */
|
||||
if ((CELL *)trail_cell < H && (CELL *)trail_cell >= H0 && MARKED_PTR((CELL *)trail_cell)) {
|
||||
if (HEAP_PTR(trail_cell)) {
|
||||
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
|
||||
}
|
||||
@ -2147,24 +2171,6 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
} else if ((CELL *)trail_cell < (CELL *)Yap_GlobalBase ||
|
||||
(CELL *)trail_cell > (CELL *)Yap_TrailTop) {
|
||||
/* we may have pointers from the heap back into the cell */
|
||||
CELL *next = GET_NEXT(*CellPtr(trail_cell));
|
||||
UNMARK(CellPtr(trail_cell));
|
||||
if (HEAP_PTR(*CellPtr(trail_cell))) {
|
||||
into_relocation_chain(CellPtr(trail_cell),next);
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
/* it is complex to recover cells with frozen segments */
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED_PTR(&TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
} else if (IsPairTerm(trail_cell)) {
|
||||
@ -3661,6 +3667,8 @@ p_inform_gc(void)
|
||||
}
|
||||
|
||||
|
||||
int vsc_gc_calls;
|
||||
|
||||
static int
|
||||
call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
|
||||
{
|
||||
@ -3695,6 +3703,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
|
||||
if (gc_margin < gc_lim)
|
||||
gc_margin = gc_lim;
|
||||
GcCalls++;
|
||||
vsc_gc_calls = GcCalls;
|
||||
if (gc_on && !(Yap_PrologMode & InErrorMode)) {
|
||||
effectiveness = do_gc(predarity, current_env, nextop);
|
||||
if (effectiveness > 90) {
|
||||
|
9
C/init.c
9
C/init.c
@ -861,8 +861,13 @@ InitCodes(void)
|
||||
Yap_heap_regs->wl[i].scratchpad.ptr = NULL;
|
||||
Yap_heap_regs->wl[i].scratchpad.sz = SCRATCH_START_SIZE;
|
||||
Yap_heap_regs->wl[i].scratchpad.msz = SCRATCH_START_SIZE;
|
||||
Yap_heap_regs->wl[i].dynamic_arrays = NULL;
|
||||
Yap_heap_regs->wl[i].static_arrays = NULL;
|
||||
}
|
||||
}
|
||||
#else
|
||||
Yap_heap_regs->wl.dynamic_arrays = NULL;
|
||||
Yap_heap_regs->wl.static_arrays = NULL;
|
||||
#endif /* YAPOR */
|
||||
Yap_heap_regs->clausecode->arity = 0;
|
||||
Yap_heap_regs->clausecode->clause = NULL;
|
||||
@ -1017,6 +1022,7 @@ InitCodes(void)
|
||||
#endif
|
||||
Yap_heap_regs->functor_arrow = Yap_MkFunctor(AtomArrow, 2);
|
||||
Yap_heap_regs->functor_assert = Yap_MkFunctor(AtomAssert, 2);
|
||||
Yap_heap_regs->functor_at_found_one = Yap_MkFunctor(AtomFoundVar, 2);
|
||||
#ifdef COROUTINING
|
||||
Yap_heap_regs->functor_att_goal = Yap_MkFunctor(Yap_FullLookupAtom("$att_do"),2);
|
||||
#endif
|
||||
@ -1033,6 +1039,7 @@ InitCodes(void)
|
||||
Yap_heap_regs->functor_g_atomic = Yap_MkFunctor(Yap_LookupAtom("atomic"), 1);
|
||||
Yap_heap_regs->functor_g_compound = Yap_MkFunctor(Yap_LookupAtom("compound"), 1);
|
||||
Yap_heap_regs->functor_g_float = Yap_MkFunctor(Yap_LookupAtom("float"), 1);
|
||||
Yap_heap_regs->functor_g_format_at = Yap_MkFunctor(Yap_LookupAtom("$format@"), 2);
|
||||
Yap_heap_regs->functor_g_integer = Yap_MkFunctor(Yap_LookupAtom("integer"), 1);
|
||||
Yap_heap_regs->functor_g_number = Yap_MkFunctor(Yap_LookupAtom("number"), 1);
|
||||
Yap_heap_regs->functor_g_primitive = Yap_MkFunctor(Yap_LookupAtom("primitive"), 1);
|
||||
@ -1067,7 +1074,6 @@ InitCodes(void)
|
||||
Yap_heap_regs->term_dollar_u = MkAtomTerm(Yap_FullLookupAtom("$u"));
|
||||
#endif
|
||||
Yap_heap_regs->term_refound_var = MkAtomTerm(Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"));
|
||||
Yap_heap_regs->dyn_array_list = NULL;
|
||||
Yap_heap_regs->n_of_file_aliases = 0;
|
||||
Yap_heap_regs->file_aliases = NULL;
|
||||
Yap_heap_regs->foreign_code_loaded = NULL;
|
||||
@ -1186,6 +1192,7 @@ Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size,
|
||||
INIT_RWLOCK(HashChain[i].AERWLock);
|
||||
HashChain[i].Entry = NIL;
|
||||
}
|
||||
NOfAtoms = 0;
|
||||
Yap_LookupAtomWithAddress(".",&(SF_STORE->AtFoundVar));
|
||||
Yap_ReleaseAtom(AtomFoundVar);
|
||||
Yap_LookupAtomWithAddress("?",&(SF_STORE->AtFreeTerm));
|
||||
|
18
C/inlines.c
18
C/inlines.c
@ -406,10 +406,17 @@ p_dif(void)
|
||||
HBREG = H;
|
||||
B = (choiceptr) H;
|
||||
save_hb();
|
||||
if (Yap_IUnify(d0, d1) == TRUE) {
|
||||
if (Yap_IUnify(d0, d1)) {
|
||||
/* restore B, no need to restore HB */
|
||||
B = pt1;
|
||||
return(FALSE);
|
||||
#ifdef COROUTINING
|
||||
/* now restore Woken Goals to its old value */
|
||||
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals);
|
||||
if (OldWokenGoals == TermNil) {
|
||||
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
|
||||
}
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
B = pt1;
|
||||
/* restore B, and later HB */
|
||||
@ -426,8 +433,11 @@ p_dif(void)
|
||||
#ifdef COROUTINING
|
||||
/* now restore Woken Goals to its old value */
|
||||
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals);
|
||||
if (OldWokenGoals == TermNil) {
|
||||
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
|
||||
}
|
||||
#endif
|
||||
return(TRUE);
|
||||
return TRUE;
|
||||
ENDP(pt0);
|
||||
|
||||
BEGP(pt0);
|
||||
@ -440,7 +450,7 @@ p_dif(void)
|
||||
deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2);
|
||||
ENDP(pt0);
|
||||
/* second argument is unbound */
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
ENDD(d1);
|
||||
ENDD(d0);
|
||||
}
|
||||
|
210
C/iopreds.c
210
C/iopreds.c
@ -120,6 +120,7 @@ STATIC_PROTO (void PurgeAlias, (int));
|
||||
STATIC_PROTO (int CheckAlias, (Atom));
|
||||
STATIC_PROTO (Atom FetchAlias, (int));
|
||||
STATIC_PROTO (int FindAliasForStream, (int, Atom));
|
||||
STATIC_PROTO (int FindStreamForAlias, (Atom));
|
||||
STATIC_PROTO (int CheckStream, (Term, int, char *));
|
||||
STATIC_PROTO (Int p_check_stream, (void));
|
||||
STATIC_PROTO (Int p_check_if_stream, (void));
|
||||
@ -1831,25 +1832,29 @@ static Int p_check_if_valid_new_alias (void)
|
||||
|
||||
static Int
|
||||
p_fetch_stream_alias (void)
|
||||
{ /* '$fetch_stream_alias'(Stream) */
|
||||
{ /* '$fetch_stream_alias'(Stream,Alias) */
|
||||
int sno;
|
||||
Term t2 = Deref(ARG2);
|
||||
Term t1 = Deref(ARG1);
|
||||
|
||||
if ((sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f,
|
||||
if (IsVarTerm(t1)) {
|
||||
return Yap_unify(ARG1,MkStream(FindStreamForAlias(AtomOfTerm(t2))));
|
||||
}
|
||||
if ((sno = CheckStream (t1, Input_Stream_f | Output_Stream_f,
|
||||
"fetch_stream_alias/2")) == -1)
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
if (IsVarTerm(t2)) {
|
||||
Atom at = FetchAlias(sno);
|
||||
if (at == AtomFoundVar)
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
else
|
||||
return(Yap_unify_constant(t2, MkAtomTerm(at)));
|
||||
return Yap_unify_constant(t2, MkAtomTerm(at));
|
||||
} else if (IsAtomTerm(t2)) {
|
||||
Atom at = AtomOfTerm(t2);
|
||||
return((Int)FindAliasForStream(sno,at));
|
||||
return (Int)FindAliasForStream(sno,at);
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t2, "fetch_stream_alias/2");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
@ -2288,6 +2293,21 @@ FindAliasForStream (int sno, Atom al)
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
/* check if arg is an alias */
|
||||
static int
|
||||
FindStreamForAlias (Atom al)
|
||||
{
|
||||
AliasDesc aliasp = FileAliases, aliasp_max = FileAliases+NOfFileAliases;
|
||||
|
||||
while (aliasp < aliasp_max) {
|
||||
if (aliasp->name == al) {
|
||||
return(aliasp->alias_stream);
|
||||
}
|
||||
aliasp++;
|
||||
}
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
static int
|
||||
CheckStream (Term arg, int kind, char *msg)
|
||||
{
|
||||
@ -3520,66 +3540,66 @@ p_put_byte (void)
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
static int format_error = FALSE;
|
||||
|
||||
#define FORMAT_MAX_SIZE 256
|
||||
|
||||
static char *format_ptr, *format_base, *format_max;
|
||||
static int format_buf_size;
|
||||
|
||||
typedef struct {
|
||||
Int pos; /* tab point */
|
||||
char pad; /* ok, it's not standard english */
|
||||
} pads;
|
||||
|
||||
static pads pad_entries[16], *pad_max = pad_entries;
|
||||
typedef struct format_status {
|
||||
int format_error;
|
||||
char *format_ptr, *format_base, *format_max;
|
||||
int format_buf_size;
|
||||
pads pad_entries[16], *pad_max;
|
||||
} format_info;
|
||||
|
||||
static int
|
||||
format_putc(int sno, int ch) {
|
||||
if (format_buf_size == -1)
|
||||
return(EOF);
|
||||
if (FormatInfo->format_buf_size == -1)
|
||||
return EOF;
|
||||
if (ch == 10) {
|
||||
char *ptr = format_base;
|
||||
char *ptr = FormatInfo->format_base;
|
||||
#if MAC || _MSC_VER
|
||||
ch = '\n';
|
||||
#endif
|
||||
for (ptr = format_base; ptr < format_ptr; ptr++) {
|
||||
for (ptr = FormatInfo->format_base; ptr < FormatInfo->format_ptr; ptr++) {
|
||||
Stream[sno].stream_putc(sno, *ptr);
|
||||
}
|
||||
/* reset line */
|
||||
format_ptr = format_base;
|
||||
pad_max = pad_entries;
|
||||
FormatInfo->format_ptr = FormatInfo->format_base;
|
||||
FormatInfo->pad_max = FormatInfo->pad_entries;
|
||||
Stream[sno].stream_putc(sno, '\n');
|
||||
return((int)10);
|
||||
} else {
|
||||
*format_ptr++ = (char)ch;
|
||||
if (format_ptr == format_max) {
|
||||
*FormatInfo->format_ptr++ = (char)ch;
|
||||
if (FormatInfo->format_ptr == FormatInfo->format_max) {
|
||||
/* oops, we have reached an overflow */
|
||||
Int new_max_size = format_buf_size + FORMAT_MAX_SIZE;
|
||||
Int new_max_size = FormatInfo->format_buf_size + FORMAT_MAX_SIZE;
|
||||
char *newbuf;
|
||||
|
||||
if ((newbuf = Yap_AllocAtomSpace(new_max_size*sizeof(char))) == NULL) {
|
||||
format_buf_size = -1;
|
||||
FormatInfo->format_buf_size = -1;
|
||||
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap for format/2");
|
||||
return(EOF);
|
||||
}
|
||||
#if HAVE_MEMMOVE
|
||||
memmove((void *)newbuf, (void *)format_base, (size_t)((format_ptr-format_base)*sizeof(char)));
|
||||
memmove((void *)newbuf, (void *)FormatInfo->format_base, (size_t)((FormatInfo->format_ptr-FormatInfo->format_base)*sizeof(char)));
|
||||
#else
|
||||
{
|
||||
Int n = format_ptr-format_base;
|
||||
Int n = FormatInfo->format_ptr-FormatInfo->format_base;
|
||||
char *to = newbuf;
|
||||
char *from = format_base;
|
||||
char *from = FormatInfo->format_base;
|
||||
while (n-- >= 0) {
|
||||
*to++ = *from++;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
Yap_FreeAtomSpace(format_base);
|
||||
format_ptr = newbuf+(format_ptr-format_base);
|
||||
format_base = newbuf;
|
||||
format_max = newbuf+new_max_size;
|
||||
format_buf_size = new_max_size;
|
||||
Yap_FreeAtomSpace(FormatInfo->format_base);
|
||||
FormatInfo->format_ptr = newbuf+(FormatInfo->format_ptr-FormatInfo->format_base);
|
||||
FormatInfo->format_base = newbuf;
|
||||
FormatInfo->format_max = newbuf+new_max_size;
|
||||
FormatInfo->format_buf_size = new_max_size;
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
if (!Yap_growheap(FALSE, 0, NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at format");
|
||||
@ -3595,11 +3615,11 @@ static void fill_pads(int nchars)
|
||||
int nfillers, fill_space, lfill_space;
|
||||
|
||||
if (nchars <= 0) return; /* ignore */
|
||||
nfillers = pad_max-pad_entries;
|
||||
nfillers = FormatInfo->pad_max-FormatInfo->pad_entries;
|
||||
if (nfillers == 0) {
|
||||
/* OK, just pad with spaces */
|
||||
while (nchars--) {
|
||||
*format_ptr++ = ' ';
|
||||
*FormatInfo->format_ptr++ = ' ';
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -3607,35 +3627,35 @@ static void fill_pads(int nchars)
|
||||
lfill_space = nchars%nfillers;
|
||||
|
||||
if (fill_space) {
|
||||
pads *padi = pad_max;
|
||||
pads *padi = FormatInfo->pad_max;
|
||||
|
||||
while (padi > pad_entries) {
|
||||
while (padi > FormatInfo->pad_entries) {
|
||||
char *start_pos;
|
||||
int n, i;
|
||||
padi--;
|
||||
start_pos = format_base+padi->pos;
|
||||
n = format_ptr-start_pos;
|
||||
start_pos = FormatInfo->format_base+padi->pos;
|
||||
n = FormatInfo->format_ptr-start_pos;
|
||||
|
||||
#if HAVE_MEMMOVE
|
||||
memmove((void *)(start_pos+fill_space), (void *)start_pos, (size_t)(n*sizeof(char)));
|
||||
#else
|
||||
{
|
||||
char *to = start_pos+(fill_space+n);
|
||||
char *from = format_ptr;
|
||||
char *from = FormatInfo->format_ptr;
|
||||
|
||||
while (n-- > 0) {
|
||||
*--to = *--from;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
format_ptr += fill_space;
|
||||
FormatInfo->format_ptr += fill_space;
|
||||
for (i = 0; i < fill_space; i++) {
|
||||
*start_pos++ = padi->pad;
|
||||
}
|
||||
}
|
||||
}
|
||||
while (lfill_space--) {
|
||||
*format_ptr++ = pad_max[-1].pad;
|
||||
*FormatInfo->format_ptr++ = FormatInfo->pad_max[-1].pad;
|
||||
}
|
||||
}
|
||||
|
||||
@ -3780,7 +3800,7 @@ format_has_tabs(const char *seq)
|
||||
if (ch == '*') {
|
||||
ch = *seq++;
|
||||
}
|
||||
if (ch == 't' || ch == '|') {
|
||||
if (ch == 't' || ch == '|' || ch == '@') {
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
@ -3804,7 +3824,12 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
jmp_buf format_botch;
|
||||
volatile void *old_handler;
|
||||
volatile int old_pos;
|
||||
format_info finfo;
|
||||
Term fmod = CurrentModule;
|
||||
|
||||
FormatInfo = &finfo;
|
||||
finfo.pad_max = finfo.pad_entries;
|
||||
finfo.format_error = FALSE;
|
||||
if (Stream[sno].status & InMemory_Stream_f) {
|
||||
old_handler = Stream[sno].u.mem_string.error_handler;
|
||||
Stream[sno].u.mem_string.error_handler = (void *)&format_botch;
|
||||
@ -3850,6 +3875,26 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
Yap_Error(CONSISTENCY_ERROR, tail, "format/2");
|
||||
return FALSE;
|
||||
}
|
||||
if (IsVarTerm(args)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
|
||||
return FALSE;
|
||||
}
|
||||
while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) {
|
||||
fmod = ArgOfTerm(1,args);
|
||||
args = ArgOfTerm(2,args);
|
||||
if (IsVarTerm(fmod)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, fmod, "format/2");
|
||||
return FALSE;
|
||||
}
|
||||
if (!IsAtomTerm(fmod)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2");
|
||||
return FALSE;
|
||||
}
|
||||
if (IsVarTerm(args)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
if (IsPairTerm(args)) {
|
||||
Int tsz = 8;
|
||||
|
||||
@ -3876,20 +3921,20 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
tnum = 0;
|
||||
targs = mytargs;
|
||||
}
|
||||
format_error = FALSE;
|
||||
finfo.format_error = FALSE;
|
||||
|
||||
if ((has_tabs = format_has_tabs(fptr))) {
|
||||
format_base = format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
|
||||
format_max = format_base+FORMAT_MAX_SIZE;
|
||||
if (format_ptr == NULL) {
|
||||
finfo.format_base = finfo.format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
|
||||
finfo.format_max = finfo.format_base+FORMAT_MAX_SIZE;
|
||||
if (finfo.format_ptr == NULL) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
|
||||
return(FALSE);
|
||||
}
|
||||
format_buf_size = FORMAT_MAX_SIZE;
|
||||
finfo.format_buf_size = FORMAT_MAX_SIZE;
|
||||
f_putc = format_putc;
|
||||
} else {
|
||||
f_putc = Stream[sno].stream_putc;
|
||||
format_base = NULL;
|
||||
finfo.format_base = NULL;
|
||||
}
|
||||
while ((ch = *fptr++)) {
|
||||
Term t = TermNil;
|
||||
@ -3932,6 +3977,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
if (!IsAtomTerm(t))
|
||||
goto do_type_atom_error;
|
||||
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f);
|
||||
FormatInfo = &finfo;
|
||||
break;
|
||||
case 'c':
|
||||
{
|
||||
@ -4004,6 +4050,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
goto do_type_int_error;
|
||||
if (!has_repeats) {
|
||||
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f);
|
||||
FormatInfo = &finfo;
|
||||
} else {
|
||||
Int siz, dec = IntegerOfTerm(t), i, div = 1;
|
||||
|
||||
@ -4044,6 +4091,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
f_putc(sno, (int) '.');
|
||||
}
|
||||
Yap_plwrite (MkIntegerTerm(dec), f_putc, Handle_vars_f|To_heap_f);
|
||||
FormatInfo = &finfo;
|
||||
break;
|
||||
case 'r':
|
||||
case 'R':
|
||||
@ -4107,8 +4155,37 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
t = targs[targ++];
|
||||
Yap_StartSlots();
|
||||
Yap_plwrite (t, f_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f );
|
||||
FormatInfo = &finfo;
|
||||
ASP++;
|
||||
break;
|
||||
case '@':
|
||||
t = targs[targ++];
|
||||
Yap_StartSlots();
|
||||
{
|
||||
long sl = Yap_InitSlot(args);
|
||||
long sl2;
|
||||
Int res;
|
||||
Term ta[2];
|
||||
Term ts;
|
||||
|
||||
ta[0] = fmod;
|
||||
ta[1] = t;
|
||||
ta[0] = Yap_MkApplTerm(FunctorModule, 2, ta);
|
||||
ta[1] = MkVarTerm();
|
||||
sl2 = Yap_InitSlot(ta[1]);
|
||||
ts = Yap_MkApplTerm(FunctorGFormatAt, 2, ta);
|
||||
res = Yap_execute_goal(ts, 0, 1);
|
||||
FormatInfo = &finfo;
|
||||
args = Yap_GetFromSlot(sl);
|
||||
if (EX) goto ex_handler;
|
||||
if (!res) return FALSE;
|
||||
ts = Yap_GetFromSlot(sl2);
|
||||
Yap_RecoverSlots(2);
|
||||
if (!format_print_str (sno, repeats, has_repeats, ts, f_putc)) {
|
||||
goto do_default_error;
|
||||
}
|
||||
}
|
||||
break;
|
||||
case 'p':
|
||||
if (targ > tnum-1 || has_repeats)
|
||||
goto do_consistency_error;
|
||||
@ -4117,11 +4194,15 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
{
|
||||
long sl = Yap_InitSlot(args);
|
||||
Yap_plwrite(t, f_putc, Handle_vars_f|Use_portray_f|To_heap_f);
|
||||
FormatInfo = &finfo;
|
||||
args = Yap_GetFromSlot(sl);
|
||||
Yap_RecoverSlots(1);
|
||||
}
|
||||
if (EX != 0L) {
|
||||
Term ball = EX;
|
||||
Term ball;
|
||||
|
||||
ex_handler:
|
||||
ball = EX;
|
||||
EX = 0L;
|
||||
if (tnum <= 8)
|
||||
targs = NULL;
|
||||
@ -4131,8 +4212,9 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
if (Stream[sno].status & InMemory_Stream_f) {
|
||||
Stream[sno].u.mem_string.error_handler = old_handler;
|
||||
}
|
||||
format_clean_up(format_base, fstr, targs);
|
||||
format_clean_up(finfo.format_base, fstr, targs);
|
||||
Yap_JumpToEnv(ball);
|
||||
return FALSE;
|
||||
}
|
||||
ASP++;
|
||||
break;
|
||||
@ -4142,6 +4224,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
t = targs[targ++];
|
||||
Yap_StartSlots();
|
||||
Yap_plwrite (t, f_putc, Handle_vars_f|Quote_illegal_f|To_heap_f);
|
||||
FormatInfo = &finfo;
|
||||
ASP++;
|
||||
break;
|
||||
case 'w':
|
||||
@ -4150,6 +4233,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
t = targs[targ++];
|
||||
Yap_StartSlots();
|
||||
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f);
|
||||
FormatInfo = &finfo;
|
||||
ASP++;
|
||||
break;
|
||||
case '~':
|
||||
@ -4164,7 +4248,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
f_putc(sno, (int) '\n');
|
||||
}
|
||||
column_boundary = 0;
|
||||
pad_max = pad_entries;
|
||||
finfo.pad_max = finfo.pad_entries;
|
||||
break;
|
||||
case 'N':
|
||||
if (!has_repeats)
|
||||
@ -4172,41 +4256,41 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
if (Stream[sno].linepos != 0) {
|
||||
f_putc(sno, (int) '\n');
|
||||
column_boundary = 0;
|
||||
pad_max = pad_entries;
|
||||
finfo.pad_max = finfo.pad_entries;
|
||||
}
|
||||
if (repeats > 1) {
|
||||
Int i;
|
||||
for (i = 1; i < repeats; i++)
|
||||
f_putc(sno, (int) '\n');
|
||||
column_boundary = 0;
|
||||
pad_max = pad_entries;
|
||||
finfo.pad_max = finfo.pad_entries;
|
||||
}
|
||||
break;
|
||||
/* padding */
|
||||
case '|':
|
||||
if (has_repeats) {
|
||||
fill_pads(repeats-(format_ptr-format_base));
|
||||
fill_pads(repeats-(finfo.format_ptr-finfo.format_base));
|
||||
}
|
||||
pad_max = pad_entries;
|
||||
finfo.pad_max = finfo.pad_entries;
|
||||
column_boundary = repeats;
|
||||
break;
|
||||
case '+':
|
||||
if (has_repeats) {
|
||||
fill_pads((repeats+column_boundary)-(format_ptr-format_base));
|
||||
fill_pads((repeats+column_boundary)-(finfo.format_ptr-finfo.format_base));
|
||||
} else {
|
||||
repeats = 8;
|
||||
fill_pads(8);
|
||||
}
|
||||
pad_max = pad_entries;
|
||||
finfo.pad_max = finfo.pad_entries;
|
||||
column_boundary = repeats+column_boundary;
|
||||
break;
|
||||
case 't':
|
||||
if (!has_repeats)
|
||||
pad_max->pad = ' ';
|
||||
finfo.pad_max->pad = ' ';
|
||||
else
|
||||
pad_max->pad = fptr[-2];
|
||||
pad_max->pos = format_ptr-format_base;
|
||||
pad_max++;
|
||||
finfo.pad_max->pad = fptr[-2];
|
||||
finfo.pad_max->pos = finfo.format_ptr-finfo.format_base;
|
||||
finfo.pad_max++;
|
||||
f_putc = format_putc;
|
||||
break;
|
||||
do_instantiation_error:
|
||||
@ -4245,7 +4329,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
if (Stream[sno].status & InMemory_Stream_f) {
|
||||
Stream[sno].u.mem_string.error_handler = old_handler;
|
||||
}
|
||||
format_clean_up(format_base, fstr, targs);
|
||||
format_clean_up(finfo.format_base, fstr, targs);
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
return FALSE;
|
||||
}
|
||||
@ -4257,7 +4341,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
}
|
||||
}
|
||||
if (has_tabs) {
|
||||
for (fptr = format_base; fptr < format_ptr; fptr++) {
|
||||
for (fptr = finfo.format_base; fptr < finfo.format_ptr; fptr++) {
|
||||
Stream[sno].stream_putc(sno, *fptr);
|
||||
}
|
||||
}
|
||||
@ -4269,7 +4353,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
|
||||
if (Stream[sno].status & InMemory_Stream_f) {
|
||||
Stream[sno].u.mem_string.error_handler = old_handler;
|
||||
}
|
||||
format_clean_up(format_base, fstr, targs);
|
||||
format_clean_up(finfo.format_base, fstr, targs);
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
|
35
C/stdpreds.c
35
C/stdpreds.c
@ -11,8 +11,11 @@
|
||||
* File: stdpreds.c *
|
||||
* comments: General-purpose C implemented system predicates *
|
||||
* *
|
||||
* Last rev: $Date: 2005-10-21 16:09:02 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-28 17:38:49 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.95 2005/10/21 16:09:02 vsc
|
||||
* SWI compatible module only operators
|
||||
*
|
||||
* Revision 1.94 2005/09/08 22:06:45 rslopes
|
||||
* BEAM for YAP update...
|
||||
*
|
||||
@ -771,6 +774,18 @@ do_signal(yap_signals sig)
|
||||
UNLOCK(SignalLock);
|
||||
}
|
||||
|
||||
inline static void
|
||||
undo_signal(yap_signals sig)
|
||||
{
|
||||
LOCK(SignalLock);
|
||||
if (ActiveSignals == sig) {
|
||||
CreepFlag = CalculateStackGap();
|
||||
}
|
||||
ActiveSignals &= ~sig;
|
||||
UNLOCK(SignalLock);
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_creep(void)
|
||||
{
|
||||
@ -820,6 +835,12 @@ Yap_signal(yap_signals sig)
|
||||
do_signal(sig);
|
||||
}
|
||||
|
||||
void
|
||||
Yap_undo_signal(yap_signals sig)
|
||||
{
|
||||
undo_signal(sig);
|
||||
}
|
||||
|
||||
#ifdef undefined
|
||||
|
||||
/*
|
||||
@ -3207,6 +3228,16 @@ p_loop(void) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static Int
|
||||
p_max_tagged_integer(void) {
|
||||
return Yap_unify(ARG1, MkIntTerm(MAX_ABS_INT-1L));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_min_tagged_integer(void) {
|
||||
return Yap_unify(ARG1, MkIntTerm(-MAX_ABS_INT));
|
||||
}
|
||||
|
||||
void
|
||||
Yap_InitBackCPreds(void)
|
||||
{
|
||||
@ -3267,6 +3298,8 @@ Yap_InitCPreds(void)
|
||||
Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
|
||||
Yap_InitCPred("$max_tagged_integer", 1, p_max_tagged_integer, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$min_tagged_integer", 1, p_min_tagged_integer, SafePredFlag|HiddenPredFlag);
|
||||
#ifdef BEAM
|
||||
Yap_InitCPred("@", 0, eager_split, SafePredFlag);
|
||||
Yap_InitCPred(":", 0, force_wait, SafePredFlag);
|
||||
|
12
C/sysbits.c
12
C/sysbits.c
@ -1758,7 +1758,7 @@ static Int
|
||||
p_shell (void)
|
||||
{ /* '$shell'(+SystCommand) */
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
return(0);
|
||||
return 0;
|
||||
#else
|
||||
#if HAVE_SYSTEM
|
||||
char *shell;
|
||||
@ -2251,6 +2251,15 @@ p_yap_home(void) {
|
||||
return(Yap_unify(out,ARG1));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_env_separator(void) {
|
||||
#if defined(_WIN32)
|
||||
return Yap_unify(MkIntegerTerm(';'),ARG1);
|
||||
#else
|
||||
return Yap_unify(MkIntegerTerm(':'),ARG1);
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
* This is responsable for the initialization of all machine dependant
|
||||
* predicates
|
||||
@ -2435,6 +2444,7 @@ Yap_InitSysPreds(void)
|
||||
Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("file_directory_name", 2, p_file_directory_name, SafePredFlag);
|
||||
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
|
||||
}
|
||||
|
||||
|
||||
|
@ -120,6 +120,12 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
/* extern int gc_calls; */
|
||||
|
||||
vsc_count++;
|
||||
if (vsc_count == 21857LL) {
|
||||
jmp_deb(1);
|
||||
}
|
||||
if (vsc_count < 21800LL) {
|
||||
return;
|
||||
}
|
||||
#ifdef COMMENTED
|
||||
// if (vsc_count == 218280)
|
||||
// vsc_xstop = 1;
|
||||
@ -181,6 +187,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
#if defined(THREADS) || defined(YAPOR)
|
||||
fprintf(Yap_stderr,"(%d)", worker_id);
|
||||
#endif
|
||||
fprintf(Yap_stderr," %x ", Yap_ReadTimedVar(WokenGoals));
|
||||
/* check_trail_consistency(); */
|
||||
if (pred == NULL)
|
||||
return;
|
||||
@ -300,3 +307,4 @@ Yap_InitLowLevelTrace(void)
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
|
@ -1940,7 +1940,7 @@ void Yap_InitUtilCPreds(void)
|
||||
{
|
||||
Term cm = CurrentModule;
|
||||
Yap_InitCPred("copy_term", 2, p_copy_term, 0);
|
||||
Yap_InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, HiddenPredFlag);
|
||||
Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, HiddenPredFlag);
|
||||
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
|
||||
Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag|HiddenPredFlag);
|
||||
|
17
H/Heap.h
17
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.84 2005-09-21 03:49:33 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.85 2005-10-28 17:38:50 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -67,6 +67,7 @@ extern struct restore_info rinfo;
|
||||
#endif
|
||||
|
||||
typedef struct worker_local_struct {
|
||||
struct format_status *f_info;
|
||||
char *scanner_stack;
|
||||
struct scanner_extra_alloc *scanner_extra_blocks;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
@ -91,6 +92,8 @@ typedef struct worker_local_struct {
|
||||
Int tot_gc_time; /* total time spent in GC */
|
||||
Int tot_gc_recovered; /* number of heap objects in all garbage collections */
|
||||
jmp_buf gc_restore; /* where to jump if garbage collection crashes */
|
||||
struct array_entry *dynamic_arrays;
|
||||
struct static_array_entry *static_arrays;
|
||||
yamop trust_lu_code[3];
|
||||
} worker_local;
|
||||
|
||||
@ -338,6 +341,7 @@ typedef struct various_codes {
|
||||
#endif
|
||||
functor_arrow,
|
||||
functor_assert,
|
||||
functor_at_found_one,
|
||||
#ifdef COROUTINING
|
||||
functor_att_goal, /* goal that activates attributed variables */
|
||||
#endif
|
||||
@ -354,6 +358,7 @@ typedef struct various_codes {
|
||||
functor_g_atom,
|
||||
functor_g_atomic,
|
||||
functor_g_compound,
|
||||
functor_g_format_at,
|
||||
functor_g_integer,
|
||||
functor_g_float,
|
||||
functor_g_number,
|
||||
@ -403,7 +408,6 @@ typedef struct various_codes {
|
||||
struct pred_entry *pred_static_clause;
|
||||
struct pred_entry *pred_throw;
|
||||
struct pred_entry *pred_handle_throw;
|
||||
struct array_entry *dyn_array_list;
|
||||
struct DB_STRUCT *db_erased_marker;
|
||||
#ifdef DEBUG
|
||||
struct logic_upd_clause *db_erased_list;
|
||||
@ -605,6 +609,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#endif
|
||||
#define FunctorArrow Yap_heap_regs->functor_arrow
|
||||
#define FunctorAssert Yap_heap_regs->functor_assert
|
||||
#define FunctorAtFoundOne Yap_heap_regs->functor_at_found_one
|
||||
#ifdef COROUTINING
|
||||
#define FunctorAttGoal Yap_heap_regs->functor_att_goal
|
||||
#endif
|
||||
@ -623,6 +628,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#define FunctorGCompound Yap_heap_regs->functor_g_compound
|
||||
#define FunctorGFloat Yap_heap_regs->functor_g_float
|
||||
#define FunctorGInteger Yap_heap_regs->functor_g_integer
|
||||
#define FunctorGFormatAt Yap_heap_regs->functor_g_format_at
|
||||
#define FunctorGNumber Yap_heap_regs->functor_g_number
|
||||
#define FunctorGPrimitive Yap_heap_regs->functor_g_primitive
|
||||
#define FunctorGVar Yap_heap_regs->functor_g_var
|
||||
@ -668,7 +674,6 @@ struct various_codes *Yap_heap_regs;
|
||||
#define PredStaticClause Yap_heap_regs->pred_static_clause
|
||||
#define PredThrow Yap_heap_regs->pred_throw
|
||||
#define PredHandleThrow Yap_heap_regs->pred_handle_throw
|
||||
#define DynArrayList Yap_heap_regs->dyn_array_list
|
||||
#define DBErasedMarker Yap_heap_regs->db_erased_marker
|
||||
#ifdef DEBUG
|
||||
#define DBErasedList Yap_heap_regs->db_erased_list
|
||||
@ -717,6 +722,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#define TrDiff rinfo[worker_id].tr_diff
|
||||
#define XDiff rinfo[worker_id].x_diff
|
||||
#define DelayDiff rinfo[worker_id].delay_diff
|
||||
#define FormatInfo Yap_heap_regs->wl[worker_id].f_info
|
||||
#define ScannerStack Yap_heap_regs->wl[worker_id].scanner_stack
|
||||
#define ScannerExtraBlocks Yap_heap_regs->wl[worker_id].scanner_extra_blocks
|
||||
#define SignalLock Yap_heap_regs->wl[worker_id].signal_lock
|
||||
@ -739,6 +745,8 @@ struct various_codes *Yap_heap_regs;
|
||||
#define TotGcRecovered Yap_heap_regs->wl[worker_id].tot_gc_recovered
|
||||
#define Yap_gc_restore Yap_heap_regs->wl[worker_id].gc_restore
|
||||
#define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code
|
||||
#define DynamicArrays Yap_heap_regs->wl[worker_id].dynamic_arrays
|
||||
#define StaticArrays Yap_heap_regs->wl[worker_id].static_arrays
|
||||
#else
|
||||
#define OldASP rinfo.old_ASP
|
||||
#define OldLCL0 rinfo.old_LCL0
|
||||
@ -757,6 +765,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#define TrDiff rinfo.tr_diff
|
||||
#define XDiff rinfo.x_diff
|
||||
#define DelayDiff rinfo.delay_diff
|
||||
#define FormatInfo Yap_heap_regs->wl.f_info
|
||||
#define ScannerStack Yap_heap_regs->wl.scanner_stack
|
||||
#define ScannerExtraBlocks Yap_heap_regs->wl.scanner_extra_blocks
|
||||
#define ActiveSignals Yap_heap_regs->wl.active_signals
|
||||
@ -777,6 +786,8 @@ struct various_codes *Yap_heap_regs;
|
||||
#define TotGcRecovered Yap_heap_regs->wl.tot_gc_recovered
|
||||
#define Yap_gc_restore Yap_heap_regs->wl.gc_restore
|
||||
#define TrustLUCode Yap_heap_regs->wl.trust_lu_code
|
||||
#define DynamicArrays Yap_heap_regs->wl.dynamic_arrays
|
||||
#define StaticArrays Yap_heap_regs->wl.static_arrays
|
||||
#endif
|
||||
#define profiling Yap_heap_regs->compiler_profiling
|
||||
#define call_counting Yap_heap_regs->compiler_call_counting
|
||||
|
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.61 2005-10-21 16:09:03 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.62 2005-10-28 17:38:50 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -260,6 +260,7 @@ void STD_PROTO(Yap_InitBackCPreds,(void));
|
||||
void STD_PROTO(Yap_InitCPreds,(void));
|
||||
void STD_PROTO(Yap_show_statistics,(void));
|
||||
void STD_PROTO(Yap_signal,(yap_signals));
|
||||
void STD_PROTO(Yap_undo_signal,(yap_signals));
|
||||
|
||||
/* sysbits.c */
|
||||
void STD_PROTO(Yap_set_fpu_exceptions,(int));
|
||||
|
@ -944,10 +944,10 @@ typedef struct array_entry
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
rwlock_t ArRWLock; /* a read-write lock to protect the entry */
|
||||
#endif
|
||||
struct array_entry *NextArrayE; /* Pointer to the actual array */
|
||||
#if THREADS
|
||||
unsigned int owner_id;
|
||||
#endif
|
||||
struct array_entry *NextAE;
|
||||
Term ValueOfVE; /* Pointer to the actual array */
|
||||
} ArrayEntry;
|
||||
|
||||
@ -987,7 +987,7 @@ typedef union
|
||||
} statarray_elements;
|
||||
|
||||
/* next, the actual data structure */
|
||||
typedef struct
|
||||
typedef struct static_array_entry
|
||||
{
|
||||
Prop NextOfPE; /* used to chain properties */
|
||||
PropFlags KindOfPE; /* kind of property */
|
||||
@ -995,6 +995,7 @@ typedef struct
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
rwlock_t ArRWLock; /* a read-write lock to protect the entry */
|
||||
#endif
|
||||
struct static_array_entry *NextAE;
|
||||
static_array_types ArrayType; /* Type of Array Elements. */
|
||||
statarray_elements ValueOfVE; /* Pointer to the Array itself */
|
||||
} StaticArrayEntry;
|
||||
|
14
H/absmi.h
14
H/absmi.h
@ -235,19 +235,19 @@ restore_absmi_regs(REGSTORE * old_regs)
|
||||
|
||||
#if Y_IN_MEM
|
||||
|
||||
#define CACHE_Y_AS_ENV(A) { register CELL *E_YREG = (A)
|
||||
#define CACHE_Y_AS_ENV(A) { register CELL *ENV_YREG = (A)
|
||||
|
||||
#define WRITEBACK_Y_AS_ENV() YREG = E_YREG
|
||||
#define WRITEBACK_Y_AS_ENV() YREG = ENV_YREG
|
||||
|
||||
#define ENDCACHE_Y_AS_ENV() }
|
||||
|
||||
#define saveregs_and_ycache() YREG = E_YREG; saveregs()
|
||||
#define saveregs_and_ycache() YREG = ENV_YREG; saveregs()
|
||||
|
||||
#define setregs_and_ycache() E_YREG = YREG; setregs()
|
||||
#define setregs_and_ycache() ENV_YREG = YREG; setregs()
|
||||
|
||||
#else
|
||||
|
||||
#define E_YREG (YREG)
|
||||
#define ENV_YREG (YREG)
|
||||
|
||||
#define WRITEBACK_Y_AS_ENV()
|
||||
|
||||
@ -679,10 +679,10 @@ Macros to check the limits of stacks
|
||||
|
||||
#if (defined(SBA) && defined(YAPOR)) || defined(TABLING)
|
||||
#define check_stack(Label, GLOB) \
|
||||
if ( (Int)(Unsigned(YOUNGEST_CP((choiceptr)E_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CFREG ) goto Label
|
||||
if ( (Int)(Unsigned(YOUNGEST_CP((choiceptr)ENV_YREG,B_FZ)) - Unsigned(YOUNGEST_H(H_FZ,GLOB))) < CFREG ) goto Label
|
||||
#else
|
||||
#define check_stack(Label, GLOB) \
|
||||
if ( (Int)(Unsigned(E_YREG) - Unsigned(GLOB)) < CFREG ) goto Label
|
||||
if ( (Int)(Unsigned(ENV_YREG) - Unsigned(GLOB)) < CFREG ) goto Label
|
||||
#endif /* SBA && YAPOR */
|
||||
|
||||
/***************************************************************
|
||||
|
31
H/rheap.h
31
H/rheap.h
@ -11,8 +11,11 @@
|
||||
* File: rheap.h *
|
||||
* comments: walk through heap code *
|
||||
* *
|
||||
* Last rev: $Date: 2005-10-21 16:09:03 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-28 17:38:50 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.56 2005/10/21 16:09:03 vsc
|
||||
* SWI compatible module only operators
|
||||
*
|
||||
* Revision 1.55 2005/10/19 19:00:48 vsc
|
||||
* extend arrays with nb_terms so that we can implement nb_ builtins
|
||||
* correctly.
|
||||
@ -362,6 +365,7 @@ restore_codes(void)
|
||||
Yap_heap_regs->functor_alt_not = FuncAdjust(Yap_heap_regs->functor_alt_not);
|
||||
Yap_heap_regs->functor_arrow = FuncAdjust(Yap_heap_regs->functor_arrow);
|
||||
Yap_heap_regs->functor_assert = FuncAdjust(Yap_heap_regs->functor_assert);
|
||||
Yap_heap_regs->functor_at_found_one = FuncAdjust(Yap_heap_regs->functor_at_found_one);
|
||||
#ifdef COROUTINING
|
||||
Yap_heap_regs->functor_att_goal = FuncAdjust(Yap_heap_regs->functor_att_goal);
|
||||
#endif
|
||||
@ -378,6 +382,7 @@ restore_codes(void)
|
||||
Yap_heap_regs->functor_g_atomic = FuncAdjust(Yap_heap_regs->functor_g_atomic);
|
||||
Yap_heap_regs->functor_g_compound = FuncAdjust(Yap_heap_regs->functor_g_compound);
|
||||
Yap_heap_regs->functor_g_float = FuncAdjust(Yap_heap_regs->functor_g_float);
|
||||
Yap_heap_regs->functor_g_format_at = FuncAdjust(Yap_heap_regs->functor_g_format_at);
|
||||
Yap_heap_regs->functor_g_integer = FuncAdjust(Yap_heap_regs->functor_g_integer);
|
||||
Yap_heap_regs->functor_g_number = FuncAdjust(Yap_heap_regs->functor_g_number);
|
||||
Yap_heap_regs->functor_g_primitive = FuncAdjust(Yap_heap_regs->functor_g_primitive);
|
||||
@ -414,10 +419,6 @@ restore_codes(void)
|
||||
Yap_heap_regs->attributes_module = AtomTermAdjust(Yap_heap_regs->attributes_module);
|
||||
Yap_heap_regs->charsio_module = AtomTermAdjust(Yap_heap_regs->charsio_module);
|
||||
Yap_heap_regs->terms_module = AtomTermAdjust(Yap_heap_regs->terms_module);
|
||||
if (Yap_heap_regs->dyn_array_list != NULL) {
|
||||
Yap_heap_regs->dyn_array_list =
|
||||
(struct array_entry *)AddrAdjust((ADDR)Yap_heap_regs->dyn_array_list);
|
||||
}
|
||||
if (Yap_heap_regs->file_aliases != NULL) {
|
||||
Yap_heap_regs->yap_streams =
|
||||
(struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams);
|
||||
@ -446,8 +447,6 @@ restore_codes(void)
|
||||
(PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_throw);
|
||||
Yap_heap_regs->pred_handle_throw =
|
||||
(PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_handle_throw);
|
||||
if (Yap_heap_regs->dyn_array_list != NULL)
|
||||
Yap_heap_regs->dyn_array_list = PtoArrayEAdjust(Yap_heap_regs->dyn_array_list);
|
||||
if (Yap_heap_regs->undef_code != NULL)
|
||||
Yap_heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->undef_code));
|
||||
if (Yap_heap_regs->creep_code != NULL)
|
||||
@ -462,6 +461,14 @@ restore_codes(void)
|
||||
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.mutable_list)));
|
||||
Yap_heap_regs->wl.atts_mutable_list =
|
||||
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.atts_mutable_list)));
|
||||
if (Yap_heap_regs->wl.dynamic_arrays) {
|
||||
Yap_heap_regs->wl.dynamic_arrays =
|
||||
PtoArrayEAdjust(Yap_heap_regs->wl.dynamic_arrays);
|
||||
}
|
||||
if (Yap_heap_regs->wl.static_arrays) {
|
||||
Yap_heap_regs->wl.static_arrays =
|
||||
PtoArraySAdjust(Yap_heap_regs->wl.static_arrays);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
if (Yap_heap_regs->last_wtime != NULL)
|
||||
@ -1035,10 +1042,14 @@ RestoreEntries(PropEntry *pp)
|
||||
ae->NextOfPE =
|
||||
PropAdjust(ae->NextOfPE);
|
||||
if (ae->ArrayEArity < 0) {
|
||||
restore_static_array((StaticArrayEntry *)ae);
|
||||
/* static array entry */
|
||||
StaticArrayEntry *sae = (StaticArrayEntry *)ae;
|
||||
if (sae->NextAE)
|
||||
sae->NextAE = PtoArraySAdjust(sae->NextAE);
|
||||
restore_static_array(sae);
|
||||
} else {
|
||||
if (ae->NextArrayE != NULL)
|
||||
ae->NextArrayE = PtoArrayEAdjust(ae->NextArrayE);
|
||||
if (ae->NextAE)
|
||||
ae->NextAE = PtoArrayEAdjust(ae->NextAE);
|
||||
if (IsVarTerm(ae->ValueOfVE))
|
||||
RESET_VARIABLE(&(ae->ValueOfVE));
|
||||
else {
|
||||
|
@ -472,6 +472,15 @@ PtoArrayEAdjust (ArrayEntry * ptr)
|
||||
}
|
||||
|
||||
|
||||
inline EXTERN StaticArrayEntry *PtoArraySAdjust (StaticArrayEntry *);
|
||||
|
||||
inline EXTERN StaticArrayEntry *
|
||||
PtoArraySAdjust (StaticArrayEntry * ptr)
|
||||
{
|
||||
return (StaticArrayEntry *) (((StaticArrayEntry *) (CharP (ptr) + HDiff)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN struct logic_upd_clause *PtoLUCAdjust (struct logic_upd_clause
|
||||
*);
|
||||
|
@ -541,8 +541,11 @@ install_data:
|
||||
@ENABLE_JPL@ (cd LGPL/JPL/java; make install)
|
||||
$(INSTALL_DATA) $(srcdir)/LGPL/pillow/icon_address.pl $(DESTDIR)$(SHAREDIR)/Yap/
|
||||
$(INSTALL_DATA) $(srcdir)/LGPL/pillow/pillow.pl $(DESTDIR)$(SHAREDIR)/Yap/
|
||||
(cd CLPQR ; make install)
|
||||
(cd CHR ; make install)
|
||||
# (cd CLPQR ; make install)
|
||||
(cd LGPL/clp ; make install)
|
||||
(cd LGPL/clpr ; make install)
|
||||
# (cd CHR ; make install)
|
||||
(cd LGPL/chr ; make install)
|
||||
(cd CLPBN ; make install)
|
||||
|
||||
|
||||
|
14
configure
vendored
14
configure
vendored
@ -12881,7 +12881,8 @@ _ACEOF
|
||||
|
||||
|
||||
|
||||
for ac_func in acosh asinh atanh chdir dlopen dup2
|
||||
|
||||
for ac_func in acosh asinh atanh chdir ctime dlopen dup2
|
||||
do
|
||||
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
|
||||
echo "$as_me:$LINENO: checking for $ac_func" >&5
|
||||
@ -14864,8 +14865,11 @@ mkdir -p LGPL/JPL/java
|
||||
mkdir -p LGPL/JPL/java/jpl
|
||||
mkdir -p LGPL/JPL/java/jpl/fli
|
||||
mkdir -p LGPL/JPL/src
|
||||
mkdir -p LGPL/clp
|
||||
mkdir -p LGPL/clpr
|
||||
mkdir -p LGPL/chr
|
||||
|
||||
ac_config_files="$ac_config_files Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile CHR/Makefile CLPBN/Makefile CLPQR/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap"
|
||||
ac_config_files="$ac_config_files Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap"
|
||||
cat >confcache <<\_ACEOF
|
||||
# This file is a shell script that caches the results of configure
|
||||
# tests run on this system so they can be shared between configure
|
||||
@ -15399,9 +15403,11 @@ do
|
||||
"library/mpi/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/mpi/Makefile" ;;
|
||||
".depend" ) CONFIG_FILES="$CONFIG_FILES .depend" ;;
|
||||
"library/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/Makefile" ;;
|
||||
"CHR/Makefile" ) CONFIG_FILES="$CONFIG_FILES CHR/Makefile" ;;
|
||||
"LGPL/chr/Makefile" ) CONFIG_FILES="$CONFIG_FILES LGPL/chr/Makefile" ;;
|
||||
"LGPL/chr/chr_swi_bootstrap.yap" ) CONFIG_FILES="$CONFIG_FILES LGPL/chr/chr_swi_bootstrap.yap" ;;
|
||||
"CLPBN/Makefile" ) CONFIG_FILES="$CONFIG_FILES CLPBN/Makefile" ;;
|
||||
"CLPQR/Makefile" ) CONFIG_FILES="$CONFIG_FILES CLPQR/Makefile" ;;
|
||||
"LGPL/clp/Makefile" ) CONFIG_FILES="$CONFIG_FILES LGPL/clp/Makefile" ;;
|
||||
"LGPL/clpr/Makefile" ) CONFIG_FILES="$CONFIG_FILES LGPL/clpr/Makefile" ;;
|
||||
"library/Tries/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/Tries/Makefile" ;;
|
||||
"LGPL/JPL/Makefile" ) CONFIG_FILES="$CONFIG_FILES LGPL/JPL/Makefile" ;;
|
||||
"LGPL/JPL/src/Makefile" ) CONFIG_FILES="$CONFIG_FILES LGPL/JPL/src/Makefile" ;;
|
||||
|
@ -997,7 +997,7 @@ fi
|
||||
|
||||
dnl Checks for library functions.
|
||||
AC_TYPE_SIGNAL
|
||||
AC_CHECK_FUNCS(acosh asinh atanh chdir dlopen dup2)
|
||||
AC_CHECK_FUNCS(acosh asinh atanh chdir ctime dlopen dup2)
|
||||
AC_CHECK_FUNCS(fesettrapenable finite getcwd getenv)
|
||||
AC_CHECK_FUNCS(gethostbyname gethostid gethostname)
|
||||
AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd)
|
||||
@ -1138,8 +1138,11 @@ mkdir -p LGPL/JPL/java
|
||||
mkdir -p LGPL/JPL/java/jpl
|
||||
mkdir -p LGPL/JPL/java/jpl/fli
|
||||
mkdir -p LGPL/JPL/src
|
||||
mkdir -p LGPL/clp
|
||||
mkdir -p LGPL/clpr
|
||||
mkdir -p LGPL/chr
|
||||
|
||||
AC_OUTPUT(Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile CHR/Makefile CLPBN/Makefile CLPQR/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap)
|
||||
AC_OUTPUT(Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap)
|
||||
|
||||
make depend
|
||||
|
||||
|
@ -87,6 +87,8 @@ typedef struct {
|
||||
char *YapPrologGoal;
|
||||
/* if NON-NULL, a goal to run as top-level */
|
||||
char *YapPrologTopLevelGoal;
|
||||
/* if NON-NULL, a path to extend file-search-path */
|
||||
char *YapPrologAddPath;
|
||||
/* if previous NON-NULL and TRUE, halt after consulting that file */
|
||||
int HaltAfterConsult;
|
||||
/* ignore .yaprc, .prolog.ini, etc. files. */
|
||||
|
@ -29,7 +29,9 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
|
||||
$(srcdir)/avl.yap \
|
||||
$(srcdir)/charsio.yap \
|
||||
$(srcdir)/cleanup.yap \
|
||||
$(srcdir)/gensym.yap \
|
||||
$(srcdir)/heaps.yap \
|
||||
$(srcdir)/listing.yap \
|
||||
$(srcdir)/lists.yap \
|
||||
$(srcdir)/logtalk.yap \
|
||||
$(srcdir)/ordsets.yap \
|
||||
|
@ -36,9 +36,14 @@
|
||||
ord_symdiff/3, % Set x Set -> Set
|
||||
ord_union/2, % Set^2 -> Set
|
||||
ord_union/3, % Set x Set -> Set
|
||||
ord_union/4 % Set x Set -> Set x Set
|
||||
ord_union/4, % Set x Set -> Set x Set,
|
||||
ord_empty/1, % -> Set
|
||||
ord_memberchk/2 % Element X Set
|
||||
]).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[memberchk/2]).
|
||||
|
||||
/*
|
||||
:- mode
|
||||
list_to_ord_set(+, ?),
|
||||
@ -347,3 +352,8 @@ ord_union_all(N,Sets0,Union,Sets) :-
|
||||
ord_union(X, Y, Union)
|
||||
).
|
||||
|
||||
ord_empty([]).
|
||||
|
||||
ord_memberchk(Element, Set) :-
|
||||
memberchk(Element, Set).
|
||||
|
||||
|
@ -56,13 +56,13 @@
|
||||
%
|
||||
%
|
||||
wsize(32) :-
|
||||
yap_flag(max_integer,2147483647), !.
|
||||
yap_flag(max_tagged_integer,I), I >> 32 =:= 0, !.
|
||||
wsize(64).
|
||||
|
||||
ranstart :- ranstart(8'365).
|
||||
|
||||
ranstart(N) :-
|
||||
wsize(32), % bits available for int.
|
||||
wsize(Wsize), % bits available for int.
|
||||
MaxInt is \(1 << (Wsize - 1)), % all bits but sign bit are 1.
|
||||
Incr is (8'154 << (Wsize - 9)) + 1, % per Knuth, v.2 p.78
|
||||
Mult is 8'3655, % OK for 16-18 Wsize
|
||||
|
@ -1,4 +1,10 @@
|
||||
|
||||
:- source.
|
||||
|
||||
:- style_check(all).
|
||||
|
||||
:- yap_flag(unknown,error).
|
||||
|
||||
% redefines stuff in prolog module.
|
||||
|
||||
:- module(swi, []).
|
||||
@ -13,7 +19,8 @@
|
||||
mktime/2]).
|
||||
|
||||
:- use_module(library(terms),[term_variables/2,
|
||||
term_variables/3]).
|
||||
term_variables/3,
|
||||
term_hash/2]).
|
||||
|
||||
:- multifile
|
||||
prolog:message/3.
|
||||
@ -111,7 +118,7 @@ prolog:b_getval(GlobalVariable,Value) :-
|
||||
|
||||
prolog:b_setval(GlobalVariable,Value) :-
|
||||
array(GlobalVariable,1),
|
||||
update_array(GlobalVariable,0,Value).
|
||||
dynamic_update_array(GlobalVariable,0,Value).
|
||||
|
||||
prolog:nb_getval(GlobalVariable,Value) :-
|
||||
array_element(GlobalVariable,0,Value).
|
||||
@ -124,7 +131,7 @@ prolog:nb_delete(GlobalVariable) :-
|
||||
close_static_array(GlobalVariable).
|
||||
|
||||
prolog:nb_current(GlobalVariable,Val) :-
|
||||
static_array_properties(GlobalVariable,1,term),
|
||||
static_array_properties(GlobalVariable,1,nb_term),
|
||||
array_element(GlobalVariable,0,Val).
|
||||
|
||||
% SWI has a dynamic attribute scheme
|
||||
@ -141,7 +148,7 @@ prolog:del_attr(Var, Mod) :-
|
||||
AttTerm =.. [Mod,_,_],
|
||||
attributes:del_all_module_atts(Var, AttTerm).
|
||||
|
||||
prolog:get_attrs(Var, SWIAtts) :-
|
||||
prolog:get_attrs(AttVar, SWIAtts) :-
|
||||
get_all_swi_atts(AttVar,SWIAtts).
|
||||
|
||||
prolog:put_attrs(_, []).
|
||||
@ -164,7 +171,7 @@ prolog:append([],L,L).
|
||||
prolog:append([X|L0],L,[X|Lf]) :-
|
||||
prolog:append(L0,L,Lf).
|
||||
|
||||
prolog:member(X[X|_]).
|
||||
prolog:member(X,[X|_]).
|
||||
prolog:member(X,[_|L0]) :-
|
||||
prolog:member(X,L0).
|
||||
|
||||
@ -188,7 +195,49 @@ prolog:get_time(Secs) :- datime(Datime), mktime(Datime, Secs).
|
||||
% Time is received as int, and converted to "..."
|
||||
prolog:convert_time(X,Y) :- swi:ctime(X,Y).
|
||||
|
||||
:- hide(atom_concat).
|
||||
|
||||
prolog:atom_concat(A,B) :- atomic_concat(A,B).
|
||||
|
||||
prolog:atom_concat(A,B,C) :- atomic_concat(A,B,C).
|
||||
|
||||
:- hide(create_mutable).
|
||||
|
||||
:- hide(get_mutable).
|
||||
|
||||
:- hide(update_mutable).
|
||||
|
||||
prolog:hash_term(X,Y) :- term_hash(X,Y).
|
||||
|
||||
:- meta_predicate prolog:maplist(:,?), prolog:maplist(:,?,?), prolog:maplist(:,?,?).
|
||||
|
||||
|
||||
prolog:maplist(_, []).
|
||||
prolog:maplist(G, [H|L]) :-
|
||||
call(G,H),
|
||||
prolog:maplist(G, L).
|
||||
|
||||
prolog:maplist(_, [], []).
|
||||
prolog:maplist(G, [H1|L1], [H2|L2]) :-
|
||||
call(G,H1,H2),
|
||||
prolog:maplist(G, L1, L2).
|
||||
|
||||
prolog:maplist(_, [], [], []).
|
||||
prolog:maplist(G, [H1|L1], [H2|L2], [H3|L3]) :-
|
||||
call(G,H1,H2,H3),
|
||||
prolog:maplist(G, L1, L2, L3).
|
||||
|
||||
prolog:make.
|
||||
|
||||
prolog:source_location(File,Line) :-
|
||||
prolog_load_context(file, File),
|
||||
prolog_load_context(term_position, '$stream_position'(_,Line,_)).
|
||||
|
||||
prolog:memberchk(Element, [Element|_]) :- !.
|
||||
prolog:memberchk(Element, [_|Rest]) :-
|
||||
prolog:memberchk(Element, Rest).
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -4,7 +4,7 @@
|
||||
%
|
||||
% Author: Nuno Fonseca (nunofonseca@acm.org)
|
||||
% Date: 2005-05-14
|
||||
% $Id: ypp.yap,v 1.1 2005-06-06 05:10:37 vsc Exp $
|
||||
% $Id: ypp.yap,v 1.2 2005-10-28 17:38:50 vsc Exp $
|
||||
%
|
||||
%====================================================================================
|
||||
|
||||
@ -39,6 +39,8 @@ ypp_define(Name,Value):-
|
||||
|
||||
ypp_undefine(Name):-
|
||||
ground(Name),
|
||||
del_define(Name).
|
||||
|
||||
ypp_extcmd(Cmd):-
|
||||
ground(Cmd),!,
|
||||
eraseall('____ypp_extcmd'),
|
||||
|
67
pl/boot.yap
67
pl/boot.yap
@ -37,6 +37,7 @@ true :- true.
|
||||
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
|
||||
|
||||
'$init_system' :-
|
||||
'$add_alias_to_stream'('$loop_stream','$stream'(0)),
|
||||
% do catch as early as possible
|
||||
(
|
||||
'$access_yap_flags'(15, 0), \+ '$uncaught_throw' ->
|
||||
@ -148,6 +149,11 @@ true :- true.
|
||||
'$sync_mmapped_arrays',
|
||||
set_value('$live','$false').
|
||||
|
||||
'$startup_goals' :-
|
||||
get_value('$extend_file_search_path',P), P \= [],
|
||||
set_value('$extend_file_search_path',[]),
|
||||
'$extend_file_search_path'(P),
|
||||
fail.
|
||||
'$startup_goals' :-
|
||||
recorded('$startup_goal',G,_),
|
||||
'$current_module'(Module),
|
||||
@ -492,12 +498,12 @@ repeat :- '$repeat'.
|
||||
'$write_answer'(_,_,_) :-
|
||||
'$flush_all_streams',
|
||||
fail.
|
||||
'$write_answer'(Vs, LBlk, LAnsw) :-
|
||||
'$write_answer'(Vs, LBlk, FLAnsw) :-
|
||||
'$purge_dontcares'(Vs,IVs),
|
||||
'$sort'(IVs, NVs),
|
||||
'$prep_answer_var_by_var'(NVs, LAnsw, LBlk),
|
||||
'$name_vars_in_goals'(LAnsw, Vs, NLAnsw),
|
||||
'$write_vars_and_goals'(NLAnsw).
|
||||
'$write_vars_and_goals'(NLAnsw, FLAnsw).
|
||||
|
||||
'$purge_dontcares'([],[]).
|
||||
'$purge_dontcares'([[[95|_]|_]|Vs],NVs) :- !,
|
||||
@ -536,25 +542,25 @@ repeat :- '$repeat'.
|
||||
C is I1+65,
|
||||
'$gen_name_string'(I2,[C|L0],LF).
|
||||
|
||||
'$write_vars_and_goals'([]).
|
||||
'$write_vars_and_goals'([G1|LG]) :-
|
||||
'$write_goal_output'(G1),
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
'$write_vars_and_goals'([], []).
|
||||
'$write_vars_and_goals'([G1|LG], NG) :-
|
||||
'$write_goal_output'(G1, NG, IG),
|
||||
'$write_remaining_vars_and_goals'(LG, IG).
|
||||
|
||||
'$write_remaining_vars_and_goals'([]).
|
||||
'$write_remaining_vars_and_goals'([nl,G1|LG]) :- !,
|
||||
'$write_remaining_vars_and_goals'([], []).
|
||||
'$write_remaining_vars_and_goals'([nl,G1|LG], NG) :- !,
|
||||
nl(user_error),
|
||||
'$write_goal_output'(G1),
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
'$write_remaining_vars_and_goals'([G1|LG]) :-
|
||||
'$write_goal_output'(G1, NG, IG),
|
||||
'$write_remaining_vars_and_goals'(LG, IG).
|
||||
'$write_remaining_vars_and_goals'([G1|LG], NG) :-
|
||||
( LG = [] -> nl(user_error) ; format(user_error,',~n',[]) ),
|
||||
'$write_goal_output'(G1),
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
'$write_goal_output'(G1, NG, IG),
|
||||
'$write_remaining_vars_and_goals'(LG, IG).
|
||||
|
||||
'$write_goal_output'(var([V|VL])) :-
|
||||
'$write_goal_output'(var([V|VL]), [var([V|VL])|L], L) :-
|
||||
format(user_error,'~s',[V]),
|
||||
'$write_output_vars'(VL).
|
||||
'$write_goal_output'(nonvar([V|VL],B)) :-
|
||||
'$write_goal_output'(nonvar([V|VL],B), [nonvar([V|VL],B)|L], L) :-
|
||||
format(user_error,'~s',[V]),
|
||||
'$write_output_vars'(VL),
|
||||
format(user_error,' = ', []),
|
||||
@ -562,17 +568,17 @@ repeat :- '$repeat'.
|
||||
write_term(user_error,B,Opts) ;
|
||||
format(user_error,'~w',[B])
|
||||
).
|
||||
'$write_goal_output'(Format-G) :-
|
||||
'$write_goal_output'(Format-G, NG, NG) :-
|
||||
G = [_|_], !,
|
||||
format(user_error,Format,G).
|
||||
'$write_goal_output'(_-G) :-
|
||||
'$write_goal_output'(_-G, NG, NG) :-
|
||||
( recorded('$print_options','$toplevel'(Opts),_) ->
|
||||
write_term(user_error,G,Opts) ;
|
||||
format(user_error,'~w',[G])
|
||||
).
|
||||
|
||||
'$name_vars_in_goals'(G, VL0, NG) :-
|
||||
'$copy_term_but_not_constraints'(G+VL0, NG+NVL0),
|
||||
copy_term_nat(G+VL0, NG+NVL0),
|
||||
'$name_well_known_vars'(NVL0),
|
||||
'$variables_in_term'(NG, [], NGVL),
|
||||
'$name_vars_in_goals1'(NGVL, 0, _).
|
||||
@ -799,21 +805,38 @@ break :-
|
||||
(nonvar(Debug) -> recorda('$debug',Debug,_); true),
|
||||
set_value('$break',BL).
|
||||
|
||||
'$silent_bootstrap'(F) :-
|
||||
get_value('$lf_verbose',OldSilent),
|
||||
set_value('$lf_verbose',silent),
|
||||
bootstrap(F),
|
||||
set_value('$lf_verbose', OldSilent).
|
||||
|
||||
bootstrap(F) :-
|
||||
'$open'(F,'$csult',Stream,0),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
'$current_stream'(File,_,Stream),
|
||||
'$start_consult'(consult, File, LC),
|
||||
file_directory_name(File, Dir),
|
||||
'$getcwd'(OldD),
|
||||
cd(Dir),
|
||||
format(user_error, '~*|% consulting ~w...~n', [LC,F]),
|
||||
(
|
||||
get_value('$lf_verbose',silent)
|
||||
->
|
||||
true
|
||||
;
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
format(user_error, '~*|% consulting ~w...~n', [LC,F])
|
||||
),
|
||||
'$loop'(Stream,consult),
|
||||
cd(OldD),
|
||||
'$end_consult',
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T]),
|
||||
(
|
||||
get_value('$lf_verbose',silent)
|
||||
->
|
||||
true
|
||||
;
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
|
||||
),
|
||||
!.
|
||||
|
||||
|
||||
|
@ -11,8 +11,11 @@
|
||||
* File: checker.yap *
|
||||
* comments: style checker for Prolog *
|
||||
* *
|
||||
* Last rev: $Date: 2005-04-20 20:06:11 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-28 17:38:50 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.18 2005/04/20 20:06:11 vsc
|
||||
* try to improve error handling and warnings from within consults.
|
||||
*
|
||||
* Revision 1.17 2005/04/20 04:08:20 vsc
|
||||
* fix warnings
|
||||
*
|
||||
@ -53,8 +56,12 @@ style_check(all) :- '$syntax_check_mode'(_,on),
|
||||
'$syntax_check_multiple'(_,on).
|
||||
style_check(single_var) :- '$syntax_check_mode'(_,on),
|
||||
'$syntax_check_single_var'(_,on).
|
||||
style_check(singleton) :-
|
||||
style_check(single_var).
|
||||
style_check(-single_var) :-
|
||||
no_style_check(single_var).
|
||||
style_check(-singleton) :-
|
||||
no_style_check(single_var).
|
||||
style_check(discontiguous) :- '$syntax_check_mode'(_,on),
|
||||
'$syntax_check_discontiguous'(_,on).
|
||||
style_check(-discontiguous) :-
|
||||
@ -188,7 +195,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
|
||||
'$multifile'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,multifile(V)).
|
||||
'$multifile'((X,Y), M) :- '$multifile'(X, M), '$multifile'(Y, M).
|
||||
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
|
||||
'$multifile'(Mod:PredSpec, _) :- !,
|
||||
'$multifile'(PredSpec, Mod).
|
||||
'$multifile'(N/A, M) :-
|
||||
|
@ -33,8 +33,9 @@ load_files(Files,Opts) :-
|
||||
|
||||
'$load_files'(Files,Opts,Call) :-
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call),
|
||||
'$check_use_module'(Call,UseModule),
|
||||
'$current_module'(M0),
|
||||
'$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult),
|
||||
'$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule),
|
||||
'$close_lf'(Silent).
|
||||
|
||||
'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
@ -83,48 +84,56 @@ load_files(Files,Opts) :-
|
||||
/* ( '$stream'(Stream) -> true ; '$do_error'(domain_error(stream,Stream),Call) ), */
|
||||
( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ).
|
||||
|
||||
'$lf'(V,_,Call,_,_,_,_,_,_,_) :- var(V), !,
|
||||
'$check_use_module'(use_module(_),use_module(_)) :- !.
|
||||
'$check_use_module'(use_module(_,_),use_module(_)) :- !.
|
||||
'$check_use_module'(use_module(M,_,_),use_module(M)) :- !.
|
||||
'$check_use_module'(_,load_files) :- !.
|
||||
|
||||
'$lf'(V,_,Call,_,_,_,_,_,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,Call).
|
||||
'$lf'([],_,_,_,_,_,_,_,_,_,_) :- !.
|
||||
'$lf'(M:X, _, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult) :- !,
|
||||
'$lf'([],_,_,_,_,_,_,_,_,_,_,_) :- !.
|
||||
'$lf'(M:X, _, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule) :- !,
|
||||
(
|
||||
atom(M)
|
||||
->
|
||||
'$lf'(X, M, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult)
|
||||
'$lf'(X, M, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule)
|
||||
;
|
||||
'$do_error'(type_error(atom,M),Call)
|
||||
).
|
||||
'$lf'([F|Fs], Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult) :- !,
|
||||
'$lf'(F, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult),
|
||||
'$lf'(Fs, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult).
|
||||
'$lf'(X, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,Stream,_,Reconsult) :-
|
||||
'$lf'([F|Fs], Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule) :- !,
|
||||
'$lf'(F, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule),
|
||||
'$lf'(Fs, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,UseModule).
|
||||
'$lf'(X, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,Stream,_,Reconsult,UseModule) :-
|
||||
nonvar(Stream), !,
|
||||
'$do_lf'(X, Mod, Stream, InfLevel,CompilationMode,Imports,Reconsult).
|
||||
'$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,Reconsult).
|
||||
'$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports).
|
||||
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult) :-
|
||||
'$do_lf'(X, Mod, Stream, InfLevel,CompilationMode,Imports,Reconsult,UseModule).
|
||||
'$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult,UseModule) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,Reconsult,UseModule).
|
||||
'$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,UseModule) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,UseModule).
|
||||
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult,UseModule) :-
|
||||
'$find_in_path'(X, Y, Call),
|
||||
'$open'(Y, '$csult', Stream, 0), !,
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,Reconsult),
|
||||
'$set_changed_lfmode'(Changed),
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,Reconsult,UseModule),
|
||||
'$close'(Stream).
|
||||
'$lf'(X, _, Call, _, _, _, _, _, _, _,_) :-
|
||||
'$lf'(X, _, Call, _, _, _, _, _, _, _,_,_) :-
|
||||
'$do_error'(permission_error(input,stream,X),Call).
|
||||
|
||||
'$set_changed_lfmode'(true) :- !.
|
||||
'$set_changed_lfmode'(_).
|
||||
|
||||
'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _) :-
|
||||
'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _,_) :-
|
||||
'$file_loaded'(Stream, Mod, Imports), !.
|
||||
'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _) :-
|
||||
'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _,_) :-
|
||||
'$file_unchanged'(Stream, Mod, Imports), !.
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, _, Reconsult) :-
|
||||
'$do_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Reconsult).
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, _, Reconsult, UseModule) :-
|
||||
'$do_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Reconsult, UseModule).
|
||||
|
||||
'$close_lf'(Silent) :-
|
||||
nonvar(Silent), !,
|
||||
set_value('$lf_verbose',Silent).
|
||||
'$close_lf'(_).
|
||||
|
||||
|
||||
ensure_loaded(Fs) :-
|
||||
'$load_files'(Fs, [if(changed)],ensure_loaded(Fs)).
|
||||
|
||||
@ -154,13 +163,13 @@ reconsult(Fs) :-
|
||||
'$load_files'(Fs, [], reconsult(Fs)).
|
||||
|
||||
use_module(F) :-
|
||||
'$load_files'(F, [if(not_loaded)],use_module(F)).
|
||||
'$load_files'(F, [if(not_loaded)], use_module(F)).
|
||||
|
||||
use_module(F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)],use_module(F,Is)).
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)], use_module(F,Is)).
|
||||
|
||||
use_module(M,F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)],use_module(M,F,Is)).
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)], use_module(M,F,Is)).
|
||||
|
||||
'$csult'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,consult(V)).
|
||||
@ -168,7 +177,7 @@ use_module(M,F,Is) :-
|
||||
'$csult'([-F|L], M) :- !, '$load_files'(M:F, [],[-M:F]), '$csult'(L, M).
|
||||
'$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M).
|
||||
|
||||
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, Reconsult) :-
|
||||
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, Reconsult, UseModule) :-
|
||||
'$record_loaded'(Stream, M),
|
||||
'$current_module'(OldModule,ContextModule),
|
||||
'$getcwd'(OldD),
|
||||
@ -176,6 +185,8 @@ use_module(M,F,Is) :-
|
||||
'$set_consulting_file'(Stream),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
'$current_stream'(File,_,Stream),
|
||||
'$fetch_stream_alias'(OldStream,'$loop_stream'),
|
||||
'$change_alias_to_stream'('$loop_stream',Stream),
|
||||
get_value('$consulting',Old),
|
||||
set_value('$consulting',false),
|
||||
'$consult_infolevel'(InfLevel),
|
||||
@ -206,13 +217,18 @@ use_module(M,F,Is) :-
|
||||
set_value('$consulting_file',OldF),
|
||||
cd(OldD),
|
||||
'$current_module'(Mod,OldModule),
|
||||
'$bind_module'(Mod, UseModule),
|
||||
'$import_to_current_module'(File, ContextModule, Imports),
|
||||
( LC == 0 -> prompt(_,' |: ') ; true),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)),
|
||||
'$exec_initialisation_goals',
|
||||
'$change_alias_to_stream'('$loop_stream',OldStream),
|
||||
!.
|
||||
|
||||
'$bind_module'(_, load_files).
|
||||
'$bind_module'(Mod, use_module(Mod)).
|
||||
|
||||
'$import_to_current_module'(File, M, Imports) :-
|
||||
recorded('$module','$module'(File,NM,Ps),_), M \= NM, !,
|
||||
'$use_preds'(Imports, Ps, NM, M).
|
||||
@ -220,7 +236,7 @@ use_module(M,F,Is) :-
|
||||
|
||||
'$consult_infolevel'(InfoLevel) :- nonvar(InfoLevel), !.
|
||||
'$consult_infolevel'(InfoLevel) :-
|
||||
get_value('$lf_verbose',InfoLevel), !.
|
||||
get_value('$lf_verbose',InfoLevel), InfoLevel \= [], !.
|
||||
'$consult_infolevel'(informational).
|
||||
|
||||
'$start_reconsulting'(F) :-
|
||||
@ -309,9 +325,9 @@ prolog_load_context(module, X) :-
|
||||
prolog_load_context(source, FileName) :-
|
||||
get_value('$consulting_file',FileName).
|
||||
prolog_load_context(stream, Stream) :-
|
||||
'$fetch_stream_alias'('$loop_stream', Stream).
|
||||
'$fetch_stream_alias'(Stream,'$loop_stream').
|
||||
prolog_load_context(term_position, Position) :-
|
||||
'$fetch_stream_alias'('$loop_stream', Stream),
|
||||
'$fetch_stream_alias'(Stream,'$loop_stream').
|
||||
stream_position(Stream, Position).
|
||||
|
||||
|
||||
|
@ -565,13 +565,13 @@ call_residue(Goal,Residue) :-
|
||||
|
||||
'$call_residue'(Goal,Module,Residue) :-
|
||||
'$read_svar_list'(OldAttsList),
|
||||
'$copy_term_but_not_constraints'(Goal, NGoal),
|
||||
copy_term_nat(Goal, NGoal),
|
||||
( '$set_svar_list'(CurrentAttsList),
|
||||
'$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)),
|
||||
|
||||
'$call_residue_continuation'(NGoal,NResidue),
|
||||
( '$set_svar_list'(OldAttsList),
|
||||
'$copy_term_but_not_constraints'(NGoal+NResidue, Goal+Residue)
|
||||
copy_term_nat(NGoal+NResidue, Goal+Residue)
|
||||
;
|
||||
'$set_svar_list'(CurrentAttsList), fail
|
||||
)
|
||||
|
@ -177,6 +177,16 @@ yap_flag(syntax_errors, Option) :-
|
||||
yap_flag(enhanced,on) :- !, set_value('$enhanced',true).
|
||||
yap_flag(enhanced,off) :- set_value('$enhanced',[]).
|
||||
%
|
||||
% SWI compatibility flag
|
||||
%
|
||||
yap_flag(generate_debug_info,V) :- var(V), !,
|
||||
source_mode(OnOff,OnOff),
|
||||
(OnOff = on -> V = true ; V = false).
|
||||
yap_flag(generate_debug_info,true) :- !.
|
||||
yap_flag(generate_debug_info,false) :- !.
|
||||
yap_flag(generate_debug_info,X) :-
|
||||
'$do_error'(domain_error(flag_value,generate_domain_info+X),yap_flag(generate_debug_info,X)).
|
||||
%
|
||||
% show state of $
|
||||
%
|
||||
yap_flag(dollar_as_lower_case,V) :-
|
||||
@ -295,6 +305,15 @@ yap_flag(max_integer,X) :-
|
||||
yap_flag(max_integer,X) :-
|
||||
'$do_error'(domain_error(flag_value,max_integer+X),yap_flag(max_integer,X)).
|
||||
|
||||
yap_flag(max_tagged_integer,X) :-
|
||||
var(X), !,
|
||||
'$max_tagged_integer'(X).
|
||||
yap_flag(max_tagged_integer,X) :-
|
||||
integer(X), X > 0, !,
|
||||
'$do_error'(permission_error(modify,flag,max_tagged_integer),yap_flag(max_tagged_integer,X)).
|
||||
yap_flag(max_tagged_integer,X) :-
|
||||
'$do_error'(domain_error(flag_value,max_tagged_integer+X),yap_flag(max_tagged_integer,X)).
|
||||
|
||||
yap_flag(min_integer,X) :-
|
||||
var(X), !,
|
||||
'$access_yap_flags'(0, 1),
|
||||
@ -305,6 +324,15 @@ yap_flag(min_integer,X) :-
|
||||
yap_flag(min_integer,X) :-
|
||||
'$do_error'(domain_error(flag_value,min_integer+X),yap_flag(min_integer,X)).
|
||||
|
||||
yap_flag(min_tagged_integer,X) :-
|
||||
var(X), !,
|
||||
'$min_tagged_integer'( X).
|
||||
yap_flag(min_tagged_integer,X) :-
|
||||
integer(X), X > 0, !,
|
||||
'$do_error'(permission_error(modify,flag,min_tagged_integer),yap_flag(min_tagged_integer,X)).
|
||||
yap_flag(min_tagged_integer,X) :-
|
||||
'$do_error'(domain_error(flag_value,min_tagged_integer+X),yap_flag(min_tagged_integer,X)).
|
||||
|
||||
yap_flag(char_conversion,X) :-
|
||||
var(X), !,
|
||||
'$access_yap_flags'(5, X1),
|
||||
@ -621,6 +649,7 @@ yap_flag(verbose_auto_load,X) :-
|
||||
V = gc ;
|
||||
V = gc_margin ;
|
||||
V = gc_trace ;
|
||||
V = generate_debug_info ;
|
||||
% V = hide ;
|
||||
V = home ;
|
||||
V = host_type ;
|
||||
@ -631,7 +660,9 @@ yap_flag(verbose_auto_load,X) :-
|
||||
V = language ;
|
||||
V = max_arity ;
|
||||
V = max_integer ;
|
||||
V = max_tagged_integer ;
|
||||
V = min_integer ;
|
||||
V = min_tagged_integer ;
|
||||
V = n_of_integer_keys_in_db ;
|
||||
V = profiling ;
|
||||
V = redefine_warnings ;
|
||||
|
@ -11,8 +11,38 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2005-10-18 17:04:43 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-28 17:38:50 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.66 2005/10/18 17:04:43 vsc
|
||||
* 5.1:
|
||||
* - improvements to GC
|
||||
* 2 generations
|
||||
* generic speedups
|
||||
* - new scheme for attvars
|
||||
* - hProlog like interface also supported
|
||||
* - SWI compatibility layer
|
||||
* - extra predicates
|
||||
* - global variables
|
||||
* - moved to Prolog module
|
||||
* - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart
|
||||
* Demoen and Jan Wielemacker
|
||||
* - load_files/2
|
||||
*
|
||||
* from 5.0.1
|
||||
*
|
||||
* - WIN32 missing include files (untested)
|
||||
* - -L trouble (my thanks to Takeyuchi Shiramoto-san)!
|
||||
* - debugging of backtrable user-C preds would core dump.
|
||||
* - redeclaring a C-predicate as Prolog core dumps.
|
||||
* - badly protected YapInterface.h.
|
||||
* - break/0 was failing at exit.
|
||||
* - YAP_cut_fail and YAP_cut_succeed were different from manual.
|
||||
* - tracing through data-bases could core dump.
|
||||
* - cut could break on very large computations.
|
||||
* - first pass at BigNum issues (reported by Roberto).
|
||||
* - debugger could get go awol after fail port.
|
||||
* - weird message on wrong debugger option.
|
||||
*
|
||||
* Revision 1.65 2005/05/25 21:43:33 vsc
|
||||
* fix compiler bug in 1 << X, found by Nuno Fonseca.
|
||||
* compiler internal errors get their own message.
|
||||
@ -236,7 +266,7 @@ print_message(Level, Mss) :-
|
||||
'$do_print_message'(declaration(Args,Action)) :- !,
|
||||
format(user_error,'declaration ~w ~w.', [Args,Action]).
|
||||
'$do_print_message'(defined_elsewhere(P,F)) :- !,
|
||||
format(user_error, 'predicate ~q, at line ~d, previously defined in file ~a.',[P,LN,F]).
|
||||
format(user_error, 'predicate ~q previously defined in file ~a.',[P,F]).
|
||||
'$do_print_message'(import(Pred,To,From,private)) :- !,
|
||||
format(user_error,'Importing private predicate ~w:~w to ~w.',
|
||||
[From,Pred,To]).
|
||||
|
@ -92,7 +92,7 @@ module(N) :-
|
||||
'$process_exports'([Name/Arity|Exports],Mod,[Name/Arity|ExportedPreds]):- !,
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([op(Prio,Assoc,Name)|Exports],Mod,ExportedPreds) :- !,
|
||||
'$opdec'(Prio,Assoc,Name,Mod),
|
||||
% '$opdec'(Prio,Assoc,Name,Mod),
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([Trash|Exports],Mod,_) :-
|
||||
'$do_error'(type_error(predicate_indicator,Trash),module(Mod,[Trash])).
|
||||
@ -134,7 +134,8 @@ module(N) :-
|
||||
'$do_error'(domain_error(predicate_spec,PS),import([PS|L])).
|
||||
|
||||
'$check_import'(M,T,N,K) :-
|
||||
recorded('$import','$import'(M1,T,N,K),R), M1 \= M, /* ZP */ !,
|
||||
recorded('$import','$import'(MI,T,N,K),_),
|
||||
\+ '$module_produced by'(M,T,N,K), !,
|
||||
format(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[M1:N/K,T]),
|
||||
format(user_error," Do you want to import it from ~w ? [y or n] ",M),
|
||||
repeat,
|
||||
@ -145,6 +146,12 @@ module(N) :-
|
||||
).
|
||||
'$check_import'(_,_,_,_).
|
||||
|
||||
'$module_produced by'(M,M0,N,K) :-
|
||||
recorded('$import','$import'(M,M0,N,K),_), !.
|
||||
'$module_produced by'(M,M0,N,K) :-
|
||||
recorded('$import','$import'(MI,M0,N,K),_),
|
||||
'$module_produced by'(M,MI,N,K).
|
||||
|
||||
% $use_preds(Imports,Publics,Mod,M)
|
||||
'$use_preds'(Imports,Publics,Mod,M) :- var(Imports), !,
|
||||
'$import'(Publics,Mod,M).
|
||||
@ -461,6 +468,8 @@ source_module(Mod) :-
|
||||
call_with_args(:,?,?,?,?,?,?,?),
|
||||
call_with_args(:,?,?,?,?,?,?,?,?),
|
||||
call_with_args(:,?,?,?,?,?,?,?,?,?),
|
||||
format(+,:),
|
||||
format(+,+,:),
|
||||
call_residue(:,?),
|
||||
catch(:,+,:),
|
||||
clause(:,?),
|
||||
|
29
pl/utils.yap
29
pl/utils.yap
@ -24,10 +24,17 @@ if(X,Y,_Z) :-
|
||||
'$execute'(Y).
|
||||
if(_X,_Y,Z) :-
|
||||
'$execute'(Z).
|
||||
|
||||
|
||||
call(X,A) :- '$execute'(X,A).
|
||||
|
||||
call(X,A1,A2) :- '$execute'(X,A1,A2).
|
||||
|
||||
call(X,A1,A2,A3) :- '$execute'(X,A1,A2,A3).
|
||||
|
||||
call_with_args(M:V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V)).
|
||||
call_with_args(_:M:A) :- !,
|
||||
call_with_args(M:A).
|
||||
call_with_args(M:A) :- !,
|
||||
'$call_with_args'(A,M).
|
||||
call_with_args(A) :- atom(A), !,
|
||||
@ -39,6 +46,8 @@ call_with_args(A) :-
|
||||
|
||||
call_with_args(M:V,A1) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1)).
|
||||
call_with_args(_:M:A,A1) :- !,
|
||||
call_with_args(M:A,A1).
|
||||
call_with_args(M:A,A1) :- !,
|
||||
'$call_with_args'(A,A1,M).
|
||||
call_with_args(A,A1) :- atom(A), !,
|
||||
@ -49,6 +58,8 @@ call_with_args(A,A1) :-
|
||||
|
||||
call_with_args(M:V,A1,A2) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2)).
|
||||
call_with_args(_:M:A,A1,A2) :- !,
|
||||
call_with_args(M:A,A1,A2).
|
||||
call_with_args(M:A,A1,A2) :- !,
|
||||
'$call_with_args'(A,A1,A2,M).
|
||||
call_with_args(A,A1,A2) :- atom(A), !,
|
||||
@ -59,6 +70,8 @@ call_with_args(A,A1,A2) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3)).
|
||||
call_with_args(_:M:A,A1,A2,A3) :- !,
|
||||
call_with_args(M:A,A1,A2,A3).
|
||||
call_with_args(M:A,A1,A2,A3) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,M).
|
||||
call_with_args(A,A1,A2,A3) :- atom(A), !,
|
||||
@ -69,6 +82,8 @@ call_with_args(A,A1,A2,A3) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4).
|
||||
call_with_args(M:A,A1,A2,A3,A4) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,A4,M).
|
||||
call_with_args(A,A1,A2,A3,A4) :- atom(A), !,
|
||||
@ -79,6 +94,8 @@ call_with_args(A,A1,A2,A3,A4) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4,A5) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4,A5) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5).
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,A4,A5,M).
|
||||
call_with_args(A,A1,A2,A3,A4,A5) :- atom(A), !,
|
||||
@ -89,6 +106,8 @@ call_with_args(A,A1,A2,A3,A4,A5) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4,A5,A6) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4,A5,A6) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6).
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,M).
|
||||
call_with_args(A,A1,A2,A3,A4,A5,A6) :- atom(A), !,
|
||||
@ -99,6 +118,8 @@ call_with_args(A,A1,A2,A3,A4,A5,A6) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4,A5,A6,A7) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7).
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,M).
|
||||
call_with_args(A,A1,A2,A3,A4,A5,A6,A7) :- atom(A), !,
|
||||
@ -109,6 +130,8 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4,A5,A6,A7,A8) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8).
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,M).
|
||||
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8) :- atom(A), !,
|
||||
@ -119,6 +142,8 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9).
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- !,
|
||||
'$current_module'(M),
|
||||
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M).
|
||||
@ -131,6 +156,8 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :-
|
||||
|
||||
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- var(V), !,
|
||||
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)).
|
||||
call_with_args(_:M:A,A1,A2,A3,A4,A5,A6,A7,A8,A10) :- !,
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A10).
|
||||
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- !,
|
||||
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,M).
|
||||
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- atom(A), !,
|
||||
|
54
pl/yio.yap
54
pl/yio.yap
@ -923,4 +923,58 @@ current_char_conversion(X,Y) :-
|
||||
current_stream(File, Opts, Stream) :-
|
||||
'$current_stream'(File, Opts, Stream).
|
||||
|
||||
'$extend_file_search_path'(P) :-
|
||||
atom_codes(P,S),
|
||||
'$env_separator'(ES),
|
||||
'$split_for_path'(S,0'=,ES,Paths),
|
||||
'$add_file_search_paths'(Paths).
|
||||
|
||||
'$split_for_path'([], _, _, []).
|
||||
'$split_for_path'(S, S1, S2, [A1=A2|R]) :-
|
||||
'$fetch_first_path'(S, S1, A1, SR1),
|
||||
'$fetch_second_path'(SR1, S2, A2, SR),
|
||||
'$split_for_path'(SR, S1, S2, R) .
|
||||
|
||||
'$fetch_first_path'([S1|SR],S1,[],SR) :- !.
|
||||
'$fetch_first_path'([C|S],S1,[C|F],SR) :-
|
||||
'$fetch_first_path'(S,S1,F,SR).
|
||||
|
||||
'$fetch_second_path'([],_,[],[]).
|
||||
'$fetch_second_path'([S1|SR],S1,[],SR) :- !.
|
||||
'$fetch_second_path'([C|S],S1,[C|A2],SR) :-
|
||||
'$fetch_second_path'(S,S1,A2,SR).
|
||||
|
||||
'$add_file_search_paths'([]).
|
||||
'$add_file_search_paths'([NS=DS|Paths]) :-
|
||||
atom_codes(N,NS),
|
||||
atom_codes(D,DS),
|
||||
assert(user:file_search_path(N,D)),
|
||||
'$add_file_search_paths'(Paths).
|
||||
|
||||
|
||||
'$format@'(Goal,Out) :-
|
||||
'$with_output_to_chars'(Goal, _, [], Out).
|
||||
|
||||
'$with_output_to_chars'(Goal, Stream, L0, Chars) :-
|
||||
charsio:open_mem_write_stream(Stream),
|
||||
current_output(SO),
|
||||
set_output(Stream),
|
||||
'$do_output_to_chars'(Goal, Stream, L0, Chars, SO).
|
||||
|
||||
'$do_output_to_chars'(Goal, Stream, L0, Chars, SO) :-
|
||||
catch(Goal, Exception, '$handle_exception'(Exception,Stream,SO)),
|
||||
!,
|
||||
set_output(SO),
|
||||
charsio:peek_mem_write_stream(Stream, L0, Chars).
|
||||
'$do_output_to_chars'(_Goal, Stream, _L0, _Chars, SO) :-
|
||||
set_output(SO),
|
||||
close(Stream),
|
||||
fail.
|
||||
|
||||
'$handle_exception'(Exception, Stream, SO) :-
|
||||
close(Stream),
|
||||
current_output(SO),
|
||||
throw(Exception).
|
||||
|
||||
|
||||
|
||||
|
Reference in New Issue
Block a user