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

sveral updates

Browse Source 
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
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);