diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

sveral updates 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1415 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-10-28 17:38:50 +00:00
parent 16970726b8
commit 1fa46c6051
41 changed files with 1241 additions and 356 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

245
C/absmi.c
View File

@ -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);

1
C/adtdefs.c
View File

@ -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
View File

@ -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
View File

@ -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);

8
C/attvar.c
View File

@ -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);

9
C/c_interface.c
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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);
}

8
C/tracer.c
View File

@ -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

2
C/utilpreds.c
View File

@ -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
View File

@ -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

3
H/Yapproto.h
View File

@ -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));

5
H/Yatom.h
View File

@ -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
View File

@ -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
View File

@ -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 {

9
H/sshift.h
View File

@ -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
*);

7
Makefile.in
View File

@ -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
View File

@ -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" ;;

7
configure.in
View File

@ -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

2
include/yap_structs.h
View File

@ -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. */

2
library/Makefile.in
View File

@ -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 \

12
library/ordsets.yap
View File

@ -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).

4
library/prandom.yap
View File

@ -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

59
library/swi.yap
View File

@ -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
library/ypp.yap
View File

@ -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
View File

@ -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
pl/checker.yap
View File

@ -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) :-

74
pl/consult.yap
View File

@ -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).

4
pl/corout.yap
View File

@ -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
)

31
pl/directives.yap
View File

@ -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 ;

34
pl/errors.yap
View File

@ -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]).

13
pl/modules.yap
View File

@ -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
View File

@ -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
View File

@ -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).