diff --git a/C/absmi.c b/C/absmi.c index 2c2050e73..169f6721a 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -784,8 +784,8 @@ Yap_absmi(int inp) op_switch: #ifdef ANALYST - Yap_opcount[opcode]++; - Yap_2opcount[old_op][opcode]++; + GLOBAL_opcount[opcode]++; + GLOBAL_2opcount[old_op][opcode]++; #ifdef DEBUG_XX ops_done++; /* if (B->cp_b > 0x103fff90) @@ -806,7 +806,7 @@ Yap_absmi(int inp) saveregs(); /* do a garbage collection first to check if we can recover memory */ if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -1556,24 +1556,24 @@ Yap_absmi(int inp) SET_ASP(YREG, E_CB*sizeof(CELL)); saveregs(); while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { UNLOCKPE(3,PP); #if defined(YAPOR) || defined(THREADS) PP = NULL; #endif - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); FAIL(); } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_gc(3, ENV, CP)) { UNLOCKPE(4,PP); #if defined(YAPOR) || defined(THREADS) PP = NULL; #endif - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); FAIL(); } } @@ -1606,7 +1606,7 @@ Yap_absmi(int inp) if (!(cl->ClFlags & InUseMask)) { /* Clause *cl = (Clause *)PREG->u.EC.ClBase; - PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase; + PREG->u.EC.ClTrail = TR-(tr_fr_ptr)LOCAL_TrailBase; PREG->u.EC.ClENV = LCL0-YREG;*/ cl->ClFlags |= InUseMask; TRAIL_CLREF(cl); @@ -1658,7 +1658,7 @@ Yap_absmi(int inp) if (!(cl->ClFlags & InUseMask)) { /* Clause *cl = (Clause *)PREG->u.EC.ClBase; - PREG->u.EC.ClTrail = TR-(tr_fr_ptr)Yap_TrailBase; + PREG->u.EC.ClTrail = TR-(tr_fr_ptr)LOCAL_TrailBase; PREG->u.EC.ClENV = LCL0-YREG;*/ cl->ClFlags |= InUseMask; TRAIL_CLREF(cl); @@ -1693,7 +1693,7 @@ Yap_absmi(int inp) SET_ASP(YREG, PREG->u.Osbpi.s); saveregs(); if (!Yap_gcl(sz, arity, YENV, PREG)) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); FAIL(); } else { @@ -2021,7 +2021,7 @@ Yap_absmi(int inp) #endif /* LOW_LEVEL_TRACER */ #ifdef FROZEN_STACKS #ifdef YAPOR_SBA - if (pt0 < TR_FZ || pt0 > (tr_fr_ptr)Yap_TrailTop) + if (pt0 < TR_FZ || pt0 > (tr_fr_ptr)LOCAL_TrailTop) #else if (pt0 < TR_FZ) #endif /* YAPOR_SBA */ @@ -2057,7 +2057,7 @@ Yap_absmi(int inp) register CELL flags; CELL *pt1 = RepPair(d1); #ifdef LIMIT_TABLING - if ((ADDR) pt1 == Yap_TrailBase) { + if ((ADDR) pt1 == LOCAL_TrailBase) { sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt0); TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1)); SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */ @@ -2071,7 +2071,7 @@ Yap_absmi(int inp) #ifdef YAPOR_SBA (ADDR) pt1 >= HeapTop #else - IN_BETWEEN(Yap_TrailBase, pt1, Yap_TrailTop) + IN_BETWEEN(LOCAL_TrailBase, pt1, LOCAL_TrailTop) #endif /* YAPOR_SBA */ ) { @@ -2609,7 +2609,7 @@ Yap_absmi(int inp) SET_ASP(YREG, PREG->u.Osbpp.s); saveregs(); if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, YREG, NEXTOP(PREG, Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs(); @@ -2663,7 +2663,7 @@ Yap_absmi(int inp) } saveregs(); if (!Yap_gc(0, ENV, CPREG)) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs(); SREG = ASP; @@ -2842,7 +2842,7 @@ Yap_absmi(int inp) ASP = (CELL *)PROTECT_FROZEN_B(B); saveregs(); if (!Yap_gc(0, YREG, NEXTOP(PREG, Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs(); JMPNext(); @@ -2967,7 +2967,7 @@ Yap_absmi(int inp) ASP = (CELL *)PROTECT_FROZEN_B(B); saveregs(); if (!Yap_gc(((PredEntry *)(SREG))->ArityOfPE, (CELL *)YREG[E_E], (yamop *)YREG[E_CP])) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs(); /* hopefully, gc will succeeded, and we will retry @@ -2989,7 +2989,7 @@ Yap_absmi(int inp) ASP = (CELL *)PROTECT_FROZEN_B(B); saveregs(); if (!Yap_gc(((PredEntry *)(SREG))->ArityOfPE, ENV, CPREG)) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs(); /* hopefully, gc will succeeded, and we will retry @@ -3037,12 +3037,12 @@ Yap_absmi(int inp) /* I need this for Windows and other systems where SIGINT is not proceesed by same thread as absmi */ LOCK(LOCAL_SignalLock); - if (Yap_PrologMode & (AbortMode|InterruptMode)) { + if (LOCAL_PrologMode & (AbortMode|InterruptMode)) { CreepFlag = CalculateStackGap(); UNLOCK(LOCAL_SignalLock); /* same instruction */ - if (Yap_PrologMode & InterruptMode) { - Yap_PrologMode &= ~InterruptMode; + if (LOCAL_PrologMode & InterruptMode) { + LOCAL_PrologMode &= ~InterruptMode; SET_ASP(YREG, E_CB*sizeof(CELL)); saveregs(); Yap_ProcessSIGINT(); @@ -7102,7 +7102,7 @@ Yap_absmi(int inp) yamop *savedP; Yap_StartSlots( PASS_REGS1 ); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; { PredEntry *p = PREG->u.Osbpp.p; @@ -7115,7 +7115,7 @@ Yap_absmi(int inp) } Yap_CloseSlots( PASS_REGS1 ); setregs(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; restore_machine_regs(); PREG = savedP; } @@ -7283,7 +7283,7 @@ Yap_absmi(int inp) #endif SET_BB(B_YREG); ENDCACHE_Y(); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; ASP = YREG; /* for slots to work */ Yap_StartSlots( PASS_REGS1 ); @@ -7293,7 +7293,7 @@ Yap_absmi(int inp) EX = 0L; restore_machine_regs(); setregs(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; Yap_CloseSlots( PASS_REGS1 ); if (!SREG) { FAIL(); @@ -7326,7 +7326,7 @@ Yap_absmi(int inp) restore_args(PREG->u.OtapFs.s); ENDCACHE_Y(); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; SET_ASP(YREG, E_CB*sizeof(CELL)); /* for slots to work */ Yap_StartSlots( PASS_REGS1 ); @@ -7336,7 +7336,7 @@ Yap_absmi(int inp) EX = 0L; restore_machine_regs(); setregs(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; Yap_CloseSlots( PASS_REGS1 ); if (!SREG) { #ifdef CUT_C @@ -9164,7 +9164,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9209,7 +9209,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9250,7 +9250,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9302,7 +9302,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9350,7 +9350,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9395,7 +9395,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9436,7 +9436,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9488,7 +9488,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9536,7 +9536,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9581,7 +9581,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9622,7 +9622,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9674,7 +9674,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9729,7 +9729,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9774,7 +9774,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9817,7 +9817,7 @@ Yap_absmi(int inp) d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0)); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9865,7 +9865,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9917,7 +9917,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -9968,7 +9968,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10017,7 +10017,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10062,7 +10062,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10103,7 +10103,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10155,7 +10155,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10204,7 +10204,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10248,7 +10248,7 @@ Yap_absmi(int inp) d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1)); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10289,7 +10289,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10341,7 +10341,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10394,7 +10394,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10440,7 +10440,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10481,7 +10481,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10525,7 +10525,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10578,7 +10578,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10627,7 +10627,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10678,7 +10678,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10722,7 +10722,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10765,7 +10765,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10810,7 +10810,7 @@ Yap_absmi(int inp) BEGP(pt0); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10860,7 +10860,7 @@ Yap_absmi(int inp) setregs(); if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -10909,7 +10909,7 @@ Yap_absmi(int inp) } if (d0 == 0L) { saveregs(); - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); setregs(); FAIL(); } @@ -12007,7 +12007,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxx),Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -12124,7 +12124,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxc),Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -12234,7 +12234,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxn),Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -12345,7 +12345,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxx),Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -12484,7 +12484,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -12628,7 +12628,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -13008,7 +13008,7 @@ Yap_absmi(int inp) /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 3, YREG, NEXTOP(NEXTOP(PREG,e),Osbmp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); setregs(); JMPNext(); } else { @@ -13253,7 +13253,7 @@ Yap_absmi(int inp) } saveregs_and_ycache(); if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs_and_ycache(); goto execute2_end; @@ -13458,7 +13458,7 @@ Yap_absmi(int inp) } saveregs_and_ycache(); if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, Osbmp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs_and_ycache(); goto execute_end; @@ -13688,7 +13688,7 @@ Yap_absmi(int inp) UNLOCK(LOCAL_SignalLock); saveregs_and_ycache(); if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); setregs_and_ycache(); FAIL(); } @@ -13732,7 +13732,7 @@ Yap_absmi(int inp) UNLOCK(LOCAL_SignalLock); saveregs_and_ycache(); if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, Osbpp))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); } setregs_and_ycache(); goto execute_after_comma; diff --git a/C/agc.c b/C/agc.c index 763d1bf5b..a8fe53696 100755 --- a/C/agc.c +++ b/C/agc.c @@ -18,7 +18,6 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90"; #endif - #include "absmi.h" #include "Foreign.h" #include "alloc.h" @@ -30,20 +29,12 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90"; /* #define DEBUG_RESTORE1 1 */ /* #define DEBUG_RESTORE2 1 */ /* #define DEBUG_RESTORE3 1 */ -#define errout Yap_stderr +#define errout GLOBAL_stderr #endif STATIC_PROTO(void RestoreEntries, (PropEntry *, int USES_REGS)); STATIC_PROTO(void CleanCode, (PredEntry * USES_REGS)); -static int agc_calls; - -static YAP_ULONG_LONG agc_collected; - -static Int tot_agc_time = 0; /* total time spent in GC */ - -static Int tot_agc_recovered = 0; /* number of heap objects in all garbage collections */ - #define AtomMarkedBit 1 static inline void @@ -228,11 +219,11 @@ static void init_reg_copies(USES_REGS1) LOCAL_OldASP = ASP; LOCAL_OldLCL0 = LCL0; LOCAL_OldTR = TR; - LOCAL_OldGlobalBase = (CELL *)Yap_GlobalBase; + LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldH = H; LOCAL_OldH0 = H0; - LOCAL_OldTrailBase = Yap_TrailBase; - LOCAL_OldTrailTop = Yap_TrailTop; + LOCAL_OldTrailBase = LOCAL_TrailBase; + LOCAL_OldTrailTop = LOCAL_TrailTop; LOCAL_OldHeapBase = Yap_HeapBase; LOCAL_OldHeapTop = HeapTop; } @@ -262,7 +253,7 @@ mark_trail(USES_REGS1) pt = TR; /* moving the trail is simple */ - while (pt != (tr_fr_ptr)Yap_TrailBase) { + while (pt != (tr_fr_ptr)LOCAL_TrailBase) { CELL reg = TrailTerm(pt-1); if (!IsVarTerm(reg)) { @@ -393,12 +384,12 @@ clean_atom_list(AtomHashEntry *HashPtr) #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%S\n", at, at->WStrOfAE); #endif - agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); + GLOBAL_agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); } else { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE); #endif - agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); + GLOBAL_agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); } *patm = atm = at->NextOfAE; Yap_FreeCodeSpace((char *)at); @@ -448,13 +439,13 @@ atom_gc(USES_REGS1) if (Yap_GetValue(AtomGcTrace) != TermNil) gc_trace = 1; - agc_calls++; - agc_collected = 0; + GLOBAL_agc_calls++; + GLOBAL_agc_collected = 0; if (gc_trace) { - fprintf(Yap_stderr, "%% agc:\n"); + fprintf(GLOBAL_stderr, "%% agc:\n"); } else if (gc_verbose) { - fprintf(Yap_stderr, "%% Start of atom garbage collection %d:\n", agc_calls); + fprintf(GLOBAL_stderr, "%% Start of atom garbage collection %d:\n", GLOBAL_agc_calls); } time_start = Yap_cputime(); /* get the number of active registers */ @@ -465,15 +456,15 @@ atom_gc(USES_REGS1) clean_atoms(); YAPLeaveCriticalSection(); agc_time = Yap_cputime()-time_start; - tot_agc_time += agc_time; - tot_agc_recovered += agc_collected; + GLOBAL_tot_agc_time += agc_time; + GLOBAL_tot_agc_recovered += GLOBAL_agc_collected; if (gc_verbose) { #ifdef _WIN32 - fprintf(Yap_stderr, "%% Collected %I64d bytes.\n", agc_collected); + fprintf(GLOBAL_stderr, "%% Collected %I64d bytes.\n", GLOBAL_agc_collected); #else - fprintf(Yap_stderr, "%% Collected %lld bytes.\n", agc_collected); + fprintf(GLOBAL_stderr, "%% Collected %lld bytes.\n", GLOBAL_agc_collected); #endif - fprintf(Yap_stderr, "%% GC %d took %g sec, total of %g sec doing GC so far.\n", agc_calls, (double)agc_time/1000, (double)tot_agc_time/1000); + fprintf(GLOBAL_stderr, "%% GC %d took %g sec, total of %g sec doing GC so far.\n", GLOBAL_agc_calls, (double)agc_time/1000, (double)GLOBAL_tot_agc_time/1000); } } @@ -495,9 +486,9 @@ p_atom_gc(USES_REGS1) static Int p_inform_agc(USES_REGS1) { - Term tn = MkIntegerTerm(tot_agc_time); - Term tt = MkIntegerTerm(agc_calls); - Term ts = MkIntegerTerm(tot_agc_recovered); + Term tn = MkIntegerTerm(GLOBAL_tot_agc_time); + Term tt = MkIntegerTerm(GLOBAL_agc_calls); + Term ts = MkIntegerTerm(GLOBAL_tot_agc_recovered); return Yap_unify(tn, ARG2) && diff --git a/C/alloc.c b/C/alloc.c index 0ef851b1e..0f636d142 100755 --- a/C/alloc.c +++ b/C/alloc.c @@ -128,6 +128,7 @@ long long unsigned int tmalloc; static inline char * call_malloc(unsigned long int size) { + CACHE_REGS char *out; #if USE_DL_MALLOC LOCK(DLMallocLock); @@ -137,13 +138,13 @@ call_malloc(unsigned long int size) tmalloc += size; size += sizeof(CELL); #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; out = (char *) my_malloc(size); #if INSTRUMENT_MALLOC *(CELL*)out = size-sizeof(CELL); out += sizeof(CELL); #endif - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif @@ -160,6 +161,7 @@ Yap_AllocCodeSpace(unsigned long int size) static inline char * call_realloc(char *p, unsigned long int size) { + CACHE_REGS char *out; #if USE_DL_MALLOC LOCK(DLMallocLock); @@ -171,13 +173,13 @@ call_realloc(char *p, unsigned long int size) p -= sizeof(CELL); tmalloc -= *(CELL*)p; #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; out = (char *) my_realloc0(p, size); #if INSTRUMENT_MALLOC *(CELL*)out = size-sizeof(CELL); out += sizeof(CELL); #endif - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif @@ -194,17 +196,18 @@ Yap_ReallocCodeSpace(char *p, unsigned long int size) void Yap_FreeCodeSpace(char *p) { + CACHE_REGS #if USE_DL_MALLOC LOCK(DLMallocLock); #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; #if INSTRUMENT_MALLOC p -= sizeof(CELL); tmalloc -= *(CELL*)p; frees++; #endif my_free (p); - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif @@ -220,17 +223,18 @@ Yap_AllocAtomSpace(unsigned long int size) void Yap_FreeAtomSpace(char *p) { + CACHE_REGS #if USE_DL_MALLOC LOCK(DLMallocLock); #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; #if INSTRUMENT_MALLOC p -= sizeof(CELL); tmalloc -= *(CELL*)p; frees++; #endif my_free (p); - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif @@ -250,19 +254,19 @@ Yap_InitPreAllocCodeSpace(void) #if USE_DL_MALLOC LOCK(DLMallocLock); #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; #if INSTRUMENT_MALLOC mallocs++; tmalloc += sz; sz += sizeof(CELL); #endif while (!(ptr = my_malloc(sz))) { - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return(NULL); } #if INSTRUMENT_MALLOC @@ -273,9 +277,9 @@ Yap_InitPreAllocCodeSpace(void) #if USE_DL_MALLOC LOCK(DLMallocLock); #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; } - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif @@ -305,20 +309,20 @@ Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip, int safe) #if USE_DL_MALLOC LOCK(DLMallocLock); #endif - Yap_PrologMode |= MallocMode; + LOCAL_PrologMode |= MallocMode; #if INSTRUMENT_MALLOC reallocs++; tmalloc -= LOCAL_ScratchPad.sz; tmalloc += sz; #endif if (!(ptr = my_realloc(LOCAL_ScratchPad.ptr, sz, LOCAL_ScratchPad.sz, safe))) { - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif return NULL; } - Yap_PrologMode &= ~MallocMode; + LOCAL_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); #endif @@ -364,22 +368,22 @@ InitExStacks(int Trail, int Stack) #ifdef THREADS if (worker_id) - Yap_GlobalBase = (ADDR)LOCAL_ThreadHandle.stack_address; + LOCAL_GlobalBase = (ADDR)LOCAL_ThreadHandle.stack_address; #endif - Yap_TrailTop = Yap_GlobalBase + pm; - Yap_LocalBase = Yap_GlobalBase + sa; - Yap_TrailBase = Yap_LocalBase + sizeof(CELL); + LOCAL_TrailTop = LOCAL_GlobalBase + pm; + LOCAL_LocalBase = LOCAL_GlobalBase + sa; + LOCAL_TrailBase = LOCAL_LocalBase + sizeof(CELL); LOCAL_ScratchPad.ptr = NULL; LOCAL_ScratchPad.sz = LOCAL_ScratchPad.msz = SCRATCH_START_SIZE; AuxSp = NULL; #ifdef DEBUG - if (Yap_output_msg) { + if (GLOBAL_output_msg) { UInt ta; fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n", - Yap_HeapBase, Yap_GlobalBase, Yap_LocalBase, Yap_TrailTop); + Yap_HeapBase, LOCAL_GlobalBase, LOCAL_LocalBase, LOCAL_TrailTop); ta = Trail*K; /* trail area size */ fprintf(stderr, "Heap+Aux: %lu\tLocal+Global: %lu\tTrail: %lu\n", @@ -408,9 +412,9 @@ Yap_KillStacks(int wid) void Yap_KillStacks(void) { - if (Yap_GlobalBase) { - free(Yap_GlobalBase); - Yap_GlobalBase = NULL; + if (LOCAL_GlobalBase) { + free(LOCAL_GlobalBase); + LOCAL_GlobalBase = NULL; } } #endif @@ -425,15 +429,15 @@ int Yap_ExtendWorkSpace(Int s) { CACHE_REGS - void *basebp = (void *)Yap_GlobalBase, *nbp; - UInt s0 = (char *)Yap_TrailTop-(char *)Yap_GlobalBase; + void *basebp = (void *)LOCAL_GlobalBase, *nbp; + UInt s0 = (char *)LOCAL_TrailTop-(char *)LOCAL_GlobalBase; nbp = realloc(basebp, s+s0); if (nbp == NULL) return FALSE; #if defined(THREADS) LOCAL_ThreadHandle.stack_address = (char *)nbp; #endif - Yap_GlobalBase = (char *)nbp; + LOCAL_GlobalBase = (char *)nbp; return TRUE; } @@ -682,7 +686,7 @@ AllocHeap(unsigned long int size) HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE); #ifdef YAPOR - if (HeapTop > Addr(Yap_GlobalBase) - MinHeapGap) + if (HeapTop > Addr(LOCAL_GlobalBase) - MinHeapGap) Yap_Error(INTERNAL_ERROR, TermNil, "no heap left (AllocHeap)"); #else if (HeapTop > HeapLim - MinHeapGap) { @@ -818,9 +822,9 @@ static int ExtendWorkSpace(Int s, int fixed_allocation) { LPVOID b = brk; - prolog_exec_mode OldPrologMode = Yap_PrologMode; + prolog_exec_mode OldPrologMode = LOCAL_PrologMode; - Yap_PrologMode = ExtendStackMode; + LOCAL_PrologMode = ExtendStackMode; #if DEBUG_WIN32_ALLOC fprintf(stderr,"trying: %p (" Int_FORMAT "K) %d\n",b, s/1024, fixed_allocation); @@ -834,7 +838,7 @@ ExtendWorkSpace(Int s, int fixed_allocation) } } if (!b) { - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; #if DEBUG_WIN32_ALLOC { char msg[256]; @@ -849,11 +853,11 @@ ExtendWorkSpace(Int s, int fixed_allocation) } b = VirtualAlloc(b, s, MEM_COMMIT, PAGE_READWRITE); if (!b) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "VirtualAlloc could not commit %ld bytes", (long int)s); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; #if DEBUG_WIN32_ALLOC fprintf(stderr,"NOT OK2: %p--%p\n",b,brk); #endif @@ -863,7 +867,7 @@ ExtendWorkSpace(Int s, int fixed_allocation) #if DEBUG_WIN32_ALLOC fprintf(stderr,"OK: %p--%p " Int_FORMAT "\n",b, brk, s); #endif - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return TRUE; } @@ -1021,6 +1025,8 @@ InitWorkSpace(Int s) return (void *) a; } + +#ifndef YAPOR static MALLOC_T mmap_extension(Int s, MALLOC_T base, int fixed_allocation) { @@ -1043,13 +1049,13 @@ mmap_extension(Int s, MALLOC_T base, int fixed_allocation) char file[256]; strncpy(file,"/tmp/YAP.TMPXXXXXX",256); if (mkstemp(file) == -1) { - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_ErrorMessage = LOCAL_ErrorSay; #if HAVE_STRERROR - snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + snprintf5(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mkstemp could not create temporary file %s (%s)", file, strerror(errno)); #else - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mkstemp could not create temporary file %s", file); #endif /* HAVE_STRERROR */ return (MALLOC_T)-1; @@ -1065,28 +1071,28 @@ mmap_extension(Int s, MALLOC_T base, int fixed_allocation) #endif /* HAVE_MKSTEMP */ fd = open(file, O_CREAT|O_RDWR, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH); if (fd < 0) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not open %s", file); return (MALLOC_T)-1; } if (lseek(fd, s, SEEK_SET) < 0) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not lseek in mmapped file %s", file); close(fd); return (MALLOC_T)-1; } if (write(fd, "", 1) < 0) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not write in mmapped file %s", file); close(fd); return (MALLOC_T)-1; } if (unlink(file) < 0) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not unlink mmapped file %s", file); close(fd); return (MALLOC_T)-1; @@ -1100,12 +1106,12 @@ mmap_extension(Int s, MALLOC_T base, int fixed_allocation) #endif , fd, 0); if (close(fd) == -1) { - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_ErrorMessage = LOCAL_ErrorSay; #if HAVE_STRERROR - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not close file (%s) ]\n", strerror(errno)); #else - snprintf3(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + snprintf3(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not close file ]\n"); #endif return (MALLOC_T)-1; @@ -1113,6 +1119,8 @@ mmap_extension(Int s, MALLOC_T base, int fixed_allocation) #endif return a; } +#endif /* !YAPOR */ + static int ExtendWorkSpace(Int s, int fixed_allocation) @@ -1122,23 +1130,23 @@ ExtendWorkSpace(Int s, int fixed_allocation) return(FALSE); #else MALLOC_T a; - prolog_exec_mode OldPrologMode = Yap_PrologMode; + prolog_exec_mode OldPrologMode = LOCAL_PrologMode; MALLOC_T base = WorkSpaceTop; if (fixed_allocation == MAP_FIXED) base = WorkSpaceTop; else base = 0L; - Yap_PrologMode = ExtendStackMode; + LOCAL_PrologMode = ExtendStackMode; a = mmap_extension(s, base, fixed_allocation); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; if (a == (MALLOC_T) - 1) { - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_ErrorMessage = LOCAL_ErrorSay; #if HAVE_STRERROR - snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + snprintf5(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not allocate %d bytes (%s)", (int)s, strerror(errno)); #else - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not allocate %d bytes", (int)s); #endif return FALSE; @@ -1146,10 +1154,10 @@ ExtendWorkSpace(Int s, int fixed_allocation) if (fixed_allocation) { if (a != WorkSpaceTop) { munmap((void *)a, (size_t)s); - Yap_ErrorMessage = Yap_ErrorSay; - snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf5(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "mmap could not grow memory at %p, got %p", WorkSpaceTop, a ); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return FALSE; } } else if (a < WorkSpaceTop) { @@ -1160,7 +1168,7 @@ ExtendWorkSpace(Int s, int fixed_allocation) return res; } WorkSpaceTop = (char *) a + s; - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return TRUE; #endif /* YAPOR */ } @@ -1211,33 +1219,33 @@ ExtendWorkSpace(Int s) { MALLOC_T ptr; int shm_id; - prolog_exec_mode OldPrologMode = Yap_PrologMode; + prolog_exec_mode OldPrologMode = LOCAL_PrologMode; - Yap_PrologMode = ExtendStackMode; + LOCAL_PrologMode = ExtendStackMode; /* mapping heap area */ if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not shmget %d bytes", s); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return(FALSE); } if((ptr = (MALLOC_T)shmat(shm_id, WorkSpaceTop, 0)) == (MALLOC_T) -1) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not shmat at %p", MMAP_ADDR); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return(FALSE); } if (shmctl(shm_id, IPC_RMID, 0) != 0) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not remove shm segment", shm_id); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return(FALSE); } WorkSpaceTop = (char *) ptr + s; - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return(TRUE); } @@ -1286,17 +1294,17 @@ static int ExtendWorkSpace(Int s) { MALLOC_T ptr = (MALLOC_T)sbrk(s); - prolog_exec_mode OldPrologMode = Yap_PrologMode; + prolog_exec_mode OldPrologMode = LOCAL_PrologMode; - Yap_PrologMode = ExtendStackMode; + LOCAL_PrologMode = ExtendStackMode; if (ptr == ((MALLOC_T) - 1)) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not expand stacks over %d bytes", s); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return(FALSE); } - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return TRUE; } @@ -1416,34 +1424,34 @@ static int ExtendWorkSpace(Int s) { MALLOC_T ptr; - prolog_exec_mode OldPrologMode = Yap_PrologMode; + prolog_exec_mode OldPrologMode = LOCAL_PrologMode; - Yap_PrologMode = ExtendStackMode; + LOCAL_PrologMode = ExtendStackMode; total_space += s; if (total_space < MAX_SPACE) return TRUE; ptr = (MALLOC_T)realloc((void *)Yap_HeapBase, total_space); if (ptr == NULL) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not allocate %d bytes", s); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return FALSE; } if (ptr != (MALLOC_T)Yap_HeapBase) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf4(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf4(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "could not expand contiguous stacks %d bytes", s); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return FALSE; } if ((CELL)ptr & MBIT) { - Yap_ErrorMessage = Yap_ErrorSay; - snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, + LOCAL_ErrorMessage = LOCAL_ErrorSay; + snprintf5(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, "memory at %p conflicts with MBIT %lx", ptr, (unsigned long)MBIT); - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return FALSE; } - Yap_PrologMode = OldPrologMode; + LOCAL_PrologMode = OldPrologMode; return TRUE; } @@ -1513,27 +1521,27 @@ Yap_InitMemory(UInt Trail, UInt Heap, UInt Stack) InitHeap(addr); - Yap_TrailTop = Yap_HeapBase + pm; - Yap_LocalBase = Yap_TrailTop - ta; - Yap_TrailBase = Yap_LocalBase + sizeof(CELL); + LOCAL_TrailTop = Yap_HeapBase + pm; + LOCAL_LocalBase = LOCAL_TrailTop - ta; + LOCAL_TrailBase = LOCAL_LocalBase + sizeof(CELL); - Yap_GlobalBase = Yap_LocalBase - sa; - HeapLim = Yap_GlobalBase; /* avoid confusions while + LOCAL_GlobalBase = LOCAL_LocalBase - sa; + HeapLim = LOCAL_GlobalBase; /* avoid confusions while * * restoring */ #if !USE_DL_MALLOC - AuxTop = (ADDR)(AuxSp = (CELL *)Yap_GlobalBase); + AuxTop = (ADDR)(AuxSp = (CELL *)LOCAL_GlobalBase); #endif #ifdef DEBUG #if SIZEOF_INT_P!=SIZEOF_INT - if (Yap_output_msg) { + if (GLOBAL_output_msg) { fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n", - Yap_HeapBase, Yap_GlobalBase, Yap_LocalBase, Yap_TrailTop); + Yap_HeapBase, LOCAL_GlobalBase, LOCAL_LocalBase, LOCAL_TrailTop); #else - if (Yap_output_msg) { + if (GLOBAL_output_msg) { fprintf(stderr, "HeapBase = %x GlobalBase = %x\n LocalBase = %x TrailTop = %x\n", - (UInt) Yap_HeapBase, (UInt) Yap_GlobalBase, - (UInt) Yap_LocalBase, (UInt) Yap_TrailTop); + (UInt) Yap_HeapBase, (UInt) LOCAL_GlobalBase, + (UInt) LOCAL_LocalBase, (UInt) LOCAL_TrailTop); #endif fprintf(stderr, "Heap+Aux: " UInt_FORMAT "\tLocal+Global: " UInt_FORMAT "\tTrail: " UInt_FORMAT "\n", @@ -1588,7 +1596,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s) WorkSpaceTop += 512*1024; if (ExtendWorkSpace(s, MAP_FIXED)) { Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s); - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; return WorkSpaceTop-WorkSpaceTop0; } #if defined(_WIN32) @@ -1606,7 +1614,7 @@ Yap_ExtendWorkSpaceThroughHole(UInt s) WorkSpaceTop += 512*1024; if (ExtendWorkSpace(s, MAP_FIXED)) { Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s); - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; return WorkSpaceTop-WorkSpaceTop0; } #if defined(_WIN32) diff --git a/C/amasm.c b/C/amasm.c index 54ea253e0..5807a8469 100755 --- a/C/amasm.c +++ b/C/amasm.c @@ -434,8 +434,8 @@ DumpOpCodes(void) while (i < 30) { for (j = i; j <= _std_top; j += 25) - fprintf(Yap_stderr, "%5d %6lx", j, absmadr(j)); - fputc('\n',Yap_stderr); + fprintf(GLOBAL_stderr, "%5d %6lx", j, absmadr(j)); + fputc('\n',GLOBAL_stderr); ++i; } } @@ -3541,7 +3541,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp if (!pass_no) { #if !USE_SYSTEM_MALLOC if (CellPtr(cip->label_offset+cip->cpc->rnd1) > ASP-256) { - Yap_Error_Size = 256+((char *)(cip->label_offset+cip->cpc->rnd1) - (char *)H); + LOCAL_Error_Size = 256+((char *)(cip->label_offset+cip->cpc->rnd1) - (char *)H); save_machine_regs(); siglongjmp(cip->CompilerBotch, 3); } @@ -3787,9 +3787,9 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep while ((x = Yap_StoreTermInDBPlusExtraSpace(*tp, size, osizep)) == NULL) { H = h0; - switch (Yap_Error_TYPE) { + switch (LOCAL_Error_TYPE) { case OUT_OF_STACK_ERROR: - Yap_Error_Size = 256+((char *)cip->freep - (char *)H); + LOCAL_Error_Size = 256+((char *)cip->freep - (char *)H); save_machine_regs(); siglongjmp(cip->CompilerBotch,3); case OUT_OF_TRAIL_ERROR: @@ -3798,15 +3798,15 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep if (!Yap_growtrail(K64, FALSE)) { return NULL; } - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; *tp = ARG1; break; case OUT_OF_AUXSPACE_ERROR: ARG1 = *tp; - if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, (void *)cip, TRUE)) { + if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, (void *)cip, TRUE)) { return NULL; } - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; *tp = ARG1; break; case OUT_OF_HEAP_ERROR: @@ -3815,7 +3815,7 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep if (!Yap_growheap(TRUE, size, cip)) { return NULL; } - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; *tp = ARG1; break; default: @@ -3932,8 +3932,8 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates while ((cip->code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) { if (!Yap_growheap(TRUE, size, cip)) { - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_Error_Size = size; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_Error_Size = size; return NULL; } } diff --git a/C/analyst.c b/C/analyst.c index 1e32eec50..ec6b95985 100644 --- a/C/analyst.c +++ b/C/analyst.c @@ -28,9 +28,7 @@ static char SccsId[] = "%W% %G%"; #include #endif -YAP_ULONG_LONG Yap_opcount[_std_top + 1]; -YAP_ULONG_LONG Yap_2opcount[_std_top + 1][_std_top + 1]; STATIC_PROTO(Int p_reset_op_counters, (void)); @@ -43,7 +41,7 @@ p_reset_op_counters() int i; for (i = 0; i <= _std_top; ++i) - Yap_opcount[i] = 0; + GLOBAL_opcount[i] = 0; return TRUE; } @@ -52,26 +50,26 @@ print_instruction(int inst) { int j; - fprintf(Yap_stderr, "%s", Yap_op_names[inst]); + fprintf(GLOBAL_stderr, "%s", Yap_op_names[inst]); for (j = strlen(Yap_op_names[inst]); j < 25; j++) - putc(' ', Yap_stderr); - j = Yap_opcount[inst]; + putc(' ', GLOBAL_stderr); + j = GLOBAL_opcount[inst]; if (j < 100000000) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 10000000) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 1000000) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 100000) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 10000) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 1000) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 100) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); if (j < 10) { - putc(' ', Yap_stderr); + putc(' ', GLOBAL_stderr); } } } @@ -80,7 +78,7 @@ print_instruction(int inst) } } } - fprintf(Yap_stderr, "%llu\n", Yap_opcount[inst]); + fprintf(GLOBAL_stderr, "%llu\n", GLOBAL_opcount[inst]); } static Int @@ -98,18 +96,18 @@ p_show_op_counters() wchar_t *program; program = RepAtom(at1)->WStrOfAE; - fprintf(Yap_stderr, "\n Instructions Executed in %S\n", program); + fprintf(GLOBAL_stderr, "\n Instructions Executed in %S\n", program); } else { char *program; program = RepAtom(at1)->StrOfAE; - fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program); + fprintf(GLOBAL_stderr, "\n Instructions Executed in %s\n", program); } } for (i = 0; i <= _std_top; ++i) print_instruction(i); - fprintf(Yap_stderr, "\n Control Instructions \n"); + fprintf(GLOBAL_stderr, "\n Control Instructions \n"); print_instruction(_op_fail); print_instruction(_execute); print_instruction(_dexecute); @@ -121,7 +119,7 @@ p_show_op_counters() print_instruction(_allocate); print_instruction(_deallocate); - fprintf(Yap_stderr, "\n Choice Point Manipulation Instructions\n"); + fprintf(GLOBAL_stderr, "\n Choice Point Manipulation Instructions\n"); print_instruction(_try_me); print_instruction(_retry_me); print_instruction(_trust_me); @@ -130,38 +128,38 @@ p_show_op_counters() print_instruction(_retry); print_instruction(_trust); - fprintf(Yap_stderr, "\n Disjunction Instructions\n"); + fprintf(GLOBAL_stderr, "\n Disjunction Instructions\n"); print_instruction(_either); print_instruction(_or_else); print_instruction(_or_last); print_instruction(_jump); print_instruction(_move_back); - fprintf(Yap_stderr, "\n Dynamic Predicates Choicepoint Instructions\n"); + fprintf(GLOBAL_stderr, "\n Dynamic Predicates Choicepoint Instructions\n"); print_instruction(_try_and_mark); print_instruction(_retry_and_mark); - fprintf(Yap_stderr, "\n C Predicates Choicepoint Instructions\n"); + fprintf(GLOBAL_stderr, "\n C Predicates Choicepoint Instructions\n"); print_instruction(_try_c); print_instruction(_retry_c); - fprintf(Yap_stderr, "\n Indexing Instructions\n"); - fprintf(Yap_stderr, "\n Switch on Type\n"); + fprintf(GLOBAL_stderr, "\n Indexing Instructions\n"); + fprintf(GLOBAL_stderr, "\n Switch on Type\n"); print_instruction(_switch_on_type); print_instruction(_switch_list_nl); print_instruction(_switch_on_arg_type); print_instruction(_switch_on_sub_arg_type); - fprintf(Yap_stderr, "\n Switch on Value\n"); + fprintf(GLOBAL_stderr, "\n Switch on Value\n"); print_instruction(_if_cons); print_instruction(_go_on_cons); print_instruction(_switch_on_cons); print_instruction(_if_func); print_instruction(_go_on_func); print_instruction(_switch_on_func); - fprintf(Yap_stderr, "\n Other Switches\n"); + fprintf(GLOBAL_stderr, "\n Other Switches\n"); print_instruction(_if_not_then); - fprintf(Yap_stderr, "\n Get Instructions\n"); + fprintf(GLOBAL_stderr, "\n Get Instructions\n"); print_instruction(_get_x_var); print_instruction(_get_y_var); print_instruction(_get_x_val); @@ -174,7 +172,7 @@ p_show_op_counters() print_instruction(_get_6atoms); print_instruction(_get_list); print_instruction(_get_struct); - fprintf(Yap_stderr, "\n Optimised Get Instructions\n"); + fprintf(GLOBAL_stderr, "\n Optimised Get Instructions\n"); print_instruction(_glist_valx); print_instruction(_glist_valy); print_instruction(_gl_void_varx); @@ -182,7 +180,7 @@ p_show_op_counters() print_instruction(_gl_void_valx); print_instruction(_gl_void_valy); - fprintf(Yap_stderr, "\n Unify Read Instructions\n"); + fprintf(GLOBAL_stderr, "\n Unify Read Instructions\n"); print_instruction(_unify_x_var); print_instruction(_unify_x_var2); print_instruction(_unify_y_var); @@ -195,7 +193,7 @@ p_show_op_counters() print_instruction(_unify_n_voids); print_instruction(_unify_list); print_instruction(_unify_struct); - fprintf(Yap_stderr, "\n Unify Last Read Instructions\n"); + fprintf(GLOBAL_stderr, "\n Unify Last Read Instructions\n"); print_instruction(_unify_l_x_var); print_instruction(_unify_l_x_var2); print_instruction(_unify_l_y_var); @@ -208,7 +206,7 @@ p_show_op_counters() print_instruction(_unify_l_list); print_instruction(_unify_l_struc); - fprintf(Yap_stderr, "\n Unify Write Instructions\n"); + fprintf(GLOBAL_stderr, "\n Unify Write Instructions\n"); print_instruction(_unify_x_var_write); print_instruction(_unify_x_var2_write); print_instruction(_unify_y_var_write); @@ -221,7 +219,7 @@ p_show_op_counters() print_instruction(_unify_n_voids_write); print_instruction(_unify_list_write); print_instruction(_unify_struct_write); - fprintf(Yap_stderr, "\n Unify Last Read Instructions\n"); + fprintf(GLOBAL_stderr, "\n Unify Last Read Instructions\n"); print_instruction(_unify_l_x_var_write); print_instruction(_unify_l_x_var2_write); print_instruction(_unify_l_y_var_write); @@ -234,7 +232,7 @@ p_show_op_counters() print_instruction(_unify_l_list_write); print_instruction(_unify_l_struc_write); - fprintf(Yap_stderr, "\n Put Instructions\n"); + fprintf(GLOBAL_stderr, "\n Put Instructions\n"); print_instruction(_put_x_var); print_instruction(_put_y_var); print_instruction(_put_x_val); @@ -245,7 +243,7 @@ p_show_op_counters() print_instruction(_put_list); print_instruction(_put_struct); - fprintf(Yap_stderr, "\n Write Instructions\n"); + fprintf(GLOBAL_stderr, "\n Write Instructions\n"); print_instruction(_write_x_var); print_instruction(_write_y_var); print_instruction(_write_x_val); @@ -257,11 +255,11 @@ p_show_op_counters() print_instruction(_write_n_voids); print_instruction(_write_list); print_instruction(_write_struct); - fprintf(Yap_stderr, "\n Last Write Instructions\n"); + fprintf(GLOBAL_stderr, "\n Last Write Instructions\n"); print_instruction(_write_l_list); print_instruction(_write_l_struc); - fprintf(Yap_stderr, "\n Miscellaneous Instructions\n"); + fprintf(GLOBAL_stderr, "\n Miscellaneous Instructions\n"); print_instruction(_cut); print_instruction(_cut_t); print_instruction(_cut_e); @@ -292,11 +290,11 @@ p_show_op_counters() typedef struct { int nxvar, nxval, nyvar, nyval, ncons, nlist, nstru, nmisc; -} uYap_opcount; +} uGLOBAL_opcount; typedef struct { int ncalls, nexecs, nproceeds, ncallbips, ncuts, nallocs, ndeallocs; -} cYap_opcount; +} cGLOBAL_opcount; typedef struct { int ntries, nretries, ntrusts; @@ -306,8 +304,8 @@ static Int p_show_ops_by_group(void) { - uYap_opcount c_get, c_unify, c_put, c_write; - cYap_opcount c_control; + uGLOBAL_opcount c_get, c_unify, c_put, c_write; + cGLOBAL_opcount c_control; ccpcount c_cp; int gets, unifies, puts, writes, controls, choice_pts, indexes, misc, total; @@ -322,261 +320,261 @@ p_show_ops_by_group(void) wchar_t *program; program = RepAtom(at1)->WStrOfAE; - fprintf(Yap_stderr, "\n Instructions Executed in %S\n", program); + fprintf(GLOBAL_stderr, "\n Instructions Executed in %S\n", program); } else { char *program; program = RepAtom(at1)->StrOfAE; - fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program); + fprintf(GLOBAL_stderr, "\n Instructions Executed in %s\n", program); } c_get.nxvar = - Yap_opcount[_get_x_var]; + GLOBAL_opcount[_get_x_var]; c_get.nyvar = - Yap_opcount[_get_y_var]; + GLOBAL_opcount[_get_y_var]; c_get.nxval = - Yap_opcount[_get_x_val]; + GLOBAL_opcount[_get_x_val]; c_get.nyval = - Yap_opcount[_get_y_val]; + GLOBAL_opcount[_get_y_val]; c_get.ncons = - Yap_opcount[_get_atom]+ - Yap_opcount[_get_2atoms]+ - Yap_opcount[_get_3atoms]+ - Yap_opcount[_get_4atoms]+ - Yap_opcount[_get_5atoms]+ - Yap_opcount[_get_6atoms]; + GLOBAL_opcount[_get_atom]+ + GLOBAL_opcount[_get_2atoms]+ + GLOBAL_opcount[_get_3atoms]+ + GLOBAL_opcount[_get_4atoms]+ + GLOBAL_opcount[_get_5atoms]+ + GLOBAL_opcount[_get_6atoms]; c_get.nlist = - Yap_opcount[_get_list] + - Yap_opcount[_glist_valx] + - Yap_opcount[_glist_valy] + - Yap_opcount[_gl_void_varx] + - Yap_opcount[_gl_void_vary] + - Yap_opcount[_gl_void_valx] + - Yap_opcount[_gl_void_valy]; + GLOBAL_opcount[_get_list] + + GLOBAL_opcount[_glist_valx] + + GLOBAL_opcount[_glist_valy] + + GLOBAL_opcount[_gl_void_varx] + + GLOBAL_opcount[_gl_void_vary] + + GLOBAL_opcount[_gl_void_valx] + + GLOBAL_opcount[_gl_void_valy]; c_get.nstru = - Yap_opcount[_get_struct]; + GLOBAL_opcount[_get_struct]; gets = c_get.nxvar + c_get.nyvar + c_get.nxval + c_get.nyval + c_get.ncons + c_get.nlist + c_get.nstru; c_unify.nxvar = - Yap_opcount[_unify_x_var] + - Yap_opcount[_unify_void] + - Yap_opcount[_unify_n_voids] + - 2 * Yap_opcount[_unify_x_var2] + - 2 * Yap_opcount[_gl_void_varx] + - Yap_opcount[_gl_void_vary] + - Yap_opcount[_gl_void_valx] + - Yap_opcount[_unify_l_x_var] + - Yap_opcount[_unify_l_void] + - Yap_opcount[_unify_l_n_voids] + - 2 * Yap_opcount[_unify_l_x_var2] + - Yap_opcount[_unify_x_var_write] + - Yap_opcount[_unify_void_write] + - Yap_opcount[_unify_n_voids_write] + - 2 * Yap_opcount[_unify_x_var2_write] + - Yap_opcount[_unify_l_x_var_write] + - Yap_opcount[_unify_l_void_write] + - Yap_opcount[_unify_l_n_voids_write] + - 2 * Yap_opcount[_unify_l_x_var2_write]; + GLOBAL_opcount[_unify_x_var] + + GLOBAL_opcount[_unify_void] + + GLOBAL_opcount[_unify_n_voids] + + 2 * GLOBAL_opcount[_unify_x_var2] + + 2 * GLOBAL_opcount[_gl_void_varx] + + GLOBAL_opcount[_gl_void_vary] + + GLOBAL_opcount[_gl_void_valx] + + GLOBAL_opcount[_unify_l_x_var] + + GLOBAL_opcount[_unify_l_void] + + GLOBAL_opcount[_unify_l_n_voids] + + 2 * GLOBAL_opcount[_unify_l_x_var2] + + GLOBAL_opcount[_unify_x_var_write] + + GLOBAL_opcount[_unify_void_write] + + GLOBAL_opcount[_unify_n_voids_write] + + 2 * GLOBAL_opcount[_unify_x_var2_write] + + GLOBAL_opcount[_unify_l_x_var_write] + + GLOBAL_opcount[_unify_l_void_write] + + GLOBAL_opcount[_unify_l_n_voids_write] + + 2 * GLOBAL_opcount[_unify_l_x_var2_write]; c_unify.nyvar = - Yap_opcount[_unify_y_var] + - Yap_opcount[_gl_void_vary] + - Yap_opcount[_unify_l_y_var] + - Yap_opcount[_unify_y_var_write] + - Yap_opcount[_unify_l_y_var_write]; + GLOBAL_opcount[_unify_y_var] + + GLOBAL_opcount[_gl_void_vary] + + GLOBAL_opcount[_unify_l_y_var] + + GLOBAL_opcount[_unify_y_var_write] + + GLOBAL_opcount[_unify_l_y_var_write]; c_unify.nxval = - Yap_opcount[_unify_x_val] + - Yap_opcount[_unify_x_loc] + - Yap_opcount[_glist_valx] + - Yap_opcount[_gl_void_valx] + - Yap_opcount[_unify_l_x_val] + - Yap_opcount[_unify_l_x_loc] + - Yap_opcount[_unify_x_val_write] + - Yap_opcount[_unify_x_loc_write] + - Yap_opcount[_unify_l_x_val_write] + - Yap_opcount[_unify_l_x_loc_write]; + GLOBAL_opcount[_unify_x_val] + + GLOBAL_opcount[_unify_x_loc] + + GLOBAL_opcount[_glist_valx] + + GLOBAL_opcount[_gl_void_valx] + + GLOBAL_opcount[_unify_l_x_val] + + GLOBAL_opcount[_unify_l_x_loc] + + GLOBAL_opcount[_unify_x_val_write] + + GLOBAL_opcount[_unify_x_loc_write] + + GLOBAL_opcount[_unify_l_x_val_write] + + GLOBAL_opcount[_unify_l_x_loc_write]; c_unify.nyval = - Yap_opcount[_unify_y_val] + - Yap_opcount[_unify_y_loc] + - Yap_opcount[_glist_valy] + - Yap_opcount[_gl_void_valy] + - Yap_opcount[_unify_l_y_val] + - Yap_opcount[_unify_l_y_loc] + - Yap_opcount[_unify_y_val_write] + - Yap_opcount[_unify_y_loc_write] + - Yap_opcount[_unify_l_y_val_write] + - Yap_opcount[_unify_l_y_loc_write]; + GLOBAL_opcount[_unify_y_val] + + GLOBAL_opcount[_unify_y_loc] + + GLOBAL_opcount[_glist_valy] + + GLOBAL_opcount[_gl_void_valy] + + GLOBAL_opcount[_unify_l_y_val] + + GLOBAL_opcount[_unify_l_y_loc] + + GLOBAL_opcount[_unify_y_val_write] + + GLOBAL_opcount[_unify_y_loc_write] + + GLOBAL_opcount[_unify_l_y_val_write] + + GLOBAL_opcount[_unify_l_y_loc_write]; c_unify.ncons = - Yap_opcount[_unify_atom] + - Yap_opcount[_unify_n_atoms] + - Yap_opcount[_unify_l_atom] + - Yap_opcount[_unify_atom_write] + - Yap_opcount[_unify_n_atoms_write] + - Yap_opcount[_unify_l_atom_write]; + GLOBAL_opcount[_unify_atom] + + GLOBAL_opcount[_unify_n_atoms] + + GLOBAL_opcount[_unify_l_atom] + + GLOBAL_opcount[_unify_atom_write] + + GLOBAL_opcount[_unify_n_atoms_write] + + GLOBAL_opcount[_unify_l_atom_write]; c_unify.nlist = - Yap_opcount[_unify_list] + - Yap_opcount[_unify_l_list] + - Yap_opcount[_unify_list_write] + - Yap_opcount[_unify_l_list_write]; + GLOBAL_opcount[_unify_list] + + GLOBAL_opcount[_unify_l_list] + + GLOBAL_opcount[_unify_list_write] + + GLOBAL_opcount[_unify_l_list_write]; c_unify.nstru = - Yap_opcount[_unify_struct] + - Yap_opcount[_unify_l_struc] + - Yap_opcount[_unify_struct_write] + - Yap_opcount[_unify_l_struc_write]; + GLOBAL_opcount[_unify_struct] + + GLOBAL_opcount[_unify_l_struc] + + GLOBAL_opcount[_unify_struct_write] + + GLOBAL_opcount[_unify_l_struc_write]; c_unify.nmisc = - Yap_opcount[_pop] + - Yap_opcount[_pop_n]; + GLOBAL_opcount[_pop] + + GLOBAL_opcount[_pop_n]; unifies = c_unify.nxvar + c_unify.nyvar + c_unify.nxval + c_unify.nyval + c_unify.ncons + c_unify.nlist + c_unify.nstru + c_unify.nmisc; c_put.nxvar = - Yap_opcount[_put_x_var]; + GLOBAL_opcount[_put_x_var]; c_put.nyvar = - Yap_opcount[_put_y_var]; + GLOBAL_opcount[_put_y_var]; c_put.nxval = - Yap_opcount[_put_x_val]+ - 2*Yap_opcount[_put_xx_val]; + GLOBAL_opcount[_put_x_val]+ + 2*GLOBAL_opcount[_put_xx_val]; c_put.nyval = - Yap_opcount[_put_y_val]; + GLOBAL_opcount[_put_y_val]; c_put.ncons = - Yap_opcount[_put_atom]; + GLOBAL_opcount[_put_atom]; c_put.nlist = - Yap_opcount[_put_list]; + GLOBAL_opcount[_put_list]; c_put.nstru = - Yap_opcount[_put_struct]; + GLOBAL_opcount[_put_struct]; puts = c_put.nxvar + c_put.nyvar + c_put.nxval + c_put.nyval + c_put.ncons + c_put.nlist + c_put.nstru; c_write.nxvar = - Yap_opcount[_write_x_var] + - Yap_opcount[_write_void] + - Yap_opcount[_write_n_voids]; + GLOBAL_opcount[_write_x_var] + + GLOBAL_opcount[_write_void] + + GLOBAL_opcount[_write_n_voids]; c_write.nyvar = - Yap_opcount[_write_y_var]; + GLOBAL_opcount[_write_y_var]; c_write.nxval = - Yap_opcount[_write_x_val]; + GLOBAL_opcount[_write_x_val]; c_write.nyval = - Yap_opcount[_write_y_val]; + GLOBAL_opcount[_write_y_val]; c_write.ncons = - Yap_opcount[_write_atom]; + GLOBAL_opcount[_write_atom]; c_write.nlist = - Yap_opcount[_write_list]; + GLOBAL_opcount[_write_list]; c_write.nstru = - Yap_opcount[_write_struct]; + GLOBAL_opcount[_write_struct]; writes = c_write.nxvar + c_write.nyvar + c_write.nxval + c_write.nyval + c_write.ncons + c_write.nlist + c_write.nstru; c_control.nexecs = - Yap_opcount[_execute] + - Yap_opcount[_dexecute]; + GLOBAL_opcount[_execute] + + GLOBAL_opcount[_dexecute]; c_control.ncalls = - Yap_opcount[_call] + - Yap_opcount[_fcall]; + GLOBAL_opcount[_call] + + GLOBAL_opcount[_fcall]; c_control.nproceeds = - Yap_opcount[_procceed]; + GLOBAL_opcount[_procceed]; c_control.ncallbips = - Yap_opcount[_call_cpred] + - Yap_opcount[_call_c_wfail] + - Yap_opcount[_try_c] + - Yap_opcount[_retry_c] + - Yap_opcount[_op_fail] + - Yap_opcount[_trust_fail] + - Yap_opcount[_p_atom_x] + - Yap_opcount[_p_atom_y] + - Yap_opcount[_p_atomic_x] + - Yap_opcount[_p_atomic_y] + - Yap_opcount[_p_compound_x] + - Yap_opcount[_p_compound_y] + - Yap_opcount[_p_float_x] + - Yap_opcount[_p_float_y] + - Yap_opcount[_p_integer_x] + - Yap_opcount[_p_integer_y] + - Yap_opcount[_p_nonvar_x] + - Yap_opcount[_p_nonvar_y] + - Yap_opcount[_p_number_x] + - Yap_opcount[_p_number_y] + - Yap_opcount[_p_var_x] + - Yap_opcount[_p_var_y] + - Yap_opcount[_p_db_ref_x] + - Yap_opcount[_p_db_ref_y] + - Yap_opcount[_p_cut_by_x] + - Yap_opcount[_p_cut_by_y] + - Yap_opcount[_p_primitive_x] + - Yap_opcount[_p_primitive_y] + - Yap_opcount[_p_equal] + - Yap_opcount[_p_plus_vv] + - Yap_opcount[_p_plus_vc] + - Yap_opcount[_p_plus_y_vv] + - Yap_opcount[_p_plus_y_vc] + - Yap_opcount[_p_minus_vv] + - Yap_opcount[_p_minus_cv] + - Yap_opcount[_p_minus_y_vv] + - Yap_opcount[_p_minus_y_cv] + - Yap_opcount[_p_times_vv] + - Yap_opcount[_p_times_vc] + - Yap_opcount[_p_times_y_vv] + - Yap_opcount[_p_times_y_vc] + - Yap_opcount[_p_div_vv] + - Yap_opcount[_p_div_vc] + - Yap_opcount[_p_div_cv] + - Yap_opcount[_p_div_y_vv] + - Yap_opcount[_p_div_y_vc] + - Yap_opcount[_p_div_y_cv] + - Yap_opcount[_p_or_vv] + - Yap_opcount[_p_or_vc] + - Yap_opcount[_p_or_y_vv] + - Yap_opcount[_p_or_y_vc] + - Yap_opcount[_p_and_vv] + - Yap_opcount[_p_and_vc] + - Yap_opcount[_p_and_y_vv] + - Yap_opcount[_p_and_y_vc] + - Yap_opcount[_p_sll_vv] + - Yap_opcount[_p_sll_vc] + - Yap_opcount[_p_sll_y_vv] + - Yap_opcount[_p_sll_y_vc] + - Yap_opcount[_p_slr_vv] + - Yap_opcount[_p_slr_vc] + - Yap_opcount[_p_slr_y_vv] + - Yap_opcount[_p_slr_y_vc] + - Yap_opcount[_p_dif] + - Yap_opcount[_p_eq] + - Yap_opcount[_p_arg_vv] + - Yap_opcount[_p_arg_cv] + - Yap_opcount[_p_arg_y_vv] + - Yap_opcount[_p_arg_y_cv] + - Yap_opcount[_p_functor] + - Yap_opcount[_p_func2s_vv] + - Yap_opcount[_p_func2s_cv] + - Yap_opcount[_p_func2s_vc] + - Yap_opcount[_p_func2s_y_vv] + - Yap_opcount[_p_func2s_y_cv] + - Yap_opcount[_p_func2s_y_vc] + - Yap_opcount[_p_func2f_xx] + - Yap_opcount[_p_func2f_xy] + - Yap_opcount[_p_func2f_yx] + - Yap_opcount[_p_func2f_yy]; + GLOBAL_opcount[_call_cpred] + + GLOBAL_opcount[_call_c_wfail] + + GLOBAL_opcount[_try_c] + + GLOBAL_opcount[_retry_c] + + GLOBAL_opcount[_op_fail] + + GLOBAL_opcount[_trust_fail] + + GLOBAL_opcount[_p_atom_x] + + GLOBAL_opcount[_p_atom_y] + + GLOBAL_opcount[_p_atomic_x] + + GLOBAL_opcount[_p_atomic_y] + + GLOBAL_opcount[_p_compound_x] + + GLOBAL_opcount[_p_compound_y] + + GLOBAL_opcount[_p_float_x] + + GLOBAL_opcount[_p_float_y] + + GLOBAL_opcount[_p_integer_x] + + GLOBAL_opcount[_p_integer_y] + + GLOBAL_opcount[_p_nonvar_x] + + GLOBAL_opcount[_p_nonvar_y] + + GLOBAL_opcount[_p_number_x] + + GLOBAL_opcount[_p_number_y] + + GLOBAL_opcount[_p_var_x] + + GLOBAL_opcount[_p_var_y] + + GLOBAL_opcount[_p_db_ref_x] + + GLOBAL_opcount[_p_db_ref_y] + + GLOBAL_opcount[_p_cut_by_x] + + GLOBAL_opcount[_p_cut_by_y] + + GLOBAL_opcount[_p_primitive_x] + + GLOBAL_opcount[_p_primitive_y] + + GLOBAL_opcount[_p_equal] + + GLOBAL_opcount[_p_plus_vv] + + GLOBAL_opcount[_p_plus_vc] + + GLOBAL_opcount[_p_plus_y_vv] + + GLOBAL_opcount[_p_plus_y_vc] + + GLOBAL_opcount[_p_minus_vv] + + GLOBAL_opcount[_p_minus_cv] + + GLOBAL_opcount[_p_minus_y_vv] + + GLOBAL_opcount[_p_minus_y_cv] + + GLOBAL_opcount[_p_times_vv] + + GLOBAL_opcount[_p_times_vc] + + GLOBAL_opcount[_p_times_y_vv] + + GLOBAL_opcount[_p_times_y_vc] + + GLOBAL_opcount[_p_div_vv] + + GLOBAL_opcount[_p_div_vc] + + GLOBAL_opcount[_p_div_cv] + + GLOBAL_opcount[_p_div_y_vv] + + GLOBAL_opcount[_p_div_y_vc] + + GLOBAL_opcount[_p_div_y_cv] + + GLOBAL_opcount[_p_or_vv] + + GLOBAL_opcount[_p_or_vc] + + GLOBAL_opcount[_p_or_y_vv] + + GLOBAL_opcount[_p_or_y_vc] + + GLOBAL_opcount[_p_and_vv] + + GLOBAL_opcount[_p_and_vc] + + GLOBAL_opcount[_p_and_y_vv] + + GLOBAL_opcount[_p_and_y_vc] + + GLOBAL_opcount[_p_sll_vv] + + GLOBAL_opcount[_p_sll_vc] + + GLOBAL_opcount[_p_sll_y_vv] + + GLOBAL_opcount[_p_sll_y_vc] + + GLOBAL_opcount[_p_slr_vv] + + GLOBAL_opcount[_p_slr_vc] + + GLOBAL_opcount[_p_slr_y_vv] + + GLOBAL_opcount[_p_slr_y_vc] + + GLOBAL_opcount[_p_dif] + + GLOBAL_opcount[_p_eq] + + GLOBAL_opcount[_p_arg_vv] + + GLOBAL_opcount[_p_arg_cv] + + GLOBAL_opcount[_p_arg_y_vv] + + GLOBAL_opcount[_p_arg_y_cv] + + GLOBAL_opcount[_p_functor] + + GLOBAL_opcount[_p_func2s_vv] + + GLOBAL_opcount[_p_func2s_cv] + + GLOBAL_opcount[_p_func2s_vc] + + GLOBAL_opcount[_p_func2s_y_vv] + + GLOBAL_opcount[_p_func2s_y_cv] + + GLOBAL_opcount[_p_func2s_y_vc] + + GLOBAL_opcount[_p_func2f_xx] + + GLOBAL_opcount[_p_func2f_xy] + + GLOBAL_opcount[_p_func2f_yx] + + GLOBAL_opcount[_p_func2f_yy]; c_control.ncuts = - Yap_opcount[_cut] + - Yap_opcount[_cut_t] + - Yap_opcount[_cut_e] + - Yap_opcount[_commit_b_x] + - Yap_opcount[_commit_b_y]; + GLOBAL_opcount[_cut] + + GLOBAL_opcount[_cut_t] + + GLOBAL_opcount[_cut_e] + + GLOBAL_opcount[_commit_b_x] + + GLOBAL_opcount[_commit_b_y]; c_control.nallocs = - Yap_opcount[_allocate] + - Yap_opcount[_fcall]; + GLOBAL_opcount[_allocate] + + GLOBAL_opcount[_fcall]; c_control.ndeallocs = - Yap_opcount[_dexecute] + - Yap_opcount[_deallocate]; + GLOBAL_opcount[_dexecute] + + GLOBAL_opcount[_deallocate]; controls = c_control.nexecs + @@ -585,30 +583,30 @@ p_show_ops_by_group(void) c_control.ncuts + c_control.nallocs + c_control.ndeallocs + - Yap_opcount[_jump] + - Yap_opcount[_move_back] + - Yap_opcount[_try_in]; + GLOBAL_opcount[_jump] + + GLOBAL_opcount[_move_back] + + GLOBAL_opcount[_try_in]; c_cp.ntries = - Yap_opcount[_try_me] + - Yap_opcount[_try_and_mark] + - Yap_opcount[_try_c] + - Yap_opcount[_try_clause] + - Yap_opcount[_either]; + GLOBAL_opcount[_try_me] + + GLOBAL_opcount[_try_and_mark] + + GLOBAL_opcount[_try_c] + + GLOBAL_opcount[_try_clause] + + GLOBAL_opcount[_either]; c_cp.nretries = - Yap_opcount[_retry_me] + - Yap_opcount[_retry_and_mark] + - Yap_opcount[_retry_c] + - Yap_opcount[_retry] + - Yap_opcount[_or_else]; + GLOBAL_opcount[_retry_me] + + GLOBAL_opcount[_retry_and_mark] + + GLOBAL_opcount[_retry_c] + + GLOBAL_opcount[_retry] + + GLOBAL_opcount[_or_else]; c_cp.ntrusts = - Yap_opcount[_trust_me] + - Yap_opcount[_trust] + - Yap_opcount[_or_last]; + GLOBAL_opcount[_trust_me] + + GLOBAL_opcount[_trust] + + GLOBAL_opcount[_or_last]; choice_pts = c_cp.ntries + @@ -616,70 +614,70 @@ p_show_ops_by_group(void) c_cp.ntrusts; indexes = - Yap_opcount[_jump_if_var] + - Yap_opcount[_switch_on_type] + - Yap_opcount[_switch_list_nl] + - Yap_opcount[_switch_on_arg_type] + - Yap_opcount[_switch_on_sub_arg_type] + - Yap_opcount[_switch_on_cons] + - Yap_opcount[_go_on_cons] + - Yap_opcount[_if_cons] + - Yap_opcount[_switch_on_func] + - Yap_opcount[_go_on_func] + - Yap_opcount[_if_func] + - Yap_opcount[_if_not_then]; + GLOBAL_opcount[_jump_if_var] + + GLOBAL_opcount[_switch_on_type] + + GLOBAL_opcount[_switch_list_nl] + + GLOBAL_opcount[_switch_on_arg_type] + + GLOBAL_opcount[_switch_on_sub_arg_type] + + GLOBAL_opcount[_switch_on_cons] + + GLOBAL_opcount[_go_on_cons] + + GLOBAL_opcount[_if_cons] + + GLOBAL_opcount[_switch_on_func] + + GLOBAL_opcount[_go_on_func] + + GLOBAL_opcount[_if_func] + + GLOBAL_opcount[_if_not_then]; misc = c_control.ncallbips + - Yap_opcount[_Ystop] + - Yap_opcount[_Nstop] + - Yap_opcount[_index_pred] + - Yap_opcount[_lock_pred] + + GLOBAL_opcount[_Ystop] + + GLOBAL_opcount[_Nstop] + + GLOBAL_opcount[_index_pred] + + GLOBAL_opcount[_lock_pred] + #if THREADS - Yap_opcount[_thread_local] + + GLOBAL_opcount[_thread_local] + #endif - Yap_opcount[_save_b_x] + - Yap_opcount[_save_b_y] + - Yap_opcount[_undef_p] + - Yap_opcount[_spy_pred] + - Yap_opcount[_spy_or_trymark] + - Yap_opcount[_save_pair_x] + - Yap_opcount[_save_pair_y] + - Yap_opcount[_save_pair_x_write] + - Yap_opcount[_save_pair_y_write] + - Yap_opcount[_save_appl_x] + - Yap_opcount[_save_appl_y] + - Yap_opcount[_save_appl_x_write] + - Yap_opcount[_save_appl_y_write]; + GLOBAL_opcount[_save_b_x] + + GLOBAL_opcount[_save_b_y] + + GLOBAL_opcount[_undef_p] + + GLOBAL_opcount[_spy_pred] + + GLOBAL_opcount[_spy_or_trymark] + + GLOBAL_opcount[_save_pair_x] + + GLOBAL_opcount[_save_pair_y] + + GLOBAL_opcount[_save_pair_x_write] + + GLOBAL_opcount[_save_pair_y_write] + + GLOBAL_opcount[_save_appl_x] + + GLOBAL_opcount[_save_appl_y] + + GLOBAL_opcount[_save_appl_x_write] + + GLOBAL_opcount[_save_appl_y_write]; total = gets + unifies + puts + writes + controls + choice_pts + indexes + misc; /* for (i = 0; i <= _std_top; ++i) * print_instruction(i); */ - fprintf(Yap_stderr, "Groups are\n\n"); - fprintf(Yap_stderr, " GET instructions: %8d (%3d%%)\n", gets, + fprintf(GLOBAL_stderr, "Groups are\n\n"); + fprintf(GLOBAL_stderr, " GET instructions: %8d (%3d%%)\n", gets, (gets * 100) / total); - fprintf(Yap_stderr, " UNIFY instructions: %8d (%3d%%)\n", unifies, + fprintf(GLOBAL_stderr, " UNIFY instructions: %8d (%3d%%)\n", unifies, (unifies * 100) / total); - fprintf(Yap_stderr, " PUT instructions: %8d (%3d%%)\n", puts, + fprintf(GLOBAL_stderr, " PUT instructions: %8d (%3d%%)\n", puts, (puts * 100) / total); - fprintf(Yap_stderr, " WRITE instructions: %8d (%3d%%)\n", writes, + fprintf(GLOBAL_stderr, " WRITE instructions: %8d (%3d%%)\n", writes, (writes * 100) / total); - fprintf(Yap_stderr, " CONTROL instructions: %8d (%3d%%)\n", controls, + fprintf(GLOBAL_stderr, " CONTROL instructions: %8d (%3d%%)\n", controls, (controls * 100) / total); - fprintf(Yap_stderr, " CHOICE POINT instructions: %8d (%3d%%)\n", choice_pts, + fprintf(GLOBAL_stderr, " CHOICE POINT instructions: %8d (%3d%%)\n", choice_pts, (choice_pts * 100) / total); - fprintf(Yap_stderr, " INDEXING instructions: %8d (%3d%%)\n", indexes, + fprintf(GLOBAL_stderr, " INDEXING instructions: %8d (%3d%%)\n", indexes, (indexes * 100) / total); - fprintf(Yap_stderr, " MISCELLANEOUS instructions: %8d (%3d%%)\n", misc, + fprintf(GLOBAL_stderr, " MISCELLANEOUS instructions: %8d (%3d%%)\n", misc, (misc * 100) / total); - fprintf(Yap_stderr, "_______________________________________________\n"); - fprintf(Yap_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, + fprintf(GLOBAL_stderr, "_______________________________________________\n"); + fprintf(GLOBAL_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, (total * 100) / total); - fprintf(Yap_stderr, "\n Analysis of Unification Instructions in %s \n", program); - fprintf(Yap_stderr, " XVAR, YVAR, XVAL, YVAL, CONS, LIST, STRUCT\n"); - fprintf(Yap_stderr, " GET: %8d %8d %8d %8d %8d %8d %8d\n", + fprintf(GLOBAL_stderr, "\n Analysis of Unification Instructions in %s \n", program); + fprintf(GLOBAL_stderr, " XVAR, YVAR, XVAL, YVAL, CONS, LIST, STRUCT\n"); + fprintf(GLOBAL_stderr, " GET: %8d %8d %8d %8d %8d %8d %8d\n", c_get.nxvar, c_get.nyvar, c_get.nxval, @@ -687,7 +685,7 @@ p_show_ops_by_group(void) c_get.ncons, c_get.nlist, c_get.nstru); - fprintf(Yap_stderr, "UNIFY: %8d %8d %8d %8d %8d %8d %8d\n", + fprintf(GLOBAL_stderr, "UNIFY: %8d %8d %8d %8d %8d %8d %8d\n", c_unify.nxvar, c_unify.nyvar, c_unify.nxval, @@ -695,7 +693,7 @@ p_show_ops_by_group(void) c_unify.ncons, c_unify.nlist, c_unify.nstru); - fprintf(Yap_stderr, " PUT: %8d %8d %8d %8d %8d %8d %8d\n", + fprintf(GLOBAL_stderr, " PUT: %8d %8d %8d %8d %8d %8d %8d\n", c_put.nxvar, c_put.nyvar, c_put.nxval, @@ -703,7 +701,7 @@ p_show_ops_by_group(void) c_put.ncons, c_put.nlist, c_put.nstru); - fprintf(Yap_stderr, "WRITE: %8d %8d %8d %8d %8d %8d %8d\n", + fprintf(GLOBAL_stderr, "WRITE: %8d %8d %8d %8d %8d %8d %8d\n", c_write.nxvar, c_write.nyvar, c_write.nxval, @@ -711,8 +709,8 @@ p_show_ops_by_group(void) c_write.ncons, c_write.nlist, c_write.nstru); - fprintf(Yap_stderr, " ___________________________________________________\n"); - fprintf(Yap_stderr, "TOTAL: %8d %8d %8d %8d %8d %8d %8d\n", + fprintf(GLOBAL_stderr, " ___________________________________________________\n"); + fprintf(GLOBAL_stderr, "TOTAL: %8d %8d %8d %8d %8d %8d %8d\n", c_get.nxvar + c_unify.nxvar + c_put.nxvar + c_write.nxvar, c_get.nyvar + c_unify.nyvar + c_put.nyvar + c_write.nyvar, c_get.nxval + c_unify.nxval + c_put.nxval + c_write.nxval, @@ -722,9 +720,9 @@ p_show_ops_by_group(void) c_get.nstru + c_unify.nstru + c_put.nstru + c_write.nstru ); - fprintf(Yap_stderr, "\n Analysis of Unification Instructions in %s \n", program); - fprintf(Yap_stderr, " XVAR, YVAR, XVAL, YVAL, CONS, LIST, STRUCT\n"); - fprintf(Yap_stderr, " GET: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", + fprintf(GLOBAL_stderr, "\n Analysis of Unification Instructions in %s \n", program); + fprintf(GLOBAL_stderr, " XVAR, YVAR, XVAL, YVAL, CONS, LIST, STRUCT\n"); + fprintf(GLOBAL_stderr, " GET: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", (((double) c_get.nxvar) * 100) / total, (((double) c_get.nyvar) * 100) / total, (((double) c_get.nxval) * 100) / total, @@ -732,7 +730,7 @@ p_show_ops_by_group(void) (((double) c_get.ncons) * 100) / total, (((double) c_get.nlist) * 100) / total, (((double) c_get.nstru) * 100) / total); - fprintf(Yap_stderr, "UNIFY: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", + fprintf(GLOBAL_stderr, "UNIFY: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", (((double) c_unify.nxvar) * 100) / total, (((double) c_unify.nyvar) * 100) / total, (((double) c_unify.nxval) * 100) / total, @@ -740,7 +738,7 @@ p_show_ops_by_group(void) (((double) c_unify.ncons) * 100) / total, (((double) c_unify.nlist) * 100) / total, (((double) c_unify.nstru) * 100) / total); - fprintf(Yap_stderr, " PUT: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", + fprintf(GLOBAL_stderr, " PUT: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", (((double) c_put.nxvar) * 100) / total, (((double) c_put.nyvar) * 100) / total, (((double) c_put.nxval) * 100) / total, @@ -748,7 +746,7 @@ p_show_ops_by_group(void) (((double) c_put.ncons) * 100) / total, (((double) c_put.nlist) * 100) / total, (((double) c_put.nstru) * 100) / total); - fprintf(Yap_stderr, "WRITE: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", + fprintf(GLOBAL_stderr, "WRITE: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", (((double) c_write.nxvar) * 100) / total, (((double) c_write.nyvar) * 100) / total, (((double) c_write.nxval) * 100) / total, @@ -756,8 +754,8 @@ p_show_ops_by_group(void) (((double) c_write.ncons) * 100) / total, (((double) c_write.nlist) * 100) / total, (((double) c_write.nstru) * 100) / total); - fprintf(Yap_stderr, " ___________________________________________________\n"); - fprintf(Yap_stderr, "TOTAL: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", + fprintf(GLOBAL_stderr, " ___________________________________________________\n"); + fprintf(GLOBAL_stderr, "TOTAL: %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%% %3.2f%%\n", (((double) c_get.nxvar + c_unify.nxvar + c_put.nxvar + c_write.nxvar) * 100) / total, (((double) c_get.nyvar + c_unify.nyvar + c_put.nyvar + c_write.nyvar) * 100) / total, (((double) c_get.nxval + c_unify.nxval + c_put.nxval + c_write.nxval) * 100) / total, @@ -767,36 +765,36 @@ p_show_ops_by_group(void) (((double) c_get.nstru + c_unify.nstru + c_put.nstru + c_write.nstru) * 100) / total ); - fprintf(Yap_stderr, "\n Control Instructions Executed in %s \n", program); - fprintf(Yap_stderr, "Grouped as\n\n"); - fprintf(Yap_stderr, " CALL instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, "\n Control Instructions Executed in %s \n", program); + fprintf(GLOBAL_stderr, "Grouped as\n\n"); + fprintf(GLOBAL_stderr, " CALL instructions: %8d (%3d%%)\n", c_control.ncalls, (c_control.ncalls * 100) / total); - fprintf(Yap_stderr, " PROCEED instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " PROCEED instructions: %8d (%3d%%)\n", c_control.nproceeds, (c_control.nproceeds * 100) / total); - fprintf(Yap_stderr, " EXECUTE instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " EXECUTE instructions: %8d (%3d%%)\n", c_control.nexecs, (c_control.nexecs * 100) / total); - fprintf(Yap_stderr, " CUT instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " CUT instructions: %8d (%3d%%)\n", c_control.ncuts, (c_control.ncuts * 100) / total); - fprintf(Yap_stderr, " CALL_BIP instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " CALL_BIP instructions: %8d (%3d%%)\n", c_control.ncallbips, (c_control.ncallbips * 100) / total); - fprintf(Yap_stderr, " ALLOCATE instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " ALLOCATE instructions: %8d (%3d%%)\n", c_control.nallocs, (c_control.nallocs * 100) / total); - fprintf(Yap_stderr, " DEALLOCATE instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " DEALLOCATE instructions: %8d (%3d%%)\n", c_control.ndeallocs, (c_control.ndeallocs * 100) / total); - fprintf(Yap_stderr, "_______________________________________________\n"); - fprintf(Yap_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, + fprintf(GLOBAL_stderr, "_______________________________________________\n"); + fprintf(GLOBAL_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, (total * 100) / total); - fprintf(Yap_stderr, "\n Choice Point Manipulation Instructions Executed in %s \n", program); - fprintf(Yap_stderr, "Grouped as\n\n"); - fprintf(Yap_stderr, " TRY instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, "\n Choice Point Manipulation Instructions Executed in %s \n", program); + fprintf(GLOBAL_stderr, "Grouped as\n\n"); + fprintf(GLOBAL_stderr, " TRY instructions: %8d (%3d%%)\n", c_cp.ntries, (c_cp.ntries * 100) / total); - fprintf(Yap_stderr, " RETRY instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " RETRY instructions: %8d (%3d%%)\n", c_cp.nretries, (c_cp.nretries * 100) / total); - fprintf(Yap_stderr, " TRUST instructions: %8d (%3d%%)\n", + fprintf(GLOBAL_stderr, " TRUST instructions: %8d (%3d%%)\n", c_cp.ntrusts, (c_cp.ntrusts * 100) / total); - fprintf(Yap_stderr, "_______________________________________________\n"); - fprintf(Yap_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, + fprintf(GLOBAL_stderr, "_______________________________________________\n"); + fprintf(GLOBAL_stderr, " TOTAL instructions: %8d (%3d%%)\n\n", total, (total * 100) / total); return TRUE; @@ -828,7 +826,7 @@ p_show_sequences(void) return FALSE; } for (i = 0; i <= _std_top; ++i) { - sum += Yap_opcount[i]; + sum += GLOBAL_opcount[i]; } for (i = 0; i <= _std_top; ++i) { for (j = 0; j <= _std_top; ++j) { diff --git a/C/arrays.c b/C/arrays.c index 011e7ad94..52af62739 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -158,12 +158,11 @@ typedef struct MMAP_ARRAY_BLOCK { struct MMAP_ARRAY_BLOCK *next; } mmap_array_block; -static mmap_array_block *mmap_arrays = NULL; static Int CloseMmappedArray(StaticArrayEntry *pp, void *area USES_REGS) { - mmap_array_block *ptr = mmap_arrays, *optr = mmap_arrays; + mmap_array_block *ptr = GLOBAL_mmap_arrays, *optr = GLOBAL_mmap_arrays; while (ptr != NULL && ptr->start != area) { ptr = ptr->next; @@ -193,7 +192,7 @@ CloseMmappedArray(StaticArrayEntry *pp, void *area USES_REGS) static void ResizeMmappedArray(StaticArrayEntry *pp, Int dim, void *area USES_REGS) { - mmap_array_block *ptr = mmap_arrays; + mmap_array_block *ptr = GLOBAL_mmap_arrays; size_t total_size; while (ptr != NULL && ptr->start != area) { ptr = ptr->next; @@ -240,16 +239,16 @@ GetTermFromArray(DBTerm *ref USES_REGS) Term TRef; while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return TermNil; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return TermNil; } } @@ -611,7 +610,7 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra while ((p->ValueOfVE.floats = (Float *) Yap_AllocAtomSpace(asize) ) == NULL) { YAPLeaveCriticalSection(); if (!Yap_growheap(FALSE, asize, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return; } YAPEnterCriticalSection(); @@ -625,7 +624,7 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star if (EndOfPAEntr(p)) { while ((p = (StaticArrayEntry *) Yap_AllocAtomSpace(sizeof(*p))) == NULL) { if (!Yap_growheap(FALSE, sizeof(*p), NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -900,12 +899,12 @@ p_create_array( USES_REGS1 ) farray = Yap_MkFunctor(AtomArray, size); if (H+1+size > ASP-1024) { if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); return(FALSE); } else { if (H+1+size > ASP-1024) { if (!Yap_growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -938,7 +937,7 @@ p_create_array( USES_REGS1 ) if (H+1+size > ASP-1024) { WRITE_UNLOCK(ae->ARWLock); if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); return(FALSE); } else goto restart; @@ -960,7 +959,7 @@ p_create_array( USES_REGS1 ) } else { if (H+1+size > ASP-1024) { if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); return(FALSE); } else goto restart; @@ -1383,8 +1382,8 @@ p_create_mmapped_array( USES_REGS1 ) ptr->items = size; ptr->start = (void *)array_addr; ptr->fd = fd; - ptr->next = mmap_arrays; - mmap_arrays = ptr; + ptr->next = GLOBAL_mmap_arrays; + GLOBAL_mmap_arrays = ptr; WRITE_UNLOCK(pp->ArRWLock); WRITE_UNLOCK(ae->ARWLock); return TRUE; @@ -2244,7 +2243,7 @@ static Int p_sync_mmapped_arrays( USES_REGS1 ) { #ifdef HAVE_MMAP - mmap_array_block *ptr = mmap_arrays; + mmap_array_block *ptr = GLOBAL_mmap_arrays; while (ptr != NULL) { msync(ptr->start, ptr->size, MS_SYNC); ptr = ptr->next; @@ -2279,12 +2278,12 @@ p_static_array_to_term( USES_REGS1 ) while (H+1+dim > ASP-1024) { if (!Yap_gcl((1+dim)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); return(FALSE); } else { if (H+1+dim > ASP-1024) { if (!Yap_growstack( sizeof(CELL) * (dim+1-(H-ASP-1024)))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } diff --git a/C/attvar.c b/C/attvar.c index 4da17e98b..cdd9a327d 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -205,7 +205,7 @@ BuildAttTerm(Functor mfun, UInt ar USES_REGS) UInt i; if (H+(1024+ar) > ASP) { - Yap_Error_Size=ar*sizeof(CELL); + LOCAL_Error_Size=ar*sizeof(CELL); return 0L; } H[0] = (CELL)mfun; @@ -433,9 +433,9 @@ p_put_att( USES_REGS1 ) { attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar( PASS_REGS1 ))) { - Yap_Error_Size = sizeof(attvar_record); - if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(LOCAL_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } inp = Deref(ARG1); @@ -445,8 +445,8 @@ p_put_att( USES_REGS1 ) { mfun= Yap_MkFunctor(modname,ar); if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) { while (!(tatts = BuildAttTerm(mfun,ar PASS_REGS))) { - if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_gcl(LOCAL_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -474,9 +474,9 @@ p_put_att_term( USES_REGS1 ) { MaBind(&(attv->Atts), Deref(ARG2)); } else { while (!(attv = BuildNewAttVar( PASS_REGS1 ))) { - Yap_Error_Size = sizeof(attvar_record); - if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(LOCAL_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } inp = Deref(ARG1); @@ -508,9 +508,9 @@ p_rm_att( USES_REGS1 ) { attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar( PASS_REGS1 ))) { - Yap_Error_Size = sizeof(attvar_record); - if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(LOCAL_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } inp = Deref(ARG1); @@ -521,8 +521,8 @@ p_rm_att( USES_REGS1 ) { mfun= Yap_MkFunctor(modname,ar); if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) { while (!(tatts = BuildAttTerm(mfun, ar PASS_REGS))) { - if (!Yap_gcl(Yap_Error_Size, 4, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_gcl(LOCAL_Error_Size, 4, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -555,9 +555,9 @@ p_put_atts( USES_REGS1 ) { attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar( PASS_REGS1 ))) { - Yap_Error_Size = sizeof(attvar_record); - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } tatts = Deref(ARG2); @@ -902,7 +902,7 @@ AllAttVars( USES_REGS1 ) { case (CELL)FunctorAttVar: if (IsUnboundVar(pt+1)) { if (ASP - myH < 1024) { - Yap_Error_Size = (ASP-H)*sizeof(CELL); + LOCAL_Error_Size = (ASP-H)*sizeof(CELL); return 0L; } if (myH != H) { @@ -952,8 +952,8 @@ p_all_attvars( USES_REGS1 ) Term out; if (!(out = AllAttVars( PASS_REGS1 ))) { - if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { @@ -1044,11 +1044,11 @@ void Yap_InitAttVarPreds(void) Term OldCurrentModule = CurrentModule; CurrentModule = ATTRIBUTES_MODULE; #ifdef COROUTINING - attas[attvars_ext].bind_op = WakeAttVar; - attas[attvars_ext].copy_term_op = CopyAttVar; - attas[attvars_ext].to_term_op = AttVarToTerm; - attas[attvars_ext].term_to_op = TermToAttVar; - attas[attvars_ext].mark_op = mark_attvar; + GLOBAL_attas[attvars_ext].bind_op = WakeAttVar; + GLOBAL_attas[attvars_ext].copy_term_op = CopyAttVar; + GLOBAL_attas[attvars_ext].to_term_op = AttVarToTerm; + GLOBAL_attas[attvars_ext].term_to_op = TermToAttVar; + GLOBAL_attas[attvars_ext].mark_op = mark_attvar; Yap_InitCPred("get_att", 4, p_get_att, SafePredFlag); Yap_InitCPred("get_module_atts", 2, p_get_atts, SafePredFlag); Yap_InitCPred("has_module_atts", 2, p_has_atts, SafePredFlag); diff --git a/C/bignum.c b/C/bignum.c index 5304a4faf..6aac3488f 100755 --- a/C/bignum.c +++ b/C/bignum.c @@ -233,7 +233,7 @@ p_rational( USES_REGS1 ) (mpq_numref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) + (mpq_denref(rat)->_mp_alloc)*(sizeof(mp_limb_t)/CellSize); if (!Yap_gcl(size, 3, ENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, t, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, t, LOCAL_ErrorMessage); return FALSE; } } diff --git a/C/c_interface.c b/C/c_interface.c index 320de21e7..5ef8d66c9 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -334,6 +334,7 @@ #include "clause.h" #include "yapio.h" #include "attvar.h" +#include "SWI-Stream.h" #if HAVE_STDARG_H #include #endif @@ -458,6 +459,7 @@ X_API int STD_PROTO(YAP_GoalHasException,(Term *)); X_API void STD_PROTO(YAP_ClearExceptions,(void)); X_API int STD_PROTO(YAP_ContinueGoal,(void)); X_API void STD_PROTO(YAP_PruneGoal,(void)); +X_API IOSTREAM *STD_PROTO(YAP_TermToStream,(Term)); X_API IOSTREAM *STD_PROTO(YAP_InitConsult,(int, char *)); X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *)); X_API Term STD_PROTO(YAP_Read, (IOSTREAM *)); @@ -761,7 +763,7 @@ YAP_MkBlobTerm(unsigned int sz) while (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) { if (!doexpand((sz+sizeof(MP_INT)/sizeof(CELL)+2)*sizeof(CELL))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, "YAP failed to grow the stack while constructing a blob: %s", LOCAL_ErrorMessage); return TermNil; } } @@ -857,7 +859,7 @@ YAP_LookupAtom(char *c) a = Yap_LookupAtom(c); if (a == NIL || (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL)) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } else { return a; @@ -875,7 +877,7 @@ YAP_LookupWideAtom(wchar_t *c) a = Yap_LookupWideAtom(c); if (a == NIL || (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL)) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } else { return a; @@ -893,7 +895,7 @@ YAP_FullLookupAtom(char *c) at = Yap_FullLookupAtom(c); if (at == NIL || (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL)) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } else { return at; @@ -1794,7 +1796,7 @@ YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) { BACKUP_MACHINE_REGS(); while ((new_ptr = Yap_ReallocCodeSpace(ptr,size)) == NULL) { if (!Yap_growheap(FALSE, size, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -1810,7 +1812,7 @@ YAP_AllocSpaceFromYap(unsigned int size) while ((ptr = Yap_AllocCodeSpace(size)) == NULL) { if (!Yap_growheap(FALSE, size, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -1927,35 +1929,35 @@ YAP_ReadBuffer(char *s, Term *tp) BACKUP_H(); while ((t = Yap_StringToTerm(s,tp)) == 0L) { - if (Yap_ErrorMessage) { - if (!strcmp(Yap_ErrorMessage,"Stack Overflow")) { + if (LOCAL_ErrorMessage) { + if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) { if (!dogc()) { - *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); - Yap_ErrorMessage = NULL; + *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); + LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } - } else if (!strcmp(Yap_ErrorMessage,"Heap Overflow")) { + } else if (!strcmp(LOCAL_ErrorMessage,"Heap Overflow")) { if (!Yap_growheap(FALSE, 0, NULL)) { - *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); - Yap_ErrorMessage = NULL; + *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); + LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } - } else if (!strcmp(Yap_ErrorMessage,"Trail Overflow")) { + } else if (!strcmp(LOCAL_ErrorMessage,"Trail Overflow")) { if (!Yap_growtrail (0, FALSE)) { - *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); - Yap_ErrorMessage = NULL; + *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); + LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } } else { - *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); - Yap_ErrorMessage = NULL; + *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); + LOCAL_ErrorMessage = NULL; RECOVER_H(); return 0L; } - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; continue; } else { break; @@ -2138,9 +2140,9 @@ run_emulator(YAP_dogoalinfo *dgi) int out; BACKUP_MACHINE_REGS(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; out = Yap_absmi(0); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; myB = (choiceptr)(LCL0-dgi->b); CP = myB->cp_cp; if (!out ) { @@ -2274,9 +2276,9 @@ YAP_RunGoal(Term t) BACKUP_MACHINE_REGS(); LOCAL_AllowRestart = FALSE; - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; out = Yap_RunTopGoal(t); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; if (out) { P = (yamop *)ENV[E_CP]; ENV = (CELL *)ENV[E_E]; @@ -2300,9 +2302,9 @@ YAP_RunGoalOnce(Term t) yamop *old_CP = CP; BACKUP_MACHINE_REGS(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; out = Yap_RunTopGoal(t); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; if (out) { choiceptr cut_pt; @@ -2338,9 +2340,9 @@ YAP_RestartGoal(void) if (LOCAL_AllowRestart) { P = (yamop *)FAILCODE; do_putcf = myputc; - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; out = Yap_exec_absmi(TRUE); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; if (out == FALSE) { /* cleanup */ Yap_CloseSlots( PASS_REGS1 ); @@ -2396,12 +2398,13 @@ YAP_ShutdownGoal(int backtrack) X_API int YAP_ContinueGoal(void) { + CACHE_REGS int out; BACKUP_MACHINE_REGS(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; out = Yap_exec_absmi(TRUE); - Yap_PrologMode = UserCCallMode; + LOCAL_PrologMode = UserCCallMode; RECOVER_MACHINE_REGS(); return(out); @@ -2432,22 +2435,22 @@ YAP_GoalHasException(Term *t) BACKUP_MACHINE_REGS(); if (EX) { do { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; *t = Yap_FetchTermFromDB(EX); - if (Yap_Error_TYPE == YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == YAP_NO_ERROR) { RECOVER_MACHINE_REGS(); return TRUE; - } else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + } else if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(EX->NOfCells*CellSize)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } @@ -2487,6 +2490,22 @@ YAP_InitConsult(int mode, char *filename) return st; } +X_API IOSTREAM * +YAP_TermToStream(Term t) +{ + CACHE_REGS + IOSTREAM *s; + int rc; + BACKUP_MACHINE_REGS(); + + if ( (rc=PL_get_stream_handle(Yap_InitSlot(t PASS_REGS), &s)) ) { + RECOVER_MACHINE_REGS(); + return s; + } + RECOVER_MACHINE_REGS(); + return NULL; +} + X_API void YAP_EndConsult(IOSTREAM *s) { @@ -2508,20 +2527,20 @@ YAP_Read(IOSTREAM *inp) BACKUP_MACHINE_REGS(); - tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp, &tpos); - if (Yap_ErrorMessage) + tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, &tpos); + if (LOCAL_ErrorMessage) { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); RECOVER_MACHINE_REGS(); return 0; } if (inp->flags & (SIO_FEOF|SIO_FEOF2)) { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); RECOVER_MACHINE_REGS(); return MkAtomTerm (AtomEof); } t = Yap_Parse(); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); RECOVER_MACHINE_REGS(); return t; @@ -2572,7 +2591,7 @@ YAP_CompileClause(Term t) BACKUP_MACHINE_REGS(); /* allow expansion during stack initialization */ - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; ARG1 = t; YAPEnterCriticalSection(); codeaddr = Yap_cclause (t,0, mod, t); @@ -2580,18 +2599,18 @@ YAP_CompileClause(Term t) t = Deref(ARG1); /* just in case there was an heap overflow */ if (!Yap_addclause (t, codeaddr, TRUE, mod, &tn)) { YAPLeaveCriticalSection(); - return Yap_ErrorMessage; + return LOCAL_ErrorMessage; } } YAPLeaveCriticalSection(); if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); } } RECOVER_MACHINE_REGS(); - return(Yap_ErrorMessage); + return(LOCAL_ErrorMessage); } static int eof_found = FALSE; @@ -2708,8 +2727,14 @@ YAP_Init(YAP_init_args *yap_init) CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; static char boot_file[256]; - Yap_argv = yap_init->Argv; - Yap_argc = yap_init->Argc; + Yap_InitPageSize(); /* init memory page size, required by later functions */ +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) + Yap_init_yapor_global_local_memory(); + LOCAL = REMOTE(0); +#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ + Yap_InitSysbits(); /* init signal handling and time, required by later functions */ + GLOBAL_argv = yap_init->Argv; + GLOBAL_argc = yap_init->Argc; #if !BOOT_FROM_SAVED_STATE if (yap_init->SavedState) { fprintf(stderr,"[ WARNING: threaded YAP will ignore saved state %s ]\n",yap_init->SavedState); @@ -2718,8 +2743,8 @@ YAP_Init(YAP_init_args *yap_init) #endif if (BOOT_FROM_SAVED_STATE && !do_bootstrap) { if (Yap_SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap) != 1) { - yap_init->ErrorNo = Yap_Error_TYPE; - yap_init->ErrorCause = Yap_ErrorMessage; + yap_init->ErrorNo = LOCAL_Error_TYPE; + yap_init->ErrorCause = LOCAL_ErrorMessage; return YAP_BOOT_ERROR; } } @@ -2754,7 +2779,7 @@ YAP_Init(YAP_init_args *yap_init) } else { Heap = yap_init->HeapSize; } - Yap_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts; + GLOBAL_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts; Yap_InitWorkspace(Heap, Stack, Trail, Atts, yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, @@ -2770,14 +2795,14 @@ YAP_Init(YAP_init_args *yap_init) Trail = MinTrailSpace; if (Stack < MinStackSpace) Stack = MinStackSpace; - if (!(Yap_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) { + if (!(LOCAL_GlobalBase = (ADDR)malloc((Trail+Stack)*1024))) { yap_init->ErrorNo = RESOURCE_ERROR_MEMORY; yap_init->ErrorCause = "could not allocate stack space for main thread"; return YAP_BOOT_ERROR; } #if THREADS /* don't forget this is a thread */ - LOCAL_ThreadHandle.stack_address = Yap_GlobalBase; + LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase; LOCAL_ThreadHandle.ssize = Trail+Stack; #endif #endif @@ -2813,8 +2838,8 @@ YAP_Init(YAP_init_args *yap_init) } else if (BOOT_FROM_SAVED_STATE) { restore_result = Yap_Restore(yap_init->SavedState, yap_init->YapLibDir); if (restore_result == FAIL_RESTORE) { - yap_init->ErrorNo = Yap_Error_TYPE; - yap_init->ErrorCause = Yap_ErrorMessage; + yap_init->ErrorNo = LOCAL_Error_TYPE; + yap_init->ErrorCause = LOCAL_ErrorMessage; /* shouldn't RECOVER_MACHINE_REGS(); be here ??? */ return YAP_BOOT_ERROR; } @@ -2823,10 +2848,10 @@ YAP_Init(YAP_init_args *yap_init) } yap_flags[FAST_BOOT_FLAG] = yap_init->FastBoot; #if defined(YAPOR) || defined(TABLING) - Yap_init_root_frames(); + Yap_init_root_frames(); #endif /* YAPOR || TABLING */ #ifdef YAPOR - init_yapor_workers(); + Yap_init_yapor_workers(); if (worker_id != 0) { #if defined(YAPOR_COPY) || defined(YAPOR_SBA) /* @@ -2900,8 +2925,8 @@ YAP_Init(YAP_init_args *yap_init) } if (BOOT_FROM_SAVED_STATE && !do_bootstrap) { if (restore_result == FAIL_RESTORE) { - yap_init->ErrorNo = Yap_Error_TYPE; - yap_init->ErrorCause = Yap_ErrorMessage; + yap_init->ErrorNo = LOCAL_Error_TYPE; + yap_init->ErrorCause = LOCAL_ErrorMessage; return YAP_BOOT_ERROR; } if (Atts && Atts*1024 > 2048*sizeof(CELL)) @@ -3050,7 +3075,7 @@ X_API void YAP_SetOutputMessage(void) { #if DEBUG - Yap_output_msg = TRUE; + GLOBAL_output_msg = TRUE; #endif } @@ -3090,11 +3115,12 @@ YAP_Throw(Term t) X_API void YAP_AsyncThrow(Term t) -{ +{ + CACHE_REGS BACKUP_MACHINE_REGS(); - Yap_PrologMode |= AsyncIntMode; + LOCAL_PrologMode |= AsyncIntMode; Yap_JumpToEnv(t); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; RECOVER_MACHINE_REGS(); } @@ -3307,13 +3333,13 @@ YAP_cwd(void) CACHE_REGS char *buf; int len; - if (!Yap_getcwd(Yap_FileNameBuf, YAP_FILENAME_MAX)) + if (!Yap_getcwd(LOCAL_FileNameBuf, YAP_FILENAME_MAX)) return FALSE; - len = strlen(Yap_FileNameBuf); + len = strlen(LOCAL_FileNameBuf); buf = Yap_AllocCodeSpace(len+1); if (!buf) return NULL; - strncpy(buf, Yap_FileNameBuf, len); + strncpy(buf, LOCAL_FileNameBuf, len); return buf; } @@ -3445,22 +3471,22 @@ YAP_Recorded(void *handle) BACKUP_MACHINE_REGS(); do { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; t = Yap_FetchTermFromDB(dbterm); - if (Yap_Error_TYPE == YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == YAP_NO_ERROR) { RECOVER_MACHINE_REGS(); return t; - } else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + } else if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(dbterm->NOfCells*CellSize)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); RECOVER_MACHINE_REGS(); return FALSE; } diff --git a/C/cdmgr.c b/C/cdmgr.c index ca44ea0ee..a9451845b 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -483,9 +483,6 @@ STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, yamop *)); STATIC_PROTO(void expand_consult, ( void )); STATIC_PROTO(int not_was_reconsulted, (PredEntry *, Term, int)); STATIC_PROTO(int RemoveIndexation, (PredEntry *)); -#if EMACS -STATIC_PROTO(int last_clause_number, (PredEntry *)); -#endif STATIC_PROTO(int static_in_use, (PredEntry *, int)); #if !defined(YAPOR) && !defined(THREADS) STATIC_PROTO(Int search_for_static_predicate_in_use, (PredEntry *, int)); @@ -961,7 +958,7 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc) #ifdef DEBUG CACHE_REGS - if (Yap_Option['i' - 'a' + 1]) { + if (GLOBAL_Option['i' - 'a' + 1]) { Term tmod = ap->ModuleOfPred; if (!tmod) tmod = TermProlog; @@ -1020,7 +1017,7 @@ IPred(PredEntry *ap, UInt NSlots, yamop *next_pc) ap->OpcodeOfPred = ap->CodeOfPred->opc; } #ifdef DEBUG - if (Yap_Option['i' - 'a' + 1]) + if (GLOBAL_Option['i' - 'a' + 1]) Yap_DebugPutc(LOCAL_c_error_stream,'\n'); #endif } @@ -1961,7 +1958,7 @@ static void expand_consult( void ) /* I assume it always works ;-) */ while ((new_cl = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj)*LOCAL_ConsultCapacity)) == NULL) { if (!Yap_growheap(FALSE, sizeof(consult_obj)*LOCAL_ConsultCapacity, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR,TermNil,LOCAL_ErrorMessage); return; } } @@ -2027,21 +2024,21 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use) ti[0] = MkAtomTerm(AbsAtom(ap)); ti[1] = MkIntegerTerm(Arity); t = Yap_MkApplTerm(FunctorSlash, 2, ti); - Yap_ErrorMessage = Yap_ErrorSay; - Yap_Error_Term = t; - Yap_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE; + LOCAL_ErrorMessage = LOCAL_ErrorSay; + LOCAL_Error_Term = t; + LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE; if (in_use) { if (Arity == 0) - sprintf(Yap_ErrorMessage, "static predicate %s is in use", ap->StrOfAE); + sprintf(LOCAL_ErrorMessage, "static predicate %s is in use", ap->StrOfAE); else - sprintf(Yap_ErrorMessage, + sprintf(LOCAL_ErrorMessage, "static predicate %s/" Int_FORMAT " is in use", ap->StrOfAE, Arity); } else { if (Arity == 0) - sprintf(Yap_ErrorMessage, "system predicate %s", ap->StrOfAE); + sprintf(LOCAL_ErrorMessage, "system predicate %s", ap->StrOfAE); else - sprintf(Yap_ErrorMessage, + sprintf(LOCAL_ErrorMessage, "system predicate %s/" Int_FORMAT, ap->StrOfAE, Arity); } @@ -2199,7 +2196,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) if (mode == consult) not_was_reconsulted(p, t, TRUE); /* always check if we have a valid error first */ - if (Yap_ErrorMessage && Yap_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE) { + if (LOCAL_ErrorMessage && LOCAL_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE) { UNLOCKPE(31,p); return TermNil; } @@ -2438,25 +2435,6 @@ Yap_add_logupd_clause(PredEntry *pe, LogUpdClause *cl, int mode) { } } -#if EMACS - -/* - * the place where one would add a new clause for the propriety pred_prop - */ -int -where_new_clause(pred_prop, mode) - Prop pred_prop; - int mode; -{ - PredEntry *p = RepPredProp(pred_prop); - - if (mode == consult && not_was_reconsulted(p, TermNil, FALSE)) - return (1); - else - return (p->cs.p_code.NOfClauses + 1); -} -#endif - static Int p_compile( USES_REGS1 ) { /* '$compile'(+C,+Flags, Mod) */ @@ -2475,15 +2453,15 @@ p_compile( USES_REGS1 ) codeadr = Yap_cclause(t, 4, mod, Deref(ARG3)); /* vsc: give the number of arguments to cclause in case there is overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */ - if (!Yap_ErrorMessage) + if (!LOCAL_ErrorMessage) addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod, &tn); YAPLeaveCriticalSection(); - if (Yap_ErrorMessage) { + if (LOCAL_ErrorMessage) { if (IntOfTerm(t1) & 4) { - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, - "in line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, + "in line %d, %s", Yap_FirstLineInParse(), LOCAL_ErrorMessage); } else { - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); } return FALSE; } @@ -2517,16 +2495,16 @@ p_compile_dynamic( USES_REGS1 ) code_adr = Yap_cclause(t, 5, mod, Deref(ARG3)); /* vsc: give the number of arguments to cclause() in case there is a overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */ - if (!Yap_ErrorMessage) { + if (!LOCAL_ErrorMessage) { optimizer_on = old_optimize; addclause(t, code_adr, mode , mod, &ARG5); } - if (Yap_ErrorMessage) { - if (!Yap_Error_Term) - Yap_Error_Term = TermNil; - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + if (LOCAL_ErrorMessage) { + if (!LOCAL_Error_Term) + LOCAL_Error_Term = TermNil; + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); YAPLeaveCriticalSection(); return FALSE; } @@ -3408,9 +3386,9 @@ all_envs(CELL *env_ptr USES_REGS) bp[0] = MkIntegerTerm(LCL0-env_ptr); if (H >= ASP-1024) { H = start; - Yap_Error_Size = (ASP-1024)-H; + LOCAL_Error_Size = (ASP-1024)-H; while (env_ptr) { - Yap_Error_Size += 2; + LOCAL_Error_Size += 2; env_ptr = (CELL *)(env_ptr[E_E]); } return 0L; @@ -3437,9 +3415,9 @@ all_cps(choiceptr b_ptr USES_REGS) bp[0] = MkIntegerTerm((Int)(LCL0-(CELL *)b_ptr)); if (H >= ASP-1024) { H = start; - Yap_Error_Size = (ASP-1024)-H; + LOCAL_Error_Size = (ASP-1024)-H; while (b_ptr) { - Yap_Error_Size += 2; + LOCAL_Error_Size += 2; b_ptr = b_ptr->cp_b; } return 0L; @@ -3485,7 +3463,7 @@ p_all_choicepoints( USES_REGS1 ) { Term t; while ((t = all_cps(B PASS_REGS)) == 0L) { - if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while dumping choicepoints"); return FALSE; } @@ -3498,7 +3476,7 @@ p_all_envs( USES_REGS1 ) { Term t; while ((t = all_envs(ENV PASS_REGS)) == 0L) { - if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while dumping environments"); return FALSE; } @@ -3511,7 +3489,7 @@ p_current_stack( USES_REGS1 ) { Term t; while ((t = all_calls( PASS_REGS1 )) == 0L) { - if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while dumping stack"); return FALSE; } @@ -4484,18 +4462,18 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya ARG5 = th; ARG6 = tb; ARG7 = tr; - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { UNLOCK(pe->PELock); - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 7, ENV, gc_P(P,CP))) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 7, ENV, gc_P(P,CP))) { UNLOCK(pe->PELock); - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -4506,9 +4484,9 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya ARG6 = th; ARG7 = tb; ARG8 = tr; - if (!Yap_gcl(Yap_Error_Size, 8, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 8, ENV, gc_P(P,CP))) { UNLOCK(pe->PELock); - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } th = ARG6; @@ -4632,18 +4610,18 @@ fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th, Term tb, Term ARG5 = th; ARG6 = tb; ARG7 = tr; - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { UNLOCK(pe->PELock); - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 7, ENV, gc_P(P,CP))) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 7, ENV, gc_P(P,CP))) { UNLOCK(pe->PELock); - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -4654,9 +4632,9 @@ fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th, Term tb, Term ARG6 = th; ARG7 = tb; ARG8 = tr; - if (!Yap_gcl(Yap_Error_Size, 8, ENV, CP)) { + if (!Yap_gcl(LOCAL_Error_Size, 8, ENV, CP)) { UNLOCK(pe->PELock); - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } th = ARG6; @@ -4870,7 +4848,7 @@ Yap_UpdateTimestamps(PredEntry *ap) return; overflow: if (!Yap_growstack(64*1024)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return; } goto restart; @@ -4969,19 +4947,19 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr } while ((t = Yap_FetchTermFromDB(cl->usc.ClSource)) == 0L) { if (first_time) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; ARG5 = th; ARG6 = tb; ARG7 = tr; if (!Yap_gc(7, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } th = ARG5; @@ -4989,12 +4967,12 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr tr = ARG7; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; ARG6 = th; ARG7 = tb; ARG8 = tr; - if (!Yap_gcl(Yap_Error_Size, 8, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_gcl(LOCAL_Error_Size, 8, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } th = ARG6; diff --git a/C/cmppreds.c b/C/cmppreds.c index 0b390b7d6..9402f82c7 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -513,9 +513,9 @@ a_cmp(Term t1, Term t2 USES_REGS) Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - Yap_Error_Term = t2; - Yap_ErrorMessage = "trying to evaluate nan"; + LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = "trying to evaluate nan"; LOCAL_ArithError = TRUE; } #endif @@ -531,9 +531,9 @@ a_cmp(Term t1, Term t2 USES_REGS) Float f1 = FloatOfTerm(t1); #if HAVE_ISNAN if (isnan(f1)) { - Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - Yap_Error_Term = t1; - Yap_ErrorMessage = "trying to evaluate nan"; + LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; + LOCAL_Error_Term = t1; + LOCAL_ErrorMessage = "trying to evaluate nan"; LOCAL_ArithError = TRUE; } #endif @@ -550,9 +550,9 @@ a_cmp(Term t1, Term t2 USES_REGS) Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - Yap_Error_Term = t2; - Yap_ErrorMessage = "trying to evaluate nan"; + LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = "trying to evaluate nan"; LOCAL_ArithError = TRUE; } #endif @@ -575,9 +575,9 @@ a_cmp(Term t1, Term t2 USES_REGS) Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - Yap_Error_Term = t2; - Yap_ErrorMessage = "trying to evaluate nan"; + LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = "trying to evaluate nan"; LOCAL_ArithError = TRUE; } #endif @@ -603,7 +603,7 @@ p_acomp( USES_REGS1 ) Int out; out = a_cmp(t1, t2 PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out; } @@ -637,7 +637,7 @@ a_eq(Term t1, Term t2) } } out = a_cmp(t1,t2 PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out == 0; } @@ -646,7 +646,7 @@ a_dif(Term t1, Term t2) { CACHE_REGS Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out != 0; } @@ -655,7 +655,7 @@ a_gt(Term t1, Term t2) { /* A > B */ CACHE_REGS Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out > 0; } @@ -664,7 +664,7 @@ a_ge(Term t1, Term t2) { /* A >= B */ CACHE_REGS Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out >= 0; } @@ -673,7 +673,7 @@ a_lt(Term t1, Term t2) { /* A < B */ CACHE_REGS Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out < 0; } @@ -682,7 +682,7 @@ a_le(Term t1, Term t2) { /* A <= B */ CACHE_REGS Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS); - if (LOCAL_ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } return out <= 0; } diff --git a/C/compiler.c b/C/compiler.c index 777ca826e..03d759216 100755 --- a/C/compiler.c +++ b/C/compiler.c @@ -286,7 +286,7 @@ active_branch(int i, int onbranch) return(i==onbranch);*/ } -#define FAIL(M,T,E) { Yap_ErrorMessage=M; Yap_Error_TYPE = T; Yap_Error_Term = E; return; } +#define FAIL(M,T,E) { LOCAL_ErrorMessage=M; LOCAL_Error_TYPE = T; LOCAL_Error_Term = E; return; } #if USE_SYSTEM_MALLOC #define IsNewVar(v) ((CELL *)(v) >= H0 && (CELL *)(v) < LCL0) @@ -567,9 +567,9 @@ compile_sf_term(Term t, int argno, int level) if (IsAtomicTerm(t)) Yap_emit((cglobs->onhead ? unify_s_a_op : write_s_a_op), t, (CELL) argno, &cglobs->cint); else if (!IsVarTerm(t)) { - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "illegal argument of soft functor"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "illegal argument of soft functor"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } @@ -595,9 +595,9 @@ c_args(Term app, unsigned int level, compiler_struct *cglobs) if (level == 0) { if (Arity >= MaxTemps) { - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "exceed maximum arity of compiled goal"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "exceed maximum arity of compiled goal"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } @@ -619,7 +619,7 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s while ((g=Yap_SizeGroundTerm(t,TRUE)) < 0) { /* oops, too deep a term */ save_machine_regs(); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_AUX_BOTCH); } if (g < 16) @@ -628,18 +628,18 @@ try_store_as_dbterm(Term t, Int argno, unsigned int arity, int level, compiler_s H = CellPtr(cglobs->cint.freep); if ((dbt = Yap_StoreTermInDB(t, -1)) == NULL) { H = h0; - switch(Yap_Error_TYPE) { + switch(LOCAL_Error_TYPE) { case OUT_OF_STACK_ERROR: - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_STACK_BOTCH); case OUT_OF_TRAIL_ERROR: - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TRAIL_BOTCH); case OUT_OF_HEAP_ERROR: - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_HEAP_BOTCH); case OUT_OF_AUXSPACE_ERROR: - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_AUX_BOTCH); default: siglongjmp(cglobs->cint.CompilerBotch,COMPILER_ERR_BOTCH); @@ -1010,11 +1010,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler } else { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_NUMBER; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2 with output bound", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2 with output bound", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1025,11 +1025,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler if (IsNewVar(t2)) { char s[32]; - Yap_Error_TYPE = INSTANTIATION_ERROR; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/3",s); + sprintf(LOCAL_ErrorMessage, "compiling %s/3",s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1041,11 +1041,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler if (!IsIntegerTerm(t2)) { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_INTEGER; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling functor/3"); + sprintf(LOCAL_ErrorMessage, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1053,11 +1053,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler if (i2 < 0) { char s[32]; - Yap_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling functor/3"); + sprintf(LOCAL_ErrorMessage, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1068,11 +1068,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler } else if (!IsAtomTerm(t1)) { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_ATOM; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling functor/3"); + sprintf(LOCAL_ErrorMessage, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1126,11 +1126,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler else { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_INTEGER; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1138,11 +1138,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler (IsApplTerm(t2) && IsExtensionFunctor(FunctorOfTerm(t2)))) { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_COMPOUND; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_COMPOUND; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } else if (IsApplTerm(t2)) { @@ -1169,11 +1169,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler } else { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_INTEGER; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1182,11 +1182,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler if (!IsAtomicTerm(t1)) { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_ATOM; - Yap_Error_Term = t1; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; + LOCAL_Error_Term = t1; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } else { @@ -1197,11 +1197,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler if (!IsIntegerTerm(t2)) { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_INTEGER; - Yap_Error_Term = t2; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; + LOCAL_Error_Term = t2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1215,11 +1215,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler if (!IsAtomTerm(t1)) { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_ATOM; - Yap_Error_Term = t1; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; + LOCAL_Error_Term = t1; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1259,11 +1259,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler } else { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_VARIABLE; - Yap_Error_Term = t1; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_VARIABLE; + LOCAL_Error_Term = t1; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2 with output bound", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2 with output bound", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1282,11 +1282,11 @@ c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler } else { char s[32]; - Yap_Error_TYPE = TYPE_ERROR_VARIABLE; - Yap_Error_Term = t3; - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = TYPE_ERROR_VARIABLE; + LOCAL_Error_Term = t3; + LOCAL_ErrorMessage = LOCAL_ErrorSay; Yap_bip_name(Op, s); - sprintf(Yap_ErrorMessage, "compiling %s/2 with input unbound", s); + sprintf(LOCAL_ErrorMessage, "compiling %s/2 with input unbound", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -1450,12 +1450,12 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) if (IsVarTerm(M) || !IsAtomTerm(M)) { CACHE_REGS if (IsVarTerm(M)) { - Yap_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_TYPE = INSTANTIATION_ERROR; } else { - Yap_Error_TYPE = TYPE_ERROR_ATOM; + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } - Yap_Error_Term = M; - Yap_ErrorMessage = "in module name"; + LOCAL_Error_Term = M; + LOCAL_ErrorMessage = "in module name"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } @@ -1469,8 +1469,8 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) FAIL("goal can not be a number", TYPE_ERROR_CALLABLE, Goal); } else if (IsRefTerm(Goal)) { CACHE_REGS - Yap_Error_TYPE = TYPE_ERROR_DBREF; - Yap_Error_Term = Goal; + LOCAL_Error_TYPE = TYPE_ERROR_DBREF; + LOCAL_Error_Term = Goal; FAIL("goal argument in static procedure can not be a data base reference", TYPE_ERROR_CALLABLE, Goal); } else if (IsPairTerm(Goal)) { @@ -1906,10 +1906,10 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) Term a2 = ArgOfTerm(2,Goal); if (IsVarTerm(a2) && !IsNewVar(a2)) { if (IsNewVar(a2)) { - Yap_Error_TYPE = INSTANTIATION_ERROR; - Yap_Error_Term = a2; - Yap_ErrorMessage = Yap_ErrorSay; - sprintf(Yap_ErrorMessage, "compiling %s/2 with second arg unbound", RepAtom(NameOfFunctor(p->FunctorOfPred))->StrOfAE); + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = a2; + LOCAL_ErrorMessage = LOCAL_ErrorSay; + sprintf(LOCAL_ErrorMessage, "compiling %s/2 with second arg unbound", RepAtom(NameOfFunctor(p->FunctorOfPred))->StrOfAE); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch,1); } @@ -2314,9 +2314,9 @@ clear_bvarray(int var, CELL *bvarray if (*bvarray & nbit) { CACHE_REGS /* someone had already marked this variable: complain */ - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "compiler internal error: variable initialised twice"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "compiler internal error: variable initialised twice"; fprintf(stderr," vsc: compiling7\n"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); @@ -2357,9 +2357,9 @@ push_bvmap(int label, PInstr *pcpc, compiler_struct *cglobs) { if (bvindex == MAX_DISJUNCTIONS) { CACHE_REGS - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "Too many embedded disjunctions"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "Too many embedded disjunctions"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } @@ -2381,9 +2381,9 @@ reset_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs) if (bvindex == 0) { CACHE_REGS - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "No embedding in disjunctions"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "No embedding in disjunctions"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } @@ -2402,9 +2402,9 @@ pop_bvmap(CELL *bvarray, int nperm, compiler_struct *cglobs) { if (bvindex == 0) { CACHE_REGS - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "Too few embedded disjunctions"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "Too few embedded disjunctions"; /* save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); */ } @@ -2673,9 +2673,9 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs) } if (target1 == cglobs->MaxCTemps) { CACHE_REGS - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "too many temporaries"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "too many temporaries"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH); } @@ -2807,9 +2807,9 @@ c_layout(compiler_struct *cglobs) #ifdef DEBUG if (cglobs->pbvars != nperm) { CACHE_REGS - Yap_Error_TYPE = INTERNAL_COMPILER_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "wrong number of variables found in bitmap"; + LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "wrong number of variables found in bitmap"; save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } @@ -3357,7 +3357,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) compiler_struct cglobs; /* make sure we know there was no error yet */ - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; if ((botch_why = sigsetjmp(cglobs.cint.CompilerBotch, 0))) { restore_machine_regs(); reset_vars(cglobs.vtable); @@ -3371,14 +3371,14 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) ARG3 = src; YAPLeaveCriticalSection(); - if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, gc_P(P,CP))) { - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Term = inp_clause; + if (!Yap_gcl(LOCAL_Error_Size, NOfArgs, ENV, gc_P(P,CP))) { + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Term = inp_clause; } if (osize > ASP-H) { if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) { - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Term = inp_clause; + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Term = inp_clause; } } YAPEnterCriticalSection(); @@ -3391,9 +3391,9 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) YAPLeaveCriticalSection(); ARG1 = inp_clause; ARG3 = src; - if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL, TRUE)) { - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; - Yap_Error_Term = inp_clause; + if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) { + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_Term = inp_clause; } YAPEnterCriticalSection(); src = ARG3; @@ -3412,9 +3412,9 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) ARG1 = inp_clause; ARG3 = src; YAPLeaveCriticalSection(); - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_Error_Term = inp_clause; + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_Error_Term = inp_clause; return NULL; } YAPEnterCriticalSection(); @@ -3426,9 +3426,9 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) ARG1 = inp_clause; ARG3 = src; YAPLeaveCriticalSection(); - if (!Yap_growtrail(Yap_TrailTop-(ADDR)TR, FALSE)) { - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; - Yap_Error_Term = inp_clause; + if (!Yap_growtrail(LOCAL_TrailTop-(ADDR)TR, FALSE)) { + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_Error_Term = inp_clause; return NULL; } YAPEnterCriticalSection(); @@ -3441,9 +3441,9 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) } my_clause = inp_clause; HB = H; - Yap_ErrorMessage = NULL; - Yap_Error_Size = 0; - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_ErrorMessage = NULL; + LOCAL_Error_Size = 0; + LOCAL_Error_TYPE = YAP_NO_ERROR; /* initialize variables for code generation */ cglobs.cint.CodeStart = cglobs.cint.cpc = NULL; @@ -3457,7 +3457,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) cglobs.cint.success_handler = 0L; if (ASP <= CellPtr (cglobs.cint.freep) + 256) { cglobs.vtable = NULL; - Yap_Error_Size = (256+maxvnum)*sizeof(CELL); + LOCAL_Error_Size = (256+maxvnum)*sizeof(CELL); save_machine_regs(); siglongjmp(cglobs.cint.CompilerBotch,3); } @@ -3481,9 +3481,9 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) cglobs.is_a_fact = FALSE; cglobs.hasdbrefs = FALSE; if (IsVarTerm(my_clause)) { - Yap_Error_TYPE = INSTANTIATION_ERROR; - Yap_Error_Term = my_clause; - Yap_ErrorMessage = "in compiling clause"; + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = my_clause; + LOCAL_ErrorMessage = "in compiling clause"; return 0; } if (IsApplTerm(my_clause) && FunctorOfTerm(my_clause) == FunctorAssert) { @@ -3494,9 +3494,9 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) head = my_clause, body = MkAtomTerm(AtomTrue); } if (IsVarTerm(head) || IsPairTerm(head) || IsIntTerm(head) || IsFloatTerm(head) || IsRefTerm(head)) { - Yap_Error_TYPE = TYPE_ERROR_CALLABLE; - Yap_Error_Term = my_clause; - Yap_ErrorMessage = "clause should be atom or term"; + LOCAL_Error_TYPE = TYPE_ERROR_CALLABLE; + LOCAL_Error_Term = my_clause; + LOCAL_ErrorMessage = "clause should be atom or term"; return (0); } else { @@ -3544,10 +3544,10 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart; cglobs.cint.BlobsStart = NULL; } - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return (0); #ifdef DEBUG - if (Yap_Option['g' - 96]) + if (GLOBAL_Option['g' - 96]) Yap_ShowCode(&cglobs.cint); #endif } else { @@ -3577,10 +3577,10 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) if (B != NULL) { HB = B->cp_h; } - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return (0); #ifdef DEBUG - if (Yap_Option['g' - 96]) + if (GLOBAL_Option['g' - 96]) Yap_ShowCode(&cglobs.cint); #endif /* phase 2: classify variables and optimize temporaries */ @@ -3596,7 +3596,7 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) /* eliminate superfluous pop's and unify_var's */ c_optimize(cglobs.cint.CodeStart); #ifdef DEBUG - if (Yap_Option['f' - 96]) + if (GLOBAL_Option['f' - 96]) Yap_ShowCode(&cglobs.cint); #endif diff --git a/C/computils.c b/C/computils.c index ab2d14569..71f1784eb 100755 --- a/C/computils.c +++ b/C/computils.c @@ -75,12 +75,7 @@ STATIC_PROTO (void ShowOp, (char *, struct PSEUDO *)); * afterwards */ -#ifdef DEBUG -char Yap_Option[20]; - -YP_FILE *Yap_logfile; -#endif typedef struct mem_blk { union { @@ -121,7 +116,7 @@ AllocCMem (UInt size, struct intermediates *cip) blksz = FIRST_CMEM_BLK_SIZE; p = (struct mem_blk *)Yap_AllocCodeSpace(blksz); if (!p) { - Yap_Error_Size = size; + LOCAL_Error_Size = size; save_machine_regs(); siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH); } @@ -132,7 +127,7 @@ AllocCMem (UInt size, struct intermediates *cip) p = (struct mem_blk *)Yap_AllocCodeSpace(blksz); if (!p) { CACHE_REGS - Yap_Error_Size = size; + LOCAL_Error_Size = size; save_machine_regs(); siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH); } @@ -153,7 +148,7 @@ AllocCMem (UInt size, struct intermediates *cip) cip->freep += size; if (ASP <= CellPtr (cip->freep) + 256) { CACHE_REGS - Yap_Error_Size = 256+((char *)cip->freep - (char *)H); + LOCAL_Error_Size = 256+((char *)cip->freep - (char *)H); save_machine_regs(); siglongjmp(cip->CompilerBotch, OUT_OF_STACK_BOTCH); } diff --git a/C/cut_c.c b/C/cut_c.c index 7de08c8c6..36e461cc5 100755 --- a/C/cut_c.c +++ b/C/cut_c.c @@ -6,14 +6,14 @@ void cut_c_initialize(void){ CACHE_REGS - Yap_REGS.CUT_C_TOP=(cut_c_str_ptr)Yap_LocalBase; + Yap_REGS.CUT_C_TOP=(cut_c_str_ptr)LOCAL_LocalBase; } /*Removes a choice_point from the stack*/ void cut_c_pop(void){ CACHE_REGS cut_c_str_ptr to_delete = NULL; - if (((CELL *)Yap_REGS.CUT_C_TOP) == ((CELL *)Yap_LocalBase)) + if (((CELL *)Yap_REGS.CUT_C_TOP) == ((CELL *)LOCAL_LocalBase)) { return; } diff --git a/C/dbase.c b/C/dbase.c index efa76d597..bb7895bdc 100755 --- a/C/dbase.c +++ b/C/dbase.c @@ -160,7 +160,6 @@ typedef struct db_globs { UInt sz; /* total size */ } dbglobs; -static dbglobs *s_dbg; #ifdef SUPPORT_HASH_TABLES typedef struct { @@ -249,7 +248,7 @@ STATIC_PROTO(DBProp find_int_key, (Int)); static UInt new_trail_size(void) { CACHE_REGS - UInt sz = (Yap_TrailTop-(ADDR)TR)/2; + UInt sz = (LOCAL_TrailTop-(ADDR)TR)/2; if (sz < K64) return K64; if (sz > M1) @@ -261,10 +260,10 @@ static int recover_from_record_error(int nargs) { CACHE_REGS - switch(Yap_Error_TYPE) { + switch(LOCAL_Error_TYPE) { case OUT_OF_STACK_ERROR: - if (!Yap_gcl(Yap_Error_Size, nargs, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_gcl(LOCAL_Error_Size, nargs, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto recover_record; @@ -275,24 +274,24 @@ recover_from_record_error(int nargs) } goto recover_record; case OUT_OF_HEAP_ERROR: - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, Yap_Error_Term, Yap_ErrorMessage); + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } goto recover_record; case OUT_OF_AUXSPACE_ERROR: - if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL, TRUE)) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, Yap_Error_Term, Yap_ErrorMessage); + if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) { + Yap_Error(OUT_OF_AUXSPACE_ERROR, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } goto recover_record; default: - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } recover_record: - Yap_Error_Size = 0; - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_Size = 0; + LOCAL_Error_TYPE = YAP_NO_ERROR; return TRUE; } @@ -368,7 +367,7 @@ static Int cmpclls(CELL *a,CELL *b,Int n) #if !THREADS int Yap_DBTrailOverflow() { - return((CELL *)s_dbg->lr > (CELL *)s_dbg->tofref - 2048); + return((CELL *)LOCAL_s_dbg->lr > (CELL *)LOCAL_s_dbg->tofref - 2048); } #endif @@ -906,7 +905,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, the variable, the constraint in some cannonical form, what type of constraint, and a list pointer */ t[0] = (CELL)ptd0; - t[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0); + t[1] = GLOBAL_attas[ExtFromCell(ptd0)].to_term_op(ptd0); t[2] = MkIntegerTerm(ExtFromCell(ptd0)); t[3] = ConstraintsTerm; ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t); @@ -975,8 +974,8 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, return CodeMax; error: - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; - Yap_Error_Size = 1024+((char *)AuxSp-(char *)CodeMaxBase); + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_Size = 1024+((char *)AuxSp-(char *)CodeMaxBase); *vars_foundp = vars_found; #ifdef RATIONAL_TREES while (to_visit > to_visit_base) { @@ -994,7 +993,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, return NULL; error2: - Yap_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; *vars_foundp = vars_found; #ifdef RATIONAL_TREES while (to_visit > to_visit_base) { @@ -1012,7 +1011,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, return NULL; error_tr_overflow: - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; *vars_foundp = vars_found; #ifdef RATIONAL_TREES while (to_visit > to_visit_base) { @@ -1078,9 +1077,9 @@ sf_include(SFKeep *sfp, struct db_globs *dbg) *StoPoint++ = tvalue; j += 2; } else { - Yap_Error_TYPE = TYPE_ERROR_DBTERM; - Yap_Error_Term = d0; - Yap_ErrorMessage = "wrong term in SF"; + LOCAL_Error_TYPE = TYPE_ERROR_DBTERM; + LOCAL_Error_Term = d0; + LOCAL_ErrorMessage = "wrong term in SF"; return(NULL); } } @@ -1208,10 +1207,10 @@ static DBRef generate_dberror_msg(int errnumb, UInt sz, char *msg) { CACHE_REGS - Yap_Error_Size = sz; - Yap_Error_TYPE = errnumb; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = msg; + LOCAL_Error_Size = sz; + LOCAL_Error_TYPE = errnumb; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = msg; return NULL; } @@ -1365,11 +1364,11 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc SMALLUNSGN flag; int NOfLinks = 0; /* place DBRefs in ConsultStack */ - DBRef *TmpRefBase = (DBRef *)Yap_TrailTop; + DBRef *TmpRefBase = (DBRef *)LOCAL_TrailTop; CELL *CodeAbs; /* how much code did we find */ int vars_found = FALSE; - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (p == NULL) { if (IsVarTerm(Tm)) { @@ -1420,15 +1419,15 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc ppt0 = &(pp0->DBT); } if ((ADDR)ppt0 >= (ADDR)AuxSp-1024) { - Yap_Error_Size = (UInt)(extra_size+sizeof(ppt0)); - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_Size = (UInt)(extra_size+sizeof(ppt0)); + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; Yap_ReleasePreAllocCodeSpace((ADDR)pp0); return NULL; } ntp0 = ppt0->Contents; - if ((ADDR)TR >= Yap_TrailTop-1024) { - Yap_Error_Size = 0; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + if ((ADDR)TR >= LOCAL_TrailTop-1024) { + LOCAL_Error_Size = 0; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; Yap_ReleasePreAllocCodeSpace((ADDR)pp0); return NULL; } @@ -1501,7 +1500,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc } } CodeAbs = (CELL *)((CELL)ntp-(CELL)ntp0); - if (Yap_Error_TYPE) { + if (LOCAL_Error_TYPE) { Yap_ReleasePreAllocCodeSpace((ADDR)pp0); return NULL; /* Error Situation */ } @@ -1517,8 +1516,8 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc flag = DBComplex; CodeAbs += CellPtr(dbg->lr) - CellPtr(dbg->LinkAr); if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) { - Yap_Error_Size = (UInt)DBLength(CodeAbs); - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_Size = (UInt)DBLength(CodeAbs); + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; Yap_ReleasePreAllocCodeSpace((ADDR)pp0); return NULL; } @@ -1536,8 +1535,8 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc if (dbg->tofref != TmpRefBase) { CodeAbs += (TmpRefBase - dbg->tofref) + 1; if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) { - Yap_Error_Size = (UInt)DBLength(CodeAbs); - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_Size = (UInt)DBLength(CodeAbs); + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; Yap_ReleasePreAllocCodeSpace((ADDR)pp0); return NULL; } @@ -1647,7 +1646,7 @@ record(int Flag, Term key, Term t_data, Term t_code USES_REGS) int needs_vars; struct db_globs dbg; - s_dbg = &dbg; + LOCAL_s_dbg = &dbg; dbg.found_one = NULL; #ifdef SFUNC FathersPlace = NIL; @@ -1724,7 +1723,7 @@ record_at(int Flag, DBRef r0, Term t_data, Term t_code USES_REGS) int needs_vars; struct db_globs dbg; - s_dbg = &dbg; + LOCAL_s_dbg = &dbg; #ifdef SFUNC FathersPlace = NIL; #endif @@ -1799,6 +1798,7 @@ record_at(int Flag, DBRef r0, Term t_data, Term t_code USES_REGS) static LogUpdClause * new_lu_db_entry(Term t, PredEntry *pe) { + CACHE_REGS DBTerm *x; LogUpdClause *cl; yamop *ipc; @@ -1811,7 +1811,7 @@ new_lu_db_entry(Term t, PredEntry *pe) if (!(pe->PredFlags & ThreadLocalPredFlag)) d_flag |= InQueue; #endif - s_dbg = &dbg; + LOCAL_s_dbg = &dbg; ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e); if ((x = (DBTerm *)CreateDBStruct(t, NULL, d_flag, &needs_vars, (UInt)ipc, &dbg)) == NULL) { return NULL; /* crash */ @@ -1859,9 +1859,9 @@ Yap_new_ludbe(Term t, PredEntry *pe, UInt nargs) CACHE_REGS LogUpdClause *x; - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; while ((x = new_lu_db_entry(t, pe)) == NULL) { - if (Yap_Error_TYPE == YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == YAP_NO_ERROR) { break; } else { XREGS[nargs+1] = t; @@ -1951,7 +1951,7 @@ p_rcda( USES_REGS1 ) if (!IsVarTerm(Deref(ARG3))) return (FALSE); pe = find_lu_entry(t1); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: if (pe) { LogUpdClause *cl; @@ -1973,7 +1973,7 @@ p_rcda( USES_REGS1 ) } else { TRef = MkDBRefTerm(record(MkFirst, t1, Deref(ARG2), Unsigned(0) PASS_REGS)); } - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(3)) { goto restart_record; } else { @@ -1993,11 +1993,11 @@ p_rcdap( USES_REGS1 ) if (!IsVarTerm(Deref(ARG3))) return FALSE; - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, Unsigned(0) PASS_REGS)); - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(3)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2027,7 +2027,7 @@ p_rcda_at( USES_REGS1 ) Yap_Error(TYPE_ERROR_DBREF, t1, "recorda_at/3"); return FALSE; } - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: dbr = DBRefOfTerm(t1); if (dbr->Flags & ErasedMask) { @@ -2039,7 +2039,7 @@ p_rcda_at( USES_REGS1 ) } else { TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0) PASS_REGS)); } - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(3)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2061,7 +2061,7 @@ p_rcdz( USES_REGS1 ) if (!IsVarTerm(Deref(ARG3))) return (FALSE); pe = find_lu_entry(t1); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: if (pe) { LogUpdClause *cl; @@ -2083,7 +2083,7 @@ p_rcdz( USES_REGS1 ) } else { TRef = MkDBRefTerm(record(MkLast, t1, t2, Unsigned(0) PASS_REGS)); } - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(3)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2105,14 +2105,14 @@ Yap_Recordz(Atom at, Term t2) PredEntry *pe; pe = find_lu_entry(MkAtomTerm(at)); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: if (pe) { record_lu(pe, t2, MkLast); } else { record(MkLast, MkAtomTerm(at), t2, Unsigned(0) PASS_REGS); } - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { ARG1 = t2; if (recover_from_record_error(1)) { t2 = ARG1; @@ -2132,10 +2132,10 @@ p_rcdzp( USES_REGS1 ) if (!IsVarTerm(Deref(ARG3))) return (FALSE); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, Unsigned(0) PASS_REGS)); - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(3)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2165,7 +2165,7 @@ p_rcdz_at( USES_REGS1 ) Yap_Error(TYPE_ERROR_DBREF, t1, "recordz_at/3"); return FALSE; } - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: dbr = DBRefOfTerm(t1); if (dbr->Flags & ErasedMask) { @@ -2177,7 +2177,7 @@ p_rcdz_at( USES_REGS1 ) } else { TRef = MkDBRefTerm(record_at(MkLast, dbr, t2, Unsigned(0) PASS_REGS)); } - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(3)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2202,13 +2202,13 @@ p_rcdstatp( USES_REGS1 ) if (IsVarTerm(t3) || !IsIntTerm(t3)) return (FALSE); mk_first = ((IntOfTerm(t3) % 4) == 2); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: if (mk_first) TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, MkIntTerm(0) PASS_REGS)); else TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, MkIntTerm(0) PASS_REGS)); - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(4)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2231,11 +2231,11 @@ p_drcdap( USES_REGS1 ) return (FALSE); if (IsVarTerm(t4) || !IsIntegerTerm(t4)) return (FALSE); - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; restart_record: TRef = MkDBRefTerm(record(MkFirst | MkCode | WithRef, t1, t2, t4 PASS_REGS)); - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(4)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2259,10 +2259,10 @@ p_drcdzp( USES_REGS1 ) if (IsVarTerm(t4) || !IsIntegerTerm(t4)) return (FALSE); restart_record: - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; TRef = MkDBRefTerm(record(MkLast | MkCode | WithRef, t1, t2, t4 PASS_REGS)); - if (Yap_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (recover_from_record_error(4)) { t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -2358,7 +2358,7 @@ copy_attachments(CELL *ts USES_REGS) while (TRUE) { /* store away in case there is an overflow */ - if (attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0] PASS_REGS) == FALSE) { + if (GLOBAL_attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0] PASS_REGS) == FALSE) { /* oops, we did not have enough space to copy the elements */ /* reset queue of woken up goals */ TR = tr0; @@ -2466,13 +2466,13 @@ GetDBTerm(DBTerm *DBSP USES_REGS) } pt = CellPtr(DBSP->Contents); if (H+NOf > ASP-CalculateStackGap()/sizeof(CELL)) { - if (Yap_PrologMode & InErrorMode) { + if (LOCAL_PrologMode & InErrorMode) { if (H+NOf > ASP) - fprintf(Yap_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n"); + fprintf(GLOBAL_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n"); Yap_exit( 1); } else { - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Size = NOf*sizeof(CELL); + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = NOf*sizeof(CELL); return (Term)0; } } @@ -2487,8 +2487,8 @@ GetDBTerm(DBTerm *DBSP USES_REGS) if (DBSP->ag.attachments != 0L) { if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->ag.attachments,(CELL)HOld-(CELL)(DBSP->Contents)) PASS_REGS)) { H = HOld; - Yap_Error_TYPE = OUT_OF_ATTVARS_ERROR; - Yap_Error_Size = 0; + LOCAL_Error_TYPE = OUT_OF_ATTVARS_ERROR; + LOCAL_Error_Size = 0; return (Term)0; } } @@ -2549,9 +2549,9 @@ resize_int_keys(UInt new_size) { new = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*new_size); if (new == NULL) { YAPLeaveCriticalSection(); - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "could not allocate space"; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "could not allocate space"; return FALSE; } Yap_LUClauseSpace += sizeof(Prop)*new_size; @@ -2642,9 +2642,9 @@ new_lu_int_key(Int key) init_int_lu_keys(); if (INT_LU_KEYS == NULL) { CACHE_REGS - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "could not allocate space"; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "could not allocate space"; return NULL; } } @@ -2765,9 +2765,9 @@ FetchIntDBPropFromKey(Int key, int flag, int new, char *error_mssg) init_int_keys(); if (INT_KEYS == NULL) { CACHE_REGS - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_Error_Term = TermNil; - Yap_ErrorMessage = "could not allocate space"; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_Error_Term = TermNil; + LOCAL_ErrorMessage = "could not allocate space"; return NULL; } } @@ -3182,20 +3182,20 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS) /* make sure the garbage collector sees what we want it to see! */ EXTRA_CBACK_ARG(3,1) = (CELL)ref; /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; twork = Deref(ARG2); t3 = Deref(ARG3); } @@ -3254,16 +3254,16 @@ i_recorded(DBProp AtProp, Term t3 USES_REGS) EXTRA_CBACK_ARG(3,2) = MkIntegerTerm(((Int)mask)); EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(((Int)key)); /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -3350,20 +3350,20 @@ c_recorded(int flags USES_REGS) /* make sure the garbage collector sees what we want it to see! */ EXTRA_CBACK_ARG(3,1) = (CELL)ref; /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; PreviousHeap = H; } Yap_unify(ARG2, TermDB); @@ -3393,20 +3393,20 @@ c_recorded(int flags USES_REGS) /* make sure the garbage collector sees what we want it to see! */ EXTRA_CBACK_ARG(3,1) = (CELL)ref; /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; PreviousHeap = H; } if (Yap_unify(ARG2, TermDB)) @@ -3530,16 +3530,16 @@ p_recorded( USES_REGS1 ) Term TermDB; while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) { /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -3677,16 +3677,16 @@ p_first_instance( USES_REGS1 ) UNLOCK(ref->lock); while ((TermDB = GetDBTermFromDBEntry(ref PASS_REGS)) == (CELL)0) { /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 3, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 3, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -4197,7 +4197,7 @@ MyEraseClause(DynamicClause *clau USES_REGS) Yap_FreeCodeSpace((char *)clau); #ifdef DEBUG if (ref->NOfRefsTo) - fprintf(Yap_stderr, "Error: references to dynamic clause\n"); + fprintf(GLOBAL_stderr, "Error: references to dynamic clause\n"); #endif RemoveDBEntry(ref PASS_REGS); } @@ -4622,16 +4622,16 @@ static_instance(StaticClause *cl USES_REGS) while ((TermDB = GetDBTerm(cl->usc.ClSource PASS_REGS)) == 0L) { /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -4735,17 +4735,17 @@ p_instance( USES_REGS1 ) Term TermDB; while ((TermDB = GetDBTerm(cl->ClSource PASS_REGS)) == 0L) { /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); UNLOCK(ap->PELock); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); UNLOCK(ap->PELock); return FALSE; } @@ -4758,16 +4758,16 @@ p_instance( USES_REGS1 ) Term TermDB; while ((TermDB = GetDBTermFromDBEntry(dbr PASS_REGS)) == 0L) { /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -4790,16 +4790,16 @@ Yap_LUInstance(LogUpdClause *cl, UInt arity) CACHE_REGS while ((TermDB = GetDBTerm(cl->ClSource PASS_REGS)) == 0L) { /* oops, we are in trouble, not enough stack space */ - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, arity, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, arity, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } @@ -5048,11 +5048,11 @@ StoreTermInDB(Term t, int nargs USES_REGS) int needs_vars; struct db_globs dbg; - s_dbg = &dbg; - Yap_Error_Size = 0; + LOCAL_s_dbg = &dbg; + LOCAL_Error_Size = 0; while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL, InQueue, &needs_vars, 0, &dbg)) == NULL) { - if (Yap_Error_TYPE == YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == YAP_NO_ERROR) { break; } else if (nargs == -1) { return NULL; @@ -5076,11 +5076,12 @@ Yap_StoreTermInDB(Term t, int nargs) { DBTerm * Yap_StoreTermInDBPlusExtraSpace(Term t, UInt extra_size, UInt *sz) { + CACHE_REGS int needs_vars; struct db_globs dbg; DBTerm *o; - s_dbg = &dbg; + LOCAL_s_dbg = &dbg; o = (DBTerm *)CreateDBStruct(t, (DBProp)NULL, InQueue, &needs_vars, extra_size, &dbg); *sz = dbg.sz; @@ -5249,16 +5250,16 @@ p_dequeue( USES_REGS1 ) father_key->FirstInQueue = cur_instance->next; WRITE_UNLOCK(father_key->QRWLock); while ((TDB = GetDBTerm(cur_instance->DBT PASS_REGS)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -5293,16 +5294,16 @@ p_dequeue_unlocked( USES_REGS1 ) while (cur_instance) { Term TDB; while ((TDB = GetDBTerm(cur_instance->DBT PASS_REGS)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -5350,16 +5351,16 @@ p_peek_queue( USES_REGS1 ) while (cur_instance) { Term TDB; while ((TDB = GetDBTerm(cur_instance->DBT PASS_REGS)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } diff --git a/C/errors.c b/C/errors.c index b91f32af7..a00607c22 100755 --- a/C/errors.c +++ b/C/errors.c @@ -38,7 +38,7 @@ STATIC_PROTO (void detect_bug_location, (yamop *,find_pred_type,char *, int)); #define ONHEAP(ptr) (CellPtr(ptr) >= CellPtr(Yap_HeapBase) && CellPtr(ptr) < CellPtr(HeapTop)) -#define ONLOCAL(ptr) (CellPtr(ptr) > CellPtr(H) && CellPtr(ptr) < CellPtr(Yap_LocalBase)) +#define ONLOCAL(ptr) (CellPtr(ptr) > CellPtr(H) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) static int hidden (Atom at) @@ -264,14 +264,14 @@ dump_stack( USES_REGS1 ) return; #if DEBUG fprintf(stderr,"%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",P,CP,ASP,H,TR,HeapTop); - fprintf(stderr,"%% YAP mode: %ux\n",(unsigned int)Yap_PrologMode); - if (Yap_ErrorMessage) - fprintf(stderr,"%% YAP_ErrorMessage: %s\n",Yap_ErrorMessage); + fprintf(stderr,"%% YAP mode: %ux\n",(unsigned int)LOCAL_PrologMode); + if (LOCAL_ErrorMessage) + fprintf(stderr,"%% LOCAL_ErrorMessage: %s\n",LOCAL_ErrorMessage); #endif if (H > ASP || H > LCL0) { fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",H,ASP); - } else if (HeapTop > (ADDR)Yap_GlobalBase) { - fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, Yap_GlobalBase); + } else if (HeapTop > (ADDR)LOCAL_GlobalBase) { + fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, LOCAL_GlobalBase); } else { #if !USE_SYSTEM_MALLOC fprintf (stderr,"%ldKB of Code Space (%p--%p)\n",(long int)((CELL)HeapTop-(CELL)Yap_HeapBase)/1024,Yap_HeapBase,HeapTop); @@ -292,7 +292,7 @@ dump_stack( USES_REGS1 ) fprintf (stderr,"%% Continuation: %s\n",(char *)H); fprintf (stderr,"%% %luKB of Global Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(H-H0))/1024,H0,H); fprintf (stderr,"%% %luKB of Local Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(LCL0-ASP))/1024,ASP,LCL0); - fprintf (stderr,"%% %luKB of Trail (%p--%p)\n",(unsigned long int)((ADDR)TR-Yap_TrailBase)/1024,Yap_TrailBase,TR); + fprintf (stderr,"%% %luKB of Trail (%p--%p)\n",(unsigned long int)((ADDR)TR-LOCAL_TrailBase)/1024,LOCAL_TrailBase,TR); fprintf (stderr,"%% Performed %ld garbage collections\n", (unsigned long int)LOCAL_GcCalls); #if LOW_LEVEL_TRACER { @@ -352,7 +352,7 @@ static void error_exit_yap (int value) { CACHE_REGS - if (!(Yap_PrologMode & BootMode)) { + if (!(LOCAL_PrologMode & BootMode)) { dump_stack( PASS_REGS1 ); #if DEBUG #endif @@ -391,14 +391,14 @@ Yap_Error(yap_error_number type, Term where, char *format,...) char *tp = tmpbuf; int psize = YAP_BUF_SIZE; - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (where == 0L) where = TermNil; #if DEBUG_STRICT - if (Yap_heap_regs && !(Yap_PrologMode & BootMode)) - fprintf(stderr,"***** Processing Error %d (%lx,%x) %s***\n", type, (unsigned long int)LOCAL_ActiveSignals,Yap_PrologMode,format); + if (Yap_heap_regs && !(LOCAL_PrologMode & BootMode)) + fprintf(stderr,"***** Processing Error %d (%lx,%x) %s***\n", type, (unsigned long int)LOCAL_ActiveSignals,LOCAL_PrologMode,format); else - fprintf(stderr,"***** Processing Error %d (%x) %s***\n", type,Yap_PrologMode,format); + fprintf(stderr,"***** Processing Error %d (%x) %s***\n", type,LOCAL_PrologMode,format); #endif if (type == INTERRUPT_ERROR) { fprintf(stderr,"%% YAP exiting: cannot handle signal %d\n", @@ -406,7 +406,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) Yap_exit(1); } /* disallow recursive error handling */ - if (Yap_PrologMode & InErrorMode) { + if (LOCAL_PrologMode & InErrorMode) { /* error within error */ va_start (ap, format); /* now build the error string */ @@ -444,7 +444,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) } else { tmpbuf[0] = '\0'; } - if (Yap_PrologMode == UserCCallMode) { + if (LOCAL_PrologMode == UserCCallMode) { fprintf(stderr,"%%\n%%\n"); fprintf(stderr,"%% YAP OOOPS in USER C-CODE: %s.\n",tmpbuf); fprintf(stderr,"%%\n%%\n"); @@ -458,12 +458,12 @@ Yap_Error(yap_error_number type, Term where, char *format,...) if (P == (yamop *)(FAILCODE)) return P; /* PURE_ABORT may not have set where correctly, BootMode may not have the data terms ready */ - if (type == PURE_ABORT || Yap_PrologMode & BootMode) { + if (type == PURE_ABORT || LOCAL_PrologMode & BootMode) { where = TermNil; - Yap_PrologMode &= ~AbortMode; - Yap_PrologMode |= InErrorMode; + LOCAL_PrologMode &= ~AbortMode; + LOCAL_PrologMode |= InErrorMode; /* make sure failure will be seen at next port */ - if (Yap_PrologMode & AsyncIntMode) + if (LOCAL_PrologMode & AsyncIntMode) Yap_signal(YAP_FAIL_SIGNAL); P = FAILCODE; } else { @@ -474,8 +474,8 @@ Yap_Error(yap_error_number type, Term where, char *format,...) where = Deref(where); } /* Exit Abort Mode, if we were there */ - Yap_PrologMode &= ~AbortMode; - Yap_PrologMode |= InErrorMode; + LOCAL_PrologMode &= ~AbortMode; + LOCAL_PrologMode |= InErrorMode; if (!(where = Yap_CopyTerm(where))) { where = TermNil; } @@ -493,7 +493,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) else tmpbuf[0] = '\0'; va_end (ap); - if (Yap_PrologMode & BootMode) { + if (LOCAL_PrologMode & BootMode) { /* crash in flames! */ fprintf(stderr,"%% YAP Fatal Error: %s exiting....\n",tmpbuf); error_exit_yap (1); @@ -506,7 +506,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) { fprintf(stderr,"%% Internal YAP Error: %s exiting....\n",tmpbuf); serious = TRUE; - if (Yap_PrologMode & BootMode) { + if (LOCAL_PrologMode & BootMode) { fprintf(stderr,"%% YAP crashed while booting %s\n",tmpbuf); } else { detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, tmpbuf, YAP_BUF_SIZE); @@ -535,7 +535,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) LOCAL_RetriesCounterOn = FALSE; Yap_JumpToEnv(MkAtomTerm(AtomCallCounter)); P = (yamop *)FAILCODE; - Yap_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; return(P); case PRED_ENTRY_COUNTER_UNDERFLOW: /* Do a long jump */ @@ -544,7 +544,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) LOCAL_RetriesCounterOn = FALSE; Yap_JumpToEnv(MkAtomTerm(AtomCallAndRetryCounter)); P = (yamop *)FAILCODE; - Yap_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; return(P); case RETRY_COUNTER_UNDERFLOW: /* Do a long jump */ @@ -553,7 +553,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) LOCAL_RetriesCounterOn = FALSE; Yap_JumpToEnv(MkAtomTerm(AtomRetryCounter)); P = (yamop *)FAILCODE; - Yap_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; return(P); case CONSISTENCY_ERROR: { @@ -1831,13 +1831,13 @@ Yap_Error(yap_error_number type, Term where, char *format,...) if (type != PURE_ABORT) { /* This is used by some complex procedures to detect there was an error */ if (IsAtomTerm(nt[0])) { - strncpy(Yap_ErrorSay, RepAtom(AtomOfTerm(nt[0]))->StrOfAE, MAX_ERROR_MSG_SIZ\ + strncpy(LOCAL_ErrorSay, RepAtom(AtomOfTerm(nt[0]))->StrOfAE, MAX_ERROR_MSG_SIZ\ E); - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_ErrorMessage = LOCAL_ErrorSay; } else { - strncpy(Yap_ErrorSay, RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,\ + strncpy(LOCAL_ErrorSay, RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,\ MAX_ERROR_MSG_SIZE); - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_ErrorMessage = LOCAL_ErrorSay; } } switch (type) { @@ -1852,7 +1852,7 @@ E); if ((stack_dump = Yap_all_calls()) == 0L) { stack_dump = TermNil; - Yap_Error_Size = 0L; + LOCAL_Error_Size = 0L; } nt[1] = MkPairTerm(MkAtomTerm(Yap_LookupAtom(tmpbuf)), stack_dump); } @@ -1861,7 +1861,7 @@ E); /* disable active signals at this point */ LOCAL_ActiveSignals = 0; CreepFlag = CalculateStackGap(); - Yap_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; LOCK(LOCAL_SignalLock); /* we might be in the middle of a critical region */ if (LOCAL_InterruptsDisabled) { @@ -1871,16 +1871,16 @@ E); #if PUSH_REGS restore_absmi_regs(&Yap_standard_regs); #endif - siglongjmp(Yap_RestartEnv,1); + siglongjmp(LOCAL_RestartEnv,1); } UNLOCK(LOCAL_SignalLock); /* wait if we we are in user code, it's up to her to decide */ - if (Yap_PrologMode & UserCCallMode) { + if (LOCAL_PrologMode & UserCCallMode) { if (!(EX = Yap_StoreTermInDB(Yap_MkApplTerm(fun, 2, nt), 0))) { /* fat chance */ - siglongjmp(Yap_RestartEnv,1); + siglongjmp(LOCAL_RestartEnv,1); } } else { if (type == PURE_ABORT) { @@ -1890,7 +1890,7 @@ E); P = (yamop *)FAILCODE; } } else { - Yap_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; } return P; } diff --git a/C/eval.c b/C/eval.c index 7de47d12f..311c96e06 100644 --- a/C/eval.c +++ b/C/eval.c @@ -34,7 +34,7 @@ static char SccsId[] = "%W% %G%"; #include #endif -yap_error_number Yap_matherror = YAP_NO_ERROR; + static Term Eval(Term t USES_REGS) @@ -131,14 +131,14 @@ p_is( USES_REGS1 ) Term out = 0L; while (!(out = Eval(Deref(ARG2) PASS_REGS))) { - if (Yap_Error_TYPE == RESOURCE_ERROR_STACK) { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 2, ENV, CP)) { - Yap_Error(RESOURCE_ERROR_STACK, ARG2, Yap_ErrorMessage); + if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) { + Yap_Error(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } } @@ -152,19 +152,19 @@ Yap_ArithError(yap_error_number type, Term where, char *format,...) va_list ap; LOCAL_ArithError = TRUE; - Yap_Error_TYPE = type; - Yap_Error_Term = where; - if (!Yap_ErrorMessage) - Yap_ErrorMessage = Yap_ErrorSay; + LOCAL_Error_TYPE = type; + LOCAL_Error_Term = where; + if (!LOCAL_ErrorMessage) + LOCAL_ErrorMessage = LOCAL_ErrorSay; va_start (ap, format); if (format != NULL) { #if HAVE_VSNPRINTF - (void) vsnprintf(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap); + (void) vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap); #else - (void) vsprintf(Yap_ErrorMessage, format, ap); + (void) vsprintf(LOCAL_ErrorMessage, format, ap); #endif } else { - Yap_ErrorMessage[0] = '\0'; + LOCAL_ErrorMessage[0] = '\0'; } va_end (ap); return 0L; diff --git a/C/evalis.c b/C/evalis.c deleted file mode 100644 index e69de29bb..000000000 diff --git a/C/evaltwo.c b/C/evaltwo.c deleted file mode 100644 index e69de29bb..000000000 diff --git a/C/exec.c b/C/exec.c index 7cc478786..20d12d683 100644 --- a/C/exec.c +++ b/C/exec.c @@ -946,12 +946,12 @@ exec_absmi(int top USES_REGS) { int lval, out; - if (top && (lval = sigsetjmp (Yap_RestartEnv, 1)) != 0) { + if (top && (lval = sigsetjmp (LOCAL_RestartEnv, 1)) != 0) { switch(lval) { case 1: { /* restart */ /* otherwise, SetDBForThrow will fail entering critical mode */ - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; /* find out where to cut to */ /* siglongjmp resets the TR hardware register */ /* TR and B are crucial, they might have been changed, or not */ @@ -966,7 +966,7 @@ exec_absmi(int top USES_REGS) /* forget any signals active, we're reborne */ LOCAL_ActiveSignals = 0; CreepFlag = CalculateStackGap(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; UNLOCK(LOCAL_SignalLock); P = (yamop *)FAILCODE; } @@ -975,11 +975,11 @@ exec_absmi(int top USES_REGS) { /* arithmetic exception */ /* must be done here, otherwise siglongjmp will clobber all the registers */ - Yap_Error(Yap_matherror,TermNil,NULL); + Yap_Error(LOCAL_matherror ,TermNil,NULL); /* reset the registers so that we don't have trash in abstract machine */ Yap_set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1); P = (yamop *)FAILCODE; - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; } break; case 3: @@ -988,10 +988,10 @@ exec_absmi(int top USES_REGS) } default: /* do nothing */ - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; } } else { - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; } Yap_CloseSlots( PASS_REGS1 ); YENV = ASP; @@ -1279,8 +1279,8 @@ Yap_RunTopGoal(Term t) CodeAdr = ppe->CodeOfPred; UNLOCK(ppe->PELock); #if !USE_SYSTEM_MALLOC - if (Yap_TrailTop - HeapTop < 2048) { - Yap_PrologMode = BootMode; + if (LOCAL_TrailTop - HeapTop < 2048) { + LOCAL_PrologMode = BootMode; Yap_Error(OUT_OF_TRAIL_ERROR,TermNil, "unable to boot because of too little Trail space"); } @@ -1474,7 +1474,7 @@ JumpToEnv(Term t USES_REGS) { /* just keep the throwed object away, we don't need to care about it */ if (!(LOCAL_BallTerm = Yap_StoreTermInDB(t, 0))) { /* fat chance */ - siglongjmp(Yap_RestartEnv,1); + siglongjmp(LOCAL_RestartEnv,1); } /* careful, previous step may have caused a stack shift, so get pointers here */ @@ -1515,7 +1515,7 @@ JumpToEnv(Term t USES_REGS) { LOCAL_BallTerm = NULL; P = (yamop *)FAILCODE; /* make sure failure will be seen at next port */ - if (Yap_PrologMode & AsyncIntMode) { + if (LOCAL_PrologMode & AsyncIntMode) { Yap_signal(YAP_FAIL_SIGNAL); } HB = B->cp_h; @@ -1529,7 +1529,7 @@ JumpToEnv(Term t USES_REGS) { #if PUSH_REGS restore_absmi_regs(&Yap_standard_regs); #endif - siglongjmp(Yap_RestartEnv,1); + siglongjmp(LOCAL_RestartEnv,1); } /* is it a continuation? */ env = handler->cp_env; @@ -1560,7 +1560,7 @@ JumpToEnv(Term t USES_REGS) { /* B->cp_h = H; */ /* I could backtrack here, but it is easier to leave the unwinding to the emulator */ - if (Yap_PrologMode & AsyncIntMode) { + if (LOCAL_PrologMode & AsyncIntMode) { Yap_signal(YAP_FAIL_SIGNAL); } P = (yamop *)FAILCODE; @@ -1575,7 +1575,7 @@ JumpToEnv(Term t USES_REGS) { Int Yap_JumpToEnv(Term t) { CACHE_REGS - if (Yap_PrologMode & BootMode) { + if (LOCAL_PrologMode & BootMode) { return FALSE; } return JumpToEnv(t PASS_REGS); @@ -1602,7 +1602,6 @@ Yap_InitYaamRegs(void) { CACHE_REGS Term h0var; - #if PUSH_REGS /* Guarantee that after a longjmp we go back to the original abstract machine registers */ @@ -1617,12 +1616,12 @@ Yap_InitYaamRegs(void) #endif /* PUSH_REGS */ Yap_ResetExceptionTerm (); Yap_PutValue (AtomBreak, MkIntTerm (0)); - TR = (tr_fr_ptr)Yap_TrailBase; - if (Yap_AttsSize > (Yap_LocalBase-Yap_GlobalBase)/8) - Yap_AttsSize = (Yap_LocalBase-Yap_GlobalBase)/8; - H = H0 = ((CELL *) Yap_GlobalBase)+ Yap_AttsSize/sizeof(CELL); + TR = (tr_fr_ptr)LOCAL_TrailBase; + if (Yap_AttsSize > (LOCAL_LocalBase-LOCAL_GlobalBase)/8) + Yap_AttsSize = (LOCAL_LocalBase-LOCAL_GlobalBase)/8; + H = H0 = ((CELL *) LOCAL_GlobalBase)+ Yap_AttsSize/sizeof(CELL); RESET_VARIABLE(H0-1); - LCL0 = ASP = (CELL *) Yap_LocalBase; + LCL0 = ASP = (CELL *) LOCAL_LocalBase; /* notice that an initial choice-point and environment *must* be created since for the garbage collector to work */ B = NULL; @@ -1637,8 +1636,8 @@ Yap_InitYaamRegs(void) #ifdef YAPOR_SBA BSEG = #endif /* YAPOR_SBA */ - BBREG = B_FZ = (choiceptr) Yap_LocalBase; - TR = TR_FZ = (tr_fr_ptr) Yap_TrailBase; + BBREG = B_FZ = (choiceptr) LOCAL_LocalBase; + TR = TR_FZ = (tr_fr_ptr) LOCAL_TrailBase; #endif /* FROZEN_STACKS */ LOCK(LOCAL_SignalLock); CreepFlag = CalculateStackGap(); @@ -1723,16 +1722,16 @@ Yap_GetException(void) do { t = Yap_PopTermFromDB(LOCAL_BallTerm); if (t == 0) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(LOCAL_BallTerm->NOfCells*CellSize)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } diff --git a/C/globals.c b/C/globals.c index d54861c40..5c2851796 100644 --- a/C/globals.c +++ b/C/globals.c @@ -111,7 +111,7 @@ NewArena(UInt size, UInt arity, CELL *where USES_REGS) if (where == NULL || where == H) { while (H+size > ASP-1024) { if (!Yap_gcl(size*sizeof(CELL), arity, ENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return TermNil; } } @@ -188,7 +188,7 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity USES_REGS) XREGS[arity+1] = arena; if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } arena = XREGS[arity+1]; @@ -203,7 +203,7 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity USES_REGS) /* try to recover some room */ if (arena == LOCAL_GlobalArena && 10*(pt-H0) > 8*(H-H0)) { if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR,TermNil,LOCAL_ErrorMessage); return FALSE; } } @@ -474,12 +474,12 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop CELL new; bp = to_visit; - if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { goto overflow; } to_visit = bp; new = *ptf; - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; @@ -491,7 +491,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop #endif /* first time we met this term */ RESET_VARIABLE(ptf); - if ((ADDR)TR > Yap_TrailTop-MIN_ARENA_SIZE) + if ((ADDR)TR > LOCAL_TrailTop-MIN_ARENA_SIZE) goto trail_overflow; Bind_and_Trail(ptd0, (CELL)ptf); ptf++; @@ -723,13 +723,13 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te if (arena == LOCAL_GlobalArena) LOCAL_GlobalArenaOverflows++; if (!GrowArena(arena, old_top, old_size, min_grow, arity+3 PASS_REGS)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } break; default: /* temporary space overflow */ if (!Yap_ExpandPreAllocCodeSpace(0,NULL,TRUE)) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } @@ -1625,7 +1625,7 @@ p_nb_queue_enqueue( USES_REGS1 ) ARG3 = to; /* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/ if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) { - Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, arena, LOCAL_ErrorMessage); return 0L; } to = ARG3; @@ -1803,7 +1803,7 @@ p_nb_heap( USES_REGS1 ) while ((heap = MkZeroApplTerm(Yap_MkFunctor(AtomHeap,2*hsize+HEAP_START+1),2*hsize+HEAP_START+1 PASS_REGS)) == TermNil) { if (!Yap_gcl((2*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1977,7 +1977,7 @@ p_nb_heap_add_to_heap( USES_REGS1 ) } ARG3 = to; if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) { - Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, arena, LOCAL_ErrorMessage); return 0L; } to = ARG3; @@ -2085,7 +2085,7 @@ p_nb_beam( USES_REGS1 ) } while ((beam = MkZeroApplTerm(Yap_MkFunctor(AtomHeap,5*hsize+HEAP_START+1),5*hsize+HEAP_START+1 PASS_REGS)) == TermNil) { if (!Yap_gcl((4*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -2363,7 +2363,7 @@ p_nb_beam_add_to_beam( USES_REGS1 ) } ARG3 = to; if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) { - Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, arena, LOCAL_ErrorMessage); return 0L; } to = ARG3; @@ -2475,7 +2475,7 @@ p_nb_beam_keys( USES_REGS1 ) if (H > ASP-1024) { H = ho; if (!Yap_gcl(((ASP-H)-1024)*sizeof(CELL), 2, ENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return TermNil; } goto restart; diff --git a/C/gprof.c b/C/gprof.c index 1ebebd8bb..3d475456f 100755 --- a/C/gprof.c +++ b/C/gprof.c @@ -123,13 +123,13 @@ typedef greg_t context_reg; #include #endif -static Int ProfCalls, ProfGCs, ProfHGrows, ProfSGrows, ProfMallocs, ProfOn, ProfOns; + #define TIMER_DEFAULT 100 #define PROFILING_FILE 1 #define PROFPREDS_FILE 2 -static char *DIRNAME=NULL; + typedef struct RB_red_blk_node { yamop *key; /* first address */ @@ -142,7 +142,7 @@ typedef struct RB_red_blk_node { struct RB_red_blk_node* parent; } rb_red_blk_node; -static rb_red_blk_node *ProfilerRoot, *ProfilerNil; + static rb_red_blk_node * RBMalloc(UInt size) @@ -162,14 +162,14 @@ RBTreeCreate(void) { /* see the comment in the rb_red_blk_tree structure in red_black_tree.h */ /* for information on nil and root */ - temp=ProfilerNil= RBMalloc(sizeof(rb_red_blk_node)); + temp=GLOBAL_ProfilerNil= RBMalloc(sizeof(rb_red_blk_node)); temp->parent=temp->left=temp->right=temp; temp->pcs=0; temp->red=0; temp->key=temp->lim=NULL; temp->pe=NULL; temp = RBMalloc(sizeof(rb_red_blk_node)); - temp->parent=temp->left=temp->right=ProfilerNil; + temp->parent=temp->left=temp->right=GLOBAL_ProfilerNil; temp->key=temp->lim=NULL; temp->pe=NULL; temp->pcs=0; @@ -199,7 +199,7 @@ RBTreeCreate(void) { static void LeftRotate(rb_red_blk_node* x) { rb_red_blk_node* y; - rb_red_blk_node* nil=ProfilerNil; + rb_red_blk_node* nil=GLOBAL_ProfilerNil; /* I originally wrote this function to use the sentinel for */ /* nil to avoid checking for nil. However this introduces a */ @@ -230,7 +230,7 @@ LeftRotate(rb_red_blk_node* x) { x->parent=y; #ifdef DEBUG_ASSERT - Assert(!ProfilerNil->red,"nil not red in LeftRotate"); + Assert(!GLOBAL_ProfilerNil->red,"nil not red in LeftRotate"); #endif } @@ -255,7 +255,7 @@ LeftRotate(rb_red_blk_node* x) { static void RightRotate(rb_red_blk_node* y) { rb_red_blk_node* x; - rb_red_blk_node* nil=ProfilerNil; + rb_red_blk_node* nil=GLOBAL_ProfilerNil; /* I originally wrote this function to use the sentinel for */ /* nil to avoid checking for nil. However this introduces a */ @@ -285,7 +285,7 @@ RightRotate(rb_red_blk_node* y) { y->parent=x; #ifdef DEBUG_ASSERT - Assert(!ProfilerNil->red,"nil not red in RightRotate"); + Assert(!GLOBAL_ProfilerNil->red,"nil not red in RightRotate"); #endif } @@ -309,11 +309,11 @@ TreeInsertHelp(rb_red_blk_node* z) { /* This function should only be called by InsertRBTree (see above) */ rb_red_blk_node* x; rb_red_blk_node* y; - rb_red_blk_node* nil=ProfilerNil; + rb_red_blk_node* nil=GLOBAL_ProfilerNil; z->left=z->right=nil; - y=ProfilerRoot; - x=ProfilerRoot->left; + y=GLOBAL_ProfilerRoot; + x=GLOBAL_ProfilerRoot->left; while( x != nil) { y=x; if (x->key > z->key) { /* x.key > z.key */ @@ -323,7 +323,7 @@ TreeInsertHelp(rb_red_blk_node* z) { } } z->parent=y; - if ( (y == ProfilerRoot) || + if ( (y == GLOBAL_ProfilerRoot) || (y->key > z->key)) { /* y.key > z.key */ y->left=z; } else { @@ -331,7 +331,7 @@ TreeInsertHelp(rb_red_blk_node* z) { } #ifdef DEBUG_ASSERT - Assert(!ProfilerNil->red,"nil not red in TreeInsertHelp"); + Assert(!GLOBAL_ProfilerNil->red,"nil not red in TreeInsertHelp"); #endif } @@ -403,12 +403,12 @@ RBTreeInsert(yamop *key, yamop *lim) { } } } - ProfilerRoot->left->red=0; + GLOBAL_ProfilerRoot->left->red=0; return newNode; #ifdef DEBUG_ASSERT - Assert(!ProfilerNil->red,"nil not red in RBTreeInsert"); - Assert(!ProfilerRoot->red,"root not red in RBTreeInsert"); + Assert(!GLOBAL_ProfilerNil->red,"nil not red in RBTreeInsert"); + Assert(!GLOBAL_ProfilerRoot->red,"root not red in RBTreeInsert"); #endif } @@ -429,10 +429,10 @@ RBTreeInsert(yamop *key, yamop *lim) { static rb_red_blk_node* RBExactQuery(yamop* q) { rb_red_blk_node* x; - rb_red_blk_node* nil=ProfilerNil; + rb_red_blk_node* nil=GLOBAL_ProfilerNil; - if (!ProfilerRoot) return NULL; - x=ProfilerRoot->left; + if (!GLOBAL_ProfilerRoot) return NULL; + x=GLOBAL_ProfilerRoot->left; if (x == nil) return NULL; while(x->key != q) {/*assignemnt*/ if (x->key > q) { /* x->key > q */ @@ -450,10 +450,10 @@ static rb_red_blk_node* RBLookup(yamop *entry) { rb_red_blk_node *current; - if (!ProfilerRoot) + if (!GLOBAL_ProfilerRoot) return NULL; - current = ProfilerRoot->left; - while (current != ProfilerNil) { + current = GLOBAL_ProfilerRoot->left; + while (current != GLOBAL_ProfilerNil) { if (current->key <= entry && current->lim >= entry) { return current; } @@ -483,7 +483,7 @@ RBLookup(yamop *entry) { /***********************************************************************/ static void RBDeleteFixUp(rb_red_blk_node* x) { - rb_red_blk_node* root=ProfilerRoot->left; + rb_red_blk_node* root=GLOBAL_ProfilerRoot->left; rb_red_blk_node *w; while( (!x->red) && (root != x)) { @@ -563,8 +563,8 @@ static void RBDeleteFixUp(rb_red_blk_node* x) { static rb_red_blk_node* TreeSuccessor(rb_red_blk_node* x) { rb_red_blk_node* y; - rb_red_blk_node* nil=ProfilerNil; - rb_red_blk_node* root=ProfilerRoot; + rb_red_blk_node* nil=GLOBAL_ProfilerNil; + rb_red_blk_node* root=GLOBAL_ProfilerRoot; if (nil != (y = x->right)) { /* assignment to y is intentional */ while(y->left != nil) { /* returns the minium of the right subtree of x */ @@ -602,8 +602,8 @@ static void RBDelete(rb_red_blk_node* z){ rb_red_blk_node* y; rb_red_blk_node* x; - rb_red_blk_node* nil=ProfilerNil; - rb_red_blk_node* root=ProfilerRoot; + rb_red_blk_node* nil=GLOBAL_ProfilerNil; + rb_red_blk_node* root=GLOBAL_ProfilerRoot; y= ((z->left == nil) || (z->right == nil)) ? z : TreeSuccessor(z); x= (y->left == nil) ? y->right : y->left; @@ -656,21 +656,21 @@ int size=0; if (name!=NULL) { size=strlen(name)+1; - if (DIRNAME!=NULL) free(DIRNAME); - DIRNAME=malloc(size); - if (DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); } - strcpy(DIRNAME,name); + if (GLOBAL_DIRNAME!=NULL) free(GLOBAL_DIRNAME); + GLOBAL_DIRNAME=malloc(size); + if (GLOBAL_DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); } + strcpy(GLOBAL_DIRNAME,name); } - if (DIRNAME==NULL) { + if (GLOBAL_DIRNAME==NULL) { do { - if (DIRNAME!=NULL) free(DIRNAME); + if (GLOBAL_DIRNAME!=NULL) free(GLOBAL_DIRNAME); size+=20; - DIRNAME=malloc(size); - if (DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); } - } while (getcwd(DIRNAME, size-15)==NULL); + GLOBAL_DIRNAME=malloc(size); + if (GLOBAL_DIRNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); } + } while (getcwd(GLOBAL_DIRNAME, size-15)==NULL); } -return DIRNAME; +return GLOBAL_DIRNAME; } char *profile_names(int); @@ -678,12 +678,12 @@ char *profile_names(int k) { static char *FNAME=NULL; int size=200; - if (DIRNAME==NULL) set_profile_dir(NULL); - size=strlen(DIRNAME)+40; + if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL); + size=strlen(GLOBAL_DIRNAME)+40; if (FNAME!=NULL) free(FNAME); FNAME=malloc(size); if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); } - strcpy(FNAME,DIRNAME); + strcpy(FNAME,GLOBAL_DIRNAME); if (k==PROFILING_FILE) { sprintf(FNAME,"%s/PROFILING_%d",FNAME,getpid()); @@ -697,7 +697,7 @@ int size=200; void del_profile_files(void); void del_profile_files() { - if (DIRNAME!=NULL) { + if (GLOBAL_DIRNAME!=NULL) { remove(profile_names(PROFPREDS_FILE)); remove(profile_names(PROFILING_FILE)); } @@ -708,7 +708,7 @@ Yap_inform_profiler_of_clause(yamop *code_start, yamop *code_end, PredEntry *pe, static Int order=0; ProfPreds++; - ProfOn = TRUE; + GLOBAL_ProfOn = TRUE; if (FPreds != NULL) { Int temp; @@ -716,7 +716,7 @@ static Int order=0; if (index_code) temp=-order; else temp=order; fprintf(FPreds,"+%p %p %p %ld\n",code_start,code_end, pe, (long int)temp); } - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; } typedef struct clause_entry { @@ -731,7 +731,7 @@ static Int profend( USES_REGS1 ); static void clean_tree(rb_red_blk_node* node) { - if (node == ProfilerNil) + if (node == GLOBAL_ProfilerNil) return; clean_tree(node->left); clean_tree(node->right); @@ -740,18 +740,18 @@ clean_tree(rb_red_blk_node* node) { static void reset_tree(void) { - clean_tree(ProfilerRoot); - Yap_FreeCodeSpace((char *)ProfilerNil); - ProfilerNil = ProfilerRoot = NULL; - ProfCalls = ProfGCs = ProfHGrows = ProfSGrows = ProfMallocs = ProfOns = 0L; + clean_tree(GLOBAL_ProfilerRoot); + Yap_FreeCodeSpace((char *)GLOBAL_ProfilerNil); + GLOBAL_ProfilerNil = GLOBAL_ProfilerRoot = NULL; + GLOBAL_ProfCalls = GLOBAL_ProfGCs = GLOBAL_ProfHGrows = GLOBAL_ProfSGrows = GLOBAL_ProfMallocs = GLOBAL_ProfOns = 0L; } static int InitProfTree(void) { - if (ProfilerRoot) + if (GLOBAL_ProfilerRoot) reset_tree(); - while (!(ProfilerRoot = RBTreeCreate())) { + while (!(GLOBAL_ProfilerRoot = RBTreeCreate())) { if (!Yap_growheap(FALSE, 0, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "while initialisating profiler"); return FALSE; @@ -807,10 +807,10 @@ static void RemoveCode(CODEADDR clau) PredEntry *pp; UInt count; - if (!ProfilerRoot) return; + if (!GLOBAL_ProfilerRoot) return; if (!(x = RBExactQuery((yamop *)clau))) { /* send message */ - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; return; } pp = x->pe; @@ -823,7 +823,7 @@ static void RemoveCode(CODEADDR clau) node->pe = pp; node->pcs = count; /* send message */ - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; return; } else { node->pcs += count; @@ -872,7 +872,7 @@ showprofres( USES_REGS1 ) { } } fclose(FProf); - if (ProfCalls==0) + if (GLOBAL_ProfCalls==0) return TRUE; return TRUE; } @@ -909,7 +909,7 @@ p_test( USES_REGS1 ) { } } fclose(FProf); - if (ProfCalls==0) + if (GLOBAL_ProfCalls==0) return TRUE; return TRUE; } @@ -920,39 +920,40 @@ p_test( USES_REGS1 ) { static void prof_alrm(int signo, siginfo_t *si, void *scv) -{ +{ + CACHE_REGS void * oldpc=(void *) CONTEXT_PC(scv); yamop *current_p; - ProfCalls++; + GLOBAL_ProfCalls++; /* skip an interrupt */ - if (ProfOn) { - ProfOns++; + if (GLOBAL_ProfOn) { + GLOBAL_ProfOns++; return; } - ProfOn = TRUE; - if (Yap_PrologMode & TestMode) { - if (Yap_PrologMode & GCMode) { - ProfGCs++; - ProfOn = FALSE; + GLOBAL_ProfOn = TRUE; + if (LOCAL_PrologMode & TestMode) { + if (LOCAL_PrologMode & GCMode) { + GLOBAL_ProfGCs++; + GLOBAL_ProfOn = FALSE; return; } - if (Yap_PrologMode & MallocMode) { - ProfMallocs++; - ProfOn = FALSE; + if (LOCAL_PrologMode & MallocMode) { + GLOBAL_ProfMallocs++; + GLOBAL_ProfOn = FALSE; return; } - if (Yap_PrologMode & GrowHeapMode) { - ProfHGrows++; - ProfOn = FALSE; + if (LOCAL_PrologMode & GrowHeapMode) { + GLOBAL_ProfHGrows++; + GLOBAL_ProfOn = FALSE; return; } - if (Yap_PrologMode & GrowStackMode) { - ProfSGrows++; - ProfOn = FALSE; + if (LOCAL_PrologMode & GrowStackMode) { + GLOBAL_ProfSGrows++; + GLOBAL_ProfOn = FALSE; return; } @@ -987,34 +988,34 @@ prof_alrm(int signo, siginfo_t *si, void *scv) #if DEBUG fprintf(stderr,"Oops: %p, %p\n", oldpc, current_p); #endif - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; return; } #endif if (Yap_OffLineProfiler) { fprintf(FProf,"%p\n", current_p); - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; return; } LookupNode(current_p); - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; } void Yap_InformOfRemoval(CODEADDR clau) { - ProfOn = TRUE; + GLOBAL_ProfOn = TRUE; if (FPreds != NULL) { /* just store info about what is going on */ fprintf(FPreds,"-%p\n",clau); - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; return; } RemoveCode(clau); - ProfOn = FALSE; + GLOBAL_ProfOn = FALSE; } static Int profend( USES_REGS1 ); @@ -1024,25 +1025,25 @@ profnode( USES_REGS1 ) { Term t1 = Deref(ARG1), tleft, tright; rb_red_blk_node *node; - if (!ProfilerRoot) + if (!GLOBAL_ProfilerRoot) return FALSE; if (!(node = (rb_red_blk_node *)IntegerOfTerm(t1))) - node = ProfilerRoot; + node = GLOBAL_ProfilerRoot; /* if (node->key) fprintf(stderr,"%p: %p,%p,%d,%p(%d),%p,%p\n",node,node->key,node->lim,node->pcs,node->pe,node->pe->ArityOfPE,node->right,node->left); */ - if (node->left == ProfilerNil) { + if (node->left == GLOBAL_ProfilerNil) { tleft = TermNil; } else { tleft = MkIntegerTerm((Int)node->left); } - if (node->left == ProfilerNil) { + if (node->left == GLOBAL_ProfilerNil) { tleft = TermNil; } else { tleft = MkIntegerTerm((Int)node->left); } - if (node->right == ProfilerNil) { + if (node->right == GLOBAL_ProfilerNil) { tright = TermNil; } else { tright = MkIntegerTerm((Int)node->right); @@ -1058,12 +1059,12 @@ profnode( USES_REGS1 ) { static Int profglobs( USES_REGS1 ) { return - Yap_unify(ARG1,MkIntegerTerm(ProfCalls)) && - Yap_unify(ARG2,MkIntegerTerm(ProfGCs)) && - Yap_unify(ARG3,MkIntegerTerm(ProfHGrows)) && - Yap_unify(ARG4,MkIntegerTerm(ProfSGrows)) && - Yap_unify(ARG5,MkIntegerTerm(ProfMallocs)) && - Yap_unify(ARG6,MkIntegerTerm(ProfOns)) ; + Yap_unify(ARG1,MkIntegerTerm(GLOBAL_ProfCalls)) && + Yap_unify(ARG2,MkIntegerTerm(GLOBAL_ProfGCs)) && + Yap_unify(ARG3,MkIntegerTerm(GLOBAL_ProfHGrows)) && + Yap_unify(ARG4,MkIntegerTerm(GLOBAL_ProfSGrows)) && + Yap_unify(ARG5,MkIntegerTerm(GLOBAL_ProfMallocs)) && + Yap_unify(ARG6,MkIntegerTerm(GLOBAL_ProfOns)) ; } static Int @@ -1169,14 +1170,14 @@ static Int profoff( USES_REGS1 ) { return FALSE; } -static Int profon( USES_REGS1 ) { +static Int ProfOn( USES_REGS1 ) { Term p; profoff( PASS_REGS1 ); p=Deref(ARG1); return(start_profilers(IntOfTerm(p))); } -static Int profon0( USES_REGS1 ) { +static Int ProfOn0( USES_REGS1 ) { profoff( PASS_REGS1 ); return(start_profilers(TIMER_DEFAULT)); } @@ -1187,7 +1188,7 @@ static Int profison( USES_REGS1 ) { static Int profalt( USES_REGS1 ) { if (ProfilerOn==0) return(FALSE); - if (ProfilerOn==-1) return profon( PASS_REGS1 ); + if (ProfilerOn==-1) return ProfOn( PASS_REGS1 ); return profoff( PASS_REGS1 ); } @@ -1248,15 +1249,15 @@ void Yap_InitLowProf(void) { #if LOW_PROF - ProfCalls = 0; + GLOBAL_ProfCalls = 0; ProfilerOn = FALSE; Yap_OffLineProfiler = FALSE; Yap_InitCPred("profinit",0, profinit, SafePredFlag); Yap_InitCPred("profinit",1, profinit1, SafePredFlag); Yap_InitCPred("$proftype",1, proftype, SafePredFlag); Yap_InitCPred("profend" ,0, profend, SafePredFlag); - Yap_InitCPred("profon" , 0, profon0, SafePredFlag); - Yap_InitCPred("profon" , 1, profon, SafePredFlag); + Yap_InitCPred("ProfOn" , 0, ProfOn0, SafePredFlag); + Yap_InitCPred("ProfOn" , 1, ProfOn, SafePredFlag); Yap_InitCPred("profoff", 0, profoff, SafePredFlag); Yap_InitCPred("profalt", 0, profalt, SafePredFlag); Yap_InitCPred("$offline_showprofres", 0, profres0, SafePredFlag); diff --git a/C/grow.c b/C/grow.c index c44f3d91d..72a34cb89 100755 --- a/C/grow.c +++ b/C/grow.c @@ -42,20 +42,7 @@ typedef enum { STACK_INCREMENTAL_COPYING = 2 } what_stack_copying; -static int heap_overflows = 0; -static Int total_heap_overflow_time = 0; -int stack_overflows = 0; -static Int total_stack_overflow_time = 0; - -int delay_overflows = 0; -static Int total_delay_overflow_time = 0; - -static int trail_overflows = 0; -static Int total_trail_overflow_time = 0; - -static int atom_table_overflows = 0; -static Int total_atom_table_overflow_time = 0; STATIC_PROTO(Int p_growheap, ( USES_REGS1 )); STATIC_PROTO(Int p_growstack, ( USES_REGS1 )); @@ -85,10 +72,11 @@ STATIC_PROTO(Term AdjustGlobTerm, (Term CACHE_TYPE)); static void LeaveGrowMode(prolog_exec_mode grow_mode) { - Yap_PrologMode &= ~grow_mode; - if (Yap_PrologMode & AbortMode) { + CACHE_REGS + LOCAL_PrologMode &= ~grow_mode; + if (LOCAL_PrologMode & AbortMode) { CACHE_REGS - Yap_PrologMode &= ~AbortMode; + LOCAL_PrologMode &= ~AbortMode; Yap_Error(PURE_ABORT, TermNil, ""); /* in case someone mangles the P register */ save_machine_regs(); @@ -98,7 +86,7 @@ LeaveGrowMode(prolog_exec_mode grow_mode) #if PUSH_REGS restore_absmi_regs(&Yap_standard_regs); #endif - siglongjmp (Yap_RestartEnv, 1); + siglongjmp (LOCAL_RestartEnv, 1); #endif } } @@ -121,27 +109,27 @@ static void SetHeapRegs(int copying_threads USES_REGS) { #ifdef undf7 - fprintf(Yap_stderr,"HeapBase = %x\tHeapTop=%x\nGlobalBase=%x\tGlobalTop=%x\nLocalBase=%x\tLocatTop=%x\n", Yap_HeapBase, HeapTop, Yap_GlobalBase, H, LCL0, ASP); + fprintf(GLOBAL_stderr,"HeapBase = %x\tHeapTop=%x\nGlobalBase=%x\tGlobalTop=%x\nLocalBase=%x\tLocatTop=%x\n", Yap_HeapBase, HeapTop, LOCAL_GlobalBase, H, LCL0, ASP); #endif /* The old stack pointers */ LOCAL_OldLCL0 = LCL0; LOCAL_OldASP = ASP; - LOCAL_OldGlobalBase = (CELL *)Yap_GlobalBase; + LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldH = H; LOCAL_OldH0 = H0; - LOCAL_OldTrailBase = Yap_TrailBase; - LOCAL_OldTrailTop = Yap_TrailTop; + LOCAL_OldTrailBase = LOCAL_TrailBase; + LOCAL_OldTrailTop = LOCAL_TrailTop; LOCAL_OldTR = TR; LOCAL_OldHeapBase = Yap_HeapBase; LOCAL_OldHeapTop = HeapTop; /* Adjust stack addresses */ - Yap_TrailBase = TrailAddrAdjust(Yap_TrailBase); - Yap_TrailTop = TrailAddrAdjust(Yap_TrailTop); + LOCAL_TrailBase = TrailAddrAdjust(LOCAL_TrailBase); + LOCAL_TrailTop = TrailAddrAdjust(LOCAL_TrailTop); if (LOCAL_GDiff) { /* make sure we are not just expanding the delay stack */ - Yap_GlobalBase = BaseAddrAdjust(Yap_GlobalBase); + LOCAL_GlobalBase = BaseAddrAdjust(LOCAL_GlobalBase); } - Yap_LocalBase = LocalAddrAdjust(Yap_LocalBase); + LOCAL_LocalBase = LocalAddrAdjust(LOCAL_LocalBase); #if !USE_SYSTEM_MALLOC && !USE_DL_MALLOC AuxSp = PtoBaseAdjust(AuxSp); AuxTop = (ADDR)PtoBaseAdjust((CELL *)AuxTop); @@ -275,7 +263,7 @@ RestoreTrail(int worker_p USES_REGS) if (IsVarTerm(aux_cell)) { if (aux_cell < LOCAL_start_global_copy || EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) { YAPOR_ERROR_CHECKING((CELL *)aux_cell < H0, "RestoreTrail: aux_cell < H0"); - YAPOR_ERROR_CHECKING((ADDR)aux_cell > Yap_LocalBase, "RestoreTrail: aux_cell > LocalBase"); + YAPOR_ERROR_CHECKING((ADDR)aux_cell > LOCAL_LocalBase, "RestoreTrail: aux_cell > LocalBase"); #ifdef TABLING *((CELL *) aux_cell) = TrailVal(aux_tr); #else @@ -286,7 +274,7 @@ RestoreTrail(int worker_p USES_REGS) } else if (IsPairTerm(aux_cell)) { /* avoid frozen segments */ aux_cell = (CELL) RepPair(aux_cell); - if (IN_BETWEEN(Yap_TrailBase, aux_cell, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) { aux_tr = (tr_fr_ptr) aux_cell; } #endif /* TABLING */ @@ -319,7 +307,7 @@ MoveGlobal( USES_REGS1 ) * cpcellsd(To,From,NOfCells) - copy the cells downwards - in * absmi.asm */ - cpcellsd((CELL *)Yap_GlobalBase, (CELL *)LOCAL_OldGlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); + cpcellsd((CELL *)LOCAL_GlobalBase, (CELL *)LOCAL_OldGlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); } static void @@ -329,7 +317,7 @@ MoveExpandedGlobal( USES_REGS1 ) * cpcellsd(To,From,NOfCells) - copy the cells downwards - in * absmi.asm */ - cpcellsd((CELL *)(Yap_GlobalBase+(LOCAL_GDiff-LOCAL_BaseDiff)), (CELL *)Yap_GlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); + cpcellsd((CELL *)(LOCAL_GlobalBase+(LOCAL_GDiff-LOCAL_BaseDiff)), (CELL *)LOCAL_GlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); } static void @@ -340,7 +328,7 @@ MoveGlobalWithHole( USES_REGS1 ) * absmi.asm */ #if USE_SYSTEM_MALLOC - cpcellsd((CELL *)((char *)Yap_GlobalBase+(LOCAL_GDiff0-LOCAL_BaseDiff)), (CELL *)Yap_GlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); + cpcellsd((CELL *)((char *)LOCAL_GlobalBase+(LOCAL_GDiff0-LOCAL_BaseDiff)), (CELL *)LOCAL_GlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); #else cpcellsd((CELL *)((char *)LOCAL_OldGlobalBase+LOCAL_GDiff0), (CELL *)LOCAL_OldGlobalBase, LOCAL_OldH - (CELL *)LOCAL_OldGlobalBase); #endif @@ -373,7 +361,7 @@ AdjustAppl(register CELL t0 USES_REGS) #ifdef DEBUG else { /* strange cell */ - /* fprintf(Yap_stderr,"% garbage appl %lx found in stacks by stack shifter\n", t0);*/ + /* fprintf(GLOBAL_stderr,"% garbage appl %lx found in stacks by stack shifter\n", t0);*/ } #endif return(t0); @@ -391,7 +379,7 @@ AdjustPair(register CELL t0 USES_REGS) else if (IsHeapP(t)) return (AbsPair(CellPtoHeapAdjust(t))); #ifdef DEBUG - /* fprintf(Yap_stderr,"% garbage pair %lx found in stacks by stack shifter\n", t0);*/ + /* fprintf(GLOBAL_stderr,"% garbage pair %lx found in stacks by stack shifter\n", t0);*/ #endif return(t0); } @@ -399,7 +387,7 @@ AdjustPair(register CELL t0 USES_REGS) static void AdjustTrail(int adjusting_heap, int thread_copying USES_REGS) { - volatile tr_fr_ptr ptt, tr_base = (tr_fr_ptr)Yap_TrailBase; + volatile tr_fr_ptr ptt, tr_base = (tr_fr_ptr)LOCAL_TrailBase; #if defined(YAPOR_THREADS) if (thread_copying == STACK_INCREMENTAL_COPYING) { @@ -736,10 +724,10 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep USES_REGS) ves = *vep = (VarEntry *)TrailAddrAdjust((ADDR)ves); AdjustVarTable(ves PASS_REGS); } - ves = Yap_AnonVarTable; + ves = LOCAL_AnonVarTable; if (ves != NULL) { if (IsOldVarTableTrailPtr(ves)) - ves = Yap_AnonVarTable = VarEntryAdjust(ves); + ves = LOCAL_AnonVarTable = VarEntryAdjust(ves); } while (ves != NULL) { VarEntry *vetmp = ves->VarLeft; @@ -773,28 +761,28 @@ static_growheap(long size, int fix_code, struct intermediates *cip, tr_fr_ptr *o if (size < YAP_ALLOC_SIZE) size = YAP_ALLOC_SIZE; size = AdjustPageSize(size); - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; if (!Yap_ExtendWorkSpace(size)) { - Int min_size = AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap); + Int min_size = AdjustPageSize(((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)+MinHeapGap); - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; if (size < min_size) size = min_size; minimal_request = size; size = Yap_ExtendWorkSpaceThroughHole(size); if (size < 0) { - Yap_ErrorMessage = "Database crashed against Stacks"; + LOCAL_ErrorMessage = "Database crashed against Stacks"; return FALSE; } } start_growth_time = Yap_cputime(); gc_verbose = Yap_is_gc_verbose(); - heap_overflows++; + LOCAL_heap_overflows++; if (gc_verbose) { #if defined(YAPOR_THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% Database Overflow %d\n", heap_overflows); - fprintf(Yap_stderr, "%% growing the heap %ld bytes\n", size); + fprintf(GLOBAL_stderr, "%% Database Overflow %d\n", LOCAL_heap_overflows); + fprintf(GLOBAL_stderr, "%% growing the heap %ld bytes\n", size); } /* CreepFlag is set to force heap expansion */ if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) { @@ -835,10 +823,10 @@ static_growheap(long size, int fix_code, struct intermediates *cip, tr_fr_ptr *o if (minimal_request) Yap_AllocHole(minimal_request, size); growth_time = Yap_cputime()-start_growth_time; - total_heap_overflow_time += growth_time; + LOCAL_total_heap_overflow_time += growth_time; if (gc_verbose) { - fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000); - fprintf(Yap_stderr, "%% Total of %g sec expanding Database\n", (double)total_heap_overflow_time/1000); + fprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000); + fprintf(GLOBAL_stderr, "%% Total of %g sec expanding Database\n", (double)LOCAL_total_heap_overflow_time/1000); } return(TRUE); } @@ -851,7 +839,7 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) UInt start_growth_time, growth_time; int gc_verbose; char *omax = (char *)H0; - ADDR old_GlobalBase = Yap_GlobalBase; + ADDR old_GlobalBase = LOCAL_GlobalBase; UInt minimal_request = 0L; long size = request; char vb_msg1 = '\0', *vb_msg2; @@ -867,10 +855,10 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) if (hsplit) { /* just a little bit of sanity checking */ - if (hsplit < H0 && hsplit > (CELL *)Yap_GlobalBase) { + if (hsplit < H0 && hsplit > (CELL *)LOCAL_GlobalBase) { insert_in_delays = TRUE; /* expanding attributed variables */ - if (omax - size > Yap_GlobalBase+4096*sizeof(CELL)) { + if (omax - size > LOCAL_GlobalBase+4096*sizeof(CELL)) { /* we can just ask for more room */ size = 0; do_grow = FALSE; @@ -899,30 +887,30 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) size = AdjustPageSize(size); } /* adjust to a multiple of 256) */ - Yap_ErrorMessage = NULL; - Yap_PrologMode |= GrowStackMode; + LOCAL_ErrorMessage = NULL; + LOCAL_PrologMode |= GrowStackMode; start_growth_time = Yap_cputime(); if (do_grow) { if (!GLOBAL_AllowGlobalExpansion) { - Yap_ErrorMessage = "Global Stack crashed against Local Stack"; + LOCAL_ErrorMessage = "Global Stack crashed against Local Stack"; LeaveGrowMode(GrowStackMode); return 0; } if (!GLOBAL_AllowGlobalExpansion || !Yap_ExtendWorkSpace(size)) { /* always fails when using malloc */ - Yap_ErrorMessage = NULL; - size += AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+MinHeapGap); + LOCAL_ErrorMessage = NULL; + size += AdjustPageSize(((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)+MinHeapGap); minimal_request = size; size = Yap_ExtendWorkSpaceThroughHole(size); if (size < 0) { - Yap_ErrorMessage = "Global Stack crashed against Local Stack"; + LOCAL_ErrorMessage = "Global Stack crashed against Local Stack"; LeaveGrowMode(GrowStackMode); return 0; } } } gc_verbose = Yap_is_gc_verbose(); - delay_overflows++; + LOCAL_delay_overflows++; if (gc_verbose) { if (hsplit) { if (hsplit > H0) { @@ -937,10 +925,10 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) vb_msg2 = "Delay"; } #if defined(YAPOR_THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% %cO %s Overflow %d\n", vb_msg1, vb_msg2, delay_overflows); - fprintf(Yap_stderr, "%% %cO growing the stacks %ld bytes\n", vb_msg1, size); + fprintf(GLOBAL_stderr, "%% %cO %s Overflow %d\n", vb_msg1, vb_msg2, LOCAL_delay_overflows); + fprintf(GLOBAL_stderr, "%% %cO growing the stacks %ld bytes\n", vb_msg1, size); } ASP -= 256; YAPEnterCriticalSection(); @@ -949,11 +937,11 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) /* we got over a hole */ if (minimal_request) { /* we went over a hole */ - LOCAL_BaseDiff = size+((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)-minimal_request; + LOCAL_BaseDiff = size+((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)-minimal_request; LOCAL_LDiff = LOCAL_TrDiff = size; } else { /* we may still have an overflow */ - LOCAL_BaseDiff = Yap_GlobalBase - old_GlobalBase; + LOCAL_BaseDiff = LOCAL_GlobalBase - old_GlobalBase; /* if we grow, we need to move the stacks */ LOCAL_LDiff = LOCAL_TrDiff = LOCAL_BaseDiff+size; } @@ -983,7 +971,7 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) } LOCAL_GSplit = hsplit; LOCAL_XDiff = LOCAL_HDiff = 0; - Yap_GlobalBase = old_GlobalBase; + LOCAL_GlobalBase = old_GlobalBase; SetHeapRegs(FALSE PASS_REGS); if (do_grow) { MoveLocalAndTrail( PASS_REGS1 ); @@ -1019,10 +1007,10 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit USES_REGS) Yap_AllocHole(minimal_request, size); } growth_time = Yap_cputime()-start_growth_time; - total_delay_overflow_time += growth_time; + LOCAL_total_delay_overflow_time += growth_time; if (gc_verbose) { - fprintf(Yap_stderr, "%% %cO took %g sec\n", vb_msg1, (double)growth_time/1000); - fprintf(Yap_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)total_delay_overflow_time/1000); + fprintf(GLOBAL_stderr, "%% %cO took %g sec\n", vb_msg1, (double)growth_time/1000); + fprintf(GLOBAL_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)LOCAL_total_delay_overflow_time/1000); } LeaveGrowMode(GrowStackMode); if (hsplit) { @@ -1246,7 +1234,7 @@ static int do_growheap(int fix_code, UInt in_size, struct intermediates *cip, tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep USES_REGS) { unsigned long size = sizeof(CELL) * K16; - int shift_factor = (heap_overflows > 8 ? 8 : heap_overflows); + int shift_factor = (LOCAL_heap_overflows > 8 ? 8 : LOCAL_heap_overflows); unsigned long sz = size << shift_factor; if (sz < in_size) { @@ -1355,13 +1343,13 @@ growatomtable( USES_REGS1 ) #endif return FALSE; } - atom_table_overflows++; + LOCAL_atom_table_overflows ++; if (gc_verbose) { #if defined(YAPOR_THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% Atom Table Overflow %d\n", atom_table_overflows); - fprintf(Yap_stderr, "%% growing the atom table to %ld entries\n", (long int)(nsize)); + fprintf(GLOBAL_stderr, "%% Atom Table Overflow %d\n", LOCAL_atom_table_overflows ); + fprintf(GLOBAL_stderr, "%% growing the atom table to %ld entries\n", (long int)(nsize)); } YAPEnterCriticalSection(); init_new_table(ntb, nsize); @@ -1371,10 +1359,10 @@ growatomtable( USES_REGS1 ) AtomHashTableSize = nsize; YAPLeaveCriticalSection(); growth_time = Yap_cputime()-start_growth_time; - total_atom_table_overflow_time += growth_time; + LOCAL_total_atom_table_overflow_time += growth_time; if (gc_verbose) { - fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000); - fprintf(Yap_stderr, "%% Total of %g sec expanding atom table \n", (double)total_atom_table_overflow_time/1000); + fprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000); + fprintf(GLOBAL_stderr, "%% Total of %g sec expanding atom table \n", (double)LOCAL_total_atom_table_overflow_time/1000); } #if USE_SYSTEM_MALLOC return TRUE; @@ -1480,7 +1468,7 @@ Yap_growstack(long size) CACHE_REGS int res; - Yap_PrologMode |= GrowStackMode; + LOCAL_PrologMode |= GrowStackMode; res=growstack(size PASS_REGS); LeaveGrowMode(GrowStackMode); return res; @@ -1491,30 +1479,30 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp, { UInt minimal_request = 0L; long size = size0; - ADDR old_Yap_GlobalBase = Yap_GlobalBase; + ADDR old_LOCAL_GlobalBase = LOCAL_GlobalBase; if (!GLOBAL_AllowGlobalExpansion) { - Yap_ErrorMessage = "Database crashed against stacks"; + LOCAL_ErrorMessage = "Database crashed against stacks"; return FALSE; } if (!Yap_ExtendWorkSpace(size)) { /* make sure stacks and trail are contiguous */ - Yap_ErrorMessage = NULL; - minimal_request = AdjustPageSize(((CELL)Yap_TrailTop-(CELL)Yap_GlobalBase)+4*MinHeapGap+size0); + LOCAL_ErrorMessage = NULL; + minimal_request = AdjustPageSize(((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)+4*MinHeapGap+size0); size = Yap_ExtendWorkSpaceThroughHole(minimal_request); if (size < 0) { - Yap_ErrorMessage = "Database crashed against stacks"; + LOCAL_ErrorMessage = "Database crashed against stacks"; return FALSE; } YAPEnterCriticalSection(); LOCAL_GDiff = LOCAL_DelayDiff = LOCAL_BaseDiff = size-size0; } else { YAPEnterCriticalSection(); - if (Yap_GlobalBase != old_Yap_GlobalBase) { - LOCAL_GDiff = LOCAL_BaseDiff = LOCAL_DelayDiff = Yap_GlobalBase-old_Yap_GlobalBase; - Yap_GlobalBase=old_Yap_GlobalBase; + if (LOCAL_GlobalBase != old_LOCAL_GlobalBase) { + LOCAL_GDiff = LOCAL_BaseDiff = LOCAL_DelayDiff = LOCAL_GlobalBase-old_LOCAL_GlobalBase; + LOCAL_GlobalBase=old_LOCAL_GlobalBase; } else { LOCAL_GDiff = LOCAL_BaseDiff = LOCAL_DelayDiff = 0; } @@ -1537,7 +1525,7 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp, ASP -= 256; SetHeapRegs(FALSE PASS_REGS); if (from_trail) { - Yap_TrailTop += size0; + LOCAL_TrailTop += size0; } if (LOCAL_LDiff) { MoveLocalAndTrail( PASS_REGS1 ); @@ -1599,28 +1587,28 @@ growstack(long size USES_REGS) if (size < YAP_ALLOC_SIZE) size = YAP_ALLOC_SIZE; size = AdjustPageSize(size); - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; start_growth_time = Yap_cputime(); gc_verbose = Yap_is_gc_verbose(); - stack_overflows++; + LOCAL_stack_overflows++; if (gc_verbose) { #if defined(YAPOR) || defined(THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% Stack Overflow %d\n", stack_overflows); - fprintf(Yap_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),Yap_GlobalBase,H); - fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); - fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n", - (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR); - fprintf(Yap_stderr, "%% Growing the stacks %ld bytes\n", size); + fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows); + fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,H); + fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); + fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", + (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); + fprintf(GLOBAL_stderr, "%% Growing the stacks %ld bytes\n", size); } if (!execute_growstack(size, FALSE, FALSE, NULL, NULL, NULL PASS_REGS)) return FALSE; growth_time = Yap_cputime()-start_growth_time; - total_stack_overflow_time += growth_time; + LOCAL_total_stack_overflow_time += growth_time; if (gc_verbose) { - fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000); - fprintf(Yap_stderr, "%% Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000); + fprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000); + fprintf(GLOBAL_stderr, "%% Total of %g sec expanding stacks \n", (double)LOCAL_total_stack_overflow_time/1000); } return TRUE; } @@ -1634,33 +1622,33 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep) UInt start_growth_time, growth_time; int gc_verbose; - Yap_PrologMode |= GrowStackMode; + LOCAL_PrologMode |= GrowStackMode; /* adjust to a multiple of 256) */ - size = AdjustPageSize((ADDR)LCL0-Yap_GlobalBase); - Yap_ErrorMessage = NULL; + size = AdjustPageSize((ADDR)LCL0-LOCAL_GlobalBase); + LOCAL_ErrorMessage = NULL; start_growth_time = Yap_cputime(); gc_verbose = Yap_is_gc_verbose(); - stack_overflows++; + LOCAL_stack_overflows++; if (gc_verbose) { #if defined(YAPOR) || defined(THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% Stack Overflow %d\n", stack_overflows); - fprintf(Yap_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),Yap_GlobalBase,H); - fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); - fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n", - (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR); - fprintf(Yap_stderr, "%% Growing the stacks %ld bytes\n", (unsigned long int)size); + fprintf(GLOBAL_stderr, "%% Stack Overflow %d\n", LOCAL_stack_overflows); + fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)LOCAL_GlobalBase),LOCAL_GlobalBase,H); + fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); + fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", + (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); + fprintf(GLOBAL_stderr, "%% Growing the stacks %ld bytes\n", (unsigned long int)size); } if (!execute_growstack(size, FALSE, TRUE, old_trp, tksp, vep PASS_REGS)) { LeaveGrowMode(GrowStackMode); return FALSE; } growth_time = Yap_cputime()-start_growth_time; - total_stack_overflow_time += growth_time; + LOCAL_total_stack_overflow_time += growth_time; if (gc_verbose) { - fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000); - fprintf(Yap_stderr, "%% Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000); + fprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000); + fprintf(GLOBAL_stderr, "%% Total of %g sec expanding stacks \n", (double)LOCAL_total_stack_overflow_time/1000); } LeaveGrowMode(GrowStackMode); return TRUE; @@ -1678,7 +1666,7 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr #endif /* at least 64K for trail */ if (!size) - size = ((ADDR)TR-Yap_TrailBase); + size = ((ADDR)TR-LOCAL_TrailBase); size *= 2; if (size < YAP_ALLOC_SIZE) size = YAP_ALLOC_SIZE; @@ -1688,33 +1676,33 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr size=size0; /* adjust to a multiple of 256) */ size = AdjustPageSize(size); - trail_overflows++; + LOCAL_trail_overflows++; if (gc_verbose) { #if defined(YAPOR) || defined(THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% Trail Overflow %d\n", trail_overflows); + fprintf(GLOBAL_stderr, "%% Trail Overflow %d\n", LOCAL_trail_overflows); #if USE_SYSTEM_MALLOC - fprintf(Yap_stderr, "%% Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)Yap_GlobalBase),(CELL *)Yap_GlobalBase,H); - fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); - fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n", - (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR); + fprintf(GLOBAL_stderr, "%% Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)LOCAL_GlobalBase),(CELL *)LOCAL_GlobalBase,H); + fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); + fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", + (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); #endif - fprintf(Yap_stderr, "%% growing the trail %ld bytes\n", size); + fprintf(GLOBAL_stderr, "%% growing the trail %ld bytes\n", size); } - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; if (!GLOBAL_AllowTrailExpansion) { - Yap_ErrorMessage = "Trail Overflow"; + LOCAL_ErrorMessage = "Trail Overflow"; return FALSE; } #if USE_SYSTEM_MALLOC execute_growstack(size, TRUE, in_parser, old_trp, tksp, vep PASS_REGS); #else if (!Yap_ExtendWorkSpace(size)) { - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; if (contiguous_only) { /* I can't expand in this case */ - trail_overflows--; + LOCAL_trail_overflows--; return FALSE; } execute_growstack(size, TRUE, in_parser, old_trp, tksp, vep PASS_REGS); @@ -1724,15 +1712,15 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr LOCAL_TrDiff = LOCAL_LDiff = LOCAL_GDiff = LOCAL_BaseDiff = LOCAL_DelayDiff = LOCAL_XDiff = LOCAL_HDiff = LOCAL_GDiff0 = 0; AdjustScannerStacks(tksp, vep PASS_REGS); } - Yap_TrailTop += size; + LOCAL_TrailTop += size; YAPLeaveCriticalSection(); } #endif growth_time = Yap_cputime()-start_growth_time; - total_trail_overflow_time += growth_time; + LOCAL_total_trail_overflow_time += growth_time; if (gc_verbose) { - fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000); - fprintf(Yap_stderr, "%% Total of %g sec expanding trail \n", (double)total_trail_overflow_time/1000); + fprintf(GLOBAL_stderr, "%% took %g sec\n", (double)growth_time/1000); + fprintf(GLOBAL_stderr, "%% Total of %g sec expanding trail \n", (double)LOCAL_total_trail_overflow_time/1000); } LOCK(LOCAL_SignalLock); if (LOCAL_ActiveSignals == YAP_TROVF_SIGNAL) { @@ -1801,8 +1789,8 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp) static Int p_inform_trail_overflows( USES_REGS1 ) { - Term tn = MkIntTerm(trail_overflows); - Term tt = MkIntegerTerm(total_trail_overflow_time); + Term tn = MkIntTerm(LOCAL_trail_overflows); + Term tt = MkIntegerTerm(LOCAL_total_trail_overflow_time); return(Yap_unify(tn, ARG1) && Yap_unify(tt, ARG2)); } @@ -1831,8 +1819,8 @@ p_growheap( USES_REGS1 ) static Int p_inform_heap_overflows( USES_REGS1 ) { - Term tn = MkIntTerm(heap_overflows); - Term tt = MkIntegerTerm(total_heap_overflow_time); + Term tn = MkIntTerm(LOCAL_heap_overflows); + Term tt = MkIntegerTerm(LOCAL_total_heap_overflow_time); return(Yap_unify(tn, ARG1) && Yap_unify(tt, ARG2)); } @@ -1855,10 +1843,10 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental) REMOTE_ThreadHandle(worker_q).ssize = REMOTE_ThreadHandle(worker_p).ssize; REMOTE_ThreadHandle(worker_q).tsize = REMOTE_ThreadHandle(worker_p).tsize; /* compute offset indicators */ - Yap_GlobalBase = Yap_thread_gl[worker_p].global_base; - Yap_LocalBase = Yap_thread_gl[worker_p].local_base; - Yap_TrailBase = Yap_thread_gl[worker_p].trail_base; - Yap_TrailTop = Yap_thread_gl[worker_p].trail_top; + LOCAL_GlobalBase = REMOTE_GlobalBase(worker_p); + LOCAL_LocalBase = REMOTE_LocalBase(worker_p); + LOCAL_TrailBase = REMOTE_TrailBase(worker_p); + LOCAL_TrailTop = REMOTE_TrailTop(worker_p); size = REMOTE_ThreadHandle(worker_q).stack_address-REMOTE_ThreadHandle(worker_p).stack_address; LOCAL_TrDiff = LOCAL_LDiff = LOCAL_GDiff = LOCAL_GDiff0 = LOCAL_DelayDiff = LOCAL_BaseDiff = size; LOCAL_XDiff = LOCAL_HDiff = 0; @@ -1929,8 +1917,8 @@ p_growstack( USES_REGS1 ) static Int p_inform_stack_overflows( USES_REGS1 ) { /* */ - Term tn = MkIntTerm(stack_overflows); - Term tt = MkIntegerTerm(total_stack_overflow_time); + Term tn = MkIntTerm(LOCAL_stack_overflows); + Term tt = MkIntegerTerm(LOCAL_total_stack_overflow_time); return(Yap_unify(tn, ARG1) && Yap_unify(tt, ARG2)); @@ -1939,9 +1927,10 @@ p_inform_stack_overflows( USES_REGS1 ) Int Yap_total_stack_shift_time(void) { - return(total_heap_overflow_time+ - total_stack_overflow_time+ - total_trail_overflow_time); + CACHE_REGS + return(LOCAL_total_heap_overflow_time+ + LOCAL_total_stack_overflow_time+ + LOCAL_total_trail_overflow_time); } void diff --git a/C/heapgc.c b/C/heapgc.c index c288b9ef2..4f60e9678 100755 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -102,7 +102,7 @@ typedef struct RB_red_blk_node { static void gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0 USES_REGS) { - UInt sz = Yap_TrailTop-(ADDR)LOCAL_OldTR; + UInt sz = LOCAL_TrailTop-(ADDR)LOCAL_OldTR; /* ask for double the size */ sz = 2*sz; @@ -131,7 +131,7 @@ PUSH_CONTINUATION(CELL *v, int nof USES_REGS) { cont *x; x = LOCAL_cont_top; x++; - if ((ADDR)x > Yap_TrailTop-1024) { + if ((ADDR)x > LOCAL_TrailTop-1024) { gc_growtrail(TRUE, NULL, NULL PASS_REGS); } x->v = v; @@ -294,7 +294,7 @@ static inline gc_ma_hash_entry * GC_ALLOC_NEW_MASPACE( USES_REGS1 ) { gc_ma_hash_entry *new = LOCAL_gc_ma_h_top; - if ((char *)LOCAL_gc_ma_h_top > Yap_TrailTop-1024) + if ((char *)LOCAL_gc_ma_h_top > LOCAL_TrailTop-1024) gc_growtrail(FALSE, NULL, NULL PASS_REGS); LOCAL_gc_ma_h_top++; LOCAL_cont_top = (cont *)LOCAL_gc_ma_h_top; @@ -378,7 +378,7 @@ GC_NEW_MAHASH(gc_ma_hash_entry *top USES_REGS) { static void check_pr_trail(tr_fr_ptr trp USES_REGS) { - if ((tr_fr_ptr)Yap_TrailTop-TR < 1024) { + if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) { if (!Yap_growtrail(0, TRUE) || TRUE) { /* could not find more trail */ save_machine_regs(); @@ -553,7 +553,7 @@ RBMalloc(UInt size USES_REGS) ADDR new = LOCAL_db_vec; LOCAL_db_vec += size; - if ((ADDR)LOCAL_db_vec > Yap_TrailTop-1024) { + if ((ADDR)LOCAL_db_vec > LOCAL_TrailTop-1024) { gc_growtrail(FALSE, NULL, NULL PASS_REGS); } return (rb_red_blk_node *)new; @@ -873,7 +873,7 @@ init_dbtable(tr_fr_ptr trail_ptr USES_REGS) { LOCAL_db_vec0 = LOCAL_db_vec = (ADDR)TR; LOCAL_db_root = RBTreeCreate(); - while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) { + while (trail_ptr > (tr_fr_ptr)LOCAL_TrailBase) { register CELL trail_cell; trail_ptr--; @@ -891,7 +891,7 @@ init_dbtable(tr_fr_ptr trail_ptr USES_REGS) { #ifdef YAPOR_SBA (ADDR) pt0 >= HeapTop #else - (ADDR) pt0 >= Yap_TrailBase && (ADDR) pt0 < Yap_TrailTop + (ADDR) pt0 >= LOCAL_TrailBase && (ADDR) pt0 < LOCAL_TrailTop #endif ) { continue; @@ -978,17 +978,17 @@ inc_vars_of_type(CELL *curr,gc_types val) { static void put_type_info(unsigned long total) { - fprintf(Yap_stderr,"%% type info for %lu cells\n", total); - fprintf(Yap_stderr,"%% %lu vars\n", vars[gc_var]); - fprintf(Yap_stderr,"%% %lu refs\n", vars[gc_ref]); - fprintf(Yap_stderr,"%% %lu references from env\n", env_vars); - fprintf(Yap_stderr,"%% %lu atoms\n", vars[gc_atom]); - fprintf(Yap_stderr,"%% %lu small ints\n", vars[gc_int]); - fprintf(Yap_stderr,"%% %lu other numbers\n", vars[gc_num]); - fprintf(Yap_stderr,"%% %lu lists\n", vars[gc_list]); - fprintf(Yap_stderr,"%% %lu compound terms\n", vars[gc_appl]); - fprintf(Yap_stderr,"%% %lu functors\n", vars[gc_func]); - fprintf(Yap_stderr,"%% %lu suspensions\n", vars[gc_susp]); + fprintf(GLOBAL_stderr,"%% type info for %lu cells\n", total); + fprintf(GLOBAL_stderr,"%% %lu vars\n", vars[gc_var]); + fprintf(GLOBAL_stderr,"%% %lu refs\n", vars[gc_ref]); + fprintf(GLOBAL_stderr,"%% %lu references from env\n", env_vars); + fprintf(GLOBAL_stderr,"%% %lu atoms\n", vars[gc_atom]); + fprintf(GLOBAL_stderr,"%% %lu small ints\n", vars[gc_int]); + fprintf(GLOBAL_stderr,"%% %lu other numbers\n", vars[gc_num]); + fprintf(GLOBAL_stderr,"%% %lu lists\n", vars[gc_list]); + fprintf(GLOBAL_stderr,"%% %lu compound terms\n", vars[gc_appl]); + fprintf(GLOBAL_stderr,"%% %lu functors\n", vars[gc_func]); + fprintf(GLOBAL_stderr,"%% %lu suspensions\n", vars[gc_susp]); } static void @@ -1066,7 +1066,7 @@ check_global(void) { #if INSTRUMENT_GC if (IsVarTerm(ccurr)) { if (IsBlobFunctor((Functor)ccurr)) vars[gc_num]++; - else if (ccurr != 0 && (ccurr < (CELL)Yap_GlobalBase || ccurr > (CELL)Yap_TrailTop)) { + else if (ccurr != 0 && (ccurr < (CELL)LOCAL_GlobalBase || ccurr > (CELL)LOCAL_TrailTop)) { /* printf("%p: %s/%d\n", current, RepAtom(NameOfFunctor((Functor)ccurr))->StrOfAE, ArityOfFunctor((Functor)ccurr));*/ @@ -1131,7 +1131,7 @@ mark_variable(CELL_PTR current USES_REGS) next = GET_NEXT(ccur); if (IsVarTerm(ccur)) { - if (IN_BETWEEN(Yap_GlobalBase,current,H) && GlobalIsAttVar(current) && current==next) { + if (IN_BETWEEN(LOCAL_GlobalBase,current,H) && GlobalIsAttVar(current) && current==next) { if (next < H0) POP_CONTINUATION(); if (!UNMARKED_MARK(next-1,local_bp)) { LOCAL_total_marked++; @@ -1213,8 +1213,8 @@ mark_variable(CELL_PTR current USES_REGS) } goto begin; #ifdef DEBUG - } else if (next < (CELL *)Yap_GlobalBase || next > (CELL *)Yap_TrailTop) { - fprintf(Yap_stderr, "OOPS in GC: marking, current=%p, *current=" UInt_FORMAT " next=%p\n", current, ccur, next); + } else if (next < (CELL *)LOCAL_GlobalBase || next > (CELL *)LOCAL_TrailTop) { + fprintf(GLOBAL_stderr, "OOPS in GC: marking, current=%p, *current=" UInt_FORMAT " next=%p\n", current, ccur, next); #endif } else { #ifdef COROUTING @@ -1455,7 +1455,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap USES_REGS) #ifdef DEBUG if (size < 0 || size > 512) - fprintf(Yap_stderr,"OOPS in GC: env size for %p is " UInt_FORMAT "\n", gc_ENV, (CELL)size); + fprintf(GLOBAL_stderr,"OOPS in GC: env size for %p is " UInt_FORMAT "\n", gc_ENV, (CELL)size); #endif mark_db_fixed((CELL *)gc_ENV[E_CP] PASS_REGS); /* for each saved variable */ @@ -1533,14 +1533,14 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap USES_REGS) PredEntry *pe = EnvPreg(gc_ENV[E_CP]); op_numbers op = Yap_op_from_opcode(ENV_ToOp(gc_ENV[E_CP])); #if defined(ANALYST) || defined(DEBUG) - fprintf(Yap_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, Yap_op_names[op]); + fprintf(GLOBAL_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, Yap_op_names[op]); #else - fprintf(Yap_stderr,"ENV %p-%p(%d) %d\n", gc_ENV, pvbmap, size-EnvSizeInCells, (int)op); + fprintf(GLOBAL_stderr,"ENV %p-%p(%d) %d\n", gc_ENV, pvbmap, size-EnvSizeInCells, (int)op); #endif if (pe->ArityOfPE) - fprintf(Yap_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE); + fprintf(GLOBAL_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE); else - fprintf(Yap_stderr," %s\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE); + fprintf(GLOBAL_stderr," %s\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE); } #endif gc_ENV = (CELL_PTR) gc_ENV[E_E]; /* link to prev @@ -1597,10 +1597,10 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B #ifdef FROZEN_STACKS RESET_VARIABLE(&TrailVal(trail_base)); #endif - } else if (hp < (CELL *)Yap_GlobalBase || hp > (CELL *)Yap_TrailTop) { + } else if (hp < (CELL *)LOCAL_GlobalBase || hp > (CELL *)LOCAL_TrailTop) { /* 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) { + } else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)LOCAL_TrailBase) { /* clean the trail, avoid dangling pointers! */ RESET_VARIABLE(&TrailTerm(trail_base)); #ifdef FROZEN_STACKS @@ -1615,7 +1615,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B nondeterministically, I know that after backtracking it will be back to be an unbound variable. The ideal solution would be to unbind all variables. The current solution is to remark it as an attributed variable */ - if (IN_BETWEEN(Yap_GlobalBase,hp,H) && GlobalIsAttVar(hp) && !UNMARKED_MARK(hp-1,LOCAL_bp)) { + if (IN_BETWEEN(LOCAL_GlobalBase,hp,H) && GlobalIsAttVar(hp) && !UNMARKED_MARK(hp-1,LOCAL_bp)) { LOCAL_total_marked++; PUSH_POINTER(hp-1 PASS_REGS); if (hp-1 < LOCAL_HGEN) { @@ -1633,7 +1633,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B tr_fr_ptr nsTR = (tr_fr_ptr)LOCAL_cont_top0; CELL *cptr = (CELL *)trail_cell; - if ((ADDR)nsTR > Yap_TrailTop-1024) { + if ((ADDR)nsTR > LOCAL_TrailTop-1024) { gc_growtrail(TRUE, begsTR, old_cont_top0 PASS_REGS); } TrailTerm(nsTR) = (CELL)NULL; @@ -1655,7 +1655,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B } else if (IsPairTerm(trail_cell)) { /* can safely ignore this */ CELL *cptr = RepPair(trail_cell); - if (IN_BETWEEN(Yap_GlobalBase,cptr,H) && + if (IN_BETWEEN(LOCAL_GlobalBase,cptr,H) && GlobalIsAttVar(cptr)) { TrailTerm(trail_base) = (CELL)cptr; mark_external_reference(&TrailTerm(trail_base) PASS_REGS); @@ -1899,19 +1899,19 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose PredEntry *pe = Yap_PredForChoicePt(gc_B); #if defined(ANALYST) || defined(DEBUG) if (pe == NULL) { - fprintf(Yap_stderr,"%% marked %ld (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]); + fprintf(GLOBAL_stderr,"%% marked %ld (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]); } else if (pe->ArityOfPE) { - fprintf(Yap_stderr,"%% %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, Yap_op_names[opnum]); + fprintf(GLOBAL_stderr,"%% %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, Yap_op_names[opnum]); } else { - fprintf(Yap_stderr,"%% %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, Yap_op_names[opnum]); + fprintf(GLOBAL_stderr,"%% %s marked %ld (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, Yap_op_names[opnum]); } #else if (pe == NULL) { - fprintf(Yap_stderr,"%% marked %ld (%u)\n", LOCAL_total_marked, (unsigned int)opnum); + fprintf(GLOBAL_stderr,"%% marked %ld (%u)\n", LOCAL_total_marked, (unsigned int)opnum); } else if (pe->ArityOfPE) { - fprintf(Yap_stderr,"%% %s/%d marked %ld (%u)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, (unsigned int)opnum); + fprintf(GLOBAL_stderr,"%% %s/%d marked %ld (%u)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, LOCAL_total_marked, (unsigned int)opnum); } else { - fprintf(Yap_stderr,"%% %s marked %ld (%u)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, (unsigned int)opnum); + fprintf(GLOBAL_stderr,"%% %s marked %ld (%u)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, LOCAL_total_marked, (unsigned int)opnum); } #endif } @@ -2205,7 +2205,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose nargs = rtp->u.Otapl.s; break; default: - fprintf(Yap_stderr, "OOPS in GC: Unexpected opcode: %d\n", opnum); + fprintf(GLOBAL_stderr, "OOPS in GC: Unexpected opcode: %d\n", opnum); nargs = 0; #else default: @@ -2367,7 +2367,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS) next = current; current = NULL; /* next, clean trail */ - source = dest = (tr_fr_ptr)Yap_TrailBase; + source = dest = (tr_fr_ptr)LOCAL_TrailBase; while (source < old_TR) { CELL trail_cell; @@ -2397,7 +2397,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS) /* 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 (IN_BETWEEN(Yap_GlobalBase,TrailTerm(trail_ptr),Yap_TrailTop) && + if (IN_BETWEEN(LOCAL_GlobalBase,TrailTerm(trail_ptr),LOCAL_TrailTop) && MARKED_PTR(&TrailTerm(trail_ptr))) { UNMARK(&TrailTerm(trail_ptr)); if (HEAP_PTR(TrailTerm(trail_ptr))) { @@ -2407,7 +2407,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS) } /* next, follows the real trail entries */ - trail_ptr = (tr_fr_ptr)Yap_TrailBase; + trail_ptr = (tr_fr_ptr)LOCAL_TrailBase; dest = trail_ptr; while (trail_ptr < old_TR) { register CELL trail_cell; @@ -2445,7 +2445,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS) CELL *pt0 = RepPair(trail_cell); CELL flags; - if (IN_BETWEEN(Yap_GlobalBase, pt0, H) && GlobalIsAttVar(pt0)) { + if (IN_BETWEEN(LOCAL_GlobalBase, pt0, H) && GlobalIsAttVar(pt0)) { TrailTerm(dest) = trail_cell; /* be careful with partial gc */ if (HEAP_PTR(TrailTerm(dest))) { @@ -2459,9 +2459,9 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS) /* process all segments */ if ( #ifdef YAPOR_SBA - (ADDR) pt0 >= Yap_GlobalBase + (ADDR) pt0 >= LOCAL_GlobalBase #else - (ADDR) pt0 >= Yap_TrailBase + (ADDR) pt0 >= LOCAL_TrailBase #endif ) { trail_ptr++; @@ -2643,28 +2643,28 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS) } LOCAL_new_TR = dest; if (is_gc_verbose()) { - if (old_TR != (tr_fr_ptr)Yap_TrailBase) - fprintf(Yap_stderr, + if (old_TR != (tr_fr_ptr)LOCAL_TrailBase) + fprintf(GLOBAL_stderr, "%% Trail: discarded %d (%ld%%) cells out of %ld\n", LOCAL_discard_trail_entries, - (unsigned long int)(LOCAL_discard_trail_entries*100/(old_TR-(tr_fr_ptr)Yap_TrailBase)), - (unsigned long int)(old_TR-(tr_fr_ptr)Yap_TrailBase)); + (unsigned long int)(LOCAL_discard_trail_entries*100/(old_TR-(tr_fr_ptr)LOCAL_TrailBase)), + (unsigned long int)(old_TR-(tr_fr_ptr)LOCAL_TrailBase)); #ifdef DEBUG if (hp_entrs > 0) - fprintf(Yap_stderr, + fprintf(GLOBAL_stderr, "%% Trail: unmarked %ld dbentries (%ld%%) out of %ld\n", (long int)hp_not_in_use, (long int)(hp_not_in_use*100/hp_entrs), (long int)hp_entrs); if (hp_in_use_erased > 0 && hp_erased > 0) - fprintf(Yap_stderr, + fprintf(GLOBAL_stderr, "%% Trail: deleted %ld dbentries (%ld%%) out of %ld\n", (long int)hp_erased, (long int)(hp_erased*100/(hp_erased+hp_in_use_erased)), (long int)(hp_erased+hp_in_use_erased)); #endif if (OldHeapUsed) { - fprintf(Yap_stderr, + fprintf(GLOBAL_stderr, "%% Heap: recovered %ld bytes (%ld%%) out of %ld\n", (unsigned long int)(OldHeapUsed-HeapUsed), (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)), @@ -2832,7 +2832,7 @@ sweep_choicepoints(choiceptr gc_B USES_REGS) restart_cp: /* - * fprintf(Yap_stderr,"sweeping cps: %x, %x, %x\n", + * fprintf(GLOBAL_stderr,"sweeping cps: %x, %x, %x\n", * *gc_B,CP_Extra(gc_B),CP_Nargs(gc_B)); */ /* any choice point */ @@ -3279,12 +3279,12 @@ compact_heap( USES_REGS1 ) #ifdef DEBUG if (dest != start_from-1) - fprintf(Yap_stderr,"%% Bad Dest (%lu): %p should be %p\n", + fprintf(GLOBAL_stderr,"%% Bad Dest (%lu): %p should be %p\n", (unsigned long int)LOCAL_GcCalls, dest, start_from-1); if (LOCAL_total_marked != found_marked) - fprintf(Yap_stderr,"%% Upward (%lu): %lu total against %lu found\n", + fprintf(GLOBAL_stderr,"%% Upward (%lu): %lu total against %lu found\n", (unsigned long int)LOCAL_GcCalls, (unsigned long int)LOCAL_total_marked, (unsigned long int)found_marked); @@ -3343,7 +3343,7 @@ compact_heap( USES_REGS1 ) } #ifdef DEBUG if (LOCAL_total_marked != found_marked) - fprintf(Yap_stderr,"%% Downward (%lu): %lu total against %lu found\n", + fprintf(GLOBAL_stderr,"%% Downward (%lu): %lu total against %lu found\n", (unsigned long int)LOCAL_GcCalls, (unsigned long int)LOCAL_total_marked, (unsigned long int)found_marked); @@ -3452,12 +3452,12 @@ icompact_heap( USES_REGS1 ) #ifdef DEBUG if (dest != H0-1) - fprintf(Yap_stderr,"%% Bad Dest (%lu): %p should be %p\n", + fprintf(GLOBAL_stderr,"%% Bad Dest (%lu): %p should be %p\n", (unsigned long int)LOCAL_GcCalls, dest, H0-1); if (LOCAL_total_marked != found_marked) - fprintf(Yap_stderr,"%% Upward (%lu): %lu total against %lu found\n", + fprintf(GLOBAL_stderr,"%% Upward (%lu): %lu total against %lu found\n", (unsigned long int)LOCAL_GcCalls, (unsigned long int)LOCAL_total_marked, (unsigned long int)found_marked); @@ -3515,12 +3515,12 @@ icompact_heap( USES_REGS1 ) } #ifdef DEBUG if (H0+LOCAL_total_marked != dest) - fprintf(Yap_stderr,"%% Downward (%lu): %p total against %p found\n", + fprintf(GLOBAL_stderr,"%% Downward (%lu): %p total against %p found\n", (unsigned long int)LOCAL_GcCalls, H0+LOCAL_total_marked, dest); if (LOCAL_total_marked != found_marked) - fprintf(Yap_stderr,"%% Downward (%lu): %lu total against %lu found\n", + fprintf(GLOBAL_stderr,"%% Downward (%lu): %lu total against %lu found\n", (unsigned long int)LOCAL_GcCalls, (unsigned long int)LOCAL_total_marked, (unsigned long int)found_marked); @@ -3591,7 +3591,7 @@ static void sweep_oldgen(CELL *max, CELL *base USES_REGS) { CELL *ptr = base; - char *bpb = LOCAL_bp+(base-(CELL*)Yap_GlobalBase); + char *bpb = LOCAL_bp+(base-(CELL*)LOCAL_GlobalBase); while (ptr < max) { if (*bpb) { @@ -3643,12 +3643,12 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp USES_REGS) -LOCAL_total_smarked #endif != LOCAL_iptop-(CELL_PTR *)H && LOCAL_iptop < (CELL_PTR *)ASP -1024) - fprintf(Yap_stderr,"%% Oops on LOCAL_iptop-H (%ld) vs %ld\n", (unsigned long int)(LOCAL_iptop-(CELL_PTR *)H), LOCAL_total_marked); + fprintf(GLOBAL_stderr,"%% Oops on LOCAL_iptop-H (%ld) vs %ld\n", (unsigned long int)(LOCAL_iptop-(CELL_PTR *)H), LOCAL_total_marked); */ #endif #if DEBUGX int effectiveness = (((H-H0)-LOCAL_total_marked)*100)/(H-H0); - fprintf(Yap_stderr,"%% using pointers (%d)\n", effectiveness); + fprintf(GLOBAL_stderr,"%% using pointers (%d)\n", effectiveness); #endif if (CurrentH0) { H0 = CurrentH0; @@ -3719,22 +3719,22 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) if (Yap_GetValue(AtomGcTrace) != TermNil) gc_trace = 1; if (gc_trace) { - fprintf(Yap_stderr, "%% gc\n"); + fprintf(GLOBAL_stderr, "%% gc\n"); } else if (gc_verbose) { #if defined(YAPOR) || defined(THREADS) - fprintf(Yap_stderr, "%% Worker Id %d:\n", worker_id); + fprintf(GLOBAL_stderr, "%% Worker Id %d:\n", worker_id); #endif - fprintf(Yap_stderr, "%% Start of garbage collection %lu:\n", (unsigned long int)LOCAL_GcCalls); - fprintf(Yap_stderr, "%% Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H); - fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); - fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n", - (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR); + fprintf(GLOBAL_stderr, "%% Start of garbage collection %lu:\n", (unsigned long int)LOCAL_GcCalls); + fprintf(GLOBAL_stderr, "%% Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H); + fprintf(GLOBAL_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); + fprintf(GLOBAL_stderr, "%% Trail:%8ld cells (%p-%p)\n", + (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); } #if !USE_SYSTEM_MALLOC - if (HeapTop >= Yap_GlobalBase - MinHeapGap) { + if (HeapTop >= LOCAL_GlobalBase - MinHeapGap) { *--ASP = (CELL)current_env; if (!Yap_growheap(FALSE, MinHeapGap, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return -1; } current_env = (CELL *)*ASP; @@ -3747,7 +3747,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) /* we cannot recover, fail system */ restore_machine_regs(); - sz = Yap_TrailTop-(ADDR)LOCAL_OldTR; + sz = LOCAL_TrailTop-(ADDR)LOCAL_OldTR; /* ask for double the size */ sz = 2*sz; TR = LOCAL_OldTR; @@ -3778,7 +3778,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) LOCAL_total_smarked = 0; #endif LOCAL_discard_trail_entries = 0; - alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase; + alloc_sz = (CELL *)LOCAL_TrailTop-(CELL*)LOCAL_GlobalBase; LOCAL_bp = Yap_PreAllocCodeSpace(); while (LOCAL_bp+alloc_sz > (char *)AuxSp) { /* not enough space */ @@ -3826,21 +3826,21 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) } else effectiveness = 0; if (gc_verbose) { - fprintf(Yap_stderr, "%% Mark: Marked %ld cells of %ld (efficiency: %ld%%) in %g sec\n", + fprintf(GLOBAL_stderr, "%% Mark: Marked %ld cells of %ld (efficiency: %ld%%) in %g sec\n", (long int)tot, (long int)heap_cells, (long int)effectiveness, (double)(m_time-time_start)/1000); if (LOCAL_HGEN-H0) - fprintf(Yap_stderr,"%% previous generation has size " UInt_FORMAT ", with " UInt_FORMAT " (" UInt_FORMAT "%%) unmarked\n", (UInt)(LOCAL_HGEN-H0), (UInt)((LOCAL_HGEN-H0)-LOCAL_total_oldies), (UInt)(100*((LOCAL_HGEN-H0)-LOCAL_total_oldies)/(LOCAL_HGEN-H0))); + fprintf(GLOBAL_stderr,"%% previous generation has size " UInt_FORMAT ", with " UInt_FORMAT " (" UInt_FORMAT "%%) unmarked\n", (UInt)(LOCAL_HGEN-H0), (UInt)((LOCAL_HGEN-H0)-LOCAL_total_oldies), (UInt)(100*((LOCAL_HGEN-H0)-LOCAL_total_oldies)/(LOCAL_HGEN-H0))); #ifdef INSTRUMENT_GC { int i; for (i=0; i<16; i++) { if (chain[i]) { - fprintf(Yap_stderr, "%% chain[%d]=%lu\n", i, chain[i]); + fprintf(GLOBAL_stderr, "%% chain[%d]=%lu\n", i, chain[i]); } } put_type_info((unsigned long int)tot); - fprintf(Yap_stderr,"%% %lu/%ld before and %lu/%ld after\n", old_vars, (unsigned long int)(B->cp_h-H0), new_vars, (unsigned long int)(H-B->cp_h)); - fprintf(Yap_stderr,"%% %ld choicepoints\n", num_bs); + fprintf(GLOBAL_stderr,"%% %lu/%ld before and %lu/%ld after\n", old_vars, (unsigned long int)(B->cp_h-H0), new_vars, (unsigned long int)(H-B->cp_h)); + fprintf(GLOBAL_stderr,"%% %ld choicepoints\n", num_bs); } #endif } @@ -3849,7 +3849,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) TR = old_TR; pop_registers(predarity, nextop PASS_REGS); TR = LOCAL_new_TR; - /* fprintf(Yap_stderr,"NEW LOCAL_HGEN %ld (%ld)\n", H-H0, LOCAL_HGEN-H0);*/ + /* fprintf(GLOBAL_stderr,"NEW LOCAL_HGEN %ld (%ld)\n", H-H0, LOCAL_HGEN-H0);*/ { Term t = MkVarTerm(); Yap_UpdateTimedVar(LOCAL_GcGeneration, t); @@ -3857,14 +3857,14 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) Yap_UpdateTimedVar(LOCAL_GcPhase, MkIntegerTerm(LOCAL_GcCurrentPhase)); c_time = Yap_cputime(); if (gc_verbose) { - fprintf(Yap_stderr, "%% Compress: took %g sec\n", (double)(c_time-time_start)/1000); + fprintf(GLOBAL_stderr, "%% Compress: took %g sec\n", (double)(c_time-time_start)/1000); } gc_time += (c_time-time_start); LOCAL_TotGcTime += gc_time; LOCAL_TotGcRecovered += heap_cells-tot; if (gc_verbose) { - fprintf(Yap_stderr, "%% GC %lu took %g sec, total of %g sec doing GC so far.\n", (unsigned long int)LOCAL_GcCalls, (double)gc_time/1000, (double)LOCAL_TotGcTime/1000); - fprintf(Yap_stderr, "%% Left %ld cells free in stacks.\n", + fprintf(GLOBAL_stderr, "%% GC %lu took %g sec, total of %g sec doing GC so far.\n", (unsigned long int)LOCAL_GcCalls, (double)gc_time/1000, (double)LOCAL_TotGcTime/1000); + fprintf(GLOBAL_stderr, "%% Left %ld cells free in stacks.\n", (unsigned long int)(ASP-H)); } check_global(); @@ -3874,7 +3874,8 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS) static int is_gc_verbose(void) { - if (Yap_PrologMode == BootMode) + CACHE_REGS + if (LOCAL_PrologMode == BootMode) return FALSE; #ifdef INSTRUMENT_GC /* always give info when we are debugging gc */ @@ -3894,7 +3895,8 @@ Yap_is_gc_verbose(void) static int is_gc_very_verbose(void) { - if (Yap_PrologMode == BootMode) + CACHE_REGS + if (LOCAL_PrologMode == BootMode) return FALSE; return Yap_GetValue(AtomGcVeryVerbose) != TermNil; } @@ -3947,7 +3949,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS) if (gc_margin < gc_lim) gc_margin = gc_lim; LOCAL_HGEN = VarOfTerm(Yap_ReadTimedVar(LOCAL_GcGeneration)); - if (gc_on && !(Yap_PrologMode & InErrorMode) && + if (gc_on && !(LOCAL_PrologMode & InErrorMode) && /* make sure there is a point in collecting the heap */ (ASP-H0)*sizeof(CELL) > gc_lim && H-LOCAL_HGEN > (LCL0-ASP)/2) { @@ -3979,10 +3981,10 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS) static void LeaveGCMode( USES_REGS1 ) { - if (Yap_PrologMode & GCMode) - Yap_PrologMode &= ~GCMode; - if (Yap_PrologMode & AbortMode) { - Yap_PrologMode &= ~AbortMode; + if (LOCAL_PrologMode & GCMode) + LOCAL_PrologMode &= ~GCMode; + if (LOCAL_PrologMode & AbortMode) { + LOCAL_PrologMode &= ~AbortMode; Yap_Error(PURE_ABORT, TermNil, ""); P = FAILCODE; } @@ -3993,11 +3995,11 @@ Yap_gc(Int predarity, CELL *current_env, yamop *nextop) { CACHE_REGS int res; - Yap_PrologMode |= GCMode; + LOCAL_PrologMode |= GCMode; res=call_gc(4096, predarity, current_env, nextop PASS_REGS); LeaveGCMode( PASS_REGS1 ); - if (Yap_PrologMode & GCMode) - Yap_PrologMode &= ~GCMode; + if (LOCAL_PrologMode & GCMode) + LOCAL_PrologMode &= ~GCMode; return res; } @@ -4008,7 +4010,7 @@ Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop) int res; UInt min = CalculateStackGap()*sizeof(CELL); - Yap_PrologMode |= GCMode; + LOCAL_PrologMode |= GCMode; if (gc_lim < min) gc_lim = min; res = call_gc(gc_lim, predarity, current_env, nextop PASS_REGS); @@ -4021,7 +4023,7 @@ static Int p_gc( USES_REGS1 ) { int res; - Yap_PrologMode |= GCMode; + LOCAL_PrologMode |= GCMode; if (P->opc == Yap_opcode(_execute_cpred)) res = do_gc(0, ENV, CP PASS_REGS) >= 0; else diff --git a/C/index.c b/C/index.c index 6f102d064..20140c7e2 100644 --- a/C/index.c +++ b/C/index.c @@ -832,14 +832,14 @@ sort_group(GroupDef *grp, CELL *top, struct intermediates *cint) if (!(base = (CELL *)Yap_AllocCodeSpace(2*max*sizeof(CELL)))) { CACHE_REGS save_machine_regs(); - Yap_Error_Size = 2*max*sizeof(CELL); + LOCAL_Error_Size = 2*max*sizeof(CELL); siglongjmp(cint->CompilerBotch,2); } #else base = top; - while (top+2*max > (CELL *)Yap_TrailTop) { + while (top+2*max > (CELL *)LOCAL_TrailTop) { if (!Yap_growtrail(2*max*CellSize, TRUE)) { - Yap_Error_Size = 2*max*CellSize; + LOCAL_Error_Size = 2*max*CellSize; save_machine_regs(); siglongjmp(cint->CompilerBotch,4); return; @@ -2058,16 +2058,16 @@ groups_in(ClauseDef *min, ClauseDef *max, GroupDef *grp, struct intermediates *c } groups++; grp++; - while (grp+16 > (GroupDef *)Yap_TrailTop) { + while (grp+16 > (GroupDef *)LOCAL_TrailTop) { UInt sz = (groups+16)*sizeof(GroupDef); #if USE_SYSTEM_MALLOC - Yap_Error_Size = sz; + LOCAL_Error_Size = sz; /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,4); #else if (!Yap_growtrail(sz, TRUE)) { - Yap_Error_Size = sz; + LOCAL_Error_Size = sz; save_machine_regs(); siglongjmp(cint->CompilerBotch,4); return 0; @@ -2197,7 +2197,7 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint, CELL func_ UInt sz = sizeof(LogUpdIndex)+n*item_size; LogUpdIndex *cl = (LogUpdIndex *)Yap_AllocCodeSpace(sz); if (cl == NULL) { - Yap_Error_Size = sz; + LOCAL_Error_Size = sz; /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,2); @@ -2218,7 +2218,7 @@ emit_switch_space(UInt n, UInt item_size, struct intermediates *cint, CELL func_ UInt sz = sizeof(StaticIndex)+n*item_size; StaticIndex *cl = (StaticIndex *)Yap_AllocCodeSpace(sz); if (cl == NULL) { - Yap_Error_Size = sz; + LOCAL_Error_Size = sz; /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,2); @@ -3147,8 +3147,8 @@ copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top, struct intermediates * { CACHE_REGS UInt sz = ((max0+1)-min0)*sizeof(ClauseDef); - if ((char *)top + sz >= Yap_TrailTop-4096) { - Yap_Error_Size = sz; + if ((char *)top + sz >= LOCAL_TrailTop-4096) { + LOCAL_Error_Size = sz; /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,4); @@ -3337,13 +3337,13 @@ compile_index(struct intermediates *cint) /* only global variable I use directly */ cint->i_labelno = 1; - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; #if USE_SYSTEM_MALLOC if (!cint->cls) { cint->cls = (ClauseDef *)Yap_AllocCodeSpace(NClauses*sizeof(ClauseDef)); if (!cint->cls) { /* tell how much space we need */ - Yap_Error_Size += NClauses*sizeof(ClauseDef); + LOCAL_Error_Size += NClauses*sizeof(ClauseDef); /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,2); @@ -3355,7 +3355,7 @@ compile_index(struct intermediates *cint) cint->cls = (ClauseDef *)H; if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) { /* tell how much space we need */ - Yap_Error_Size += NClauses*sizeof(ClauseDef); + LOCAL_Error_Size += NClauses*sizeof(ClauseDef); /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,3); @@ -3402,37 +3402,37 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) cint.code_addr = NULL; cint.blks = NULL; cint.cls = NULL; - Yap_Error_Size = 0; + LOCAL_Error_Size = 0; if ((setjres = sigsetjmp(cint.CompilerBotch, 0)) == 3) { restore_machine_regs(); recover_from_failed_susp_on_cls(&cint, 0); - if (!Yap_gcl(Yap_Error_Size, ap->ArityOfPE+NSlots, ENV, next_pc)) { + if (!Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE+NSlots, ENV, next_pc)) { CleanCls(&cint); - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FAILCODE; } } else if (setjres == 2) { restore_machine_regs(); - Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size); - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { + LOCAL_Error_Size = recover_from_failed_susp_on_cls(&cint, LOCAL_Error_Size); + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { CleanCls(&cint); - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FAILCODE; } } else if (setjres == 4) { restore_machine_regs(); recover_from_failed_susp_on_cls(&cint, 0); - if (!Yap_growtrail(Yap_Error_Size, FALSE)) { + if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) { CleanCls(&cint); - Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, LOCAL_ErrorMessage); return FAILCODE; } } else if (setjres != 0) { restore_machine_regs(); recover_from_failed_susp_on_cls(&cint, 0); - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); CleanCls(&cint); return FAILCODE; } @@ -3442,14 +3442,14 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL; cint.expand_block = NULL; cint.label_offset = NULL; - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; if (compile_index(&cint) == (UInt)FAILCODE) { Yap_ReleaseCMem(&cint); CleanCls(&cint); return FAILCODE; } #ifdef DEBUG - if (Yap_Option['i' - 'a' + 1]) { + if (GLOBAL_Option['i' - 'a' + 1]) { Yap_ShowCode(&cint); } #endif @@ -3457,10 +3457,10 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) LOCAL_IPredArity = ap->ArityOfPE; if (cint.CodeStart) { if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE, &cint, cint.i_labelno+1)) == NULL) { - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { Yap_ReleaseCMem(&cint); CleanCls(&cint); - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } goto restart_index; @@ -3483,7 +3483,7 @@ static istack_entry * push_stack(istack_entry *sp, Int arg, Term Tag, Term extra, struct intermediates *cint) { CACHE_REGS - if (sp+1 > (istack_entry *)Yap_TrailTop) { + if (sp+1 > (istack_entry *)LOCAL_TrailTop) { save_machine_regs(); siglongjmp(cint->CompilerBotch,4); } @@ -4369,7 +4369,7 @@ expand_index(struct intermediates *cint) { cint->cls = (ClauseDef *)Yap_AllocCodeSpace(nclauses*sizeof(ClauseDef)); if (!cint->cls) { /* tell how much space we need */ - Yap_Error_Size += NClauses*sizeof(ClauseDef); + LOCAL_Error_Size += NClauses*sizeof(ClauseDef); /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,2); @@ -4379,7 +4379,7 @@ expand_index(struct intermediates *cint) { cint->cls = (ClauseDef *)H; if (cint->cls+2*nclauses > (ClauseDef *)(ASP-4096)) { /* tell how much space we need (worst case) */ - Yap_Error_Size += 2*NClauses*sizeof(ClauseDef); + LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef); /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,3); @@ -4397,7 +4397,7 @@ expand_index(struct intermediates *cint) { cint->cls = (ClauseDef *)Yap_AllocCodeSpace(NClauses*sizeof(ClauseDef)); if (!cint->cls) { /* tell how much space we need */ - Yap_Error_Size += NClauses*sizeof(ClauseDef); + LOCAL_Error_Size += NClauses*sizeof(ClauseDef); /* grow stack */ save_machine_regs(); siglongjmp(cint->CompilerBotch,2); @@ -4407,7 +4407,7 @@ expand_index(struct intermediates *cint) { cint->cls = (ClauseDef *)H; if (cint->cls+2*NClauses > (ClauseDef *)(ASP-4096)) { /* tell how much space we need (worst case) */ - Yap_Error_Size += 2*NClauses*sizeof(ClauseDef); + LOCAL_Error_Size += 2*NClauses*sizeof(ClauseDef); save_machine_regs(); siglongjmp(cint->CompilerBotch,3); } @@ -4513,11 +4513,11 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop USES_REGS) { restore_machine_regs(); /* grow stack */ recover_from_failed_susp_on_cls(&cint, 0); - Yap_gcl(Yap_Error_Size, ap->ArityOfPE+ExtraArgs, ENV, nextop); + Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE+ExtraArgs, ENV, nextop); } else if (cb == 2) { restore_machine_regs(); - Yap_Error_Size = recover_from_failed_susp_on_cls(&cint, Yap_Error_Size); - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { + LOCAL_Error_Size = recover_from_failed_susp_on_cls(&cint, LOCAL_Error_Size); + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { save_machine_regs(); if (ap->PredFlags & LogUpdatePredFlag) { Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap); @@ -4540,14 +4540,14 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop USES_REGS) { #if defined(YAPOR) || defined(THREADS) } #endif - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); CleanCls(&cint); return FAILCODE; } } else if (cb == 4) { restore_machine_regs(); Yap_ReleaseCMem(&cint); - if (!Yap_growtrail(Yap_Error_Size, FALSE)) { + if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) { save_machine_regs(); if (ap->PredFlags & LogUpdatePredFlag) { Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap); @@ -4564,15 +4564,15 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop USES_REGS) { restart_index: cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL; cint.CurrentPred = ap; - Yap_ErrorMessage = NULL; - Yap_Error_Size = 0; + LOCAL_ErrorMessage = NULL; + LOCAL_Error_Size = 0; if (P->opc == Yap_opcode(_expand_clauses)) { expand_clauses = P; } else { expand_clauses = NULL; } #ifdef DEBUG - if (Yap_Option['i' - 'a' + 1]) { + if (GLOBAL_Option['i' - 'a' + 1]) { Term tmod = ap->ModuleOfPred; if (!tmod) tmod = TermProlog; #if THREADS @@ -4634,7 +4634,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop USES_REGS) { return FAILCODE; } #ifdef DEBUG - if (Yap_Option['i' - 'a' + 1]) { + if (GLOBAL_Option['i' - 'a' + 1]) { Yap_ShowCode(&cint); } #endif @@ -4642,8 +4642,8 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop USES_REGS) { LOCAL_IPredArity = ap->ArityOfPE; if (cint.CodeStart) { if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint, cint.i_labelno+1)) == NULL) { - if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); Yap_ReleaseCMem(&cint); CleanCls(&cint); return FAILCODE; @@ -4715,7 +4715,7 @@ static path_stack_entry * push_path(path_stack_entry *sp, yamop **pipc, ClauseDef *clp, struct intermediates *cint) { CACHE_REGS - if (sp+1 > (path_stack_entry *)Yap_TrailTop) { + if (sp+1 > (path_stack_entry *)LOCAL_TrailTop) { save_machine_regs(); siglongjmp(cint->CompilerBotch,4); } @@ -4732,7 +4732,7 @@ static path_stack_entry * fetch_new_block(path_stack_entry *sp, yamop **pipc, PredEntry *ap, struct intermediates *cint) { CACHE_REGS - if (sp+1 > (path_stack_entry *)Yap_TrailTop) { + if (sp+1 > (path_stack_entry *)LOCAL_TrailTop) { save_machine_regs(); siglongjmp(cint->CompilerBotch,4); } @@ -6028,25 +6028,25 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) { cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NIL; if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) { restore_machine_regs(); - Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP); + Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE, ENV, CP); save_machine_regs(); } else if (cb == 2) { restore_machine_regs(); - Yap_growheap(FALSE, Yap_Error_Size, NULL); + Yap_growheap(FALSE, LOCAL_Error_Size, NULL); save_machine_regs(); } else if (cb == 4) { restore_machine_regs(); - Yap_growtrail(Yap_Error_Size, FALSE); + Yap_growtrail(LOCAL_Error_Size, FALSE); save_machine_regs(); } if (cb) { Yap_RemoveIndexation(ap); return; } - Yap_Error_Size = 0; - Yap_ErrorMessage = NULL; + LOCAL_Error_Size = 0; + LOCAL_ErrorMessage = NULL; #ifdef DEBUG - if (Yap_Option['i' - 'a' + 1]) { + if (GLOBAL_Option['i' - 'a' + 1]) { Term tmod = ap->ModuleOfPred; if (!tmod) tmod = TermProlog; Yap_DebugPutc(LOCAL_c_error_stream,'+'); @@ -6504,19 +6504,19 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) { cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL; if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) { restore_machine_regs(); - Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP); + Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE, ENV, CP); save_machine_regs(); } else if (cb == 2) { restore_machine_regs(); - Yap_growheap(FALSE, Yap_Error_Size, NULL); + Yap_growheap(FALSE, LOCAL_Error_Size, NULL); save_machine_regs(); } else if (cb == 4) { restore_machine_regs(); - Yap_growtrail(Yap_Error_Size, FALSE); + Yap_growtrail(LOCAL_Error_Size, FALSE); save_machine_regs(); } - Yap_Error_Size = 0; - Yap_ErrorMessage = NULL; + LOCAL_Error_Size = 0; + LOCAL_ErrorMessage = NULL; if (cb) { /* cannot rely on the code */ if (ap->PredFlags & LogUpdatePredFlag) { @@ -6530,7 +6530,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) { return; } #ifdef DEBUG - if (Yap_Option['i' - 'a' + 1]) { + if (GLOBAL_Option['i' - 'a' + 1]) { Term tmod = ap->ModuleOfPred; if (!tmod) tmod = TermProlog; diff --git a/C/init.c b/C/init.c index 2e69c9cb5..55a1b4a99 100755 --- a/C/init.c +++ b/C/init.c @@ -34,8 +34,11 @@ static char SccsId[] = "%W% %G%"; #include "tracer.h" #endif #ifdef YAPOR +#ifdef YAPOR_COW +#include +#endif /* YAPOR_COW */ #include "or.macros.h" -#endif /* YAPOR */ +#endif /* YAPOR */ #if defined(YAPOR) || defined(TABLING) #if HAVE_SYS_TYPES_H #include @@ -55,7 +58,6 @@ static char SccsId[] = "%W% %G%"; #define LOGFILE "logfile" -int Yap_output_msg = FALSE; #ifdef MACC STATIC_PROTO(void InTTYLine, (char *)); @@ -75,113 +77,13 @@ STATIC_PROTO(void InitCodes, (void)); STATIC_PROTO(void InitVersion, (void)); STD_PROTO(void exit, (int)); static void InitWorker(int wid); -#ifdef YAPOR -void init_yapor_workers(void); -#endif /* YAPOR */ /************** YAP PROLOG GLOBAL VARIABLES *************************/ /************* variables related to memory allocation ***************/ - -#if defined(THREADS) - ADDR Yap_HeapBase; -struct thread_globs Yap_thread_gl[MAX_THREADS]; - -pthread_t Yap_master_thread; - -#else - -ADDR Yap_HeapBase, - Yap_LocalBase, - Yap_GlobalBase, - Yap_TrailBase, - Yap_TrailTop; - -/************ variables concerned with Error Handling *************/ -char *Yap_ErrorMessage; /* used to pass error messages */ -Term Yap_Error_Term; /* used to pass error terms */ -yap_error_number Yap_Error_TYPE; /* used to pass the error */ -UInt Yap_Error_Size; /* used to pass a size associated with an error */ - -/******************* storing error messages ****************************/ -char Yap_ErrorSay[MAX_ERROR_MSG_SIZE]; - -/* if we botched in a LongIO operation */ -jmp_buf Yap_IOBotch; - -/* if we botched in the compiler */ -jmp_buf Yap_CompilerBotch; - -/************ variables concerned with Error Handling *************/ -sigjmp_buf Yap_RestartEnv; /* used to restart after an abort execution */ - -/********* IO support *****/ - -/********* parsing ********************************************/ - -TokEntry *Yap_tokptr, *Yap_toktide; -VarEntry *Yap_VarTable, *Yap_AnonVarTable; -int Yap_eot_before_eof = FALSE; - -/******************* intermediate buffers **********************/ - -char Yap_FileNameBuf[YAP_FILENAME_MAX], - Yap_FileNameBuf2[YAP_FILENAME_MAX]; - -#endif /* THREADS */ - -/******** whether Yap is responsible for signal handling******************/ -int Yap_PrologShouldHandleInterrupts; - -/********* readline support *****/ -#if HAVE_LIBREADLINE - -char *_line = (char *) NULL; - -#endif - -#ifdef MPWSHELL -/********** informing if we are in the MPW shell ********************/ - -int mpwshell = FALSE; - -#endif - -#ifdef EMACS - -int emacs_mode = FALSE; -char emacs_tmp[256], emacs_tmp2[256]; - -#endif - -/********* Prolog State ********************************************/ - -Int Yap_PrologMode = BootMode; - -int Yap_CritLocks = 0; - -/********* streams ********************************************/ - -YP_FILE *Yap_stdin; -YP_FILE *Yap_stdout; -YP_FILE *Yap_stderr; - - -/************** Access to yap initial arguments ***************************/ - -char **Yap_argv; -int Yap_argc; - -/************** Extensions to Terms ***************************************/ - -#ifdef COROUTINING -/* array with the ops for your favourite extensions */ -ext_op attas[attvars_ext+1]; -#endif - /************** declarations local to init.c ************************/ static char *optypes[] = {"", "xfx", "xfy", "yfx", "xf", "yf", "fx", "fy"}; @@ -194,10 +96,6 @@ int Yap_page_size; void **Yap_ABSMI_OPCODES; #endif -#if USE_SOCKET -int Yap_sockets_io=0; -#endif - #if DEBUG #if COROUTINING int Yap_Portray_delays = FALSE; @@ -303,7 +201,7 @@ static void SetOp(int p, int type, char *at, Term m) { #ifdef DEBUG - if (Yap_Option[5]) + if (GLOBAL_Option[5]) fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at); #endif OpDec(p, optypes[type], Yap_LookupAtom(at), m); @@ -445,8 +343,8 @@ InitDebug(void) int i; for (i = 1; i < 20; ++i) - Yap_Option[i] = 0; - if (Yap_output_msg) { + GLOBAL_Option[i] = 0; + if (GLOBAL_output_msg) { char ch; #if HAVE_ISATTY @@ -461,10 +359,10 @@ InitDebug(void) fprintf(stderr,"m Machine\t p parser\n"); while ((ch = YP_putchar(YP_getchar())) != '\n') if (ch >= 'a' && ch <= 'z') - Yap_Option[ch - 'a' + 1] = 1; - if (Yap_Option['l' - 96]) { - Yap_logfile = fopen(LOGFILE, "w"); - if (Yap_logfile == NULL) { + GLOBAL_Option[ch - 'a' + 1] = 1; + if (GLOBAL_Option['l' - 96]) { + GLOBAL_logfile = fopen(LOGFILE, "w"); + if (GLOBAL_logfile == NULL) { fprintf(stderr,"can not open %s\n", LOGFILE); getchar(); exit(0); @@ -1165,23 +1063,22 @@ InitInvisibleAtoms(void) #ifdef YAPOR -void init_yapor_workers(void) { +void Yap_init_yapor_workers(void) { CACHE_REGS int proc; #ifdef YAPOR_THREADS return; #endif /* YAPOR_THREADS */ #ifdef YAPOR_COW + GLOBAL_master_worker = getpid(); if (GLOBAL_number_workers > 1) { int son; son = fork(); if (son == -1) - Yap_Error(FATAL_ERROR, TermNil, "fork error (init_yapor_workers)"); + Yap_Error(FATAL_ERROR, TermNil, "fork error (Yap_init_yapor_workers)"); if (son > 0) { /* I am the father, I must stay here and wait for my children to all die */ struct sigaction sigact; - - GLOBAL_master_worker = getpid(); sigact.sa_handler = SIG_DFL; sigemptyset(&sigact.sa_mask); sigact.sa_flags = SA_RESTART; @@ -1196,12 +1093,13 @@ void init_yapor_workers(void) { int son; son = fork(); if (son == -1) - Yap_Error(FATAL_ERROR, TermNil, "fork error (init_yapor_workers)"); + Yap_Error(FATAL_ERROR, TermNil, "fork error (Yap_init_yapor_workers)"); if (son == 0) { /* new worker */ worker_id = proc; - Yap_remap_optyap_memory(); + Yap_remap_yapor_memory(); LOCAL = REMOTE(worker_id); + memcpy(REMOTE(worker_id), REMOTE(0), sizeof(struct worker_local)); InitWorker(worker_id); break; } else @@ -1353,7 +1251,7 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s return; pthread_key_create(&Yap_yaamregs_key, NULL); pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs); - Yap_master_thread = pthread_self(); + GLOBAL_master_thread = pthread_self(); #else /* In this case we need to initialise the abstract registers */ Yap_regp = &Yap_standard_regs; @@ -1364,10 +1262,8 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s #ifdef THREADS Yap_regp = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key)); + LOCAL = REMOTE(0); #endif /* THREADS */ - /* Init signal handling and time */ - /* also init memory page size, required by later functions */ - Yap_InitSysbits (); if (Heap < MinHeapSpace) Heap = MinHeapSpace; Heap = AdjustPageSize(Heap * K); @@ -1399,19 +1295,16 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s #endif /* YAPOR_COPY - YAPOR_COW - YAPOR_SBA - YAPOR_THREADS */ #endif /* YAPOR */ #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) - Yap_init_optyap_memory(Trail, Heap, Stack+Atts, n_workers); + Yap_init_yapor_stacks_memory(Trail, Heap, Stack+Atts, n_workers); #else Yap_InitMemory(Trail, Heap, Stack+Atts); #endif #if defined(YAPOR) || defined(TABLING) Yap_init_global_optyap_data(max_table_size, n_workers, sch_loop, delay_load); #endif /* YAPOR || TABLING */ -#if defined(YAPOR) || defined(THREADS) - LOCAL = REMOTE(0); /* point to the first area */ -#endif /* YAPOR || THREADS */ Yap_AttsSize = Atts; - Yap_InitTime (); + Yap_InitTime(); /* InitAbsmi must be done before InitCodes */ /* This must be done before initialising predicates */ for (i = 0; i <= LAST_FLAG; i++) { @@ -1464,11 +1357,12 @@ run_halt_hooks(int code) void Yap_exit (int value) { + CACHE_REGS #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) - Yap_unmap_optyap_memory(); -#endif + Yap_unmap_yapor_memory(); +#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ - if (! (Yap_PrologMode & BootMode) ) { + if (! (LOCAL_PrologMode & BootMode) ) { #ifdef LOW_PROF remove("PROFPREDS"); remove("PROFILING"); diff --git a/C/inlines.c b/C/inlines.c index f60ec914b..218123292 100755 --- a/C/inlines.c +++ b/C/inlines.c @@ -719,7 +719,7 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */ d0 = AbsAppl(H); if (pt1+d1 > ENV - CreepFlag) { if (!Yap_gcl((1+d1)*sizeof(CELL), 3, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto restart; diff --git a/C/iopreds.c b/C/iopreds.c index d4a5071d1..b2784ce1c 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -183,17 +183,17 @@ Yap_DebugGetc() } if ((ch = *lp++) == 0) ch = '\n', eolflg = 1; - if (Yap_Option['l' - 96]) - putc(ch, Yap_logfile); + if (GLOBAL_Option['l' - 96]) + putc(ch, GLOBAL_logfile); return (ch); } int Yap_DebugPutc(int sno, wchar_t ch) { - if (Yap_Option['l' - 96]) - (void) putc(ch, Yap_logfile); - return (putc(ch, Yap_stderr)); + if (GLOBAL_Option['l' - 96]) + (void) putc(ch, GLOBAL_logfile); + return (putc(ch, GLOBAL_stderr)); } void @@ -273,8 +273,8 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp) /* make sure to globalise variable */ Yap_unify(*outp, MkVarTerm()); start = tokptr->TokPos; - clean_vars(Yap_VarTable); - clean_vars(Yap_AnonVarTable); + clean_vars(LOCAL_VarTable); + clean_vars(LOCAL_AnonVarTable); while (1) { Term ts[2]; @@ -286,7 +286,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp) H = Hi; break; } - if (tokptr == Yap_toktide) { + if (tokptr == LOCAL_toktide) { err = tokptr->TokPos; out = count; } @@ -402,31 +402,31 @@ Yap_StringToTerm(char *s,Term *tp) if (sno == NULL) return FALSE; TR_before_parse = TR; - tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos); + tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(sno, &tpos); if (tokstart == NIL || tokstart->Tok == Ord (eot_tok)) { if (tp) { *tp = MkAtomTerm(AtomEOFBeforeEOT); } - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Sclose(sno); return FALSE; - } else if (Yap_ErrorMessage) { + } else if (LOCAL_ErrorMessage) { if (tp) { - *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); + *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); } - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Sclose(sno); return FALSE; } t = Yap_Parse(); TR = TR_before_parse; - if (!t || Yap_ErrorMessage) { + if (!t || LOCAL_ErrorMessage) { GenerateSyntaxError(tp, tokstart, sno PASS_REGS); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Sclose(sno); return FALSE; } - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Sclose(sno); return t; } @@ -512,25 +512,25 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos) if (st == NULL) { return FALSE; } - tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(st, tpos); - if (Yap_ErrorMessage) + tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(st, tpos); + if (LOCAL_ErrorMessage) { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); if (terror) - *terror = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + *terror = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return FALSE; } pt = Yap_Parse(); - if (Yap_ErrorMessage || pt == (CELL)0) { + if (LOCAL_ErrorMessage || pt == (CELL)0) { GenerateSyntaxError(terror, tokstart, st PASS_REGS); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return FALSE; } if (varnames) { - *varnames = Yap_VarNames(Yap_VarTable, TermNil); + *varnames = Yap_VarNames(LOCAL_VarTable, TermNil); if (!*varnames) { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return FALSE; } } @@ -554,9 +554,6 @@ static Int { Term t, v; TokEntry *tokstart; -#if EMACS - int emacs_cares = FALSE; -#endif Term tmod = Deref(ARG3), OCurrentModule = CurrentModule, tpos; extern void Yap_setCurrentSourceLocation(IOSTREAM **s); @@ -567,7 +564,7 @@ static Int Yap_Error(TYPE_ERROR_ATOM, tmod, "read_term/2"); return FALSE; } - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; tpos = Yap_StreamPosition(inp_stream); if (!Yap_unify(tpos,ARG5)) { /* do this early so that we do not have to protect it in case of stack expansion */ @@ -585,33 +582,32 @@ static Int /* Scans the term using stack space */ while (TRUE) { old_H = H; - Yap_eot_before_eof = FALSE; tpos = Yap_StreamPosition(inp_stream); - tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp_stream, &tpos); - if (Yap_Error_TYPE != YAP_NO_ERROR && seekable) { + tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, &tpos); + if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) { H = old_H; - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); if (seekable) { Sseek64(inp_stream, cpos, SIO_SEEK_SET); } - if (Yap_Error_TYPE == OUT_OF_TRAIL_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_TRAIL_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growtrail (sizeof(CELL) * K16, FALSE)) { return FALSE; } - } else if (Yap_Error_TYPE == OUT_OF_AUXSPACE_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + } else if (LOCAL_Error_TYPE == OUT_OF_AUXSPACE_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { return FALSE; } - } else if (Yap_Error_TYPE == OUT_OF_HEAP_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + } else if (LOCAL_Error_TYPE == OUT_OF_HEAP_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growheap(FALSE, 0, NULL)) { return FALSE; } - } else if (Yap_Error_TYPE == OUT_OF_STACK_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, nargs, ENV, CP)) { + } else if (LOCAL_Error_TYPE == OUT_OF_STACK_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, nargs, ENV, CP)) { return FALSE; } } @@ -620,18 +616,18 @@ static Int break; } } - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; /* preserve value of H after scanning: otherwise we may lose strings and floats */ old_H = H; if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) { /* did we get the end of file from an abort? */ - if (Yap_ErrorMessage && - !strcmp(Yap_ErrorMessage,"Abort")) { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + if (LOCAL_ErrorMessage && + !strcmp(LOCAL_ErrorMessage,"Abort")) { + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return FALSE; } else { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)) && Yap_unify_constant(ARG4, TermNil); @@ -639,14 +635,14 @@ static Int } repeat_cycle: CurrentModule = tmod; - if (Yap_ErrorMessage || (t = Yap_Parse()) == 0) { + if (LOCAL_ErrorMessage || (t = Yap_Parse()) == 0) { CurrentModule = OCurrentModule; - if (Yap_ErrorMessage) { + if (LOCAL_ErrorMessage) { int res; - if (!strcmp(Yap_ErrorMessage,"Stack Overflow") || - !strcmp(Yap_ErrorMessage,"Trail Overflow") || - !strcmp(Yap_ErrorMessage,"Heap Overflow")) { + if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow") || + !strcmp(LOCAL_ErrorMessage,"Trail Overflow") || + !strcmp(LOCAL_ErrorMessage,"Heap Overflow")) { /* ignore term we just built */ tr_fr_ptr old_TR = TR; @@ -654,18 +650,18 @@ static Int H = old_H; TR = (tr_fr_ptr)LOCAL_ScannerStack; - if (!strcmp(Yap_ErrorMessage,"Stack Overflow")) - res = Yap_growstack_in_parser(&old_TR, &tokstart, &Yap_VarTable); - else if (!strcmp(Yap_ErrorMessage,"Heap Overflow")) - res = Yap_growheap_in_parser(&old_TR, &tokstart, &Yap_VarTable); + if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) + res = Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); + else if (!strcmp(LOCAL_ErrorMessage,"Heap Overflow")) + res = Yap_growheap_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); else - res = Yap_growtrail_in_parser(&old_TR, &tokstart, &Yap_VarTable); + res = Yap_growtrail_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); if (res) { LOCAL_ScannerStack = (char *)TR; TR = old_TR; old_H = H; - Yap_tokptr = Yap_toktide = tokstart; - Yap_ErrorMessage = NULL; + LOCAL_tokptr = LOCAL_toktide = tokstart; + LOCAL_ErrorMessage = NULL; goto repeat_cycle; } LOCAL_ScannerStack = (char *)TR; @@ -674,26 +670,26 @@ static Int } if (ParserErrorStyle == QUIET_ON_PARSER_ERROR) { /* just fail */ - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return FALSE; } else if (ParserErrorStyle == CONTINUE_ON_PARSER_ERROR) { - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; /* try again */ goto repeat_cycle; } else { Term terr = syntax_error(tokstart, inp_stream, &ARG2); - if (Yap_ErrorMessage == NULL) - Yap_ErrorMessage = "SYNTAX ERROR"; + if (LOCAL_ErrorMessage == NULL) + LOCAL_ErrorMessage = "SYNTAX ERROR"; if (ParserErrorStyle == EXCEPTION_ON_PARSER_ERROR) { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - Yap_Error(SYNTAX_ERROR,terr,Yap_ErrorMessage); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); + Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage); return FALSE; } else /* FAIL ON PARSER ERROR */ { Term t[2]; t[0] = terr; - t[1] = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + t[1] = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(AtomError,2),2,t)); } } @@ -703,17 +699,14 @@ static Int break; } } -#if EMACS - first_char = tokstart->TokPos; -#endif /* EMACS */ if (!Yap_unify(t, ARG2)) return FALSE; if (AtomOfTerm (Deref (ARG1)) == AtomTrue) { while (TRUE) { CELL *old_H = H; - if (setjmp(Yap_IOBotch) == 0) { - v = Yap_VarNames(Yap_VarTable, TermNil); + if (setjmp(LOCAL_IOBotch) == 0) { + v = Yap_VarNames(LOCAL_VarTable, TermNil); break; } else { tr_fr_ptr old_TR; @@ -723,15 +716,15 @@ static Int /* restart global */ H = old_H; TR = (tr_fr_ptr)LOCAL_ScannerStack; - Yap_growstack_in_parser(&old_TR, &tokstart, &Yap_VarTable); + Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable); LOCAL_ScannerStack = (char *)TR; TR = old_TR; } } - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return Yap_unify (v, ARG4); } else { - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return TRUE; } } @@ -976,7 +969,7 @@ p_char_conversion( USES_REGS1 ) CharConversionTable2 = Yap_AllocCodeSpace(NUMBER_OF_CHARS*sizeof(char)); while (CharConversionTable2 == NULL) { if (!Yap_growheap(FALSE, NUMBER_OF_CHARS*sizeof(char), NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } } @@ -1110,9 +1103,6 @@ Yap_InitBackIO (void) void Yap_InitIOPreds(void) { - Yap_stdin = stdin; - Yap_stdout = stdout; - Yap_stderr = stderr; if (!Stream) Stream = (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc)*MaxStreams); /* here the Input/Output predicates */ diff --git a/C/load_aix.c b/C/load_aix.c index 654d30b90..7e9bf1c51 100644 --- a/C/load_aix.c +++ b/C/load_aix.c @@ -65,16 +65,16 @@ LoadForeign(StringList ofiles, StringList libs, /* load wants to follow the LIBRARY_PATH */ if (ofiles->next != NULL || libs != NULL) { - strcpy(Yap_ErrorSay," Load Failed: in AIX you must load a single object file"); + strcpy(LOCAL_ErrorSay," Load Failed: in AIX you must load a single object file"); return LOAD_FAILLED; } - if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) { - strcpy(Yap_ErrorSay, " Trying to open unexisting file in LoadForeign "); + if (!Yap_TrueFileName(AtomName(ofiles->name), LOCAL_FileNameBuf, TRUE)) { + strcpy(LOCAL_ErrorSay, " Trying to open unexisting file in LoadForeign "); return LOAD_FAILLED; } /* In AIX, just call load and everything will go in */ - if ((*init_proc=((YapInitProc *)load(Yap_FileNameBuf,0,NULL))) == NULL) { - strcpy(Yap_ErrorSay,sys_errlist[errno]); + if ((*init_proc=((YapInitProc *)load(LOCAL_FileNameBuf,0,NULL))) == NULL) { + strcpy(LOCAL_ErrorSay,sys_errlist[errno]); return LOAD_FAILLED; } return LOAD_SUCCEEDED; diff --git a/C/load_aout.c b/C/load_aout.c index 0c2e2c1b6..bc96d8b8b 100644 --- a/C/load_aout.c +++ b/C/load_aout.c @@ -18,7 +18,7 @@ #include "Foreign.h" #ifdef A_OUT - +this code is no being maintained anymore #include #if STDC_HEADERS #include @@ -43,7 +43,7 @@ #endif #include -static char YapExecutable[YAP_FILE_MAX]; + #define oktox(n) \ (0==stat(n,&stbuf)&&(stbuf.st_mode&S_IFMT)==S_IFREG&&0==access(n,X_OK)) @@ -64,10 +64,10 @@ Yap_FindExecutable(char *name) cp = (char *)getenv("PATH"); if (cp == NULL) cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin"; - if (*Yap_argv[0] == '/') { - if (oktox(Yap_argv[0])) { - strcpy(Yap_FileNameBuf, Yap_argv[0]); - Yap_TrueFileName(Yap_FileNameBuf, YapExecutable, TRUE); + if (*GLOBAL_argv[0] == '/') { + if (oktox(GLOBAL_argv[0])) { + strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]); + Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE); return; } } @@ -79,24 +79,24 @@ Yap_FindExecutable(char *name) * argv[0] */ - for (cp2 = Yap_FileNameBuf; (*cp) != 0 && (*cp) != ':';) + for (cp2 = LOCAL_FileNameBuf; (*cp) != 0 && (*cp) != ':';) *cp2++ = *cp++; *cp2++ = '/'; - strcpy(cp2, Yap_argv[0]); + strcpy(cp2, GLOBAL_argv[0]); if (*cp) cp++; - if (!oktox(Yap_FileNameBuf)) + if (!oktox(LOCAL_FileNameBuf)) continue; - Yap_TrueFileName(Yap_FileNameBuf, YapExecutable, TRUE); + Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE); return; } /* one last try for dual systems */ - strcpy(Yap_FileNameBuf, Yap_argv[0]); - Yap_TrueFileName(Yap_FileNameBuf, YapExecutable, TRUE); - if (oktox(YapExecutable)) + strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]); + Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE); + if (oktox(GLOBAL_Executable)) return; else - Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(YapExecutable)), + Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(GLOBAL_Executable)), "cannot find file being executed"); } @@ -174,22 +174,22 @@ LoadForeign(StringList ofiles, /* prepare the magic */ if (strlen(o_files) + strlen(l_files) + strlen(proc_name) + - strlen(YapExecutable) > 2*MAXPATHLEN) { - strcpy(Yap_ErrorSay, " too many parameters in load_foreign/3 "); + strlen(GLOBAL_Executable) > 2*MAXPATHLEN) { + strcpy(LOCAL_ErrorSay, " too many parameters in load_foreign/3 "); return LOAD_FAILLED; } sprintf(command, "/usr/bin/ld -N -A %s -o %s -u _%s %s %s -lc", - YapExecutable, + GLOBAL_Executable, tfile, proc_name, o_files, l_files); /* now, do the magic */ if (system(command) != 0) { unlink(tfile); - strcpy(Yap_ErrorSay," ld returned error status in load_foreign_files "); + strcpy(LOCAL_ErrorSay," ld returned error status in load_foreign_files "); return LOAD_FAILLED; } /* now check the music has played */ if ((fildes = open(tfile, O_RDONLY)) < 0) { - strcpy(Yap_ErrorSay," unable to open temp file in load_foreign_files "); + strcpy(LOCAL_ErrorSay," unable to open temp file in load_foreign_files "); return LOAD_FAILLED; } /* it did, get the mice */ @@ -204,28 +204,28 @@ LoadForeign(StringList ofiles, firstloadImSz = loadImageSize; /* now fetch the space we need */ if (!(FCodeBase = Yap_AllocCodeSpace((int) loadImageSize))) { - strcpy(Yap_ErrorSay," unable to allocate space for external code "); + strcpy(LOCAL_ErrorSay," unable to allocate space for external code "); return LOAD_FAILLED; } /* now, a new incantation to load the new foreign code */ sprintf(command, "/usr/bin/ld -N -A %s -T %lx -o %s -u _%s %s %s -lc", - YapExecutable, + GLOBAL_Executable, (unsigned long) FCodeBase, tfile, proc_name, o_files, l_files); /* and do it */ if (system(command) != 0) { unlink(tfile); - strcpy(Yap_ErrorSay," ld returned error status in load_foreign_files "); + strcpy(LOCAL_ErrorSay," ld returned error status in load_foreign_files "); return LOAD_FAILLED; } if ((fildes = open(tfile, O_RDONLY)) < 0) { - strcpy(Yap_ErrorSay," unable to open temp file in load_foreign_files "); + strcpy(LOCAL_ErrorSay," unable to open temp file in load_foreign_files "); return LOAD_FAILLED; } read(fildes, (char *) &header, sizeof(header)); loadImageSize = header.a_text + header.a_data + header.a_bss; if (firstloadImSz < loadImageSize) { - strcpy(Yap_ErrorSay," miscalculation in load_foreign/3 "); + strcpy(LOCAL_ErrorSay," miscalculation in load_foreign/3 "); return LOAD_FAILLED; } /* now search for our init function */ @@ -236,11 +236,11 @@ LoadForeign(StringList ofiles, func_info[0].n_un.n_name = entry_fun; func_info[1].n_un.n_name = NULL; if (nlist(tfile, func_info) == -1) { - strcpy(Yap_ErrorSay," in nlist(3) "); + strcpy(LOCAL_ErrorSay," in nlist(3) "); return LOAD_FAILLED; } if (func_info[0].n_type == 0) { - strcpy(Yap_ErrorSay," in nlist(3) "); + strcpy(LOCAL_ErrorSay," in nlist(3) "); return LOAD_FAILLED; } *init_proc = (YapInitProc)(func_info[0].n_value); diff --git a/C/load_coff.c b/C/load_coff.c index bb090f131..89fb345dc 100644 --- a/C/load_coff.c +++ b/C/load_coff.c @@ -19,7 +19,7 @@ #include "Foreign.h" #ifdef COFF - +this code is no being maintained anymore #include #include #include @@ -45,8 +45,6 @@ #define N_TXTOFF(x) (sizeof(struct filehdr)+(x).f_opthdr+(x).f_nscns*sizeof(struct scnhdr)) -static char YapExecutable[YAP_FILE_MAX]; - /* * YAP_FindExecutable(argv[0]) should be called on yap initialization to @@ -62,10 +60,10 @@ Yap_FindExecutable(char *name) cp = (char *)getenv("PATH"); if (cp == NULL) cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin"; - if (*Yap_argv[0] == '/') { - if (oktox(Yap_argv[0])) { - strcpy(Yap_FileNameBuf, Yap_argv[0]); - Yap_TrueFileName(Yap_FileNameBuf, YapExecutable, TRUE); + if (*GLOBAL_argv[0] == '/') { + if (oktox(GLOBAL_argv[0])) { + strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]); + Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE); return; } } @@ -77,24 +75,24 @@ Yap_FindExecutable(char *name) * argv[0] */ - for (cp2 = Yap_FileNameBuf; (*cp) != 0 && (*cp) != ':';) + for (cp2 = LOCAL_FileNameBuf; (*cp) != 0 && (*cp) != ':';) *cp2++ = *cp++; *cp2++ = '/'; - strcpy(cp2, Yap_argv[0]); + strcpy(cp2, GLOBAL_argv[0]); if (*cp) cp++; - if (!oktox(Yap_FileNameBuf)) + if (!oktox(LOCAL_FileNameBuf)) continue; - Yap_TrueFileName(Yap_FileNameBuf, YapExecutable, TRUE); + Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE); return; } /* one last try for dual systems */ - strcpy(Yap_FileNameBuf, Yap_argv[0]); - Yap_TrueFileName(Yap_FileNameBuf, YapExecutable, TRUE); - if (oktox(YapExecutable)) + strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]); + Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE); + if (oktox(GLOBAL_Executable)) return; else - Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(YapExecutable)), + Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(GLOBAL_Executable)), "cannot find file being executed"); } @@ -175,22 +173,22 @@ LoadForeign(StringList ofiles, /* prepare the magic */ if (strlen(o_files) + strlen(l_files) + strlen(proc_name) + - strlen(YapExecutable) > 2*MAXPATHLEN) { - strcpy(Yap_ErrorSay, " too many parameters in load_foreign/3 "); + strlen(GLOBAL_Executable) > 2*MAXPATHLEN) { + strcpy(LOCAL_ErrorSay, " too many parameters in load_foreign/3 "); return LOAD_FAILLED; } sprintf(command, "/usr/bin/ld -N -A %s -o %s %s %s -lc", - YapExecutable, + GLOBAL_Executable, tfile, o_files, l_files); /* now, do the magic */ if (system(command) != 0) { unlink(tfile); - strcpy(Yap_ErrorSay," ld returned error status in load_foreign_files "); + strcpy(LOCAL_ErrorSay," ld returned error status in load_foreign_files "); return LOAD_FAILLED; } /* now check the music has played */ if ((fildes = open(tfile, O_RDONLY)) < 0) { - strcpy(Yap_ErrorSay," unable to open temp file in load_foreign_files "); + strcpy(LOCAL_ErrorSay," unable to open temp file in load_foreign_files "); return LOAD_FAILLED; } /* it did, get the mice */ @@ -220,7 +218,7 @@ LoadForeign(StringList ofiles, || activate_code(ForeignCodeBase, u1) #endif /* pyr */ ) { - strcpy(Yap_ErrorSay," unable to allocate space for external code "); + strcpy(LOCAL_ErrorSay," unable to allocate space for external code "); return LOAD_FAILLED; } #ifdef mips @@ -253,11 +251,11 @@ LoadForeign(StringList ofiles, /* and do it */ if (system(command) != 0) { unlink(tfile); - strcpy(Yap_ErrorSay," ld returned error status in load_foreign_files "); + strcpy(LOCAL_ErrorSay," ld returned error status in load_foreign_files "); return LOAD_FAILLED; } if ((fildes = open(tfile, O_RDONLY)) < 0) { - strcpy(Yap_ErrorSay," unable to open temp file in load_foreign_files "); + strcpy(LOCAL_ErrorSay," unable to open temp file in load_foreign_files "); return LOAD_FAILLED; } read(fildes, (char *) &fileHeader, sizeof(fileHeader)); @@ -269,7 +267,7 @@ LoadForeign(StringList ofiles, } loadImageSize = sysHeader.tsize + sysHeader.dsize + sysHeader.bsize; if (firstloadImSz < loadImageSize) { - strcpy(Yap_ErrorSay," miscalculation in load_foreign/3 "); + strcpy(LOCAL_ErrorSay," miscalculation in load_foreign/3 "); return LOAD_FAILLED; } /* now search for our init function */ @@ -285,11 +283,11 @@ LoadForeign(StringList ofiles, func_info[0].n_name = entry_fun; func_info[1].n_name = NULL; if (nlist(tfile, func_info) == -1) { - strcpy(Yap_ErrorSay," in nlist(3) "); + strcpy(LOCAL_ErrorSay," in nlist(3) "); return LOAD_FAILLED; } if (func_info[0].n_type == 0) { - strcpy(Yap_ErrorSay," in nlist(3) "); + strcpy(LOCAL_ErrorSay," in nlist(3) "); return LOAD_FAILLED; } *init_proc = (YapInitProc)(func_info[0].n_value); diff --git a/C/load_dl.c b/C/load_dl.c index fe7394d4d..ff3131e9a 100755 --- a/C/load_dl.c +++ b/C/load_dl.c @@ -94,18 +94,18 @@ LoadForeign(StringList ofiles, StringList libs, CACHE_REGS while (libs) { - if (!Yap_TrueFileName(AtomName(libs->name), Yap_FileNameBuf, TRUE)) { + if (!Yap_TrueFileName(AtomName(libs->name), LOCAL_FileNameBuf, TRUE)) { /* use LD_LIBRARY_PATH */ - strncpy(Yap_FileNameBuf, AtomName(libs->name), YAP_FILENAME_MAX); + strncpy(LOCAL_FileNameBuf, AtomName(libs->name), YAP_FILENAME_MAX); } #ifdef __osf__ - if((libs->handle=dlopen(Yap_FileNameBuf,RTLD_LAZY)) == NULL) + if((libs->handle=dlopen(LOCAL_FileNameBuf,RTLD_LAZY)) == NULL) #else - if((libs->handle=dlopen(Yap_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == NULL) + if((libs->handle=dlopen(LOCAL_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == NULL) #endif { - strcpy(Yap_ErrorSay,dlerror()); + strcpy(LOCAL_ErrorSay,dlerror()); return LOAD_FAILLED; } libs = libs->next; @@ -118,18 +118,18 @@ LoadForeign(StringList ofiles, StringList libs, other routines */ /* dlopen wants to follow the LD_CONFIG_PATH */ - if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) { - strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign"); + if (!Yap_TrueFileName(AtomName(ofiles->name), LOCAL_FileNameBuf, TRUE)) { + strcpy(LOCAL_ErrorSay, "%% Trying to open unexisting file in LoadForeign"); return LOAD_FAILLED; } #ifdef __osf__ - if((handle=dlopen(Yap_FileNameBuf,RTLD_LAZY)) == 0) + if((handle=dlopen(LOCAL_FileNameBuf,RTLD_LAZY)) == 0) #else - if((handle=dlopen(Yap_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0) + if((handle=dlopen(LOCAL_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0) #endif { - fprintf(stderr,"dlopen of %s failed with error %s\n", Yap_FileNameBuf, dlerror()); -/* strcpy(Yap_ErrorSay,dlerror());*/ + fprintf(stderr,"dlopen of %s failed with error %s\n", LOCAL_FileNameBuf, dlerror()); +/* strcpy(LOCAL_ErrorSay,dlerror());*/ return LOAD_FAILLED; } @@ -142,7 +142,7 @@ LoadForeign(StringList ofiles, StringList libs, } if(! *init_proc) { - strcpy(Yap_ErrorSay,"Could not locate initialization routine"); + strcpy(LOCAL_ErrorSay,"Could not locate initialization routine"); return LOAD_FAILLED; } diff --git a/C/load_dld.c b/C/load_dld.c index 94f279539..e697011d8 100644 --- a/C/load_dld.c +++ b/C/load_dld.c @@ -20,8 +20,7 @@ #include #include -static char YapExecutable[YAP_FILE_MAX]; - +this code is no being maintained anymore /* * YAP_FindExecutable(argv[0]) should be called on yap initialization to @@ -33,9 +32,9 @@ Yap_FindExecutable(char *name) /* use dld_find_executable */ char *res; if(name != NULL && (res=dld_find_executable(name))) { - strcpy(YapExecutable,res); + strcpy(GLOBAL_Executable,res); } else { - strcpy(YapExecutable,"./yap"); + strcpy(GLOBAL_Executable,"./yap"); } } @@ -71,9 +70,9 @@ LoadForeign(StringList ofiles, StringList libs, int error; if(firstTime) { - error = dld_init(YapExecutable); + error = dld_init(GLOBAL_Executable); if(error) { - strcpy(Yap_ErrorSay,dld_strerror(error)); + strcpy(LOCAL_ErrorSay,dld_strerror(error)); return LOAD_FAILLED; } firstTime=0; @@ -81,7 +80,7 @@ LoadForeign(StringList ofiles, StringList libs, while (ofiles) { if((error=dld_link(AtomName(ofiles->name))) !=0) { - strcpy(Yap_ErrorSay,dld_strerror(error)); + strcpy(LOCAL_ErrorSay,dld_strerror(error)); return LOAD_FAILLED; } ofiles = ofiles->next; @@ -91,14 +90,14 @@ LoadForeign(StringList ofiles, StringList libs, /* TODO: handle libs */ *init_proc = (YapInitProc) dld_get_func(proc_name); if(! *init_proc) { - strcpy(Yap_ErrorSay,"Could not locate initialization routine"); + strcpy(LOCAL_ErrorSay,"Could not locate initialization routine"); return LOAD_FAILLED; } if(!dld_function_executable_p(proc_name)) { char **undefs = dld_list_undefined_sym(); char **p = undefs; int k = dld_undefined_sym_count; - strcpy(Yap_ErrorSay,"Could not resolve all symbols"); + strcpy(LOCAL_ErrorSay,"Could not resolve all symbols"); while(k) { YP_printf("[undefined symbol %s]\n",*p++); --k; diff --git a/C/load_dll.c b/C/load_dll.c index 972ec0ec5..4bb21c1d3 100755 --- a/C/load_dll.c +++ b/C/load_dll.c @@ -66,16 +66,16 @@ LoadForeign(StringList ofiles, StringList libs, while (ofiles) { HINSTANCE handle; - if (Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE) && - (handle=LoadLibrary(Yap_FileNameBuf)) != 0) + if (Yap_TrueFileName(AtomName(ofiles->name), LOCAL_FileNameBuf, TRUE) && + (handle=LoadLibrary(LOCAL_FileNameBuf)) != 0) { - Yap_ErrorSay[0]=~'\0'; + LOCAL_ErrorSay[0]=~'\0'; if (*init_proc == NULL) *init_proc = (YapInitProc)GetProcAddress((HMODULE)handle, proc_name); } else { FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, GetLastError(), - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), Yap_ErrorSay, 256, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), LOCAL_ErrorSay, 256, NULL); } ofiles = ofiles->next; @@ -87,15 +87,15 @@ LoadForeign(StringList ofiles, StringList libs, char * s = AtomName(libs->name); if (s[0] == '-') { - strcat(Yap_FileNameBuf,s+2); - strcat(Yap_FileNameBuf,".dll"); + strcat(LOCAL_FileNameBuf,s+2); + strcat(LOCAL_FileNameBuf,".dll"); } else { - strcpy(Yap_FileNameBuf,s); + strcpy(LOCAL_FileNameBuf,s); } - if((handle=LoadLibrary(Yap_FileNameBuf)) == 0) + if((handle=LoadLibrary(LOCAL_FileNameBuf)) == 0) { -/* strcpy(Yap_ErrorSay,dlerror());*/ +/* strcpy(LOCAL_ErrorSay,dlerror());*/ return LOAD_FAILLED; } @@ -106,7 +106,7 @@ LoadForeign(StringList ofiles, StringList libs, } if(*init_proc == NULL) { - strcpy(Yap_ErrorSay,"Could not locate initialization routine"); + strcpy(LOCAL_ErrorSay,"Could not locate initialization routine"); return LOAD_FAILLED; } diff --git a/C/load_dyld.c b/C/load_dyld.c index 8e7b47b25..1367a9c9c 100644 --- a/C/load_dyld.c +++ b/C/load_dyld.c @@ -28,13 +28,13 @@ */ #import -static int dl_errno; + static char * mydlerror(void) { char *errString; - switch(dl_errno) { + switch(LOCAL_dl_errno) { default: case NSObjectFileImageFailure: case NSObjectFileImageFormat: @@ -76,7 +76,7 @@ mydlopen(char *path) NSModule handle = NULL; dyld_result = NSCreateObjectFileImageFromFile(path, &ofile); if (dyld_result != NSObjectFileImageSuccess) { - dl_errno = dyld_result; + LOCAL_dl_errno = dyld_result; } else { /* NSLinkModule will cause the run to abort on any link error's */ /* not very friendly but the error recovery functionality is limited */ @@ -145,14 +145,14 @@ LoadForeign(StringList ofiles, StringList libs, void *handle; /* mydlopen wants to follow the LD_CONFIG_PATH */ - if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) { - strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign"); + if (!Yap_TrueFileName(AtomName(ofiles->name), LOCAL_FileNameBuf, TRUE)) { + strcpy(LOCAL_ErrorSay, "%% Trying to open unexisting file in LoadForeign"); return LOAD_FAILLED; } - if((handle=mydlopen(Yap_FileNameBuf)) == 0) + if((handle=mydlopen(LOCAL_FileNameBuf)) == 0) { fprintf(stderr,"calling dlopen with error %s\n", mydlerror()); -/* strcpy(Yap_ErrorSay,dlerror());*/ +/* strcpy(LOCAL_ErrorSay,dlerror());*/ return LOAD_FAILLED; } @@ -166,16 +166,16 @@ LoadForeign(StringList ofiles, StringList libs, char *s = AtomName(lib->name); if (ls[0] == '-') { - strcpy(Yap_FileNameBuf,"lib"); - strcat(Yap_FileNameBuf,s+2); - strcat(Yap_FileNameBuf,".so"); + strcpy(LOCAL_FileNameBuf,"lib"); + strcat(LOCAL_FileNameBuf,s+2); + strcat(LOCAL_FileNameBuf,".so"); } else { - strcpy(Yap_FileNameBuf,s); + strcpy(LOCAL_FileNameBuf,s); } - if((libs->handle=mydlopen(Yap_FileNameBuf)) == NULL) + if((libs->handle=mydlopen(LOCAL_FileNameBuf)) == NULL) { - strcpy(Yap_ErrorSay,mydlerror()); + strcpy(LOCAL_ErrorSay,mydlerror()); return LOAD_FAILLED; } libs = libs->next; @@ -184,7 +184,7 @@ LoadForeign(StringList ofiles, StringList libs, *init_proc = (YapInitProc) mydlsym(proc_name); if(! *init_proc) { - strcpy(Yap_ErrorSay,"Could not locate initialization routine"); + strcpy(LOCAL_ErrorSay,"Could not locate initialization routine"); return LOAD_FAILLED; } diff --git a/C/load_foreign.c b/C/load_foreign.c index e3d4aaa12..d4d3d351e 100755 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -47,7 +47,7 @@ p_load_foreign( USES_REGS1 ) StringList new; Int returncode = FALSE; - strcpy(Yap_ErrorSay,"Invalid arguments"); + strcpy(LOCAL_ErrorSay,"Invalid arguments"); /* collect the list of object files */ t = Deref(ARG1); @@ -225,10 +225,10 @@ p_open_shared_objects( USES_REGS1 ) { void Yap_InitLoadForeign( void ) { - if (Yap_argv == NULL) + if (GLOBAL_argv == NULL) Yap_FindExecutable("yap"); else - Yap_FindExecutable(Yap_argv[0]); + Yap_FindExecutable(GLOBAL_argv[0]); Yap_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$open_shared_object", 3, p_open_shared_object, SyncPredFlag|HiddenPredFlag); diff --git a/C/load_none.c b/C/load_none.c index 45aeb5c54..9a9c4a01c 100644 --- a/C/load_none.c +++ b/C/load_none.c @@ -40,7 +40,7 @@ static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name, YapInitProc *init_proc) { - strcpy(Yap_ErrorSay,"load_foreign not supported in this version of Yap"); + strcpy(LOCAL_ErrorSay,"load_foreign not supported in this version of Yap"); return LOAD_FAILLED; } diff --git a/C/load_shl.c b/C/load_shl.c index 0ff8799d4..25c1f573c 100644 --- a/C/load_shl.c +++ b/C/load_shl.c @@ -61,17 +61,17 @@ LoadForeign( StringList ofiles, StringList libs, int valid_fname; /* shl_load wants to follow the LD_CONFIG_PATH */ - valid_fname = Yap_TrueFileName( AtomName(ofiles->name), Yap_FileNameBuf, TRUE ); + valid_fname = Yap_TrueFileName( AtomName(ofiles->name), LOCAL_FileNameBuf, TRUE ); if( !valid_fname ) { - strcpy( Yap_ErrorSay, "%% Trying to open non-existing file in LoadForeign" ); + strcpy( LOCAL_ErrorSay, "%% Trying to open non-existing file in LoadForeign" ); return LOAD_FAILLED; } ofiles->handle = Yap_AllocCodeSpace( sizeof(shl_t) ); - *(shl_t *)ofiles->handle = shl_load( Yap_FileNameBuf, BIND_DEFERRED, 0 ); + *(shl_t *)ofiles->handle = shl_load( LOCAL_FileNameBuf, BIND_DEFERRED, 0 ); if( *(shl_t *)ofiles->handle == NULL ) { - strncpy( Yap_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE ); + strncpy( LOCAL_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE ); return LOAD_FAILLED; } @@ -84,7 +84,7 @@ LoadForeign( StringList ofiles, StringList libs, } if( init_missing ) { - strcpy( Yap_ErrorSay, "Could not locate initialization routine" ); + strcpy( LOCAL_ErrorSay, "Could not locate initialization routine" ); return LOAD_FAILLED; } @@ -92,17 +92,17 @@ LoadForeign( StringList ofiles, StringList libs, char *s = AtomName(lib->s); if( s[0] == '-' ) { - strcpy( Yap_FileNameBuf, "lib" ); - strcat( Yap_FileNameBuf, s+2 ); - strcat( Yap_FileNameBuf, ".sl" ); + strcpy( LOCAL_FileNameBuf, "lib" ); + strcat( LOCAL_FileNameBuf, s+2 ); + strcat( LOCAL_FileNameBuf, ".sl" ); } else { - strcpy( Yap_FileNameBuf, s ); + strcpy( LOCAL_FileNameBuf, s ); } - *(shl_t *)libs->handle = shl_load( Yap_FileNameBuf, BIND_DEFERRED, 0 ); + *(shl_t *)libs->handle = shl_load( LOCAL_FileNameBuf, BIND_DEFERRED, 0 ); if( *(shl_t *)libs->handle == NULL ) { - strncpy( Yap_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE ); + strncpy( LOCAL_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE ); return LOAD_FAILLED; } diff --git a/C/parser.c b/C/parser.c index 352befa16..044c85c96 100644 --- a/C/parser.c +++ b/C/parser.c @@ -77,7 +77,7 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF * CACHE_TYPE)); #define TRY(S,P) \ { Volatile JMPBUFF *saveenv, newenv; \ - Volatile TokEntry *saveT=Yap_tokptr; \ + Volatile TokEntry *saveT=LOCAL_tokptr; \ Volatile CELL *saveH=H; \ Volatile int savecurprio=curprio; \ saveenv=FailBuff; \ @@ -90,13 +90,13 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF * CACHE_TYPE)); else { FailBuff=saveenv; \ H=saveH; \ curprio = savecurprio; \ - Yap_tokptr=saveT; \ + LOCAL_tokptr=saveT; \ } \ } #define TRY3(S,P,F) \ { Volatile JMPBUFF *saveenv, newenv; \ - Volatile TokEntry *saveT=Yap_tokptr; \ + Volatile TokEntry *saveT=LOCAL_tokptr; \ Volatile CELL *saveH=H; \ saveenv=FailBuff; \ if(!sigsetjmp(newenv.JmpBuff, 0)) { \ @@ -108,7 +108,7 @@ STATIC_PROTO(Term ParseTerm, (int, JMPBUFF * CACHE_TYPE)); else { \ FailBuff=saveenv; \ H=saveH; \ - Yap_tokptr=saveT; \ + LOCAL_tokptr=saveT; \ F } \ } @@ -122,15 +122,15 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */ VarEntry *p; #ifdef DEBUG - if (Yap_Option[4]) - fprintf(Yap_stderr,"[LookupVar %s]", var); + if (GLOBAL_Option[4]) + fprintf(GLOBAL_stderr,"[LookupVar %s]", var); #endif if (var[0] != '_' || var[1] != '\0') { - VarEntry **op = &Yap_VarTable; + VarEntry **op = &LOCAL_VarTable; unsigned char *vp = (unsigned char *)var; UInt hv; - p = Yap_VarTable; + p = LOCAL_VarTable; hv = HashFunction(vp) % AtomHashTableSize; while (p != NULL) { CELL hpv = p->hv; @@ -161,8 +161,8 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */ } else { /* anon var */ p = (VarEntry *) Yap_AllocScannerMemory(sizeof(VarEntry) + 2); - p->VarLeft = Yap_AnonVarTable; - Yap_AnonVarTable = p; + p->VarLeft = LOCAL_AnonVarTable; + LOCAL_AnonVarTable = p; p->VarRight = NULL; p->hv = 0L; p->VarRep[0] = '_'; @@ -182,7 +182,7 @@ VarNames(VarEntry *p,Term l USES_REGS) VarNames(p->VarLeft,l PASS_REGS) PASS_REGS)); if (H > ASP-4096) { save_machine_regs(); - siglongjmp(Yap_IOBotch,1); + siglongjmp(LOCAL_IOBotch,1); } return(o); } else { @@ -295,24 +295,19 @@ Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) inline static void GNextToken( USES_REGS1 ) { - if (Yap_tokptr->Tok == Ord(eot_tok)) + if (LOCAL_tokptr->Tok == Ord(eot_tok)) return; -#ifdef EMACS - if ((Yap_tokptr = Yap_tokptr->TokNext)->TokPos > Yap_toktide->TokPos) - Yap_toktide = Yap_tokptr; -#else - if (Yap_tokptr == Yap_toktide) - Yap_toktide = Yap_tokptr = Yap_tokptr->TokNext; + if (LOCAL_tokptr == LOCAL_toktide) + LOCAL_toktide = LOCAL_tokptr = LOCAL_tokptr->TokNext; else - Yap_tokptr = Yap_tokptr->TokNext; -#endif + LOCAL_tokptr = LOCAL_tokptr->TokNext; } inline static void checkfor(Term c, JMPBUFF *FailBuff USES_REGS) { - if (Yap_tokptr->Tok != Ord(Ponctuation_tok) - || Yap_tokptr->TokInfo != c) + if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) + || LOCAL_tokptr->TokInfo != c) FAIL; NextToken; } @@ -331,16 +326,16 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS) p = (Term *) ParserAuxSp; while (1) { Term *tp = (Term *)ParserAuxSp; - if (ParserAuxSp+1 > Yap_TrailTop) { - Yap_ErrorMessage = "Trail Overflow"; + if (ParserAuxSp+1 > LOCAL_TrailTop) { + LOCAL_ErrorMessage = "Trail Overflow"; FAIL; } *tp++ = Unsigned(ParseTerm(999, FailBuff PASS_REGS)); ParserAuxSp = (char *)tp; ++nargs; - if (Yap_tokptr->Tok != Ord(Ponctuation_tok)) + if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)) break; - if (((int) Yap_tokptr->TokInfo) != ',') + if (((int) LOCAL_tokptr->TokInfo) != ',') break; NextToken; } @@ -350,12 +345,12 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS) * order */ if (H > ASP-(nargs+1)) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } func = Yap_MkFunctor(a, nargs); if (func == NULL) { - Yap_ErrorMessage = "Heap Overflow"; + LOCAL_ErrorMessage = "Heap Overflow"; FAIL; } #ifdef SFUNC @@ -370,7 +365,7 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS) t = Yap_MkApplTerm(func, nargs, p); #endif if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; return TermNil; } /* check for possible overflow against local stack */ @@ -389,25 +384,25 @@ ParseList(JMPBUFF *FailBuff USES_REGS) to_store = H; H+=2; to_store[0] = ParseTerm(999, FailBuff PASS_REGS); - if (Yap_tokptr->Tok == Ord(Ponctuation_tok)) { - if (((int) Yap_tokptr->TokInfo) == ',') { + if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { + if (((int) LOCAL_tokptr->TokInfo) == ',') { NextToken; - if (Yap_tokptr->Tok == Ord(Name_tok) - && strcmp(RepAtom((Atom)(Yap_tokptr->TokInfo))->StrOfAE, "..") == 0) { + if (LOCAL_tokptr->Tok == Ord(Name_tok) + && strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) { NextToken; to_store[1] = ParseTerm(999, FailBuff PASS_REGS); } else { /* check for possible overflow against local stack */ if (H > ASP-4096) { to_store[1] = TermNil; - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } else { to_store[1] = AbsPair(H); goto loop; } } - } else if (((int) Yap_tokptr->TokInfo) == '|') { + } else if (((int) LOCAL_tokptr->TokInfo) == '|') { NextToken; to_store[1] = ParseTerm(999, FailBuff PASS_REGS); } else { @@ -436,14 +431,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) Volatile int curprio = 0, opprio, oplprio, oprprio; Volatile Atom opinfo; - switch (Yap_tokptr->Tok) { + switch (LOCAL_tokptr->Tok) { case Name_tok: - t = Yap_tokptr->TokInfo; + t = LOCAL_tokptr->TokInfo; NextToken; /* special rules apply for +1, -2.3, etc... */ - if (Yap_tokptr->Tok == Number_tok) { + if (LOCAL_tokptr->Tok == Number_tok) { if ((Atom)t == AtomMinus) { - t = Yap_tokptr->TokInfo; + t = LOCAL_tokptr->TokInfo; if (IsIntTerm(t)) t = MkIntTerm(-IntOfTerm(t)); else if (IsFloatTerm(t)) @@ -459,12 +454,12 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) break; } } - if ((Yap_tokptr->Tok != Ord(Ponctuation_tok) - || Unsigned(Yap_tokptr->TokInfo) != 'l') + if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) + || Unsigned(LOCAL_tokptr->TokInfo) != 'l') && IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS) ) { - if (Yap_tokptr->Tok == Name_tok) { - Atom at = (Atom)Yap_tokptr->TokInfo; + if (LOCAL_tokptr->Tok == Name_tok) { + Atom at = (Atom)LOCAL_tokptr->TokInfo; #ifndef _MSC_VER if ((Atom)t == AtomPlus) { if (at == AtomInf) { @@ -495,14 +490,14 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) /* build appl on the heap */ func = Yap_MkFunctor((Atom) t, 1); if (func == NULL) { - Yap_ErrorMessage = "Heap Overflow"; + LOCAL_ErrorMessage = "Heap Overflow"; FAIL; } t = ParseTerm(oprprio, FailBuff PASS_REGS); t = Yap_MkApplTerm(func, 1, &t); /* check for possible overflow against local stack */ if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } curprio = opprio; @@ -511,21 +506,21 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) ) } } - if (Yap_tokptr->Tok == Ord(Ponctuation_tok) - && Unsigned(Yap_tokptr->TokInfo) == 'l') + if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) + && Unsigned(LOCAL_tokptr->TokInfo) == 'l') t = ParseArgs((Atom) t, FailBuff PASS_REGS); else t = MkAtomTerm((Atom)t); break; case Number_tok: - t = Yap_tokptr->TokInfo; + t = LOCAL_tokptr->TokInfo; NextToken; break; case String_tok: /* build list on the heap */ { - Volatile char *p = (char *) Yap_tokptr->TokInfo; + Volatile char *p = (char *) LOCAL_tokptr->TokInfo; if (*p == 0) t = MkAtomTerm(AtomNil); else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS) @@ -533,7 +528,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_ATOM) { Atom at = Yap_LookupAtom(p); if (at == NIL) { - Yap_ErrorMessage = "Heap Overflow"; + LOCAL_ErrorMessage = "Heap Overflow"; FAIL; } t = MkAtomTerm(at); @@ -545,7 +540,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) case WString_tok: /* build list on the heap */ { - Volatile wchar_t *p = (wchar_t *) Yap_tokptr->TokInfo; + Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo; if (*p == 0) t = MkAtomTerm(AtomNil); else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS) @@ -559,7 +554,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) break; case Var_tok: - varinfo = (VarEntry *) (Yap_tokptr->TokInfo); + varinfo = (VarEntry *) (LOCAL_tokptr->TokInfo); if ((t = varinfo->VarAdr) == TermNil) { t = varinfo->VarAdr = MkVarTerm(); } @@ -570,7 +565,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) FAIL; case Ponctuation_tok: - switch ((int) Yap_tokptr->TokInfo) { + switch ((int) LOCAL_tokptr->TokInfo) { case '(': case 'l': /* non solo ( */ NextToken; @@ -588,7 +583,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) t = Yap_MkApplTerm(FunctorBraces, 1, &t); /* check for possible overflow against local stack */ if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } checkfor((Term) '}', FailBuff PASS_REGS); @@ -605,17 +600,17 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) /* main loop to parse infix and posfix operators starts here */ while (TRUE) { - if (Yap_tokptr->Tok == Ord(Name_tok) - && Yap_HasOp((Atom)(Yap_tokptr->TokInfo))) { - Atom save_opinfo = opinfo = (Atom)(Yap_tokptr->TokInfo); + if (LOCAL_tokptr->Tok == Ord(Name_tok) + && Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) { + Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo); if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* try parsing as infix operator */ Volatile int oldprio = curprio; TRY3( - func = Yap_MkFunctor((Atom) Yap_tokptr->TokInfo, 2); + func = Yap_MkFunctor((Atom) LOCAL_tokptr->TokInfo, 2); if (func == NULL) { - Yap_ErrorMessage = "Heap Overflow"; + LOCAL_ErrorMessage = "Heap Overflow"; FAIL; } NextToken; @@ -626,7 +621,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) t = Yap_MkApplTerm(func, 2, args); /* check for possible overflow against local stack */ if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } }, @@ -641,15 +636,15 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* parse as posfix operator */ - Functor func = Yap_MkFunctor((Atom) Yap_tokptr->TokInfo, 1); + Functor func = Yap_MkFunctor((Atom) LOCAL_tokptr->TokInfo, 1); if (func == NULL) { - Yap_ErrorMessage = "Heap Overflow"; + LOCAL_ErrorMessage = "Heap Overflow"; FAIL; } t = Yap_MkApplTerm(func, 1, &t); /* check for possible overflow against local stack */ if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } curprio = opprio; @@ -658,8 +653,8 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) } break; } - if (Yap_tokptr->Tok == Ord(Ponctuation_tok)) { - if (Unsigned(Yap_tokptr->TokInfo) == ',' && + if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { + if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 && curprio <= 999) { Volatile Term args[2]; NextToken; @@ -668,12 +663,12 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) t = Yap_MkApplTerm(FunctorComma, 2, args); /* check for possible overflow against local stack */ if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } curprio = 1000; continue; - } else if (Unsigned(Yap_tokptr->TokInfo) == '|' && + } else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' && IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { Volatile Term args[2]; @@ -683,19 +678,19 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) t = Yap_MkApplTerm(FunctorVBar, 2, args); /* check for possible overflow against local stack */ if (H > ASP-4096) { - Yap_ErrorMessage = "Stack Overflow"; + LOCAL_ErrorMessage = "Stack Overflow"; FAIL; } curprio = opprio; continue; } } - if (Yap_tokptr->Tok <= Ord(WString_tok)) + if (LOCAL_tokptr->Tok <= Ord(WString_tok)) FAIL; break; } #ifdef DEBUG - if (Yap_Option['p' - 'a' + 1]) { + if (GLOBAL_Option['p' - 'a' + 1]) { Yap_DebugPutc(LOCAL_c_error_stream,'['); Yap_DebugPlWrite(t); Yap_DebugPutc(LOCAL_c_error_stream,']'); @@ -715,7 +710,7 @@ Yap_Parse(void) if (!sigsetjmp(FailBuff.JmpBuff, 0)) { t = ParseTerm(1200, &FailBuff PASS_REGS); - if (Yap_tokptr->Tok != Ord(eot_tok)) + if (LOCAL_tokptr->Tok != Ord(eot_tok)) return (0L); return (t); } else diff --git a/C/save.c b/C/save.c index 53bc88ff0..80924d8c2 100755 --- a/C/save.c +++ b/C/save.c @@ -164,19 +164,19 @@ do_system_error(yap_error_number etype, const char *msg) CACHE_REGS #if HAVE_SNPRINTF #if HAVE_STRERROR - snprintf(Yap_ErrorSay,MAX_ERROR_MSG_SIZE,"%s (%s when reading %s)", msg, strerror(errno), Yap_FileNameBuf); + snprintf(LOCAL_ErrorSay,MAX_ERROR_MSG_SIZE,"%s (%s when reading %s)", msg, strerror(errno), LOCAL_FileNameBuf); #else - snprintf(Yap_ErrorSay,MAX_ERROR_MSG_SIZE,"%s, (system error %d when reading %s)",msg,errno,Yap_FileNameBuf); + snprintf(LOCAL_ErrorSay,MAX_ERROR_MSG_SIZE,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf); #endif #else #if HAVE_STRERROR - sprintf(Yap_ErrorSay,"%s, (%s when reading %s)",msg,strerror(errno),Yap_FileNameBuf); + sprintf(LOCAL_ErrorSay,"%s, (%s when reading %s)",msg,strerror(errno),LOCAL_FileNameBuf); #else - sprintf(Yap_ErrorSay,"%s, (system error %d when reading %s)",msg,errno,Yap_FileNameBuf); + sprintf(LOCAL_ErrorSay,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf); #endif #endif - Yap_ErrorMessage = Yap_ErrorSay; - Yap_Error_TYPE = etype; + LOCAL_ErrorMessage = LOCAL_ErrorSay; + LOCAL_Error_TYPE = etype; return -1; } @@ -227,7 +227,7 @@ static int splfild = 0; #ifdef DEBUG_RESTORE4 static FILE *errout; #else -#define errout Yap_stderr +#define errout GLOBAL_stderr #endif #endif /* DEBUG */ @@ -349,13 +349,13 @@ put_info(int info, int mode USES_REGS) return -1; /* current state of stacks, to be used by SavedInfo */ /* space available in heap area */ - if (putout(Unsigned(Yap_GlobalBase)-Unsigned(Yap_HeapBase)) < 0) + if (putout(Unsigned(LOCAL_GlobalBase)-Unsigned(Yap_HeapBase)) < 0) return -1; /* space available for stacks */ - if (putout(Unsigned(Yap_LocalBase)-Unsigned(Yap_GlobalBase)) < 0) + if (putout(Unsigned(LOCAL_LocalBase)-Unsigned(LOCAL_GlobalBase)) < 0) return -1; /* space available for trail */ - if (putout(Unsigned(Yap_TrailTop)-Unsigned(Yap_TrailBase)) < 0) + if (putout(Unsigned(LOCAL_TrailTop)-Unsigned(LOCAL_TrailBase)) < 0) return -1; /* Space used in heap area */ if (putout(Unsigned(HeapTop)-Unsigned(Yap_HeapBase)) < 0) @@ -364,10 +364,10 @@ put_info(int info, int mode USES_REGS) if (putout(Unsigned(LCL0)-Unsigned(ASP)) < 0) return -1; /* Space used for global stack */ - if (putout(Unsigned(H) - Unsigned(Yap_GlobalBase)) < 0) + if (putout(Unsigned(H) - Unsigned(LOCAL_GlobalBase)) < 0) return -1; /* Space used for trail */ - if (putout(Unsigned(TR) - Unsigned(Yap_TrailBase)) < 0) + if (putout(Unsigned(TR) - Unsigned(LOCAL_TrailBase)) < 0) return -1; return 0; } @@ -473,7 +473,7 @@ save_regs(int mode USES_REGS) if (putout(ARG2) < 0) return -1; } - if (putcellptr(CellPtr(Yap_TrailBase)) < 0) + if (putcellptr(CellPtr(LOCAL_TrailBase)) < 0) return -1; } return 0; @@ -528,18 +528,18 @@ save_stacks(int mode USES_REGS) if (mywrite(splfild, (char *) ASP, j) < 0) return -1; /* Save the global stack */ - j = Unsigned(H) - Unsigned(Yap_GlobalBase); - if (mywrite(splfild, (char *) Yap_GlobalBase, j) < 0) + j = Unsigned(H) - Unsigned(LOCAL_GlobalBase); + if (mywrite(splfild, (char *) LOCAL_GlobalBase, j) < 0) return -1; /* Save the trail */ - j = Unsigned(TR) - Unsigned(Yap_TrailBase); - if (mywrite(splfild, (char *) Yap_TrailBase, j) < 0) + j = Unsigned(TR) - Unsigned(LOCAL_TrailBase); + if (mywrite(splfild, (char *) LOCAL_TrailBase, j) < 0) return -1; break; case DO_ONLY_CODE: { tr_fr_ptr tr_ptr = TR; - while (tr_ptr != (tr_fr_ptr)Yap_TrailBase) { + while (tr_ptr != (tr_fr_ptr)LOCAL_TrailBase) { CELL val = TrailTerm(tr_ptr-1); if (IsVarTerm(val)) { CELL *d1 = VarOfTerm(val); @@ -577,18 +577,18 @@ do_save(int mode USES_REGS) { Term t1 = Deref(ARG1); if (Yap_HoleSize) { - Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)), + Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), "restore/1: address space has holes of size %ld, cannot save", (long int)Yap_HoleSize); return FALSE; } - if (!Yap_GetName(Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) { + if (!Yap_GetName(LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) { Yap_Error(TYPE_ERROR_LIST,t1,"save/1"); return FALSE; } Scleanup(); Yap_CloseStreams(TRUE); - if ((splfild = open_file(Yap_FileNameBuf, O_WRONLY | O_CREAT)) < 0) { - Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)), + if ((splfild = open_file(LOCAL_FileNameBuf, O_WRONLY | O_CREAT)) < 0) { + Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), "restore/1, open(%s)", strerror(errno)); return(FALSE); } @@ -682,42 +682,42 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS) } } if (strcmp(pp, msg) != 0) { - Yap_ErrorMessage = Yap_ErrorSay; - strncpy(Yap_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE); - strncat(Yap_ErrorMessage, Yap_FileNameBuf, MAX_ERROR_MSG_SIZE); - strncat(Yap_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE); - Yap_Error_TYPE = CONSISTENCY_ERROR; + LOCAL_ErrorMessage = LOCAL_ErrorSay; + strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE); + strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, MAX_ERROR_MSG_SIZE); + strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE); + LOCAL_Error_TYPE = CONSISTENCY_ERROR; return FAIL_RESTORE; } /* check info on header */ /* ignore info on saved state */ *info = get_header_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; /* check the restore mode */ mode = get_header_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) { return FAIL_RESTORE; } /* ignore info on stacks size */ *AHeap = get_header_cell(); - if (Yap_ErrorMessage) { + if (LOCAL_ErrorMessage) { return FAIL_RESTORE; } *AStack = get_header_cell(); - if (Yap_ErrorMessage) { + if (LOCAL_ErrorMessage) { return FAIL_RESTORE; } *ATrail = get_header_cell(); - if (Yap_ErrorMessage) { + if (LOCAL_ErrorMessage) { return FAIL_RESTORE; } /* now, check whether we got enough enough space to load the saved space */ hp_size = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; while (Yap_HeapBase != NULL && hp_size > Unsigned(HeapLim) - Unsigned(Yap_HeapBase)) { @@ -727,31 +727,31 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS) } if (mode == DO_EVERYTHING) { lc_size = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; gb_size=get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; - if (Yap_HeapBase != NULL && lc_size+gb_size > Unsigned(Yap_LocalBase) - Unsigned(Yap_GlobalBase)) { - if (Yap_ErrorMessage != NULL) - Yap_ErrorMessage = "could not allocate enough stack space"; + if (Yap_HeapBase != NULL && lc_size+gb_size > Unsigned(LOCAL_LocalBase) - Unsigned(LOCAL_GlobalBase)) { + if (LOCAL_ErrorMessage != NULL) + LOCAL_ErrorMessage = "could not allocate enough stack space"; return FAIL_RESTORE; } - if (Yap_HeapBase != NULL && (tr_size = get_cell()) > Unsigned(Yap_TrailTop) - Unsigned(Yap_TrailBase)) { - if (Yap_ErrorMessage != NULL) - Yap_ErrorMessage = "could not allocate enough trail space"; + if (Yap_HeapBase != NULL && (tr_size = get_cell()) > Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase)) { + if (LOCAL_ErrorMessage != NULL) + LOCAL_ErrorMessage = "could not allocate enough trail space"; return FAIL_RESTORE; } } else { /* skip cell size */ get_header_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; get_header_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; get_header_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return FAIL_RESTORE; } return(mode); @@ -762,35 +762,35 @@ static int get_heap_info(USES_REGS1) { LOCAL_OldHeapBase = (ADDR) get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_OldHeapTop = (ADDR) get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; OldHeapUsed = (Int) get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; FreeBlocks = (BlockHeader *) get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; AuxBase = (ADDR)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; AuxSp = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; AuxTop = (ADDR)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_ScratchPad.ptr = (ADDR)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_ScratchPad.sz = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_ScratchPad.msz = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_HDiff = Unsigned(Yap_HeapBase) - Unsigned(LOCAL_OldHeapBase); return 1; @@ -802,130 +802,130 @@ get_heap_info(USES_REGS1) static int get_regs(int flag USES_REGS) { - CELL *NewGlobalBase = (CELL *)Yap_GlobalBase; + CELL *NewGlobalBase = (CELL *)LOCAL_GlobalBase; CELL *NewLCL0 = LCL0; CELL *OldXREGS; /* Get regs */ compile_arrays = (int)get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; if (flag == DO_EVERYTHING) { CP = (yamop *)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; ENV = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; ASP = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; /* N = get_cell(); */ H0 = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LCL0 = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; H = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; HB = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; B = (choiceptr)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; TR = (tr_fr_ptr)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; YENV = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; S = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; P = (yamop *)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; CreepFlag = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; EX = (struct DB_TERM *)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; #if defined(YAPOR_SBA) || defined(TABLING) H_FZ = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; B_FZ = (choiceptr)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; TR_FZ = (tr_fr_ptr)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; #endif /* YAPOR_SBA || TABLING */ } CurrentModule = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; if (flag == DO_EVERYTHING) { #ifdef COROUTINING LOCAL_WokenGoals = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; #endif #ifdef DEPTH_LIMIT DEPTH = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; #endif LOCAL_GcGeneration = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_GcPhase = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_GcCurrentPhase = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; } /* Get the old bases */ OldXREGS = get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; which_save = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; LOCAL_XDiff = (CELL)XREGS - (CELL)OldXREGS; - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; if (get_heap_info( PASS_REGS1 ) < 0) return -1; if (flag == DO_EVERYTHING) { ARG1 = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; if (which_save == 2) { ARG2 = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; } /* get old trail base */ LOCAL_OldTrailBase = (ADDR)get_cellptr(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; /* Save the old register where we can easily access them */ LOCAL_OldASP = ASP; LOCAL_OldLCL0 = LCL0; - LOCAL_OldGlobalBase = (CELL *)Yap_GlobalBase; + LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldH = H; LOCAL_OldTR = TR; - LOCAL_GDiff = Unsigned(NewGlobalBase) - Unsigned(Yap_GlobalBase); + LOCAL_GDiff = Unsigned(NewGlobalBase) - Unsigned(LOCAL_GlobalBase); LOCAL_GDiff0 = 0; LOCAL_LDiff = Unsigned(NewLCL0) - Unsigned(LCL0); LOCAL_TrDiff = LOCAL_LDiff; - Yap_GlobalBase = (ADDR)NewGlobalBase; + LOCAL_GlobalBase = (ADDR)NewGlobalBase; LCL0 = NewLCL0; } return 1; @@ -968,10 +968,10 @@ CopyStacks( USES_REGS1 ) if (myread(splfild, (char *) NewASP, j) < 0) return -1; j = Unsigned(H) - Unsigned(LOCAL_OldGlobalBase); - if (myread(splfild, (char *) Yap_GlobalBase, j) < 0) + if (myread(splfild, (char *) LOCAL_GlobalBase, j) < 0) return -1; j = Unsigned(TR) - Unsigned(LOCAL_OldTrailBase); - if (myread(splfild, Yap_TrailBase, j)) + if (myread(splfild, LOCAL_TrailBase, j)) return -1; return 1; } @@ -983,10 +983,10 @@ CopyTrailEntries( USES_REGS1 ) { CELL entry, *Entries; - Entries = (CELL *)Yap_TrailBase; + Entries = (CELL *)LOCAL_TrailBase; do { *Entries++ = entry = get_cell(); - if (Yap_ErrorMessage) + if (LOCAL_ErrorMessage) return -1; } while ((CODEADDR)entry != NULL); return 1; @@ -1020,7 +1020,7 @@ get_coded(int flag, OPCODE old_ops[] USES_REGS) if (myread(splfild, my_end_msg, 256) < 0) return -1; if (strcmp(end_msg,my_end_msg) != 0) { - Yap_ErrorMessage = "bad trailing CRC in saved state"; + LOCAL_ErrorMessage = "bad trailing CRC in saved state"; return -1; } return 1; @@ -1035,7 +1035,7 @@ restore_heap_regs( USES_REGS1 ) *((YAP_SEG_SIZE *) HeapTop) = InUseFlag; } HeapMax = Yap_heap_regs->heap_used = OldHeapUsed; - HeapLim = Yap_GlobalBase; + HeapLim = LOCAL_GlobalBase; } /* adjust abstract machine registers */ @@ -1142,8 +1142,8 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS) basep = H; if (H + (NOfE*2) > ASP) { basep = (CELL *)TR; - if (basep + (NOfE*2) > (CELL *)Yap_TrailTop) { - if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-Yap_TrailTop, TRUE)) { + if (basep + (NOfE*2) > (CELL *)LOCAL_TrailTop) { + if (!Yap_growtrail((ADDR)(basep + (NOfE*2))-LOCAL_TrailTop, TRUE)) { Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "not enough space to restore hash tables for indexing"); Yap_exit(1); @@ -1337,7 +1337,7 @@ ShowEntries(pp) PropEntry *pp; { while (!EndOfPAEntr(pp)) { - fprintf(Yap_stderr,"Estou a ver a prop %x em %x\n", pp->KindOfPE, pp); + fprintf(GLOBAL_stderr,"Estou a ver a prop %x em %x\n", pp->KindOfPE, pp); pp = RepProp(pp->NextOfPE); } } @@ -1352,7 +1352,7 @@ ShowAtoms() AtomEntry *at; at = RepAtom(HashPtr->Entry); do { - fprintf(Yap_stderr,"Passei ao %s em %x\n", at->StrOfAE, at); + fprintf(GLOBAL_stderr,"Passei ao %s em %x\n", at->StrOfAE, at); ShowEntries(RepProp(at->PropsOfAE)); } while (!EndOfPAEntr(at = RepAtom(at->NextOfAE))); } @@ -1364,7 +1364,7 @@ ShowAtoms() AtomEntry *at; at = RepAtom(HashPtr->Entry); do { - fprintf(Yap_stderr,"Passei ao %s em %x\n", at->StrOfAE, at); + fprintf(GLOBAL_stderr,"Passei ao %s em %x\n", at->StrOfAE, at); ShowEntries(RepProp(at->PropsOfAE)); } while (!EndOfPAEntr(at = RepAtom(at->NextOfAE))); } @@ -1383,12 +1383,12 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A if ((mode = check_header(Astate,ATrail,AStack,AHeap PASS_REGS)) == FAIL_RESTORE) return(FAIL_RESTORE); - Yap_PrologMode = BootMode; + LOCAL_PrologMode = BootMode; if (Yap_HeapBase) { extern void Scleanup(void); if (!yap_flags[HALT_AFTER_CONSULT_FLAG] && !yap_flags[QUIET_MODE_FLAG]) { - Yap_TrueFileName(s,Yap_FileNameBuf2, YAP_FILENAME_MAX); - fprintf(stderr, "%% Restoring file %s\n", Yap_FileNameBuf2); + Yap_TrueFileName(s,LOCAL_FileNameBuf2, YAP_FILENAME_MAX); + fprintf(stderr, "%% Restoring file %s\n", LOCAL_FileNameBuf2); } Scleanup(); Yap_CloseStreams(TRUE); @@ -1397,7 +1397,7 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A /* * This should be another file, like the log file */ - errout = Yap_stderr; + errout = GLOBAL_stderr; #endif return mode; } @@ -1425,7 +1425,7 @@ static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL * strncpy(buf, inpf, YAP_FILENAME_MAX); if ((mode = commit_to_saved_state(inpf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) { CACHE_REGS - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; return mode; } return mode; @@ -1437,8 +1437,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac CACHE_REGS int mode = FAIL_RESTORE; char save_buffer[YAP_FILENAME_MAX+1]; - - // Yap_ErrorMessage = NULL; + // LOCAL_ErrorMessage = NULL; if (inpf == NULL) { #if _MSC_VER || defined(__MINGW32__) if (!(inpf = Yap_RegistryGetString("startup"))) @@ -1449,18 +1448,18 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac if (inpf[0] != '/') { #if __simplescalar__ /* does not implement getcwd */ - strncpy(Yap_FileNameBuf,yap_pwd,YAP_FILENAME_MAX); + strncpy(LOCAL_FileNameBuf,GLOBAL_pwd,YAP_FILENAME_MAX); #elif HAVE_GETCWD - if (getcwd (Yap_FileNameBuf, YAP_FILENAME_MAX) == NULL) - Yap_FileNameBuf[0] = '\0'; + if (getcwd (LOCAL_FileNameBuf, YAP_FILENAME_MAX) == NULL) + LOCAL_FileNameBuf[0] = '\0'; #else - if (getwd (Yap_FileNameBuf) == NULL) - Yap_FileNameBuf[0] = '\0'; + if (getwd (LOCAL_FileNameBuf) == NULL) + LOCAL_FileNameBuf[0] = '\0'; #endif - strncat(Yap_FileNameBuf, "/", YAP_FILENAME_MAX-1); - strncat(Yap_FileNameBuf, inpf, YAP_FILENAME_MAX-1); + strncat(LOCAL_FileNameBuf, "/", YAP_FILENAME_MAX-1); + strncat(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX-1); } else { - strncat(Yap_FileNameBuf, inpf, YAP_FILENAME_MAX-1); + strncat(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX-1); } if (inpf != NULL && (splfild = open_file(inpf, O_RDONLY)) > 0) { if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { @@ -1473,12 +1472,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac using YAPLIBDIR or friends. */ if (YapLibDir != NULL) { - cat_file_name(Yap_FileNameBuf, Yap_LibDir, inpf, YAP_FILENAME_MAX); - if ((mode = try_open(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + cat_file_name(LOCAL_FileNameBuf, Yap_LibDir, inpf, YAP_FILENAME_MAX); + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { return mode; } } else { - if ((mode = try_open(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { return mode; } } @@ -1486,17 +1485,17 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac { char *yap_env = getenv("YAPLIBDIR"); if (yap_env != NULL) { - cat_file_name(Yap_FileNameBuf, yap_env, inpf, YAP_FILENAME_MAX); - if ((mode = try_open(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + cat_file_name(LOCAL_FileNameBuf, yap_env, inpf, YAP_FILENAME_MAX); + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { return mode; } } } #endif if (YAP_LIBDIR != NULL) { - cat_file_name(Yap_FileNameBuf, YAP_LIBDIR, inpf, YAP_FILENAME_MAX); - if ((splfild = open_file(Yap_FileNameBuf, O_RDONLY)) > 0) { - if ((mode = try_open(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + cat_file_name(LOCAL_FileNameBuf, YAP_LIBDIR, inpf, YAP_FILENAME_MAX); + if ((splfild = open_file(LOCAL_FileNameBuf, O_RDONLY)) > 0) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { return mode; } } @@ -1509,34 +1508,34 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac char *pt; /* try to get it from current executable */ - if ((fatts = GetFileAttributes(Yap_FileNameBuf)) == 0xFFFFFFFFL || + if ((fatts = GetFileAttributes(LOCAL_FileNameBuf)) == 0xFFFFFFFFL || !(fatts & FILE_ATTRIBUTE_DIRECTORY)) { /* couldn't find it where it was supposed to be, let's try using the executable */ - if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, Yap_FileNameBuf, YAP_FILENAME_MAX)) { + if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) { /* do nothing */ goto end; } - buflen = strlen(Yap_FileNameBuf); - pt = Yap_FileNameBuf+strlen(Yap_FileNameBuf); + buflen = strlen(LOCAL_FileNameBuf); + pt = LOCAL_FileNameBuf+strlen(LOCAL_FileNameBuf); while (*--pt != '\\') { /* skip executable */ - if (pt == Yap_FileNameBuf) { + if (pt == LOCAL_FileNameBuf) { /* do nothing */ goto end; } } while (*--pt != '\\') { /* skip parent directory "bin\\" */ - if (pt == Yap_FileNameBuf) { + if (pt == LOCAL_FileNameBuf) { goto end; } } /* now, this is a possible location for the ROOT_DIR, let's look for a share directory here */ pt[1] = '\0'; - strncat(Yap_FileNameBuf,"lib/Yap/startup.yss",YAP_FILENAME_MAX); + strncat(LOCAL_FileNameBuf,"lib/Yap/startup.yss",YAP_FILENAME_MAX); } - if ((mode = try_open(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { + if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer)) != FAIL_RESTORE) { return mode; } } @@ -1544,12 +1543,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac #endif /* try to open from current directory */ /* could not open file */ - if (Yap_ErrorMessage == NULL) { + if (LOCAL_ErrorMessage == NULL) { if (save_buffer[0]) { - strncpy(Yap_FileNameBuf, save_buffer, YAP_FILENAME_MAX-1); + strncpy(LOCAL_FileNameBuf, save_buffer, YAP_FILENAME_MAX-1); do_system_error(PERMISSION_ERROR_OPEN_SOURCE_SINK,"incorrect saved state"); } else { - strncpy(Yap_FileNameBuf, inpf, YAP_FILENAME_MAX-1); + strncpy(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX-1); do_system_error(PERMISSION_ERROR_OPEN_SOURCE_SINK,"could not open saved state"); } } @@ -1559,11 +1558,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac static void CloseRestore(void) { + CACHE_REGS #ifdef DEBUG_RESTORE3 ShowAtoms(); #endif close_file(); - Yap_PrologMode = UserMode; + LOCAL_PrologMode = UserMode; } #if !defined(_WIN32) @@ -1660,7 +1660,7 @@ UnmarkTrEntries( USES_REGS1 ) B = (choiceptr)LCL0; B--; B->cp_ap = NOCODE; - Entries = (CELL *)Yap_TrailBase; + Entries = (CELL *)LOCAL_TrailBase; while ((entry = *Entries++) != (CELL)NULL) { if (!IsVarTerm(entry)) { if(IsPairTerm(entry)) { @@ -1742,8 +1742,8 @@ Restore(char *s, char *lib_dir USES_REGS) case DO_EVERYTHING: if (LOCAL_OldHeapBase != Yap_HeapBase || LOCAL_OldLCL0 != LCL0 || - LOCAL_OldGlobalBase != (CELL *)Yap_GlobalBase || - LOCAL_OldTrailBase != Yap_TrailBase) { + LOCAL_OldGlobalBase != (CELL *)LOCAL_GlobalBase || + LOCAL_OldTrailBase != LOCAL_TrailBase) { Yap_AdjustStacksAndTrail(); if (which_save == 2) { Yap_AdjustRegs(2); @@ -1816,7 +1816,7 @@ p_restore( USES_REGS1 ) restore_absmi_regs(&Yap_standard_regs); #endif /* back to the top level we go */ - siglongjmp(Yap_RestartEnv,3); + siglongjmp(LOCAL_RestartEnv,3); } return(mode != FAIL_RESTORE); } diff --git a/C/scanner.c b/C/scanner.c index 412faed56..240af48e2 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -184,7 +184,7 @@ AllocScannerMemory(unsigned int size) ptr->next = LOCAL_ScannerExtraBlocks; LOCAL_ScannerExtraBlocks = ptr; return (char *)(ptr+1); - } else if (Yap_TrailTop <= AuxSpScan+size) { + } else if (LOCAL_TrailTop <= AuxSpScan+size) { UInt alloc_size = sizeof(CELL) * K16; if (size > alloc_size) @@ -235,7 +235,7 @@ float_send(char *s, int sign) if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ if (!finite(f)) { CACHE_REGS - Yap_ErrorMessage = "Float overflow while scanning"; + LOCAL_ErrorMessage = "Float overflow while scanning"; return(MkEvalFl(0.0)); } } @@ -268,7 +268,7 @@ static int send_error_message(char s[]) { CACHE_REGS - Yap_ErrorMessage = s; + LOCAL_ErrorMessage = s; return 0; } @@ -502,7 +502,7 @@ static int num_send_error_message(char s[]) { CACHE_REGS - Yap_ErrorMessage = s; + LOCAL_ErrorMessage = s; return TermNil; } @@ -727,12 +727,12 @@ Yap_scan_num(IOSTREAM *inp) int ch, cherr; char *ptr; - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; LOCAL_ScannerStack = (char *)TR; LOCAL_ScannerExtraBlocks = NULL; if (!(ptr = AllocScannerMemory(4096))) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; return TermNil; } ch = getchr(inp); @@ -755,7 +755,7 @@ Yap_scan_num(IOSTREAM *inp) out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */ PopScannerMemory(ptr, 4096); Yap_clean_tokenizer(NULL, NULL, NULL); - if (Yap_ErrorMessage != NULL || ch != -1 || cherr) + if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) return TermNil; return out; } @@ -769,8 +769,8 @@ ch_to_wide(char *base, char *charp) wchar_t *nb = (wchar_t *)base; if ((nb+n) + 1024 > (wchar_t *)AuxSp) { - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; - Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; return NULL; } for (i=n; i > 0; i--) { @@ -800,11 +800,10 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) int ch; wchar_t *wcharp; - Yap_ErrorMessage = NULL; - Yap_Error_Size = 0; - Yap_VarTable = NULL; - Yap_AnonVarTable = NULL; - Yap_eot_before_eof = FALSE; + LOCAL_ErrorMessage = NULL; + LOCAL_Error_Size = 0; + LOCAL_VarTable = NULL; + LOCAL_AnonVarTable = NULL; LOCAL_ScannerStack = (char *)TR; LOCAL_ScannerExtraBlocks = NULL; l = NULL; @@ -826,8 +825,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); t->TokNext = NULL; if (t == NULL) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; if (p) p->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -855,6 +854,15 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) while (chtype(ch) == BS) { ch = getchr(inp_stream); } + if (ASP-H < 1024) { + LOCAL_ErrorMessage = "Stack Overflow"; + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = 0L; + if (p) + p->Tok = Ord(kind = eot_tok); + /* serious error now */ + return l; + } *tposp = Yap_StreamPosition(inp_stream); } goto restart; @@ -878,8 +886,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) if (charp == (char *)AuxSp-1024) { huge_var_error: /* huge atom or variable, we are in trouble */ - Yap_ErrorMessage = "Code Space Overflow due to huge atom"; - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_ErrorMessage = "Code Space Overflow due to huge atom"; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); if (p) p->Tok = Ord(kind = eot_tok); @@ -905,8 +913,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) ae = Yap_LookupAtom(TokImage); } if (ae == NIL) { - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_ErrorMessage = "Code Space Overflow"; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_ErrorMessage = "Code Space Overflow"; if (p) t->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -932,17 +940,17 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) cherr = 0; if (!(ptr = AllocScannerMemory(4096))) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; if (p) t->Tok = Ord(kind = eot_tok); /* serious error now */ return l; } if (ASP-H < 1024) { - Yap_ErrorMessage = "Stack Overflow"; - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Size = 0L; + LOCAL_ErrorMessage = "Stack Overflow"; + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = 0L; if (p) p->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -962,8 +970,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) t->TokPos = GetCurInpPos(inp_stream); e = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); if (e == NULL) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; if (p) p->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -991,8 +999,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) t->TokPos = GetCurInpPos(inp_stream); e2 = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); if (e2 == NULL) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; if (p) p->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -1022,8 +1030,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) t->TokPos = GetCurInpPos(inp_stream); e2 = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); if (e2 == NULL) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; t->Tok = Ord(kind = eot_tok); /* serious error now */ return l; @@ -1055,13 +1063,13 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) while (TRUE) { if (charp + 1024 > (char *)AuxSp) { - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; - Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; break; } if (ch == 10 && yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) { /* in ISO a new line terminates a string */ - Yap_ErrorMessage = "layout character \n inside quotes"; + LOCAL_ErrorMessage = "layout character \n inside quotes"; break; } if (ch == quote) { @@ -1088,8 +1096,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) ++len; if (charp > (char *)AuxSp - 1024) { /* Not enough space to read in the string. */ - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; - Yap_ErrorMessage = "not enough space to read in string or quoted atom"; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_ErrorMessage = "not enough space to read in string or quoted atom"; /* serious error now */ Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); @@ -1108,7 +1116,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) mp = AllocScannerMemory(len + 1); } if (mp == NULL) { - Yap_ErrorMessage = "not enough heap space to read in string or quoted atom"; + LOCAL_ErrorMessage = "not enough heap space to read in string or quoted atom"; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); return l; @@ -1131,8 +1139,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) t->TokInfo = Unsigned(Yap_LookupAtom(TokImage)); } if (!(t->TokInfo)) { - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_ErrorMessage = "Code Space Overflow"; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_ErrorMessage = "Code Space Overflow"; if (p) t->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -1162,6 +1170,15 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) while (chtype(ch) == BS) { ch = getchr(inp_stream); } + if (ASP-H < 1024) { + LOCAL_ErrorMessage = "Stack Overflow"; + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = 0L; + if (p) + p->Tok = Ord(kind = eot_tok); + /* serious error now */ + return l; + } *tposp = Yap_StreamPosition(inp_stream); } goto restart; @@ -1169,7 +1186,6 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) enter_symbol: if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || chtype(ch) == CC)) { - Yap_eot_before_eof = TRUE; if (chtype(ch) == CC) while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF); t->Tok = Ord(kind = eot_tok); @@ -1183,8 +1199,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) *charp = '\0'; t->TokInfo = Unsigned(Yap_LookupAtom(TokImage)); if (t->TokInfo == (CELL)NIL) { - Yap_Error_TYPE = OUT_OF_HEAP_ERROR; - Yap_ErrorMessage = "Code Space Overflow"; + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + LOCAL_ErrorMessage = "Code Space Overflow"; if (p) t->Tok = Ord(kind = eot_tok); /* serious error now */ @@ -1247,29 +1263,29 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) default: #ifdef DEBUG - fprintf(Yap_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch)); + fprintf(GLOBAL_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch)); #endif t->Tok = Ord(kind = eot_tok); } #ifdef DEBUG - if(Yap_Option[2]) fprintf(Yap_stderr,"[Token %d %ld]",Ord(kind),(unsigned long int)t->TokInfo); + if(GLOBAL_Option[2]) fprintf(GLOBAL_stderr,"[Token %d %ld]",Ord(kind),(unsigned long int)t->TokInfo); #endif - if (Yap_ErrorMessage) { + if (LOCAL_ErrorMessage) { /* insert an error token to inform the system of what happened */ TokEntry *e = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); if (e == NULL) { - Yap_ErrorMessage = "Trail Overflow"; - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; p->Tok = Ord(kind = eot_tok); /* serious error now */ return l; } p->TokNext = e; e->Tok = Error_tok; - e->TokInfo = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); + e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); e->TokPos = GetCurInpPos(inp_stream); e->TokNext = NULL; - Yap_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; p = e; } } while (kind != eot_tok); diff --git a/C/sort.c b/C/sort.c index 8d5f18133..0f78c6fa5 100644 --- a/C/sort.c +++ b/C/sort.c @@ -59,7 +59,7 @@ build_new_list(CELL *pt, Term t USES_REGS) pt += 2; if (pt > ASP - 4096) { if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } t = Deref(ARG1); diff --git a/C/stdpreds.c b/C/stdpreds.c index 235bc63da..9937d4f9b 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -904,8 +904,8 @@ ch_to_wide(char *base, char *charp USES_REGS) wchar_t *nb = (wchar_t *)base; if ((nb+n) + 1024 > (wchar_t *)AuxSp) { - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; - Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; return NULL; } for (i=n; i > 0; i--) { @@ -1241,7 +1241,7 @@ p_atom_chars( USES_REGS1 ) *ws++ = '\0'; while ((at = Yap_LookupWideAtom((wchar_t *)String)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1249,7 +1249,7 @@ p_atom_chars( USES_REGS1 ) *s++ = '\0'; while ((at = Yap_LookupAtom(String)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1313,7 +1313,7 @@ p_atom_concat( USES_REGS1 ) if (cptr+sz >= top-1024) { Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto restart; @@ -1340,7 +1340,7 @@ p_atom_concat( USES_REGS1 ) cptr[0] = '\0'; while ((at = Yap_LookupWideAtom(cpt0)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1376,7 +1376,7 @@ p_atom_concat( USES_REGS1 ) if (cptr+sz >= top-1024) { Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto restart; @@ -1396,7 +1396,7 @@ p_atom_concat( USES_REGS1 ) cptr[0] = '\0'; while ((at = Yap_LookupAtom(cpt0)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1460,7 +1460,7 @@ p_atomic_concat( USES_REGS1 ) if (wcptr+sz >= wtop-1024) { Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto restart; @@ -1474,7 +1474,7 @@ p_atomic_concat( USES_REGS1 ) if (wcptr+sz >= wtop-1024) { Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto restart; @@ -1517,7 +1517,7 @@ p_atomic_concat( USES_REGS1 ) if (!Yap_gmp_to_string(thead, tmp, (wtop-wcptr)-1024, 10 )) { Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } goto restart; @@ -1541,7 +1541,7 @@ p_atomic_concat( USES_REGS1 ) wcptr[0] = '\0'; while ((at = Yap_LookupWideAtom(wcpt0)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1580,7 +1580,7 @@ p_atomic_concat( USES_REGS1 ) if (cptr+sz >= top-1024) { Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } goto restart; @@ -1607,7 +1607,7 @@ p_atomic_concat( USES_REGS1 ) size_t sz = Yap_gmp_to_size(thead, 10); Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); if (!Yap_growheap(FALSE, sz+1024, NULL)) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } goto restart; @@ -1628,7 +1628,7 @@ p_atomic_concat( USES_REGS1 ) cptr[0] = '\0'; while ((at = Yap_LookupAtom(cpt0)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -2001,7 +2001,7 @@ p_number_chars( USES_REGS1 ) size_t sz = Yap_gmp_to_size(t1, 10); Yap_ReleasePreAllocCodeSpace((ADDR)String); if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } goto restart_aux; @@ -2159,7 +2159,7 @@ p_number_atom( USES_REGS1 ) while (!Yap_gmp_to_string(t1, String, ((char *)AuxSp-String)-1024, 10 )) { size_t sz = Yap_gmp_to_size(t1, 10); if (!(String = Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE))) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, t1, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, t1, LOCAL_ErrorMessage); return FALSE; } } @@ -2170,7 +2170,7 @@ p_number_atom( USES_REGS1 ) } while ((at = Yap_LookupAtom(String)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -2221,7 +2221,7 @@ p_number_codes( USES_REGS1 ) while (!Yap_gmp_to_string(t1, String, ((char *)AuxSp-String)-1024, 10 )) { size_t sz = Yap_gmp_to_size(t1, 10); if (!(String = Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE))) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, t1, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, t1, LOCAL_ErrorMessage); return FALSE; } } @@ -2318,7 +2318,7 @@ p_atom_number( USES_REGS1 ) while (!Yap_gmp_to_string(t2, String, ((char *)AuxSp-String)-1024, 10 )) { size_t sz = Yap_gmp_to_size(t2, 10); if (!(String = Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE))) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, t2, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, t2, LOCAL_ErrorMessage); return FALSE; } } @@ -2415,7 +2415,7 @@ p_univ( USES_REGS1 ) /* restore space */ H = Ar; if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } twork = TailOfTerm(Deref(ARG2)); @@ -2480,7 +2480,7 @@ p_univ( USES_REGS1 ) twork = Yap_ArrayToList(CellPtr(TR), argno - 1); while (IsIntTerm(twork)) { if (!Yap_gc(2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } twork = Yap_ArrayToList(CellPtr(TR), argno - 1); @@ -2490,7 +2490,7 @@ p_univ( USES_REGS1 ) { while (H+arity*2 > ASP-1024) { if (!Yap_gcl((arity*2)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } tin = Deref(ARG1); @@ -3135,7 +3135,7 @@ p_debug( USES_REGS1 ) int i = IntOfTerm(Deref(ARG1)); if (i >= 'a' && i <= 'z') - Yap_Option[i - 96] = !Yap_Option[i - 96]; + GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96]; return (1); } #endif @@ -3329,21 +3329,21 @@ Yap_show_statistics(void) #endif frag = (100.0*(heap_space_taken-HeapUsed))/heap_space_taken; - fprintf(Yap_stderr, "Code Space: %ld (%ld bytes needed, %ld bytes used, fragmentation %.3f%%).\n", + fprintf(GLOBAL_stderr, "Code Space: %ld (%ld bytes needed, %ld bytes used, fragmentation %.3f%%).\n", (unsigned long int)(Unsigned (H0) - Unsigned (Yap_HeapBase)), (unsigned long int)(Unsigned(HeapTop)-Unsigned(Yap_HeapBase)), (unsigned long int)(HeapUsed), frag); - fprintf(Yap_stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n", + fprintf(GLOBAL_stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n", (unsigned long int)(sizeof(CELL)*(LCL0-H0)), (unsigned long int)(sizeof(CELL)*(H-H0)), (unsigned long int)(sizeof(CELL)*(LCL0-ASP))); - fprintf(Yap_stderr, "Trail Space: %ld (%ld used).\n", - (unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(Yap_TrailTop)-Unsigned(Yap_TrailBase))), - (unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(TR)-Unsigned(Yap_TrailBase)))); - fprintf(Yap_stderr, "Runtime: %lds.\n", (unsigned long int)(runtime ( PASS_REGS1 ))); - fprintf(Yap_stderr, "Cputime: %lds.\n", (unsigned long int)(Yap_cputime ())); - fprintf(Yap_stderr, "Walltime: %lds.\n", (unsigned long int)(Yap_walltime ())); + fprintf(GLOBAL_stderr, "Trail Space: %ld (%ld used).\n", + (unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(LOCAL_TrailTop)-Unsigned(LOCAL_TrailBase))), + (unsigned long int)(sizeof(tr_fr_ptr)*(Unsigned(TR)-Unsigned(LOCAL_TrailBase)))); + fprintf(GLOBAL_stderr, "Runtime: %lds.\n", (unsigned long int)(runtime ( PASS_REGS1 ))); + fprintf(GLOBAL_stderr, "Cputime: %lds.\n", (unsigned long int)(Yap_cputime ())); + fprintf(GLOBAL_stderr, "Walltime: %lds.\n", (unsigned long int)(Yap_walltime ())); } static Int @@ -3366,12 +3366,12 @@ TrailMax(void) { CACHE_REGS Int i; - Int TrWidth = Unsigned(Yap_TrailTop) - Unsigned(Yap_TrailBase); + Int TrWidth = Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase); CELL *pt; if (TrailTide != TrWidth) { pt = (CELL *)TR; - while (pt+2 < (CELL *)Yap_TrailTop) { + while (pt+2 < (CELL *)LOCAL_TrailTop) { if (pt[0] == 0 && pt[1] == 0 && pt[2] == 0) @@ -3379,8 +3379,8 @@ TrailMax(void) else pt++; } - if (pt+2 < (CELL *)Yap_TrailTop) - i = Unsigned(pt) - Unsigned(Yap_TrailBase); + if (pt+2 < (CELL *)LOCAL_TrailTop) + i = Unsigned(pt) - Unsigned(LOCAL_TrailBase); else i = TrWidth; } else @@ -3495,12 +3495,12 @@ p_statistics_heap_info( USES_REGS1 ) #if USE_SYSTEM_MALLOC && HAVE_MALLINFO struct mallinfo mi = mallinfo(); - UInt sstack = Yap_HoleSize+(Yap_TrailTop-Yap_GlobalBase); + UInt sstack = Yap_HoleSize+(LOCAL_TrailTop-LOCAL_GlobalBase); UInt mmax = (mi.arena+mi.hblkhd); Term tmax = MkIntegerTerm(mmax-sstack); tusage = MkIntegerTerm(mmax-(mi.fordblks+sstack)); #else - Term tmax = MkIntegerTerm((Yap_GlobalBase - Yap_HeapBase)-Yap_HoleSize); + Term tmax = MkIntegerTerm((LOCAL_GlobalBase - Yap_HeapBase)-Yap_HoleSize); #endif return(Yap_unify(tmax, ARG1) && Yap_unify(tusage,ARG2)); @@ -3524,8 +3524,8 @@ p_statistics_stacks_info( USES_REGS1 ) static Int p_statistics_trail_info( USES_REGS1 ) { - Term tmax = MkIntegerTerm(Unsigned(Yap_TrailTop) - Unsigned(Yap_TrailBase)); - Term tusage = MkIntegerTerm(Unsigned(TR) - Unsigned(Yap_TrailBase)); + Term tmax = MkIntegerTerm(Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase)); + Term tusage = MkIntegerTerm(Unsigned(TR) - Unsigned(LOCAL_TrailBase)); return(Yap_unify(tmax, ARG1) && Yap_unify(tusage,ARG2)); @@ -3623,8 +3623,8 @@ mk_argc_list( USES_REGS1 ) { int i =0; Term t = TermNil; - while (i < Yap_argc) { - char *arg = Yap_argv[i]; + while (i < GLOBAL_argc) { + char *arg = GLOBAL_argv[i]; /* check for -L -- */ if (arg[0] == '-' && arg[1] == 'L') { arg += 2; @@ -3633,15 +3633,15 @@ mk_argc_list( USES_REGS1 ) if (*arg == '-' && arg[1] == '-' && arg[2] == '\0') { /* we found the separator */ int j; - for (j = Yap_argc-1; j > i+1; --j) { - t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(Yap_argv[j])),t); + for (j = GLOBAL_argc-1; j > i+1; --j) { + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])),t); } return t; - } else if (Yap_argv[i+1] && Yap_argv[i+1][0] == '-' && Yap_argv[i+1][1] == '-' && Yap_argv[i+1][2] == '\0') { + } else if (GLOBAL_argv[i+1] && GLOBAL_argv[i+1][0] == '-' && GLOBAL_argv[i+1][1] == '-' && GLOBAL_argv[i+1][2] == '\0') { /* we found the separator */ int j; - for (j = Yap_argc-1; j > i+2; --j) { - t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(Yap_argv[j])),t); + for (j = GLOBAL_argc-1; j > i+2; --j) { + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])),t); } return t; } @@ -3649,8 +3649,8 @@ mk_argc_list( USES_REGS1 ) if (arg[0] == '-' && arg[1] == '-' && arg[2] == '\0') { /* we found the separator */ int j; - for (j = Yap_argc-1; j > i; --j) { - t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(Yap_argv[j])),t); + for (j = GLOBAL_argc-1; j > i; --j) { + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])),t); } return(t); } @@ -3670,8 +3670,8 @@ static Int p_executable( USES_REGS1 ) { - Yap_TrueFileName (Yap_argv[0], Yap_FileNameBuf, FALSE); - return Yap_unify(MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)),ARG1); + Yap_TrueFileName (GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE); + return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)),ARG1); } static Int @@ -3904,9 +3904,9 @@ p_system_mode( USES_REGS1 ) { Int i = IntegerOfTerm(Deref(ARG1)); if (i == 0) - Yap_PrologMode &= ~SystemMode; + LOCAL_PrologMode &= ~SystemMode; else - Yap_PrologMode |= SystemMode; + LOCAL_PrologMode |= SystemMode; return TRUE; } @@ -4110,7 +4110,7 @@ Proc E_Modules[]= {/* init_fc,*/ (Proc) 0 }; #ifndef YAPOR static -Int p_yapor_threads(void) { +Int p_yapor_threads( USES_REGS1 ) { return FALSE; } #endif diff --git a/C/sysbits.c b/C/sysbits.c index 6a0f95aca..0912cd079 100755 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -88,7 +88,7 @@ static char SccsId[] = "%W% %G%"; #include #endif -STATIC_PROTO (void InitPageSize, (void)); + STATIC_PROTO (void InitTime, (void)); STATIC_PROTO (void InitWTime, (void)); STATIC_PROTO (Int p_sh, ( USES_REGS1 )); @@ -107,9 +107,6 @@ STATIC_PROTO (int chdir, (char *)); /* #define signal skel_signal */ #endif /* MACYAP */ -#if __simplescalar__ -char yap_pwd[YAP_FILENAME_MAX]; -#endif STD_PROTO (void exit, (int)); @@ -202,27 +199,27 @@ Yap_InitSysPath(void) { if (dir_done && commons_done) return; #endif - strncpy(Yap_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX); + strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX); #if _MSC_VER || defined(__MINGW32__) { DWORD fatts; int buflen; char *pt; - if ((fatts = GetFileAttributes(Yap_FileNameBuf)) == 0xFFFFFFFFL || + if ((fatts = GetFileAttributes(LOCAL_FileNameBuf)) == 0xFFFFFFFFL || !(fatts & FILE_ATTRIBUTE_DIRECTORY)) { /* couldn't find it where it was supposed to be, let's try using the executable */ - if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, Yap_FileNameBuf, YAP_FILENAME_MAX)) { + if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) { Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name"); /* do nothing */ return; } - buflen = strlen(Yap_FileNameBuf); - pt = Yap_FileNameBuf+strlen(Yap_FileNameBuf); + buflen = strlen(LOCAL_FileNameBuf); + pt = LOCAL_FileNameBuf+strlen(LOCAL_FileNameBuf); while (*--pt != '\\') { /* skip executable */ - if (pt == Yap_FileNameBuf) { + if (pt == LOCAL_FileNameBuf) { Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name"); /* do nothing */ return; @@ -230,7 +227,7 @@ Yap_InitSysPath(void) { } while (*--pt != '\\') { /* skip parent directory "bin\\" */ - if (pt == Yap_FileNameBuf) { + if (pt == LOCAL_FileNameBuf) { Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name"); /* do nothing */ } @@ -238,34 +235,34 @@ Yap_InitSysPath(void) { /* now, this is a possible location for the ROOT_DIR, let's look for a share directory here */ pt[1] = '\0'; /* grosse */ - strncat(Yap_FileNameBuf,"lib\\Yap",YAP_FILENAME_MAX); - libdir = Yap_AllocCodeSpace(strlen(Yap_FileNameBuf)+1); - strncpy(libdir, Yap_FileNameBuf, strlen(Yap_FileNameBuf)+1); + strncat(LOCAL_FileNameBuf,"lib\\Yap",YAP_FILENAME_MAX); + libdir = Yap_AllocCodeSpace(strlen(LOCAL_FileNameBuf)+1); + strncpy(libdir, LOCAL_FileNameBuf, strlen(LOCAL_FileNameBuf)+1); pt[1] = '\0'; - strncat(Yap_FileNameBuf,"share",YAP_FILENAME_MAX); + strncat(LOCAL_FileNameBuf,"share",YAP_FILENAME_MAX); } } - strncat(Yap_FileNameBuf,"\\", YAP_FILENAME_MAX); + strncat(LOCAL_FileNameBuf,"\\", YAP_FILENAME_MAX); #else - strncat(Yap_FileNameBuf,"/", YAP_FILENAME_MAX); + strncat(LOCAL_FileNameBuf,"/", YAP_FILENAME_MAX); #endif - len = strlen(Yap_FileNameBuf); - strncat(Yap_FileNameBuf, "Yap", YAP_FILENAME_MAX); + len = strlen(LOCAL_FileNameBuf); + strncat(LOCAL_FileNameBuf, "Yap", YAP_FILENAME_MAX); #if _MSC_VER || defined(__MINGW32__) if (!dir_done) #endif { Yap_PutValue(AtomSystemLibraryDir, - MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf))); + MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); } #if _MSC_VER || defined(__MINGW32__) if (!commons_done) #endif { - Yap_FileNameBuf[len] = '\0'; - strncat(Yap_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX); + LOCAL_FileNameBuf[len] = '\0'; + strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX); Yap_PutValue(AtomPrologCommonsDir, - MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf))); + MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); } } @@ -287,8 +284,8 @@ p_dir_sp ( USES_REGS1 ) } -static void -InitPageSize(void) +void +Yap_InitPageSize(void) { #ifdef _WIN32 SYSTEM_INFO si; @@ -1197,7 +1194,7 @@ HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap) sip->si_code != SI_NOINFO && sip->si_code == SEGV_MAPERR && (void *)(sip->si_addr) > (void *)(Yap_HeapBase) && - (void *)(sip->si_addr) < (void *)(Yap_TrailTop+K64)) { + (void *)(sip->si_addr) < (void *)(LOCAL_TrailTop+K64)) { Yap_growtrail(K64, TRUE); } else #endif @@ -1211,6 +1208,7 @@ HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap) static void HandleMatherr(int sig, siginfo_t *sip, ucontext_t *uap) { + CACHE_REGS yap_error_number error_no; /* reset the registers so that we don't have trash in abstract machine */ @@ -1308,6 +1306,7 @@ STATIC_PROTO (void my_signal, (int, void (*)(int))); static RETSIGTYPE HandleMatherr(int sig) { + CACHE_REGS #if HAVE_FETESTEXCEPT /* This should work in Linux, but it doesn't seem to. */ @@ -1315,19 +1314,19 @@ HandleMatherr(int sig) int raised = fetestexcept(FE_ALL_EXCEPT); if (raised & FE_OVERFLOW) { - Yap_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW; + LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW; } else if (raised & (FE_INVALID|FE_INEXACT)) { - Yap_matherror = EVALUATION_ERROR_UNDEFINED; + LOCAL_matherror = EVALUATION_ERROR_UNDEFINED; } else if (raised & FE_DIVBYZERO) { - Yap_matherror = EVALUATION_ERROR_ZERO_DIVISOR; + LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR; } else if (raised & FE_UNDERFLOW) { - Yap_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW; + LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW; } else #endif - Yap_matherror = EVALUATION_ERROR_UNDEFINED; + LOCAL_matherror = EVALUATION_ERROR_UNDEFINED; /* something very bad happened on the way to the forum */ set_fpu_exceptions(FALSE); - Yap_Error(Yap_matherror, TermNil, ""); + Yap_Error(LOCAL_matherror , TermNil, ""); } #if HAVE_SIGSEGV && !defined(THREADS) @@ -1358,8 +1357,8 @@ SearchForTrailFault(siginfo_t *siginfo) crash again */ #if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC - if ((ptr > (void *)Yap_TrailTop-1024 && - TR < (tr_fr_ptr) Yap_TrailTop+(64*1024))) { + if ((ptr > (void *)LOCAL_TrailTop-1024 && + TR < (tr_fr_ptr) LOCAL_TrailTop+(64*1024))) { if (!Yap_growtrail(64*1024, TRUE)) { Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", K64); } @@ -1376,8 +1375,8 @@ SearchForTrailFault(siginfo_t *siginfo) static RETSIGTYPE HandleSIGSEGV(int sig, siginfo_t *siginfo, void *context) { - if (Yap_PrologMode & ExtendStackMode) { - Yap_Error(FATAL_ERROR, TermNil, "OS memory allocation crashed at address %p, bailing out\n",Yap_TrailTop); + if (LOCAL_PrologMode & ExtendStackMode) { + Yap_Error(FATAL_ERROR, TermNil, "OS memory allocation crashed at address %p, bailing out\n",LOCAL_TrailTop); } SearchForTrailFault(siginfo); } @@ -1445,19 +1444,19 @@ HandleMatherr(int sig) int raised = fetestexcept(FE_ALL_EXCEPT); if (raised & FE_OVERFLOW) { - Yap_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW; + LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW; } else if (raised & (FE_INVALID|FE_INEXACT)) { - Yap_matherror = EVALUATION_ERROR_UNDEFINED; + LOCAL_matherror = EVALUATION_ERROR_UNDEFINED; } else if (raised & FE_DIVBYZERO) { - Yap_matherror = EVALUATION_ERROR_ZERO_DIVISOR; + LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR; } else if (raised & FE_UNDERFLOW) { - Yap_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW; + LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW; } else #endif - Yap_matherror = EVALUATION_ERROR_UNDEFINED; + LOCAL_matherror = EVALUATION_ERROR_UNDEFINED; /* something very bad happened on the way to the forum */ set_fpu_exceptions(FALSE); - Yap_Error(Yap_matherror, TermNil, ""); + Yap_Error(LOCAL_matherror , TermNil, ""); } static void @@ -1472,11 +1471,11 @@ SearchForTrailFault(void) /* fprintf(stderr,"Catching a sigsegv at %p with %p\n", TR, TrailTop); */ #endif #if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC - if ((TR > (tr_fr_ptr)Yap_TrailTop-1024 && - TR < (tr_fr_ptr)Yap_TrailTop+(64*1024))|| Yap_DBTrailOverflow()) { + if ((TR > (tr_fr_ptr)LOCAL_TrailTop-1024 && + TR < (tr_fr_ptr)LOCAL_TrailTop+(64*1024))|| Yap_DBTrailOverflow()) { long trsize = K64; - while ((CELL)TR > (CELL)Yap_TrailTop+trsize) { + while ((CELL)TR > (CELL)LOCAL_TrailTop+trsize) { trsize += K64; } if (!Yap_growtrail(trsize, TRUE)) { @@ -1493,9 +1492,9 @@ SearchForTrailFault(void) static RETSIGTYPE HandleSIGSEGV(int sig) { - if (Yap_PrologMode & ExtendStackMode) { + if (LOCAL_PrologMode & ExtendStackMode) { CACHE_REGS - Yap_Error(FATAL_ERROR, TermNil, "OS memory allocation crashed at address %p, bailing out\n",Yap_TrailTop); + Yap_Error(FATAL_ERROR, TermNil, "OS memory allocation crashed at address %p, bailing out\n",LOCAL_TrailTop); } SearchForTrailFault(); } @@ -1554,71 +1553,71 @@ void (*handler)(int); static int InteractSIGINT(int ch) { CACHE_REGS - Yap_PrologMode |= AsyncIntMode; + LOCAL_PrologMode |= AsyncIntMode; switch (ch) { case 'a': /* abort computation */ - if (Yap_PrologMode & (GCMode|ConsoleGetcMode|GrowStackMode|GrowHeapMode)) { - Yap_PrologMode |= AbortMode; + if (LOCAL_PrologMode & (GCMode|ConsoleGetcMode|GrowStackMode|GrowHeapMode)) { + LOCAL_PrologMode |= AbortMode; } else { Yap_Error(PURE_ABORT, TermNil, "abort from console"); /* in case someone mangles the P register */ } - Yap_PrologMode &= ~AsyncIntMode; - siglongjmp(Yap_RestartEnv,1); + LOCAL_PrologMode &= ~AsyncIntMode; + siglongjmp(LOCAL_RestartEnv,1); return -1; case 'b': /* continue */ Yap_signal (YAP_BREAK_SIGNAL); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; return 1; case 'c': /* continue */ return 1; case 'd': Yap_signal (YAP_DEBUG_SIGNAL); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; /* enter debug mode */ return 1; case 'e': /* exit */ - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; Yap_exit(0); return -1; case 'g': /* exit */ Yap_signal (YAP_STACK_DUMP_SIGNAL); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; return -1; case 't': /* start tracing */ Yap_signal (YAP_TRACE_SIGNAL); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; return 1; #ifdef LOW_LEVEL_TRACER case 'T': toggle_low_level_trace(); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; return 1; #endif case 's': /* show some statistics */ Yap_signal (YAP_STATISTICS_SIGNAL); - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; return 1; case EOF: - Yap_PrologMode &= ~AsyncIntMode; + LOCAL_PrologMode &= ~AsyncIntMode; return(0); break; case 'h': case '?': default: /* show an helpful message */ - fprintf(Yap_stderr, "Please press one of:\n"); - fprintf(Yap_stderr, " a for abort\n c for continue\n d for debug\n"); - fprintf(Yap_stderr, " e for exit\n g for stack dump\n s for statistics\n t for trace\n"); - fprintf(Yap_stderr, " b for break\n"); - Yap_PrologMode &= ~AsyncIntMode; + fprintf(GLOBAL_stderr, "Please press one of:\n"); + fprintf(GLOBAL_stderr, " a for abort\n c for continue\n d for debug\n"); + fprintf(GLOBAL_stderr, " e for exit\n g for stack dump\n s for statistics\n t for trace\n"); + fprintf(GLOBAL_stderr, " b for break\n"); + LOCAL_PrologMode &= ~AsyncIntMode; return(0); } } @@ -1666,7 +1665,7 @@ HandleSIGINT (int sig) my_signal(SIGINT, HandleSIGINT); /* do this before we act */ #if HAVE_ISATTY - if (!isatty(0) && !Yap_sockets_io) { + if (!isatty(0)) { Yap_Error(INTERRUPT_ERROR,MkIntTerm(SIGINT),NULL); return; } @@ -1674,8 +1673,8 @@ HandleSIGINT (int sig) if (LOCAL_InterruptsDisabled) { return; } - if (Yap_PrologMode & (CritMode|ConsoleGetcMode)) { - Yap_PrologMode |= InterruptMode; + if (LOCAL_PrologMode & (CritMode|ConsoleGetcMode)) { + LOCAL_PrologMode |= InterruptMode; } #ifdef HAVE_SETBUF /* make sure we are not waiting for the end of line */ @@ -1777,7 +1776,7 @@ ReceiveSignal (int s) break; #endif /* defined(SIGHUP) */ default: - fprintf(Yap_stderr, "\n[ Unexpected signal ]\n"); + fprintf(GLOBAL_stderr, "\n[ Unexpected signal ]\n"); exit (EXIT_FAILURE); } } @@ -1793,7 +1792,7 @@ MSCHandleSignal(DWORD dwCtrlType) { case CTRL_C_EVENT: case CTRL_BREAK_EVENT: Yap_signal(YAP_ALARM_SIGNAL); - Yap_PrologMode |= InterruptMode; + LOCAL_PrologMode |= InterruptMode; return(TRUE); default: return(FALSE); @@ -1805,7 +1804,7 @@ MSCHandleSignal(DWORD dwCtrlType) { static void InitSignals (void) { - if (Yap_PrologShouldHandleInterrupts) { + if (GLOBAL_PrologShouldHandleInterrupts) { #if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT) my_signal (SIGQUIT, ReceiveSignal); my_signal (SIGKILL, ReceiveSignal); @@ -1878,7 +1877,7 @@ int Yap_getcwd(const char *buf, int len) CACHE_REGS #if __simplescalar__ /* does not implement getcwd */ - strncpy(Yap_buf,yap_pwd,len); + strncpy(Yap_buf,GLOBAL_pwd,len); #elif HAVE_GETCWD if (getcwd ((char *)buf, len) == NULL) { #if HAVE_STRERROR @@ -2007,7 +2006,7 @@ TrueFileName (char *source, char *root, char *result, int in_lib) if ((tmpf = open(ares1, O_RDONLY)) < 0) { /* not in current directory, let us try the library */ if (Yap_LibDir != NULL) { - strncpy(Yap_FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX); + strncpy(LOCAL_FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX); #if HAVE_GETENV } else { char *yap_env = getenv("YAPLIBDIR"); @@ -2105,8 +2104,8 @@ p_true_file_name ( USES_REGS1 ) Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name"); return FALSE; } - TrueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, Yap_FileNameBuf, FALSE); - return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf))); + TrueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, LOCAL_FileNameBuf, FALSE); + return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); } static Int @@ -2130,8 +2129,8 @@ p_true_file_name3 ( USES_REGS1 ) } root = RepAtom(AtomOfTerm(t2))->StrOfAE; } - TrueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, root, Yap_FileNameBuf, FALSE); - return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf))); + TrueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, root, LOCAL_FileNameBuf, FALSE); + return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); } /* Executes $SHELL under Prolog */ @@ -2239,11 +2238,11 @@ p_system ( USES_REGS1 ) } else if (IsAtomTerm(t1)) { s = RepAtom(AtomOfTerm(t1))->StrOfAE; } else { - if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) { + if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) { Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1"); return FALSE; } - s = Yap_FileNameBuf; + s = LOCAL_FileNameBuf; } /* Yap_CloseStreams(TRUE); */ #if _MSC_VER @@ -2397,7 +2396,7 @@ static Int p_putenv( USES_REGS1 ) } else s2 = RepAtom(AtomOfTerm(t2))->StrOfAE; while (!(p0 = p = Yap_AllocAtomSpace(strlen(s)+strlen(s2)+3))) { if (!Yap_growheap(FALSE, MinHeapGap, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -2730,10 +2729,9 @@ Yap_InitSysbits (void) #if __simplescalar__ { char *pwd = getenv("PWD"); - strncpy(yap_pwd,pwd,YAP_FILENAME_MAX); + strncpy(GLOBAL_pwd,pwd,YAP_FILENAME_MAX); } #endif - InitPageSize(); InitWTime (); InitRandom (); /* let the caller control signals as it sees fit */ diff --git a/C/threads.c b/C/threads.c index 1acbb645a..cd6955685 100755 --- a/C/threads.c +++ b/C/threads.c @@ -212,17 +212,17 @@ thread_run(void *widp) do { t = tgs[0] = Yap_PopTermFromDB(LOCAL_ThreadHandle.tgoal); if (t == 0) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); thread_die(worker_id, FALSE); return NULL; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(LOCAL_ThreadHandle.tgoal->NOfCells*CellSize)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); thread_die(worker_id, FALSE); return NULL; } @@ -405,7 +405,7 @@ Yap_thread_create_engine(thread_attr *ops) ops->sysize = 0; ops->egoal = t; } - if (pthread_self() != Yap_master_thread) { + if (pthread_self() != GLOBAL_master_thread) { /* we are worker_id 0 for now, lock master thread so that no one messes with us */ pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs); pthread_mutex_lock(&(REMOTE_ThreadHandle(0).tlock)); @@ -416,7 +416,7 @@ Yap_thread_create_engine(thread_attr *ops) REMOTE_ThreadHandle(new_id).id = new_id; REMOTE_ThreadHandle(new_id).ref_count = 0; setup_engine(new_id, FALSE); - if (pthread_self() != Yap_master_thread) { + if (pthread_self() != GLOBAL_master_thread) { pthread_setspecific(Yap_yaamregs_key, NULL); pthread_mutex_unlock(&(REMOTE_ThreadHandle(0).tlock)); } @@ -773,17 +773,17 @@ p_thread_atexit( USES_REGS1 ) t = Yap_PopTermFromDB(LOCAL_ThreadHandle.texit); LOCAL_ThreadHandle.texit = NULL; if (t == 0) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); thread_die(worker_id, FALSE); return FALSE; } } else { - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_growstack(LOCAL_ThreadHandle.tgoal->NOfCells*CellSize)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); thread_die(worker_id, FALSE); return FALSE; } diff --git a/C/tracer.c b/C/tracer.c index 527d540e6..36f0094b1 100755 --- a/C/tracer.c +++ b/C/tracer.c @@ -28,12 +28,12 @@ STATIC_PROTO(int TracePutchar, (int, int)); STATIC_PROTO(void send_tracer_message, (char *, char *, Int, char *, CELL *)); -static int do_trace_primitives = TRUE; + static int TracePutchar(int sno, int ch) { - return(putc(ch, Yap_stderr)); /* use standard error stream, which is supposed to be 2*/ + return(putc(ch, GLOBAL_stderr)); /* use standard error stream, which is supposed to be 2*/ } static void @@ -42,24 +42,24 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args) CACHE_REGS if (name == NULL) { #ifdef YAPOR - fprintf(Yap_stderr, "(%d)%s", worker_id, start); + fprintf(GLOBAL_stderr, "(%d)%s", worker_id, start); #else - fprintf(Yap_stderr, "%s", start); + fprintf(GLOBAL_stderr, "%s", start); #endif } else { int i; if (arity) { if (args) - fprintf(Yap_stderr, "%s %s:%s(", start, mname, name); + fprintf(GLOBAL_stderr, "%s %s:%s(", start, mname, name); else - fprintf(Yap_stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity); + fprintf(GLOBAL_stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity); } else { - fprintf(Yap_stderr, "%s %s:%s", start, mname, name); + fprintf(GLOBAL_stderr, "%s %s:%s", start, mname, name); } if (args) { for (i= 0; i < arity; i++) { - if (i > 0) fprintf(Yap_stderr, ","); + if (i > 0) fprintf(GLOBAL_stderr, ","); #if DEBUG #if COROUTINING Yap_Portray_delays = TRUE; @@ -73,11 +73,11 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args) #endif } if (arity) { - fprintf(Yap_stderr, ")"); + fprintf(GLOBAL_stderr, ")"); } } } - fprintf(Yap_stderr, "\n"); + fprintf(GLOBAL_stderr, "\n"); } #if defined(__GNUC__) @@ -94,7 +94,7 @@ static int thread_trace; static int check_trail_consistency(void) { tr_fr_ptr ptr = TR; - while (ptr > (CELL *)Yap_TrailBase) { + while (ptr > (CELL *)LOCAL_TrailBase) { ptr = --ptr; if (!IsVarTerm(TrailTerm(ptr))) { if (IsApplTerm(TrailTerm(ptr))) { @@ -186,7 +186,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) } else return; { - tr_fr_ptr pt = (tr_fr_ptr)Yap_TrailBase; + tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase; if (pt[140].term == 0 && pt[140].value != 0) jmp_deb(1); } @@ -235,7 +235,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) if (TR_FZ > TR) jmp_deb(1); { - tr_fr_ptr pt = (tr_fr_ptr)Yap_TrailBase; + tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase; if (pt[153].term == 0 && pt[153].value == 0 && pt[154].term != 0 && pt[154].value != 0 && ( TR > pt+154 || TR_FZ > pt+154)) @@ -293,16 +293,16 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) printf("\n"); } #endif - fprintf(Yap_stderr,"%lld ",vsc_count); + fprintf(GLOBAL_stderr,"%lld ",vsc_count); #if defined(THREADS) || defined(YAPOR) - fprintf(Yap_stderr,"(%d)", worker_id); + fprintf(GLOBAL_stderr,"(%d)", worker_id); #endif /* check_trail_consistency(); */ if (pred == NULL) { UNLOCK(Yap_heap_regs->low_level_trace_lock); return; } - if (pred->ModuleOfPred == 0 && !do_trace_primitives) { + if (pred->ModuleOfPred == 0 && !LOCAL_do_trace_primitives) { UNLOCK(Yap_heap_regs->low_level_trace_lock); return; } @@ -425,7 +425,7 @@ static Int p_start_low_level_trace2( USES_REGS1 ) static Int p_stop_low_level_trace( USES_REGS1 ) { Yap_do_low_level_trace = FALSE; - do_trace_primitives = TRUE; + LOCAL_do_trace_primitives = TRUE; return(TRUE); } diff --git a/C/utilpreds.c b/C/utilpreds.c index 8684cc32c..37f763193 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -244,7 +244,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL new; bp = to_visit; - if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { goto overflow; } to_visit = bp; @@ -255,7 +255,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, #endif /* first time we met this term */ RESET_VARIABLE(ptf); - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; @@ -355,7 +355,7 @@ trail_overflow: } #endif reset_trail(TR0); - Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; } @@ -368,7 +368,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) switch(res) { case -1: if (!Yap_gcl((ASP-H)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } return Deref(XREGS[arity+1]); @@ -376,19 +376,19 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) return Deref(XREGS[arity+1]); case -3: { - UInt size = Yap_Error_Size; - Yap_Error_Size = 0L; + UInt size = LOCAL_Error_Size; + LOCAL_Error_Size = 0L; if (size > 4*1024*1024) size = 4*1024*1024; if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) { - Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } return Deref(XREGS[arity+1]); case -4: if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), FALSE)) { - Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } return Deref(XREGS[arity+1]); @@ -751,7 +751,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE } #endif reset_trail(TR0); - Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; } @@ -1066,7 +1066,7 @@ restore_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, } #endif reset_trail(TR0); - Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; } @@ -1400,7 +1400,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, CELL new; bp = to_visit; - if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { goto overflow; } to_visit = bp; @@ -1411,7 +1411,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, #endif /* first time we met this term */ *ptf = (CELL)CellDifH(ptf,HLow); - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; @@ -1501,7 +1501,7 @@ trail_overflow: } #endif reset_trail(TR0); - Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; } @@ -1749,7 +1749,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter H += 2; H[-2] = (CELL)ptd0; /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; @@ -1796,15 +1796,15 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; - Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; return 0L; aux_overflow: - Yap_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -1812,7 +1812,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; @@ -1829,8 +1829,8 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Size = (ASP-H)*sizeof(CELL); + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = (ASP-H)*sizeof(CELL); return 0L; } @@ -1838,11 +1838,11 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter static int expand_vts( USES_REGS1 ) { - UInt expand = Yap_Error_Size; - yap_error_number yap_errno = Yap_Error_TYPE; + UInt expand = LOCAL_Error_Size; + yap_error_number yap_errno = LOCAL_Error_TYPE; - Yap_Error_Size = 0; - Yap_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_Size = 0; + LOCAL_Error_TYPE = YAP_NO_ERROR; if (yap_errno == OUT_OF_TRAIL_ERROR) { /* Trail overflow */ if (!Yap_growtrail(expand, FALSE)) { @@ -1881,7 +1881,7 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ *ptr = TermFoundVar; TrailTerm(TR++) = t; count++; - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { clean_tr(TR-count PASS_REGS); if (!Yap_growtrail(count*sizeof(tr_fr_ptr *), FALSE)) { return FALSE; @@ -2032,7 +2032,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, /* do or pt2 are unbound */ *ptd0 = TermNil; /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; @@ -2106,15 +2106,15 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; - Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; return 0L; aux_overflow: - Yap_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2122,7 +2122,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; @@ -2139,8 +2139,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Size = (ASP-H)*sizeof(CELL); + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = (ASP-H)*sizeof(CELL); return 0L; } @@ -2225,7 +2225,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; TrailTerm(TR++) = t; - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; } @@ -2338,15 +2338,15 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; - Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; return 0L; aux_overflow: - Yap_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2354,7 +2354,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; @@ -2371,8 +2371,8 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Size = (ASP-H)*sizeof(CELL); + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = (ASP-H)*sizeof(CELL); return 0L; } @@ -2422,7 +2422,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; TrailTerm(TR++) = t; - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; } @@ -2503,7 +2503,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, H += 2; H[-2] = (CELL)ptd0; /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; @@ -2543,15 +2543,15 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; - Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; return 0L; aux_overflow: - Yap_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2559,7 +2559,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *pt0 = (CELL)to_visit[2]; } #endif - Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; @@ -2576,8 +2576,8 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); H = InitialH; - Yap_Error_TYPE = OUT_OF_STACK_ERROR; - Yap_Error_Size = (ASP-H)*sizeof(CELL); + LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; + LOCAL_Error_Size = (ASP-H)*sizeof(CELL); return 0L; } diff --git a/C/write.c b/C/write.c index ea0710ed4..0e70abf69 100755 --- a/C/write.c +++ b/C/write.c @@ -149,7 +149,7 @@ ensure_space(size_t sz) { } if (!s) { s = (char *)TR; - while (s+sz >= Yap_TrailTop) { + while (s+sz >= LOCAL_TrailTop) { if (!Yap_growtrail(sz/sizeof(CELL), FALSE)) { s = NULL; break; diff --git a/H/Regs.h b/H/Regs.h index 54ac3c30e..ee9ccb7ed 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -208,7 +208,6 @@ extern REGSTORE Yap_REGS; #define MinTrailGap (sizeof(CELL)*1024) #define MinHeapGap (sizeof(CELL)*4096) #define MinStackGap (sizeof(CELL)*8*1024) -extern int Yap_stack_overflows; #define ENV Yap_REGS.ENV_ /* current environment */ diff --git a/H/ScannerTypes.h b/H/ScannerTypes.h new file mode 100644 index 000000000..6665b3279 --- /dev/null +++ b/H/ScannerTypes.h @@ -0,0 +1,28 @@ +typedef enum TokenKinds { + Name_tok, + Number_tok, + Var_tok, + String_tok, + WString_tok, + Ponctuation_tok, + Error_tok, + eot_tok +} tkinds; + +typedef struct TOKEN { + enum TokenKinds Tok; + Term TokInfo; + int TokPos; + struct TOKEN *TokNext; +} TokEntry; + +#define Ord(X) ((enum TokenKinds) (X)) + +#define NextToken GNextToken( PASS_REGS1 ) + +typedef struct VARSTRUCT { + Term VarAdr; + CELL hv; + struct VARSTRUCT *VarLeft, *VarRight; + char VarRep[1]; +} VarEntry; diff --git a/H/TermExt.h b/H/TermExt.h index 1f7d7f2a2..4a9d46a2e 100755 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -136,8 +136,7 @@ typedef enum exts; -/* array with the ops for your favourite extensions */ -extern ext_op attas[attvars_ext + 1]; + #endif diff --git a/H/Yap.h b/H/Yap.h index 3fc639f03..cf0bbb445 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -45,11 +45,8 @@ /* #define RATIONAL_TREES 1 - #define DEPTH_LIMIT 1 - #define COROUTINING 1 - #define ANALYST 1 */ @@ -73,52 +70,47 @@ #define USE_SYSTEM_MALLOC 1 #endif /* THREADS || SUPPORT_CONDOR */ -#ifdef ANALYST -#ifdef USE_THREADED_CODE +#if defined(ANALYST) && defined(USE_THREADED_CODE) #undef USE_THREADED_CODE -#endif -#endif +#endif /* ANALYST && USE_THREADED_CODE */ -#ifdef COROUTINING -#ifndef TERM_EXTENSIONS +#if defined(COROUTINING) && !defined(TERM_EXTENSIONS) #define TERM_EXTENSIONS 1 -#endif -#endif +#endif /* COROUTINING && !TERM_EXTENSIONS */ -#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ -/* adjust a config.h from mingw32 to work with vc++ */ +/* Microsoft's Visual C++ Compiler */ +#ifdef _MSC_VER /* adjust a config.h from mingw32 to work with vc++ */ #ifdef HAVE_GCC -#undef HAVE_GCC -#endif +#undef HAVE_GCC +#endif /* HAVE_GCC */ #ifdef USE_THREADED_CODE #undef USE_THREADED_CODE -#endif +#endif /* USE_THREADED_CODE */ #define inline __inline #define YAP_VERSION "YAP-6.3.0" - #define BIN_DIR "c:\\Yap\\bin" #define LIB_DIR "c:\\Yap\\lib\\Yap" #define SHARE_DIR "c:\\Yap\\share\\Yap" -#ifdef HOST_ALIAS -#undef HOST_ALIAS -#endif +#ifdef HOST_ALIAS +#undef HOST_ALIAS +#endif /* HOST_ALIAS */ #define HOST_ALIAS "i386-pc-win32" -#ifdef HAVE_IEEEFP_H -#undef HAVE_IEEEFP_H -#endif -#ifdef HAVE_UNISTD_H -#undef HAVE_UNISTD_H -#endif -#ifdef HAVE_SYS_TIME_H -#undef HAVE_SYS_TIME_H -#endif -#endif +#ifdef HAVE_IEEEFP_H +#undef HAVE_IEEEFP_H +#endif /* HAVE_IEEEFP_H */ +#ifdef HAVE_UNISTD_H +#undef HAVE_UNISTD_H +#endif /* HAVE_UNISTD_H */ +#ifdef HAVE_SYS_TIME_H +#undef HAVE_SYS_TIME_H +#endif /* HAVE_SYS_TIME_H */ +#endif /* _MSC_VER */ #ifdef __MINGW32__ #ifndef _WIN32 #define _WIN32 1 -#endif -#endif +#endif /* _WIN32 */ +#endif /* __MINGW32__ */ #if HAVE_GCC #define MIN_ARRAY 0 @@ -126,35 +118,36 @@ #else #define MIN_ARRAY 1 #define DUMMY_FILLER_FOR_ABS_TYPE int dummy; -#endif +#endif /* HAVE_GCC */ #ifndef ADTDEFS_C #define EXTERN static #else #define EXTERN -#endif +#endif /* ADTDEFS_C */ -/* truth-values */ +/* truth-values */ #define TRUE 1 #define FALSE 0 -/* null pointer */ + +/* null pointer */ #define NIL 0 + /* Basic types */ /* defines integer types Int and UInt (unsigned) with the same size as a ptr -** and integer types Short and UShort with half the size of a ptr -*/ +** and integer types Short and UShort with half the size of a ptr */ #ifdef THREADS #if USE_PTHREAD_LOCKING #ifndef _XOPEN_SOURCE #define _XOPEN_SOURCE 600 -#endif -#endif +#endif /* !_XOPEN_SOURCE */ +#endif /* USE_PTHREAD_LOCKING */ #include -#endif +#endif /* THREADS */ #if SIZEOF_INT_P==4 @@ -173,7 +166,7 @@ #define UInt_FORMAT "%lu" #else -# error Yap require integer types of the same size as a pointer +#error Yap require integer types of the same size as a pointer #endif #if SIZEOF_SHORT_INT==2 @@ -249,16 +242,13 @@ typedef unsigned long int YAP_ULONG_LONG; #define LOW_PROF 1 #endif -#ifdef DEBUG -extern char Yap_Option[20]; -#endif /* #define FORCE_SECOND_QUADRANT 1 */ #if defined(FORCE_SECOND_QUADRANT) #define IN_SECOND_QUADRANT 1 #define MMAP_ADDR 0x42000000 -#endif +#endif /* FORCE_SECOND_QUADRANT */ #if !defined(IN_SECOND_QUADRANT) #if defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(mips) || defined(__APPLE__) || defined(__DragonFly__) @@ -276,10 +266,10 @@ extern char Yap_Option[20]; #define MMAP_ADDR 0x20000000 #else #define MMAP_ADDR 0x10000000 -#endif +#endif /* YAPOR && __alpha */ #elif __svr4__ || defined(__SVR4) #define MMAP_ADDR 0x02000000 -#endif +#endif /* __linux__ || __FreeBSD__ || __NetBSD__ || mips || __APPLE__ || __DragonFly__ */ #endif /* !IN_SECOND_QUADRANT */ /* #define RANDOMIZE_START_ADDRESS 1 */ @@ -287,15 +277,15 @@ extern char Yap_Option[20]; #ifdef USE_SYSTEM_MALLOC #define HEAP_INIT_BASE 0L #define AtomBase NULL -#else +#else /* !USE_SYSTEM_MALLOC */ #if defined(MMAP_ADDR) && (defined(USE_MMAP) || USE_SHMAT) && !defined(__simplescalar__) && !defined(RANDOMIZE_START_ADDRESS) #define HEAP_INIT_BASE (MMAP_ADDR) #define AtomBase ((char *)MMAP_ADDR) -#else +#else /*! (MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && !RANDOMIZE_START_ADDRESS) */ #define HEAP_INIT_BASE ((CELL)Yap_HeapBase) #define AtomBase (Yap_HeapBase) -#endif -#endif +#endif /* MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && !RANDOMIZE_START_ADDRESS */ +#endif /* USE_SYSTEM_MALLOC */ @@ -315,7 +305,9 @@ extern char Yap_Option[20]; #define M1 ((CELL)(1024*1024)) #define M2 ((CELL)(2048*1024)) -/* basic data types */ +/************************************************************************************************* + basic data types +*************************************************************************************************/ typedef UInt CELL; typedef UShort BITS16; @@ -336,7 +328,9 @@ typedef unsigned char *CODEADDR; #define CellSize sizeof(CELL) #define SmallSize sizeof(SMALLUNSGN) -/* type casting macros */ +/************************************************************************************************* + type casting macros +*************************************************************************************************/ #define Addr(V) ((ADDR) (V)) #define Unsigned(V) ((CELL) (V)) @@ -351,7 +345,9 @@ typedef unsigned char *CODEADDR; #define DisplPtr(V) ((DISPREG *)(V)) #define TermPtr(V) ((Term *) (V)) -/* Abstract Type Definitions for YAPProlog */ +/************************************************************************************************* + Abstract Type Definitions for YAPProlog +*************************************************************************************************/ typedef CELL Term; @@ -390,7 +386,9 @@ typedef pthread_rwlock_t rwlock_t; #include #endif -/********************** use an auxiliary function for ranges ************/ +/************************************************************************************************* + use an auxiliary function for ranges +*************************************************************************************************/ #ifdef __GNUC__ #define IN_BETWEEN(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) <= \ @@ -404,19 +402,25 @@ typedef pthread_rwlock_t rwlock_t; #define OUTSIDE(MIN,X,MAX) ((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX)) #endif -/* ************************* Atoms *************************************/ +/************************************************************************************************* + Atoms +*************************************************************************************************/ #include "Atoms.h" -/* ************************* Coroutining **********************************/ +/************************************************************************************************* + Coroutining +*************************************************************************************************/ + #ifdef COROUTINING /* Support for co-routining */ #include "corout.h" #endif -/********* abstract machine registers **********************************/ - +/************************************************************************************************* + abstract machine registers +*************************************************************************************************/ #include "amidefs.h" @@ -431,7 +435,9 @@ typedef pthread_rwlock_t rwlock_t; #endif #endif -/************ variables concerned with Error Handling *************/ +/************************************************************************************************* + variables concerned with Error Handling +*************************************************************************************************/ #include @@ -444,7 +450,6 @@ typedef pthread_rwlock_t rwlock_t; /* Support for arrays */ #include "arrays.h" -/************ variables concerned with Error Handling *************/ /* Types of Errors */ typedef enum @@ -622,7 +627,9 @@ typedef enum #define NUMBER_OF_YAP_FLAGS LAST_FLAG -/************************ prototypes **********************************/ +/************************************************************************************************* + prototypes +*************************************************************************************************/ #include "Yapproto.h" @@ -740,7 +747,9 @@ typedef enum #define TermSize sizeof(Term) -/************* variables related to memory allocation *******************/ +/************************************************************************************************* + variables related to memory allocation +*************************************************************************************************/ /* must be before TermExt.h */ extern ADDR Yap_HeapBase; @@ -750,71 +759,17 @@ extern ADDR Yap_HeapBase; #define MAX_ERROR_MSG_SIZE YAP_FILENAME_MAX -#ifdef THREADS -typedef struct thread_globs -{ - ADDR local_base; - ADDR global_base; - ADDR trail_base; - ADDR trail_top; - char *error_message; - Term error_term; - Term error_type; - UInt error_size; - char error_say[MAX_ERROR_MSG_SIZE]; - jmp_buf io_botch; - sigjmp_buf restart_env; - struct TOKEN *tokptr; - struct TOKEN *toktide; - struct VARSTRUCT *var_table; - struct VARSTRUCT *anon_var_table; - int eot_before_eof; - char file_name_buf[YAP_FILENAME_MAX]; - char file_name_buf2[YAP_FILENAME_MAX]; -} tglobs; - -extern struct thread_globs Yap_thread_gl[MAX_THREADS]; - -#define Yap_LocalBase Yap_thread_gl[worker_id].local_base -#define Yap_GlobalBase Yap_thread_gl[worker_id].global_base -#define Yap_TrailBase Yap_thread_gl[worker_id].trail_base -#define Yap_TrailTop Yap_thread_gl[worker_id].trail_top -#define Yap_ErrorMessage Yap_thread_gl[worker_id].error_message -#define Yap_Error_Term Yap_thread_gl[worker_id].error_term -#define Yap_Error_TYPE Yap_thread_gl[worker_id].error_type -#define Yap_Error_Size Yap_thread_gl[worker_id].error_size -#define Yap_ErrorSay Yap_thread_gl[worker_id].error_say -#define Yap_RestartEnv Yap_thread_gl[worker_id].restart_env - -/* This is the guy who actually started the system, and who has the correct registers */ -extern pthread_t Yap_master_thread; - -#else -extern ADDR Yap_HeapBase, - Yap_LocalBase, Yap_GlobalBase, Yap_TrailBase, Yap_TrailTop; - -extern sigjmp_buf Yap_RestartEnv; /* used to restart after an abort */ - -extern char *Yap_ErrorMessage; /* used to pass error messages */ -extern Term Yap_Error_Term; /* used to pass error terms */ -extern yap_error_number Yap_Error_TYPE; /* used to pass the error */ -extern UInt Yap_Error_Size; /* used to pass the error */ - -/******************* storing error messages ****************************/ -extern char Yap_ErrorSay[MAX_ERROR_MSG_SIZE]; - -#endif - -#ifdef DEBUG -/************** Debugging Support ***************************/ -extern int Yap_output_msg; -#endif +/************************************************************************************************* + ??? +*************************************************************************************************/ #define MkVarTerm() MkVarTerm__( PASS_REGS1 ) #define MkPairTerm(A,B) MkPairTerm__( A, B PASS_REGS ) -/* applies to unbound variables */ +/************************************************************************************************* + applies to unbound variables +*************************************************************************************************/ inline EXTERN Term *VarOfTerm (Term t); @@ -1058,18 +1013,317 @@ IntegerOfTerm (Term t) +/************************************************************************************************* + variables concerned with atoms table +*************************************************************************************************/ -/*************** unification routines ***********************************/ +#define MaxHash 3333 +#define MaxWideHash (MaxHash/10+1) + +#define FAIL_RESTORE 0 +#define DO_EVERYTHING 1 +#define DO_ONLY_CODE 2 + +/************************************************************************************************* + common instructions codes +*************************************************************************************************/ + +#define MAX_PROMPT 256 + +#if USE_THREADED_CODE + +/************************************************************************************************* + reverse lookup of instructions +*************************************************************************************************/ +typedef struct opcode_tab_entry +{ + OPCODE opc; + op_numbers opnum; +} opentry; + +#endif + +/************************************************************************************************* + Prolog may be in several modes +*************************************************************************************************/ + +typedef enum +{ + BootMode = 0x1, /* if booting or restoring */ + UserMode = 0x2, /* Normal mode */ + CritMode = 0x4, /* If we are meddling with the heap */ + AbortMode = 0x8, /* expecting to abort */ + InterruptMode = 0x10, /* under an interrupt */ + InErrorMode = 0x20, /* under an interrupt */ + ConsoleGetcMode = 0x40, /* blocked reading from console */ + ExtendStackMode = 0x80, /* trying to extend stack */ + GrowHeapMode = 0x100, /* extending Heap */ + GrowStackMode = 0x200, /* extending Stack */ + GCMode = 0x400, /* doing Garbage Collecting */ + ErrorHandlingMode = 0x800, /* doing error handling */ + CCallMode = 0x1000, /* In c Call */ + UnifyMode = 0x2000, /* In Unify Code */ + UserCCallMode = 0x4000, /* In User C-call Code */ + MallocMode = 0x8000, /* Doing malloc, realloc, free */ + SystemMode = 0x10000, /* in system mode */ + AsyncIntMode = 0x20000, /* YAP has just been interrupted from the outside */ + InReadlineMode = 0x40000 /* YAP has just been interrupted from the outside */ +} prolog_exec_mode; + + +/************************************************************************************************* + number of modules +*************************************************************************************************/ + +#define DefaultMaxModules 256 + +/************************************************************************************************* + Critical sections +*************************************************************************************************/ +#ifdef YAPOR +#define YAPEnterCriticalSection() \ + { \ + if (worker_id != GLOBAL_locks_who_locked_heap) { \ + LOCK(GLOBAL_locks_heap_access); \ + GLOBAL_locks_who_locked_heap = worker_id; \ + } \ + LOCAL_PrologMode |= CritMode; \ + LOCAL_CritLocks++; \ + } +#define YAPLeaveCriticalSection() \ + { \ + LOCAL_CritLocks--; \ + if (!LOCAL_CritLocks) { \ + LOCAL_PrologMode &= ~CritMode; \ + if (LOCAL_PrologMode & InterruptMode) { \ + LOCAL_PrologMode &= ~InterruptMode; \ + Yap_ProcessSIGINT(); \ + } \ + if (LOCAL_PrologMode & AbortMode) { \ + LOCAL_PrologMode &= ~AbortMode; \ + Yap_Error(PURE_ABORT, 0, ""); \ + } \ + GLOBAL_locks_who_locked_heap = MAX_WORKERS; \ + UNLOCK(GLOBAL_locks_heap_access); \ + } \ + } +#elif defined(THREADS) +#define YAPEnterCriticalSection() \ + { \ + /* LOCK(BGL); */ \ + LOCAL_PrologMode |= CritMode; \ + } +#define YAPLeaveCriticalSection() \ + { \ + LOCAL_PrologMode &= ~CritMode; \ + if (LOCAL_PrologMode & InterruptMode) { \ + LOCAL_PrologMode &= ~InterruptMode; \ + Yap_ProcessSIGINT(); \ + } \ + if (LOCAL_PrologMode & AbortMode) { \ + LOCAL_PrologMode &= ~AbortMode; \ + Yap_Error(PURE_ABORT, 0, ""); \ + } \ + /* UNLOCK(BGL); */ \ + } +#else +#define YAPEnterCriticalSection() \ + { \ + LOCAL_PrologMode |= CritMode; \ + LOCAL_CritLocks++; \ + } +#define YAPLeaveCriticalSection() \ + { \ + LOCAL_CritLocks--; \ + if (!LOCAL_CritLocks) { \ + LOCAL_PrologMode &= ~CritMode; \ + if (LOCAL_PrologMode & InterruptMode) { \ + LOCAL_PrologMode &= ~InterruptMode; \ + Yap_ProcessSIGINT(); \ + } \ + if (LOCAL_PrologMode & AbortMode) { \ + LOCAL_PrologMode &= ~AbortMode; \ + Yap_Error(PURE_ABORT, 0, ""); \ + } \ + } \ + } +#endif /* YAPOR */ + +/* when we are calling the InitStaff procedures */ +#define AT_BOOT 0 +#define AT_RESTORE 1 + + +/************************************************************************************************* + mutable variables +*************************************************************************************************/ + +/* I assume that the size of this structure is a multiple of the size + of CELL!!! */ +typedef struct TIMED_MAVAR +{ + CELL value; + CELL clock; +} timed_var; + + +/************************************************************************************************* + execution mode +*************************************************************************************************/ + +typedef enum + { + INTERPRETED, /* interpreted */ + MIXED_MODE_USER, /* mixed mode only for user predicates */ + MIXED_MODE_ALL, /* mixed mode for all predicates */ + COMPILE_USER, /* compile all user predicates*/ + COMPILE_ALL /* compile all predicates */ + } yap_exec_mode; + + +/************************************************************************************************* + slots +*************************************************************************************************/ + + +static inline void +Yap_StartSlots( USES_REGS1 ) { + *--ASP = MkIntegerTerm(CurSlot); + *--ASP = MkIntTerm(0); + CurSlot = LCL0-ASP; +} + +static inline void +Yap_CloseSlots( USES_REGS1 ) { + Int old_slots; + old_slots = IntOfTerm(ASP[0]); + ASP += (old_slots+1); + CurSlot = IntOfTerm(*ASP); + ASP++; +} + +static inline Int +Yap_CurrentSlot( USES_REGS1 ) { + return IntOfTerm(ASP[0]); +} + +/************************/ +#ifdef THREADS +typedef struct thandle { + int in_use; + int zombie; + UInt ssize; + UInt tsize; + UInt sysize; + void *stack_address; + Term tdetach; + Term cmod, texit_mod; + struct DB_TERM *tgoal, *texit; + int id; + int ret; + REGSTORE *default_yaam_regs; + REGSTORE *current_yaam_regs; + struct pred_entry *local_preds; + pthread_t pthread_handle; + int ref_count; +#ifdef LOW_LEVEL_TRACER + long long int thread_inst_count; + int been_here1; + int been_here2; +#endif +#ifdef DEBUG + int been_here; +#endif + pthread_mutex_t tlock; + pthread_mutex_t tlock_status; +#if HAVE_GETRUSAGE||defined(_WIN32) + struct timeval *start_of_timesp; + struct timeval *last_timep; +#endif +} yap_thandle; +#endif /* THREADS */ + +#define GC_MAVARS_HASH_SIZE 512 +typedef struct gc_ma_hash_entry_struct { + UInt timestmp; +#ifdef TABLING + tr_fr_ptr loc; + struct gc_ma_hash_entry_struct *more; +#endif + CELL* addr; + struct gc_ma_hash_entry_struct *next; +} gc_ma_hash_entry; + +typedef int (*Agc_hook)(Atom); + +typedef struct scratch_block_struct { + char *ptr; + UInt sz, msz; +} scratch_block; + + +/* scanner types */ +#include "ScannerTypes.h" + +/************************************************************************************************* + OPTYAP includes +*************************************************************************************************/ + +#if defined(YAPOR) || defined(TABLING) +#include "opt.structs.h" +#include "opt.proto.h" +#include "opt.macros.h" +#endif /* YAPOR || TABLING */ + + + +/************************************************************************************************* + GLOBAL and LOCAL variables +*************************************************************************************************/ + +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) +extern struct global_data *Yap_global; +extern long Yap_worker_area_size; +#else +extern struct global_data Yap_Global; +#define Yap_global (&Yap_Global) +#endif + +#if defined(THREADS) +extern struct worker_local *Yap_local[MAX_THREADS]; +#define REMOTE(wid) (Yap_local[wid]) +#elif defined(YAPOR) +extern struct worker_local *Yap_local; +#define REMOTE(wid) (Yap_local + wid) +#else /* !THREADS && !YAPOR */ +extern struct worker_local Yap_local; +#define REMOTE(wid) (&Yap_local) +#endif + +#define YP_FILE FILE +#include "hglobals.h" +#include "dglobals.h" +#include "hlocals.h" +#include "dlocals.h" + + +/************************************************************************************************* + unification routines +*************************************************************************************************/ #ifdef YAPOR_SBA #include "or.sba_amiops.h" +#include "or.sba_unify.h" #else #include "amiops.h" -#endif +#endif /* YAPOR_SBA */ -/*************** High level macros to access arguments ******************/ +/************************************************************************************************* + High level macros to access arguments +*************************************************************************************************/ + inline EXTERN Term ArgOfTerm (int i, Term t); inline EXTERN Term @@ -1129,214 +1383,4 @@ TailOfTermCell (Term t) return (Term) ((CELL) (RepPair (t) + 1)); } - - -/*************** variables concerned with atoms table *******************/ -#define MaxHash 3333 -#define MaxWideHash (MaxHash/10+1) - -#define FAIL_RESTORE 0 -#define DO_EVERYTHING 1 -#define DO_ONLY_CODE 2 - - -#ifdef EMACS - -/******************** using Emacs mode ********************************/ - -extern int emacs_mode; - -#endif - - -/********* common instructions codes*************************/ - -#define MAX_PROMPT 256 - -#if USE_THREADED_CODE - -/************ reverse lookup of instructions *****************/ -typedef struct opcode_tab_entry -{ - OPCODE opc; - op_numbers opnum; -} opentry; - -#endif - -/********* Prolog may be in several modes *******************************/ - -typedef enum -{ - BootMode = 0x1, /* if booting or restoring */ - UserMode = 0x2, /* Normal mode */ - CritMode = 0x4, /* If we are meddling with the heap */ - AbortMode = 0x8, /* expecting to abort */ - InterruptMode = 0x10, /* under an interrupt */ - InErrorMode = 0x20, /* under an interrupt */ - ConsoleGetcMode = 0x40, /* blocked reading from console */ - ExtendStackMode = 0x80, /* trying to extend stack */ - GrowHeapMode = 0x100, /* extending Heap */ - GrowStackMode = 0x200, /* extending Stack */ - GCMode = 0x400, /* doing Garbage Collecting */ - ErrorHandlingMode = 0x800, /* doing error handling */ - CCallMode = 0x1000, /* In c Call */ - UnifyMode = 0x2000, /* In Unify Code */ - UserCCallMode = 0x4000, /* In User C-call Code */ - MallocMode = 0x8000, /* Doing malloc, realloc, free */ - SystemMode = 0x10000, /* in system mode */ - AsyncIntMode = 0x20000, /* YAP has just been interrupted from the outside */ - InReadlineMode = 0x40000 /* YAP has just been interrupted from the outside */ -} prolog_exec_mode; - -extern Int Yap_PrologMode; -extern int Yap_CritLocks; - -/************** Access to yap initial arguments ***************************/ - -extern char **Yap_argv; -extern int Yap_argc; - -/******** whether Yap is responsible for signal handling ******************/ - -extern int Yap_PrologShouldHandleInterrupts; - -/******************* number of modules ****************************/ - -#define DefaultMaxModules 256 - -#ifdef YAPOR -#define YAPEnterCriticalSection() \ - { \ - if (worker_id != GLOBAL_locks_who_locked_heap) { \ - LOCK(GLOBAL_locks_heap_access); \ - GLOBAL_locks_who_locked_heap = worker_id; \ - } \ - Yap_PrologMode |= CritMode; \ - Yap_CritLocks++; \ - } -#define YAPLeaveCriticalSection() \ - { \ - Yap_CritLocks--; \ - if (!Yap_CritLocks) { \ - Yap_PrologMode &= ~CritMode; \ - if (Yap_PrologMode & InterruptMode) { \ - Yap_PrologMode &= ~InterruptMode; \ - Yap_ProcessSIGINT(); \ - } \ - if (Yap_PrologMode & AbortMode) { \ - Yap_PrologMode &= ~AbortMode; \ - Yap_Error(PURE_ABORT, 0, ""); \ - } \ - GLOBAL_locks_who_locked_heap = MAX_WORKERS; \ - UNLOCK(GLOBAL_locks_heap_access); \ - } \ - } -#elif defined(THREADS) -#define YAPEnterCriticalSection() \ - { \ - /* LOCK(BGL); */ \ - Yap_PrologMode |= CritMode; \ - } -#define YAPLeaveCriticalSection() \ - { \ - Yap_PrologMode &= ~CritMode; \ - if (Yap_PrologMode & InterruptMode) { \ - Yap_PrologMode &= ~InterruptMode; \ - Yap_ProcessSIGINT(); \ - } \ - if (Yap_PrologMode & AbortMode) { \ - Yap_PrologMode &= ~AbortMode; \ - Yap_Error(PURE_ABORT, 0, ""); \ - } \ - /* UNLOCK(BGL); */ \ - } -#else -#define YAPEnterCriticalSection() \ - { \ - Yap_PrologMode |= CritMode; \ - Yap_CritLocks++; \ - } -#define YAPLeaveCriticalSection() \ - { \ - Yap_CritLocks--; \ - if (!Yap_CritLocks) { \ - Yap_PrologMode &= ~CritMode; \ - if (Yap_PrologMode & InterruptMode) { \ - Yap_PrologMode &= ~InterruptMode; \ - Yap_ProcessSIGINT(); \ - } \ - if (Yap_PrologMode & AbortMode) { \ - Yap_PrologMode &= ~AbortMode; \ - Yap_Error(PURE_ABORT, 0, ""); \ - } \ - } \ - } -#endif /* YAPOR */ - -/* when we are calling the InitStaff procedures */ -#define AT_BOOT 0 -#define AT_RESTORE 1 - -/********* mutable variables ******************/ - -/* I assume that the size of this structure is a multiple of the size - of CELL!!! */ -typedef struct TIMED_MAVAR -{ - CELL value; - CELL clock; -} timed_var; - -/********* while debugging you may need some info ***********************/ - -#ifdef EMACS -extern char emacs_tmp[], emacs_tmp2[]; -#endif - -#if defined(YAPOR) || defined(TABLING) -#include "opt.structs.h" -#include "opt.proto.h" -#include "opt.macros.h" -#endif /* YAPOR || TABLING */ - -#ifdef YAPOR_SBA -#include "or.sba_unify.h" -#endif - -/********* execution mode ***********************/ - -typedef enum - { - INTERPRETED, /* interpreted */ - MIXED_MODE_USER, /* mixed mode only for user predicates */ - MIXED_MODE_ALL, /* mixed mode for all predicates */ - COMPILE_USER, /* compile all user predicates*/ - COMPILE_ALL /* compile all predicates */ - } yap_exec_mode; - -/********* slots ***********************/ - - -static inline void -Yap_StartSlots( USES_REGS1 ) { - *--ASP = MkIntegerTerm(CurSlot); - *--ASP = MkIntTerm(0); - CurSlot = LCL0-ASP; -} - -static inline void -Yap_CloseSlots( USES_REGS1 ) { - Int old_slots; - old_slots = IntOfTerm(ASP[0]); - ASP += (old_slots+1); - CurSlot = IntOfTerm(*ASP); - ASP++; -} - -static inline Int -Yap_CurrentSlot( USES_REGS1 ) { - return IntOfTerm(ASP[0]); -} - #endif /* YAP_H */ diff --git a/H/YapHeap.h b/H/YapHeap.h index ae1dfbee6..d24d28ab8 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -52,17 +52,17 @@ typedef struct swi_reverse_hash { Int pos; } swi_rev_hash; -#define GC_MAVARS_HASH_SIZE 512 - -typedef struct gc_ma_hash_entry_struct { - UInt timestmp; -#ifdef TABLING - tr_fr_ptr loc; - struct gc_ma_hash_entry_struct *more; -#endif - CELL* addr; - struct gc_ma_hash_entry_struct *next; -} gc_ma_hash_entry; +//#define GC_MAVARS_HASH_SIZE 512 +// +//typedef struct gc_ma_hash_entry_struct { +// UInt timestmp; +//#ifdef TABLING +// tr_fr_ptr loc; +// struct gc_ma_hash_entry_struct *more; +//#endif +// CELL* addr; +// struct gc_ma_hash_entry_struct *next; +//} gc_ma_hash_entry; typedef void (*HaltHookFunc)(int, void *); @@ -81,10 +81,10 @@ typedef struct atom_hash_entry { Atom Entry; } AtomHashEntry; -typedef struct scratch_block_struct { - char *ptr; - UInt sz, msz; -} scratch_block; +//typedef struct scratch_block_struct { +// char *ptr; +// UInt sz, msz; +//} scratch_block; typedef struct record_list { /* a list of dbterms associated with a clause */ @@ -97,6 +97,7 @@ typedef struct record_list { #define SWI_TMP_BUF_SIZE 2*SWI_BUF_SIZE #define SWI_BUF_RINGS 16 +/* ricardo #ifdef THREADS typedef struct thandle { int in_use; @@ -130,9 +131,9 @@ typedef struct thandle { struct timeval *last_timep; #endif } yap_thandle; -#endif +#endif */ -typedef int (*Agc_hook)(Atom); +//typedef int (*Agc_hook)(Atom); /******************* this is the data base: everything here should be possible to restore @@ -145,9 +146,10 @@ typedef struct various_codes { } all_heap_codes; -#include "hglobals.h" -#include "hlocals.h" +//#include "hglobals.h" +//#include "hlocals.h" +/* ricardo #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) extern struct global_data *Yap_global; extern long Yap_worker_area_size; @@ -162,10 +164,11 @@ extern struct worker_local *Yap_local[MAX_THREADS]; #elif defined(YAPOR) extern struct worker_local *Yap_local; #define REMOTE(wid) (Yap_local + wid) -#else /* !THREADS && !YAPOR */ +#else extern struct worker_local Yap_local; #define REMOTE(wid) (&Yap_local) #endif +*/ #ifdef USE_SYSTEM_MALLOC extern struct various_codes *Yap_heap_regs; @@ -174,8 +177,8 @@ extern struct various_codes *Yap_heap_regs; #endif #include "dhstruct.h" -#include "dglobals.h" -#include "dlocals.h" +//#include "dglobals.h" +//#include "dlocals.h" /******************* these are the global variables: they need not be restored... diff --git a/H/Yapproto.h b/H/Yapproto.h index edc2b8368..0c8be2542 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -132,9 +132,6 @@ Term STD_PROTO(Yap_all_calls,(void)); Atom STD_PROTO(Yap_ConsultingFile,(void)); struct pred_entry *STD_PROTO(Yap_PredForChoicePt,(choiceptr)); void STD_PROTO(Yap_InitCdMgr,(void)); -#ifdef EMACS -int STD_PROTO(where_new_clause, (Prop, int)); -#endif void STD_PROTO(Yap_init_consult,(int, char *)); void STD_PROTO(Yap_end_consult,(void)); void STD_PROTO(Yap_Abolish,(struct pred_entry *)); @@ -239,6 +236,9 @@ void STD_PROTO(Yap_InitCPredBack_,(char *, unsigned long int, unsigned int, C #endif void STD_PROTO(Yap_InitWorkspace,(UInt,UInt,UInt,UInt,UInt,int,int,int)); +#ifdef YAPOR +void STD_PROTO(Yap_init_yapor_workers, (void)); +#endif /* YAPOR */ #if defined(YAPOR) || defined(THREADS) void STD_PROTO(Yap_KillStacks,(int)); #else @@ -328,6 +328,7 @@ void STD_PROTO(Yap_undo_signal,(yap_signals)); int STD_PROTO(Yap_IsOpMaxPrio,(Atom)); /* sysbits.c */ +void STD_PROTO(Yap_InitPageSize, (void)); void STD_PROTO(Yap_set_fpu_exceptions,(int)); UInt STD_PROTO(Yap_cputime,(void)); Int STD_PROTO(Yap_walltime,(void)); @@ -391,6 +392,11 @@ void STD_PROTO(Yap_InitUtilCPreds,(void)); Int STD_PROTO(Yap_TermHash,(Term, Int, Int, int)); /* yap.c */ + +/* write.c */ +void STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int)); + + /* MYDDAS */ #if defined MYDDAS_MYSQL || defined MYDDAS_ODBC diff --git a/H/absmi.h b/H/absmi.h index 240602b70..c68eb45c0 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -682,10 +682,10 @@ Macros to check the limits of stacks #else -#define check_trail(x) if (Unsigned(Yap_TrailTop) - Unsigned(x) < MinTrailGap) \ +#define check_trail(x) if (Unsigned(LOCAL_TrailTop) - Unsigned(x) < MinTrailGap) \ goto notrailleft -#define check_trail_in_indexing(x) if (Unsigned(Yap_TrailTop) - Unsigned(x) < MinTrailGap) \ +#define check_trail_in_indexing(x) if (Unsigned(LOCAL_TrailTop) - Unsigned(x) < MinTrailGap) \ goto notrailleft_from_index #endif diff --git a/H/amidefs.h b/H/amidefs.h index 13a09dd22..e3c111f1a 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -1095,12 +1095,8 @@ extern void **Yap_ABSMI_OPCODES; #define absmadr(i) ((OPCODE)(i)) #endif -/* used to find out how many instructions of each kind are executed */ -#ifdef ANALYST -extern YAP_ULONG_LONG Yap_opcount[_std_top + 1]; -extern YAP_ULONG_LONG Yap_2opcount[_std_top + 1][_std_top + 1]; -#endif /* ANALYST */ + #if DEPTH_LIMIT /* diff --git a/H/amiops.h b/H/amiops.h index d58cfb0f1..0df524333 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -15,6 +15,7 @@ * dereferencing, binding, trailing, and unification. * * * *************************************************************************/ + #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif /* SCCS */ @@ -276,7 +277,7 @@ Binding Macros for Multiple Assignment Variables. #define TRAIL_CLREF(REF) TrailTerm(TR++) = CLREF_TO_TRENTRY(REF) #define TRAIL_LINK(REF) TrailTerm(TR++) = AbsPair((CELL *)(REF)) #endif -#define TRAIL_FRAME(FR) DO_TRAIL(AbsPair((CELL *)(Yap_TrailBase)), FR) +#define TRAIL_FRAME(FR) DO_TRAIL(AbsPair((CELL *)(LOCAL_TrailBase)), FR) extern void Yap_WakeUp(CELL *v); diff --git a/H/cut_c.h b/H/cut_c.h index 857a96da5..cf53117a7 100755 --- a/H/cut_c.h +++ b/H/cut_c.h @@ -32,7 +32,7 @@ struct cut_c_str{ #define POP_CHOICE_POINT(cp) \ - (((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)Yap_LocalBase) && ((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP)) + (((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && ((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP)) #define POP_EXECUTE() \ diff --git a/H/dglobals.h b/H/dglobals.h index 77591eeac..e049b2252 100644 --- a/H/dglobals.h +++ b/H/dglobals.h @@ -44,7 +44,7 @@ #define GLOBAL_ThreadsTotalTime Yap_global->ThreadsTotalTime_ #define GLOBAL_ThreadHandlesLock Yap_global->ThreadHandlesLock_ -#endif +#endif #if defined(YAPOR) || defined(THREADS) #define GLOBAL_BGL Yap_global->BGL_ @@ -53,3 +53,58 @@ #define GLOBAL_optyap_data Yap_global->optyap_data_ #endif /* YAPOR || TABLING */ +#define GLOBAL_PrologShouldHandleInterrupts Yap_global->PrologShouldHandleInterrupts_ + +#if defined(THREADS) +#define GLOBAL_master_thread Yap_global->master_thread_ +#endif /* THREADS */ + +#define GLOBAL_stdout Yap_global->stdout_ +#define GLOBAL_stderr Yap_global->stderr_ + +#define GLOBAL_argv Yap_global->argv_ +#define GLOBAL_argc Yap_global->argc_ + +#ifdef COROUTINING + +#define GLOBAL_attas Yap_global->attas_ +#endif + +#define GLOBAL_agc_calls Yap_global->agc_calls_ +#define GLOBAL_agc_collected Yap_global->agc_collected_ + +#define GLOBAL_tot_agc_time Yap_global->tot_agc_time_ + +#define GLOBAL_tot_agc_recovered Yap_global->tot_agc_recovered_ + +#if HAVE_MMAP +#define GLOBAL_mmap_arrays Yap_global->mmap_arrays_ +#endif +#ifdef DEBUG + +#define GLOBAL_Option Yap_global->Option_ +#define GLOBAL_logfile Yap_global->logfile_ + +#define GLOBAL_output_msg Yap_global->output_msg_ +#endif + +#define GLOBAL_ProfCalls Yap_global->ProfCalls_ +#define GLOBAL_ProfGCs Yap_global->ProfGCs_ +#define GLOBAL_ProfHGrows Yap_global->ProfHGrows_ +#define GLOBAL_ProfSGrows Yap_global->ProfSGrows_ +#define GLOBAL_ProfMallocs Yap_global->ProfMallocs_ +#define GLOBAL_ProfOn Yap_global->ProfOn_ +#define GLOBAL_ProfOns Yap_global->ProfOns_ +#define GLOBAL_ProfilerRoot Yap_global->ProfilerRoot_ +#define GLOBAL_ProfilerNil Yap_global->ProfilerNil_ +#define GLOBAL_DIRNAME Yap_global->DIRNAME_ +#if defined(COFF) || defined(A_OUT) + +#define GLOBAL_Executable Yap_global->Executable_ +#endif +#if __simplescalar__ +#define GLOBAL_pwd Yap_global->pwd_ +#endif + + + diff --git a/H/dlocals.h b/H/dlocals.h index ab251c66b..367b899be 100644 --- a/H/dlocals.h +++ b/H/dlocals.h @@ -227,3 +227,93 @@ #define REMOTE_SignalLock(wid) REMOTE(wid)->SignalLock_ #endif +#define LOCAL_LocalBase LOCAL->LocalBase_ +#define REMOTE_LocalBase(wid) REMOTE(wid)->LocalBase_ +#define LOCAL_GlobalBase LOCAL->GlobalBase_ +#define REMOTE_GlobalBase(wid) REMOTE(wid)->GlobalBase_ +#define LOCAL_TrailBase LOCAL->TrailBase_ +#define REMOTE_TrailBase(wid) REMOTE(wid)->TrailBase_ +#define LOCAL_TrailTop LOCAL->TrailTop_ +#define REMOTE_TrailTop(wid) REMOTE(wid)->TrailTop_ +#define LOCAL_ErrorMessage LOCAL->ErrorMessage_ +#define REMOTE_ErrorMessage(wid) REMOTE(wid)->ErrorMessage_ +#define LOCAL_Error_Term LOCAL->Error_Term_ +#define REMOTE_Error_Term(wid) REMOTE(wid)->Error_Term_ +#ifdef THREADS +#define LOCAL_Error_TYPE LOCAL->Error_TYPE_ +#define REMOTE_Error_TYPE(wid) REMOTE(wid)->Error_TYPE_ +#else +#define LOCAL_Error_TYPE LOCAL->Error_TYPE_ +#define REMOTE_Error_TYPE(wid) REMOTE(wid)->Error_TYPE_ +#endif +#define LOCAL_Error_Size LOCAL->Error_Size_ +#define REMOTE_Error_Size(wid) REMOTE(wid)->Error_Size_ +#define LOCAL_ErrorSay LOCAL->ErrorSay_ +#define REMOTE_ErrorSay(wid) REMOTE(wid)->ErrorSay_ +#define LOCAL_IOBotch LOCAL->IOBotch_ +#define REMOTE_IOBotch(wid) REMOTE(wid)->IOBotch_ +#define LOCAL_tokptr LOCAL->tokptr_ +#define REMOTE_tokptr(wid) REMOTE(wid)->tokptr_ +#define LOCAL_toktide LOCAL->toktide_ +#define REMOTE_toktide(wid) REMOTE(wid)->toktide_ +#define LOCAL_VarTable LOCAL->VarTable_ +#define REMOTE_VarTable(wid) REMOTE(wid)->VarTable_ +#define LOCAL_AnonVarTable LOCAL->AnonVarTable_ +#define REMOTE_AnonVarTable(wid) REMOTE(wid)->AnonVarTable_ +#define LOCAL_RestartEnv LOCAL->RestartEnv_ +#define REMOTE_RestartEnv(wid) REMOTE(wid)->RestartEnv_ +#define LOCAL_FileNameBuf LOCAL->FileNameBuf_ +#define REMOTE_FileNameBuf(wid) REMOTE(wid)->FileNameBuf_ +#define LOCAL_FileNameBuf2 LOCAL->FileNameBuf2_ +#define REMOTE_FileNameBuf2(wid) REMOTE(wid)->FileNameBuf2_ + +#define LOCAL_PrologMode LOCAL->PrologMode_ +#define REMOTE_PrologMode(wid) REMOTE(wid)->PrologMode_ +#define LOCAL_CritLocks LOCAL->CritLocks_ +#define REMOTE_CritLocks(wid) REMOTE(wid)->CritLocks_ + + +#ifdef ANALYST +#define LOCAL_opcount LOCAL->opcount_ +#define REMOTE_opcount(wid) REMOTE(wid)->opcount_ +#define LOCAL_2opcount LOCAL->2opcount_ +#define REMOTE_2opcount(wid) REMOTE(wid)->2opcount_ +#endif /* ANALYST */ + +#define LOCAL_s_dbg LOCAL->s_dbg_ +#define REMOTE_s_dbg(wid) REMOTE(wid)->s_dbg_ + +#define LOCAL_matherror LOCAL->matherror_ +#define REMOTE_matherror(wid) REMOTE(wid)->matherror_ + +#define LOCAL_heap_overflows LOCAL->heap_overflows_ +#define REMOTE_heap_overflows(wid) REMOTE(wid)->heap_overflows_ +#define LOCAL_total_heap_overflow_time LOCAL->total_heap_overflow_time_ +#define REMOTE_total_heap_overflow_time(wid) REMOTE(wid)->total_heap_overflow_time_ +#define LOCAL_stack_overflows LOCAL->stack_overflows_ +#define REMOTE_stack_overflows(wid) REMOTE(wid)->stack_overflows_ +#define LOCAL_total_stack_overflow_time LOCAL->total_stack_overflow_time_ +#define REMOTE_total_stack_overflow_time(wid) REMOTE(wid)->total_stack_overflow_time_ +#define LOCAL_delay_overflows LOCAL->delay_overflows_ +#define REMOTE_delay_overflows(wid) REMOTE(wid)->delay_overflows_ +#define LOCAL_total_delay_overflow_time LOCAL->total_delay_overflow_time_ +#define REMOTE_total_delay_overflow_time(wid) REMOTE(wid)->total_delay_overflow_time_ +#define LOCAL_trail_overflows LOCAL->trail_overflows_ +#define REMOTE_trail_overflows(wid) REMOTE(wid)->trail_overflows_ +#define LOCAL_total_trail_overflow_time LOCAL->total_trail_overflow_time_ +#define REMOTE_total_trail_overflow_time(wid) REMOTE(wid)->total_trail_overflow_time_ +#define LOCAL_atom_table_overflows LOCAL->atom_table_overflows_ +#define REMOTE_atom_table_overflows(wid) REMOTE(wid)->atom_table_overflows_ +#define LOCAL_total_atom_table_overflow_time LOCAL->total_atom_table_overflow_time_ +#define REMOTE_total_atom_table_overflow_time(wid) REMOTE(wid)->total_atom_table_overflow_time_ + +#ifdef LOAD_DYLD +#define LOCAL_dl_errno LOCAL->dl_errno_ +#define REMOTE_dl_errno(wid) REMOTE(wid)->dl_errno_ +#endif + +#ifdef LOW_LEVEL_TRACER +#define LOCAL_do_trace_primitives LOCAL->do_trace_primitives_ +#define REMOTE_do_trace_primitives(wid) REMOTE(wid)->do_trace_primitives_ +#endif + diff --git a/H/eval.h b/H/eval.h index 511b5e54b..7894042f1 100644 --- a/H/eval.h +++ b/H/eval.h @@ -161,8 +161,6 @@ Functor STD_PROTO(EvalArg,(Term)); #define FL(X) ((double)(X)) #endif -extern yap_error_number Yap_matherror; - void STD_PROTO(Yap_InitConstExps,(void)); void STD_PROTO(Yap_InitUnaryExps,(void)); void STD_PROTO(Yap_InitBinaryExps,(void)); @@ -190,8 +188,8 @@ inline static Term Yap_FoundArithError(Term t, Term inp) { CACHE_REGS - if (Yap_Error_TYPE) { - Yap_Error(Yap_Error_TYPE, (inp ? inp : Yap_Error_Term), Yap_ErrorMessage); + if (LOCAL_Error_TYPE) { + Yap_Error(LOCAL_Error_TYPE, (inp ? inp : LOCAL_Error_Term), LOCAL_ErrorMessage); P = FAILCODE; return 0L; } diff --git a/H/heapgc.h b/H/heapgc.h index e747f8bff..79d5d97ca 100755 --- a/H/heapgc.h +++ b/H/heapgc.h @@ -49,7 +49,7 @@ /* is ptr a pointer to code space? */ #if USE_SYSTEM_MALLOC -#define ONCODE(ptr) (Addr(ptr) < Yap_GlobalBase || Addr(ptr) > Yap_TrailTop) +#define ONCODE(ptr) (Addr(ptr) < LOCAL_GlobalBase || Addr(ptr) > LOCAL_TrailTop) #else #define ONCODE(ptr) (Addr(ptr) < HeapTop && Addr(ptr) >= Yap_HeapBase) #endif @@ -80,7 +80,7 @@ #define MARK_BIT ((char)1) #define RMARK_BIT ((char)2) -#define mcell(X) LOCAL_bp[(X)-(CELL *)Yap_GlobalBase] +#define mcell(X) LOCAL_bp[(X)-(CELL *)LOCAL_GlobalBase] #define MARKED_PTR(P) MARKED_PTR__(P PASS_REGS) #define UNMARKED_MARK(P, BP) UNMARKED_MARK__(P, BP PASS_REGS) @@ -99,7 +99,7 @@ MARKED_PTR__(CELL* ptr USES_REGS) static inline Int UNMARKED_MARK__(CELL* ptr, char *bp USES_REGS) { - Int pos = ptr - (CELL *)Yap_GlobalBase; + Int pos = ptr - (CELL *)LOCAL_GlobalBase; char t = bp[pos]; if (t & MARK_BIT) { return TRUE; diff --git a/H/hglobals.h b/H/hglobals.h index ea948ec58..ad4c1e699 100644 --- a/H/hglobals.h +++ b/H/hglobals.h @@ -44,7 +44,7 @@ typedef struct global_data { UInt ThreadsTotalTime_; lockvar ThreadHandlesLock_; -#endif +#endif #if defined(YAPOR) || defined(THREADS) lockvar BGL_; @@ -52,4 +52,59 @@ typedef struct global_data { #if defined(YAPOR) || defined(TABLING) struct global_optyap_data optyap_data_; #endif /* YAPOR || TABLING */ + + int PrologShouldHandleInterrupts_; + +#if defined(THREADS) + pthread_t master_thread_; +#endif /* THREADS */ + + YP_FILE* stdout_; + YP_FILE* stderr_; + + char** argv_; + int argc_; + +#ifdef COROUTINING + + ext_op attas_[attvars_ext+1]; +#endif + + int agc_calls_; + YAP_ULONG_LONG agc_collected_; + + Int tot_agc_time_; + + Int tot_agc_recovered_; + +#if HAVE_MMAP + struct MMAP_ARRAY_BLOCK* mmap_arrays_; +#endif +#ifdef DEBUG + + char Option_[20]; + YP_FILE* logfile_; + + int output_msg_; +#endif + + Int ProfCalls_; + Int ProfGCs_; + Int ProfHGrows_; + Int ProfSGrows_; + Int ProfMallocs_; + Int ProfOn_; + Int ProfOns_; + struct RB_red_blk_node* ProfilerRoot_; + struct RB_red_blk_node* ProfilerNil_; + char* DIRNAME_; +#if defined(COFF) || defined(A_OUT) + + char Executable_[YAP_FILENAME_MAX]; +#endif +#if __simplescalar__ + char pwd_[YAP_FILENAME_MAX]; +#endif + + } w_shared; diff --git a/H/hlocals.h b/H/hlocals.h index 35cb2b2be..c737f5b59 100644 --- a/H/hlocals.h +++ b/H/hlocals.h @@ -23,7 +23,7 @@ typedef struct worker_local { Int GDiff_; Int HDiff_; Int GDiff0_; - Int GSplit_; + CELL* GSplit_; Int LDiff_; Int TrDiff_; Int XDiff_; @@ -128,4 +128,58 @@ typedef struct worker_local { #if defined(YAPOR) || defined(THREADS) lockvar SignalLock_; #endif + + ADDR LocalBase_; + ADDR GlobalBase_; + ADDR TrailBase_; + ADDR TrailTop_; + char* ErrorMessage_; + Term Error_Term_; +#ifdef THREADS + Term Error_TYPE_; +#else + yap_error_number Error_TYPE_; +#endif + UInt Error_Size_; + char ErrorSay_[MAX_ERROR_MSG_SIZE]; + jmp_buf IOBotch_; + TokEntry* tokptr_; + TokEntry* toktide_; + VarEntry* VarTable_; + VarEntry* AnonVarTable_; + sigjmp_buf RestartEnv_; + char FileNameBuf_[YAP_FILENAME_MAX]; + char FileNameBuf2_[YAP_FILENAME_MAX]; + + Int PrologMode_; + int CritLocks_; + + +#ifdef ANALYST + YAP_ULONG_LONG opcount_[_std_top+1]; + YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1]_; +#endif /* ANALYST */ + + struct db_globs* s_dbg_; + + yap_error_number matherror_; + + int heap_overflows_; + Int total_heap_overflow_time_; + int stack_overflows_; + Int total_stack_overflow_time_; + int delay_overflows_; + Int total_delay_overflow_time_; + int trail_overflows_; + Int total_trail_overflow_time_; + int atom_table_overflows_; + Int total_atom_table_overflow_time_; + +#ifdef LOAD_DYLD + static dl_errno_; +#endif + +#ifdef LOW_LEVEL_TRACER + int do_trace_primitives_; +#endif } w_local; diff --git a/H/iglobals.h b/H/iglobals.h index f47fc6533..bf2abed19 100644 --- a/H/iglobals.h +++ b/H/iglobals.h @@ -44,7 +44,7 @@ static void InitGlobal(void) { GLOBAL_ThreadsTotalTime = 0L; INIT_LOCK(GLOBAL_ThreadHandlesLock); -#endif +#endif #if defined(YAPOR) || defined(THREADS) INIT_LOCK(GLOBAL_BGL); @@ -52,4 +52,59 @@ static void InitGlobal(void) { #if defined(YAPOR) || defined(TABLING) #endif /* YAPOR || TABLING */ + + + +#if defined(THREADS) + +#endif /* THREADS */ + + GLOBAL_stdout = stdout; + GLOBAL_stderr = stderr; + + + + +#ifdef COROUTINING + + +#endif + + + + + GLOBAL_tot_agc_time = 0; + + GLOBAL_tot_agc_recovered = 0; + +#if HAVE_MMAP + GLOBAL_mmap_arrays = NULL; +#endif +#ifdef DEBUG + + + + + GLOBAL_output_msg = FALSE; +#endif + + + + + + + + + + + GLOBAL_DIRNAME = NULL; +#if defined(COFF) || defined(A_OUT) + + +#endif +#if __simplescalar__ + +#endif + + } diff --git a/H/ilocals.h b/H/ilocals.h index f09a08e7d..cd030df76 100644 --- a/H/ilocals.h +++ b/H/ilocals.h @@ -128,4 +128,58 @@ static void InitWorker(int wid) { #if defined(YAPOR) || defined(THREADS) INIT_LOCK(REMOTE_SignalLock(wid)); #endif + + + + + + + +#ifdef THREADS + +#else + +#endif + + + + + + + + + + + + REMOTE_PrologMode(wid) = BootMode; + REMOTE_CritLocks(wid) = 0; + + +#ifdef ANALYST + + +#endif /* ANALYST */ + + + + REMOTE_matherror(wid) = YAP_NO_ERROR; + + REMOTE_heap_overflows(wid) = 0; + REMOTE_total_heap_overflow_time(wid) = 0; + REMOTE_stack_overflows(wid) = 0; + REMOTE_total_stack_overflow_time(wid) = 0; + REMOTE_delay_overflows(wid) = 0; + REMOTE_total_delay_overflow_time(wid) = 0; + REMOTE_trail_overflows(wid) = 0; + REMOTE_total_trail_overflow_time(wid) = 0; + REMOTE_atom_table_overflows(wid) = 0; + REMOTE_total_atom_table_overflow_time(wid) = 0; + +#ifdef LOAD_DYLD + REMOTE_dl_errno(wid) = 0; +#endif + +#ifdef LOW_LEVEL_TRACER + REMOTE_do_trace_primitives(wid) = TRUE; +#endif } diff --git a/H/iopreds.h b/H/iopreds.h index 887f98684..f44373881 100644 --- a/H/iopreds.h +++ b/H/iopreds.h @@ -115,4 +115,5 @@ StreamDesc; void STD_PROTO (Yap_InitStdStreams, (void)); Term STD_PROTO (Yap_StreamPosition, (struct io_stream *)); +void STD_PROTO (Yap_InitPlIO, (void)); diff --git a/H/rglobals.h b/H/rglobals.h index b0cef7bb0..289f14458 100644 --- a/H/rglobals.h +++ b/H/rglobals.h @@ -44,7 +44,7 @@ static void RestoreGlobal(void) { REINIT_LOCK(GLOBAL_ThreadHandlesLock); -#endif +#endif #if defined(YAPOR) || defined(THREADS) REINIT_LOCK(GLOBAL_BGL); @@ -52,4 +52,59 @@ static void RestoreGlobal(void) { #if defined(YAPOR) || defined(TABLING) #endif /* YAPOR || TABLING */ + + + +#if defined(THREADS) + +#endif /* THREADS */ + + + + + + + +#ifdef COROUTINING + + +#endif + + + + + + + + +#if HAVE_MMAP + +#endif +#ifdef DEBUG + + + + + +#endif + + + + + + + + + + + +#if defined(COFF) || defined(A_OUT) + + +#endif +#if __simplescalar__ + +#endif + + } diff --git a/H/rlocals.h b/H/rlocals.h index ad4a1f9aa..44d5a5277 100644 --- a/H/rlocals.h +++ b/H/rlocals.h @@ -128,4 +128,58 @@ static void RestoreWorker(int wid USES_REGS) { #if defined(YAPOR) || defined(THREADS) REINIT_LOCK(REMOTE_SignalLock(wid)); #endif + + + + + + + +#ifdef THREADS + +#else + +#endif + + + + + + + + + + + + + + + +#ifdef ANALYST + + +#endif /* ANALYST */ + + + + + + + + + + + + + + + + +#ifdef LOAD_DYLD + +#endif + +#ifdef LOW_LEVEL_TRACER + +#endif } diff --git a/H/sshift.h b/H/sshift.h index 1febc9949..e0c7c61bd 100755 --- a/H/sshift.h +++ b/H/sshift.h @@ -124,7 +124,7 @@ inline EXTERN int IsHeapP__ (CELL * ptr USES_REGS) { #if USE_SYSTEM_MALLOC - return (int) ((ptr < (CELL *) Yap_GlobalBase || ptr > (CELL *) Yap_TrailTop)); + return (int) ((ptr < (CELL *) LOCAL_GlobalBase || ptr > (CELL *) LOCAL_TrailTop)); #else return (int) ((ptr >= (CELL *) Yap_HeapBase && ptr <= (CELL *) HeapTop)); #endif @@ -1123,7 +1123,7 @@ inline EXTERN int IsGlobal__ (CELL CACHE_TYPE); inline EXTERN int IsGlobal__ (CELL reg USES_REGS) { - return (int) (IN_BETWEEN (Yap_GlobalBase, reg, H)); + return (int) (IN_BETWEEN (LOCAL_GlobalBase, reg, H)); } diff --git a/H/trim_trail.h b/H/trim_trail.h index 81233c769..872e6d74c 100644 --- a/H/trim_trail.h +++ b/H/trim_trail.h @@ -17,13 +17,13 @@ } else if (IsPairTerm(d1)) { CELL *pt = RepPair(d1); #ifdef LIMIT_TABLING - if ((ADDR) pt == Yap_TrailBase) { + if ((ADDR) pt == LOCAL_TrailBase) { sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt1); SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */ insert_into_global_sg_fr_list(sg_fr); } else #endif /* LIMIT_TABLING */ - if (IN_BETWEEN(Yap_TrailBase, pt, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, pt, LOCAL_TrailTop)) { /* skip, this is a problem because we lose information, namely active references */ pt1 = (tr_fr_ptr)pt; diff --git a/H/yapio.h b/H/yapio.h index f5c3d2b34..7f891a96c 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -65,9 +65,6 @@ #endif #define YP_FILE FILE -extern YP_FILE *Yap_stdin; -extern YP_FILE *Yap_stdout; -extern YP_FILE *Yap_stderr; int STD_PROTO(YP_putc,(int, int)); @@ -167,6 +164,7 @@ extern YP_FILE yp_iob[YP_MAX_FILES]; typedef YP_FILE *YP_File; +/* ricardo typedef enum TokenKinds { Name_tok, Number_tok, @@ -195,6 +193,7 @@ typedef struct VARSTRUCT { struct VARSTRUCT *VarLeft, *VarRight; char VarRep[1]; } VarEntry; +*/ /* Character types for tokenizer and write.c */ @@ -325,8 +324,7 @@ Atom STD_PROTO(Yap_LookupWideAtom,(wchar_t *)); #define Unfold_cyclics_f 0x20 #define Use_SWI_Stream_f 0x40 -/* write.c */ -void STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int)); + /* grow.c */ int STD_PROTO(Yap_growheap_in_parser, (tr_fr_ptr *, TokEntry **, VarEntry **)); @@ -386,32 +384,4 @@ WideHashFunction(wchar_t *CHP) #define CONTINUE_ON_PARSER_ERROR 2 #define EXCEPTION_ON_PARSER_ERROR 3 -#ifdef THREADS -#define Yap_IOBotch Yap_thread_gl[worker_id].io_botch -#define Yap_tokptr Yap_thread_gl[worker_id].tokptr -#define Yap_toktide Yap_thread_gl[worker_id].toktide -#define Yap_VarTable Yap_thread_gl[worker_id].var_table -#define Yap_AnonVarTable Yap_thread_gl[worker_id].anon_var_table -#define Yap_eot_before_eof Yap_thread_gl[worker_id].eot_before_eof -#define Yap_FileNameBuf Yap_thread_gl[worker_id].file_name_buf -#define Yap_FileNameBuf2 Yap_thread_gl[worker_id].file_name_buf2 -#else -extern jmp_buf Yap_IOBotch; - -/*************** variables concerned with parsing *********************/ -extern TokEntry *Yap_tokptr, *Yap_toktide; -extern VarEntry *Yap_VarTable, *Yap_AnonVarTable; -extern int Yap_eot_before_eof; - -extern char Yap_FileNameBuf[YAP_FILENAME_MAX], Yap_FileNameBuf2[YAP_FILENAME_MAX]; - -#endif - -#ifdef DEBUG -extern YP_FILE *Yap_logfile; -#endif - -#if USE_SOCKET -extern int Yap_sockets_io; -#endif diff --git a/Makefile.in b/Makefile.in index 7004a0e57..c7605f31e 100755 --- a/Makefile.in +++ b/Makefile.in @@ -260,7 +260,7 @@ C_SOURCES= \ $(srcdir)/BEAM/eam_am.c $(srcdir)/BEAM/eam_showcode.c \ $(srcdir)/BEAM/eamindex.c $(srcdir)/BEAM/eamamasm.c \ $(srcdir)/BEAM/eam_gc.c $(srcdir)/BEAM/eam_split.c \ - $(srcdir)/OPTYap/opt.memory.c $(srcdir)/OPTYap/opt.init.c \ + $(srcdir)/OPTYap/or.memory.c $(srcdir)/OPTYap/opt.init.c \ $(srcdir)/OPTYap/opt.preds.c $(srcdir)/OPTYap/or.copy_engine.c \ $(srcdir)/OPTYap/or.cow_engine.c $(srcdir)/OPTYap/or.sba_engine.c \ $(srcdir)/OPTYap/or.thread_engine.c \ @@ -378,7 +378,7 @@ C_INTERFACE_OBJECTS = \ c_interface.o clause_list.o OR_OBJECTS = \ - opt.memory.o opt.init.o opt.preds.o \ + or.memory.o opt.init.o opt.preds.o \ or.copy_engine.o or.cow_engine.o or.sba_engine.o or.thread_engine.o \ or.scheduler.o or.cut.o \ tab.tries.o tab.completion.o @@ -489,8 +489,8 @@ myddas_wkb2prolog.o: $(srcdir)/MYDDAS/myddas_wkb2prolog.c config.h myddas_statistics.o: $(srcdir)/MYDDAS/myddas_statistics.c config.h $(CC) -c $(CFLAGS) $(srcdir)/MYDDAS/myddas_statistics.c -o $@ -opt.memory.o: $(srcdir)/OPTYap/opt.memory.c config.h - $(CC) -c $(CFLAGS) $(srcdir)/OPTYap/opt.memory.c -o $@ +or.memory.o: $(srcdir)/OPTYap/or.memory.c config.h + $(CC) -c $(CFLAGS) $(srcdir)/OPTYap/or.memory.c -o $@ opt.init.o: $(srcdir)/OPTYap/opt.init.c config.h $(CC) -c $(CFLAGS) $(srcdir)/OPTYap/opt.init.c -o $@ diff --git a/OPTYap/opt.config.h b/OPTYap/opt.config.h index e754769df..fc5ef710d 100644 --- a/OPTYap/opt.config.h +++ b/OPTYap/opt.config.h @@ -17,9 +17,9 @@ ** General Configuration Parameters ** ************************************************************************/ -/**************************************************************** -** use shared pages memory alloc scheme ? (optional) ** -****************************************************************/ +/****************************************************************************************** +** use shared pages memory alloc scheme for OPTYap data structures? (optional) ** +******************************************************************************************/ /* #define USE_PAGES_MALLOC 1 */ @@ -92,7 +92,7 @@ ** memory mapping scheme (mandatory, define one) ** ************************************************************/ #define MMAP_MEMORY_MAPPING_SCHEME 1 -/* #define SHM_MEMORY_MAPPING_SCHEME 1 */ +/* #define SHM_MEMORY_MAPPING_SCHEME 1 */ /************************************************* ** enable error checking ? (optional) ** diff --git a/OPTYap/opt.init.c b/OPTYap/opt.init.c index 2ac50e796..7ea4ef886 100644 --- a/OPTYap/opt.init.c +++ b/OPTYap/opt.init.c @@ -71,8 +71,8 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop #endif /* LIMIT_TABLING */ INIT_PAGES(GLOBAL_pages_void, void *); #ifdef YAPOR - INIT_PAGES(GLOBAL_pages_or_fr , struct or_frame); - INIT_PAGES(GLOBAL_pages_qg_sol_fr , struct query_goal_solution_frame); + INIT_PAGES(GLOBAL_pages_or_fr, struct or_frame); + INIT_PAGES(GLOBAL_pages_qg_sol_fr, struct query_goal_solution_frame); INIT_PAGES(GLOBAL_pages_qg_ans_fr, struct query_goal_answer_frame); #endif /* YAPOR */ #ifdef TABLING_INNER_CUTS @@ -164,7 +164,7 @@ void Yap_init_local_optyap_data(int wid) { #ifdef YAPOR CACHE_REGS /* local data related to or-parallelism */ - Set_REMOTE_top_cp(wid, (choiceptr) Yap_LocalBase); + Set_REMOTE_top_cp(wid, (choiceptr) LOCAL_LocalBase); REMOTE_top_or_fr(wid) = GLOBAL_root_or_fr; REMOTE_load(wid) = 0; REMOTE_share_request(wid) = MAX_WORKERS; @@ -173,15 +173,16 @@ void Yap_init_local_optyap_data(int wid) { INIT_LOCK(REMOTE_lock_signals(wid)); #endif /* YAPOR_COPY */ Set_REMOTE_prune_request(wid, NULL); -#endif /* YAPOR */ INIT_LOCK(REMOTE_lock(wid)); +#endif /* YAPOR */ + #ifdef TABLING /* local data related to tabling */ REMOTE_next_free_ans_node(wid) = NULL; REMOTE_top_sg_fr(wid) = NULL; REMOTE_top_dep_fr(wid) = GLOBAL_root_dep_fr; #ifdef YAPOR - Set_REMOTE_top_cp_on_stack(wid, (choiceptr) Yap_LocalBase); /* ??? */ + Set_REMOTE_top_cp_on_stack(wid, (choiceptr) LOCAL_LocalBase); /* ??? */ REMOTE_top_susp_or_fr(wid) = GLOBAL_root_or_fr; #endif /* YAPOR */ #endif /* TABLING */ @@ -198,7 +199,7 @@ void Yap_init_root_frames(void) { INIT_LOCK(OrFr_lock(or_fr)); OrFr_alternative(or_fr) = NULL; BITMAP_copy(OrFr_members(or_fr), GLOBAL_bm_present_workers); - SetOrFr_node(or_fr, (choiceptr) Yap_LocalBase); + SetOrFr_node(or_fr, (choiceptr) LOCAL_LocalBase); OrFr_nearest_livenode(or_fr) = NULL; OrFr_depth(or_fr) = 0; Set_OrFr_pend_prune_cp(or_fr, NULL); diff --git a/OPTYap/opt.macros.h b/OPTYap/opt.macros.h index a37814923..937e0627d 100644 --- a/OPTYap/opt.macros.h +++ b/OPTYap/opt.macros.h @@ -173,7 +173,7 @@ extern int Yap_page_size; /* see function 'InteractSIGINT' in file 'sysbits.c' */ \ /* Yap_Error(PURE_ABORT, TermNil, ""); */ \ /* restore_absmi_regs(&Yap_standard_regs); */ \ - /* siglongjmp (Yap_RestartEnv, 1); */ \ + /* siglongjmp (LOCAL_RestartEnv, 1); */ \ if (SgFr_first_answer(sg_fr) && \ SgFr_first_answer(sg_fr) != SgFr_answer_trie(sg_fr)) { \ SgFr_state(sg_fr) = ready; \ @@ -263,7 +263,7 @@ extern int Yap_page_size; ** USE_PAGES_MALLOC && ! LIMIT_TABLING ** *************************************************************************************************/ #define ALLOC_PAGE(PG_HD) \ - LOCK(Pg_lock(GLOBAL_pages_void)); \ + LOCK(Pg_lock(GLOBAL_pages_void)); \ if (Pg_free_pg(GLOBAL_pages_void) == NULL) { \ int i, shmid; \ pg_hd_ptr pg_hd, aux_pg_hd; \ @@ -457,7 +457,7 @@ extern int Yap_page_size; ************************************************************************/ #define INFORMATION_MESSAGE(MESSAGE,ARGS...) \ - fprintf(stderr, "[ " MESSAGE " ]\n", ##ARGS) + Sfprintf(Serror, "[ " MESSAGE " ]\n", ##ARGS) #ifdef YAPOR #define ERROR_MESSAGE(MESSAGE) \ diff --git a/OPTYap/opt.memory.c b/OPTYap/opt.memory.c deleted file mode 100644 index e755fb77a..000000000 --- a/OPTYap/opt.memory.c +++ /dev/null @@ -1,274 +0,0 @@ -/************************************************************************ -** ** -** The YapTab/YapOr/OPTYap systems ** -** ** -** YapTab extends the Yap Prolog engine to support sequential tabling ** -** YapOr extends the Yap Prolog engine to support or-parallelism ** -** OPTYap extends the Yap Prolog engine to support or-parallel tabling ** -** ** -** ** -** Yap Prolog was developed at University of Porto, Portugal ** -** ** -************************************************************************/ - -/************************************** -** Includes & Declarations ** -**************************************/ - -#include "Yap.h" -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include "Yatom.h" -#include "YapHeap.h" -#include "alloc.h" -#include "heapgc.h" -#include "or.macros.h" - - - -/************************************ -** Macros & Declarations ** -************************************/ - -#define KBYTES 1024 - -#ifdef MMAP_MEMORY_MAPPING_SCHEME -int fd_mapfile; -#else /* SHM_MEMORY_MAPPING_SCHEME */ -int shm_mapid[MAX_WORKERS + 1]; -#endif /* MEMORY_MAPPING_SCHEME */ - - - -/****************************************** -** Local functions declaration ** -******************************************/ - -#ifdef MMAP_MEMORY_MAPPING_SCHEME -void open_mapfile(long TotalArea); -#else /* SHM_MEMORY_MAPPING_SCHEME */ -void shm_map_memory(int id, int size, void *shmaddr); -#endif /* MEMORY_MAPPING_SCHEME */ - - - -/******************************** -** Global functions ** -********************************/ - -void Yap_init_optyap_memory(long TrailAuxArea, long HeapArea, long GlobalLocalArea, int n_workers) { -#ifdef YAPOR_COW - int private_fd_mapfile; -#if MMAP_MEMORY_MAPPING_SCHEME - long TotalArea; -#endif /* MMAP_MEMORY_MAPPING_SCHEME */ -#else /* YAPOR_COPY || YAPOR_SBA */ - long TotalArea; -#endif - long ExtraArea; - - HeapArea = ADJUST_SIZE_TO_PAGE(HeapArea); - GlobalLocalArea = ADJUST_SIZE(GlobalLocalArea); - TrailAuxArea = ADJUST_SIZE(TrailAuxArea); - - /* initial allocation - model independent */ - ExtraArea = ADJUST_SIZE_TO_PAGE(sizeof(struct global_data) + MAX_WORKERS * sizeof(struct worker_local)); - Yap_local = (struct worker_local *)(MMAP_ADDR - ExtraArea); - Yap_global = (struct global_data *)(MMAP_ADDR - sizeof(struct global_data)); - Yap_HeapBase = (ADDR) MMAP_ADDR; - Yap_GlobalBase = (ADDR) (MMAP_ADDR + HeapArea); - - /* shared memory allocation - model dependent */ -#ifdef YAPOR_COW - /* acow just needs one stack */ -#ifdef MMAP_MEMORY_MAPPING_SCHEME - /* I need this for MMAP to know what it must allocate */ - TotalArea = HeapArea; -#endif /* MMAP_MEMORY_MAPPING_SCHEME */ -#else /* YAPOR_COPY || YAPOR_SBA */ - /* the others need n stacks */ - Yap_worker_area_size = ADJUST_SIZE_TO_PAGE(GlobalLocalArea + TrailAuxArea); - TotalArea = ExtraArea + HeapArea + Yap_worker_area_size * n_workers; -#endif - -#ifdef MMAP_MEMORY_MAPPING_SCHEME - /* map total area in a single go */ - open_mapfile(TotalArea); - if (mmap((void *) Yap_local, (size_t) TotalArea, PROT_READ|PROT_WRITE, MAP_SHARED|MAP_FIXED, fd_mapfile, 0) == (void *) -1) - Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_init_optyap_memory)"); -#else /* SHM_MEMORY_MAPPING_SCHEME */ - /* most systems are limited regarding what we can allocate */ -#ifdef YAPOR_COW - /* single shared segment in ACOW */ - shm_map_memory(0, ExtraArea + HeapArea, (void *) MMAP_ADDR); -#else /* YAPOR_COPY || YAPOR_SBA */ - /* place as segment n otherwise (0..n-1 reserved for worker areas */ - shm_map_memory(n_workers, ExtraArea + HeapArea, (void *) Yap_local); - { int i; - for (i = 0; i < n_workers; i++) - shm_map_memory(i, Yap_worker_area_size, Yap_GlobalBase + Yap_worker_area_size * i); - } -#endif -#endif /* MEMORY_MAPPING_SCHEME */ - -#ifdef YAPOR_COW - /* just allocate local space for stacks */ - if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0) - Yap_Error(FATAL_ERROR, TermNil, "open error (Yap_init_optyap_memory)"); - if (mmap(Yap_GlobalBase, GlobalLocalArea + TrailAuxArea, PROT_READ|PROT_WRITE, - MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1) - Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_init_optyap_memory)"); - close(private_fd_mapfile); -#endif /* YAPOR_COW */ - -#ifdef YAPOR_SBA - /* alloc space for the sparse binding array */ - sba_size = Yap_worker_area_size * n_workers; - if ((binding_array = (char *)malloc(sba_size)) == NULL) - Yap_Error(FATAL_ERROR, TermNil, "malloc error (Yap_init_optyap_memory)"); - if ((CELL)binding_array & MBIT) { - Yap_Error(INTERNAL_ERROR, TermNil, "binding_array start address conflicts with tag used in IDB (Yap_init_optyap_memory)"); - } - sba_offset = binding_array - Yap_GlobalBase; - sba_end = (int)binding_array + sba_size; -#endif /* YAPOR_SBA */ - - Yap_TrailBase = Yap_GlobalBase + GlobalLocalArea; - Yap_LocalBase = Yap_TrailBase - CellSize; - if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */ - Yap_TrailTop = Yap_TrailBase + (TrailAuxArea - 131072); /* 131072 = 262144 / 2 */ - else - Yap_TrailTop = Yap_TrailBase + (TrailAuxArea / 2); - HeapMax = (CELL)(Yap_TrailBase + (TrailAuxArea - CellSize)); - - Yap_InitHeap(Yap_HeapBase); -} - - - -void Yap_remap_optyap_memory(void) { -#ifdef YAPOR_SBA - /* setup workers so that they have different areas */ - Yap_GlobalBase += worker_id * Yap_worker_area_size; - Yap_TrailBase += worker_id * Yap_worker_area_size; - Yap_LocalBase += worker_id * Yap_worker_area_size; - Yap_TrailTop += worker_id * Yap_worker_area_size; -#endif /* YAPOR_SBA */ - -#ifdef YAPOR_COPY - int i; - void *remap_addr = Yap_GlobalBase; -#ifdef MMAP_MEMORY_MAPPING_SCHEME - long remap_offset = (ADDR) remap_addr - (ADDR) Yap_local; - if (munmap(remap_addr, (size_t)(Yap_worker_area_size * GLOBAL_number_workers)) == -1) - Yap_Error(FATAL_ERROR, TermNil, "munmap error (Yap_remap_optyap_memory)"); - for (i = 0; i < GLOBAL_number_workers; i++) - if (mmap(remap_addr + worker_offset(i), (size_t)Yap_worker_area_size, PROT_READ|PROT_WRITE, - MAP_SHARED|MAP_FIXED, fd_mapfile, remap_offset + i * Yap_worker_area_size) == (void *) -1) - Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_remap_optyap_memory)"); -#else /* SHM_MEMORY_MAPPING_SCHEME */ - for (i = 0; i < GLOBAL_number_workers; i++) - if (shmdt(remap_addr + Yap_worker_area_size * i) == -1) - Yap_Error(FATAL_ERROR, TermNil, "shmdt error (Yap_remap_optyap_memory)"); - for (i = 0; i < GLOBAL_number_workers; i++) - if(shmat(shm_mapid[i], remap_addr + worker_offset(i), 0) == (void *) -1) - Yap_Error(FATAL_ERROR, TermNil, "shmat error (Yap_remap_optyap_memory)"); -#endif /* MEMORY_MAPPING_SCHEME */ -#endif /* YAPOR_COPY */ -} - - -void Yap_unmap_optyap_memory (void) { -#ifdef MMAP_MEMORY_MAPPING_SCHEME - char MapFile[20]; -#else /* SHM_MEMORY_MAPPING_SCHEME */ - int i; -#endif /* MEMORY_MAPPING_SCHEME */ - int proc; - - INFORMATION_MESSAGE("Worker %d exiting...", worker_id); - for (proc = 0; proc < GLOBAL_number_workers; proc++) { - if (proc != worker_id && GLOBAL_worker_pid(proc) != 0) { - if (kill(GLOBAL_worker_pid(proc), SIGKILL) != 0) - INFORMATION_MESSAGE("Can't kill process %d", GLOBAL_worker_pid(proc)); - else - INFORMATION_MESSAGE("Killing process %d", GLOBAL_worker_pid(proc)); - } - } - -#ifdef YAPOR_COW - if (GLOBAL_number_workers > 1) { - if (kill(GLOBAL_master_worker, SIGINT) != 0) - INFORMATION_MESSAGE("Can't kill process %d", GLOBAL_master_worker); - else - INFORMATION_MESSAGE("Killing process %d", GLOBAL_master_worker); - } -#endif /* YAPOR_COW */ - - -#ifdef MMAP_MEMORY_MAPPING_SCHEME - strcpy(MapFile,"./mapfile"); -#ifdef YAPOR_COW - itos(GLOBAL_master_worker, &MapFile[9]); -#else /* YAPOR_COPY || YAPOR_SBA */ - itos(GLOBAL_worker_pid(0), &MapFile[9]); -#endif - if (remove(MapFile) == 0) - INFORMATION_MESSAGE("Removing mapfile \"%s\"", MapFile); - else - INFORMATION_MESSAGE("Can't remove mapfile \"%s\"", MapFile); -#else /* SHM_MEMORY_MAPPING_SCHEME */ -#ifdef YAPOR_COW - i = 0; -#else /* YAPOR_COPY || YAPOR_SBA */ - for (i = 0; i < GLOBAL_number_workers + 1; i++) -#endif - { - if (shmctl(shm_mapid[i], IPC_RMID, 0) == 0) - INFORMATION_MESSAGE("Removing shared memory segment %d", shm_mapid[i]); - else - INFORMATION_MESSAGE("Can't remove shared memory segment %d", shm_mapid[i]); - } -#endif /* MEMORY_MAPPING_SCHEME */ - return; -} - - - -/* ------------------------- ** -** Local functions ** -** ------------------------- */ - -#ifdef MMAP_MEMORY_MAPPING_SCHEME -void open_mapfile(long TotalArea) { - char mapfile[20]; - strcpy(mapfile,"./mapfile"); - itos(getpid(), &mapfile[9]); - if ((fd_mapfile = open(mapfile, O_RDWR|O_CREAT|O_TRUNC, 0666)) < 0) - Yap_Error(FATAL_ERROR, TermNil, "open error (open_mapfile)"); - if (lseek(fd_mapfile, TotalArea, SEEK_SET) < 0) - Yap_Error(FATAL_ERROR, TermNil, "lseek error (open_mapfile)"); - if (write(fd_mapfile, "", 1) < 0) - Yap_Error(FATAL_ERROR, TermNil, "write error (open_mapfile)"); - return; -} -#else /* SHM_MEMORY_MAPPING_SCHEME */ -void shm_map_memory(int id, int size, void *shmaddr) { - if (size > SHMMAX) - Yap_Error(FATAL_ERROR, TermNil, "maximum size for a shm segment exceeded (shm_map_memory)"); - if ((shm_mapid[id] = shmget(IPC_PRIVATE, size, SHM_R|SHM_W)) == -1) - Yap_Error(FATAL_ERROR, TermNil, "shmget error (shm_map_memory)"); - if (shmat(shm_mapid[id], shmaddr, 0) == (void *) -1) - Yap_Error(FATAL_ERROR, TermNil, "shmat error (shm_map_memory)"); - return; -} -#endif /* MMAP_MEMORY_MAPPING_SCHEME */ -#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index ca5a502fc..3e23b36f1 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -17,14 +17,13 @@ #include "Yap.h" #if defined(YAPOR) || defined(TABLING) -#include +#include "Yatom.h" +#include "YapHeap.h" +#include "SWI-Prolog.h" +#ifdef YAPOR #if HAVE_STRING_H #include #endif /* HAVE_STRING_H */ -#include "Yatom.h" -#include "YapHeap.h" -#include "yapio.h" -#ifdef YAPOR #if HAVE_SYS_TIME_H #include #endif /* HAVE_SYS_TIME_H */ @@ -43,9 +42,11 @@ static Int p_table( USES_REGS1 ); static Int p_tabling_mode( USES_REGS1 ); static Int p_abolish_table( USES_REGS1 ); static Int p_abolish_all_tables( USES_REGS1 ); +static Int p_abolish_all_local_tables( USES_REGS1 ); static Int p_show_tabled_predicates( USES_REGS1 ); static Int p_show_table( USES_REGS1 ); static Int p_show_all_tables( USES_REGS1 ); +static Int p_show_all_local_tables( USES_REGS1 ); static Int p_show_global_trie( USES_REGS1 ); static Int p_show_statistics_table( USES_REGS1 ); static Int p_show_statistics_tabling( USES_REGS1 ); @@ -76,26 +77,26 @@ static inline void answer_to_stdout(char *answer); #endif /* YAPOR */ #ifdef TABLING -static inline long show_statistics_table_entries(void); -static inline long show_statistics_subgoal_frames(void); -static inline long show_statistics_dependency_frames(void); -static inline long show_statistics_subgoal_trie_nodes(void); -static inline long show_statistics_answer_trie_nodes(void); -static inline long show_statistics_subgoal_trie_hashes(void); -static inline long show_statistics_answer_trie_hashes(void); -static inline long show_statistics_global_trie_nodes(void); -static inline long show_statistics_global_trie_hashes(void); +static inline long show_statistics_table_entries(IOSTREAM *out); +static inline long show_statistics_subgoal_frames(IOSTREAM *out); +static inline long show_statistics_dependency_frames(IOSTREAM *out); +static inline long show_statistics_subgoal_trie_nodes(IOSTREAM *out); +static inline long show_statistics_answer_trie_nodes(IOSTREAM *out); +static inline long show_statistics_subgoal_trie_hashes(IOSTREAM *out); +static inline long show_statistics_answer_trie_hashes(IOSTREAM *out); +static inline long show_statistics_global_trie_nodes(IOSTREAM *out); +static inline long show_statistics_global_trie_hashes(IOSTREAM *out); #endif /* TABLING */ #ifdef YAPOR -static inline long show_statistics_or_frames(void); -static inline long show_statistics_query_goal_solution_frames(void); -static inline long show_statistics_query_goal_answer_frames(void); +static inline long show_statistics_or_frames(IOSTREAM *out); +static inline long show_statistics_query_goal_solution_frames(IOSTREAM *out); +static inline long show_statistics_query_goal_answer_frames(IOSTREAM *out); #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) -static inline long show_statistics_suspension_frames(void); +static inline long show_statistics_suspension_frames(IOSTREAM *out); #ifdef TABLING_INNER_CUTS -static inline long show_statistics_table_subgoal_solution_frames(void); -static inline long show_statistics_table_subgoal_answer_frames(void); +static inline long show_statistics_table_subgoal_solution_frames(IOSTREAM *out); +static inline long show_statistics_table_subgoal_answer_frames(IOSTREAM *out); #endif /* TABLING_INNER_CUTS */ #endif /* YAPOR && TABLING */ @@ -129,13 +130,15 @@ void Yap_init_optyap_preds(void) { Yap_InitCPred("$c_tabling_mode", 3, p_tabling_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$c_abolish_table", 2, p_abolish_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("abolish_all_tables", 0, p_abolish_all_tables, SafePredFlag|SyncPredFlag); - Yap_InitCPred("show_tabled_predicates", 0, p_show_tabled_predicates, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_show_table", 2, p_show_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("show_all_tables", 0, p_show_all_tables, SafePredFlag|SyncPredFlag); - Yap_InitCPred("show_global_trie", 0, p_show_global_trie, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$c_table_statistics", 2, p_show_statistics_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("tabling_statistics", 0, p_show_statistics_tabling, SafePredFlag|SyncPredFlag); - Yap_InitCPred("global_trie_statistics", 0, p_show_statistics_global_trie, SafePredFlag|SyncPredFlag); + Yap_InitCPred("abolish_all_local_tables", 0, p_abolish_all_local_tables, SafePredFlag|SyncPredFlag); + Yap_InitCPred("show_tabled_predicates", 1, p_show_tabled_predicates, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$c_show_table", 3, p_show_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("show_all_tables", 1, p_show_all_tables, SafePredFlag|SyncPredFlag); + Yap_InitCPred("show_all_local_tables", 1, p_show_all_local_tables, SafePredFlag|SyncPredFlag); + Yap_InitCPred("show_global_trie", 1, p_show_global_trie, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$c_table_statistics", 3, p_show_statistics_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("tabling_statistics", 1, p_show_statistics_tabling, SafePredFlag|SyncPredFlag); + Yap_InitCPred("global_trie_statistics", 1, p_show_statistics_global_trie, SafePredFlag|SyncPredFlag); #endif /* TABLING */ Yap_InitCPred("$c_yapor_threads", 1, p_yapor_threads, SafePredFlag|SyncPredFlag|HiddenPredFlag); #ifdef YAPOR @@ -147,10 +150,10 @@ void Yap_init_optyap_preds(void) { Yap_InitCPred("performance", 1, p_performance, SafePredFlag|SyncPredFlag); Yap_InitCPred("$c_parallel_new_answer", 1, p_parallel_new_answer, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$c_parallel_yes_answer", 0, p_parallel_yes_answer, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("or_statistics", 0, p_show_statistics_or, SafePredFlag|SyncPredFlag); + Yap_InitCPred("or_statistics", 1, p_show_statistics_or, SafePredFlag|SyncPredFlag); #endif /* YAPOR */ #if defined(YAPOR) && defined(TABLING) - Yap_InitCPred("opt_statistics", 0, p_show_statistics_opt, SafePredFlag|SyncPredFlag); + Yap_InitCPred("opt_statistics", 1, p_show_statistics_opt, SafePredFlag|SyncPredFlag); #endif /* YAPOR && TABLING */ Yap_InitCPred("$c_get_optyap_statistics", 3, p_get_optyap_statistics, SafePredFlag|SyncPredFlag|HiddenPredFlag); } @@ -384,16 +387,29 @@ static Int p_abolish_all_tables( USES_REGS1 ) { } +static Int p_abolish_all_local_tables( USES_REGS1 ) { +#ifdef THREADS + +#else + p_abolish_all_tables(); +#endif /* THREADS */ + return (TRUE); +} + + static Int p_show_tabled_predicates( USES_REGS1 ) { + IOSTREAM *out; tab_ent_ptr tab_ent; + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); tab_ent = GLOBAL_root_tab_ent; - fprintf(Yap_stdout, "Tabled predicates\n"); + Sfprintf(out, "Tabled predicates\n"); if (tab_ent == NULL) - fprintf(Yap_stdout, " NONE\n"); + Sfprintf(out, " NONE\n"); else while(tab_ent) { - fprintf(Yap_stdout, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + Sfprintf(out, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); tab_ent = TabEnt_next(tab_ent); } return (TRUE); @@ -401,96 +417,124 @@ static Int p_show_tabled_predicates( USES_REGS1 ) { static Int p_show_table( USES_REGS1 ) { + IOSTREAM *out; Term mod, t; tab_ent_ptr tab_ent; - mod = Deref(ARG1); - t = Deref(ARG2); + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); + mod = Deref(ARG2); + t = Deref(ARG3); if (IsAtomTerm(t)) tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred; else if (IsApplTerm(t)) tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; else return (FALSE); - show_table(tab_ent, SHOW_MODE_STRUCTURE); + show_table(tab_ent, SHOW_MODE_STRUCTURE, out); return (TRUE); } static Int p_show_all_tables( USES_REGS1 ) { + IOSTREAM *out; tab_ent_ptr tab_ent; + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); tab_ent = GLOBAL_root_tab_ent; while(tab_ent) { - show_table(tab_ent, SHOW_MODE_STRUCTURE); + show_table(tab_ent, SHOW_MODE_STRUCTURE, out); tab_ent = TabEnt_next(tab_ent); } return (TRUE); } +static Int p_show_all_local_tables( USES_REGS1 ) { +#ifdef THREADS + +#else + p_show_all_tables(); +#endif /* THREADS */ + return (TRUE); +} + + static Int p_show_global_trie( USES_REGS1 ) { - show_global_trie(SHOW_MODE_STRUCTURE); + IOSTREAM *out; + + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); + show_global_trie(SHOW_MODE_STRUCTURE, out); return (TRUE); } static Int p_show_statistics_table( USES_REGS1 ) { + IOSTREAM *out; Term mod, t; tab_ent_ptr tab_ent; - mod = Deref(ARG1); - t = Deref(ARG2); + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); + mod = Deref(ARG2); + t = Deref(ARG3); if (IsAtomTerm(t)) tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred; else if (IsApplTerm(t)) tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; else return (FALSE); - show_table(tab_ent, SHOW_MODE_STATISTICS); + show_table(tab_ent, SHOW_MODE_STATISTICS, out); return (TRUE); } static Int p_show_statistics_tabling( USES_REGS1 ) { + IOSTREAM *out; long total_bytes = 0, aux_bytes; + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); aux_bytes = 0; - fprintf(Yap_stdout, "Execution data structures\n"); - aux_bytes += show_statistics_table_entries(); - aux_bytes += show_statistics_subgoal_frames(); - aux_bytes += show_statistics_dependency_frames(); - fprintf(Yap_stdout, " Memory in use (I): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Execution data structures\n"); + aux_bytes += show_statistics_table_entries(out); + aux_bytes += show_statistics_subgoal_frames(out); + aux_bytes += show_statistics_dependency_frames(out); + Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; aux_bytes = 0; - fprintf(Yap_stdout, "Local trie data structures\n"); - aux_bytes += show_statistics_subgoal_trie_nodes(); - aux_bytes += show_statistics_answer_trie_nodes(); - aux_bytes += show_statistics_subgoal_trie_hashes(); - aux_bytes += show_statistics_answer_trie_hashes(); - fprintf(Yap_stdout, " Memory in use (II): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Local trie data structures\n"); + aux_bytes += show_statistics_subgoal_trie_nodes(out); + aux_bytes += show_statistics_answer_trie_nodes(out); + aux_bytes += show_statistics_subgoal_trie_hashes(out); + aux_bytes += show_statistics_answer_trie_hashes(out); + Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; aux_bytes = 0; - fprintf(Yap_stdout, "Global trie data structures\n"); - aux_bytes += show_statistics_global_trie_nodes(); - aux_bytes += show_statistics_global_trie_hashes(); - fprintf(Yap_stdout, " Memory in use (III): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Global trie data structures\n"); + aux_bytes += show_statistics_global_trie_nodes(out); + aux_bytes += show_statistics_global_trie_hashes(out); + Sfprintf(out, " Memory in use (III): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; #ifdef USE_PAGES_MALLOC - fprintf(Yap_stdout, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n", + Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n", total_bytes, Pg_str_in_use(GLOBAL_pages_void)); - fprintf(Yap_stdout, "Total memory allocated: %10ld bytes (%ld pages in total)\n", + Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size, Pg_pg_alloc(GLOBAL_pages_void)); #else - fprintf(Yap_stdout, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes); + Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ - fflush(Yap_stdout); - return (TRUE); } static Int p_show_statistics_global_trie( USES_REGS1 ) { - show_global_trie(SHOW_MODE_STATISTICS); + IOSTREAM *out; + + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); + show_global_trie(SHOW_MODE_STATISTICS, out); return (TRUE); } #endif /* TABLING */ @@ -640,32 +684,33 @@ static Int p_performance( USES_REGS1 ) { return(FALSE); if (GLOBAL_number_goals) { - fprintf(Yap_stdout, "[\n Best execution times:\n"); + Sfprintf(Soutput, "[\n Best execution times:\n"); for (i = 1; i <= GLOBAL_number_goals; i++) { - fprintf(Yap_stdout, " %d. time: %f seconds", i, GLOBAL_best_times(i)); + Sfprintf(Soutput, " %d. time: %f seconds", i, GLOBAL_best_times(i)); if (one_worker_execution_time != 0) - fprintf(Yap_stdout, " --> speedup %f (%6.2f %% )\n", + Sfprintf(Soutput, " --> speedup %f (%6.2f %% )\n", one_worker_execution_time / GLOBAL_best_times(i), one_worker_execution_time / GLOBAL_best_times(i) / GLOBAL_number_workers* 100 ); - else fprintf(Yap_stdout, "\n"); + else Sfprintf(Soutput, "\n"); } - fprintf(Yap_stdout, " Average : %f seconds", + Sfprintf(Soutput, " Average : %f seconds", GLOBAL_best_times(0) / GLOBAL_number_goals); if (one_worker_execution_time != 0) - fprintf(Yap_stdout, " --> speedup %f (%6.2f %% )", + Sfprintf(Soutput, " --> speedup %f (%6.2f %% )", one_worker_execution_time * GLOBAL_number_goals / GLOBAL_best_times(0), one_worker_execution_time * GLOBAL_number_goals / GLOBAL_best_times(0) / GLOBAL_number_workers* 100 ); if (GLOBAL_number_goals >= 3) { - fprintf(Yap_stdout, "\n Average (best three): %f seconds", + Sfprintf(Soutput, "\n Average (best three): %f seconds", (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)) / 3); if (one_worker_execution_time != 0) - fprintf(Yap_stdout, " --> speedup %f (%6.2f %% ) ]\n\n", + Sfprintf(Soutput, " --> speedup %f (%6.2f %% ) ]\n\n", one_worker_execution_time * 3 / (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)), one_worker_execution_time * 3 / (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)) / GLOBAL_number_workers* 100 ); - else fprintf(Yap_stdout, "\n]\n\n"); - } else fprintf(Yap_stdout, "\n]\n\n"); + else Sfprintf(Soutput, "\n]\n\n"); + } else Sfprintf(Soutput, "\n]\n\n"); + Sflush(Soutput); return (TRUE); } return (FALSE); @@ -700,28 +745,30 @@ static Int p_parallel_yes_answer( USES_REGS1 ) { static Int p_show_statistics_or( USES_REGS1 ) { + IOSTREAM *out; long total_bytes = 0, aux_bytes; + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); aux_bytes = 0; - fprintf(Yap_stdout, "Execution data structures\n"); - aux_bytes += show_statistics_or_frames(); - fprintf(Yap_stdout, " Memory in use (I): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Execution data structures\n"); + aux_bytes += show_statistics_or_frames(out); + Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; aux_bytes = 0; - fprintf(Yap_stdout, "Cut support data structures\n"); - aux_bytes += show_statistics_query_goal_solution_frames(); - aux_bytes += show_statistics_query_goal_answer_frames(); - fprintf(Yap_stdout, " Memory in use (II): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Cut support data structures\n"); + aux_bytes += show_statistics_query_goal_solution_frames(out); + aux_bytes += show_statistics_query_goal_answer_frames(out); + Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; #ifdef USE_PAGES_MALLOC - fprintf(Yap_stdout, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n", + Sfprintf(out, "Total memory in use (I+II): %10ld bytes (%ld pages in use)\n", total_bytes, Pg_str_in_use(GLOBAL_pages_void)); - fprintf(Yap_stdout, "Total memory allocated: %10ld bytes (%ld pages in total)\n", + Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size, Pg_pg_alloc(GLOBAL_pages_void)); #else - fprintf(Yap_stdout, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes); + Sfprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ - return (TRUE); } #endif /* YAPOR */ @@ -734,50 +781,52 @@ static Int p_show_statistics_or( USES_REGS1 ) { #if defined(YAPOR) && defined(TABLING) static Int p_show_statistics_opt( USES_REGS1 ) { + IOSTREAM *out; long total_bytes = 0, aux_bytes; + if ((out = YAP_TermToStream(Deref(ARG1))) == NULL) + return (FALSE); aux_bytes = 0; - fprintf(Yap_stdout, "Execution data structures\n"); - aux_bytes += show_statistics_table_entries(); - aux_bytes += show_statistics_subgoal_frames(); - aux_bytes += show_statistics_dependency_frames(); - aux_bytes += show_statistics_or_frames(); - aux_bytes += show_statistics_suspension_frames(); - fprintf(Yap_stdout, " Memory in use (I): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Execution data structures\n"); + aux_bytes += show_statistics_table_entries(out); + aux_bytes += show_statistics_subgoal_frames(out); + aux_bytes += show_statistics_dependency_frames(out); + aux_bytes += show_statistics_or_frames(out); + aux_bytes += show_statistics_suspension_frames(out); + Sfprintf(out, " Memory in use (I): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; aux_bytes = 0; - fprintf(Yap_stdout, "Local trie data structures\n"); - aux_bytes += show_statistics_subgoal_trie_nodes(); - aux_bytes += show_statistics_answer_trie_nodes(); - aux_bytes += show_statistics_subgoal_trie_hashes(); - aux_bytes += show_statistics_answer_trie_hashes(); - fprintf(Yap_stdout, " Memory in use (II): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Local trie data structures\n"); + aux_bytes += show_statistics_subgoal_trie_nodes(out); + aux_bytes += show_statistics_answer_trie_nodes(out); + aux_bytes += show_statistics_subgoal_trie_hashes(out); + aux_bytes += show_statistics_answer_trie_hashes(out); + Sfprintf(out, " Memory in use (II): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; aux_bytes = 0; - fprintf(Yap_stdout, "Global trie data structures\n"); - aux_bytes += show_statistics_global_trie_nodes(); - aux_bytes += show_statistics_global_trie_hashes(); - fprintf(Yap_stdout, " Memory in use (III): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, "Global trie data structures\n"); + aux_bytes += show_statistics_global_trie_nodes(out); + aux_bytes += show_statistics_global_trie_hashes(out); + Sfprintf(out, " Memory in use (III): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; aux_bytes = 0; - fprintf(Yap_stdout, "Cut support data structures\n"); - aux_bytes += show_statistics_query_goal_solution_frames(); - aux_bytes += show_statistics_query_goal_answer_frames(); + Sfprintf(out, "Cut support data structures\n"); + aux_bytes += show_statistics_query_goal_solution_frames(out); + aux_bytes += show_statistics_query_goal_answer_frames(out); #ifdef TABLING_INNER_CUTS - aux_bytes += show_statistics_table_subgoal_solution_frames(); - aux_bytes += show_statistics_table_subgoal_answer_frames(); + aux_bytes += show_statistics_table_subgoal_solution_frames(out); + aux_bytes += show_statistics_table_subgoal_answer_frames(out); #endif /* TABLING_INNER_CUTS */ - fprintf(Yap_stdout, " Memory in use (IV): %10ld bytes\n\n", aux_bytes); + Sfprintf(out, " Memory in use (IV): %10ld bytes\n\n", aux_bytes); total_bytes += aux_bytes; #ifdef USE_PAGES_MALLOC - fprintf(Yap_stdout, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n", + Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n", total_bytes, Pg_str_in_use(GLOBAL_pages_void)); - fprintf(Yap_stdout, "Total memory allocated: %10ld bytes (%ld pages in total)\n", + Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n", Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size, Pg_pg_alloc(GLOBAL_pages_void)); #else - fprintf(Yap_stdout, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes); + Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes); #endif /* USE_PAGES_MALLOC */ - return (TRUE); } #endif /* YAPOR && TABLING */ @@ -945,19 +994,20 @@ static inline void show_answers(void) { } switch(GLOBAL_answers) { case YES_ANSWER: - fprintf(Yap_stderr, "[ yes"); + Sfprintf(Serror, "[ yes"); break; case NO_ANSWER: - fprintf(Yap_stderr, "[ no"); + Sfprintf(Serror, "[ no"); break; case 1: - fprintf(Yap_stderr, "[ 1 answer found"); + Sfprintf(Serror, "[ 1 answer found"); break; default: - fprintf(Yap_stderr, "[ %d answers found", GLOBAL_answers); + Sfprintf(Serror, "[ %d answers found", GLOBAL_answers); break; } - fprintf(Yap_stderr, " (in %f seconds) ]\n\n", GLOBAL_execution_time); + Sfprintf(Serror, " (in %f seconds) ]\n\n", GLOBAL_execution_time); + Sflush(Serror); if (GLOBAL_performance_mode == PERFORMANCE_ON) { for (i = GLOBAL_number_goals; i > 0; i--) { @@ -1017,14 +1067,15 @@ static inline void answer_to_stdout(char *answer) { else break; } output[length_output] = 0; - fprintf(Yap_stderr, " %s\n", output); + Sfprintf(Serror, " %s\n", output); + Sflush(Serror); return; } #endif /* YAPOR */ #ifdef TABLING -static inline long show_statistics_table_entries(void) { +static inline long show_statistics_table_entries(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1042,17 +1093,17 @@ static inline long show_statistics_table_entries(void) { } TABLING_ERROR_CHECKING(statistics_table_entries, Pg_str_free(GLOBAL_pages_tab_ent) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Table entries: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Table entries: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_tab_ent) * sizeof(struct table_entry), Pg_pg_alloc(GLOBAL_pages_tab_ent), Pg_str_in_use(GLOBAL_pages_tab_ent)); #else - fprintf(Yap_stdout, " Table entries: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Table entries: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_tab_ent) * sizeof(struct table_entry), Pg_str_in_use(GLOBAL_pages_tab_ent)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_tab_ent) * sizeof(struct table_entry); } -static inline long show_statistics_subgoal_frames(void) { +static inline long show_statistics_subgoal_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1070,17 +1121,17 @@ static inline long show_statistics_subgoal_frames(void) { } TABLING_ERROR_CHECKING(statistics_subgoal_frames, Pg_str_free(GLOBAL_pages_sg_fr) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Subgoal frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Subgoal frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_sg_fr) * sizeof(struct subgoal_frame), Pg_pg_alloc(GLOBAL_pages_sg_fr), Pg_str_in_use(GLOBAL_pages_sg_fr)); #else - fprintf(Yap_stdout, " Subgoal frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Subgoal frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_sg_fr) * sizeof(struct subgoal_frame), Pg_str_in_use(GLOBAL_pages_sg_fr)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_sg_fr) * sizeof(struct subgoal_frame); } -static inline long show_statistics_dependency_frames(void) { +static inline long show_statistics_dependency_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1098,17 +1149,17 @@ static inline long show_statistics_dependency_frames(void) { } TABLING_ERROR_CHECKING(statistics_dependency_frames, Pg_str_free(GLOBAL_pages_dep_fr) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Dependency frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Dependency frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_dep_fr) * sizeof(struct dependency_frame), Pg_pg_alloc(GLOBAL_pages_dep_fr), Pg_str_in_use(GLOBAL_pages_dep_fr)); #else - fprintf(Yap_stdout, " Dependency frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Dependency frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_dep_fr) * sizeof(struct dependency_frame), Pg_str_in_use(GLOBAL_pages_dep_fr)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_dep_fr) * sizeof(struct dependency_frame); } -static inline long show_statistics_subgoal_trie_nodes(void) { +static inline long show_statistics_subgoal_trie_nodes(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1126,17 +1177,17 @@ static inline long show_statistics_subgoal_trie_nodes(void) { } TABLING_ERROR_CHECKING(statistics_subgoal_trie_nodes, Pg_str_free(GLOBAL_pages_sg_node) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Subgoal trie nodes: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Subgoal trie nodes: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_sg_node) * sizeof(struct subgoal_trie_node), Pg_pg_alloc(GLOBAL_pages_sg_node), Pg_str_in_use(GLOBAL_pages_sg_node)); #else - fprintf(Yap_stdout, " Subgoal trie nodes: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Subgoal trie nodes: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_sg_node) * sizeof(struct subgoal_trie_node), Pg_str_in_use(GLOBAL_pages_sg_node)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_sg_node) * sizeof(struct subgoal_trie_node); } -static inline long show_statistics_answer_trie_nodes(void) { +static inline long show_statistics_answer_trie_nodes(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1154,17 +1205,17 @@ static inline long show_statistics_answer_trie_nodes(void) { } TABLING_ERROR_CHECKING(statistics_answer_trie_nodes, Pg_str_free(GLOBAL_pages_ans_node) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Answer trie nodes: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Answer trie nodes: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_ans_node) * sizeof(struct answer_trie_node), Pg_pg_alloc(GLOBAL_pages_ans_node), Pg_str_in_use(GLOBAL_pages_ans_node)); #else - fprintf(Yap_stdout, " Answer trie nodes: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Answer trie nodes: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_ans_node) * sizeof(struct answer_trie_node), Pg_str_in_use(GLOBAL_pages_ans_node)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_ans_node) * sizeof(struct answer_trie_node); } -static inline long show_statistics_subgoal_trie_hashes(void) { +static inline long show_statistics_subgoal_trie_hashes(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1182,17 +1233,17 @@ static inline long show_statistics_subgoal_trie_hashes(void) { } TABLING_ERROR_CHECKING(statistics_subgoal_trie_hashes, Pg_str_free(GLOBAL_pages_sg_hash) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Subgoal trie hashes: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Subgoal trie hashes: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_sg_hash) * sizeof(struct subgoal_trie_hash), Pg_pg_alloc(GLOBAL_pages_sg_hash), Pg_str_in_use(GLOBAL_pages_sg_hash)); #else - fprintf(Yap_stdout, " Subgoal trie hashes: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Subgoal trie hashes: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_sg_hash) * sizeof(struct subgoal_trie_hash), Pg_str_in_use(GLOBAL_pages_sg_hash)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_sg_hash) * sizeof(struct subgoal_trie_hash); } -static inline long show_statistics_answer_trie_hashes(void) { +static inline long show_statistics_answer_trie_hashes(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1210,17 +1261,17 @@ static inline long show_statistics_answer_trie_hashes(void) { } TABLING_ERROR_CHECKING(statistics_answer_trie_hashes, Pg_str_free(GLOBAL_pages_ans_hash) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Answer trie hashes: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Answer trie hashes: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_ans_hash) * sizeof(struct answer_trie_hash), Pg_pg_alloc(GLOBAL_pages_ans_hash), Pg_str_in_use(GLOBAL_pages_ans_hash)); #else - fprintf(Yap_stdout, " Answer trie hashes: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Answer trie hashes: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_ans_hash) * sizeof(struct answer_trie_hash), Pg_str_in_use(GLOBAL_pages_ans_hash)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_ans_hash) * sizeof(struct answer_trie_hash); } -static inline long show_statistics_global_trie_nodes(void) { +static inline long show_statistics_global_trie_nodes(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING pg_hd_ptr pg_hd; @@ -1238,19 +1289,20 @@ static inline long show_statistics_global_trie_nodes(void) { } TABLING_ERROR_CHECKING(statistics_global_trie_nodes, Pg_str_free(GLOBAL_pages_gt_node) != cont); #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Global trie nodes: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Global trie nodes: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_gt_node) * sizeof(struct global_trie_node), Pg_pg_alloc(GLOBAL_pages_gt_node), Pg_str_in_use(GLOBAL_pages_gt_node)); #else - fprintf(Yap_stdout, " Global trie nodes: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Global trie nodes: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_gt_node) * sizeof(struct global_trie_node), Pg_str_in_use(GLOBAL_pages_gt_node)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_gt_node) * sizeof(struct global_trie_node); } -static inline long show_statistics_global_trie_hashes(void) { +static inline long show_statistics_global_trie_hashes(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_TABLING + /* suport not yet implemented :( pg_hd_ptr pg_hd; gt_hash_ptr aux_ptr; long cont = 0; @@ -1265,11 +1317,12 @@ static inline long show_statistics_global_trie_hashes(void) { pg_hd = PgHd_next(pg_hd); } TABLING_ERROR_CHECKING(statistics_global_trie_hashes, Pg_str_free(GLOBAL_pages_gt_hash) != cont); + */ #endif /* DEBUG_TABLING */ - fprintf(Yap_stdout, " Global trie hashes: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Global trie hashes: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_gt_hash) * sizeof(struct global_trie_hash), Pg_pg_alloc(GLOBAL_pages_gt_hash), Pg_str_in_use(GLOBAL_pages_gt_hash)); #else - fprintf(Yap_stdout, " Global trie hashes: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Global trie hashes: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_gt_hash) * sizeof(struct global_trie_hash), Pg_str_in_use(GLOBAL_pages_gt_hash)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_gt_hash) * sizeof(struct global_trie_hash); @@ -1278,7 +1331,7 @@ static inline long show_statistics_global_trie_hashes(void) { #ifdef YAPOR -static inline long show_statistics_or_frames(void) { +static inline long show_statistics_or_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_YAPOR pg_hd_ptr pg_hd; @@ -1296,17 +1349,17 @@ static inline long show_statistics_or_frames(void) { } YAPOR_ERROR_CHECKING(statistics_or_frames, Pg_str_free(GLOBAL_pages_or_fr ) != cont); #endif /* DEBUG_YAPOR */ - fprintf(Yap_stdout, " Or-frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Or-frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_or_fr ) * sizeof(struct or_frame), Pg_pg_alloc(GLOBAL_pages_or_fr ), Pg_str_in_use(GLOBAL_pages_or_fr )); #else - fprintf(Yap_stdout, " Or-frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Or-frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_or_fr ) * sizeof(struct or_frame), Pg_str_in_use(GLOBAL_pages_or_fr )); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_or_fr ) * sizeof(struct or_frame); } -static inline long show_statistics_query_goal_solution_frames(void) { +static inline long show_statistics_query_goal_solution_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_YAPOR pg_hd_ptr pg_hd; @@ -1324,17 +1377,17 @@ static inline long show_statistics_query_goal_solution_frames(void) { } YAPOR_ERROR_CHECKING(statistics_query_goal_solution_frames, Pg_str_free(GLOBAL_pages_qg_sol_fr ) != cont); #endif /* DEBUG_YAPOR */ - fprintf(Yap_stdout, " Query goal solution frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Query goal solution frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_qg_sol_fr ) * sizeof(struct query_goal_solution_frame), Pg_pg_alloc(GLOBAL_pages_qg_sol_fr ), Pg_str_in_use(GLOBAL_pages_qg_sol_fr )); #else - fprintf(Yap_stdout, " Query goal solution frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Query goal solution frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_qg_sol_fr ) * sizeof(struct query_goal_solution_frame), Pg_str_in_use(GLOBAL_pages_qg_sol_fr )); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_qg_sol_fr ) * sizeof(struct query_goal_solution_frame); } -static inline long show_statistics_query_goal_answer_frames(void) { +static inline long show_statistics_query_goal_answer_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_YAPOR pg_hd_ptr pg_hd; @@ -1352,10 +1405,10 @@ static inline long show_statistics_query_goal_answer_frames(void) { } YAPOR_ERROR_CHECKING(statistics_query_goal_answer_frames, Pg_str_free(GLOBAL_pages_qg_ans_fr) != cont); #endif /* DEBUG_YAPOR */ - fprintf(Yap_stdout, " Query goal answer frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Query goal answer frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_qg_ans_fr) * sizeof(struct query_goal_answer_frame), Pg_pg_alloc(GLOBAL_pages_qg_ans_fr), Pg_str_in_use(GLOBAL_pages_qg_ans_fr)); #else - fprintf(Yap_stdout, " Query goal answer frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Query goal answer frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_qg_ans_fr) * sizeof(struct query_goal_answer_frame), Pg_str_in_use(GLOBAL_pages_qg_ans_fr)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_qg_ans_fr) * sizeof(struct query_goal_answer_frame); @@ -1364,7 +1417,7 @@ static inline long show_statistics_query_goal_answer_frames(void) { #if defined(YAPOR) && defined(TABLING) -static inline long show_statistics_suspension_frames(void) { +static inline long show_statistics_suspension_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_OPTYAP pg_hd_ptr pg_hd; @@ -1382,10 +1435,10 @@ static inline long show_statistics_suspension_frames(void) { } OPTYAP_ERROR_CHECKING(statistics_suspension_frames, Pg_str_free(GLOBAL_pages_susp_fr) != cont); #endif /* DEBUG_OPTYAP */ - fprintf(Yap_stdout, " Suspension frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Suspension frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_susp_fr) * sizeof(struct suspension_frame), Pg_pg_alloc(GLOBAL_pages_susp_fr), Pg_str_in_use(GLOBAL_pages_susp_fr)); #else - fprintf(Yap_stdout, " Suspension frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Suspension frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_susp_fr) * sizeof(struct suspension_frame), Pg_str_in_use(GLOBAL_pages_susp_fr)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_susp_fr) * sizeof(struct suspension_frame); @@ -1393,7 +1446,7 @@ static inline long show_statistics_suspension_frames(void) { #ifdef TABLING_INNER_CUTS -static inline long show_statistics_table_subgoal_solution_frames(void) { +static inline long show_statistics_table_subgoal_solution_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_OPTYAP pg_hd_ptr pg_hd; @@ -1411,17 +1464,17 @@ static inline long show_statistics_table_subgoal_solution_frames(void) { } OPTYAP_ERROR_CHECKING(statistics_table_subgoal_solution_frames, Pg_str_free(GLOBAL_pages_tg_sol_fr) != cont); #endif /* DEBUG_OPTYAP */ - fprintf(Yap_stdout, " Table subgoal solution frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Table subgoal solution frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_tg_sol_fr) * sizeof(struct table_subgoal_solution_frame), Pg_pg_alloc(GLOBAL_pages_tg_sol_fr), Pg_str_in_use(GLOBAL_pages_tg_sol_fr)); #else - fprintf(Yap_stdout, " Table subgoal solution frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Table subgoal solution frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_tg_sol_fr) * sizeof(struct table_subgoal_solution_frame), Pg_str_in_use(GLOBAL_pages_tg_sol_fr)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_tg_sol_fr) * sizeof(struct table_subgoal_solution_frame); } -static inline long show_statistics_table_subgoal_answer_frames(void) { +static inline long show_statistics_table_subgoal_answer_frames(IOSTREAM *out) { #ifdef USE_PAGES_MALLOC #ifdef DEBUG_OPTYAP pg_hd_ptr pg_hd; @@ -1439,10 +1492,10 @@ static inline long show_statistics_table_subgoal_answer_frames(void) { } OPTYAP_ERROR_CHECKING(statistics_table_subgoal_answer_frames, Pg_str_free(GLOBAL_pages_tg_ans_fr) != cont); #endif /* DEBUG_OPTYAP */ - fprintf(Yap_stdout, " Table subgoal answer frames: %10ld bytes (%ld pages and %ld structs in use)\n", + Sfprintf(out, " Table subgoal answer frames: %10ld bytes (%ld pages and %ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_tg_ans_fr) * sizeof(struct table_subgoal_answer_frame), Pg_pg_alloc(GLOBAL_pages_tg_ans_fr), Pg_str_in_use(GLOBAL_pages_tg_ans_fr)); #else - fprintf(Yap_stdout, " Table subgoal answer frames: %10ld bytes (%ld structs in use)\n", + Sfprintf(out, " Table subgoal answer frames: %10ld bytes (%ld structs in use)\n", Pg_str_in_use(GLOBAL_pages_tg_ans_fr) * sizeof(struct table_subgoal_answer_frame), Pg_str_in_use(GLOBAL_pages_tg_ans_fr)); #endif /* USE_PAGES_MALLOC */ return Pg_str_in_use(GLOBAL_pages_tg_ans_fr) * sizeof(struct table_subgoal_answer_frame); diff --git a/OPTYap/opt.proto.h b/OPTYap/opt.proto.h index 08de51f28..b954016dc 100644 --- a/OPTYap/opt.proto.h +++ b/OPTYap/opt.proto.h @@ -11,15 +11,9 @@ ** ** ************************************************************************/ -/*************************** -** opt.memory.c ** -***************************/ - -#ifdef YAPOR -void Yap_init_optyap_memory(long, long, long, int); -void Yap_unmap_optyap_memory(void); -void Yap_remap_optyap_memory(void); -#endif /* YAPOR */ +#if defined(TABLING) || defined(YAPOR) +#include "SWI-Stream.h" +#endif /* TABLING || YAPOR */ @@ -58,8 +52,8 @@ void free_subgoal_trie(sg_node_ptr, int, int); void free_answer_trie(ans_node_ptr, int, int); void free_subgoal_hash_chain(sg_hash_ptr); void free_answer_hash_chain(ans_hash_ptr); -void show_table(tab_ent_ptr, int); -void show_global_trie(int); +void show_table(tab_ent_ptr, int, IOSTREAM *); +void show_global_trie(int, IOSTREAM *); #endif /* TABLING */ @@ -81,9 +75,22 @@ void resume_suspension_frame(susp_fr_ptr, or_fr_ptr); /************************** -** or.copy_engine.c ** +** or.memory.c ** **************************/ +#ifdef YAPOR +void Yap_init_yapor_global_local_memory(void); +void Yap_init_yapor_stacks_memory(long, long, long, int); +void Yap_unmap_yapor_memory(void); +void Yap_remap_yapor_memory(void); +#endif /* YAPOR */ + + + +/******************************* +** or.copy_engine.c ** +*******************************/ + #ifdef YAPOR void make_root_choice_point(void); void free_root_choice_point(void); diff --git a/OPTYap/opt.structs.h b/OPTYap/opt.structs.h index 99c0a5206..762d2a66d 100644 --- a/OPTYap/opt.structs.h +++ b/OPTYap/opt.structs.h @@ -57,6 +57,7 @@ cptr_to_offset_with_null(choiceptr node) ** Struct page_header ** *********************************/ +#ifdef USE_PAGES_MALLOC typedef struct page_header { volatile int structs_in_use; void *first_free_struct; @@ -68,6 +69,7 @@ typedef struct page_header { #define PgHd_free_str(X) ((X)->first_free_struct) #define PgHd_previous(X) ((X)->previous) #define PgHd_next(X) ((X)->next) +#endif /* USE_PAGES_MALLOC */ diff --git a/OPTYap/or.copy_engine.c b/OPTYap/or.copy_engine.c index e5552a28f..4f0e6b0c2 100644 --- a/OPTYap/or.copy_engine.c +++ b/OPTYap/or.copy_engine.c @@ -58,7 +58,7 @@ static void share_private_nodes(int worker_q); REMOTE_end_global_copy(Q) = (CELL) (H); \ REMOTE_start_local_copy(Q) = (CELL) (B); \ REMOTE_end_local_copy(Q) = (CELL) (LCL0); \ - REMOTE_start_trail_copy(Q) = (CELL) (Yap_TrailBase); \ + REMOTE_start_trail_copy(Q) = (CELL) (LOCAL_TrailBase); \ REMOTE_end_trail_copy(Q) = (CELL) (TR) #endif @@ -125,7 +125,7 @@ void free_root_choice_point(void) { #ifdef TABLING LOCAL_top_cp_on_stack = #endif /* TABLING */ - LOCAL_top_cp = GLOBAL_root_cp = OrFr_node(GLOBAL_root_or_fr) = (choiceptr) Yap_LocalBase; + LOCAL_top_cp = GLOBAL_root_cp = OrFr_node(GLOBAL_root_or_fr) = (choiceptr) LOCAL_LocalBase; return; } @@ -220,10 +220,10 @@ int q_share_work(int worker_p) { #ifdef TABLING } else if (IsPairTerm(aux_cell)) { aux_cell = (CELL) RepPair(aux_cell); - if (IN_BETWEEN(Yap_TrailBase, aux_cell, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) { /* avoid frozen segments */ TR = (tr_fr_ptr) aux_cell; - TABLING_ERROR_CHECKING(q_share_work, TR > (tr_fr_ptr) Yap_TrailTop); + TABLING_ERROR_CHECKING(q_share_work, TR > (tr_fr_ptr) LOCAL_TrailTop); TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr); } #endif /* TABLING */ @@ -308,7 +308,7 @@ sync_with_p: if (IsVarTerm(aux_cell)) { if (aux_cell < LOCAL_start_global_copy || EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) { YAPOR_ERROR_CHECKING(q_share_work, (CELL *)aux_cell < H0); - YAPOR_ERROR_CHECKING(q_share_work, (ADDR)aux_cell > Yap_LocalBase); + YAPOR_ERROR_CHECKING(q_share_work, (ADDR)aux_cell > LOCAL_LocalBase); #ifdef TABLING *((CELL *) aux_cell) = TrailVal(aux_tr); #else @@ -318,7 +318,7 @@ sync_with_p: #ifdef TABLING } else if (IsPairTerm(aux_cell)) { aux_cell = (CELL) RepPair(aux_cell); - if (IN_BETWEEN(Yap_TrailBase, aux_cell, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) { /* avoid frozen segments */ aux_tr = (tr_fr_ptr) aux_cell; } @@ -443,7 +443,7 @@ void share_private_nodes(int worker_q) { consumer_cp = DepFr_cons_cp(dep_frame); next_node_on_branch = NULL; stack_limit = (CELL *)TR; - stack = (CELL *)Yap_TrailTop; + stack = (CELL *)LOCAL_TrailTop; #endif /* TABLING */ /* initialize auxiliary variables */ @@ -549,7 +549,7 @@ void share_private_nodes(int worker_q) { #ifdef TABLING /* update or-frames stored in auxiliary stack */ - while (STACK_NOT_EMPTY(stack, (CELL *)Yap_TrailTop)) { + while (STACK_NOT_EMPTY(stack, (CELL *)LOCAL_TrailTop)) { next_node_on_branch = (choiceptr) STACK_POP_DOWN(stack); or_frame = (or_fr_ptr) STACK_POP_DOWN(stack); OrFr_nearest_livenode(or_frame) = OrFr_next(or_frame) = next_node_on_branch->cp_or_fr; diff --git a/OPTYap/or.cow_engine.c b/OPTYap/or.cow_engine.c index e67e36e23..e88017000 100644 --- a/OPTYap/or.cow_engine.c +++ b/OPTYap/or.cow_engine.c @@ -75,7 +75,7 @@ void make_root_choice_point(void) { void free_root_choice_point(void) { B = LOCAL_top_cp->cp_b; - LOCAL_top_cp = (choiceptr) Yap_LocalBase; + LOCAL_top_cp = (choiceptr) LOCAL_LocalBase; return; } diff --git a/OPTYap/or.cut.c b/OPTYap/or.cut.c index 11a5c915e..479a70e74 100644 --- a/OPTYap/or.cut.c +++ b/OPTYap/or.cut.c @@ -40,7 +40,6 @@ void prune_shared_branch(choiceptr prune_cp) { #ifdef TABLING_INNER_CUTS tg_sol_fr_ptr tg_solutions, aux_tg_solutions; #endif /* TABLING_INNER_CUTS */ - leftmost_or_fr = CUT_leftmost_or_frame(); leftmost_cp = GetOrFr_node(leftmost_or_fr); qg_solutions = NULL; diff --git a/OPTYap/or.memory.c b/OPTYap/or.memory.c new file mode 100644 index 000000000..17c05b91a --- /dev/null +++ b/OPTYap/or.memory.c @@ -0,0 +1,254 @@ +/************************************************************************ +** ** +** The YapTab/YapOr/OPTYap systems ** +** ** +** YapTab extends the Yap Prolog engine to support sequential tabling ** +** YapOr extends the Yap Prolog engine to support or-parallelism ** +** OPTYap extends the Yap Prolog engine to support or-parallel tabling ** +** ** +** ** +** Yap Prolog was developed at University of Porto, Portugal ** +** ** +************************************************************************/ + +/************************************** +** Includes & Declarations ** +**************************************/ + +#include "Yap.h" +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) +#include +#include +#include +#include +#include +#include "Yatom.h" +#include "alloc.h" +#include "or.macros.h" + + + +/************************************ +** Macros & Declarations ** +************************************/ + +#define GLOBAL_LOCAL_STRUCTS_AREA ADJUST_SIZE_TO_PAGE(sizeof(struct global_data) + MAX_WORKERS * sizeof(struct worker_local)) + +#ifdef MMAP_MEMORY_MAPPING_SCHEME +int fd_mapfile; +#elif SHM_MEMORY_MAPPING_SCHEME +int shm_mapid[MAX_WORKERS + 2]; +#endif /* MEMORY_MAPPING_SCHEME */ + + + +/****************************************** +** Local functions declaration ** +******************************************/ + +#ifdef SHM_MEMORY_MAPPING_SCHEME +void shm_map_memory(int id, int size, void *shmaddr); +void shm_unmap_memory(int id); +#endif /* SHM_MEMORY_MAPPING_SCHEME */ + + + +/******************************** +** Global functions ** +********************************/ + +void Yap_init_yapor_global_local_memory(void) { + Yap_local = (struct worker_local *)(MMAP_ADDR - GLOBAL_LOCAL_STRUCTS_AREA); + Yap_global = (struct global_data *)(MMAP_ADDR - sizeof(struct global_data)); + +#ifdef MMAP_MEMORY_MAPPING_SCHEME + { char mapfile[20]; + strcpy(mapfile,"./mapfile"); + itos(getpid(), &mapfile[9]); + if ((fd_mapfile = open(mapfile, O_RDWR|O_CREAT|O_TRUNC, 0666)) < 0) + Yap_Error(FATAL_ERROR, TermNil, "open error (Yap_init_yapor_global_local_memory)"); + if (lseek(fd_mapfile, GLOBAL_LOCAL_STRUCTS_AREA, SEEK_SET) < 0) + Yap_Error(FATAL_ERROR, TermNil, "lseek error (Yap_init_yapor_global_local_memory)"); + if (write(fd_mapfile, "", 1) < 0) + Yap_Error(FATAL_ERROR, TermNil, "write error (Yap_init_yapor_global_local_memory)"); + if (mmap((void *) Yap_local, (size_t) GLOBAL_LOCAL_STRUCTS_AREA, PROT_READ|PROT_WRITE, MAP_SHARED|MAP_FIXED, fd_mapfile, 0) == (void *) -1) + Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_init_global_local_memory)"); + } +#elif SHM_MEMORY_MAPPING_SCHEME + /* place as segment MAX_WORKERS (0..MAX_WORKERS-1 reserved for worker areas) */ + shm_map_memory(MAX_WORKERS, GLOBAL_LOCAL_STRUCTS_AREA, (void *) Yap_local); +#endif /* MEMORY_MAPPING_SCHEME */ + + return; +} + + +void Yap_init_yapor_stacks_memory(long TrailStackArea, long HeapStackArea, long GlobalLocalStackArea, int n_workers) { + long StacksArea; + + TrailStackArea = ADJUST_SIZE_TO_PAGE(TrailStackArea); + HeapStackArea = ADJUST_SIZE_TO_PAGE(HeapStackArea); + GlobalLocalStackArea = ADJUST_SIZE_TO_PAGE(GlobalLocalStackArea); + Yap_worker_area_size = GlobalLocalStackArea + TrailStackArea; +#if defined(YAPOR_COPY) || defined(YAPOR_SBA) + StacksArea = HeapStackArea + Yap_worker_area_size * n_workers; +#elif defined(YAPOR_COW) + StacksArea = HeapStackArea; +#endif /* YAPOR_COPY || YAPOR_SBA || YAPOR_COW */ + + Yap_HeapBase = (ADDR) MMAP_ADDR; + LOCAL_GlobalBase = (ADDR) (MMAP_ADDR + HeapStackArea); + +#ifdef MMAP_MEMORY_MAPPING_SCHEME + /* map stacks in a single go */ + if (lseek(fd_mapfile, GLOBAL_LOCAL_STRUCTS_AREA + StacksArea, SEEK_SET) < 0) + Yap_Error(FATAL_ERROR, TermNil, "lseek error (Yap_init_yapor_stacks_memory)"); + if (write(fd_mapfile, "", 1) < 0) + Yap_Error(FATAL_ERROR, TermNil, "write error (Yap_init_yapor_stacks_memory)"); + if (mmap((void *) Yap_HeapBase, (size_t) StacksArea, PROT_READ|PROT_WRITE, MAP_SHARED|MAP_FIXED, fd_mapfile, GLOBAL_LOCAL_STRUCTS_AREA) == (void *) -1) + Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_init_yapor_stacks_memory)"); +#elif SHM_MEMORY_MAPPING_SCHEME + /* place heap stack segment as MAX_WORKERS+1 */ + shm_map_memory(MAX_WORKERS + 1, HeapStackArea, (void *) Yap_HeapBase); +#if defined(YAPOR_COPY) || defined(YAPOR_SBA) + /* map segments for worker areas as 0..MAX_WORKERS-1 */ + { int i; + for (i = 0; i < n_workers; i++) + shm_map_memory(i, Yap_worker_area_size, LOCAL_GlobalBase + Yap_worker_area_size * i); + } +#endif /* YAPOR_COPY || YAPOR_SBA */ +#endif /* MEMORY_MAPPING_SCHEME */ + +#ifdef YAPOR_COW + /* just allocate local space for stacks */ + { int private_fd_mapfile; + if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0) + Yap_Error(FATAL_ERROR, TermNil, "open error (Yap_init_yapor_stacks_memory)"); + if (mmap(LOCAL_GlobalBase, Yap_worker_area_size, PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1) + Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_init_yapor_stacks_memory)"); + close(private_fd_mapfile); + } +#endif /* YAPOR_COW */ + +#ifdef YAPOR_SBA + /* alloc space for the sparse binding array */ + sba_size = Yap_worker_area_size * n_workers; + if ((binding_array = (char *)malloc(sba_size)) == NULL) + Yap_Error(FATAL_ERROR, TermNil, "malloc error (Yap_init_yapor_stacks_memory)"); + if ((CELL)binding_array & MBIT) + Yap_Error(INTERNAL_ERROR, TermNil, "binding_array start address conflicts with tag used in IDB (Yap_init_yapor_stacks_memory)"); + sba_offset = binding_array - LOCAL_GlobalBase; + sba_end = (int)binding_array + sba_size; +#endif /* YAPOR_SBA */ + + LOCAL_TrailBase = LOCAL_GlobalBase + GlobalLocalStackArea; + LOCAL_LocalBase = LOCAL_TrailBase - CellSize; + LOCAL_TrailTop = LOCAL_TrailBase + TrailStackArea; + HeapLim = LOCAL_GlobalBase; + Yap_InitHeap(Yap_HeapBase); + return; +} + + +void Yap_remap_yapor_memory(void) { +#if defined(YAPOR_COPY) + int i; + void *remap_addr = LOCAL_GlobalBase; +#ifdef MMAP_MEMORY_MAPPING_SCHEME + long remap_offset = (ADDR) remap_addr - (ADDR) Yap_local; + if (munmap(remap_addr, (size_t)(Yap_worker_area_size * GLOBAL_number_workers)) == -1) + Yap_Error(FATAL_ERROR, TermNil, "munmap error (Yap_remap_yapor_memory)"); + for (i = 0; i < GLOBAL_number_workers; i++) + if (mmap(remap_addr + worker_offset(i), (size_t)Yap_worker_area_size, PROT_READ|PROT_WRITE, + MAP_SHARED|MAP_FIXED, fd_mapfile, remap_offset + i * Yap_worker_area_size) == (void *) -1) + Yap_Error(FATAL_ERROR, TermNil, "mmap error (Yap_remap_yapor_memory)"); +#else /* SHM_MEMORY_MAPPING_SCHEME */ + for (i = 0; i < GLOBAL_number_workers; i++) + if (shmdt(remap_addr + Yap_worker_area_size * i) == -1) + Yap_Error(FATAL_ERROR, TermNil, "shmdt error (Yap_remap_yapor_memory)"); + for (i = 0; i < GLOBAL_number_workers; i++) + if(shmat(shm_mapid[i], remap_addr + worker_offset(i), 0) == (void *) -1) + Yap_Error(FATAL_ERROR, TermNil, "shmat error (Yap_remap_yapor_memory)"); +#endif /* MEMORY_MAPPING_SCHEME */ +#elif defined(YAPOR_SBA) + /* setup workers so that they have different areas */ + LOCAL_GlobalBase += worker_id * Yap_worker_area_size; + LOCAL_TrailBase += worker_id * Yap_worker_area_size; + LOCAL_LocalBase += worker_id * Yap_worker_area_size; + LOCAL_TrailTop += worker_id * Yap_worker_area_size; +#endif /* YAPOR_COPY || YAPOR_SBA */ +} + + +void Yap_unmap_yapor_memory (void) { + int i; + + INFORMATION_MESSAGE("Worker %d exiting...", worker_id); + for (i = 0; i < GLOBAL_number_workers; i++) + if (i != worker_id && GLOBAL_worker_pid(i) != 0) { + if (kill(GLOBAL_worker_pid(i), SIGKILL) != 0) + INFORMATION_MESSAGE("Can't kill process %d", GLOBAL_worker_pid(i)); + else + INFORMATION_MESSAGE("Killing process %d", GLOBAL_worker_pid(i)); + } +#ifdef YAPOR_COW + if (GLOBAL_number_workers > 1) { + if (kill(GLOBAL_master_worker, SIGINT) != 0) + INFORMATION_MESSAGE("Can't kill process %d", GLOBAL_master_worker); + else + INFORMATION_MESSAGE("Killing process %d", GLOBAL_master_worker); + } +#endif /* YAPOR_COW */ + +#ifdef MMAP_MEMORY_MAPPING_SCHEME + { char mapfile[20]; + strcpy(mapfile,"./mapfile"); +#if defined(YAPOR_COPY) || defined(YAPOR_SBA) + itos(GLOBAL_worker_pid(0), &mapfile[9]); +#elif defined(YAPOR_COW) + itos(GLOBAL_master_worker, &mapfile[9]); +#endif /* YAPOR_COPY || YAPOR_SBA || YAPOR_COW */ + if (remove(mapfile) == 0) + INFORMATION_MESSAGE("Removing mapfile \"%s\"", mapfile); + else + INFORMATION_MESSAGE("Can't remove mapfile \"%s\"", mapfile); + } +#elif SHM_MEMORY_MAPPING_SCHEME +#if defined(YAPOR_COPY) || defined(YAPOR_SBA) + shm_unmap_memory(MAX_WORKERS); + shm_unmap_memory(MAX_WORKERS + 1); + for (i = 0; i < GLOBAL_number_workers; i++) + shm_unmap_memory(i); +#elif defined(YAPOR_COW) + shm_unmap_memory(0); +#endif /* YAPOR_COPY || YAPOR_SBA || YAPOR_COW */ +#endif /* MEMORY_MAPPING_SCHEME */ + return; +} + + + +/* ------------------------- ** +** Local functions ** +** ------------------------- */ + +#ifdef SHM_MEMORY_MAPPING_SCHEME +void shm_map_memory(int id, int size, void *shmaddr) { + if ((shm_mapid[id] = shmget(IPC_PRIVATE, size, SHM_R|SHM_W)) == -1) + Yap_Error(FATAL_ERROR, TermNil, "shmget error (shm_map_memory)"); + if (shmat(shm_mapid[id], shmaddr, 0) == (void *) -1) + Yap_Error(FATAL_ERROR, TermNil, "shmat error (shm_map_memory)"); + return; +} + + +void shm_unmap_memory(int id) { + if (shmctl(shm_mapid[id], IPC_RMID, 0) == 0) + INFORMATION_MESSAGE("Removing shared memory segment %d", shm_mapid[id]); + else + INFORMATION_MESSAGE("Can't remove shared memory segment %d", shm_mapid[id]); + return; +} +#endif /* SHM_MEMORY_MAPPING_SCHEME */ +#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ diff --git a/OPTYap/or.sba_amiops.h b/OPTYap/or.sba_amiops.h index 7d534b8b8..c5224f25a 100644 --- a/OPTYap/or.sba_amiops.h +++ b/OPTYap/or.sba_amiops.h @@ -66,7 +66,6 @@ Dereferencing macros if (0 == (D)) break; \ if (IsPairTerm(D)) goto LabelList; \ } while (TRUE); - #endif /* UNIQUE_TAG_FOR_PAIRS */ EXTERN inline Term Deref(Term a) @@ -108,6 +107,7 @@ A contains the address of the variable that is to be trailed #define RESET_VARIABLE(V) (*(CELL *)(V) = 0) +#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT inline EXTERN void AlignGlobalForDouble(void) { @@ -118,6 +118,7 @@ AlignGlobalForDouble(void) H++; } } +#endif /* SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT */ #ifdef YAPOR diff --git a/OPTYap/or.sba_engine.c b/OPTYap/or.sba_engine.c index 70a81a6f5..08747bd34 100644 --- a/OPTYap/or.sba_engine.c +++ b/OPTYap/or.sba_engine.c @@ -99,9 +99,9 @@ void make_root_choice_point(void) { LOCAL_load = 0; LOCAL_prune_request = NULL; BRANCH(worker_id, 0) = 0; - H_FZ = (CELL *) Yap_GlobalBase; - B_FZ = (choiceptr) Yap_LocalBase; - TR_FZ = (tr_fr_ptr) Yap_TrailBase; + H_FZ = (CELL *) LOCAL_GlobalBase; + B_FZ = (choiceptr) LOCAL_LocalBase; + TR_FZ = (tr_fr_ptr) LOCAL_TrailBase; } @@ -109,10 +109,10 @@ void free_root_choice_point(void) { reset_trail(LOCAL_top_cp->cp_tr, TR); TR = LOCAL_top_cp->cp_tr; B = LOCAL_top_cp->cp_b; - LOCAL_top_cp = (choiceptr) Yap_LocalBase; - H_FZ = (CELL *) Yap_GlobalBase; - B_FZ = (choiceptr) Yap_LocalBase; - TR_FZ = (tr_fr_ptr) Yap_TrailBase; + LOCAL_top_cp = (choiceptr) LOCAL_LocalBase; + H_FZ = (CELL *) LOCAL_GlobalBase; + B_FZ = (choiceptr) LOCAL_LocalBase; + TR_FZ = (tr_fr_ptr) LOCAL_TrailBase; } diff --git a/OPTYap/or.sba_unify.h b/OPTYap/or.sba_unify.h index b2bcf8362..d5d640596 100644 --- a/OPTYap/or.sba_unify.h +++ b/OPTYap/or.sba_unify.h @@ -37,9 +37,6 @@ Int bind_variable(Term t0, Term t1) } EXTERN inline -/* -Int unify(Term t0, Term t1) -*/ Int unify(Term t0, Term t1) { tr_fr_ptr TR0 = TR; @@ -69,7 +66,7 @@ EXTERN inline Int unify_constant(register Term a, register Term cons) return(IsLongIntTerm(cons) && LongIntOfTerm(a) == LongIntOfTerm(cons)); #ifdef TERM_EXTENSIONS } else if (IsAttachFunc(fun)) { - return(attas[ExtFromFunctor(fun)].bind_op(SBIND,a,cons)); + return(GLOBAL_attas[ExtFromFunctor(fun)].bind_op(SBIND,a,cons)); #endif /* TERM_EXTENSIONS */ } else return(FALSE); diff --git a/OPTYap/or.thread_engine.c b/OPTYap/or.thread_engine.c index ba5fdc58b..8bf584646 100644 --- a/OPTYap/or.thread_engine.c +++ b/OPTYap/or.thread_engine.c @@ -95,11 +95,11 @@ void free_root_choice_point(void) { CACHE_REGS B = Get_LOCAL_top_cp()->cp_b; #ifdef TABLING - Set_LOCAL_top_cp_on_stack((choiceptr) Yap_LocalBase); + Set_LOCAL_top_cp_on_stack((choiceptr) LOCAL_LocalBase); #endif /* TABLING */ - Set_GLOBAL_root_cp((choiceptr) Yap_LocalBase); - Set_LOCAL_top_cp((choiceptr) Yap_LocalBase); - SetOrFr_node(GLOBAL_root_or_fr, (choiceptr) Yap_LocalBase); + Set_GLOBAL_root_cp((choiceptr) LOCAL_LocalBase); + Set_LOCAL_top_cp((choiceptr) LOCAL_LocalBase); + SetOrFr_node(GLOBAL_root_or_fr, (choiceptr) LOCAL_LocalBase); return; } @@ -282,7 +282,7 @@ void share_private_nodes(int worker_q) { consumer_cp = DepFr_cons_cp(dep_frame); next_node_on_branch = NULL; stack_limit = (CELL *)TR; - stack = (CELL *)Yap_TrailTop; + stack = (CELL *)LOCAL_TrailTop; #endif /* TABLING */ /* initialize auxiliary variables */ @@ -388,7 +388,7 @@ void share_private_nodes(int worker_q) { #ifdef TABLING /* update or-frames stored in auxiliary stack */ - while (STACK_NOT_EMPTY(stack, (CELL *)Yap_TrailTop)) { + while (STACK_NOT_EMPTY(stack, (CELL *)LOCAL_TrailTop)) { next_node_on_branch = (choiceptr) STACK_POP_DOWN(stack); or_frame = (or_fr_ptr) STACK_POP_DOWN(stack); OrFr_nearest_livenode(or_frame) = OrFr_next(or_frame) = next_node_on_branch->cp_or_fr; diff --git a/OPTYap/tab.insts.i b/OPTYap/tab.insts.i index f4e128858..9555ab6a0 100644 --- a/OPTYap/tab.insts.i +++ b/OPTYap/tab.insts.i @@ -304,7 +304,7 @@ -> we need a shared data structure to avoid redundant computations! UNLOCK_OR_FRAME(LOCAL_top_or_fr); #else - fprintf(stderr,"PROBLEM: cp_last_answer field is local to the cp!\n"); + Sfprintf(Serror, "PROBLEM: cp_last_answer field is local to the cp!\n"); exit(1); #endif } diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index 06cc3f13e..b9899a4b2 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -435,13 +435,13 @@ static inline Int freeze_current_cp(void) { TR_FZ = freeze_cp->cp_tr; B = B->cp_b; HB = B->cp_h; - return (Yap_LocalBase - (ADDR)freeze_cp); + return (LOCAL_LocalBase - (ADDR)freeze_cp); } static inline void wake_frozen_cp(Int frozen_offset) { CACHE_REGS - choiceptr frozen_cp = (choiceptr)(Yap_LocalBase - frozen_offset); + choiceptr frozen_cp = (choiceptr)(LOCAL_LocalBase - frozen_offset); restore_bindings(TR, frozen_cp->cp_tr); B = frozen_cp; @@ -453,7 +453,7 @@ static inline void wake_frozen_cp(Int frozen_offset) { static inline void abolish_frozen_cps_until(Int frozen_offset) { CACHE_REGS - choiceptr frozen_cp = (choiceptr)(Yap_LocalBase - frozen_offset); + choiceptr frozen_cp = (choiceptr)(LOCAL_LocalBase - frozen_offset); B_FZ = frozen_cp; H_FZ = frozen_cp->cp_h; @@ -464,9 +464,9 @@ static inline void abolish_frozen_cps_until(Int frozen_offset) { static inline void abolish_frozen_cps_all(void) { CACHE_REGS - B_FZ = (choiceptr) Yap_LocalBase; - H_FZ = (CELL *) Yap_GlobalBase; - TR_FZ = (tr_fr_ptr) Yap_TrailBase; + B_FZ = (choiceptr) LOCAL_LocalBase; + H_FZ = (CELL *) LOCAL_GlobalBase; + TR_FZ = (tr_fr_ptr) LOCAL_TrailBase; return; } @@ -500,10 +500,10 @@ static inline void unbind_variables(tr_fr_ptr unbind_tr, tr_fr_ptr end_tr) { RESET_VARIABLE(ref); } else if (IsPairTerm(ref)) { ref = (CELL) RepPair(ref); - if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, ref, LOCAL_TrailTop)) { /* avoid frozen segments */ unbind_tr = (tr_fr_ptr) ref; - TABLING_ERROR_CHECKING(unbind_variables, unbind_tr > (tr_fr_ptr) Yap_TrailTop); + TABLING_ERROR_CHECKING(unbind_variables, unbind_tr > (tr_fr_ptr) LOCAL_TrailTop); TABLING_ERROR_CHECKING(unbind_variables, unbind_tr < end_tr); } #ifdef MULTI_ASSIGNMENT_VARIABLES @@ -523,7 +523,7 @@ static inline void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) { CACHE_REGS TABLING_ERROR_CHECKING(rebind_variables, rebind_tr < end_tr); /* rebind loop */ - Yap_NEW_MAHASH((ma_h_inner_struct *)H); + Yap_NEW_MAHASH((ma_h_inner_struct *)H PASS_REGS); while (rebind_tr != end_tr) { CELL ref = (CELL) TrailTerm(--rebind_tr); /* check for global or local variables */ @@ -532,16 +532,16 @@ static inline void rebind_variables(tr_fr_ptr rebind_tr, tr_fr_ptr end_tr) { *((CELL *)ref) = TrailVal(rebind_tr); } else if (IsPairTerm(ref)) { ref = (CELL) RepPair(ref); - if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, ref, LOCAL_TrailTop)) { /* avoid frozen segments */ rebind_tr = (tr_fr_ptr) ref; - TABLING_ERROR_CHECKING(rebind_variables, rebind_tr > (tr_fr_ptr) Yap_TrailTop); + TABLING_ERROR_CHECKING(rebind_variables, rebind_tr > (tr_fr_ptr) LOCAL_TrailTop); TABLING_ERROR_CHECKING(rebind_variables, rebind_tr < end_tr); } #ifdef MULTI_ASSIGNMENT_VARIABLES } else { CELL *cell_ptr = RepAppl(ref); - if (!Yap_lookup_ma_var(cell_ptr)) { + if (!Yap_lookup_ma_var(cell_ptr PASS_REGS)) { /* first time we found the variable, let's put the new value */ *cell_ptr = TrailVal(rebind_tr); } @@ -560,7 +560,7 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { TABLING_ERROR_CHECKING(restore_variables, unbind_tr < rebind_tr); end_tr = rebind_tr; - Yap_NEW_MAHASH((ma_h_inner_struct *)H); + Yap_NEW_MAHASH((ma_h_inner_struct *)H PASS_REGS); while (unbind_tr != end_tr) { /* unbind loop */ while (unbind_tr > end_tr) { @@ -569,10 +569,10 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { RESET_VARIABLE(ref); } else if (IsPairTerm(ref)) { ref = (CELL) RepPair(ref); - if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, ref, LOCAL_TrailTop)) { /* avoid frozen segments */ unbind_tr = (tr_fr_ptr) ref; - TABLING_ERROR_CHECKING(restore_variables, unbind_tr > (tr_fr_ptr) Yap_TrailTop); + TABLING_ERROR_CHECKING(restore_variables, unbind_tr > (tr_fr_ptr) LOCAL_TrailTop); } #ifdef MULTI_ASSIGNMENT_VARIABLES } else if (IsApplTerm(ref)) { @@ -582,7 +582,7 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { /* multi-assignment variable */ /* so that the upper cell is the old value */ --unbind_tr; - if (!Yap_lookup_ma_var(pt)) { + if (!Yap_lookup_ma_var(pt PASS_REGS)) { pt[0] = TrailVal(unbind_tr); } #endif /* MULTI_ASSIGNMENT_VARIABLES */ @@ -593,10 +593,10 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { ref = (CELL) TrailTerm(--end_tr); if (IsPairTerm(ref)) { ref = (CELL) RepPair(ref); - if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, ref, LOCAL_TrailTop)) { /* avoid frozen segments */ end_tr = (tr_fr_ptr) ref; - TABLING_ERROR_CHECKING(restore_variables, end_tr > (tr_fr_ptr) Yap_TrailTop); + TABLING_ERROR_CHECKING(restore_variables, end_tr > (tr_fr_ptr) LOCAL_TrailTop); } } } @@ -608,10 +608,10 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { *((CELL *)ref) = TrailVal(rebind_tr); } else if (IsPairTerm(ref)) { ref = (CELL) RepPair(ref); - if (IN_BETWEEN(Yap_TrailBase, ref, Yap_TrailTop)) { + if (IN_BETWEEN(LOCAL_TrailBase, ref, LOCAL_TrailTop)) { /* avoid frozen segments */ rebind_tr = (tr_fr_ptr) ref; - TABLING_ERROR_CHECKING(restore_variables, rebind_tr > (tr_fr_ptr) Yap_TrailTop); + TABLING_ERROR_CHECKING(restore_variables, rebind_tr > (tr_fr_ptr) LOCAL_TrailTop); TABLING_ERROR_CHECKING(restore_variables, rebind_tr < end_tr); } #ifdef MULTI_ASSIGNMENT_VARIABLES @@ -629,13 +629,13 @@ static inline void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { static inline CELL *expand_auxiliary_stack(CELL *stack) { CACHE_REGS - void *old_top = Yap_TrailTop; + void *old_top = LOCAL_TrailTop; INFORMATION_MESSAGE("Expanding trail in 64 Kbytes"); if (! Yap_growtrail(K64, TRUE)) { /* TRUE means 'contiguous_only' */ Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)"); return NULL; } else { - UInt diff = (void *)Yap_TrailTop - old_top; + UInt diff = (void *)LOCAL_TrailTop - old_top; CELL *new_stack = (CELL *)((void *)stack + diff); memmove((void *)new_stack, (void *)stack, old_top - (void *)stack); return new_stack; diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index b52e3799e..f76cb2d6b 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -17,13 +17,8 @@ #include "Yap.h" #ifdef TABLING -#include -#ifdef HAVE_STRING_H -#include -#endif /* HAVE_STRING_H */ #include "Yatom.h" #include "YapHeap.h" -#include "yapio.h" #include "tab.macros.h" static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term); @@ -78,6 +73,7 @@ static inline void traverse_update_arity(char *, int *, int *); *******************************/ static struct trie_statistics{ + IOSTREAM *out; int show; long subgoals; long subgoals_incomplete; @@ -94,6 +90,7 @@ static struct trie_statistics{ long global_trie_references; } trie_stats; +#define TrStat_out trie_stats.out #define TrStat_show trie_stats.show #define TrStat_subgoals trie_stats.subgoals #define TrStat_sg_incomplete trie_stats.subgoals_incomplete @@ -110,7 +107,7 @@ static struct trie_statistics{ #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000 #define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ if (TrStat_show == SHOW_MODE_STRUCTURE) \ - fprintf(Yap_stdout, MESG, ##ARGS) + Sfprintf(TrStat_out, MESG, ##ARGS) #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) \ if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \ @@ -185,47 +182,47 @@ static struct trie_statistics{ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms) { /************************************************************************ - =========== - | | - | ... | - | | - ----------- - YENV --> | N+1 | <-- stack_vars - ----------- - | VAR_N | - ----------- - | ... | - ----------- - | VAR_0 | - ----------- - | | - | ... | - | | - =========== - | | - | ... | - | | - ----------- - TR --> | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) - | TERM_1 | \|/ - =========== * - Yap_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) - ----------- + =========== + | | + | ... | + | | + ----------- + YENV --> | N+1 | <-- stack_vars + ----------- + | VAR_N | + ----------- + | ... | + ----------- + | VAR_0 | + ----------- + | | + | ... | + | | + =========== + | | + | ... | + | | + ----------- + TR --> | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) + | TERM_1 | \|/ + =========== * + LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) + ----------- ************************************************************************/ CACHE_REGS CELL *stack_vars = *stack_vars_ptr; CELL *stack_terms_limit = (CELL *) TR; #ifdef TRIE_COMPACT_PAIRS -#define stack_terms_base ((CELL *) Yap_TrailTop) +#define stack_terms_base ((CELL *) LOCAL_TrailTop) int stack_terms_pair_offset = 0; #endif /* TRIE_COMPACT_PAIRS */ Term t = TrNode_entry(current_node); @@ -1085,7 +1082,7 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { Term t = STACK_POP_DOWN(stack_terms); Bind((CELL *) subs_ptr[i], t); } - TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)Yap_TrailTop); + TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)LOCAL_TrailTop); return; #undef subs_arity @@ -1099,13 +1096,13 @@ CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) { Term t; ++aux_stack; /* skip the heap_arity entry */ - stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) Yap_TrailTop); + stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) LOCAL_TrailTop); *--aux_stack = 0; /* restore the heap_arity entry */ subs_ptr = aux_stack + aux_stack[1] + 2; t = STACK_POP_DOWN(stack_terms); Bind((CELL *) subs_ptr[subs_arity], t); - TABLING_ERROR_CHECKING(exec_substitution, stack_terms != (CELL *)Yap_TrailTop); + TABLING_ERROR_CHECKING(exec_substitution, stack_terms != (CELL *)LOCAL_TrailTop); *subs_ptr = subs_arity - 1; return aux_stack; @@ -1297,9 +1294,10 @@ void free_answer_hash_chain(ans_hash_ptr hash) { } -void show_table(tab_ent_ptr tab_ent, int show_mode) { +void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) { sg_node_ptr sg_node; + TrStat_out = out; TrStat_show = show_mode; if (show_mode == SHOW_MODE_STATISTICS) { TrStat_subgoals = 0; @@ -1313,9 +1311,9 @@ void show_table(tab_ent_ptr tab_ent, int show_mode) { #endif /* TABLING_INNER_CUTS */ TrStat_ans_nodes = 0; TrStat_gt_refs = 0; - fprintf(Yap_stdout, "Table statistics for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + Sfprintf(TrStat_out, "Table statistics for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); } else { /* SHOW_MODE_STRUCTURE */ - fprintf(Yap_stdout, "Table structure for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + Sfprintf(TrStat_out, "Table structure for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); } sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); if (sg_node) { @@ -1349,34 +1347,34 @@ void show_table(tab_ent_ptr tab_ent, int show_mode) { } else SHOW_TABLE_STRUCTURE(" EMPTY\n"); if (show_mode == SHOW_MODE_STATISTICS) { - fprintf(Yap_stdout, " Subgoal trie structure\n"); - fprintf(Yap_stdout, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete); - fprintf(Yap_stdout, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes); - fprintf(Yap_stdout, " Answer trie structure(s)\n"); + Sfprintf(TrStat_out, " Subgoal trie structure\n"); + Sfprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete); + Sfprintf(TrStat_out, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes); + Sfprintf(TrStat_out, " Answer trie structure(s)\n"); #ifdef TABLING_INNER_CUTS - fprintf(Yap_stdout, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned); + Sfprintf(TrStat_out, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned); #else - fprintf(Yap_stdout, " Answers: %ld\n", TrStat_answers); + Sfprintf(TrStat_out, " Answers: %ld\n", TrStat_answers); #endif /* TABLING_INNER_CUTS */ - fprintf(Yap_stdout, " Answers 'TRUE': %ld\n", TrStat_answers_true); - fprintf(Yap_stdout, " Answers 'NO': %ld\n", TrStat_answers_no); - fprintf(Yap_stdout, " Answer trie nodes: %ld\n", TrStat_ans_nodes); - fprintf(Yap_stdout, " Global trie references: %ld\n", TrStat_gt_refs); + Sfprintf(TrStat_out, " Answers 'TRUE': %ld\n", TrStat_answers_true); + Sfprintf(TrStat_out, " Answers 'NO': %ld\n", TrStat_answers_no); + Sfprintf(TrStat_out, " Answer trie nodes: %ld\n", TrStat_ans_nodes); + Sfprintf(TrStat_out, " Global trie references: %ld\n", TrStat_gt_refs); } - fflush(Yap_stdout); return; } -void show_global_trie(int show_mode) { +void show_global_trie(int show_mode, IOSTREAM *out) { + TrStat_out = out; TrStat_show = show_mode; if (show_mode == SHOW_MODE_STATISTICS) { TrStat_gt_terms = 0; TrStat_gt_nodes = 1; TrStat_gt_refs = 0; - fprintf(Yap_stdout, "Global trie statistics\n"); + Sfprintf(TrStat_out, "Global trie statistics\n"); } else { /* SHOW_MODE_STRUCTURE */ - fprintf(Yap_stdout, "Global trie structure\n"); + Sfprintf(TrStat_out, "Global trie structure\n"); } if (TrNode_child(GLOBAL_root_gt)) { char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE); @@ -1388,9 +1386,9 @@ void show_global_trie(int show_mode) { } else SHOW_TABLE_STRUCTURE(" EMPTY\n"); if (show_mode == SHOW_MODE_STATISTICS) { - fprintf(Yap_stdout, " Terms: %ld\n", TrStat_gt_terms); - fprintf(Yap_stdout, " Global trie nodes: %ld\n", TrStat_gt_nodes); - fprintf(Yap_stdout, " Global trie auto references: %ld\n", TrStat_gt_refs); + Sfprintf(TrStat_out, " Terms: %ld\n", TrStat_gt_terms); + Sfprintf(TrStat_out, " Global trie nodes: %ld\n", TrStat_gt_nodes); + Sfprintf(TrStat_out, " Global trie auto references: %ld\n", TrStat_gt_refs); } return; } diff --git a/OPTYap/tab.tries.i b/OPTYap/tab.tries.i index 659f2cdc5..b6eea1ba8 100644 --- a/OPTYap/tab.tries.i +++ b/OPTYap/tab.tries.i @@ -791,43 +791,43 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c #endif /* MODE_TERMS_LOOP */ #endif /* MODE_GLOBAL_TRIE_LOOP */ /************************************************************************ - =========== - | | - | ... | - | | - ----------- - | VAR_N | <-- stack_vars - ----------- * - | ... | /|\ - ----------- | subs_arity (N+1) - | VAR_0 | \|/ - ----------- * - YENV --> | | - ----------- - | | - | ... | - | | - =========== - | | - | ... | - | | - ----------- - TR --> | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | - | TERM_1 | | - ----------| | - | NULL | \|/ - =========== * - Yap_TrailTop --> | | - ----------- + =========== + | | + | ... | + | | + ----------- + | VAR_N | <-- stack_vars + ----------- * + | ... | /|\ + ----------- | subs_arity (N+1) + | VAR_0 | \|/ + ----------- * + YENV --> | | + ----------- + | | + | ... | + | | + =========== + | | + | ... | + | | + ----------- + TR --> | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | + | TERM_1 | | + ----------| | + | NULL | \|/ + =========== * + LOCAL_TrailTop --> | | + ----------- ************************************************************************/ CACHE_REGS #ifdef MODE_GLOBAL_TRIE_LOOP @@ -836,7 +836,7 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c int subs_arity = *subs_arity_ptr; CELL *stack_vars = *stack_vars_ptr; #if ! defined(MODE_GLOBAL_TRIE_LOOP) || ! defined(GLOBAL_TRIE_FOR_SUBTERMS) - CELL *stack_terms = (CELL *) Yap_TrailTop; + CELL *stack_terms = (CELL *) LOCAL_TrailTop; #endif /* ! MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE_FOR_SUBTERMS */ CELL *stack_terms_limit = (CELL *) TR; AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); /* + 1 because initially we stiil haven't done any STACK_POP_DOWN */ @@ -1005,33 +1005,33 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr #endif /* MODE_TERMS_LOOP */ #endif /* MODE_GLOBAL_TRIE_LOOP */ /************************************************************************ - =========== - | | - | ... | - | | - ----------- - TR --> | VAR_0 | <-- stack_vars_base - ----------- * - | ... | /|\ - ----------- | vars_arity (N+1) - | VAR_N | \|/ - ----------- * - | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | - | TERM_1 | | - ----------| | - | NULL | \|/ - =========== * - Yap_TrailTop --> | | - ----------- + =========== + | | + | ... | + | | + ----------- + TR --> | VAR_0 | <-- stack_vars_base + ----------- * + | ... | /|\ + ----------- | vars_arity (N+1) + | VAR_N | \|/ + ----------- * + | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | + | TERM_1 | | + ----------| | + | NULL | \|/ + =========== * + LOCAL_TrailTop --> | | + ----------- ************************************************************************/ CACHE_REGS #ifdef MODE_GLOBAL_TRIE_LOOP @@ -1039,7 +1039,7 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr #endif /* MODE_GLOBAL_TRIE_LOOP */ int vars_arity = *vars_arity_ptr; #if ! defined(MODE_GLOBAL_TRIE_LOOP) || ! defined(GLOBAL_TRIE_FOR_SUBTERMS) - CELL *stack_terms = (CELL *) Yap_TrailTop; + CELL *stack_terms = (CELL *) LOCAL_TrailTop; #endif /* ! MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE_FOR_SUBTERMS */ CELL *stack_vars_base = (CELL *) TR; #define stack_terms_limit (stack_vars_base + vars_arity) @@ -1219,43 +1219,43 @@ static inline CELL *load_substitution_loop(gt_node_ptr current_node, int *vars_a static inline CELL *load_answer_loop(ans_node_ptr current_node) { #endif /* MODE_GLOBAL_TRIE_LOOP */ /************************************************************************ - =========== - | | - | ... | - | | - ----------- - TR --> | VAR_0 | <-- stack_vars_base - ----------- * - | ... | /|\ - ----------- | vars_arity (N+1) - | VAR_N | \|/ - ----------- * - | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) - | TERM_1 | \|/ - =========== * - Yap_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) - ----------- + =========== + | | + | ... | + | | + ----------- + TR --> | VAR_0 | <-- stack_vars_base + ----------- * + | ... | /|\ + ----------- | vars_arity (N+1) + | VAR_N | \|/ + ----------- * + | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) + | TERM_1 | \|/ + =========== * + LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) + ----------- ************************************************************************/ CACHE_REGS #ifdef MODE_GLOBAL_TRIE_LOOP int vars_arity = *vars_arity_ptr; #else int vars_arity = 0; - CELL *stack_terms = (CELL *) Yap_TrailTop; + CELL *stack_terms = (CELL *) LOCAL_TrailTop; #endif /* MODE_GLOBAL_TRIE_LOOP */ CELL *stack_vars_base = (CELL *) TR; #define stack_terms_limit (stack_vars_base + vars_arity) #ifdef TRIE_COMPACT_PAIRS -#define stack_terms_base ((CELL *) Yap_TrailTop) +#define stack_terms_base ((CELL *) LOCAL_TrailTop) int stack_terms_pair_offset = 0; #endif /* TRIE_COMPACT_PAIRS */ Term t = TrNode_entry(current_node); diff --git a/VC/include/Yap.h b/VC/include/Yap.h index c95982e92..627a55f15 100644 --- a/VC/include/Yap.h +++ b/VC/include/Yap.h @@ -900,16 +900,6 @@ extern int splfild; #define DO_EVERYTHING 1 #define DO_ONLY_CODE 2 - -#ifdef EMACS - -/******************** using Emacs mode ********************************/ - -extern int emacs_mode; - -#endif - - /************ variable concerned with version number *****************/ extern char version_number[]; @@ -1033,10 +1023,6 @@ typedef struct TIMED_MAVAR{ extern int output_msg; #endif -#if EMACS -extern char emacs_tmp[], emacs_tmp2[]; -#endif - #if HAVE_SIGNAL extern int snoozing; #endif diff --git a/VC/yapdll.mak b/VC/yapdll.mak index bab598d20..6c46efa1f 100755 --- a/VC/yapdll.mak +++ b/VC/yapdll.mak @@ -81,7 +81,7 @@ CLEAN : -@erase "$(INTDIR)\mavar.obj" -@erase "$(INTDIR)\modules.obj" -@erase "$(INTDIR)\opt.init.obj" - -@erase "$(INTDIR)\opt.memory.obj" + -@erase "$(INTDIR)\or.memory.obj" -@erase "$(INTDIR)\opt.preds.obj" -@erase "$(INTDIR)\or.cowengine.obj" -@erase "$(INTDIR)\or.cut.obj" @@ -161,7 +161,7 @@ LINK32_OBJS= \ "$(INTDIR)\mavar.obj" \ "$(INTDIR)\modules.obj" \ "$(INTDIR)\opt.init.obj" \ - "$(INTDIR)\opt.memory.obj" \ + "$(INTDIR)\or.memory.obj" \ "$(INTDIR)\opt.preds.obj" \ "$(INTDIR)\or.cowengine.obj" \ "$(INTDIR)\or.cut.obj" \ @@ -242,7 +242,7 @@ CLEAN : -@erase "$(INTDIR)\mavar.obj" -@erase "$(INTDIR)\modules.obj" -@erase "$(INTDIR)\opt.init.obj" - -@erase "$(INTDIR)\opt.memory.obj" + -@erase "$(INTDIR)\or.memory.obj" -@erase "$(INTDIR)\opt.preds.obj" -@erase "$(INTDIR)\or.cowengine.obj" -@erase "$(INTDIR)\or.cut.obj" @@ -325,7 +325,7 @@ LINK32_OBJS= \ "$(INTDIR)\mavar.obj" \ "$(INTDIR)\modules.obj" \ "$(INTDIR)\opt.init.obj" \ - "$(INTDIR)\opt.memory.obj" \ + "$(INTDIR)\or.memory.obj" \ "$(INTDIR)\opt.preds.obj" \ "$(INTDIR)\or.cowengine.obj" \ "$(INTDIR)\or.cut.obj" \ @@ -637,9 +637,9 @@ SOURCE="\Yap\Yap-4.3.17\OPTYap\opt.init.c" $(CPP) $(CPP_PROJ) $(SOURCE) -SOURCE="\Yap\Yap-4.3.17\OPTYap\opt.memory.c" +SOURCE="\Yap\Yap-4.3.17\OPTYap\or.memory.c" -"$(INTDIR)\opt.memory.obj" : $(SOURCE) "$(INTDIR)" +"$(INTDIR)\or.memory.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) diff --git a/console/LGPL/pl-ntmain.c b/console/LGPL/pl-ntmain.c index 3bdf34ab5..4505c4882 100755 --- a/console/LGPL/pl-ntmain.c +++ b/console/LGPL/pl-ntmain.c @@ -1035,6 +1035,7 @@ win32main(rlc_console c, int argc, TCHAR **argv) if ( !PL_initialise(argc, av) ) PL_halt(1); + rlc_bind_terminal(c); PL_halt(PL_toplevel() ? 0 : 1); return 0; @@ -1050,7 +1051,6 @@ int PASCAL WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdLine, int nCmdShow) { LPTSTR cmdline; - fprintf(stderr,"Hello\n"); InitializeCriticalSection(&mutex); diff --git a/console/yap.c b/console/yap.c index d3cec5e16..dfa47a843 100644 --- a/console/yap.c +++ b/console/yap.c @@ -259,48 +259,6 @@ parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) if (!strcmp("dump-runtime-variables",p)) return dump_runtime_variables(); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ -#ifdef USE_SOCKET - case 'c': /* running as client */ - { - char *host, *p1; - long port; - char *ptr; - - host = *++argv; - argc--; - if (host == NULL || host[0] == '-') - YAP_Error(0,0L,"sockets must receive host to connect to"); - p1 = *++argv; - argc--; - if (p1 == NULL || p1[0] == '-') - YAP_Error(0,0L,"sockets must receive port to connect to"); - port = strtol(p1, &ptr, 10); - if (ptr == NULL || ptr[0] != '\0') - YAP_Error(0,0L,"port argument to socket must be a number"); - YAP_InitSocks(host,port); - } - break; -#endif -#ifdef EMACS - case 'e': - emacs_mode = TRUE; - { - File fd; - strcpy (emacs_tmp, ++p); - if ((fd = fopen (emacs_tmp, "w")) == NIL) - fprintf(stderr, "[ Warning: unable to communicate with emacs: failed to open %s ]\n", emacs_tmp); - fclose (fd); - unlink (emacs_tmp); - p = *++argv; - --argc; - strcpy (emacs_tmp2, p); - if ((fd = fopen (emacs_tmp2, "w")) == NIL) - fprintf(stderr, "Unable to communicate with emacs: failed to open %s\n", emacs_tmp2); - fclose (fd); - unlink (emacs_tmp2); - } - break; -#endif /* EMACS */ case 'F': /* just ignore for now */ argc--; @@ -348,12 +306,6 @@ parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) goto myddas_error_print; break; } -#endif -#ifdef MPWSHELL - case 'm': - if (*++p == 'p' && *++p == 'w' && *++p == '\0') - mpwshell = TRUE; - break; #endif // execution mode case 'J': diff --git a/include/YapInterface.h b/include/YapInterface.h index ca720aab5..8ede58f0f 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -325,6 +325,9 @@ extern X_API int PROTO(YAP_Init,(YAP_init_args *)); /* int YAP_FastInit(const char *) */ extern X_API int PROTO(YAP_FastInit,(CONST char *)); +/* void * YAP_TermToStream(YAP_Term) */ +extern X_API void * PROTO(YAP_TermToStream,(YAP_Term)); + /* void * YAP_InitConsult(int, const char *) */ extern X_API void * PROTO(YAP_InitConsult,(int, CONST char *)); diff --git a/library/dgraphs.yap b/library/dgraphs.yap index 73e9e7da6..7dfb1d320 100644 --- a/library/dgraphs.yap +++ b/library/dgraphs.yap @@ -210,27 +210,21 @@ delete_remaining_edges(SortedVs,Vs0,Vsf) :- dgraph_transpose(Graph, TGraph) :- rb_visit(Graph, Edges), - rb_clone(Graph, TGraph, NewNodes), - tedges(Edges,UnsortedTEdges), - sort(UnsortedTEdges,TEdges), - fill_nodes(NewNodes,TEdges). + transpose(Edges, Nodes, TEdges, []), + dgraph_new(G0), + % make sure we have all vertices, even if they are unconnected. + dgraph_add_vertices(G0, Nodes, G1), + dgraph_add_edges(G1, TEdges, TGraph). -tedges([],[]). -tedges([V-Vs|Edges],TEdges) :- - fill_tedges(Vs, V, TEdges, TEdges0), - tedges(Edges,TEdges0). +transpose([], []) --> []. +transpose([V-Edges|MoreVs], [V|Vs]) --> + transpose_edges(Edges, V), + transpose(MoreVs, Vs). -fill_tedges([], _, TEdges, TEdges). -fill_tedges([V1|Vs], V, [V1-V|TEdges], TEdges0) :- - fill_tedges(Vs, V, TEdges, TEdges0). - - -fill_nodes([],[]). -fill_nodes([V-[Child|MoreChildren]|Nodes],[V-Child|Edges]) :- !, - get_extra_children(Edges,V,MoreChildren,REdges), - fill_nodes(Nodes,REdges). -fill_nodes([_-[]|Edges],TEdges) :- - fill_nodes(Edges,TEdges). +transpose_edges([], _V) --> []. +transpose_edges(E.Edges, V) --> + [E-V], + transpose_edges(Edges, V). dgraph_compose(T1,T2,CT) :- rb_visit(T1,Nodes), diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 4038f860f..d0268df46 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -9,6 +9,8 @@ */ +#define PL_KERNEL 1 + //=== includes =============================================================== #include #include @@ -118,7 +120,7 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f Atom at; while ((at = Yap_LookupAtom(a)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return; } } @@ -129,7 +131,7 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f while ((at = Yap_LookupAtom(a)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return; } } @@ -630,7 +632,7 @@ X_API atom_t PL_new_atom(const char *c) while ((at = Yap_LookupAtom((char *)c)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } @@ -646,7 +648,7 @@ X_API atom_t PL_new_atom_nchars(size_t len, const char *c) while ((pt = (char *)Yap_AllocCodeSpace(len+1)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } @@ -658,7 +660,7 @@ X_API atom_t PL_new_atom_nchars(size_t len, const char *c) while ((at = Yap_LookupAtom(pt)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } @@ -680,7 +682,7 @@ X_API atom_t PL_new_atom_wchars(size_t len, const wchar_t *c) while (!(nbf = (wchar_t *)YAP_AllocSpaceFromYap((len+1)*sizeof(wchar_t)))) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0; } } @@ -690,7 +692,7 @@ X_API atom_t PL_new_atom_wchars(size_t len, const wchar_t *c) while ((at0 = Yap_LookupWideAtom(nbf)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0L; } } @@ -703,7 +705,7 @@ X_API atom_t PL_new_atom_wchars(size_t len, const wchar_t *c) while (!(nbf = (char *)YAP_AllocSpaceFromYap((len+1)*sizeof(char)))) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0; } } @@ -713,7 +715,7 @@ X_API atom_t PL_new_atom_wchars(size_t len, const wchar_t *c) while (!(at0 = Yap_LookupAtom(nbf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return 0; } } @@ -853,7 +855,7 @@ X_API int PL_put_atom_chars(term_t t, const char *s) while (!(at = Yap_LookupAtom((char *)s))) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -870,7 +872,7 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s) if (strlen(s) > len) { while (!(buf = (char *)Yap_AllocCodeSpace(len+1))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -881,7 +883,7 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s) } while (!(at = Yap_LookupAtom(buf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1078,7 +1080,7 @@ X_API int PL_unify_atom_chars(term_t t, const char *s) Term cterm; while (!(catom = Yap_LookupAtom((char *)s))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1101,7 +1103,7 @@ X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s) buf[len] = '\0'; while (!(catom = Yap_LookupAtom(buf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1336,7 +1338,7 @@ X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *char Atom at; while ((at = Yap_LookupMaybeWideAtomWithLength((wchar_t *)chars, len)) == NULL) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1395,7 +1397,7 @@ LookupMaxAtom(size_t n, char *s) buf[n] = '\0'; while (!(catom = Yap_LookupAtom(buf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -1416,7 +1418,7 @@ LookupMaxWideAtom(size_t n, wchar_t *s) while (!(catom = Yap_LookupMaybeWideAtom(buf))) { if (!Yap_growheap(FALSE, 0L, NULL)) { CACHE_REGS - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -1499,7 +1501,7 @@ X_API int PL_unify_term(term_t l,...) char *s = va_arg(ap, char *); while (!(at = Yap_LookupAtom(s))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1594,7 +1596,7 @@ X_API int PL_unify_term(term_t l,...) while (!(at = Yap_LookupAtom(fname))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -1606,7 +1608,7 @@ X_API int PL_unify_term(term_t l,...) while (!(at = Yap_LookupAtom(fname))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return FALSE; } } @@ -2057,7 +2059,7 @@ X_API predicate_t PL_predicate(const char *name, int arity, const char *m) Atom at; while (!(at = Yap_LookupAtom((char *)m))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -2065,7 +2067,7 @@ X_API predicate_t PL_predicate(const char *name, int arity, const char *m) } while (!(at = Yap_LookupAtom((char *)name))) { if (!Yap_growheap(FALSE, 0L, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } } @@ -2741,9 +2743,9 @@ PL_query(int query) { switch(query) { case PL_QUERY_ARGC: - return (intptr_t)Yap_argc; + return (intptr_t)GLOBAL_argc; case PL_QUERY_ARGV: - return (intptr_t)Yap_argv; + return (intptr_t)GLOBAL_argv; case PL_QUERY_USER_CPU: return (intptr_t)Yap_cputime(); case PL_QUERY_VERSION: diff --git a/library/lammpi/prologterms2c.c b/library/lammpi/prologterms2c.c index 9f344a1c7..a2af81238 100644 --- a/library/lammpi/prologterms2c.c +++ b/library/lammpi/prologterms2c.c @@ -52,7 +52,6 @@ Comments: This file provides a set of functions to convert a prolog term to a C #endif struct buffer_ds buffer; -extern char *Yap_ErrorMessage; /*********************************************************************************************/ // prototypes @@ -229,10 +228,10 @@ string2term(char *const ptr,const size_t *size) { b.ptr=NULL; } BUFFER_POS=0; - Yap_ErrorMessage=NULL; + LOCAL_ErrorMessage=NULL; t = YAP_Read(p2c_getc); if ( t==FALSE ) { - write_msg(__FUNCTION__,__FILE__,__LINE__,"FAILED string2term>>>>size:%d %d %s\n",BUFFER_SIZE,strlen(BUFFER_PTR),Yap_ErrorMessage); + write_msg(__FUNCTION__,__FILE__,__LINE__,"FAILED string2term>>>>size:%d %d %s\n",BUFFER_SIZE,strlen(BUFFER_PTR),LOCAL_ErrorMessage); exit(1); } diff --git a/library/lammpi/yap_mpi.c b/library/lammpi/yap_mpi.c index daa4237e2..4bba051f9 100644 --- a/library/lammpi/yap_mpi.c +++ b/library/lammpi/yap_mpi.c @@ -75,8 +75,7 @@ typedef struct broadcast_req BroadcastRequest; * Auxiliary data ********************************************************************/ static int mpi_status; -extern char **Yap_argv; -extern int Yap_argc; +extern int GLOBAL_argc; #define HASHSIZE 1777 static hashtable requests=NULL; @@ -261,8 +260,8 @@ static int mpi_error(int errcode){ static int mpi_init(void){ int thread_level; - // MPI_Init(&Yap_argc, &Yap_argv); - MPI_Init_thread(&Yap_argc, &Yap_argv,MPI_THREAD_SINGLE,&thread_level); + // MPI_Init(&GLOBAL_argc, &GLOBAL_argv); + MPI_Init_thread(&GLOBAL_argc, &GLOBAL_argv,MPI_THREAD_SINGLE,&thread_level); #ifdef DEBUG write_msg(__FUNCTION__,__FILE__,__LINE__,"Thread level: %d\n",thread_level); #endif @@ -300,11 +299,11 @@ rcv_msg_thread(char *handle_pred) { static int mpi_init_rcv_thread(void){ int thread_level; - // MPI_Init(&Yap_argc, &Yap_argv); + // MPI_Init(&GLOBAL_argc, &GLOBAL_argv); pthread_t thread; char *arg="handle_msg"; - MPI_Init_thread(&Yap_argc, &Yap_argv,MPI_THREAD_SINGLE,&thread_level); + MPI_Init_thread(&GLOBAL_argc, &GLOBAL_argv,MPI_THREAD_SINGLE,&thread_level); if(pthread_create(&thread,NULL,(void*)&rcv_msg_thread,arg)) { return (FALSE); } diff --git a/library/mpi/mpi.c b/library/mpi/mpi.c index 8ada34123..9c287d5f0 100644 --- a/library/mpi/mpi.c +++ b/library/mpi/mpi.c @@ -491,21 +491,21 @@ Yap_InitMPI(void) { int i,j; - mpi_argv = malloc( Yap_argc * sizeof(char *) ); - mpi_argv[0] = strdup( Yap_argv[0] ); + mpi_argv = malloc( GLOBAL_argc * sizeof(char *) ); + mpi_argv[0] = strdup( GLOBAL_argv[0] ); bufsize = RECV_BUF_SIZE; buf = malloc(bufsize * sizeof(char)); - for( i=1; i CURRENT_INDEX; i--) stack_vars_base[i] = 0; @@ -864,17 +874,18 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { *cur_node = node; return t; } else if (t == FloatEndTag) { - volatile double f; - volatile YAP_Term *p; - p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */ + volatile union { + double f; + YAP_Term p[SIZE_FLOAT_AS_TERM]; + } tf; /* to avoid gcc warning */ #ifdef TAG_LOW_BITS_32 node = TrNode_parent(node); - *(p + 1) = TrNode_entry(node); + tf.p[1] = TrNode_entry(node); #endif /* TAG_LOW_BITS_32 */ node = TrNode_parent(node); - *p = TrNode_entry(node); + tf.p[0] = TrNode_entry(node); node = TrNode_parent(node); /* ignore FloatInitTag */ - t = YAP_MkFloatTerm(f); + t = YAP_MkFloatTerm(tf.f); PUSH_UP(stack_args, t, stack_vars); } else if (t == FloatInitTag) { } @@ -888,6 +899,7 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { fprintf(stderr, "***************************************\n"); fprintf(stderr, " Tries core module: unknown type tag\n"); fprintf(stderr, "***************************************\n"); + fflush(stderr); } node = TrNode_parent(node); } @@ -1462,7 +1474,7 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) { /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */ - if (str[str_index - 1] != '[') + if (str_index > 0 && str[str_index - 1] != '[') str[str_index - 1] = ','; /* restore possible PairEndTermTag side-effect */ if (str[last_pair_mark] == '|') @@ -1481,7 +1493,7 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) { /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */ - if (str[str_index - 1] != '[') + if (str_index > 0 && str[str_index - 1] != '[') str[str_index - 1] = ','; /* restore possible PairEndTermTag side-effect */ if (str[last_pair_mark] == '|') @@ -1500,19 +1512,21 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m arity[arity[0]] = (YAP_Int) t; mode = TRIE_PRINT_FLOAT2; } else if (mode == TRIE_PRINT_FLOAT2) { - volatile double f; - volatile YAP_Term *p; - p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */ - *(p + 1) = t; - *p = (YAP_Term) arity[arity[0]]; + volatile union { + double f; + YAP_Term p[SIZE_FLOAT_AS_TERM]; + } tf; /* to avoid gcc warning */ + tf.p[1] = t; + tf.p[0] = (YAP_Term) arity[arity[0]]; arity[arity[0]] = -1; #else /* TAG_64BITS */ - volatile double f; - volatile YAP_Term *p; - p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */ - *p = t; + volatile union { + double f; + YAP_Term p[SIZE_FLOAT_AS_TERM]; + } tf; /* to avoid gcc warning */ + tf.p[0] = t; #endif /* TAG_SCHEME */ - str_index += sprintf(& str[str_index], "%.15g", f); + str_index += sprintf(& str[str_index], "%.15g", tf.f); mode = TRIE_PRINT_FLOAT_END; } else if (mode == TRIE_PRINT_FLOAT_END) { arity[0]--; @@ -1609,6 +1623,7 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m fprintf(stderr, "***************************************\n"); fprintf(stderr, " Tries core module: unknown type tag\n"); fprintf(stderr, "***************************************\n"); + fflush(stderr); } if (arity[0]) { @@ -1696,6 +1711,7 @@ YAP_Term trie_to_list_node(TrNode node) { fprintf(stderr, "***************************************\n"); fprintf(stderr, " Tries core module: unknown type tag\n"); fprintf(stderr, "***************************************\n"); + fflush(stderr); return YAP_MkAtomTerm(YAP_LookupAtom("fail")); } @@ -1709,7 +1725,7 @@ YAP_Term trie_to_list_node(TrNode node) { #ifdef TAG_LOW_BITS_32 static inline -YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile YAP_Term **p, volatile double *f) { +YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile YAP_Term *p, volatile double *f) { if(IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; TrHash hash = (TrHash) node; @@ -1720,16 +1736,15 @@ YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile Y do { if(*--bucket) { node = *bucket; - do { - *(*p + 1) = TrNode_entry(node); + p[1] = TrNode_entry(node); PUSH_NEW_FLOAT_TERM(*f); } while((node = TrNode_next(node))); } } while (bucket != first_bucket); } else { do { - *(*p + 1) = TrNode_entry(node); + p[1] = TrNode_entry(node); PUSH_NEW_FLOAT_TERM(*f); } while((node = TrNode_next(node))); } @@ -1741,11 +1756,12 @@ YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile Y static YAP_Term trie_to_list_floats(TrNode node) { - volatile double f; - volatile YAP_Term *p; + volatile union { + double f; + YAP_Term p[SIZE_FLOAT_AS_TERM]; + } tf; /* to avoid gcc warning */ YAP_Term result = YAP_MkAtomTerm(YAP_LookupAtom("[]")); - p = (YAP_Term *)((void *) &f); /* to avoid gcc warning */ if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; TrHash hash = (TrHash) node; @@ -1755,22 +1771,22 @@ YAP_Term trie_to_list_floats(TrNode node) { if (*--bucket) { node = *bucket; do { - *p = TrNode_entry(node); + tf.p[0] = TrNode_entry(node); #ifdef TAG_LOW_BITS_32 - result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &p, &f); + result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, &tf.f); #else - PUSH_NEW_FLOAT_TERM(f); + PUSH_NEW_FLOAT_TERM(tf.f); #endif /* TAG_LOW_BITS_32 */ } while((node = TrNode_next(node))); } } while (bucket != first_bucket); } else { do { - *p = TrNode_entry(node); + tf.p[0] = TrNode_entry(node); #ifdef TAG_LOW_BITS_32 - result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &p, &f); + result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, &tf.f); #else - PUSH_NEW_FLOAT_TERM(f); + PUSH_NEW_FLOAT_TERM(tf.f); #endif /* TAG_LOW_BITS_32 */ } while((node = TrNode_next(node))); } diff --git a/library/tries/core_tries.h b/library/tries/core_tries.h index f627911be..e9029ed26 100644 --- a/library/tries/core_tries.h +++ b/library/tries/core_tries.h @@ -14,8 +14,10 @@ #include "config.h" #if SIZEOF_INT_P==4 #define TAG_LOW_BITS_32 /* 'Tags_32LowTag.h' tagging scheme */ +#define SIZE_FLOAT_AS_TERM 2 #elif SIZEOF_INT_P==8 #define TAG_64BITS /* 'Tags_64bits.h' tagging scheme */ +#define SIZE_FLOAT_AS_TERM 1 #else #error Unknown tagging scheme #endif /* YAP_SCHEME */ diff --git a/misc/GLOBALS b/misc/GLOBALS index 0bc2ae333..d410af693 100644 --- a/misc/GLOBALS +++ b/misc/GLOBALS @@ -18,44 +18,117 @@ START_GLOBAL_DATA // initialization: tell whether the system has been initialised and by whom. -int Initialised =FALSE -int InitialisedFromPL =FALSE -int PL_Argc =0 -char** PL_Argv =NULL +int Initialised =FALSE +int InitialisedFromPL =FALSE +int PL_Argc =0 +char** PL_Argv =NULL // halt hooks -struct halt_hook* HaltHooks =NULL +struct halt_hook* HaltHooks =NULL // stack overflow expansion/gc control -int AllowLocalExpansion =TRUE -int AllowGlobalExpansion =TRUE -int AllowTrailExpansion =TRUE -UInt SizeOfOverflow =0 +int AllowLocalExpansion =TRUE +int AllowGlobalExpansion =TRUE +int AllowTrailExpansion =TRUE +UInt SizeOfOverflow =0 // amount of space recovered in all garbage collections -UInt AGcThreshold =10000 -Agc_hook AGCHook =NULL +UInt AGcThreshold =10000 +Agc_hook AGCHook =NULL + /* multi-thread support */ #if THREADS /* number of threads and processes in system */ -UInt NOfThreads =1 +UInt NOfThreads =1 /* number of threads created since start */ -UInt NOfThreadsCreated =1 +UInt NOfThreadsCreated =1 /* total run time for dead threads */ -UInt ThreadsTotalTime =0L +UInt ThreadsTotalTime =0L // Threads Array -lockvar ThreadHandlesLock MkLock -#endif +lockvar ThreadHandlesLock MkLock +#endif #if defined(YAPOR) || defined(THREADS) // protect long critical regions -lockvar BGL MkLock +lockvar BGL MkLock #endif #if defined(YAPOR) || defined(TABLING) -struct global_optyap_data optyap_data void +struct global_optyap_data optyap_data void #endif /* YAPOR || TABLING */ +// whether Yap is responsible for signal handling + +int PrologShouldHandleInterrupts void + +/* This is the guy who actually started the system, and who has the correct registers */ +#if defined(THREADS) +pthread_t master_thread void +#endif /* THREADS */ + +// streams +YP_FILE* stdout =stdout +YP_FILE* stderr =stderr + +// access to yap initial arguments +char** argv void +int argc void + +// extensions to Terms +#ifdef COROUTINING +/* array with the ops for your favourite extensions */ +ext_op attas[attvars_ext+1] void +#endif + +// agc.c +int agc_calls void +YAP_ULONG_LONG agc_collected void +/* total time spent in GC */ +Int tot_agc_time =0 +/* number of heap objects in all garbage collections */ +Int tot_agc_recovered =0 + +//arrays.c +#if HAVE_MMAP +struct MMAP_ARRAY_BLOCK* mmap_arrays =NULL +#endif + + +#ifdef DEBUG +//computils.c +char Option[20] void +YP_FILE* logfile void +//init.c +int output_msg =FALSE +#endif + +//gprof.c +Int ProfCalls void +Int ProfGCs void +Int ProfHGrows void +Int ProfSGrows void +Int ProfMallocs void +Int ProfOn void +Int ProfOns void +struct RB_red_blk_node* ProfilerRoot void +struct RB_red_blk_node* ProfilerNil void +char* DIRNAME =NULL + +#if defined(COFF) || defined(A_OUT) +// loada_coff.c && load_aout.c +char Executable[YAP_FILENAME_MAX] void +#endif + + +#if __simplescalar__ +char pwd[YAP_FILENAME_MAX] void +#endif + +//udi.c +//struct udi_control_block RtreeCmd void + + + END_GLOBAL_DATA diff --git a/misc/LOCALS b/misc/LOCALS index 7636e5d9e..f5b8e50f6 100644 --- a/misc/LOCALS +++ b/misc/LOCALS @@ -2,148 +2,213 @@ START_WORKER_LOCAL // Streams -int c_input_stream =0 -int c_output_stream =1 -int c_error_stream =2 +int c_input_stream =0 +int c_output_stream =1 +int c_error_stream =2 // Restore info -CELL* OldASP =NULL -CELL* OldLCL0 =NULL -tr_fr_ptr OldTR =NULL -CELL* OldGlobalBase =NULL -CELL* OldH =NULL -CELL* OldH0 =NULL -ADDR OldTrailBase =NULL -ADDR OldTrailTop =NULL -ADDR OldHeapBase =NULL -ADDR OldHeapTop =NULL -Int ClDiff =0L -Int GDiff =0L -Int HDiff =0L -Int GDiff0 =0L -Int GSplit =NULL -Int LDiff =0L -Int TrDiff =0L -Int XDiff =0L -Int DelayDiff =0L -Int BaseDiff =0L +CELL* OldASP =NULL +CELL* OldLCL0 =NULL +tr_fr_ptr OldTR =NULL +CELL* OldGlobalBase =NULL +CELL* OldH =NULL +CELL* OldH0 =NULL +ADDR OldTrailBase =NULL +ADDR OldTrailTop =NULL +ADDR OldHeapBase =NULL +ADDR OldHeapTop =NULL +Int ClDiff =0L +Int GDiff =0L +Int HDiff =0L +Int GDiff0 =0L +CELL* GSplit =NULL +Int LDiff =0L +Int TrDiff =0L +Int XDiff =0L +Int DelayDiff =0L +Int BaseDiff =0L // Reduction counters -YAP_ULONG_LONG ReductionsCounter =0L -YAP_ULONG_LONG PredEntriesCounter =0L -YAP_ULONG_LONG RetriesCounter =0L -int ReductionsCounterOn =0L -int PredEntriesCounterOn =0L -int RetriesCounterOn =0L +YAP_ULONG_LONG ReductionsCounter =0L +YAP_ULONG_LONG PredEntriesCounter =0L +YAP_ULONG_LONG RetriesCounter =0L +int ReductionsCounterOn =0L +int PredEntriesCounterOn =0L +int RetriesCounterOn =0L // support for consulting files /* current consult stack */ -union CONSULT_OBJ* ConsultSp =NULL +union CONSULT_OBJ* ConsultSp =NULL /* current maximum number of cells in consult stack */ -UInt ConsultCapacity void +UInt ConsultCapacity void /* top of consult stack */ -union CONSULT_OBJ* ConsultBase =NULL +union CONSULT_OBJ* ConsultBase =NULL /* low-water mark for consult */ -union CONSULT_OBJ* ConsultLow =NULL +union CONSULT_OBJ* ConsultLow =NULL //global variables -Term GlobalArena =0L TermToGlobalOrAtomAdjust -UInt GlobalArenaOverflows =0L -Int ArenaOverflows =0L -Int DepthArenas =0 +Term GlobalArena =0L TermToGlobalOrAtomAdjust +UInt GlobalArenaOverflows =0L +Int ArenaOverflows =0L +Int DepthArenas =0 -int ArithError =FALSE -struct pred_entry* LastAssertedPred =NULL -int DebugOn =FALSE -char* ScannerStack =NULL -struct scanner_extra_alloc* ScannerExtraBlocks =NULL -struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid) -UInt ActiveSignals =0L -UInt IPredArity =0L -yamop* ProfEnd =NULL -int UncaughtThrow =FALSE -int DoingUndefp =FALSE -Int StartLine =0L -scratch_block ScratchPad InitScratchPad(wid) +int ArithError =FALSE +struct pred_entry* LastAssertedPred =NULL +int DebugOn =FALSE +char* ScannerStack =NULL +struct scanner_extra_alloc* ScannerExtraBlocks =NULL +struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid) +UInt ActiveSignals =0L +UInt IPredArity =0L +yamop* ProfEnd =NULL +int UncaughtThrow =FALSE +int DoingUndefp =FALSE +Int StartLine =0L +scratch_block ScratchPad InitScratchPad(wid) #ifdef COROUTINING -Term WokenGoals =0L TermToGlobalAdjust -Term AttsMutableList =0L TermToGlobalAdjust +Term WokenGoals =0L TermToGlobalAdjust +Term AttsMutableList =0L TermToGlobalAdjust #endif // gc_stuff -Term GcGeneration =0L TermToGlobalAdjust -Term GcPhase =0L TermToGlobalAdjust -UInt GcCurrentPhase =0L -UInt GcCalls =0L -Int TotGcTime =0L -YAP_ULONG_LONG TotGcRecovered =0L -Int LastGcTime =0L -Int LastSSTime =0L +Term GcGeneration =0L TermToGlobalAdjust +Term GcPhase =0L TermToGlobalAdjust +UInt GcCurrentPhase =0L +UInt GcCalls =0L +Int TotGcTime =0L +YAP_ULONG_LONG TotGcRecovered =0L +Int LastGcTime =0L +Int LastSSTime =0L /* in a single gc */ -Int total_marked =0L -Int total_oldies =0L -struct choicept* current_B =NULL -CELL* prev_HB =NULL -CELL* HGEN =NULL -CELL** iptop =NULL +Int total_marked =0L +Int total_oldies =0L +struct choicept* current_B =NULL +CELL* prev_HB =NULL +CELL* HGEN =NULL +CELL** iptop =NULL #if defined(GC_NO_TAGS) -char* bp =NULL +char* bp =NULL #endif -tr_fr_ptr sTR =NULL -tr_fr_ptr sTR0 =NULL -tr_fr_ptr new_TR =NULL -struct gc_mark_continuation* cont_top0 =NULL -struct gc_mark_continuation* cont_top =NULL -int discard_trail_entries =0 -gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE] void -gc_ma_hash_entry* gc_ma_h_top =NULL -gc_ma_hash_entry* gc_ma_h_list =NULL -UInt gc_timestamp =0L -ADDR db_vec =NULL -ADDR db_vec0 =NULL -struct RB_red_blk_node* db_root =NULL -struct RB_red_blk_node* db_nil =NULL - -sigjmp_buf gc_restore void -struct array_entry* DynamicArrays =NULL PtoArrayEAdjust -struct static_array_entry* StaticArrays =NULL PtoArraySAdjust -struct global_entry* GlobalVariables =NULL PtoGlobalEAdjust -int AllowRestart =FALSE +tr_fr_ptr sTR =NULL +tr_fr_ptr sTR0 =NULL +tr_fr_ptr new_TR =NULL +struct gc_mark_continuation* cont_top0 =NULL +struct gc_mark_continuation* cont_top =NULL +int discard_trail_entries =0 +gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE] void +gc_ma_hash_entry* gc_ma_h_top =NULL +gc_ma_hash_entry* gc_ma_h_list =NULL +UInt gc_timestamp =0L +ADDR db_vec =NULL +ADDR db_vec0 =NULL +struct RB_red_blk_node* db_root =NULL +struct RB_red_blk_node* db_nil =NULL +sigjmp_buf gc_restore void +struct array_entry* DynamicArrays =NULL PtoArrayEAdjust +struct static_array_entry* StaticArrays =NULL PtoArraySAdjust +struct global_entry* GlobalVariables =NULL PtoGlobalEAdjust +int AllowRestart =FALSE + // Thread Local Area for Fast Storage of Intermediate Compiled Code -struct mem_blk* CMemFirstBlock =NULL -UInt CMemFirstBlockSz =0L +struct mem_blk* CMemFirstBlock =NULL +UInt CMemFirstBlockSz =0L // Thread Local Area for Labels -Int* LabelFirstArray =NULL -UInt LabelFirstArraySz =0L +Int* LabelFirstArray =NULL +UInt LabelFirstArraySz =0L // Thread Local Area for SWI-Prolog emulation routines. -struct PL_local_data* PL_local_data_p =Yap_InitThreadIO(wid) +struct PL_local_data* PL_local_data_p =Yap_InitThreadIO(wid) #ifdef THREADS -struct thandle ThreadHandle InitThreadHandle(wid) +struct thandle ThreadHandle InitThreadHandle(wid) #endif /* THREADS */ #if defined(YAPOR) || defined(TABLING) -struct local_optyap_data optyap_data Yap_init_local_optyap_data(wid) +struct local_optyap_data optyap_data Yap_init_local_optyap_data(wid) #endif /* YAPOR || TABLING */ -int InterruptsDisabled =FALSE +int InterruptsDisabled =FALSE -struct open_query_struct* execution =NULL +struct open_query_struct* execution =NULL #if LOW_LEVEL_TRACER -Int total_choicepoints =0 +Int total_choicepoints =0 #endif -int consult_level =0 +int consult_level =0 #if defined(YAPOR) || defined(THREADS) -lockvar SignalLock MkLock +lockvar SignalLock MkLock +#endif + +// Variables related to memory allocation +ADDR LocalBase void +ADDR GlobalBase void +ADDR TrailBase void +ADDR TrailTop void +char* ErrorMessage void +Term Error_Term void +#ifdef THREADS +Term Error_TYPE void +#else +yap_error_number Error_TYPE void +#endif +UInt Error_Size void +char ErrorSay[MAX_ERROR_MSG_SIZE] void +jmp_buf IOBotch void +TokEntry* tokptr void +TokEntry* toktide void +VarEntry* VarTable void +VarEntry* AnonVarTable void +sigjmp_buf RestartEnv void +char FileNameBuf[YAP_FILENAME_MAX] void +char FileNameBuf2[YAP_FILENAME_MAX] void + +// Prolog State + +Int PrologMode =BootMode +int CritLocks =0 + +//analyst.c +/* used to find out how many instructions of each kind are executed */ +#ifdef ANALYST +YAP_ULONG_LONG opcount[_std_top+1] void +YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1] void +#endif /* ANALYST */ + +//dbase.c +struct db_globs* s_dbg void + +//eval.c +yap_error_number matherror =YAP_NO_ERROR + +//grow.c +int heap_overflows =0 +Int total_heap_overflow_time =0 +int stack_overflows =0 +Int total_stack_overflow_time =0 +int delay_overflows =0 +Int total_delay_overflow_time =0 +int trail_overflows =0 +Int total_trail_overflow_time =0 +int atom_table_overflows =0 +Int total_atom_table_overflow_time =0 + +//load_dyld +#ifdef LOAD_DYLD +static dl_errno =0 +#endif + +//tracer.c +#ifdef LOW_LEVEL_TRACER +int do_trace_primitives =TRUE #endif END_WORKER_LOCAL + + diff --git a/packages/CLPBN/Makefile.in b/packages/CLPBN/Makefile.in index 6eae7152b..c3cc626e7 100644 --- a/packages/CLPBN/Makefile.in +++ b/packages/CLPBN/Makefile.in @@ -51,7 +51,7 @@ CLPBN_PROGRAMS= \ $(CLPBN_SRCDIR)/table.yap \ $(CLPBN_SRCDIR)/topsort.yap \ $(CLPBN_SRCDIR)/utils.yap \ - $(CLPBN_SRCDIR)/vel.yap \ + $(CLPBN_SRCDIR)/ve.yap \ $(CLPBN_SRCDIR)/viterbi.yap \ $(CLPBN_SRCDIR)/xbif.yap diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index c28814f92..11e57eb45 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -7,6 +7,7 @@ clpbn_key/2, clpbn_init_solver/4, clpbn_run_solver/3, + clpbn_finalize_solver/1, clpbn_init_solver/5, clpbn_run_solver/4, clpbn_init_graph/1, @@ -28,13 +29,22 @@ :- attribute key/1, dist/2, evidence/1, starter/0. -:- use_module('clpbn/vel', - [vel/3, - check_if_vel_done/1, - init_vel_solver/4, - run_vel_solver/3 +:- use_module('clpbn/ve', + [ve/3, + check_if_ve_done/1, + init_ve_solver/4, + run_ve_solver/3 ]). +:- use_module('clpbn/bp', + [bp/3, + check_if_bp_done/1, + init_bp_solver/4, + run_bp_solver/3, + finalize_bp_solver/1 + ]). + + :- use_module('clpbn/jt', [jt/3, init_jt_solver/4, @@ -53,6 +63,14 @@ run_gibbs_solver/3 ]). +:- use_module('clpbn/bp', + [bp/3, + check_if_bp_done/1, + init_bp_solver/4, + run_bp_solver/3, + finalize_bp_solver/1 + ]). + :- use_module('clpbn/pgrammar', [init_pcg_solver/4, run_pcg_solver/3, @@ -92,8 +110,8 @@ :- dynamic solver/1,output/1,use/1,suppress_attribute_display/1, parameter_softening/1, em_solver/1. -solver(vel). -em_solver(vel). +solver(ve). +em_solver(ve). %output(xbif(user_error)). %output(gviz(user_error)). @@ -142,6 +160,18 @@ clpbn_flag(parameter_softening,Before,After) :- % ,writeln({Var = Key with Dist}) . +% +% make sure a query variable is reachable by the garbage collector. +% +store_var(El) :- + catch(b_getval(clpbn_qvars,Q.Tail), _, init_clpbn_vars(El, Q, Tail)), + Tail = [El|NewTail], + b_setval(clpbn_qvars, [Q|NewTail]). + +init_clpbn_vars(El, Q, Tail) :- + Q = [El|Tail], + b_setval(clpbn_qvars, [Q|Tail]). + check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !. check_constraint((A->D), _, _, (A->D)) :- var(A), !. check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !, @@ -162,8 +192,10 @@ add_evidence(V,Key,Distinfo,NV) :- nonvar(V), !, get_evidence_position(V, Distinfo, Pos), check_stored_evidence(Key, Pos), + store_var(NV), clpbn:put_atts(NV,evidence(Pos)). add_evidence(V,K,_,V) :- + store_var(V), add_evidence(K,V). clpbn_marginalise(V, Dist) :- @@ -183,7 +215,7 @@ project_attributes(GVars, AVars) :- clpbn_vars(AVars, DiffVars, AllVars), get_clpbn_vars(GVars,CLPBNGVars0), simplify_query_vars(CLPBNGVars0, CLPBNGVars), - (output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,vel,AllVars) ; true), + (output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,ve,AllVars) ; true), (output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,sort,AllVars,GVars) ; true), ( Solver = graphs @@ -225,10 +257,12 @@ get_rid_of_ev_vars([V|LVs0],[V|LVs]) :- % do nothing if we don't have query variables to compute. write_out(graphs, _, AVars, _) :- clpbn2graph(AVars). -write_out(vel, GVars, AVars, DiffVars) :- - vel(GVars, AVars, DiffVars). +write_out(ve, GVars, AVars, DiffVars) :- + ve(GVars, AVars, DiffVars). write_out(jt, GVars, AVars, DiffVars) :- jt(GVars, AVars, DiffVars). +write_out(bp, GVars, AVars, DiffVars) :- + bp(GVars, AVars, DiffVars). write_out(gibbs, GVars, AVars, DiffVars) :- gibbs(GVars, AVars, DiffVars). write_out(bnt, GVars, AVars, DiffVars) :- @@ -315,11 +349,14 @@ bind_clpbn(_, Var, _, _, _, _, []) :- use(bnt), check_if_bnt_done(Var), !. bind_clpbn(_, Var, _, _, _, _, []) :- - use(vel), - check_if_vel_done(Var), !. + use(ve), + check_if_ve_done(Var), !. +bind_clpbn(_, Var, _, _, _, _, []) :- + use(bp), + check_if_bp_done(Var), !. bind_clpbn(_, Var, _, _, _, _, []) :- use(jt), - check_if_vel_done(Var), !. + check_if_ve_done(Var), !. bind_clpbn(T, Var, Key0, _, _, _, []) :- get_atts(Var, [key(Key)]), !, ( @@ -379,18 +416,21 @@ clpbn_key(Var,Key) :- % values at the end of the day. % clpbn_init_solver(LVs, Vs0, VarsWithUnboundKeys, State) :- - solver(Solver), + solver(Solver), clpbn_init_solver(Solver, LVs, Vs0, VarsWithUnboundKeys, State). clpbn_init_solver(gibbs, LVs, Vs0, VarsWithUnboundKeys, State) :- init_gibbs_solver(LVs, Vs0, VarsWithUnboundKeys, State). -clpbn_init_solver(vel, LVs, Vs0, VarsWithUnboundKeys, State) :- - init_vel_solver(LVs, Vs0, VarsWithUnboundKeys, State). +clpbn_init_solver(ve, LVs, Vs0, VarsWithUnboundKeys, State) :- + init_ve_solver(LVs, Vs0, VarsWithUnboundKeys, State). +clpbn_init_solver(bp, LVs, Vs0, VarsWithUnboundKeys, State) :- + init_bp_solver(LVs, Vs0, VarsWithUnboundKeys, State). clpbn_init_solver(jt, LVs, Vs0, VarsWithUnboundKeys, State) :- init_jt_solver(LVs, Vs0, VarsWithUnboundKeys, State). clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :- init_pcg_solver(LVs, Vs0, VarsWithUnboundKeys, State). + % % LVs is the list of lists of variables to marginalise % Vs is the full graph @@ -398,15 +438,21 @@ clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :- % % clpbn_run_solver(LVs, LPs, State) :- - solver(Solver), + solver(Solver), clpbn_run_solver(Solver, LVs, LPs, State). clpbn_run_solver(gibbs, LVs, LPs, State) :- run_gibbs_solver(LVs, LPs, State). -clpbn_run_solver(vel, LVs, LPs, State) :- - run_vel_solver(LVs, LPs, State). + +clpbn_run_solver(ve, LVs, LPs, State) :- + run_ve_solver(LVs, LPs, State). + +clpbn_run_solver(bp, LVs, LPs, State) :- + run_bp_solver(LVs, LPs, State). + clpbn_run_solver(jt, LVs, LPs, State) :- run_jt_solver(LVs, LPs, State). + clpbn_run_solver(pcg, LVs, LPs, State) :- run_pcg_solver(LVs, LPs, State). @@ -415,3 +461,10 @@ add_keys(Key1+V1,_Key2,Key1+V1). clpbn_init_graph(pcg) :- !, pcg_init_graph. clpbn_init_graph(_). + +clpbn_finalize_solver(State) :- + solver(bp), !, + functor(State, _, Last), + arg(Last, State, Info), + finalize_bp_solver(Info). +clpbn_finalize_solver(_State). diff --git a/packages/CLPBN/clpbn/aggregates.yap b/packages/CLPBN/clpbn/aggregates.yap index ed83ebb95..3c189756d 100644 --- a/packages/CLPBN/clpbn/aggregates.yap +++ b/packages/CLPBN/clpbn/aggregates.yap @@ -52,7 +52,7 @@ cpt_average(AllVars, Key, Els0, Tab, Vs, NewVs) :- cpt_average(AllVars, Key, Els0, 1.0, Tab, Vs, NewVs). % support variables with evidence from domain. This should make everyone's life easier. -cpt_average([Ev|Vars], Key, Els0, Softness, p(Els0, CPT, NewParents), Vs, NewVs) :- +cpt_average([Ev|Vars], Key, Els0, Softness, pf(Els0, MAT, NewParents), Vs, NewVs) :- find_evidence(Vars, 0, TotEvidence, RVars), build_avg_table(RVars, Vars, Els0, Key, TotEvidence, Softness, MAT0, NewParents0, Vs, IVs), include_qevidence(Ev, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs). diff --git a/packages/CLPBN/clpbn/bp.yap b/packages/CLPBN/clpbn/bp.yap index da4043a4f..417958298 100644 --- a/packages/CLPBN/clpbn/bp.yap +++ b/packages/CLPBN/clpbn/bp.yap @@ -1,157 +1,152 @@ -/*********************************** +/************************************************ Belief Propagation in CLP(BN) - - This should connect to C-code. -*********************************/ +**************************************************/ -:- module(clpbn_bp, [ - bp/3, - check_if_bp_done/1, - init_bp_solver/4, - run_bp_solver/3]). - - -:- use_module(library('clpbn/aggregates'), - [check_for_agg_vars/2]). - -:- use_module(library('clpbn/connected'), - [init_influences/3, - influences/5 +:- module(clpbn_bp, + [bp/3, + check_if_bp_done/1, + init_bp_solver/4, + run_bp_solver/3, + finalize_bp_solver/1 ]). + :- use_module(library('clpbn/dists'), [dist/4, get_dist_domain/2, + get_dist_domain_size/2, get_dist_params/2 ]). -:- use_module(library('clpbn/display'), - [clpbn_bind_vals/3]). -:-use_module(library(lists), - [append/3, - memberchk/2 - ]). +:- use_module(library('clpbn/display'), + [clpbn_bind_vals/3]). + + +:- use_module(library(atts)). + +:- use_module(library(charsio)). :- load_foreign_files(['horus'], [], init_predicates). -:- attribute all_diffs/1. +:- attribute id/1. + +:- dynamic num_bayes_nets/1. check_if_bp_done(_Var). -% -% implementation of belief propagation -% -% A1 = +QueryVars -> sets of independent marginalization variables -% A2 = *AllVars -> list of all variables -% A3 = -Output -> output probabilities -% -% Other important variables: -% -% State0 initialized graph, is used to pass data from initialization -% to query solving (eg, State might be the JT and be used to run -% different queries). -% +num_bayes_nets(0). + + bp([[]],_,_) :- !. -bp([QueryVars],AllVars,Output) :- - writeln(queryVars:QueryVars), - writeln(allVars:AllVars), - % init_bp_solver([QueryVars], AllVars, Output, State), - run_bp_solver([QueryVars], [AllVars], _State), - % bind probs back to variables so that they can be output. - clpbn_bind_vals([QueryVars],[LPs],Output). - -% initialise necessary data for query solver -init_bp_solver(Qs, AllVars, _, graph(LVis)) :- - % replace average, max, min and friends by binary nodes. - check_for_agg_vars(AllVars, UnFoldedVars), - % replace the variables reachable from G - init_influences(UnfoldedVars, G, RG), - init_bp_solver_for_questions(Qs, G, RG, _, LVis). - -init_bp_solver_for_questions([], _, _, [], []). -init_bp_solver_for_questions([Vs|MVs], G, RG, [NVs|MNVs0], [NVs|LVis]) :- - % find variables connectd to Vs - influences(Vs, _, NVs0, G, RG), - sort(NVs0, NVs), - init_bp_solver_for_questions(MVs, G, RG, MNVs0, LVis). +bp([QueryVars], AllVars, Output) :- + init_bp_solver(_, AllVars, _, BayesNet), + run_bp_solver([QueryVars], LPs, BayesNet), + finalize_bp_solver(BayesNet), + clpbn_bind_vals([QueryVars], LPs, Output). -% use a findall to recover space without needing for GC -run_bp_solver(LVs, LPs, _) :- - findall(Ps, solve_bp(LVs, LPs, Ps), LPs). +init_bp_solver(_, AllVars, _, (BayesNet, DistIds)) :- + %inc_num_bayes_nets, + %(showprofres(50) -> true ; true), + process_ids(AllVars, 0, DistIds0), + get_vars_info(AllVars, VarsInfo), + sort(DistIds0, DistIds), + %(num_bayes_nets(0) -> writeln(vars:VarsInfo) ; true), + %(num_bayes_nets(0) -> writeln(dists:DistsInfo) ; true), + create_network(VarsInfo, BayesNet). + %get_extra_vars_info(AllVars, ExtraVarsInfo), + %set_extra_vars_info(BayesNet, ExtraVarsInfo). + - -solve_bp([LVs|_], [NVs0|_], Ps) :- - get_vars_info(NVs0, LVi), - get_dists_info(NVs0, Dists), - process(LVi, Dists, LVs, Ps). -solve_bp([_|MoreLVs], [_|MoreLVis], Ps) :- - solve_bp(MoreLVs, MoreLVis, Ps). +process_ids([], _, []). +process_ids([V|Vs], VarId0, [DistId|DistIds]) :- + clpbn:get_atts(V, [dist(DistId, _)]), !, + put_atts(V, [id(VarId0)]), + VarId is VarId0 + 1, + process_ids(Vs, VarId, DistIds). +process_ids([_|Vs], VarId, DistIds) :- + process_ids(Vs, VarId, DistIds). get_vars_info([], []). -get_vars_info([V|Vs], [var(V, Id, Parents, NParents, Ev)|LV]) :- - clpbn:get_atts(V, [dist(Id, Parents)]), !, - length(Parents, NParents), +get_vars_info([V|Vs], [var(VarId, DSize, Ev, ParentIds, DistId)|VarsInfo]) :- + clpbn:get_atts(V, [dist(DistId, Parents)]), !, + get_atts(V, [id(VarId)]), + get_dist_domain_size(DistId, DSize), get_evidence(V, Ev), - get_vars_info(Vs, LV). -get_vars_info([_|Vs], LV) :- - get_vars_info(Vs, LV). + vars2ids(Parents, ParentIds), + get_vars_info(Vs, VarsInfo). +get_vars_info([_|Vs], VarsInfo) :- + get_vars_info(Vs, VarsInfo). + + +vars2ids([], []). +vars2ids([V|QueryVars], [VarId|Ids]) :- + get_atts(V, [id(VarId)]), + vars2ids(QueryVars, Ids). get_evidence(V, Ev) :- clpbn:get_atts(V, [evidence(Ev)]), !. -get_evidence(V, -1). % no evidence !!! +get_evidence(_V, -1). % no evidence !!! -get_dists_info([],[]). -get_dists_info([V|Vs], [dist(Id, Domain, DSize, Params, NParams) | Dists]) :- - clpbn:get_atts(V, [dist(Id, _)]), !, - get_dist_domain(Id, Domain), - length(Domain, DSize), +get_extra_vars_info([], []). +get_extra_vars_info([V|Vs], [v(VarId, Label, Domain)|VarsInfo]) :- + get_atts(V, [id(VarId)]), !, + clpbn:get_atts(V, [key(Key),dist(DistId, _)]), + term_to_atom(Key, Label), + get_dist_domain(DistId, Domain0), + numbers2atoms(Domain0, Domain), + get_extra_vars_info(Vs, VarsInfo). +get_extra_vars_info([_|Vs], VarsInfo) :- + get_extra_vars_info(Vs, VarsInfo). + + +numbers2atoms([], []). +numbers2atoms([Atom|L0], [Atom|L]) :- + atom(Atom), !, + numbers2atoms(L0, L). +numbers2atoms([Number|L0], [Atom|L]) :- + number_atom(Number, Atom), + numbers2atoms(L0, L). + + +run_bp_solver(QVsL0, LPs, (BayesNet, DistIds)) :- + get_dists_parameters(DistIds, DistsParams), + set_parameters(BayesNet, DistsParams), + process_query_list(QVsL0, QVsL), + %writeln(' qvs':QVsL), + %(num_bayes_nets(1506) -> writeln(qvs:QVsL) ; true), + run_solver(BayesNet, QVsL, LPs). + + +process_query_list([], []). +process_query_list([[V]|QueryVars], [VarId|Ids]) :- !, + get_atts(V, [id(VarId)]), + process_query_list(QueryVars, Ids). +process_query_list([Vs|QueryVars], [VarIds|Ids]) :- + vars2ids(Vs, VarIds), + process_query_list(QueryVars, Ids). + + +get_dists_parameters([],[]). +get_dists_parameters([Id|Ids], [dist(Id, Params)|DistsInfo]) :- get_dist_params(Id, Params), - length(Params, NParams), - get_dists_info(Vs, Dists). -get_dists_info([_|Vs], Dists) :- - get_dists_info(Vs, Dists). + get_dists_parameters(Ids, DistsInfo). -% +Vars is a list containing info about every clpbn variables -% +Dists is a list containing info about distributions -% +QVs is a list containing the query variables -% -Out is some output term stating the probabilities -process(Vars, Dists, QVs, Out) :- - write('vars = '), writeln(Vars), - order_vars(Vars, [], OrderedVars), - write('ovars = '), writeln(OrderedVars), - write('dists = '), writeln(Dists), - write('qvs = '), writeln(QVs), - length(OrderedVars, NVars), - length(Dists, NDists), - %create_network(OrderedVars, NVars, Dists, NDists, BNet), - length(QVs, NQVs), - run_solver(BNet, QVs, NQVs, Out), - free_memory(BNet). +finalize_bp_solver((BayesNet, _)) :- + delete_bayes_net(BayesNet). -order_vars([V], _, [V]) :- !. -order_vars([var(V, Id, Parents, NParents, Ev)|Vs], ParsedVars, [var(V, Id, Parents, NParents, Ev)|OrderedVars]) :- - \+ memberchk(V, ParsedVars), - parents_defined(Parents, ParsedVars), !, - order_vars(Vs, [V|ParsedVars], OrderedVars). -order_vars([var(V, Id, Parents, NParents, Ev)|Vs], ParsedVars, OrderedVars) :- - append(Vs, [var(V, Id, Parents, NParents, Ev)], NVs), - order_vars(NVs, ParsedVars, OrderedVars). +inc_num_bayes_nets :- + retract(num_bayes_nets(Count0)), + Count is Count0 + 1, + assert(num_bayes_nets(Count)). - -parents_defined([], _) :- !. -parents_defined([Parent|Parents], ParsedVars) :- - memberchk(Parent, ParsedVars), - parents_defined(Parents, ParsedVars). - -% f(F), b(B). ----> FAIL diff --git a/packages/CLPBN/clpbn/bp/BPSolver.cpp b/packages/CLPBN/clpbn/bp/BPSolver.cpp new file mode 100755 index 000000000..1d3566aa8 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/BPSolver.cpp @@ -0,0 +1,891 @@ +#include +#include +#include +#include +#include +#include + +#include "BPSolver.h" +#include "BpNode.h" + + +BPSolver* Edge::klass = 0; +StatisticMap Statistics::stats_; +unsigned Statistics::numCreatedNets = 0; +unsigned Statistics::numSolvedPolyTrees = 0; +unsigned Statistics::numSolvedLoopyNets = 0; +unsigned Statistics::numUnconvergedRuns = 0; +unsigned Statistics::maxIterations = 0; +unsigned Statistics::totalOfIterations = 0; + + +BPSolver::BPSolver (const BayesNet& bn) : Solver (&bn) +{ + bn_ = &bn; + forceGenericSolver_ = false; + //forceGenericSolver_ = true; + schedule_ = S_SEQ_FIXED; + //schedule_ = S_SEQ_RANDOM; + //schedule_ = S_PARALLEL; + //schedule_ = S_MAX_RESIDUAL; + maxIter_ = 205; + accuracy_ = 0.000001; +} + + + +BPSolver::~BPSolver (void) +{ + for (unsigned i = 0; i < msgs_.size(); i++) { + delete msgs_[i]; + } +} + + + +void +BPSolver::runSolver (void) +{ + if (DL >= 1) { + //bn_->printNetwork(); + } + + clock_t start_ = clock(); + if (bn_->isSingleConnected() && !forceGenericSolver_) { + runPolyTreeSolver(); + Statistics::numSolvedPolyTrees ++; + } else { + runGenericSolver(); + Statistics::numSolvedLoopyNets ++; + if (nIter_ >= maxIter_) { + Statistics::numUnconvergedRuns ++; + } else { + Statistics::updateIterations (nIter_); + } + if (DL >= 1) { + cout << endl; + if (nIter_ < maxIter_) { + cout << "Belief propagation converged in " ; + cout << nIter_ << " iterations" << endl; + } else { + cout << "The maximum number of iterations was hit, terminating..." ; + cout << endl; + } + } + } + double time = (double (clock() - start_)) / CLOCKS_PER_SEC; + unsigned size = bn_->getNumberOfNodes(); + Statistics::updateStats (size, time); + //if (size > 30) { + // stringstream ss; + // ss << size << "." << Statistics::getCounting (size) << ".dot" ; + // bn_->exportToDotFile (ss.str().c_str()); + //} +} + + + +ParamSet +BPSolver::getPosterioriOf (const Variable* var) const +{ + assert (var); + assert (var == bn_->getNode (var->getVarId())); + assert (var->getIndex() < msgs_.size()); + return msgs_[var->getIndex()]->getBeliefs(); +} + + + + +ParamSet +BPSolver::getJointDistribution (const NodeSet& jointVars) const +{ + if (DL >= 1) { + cout << "calculating joint distribuition on: " ; + for (unsigned i = 0; i < jointVars.size(); i++) { + cout << jointVars[i]->getLabel() << " " ; + } + cout << endl; + } + + //BayesNet* workingNet = bn_->pruneNetwork (bn_->getNodes()); + //FIXME see if this works: + BayesNet* workingNet = bn_->pruneNetwork (jointVars); + BayesNode* node = workingNet->getNode (jointVars[0]->getVarId()); + + BayesNet* tempNet = workingNet->pruneNetwork (node); + BPSolver solver (*tempNet); + solver.runSolver(); + + NodeSet observedVars = { jointVars[0] }; + + node = tempNet->getNode (jointVars[0]->getVarId()); + ParamSet prevBeliefs = solver.getPosterioriOf (node); + + delete tempNet; + + for (unsigned i = 1; i < jointVars.size(); i++) { + node = workingNet->getNode (observedVars[i - 1]->getVarId()); + if (!node->hasEvidence()) { + node->setEvidence (0); + } + node = workingNet->getNode (jointVars[i]->getVarId()); + tempNet = workingNet->pruneNetwork (node); + + ParamSet allBeliefs; + vector confs = + BayesNet::getDomainConfigurationsOf (observedVars); + for (unsigned j = 0; j < confs.size(); j++) { + for (unsigned k = 0; k < observedVars.size(); k++) { + node = tempNet->getNode (observedVars[k]->getVarId()); + if (!observedVars[k]->hasEvidence()) { + if (node) { + node->setEvidence (confs[j][k]); + } else { + // FIXME try optimize + //assert (false); + cout << observedVars[k]->getLabel(); + cout << " is not in temporary net!" ; + cout << endl; + } + } else { + cout << observedVars[k]->getLabel(); + cout << " already has evidence in original net!" ; + cout << endl; + } + } + BPSolver solver (*tempNet); + node = tempNet->getNode (jointVars[i]->getVarId()); + solver.runSolver(); + ParamSet beliefs = solver.getPosterioriOf (node); + for (unsigned k = 0; k < beliefs.size(); k++) { + allBeliefs.push_back (beliefs[k]); + } + } + + int count = -1; + for (unsigned j = 0; j < allBeliefs.size(); j++) { + if (j % jointVars[i]->getDomainSize() == 0) { + count ++; + } + allBeliefs[j] *= prevBeliefs[count]; + } + prevBeliefs = allBeliefs; + observedVars.push_back (jointVars[i]); + delete tempNet; + } + delete workingNet; + return prevBeliefs; +} + + + +void +BPSolver::initializeSolver (void) +{ + if (DL >= 1) { + cout << "Initializing solver" << endl; + cout << "-> schedule = "; + if (forceGenericSolver_) { + switch (schedule_) { + case S_SEQ_FIXED: cout << "sequential fixed" ; break; + case S_SEQ_RANDOM: cout << "sequential random" ; break; + case S_PARALLEL: cout << "parallel" ; break; + case S_MAX_RESIDUAL: cout << "max residual" ; break; + } + } else { + cout << "polytree solver" ; + } + cout << endl; + cout << "-> max iters = " << maxIter_ << endl; + cout << "-> accuracy = " << accuracy_ << endl; + cout << endl; + } + + const NodeSet& nodes = bn_->getNodes(); + for (unsigned i = 0; i < msgs_.size(); i++) { + delete msgs_[i]; + } + msgs_.clear(); + msgs_.reserve (nodes.size()); + updateOrder_.clear(); + sortedOrder_.clear(); + edgeMap_.clear(); + + for (unsigned i = 0; i < nodes.size(); i++) { + msgs_.push_back (new BpNode (nodes[i])); + } + + NodeSet roots = bn_->getRootNodes(); + for (unsigned i = 0; i < roots.size(); i++) { + const ParamSet& params = roots[i]->getParameters(); + ParamSet& piVals = M(roots[i])->getPiValues(); + for (int ri = 0; ri < roots[i]->getDomainSize(); ri++) { + piVals[ri] = params[ri]; + } + } +} + + + +void +BPSolver::incorporateEvidence (BayesNode* x) +{ + ParamSet& piVals = M(x)->getPiValues(); + ParamSet& ldVals = M(x)->getLambdaValues(); + for (int xi = 0; xi < x->getDomainSize(); xi++) { + piVals[xi] = 0.0; + ldVals[xi] = 0.0; + } + piVals[x->getEvidence()] = 1.0; + ldVals[x->getEvidence()] = 1.0; +} + + + +void +BPSolver::runPolyTreeSolver (void) +{ + initializeSolver(); + const NodeSet& nodes = bn_->getNodes(); + + // Hack: I need this else this can happen with bayes ball + // Variable: 174 + // Id: 174 + // Domain: -1, 0, 1 + // Evidence: 1 + // Parents: + // Childs: 176 + // cpt + // ---------------------------------------------------- + // -1 0 0 0 0 ... + // 0 0.857143 0.857143 0.857143 0.857143 ... + // 1 0.142857 0.142857 0.142857 0.142857 ... + // the cpt for this node would be 0,0,0 + + for (unsigned i = 0; i < nodes.size(); i++) { + if (nodes[i]->hasEvidence()) { + incorporateEvidence (nodes[i]); + } + } + + // first compute all node marginals ... + NodeSet roots = bn_->getRootNodes(); + for (unsigned i = 0; i < roots.size(); i++) { + const NodeSet& childs = roots[i]->getChilds(); + for (unsigned j = 0; j < childs.size(); j++) { + polyTreePiMessage (roots[i], childs[j]); + } + } + // then propagate the evidence + for (unsigned i = 0; i < nodes.size(); i++) { + if (nodes[i]->hasEvidence()) { + incorporateEvidence (nodes[i]); + const NodeSet& parents = nodes[i]->getParents(); + for (unsigned j = 0; j < parents.size(); j++) { + if (!parents[j]->hasEvidence()) { + polyTreeLambdaMessage (nodes[i], parents[j]); + } + } + const NodeSet& childs = nodes[i]->getChilds(); + for (unsigned j = 0; j < childs.size(); j++) { + polyTreePiMessage (nodes[i], childs[j]); + } + } + } +} + + + +void +BPSolver::polyTreePiMessage (BayesNode* z, BayesNode* x) +{ + if (DL >= 1) { + cout << PI << " (" << z->getLabel(); + cout << " --> " << x->getLabel(); + cout << ")" << endl; + } + calculateNextPiMessage (z, x); + updatePiMessage (z, x); + + if (!x->hasEvidence()) { + updatePiValues (x); + const NodeSet& xChilds = x->getChilds(); + for (unsigned i = 0; i < xChilds.size(); i++) { + polyTreePiMessage (x, xChilds[i]); + } + } + + if (M(x)->hasReceivedChildInfluence()) { + const NodeSet& xParents = x->getParents(); + for (unsigned i = 0; i < xParents.size(); i++) { + if (xParents[i] != z && !xParents[i]->hasEvidence()) { + polyTreeLambdaMessage (x, xParents[i]); + } + } + } +} + + + +void +BPSolver::polyTreeLambdaMessage (BayesNode* y, BayesNode* x) +{ + if (DL >= 1) { + cout << LD << " (" << y->getLabel(); + cout << " --> " << x->getLabel(); + cout << ")" << endl; + } + calculateNextLambdaMessage (y, x); + updateLambdaMessage (y, x); + updateLambdaValues (x); + + const NodeSet& xParents = x->getParents(); + for (unsigned i = 0; i < xParents.size(); i++) { + if (!xParents[i]->hasEvidence()) { + polyTreeLambdaMessage (x, xParents[i]); + } + } + + const NodeSet& xChilds = x->getChilds(); + for (unsigned i = 0; i < xChilds.size(); i++) { + if (xChilds[i] != y) { + polyTreePiMessage (x, xChilds[i]); + } + } +} + + + +void +BPSolver::runGenericSolver() +{ + initializeSolver(); + const NodeSet& nodes = bn_->getNodes(); + for (unsigned i = 0; i < nodes.size(); i++) { + if (nodes[i]->hasEvidence()) { + incorporateEvidence (nodes[i]); + } + } + + for (unsigned i = 0; i < nodes.size(); i++) { + // pi messages + const NodeSet& childs = nodes[i]->getChilds(); + for (unsigned j = 0; j < childs.size(); j++) { + updateOrder_.push_back (Edge (nodes[i], childs[j], PI_MSG)); + } + // lambda messages + const NodeSet& parents = nodes[i]->getParents(); + for (unsigned j = 0; j < parents.size(); j++) { + if (!parents[j]->hasEvidence()) { + updateOrder_.push_back (Edge (nodes[i], parents[j], LAMBDA_MSG)); + } + } + } + + nIter_ = 0; + while (!converged() && nIter_ < maxIter_) { + + nIter_++; + if (DL >= 1) { + cout << endl; + cout << "****************************************" ; + cout << "****************************************" ; + cout << endl; + cout << " Iteration " << nIter_ << endl; + cout << "****************************************" ; + cout << "****************************************" ; + cout << endl; + } + + switch (schedule_) { + + case S_SEQ_RANDOM: + random_shuffle (updateOrder_.begin(), updateOrder_.end()); + // no break + + case S_SEQ_FIXED: + for (unsigned i = 0; i < updateOrder_.size(); i++) { + calculateNextMessage (updateOrder_[i]); + updateMessage (updateOrder_[i]); + updateValues (updateOrder_[i]); + } + break; + + case S_PARALLEL: + for (unsigned i = 0; i < updateOrder_.size(); i++) { + calculateNextMessage (updateOrder_[i]); + } + for (unsigned i = 0; i < updateOrder_.size(); i++) { + updateMessage (updateOrder_[i]); + updateValues (updateOrder_[i]); + } + break; + + case S_MAX_RESIDUAL: + maxResidualSchedule(); + break; + + } + } +} + + + +void +BPSolver::maxResidualSchedule (void) +{ + if (nIter_ == 1) { + Edge::klass = this; + for (unsigned i = 0; i < updateOrder_.size(); i++) { + calculateNextMessage (updateOrder_[i]); + updateResidual (updateOrder_[i]); + SortedOrder::iterator it = sortedOrder_.insert (updateOrder_[i]); + edgeMap_.insert (make_pair (updateOrder_[i].getId(), it)); + } + return; + } + + for (unsigned c = 0; c < sortedOrder_.size(); c++) { + if (DL >= 1) { + for (set::iterator it = sortedOrder_.begin(); + it != sortedOrder_.end(); it ++) { + cout << it->toString() << " residual = " ; + cout << getResidual (*it) << endl; + } + } + + set::iterator it = sortedOrder_.begin(); + Edge e = *it; + if (getResidual (e) < accuracy_) { + return; + } + updateMessage (e); + updateValues (e); + clearResidual (e); + sortedOrder_.erase (it); + assert (edgeMap_.find (e.getId()) != edgeMap_.end()); + edgeMap_.find (e.getId())->second = sortedOrder_.insert (e); + + // update the messages that depend on message source --> destination + const NodeSet& childs = e.destination->getChilds(); + for (unsigned i = 0; i < childs.size(); i++) { + if (childs[i] != e.source) { + Edge neighbor (e.destination, childs[i], PI_MSG); + calculateNextMessage (neighbor); + updateResidual (neighbor); + assert (edgeMap_.find (neighbor.getId()) != edgeMap_.end()); + EdgeMap::iterator iter = edgeMap_.find (neighbor.getId()); + sortedOrder_.erase (iter->second); + iter->second = sortedOrder_.insert (neighbor); + } + } + const NodeSet& parents = e.destination->getParents(); + for (unsigned i = 0; i < parents.size(); i++) { + if (parents[i] != e.source && !parents[i]->hasEvidence()) { + Edge neighbor (e.destination, parents[i], LAMBDA_MSG); + calculateNextMessage (neighbor); + updateResidual (neighbor); + assert (edgeMap_.find (neighbor.getId()) != edgeMap_.end()); + EdgeMap::iterator iter = edgeMap_.find (neighbor.getId()); + sortedOrder_.erase (iter->second); + iter->second = sortedOrder_.insert (neighbor); + } + } + } +} + + + +bool +BPSolver::converged (void) const +{ + bool converged = true; + if (schedule_ == S_MAX_RESIDUAL) { + if (nIter_ <= 2) { + return false; + } + // this can happen if every node does not have neighbors + if (sortedOrder_.size() == 0) { + return true; + } + Param maxResidual = getResidual (*(sortedOrder_.begin())); + if (maxResidual > accuracy_) { + return false; + } + } else { + if (nIter_ == 0) { + return false; + } + const NodeSet& nodes = bn_->getNodes(); + for (unsigned i = 0; i < nodes.size(); i++) { + if (!nodes[i]->hasEvidence()) { + double change = M(nodes[i])->getBeliefChange(); + if (DL >= 1) { + cout << nodes[i]->getLabel() + " belief change = " ; + cout << change << endl; + } + if (change > accuracy_) { + converged = false; + if (DL == 0) break; + } + } + } + } + + return converged; +} + + + +void +BPSolver::updatePiValues (BayesNode* x) +{ + // π(Xi) + const NodeSet& parents = x->getParents(); + const vector& entries = x->getCptEntries(); + assert (parents.size() != 0); + stringstream* calcs1; + stringstream* calcs2; + + ParamSet messageProducts (entries.size()); + for (unsigned k = 0; k < entries.size(); k++) { + if (DL >= 5) { + calcs1 = new stringstream; + calcs2 = new stringstream; + } + double messageProduct = 1.0; + const DomainConf& conf = entries[k].getParentConfigurations(); + for (unsigned i = 0; i < parents.size(); i++) { + messageProduct *= M(parents[i])->getPiMessageValue(x, conf[i]); + if (DL >= 5) { + if (i != 0) *calcs1 << "." ; + if (i != 0) *calcs2 << "*" ; + *calcs1 << PI << "(" << x->getLabel() << ")" ; + *calcs1 << "[" << parents[i]->getDomain()[conf[i]] << "]"; + *calcs2 << M(parents[i])->getPiMessageValue(x, conf[i]); + } + } + messageProducts[k] = messageProduct; + if (DL >= 5) { + cout << " mp" << k; + cout << " = " << (*calcs1).str(); + if (parents.size() == 1) { + cout << " = " << messageProduct << endl; + } else { + cout << " = " << (*calcs2).str(); + cout << " = " << messageProduct << endl; + } + delete calcs1; + delete calcs2; + } + } + + for (int xi = 0; xi < x->getDomainSize(); xi++) { + double sum = 0.0; + if (DL >= 5) { + calcs1 = new stringstream; + calcs2 = new stringstream; + } + for (unsigned k = 0; k < entries.size(); k++) { + sum += x->getProbability (xi, entries[k]) * messageProducts[k]; + if (DL >= 5) { + if (k != 0) *calcs1 << " + " ; + if (k != 0) *calcs2 << " + " ; + *calcs1 << x->cptEntryToString (xi, entries[k]); + *calcs1 << ".mp" << k; + *calcs2 << x->getProbability (xi, entries[k]); + *calcs2 << "*" << messageProducts[k]; + } + } + M(x)->setPiValue (xi, sum); + if (DL >= 5) { + cout << " " << PI << "(" << x->getLabel() << ")" ; + cout << "[" << x->getDomain()[xi] << "]" ; + cout << " = " << (*calcs1).str(); + cout << " = " << (*calcs2).str(); + cout << " = " << sum << endl; + delete calcs1; + delete calcs2; + } + } +} + + + +void +BPSolver::updateLambdaValues (BayesNode* x) +{ + // λ(Xi) + const NodeSet& childs = x->getChilds(); + assert (childs.size() != 0); + stringstream* calcs1; + stringstream* calcs2; + + for (int xi = 0; xi < x->getDomainSize(); xi++) { + double product = 1.0; + if (DL >= 5) { + calcs1 = new stringstream; + calcs2 = new stringstream; + } + for (unsigned i = 0; i < childs.size(); i++) { + product *= M(x)->getLambdaMessageValue(childs[i], xi); + if (DL >= 5) { + if (i != 0) *calcs1 << "." ; + if (i != 0) *calcs2 << "*" ; + *calcs1 << LD << "(" << childs[i]->getLabel(); + *calcs1 << "-->" << x->getLabel() << ")" ; + *calcs1 << "[" << x->getDomain()[xi] << "]" ; + *calcs2 << M(x)->getLambdaMessageValue(childs[i], xi); + } + } + M(x)->setLambdaValue (xi, product); + if (DL >= 5) { + cout << " " << LD << "(" << x->getLabel() << ")" ; + cout << "[" << x->getDomain()[xi] << "]" ; + cout << " = " << (*calcs1).str(); + if (childs.size() == 1) { + cout << " = " << product << endl; + } else { + cout << " = " << (*calcs2).str(); + cout << " = " << product << endl; + } + delete calcs1; + delete calcs2; + } + } +} + + + +void +BPSolver::calculateNextPiMessage (BayesNode* z, BayesNode* x) +{ + // πX(Zi) + ParamSet& zxPiNextMessage = M(z)->piNextMessageReference (x); + const NodeSet& zChilds = z->getChilds(); + stringstream* calcs1; + stringstream* calcs2; + + for (int zi = 0; zi < z->getDomainSize(); zi++) { + double product = M(z)->getPiValue (zi); + if (DL >= 5) { + calcs1 = new stringstream; + calcs2 = new stringstream; + *calcs1 << PI << "(" << z->getLabel() << ")"; + *calcs1 << "[" << z->getDomain()[zi] << "]" ; + *calcs2 << product; + } + for (unsigned i = 0; i < zChilds.size(); i++) { + if (zChilds[i] != x) { + product *= M(z)->getLambdaMessageValue(zChilds[i], zi); + if (DL >= 5) { + *calcs1 << "." << LD << "(" << zChilds[i]->getLabel(); + *calcs1 << "-->" << z->getLabel() << ")"; + *calcs1 << "[" << z->getDomain()[zi] + "]" ; + *calcs2 << " * " << M(z)->getLambdaMessageValue(zChilds[i], zi); + } + } + } + zxPiNextMessage[zi] = product; + if (DL >= 5) { + cout << " " << PI << "(" << z->getLabel(); + cout << "-->" << x->getLabel() << ")" ; + cout << "[" << z->getDomain()[zi] << "]" ; + cout << " = " << (*calcs1).str(); + if (zChilds.size() == 1) { + cout << " = " << product << endl; + } else { + cout << " = " << (*calcs2).str(); + cout << " = " << product << endl; + } + delete calcs1; + delete calcs2; + } + } +} + + + +void +BPSolver::calculateNextLambdaMessage (BayesNode* y, BayesNode* x) +{ + // λY(Xi) + //if (!y->hasEvidence() && !M(y)->hasReceivedChildInfluence()) { + // if (DL >= 5) { + // cout << "unnecessary calculation" << endl; + // } + // return; + //} + ParamSet& yxLambdaNextMessage = M(x)->lambdaNextMessageReference (y); + const NodeSet& yParents = y->getParents(); + const vector& allEntries = y->getCptEntries(); + int parentIndex = y->getIndexOfParent (x); + stringstream* calcs1; + stringstream* calcs2; + + vector entries; + DomainConstr constr = make_pair (parentIndex, 0); + for (unsigned i = 0; i < allEntries.size(); i++) { + if (allEntries[i].matchConstraints(constr)) { + entries.push_back (allEntries[i]); + } + } + + ParamSet messageProducts (entries.size()); + for (unsigned k = 0; k < entries.size(); k++) { + if (DL >= 5) { + calcs1 = new stringstream; + calcs2 = new stringstream; + } + double messageProduct = 1.0; + const DomainConf& conf = entries[k].getParentConfigurations(); + for (unsigned i = 0; i < yParents.size(); i++) { + if (yParents[i] != x) { + if (DL >= 5) { + if (messageProduct != 1.0) *calcs1 << "*" ; + if (messageProduct != 1.0) *calcs2 << "*" ; + *calcs1 << PI << "(" << yParents[i]->getLabel(); + *calcs1 << "-->" << y->getLabel() << ")" ; + *calcs1 << "[" << yParents[i]->getDomain()[conf[i]] << "]" ; + *calcs2 << M(yParents[i])->getPiMessageValue(y, conf[i]); + } + messageProduct *= M(yParents[i])->getPiMessageValue(y, conf[i]); + } + } + messageProducts[k] = messageProduct; + if (DL >= 5) { + cout << " mp" << k; + cout << " = " << (*calcs1).str(); + if (yParents.size() == 1) { + cout << 1 << endl; + } else if (yParents.size() == 2) { + cout << " = " << messageProduct << endl; + } else { + cout << " = " << (*calcs2).str(); + cout << " = " << messageProduct << endl; + } + delete calcs1; + delete calcs2; + } + } + + for (int xi = 0; xi < x->getDomainSize(); xi++) { + if (DL >= 5) { + calcs1 = new stringstream; + calcs2 = new stringstream; + } + vector entries; + DomainConstr constr = make_pair (parentIndex, xi); + for (unsigned i = 0; i < allEntries.size(); i++) { + if (allEntries[i].matchConstraints(constr)) { + entries.push_back (allEntries[i]); + } + } + double outerSum = 0.0; + for (int yi = 0; yi < y->getDomainSize(); yi++) { + if (DL >= 5) { + (yi != 0) ? *calcs1 << " + {" : *calcs1 << "{" ; + (yi != 0) ? *calcs2 << " + {" : *calcs2 << "{" ; + } + double innerSum = 0.0; + for (unsigned k = 0; k < entries.size(); k++) { + if (DL >= 5) { + if (k != 0) *calcs1 << " + " ; + if (k != 0) *calcs2 << " + " ; + *calcs1 << y->cptEntryToString (yi, entries[k]); + *calcs1 << ".mp" << k; + *calcs2 << y->getProbability (yi, entries[k]); + *calcs2 << "*" << messageProducts[k]; + } + innerSum += y->getProbability (yi, entries[k]) * messageProducts[k]; + } + outerSum += innerSum * M(y)->getLambdaValue (yi); + if (DL >= 5) { + *calcs1 << "}." << LD << "(" << y->getLabel() << ")" ; + *calcs1 << "[" << y->getDomain()[yi] << "]"; + *calcs2 << "}*" << M(y)->getLambdaValue (yi); + } + } + yxLambdaNextMessage[xi] = outerSum; + if (DL >= 5) { + cout << " " << LD << "(" << y->getLabel(); + cout << "-->" << x->getLabel() << ")" ; + cout << "[" << x->getDomain()[xi] << "]" ; + cout << " = " << (*calcs1).str(); + cout << " = " << (*calcs2).str(); + cout << " = " << outerSum << endl; + delete calcs1; + delete calcs2; + } + } +} + + + +void +BPSolver::printMessageStatusOf (const BayesNode* var) const +{ + cout << left; + cout << setw (10) << "domain" ; + cout << setw (20) << PI << "(" + var->getLabel() + ")" ; + cout << setw (20) << LD << "(" + var->getLabel() + ")" ; + cout << setw (16) << "belief" ; + cout << endl; + cout << "--------------------------------" ; + cout << "--------------------------------" ; + cout << endl; + + BpNode* x = M(var); + ParamSet& piVals = x->getPiValues(); + ParamSet& ldVals = x->getLambdaValues(); + ParamSet beliefs = x->getBeliefs(); + const Domain& domain = var->getDomain(); + const NodeSet& childs = var->getChilds(); + + for (int xi = 0; xi < var->getDomainSize(); xi++) { + cout << setw (10) << domain[xi]; + cout << setw (19) << piVals[xi]; + cout << setw (19) << ldVals[xi]; + cout.precision (PRECISION); + cout << setw (16) << beliefs[xi]; + cout << endl; + } + cout << endl; + if (childs.size() > 0) { + string s = "(" + var->getLabel() + ")" ; + for (unsigned j = 0; j < childs.size(); j++) { + cout << setw (10) << "domain" ; + cout << setw (28) << PI + childs[j]->getLabel() + s; + cout << setw (28) << LD + childs[j]->getLabel() + s; + cout << endl; + cout << "--------------------------------" ; + cout << "--------------------------------" ; + cout << endl; + const ParamSet& piMessage = x->getPiMessage (childs[j]); + const ParamSet& lambdaMessage = x->getLambdaMessage (childs[j]); + for (int xi = 0; xi < var->getDomainSize(); xi++) { + cout << setw (10) << domain[xi]; + cout.precision (PRECISION); + cout << setw (27) << piMessage[xi]; + cout.precision (PRECISION); + cout << setw (27) << lambdaMessage[xi]; + cout << endl; + } + cout << endl; + } + } +} + + + +void +BPSolver::printAllMessageStatus (void) const +{ + const NodeSet& nodes = bn_->getNodes(); + for (unsigned i = 0; i < nodes.size(); i++) { + printMessageStatusOf (nodes[i]); + } +} + + diff --git a/packages/CLPBN/clpbn/bp/BPSolver.h b/packages/CLPBN/clpbn/bp/BPSolver.h new file mode 100755 index 000000000..b752b92d2 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/BPSolver.h @@ -0,0 +1,450 @@ +#ifndef BP_BPSOLVER_H +#define BP_BPSOLVER_H + +#include +#include +#include + +#include "Solver.h" +#include "BayesNet.h" +#include "BpNode.h" +#include "Shared.h" + +using namespace std; + +class BPSolver; + +static const string PI = "pi" ; +static const string LD = "ld" ; + +enum MessageType {PI_MSG, LAMBDA_MSG}; + +class BPSolver; +struct Edge +{ + Edge (BayesNode* s, BayesNode* d, MessageType t) + { + source = s; + destination = d; + type = t; + } + string getId (void) const + { + stringstream ss; + type == PI_MSG ? ss << PI : ss << LD; + ss << source->getVarId() << "." << destination->getVarId(); + return ss.str(); + } + string toString (void) const + { + stringstream ss; + type == PI_MSG ? ss << PI << "(" : ss << LD << "(" ; + ss << source->getLabel() << " --> " ; + ss << destination->getLabel(); + ss << ")" ; + return ss.str(); + } + BayesNode* source; + BayesNode* destination; + MessageType type; + static BPSolver* klass; +}; + + + +/* +class BPMessage +{ + BPMessage (BayesNode* parent, BayesNode* child) + { + parent_ = parent; + child_ = child; + currPiMsg_.resize (child->getDomainSize(), 1); + currLdMsg_.resize (parent->getDomainSize(), 1); + nextLdMsg_.resize (parent->getDomainSize(), 1); + nextPiMsg_.resize (child->getDomainSize(), 1); + piResidual_ = 1.0; + ldResidual_ = 1.0; + } + + Param getPiMessageValue (int idx) const + { + assert (idx >=0 && idx < child->getDomainSize()); + return currPiMsg_[idx]; + } + + Param getLambdaMessageValue (int idx) const + { + assert (idx >=0 && idx < parent->getDomainSize()); + return currLdMsg_[idx]; + } + + const ParamSet& getPiMessage (void) const + { + return currPiMsg_; + } + + const ParamSet& getLambdaMessage (void) const + { + return currLdMsg_; + } + + ParamSet& piNextMessageReference (void) + { + return nextPiMsg_; + } + + ParamSet& lambdaNextMessageReference (const BayesNode* source) + { + return nextLdMsg_; + } + + void updatePiMessage (void) + { + currPiMsg_ = nextPiMsg_; + Util::normalize (currPiMsg_); + } + + void updateLambdaMessage (void) + { + currLdMsg_ = nextLdMsg_; + Util::normalize (currLdMsg_); + } + + double getPiResidual (void) + { + return piResidual_; + } + + double getLambdaResidual (void) + { + return ldResidual_; + } + + void updatePiResidual (void) + { + piResidual_ = Util::getL1dist (currPiMsg_, nextPiMsg_); + } + + void updateLambdaResidual (void) + { + ldResidual_ = Util::getL1dist (currLdMsg_, nextLdMsg_); + } + + void clearPiResidual (void) + { + piResidual_ = 0.0; + } + + void clearLambdaResidual (void) + { + ldResidual_ = 0.0; + } + + BayesNode* parent_; + BayesNode* child_; + ParamSet currPiMsg_; // current pi messages + ParamSet currLdMsg_; // current lambda messages + ParamSet nextPiMsg_; + ParamSet nextLdMsg_; + Param piResidual_; + Param ldResidual_; +}; + + + +class NodeInfo +{ + NodeInfo (BayesNode* node) + { + node_ = node; + piVals_.resize (node->getDomainSize(), 1); + ldVals_.resize (node->getDomainSize(), 1); + } + + ParamSet getBeliefs (void) const + { + double sum = 0.0; + ParamSet beliefs (node_->getDomainSize()); + for (int xi = 0; xi < node_->getDomainSize(); xi++) { + double prod = piVals_[xi] * ldVals_[xi]; + beliefs[xi] = prod; + sum += prod; + } + assert (sum); + //normalize the beliefs + for (int xi = 0; xi < node_->getDomainSize(); xi++) { + beliefs[xi] /= sum; + } + return beliefs; + } + + double getPiValue (int idx) const + { + assert (idx >=0 && idx < node_->getDomainSize()); + return piVals_[idx]; + } + + void setPiValue (int idx, double value) + { + assert (idx >=0 && idx < node_->getDomainSize()); + piVals_[idx] = value; + } + + double getLambdaValue (int idx) const + { + assert (idx >=0 && idx < node_->getDomainSize()); + return ldVals_[idx]; + } + + void setLambdaValue (int idx, double value) + { + assert (idx >=0 && idx < node_->getDomainSize()); + ldVals_[idx] = value; + } + + ParamSet& getPiValues (void) + { + return piVals_; + } + + ParamSet& getLambdaValues (void) + { + return ldVals_; + } + + double getBeliefChange (void) + { + double change = 0.0; + if (oldBeliefs_.size() == 0) { + oldBeliefs_ = getBeliefs(); + change = MAX_CHANGE_; + } else { + ParamSet currentBeliefs = getBeliefs(); + for (int xi = 0; xi < node_->getDomainSize(); xi++) { + change += abs (currentBeliefs[xi] - oldBeliefs_[xi]); + } + oldBeliefs_ = currentBeliefs; + } + return change; + } + + bool hasReceivedChildInfluence (void) const + { + // if all lambda values are equal, then neither + // this node neither its descendents have evidence, + // we can use this to don't send lambda messages his parents + bool childInfluenced = false; + for (int xi = 1; xi < node_->getDomainSize(); xi++) { + if (ldVals_[xi] != ldVals_[0]) { + childInfluenced = true; + break; + } + } + return childInfluenced; + } + + BayesNode* node_; + ParamSet piVals_; // pi values + ParamSet ldVals_; // lambda values + ParamSet oldBeliefs_; +}; +*/ + + +bool compareResidual (const Edge&, const Edge&); + +class BPSolver : public Solver +{ + public: + BPSolver (const BayesNet&); + ~BPSolver (void); + + void runSolver (void); + ParamSet getPosterioriOf (const Variable* var) const; + ParamSet getJointDistribution (const NodeSet&) const; + + private: + DISALLOW_COPY_AND_ASSIGN (BPSolver); + + void initializeSolver (void); + void incorporateEvidence (BayesNode*); + void runPolyTreeSolver (void); + void polyTreePiMessage (BayesNode*, BayesNode*); + void polyTreeLambdaMessage (BayesNode*, BayesNode*); + void runGenericSolver (void); + void maxResidualSchedule (void); + bool converged (void) const; + void updatePiValues (BayesNode*); + void updateLambdaValues (BayesNode*); + void calculateNextPiMessage (BayesNode*, BayesNode*); + void calculateNextLambdaMessage (BayesNode*, BayesNode*); + void printMessageStatusOf (const BayesNode*) const; + void printAllMessageStatus (void) const; + // inlines + void updatePiMessage (BayesNode*, BayesNode*); + void updateLambdaMessage (BayesNode*, BayesNode*); + void calculateNextMessage (const Edge&); + void updateMessage (const Edge&); + void updateValues (const Edge&); + double getResidual (const Edge&) const; + void updateResidual (const Edge&); + void clearResidual (const Edge&); + BpNode* M (const BayesNode*) const; + friend bool compareResidual (const Edge&, const Edge&); + + const BayesNet* bn_; + vector msgs_; + Schedule schedule_; + int nIter_; + int maxIter_; + double accuracy_; + vector updateOrder_; + bool forceGenericSolver_; + + struct compare + { + inline bool operator() (const Edge& e1, const Edge& e2) + { + return compareResidual (e1, e2); + } + }; + + typedef multiset SortedOrder; + SortedOrder sortedOrder_; + + typedef unordered_map EdgeMap; + EdgeMap edgeMap_; + +}; + + + +inline void +BPSolver::updatePiMessage (BayesNode* source, BayesNode* destination) +{ + M(source)->updatePiMessage(destination); +} + + + +inline void +BPSolver::updateLambdaMessage (BayesNode* source, BayesNode* destination) +{ + M(destination)->updateLambdaMessage(source); +} + + + +inline void +BPSolver::calculateNextMessage (const Edge& e) +{ + if (DL >= 1) { + cout << "calculating " << e.toString() << endl; + } + if (e.type == PI_MSG) { + calculateNextPiMessage (e.source, e.destination); + } else { + calculateNextLambdaMessage (e.source, e.destination); + } +} + + + +inline void +BPSolver::updateMessage (const Edge& e) +{ + if (DL >= 1) { + cout << "updating " << e.toString() << endl; + } + if (e.type == PI_MSG) { + M(e.source)->updatePiMessage(e.destination); + } else { + M(e.destination)->updateLambdaMessage(e.source); + } +} + + + +inline void +BPSolver::updateValues (const Edge& e) +{ + if (!e.destination->hasEvidence()) { + if (e.type == PI_MSG) { + updatePiValues (e.destination); + } else { + updateLambdaValues (e.destination); + } + } +} + + + +inline double +BPSolver::getResidual (const Edge& e) const +{ + if (e.type == PI_MSG) { + return M(e.source)->getPiResidual(e.destination); + } else { + return M(e.destination)->getLambdaResidual(e.source); + } +} + + + +inline void +BPSolver::updateResidual (const Edge& e) +{ + if (e.type == PI_MSG) { + M(e.source)->updatePiResidual(e.destination); + } else { + M(e.destination)->updateLambdaResidual(e.source); + } +} + + + +inline void +BPSolver::clearResidual (const Edge& e) +{ + if (e.type == PI_MSG) { + M(e.source)->clearPiResidual(e.destination); + } else { + M(e.destination)->clearLambdaResidual(e.source); + } +} + + + +inline bool +compareResidual (const Edge& e1, const Edge& e2) +{ + double residual1; + double residual2; + if (e1.type == PI_MSG) { + residual1 = Edge::klass->M(e1.source)->getPiResidual(e1.destination); + } else { + residual1 = Edge::klass->M(e1.destination)->getLambdaResidual(e1.source); + } + if (e2.type == PI_MSG) { + residual2 = Edge::klass->M(e2.source)->getPiResidual(e2.destination); + } else { + residual2 = Edge::klass->M(e2.destination)->getLambdaResidual(e2.source); + } + return residual1 > residual2; +} + + + +inline BpNode* +BPSolver::M (const BayesNode* node) const +{ + assert (node); + assert (node == bn_->getNode (node->getVarId())); + assert (node->getIndex() < msgs_.size()); + return msgs_[node->getIndex()]; +} + + +#endif + diff --git a/packages/CLPBN/clpbn/bp/BayesNet.cpp b/packages/CLPBN/clpbn/bp/BayesNet.cpp new file mode 100755 index 000000000..291c0c8d3 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/BayesNet.cpp @@ -0,0 +1,792 @@ +#include +#include +#include +#include +#include +#include +#include + +#include "xmlParser/xmlParser.h" + +#include "BayesNet.h" + + +BayesNet::BayesNet (void) +{ +} + + + +BayesNet::BayesNet (const char* fileName) +{ + map domains; + XMLNode xMainNode = XMLNode::openFileHelper (fileName, "BIF"); + // only the first network is parsed, others are ignored + XMLNode xNode = xMainNode.getChildNode ("NETWORK"); + int nVars = xNode.nChildNode ("VARIABLE"); + for (int i = 0; i < nVars; i++) { + XMLNode var = xNode.getChildNode ("VARIABLE", i); + string type = var.getAttribute ("TYPE"); + if (type != "nature") { + cerr << "error: only \"nature\" variables are supported" << endl; + abort(); + } + Domain domain; + string label = var.getChildNode("NAME").getText(); + int domainSize = var.nChildNode ("OUTCOME"); + for (int j = 0; j < domainSize; j++) { + if (var.getChildNode("OUTCOME", j).getText() == 0) { + stringstream ss; + ss << j + 1; + domain.push_back (ss.str()); + } else { + domain.push_back (var.getChildNode("OUTCOME", j).getText()); + } + } + domains.insert (make_pair (label, domain)); + } + + int nDefs = xNode.nChildNode ("DEFINITION"); + if (nVars != nDefs) { + cerr << "error: different number of variables and definitions"; + cerr << endl; + } + + queue indexes; + for (int i = 0; i < nDefs; i++) { + indexes.push (i); + } + + while (!indexes.empty()) { + int index = indexes.front(); + indexes.pop(); + XMLNode def = xNode.getChildNode ("DEFINITION", index); + string label = def.getChildNode("FOR").getText(); + map::const_iterator iter; + iter = domains.find (label); + if (iter == domains.end()) { + cerr << "error: unknow variable `" << label << "'" << endl; + abort(); + } + bool processItLatter = false; + NodeSet parents; + int nParams = iter->second.size(); + for (int j = 0; j < def.nChildNode ("GIVEN"); j++) { + string parentLabel = def.getChildNode("GIVEN", j).getText(); + BayesNode* parentNode = getNode (parentLabel); + if (parentNode) { + nParams *= parentNode->getDomainSize(); + parents.push_back (parentNode); + } + else { + iter = domains.find (parentLabel); + if (iter == domains.end()) { + cerr << "error: unknow parent `" << parentLabel << "'" << endl; + abort(); + } else { + // this definition contains a parent that doesn't + // have a corresponding bayesian node instance yet, + // so process this definition latter + indexes.push (index); + processItLatter = true; + break; + } + } + } + + if (!processItLatter) { + int count = 0; + ParamSet params (nParams); + stringstream s (def.getChildNode("TABLE").getText()); + while (!s.eof() && count < nParams) { + s >> params[count]; + count ++; + } + if (count != nParams) { + cerr << "error: invalid number of parameters " ; + cerr << "for variable `" << label << "'" << endl; + abort(); + } + params = reorderParameters (params, iter->second.size()); + addNode (label, iter->second, parents, params); + } + } + setIndexes(); +} + + + +BayesNet::~BayesNet (void) +{ + Statistics::writeStats(); + for (unsigned i = 0; i < nodes_.size(); i++) { + delete nodes_[i]; + } +} + + + +BayesNode* +BayesNet::addNode (unsigned varId) +{ + indexMap_.insert (make_pair (varId, nodes_.size())); + nodes_.push_back (new BayesNode (varId)); + return nodes_.back(); +} + + + +BayesNode* +BayesNet::addNode (unsigned varId, + unsigned dsize, + int evidence, + NodeSet& parents, + Distribution* dist) +{ + indexMap_.insert (make_pair (varId, nodes_.size())); + nodes_.push_back (new BayesNode ( + varId, dsize, evidence, parents, dist)); + return nodes_.back(); +} + + + +BayesNode* +BayesNet::addNode (string label, + Domain domain, + NodeSet& parents, + ParamSet& params) +{ + indexMap_.insert (make_pair (nodes_.size(), nodes_.size())); + Distribution* dist = new Distribution (params); + BayesNode* node = new BayesNode ( + nodes_.size(), label, domain, parents, dist); + dists_.push_back (dist); + nodes_.push_back (node); + return node; +} + + + +BayesNode* +BayesNet::getNode (unsigned varId) const +{ + IndexMap::const_iterator it = indexMap_.find(varId); + if (it == indexMap_.end()) { + return 0; + } else { + return nodes_[it->second]; + } +} + + + +BayesNode* +BayesNet::getNode (string label) const +{ + BayesNode* node = 0; + for (unsigned i = 0; i < nodes_.size(); i++) { + if (nodes_[i]->getLabel() == label) { + node = nodes_[i]; + break; + } + } + return node; +} + + + +void +BayesNet::addDistribution (Distribution* dist) +{ + dists_.push_back (dist); +} + + + +Distribution* +BayesNet::getDistribution (unsigned distId) const +{ + Distribution* dist = 0; + for (unsigned i = 0; i < dists_.size(); i++) { + if (dists_[i]->id == distId) { + dist = dists_[i]; + break; + } + } + return dist; +} + + + +const NodeSet& +BayesNet::getNodes (void) const +{ + return nodes_; +} + + + +int +BayesNet::getNumberOfNodes (void) const +{ + return nodes_.size(); +} + + + +NodeSet +BayesNet::getRootNodes (void) const +{ + NodeSet roots; + for (unsigned i = 0; i < nodes_.size(); i++) { + if (nodes_[i]->isRoot()) { + roots.push_back (nodes_[i]); + } + } + return roots; +} + + + +NodeSet +BayesNet::getLeafNodes (void) const +{ + NodeSet leafs; + for (unsigned i = 0; i < nodes_.size(); i++) { + if (nodes_[i]->isLeaf()) { + leafs.push_back (nodes_[i]); + } + } + return leafs; +} + + + +VarSet +BayesNet::getVariables (void) const +{ + VarSet vars; + for (unsigned i = 0; i < nodes_.size(); i++) { + vars.push_back (nodes_[i]); + } + return vars; +} + + + +BayesNet* +BayesNet::pruneNetwork (BayesNode* queryNode) const +{ + NodeSet queryNodes; + queryNodes.push_back (queryNode); + return pruneNetwork (queryNodes); +} + + + +BayesNet* +BayesNet::pruneNetwork (const NodeSet& interestedVars) const +{ + /* + cout << "interested vars: " ; + for (unsigned i = 0; i < interestedVars.size(); i++) { + cout << interestedVars[i]->getLabel() << " " ; + } + cout << endl; + */ + vector states (nodes_.size(), 0); + + Scheduling scheduling; + for (NodeSet::const_iterator it = interestedVars.begin(); + it != interestedVars.end(); it++) { + scheduling.push (ScheduleInfo (*it, false, true)); + } + + while (!scheduling.empty()) { + ScheduleInfo& sch = scheduling.front(); + StateInfo* state = states[sch.node->getIndex()]; + if (!state) { + state = new StateInfo(); + states[sch.node->getIndex()] = state; + } else { + state->visited = true; + } + if (!sch.node->hasEvidence() && sch.visitedFromChild) { + if (!state->markedOnTop) { + state->markedOnTop = true; + scheduleParents (sch.node, scheduling); + } + if (!state->markedOnBottom) { + state->markedOnBottom = true; + scheduleChilds (sch.node, scheduling); + } + } + if (sch.visitedFromParent) { + if (sch.node->hasEvidence() && !state->markedOnTop) { + state->markedOnTop = true; + scheduleParents (sch.node, scheduling); + } + if (!sch.node->hasEvidence() && !state->markedOnBottom) { + state->markedOnBottom = true; + scheduleChilds (sch.node, scheduling); + } + } + scheduling.pop(); + } + /* + cout << "\t\ttop\tbottom" << endl; + cout << "variable\t\tmarked\tmarked\tvisited\tobserved" << endl; + cout << "----------------------------------------------------------" ; + cout << endl; + for (unsigned i = 0; i < states.size(); i++) { + cout << nodes_[i]->getLabel() << ":\t\t" ; + if (states[i]) { + states[i]->markedOnTop ? cout << "yes\t" : cout << "no\t" ; + states[i]->markedOnBottom ? cout << "yes\t" : cout << "no\t" ; + states[i]->visited ? cout << "yes\t" : cout << "no\t" ; + nodes_[i]->hasEvidence() ? cout << "yes" : cout << "no" ; + cout << endl; + } else { + cout << "no\tno\tno\t" ; + nodes_[i]->hasEvidence() ? cout << "yes" : cout << "no" ; + cout << endl; + } + } + cout << endl; + */ + BayesNet* bn = new BayesNet(); + constructGraph (bn, states); + + for (unsigned i = 0; i < nodes_.size(); i++) { + delete states[i]; + } + return bn; +} + + + +void +BayesNet::constructGraph (BayesNet* bn, + const vector& states) const +{ + for (unsigned i = 0; i < nodes_.size(); i++) { + bool isRequired = false; + if (states[i]) { + isRequired = (nodes_[i]->hasEvidence() && states[i]->visited) + || + states[i]->markedOnTop; + } + if (isRequired) { + NodeSet parents; + if (states[i]->markedOnTop) { + const NodeSet& ps = nodes_[i]->getParents(); + for (unsigned j = 0; j < ps.size(); j++) { + BayesNode* parent = bn->getNode (ps[j]->getVarId()); + if (!parent) { + parent = bn->addNode (ps[j]->getVarId()); + } + parents.push_back (parent); + } + } + BayesNode* node = bn->getNode (nodes_[i]->getVarId()); + if (node) { + node->setData (nodes_[i]->getDomainSize(), + nodes_[i]->getEvidence(), parents, + nodes_[i]->getDistribution()); + } else { + node = bn->addNode (nodes_[i]->getVarId(), + nodes_[i]->getDomainSize(), + nodes_[i]->getEvidence(), parents, + nodes_[i]->getDistribution()); + } + if (nodes_[i]->hasDomain()) { + node->setDomain (nodes_[i]->getDomain()); + } + if (nodes_[i]->hasLabel()) { + node->setLabel (nodes_[i]->getLabel()); + } + } + } + bn->setIndexes(); +} + +/* +void +BayesNet::constructGraph (BayesNet* bn, + const vector& states) const +{ + for (unsigned i = 0; i < nodes_.size(); i++) { + if (states[i]) { + if (nodes_[i]->hasEvidence() && states[i]->visited) { + NodeSet parents; + if (states[i]->markedOnTop) { + const NodeSet& ps = nodes_[i]->getParents(); + for (unsigned j = 0; j < ps.size(); j++) { + BayesNode* parent = bn->getNode (ps[j]->getVarId()); + if (parent == 0) { + parent = bn->addNode (ps[j]->getVarId()); + } + parents.push_back (parent); + } + } + + BayesNode* n = bn->getNode (nodes_[i]->getVarId()); + if (n) { + n->setData (nodes_[i]->getDomainSize(), + nodes_[i]->getEvidence(), parents, + nodes_[i]->getDistribution()); + } else { + bn->addNode (nodes_[i]->getVarId(), + nodes_[i]->getDomainSize(), + nodes_[i]->getEvidence(), parents, + nodes_[i]->getDistribution()); + } + + } else if (states[i]->markedOnTop) { + NodeSet parents; + const NodeSet& ps = nodes_[i]->getParents(); + for (unsigned j = 0; j < ps.size(); j++) { + BayesNode* parent = bn->getNode (ps[j]->getVarId()); + if (parent == 0) { + parent = bn->addNode (ps[j]->getVarId()); + } + parents.push_back (parent); + } + + BayesNode* n = bn->getNode (nodes_[i]->getVarId()); + if (n) { + n->setData (nodes_[i]->getDomainSize(), + nodes_[i]->getEvidence(), parents, + nodes_[i]->getDistribution()); + } else { + bn->addNode (nodes_[i]->getVarId(), + nodes_[i]->getDomainSize(), + nodes_[i]->getEvidence(), parents, + nodes_[i]->getDistribution()); + } + } + } + } +}*/ + + + +bool +BayesNet::isSingleConnected (void) const +{ + return !containsUndirectedCycle(); +} + + + +vector +BayesNet::getDomainConfigurationsOf (const NodeSet& nodes) +{ + int nConfs = 1; + for (unsigned i = 0; i < nodes.size(); i++) { + nConfs *= nodes[i]->getDomainSize(); + } + + vector confs (nConfs); + for (int i = 0; i < nConfs; i++) { + confs[i].resize (nodes.size()); + } + + int nReps = 1; + for (int i = nodes.size() - 1; i >= 0; i--) { + int index = 0; + while (index < nConfs) { + for (int j = 0; j < nodes[i]->getDomainSize(); j++) { + for (int r = 0; r < nReps; r++) { + confs[index][i] = j; + index++; + } + } + } + nReps *= nodes[i]->getDomainSize(); + } + + return confs; +} + + + +vector +BayesNet::getInstantiations (const NodeSet& parents_) +{ + int nParents = parents_.size(); + int rowSize = 1; + for (unsigned i = 0; i < parents_.size(); i++) { + rowSize *= parents_[i]->getDomainSize(); + } + int nReps = 1; + vector headers (rowSize); + for (int i = nParents - 1; i >= 0; i--) { + Domain domain = parents_[i]->getDomain(); + int index = 0; + while (index < rowSize) { + for (int j = 0; j < parents_[i]->getDomainSize(); j++) { + for (int r = 0; r < nReps; r++) { + if (headers[index] != "") { + headers[index] = domain[j] + "," + headers[index]; + } else { + headers[index] = domain[j]; + } + index++; + } + } + } + nReps *= parents_[i]->getDomainSize(); + } + return headers; +} + + + +void +BayesNet::setIndexes (void) +{ + for (unsigned i = 0; i < nodes_.size(); i++) { + nodes_[i]->setIndex (i); + } +} + + + +void +BayesNet::freeDistributions (void) +{ + for (unsigned i = 0; i < dists_.size(); i++) { + delete dists_[i]; + } +} + + + +void +BayesNet::printNetwork (void) const +{ + for (unsigned i = 0; i < nodes_.size(); i++) { + cout << *nodes_[i]; + } +} + + + +void +BayesNet::printNetworkToFile (const char* fileName) const +{ + string s = "../../" ; + s += fileName; + ofstream out (s.c_str()); + if (!out.is_open()) { + cerr << "error: cannot open file to write at " ; + cerr << "BayesNet::printToFile()" << endl; + abort(); + } + for (unsigned i = 0; i < nodes_.size(); i++) { + out << *nodes_[i]; + } + out.close(); +} + + + +void +BayesNet::exportToDotFile (const char* fileName, + bool showNeighborless, + const NodeSet& highlightNodes) const +{ + string s = "../../" ; + s+= fileName; + ofstream out (s.c_str()); + if (!out.is_open()) { + cerr << "error: cannot open file to write at " ; + cerr << "BayesNet::exportToDotFile()" << endl; + abort(); + } + + out << "digraph \"" << fileName << "\" {" << endl; + for (unsigned i = 0; i < nodes_.size(); i++) { + const NodeSet& childs = nodes_[i]->getChilds(); + for (unsigned j = 0; j < childs.size(); j++) { + out << '"' << nodes_[i]->getLabel() << '"' << " -> " ; + out << '"' << childs[j]->getLabel() << '"' << endl; + } + } + + for (unsigned i = 0; i < nodes_.size(); i++) { + if (showNeighborless || nodes_[i]->hasNeighbors()) { + out << '"' << nodes_[i]->getLabel() << '"' ; + if (nodes_[i]->hasEvidence()) { + out << " [style=filled, fillcolor=yellow]" << endl; + } else { + out << endl; + } + } + } + + for (unsigned i = 0; i < highlightNodes.size(); i++) { + out << '"' << highlightNodes[i]->getLabel() << '"' ; + out << " [shape=box]" << endl; + } + + out << "}" << endl; + out.close(); +} + + + +void +BayesNet::exportToBifFile (const char* fileName) const +{ + string s = "../../" ; + s += fileName; + ofstream out (s.c_str()); + if(!out.is_open()) { + cerr << "error: cannot open file to write at " ; + cerr << "BayesNet::exportToBifFile()" << endl; + abort(); + } + out << "" << endl; + out << "" << endl; + out << "" << endl; + out << "" << fileName << "" << endl << endl; + for (unsigned i = 0; i < nodes_.size(); i++) { + out << "" << endl; + out << "\t" << nodes_[i]->getLabel() << "" << endl; + const Domain& domain = nodes_[i]->getDomain(); + for (unsigned j = 0; j < domain.size(); j++) { + out << "\t" << domain[j] << "" << endl; + } + out << "" << endl << endl; + } + + for (unsigned i = 0; i < nodes_.size(); i++) { + out << "" << endl; + out << "\t" << nodes_[i]->getLabel() << "" << endl; + const NodeSet& parents = nodes_[i]->getParents(); + for (unsigned j = 0; j < parents.size(); j++) { + out << "\t" << parents[j]->getLabel(); + out << "" << endl; + } + ParamSet params = revertParameterReorder (nodes_[i]->getParameters(), + nodes_[i]->getDomainSize()); + out << "\t" ; + for (unsigned j = 0; j < params.size(); j++) { + out << " " << params[j]; + } + out << "
" << endl; + out << "
" << endl << endl; + } + out << "
" << endl; + out << "
" << endl << endl; + out.close(); +} + + + +bool +BayesNet::containsUndirectedCycle (void) const +{ + vector visited (nodes_.size(), false); + for (unsigned i = 0; i < nodes_.size(); i++) { + int v = nodes_[i]->getIndex(); + if (!visited[v]) { + if (containsUndirectedCycle (v, -1, visited)) { + return true; + } + } + } + return false; +} + + + +bool +BayesNet::containsUndirectedCycle (int v, + int p, + vector& visited) const +{ + visited[v] = true; + vector adjacencies = getAdjacentNodes (v); + for (unsigned i = 0; i < adjacencies.size(); i++) { + int w = adjacencies[i]; + if (!visited[w]) { + if (containsUndirectedCycle (w, v, visited)) { + return true; + } + } + else if (visited[w] && w != p) { + return true; + } + } + return false; // no cycle detected in this component +} + + + +vector +BayesNet::getAdjacentNodes (int v) const +{ + vector adjacencies; + const NodeSet& parents = nodes_[v]->getParents(); + const NodeSet& childs = nodes_[v]->getChilds(); + for (unsigned i = 0; i < parents.size(); i++) { + adjacencies.push_back (parents[i]->getIndex()); + } + for (unsigned i = 0; i < childs.size(); i++) { + adjacencies.push_back (childs[i]->getIndex()); + } + return adjacencies; +} + + + +ParamSet +BayesNet::reorderParameters (const ParamSet& params, + int domainSize) const +{ + // the interchange format for bayesian networks keeps the probabilities + // in the following order: + // p(a1|b1,c1) p(a2|b1,c1) p(a1|b1,c2) p(a2|b1,c2) p(a1|b2,c1) p(a2|b2,c1) + // p(a1|b2,c2) p(a2|b2,c2). + // + // however, in clpbn we keep the probabilities in this order: + // p(a1|b1,c1) p(a1|b1,c2) p(a1|b2,c1) p(a1|b2,c2) p(a2|b1,c1) p(a2|b1,c2) + // p(a2|b2,c1) p(a2|b2,c2). + unsigned count = 0; + unsigned rowSize = params.size() / domainSize; + ParamSet reordered; + while (reordered.size() < params.size()) { + unsigned idx = count; + for (unsigned i = 0; i < rowSize; i++) { + reordered.push_back (params[idx]); + idx += domainSize; + } + count++; + } + return reordered; +} + + + +ParamSet +BayesNet::revertParameterReorder (const ParamSet& params, + int domainSize) const +{ + unsigned count = 0; + unsigned rowSize = params.size() / domainSize; + ParamSet reordered; + while (reordered.size() < params.size()) { + unsigned idx = count; + for (int i = 0; i < domainSize; i++) { + reordered.push_back (params[idx]); + idx += rowSize; + } + count ++; + } + return reordered; +} + diff --git a/packages/CLPBN/clpbn/bp/BayesNet.h b/packages/CLPBN/clpbn/bp/BayesNet.h new file mode 100755 index 000000000..547671f31 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/BayesNet.h @@ -0,0 +1,129 @@ +#ifndef BP_BAYES_NET_H +#define BP_BAYES_NET_H + +#include +#include +#include +#include +#include +#include + +#include "GraphicalModel.h" +#include "BayesNode.h" +#include "Shared.h" + + +using namespace std; + +class Distribution; + +struct ScheduleInfo +{ + ScheduleInfo (BayesNode* n, bool vfp, bool vfc) + { + node = n; + visitedFromParent = vfp; + visitedFromChild = vfc; + } + BayesNode* node; + bool visitedFromParent; + bool visitedFromChild; +}; + + +struct StateInfo +{ + StateInfo (void) + { + visited = true; + markedOnTop = false; + markedOnBottom = false; + } + bool visited; + bool markedOnTop; + bool markedOnBottom; +}; + +typedef vector DistSet; +typedef queue > Scheduling; +typedef unordered_map Histogram; +typedef unordered_map Times; + + +class BayesNet : public GraphicalModel +{ + public: + BayesNet (void); + BayesNet (const char*); + ~BayesNet (void); + + BayesNode* addNode (unsigned); + BayesNode* addNode (unsigned, unsigned, int, NodeSet&, Distribution*); + BayesNode* addNode (string, Domain, NodeSet&, ParamSet&); + BayesNode* getNode (unsigned) const; + BayesNode* getNode (string) const; + void addDistribution (Distribution*); + Distribution* getDistribution (unsigned) const; + const NodeSet& getNodes (void) const; + int getNumberOfNodes (void) const; + NodeSet getRootNodes (void) const; + NodeSet getLeafNodes (void) const; + VarSet getVariables (void) const; + BayesNet* pruneNetwork (BayesNode*) const; + BayesNet* pruneNetwork (const NodeSet& queryNodes) const; + void constructGraph (BayesNet*, const vector&) const; + bool isSingleConnected (void) const; + static vector getDomainConfigurationsOf (const NodeSet&); + static vector getInstantiations (const NodeSet& nodes); + void setIndexes (void); + void freeDistributions (void); + void printNetwork (void) const; + void printNetworkToFile (const char*) const; + void exportToDotFile (const char*, bool = true, + const NodeSet& = NodeSet()) const; + void exportToBifFile (const char*) const; + + static Histogram histogram_; + static Times times_; + + private: + DISALLOW_COPY_AND_ASSIGN (BayesNet); + + bool containsUndirectedCycle (void) const; + bool containsUndirectedCycle (int, int, + vector&)const; + vector getAdjacentNodes (int) const ; + ParamSet reorderParameters (const ParamSet&, int) const; + ParamSet revertParameterReorder (const ParamSet&, int) const; + void scheduleParents (const BayesNode*, Scheduling&) const; + void scheduleChilds (const BayesNode*, Scheduling&) const; + + NodeSet nodes_; + DistSet dists_; + IndexMap indexMap_; +}; + + + +inline void +BayesNet::scheduleParents (const BayesNode* n, Scheduling& sch) const +{ + const NodeSet& ps = n->getParents(); + for (NodeSet::const_iterator it = ps.begin(); it != ps.end(); it++) { + sch.push (ScheduleInfo (*it, false, true)); + } +} + + + +inline void +BayesNet::scheduleChilds (const BayesNode* n, Scheduling& sch) const +{ + const NodeSet& cs = n->getChilds(); + for (NodeSet::const_iterator it = cs.begin(); it != cs.end(); it++) { + sch.push (ScheduleInfo (*it, true, false)); + } +} + +#endif + diff --git a/packages/CLPBN/clpbn/bp/BayesNode.cpp b/packages/CLPBN/clpbn/bp/BayesNode.cpp new file mode 100755 index 000000000..72ed5febd --- /dev/null +++ b/packages/CLPBN/clpbn/bp/BayesNode.cpp @@ -0,0 +1,355 @@ +#include +#include +#include +#include +#include + +#include "BayesNode.h" + + +BayesNode::BayesNode (unsigned varId) : Variable (varId) +{ +} + + + +BayesNode::BayesNode (unsigned varId, + unsigned dsize, + int evidence, + const NodeSet& parents, + Distribution* dist) : Variable(varId, dsize, evidence) +{ + parents_ = parents; + dist_ = dist; + for (unsigned int i = 0; i < parents.size(); i++) { + parents[i]->addChild (this); + } +} + + + +BayesNode::BayesNode (unsigned varId, + string label, + const Domain& domain, + const NodeSet& parents, + Distribution* dist) : Variable(varId, domain) +{ + label_ = new string (label); + parents_ = parents; + dist_ = dist; + for (unsigned int i = 0; i < parents.size(); i++) { + parents[i]->addChild (this); + } +} + + + +void +BayesNode::setData (unsigned dsize, + int evidence, + const NodeSet& parents, + Distribution* dist) +{ + setDomainSize (dsize); + evidence_ = evidence; + parents_ = parents; + dist_ = dist; + for (unsigned int i = 0; i < parents.size(); i++) { + parents[i]->addChild (this); + } +} + + + +void +BayesNode::addChild (BayesNode* node) +{ + childs_.push_back (node); +} + + + +Distribution* +BayesNode::getDistribution (void) +{ + return dist_; +} + + + +const ParamSet& +BayesNode::getParameters (void) +{ + return dist_->params; +} + + + +ParamSet +BayesNode::getRow (int rowIndex) const +{ + int rowSize = getRowSize(); + int offset = rowSize * rowIndex; + ParamSet row (rowSize); + for (int i = 0; i < rowSize; i++) { + row[i] = dist_->params[offset + i] ; + } + return row; +} + + + +bool +BayesNode::isRoot (void) +{ + return getParents().empty(); +} + + + +bool +BayesNode::isLeaf (void) +{ + return getChilds().empty(); +} + + + +bool +BayesNode::hasNeighbors (void) const +{ + return childs_.size() != 0 || parents_.size() != 0; +} + + +int +BayesNode::getCptSize (void) +{ + return dist_->params.size(); +} + + + +const vector& +BayesNode::getCptEntries (void) +{ + if (dist_->entries.size() == 0) { + unsigned rowSize = getRowSize(); + unsigned nParents = parents_.size(); + vector confs (rowSize); + + for (unsigned i = 0; i < rowSize; i++) { + confs[i].resize (nParents); + } + + int nReps = 1; + for (int i = nParents - 1; i >= 0; i--) { + unsigned index = 0; + while (index < rowSize) { + for (int j = 0; j < parents_[i]->getDomainSize(); j++) { + for (int r = 0; r < nReps; r++) { + confs[index][i] = j; + index++; + } + } + } + nReps *= parents_[i]->getDomainSize(); + } + + dist_->entries.reserve (rowSize); + for (unsigned i = 0; i < rowSize; i++) { + dist_->entries.push_back (CptEntry (i, confs[i])); + } + } + return dist_->entries; +} + + + +int +BayesNode::getIndexOfParent (const BayesNode* parent) const +{ + for (unsigned int i = 0; i < parents_.size(); i++) { + if (parents_[i] == parent) { + return i; + } + } + return -1; +} + + + +string +BayesNode::cptEntryToString (const CptEntry& entry) const +{ + stringstream ss; + ss << "p(" ; + const DomainConf& conf = entry.getParentConfigurations(); + int row = entry.getParameterIndex() / getRowSize(); + ss << getDomain()[row]; + if (parents_.size() > 0) { + ss << "|" ; + for (unsigned int i = 0; i < conf.size(); i++) { + if (i != 0) { + ss << ","; + } + ss << parents_[i]->getDomain()[conf[i]]; + } + } + ss << ")" ; + return ss.str(); +} + + + +string +BayesNode::cptEntryToString (int row, const CptEntry& entry) const +{ + stringstream ss; + ss << "p(" ; + const DomainConf& conf = entry.getParentConfigurations(); + ss << getDomain()[row]; + if (parents_.size() > 0) { + ss << "|" ; + for (unsigned int i = 0; i < conf.size(); i++) { + if (i != 0) { + ss << ","; + } + ss << parents_[i]->getDomain()[conf[i]]; + } + } + ss << ")" ; + return ss.str(); +} + + + +vector +BayesNode::getDomainHeaders (void) const +{ + int nParents = parents_.size(); + int rowSize = getRowSize(); + int nReps = 1; + vector headers (rowSize); + for (int i = nParents - 1; i >= 0; i--) { + Domain domain = parents_[i]->getDomain(); + int index = 0; + while (index < rowSize) { + for (int j = 0; j < parents_[i]->getDomainSize(); j++) { + for (int r = 0; r < nReps; r++) { + if (headers[index] != "") { + headers[index] = domain[j] + "," + headers[index]; + } else { + headers[index] = domain[j]; + } + index++; + } + } + } + nReps *= parents_[i]->getDomainSize(); + } + return headers; +} + + + +ostream& +operator << (ostream& o, const BayesNode& node) +{ + o << "variable " << node.getIndex() << endl; + o << "Var Id: " << node.getVarId() << endl; + o << "Label: " << node.getLabel() << endl; + + o << "Evidence: " ; + if (node.hasEvidence()) { + o << node.getEvidence(); + } + else { + o << "no" ; + } + o << endl; + + o << "Parents: " ; + const NodeSet& parents = node.getParents(); + if (parents.size() != 0) { + for (unsigned int i = 0; i < parents.size() - 1; i++) { + o << parents[i]->getLabel() << ", " ; + } + o << parents[parents.size() - 1]->getLabel(); + } + o << endl; + + o << "Childs: " ; + const NodeSet& childs = node.getChilds(); + if (childs.size() != 0) { + for (unsigned int i = 0; i < childs.size() - 1; i++) { + o << childs[i]->getLabel() << ", " ; + } + o << childs[childs.size() - 1]->getLabel(); + } + o << endl; + + o << "Domain: " ; + Domain domain = node.getDomain(); + for (unsigned int i = 0; i < domain.size() - 1; i++) { + o << domain[i] << ", " ; + } + if (domain.size() != 0) { + o << domain[domain.size() - 1]; + } + o << endl; + + // min width of first column + const unsigned int MIN_DOMAIN_WIDTH = 4; + // min width of following columns + const unsigned int MIN_COMBO_WIDTH = 12; + + unsigned int domainWidth = domain[0].length(); + for (unsigned int i = 1; i < domain.size(); i++) { + if (domain[i].length() > domainWidth) { + domainWidth = domain[i].length(); + } + } + domainWidth = (domainWidth < MIN_DOMAIN_WIDTH) + ? MIN_DOMAIN_WIDTH + : domainWidth; + + o << left << setw (domainWidth) << "cpt" << right; + + vector widths; + int lineWidth = domainWidth; + vector headers = node.getDomainHeaders(); + + if (!headers.empty()) { + for (unsigned int i = 0; i < headers.size(); i++) { + unsigned int len = headers[i].length(); + int w = (len < MIN_COMBO_WIDTH) ? MIN_COMBO_WIDTH : len; + widths.push_back (w); + o << setw (w) << headers[i]; + lineWidth += w; + } + o << endl; + } else { + cout << endl; + widths.push_back (domainWidth); + lineWidth += MIN_COMBO_WIDTH; + } + + for (int i = 0; i < lineWidth; i++) { + o << "-" ; + } + o << endl; + + for (unsigned int i = 0; i < domain.size(); i++) { + ParamSet row = node.getRow (i); + o << left << setw (domainWidth) << domain[i] << right; + for (unsigned j = 0; j < node.getRowSize(); j++) { + o << setw (widths[j]) << row[j]; + } + o << endl; + } + o << endl; + + return o; +} + diff --git a/packages/CLPBN/clpbn/bp/BayesNode.h b/packages/CLPBN/clpbn/bp/BayesNode.h new file mode 100755 index 000000000..923cca0f1 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/BayesNode.h @@ -0,0 +1,91 @@ +#ifndef BP_BAYESNODE_H +#define BP_BAYESNODE_H + +#include +#include +#include + +#include "Variable.h" +#include "CptEntry.h" +#include "Distribution.h" +#include "Shared.h" + +using namespace std; + + +class BayesNode : public Variable +{ + public: + BayesNode (unsigned); + BayesNode (unsigned, unsigned, int, const NodeSet&, Distribution*); + BayesNode (unsigned, string, const Domain&, const NodeSet&, Distribution*); + + void setData (unsigned, int, const NodeSet&, Distribution*); + void addChild (BayesNode*); + Distribution* getDistribution (void); + const ParamSet& getParameters (void); + ParamSet getRow (int) const; + void setProbability (int, const CptEntry&, double); + bool isRoot (void); + bool isLeaf (void); + bool hasNeighbors (void) const; + int getCptSize (void); + const vector& getCptEntries (void); + int getIndexOfParent (const BayesNode*) const; + string cptEntryToString (const CptEntry&) const; + string cptEntryToString (int, const CptEntry&) const; + // inlines + const NodeSet& getParents (void) const; + const NodeSet& getChilds (void) const; + double getProbability (int, const CptEntry& entry); + unsigned getRowSize (void) const; + + private: + DISALLOW_COPY_AND_ASSIGN (BayesNode); + + Domain getDomainHeaders (void) const; + friend ostream& operator << (ostream&, const BayesNode&); + + NodeSet parents_; + NodeSet childs_; + Distribution* dist_; +}; + +ostream& operator << (ostream&, const BayesNode&); + + + +inline const NodeSet& +BayesNode::getParents (void) const +{ + return parents_; +} + + + +inline const NodeSet& +BayesNode::getChilds (void) const +{ + return childs_; +} + + + +inline double +BayesNode::getProbability (int row, const CptEntry& entry) +{ + int col = entry.getParameterIndex(); + int idx = (row * getRowSize()) + col; + return dist_->params[idx]; +} + + + +inline unsigned +BayesNode::getRowSize (void) const +{ + return dist_->params.size() / getDomainSize(); +} + +#endif + diff --git a/packages/CLPBN/clpbn/bp/BayesianNetwork.cpp b/packages/CLPBN/clpbn/bp/BayesianNetwork.cpp deleted file mode 100644 index 1dd17af03..000000000 --- a/packages/CLPBN/clpbn/bp/BayesianNetwork.cpp +++ /dev/null @@ -1,208 +0,0 @@ -#include -#include -#include -#include - -#include "BayesianNetwork.h" -#include "BayesianNode.h" - -BayesianNetwork::BayesianNetwork (void) -{ -} - - - -BayesianNetwork::~BayesianNetwork (void) -{ - for (unsigned int i = 0; i < nodes_.size(); i++) { - delete nodes_[i]; - } - for (unsigned int i = 0; i < dists_.size(); i++) { - delete dists_[i]; - } -} - - - -void -BayesianNetwork::addNode (string varName, - vector parents, - int evidence, - int distId) -{ - for (unsigned int i = 0; i < dists_.size(); i++) { - if (dists_[i]->id == distId) { - BayesianNode* node = new BayesianNode (varName, parents, - dists_[i], evidence); - nodes_.push_back (node); - break; - } - } -} - - -void -BayesianNetwork::addNode (string varName, - vector parents, - double* params, - int nParams, - vector domain) -{ - Distribution* dist = new Distribution (params, nParams, domain); - BayesianNode* node = new BayesianNode (varName, parents, dist); - dists_.push_back (dist); - nodes_.push_back (node); -} - - - -BayesianNode* -BayesianNetwork::getNode (string varName) const -{ - for (unsigned int i = 0; i < nodes_.size(); i++) { - if (nodes_[i]->getVariableName() == varName) { - return nodes_[i]; - } - } - return 0; -} - - - -void -BayesianNetwork::addDistribution (int distId, - double* params, - int nParams, - vector domain) -{ - dists_.push_back (new Distribution (distId, params, nParams, domain)); -} - - - -vector -BayesianNetwork::getNodes (void) const -{ - return nodes_; -} - - - -vector -BayesianNetwork::getRootNodes (void) const -{ - vector roots; - for (unsigned int i = 0; i < nodes_.size(); i++) { - if (nodes_[i]->isRoot()) { - roots.push_back (nodes_[i]); - } - } - return roots; -} - - - -vector -BayesianNetwork::getLeafNodes (void) const -{ - vector leafs; - for (unsigned int i = 0; i < nodes_.size(); i++) { - if (nodes_[i]->isLeaf()) { - leafs.push_back (nodes_[i]); - } - } - return leafs; -} - - - -bool -BayesianNetwork::isPolyTree (void) const -{ - return !containsCycle(); -} - - - -void -BayesianNetwork::printNetwork (void) const -{ - for (unsigned int i = 0; i < nodes_.size(); i++) { - cout << *nodes_[i]; - } -} - - - -bool -BayesianNetwork::containsCycle (void) const -{ - vector visited (nodes_.size()); - for (unsigned int v = 0; v < nodes_.size(); v++) { - visited[v] = false; - } - - for (unsigned int v = 0; v < nodes_.size(); v++) { - if (!visited[v]) { - if (containsCycle (v, -1, visited)) { - return true; - } - } - } - - return false; -} - - - -bool -BayesianNetwork::containsCycle (int v, - int predecessor, - vector& visited) const -{ - visited[v] = true; - vector adjs = getAdjacentVertexes (v); - for (unsigned int i = 0; i < adjs.size(); i++) { - int w = adjs[i]; - if (!visited[w]) { - if (containsCycle (w, v, visited)) { - return true; - } - } - else if (visited[w] && w != predecessor) { - return true; - } - } - return false; // no cycle detected in this component -} - - - -int -BayesianNetwork::getIndexOf (const BayesianNode* node) const -{ - for (unsigned int i = 0; i < nodes_.size(); i++) { - if (node == nodes_[i]) { - return i; - } - } - return -1; -} - - - -vector -BayesianNetwork::getAdjacentVertexes (int v) const -{ - vector adjs; - vector parents = nodes_[v]->getParents(); - vector childs = nodes_[v]->getChilds(); - for (unsigned int i = 0; i < parents.size(); i++) { - adjs.push_back (getIndexOf (parents[i])); - } - for (unsigned int i = 0; i < childs.size(); i++) { - adjs.push_back (getIndexOf (childs[i])); - } - return adjs; -} - diff --git a/packages/CLPBN/clpbn/bp/BayesianNetwork.h b/packages/CLPBN/clpbn/bp/BayesianNetwork.h deleted file mode 100644 index 5003faaed..000000000 --- a/packages/CLPBN/clpbn/bp/BayesianNetwork.h +++ /dev/null @@ -1,46 +0,0 @@ -#ifndef BAYESIAN_NETWORK_H -#define BAYESIAN_NETWORK_H - -#include -#include - -using namespace std; - -class BayesianNode; -class Distribution; - -class BayesianNetwork -{ - public: - // constructs - BayesianNetwork (void); - // destruct - virtual ~BayesianNetwork (void); - // methods - virtual void addNode (string, vector, int, int); - virtual void addNode (string, vector, - double*, int, vector); - BayesianNode* getNode (string) const; - void addDistribution (int, double*, int, vector); - vector getNodes (void) const; - vector getRootNodes (void) const; - vector getLeafNodes (void) const; - bool isPolyTree (void) const; - void printNetwork (void) const; - - protected: - // members - vector nodes_; - vector dists_; - - private: - BayesianNetwork (const BayesianNetwork&); // disallow copy - void operator= (const BayesianNetwork&); // disallow assign - bool containsCycle (void) const; - bool containsCycle (int, int, vector&) const; - int getIndexOf (const BayesianNode*) const; - vector getAdjacentVertexes (int) const ; -}; - -#endif // BAYESIAN_NETWORK_H - diff --git a/packages/CLPBN/clpbn/bp/BayesianNode.cpp b/packages/CLPBN/clpbn/bp/BayesianNode.cpp deleted file mode 100644 index 26a3106e5..000000000 --- a/packages/CLPBN/clpbn/bp/BayesianNode.cpp +++ /dev/null @@ -1,382 +0,0 @@ -#include -#include -#include - -#include "BayesianNode.h" -#include "CptEntry.h" - - -BayesianNode::BayesianNode (string varName, - vector parents, - Distribution* dist, - int evidence) -{ - varName_ = varName; - parents_ = parents; - dist_ = dist; - evidence_ = evidence; - for (unsigned int i = 0; i < parents.size(); i++) { - parents[i]->addChild (this); - } -} - - - -BayesianNode::~BayesianNode (void) -{ -} - - - -string -BayesianNode::getVariableName (void) const -{ - return varName_; -} - - - -vector -BayesianNode::getParents (void) const -{ - return parents_; -} - - - -vector -BayesianNode::getChilds (void) const -{ - return childs_; -} - - - -void -BayesianNode::addChild (BayesianNode* node) -{ - childs_.push_back (node); -} - - - -double* -BayesianNode::getParameters (void) -{ - return dist_->params; -} - - - -double* -BayesianNode::getRow (int rowIndex) const -{ - int offset = getRowSize() * rowIndex; - return &dist_->params[offset]; -} - - - -double -BayesianNode::getProbability (CptEntry& entry) -{ - int index = entry.getCptIndex(); - return dist_->params[index]; -} - - - -void -BayesianNode::setProbability (CptEntry& entry, double prob) -{ - int index = entry.getCptIndex(); - dist_->params[index] = prob; -} - - - -bool -BayesianNode::isRoot (void) -{ - return parents_.empty(); -} - - - -bool -BayesianNode::isLeaf (void) -{ - return childs_.empty(); -} - - - -int -BayesianNode::getRowSize (void) const -{ - return dist_->nParams / dist_->domain.size(); -} - - - -int -BayesianNode::getCptSize (void) -{ - return dist_->nParams; -} - - - -vector -BayesianNode::getDomain (void) const -{ - return dist_->domain; -} - - - -int -BayesianNode::getDomainSize (void) const -{ - return dist_->domain.size(); -} - - - -vector -BayesianNode::getCptEntries (const vector >& constraints) -{ - vector matchedEntries; - if (constraints.size() > 0 && constraints[0].first == 0) { - vector entries = getCptEntriesOfRow (constraints[0].second); - for (unsigned int i = 0; i < entries.size(); i++) { - if (entries[i].matchConstraints (constraints)) { - matchedEntries.push_back (entries[i]); - } - } - } - else { - for (unsigned int i = 0; i < dist_->domain.size(); i++) { - vector entries = getCptEntriesOfRow (i); - for (unsigned int j = 0; j < entries.size(); j++) { - if (entries[j].matchConstraints (constraints)) { - matchedEntries.push_back (entries[j]); - } - } - } - } - return matchedEntries; -} - - - -vector -BayesianNode::getCptEntriesOfRow (int rowIndex) -{ - int rowSize = getRowSize(); - int nParents = parents_.size(); - vector > insts (rowSize); - - for (int i = 0; i < rowSize; i++) { - insts[i].resize (nParents + 1); - insts[i][0] = rowIndex; - } - - int reps = 1; - for (int i = nParents - 1; i >= 0; i--) { - int index = 0; - while (index < rowSize) { - for (int j = 0; j < parents_[i]->getDomainSize(); j++) { - for (int k = 0; k < reps; k++) { - insts[index][i + 1] = j; - index++; - } - } - } - reps *= parents_[i]->getDomainSize(); - } - - vector entries; - for (int i = 0; i < rowSize; i++ ) { - entries.push_back (CptEntry ((rowIndex * rowSize) + i, insts[i])); - } - - return entries; -} - - - -int -BayesianNode::getIndexOfParent (const BayesianNode* myParent) const -{ - for (unsigned int i = 0; i < parents_.size(); i++) { - if (myParent == parents_[i]) { - return i; - } - } - return -1; -} - - - -bool -BayesianNode::hasEvidence (void) -{ - return evidence_ != -1; -} - - - -int -BayesianNode::getEvidence (void) -{ - return evidence_; -} - - - -void -BayesianNode::setEvidence (int evidence) -{ - evidence_ = evidence; -} - - - -string -BayesianNode::entryToString (const CptEntry& entry) const -{ - string s = "p(" ; - vector insts = entry.getDomainInstantiations(); - s += getDomain()[insts[0]]; - if (parents_.size() > 0) { - s += "|" ; - for (unsigned int i = 1; i < insts.size() - 1; i++) { - s += parents_[i - 1]->getDomain()[insts[i]] + ","; - } - BayesianNode* lastParent = parents_[parents_.size() - 1]; - int lastIndex = insts[insts.size() - 1]; - s += lastParent->getDomain()[lastIndex]; - } - s += ")" ; - return s; -} - - - -vector -BayesianNode::getDomainHeaders (void) const -{ - int rowSize = getRowSize(); - int nParents = parents_.size(); - int reps = 1; - vector headers (rowSize); - for (int i = nParents - 1; i >= 0; i--) { - vector domain = parents_[i]->getDomain(); - int index = 0; - while (index < rowSize) { - for (int j = 0; j < parents_[i]->getDomainSize(); j++) { - for (int k = 0; k < reps; k++) { - if (headers[index] != "") { - headers[index] = domain[j] + "," + headers[index]; - } else { - headers[index] = domain[j]; - } - index++; - } - } - } - reps *= parents_[i]->getDomainSize(); - } - return headers; -} - - - -ostream& -operator << (ostream& o, const BayesianNode& node) -{ - o << "Variable: " << node.getVariableName() << endl; - - o << "Domain: " ; - vector domain = node.dist_->domain; - for (unsigned int i = 0; i < domain.size() - 1; i++) { - o << domain[i] << ", " ; - } - if (domain.size() != 0) { - o << domain[domain.size() - 1]; - } - o << endl; - - o << "Parents: " ; - vector parents = node.getParents(); - if (parents.size() != 0) { - for (unsigned int i = 0; i < parents.size() - 1; i++) { - o << parents[i]->getVariableName() << ", " ; - } - o << parents[parents.size() - 1]->getVariableName(); - } - o << endl; - - o << "Childs: " ; - vector childs = node.getChilds(); - if (childs.size() != 0) { - for (unsigned int i = 0; i < childs.size() - 1; i++) { - o << childs[i]->getVariableName() << ", " ; - } - o << childs[childs.size() - 1]->getVariableName(); - } - o << endl; - - const unsigned int MIN_DOMAIN_WIDTH = 4; // min width of first column - const unsigned int MIN_COMBO_WIDTH = 12; // min width of following columns - - unsigned int domainWidth = domain[0].length(); - for (unsigned int i = 1; i < domain.size(); i++) { - if (domain[i].length() > domainWidth) { - domainWidth = domain[i].length(); - } - } - - domainWidth = (domainWidth < MIN_DOMAIN_WIDTH) - ? MIN_DOMAIN_WIDTH - : domainWidth; - - o << left << setw (domainWidth) << "cpt" << right; - - vector widths; - int lineWidth = domainWidth; - vector headers = node.getDomainHeaders(); - if (!headers.empty()) { - for (unsigned int i = 0; i < headers.size(); i++) { - unsigned int len = headers[i].length(); - int w = (len < MIN_COMBO_WIDTH) ? MIN_COMBO_WIDTH : len; - widths.push_back (w); - o << setw (w) << headers[i]; - lineWidth += w; - } - o << endl; - } else { - cout << endl; - widths.push_back (domainWidth); - lineWidth += MIN_COMBO_WIDTH; - } - - for (int i = 0; i < lineWidth; i++) { - o << "-" ; - } - o << endl; - - for (unsigned int i = 0; i < domain.size(); i++) { - double* row = node.getRow (i); - o << left << setw (domainWidth) << domain[i] << right; - for (int j = 0; j < node.getRowSize(); j++) { - o << setw (widths[j]) << row[j]; - } - o << endl; - } - o << endl; - - return o; -} - diff --git a/packages/CLPBN/clpbn/bp/BayesianNode.h b/packages/CLPBN/clpbn/bp/BayesianNode.h deleted file mode 100644 index 63b1dc301..000000000 --- a/packages/CLPBN/clpbn/bp/BayesianNode.h +++ /dev/null @@ -1,59 +0,0 @@ -#ifndef BAYESIAN_NODE_H -#define BAYESIAN_NODE_H - -#include -#include - -#include "Distribution.h" -#include "CptEntry.h" - -using namespace std; - -class BayesianNode -{ - public: - // constructs - BayesianNode (string, vector, Distribution*, int = -1); - // destruct - ~BayesianNode (void); - // methods - string getVariableName (void) const; - vector getParents (void) const; - vector getChilds (void) const; - void addChild (BayesianNode*); - double* getParameters (void); - double* getRow (int) const; - double getProbability (CptEntry&); - void setProbability (CptEntry&, double); - bool isRoot (void); - bool isLeaf (void); - int getRowSize (void) const; - int getCptSize (void); - vector getDomain (void) const; - int getDomainSize (void) const; - vector getCptEntries (const vector >&); - vector getCptEntriesOfRow (int); - int getIndexOfParent (const BayesianNode*) const; - bool hasEvidence (void); - int getEvidence (void); - void setEvidence (int); - string entryToString (const CptEntry& entry) const; - - private: - BayesianNode (const BayesianNode&); // disallow copy - void operator= (const BayesianNode&); // disallow assign - // methods - vector getDomainHeaders (void) const; - friend ostream& operator << (ostream&, const BayesianNode&); - // members - string varName_; // variable name - vector parents_; // parents of this node - vector childs_; // children of this node - Distribution* dist_; - int evidence_; -}; - -ostream& operator << (ostream&, const BayesianNode&); - -#endif // BAYESIAN_NODE_H - diff --git a/packages/CLPBN/clpbn/bp/BifInterface.cpp b/packages/CLPBN/clpbn/bp/BifInterface.cpp deleted file mode 100644 index ba38030af..000000000 --- a/packages/CLPBN/clpbn/bp/BifInterface.cpp +++ /dev/null @@ -1,117 +0,0 @@ -#include -#include -#include - -#include "xmlParser/xmlParser.h" - -#include "BifInterface.h" -#include "BayesianNetwork.h" -#include "BayesianNode.h" - - -void -BifInterface::createNetworkFromXML (BayesianNetwork* bn, const char* fileName) -{ - map > domains; - XMLNode xMainNode = XMLNode::openFileHelper (fileName, "BIF"); - // only the first network is parsed, others are ignored - XMLNode xNode = xMainNode.getChildNode ("NETWORK"); - int nVars = xNode.nChildNode ("VARIABLE"); - for (int i = 0; i < nVars; i++) { - XMLNode var = xNode.getChildNode ("VARIABLE", i); - string type = var.getAttribute ("TYPE"); - if (type != "nature") { - cerr << "error: only \"nature\" variables are supported" << endl; - abort(); - } - vector domain; - string varName = var.getChildNode("NAME").getText(); - int domainSize = var.nChildNode ("OUTCOME"); - for (int j = 0; j < domainSize; j++) { - domain.push_back (var.getChildNode("OUTCOME", j).getText()); - } - domains.insert (make_pair (varName, domain)); - } - - int nDefs = xNode.nChildNode ("DEFINITION"); - if (nVars != nDefs) { - cerr << "error: different number of variables and definitions"; - cerr << endl; - } - - for (int i = 0; i < nDefs; i++) { - XMLNode def = xNode.getChildNode ("DEFINITION", i); - string nodeName = def.getChildNode("FOR").getText(); - map >::const_iterator iter = domains.find (nodeName); - if (iter == domains.end()) { - cerr << "error: unknow variable `" << nodeName << "'" << endl; - abort(); - } - vector parents; - int nParams = iter->second.size(); - for (int j = 0; j < def.nChildNode ("GIVEN"); j++) { - string parentName = def.getChildNode("GIVEN", j).getText(); - BayesianNode* parentNode = bn->getNode (parentName); - if (parentNode) { - nParams *= parentNode->getDomainSize(); - parents.push_back (parentNode); - } - else { - cerr << "error: unknow variable `" << parentName << "'" << endl; - abort(); - } - } - - int c = 0; - double* params = new double [nParams]; - stringstream s (def.getChildNode("TABLE").getText()); - while (!s.eof() && c < nParams) { - s >> params[c]; - c++; - } - if (c != nParams) { - cerr << "error: invalid number of parameters " ; - cerr << "for variable `" << nodeName << "'" << endl; - abort(); - } - - params = reorderParameters (params, nParams, iter->second.size()); - bn->addNode (nodeName, parents, params, nParams, iter->second); - } -} - - -double* -BifInterface::reorderParameters (double* params, - int nParams, - int domainSize) -{ - // the interchange format for bayesian networks saves the probabilities - // in the following order: - // p(a1|b1,c1) p(a2|b1,c1) p(a1|b1,c2) p(a2|b1,c2) p(a1|b2,c1) p(a2|b2,c1) - // p(a1|b2,c2) p(a2|b2,c2). - // - // however, in clpbn we keep the probabilities in this order: - // p(a1|b1,c1) p(a1|b1,c2) p(a1|b2,c1) p(a1|b2,c2) p(a2|b1,c1) p(a2|b1,c2) - // p(a2|b2,c1) p(a2|b2,c2). - - int count = 0; - int index1 = 0; - int index2 = 0; - int rowSize = nParams / domainSize; - double* reordered = new double [nParams]; - - while (index1 < nParams) { - index2 = count; - for (int i = 0; i < domainSize; i++) { - reordered[index2] = params[index1]; - index1 += 1; - index2 += rowSize; - } - count++; - } - - delete [] params; - return reordered; -} - diff --git a/packages/CLPBN/clpbn/bp/BifInterface.h b/packages/CLPBN/clpbn/bp/BifInterface.h deleted file mode 100644 index 84f3cceb0..000000000 --- a/packages/CLPBN/clpbn/bp/BifInterface.h +++ /dev/null @@ -1,20 +0,0 @@ -#ifndef BIF_INTERFACE_H -#define BIF_INTERFACE_H - -using namespace std; - -class BayesianNetwork; -class BayesianNode; - -class BifInterface -{ - public: - static void createNetworkFromXML (BayesianNetwork*, const char*); - - private: - static double* reorderParameters (double*, int, int); -}; - -#endif // BIF_INTERFACE_H - - diff --git a/packages/CLPBN/clpbn/bp/BifTest.cpp b/packages/CLPBN/clpbn/bp/BifTest.cpp deleted file mode 100644 index 13420e6aa..000000000 --- a/packages/CLPBN/clpbn/bp/BifTest.cpp +++ /dev/null @@ -1,36 +0,0 @@ -#include - -#include "BayesianNetwork.h" -#include "BayesianNode.h" -#include "BpNetwork.h" -#include "BpNode.h" -#include "BifInterface.h" - -using namespace std; - -int main (int argc, char* argv[]) -{ - BpNetwork bn; - // BayesianNetwork bn; - BifInterface::createNetworkFromXML (&bn, argv[1]); - bn.printNetwork(); - - // bn.getNode("FreightTruck")->setEvidence (0); - // bn.getNode("Alarm")->setEvidence (0); - - // bn.setSolverParameters (SEQUENTIAL_SCHEDULE, 500, 0.001); - // bn.setSolverParameters (PARALLEL_SCHEDULE, 500, 0.00000000000001); - // bn.setSolverParameters (PARALLEL_SCHEDULE, 500, 0.0000000000000000000001); - - //bn.getNode ("F")->setEvidence (0); - vector queryVars; - //queryVars.push_back (bn.getNode ("D")); - //queryVars.push_back (bn.getNode ("Burglar")); - queryVars.push_back (bn.getNode ("FreightTruck")); - queryVars.push_back (bn.getNode ("Alarm")); - bn.runSolver (queryVars); - - // bn.printCurrentStatus(); - // bn.printBeliefs(); - return 0; -} diff --git a/packages/CLPBN/clpbn/bp/BpNode.cpp b/packages/CLPBN/clpbn/bp/BpNode.cpp index 8f784ab16..4fd52f95c 100644 --- a/packages/CLPBN/clpbn/bp/BpNode.cpp +++ b/packages/CLPBN/clpbn/bp/BpNode.cpp @@ -4,226 +4,44 @@ #include "BpNode.h" +bool BpNode::calculateMessageResidual_ = true; -bool BpNode::parallelSchedule_ = false; -BpNode::BpNode (string varName, - vector parents, - Distribution* dist, - int evidence) : BayesianNode (varName, parents, dist, evidence) +BpNode::BpNode (BayesNode* node) { - -} - - - -BpNode::~BpNode (void) -{ - delete [] piValues_; - delete [] lambdaValues_; - delete [] oldBeliefs_; - map::iterator iter; - for (iter = lambdaMessages_.begin(); iter != lambdaMessages_.end(); ++iter) { - delete [] iter->second; + ds_ = node->getDomainSize(); + const NodeSet& childs = node->getChilds(); + piVals_.resize (ds_, 1); + ldVals_.resize (ds_, 1); + if (calculateMessageResidual_) { + piResiduals_.resize (childs.size(), 0.0); + ldResiduals_.resize (childs.size(), 0.0); } - for (iter = piMessages_.begin(); iter != piMessages_.end(); ++iter) { - delete [] iter->second; - } - // FIXME delete new messages -} - - - -void -BpNode::enableParallelSchedule (void) -{ - parallelSchedule_ = true; -} - - - -void -BpNode::allocateMemory (void) -{ - // FIXME do i need this !? - int domainSize = getDomainSize(); - piValues_ = new double [domainSize]; - lambdaValues_ = new double [domainSize]; - if (parallelSchedule_) { - newPiMessages_ = new map; - newLambdaMessages_ = new map; - } - oldBeliefs_ = 0; - vector childs = getChilds(); - for (unsigned int i = 0; i < childs.size(); i++) { - BpNode* child = static_cast (childs[i]); - piMessages_.insert (make_pair (child, new double [domainSize])); - lambdaMessages_.insert (make_pair (child, new double [domainSize])); - if (parallelSchedule_) { - newPiMessages_->insert (make_pair (child, new double [domainSize])); - newLambdaMessages_->insert (make_pair (child, new double [domainSize])); - } + childs_ = &childs; + for (unsigned i = 0; i < childs.size(); i++) { + //indexMap_.insert (make_pair (childs[i]->getVarId(), i)); + currPiMsgs_.push_back (ParamSet (ds_, 1)); + currLdMsgs_.push_back (ParamSet (ds_, 1)); + nextPiMsgs_.push_back (ParamSet (ds_, 1)); + nextLdMsgs_.push_back (ParamSet (ds_, 1)); } } -double* -BpNode::getPiValues (void) const +ParamSet +BpNode::getBeliefs (void) const { - return piValues_; -} - - - -double -BpNode::getPiValue (int index) const -{ - const int c = getDomainSize(); - assert (index >=0 && index < c); - return piValues_[index]; -} - - - -void -BpNode::setPiValue (int index, double value) -{ - const int c = getDomainSize(); - assert (index >=0 && index < c); - piValues_[index] = value; -} - - - -double* -BpNode::getLambdaValues (void) const -{ - return lambdaValues_; -} - - - -double -BpNode::getLambdaValue (int index) const -{ - const int c = getDomainSize(); - assert (index >=0 && index < c); - return lambdaValues_[index]; -} - - - -void -BpNode::setLambdaValue (int index, double value) -{ - const int c = getDomainSize(); - assert (index >=0 && index < c); - lambdaValues_[index] = value; -} - - - -double* -BpNode::getPiMessages (BpNode* node) const -{ - assert (node); - map::const_iterator iter = piMessages_.find (node); - assert (iter != piMessages_.end()); - return iter->second; -} - - - -double -BpNode::getPiMessage (BpNode* node, int index) const -{ - assert (node); - const int c = getDomainSize(); - assert (index >=0 && index < c); - map::const_iterator iter = piMessages_.find (node); - assert (iter != piMessages_.end()); - return iter->second[index]; -} - - - -void -BpNode::setPiMessage (BpNode* node, int index, double probability) -{ - assert (node); - const int c = getDomainSize(); - assert (index >=0 && index < c); - map::const_iterator iter; - if (parallelSchedule_) { - // cerr << "set_pi_message" << endl; - iter = newPiMessages_->find (node); - assert (iter != newPiMessages_->end()); - } else { - iter = piMessages_.find (node); - assert (iter != piMessages_.end()); - } - iter->second[index] = probability; -} - - - -double* -BpNode::getLambdaMessages (BpNode* node) const -{ - assert (node); - map::const_iterator iter = lambdaMessages_.find (node); - assert (iter != piMessages_.end()); - return iter->second; -} - - - -double -BpNode::getLambdaMessage (BpNode* node, int index) const -{ - assert (node); - const int c = getDomainSize(); - assert (index >=0 && index < c); - map::const_iterator iter = lambdaMessages_.find (node); - assert (iter != piMessages_.end()); - return iter->second[index]; -} - - - -void -BpNode::setLambdaMessage (BpNode* node, int index, double probability) -{ - assert (node); - const int c = getDomainSize(); - assert (index >=0 && index < c); - map::const_iterator iter; - if (parallelSchedule_) { - //cerr << "set_lambda_message" << endl; - iter = newLambdaMessages_->find (node); - assert (iter != newLambdaMessages_->end()); - } else { - iter = lambdaMessages_.find (node); - assert (iter != lambdaMessages_.end()); - } - iter->second[index] = probability; -} - - - -double* -BpNode::getBeliefs (void) -{ - double sum = 0.0; - double* beliefs = new double [getDomainSize()]; - for (int xi = 0; xi < getDomainSize(); xi++) { - double prod = piValues_[xi] * lambdaValues_[xi]; + double sum = 0.0; + ParamSet beliefs (ds_); + for (int xi = 0; xi < ds_; xi++) { + double prod = piVals_[xi] * ldVals_[xi]; beliefs[xi] = prod; sum += prod; } - // normalize the beliefs - for (int xi = 0; xi < getDomainSize(); xi++) { + assert (sum); + //normalize the beliefs + for (int xi = 0; xi < ds_; xi++) { beliefs[xi] /= sum; } return beliefs; @@ -231,91 +49,202 @@ BpNode::getBeliefs (void) +double +BpNode::getPiValue (int idx) const +{ + assert (idx >=0 && idx < ds_); + return piVals_[idx]; +} + + + +void +BpNode::setPiValue (int idx, double value) +{ + assert (idx >=0 && idx < ds_); + piVals_[idx] = value; +} + + + +double +BpNode::getLambdaValue (int idx) const +{ + assert (idx >=0 && idx < ds_); + return ldVals_[idx]; +} + + + +void +BpNode::setLambdaValue (int idx, double value) +{ + assert (idx >=0 && idx < ds_); + ldVals_[idx] = value; +} + + + +ParamSet& +BpNode::getPiValues (void) +{ + return piVals_; +} + + + +ParamSet& +BpNode::getLambdaValues (void) +{ + return ldVals_; +} + + + +double +BpNode::getPiMessageValue (const BayesNode* destination, int idx) const +{ + assert (idx >=0 && idx < ds_); + return currPiMsgs_[getIndex(destination)][idx]; +} + + + +double +BpNode::getLambdaMessageValue (const BayesNode* source, int idx) const +{ + assert (idx >=0 && idx < ds_); + return currLdMsgs_[getIndex(source)][idx]; +} + + + +const ParamSet& +BpNode::getPiMessage (const BayesNode* destination) const +{ + return currPiMsgs_[getIndex(destination)]; +} + + + +const ParamSet& +BpNode::getLambdaMessage (const BayesNode* source) const +{ + return currLdMsgs_[getIndex(source)]; +} + + + +ParamSet& +BpNode::piNextMessageReference (const BayesNode* destination) +{ + return nextPiMsgs_[getIndex(destination)]; +} + + + +ParamSet& +BpNode::lambdaNextMessageReference (const BayesNode* source) +{ + return nextLdMsgs_[getIndex(source)]; +} + + + +void +BpNode::updatePiMessage (const BayesNode* destination) +{ + int idx = getIndex (destination); + currPiMsgs_[idx] = nextPiMsgs_[idx]; + Util::normalize (currPiMsgs_[idx]); +} + + + +void +BpNode::updateLambdaMessage (const BayesNode* source) +{ + int idx = getIndex (source); + currLdMsgs_[idx] = nextLdMsgs_[idx]; + Util::normalize (currLdMsgs_[idx]); +} + + + double BpNode::getBeliefChange (void) { double change = 0.0; - if (!oldBeliefs_) { + if (oldBeliefs_.size() == 0) { oldBeliefs_ = getBeliefs(); - change = MAX_CHANGE_; + change = 9999999999.0; } else { - double* currentBeliefs = getBeliefs(); - for (int xi = 0; xi < getDomainSize(); xi++) { + ParamSet currentBeliefs = getBeliefs(); + for (int xi = 0; xi < ds_; xi++) { change += abs (currentBeliefs[xi] - oldBeliefs_[xi]); } oldBeliefs_ = currentBeliefs; } - //FIXME memory leak return change; } void -BpNode::normalizeMessages (void) +BpNode::updatePiResidual (const BayesNode* destination) { - map::iterator iter; - - iter = lambdaMessages_.begin(); - while (iter != lambdaMessages_.end()) { - double* v = iter->second; - double sum = 0.0; - for (int xi = 0; xi < getDomainSize(); xi++) { - sum += v[xi]; - } - for (int xi = 0; xi < getDomainSize(); xi++) { - v[xi] /= sum; - } - iter ++; - } - - iter = piMessages_.begin(); - while (iter != piMessages_.end()) { - double* v = iter->second; - double sum = 0.0; - for (int xi = 0; xi < getDomainSize(); xi++) { - sum += v[xi]; - } - for (int xi = 0; xi < getDomainSize(); xi++) { - v[xi] /= sum; - } - iter ++; - } + int idx = getIndex (destination); + Util::normalize (nextPiMsgs_[idx]); + //piResiduals_[idx] = Util::getL1dist ( + // currPiMsgs_[idx], nextPiMsgs_[idx]); + piResiduals_[idx] = Util::getMaxNorm ( + currPiMsgs_[idx], nextPiMsgs_[idx]); } void -BpNode::swapMessages (void) +BpNode::updateLambdaResidual (const BayesNode* source) { - //FIXME fast way to do this - map::iterator iter1; - map::iterator iter2; - - iter1 = lambdaMessages_.begin(); - iter2 = newLambdaMessages_->begin(); - while (iter1 != lambdaMessages_.end()) { - double* v1 = iter1->second; - double* v2 = iter2->second; - for (int xi = 0; xi < getDomainSize(); xi++) { - //v1[xi] = v2[xi]; - v1[xi] = (v1[xi] + v2[xi]) / 2; - } - iter1 ++; - iter2 ++; - } - - iter1 = piMessages_.begin(); - iter2 = newPiMessages_->begin(); - while (iter1 != piMessages_.end()) { - double* v1 = iter1->second; - double* v2 = iter2->second; - for (int xi = 0; xi < getDomainSize(); xi++) { - //v1[xi] = v2[xi]; - v1[xi] = (v1[xi] + v2[xi]) / 2; - } - iter1 ++; - iter2 ++; - } + int idx = getIndex (source); + Util::normalize (nextLdMsgs_[idx]); + //ldResiduals_[idx] = Util::getL1dist ( + // currLdMsgs_[idx], nextLdMsgs_[idx]); + ldResiduals_[idx] = Util::getMaxNorm ( + currLdMsgs_[idx], nextLdMsgs_[idx]); +} + + + +void +BpNode::clearPiResidual (const BayesNode* destination) +{ + piResiduals_[getIndex(destination)] = 0; +} + + + +void +BpNode::clearLambdaResidual (const BayesNode* source) +{ + ldResiduals_[getIndex(source)] = 0; +} + + + +bool +BpNode::hasReceivedChildInfluence (void) const +{ + // if all lambda values are equal, then neither + // this node neither its descendents have evidence, + // we can use this to don't send lambda messages his parents + bool childInfluenced = false; + for (int xi = 1; xi < ds_; xi++) { + if (ldVals_[xi] != ldVals_[0]) { + childInfluenced = true; + break; + } + } + return childInfluenced; } diff --git a/packages/CLPBN/clpbn/bp/BpNode.h b/packages/CLPBN/clpbn/bp/BpNode.h index 2d796365e..2b84a298d 100644 --- a/packages/CLPBN/clpbn/bp/BpNode.h +++ b/packages/CLPBN/clpbn/bp/BpNode.h @@ -1,56 +1,99 @@ -#ifndef BP_BP_NODE_H -#define BP_BP_NODE_H +#ifndef BP_BPNODE_H +#define BP_BPNODE_H #include #include -#include #include +#include -#include "BayesianNode.h" +#include "BayesNode.h" +#include "Shared.h" using namespace std; -class BpNode : public BayesianNode +class BpNode { public: - // constructs - BpNode (string, vector, Distribution* dist, int = -1); - // destruct - ~BpNode (void); - // methods - static void enableParallelSchedule (void); - void allocateMemory (void); - double* getPiValues (void) const; - double getPiValue (int) const; - void setPiValue (int, double); - double* getLambdaValues (void) const; - double getLambdaValue (int) const; - void setLambdaValue (int, double); - double* getPiMessages (BpNode*) const; - double getPiMessage (BpNode*, int) const; - void setPiMessage (BpNode*, int, double); - double* getLambdaMessages (BpNode*) const; - double getLambdaMessage (BpNode*, int) const; - void setLambdaMessage (BpNode*, int, double); - double* getBeliefs (void); - double getBeliefChange (void); - void normalizeMessages (void); - void swapMessages (void); + BpNode (int); + BpNode (BayesNode*); + + ParamSet getBeliefs (void) const; + double getPiValue (int) const; + void setPiValue (int, double); + double getLambdaValue (int) const; + void setLambdaValue (int, double); + ParamSet& getPiValues (void); + ParamSet& getLambdaValues (void); + double getPiMessageValue (const BayesNode*, int) const; + double getLambdaMessageValue (const BayesNode*, int) const; + const ParamSet& getPiMessage (const BayesNode*) const; + const ParamSet& getLambdaMessage (const BayesNode*) const; + ParamSet& piNextMessageReference (const BayesNode*); + ParamSet& lambdaNextMessageReference (const BayesNode*); + void updatePiMessage (const BayesNode*); + void updateLambdaMessage (const BayesNode*); + double getBeliefChange (void); + void updatePiResidual (const BayesNode*); + void updateLambdaResidual (const BayesNode*); + void clearPiResidual (const BayesNode*); + void clearLambdaResidual (const BayesNode*); + bool hasReceivedChildInfluence (void) const; + // inlines + double getPiResidual (const BayesNode*); + double getLambdaResidual (const BayesNode*); + int getIndex (const BayesNode*) const; private: - BpNode (const BpNode&); // disallow copy - void operator= (const BpNode&); // disallow assign - // members - double* lambdaValues_; - double* piValues_; - map piMessages_; - map lambdaMessages_; - map* newPiMessages_; - map* newLambdaMessages_; - double* oldBeliefs_; - static bool parallelSchedule_; - static const double MAX_CHANGE_ = 1.0; + DISALLOW_COPY_AND_ASSIGN (BpNode); + + IndexMap indexMap_; + ParamSet piVals_; // pi values + ParamSet ldVals_; // lambda values + vector currPiMsgs_; // current pi messages + vector currLdMsgs_; // current lambda messages + vector nextPiMsgs_; + vector nextLdMsgs_; + ParamSet oldBeliefs_; + ParamSet piResiduals_; + ParamSet ldResiduals_; + int ds_; + const NodeSet* childs_; + static bool calculateMessageResidual_; +// static const double MAX_CHANGE_ = 10000000.0; }; -#endif // BP_BP_NODE_H + + +inline double +BpNode::getPiResidual (const BayesNode* destination) +{ + return piResiduals_[getIndex(destination)]; +} + + +inline double +BpNode::getLambdaResidual (const BayesNode* source) +{ + return ldResiduals_[getIndex(source)]; +} + + + +inline int +BpNode::getIndex (const BayesNode* node) const +{ + assert (node); + //assert (indexMap_.find(node->getVarId()) != indexMap_.end()); + //return indexMap_.find(node->getVarId())->second; + for (unsigned i = 0; childs_->size(); i++) { + if ((*childs_)[i]->getVarId() == node->getVarId()) { + return i; + } + } + assert (false); + return -1; +} + + +#endif diff --git a/packages/CLPBN/clpbn/bp/CptEntry.h b/packages/CLPBN/clpbn/bp/CptEntry.h index 7289212d7..9229b2564 100644 --- a/packages/CLPBN/clpbn/bp/CptEntry.h +++ b/packages/CLPBN/clpbn/bp/CptEntry.h @@ -1,23 +1,71 @@ -#ifndef CPT_ENTRY_H -#define CPT_ENTRY_H +#ifndef BP_CPTENTRY_H +#define BP_CPTENTRY_H #include +#include "Shared.h" + using namespace std; class CptEntry { public: - // constructs - CptEntry (int, vector); - // methods - int getCptIndex (void) const; - vector getDomainInstantiations (void) const; - bool matchConstraints (const vector >&) const; + CptEntry (unsigned, const vector&); + + unsigned getParameterIndex (void) const; + const vector& getParentConfigurations (void) const; + bool matchConstraints (const DomainConstr&) const; + bool matchConstraints (const vector&) const; + private: - // members - int cptIndex_; - vector instantiations_; + unsigned index_; + vector confs_; }; -#endif // CPT_ENTRY_H + + +inline +CptEntry::CptEntry (unsigned index, const vector& confs) +{ + index_ = index; + confs_ = confs; +} + + + +inline unsigned +CptEntry::getParameterIndex (void) const +{ + return index_; +} + + + +inline const vector& +CptEntry::getParentConfigurations (void) const +{ + return confs_; +} + + + +inline bool +CptEntry::matchConstraints (const DomainConstr& constr) const +{ + return confs_[constr.first] == constr.second; +} + + + +inline bool +CptEntry::matchConstraints (const vector& constrs) const +{ + for (unsigned j = 0; j < constrs.size(); j++) { + if (confs_[constrs[j].first] != constrs[j].second) { + return false; + } + } + return true; +} + +#endif diff --git a/packages/CLPBN/clpbn/bp/Distribution.h b/packages/CLPBN/clpbn/bp/Distribution.h index 51a540b4c..63b562be4 100644 --- a/packages/CLPBN/clpbn/bp/Distribution.h +++ b/packages/CLPBN/clpbn/bp/Distribution.h @@ -1,24 +1,40 @@ -#ifndef DISTRIBUTION_H -#define DISTRIBUTION_H +#ifndef BP_DISTRIBUTION_H +#define BP_DISTRIBUTION_H #include #include +#include "Shared.h" + using namespace std; -class CptEntry; - -class Distribution +struct Distribution { public: - Distribution (int, double*, int, vector); - Distribution (double*, int, vector); - int id; - double* params; - int nParams; - vector domain; - int* offsets; + Distribution (unsigned id) + { + this->id = id; + this->params = params; + } + + Distribution (const ParamSet& params) + { + this->id = -1; + this->params = params; + } + + void updateParameters (const ParamSet& params) + { + this->params = params; + } + + unsigned id; + ParamSet params; + vector entries; + + private: + DISALLOW_COPY_AND_ASSIGN (Distribution); }; -#endif // DISTRIBUTION +#endif diff --git a/packages/CLPBN/clpbn/bp/Factor.cpp b/packages/CLPBN/clpbn/bp/Factor.cpp new file mode 100755 index 000000000..66d2296e0 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/Factor.cpp @@ -0,0 +1,346 @@ +#include +#include +#include +#include + +#include "Factor.h" +#include "FgVarNode.h" + + +int Factor::indexCount_ = 0; + +Factor::Factor (FgVarNode* var) { + vs_.push_back (var); + int nParams = var->getDomainSize(); + // create a uniform distribution + double val = 1.0 / nParams; + ps_ = ParamSet (nParams, val); + id_ = indexCount_; + indexCount_ ++; +} + + + +Factor::Factor (const FgVarSet& vars) { + vs_ = vars; + int nParams = 1; + for (unsigned i = 0; i < vs_.size(); i++) { + nParams *= vs_[i]->getDomainSize(); + } + // create a uniform distribution + double val = 1.0 / nParams; + ps_ = ParamSet (nParams, val); + id_ = indexCount_; + indexCount_ ++; +} + + + +Factor::Factor (FgVarNode* var, + const ParamSet& params) +{ + vs_.push_back (var); + ps_ = params; + id_ = indexCount_; + indexCount_ ++; +} + + + +Factor::Factor (const FgVarSet& vars, + const ParamSet& params) +{ + vs_ = vars; + ps_ = params; + id_ = indexCount_; + indexCount_ ++; +} + + + +const FgVarSet& +Factor::getFgVarNodes (void) const +{ + return vs_; +} + + + +FgVarSet& +Factor::getFgVarNodes (void) +{ + return vs_; +} + + + +const ParamSet& +Factor::getParameters (void) const +{ + return ps_; +} + + + +ParamSet& +Factor::getParameters (void) +{ + return ps_; +} + + + +void +Factor::setParameters (const ParamSet& params) +{ + //cout << "ps size: " << ps_.size() << endl; + //cout << "params size: " << params.size() << endl; + assert (ps_.size() == params.size()); + ps_ = params; +} + + + +Factor& +Factor::operator= (const Factor& g) +{ + FgVarSet vars = g.getFgVarNodes(); + ParamSet params = g.getParameters(); + return *this; +} + + + +Factor& +Factor::operator*= (const Factor& g) +{ + FgVarSet gVs = g.getFgVarNodes(); + const ParamSet& gPs = g.getParameters(); + + bool hasCommonVars = false; + vector varIndexes; + for (unsigned i = 0; i < gVs.size(); i++) { + int idx = getIndexOf (gVs[i]); + if (idx == -1) { + insertVariable (gVs[i]); + varIndexes.push_back (vs_.size() - 1); + } else { + hasCommonVars = true; + varIndexes.push_back (idx); + } + } + + if (hasCommonVars) { + vector offsets (gVs.size()); + offsets[gVs.size() - 1] = 1; + for (int i = gVs.size() - 2; i >= 0; i--) { + offsets[i] = offsets[i + 1] * gVs[i + 1]->getDomainSize(); + } + vector entries = getCptEntries(); + for (unsigned i = 0; i < entries.size(); i++) { + int idx = 0; + const DomainConf conf = entries[i].getParentConfigurations(); + for (unsigned j = 0; j < varIndexes.size(); j++) { + idx += offsets[j] * conf[varIndexes[j]]; + } + //cout << "ps_[" << i << "] = " << ps_[i] << " * " ; + //cout << gPs[idx] << " , idx = " << idx << endl; + ps_[i] = ps_[i] * gPs[idx]; + } + } else { + // if the originally factors doesn't have common factors. + // we don't have to make domain comparations + unsigned idx = 0; + for (unsigned i = 0; i < ps_.size(); i++) { + //cout << "ps_[" << i << "] = " << ps_[i] << " * " ; + //cout << gPs[idx] << " , idx = " << idx << endl; + ps_[i] = ps_[i] * gPs[idx]; + idx ++; + if (idx >= gPs.size()) { + idx = 0; + } + } + } + return *this; +} + + + +void +Factor::insertVariable (FgVarNode* var) +{ + int c = 0; + ParamSet newPs (ps_.size() * var->getDomainSize()); + for (unsigned i = 0; i < ps_.size(); i++) { + for (int j = 0; j < var->getDomainSize(); j++) { + newPs[c] = ps_[i]; + c ++; + } + } + vs_.push_back (var); + ps_ = newPs; +} + + + +void +Factor::marginalizeVariable (const FgVarNode* var) { + int varIndex = getIndexOf (var); + marginalizeVariable (varIndex); +} + + + +void +Factor::marginalizeVariable (unsigned varIndex) +{ + assert (varIndex >= 0 && varIndex < vs_.size()); + int distOffset = 1; + int leftVarOffset = 1; + for (unsigned i = vs_.size() - 1; i > varIndex; i--) { + distOffset *= vs_[i]->getDomainSize(); + leftVarOffset *= vs_[i]->getDomainSize(); + } + leftVarOffset *= vs_[varIndex]->getDomainSize(); + + int ds = vs_[varIndex]->getDomainSize(); + int count = 0; + int offset = 0; + int startIndex = 0; + int currDomainIdx = 0; + unsigned newPsSize = ps_.size() / ds; + ParamSet newPs; + newPs.reserve (newPsSize); + + stringstream ss; + ss << "marginalizing " << vs_[varIndex]->getLabel(); + ss << " from factor " << getLabel() << endl; + while (newPs.size() < newPsSize) { + ss << " sum = "; + double sum = 0.0; + for (int j = 0; j < ds; j++) { + if (j != 0) ss << " + "; + ss << ps_[offset]; + sum = sum + ps_[offset]; + offset = offset + distOffset; + } + newPs.push_back (sum); + count ++; + if (varIndex == vs_.size() - 1) { + offset = count * ds; + } else { + offset = offset - distOffset + 1; + if ((offset % leftVarOffset) == 0) { + currDomainIdx ++; + startIndex = leftVarOffset * currDomainIdx; + offset = startIndex; + count = 0; + } else { + offset = startIndex + count; + } + } + ss << " = " << sum << endl; + } + //cout << ss.str() << endl; + ps_ = newPs; + vs_.erase (vs_.begin() + varIndex); +} + + + +string +Factor::getLabel (void) const +{ + stringstream ss; + ss << "f(" ; + // ss << "Φ(" ; + for (unsigned i = 0; i < vs_.size(); i++) { + if (i != 0) ss << ", " ; + ss << "v" << vs_[i]->getVarId(); + } + ss << ")" ; + return ss.str(); +} + + + +string +Factor::toString (void) const +{ + stringstream ss; + ss << "vars: " ; + for (unsigned i = 0; i < vs_.size(); i++) { + if (i != 0) ss << ", " ; + ss << "v" << vs_[i]->getVarId(); + } + ss << endl; + vector entries = getCptEntries(); + for (unsigned i = 0; i < entries.size(); i++) { + ss << "Φ(" ; + char s = 'a' ; + const DomainConf& conf = entries[i].getParentConfigurations(); + for (unsigned j = 0; j < conf.size(); j++) { + if (j != 0) ss << "," ; + ss << s << conf[j] + 1; + s++; + } + ss << ") = " << ps_[entries[i].getParameterIndex()] << endl; + } + return ss.str(); +} + + + +vector +Factor::getCptEntries (void) const +{ + vector confs (ps_.size()); + for (unsigned i = 0; i < ps_.size(); i++) { + confs[i].resize (vs_.size()); + } + + int nReps = 1; + for (int i = vs_.size() - 1; i >= 0; i--) { + unsigned index = 0; + while (index < ps_.size()) { + for (int j = 0; j < vs_[i]->getDomainSize(); j++) { + for (int r = 0; r < nReps; r++) { + confs[index][i] = j; + index++; + } + } + } + nReps *= vs_[i]->getDomainSize(); + } + + vector entries; + for (unsigned i = 0; i < ps_.size(); i++) { + for (unsigned j = 0; j < vs_.size(); j++) { + } + entries.push_back (CptEntry (i, confs[i])); + } + return entries; +} + + + +int +Factor::getIndexOf (const FgVarNode* var) const +{ + for (unsigned i = 0; i < vs_.size(); i++) { + if (vs_[i] == var) { + return i; + } + } + return -1; +} + + + +Factor operator* (const Factor& f, const Factor& g) +{ + Factor r = f; + r *= g; + return r; +} + diff --git a/packages/CLPBN/clpbn/bp/Factor.h b/packages/CLPBN/clpbn/bp/Factor.h new file mode 100755 index 000000000..71b14df07 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/Factor.h @@ -0,0 +1,45 @@ +#ifndef BP_FACTOR_H +#define BP_FACTOR_H + +#include + +#include "CptEntry.h" + +using namespace std; + +class FgVarNode; + +class Factor +{ + public: + Factor (FgVarNode*); + Factor (const FgVarSet&); + Factor (FgVarNode*, const ParamSet&); + Factor (const FgVarSet&, const ParamSet&); + + const FgVarSet& getFgVarNodes (void) const; + FgVarSet& getFgVarNodes (void); + const ParamSet& getParameters (void) const; + ParamSet& getParameters (void); + void setParameters (const ParamSet&); + Factor& operator= (const Factor& f); + Factor& operator*= (const Factor& f); + void insertVariable (FgVarNode* index); + void marginalizeVariable (const FgVarNode* var); + void marginalizeVariable (unsigned); + string getLabel (void) const; + string toString (void) const; + + private: + vector getCptEntries() const; + int getIndexOf (const FgVarNode*) const; + + FgVarSet vs_; + ParamSet ps_; + int id_; + static int indexCount_; +}; + +Factor operator* (const Factor&, const Factor&); + +#endif diff --git a/packages/CLPBN/clpbn/bp/FactorGraph.cpp b/packages/CLPBN/clpbn/bp/FactorGraph.cpp new file mode 100755 index 000000000..0a85d2b5b --- /dev/null +++ b/packages/CLPBN/clpbn/bp/FactorGraph.cpp @@ -0,0 +1,173 @@ +#include +#include +#include +#include +#include + +#include "FactorGraph.h" +#include "FgVarNode.h" +#include "Factor.h" + + +FactorGraph::FactorGraph (const char* fileName) +{ + string line; + ifstream is (fileName); + if (!is.is_open()) { + cerr << "error: cannot read from file " + std::string (fileName) << endl; + abort(); + } + + while (is.peek() == '#' || is.peek() == '\n') getline (is, line); + getline (is, line); + if (line != "MARKOV") { + cerr << "error: the network must be a MARKOV network " << endl; + abort(); + } + + while (is.peek() == '#' || is.peek() == '\n') getline (is, line); + int nVars; + is >> nVars; + + while (is.peek() == '#' || is.peek() == '\n') getline (is, line); + vector domainSizes (nVars); + for (int i = 0; i < nVars; i++) { + int ds; + is >> ds; + domainSizes[i] = ds; + } + + while (is.peek() == '#' || is.peek() == '\n') getline (is, line); + for (int i = 0; i < nVars; i++) { + varNodes_.push_back (new FgVarNode (i, domainSizes[i])); + } + + int nFactors; + is >> nFactors; + for (int i = 0; i < nFactors; i++) { + while (is.peek() == '#' || is.peek() == '\n') getline (is, line); + int nFactorVars; + is >> nFactorVars; + FgVarSet factorVars; + for (int j = 0; j < nFactorVars; j++) { + int varId; + is >> varId; + FgVarNode* var = getVariableById (varId); + if (var == 0) { + cerr << "error: invalid variable identifier (" << varId << ")" << endl; + abort(); + } + factorVars.push_back (var); + } + Factor* f = new Factor (factorVars); + factors_.push_back (f); + for (unsigned j = 0; j < factorVars.size(); j++) { + factorVars[j]->addFactor (f); + } + } + + for (int i = 0; i < nFactors; i++) { + while (is.peek() == '#' || is.peek() == '\n') getline (is, line); + int nParams; + is >> nParams; + ParamSet params (nParams); + for (int j = 0; j < nParams; j++) { + double param; + is >> param; + params[j] = param; + } + factors_[i]->setParameters (params); + } + is.close(); + + for (unsigned i = 0; i < varNodes_.size(); i++) { + varNodes_[i]->setIndex (i); + } +} + + + +FactorGraph::~FactorGraph (void) +{ + for (unsigned i = 0; i < varNodes_.size(); i++) { + delete varNodes_[i]; + } + for (unsigned i = 0; i < factors_.size(); i++) { + delete factors_[i]; + } +} + + + +FgVarSet +FactorGraph::getFgVarNodes (void) const +{ + return varNodes_; +} + + + +vector +FactorGraph::getFactors (void) const +{ + return factors_; +} + + + +VarSet +FactorGraph::getVariables (void) const +{ + VarSet vars; + for (unsigned i = 0; i < varNodes_.size(); i++) { + vars.push_back (varNodes_[i]); + } + return vars; +} + + + +FgVarNode* +FactorGraph::getVariableById (unsigned id) const +{ + for (unsigned i = 0; i < varNodes_.size(); i++) { + if (varNodes_[i]->getVarId() == id) { + return varNodes_[i]; + } + } + return 0; +} + + + +FgVarNode* +FactorGraph::getVariableByLabel (string label) const +{ + for (unsigned i = 0; i < varNodes_.size(); i++) { + stringstream ss; + ss << "v" << varNodes_[i]->getVarId(); + if (ss.str() == label) { + return varNodes_[i]; + } + } + return 0; +} + + + +void +FactorGraph::printFactorGraph (void) const +{ + for (unsigned i = 0; i < varNodes_.size(); i++) { + cout << "variable number " << varNodes_[i]->getIndex() << endl; + cout << "Id = " << varNodes_[i]->getVarId() << endl; + cout << "Domain size = " << varNodes_[i]->getDomainSize() << endl; + cout << "Evidence = " << varNodes_[i]->getEvidence() << endl; + cout << endl; + } + cout << endl; + for (unsigned i = 0; i < factors_.size(); i++) { + cout << factors_[i]->toString() << endl; + } +} + diff --git a/packages/CLPBN/clpbn/bp/FactorGraph.h b/packages/CLPBN/clpbn/bp/FactorGraph.h new file mode 100755 index 000000000..9809f25b8 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/FactorGraph.h @@ -0,0 +1,35 @@ +#ifndef BP_FACTORGRAPH_H +#define BP_FACTORGRAPH_H + +#include +#include + +#include "GraphicalModel.h" +#include "Shared.h" + +using namespace std; + +class FgVarNode; +class Factor; + +class FactorGraph : public GraphicalModel +{ + public: + FactorGraph (const char* fileName); + ~FactorGraph (void); + + FgVarSet getFgVarNodes (void) const; + vector getFactors (void) const; + VarSet getVariables (void) const; + FgVarNode* getVariableById (unsigned) const; + FgVarNode* getVariableByLabel (string) const; + void printFactorGraph (void) const; + + private: + DISALLOW_COPY_AND_ASSIGN (FactorGraph); + + FgVarSet varNodes_; + vector factors_; +}; + +#endif diff --git a/packages/CLPBN/clpbn/bp/FgVarNode.h b/packages/CLPBN/clpbn/bp/FgVarNode.h new file mode 100755 index 000000000..e82ab0c52 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/FgVarNode.h @@ -0,0 +1,28 @@ +#ifndef BP_VARIABLE_H +#define BP_VARIABLE_H + +#include +#include + +#include "Variable.h" +#include "Shared.h" + +using namespace std; + +class Factor; + +class FgVarNode : public Variable +{ + public: + FgVarNode (int varId, int dsize) : Variable (varId, dsize) { } + + void addFactor (Factor* f) { factors_.push_back (f); } + vector getFactors (void) const { return factors_; } + + private: + DISALLOW_COPY_AND_ASSIGN (FgVarNode); + // members + vector factors_; +}; + +#endif // BP_VARIABLE_H diff --git a/packages/CLPBN/clpbn/bp/GraphicalModel.h b/packages/CLPBN/clpbn/bp/GraphicalModel.h new file mode 100755 index 000000000..4aaf4baf3 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/GraphicalModel.h @@ -0,0 +1,17 @@ +#ifndef BP_GRAPHICALMODEL_H +#define BP_GRAPHICALMODEL_H + +#include "Variable.h" +#include "Shared.h" + +using namespace std; + +class GraphicalModel +{ + public: + virtual VarSet getVariables (void) const = 0; + + private: +}; + +#endif diff --git a/packages/CLPBN/clpbn/bp/Horus.cpp b/packages/CLPBN/clpbn/bp/Horus.cpp deleted file mode 100755 index 43770b689..000000000 --- a/packages/CLPBN/clpbn/bp/Horus.cpp +++ /dev/null @@ -1,125 +0,0 @@ -#include -#include -#include -#include - -#include - -#include -#include -#include -#include - - -using namespace std; - -int addVariables (BayesianNetwork&, YAP_Term, int); -int addDistributions (BayesianNetwork&, YAP_Term, int); - -int createNetwork (void) -{ - BayesianNetwork* bn = new BpNetwork(); - addDistributions (*bn, YAP_ARG3, (int) YAP_IntOfTerm (YAP_ARG4)); - addVariables (*bn, YAP_ARG1, (int) YAP_IntOfTerm (YAP_ARG2)); - YAP_Int p = (YAP_Int) (bn); - return YAP_Unify (YAP_MkIntTerm (p), YAP_ARG5); -} - - - -int addVariables (BayesianNetwork& bn, YAP_Term varList, int nVars) -{ - for (int i = 0; i < nVars; i++) { - YAP_Term var = YAP_HeadOfTerm (varList); - int varId = (int) YAP_IntOfTerm (YAP_ArgOfTerm (1, var)); - int distId = (int) YAP_IntOfTerm (YAP_ArgOfTerm (2, var)); - YAP_Term parentsList = YAP_ArgOfTerm (3, var); - int nParents = (int) YAP_IntOfTerm (YAP_ArgOfTerm (4, var)); - vector parents; - for (int j = 0; j < nParents; j++) { - int parentId = (int) YAP_IntOfTerm (YAP_HeadOfTerm (parentsList)); - stringstream parentName; - parentName << parentId; - parents.push_back (bn.getNode (parentName.str())); - parentsList = YAP_TailOfTerm (parentsList); - } - stringstream nodeName; - nodeName << varId; - int evidence = (int) YAP_IntOfTerm (YAP_ArgOfTerm (5, var)); - bn.addNode (nodeName.str(), parents, evidence, distId); - varList = YAP_TailOfTerm (varList); - } - return TRUE; -} - - - -int addDistributions (BayesianNetwork& bn, YAP_Term distList, int nDists) -{ - for (int i = 0; i < nDists; i++) { - YAP_Term dist = YAP_HeadOfTerm (distList); - int distId = (int) YAP_IntOfTerm (YAP_ArgOfTerm (1, dist)); - YAP_Term domainList = YAP_ArgOfTerm (2, dist); - int domainSize = (int) YAP_IntOfTerm (YAP_ArgOfTerm (3, dist)); - vector domain (domainSize); - for (int j = 0; j < domainSize; j++) { - YAP_Atom atom = YAP_AtomOfTerm (YAP_HeadOfTerm (domainList)); - domain[j] = (char*) YAP_AtomName (atom);; - domainList = YAP_TailOfTerm (domainList); - } - YAP_Term paramsList = YAP_ArgOfTerm (4, dist); - int nParams = (int) YAP_IntOfTerm (YAP_ArgOfTerm (5, dist)); - double* params = new double [nParams]; - for (int j = 0; j < nParams; j++) { - params[j] = (double) YAP_FloatOfTerm (YAP_HeadOfTerm (paramsList)); - paramsList = YAP_TailOfTerm (paramsList); - } - bn.addDistribution (distId, params, nParams, domain); - distList = YAP_TailOfTerm (distList); - } - return TRUE; -} - - - -int runSolver (void) -{ - BpNetwork* bn = (BpNetwork*) YAP_IntOfTerm (YAP_ARG1); - YAP_Term queryVarsList = YAP_ARG2; - int nQueryVars = (int) YAP_IntOfTerm (YAP_ARG3); - vector queryVars; - for (int i = 0; i < nQueryVars; i++) { - int queryVarId = (int) YAP_IntOfTerm (YAP_HeadOfTerm (queryVarsList)); - stringstream queryVarName; - queryVarName << queryVarId; - queryVars.push_back (bn->getNode (queryVarName.str())); - queryVarsList = YAP_TailOfTerm (queryVarsList); - } - bn->runSolver (queryVars); - vector beliefs = bn->getBeliefs(); - YAP_Term beliefsList = YAP_TermNil(); - for (int i = beliefs.size() - 1; i >= 0; i--) { - YAP_Term belief = YAP_MkFloatTerm (beliefs[i]); - beliefsList = YAP_MkPairTerm (belief, beliefsList); - } - return YAP_Unify (beliefsList, YAP_ARG4); -} - - - -int freeMemory (void) -{ - BpNetwork* bn = (BpNetwork*) YAP_IntOfTerm (YAP_ARG1); - delete bn; - return TRUE; -} - - - -extern "C" void init_predicates (void) -{ - YAP_UserCPredicate ("create_network", createNetwork, 5); - YAP_UserCPredicate ("run_solver", runSolver, 4); - YAP_UserCPredicate ("free_memory", freeMemory, 1); -} - diff --git a/packages/CLPBN/clpbn/bp/HorusCli.cpp b/packages/CLPBN/clpbn/bp/HorusCli.cpp new file mode 100755 index 000000000..a4619566f --- /dev/null +++ b/packages/CLPBN/clpbn/bp/HorusCli.cpp @@ -0,0 +1,214 @@ +#include +#include +#include + +#include "BayesNet.h" +#include "BPSolver.h" + +#include "FactorGraph.h" +#include "SPSolver.h" + +using namespace std; + +void BayesianNetwork (int, const char* []); +void markovNetwork (int, const char* []); + +const string USAGE = "usage: \ +./hcli FILE [VARIABLE | OBSERVED_VARIABLE=EVIDENCE]..." ; + + +int +main (int argc, const char* argv[]) +{ + if (!argv[1]) { + cerr << "error: no graphical model specified" << endl; + cerr << USAGE << endl; + exit (0); + } + string fileName = argv[1]; + string extension = fileName.substr (fileName.find_last_of ('.') + 1); + if (extension == "xml") { + BayesianNetwork (argc, argv); + } else if (extension == "uai") { + markovNetwork (argc, argv); + } else { + cerr << "error: the graphical model must be defined either " ; + cerr << "in a xml file or uai file" << endl; + exit (0); + } + return 0; +} + + + +void +BayesianNetwork (int argc, const char* argv[]) +{ + BayesNet bn (argv[1]); + //bn.printNetwork(); + + NodeSet queryVars; + for (int i = 2; i < argc; i++) { + string arg = argv[i]; + if (arg.find ('=') == std::string::npos) { + BayesNode* queryVar = bn.getNode (arg); + if (queryVar) { + queryVars.push_back (queryVar); + } else { + cerr << "error: there isn't a variable labeled of " ; + cerr << "`" << arg << "'" ; + cerr << endl; + exit (0); + } + } else { + size_t pos = arg.find ('='); + string label = arg.substr (0, pos); + string state = arg.substr (pos + 1); + if (label.empty()) { + cerr << "error: missing left argument" << endl; + cerr << USAGE << endl; + exit (0); + } + if (state.empty()) { + cerr << "error: missing right argument" << endl; + cerr << USAGE << endl; + exit (0); + } + BayesNode* node = bn.getNode (label); + if (node) { + if (node->isValidState (state)) { + node->setEvidence (state); + } else { + cerr << "error: `" << state << "' " ; + cerr << "is not a valid state for " ; + cerr << "`" << node->getLabel() << "'" ; + cerr << endl; + exit (0); + } + } else { + cerr << "error: there isn't a variable labeled of " ; + cerr << "`" << label << "'" ; + cerr << endl; + exit (0); + } + } + } + + BPSolver solver (bn); + if (queryVars.size() == 0) { + solver.runSolver(); + solver.printAllPosterioris(); + } else if (queryVars.size() == 1) { + solver.runSolver(); + solver.printPosterioriOf (queryVars[0]); + } else { + Domain domain = BayesNet::getInstantiations(queryVars); + ParamSet params = solver.getJointDistribution (queryVars); + for (unsigned i = 0; i < params.size(); i++) { + cout << domain[i] << "\t" << params[i] << endl; + } + } + bn.freeDistributions(); +} + + + +void +markovNetwork (int argc, const char* argv[]) +{ + FactorGraph fg (argv[1]); + //fg.printFactorGraph(); + + VarSet queryVars; + for (int i = 2; i < argc; i++) { + string arg = argv[i]; + if (arg.find ('=') == std::string::npos) { + if (!Util::isInteger (arg)) { + cerr << "error: `" << arg << "' " ; + cerr << "is not a valid variable id" ; + cerr << endl; + exit (0); + } + unsigned varId; + stringstream ss; + ss << arg; + ss >> varId; + Variable* queryVar = fg.getVariableById (varId); + if (queryVar) { + queryVars.push_back (queryVar); + } else { + cerr << "error: there isn't a variable with " ; + cerr << "`" << varId << "' as id" ; + cerr << endl; + exit (0); + } + } else { + size_t pos = arg.find ('='); + if (arg.substr (0, pos).empty()) { + cerr << "error: missing left argument" << endl; + cerr << USAGE << endl; + exit (0); + } + if (arg.substr (pos + 1).empty()) { + cerr << "error: missing right argument" << endl; + cerr << USAGE << endl; + exit (0); + } + if (!Util::isInteger (arg.substr (0, pos))) { + cerr << "error: `" << arg.substr (0, pos) << "' " ; + cerr << "is not a variable id" ; + cerr << endl; + exit (0); + } + unsigned varId; + stringstream ss; + ss << arg.substr (0, pos); + ss >> varId; + Variable* var = fg.getVariableById (varId); + if (var) { + if (!Util::isInteger (arg.substr (pos + 1))) { + cerr << "error: `" << arg.substr (pos + 1) << "' " ; + cerr << "is not a state index" ; + cerr << endl; + exit (0); + } + int stateIndex; + stringstream ss; + ss << arg.substr (pos + 1); + ss >> stateIndex; + cout << "si: " << stateIndex << endl; + if (var->isValidStateIndex (stateIndex)) { + var->setEvidence (stateIndex); + } else { + cerr << "error: `" << stateIndex << "' " ; + cerr << "is not a valid state index for variable " ; + cerr << "`" << var->getVarId() << "'" ; + cerr << endl; + exit (0); + } + } else { + cerr << "error: there isn't a variable with " ; + cerr << "`" << varId << "' as id" ; + cerr << endl; + exit (0); + } + } + } + + SPSolver solver (fg); + if (queryVars.size() == 0) { + solver.runSolver(); + solver.printAllPosterioris(); + } else if (queryVars.size() == 1) { + solver.runSolver(); + solver.printPosterioriOf (queryVars[0]); + } else { + assert (false); //FIXME + //Domain domain = BayesNet::getInstantiations(queryVars); + //ParamSet params = solver.getJointDistribution (queryVars); + //for (unsigned i = 0; i < params.size(); i++) { + // cout << domain[i] << "\t" << params[i] << endl; + //} + } +} + diff --git a/packages/CLPBN/clpbn/bp/HorusYap.cpp b/packages/CLPBN/clpbn/bp/HorusYap.cpp new file mode 100755 index 000000000..c4ccb8aa7 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/HorusYap.cpp @@ -0,0 +1,232 @@ +#include +#include +#include +#include +#include + +#include + +#include "callgrind.h" + +#include "BayesNet.h" +#include "BayesNode.h" +#include "BPSolver.h" + +using namespace std; + +int +createNetwork (void) +{ + Statistics::numCreatedNets ++; + cout << "creating network number " << Statistics::numCreatedNets << endl; + if (Statistics::numCreatedNets == 1) { + //CALLGRIND_START_INSTRUMENTATION; + } + BayesNet* bn = new BayesNet(); + + YAP_Term varList = YAP_ARG1; + while (varList != YAP_TermNil()) { + YAP_Term var = YAP_HeadOfTerm (varList); + unsigned varId = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (1, var)); + unsigned dsize = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (2, var)); + int evidence = (int) YAP_IntOfTerm (YAP_ArgOfTerm (3, var)); + YAP_Term parentL = YAP_ArgOfTerm (4, var); + unsigned distId = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (5, var)); + NodeSet parents; + while (parentL != YAP_TermNil()) { + unsigned parentId = (unsigned) YAP_IntOfTerm (YAP_HeadOfTerm (parentL)); + BayesNode* parent = bn->getNode (parentId); + if (!parent) { + parent = bn->addNode (parentId); + } + parents.push_back (parent); + parentL = YAP_TailOfTerm (parentL); + } + Distribution* dist = bn->getDistribution (distId); + if (!dist) { + dist = new Distribution (distId); + bn->addDistribution (dist); + } + BayesNode* node = bn->getNode (varId); + if (node) { + node->setData (dsize, evidence, parents, dist); + } else { + bn->addNode (varId, dsize, evidence, parents, dist); + } + varList = YAP_TailOfTerm (varList); + } + bn->setIndexes(); + + if (Statistics::numCreatedNets == 1688) { + Statistics::writeStats(); + //Statistics::writeStats(); + //CALLGRIND_STOP_INSTRUMENTATION; + //CALLGRIND_DUMP_STATS; + //exit (0); + } + YAP_Int p = (YAP_Int) (bn); + return YAP_Unify (YAP_MkIntTerm (p), YAP_ARG2); +} + + + +int +setExtraVarsInfo (void) +{ + BayesNet* bn = (BayesNet*) YAP_IntOfTerm (YAP_ARG1); + YAP_Term varsInfoL = YAP_ARG2; + while (varsInfoL != YAP_TermNil()) { + YAP_Term head = YAP_HeadOfTerm (varsInfoL); + unsigned varId = YAP_IntOfTerm (YAP_ArgOfTerm (1, head)); + YAP_Atom label = YAP_AtomOfTerm (YAP_ArgOfTerm (2, head)); + YAP_Term domainL = YAP_ArgOfTerm (3, head); + Domain domain; + while (domainL != YAP_TermNil()) { + YAP_Atom atom = YAP_AtomOfTerm (YAP_HeadOfTerm (domainL)); + domain.push_back ((char*) YAP_AtomName (atom)); + domainL = YAP_TailOfTerm (domainL); + } + BayesNode* node = bn->getNode (varId); + assert (node); + node->setLabel ((char*) YAP_AtomName (label)); + node->setDomain (domain); + varsInfoL = YAP_TailOfTerm (varsInfoL); + } + return TRUE; +} + + + +int +setParameters (void) +{ + BayesNet* bn = (BayesNet*) YAP_IntOfTerm (YAP_ARG1); + YAP_Term distList = YAP_ARG2; + while (distList != YAP_TermNil()) { + YAP_Term dist = YAP_HeadOfTerm (distList); + unsigned distId = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (1, dist)); + YAP_Term paramL = YAP_ArgOfTerm (2, dist); + ParamSet params; + while (paramL!= YAP_TermNil()) { + params.push_back ((double) YAP_FloatOfTerm (YAP_HeadOfTerm (paramL))); + paramL = YAP_TailOfTerm (paramL); + } + bn->getDistribution(distId)->updateParameters(params); + distList = YAP_TailOfTerm (distList); + } + return TRUE; +} + + + +int +runSolver (void) +{ + BayesNet* bn = (BayesNet*) YAP_IntOfTerm (YAP_ARG1); + YAP_Term taskList = YAP_ARG2; + + vector tasks; + NodeSet marginalVars; + + while (taskList != YAP_TermNil()) { + if (YAP_IsPairTerm (YAP_HeadOfTerm (taskList))) { + NodeSet jointVars; + YAP_Term jointList = YAP_HeadOfTerm (taskList); + while (jointList != YAP_TermNil()) { + unsigned varId = (unsigned) YAP_IntOfTerm (YAP_HeadOfTerm (jointList)); + assert (bn->getNode (varId)); + jointVars.push_back (bn->getNode (varId)); + jointList = YAP_TailOfTerm (jointList); + } + tasks.push_back (jointVars); + } else { + unsigned varId = (unsigned) YAP_IntOfTerm (YAP_HeadOfTerm (taskList)); + BayesNode* node = bn->getNode (varId); + assert (node); + tasks.push_back (NodeSet() = {node}); + marginalVars.push_back (node); + } + taskList = YAP_TailOfTerm (taskList); + } + /* + cout << "tasks to resolve:" << endl; + for (unsigned i = 0; i < tasks.size(); i++) { + cout << "i" << ": " ; + if (tasks[i].size() == 1) { + cout << tasks[i][0]->getVarId() << endl; + } else { + for (unsigned j = 0; j < tasks[i].size(); j++) { + cout << tasks[i][j]->getVarId() << " " ; + } + cout << endl; + } + } + */ + + cerr << "prunning now..." << endl; + BayesNet* prunedNet = bn->pruneNetwork (marginalVars); + bn->printNetworkToFile ("net.txt"); + BPSolver solver (*prunedNet); + cerr << "solving marginals now..." << endl; + solver.runSolver(); + cerr << "calculating joints now ..." << endl; + + vector results; + results.reserve (tasks.size()); + for (unsigned i = 0; i < tasks.size(); i++) { + if (tasks[i].size() == 1) { + BayesNode* node = prunedNet->getNode (tasks[i][0]->getVarId()); + results.push_back (solver.getPosterioriOf (node)); + } else { + BPSolver solver2 (*bn); + cout << "calculating an join dist on: " ; + for (unsigned j = 0; j < tasks[i].size(); j++) { + cout << tasks[i][j]->getVarId() << " " ; + } + cout << "..." << endl; + results.push_back (solver2.getJointDistribution (tasks[i])); + } + } + + delete prunedNet; + + YAP_Term list = YAP_TermNil(); + for (int i = results.size() - 1; i >= 0; i--) { + const ParamSet& beliefs = results[i]; + YAP_Term queryBeliefsL = YAP_TermNil(); + for (int j = beliefs.size() - 1; j >= 0; j--) { + YAP_Int sl1 = YAP_InitSlot(list); + YAP_Term belief = YAP_MkFloatTerm (beliefs[j]); + queryBeliefsL = YAP_MkPairTerm (belief, queryBeliefsL); + list = YAP_GetFromSlot(sl1); + YAP_RecoverSlots(1); + } + list = YAP_MkPairTerm (queryBeliefsL, list); + } + + return YAP_Unify (list, YAP_ARG3); +} + + + +int +deleteBayesNet (void) +{ + BayesNet* bn = (BayesNet*) YAP_IntOfTerm (YAP_ARG1); + bn->freeDistributions(); + delete bn; + return TRUE; +} + + + +extern "C" void +init_predicates (void) +{ + YAP_UserCPredicate ("create_network", createNetwork, 2); + YAP_UserCPredicate ("set_extra_vars_info", setExtraVarsInfo, 2); + YAP_UserCPredicate ("set_parameters", setParameters, 2); + YAP_UserCPredicate ("run_solver", runSolver, 3); + YAP_UserCPredicate ("delete_bayes_net", deleteBayesNet, 1); +} + diff --git a/packages/CLPBN/clpbn/bp/Makefile.in b/packages/CLPBN/clpbn/bp/Makefile.in index 201e1e76b..10f192755 100755 --- a/packages/CLPBN/clpbn/bp/Makefile.in +++ b/packages/CLPBN/clpbn/bp/Makefile.in @@ -21,7 +21,17 @@ YAPLIBDIR=@libdir@/Yap # CC=@CC@ CXX=@CXX@ -CXXFLAGS= @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) -D_YAP_NOT_INSTALLED_=1 -I$(srcdir) -I../../../.. -I$(srcdir)/../../../../include @CPPFLAGS@ + +# normal +CXXFLAGS= -std=c++0x @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) -D_YAP_NOT_INSTALLED_=1 -I$(srcdir) -I../../../.. -I$(srcdir)/../../../../include @CPPFLAGS@ -DNDEBUG + +# debug +#CXXFLAGS= -std=c++0x @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) -D_YAP_NOT_INSTALLED_=1 -I$(srcdir) -I../../../.. -I$(srcdir)/../../../../include @CPPFLAGS@ -g -O0 + +# profiling (callgrind) +#CXXFLAGS= -std=c++0x @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) -D_YAP_NOT_INSTALLED_=1 -I$(srcdir) -I../../../.. -I$(srcdir)/../../../../include @CPPFLAGS@ -g -DNDEBUG + + # # # You shouldn't need to change what follows. @@ -38,64 +48,75 @@ CWD=$(PWD) HEADERS = \ - $(srcdir)/BayesianNetwork.h \ - $(srcdir)/BayesianNode.h \ - $(srcdir)/BpNetwork.h \ - $(srcdir)/BpNode.h \ + $(srcdir)/GraphicalModel.h \ + $(srcdir)/Variable.h \ + $(srcdir)/BayesNet.h \ + $(srcdir)/BayesNode.h \ $(srcdir)/Distribution.h \ $(srcdir)/CptEntry.h \ - $(srcdir)/BifInterface.h \ + $(srcdir)/FactorGraph.h \ + $(srcdir)/FgVarNode.h \ + $(srcdir)/Factor.h \ + $(srcdir)/Solver.h \ + $(srcdir)/BPSolver.h \ + $(srcdir)/BpNode.h \ + $(srcdir)/SPSolver.h \ + $(srcdir)/Shared.h \ $(srcdir)/xmlParser/xmlParser.h - + CPP_SOURCES = \ - $(srcdir)/BayesianNetwork.cpp \ - $(srcdir)/BayesianNode.cpp \ - $(srcdir)/BpNetwork.cpp \ + $(srcdir)/BayesNet.cpp \ + $(srcdir)/BayesNode.cpp \ + $(srcdir)/FactorGraph.cpp \ + $(srcdir)/Factor.cpp \ + $(srcdir)/BPSolver.cpp \ $(srcdir)/BpNode.cpp \ - $(srcdir)/Distribution.cpp \ - $(srcdir)/CptEntry.cpp \ - $(srcdir)/Horus.cpp \ - $(srcdir)/BifInterface.cpp \ - $(srcdir)/BifTest.cpp \ + $(srcdir)/SPSolver.cpp \ + $(srcdir)/HorusYap.cpp \ + $(srcdir)/HorusCli.cpp \ $(srcdir)/xmlParser/xmlParser.cpp OBJS = \ - BayesianNetwork.o \ - BayesianNode.o \ - BpNetwork.o \ + BayesNet.o \ + BayesNode.o \ + FactorGraph.o \ + Factor.o \ + BPSolver.o \ BpNode.o \ - Distribution.o \ - CptEntry.o \ - Horus.o + SPSolver.o \ + HorusYap.o -BIF_OBJS = \ - BayesianNetwork.o \ - BayesianNode.o \ - BpNetwork.o \ - BpNode.o \ - Distribution.o \ - CptEntry.o \ - BifInterface.o \ - BifTest.o \ - xmlParser.o +HCLI_OBJS = \ + BayesNet.o \ + BayesNode.o \ + FactorGraph.o \ + Factor.o \ + BPSolver.o \ + BpNode.o \ + SPSolver.o \ + HorusCli.o \ + xmlParser.o SOBJS=horus.@SO@ -all: $(SOBJS) biftest +all: $(SOBJS) hcli # default rule +%.o : $(srcdir)/%.cpp + $(CXX) -c $(CXXFLAGS) $< -o $@ + + xmlParser.o : $(srcdir)/xmlParser/xmlParser.cpp $(CXX) -c $(CXXFLAGS) $< -o $@ -%.o : $(srcdir)/%.cpp - $(CXX) -c $(CXXFLAGS) $< -o $@ @DO_SECOND_LD@horus.@SO@: $(OBJS) @DO_SECOND_LD@ @SHLIB_CXX_LD@ -o horus.@SO@ $(OBJS) @EXTRA_LIBS_FOR_SWIDLLS@ -biftest: $(BIF_OBJS) - $(CXX) -o biftest $(BIF_OBJS) + +hcli: $(HCLI_OBJS) + $(CXX) -o hcli $(HCLI_OBJS) install: all @@ -103,12 +124,12 @@ install: all clean: - rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK biftest xmlParser/*.o + rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK hcli xmlParser/*.o depend: $(HEADERS) $(CPP_SOURCES) -@if test "$(GCC)" = yes; then\ - $(CC) -MM -MG $(CFLAGS) -I$(srcdir) -I$(srcdir)/../../../../include -I$(srcdir)/../../../../H $(CPP_SOURCES) >> Makefile;\ + $(CC) -std=c++0x -MM -MG $(CFLAGS) -I$(srcdir) -I$(srcdir)/../../../../include -I$(srcdir)/../../../../H $(CPP_SOURCES) >> Makefile;\ else\ makedepend -f - -- $(CFLAGS) -I$(srcdir)/../../../../H -I$(srcdir)/../../../../include -- $(CPP_SOURCES) |\ sed 's|.*/\([^:]*\):|\1:|' >> Makefile ;\ diff --git a/packages/CLPBN/clpbn/bp/SPSolver.cpp b/packages/CLPBN/clpbn/bp/SPSolver.cpp new file mode 100755 index 000000000..fe0ea1e69 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/SPSolver.cpp @@ -0,0 +1,295 @@ +#include +#include +#include + +#include "SPSolver.h" +#include "FactorGraph.h" +#include "FgVarNode.h" +#include "Factor.h" + +SPSolver* Link::klass = 0; + + +SPSolver::SPSolver (const FactorGraph& fg) : Solver (&fg) +{ + fg_ = &fg; + accuracy_ = 0.0001; + maxIter_ = 10000; + //schedule_ = S_SEQ_FIXED; + //schedule_ = S_SEQ_RANDOM; + //schedule_ = S_SEQ_PARALLEL; + schedule_ = S_MAX_RESIDUAL; + Link::klass = this; + FgVarSet vars = fg_->getFgVarNodes(); + for (unsigned i = 0; i < vars.size(); i++) { + msgs_.push_back (new MessageBanket (vars[i])); + } +} + + + +SPSolver::~SPSolver (void) +{ + for (unsigned i = 0; i < msgs_.size(); i++) { + delete msgs_[i]; + } +} + + + +void +SPSolver::runSolver (void) +{ + nIter_ = 0; + vector factors = fg_->getFactors(); + for (unsigned i = 0; i < factors.size(); i++) { + FgVarSet neighbors = factors[i]->getFgVarNodes(); + for (unsigned j = 0; j < neighbors.size(); j++) { + updateOrder_.push_back (Link (factors[i], neighbors[j])); + } + } + + while (!converged() && nIter_ < maxIter_) { + if (DL >= 1) { + cout << endl; + cout << "****************************************" ; + cout << "****************************************" ; + cout << endl; + cout << " Iteration " << nIter_ + 1 << endl; + cout << "****************************************" ; + cout << "****************************************" ; + cout << endl; + } + + switch (schedule_) { + + case S_SEQ_RANDOM: + random_shuffle (updateOrder_.begin(), updateOrder_.end()); + // no break + + case S_SEQ_FIXED: + for (unsigned c = 0; c < updateOrder_.size(); c++) { + Link& link = updateOrder_[c]; + calculateNextMessage (link.source, link.destination); + updateMessage (updateOrder_[c]); + } + break; + + case S_PARALLEL: + for (unsigned c = 0; c < updateOrder_.size(); c++) { + Link link = updateOrder_[c]; + calculateNextMessage (link.source, link.destination); + } + for (unsigned c = 0; c < updateOrder_.size(); c++) { + Link link = updateOrder_[c]; + updateMessage (updateOrder_[c]); + } + break; + + case S_MAX_RESIDUAL: + maxResidualSchedule(); + break; + } + + nIter_++; + } + cout << endl; + if (DL >= 1) { + if (nIter_ < maxIter_) { + cout << "Loopy Sum-Product converged in " ; + cout << nIter_ << " iterations" << endl; + } else { + cout << "The maximum number of iterations was hit, terminating..." ; + cout << endl; + } + } +} + + + +ParamSet +SPSolver::getPosterioriOf (const Variable* var) const +{ + assert (var); + assert (var == fg_->getVariableById (var->getVarId())); + assert (var->getIndex() < msgs_.size()); + + ParamSet probs (var->getDomainSize(), 1); + if (var->hasEvidence()) { + for (unsigned i = 0; i < probs.size(); i++) { + if ((int)i != var->getEvidence()) { + probs[i] = 0; + } + } + + } else { + + MessageBanket* mb = msgs_[var->getIndex()]; + const FgVarNode* varNode = fg_->getFgVarNodes()[var->getIndex()]; + vector neighbors = varNode->getFactors(); + for (unsigned i = 0; i < neighbors.size(); i++) { + const Message& msg = mb->getMessage (neighbors[i]); + for (unsigned j = 0; j < msg.size(); j++) { + probs[j] *= msg[j]; + } + } + Util::normalize (probs); + } + + return probs; +} + + + +bool +SPSolver::converged (void) +{ + if (nIter_ == 0 || nIter_ == 1) { + return false; + } + bool converged = true; + for (unsigned i = 0; i < updateOrder_.size(); i++) { + double residual = getResidual (updateOrder_[i]); + if (DL >= 1) { + cout << updateOrder_[i].toString(); + cout << " residual = " << residual << endl; + } + if (residual > accuracy_) { + converged = false; + if (DL == 0) { + break; + } + } + } + return converged; +} + + + +void +SPSolver::maxResidualSchedule (void) +{ + if (nIter_ == 0) { + for (unsigned c = 0; c < updateOrder_.size(); c++) { + Link& l = updateOrder_[c]; + calculateNextMessage (l.source, l.destination); + if (DL >= 1) { + cout << updateOrder_[c].toString() << " residual = " ; + cout << getResidual (updateOrder_[c]) << endl; + } + } + sort (updateOrder_.begin(), updateOrder_.end(), compareResidual); + } else { + + for (unsigned c = 0; c < updateOrder_.size(); c++) { + Link& link = updateOrder_.front(); + updateMessage (link); + resetResidual (link); + + // update the messages that depend on message source --> destination + vector fstLevelNeighbors = link.destination->getFactors(); + for (unsigned i = 0; i < fstLevelNeighbors.size(); i++) { + if (fstLevelNeighbors[i] != link.source) { + FgVarSet sndLevelNeighbors; + sndLevelNeighbors = fstLevelNeighbors[i]->getFgVarNodes(); + for (unsigned j = 0; j < sndLevelNeighbors.size(); j++) { + if (sndLevelNeighbors[j] != link.destination) { + calculateNextMessage (fstLevelNeighbors[i], sndLevelNeighbors[j]); + } + } + } + } + sort (updateOrder_.begin(), updateOrder_.end(), compareResidual); + } + } +} + + + +void +SPSolver::updateMessage (const Link& link) +{ + updateMessage (link.source, link.destination); +} + + + +void +SPSolver::updateMessage (const Factor* src, const FgVarNode* dest) +{ + msgs_[dest->getIndex()]->updateMessage (src); +/* cout << src->getLabel() << " --> " << dest->getLabel() << endl; + cout << " m: " ; + Message msg = msgs_[dest->getIndex()]->getMessage (src); + for (unsigned i = 0; i < msg.size(); i++) { + if (i != 0) cout << ", " ; + cout << msg[i]; + } + cout << endl; +*/ +} + + + +void +SPSolver::calculateNextMessage (const Link& link) +{ + calculateNextMessage (link.source, link.destination); +} + + +void +SPSolver::calculateNextMessage (const Factor* src, const FgVarNode* dest) +{ + FgVarSet neighbors = src->getFgVarNodes(); + // calculate the product of MessageBankets sended + // to factor `src', except from var `dest' + Factor result = *src; + for (unsigned i = 0; i < neighbors.size(); i++) { + if (neighbors[i] != dest) { + Message msg (neighbors[i]->getDomainSize(), 1); + calculateVarFactorMessage (neighbors[i], src, msg); + result *= Factor (neighbors[i], msg); + } + } + // marginalize all vars except `dest' + for (unsigned i = 0; i < neighbors.size(); i++) { + if (neighbors[i] != dest) { + result.marginalizeVariable (neighbors[i]); + } + } + msgs_[dest->getIndex()]->setNextMessage (src, result.getParameters()); +} + + + +void +SPSolver::calculateVarFactorMessage (const FgVarNode* src, + const Factor* dest, + Message& placeholder) const +{ + assert (src->getDomainSize() == (int)placeholder.size()); + if (src->hasEvidence()) { + for (unsigned i = 0; i < placeholder.size(); i++) { + if ((int)i != src->getEvidence()) { + placeholder[i] = 0.0; + } else { + placeholder[i] = 1.0; + } + } + + } else { + + MessageBanket* mb = msgs_[src->getIndex()]; + vector neighbors = src->getFactors(); + for (unsigned i = 0; i < neighbors.size(); i++) { + if (neighbors[i] != dest) { + const Message& fromFactor = mb->getMessage (neighbors[i]); + for (unsigned j = 0; j < fromFactor.size(); j++) { + placeholder[j] *= fromFactor[j]; + } + } + } + } +} + diff --git a/packages/CLPBN/clpbn/bp/SPSolver.h b/packages/CLPBN/clpbn/bp/SPSolver.h new file mode 100755 index 000000000..421172166 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/SPSolver.h @@ -0,0 +1,171 @@ +#ifndef BP_SPSOLVER_H +#define BP_SPSOLVER_H + +#include +#include +#include +#include + +#include "Solver.h" +#include "FgVarNode.h" +#include "Factor.h" + +using namespace std; + +class FactorGraph; +class SPSolver; + +struct Link +{ + Link (Factor* s, FgVarNode* d) + { + source = s; + destination = d; + } + string toString (void) const + { + stringstream ss; + ss << source->getLabel() << " --> " ; + ss << destination->getLabel(); + return ss.str(); + } + Factor* source; + FgVarNode* destination; + static SPSolver* klass; +}; + + + +class MessageBanket +{ + public: + MessageBanket (const FgVarNode* var) + { + vector sources = var->getFactors(); + for (unsigned i = 0; i < sources.size(); i++) { + indexMap_.insert (make_pair (sources[i], i)); + currMsgs_.push_back (Message(var->getDomainSize(), 1)); + nextMsgs_.push_back (Message(var->getDomainSize(), -10)); + residuals_.push_back (0.0); + } + } + + void updateMessage (const Factor* source) + { + unsigned idx = getIndex(source); + currMsgs_[idx] = nextMsgs_[idx]; + } + + void setNextMessage (const Factor* source, const Message& msg) + { + unsigned idx = getIndex(source); + nextMsgs_[idx] = msg; + residuals_[idx] = computeResidual (source); + } + + const Message& getMessage (const Factor* source) const + { + return currMsgs_[getIndex(source)]; + } + + double getResidual (const Factor* source) const + { + return residuals_[getIndex(source)]; + } + + void resetResidual (const Factor* source) + { + residuals_[getIndex(source)] = 0.0; + } + + private: + double computeResidual (const Factor* source) + { + double change = 0.0; + unsigned idx = getIndex (source); + const Message& currMessage = currMsgs_[idx]; + const Message& nextMessage = nextMsgs_[idx]; + for (unsigned i = 0; i < currMessage.size(); i++) { + change += abs (currMessage[i] - nextMessage[i]); + } + return change; + } + + unsigned getIndex (const Factor* factor) const + { + assert (factor); + assert (indexMap_.find(factor) != indexMap_.end()); + return indexMap_.find(factor)->second; + } + + typedef map IndexMap; + + IndexMap indexMap_; + vector currMsgs_; + vector nextMsgs_; + vector residuals_; +}; + + + +class SPSolver : public Solver +{ + public: + SPSolver (const FactorGraph&); + ~SPSolver (void); + + void runSolver (void); + ParamSet getPosterioriOf (const Variable* var) const; + + private: + bool converged (void); + void maxResidualSchedule (void); + void updateMessage (const Link&); + void updateMessage (const Factor*, const FgVarNode*); + void calculateNextMessage (const Link&); + void calculateNextMessage (const Factor*, const FgVarNode*); + void calculateVarFactorMessage ( + const FgVarNode*, const Factor*, Message&) const; + double getResidual (const Link&) const; + void resetResidual (const Link&) const; + friend bool compareResidual (const Link&, const Link&); + + const FactorGraph* fg_; + vector msgs_; + Schedule schedule_; + int nIter_; + double accuracy_; + int maxIter_; + vector updateOrder_; +}; + + + +inline double +SPSolver::getResidual (const Link& link) const +{ + MessageBanket* mb = Link::klass->msgs_[link.destination->getIndex()]; + return mb->getResidual (link.source); +} + + + +inline void +SPSolver::resetResidual (const Link& link) const +{ + MessageBanket* mb = Link::klass->msgs_[link.destination->getIndex()]; + mb->resetResidual (link.source); +} + + + +inline bool +compareResidual (const Link& link1, const Link& link2) +{ + MessageBanket* mb1 = Link::klass->msgs_[link1.destination->getIndex()]; + MessageBanket* mb2 = Link::klass->msgs_[link2.destination->getIndex()]; + return mb1->getResidual(link1.source) > mb2->getResidual(link2.source); +} + +#endif + diff --git a/packages/CLPBN/clpbn/bp/Shared.h b/packages/CLPBN/clpbn/bp/Shared.h new file mode 100755 index 000000000..82afd3e51 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/Shared.h @@ -0,0 +1,203 @@ +#ifndef BP_SHARED_H +#define BP_SHARED_H + +#include +#include +#include +#include +#include +#include +#include + +// Macro to disallow the copy constructor and operator= functions +#define DISALLOW_COPY_AND_ASSIGN(TypeName) \ + TypeName(const TypeName&); \ + void operator=(const TypeName&) + +using namespace std; + +class Variable; +class BayesNode; +class FgVarNode; + +typedef double Param; +typedef vector ParamSet; +typedef vector Message; +typedef vector VarSet; +typedef vector NodeSet; +typedef vector FgVarSet; +typedef vector Domain; +typedef vector DomainConf; +typedef pair DomainConstr; +typedef unordered_map IndexMap; + + +//extern unsigned DL; +static const unsigned DL = 0; + +// number of digits to show when printing a parameter +static const unsigned PRECISION = 10; + +// shared by bp and sp solver +enum Schedule +{ + S_SEQ_FIXED, + S_SEQ_RANDOM, + S_PARALLEL, + S_MAX_RESIDUAL +}; + + +struct NetInfo +{ + NetInfo (unsigned c, double t) + { + counting = c; + solvingTime = t; + } + unsigned counting; + double solvingTime; +}; + +typedef map StatisticMap; + + +class Statistics +{ + public: + + static void updateStats (unsigned size, double time) + { + StatisticMap::iterator it = stats_.find(size); + if (it == stats_.end()) { + stats_.insert (make_pair (size, NetInfo (1, 0.0))); + } else { + it->second.counting ++; + it->second.solvingTime += time; + } + } + + static unsigned getCounting (unsigned size) + { + StatisticMap::iterator it = stats_.find(size); + assert (it != stats_.end()); + return it->second.counting; + } + + static void updateIterations (unsigned nIters) + { + totalOfIterations += nIters; + if (nIters > maxIterations) { + maxIterations = nIters; + } + } + + static void writeStats (void) + { + ofstream out ("../../stats.txt"); + if (!out.is_open()) { + cerr << "error: cannot open file to write at " ; + cerr << "Statistics:::updateStats()" << endl; + abort(); + } + unsigned avgIterations = 0; + if (numSolvedLoopyNets > 0) { + avgIterations = totalOfIterations / numSolvedLoopyNets; + } + double totalSolvingTime = 0.0; + for (StatisticMap::iterator it = stats_.begin(); + it != stats_.end(); it++) { + totalSolvingTime += it->second.solvingTime; + } + out << "created networks: " << numCreatedNets << endl; + out << "solver runs on polytrees: " << numSolvedPolyTrees << endl; + out << "solver runs on loopy networks: " << numSolvedLoopyNets << endl; + out << " unconverged: " << numUnconvergedRuns << endl; + out << " max iterations: " << maxIterations << endl; + out << " average iterations: " << avgIterations << endl; + out << "total solving time " << totalSolvingTime << endl; + out << endl; + out << "Network Size\tCounting\tSolving Time\tAverage Time" << endl; + for (StatisticMap::iterator it = stats_.begin(); + it != stats_.end(); it++) { + out << it->first; + out << "\t\t" << it->second.counting; + out << "\t\t" << it->second.solvingTime; + if (it->second.counting > 0) { + out << "\t\t" << it->second.solvingTime / it->second.counting; + } else { + out << "\t\t0.0" ; + } + out << endl; + } + out.close(); + } + + static unsigned numCreatedNets; + static unsigned numSolvedPolyTrees; + static unsigned numSolvedLoopyNets; + static unsigned numUnconvergedRuns; + + private: + static StatisticMap stats_; + static unsigned maxIterations; + static unsigned totalOfIterations; + +}; + + + +class Util +{ + public: + static void normalize (ParamSet& v) + { + double sum = 0.0; + for (unsigned i = 0; i < v.size(); i++) { + sum += v[i]; + } + assert (sum != 0.0); + for (unsigned i = 0; i < v.size(); i++) { + v[i] /= sum; + } + } + + static double getL1dist (const ParamSet& v1, const ParamSet& v2) + { + assert (v1.size() == v2.size()); + double dist = 0.0; + for (unsigned i = 0; i < v1.size(); i++) { + dist += abs (v1[i] - v2[i]); + } + return dist; + } + + static double getMaxNorm (const ParamSet& v1, const ParamSet& v2) + { + assert (v1.size() == v2.size()); + double max = 0.0; + for (unsigned i = 0; i < v1.size(); i++) { + double diff = abs (v1[i] - v2[i]); + if (diff > max) { + max = diff; + } + } + return max; + } + + static bool isInteger (const string& s) + { + stringstream ss1 (s); + stringstream ss2; + int integer; + ss1 >> integer; + ss2 << integer; + return (ss1.str() == ss2.str()); + } +}; + + +//unsigned Statistics::totalOfIterations = 0; + +#endif + diff --git a/packages/CLPBN/clpbn/bp/Solver.h b/packages/CLPBN/clpbn/bp/Solver.h new file mode 100644 index 000000000..483986278 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/Solver.h @@ -0,0 +1,50 @@ +#ifndef BP_SOLVER_H +#define BP_SOLVER_H + +#include + +#include "GraphicalModel.h" +#include "Variable.h" + +using namespace std; + +class Solver +{ + public: + Solver (const GraphicalModel* gm) + { + gm_ = gm; + } + virtual void runSolver (void) = 0; + virtual ParamSet getPosterioriOf (const Variable*) const = 0; + + void printPosterioriOf (const Variable* var) const + { + cout << endl; + cout << setw (20) << left << var->getLabel() << "posteriori" ; + cout << endl; + cout << "------------------------------" ; + cout << endl; + const Domain& domain = var->getDomain(); + ParamSet results = getPosterioriOf (var); + for (int xi = 0; xi < var->getDomainSize(); xi++) { + cout << setw (20) << domain[xi]; + cout << setprecision (PRECISION) << results[xi]; + cout << endl; + } + cout << endl; + } + + void printAllPosterioris (void) const + { + VarSet vars = gm_->getVariables(); + for (unsigned i = 0; i < vars.size(); i++) { + printPosterioriOf (vars[i]); + } + } + + private: + const GraphicalModel* gm_; +}; + +#endif diff --git a/packages/CLPBN/clpbn/bp/Variable.h b/packages/CLPBN/clpbn/bp/Variable.h new file mode 100755 index 000000000..63f3edcbc --- /dev/null +++ b/packages/CLPBN/clpbn/bp/Variable.h @@ -0,0 +1,143 @@ +#ifndef BP_GENERIC_VARIABLE_H +#define BP_GENERIC_VARIABLE_H + +#include + +#include +#include "Shared.h" + +using namespace std; + +class Variable +{ + public: + + Variable (unsigned varId) + { + this->varId_ = varId; + this->dsize_ = 0; + this->evidence_ = -1; + this->label_ = 0; + } + + Variable (unsigned varId, unsigned dsize, int evidence = -1) + { + assert (dsize != 0); + assert (evidence < (int)dsize); + this->varId_ = varId; + this->dsize_ = dsize; + this->evidence_ = evidence; + this->label_ = 0; + } + + Variable (unsigned varId, const Domain& domain, int evidence = -1) + { + assert (!domain.empty()); + assert (evidence < (int)domain.size()); + this->varId_ = varId; + this->dsize_ = domain.size(); + this->domain_ = domain; + this->evidence_ = evidence; + this->label_ = 0; + } + + ~Variable (void) + { + delete label_; + } + + unsigned getVarId (void) const { return varId_; } + unsigned getIndex (void) const { return index_; } + void setIndex (unsigned idx) { index_ = idx; } + int getDomainSize (void) const { return dsize_; } + bool hasEvidence (void) const { return evidence_ != -1; } + int getEvidence (void) const { return evidence_; } + bool hasDomain (void) { return !domain_.empty(); } + bool hasLabel (void) { return label_ != 0; } + + bool isValidStateIndex (int index) + { + return index >= 0 && index < dsize_; + } + + bool isValidState (const string& state) + { + return find (domain_.begin(), domain_.end(), state) != domain_.end(); + } + + Domain getDomain (void) const + { + assert (dsize_ != 0); + if (domain_.size() == 0) { + Domain d; + for (int i = 0; i < dsize_; i++) { + stringstream ss; + ss << "x" << i ; + d.push_back (ss.str()); + } + return d; + } else { + return domain_; + } + } + + void setDomainSize (unsigned dsize) + { + assert (dsize != 0); + dsize_ = dsize; + } + + void setDomain (const Domain& domain) + { + assert (!domain.empty()); + domain_ = domain; + dsize_ = domain.size(); + } + + void setEvidence (int ev) + { + assert (ev < dsize_); + evidence_ = ev; + } + + void setEvidence (const string& ev) + { + assert (isValidState (ev)); + for (unsigned i = 0; i < domain_.size(); i++) { + if (domain_[i] == ev) { + evidence_ = i; + } + } + } + + void setLabel (string label) + { + label_ = new string (label); + } + + string getLabel (void) const + { + if (label_ == 0) { + stringstream ss; + ss << "v" << varId_; + return ss.str(); + } else { + return *label_; + } + } + + protected: + unsigned varId_; + string* label_; + unsigned index_; + int evidence_; + + private: + DISALLOW_COPY_AND_ASSIGN (Variable); + Domain domain_; + int dsize_; + +}; + +#endif // BP_GENERIC_VARIABLE_H + diff --git a/packages/CLPBN/clpbn/bp/bnets/dog-net.xml b/packages/CLPBN/clpbn/bp/bnets/dog-net.xml deleted file mode 100644 index 74f0a0e1e..000000000 --- a/packages/CLPBN/clpbn/bp/bnets/dog-net.xml +++ /dev/null @@ -1,102 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -]> - - - - -Dog-Problem - - - - light-on - true - false - position = (73, 165) - - - - bowel-problem - true - false - position = (190, 69) - - - - dog-out - true - false - position = (155, 165) - - - - hear-bark - true - false - position = (154, 241) - - - - family-out - true - false - position = (112, 69) - - - - - - light-on - family-out - 0.6 0.4 0.05 0.95
-
- - - bowel-problem - 0.01 0.99
-
- - - dog-out - bowel-problem - family-out - 0.99 0.01 0.97 0.03 0.9 0.1 0.3 0.7
-
- - - hear-bark - dog-out - 0.7 0.3 0.01 0.99
-
- - - family-out - 0.15 0.85
-
- - -
-
diff --git a/packages/CLPBN/clpbn/bp/bnets/multiconnected.xml b/packages/CLPBN/clpbn/bp/bnets/multiconnected.xml deleted file mode 100644 index 973679408..000000000 --- a/packages/CLPBN/clpbn/bp/bnets/multiconnected.xml +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - -Multiconnected - - - - H - h1 - h2 - - - - B - b1 - b2 - - - - L - l1 - l2 - - - - F - f1 - f2 - - - - C - c1 - c2 - - - - H - .2 .8
-
- - - B - H - .25 .75 .05 .95
-
- - - L - H - .003 .997 .00005 .99995
-
- - - F - B - L - .75 .25 .1 .9 .5 .5 .05 .95
-
- - - C - L - .6 .4 .02 .98
-
- -
-
- diff --git a/packages/CLPBN/clpbn/bp/bnets/multiconnected.yap b/packages/CLPBN/clpbn/bp/bnets/multiconnected.yap deleted file mode 100644 index 493ac7bf3..000000000 --- a/packages/CLPBN/clpbn/bp/bnets/multiconnected.yap +++ /dev/null @@ -1,59 +0,0 @@ - -:- use_module(library(clpbn)). - -:- set_clpbn_flag(solver, bp). - - -% H -% / \ -% / \ -% B L -% \ / \ -% \ / \ -% F C - - -h(H) :- - h_table(HDist), - { H = h with p([h1, h2], HDist) }. - - -b(B) :- - h(H), - b_table(BDist), - { B = b with p([b1, b2], BDist, [H]) }. - - -l(L) :- - h(H), - l_table(LDist), - { L = l with p([l1, l2], LDist, [H]) }. - - -f(F) :- - b(B), - l(L), - f_table(FDist), - { F = f with p([f1, f2], FDist, [B, L]) }. - - -c(C) :- - l(L), - c_table(CDist), - { C = c with p([c1, c2], CDist, [L]) }. - - -h_table([0.2, 0.8]). - -b_table([0.25, 0.05, - 0.75, 0.95]). - -l_table([0.003, 0.00005, - 0.997, 0.99995]). - -f_table([0.75, 0.1, 0.5, 0.05, - 0.25, 0.9, 0.5, 0.95]). - -c_table([0.6, 0.02, - 0.4, 0.98]). - diff --git a/packages/CLPBN/clpbn/bp/bnets/test.yap b/packages/CLPBN/clpbn/bp/bnets/test.yap deleted file mode 100644 index d617ea5ae..000000000 --- a/packages/CLPBN/clpbn/bp/bnets/test.yap +++ /dev/null @@ -1,36 +0,0 @@ - -:- use_module(library(clpbn)). - -:- set_clpbn_flag(solver, bp). - - -% B F -% \ / -% \ / -% A - - -a(A) :- - b(B), - f(F), - a_table(ADist), - { A = a with p([a1, a2, a3], ADist, [B, F]) }. - - - -b(B) :- - b_table(BDist), - { B = b with p([b1, b2], BDist) }. - -f(F) :- - f_table(FDist), - { F = f with p([f1, f2], FDist) }. - -b_table([0.005, 0.995]). - -f_table([0.03, 0.97]). - -a_table([0.992, 0.99, 0.2, 0.003, - 0.008, 0.01, 0.8, 0.997, - 0.018, 0.21, 0.2, 0.927]). - diff --git a/packages/CLPBN/clpbn/bp/callgrind.h b/packages/CLPBN/clpbn/bp/callgrind.h new file mode 100755 index 000000000..d36b6f4eb --- /dev/null +++ b/packages/CLPBN/clpbn/bp/callgrind.h @@ -0,0 +1,147 @@ + +/* + ---------------------------------------------------------------- + + Notice that the following BSD-style license applies to this one + file (callgrind.h) only. The rest of Valgrind is licensed under the + terms of the GNU General Public License, version 2, unless + otherwise indicated. See the COPYING file in the source + distribution for details. + + ---------------------------------------------------------------- + + This file is part of callgrind, a valgrind tool for cache simulation + and call tree tracing. + + Copyright (C) 2003-2010 Josef Weidendorfer. All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. The origin of this software must not be misrepresented; you must + not claim that you wrote the original software. If you use this + software in a product, an acknowledgment in the product + documentation would be appreciated but is not required. + + 3. Altered source versions must be plainly marked as such, and must + not be misrepresented as being the original software. + + 4. The name of the author may not be used to endorse or promote + products derived from this software without specific prior written + permission. + + THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY + DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE + GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + ---------------------------------------------------------------- + + Notice that the above BSD-style license applies to this one file + (callgrind.h) only. The entire rest of Valgrind is licensed under + the terms of the GNU General Public License, version 2. See the + COPYING file in the source distribution for details. + + ---------------------------------------------------------------- +*/ + +#ifndef __CALLGRIND_H +#define __CALLGRIND_H + +#include "valgrind.h" + +/* !! ABIWARNING !! ABIWARNING !! ABIWARNING !! ABIWARNING !! + This enum comprises an ABI exported by Valgrind to programs + which use client requests. DO NOT CHANGE THE ORDER OF THESE + ENTRIES, NOR DELETE ANY -- add new ones at the end. + + The identification ('C','T') for Callgrind has historical + reasons: it was called "Calltree" before. Besides, ('C','G') would + clash with cachegrind. + */ + +typedef + enum { + VG_USERREQ__DUMP_STATS = VG_USERREQ_TOOL_BASE('C','T'), + VG_USERREQ__ZERO_STATS, + VG_USERREQ__TOGGLE_COLLECT, + VG_USERREQ__DUMP_STATS_AT, + VG_USERREQ__START_INSTRUMENTATION, + VG_USERREQ__STOP_INSTRUMENTATION + } Vg_CallgrindClientRequest; + +/* Dump current state of cost centers, and zero them afterwards */ +#define CALLGRIND_DUMP_STATS \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__DUMP_STATS, \ + 0, 0, 0, 0, 0); \ + } + +/* Dump current state of cost centers, and zero them afterwards. + The argument is appended to a string stating the reason which triggered + the dump. This string is written as a description field into the + profile data dump. */ +#define CALLGRIND_DUMP_STATS_AT(pos_str) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__DUMP_STATS_AT, \ + pos_str, 0, 0, 0, 0); \ + } + +/* Zero cost centers */ +#define CALLGRIND_ZERO_STATS \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__ZERO_STATS, \ + 0, 0, 0, 0, 0); \ + } + +/* Toggles collection state. + The collection state specifies whether the happening of events + should be noted or if they are to be ignored. Events are noted + by increment of counters in a cost center */ +#define CALLGRIND_TOGGLE_COLLECT \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__TOGGLE_COLLECT, \ + 0, 0, 0, 0, 0); \ + } + +/* Start full callgrind instrumentation if not already switched on. + When cache simulation is done, it will flush the simulated cache; + this will lead to an artifical cache warmup phase afterwards with + cache misses which would not have happened in reality. */ +#define CALLGRIND_START_INSTRUMENTATION \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__START_INSTRUMENTATION, \ + 0, 0, 0, 0, 0); \ + } + +/* Stop full callgrind instrumentation if not already switched off. + This flushes Valgrinds translation cache, and does no additional + instrumentation afterwards, which effectivly will run at the same + speed as the "none" tool (ie. at minimal slowdown). + Use this to bypass Callgrind aggregation for uninteresting code parts. + To start Callgrind in this mode to ignore the setup phase, use + the option "--instr-atstart=no". */ +#define CALLGRIND_STOP_INSTRUMENTATION \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__STOP_INSTRUMENTATION, \ + 0, 0, 0, 0, 0); \ + } + +#endif /* __CALLGRIND_H */ diff --git a/packages/CLPBN/clpbn/bp/examples/bayes-ball a.xml b/packages/CLPBN/clpbn/bp/examples/bayes-ball a.xml new file mode 100755 index 000000000..286b95f59 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/bayes-ball a.xml @@ -0,0 +1,76 @@ + + + + +Bayes-Ball: The Rational Pastime Network, Figure 4, a) + + + 1 + + + + + 2 + + + + + 3 + + + + + 4 + + + + + 5 + + + + + 6 + + + + + 1 + 1
+
+ + + 2 + 1 + 3 + 1
+
+ + + 3 + 1
+
+ + + 4 + 1 + 5 + 1
+
+ + + 5 + 2 + 6 + 1
+
+ + + 6 + 3 + 1
+
+ +
+
+ diff --git a/packages/CLPBN/clpbn/bp/examples/bayes-ball c.xml b/packages/CLPBN/clpbn/bp/examples/bayes-ball c.xml new file mode 100755 index 000000000..44b291822 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/bayes-ball c.xml @@ -0,0 +1,74 @@ + + + + +Bayes-Ball: The Rational Pastime Network, Figure 4, c) + + + 1 + + + + + 2 + + + + + 3 + + + + + 4 + + + + + 5 + + + + + 6 + + + + + 1 + 1
+
+ + + 2 + 1 + 3 + 1
+
+ + + 3 + 1
+
+ + + 4 + 5 + 1
+
+ + + 5 + 2 + 6 + 1
+
+ + + 6 + 1
+
+ +
+
+ diff --git a/packages/CLPBN/clpbn/bp/examples/burglary-alarm.uai b/packages/CLPBN/clpbn/bp/examples/burglary-alarm.uai new file mode 100755 index 000000000..3f24754e2 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/burglary-alarm.uai @@ -0,0 +1,28 @@ +MARKOV +5 +2 2 2 2 2 +5 +1 0 +1 1 +3 2 0 1 +2 3 2 +2 4 2 + +2 + .001 .009 + +2 + .002 .008 + +8 + .95 .94 .29 .001 + .05 .06 .71 .999 + +4 + .9 .05 + .1 .95 + +4 + .7 .01 + .3 .99 + diff --git a/packages/CLPBN/clpbn/bp/examples/burglary-alarm.xml b/packages/CLPBN/clpbn/bp/examples/burglary-alarm.xml new file mode 100755 index 000000000..36c7a500b --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/burglary-alarm.xml @@ -0,0 +1,81 @@ + + + + + + + +Simple Loop + + + B + b1 + b2 + + + + E + e1 + e2 + + + + A + a1 + a2 + + + + J + j1 + j2 + + + + M + m1 + m2 + + + + B + .001 .009
+
+ + + E + .002 .008
+
+ + + A + B + E + .95 .05 .94 .06 .29 .71 .001 .999
+
+ + + J + A + .9 .1 .05 .95
+
+ + + M + A + .7 .3 .01 .99
+
+ +
+
+ diff --git a/packages/CLPBN/clpbn/bp/examples/burglary-alarm.yap b/packages/CLPBN/clpbn/bp/examples/burglary-alarm.yap new file mode 100755 index 000000000..9fd004712 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/burglary-alarm.yap @@ -0,0 +1,54 @@ + +:- use_module(library(clpbn)). + +:- set_clpbn_flag(solver, vel). + +% +% B E +% \ / +% \ / +% A +% / \ +% / \ +% J M +% + + +b(B) :- + b_table(BDist), + { B = b with p([b1, b2], BDist) }. + +e(E) :- + e_table(EDist), + { E = e with p([e1, e2], EDist) }. + +a(A) :- + b(B), + e(E), + a_table(ADist), + { A = a with p([a1, a2], ADist, [B, E]) }. + +j(J):- + a(A), + j_table(JDist), + { J = j with p([j1, j2], JDist, [A]) }. + +m(M):- + a(A), + m_table(MDist), + { M = m with p([m1, m2], MDist, [A]) }. + + +b_table([0.001, 0.009]). + +e_table([0.002, 0.008]). + +a_table([0.95, 0.94, 0.29, 0.001, + 0.05, 0.06, 0.71, 0.999]). + +j_table([0.9, 0.05, + 0.1, 0.95]). + +m_table([0.7, 0.01, + 0.3, 0.99]). + diff --git a/packages/CLPBN/clpbn/bp/examples/chain.xml b/packages/CLPBN/clpbn/bp/examples/chain.xml new file mode 100755 index 000000000..6b5882e5d --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/chain.xml @@ -0,0 +1,58 @@ + + + + + + +Simple Chain + + + A + a1 + a2 + + + + B + b1 + b2 + + + + C + c1 + c2 + + + + A + 0.3 0.7
+
+ + + B + A + 0.4 0.6 0.2 0.8
+
+ + + C + B + 0.9 0.1 0.25 0.75
+
+ +
+
+ diff --git a/packages/CLPBN/clpbn/bp/examples/convergence.xml b/packages/CLPBN/clpbn/bp/examples/convergence.xml new file mode 100755 index 000000000..8172042ed --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/convergence.xml @@ -0,0 +1,51 @@ + + + + + + +Simple Convergence + + + A + + + + + B + + + + + C + + + + + A + 1
+
+ + + B + 1
+
+ + + C + A + B + 1
+
+ +
+
+ diff --git a/packages/CLPBN/clpbn/bp/examples/divergence.xml b/packages/CLPBN/clpbn/bp/examples/divergence.xml new file mode 100755 index 000000000..69ef00f04 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/divergence.xml @@ -0,0 +1,51 @@ + + + + + + +Simple Divergence + + + A + + + + + B + + + + + C + + + + + A + 1
+
+ + + B + A + 1
+
+ + + C + A + 1
+
+ +
+
+ diff --git a/packages/CLPBN/clpbn/bp/bnets/john-mary-call.xml b/packages/CLPBN/clpbn/bp/examples/john-mary-call.xml old mode 100644 new mode 100755 similarity index 100% rename from packages/CLPBN/clpbn/bp/bnets/john-mary-call.xml rename to packages/CLPBN/clpbn/bp/examples/john-mary-call.xml diff --git a/packages/CLPBN/clpbn/bp/bnets/simple-loop.xml b/packages/CLPBN/clpbn/bp/examples/loop.xml old mode 100644 new mode 100755 similarity index 63% rename from packages/CLPBN/clpbn/bp/bnets/simple-loop.xml rename to packages/CLPBN/clpbn/bp/examples/loop.xml index f3a52a087..2764d73d1 --- a/packages/CLPBN/clpbn/bp/bnets/simple-loop.xml +++ b/packages/CLPBN/clpbn/bp/examples/loop.xml @@ -1,8 +1,20 @@ + + -Simple Loop +Loop A @@ -28,6 +40,12 @@ d2 + + E + e1 + e2 + + A .01 .09
@@ -36,20 +54,26 @@ B A - .03 .97 .6 .4
+ .03 .97 .6 .4
C A - .24 .76 .12 .88
+ E + .24 .76 .12 .88 .2 .4. 5. .6
D B C - .2 .8 .7 .3 .45 .55 .22 .78
+ .2 .8 .7 .3 .45 .55 .22 .78
+
+ + + E + .5 .6
diff --git a/packages/CLPBN/clpbn/bp/examples/loop.yap b/packages/CLPBN/clpbn/bp/examples/loop.yap new file mode 100755 index 000000000..c18784975 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/loop.yap @@ -0,0 +1,53 @@ + +:- use_module(library(clpbn)). + +:- set_clpbn_flag(solver, bp). + +% +% A E +% / \ / +% / \ / +% B C +% \ / +% \ / +% D +% + +a(A) :- + a_table(ADist), + { A = a with p([a1, a2], ADist) }. + +b(B) :- + a(A), + b_table(BDist), + { B = b with p([b1, b2], BDist, [A]) }. + +c(C) :- + a(A), + c_table(CDist), + { C = c with p([c1, c2], CDist, [A]) }. + +d(D) :- + b(B), + c(C), + d_table(DDist), + { D = d with p([d1, d2], DDist, [B, C]) }. + +e(E) :- + e_table(EDist), + { E = e with p([e1, e2], EDist) }. + + +a_table([0.005, 0.995]). + +b_table([0.02, 0.97, + 0.88, 0.03]). + +c_table([0.55, 0.94, + 0.45, 0.06]). + +d_table([0.192, 0.98, 0.33, 0.013, + 0.908, 0.02, 0.77, 0.987]). + +e_table([0.055, 0.945]). + diff --git a/packages/CLPBN/clpbn/bp/examples/neapolitan-A-F-joint.yap b/packages/CLPBN/clpbn/bp/examples/neapolitan-A-F-joint.yap new file mode 100755 index 000000000..4cb95eab4 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/neapolitan-A-F-joint.yap @@ -0,0 +1,55 @@ + +:- use_module(library(clpbn)). + +:- set_clpbn_flag(solver, bp). + +% +% B F +% \ / +% \ / +% A +% + +b(B) :- + b_table(BDist), + { B = b with p([b1, b2], BDist) }. + +f(F) :- + f_table(FDist), + { F = f with p([f1, f2], FDist) }. + +a(A) :- + b(B), + f(F), + a_table(ADist), + { A = a with p([a1, a2], ADist, [B, F]) }. + +d(D) :- + a(A), + f(F), + d_table(DDist), + { D = d with p([d1, d2, d3, d4], DDist, [A, F]) }. + + +b_table([0.005, 0.995]). + +f_table([0.03, 0.97]). + +a_table([0.992, 0.99, 0.2, 0.003, + 0.008, 0.01, 0.8, 0.997]). + +d_table([1.0, 0.0, 0.0, 0.0, + 0.0, 1.0, 0.0, 0.0, + 0.0, 0.0, 1.0, 0.0, + 0.0, 0.0, 0.0, 1.0]). + +%d_table([0.997, 0.001, 0.001, 0.001, +% 0.001, 0.997, 0.001, 0.001, +% 0.001, 0.001, 0.997, 0.001, +% 0.001, 0.001, 0.001, 0.997]). + +%d_table([0.15, 0.1, 0.7, 0.5, +% 0.25, 0.3, 0.2, 0.25, +% 0.3, 0.15, 0.35, 0.2, +% 0.3, 0.4, 0.2, 0.1]). + diff --git a/packages/CLPBN/clpbn/bp/examples/neapolitan.uai b/packages/CLPBN/clpbn/bp/examples/neapolitan.uai new file mode 100755 index 000000000..1339c83c2 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/neapolitan.uai @@ -0,0 +1,17 @@ +MARKOV +3 +2 2 2 +3 +1 0 +1 1 +3 2 0 1 + +2 + 0.005 0.995 + +2 + 0.03 0.97 + +8 + 0.992 0.99 0.2 0.003 + 0.008 0.01 0.8 0.997 diff --git a/packages/CLPBN/clpbn/bp/bnets/neapolitan.xml b/packages/CLPBN/clpbn/bp/examples/neapolitan.xml old mode 100644 new mode 100755 similarity index 60% rename from packages/CLPBN/clpbn/bp/bnets/neapolitan.xml rename to packages/CLPBN/clpbn/bp/examples/neapolitan.xml index b3a2e9612..0b359e274 --- a/packages/CLPBN/clpbn/bp/bnets/neapolitan.xml +++ b/packages/CLPBN/clpbn/bp/examples/neapolitan.xml @@ -1,49 +1,50 @@ - Neapolitan - - Burglar + B b1 b2 - FreightTruck + F f1 f2 - Alarm + A a1 a2 - Burglar + B .005 .995
- FreightTruck + F .03 .97
- Alarm - Burglar - FreightTruck + A + B + F .992 .008 .99 .01 .2 .8 .003 .997
diff --git a/packages/CLPBN/clpbn/bp/bnets/neapolitan.yap b/packages/CLPBN/clpbn/bp/examples/neapolitan.yap old mode 100644 new mode 100755 similarity index 99% rename from packages/CLPBN/clpbn/bp/bnets/neapolitan.yap rename to packages/CLPBN/clpbn/bp/examples/neapolitan.yap index 7a2155931..1d558d634 --- a/packages/CLPBN/clpbn/bp/bnets/neapolitan.yap +++ b/packages/CLPBN/clpbn/bp/examples/neapolitan.yap @@ -3,19 +3,12 @@ :- set_clpbn_flag(solver, bp). - +% % B F % \ / % \ / % A - - -a(A) :- - b(B), - f(F), - a_table(ADist), - { A = a with p([a1, a2], ADist, [B, F]) }. - +% b(B) :- @@ -26,6 +19,13 @@ f(F) :- f_table(FDist), { F = f with p([f1, f2], FDist) }. +a(A) :- + b(B), + f(F), + a_table(ADist), + { A = a with p([a1, a2], ADist, [B, F]) }. + + b_table([0.005, 0.995]). f_table([0.03, 0.97]). diff --git a/packages/CLPBN/clpbn/bp/bnets/more-than-2-parents-and-childs.xml b/packages/CLPBN/clpbn/bp/examples/several-parents-and-childs.xml old mode 100644 new mode 100755 similarity index 94% rename from packages/CLPBN/clpbn/bp/bnets/more-than-2-parents-and-childs.xml rename to packages/CLPBN/clpbn/bp/examples/several-parents-and-childs.xml index 9d1794264..e37c7ac5e --- a/packages/CLPBN/clpbn/bp/bnets/more-than-2-parents-and-childs.xml +++ b/packages/CLPBN/clpbn/bp/examples/several-parents-and-childs.xml @@ -1,8 +1,20 @@ + + -Test +Node with several parents and childs A diff --git a/packages/CLPBN/clpbn/bp/examples/test.uai b/packages/CLPBN/clpbn/bp/examples/test.uai new file mode 100755 index 000000000..f773cd9bf --- /dev/null +++ b/packages/CLPBN/clpbn/bp/examples/test.uai @@ -0,0 +1,36 @@ +MARKOV +5 +4 2 3 2 3 +7 +1 0 +1 1 +1 2 +1 3 +1 4 +2 0 1 +4 1 2 3 4 + +4 + 0.1 0.7 0.43 0.22 + +2 + 0.2 0.6 + +3 + 0.3 0.5 0.2 + +2 + 0.15 0.75 + +3 + 0.25 0.45 0.15 + +8 + 0.210 0.333 0.457 0.4 + 0.811 0.000 0.189 0.89 + +36 + 0.1 0.15 0.2 0.25 0.3 0.45 0.5 0.55 0.65 0.7 0.75 0.9 + 0.11 0.22 0.33 0.44 0.55 0.66 0.77 0.88 0.91 0.93 0.95 0.97 + 0.42 0.22 0.33 0.44 0.15 0.36 0.27 0.28 0.21 0.13 0.25 0.17 + diff --git a/packages/CLPBN/clpbn/bp/valgrind.h b/packages/CLPBN/clpbn/bp/valgrind.h new file mode 100755 index 000000000..0f5b37662 --- /dev/null +++ b/packages/CLPBN/clpbn/bp/valgrind.h @@ -0,0 +1,4536 @@ +/* -*- c -*- + ---------------------------------------------------------------- + + Notice that the following BSD-style license applies to this one + file (valgrind.h) only. The rest of Valgrind is licensed under the + terms of the GNU General Public License, version 2, unless + otherwise indicated. See the COPYING file in the source + distribution for details. + + ---------------------------------------------------------------- + + This file is part of Valgrind, a dynamic binary instrumentation + framework. + + Copyright (C) 2000-2010 Julian Seward. All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. The origin of this software must not be misrepresented; you must + not claim that you wrote the original software. If you use this + software in a product, an acknowledgment in the product + documentation would be appreciated but is not required. + + 3. Altered source versions must be plainly marked as such, and must + not be misrepresented as being the original software. + + 4. The name of the author may not be used to endorse or promote + products derived from this software without specific prior written + permission. + + THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS + OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY + DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE + GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + ---------------------------------------------------------------- + + Notice that the above BSD-style license applies to this one file + (valgrind.h) only. The entire rest of Valgrind is licensed under + the terms of the GNU General Public License, version 2. See the + COPYING file in the source distribution for details. + + ---------------------------------------------------------------- +*/ + + +/* This file is for inclusion into client (your!) code. + + You can use these macros to manipulate and query Valgrind's + execution inside your own programs. + + The resulting executables will still run without Valgrind, just a + little bit more slowly than they otherwise would, but otherwise + unchanged. When not running on valgrind, each client request + consumes very few (eg. 7) instructions, so the resulting performance + loss is negligible unless you plan to execute client requests + millions of times per second. Nevertheless, if that is still a + problem, you can compile with the NVALGRIND symbol defined (gcc + -DNVALGRIND) so that client requests are not even compiled in. */ + +#ifndef __VALGRIND_H +#define __VALGRIND_H + + +/* ------------------------------------------------------------------ */ +/* VERSION NUMBER OF VALGRIND */ +/* ------------------------------------------------------------------ */ + +/* Specify Valgrind's version number, so that user code can + conditionally compile based on our version number. Note that these + were introduced at version 3.6 and so do not exist in version 3.5 + or earlier. The recommended way to use them to check for "version + X.Y or later" is (eg) + +#if defined(__VALGRIND_MAJOR__) && defined(__VALGRIND_MINOR__) \ + && (__VALGRIND_MAJOR__ > 3 \ + || (__VALGRIND_MAJOR__ == 3 && __VALGRIND_MINOR__ >= 6)) +*/ +#define __VALGRIND_MAJOR__ 3 +#define __VALGRIND_MINOR__ 6 + + +#include + +/* Nb: this file might be included in a file compiled with -ansi. So + we can't use C++ style "//" comments nor the "asm" keyword (instead + use "__asm__"). */ + +/* Derive some tags indicating what the target platform is. Note + that in this file we're using the compiler's CPP symbols for + identifying architectures, which are different to the ones we use + within the rest of Valgrind. Note, __powerpc__ is active for both + 32 and 64-bit PPC, whereas __powerpc64__ is only active for the + latter (on Linux, that is). + + Misc note: how to find out what's predefined in gcc by default: + gcc -Wp,-dM somefile.c +*/ +#undef PLAT_ppc64_aix5 +#undef PLAT_ppc32_aix5 +#undef PLAT_x86_darwin +#undef PLAT_amd64_darwin +#undef PLAT_x86_linux +#undef PLAT_amd64_linux +#undef PLAT_ppc32_linux +#undef PLAT_ppc64_linux +#undef PLAT_arm_linux + +#if defined(_AIX) && defined(__64BIT__) +# define PLAT_ppc64_aix5 1 +#elif defined(_AIX) && !defined(__64BIT__) +# define PLAT_ppc32_aix5 1 +#elif defined(__APPLE__) && defined(__i386__) +# define PLAT_x86_darwin 1 +#elif defined(__APPLE__) && defined(__x86_64__) +# define PLAT_amd64_darwin 1 +#elif defined(__linux__) && defined(__i386__) +# define PLAT_x86_linux 1 +#elif defined(__linux__) && defined(__x86_64__) +# define PLAT_amd64_linux 1 +#elif defined(__linux__) && defined(__powerpc__) && !defined(__powerpc64__) +# define PLAT_ppc32_linux 1 +#elif defined(__linux__) && defined(__powerpc__) && defined(__powerpc64__) +# define PLAT_ppc64_linux 1 +#elif defined(__linux__) && defined(__arm__) +# define PLAT_arm_linux 1 +#else +/* If we're not compiling for our target platform, don't generate + any inline asms. */ +# if !defined(NVALGRIND) +# define NVALGRIND 1 +# endif +#endif + + +/* ------------------------------------------------------------------ */ +/* ARCHITECTURE SPECIFICS for SPECIAL INSTRUCTIONS. There is nothing */ +/* in here of use to end-users -- skip to the next section. */ +/* ------------------------------------------------------------------ */ + +#if defined(NVALGRIND) + +/* Define NVALGRIND to completely remove the Valgrind magic sequence + from the compiled code (analogous to NDEBUG's effects on + assert()) */ +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + { \ + (_zzq_rlval) = (_zzq_default); \ + } + +#else /* ! NVALGRIND */ + +/* The following defines the magic code sequences which the JITter + spots and handles magically. Don't look too closely at them as + they will rot your brain. + + The assembly code sequences for all architectures is in this one + file. This is because this file must be stand-alone, and we don't + want to have multiple files. + + For VALGRIND_DO_CLIENT_REQUEST, we must ensure that the default + value gets put in the return slot, so that everything works when + this is executed not under Valgrind. Args are passed in a memory + block, and so there's no intrinsic limit to the number that could + be passed, but it's currently five. + + The macro args are: + _zzq_rlval result lvalue + _zzq_default default value (result returned when running on real CPU) + _zzq_request request code + _zzq_arg1..5 request params + + The other two macros are used to support function wrapping, and are + a lot simpler. VALGRIND_GET_NR_CONTEXT returns the value of the + guest's NRADDR pseudo-register and whatever other information is + needed to safely run the call original from the wrapper: on + ppc64-linux, the R2 value at the divert point is also needed. This + information is abstracted into a user-visible type, OrigFn. + + VALGRIND_CALL_NOREDIR_* behaves the same as the following on the + guest, but guarantees that the branch instruction will not be + redirected: x86: call *%eax, amd64: call *%rax, ppc32/ppc64: + branch-and-link-to-r11. VALGRIND_CALL_NOREDIR is just text, not a + complete inline asm, since it needs to be combined with more magic + inline asm stuff to be useful. +*/ + +/* ------------------------- x86-{linux,darwin} ---------------- */ + +#if defined(PLAT_x86_linux) || defined(PLAT_x86_darwin) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "roll $3, %%edi ; roll $13, %%edi\n\t" \ + "roll $29, %%edi ; roll $19, %%edi\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + { volatile unsigned int _zzq_args[6]; \ + volatile unsigned int _zzq_result; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %EDX = client_request ( %EAX ) */ \ + "xchgl %%ebx,%%ebx" \ + : "=d" (_zzq_result) \ + : "a" (&_zzq_args[0]), "0" (_zzq_default) \ + : "cc", "memory" \ + ); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %EAX = guest_NRADDR */ \ + "xchgl %%ecx,%%ecx" \ + : "=a" (__addr) \ + : \ + : "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_EAX \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* call-noredir *%EAX */ \ + "xchgl %%edx,%%edx\n\t" +#endif /* PLAT_x86_linux || PLAT_x86_darwin */ + +/* ------------------------ amd64-{linux,darwin} --------------- */ + +#if defined(PLAT_amd64_linux) || defined(PLAT_amd64_darwin) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rolq $3, %%rdi ; rolq $13, %%rdi\n\t" \ + "rolq $61, %%rdi ; rolq $51, %%rdi\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + { volatile unsigned long long int _zzq_args[6]; \ + volatile unsigned long long int _zzq_result; \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %RDX = client_request ( %RAX ) */ \ + "xchgq %%rbx,%%rbx" \ + : "=d" (_zzq_result) \ + : "a" (&_zzq_args[0]), "0" (_zzq_default) \ + : "cc", "memory" \ + ); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + volatile unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %RAX = guest_NRADDR */ \ + "xchgq %%rcx,%%rcx" \ + : "=a" (__addr) \ + : \ + : "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_CALL_NOREDIR_RAX \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* call-noredir *%RAX */ \ + "xchgq %%rdx,%%rdx\n\t" +#endif /* PLAT_amd64_linux || PLAT_amd64_darwin */ + +/* ------------------------ ppc32-linux ------------------------ */ + +#if defined(PLAT_ppc32_linux) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rlwinm 0,0,3,0,0 ; rlwinm 0,0,13,0,0\n\t" \ + "rlwinm 0,0,29,0,0 ; rlwinm 0,0,19,0,0\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + { unsigned int _zzq_args[6]; \ + unsigned int _zzq_result; \ + unsigned int* _zzq_ptr; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile("mr 3,%1\n\t" /*default*/ \ + "mr 4,%2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1\n\t" \ + "mr %0,3" /*result*/ \ + : "=b" (_zzq_result) \ + : "b" (_zzq_default), "b" (_zzq_ptr) \ + : "cc", "memory", "r3", "r4"); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R11 */ \ + "or 3,3,3\n\t" +#endif /* PLAT_ppc32_linux */ + +/* ------------------------ ppc64-linux ------------------------ */ + +#if defined(PLAT_ppc64_linux) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + unsigned long long int r2; /* what tocptr do we need? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rotldi 0,0,3 ; rotldi 0,0,13\n\t" \ + "rotldi 0,0,61 ; rotldi 0,0,51\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + { unsigned long long int _zzq_args[6]; \ + register unsigned long long int _zzq_result __asm__("r3"); \ + register unsigned long long int* _zzq_ptr __asm__("r4"); \ + _zzq_args[0] = (unsigned long long int)(_zzq_request); \ + _zzq_args[1] = (unsigned long long int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned long long int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned long long int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned long long int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned long long int)(_zzq_arg5); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1" \ + : "=r" (_zzq_result) \ + : "0" (_zzq_default), "r" (_zzq_ptr) \ + : "cc", "memory"); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + register unsigned long long int __addr __asm__("r3"); \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2" \ + : "=r" (__addr) \ + : \ + : "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR_GPR2 */ \ + "or 4,4,4" \ + : "=r" (__addr) \ + : \ + : "cc", "memory" \ + ); \ + _zzq_orig->r2 = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R11 */ \ + "or 3,3,3\n\t" + +#endif /* PLAT_ppc64_linux */ + +/* ------------------------- arm-linux ------------------------- */ + +#if defined(PLAT_arm_linux) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "mov r12, r12, ror #3 ; mov r12, r12, ror #13 \n\t" \ + "mov r12, r12, ror #29 ; mov r12, r12, ror #19 \n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + { volatile unsigned int _zzq_args[6]; \ + volatile unsigned int _zzq_result; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + __asm__ volatile("mov r3, %1\n\t" /*default*/ \ + "mov r4, %2\n\t" /*ptr*/ \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* R3 = client_request ( R4 ) */ \ + "orr r10, r10, r10\n\t" \ + "mov %0, r3" /*result*/ \ + : "=r" (_zzq_result) \ + : "r" (_zzq_default), "r" (&_zzq_args[0]) \ + : "cc","memory", "r3", "r4"); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* R3 = guest_NRADDR */ \ + "orr r11, r11, r11\n\t" \ + "mov %0, r3" \ + : "=r" (__addr) \ + : \ + : "cc", "memory", "r3" \ + ); \ + _zzq_orig->nraddr = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R4 */ \ + "orr r12, r12, r12\n\t" + +#endif /* PLAT_arm_linux */ + +/* ------------------------ ppc32-aix5 ------------------------- */ + +#if defined(PLAT_ppc32_aix5) + +typedef + struct { + unsigned int nraddr; /* where's the code? */ + unsigned int r2; /* what tocptr do we need? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rlwinm 0,0,3,0,0 ; rlwinm 0,0,13,0,0\n\t" \ + "rlwinm 0,0,29,0,0 ; rlwinm 0,0,19,0,0\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + { unsigned int _zzq_args[7]; \ + register unsigned int _zzq_result; \ + register unsigned int* _zzq_ptr; \ + _zzq_args[0] = (unsigned int)(_zzq_request); \ + _zzq_args[1] = (unsigned int)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int)(_zzq_arg5); \ + _zzq_args[6] = (unsigned int)(_zzq_default); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile("mr 4,%1\n\t" \ + "lwz 3, 24(4)\n\t" \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1\n\t" \ + "mr %0,3" \ + : "=b" (_zzq_result) \ + : "b" (_zzq_ptr) \ + : "r3", "r4", "cc", "memory"); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + register unsigned int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "r3", "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR_GPR2 */ \ + "or 4,4,4\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "r3", "cc", "memory" \ + ); \ + _zzq_orig->r2 = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R11 */ \ + "or 3,3,3\n\t" + +#endif /* PLAT_ppc32_aix5 */ + +/* ------------------------ ppc64-aix5 ------------------------- */ + +#if defined(PLAT_ppc64_aix5) + +typedef + struct { + unsigned long long int nraddr; /* where's the code? */ + unsigned long long int r2; /* what tocptr do we need? */ + } + OrigFn; + +#define __SPECIAL_INSTRUCTION_PREAMBLE \ + "rotldi 0,0,3 ; rotldi 0,0,13\n\t" \ + "rotldi 0,0,61 ; rotldi 0,0,51\n\t" + +#define VALGRIND_DO_CLIENT_REQUEST( \ + _zzq_rlval, _zzq_default, _zzq_request, \ + _zzq_arg1, _zzq_arg2, _zzq_arg3, _zzq_arg4, _zzq_arg5) \ + \ + { unsigned long long int _zzq_args[7]; \ + register unsigned long long int _zzq_result; \ + register unsigned long long int* _zzq_ptr; \ + _zzq_args[0] = (unsigned int long long)(_zzq_request); \ + _zzq_args[1] = (unsigned int long long)(_zzq_arg1); \ + _zzq_args[2] = (unsigned int long long)(_zzq_arg2); \ + _zzq_args[3] = (unsigned int long long)(_zzq_arg3); \ + _zzq_args[4] = (unsigned int long long)(_zzq_arg4); \ + _zzq_args[5] = (unsigned int long long)(_zzq_arg5); \ + _zzq_args[6] = (unsigned int long long)(_zzq_default); \ + _zzq_ptr = _zzq_args; \ + __asm__ volatile("mr 4,%1\n\t" \ + "ld 3, 48(4)\n\t" \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = client_request ( %R4 ) */ \ + "or 1,1,1\n\t" \ + "mr %0,3" \ + : "=b" (_zzq_result) \ + : "b" (_zzq_ptr) \ + : "r3", "r4", "cc", "memory"); \ + _zzq_rlval = _zzq_result; \ + } + +#define VALGRIND_GET_NR_CONTEXT(_zzq_rlval) \ + { volatile OrigFn* _zzq_orig = &(_zzq_rlval); \ + register unsigned long long int __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR */ \ + "or 2,2,2\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "r3", "cc", "memory" \ + ); \ + _zzq_orig->nraddr = __addr; \ + __asm__ volatile(__SPECIAL_INSTRUCTION_PREAMBLE \ + /* %R3 = guest_NRADDR_GPR2 */ \ + "or 4,4,4\n\t" \ + "mr %0,3" \ + : "=b" (__addr) \ + : \ + : "r3", "cc", "memory" \ + ); \ + _zzq_orig->r2 = __addr; \ + } + +#define VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + __SPECIAL_INSTRUCTION_PREAMBLE \ + /* branch-and-link-to-noredir *%R11 */ \ + "or 3,3,3\n\t" + +#endif /* PLAT_ppc64_aix5 */ + +/* Insert assembly code for other platforms here... */ + +#endif /* NVALGRIND */ + + +/* ------------------------------------------------------------------ */ +/* PLATFORM SPECIFICS for FUNCTION WRAPPING. This is all very */ +/* ugly. It's the least-worst tradeoff I can think of. */ +/* ------------------------------------------------------------------ */ + +/* This section defines magic (a.k.a appalling-hack) macros for doing + guaranteed-no-redirection macros, so as to get from function + wrappers to the functions they are wrapping. The whole point is to + construct standard call sequences, but to do the call itself with a + special no-redirect call pseudo-instruction that the JIT + understands and handles specially. This section is long and + repetitious, and I can't see a way to make it shorter. + + The naming scheme is as follows: + + CALL_FN_{W,v}_{v,W,WW,WWW,WWWW,5W,6W,7W,etc} + + 'W' stands for "word" and 'v' for "void". Hence there are + different macros for calling arity 0, 1, 2, 3, 4, etc, functions, + and for each, the possibility of returning a word-typed result, or + no result. +*/ + +/* Use these to write the name of your wrapper. NOTE: duplicates + VG_WRAP_FUNCTION_Z{U,Z} in pub_tool_redir.h. */ + +/* Use an extra level of macroisation so as to ensure the soname/fnname + args are fully macro-expanded before pasting them together. */ +#define VG_CONCAT4(_aa,_bb,_cc,_dd) _aa##_bb##_cc##_dd + +#define I_WRAP_SONAME_FNNAME_ZU(soname,fnname) \ + VG_CONCAT4(_vgwZU_,soname,_,fnname) + +#define I_WRAP_SONAME_FNNAME_ZZ(soname,fnname) \ + VG_CONCAT4(_vgwZZ_,soname,_,fnname) + +/* Use this macro from within a wrapper function to collect the + context (address and possibly other info) of the original function. + Once you have that you can then use it in one of the CALL_FN_ + macros. The type of the argument _lval is OrigFn. */ +#define VALGRIND_GET_ORIG_FN(_lval) VALGRIND_GET_NR_CONTEXT(_lval) + +/* Derivatives of the main macros below, for calling functions + returning void. */ + +#define CALL_FN_v_v(fnptr) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_v(_junk,fnptr); } while (0) + +#define CALL_FN_v_W(fnptr, arg1) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_W(_junk,fnptr,arg1); } while (0) + +#define CALL_FN_v_WW(fnptr, arg1,arg2) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_WW(_junk,fnptr,arg1,arg2); } while (0) + +#define CALL_FN_v_WWW(fnptr, arg1,arg2,arg3) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_WWW(_junk,fnptr,arg1,arg2,arg3); } while (0) + +#define CALL_FN_v_WWWW(fnptr, arg1,arg2,arg3,arg4) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_WWWW(_junk,fnptr,arg1,arg2,arg3,arg4); } while (0) + +#define CALL_FN_v_5W(fnptr, arg1,arg2,arg3,arg4,arg5) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_5W(_junk,fnptr,arg1,arg2,arg3,arg4,arg5); } while (0) + +#define CALL_FN_v_6W(fnptr, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_6W(_junk,fnptr,arg1,arg2,arg3,arg4,arg5,arg6); } while (0) + +#define CALL_FN_v_7W(fnptr, arg1,arg2,arg3,arg4,arg5,arg6,arg7) \ + do { volatile unsigned long _junk; \ + CALL_FN_W_7W(_junk,fnptr,arg1,arg2,arg3,arg4,arg5,arg6,arg7); } while (0) + +/* ------------------------- x86-{linux,darwin} ---------------- */ + +#if defined(PLAT_x86_linux) || defined(PLAT_x86_darwin) + +/* These regs are trashed by the hidden call. No need to mention eax + as gcc can already see that, plus causes gcc to bomb. */ +#define __CALLER_SAVED_REGS /*"eax"*/ "ecx", "edx" + +/* These CALL_FN_ macros assume that on x86-linux, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $4, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $8, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $12, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $16, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $20, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $24, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $28, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $32, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $36, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + "pushl 40(%%eax)\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $40, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + "pushl 44(%%eax)\n\t" \ + "pushl 40(%%eax)\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $44, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + "pushl 48(%%eax)\n\t" \ + "pushl 44(%%eax)\n\t" \ + "pushl 40(%%eax)\n\t" \ + "pushl 36(%%eax)\n\t" \ + "pushl 32(%%eax)\n\t" \ + "pushl 28(%%eax)\n\t" \ + "pushl 24(%%eax)\n\t" \ + "pushl 20(%%eax)\n\t" \ + "pushl 16(%%eax)\n\t" \ + "pushl 12(%%eax)\n\t" \ + "pushl 8(%%eax)\n\t" \ + "pushl 4(%%eax)\n\t" \ + "movl (%%eax), %%eax\n\t" /* target->%eax */ \ + VALGRIND_CALL_NOREDIR_EAX \ + "addl $48, %%esp\n" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_x86_linux || PLAT_x86_darwin */ + +/* ------------------------ amd64-{linux,darwin} --------------- */ + +#if defined(PLAT_amd64_linux) || defined(PLAT_amd64_darwin) + +/* ARGREGS: rdi rsi rdx rcx r8 r9 (the rest on stack in R-to-L order) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS /*"rax",*/ "rcx", "rdx", "rsi", \ + "rdi", "r8", "r9", "r10", "r11" + +/* These CALL_FN_ macros assume that on amd64-linux, sizeof(unsigned + long) == 8. */ + +/* NB 9 Sept 07. There is a nasty kludge here in all these CALL_FN_ + macros. In order not to trash the stack redzone, we need to drop + %rsp by 128 before the hidden call, and restore afterwards. The + nastyness is that it is only by luck that the stack still appears + to be unwindable during the hidden call - since then the behaviour + of any routine using this macro does not match what the CFI data + says. Sigh. + + Why is this important? Imagine that a wrapper has a stack + allocated local, and passes to the hidden call, a pointer to it. + Because gcc does not know about the hidden call, it may allocate + that local in the redzone. Unfortunately the hidden call may then + trash it before it comes to use it. So we must step clear of the + redzone, for the duration of the hidden call, to make it safe. + + Probably the same problem afflicts the other redzone-style ABIs too + (ppc64-linux, ppc32-aix5, ppc64-aix5); but for those, the stack is + self describing (none of this CFI nonsense) so at least messing + with the stack pointer doesn't give a danger of non-unwindable + stack. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + "addq $128,%%rsp\n\t" \ + VALGRIND_CALL_NOREDIR_RAX \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $8, %%rsp\n" \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $16, %%rsp\n" \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $24, %%rsp\n" \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "pushq 80(%%rax)\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $32, %%rsp\n" \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "pushq 88(%%rax)\n\t" \ + "pushq 80(%%rax)\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $40, %%rsp\n" \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + "subq $128,%%rsp\n\t" \ + "pushq 96(%%rax)\n\t" \ + "pushq 88(%%rax)\n\t" \ + "pushq 80(%%rax)\n\t" \ + "pushq 72(%%rax)\n\t" \ + "pushq 64(%%rax)\n\t" \ + "pushq 56(%%rax)\n\t" \ + "movq 48(%%rax), %%r9\n\t" \ + "movq 40(%%rax), %%r8\n\t" \ + "movq 32(%%rax), %%rcx\n\t" \ + "movq 24(%%rax), %%rdx\n\t" \ + "movq 16(%%rax), %%rsi\n\t" \ + "movq 8(%%rax), %%rdi\n\t" \ + "movq (%%rax), %%rax\n\t" /* target->%rax */ \ + VALGRIND_CALL_NOREDIR_RAX \ + "addq $48, %%rsp\n" \ + "addq $128,%%rsp\n\t" \ + : /*out*/ "=a" (_res) \ + : /*in*/ "a" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_amd64_linux || PLAT_amd64_darwin */ + +/* ------------------------ ppc32-linux ------------------------ */ + +#if defined(PLAT_ppc32_linux) + +/* This is useful for finding out about the on-stack stuff: + + extern int f9 ( int,int,int,int,int,int,int,int,int ); + extern int f10 ( int,int,int,int,int,int,int,int,int,int ); + extern int f11 ( int,int,int,int,int,int,int,int,int,int,int ); + extern int f12 ( int,int,int,int,int,int,int,int,int,int,int,int ); + + int g9 ( void ) { + return f9(11,22,33,44,55,66,77,88,99); + } + int g10 ( void ) { + return f10(11,22,33,44,55,66,77,88,99,110); + } + int g11 ( void ) { + return f11(11,22,33,44,55,66,77,88,99,110,121); + } + int g12 ( void ) { + return f12(11,22,33,44,55,66,77,88,99,110,121,132); + } +*/ + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* These CALL_FN_ macros assume that on ppc32-linux, + sizeof(unsigned long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "addi 1,1,-16\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "addi 1,1,16\n\t" \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "addi 1,1,-16\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,12(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "addi 1,1,16\n\t" \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + _argvec[11] = (unsigned long)arg11; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "addi 1,1,-32\n\t" \ + /* arg11 */ \ + "lwz 3,44(11)\n\t" \ + "stw 3,16(1)\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,12(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "addi 1,1,32\n\t" \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)arg1; \ + _argvec[2] = (unsigned long)arg2; \ + _argvec[3] = (unsigned long)arg3; \ + _argvec[4] = (unsigned long)arg4; \ + _argvec[5] = (unsigned long)arg5; \ + _argvec[6] = (unsigned long)arg6; \ + _argvec[7] = (unsigned long)arg7; \ + _argvec[8] = (unsigned long)arg8; \ + _argvec[9] = (unsigned long)arg9; \ + _argvec[10] = (unsigned long)arg10; \ + _argvec[11] = (unsigned long)arg11; \ + _argvec[12] = (unsigned long)arg12; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "addi 1,1,-32\n\t" \ + /* arg12 */ \ + "lwz 3,48(11)\n\t" \ + "stw 3,20(1)\n\t" \ + /* arg11 */ \ + "lwz 3,44(11)\n\t" \ + "stw 3,16(1)\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,12(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,8(1)\n\t" \ + /* args1-8 */ \ + "lwz 3,4(11)\n\t" /* arg1->r3 */ \ + "lwz 4,8(11)\n\t" \ + "lwz 5,12(11)\n\t" \ + "lwz 6,16(11)\n\t" /* arg4->r6 */ \ + "lwz 7,20(11)\n\t" \ + "lwz 8,24(11)\n\t" \ + "lwz 9,28(11)\n\t" \ + "lwz 10,32(11)\n\t" /* arg8->r10 */ \ + "lwz 11,0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "addi 1,1,32\n\t" \ + "mr %0,3" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc32_linux */ + +/* ------------------------ ppc64-linux ------------------------ */ + +#if defined(PLAT_ppc64_linux) + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* These CALL_FN_ macros assume that on ppc64-linux, sizeof(unsigned + long) == 8. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+0]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+1]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+2]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+3]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+4]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+5]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+6]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+7]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+8]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)" /* restore tocptr */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+9]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-128\n\t" /* expand stack frame */ \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + "addi 1,1,128" /* restore frame */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+10]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-128\n\t" /* expand stack frame */ \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + "addi 1,1,128" /* restore frame */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+11]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-144\n\t" /* expand stack frame */ \ + /* arg11 */ \ + "ld 3,88(11)\n\t" \ + "std 3,128(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + "addi 1,1,144" /* restore frame */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+12]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + _argvec[2+12] = (unsigned long)arg12; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "addi 1,1,-144\n\t" /* expand stack frame */ \ + /* arg12 */ \ + "ld 3,96(11)\n\t" \ + "std 3,136(1)\n\t" \ + /* arg11 */ \ + "ld 3,88(11)\n\t" \ + "std 3,128(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + "addi 1,1,144" /* restore frame */ \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc64_linux */ + +/* ------------------------- arm-linux ------------------------- */ + +#if defined(PLAT_arm_linux) + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS "r0", "r1", "r2", "r3","r4","r14" + +/* These CALL_FN_ macros assume that on arm-linux, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[1]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[2]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + __asm__ volatile( \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + __asm__ volatile( \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[4]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + __asm__ volatile( \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "mov %0, r0\n" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[5]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + __asm__ volatile( \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[6]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + __asm__ volatile( \ + "ldr r0, [%1, #20] \n\t" \ + "push {r0} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #4 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[7]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + __asm__ volatile( \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "push {r0, r1} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #8 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[8]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + __asm__ volatile( \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "push {r0, r1, r2} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #12 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[9]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + __asm__ volatile( \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "push {r0, r1, r2, r3} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #16 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[10]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + __asm__ volatile( \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #20 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[11]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + __asm__ volatile( \ + "ldr r0, [%1, #40] \n\t" \ + "push {r0} \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #24 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[12]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + __asm__ volatile( \ + "ldr r0, [%1, #40] \n\t" \ + "ldr r1, [%1, #44] \n\t" \ + "push {r0, r1} \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #28 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory",__CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5, \ + arg6,arg7,arg8,arg9,arg10, \ + arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[13]; \ + volatile unsigned long _res; \ + _argvec[0] = (unsigned long)_orig.nraddr; \ + _argvec[1] = (unsigned long)(arg1); \ + _argvec[2] = (unsigned long)(arg2); \ + _argvec[3] = (unsigned long)(arg3); \ + _argvec[4] = (unsigned long)(arg4); \ + _argvec[5] = (unsigned long)(arg5); \ + _argvec[6] = (unsigned long)(arg6); \ + _argvec[7] = (unsigned long)(arg7); \ + _argvec[8] = (unsigned long)(arg8); \ + _argvec[9] = (unsigned long)(arg9); \ + _argvec[10] = (unsigned long)(arg10); \ + _argvec[11] = (unsigned long)(arg11); \ + _argvec[12] = (unsigned long)(arg12); \ + __asm__ volatile( \ + "ldr r0, [%1, #40] \n\t" \ + "ldr r1, [%1, #44] \n\t" \ + "ldr r2, [%1, #48] \n\t" \ + "push {r0, r1, r2} \n\t" \ + "ldr r0, [%1, #20] \n\t" \ + "ldr r1, [%1, #24] \n\t" \ + "ldr r2, [%1, #28] \n\t" \ + "ldr r3, [%1, #32] \n\t" \ + "ldr r4, [%1, #36] \n\t" \ + "push {r0, r1, r2, r3, r4} \n\t" \ + "ldr r0, [%1, #4] \n\t" \ + "ldr r1, [%1, #8] \n\t" \ + "ldr r2, [%1, #12] \n\t" \ + "ldr r3, [%1, #16] \n\t" \ + "ldr r4, [%1] \n\t" /* target->r4 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R4 \ + "add sp, sp, #32 \n\t" \ + "mov %0, r0" \ + : /*out*/ "=r" (_res) \ + : /*in*/ "0" (&_argvec[0]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_arm_linux */ + +/* ------------------------ ppc32-aix5 ------------------------- */ + +#if defined(PLAT_ppc32_aix5) + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* Expand the stack frame, copying enough info that unwinding + still works. Trashes r3. */ + +#define VG_EXPAND_FRAME_BY_trashes_r3(_n_fr) \ + "addi 1,1,-" #_n_fr "\n\t" \ + "lwz 3," #_n_fr "(1)\n\t" \ + "stw 3,0(1)\n\t" + +#define VG_CONTRACT_FRAME_BY(_n_fr) \ + "addi 1,1," #_n_fr "\n\t" + +/* These CALL_FN_ macros assume that on ppc32-aix5, sizeof(unsigned + long) == 4. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+0]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+1]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+2]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+3]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+4]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+5]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+6]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+7]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 9, 28(11)\n\t" /* arg7->r9 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+8]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 9, 28(11)\n\t" /* arg7->r9 */ \ + "lwz 10, 32(11)\n\t" /* arg8->r10 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+9]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(64) \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,56(1)\n\t" \ + /* args1-8 */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 9, 28(11)\n\t" /* arg7->r9 */ \ + "lwz 10, 32(11)\n\t" /* arg8->r10 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(64) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+10]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(64) \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,60(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,56(1)\n\t" \ + /* args1-8 */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 9, 28(11)\n\t" /* arg7->r9 */ \ + "lwz 10, 32(11)\n\t" /* arg8->r10 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(64) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+11]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(72) \ + /* arg11 */ \ + "lwz 3,44(11)\n\t" \ + "stw 3,64(1)\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,60(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,56(1)\n\t" \ + /* args1-8 */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 9, 28(11)\n\t" /* arg7->r9 */ \ + "lwz 10, 32(11)\n\t" /* arg8->r10 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(72) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+12]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + _argvec[2+12] = (unsigned long)arg12; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "stw 2,-8(11)\n\t" /* save tocptr */ \ + "lwz 2,-4(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(72) \ + /* arg12 */ \ + "lwz 3,48(11)\n\t" \ + "stw 3,68(1)\n\t" \ + /* arg11 */ \ + "lwz 3,44(11)\n\t" \ + "stw 3,64(1)\n\t" \ + /* arg10 */ \ + "lwz 3,40(11)\n\t" \ + "stw 3,60(1)\n\t" \ + /* arg9 */ \ + "lwz 3,36(11)\n\t" \ + "stw 3,56(1)\n\t" \ + /* args1-8 */ \ + "lwz 3, 4(11)\n\t" /* arg1->r3 */ \ + "lwz 4, 8(11)\n\t" /* arg2->r4 */ \ + "lwz 5, 12(11)\n\t" /* arg3->r5 */ \ + "lwz 6, 16(11)\n\t" /* arg4->r6 */ \ + "lwz 7, 20(11)\n\t" /* arg5->r7 */ \ + "lwz 8, 24(11)\n\t" /* arg6->r8 */ \ + "lwz 9, 28(11)\n\t" /* arg7->r9 */ \ + "lwz 10, 32(11)\n\t" /* arg8->r10 */ \ + "lwz 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "lwz 2,-8(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(72) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc32_aix5 */ + +/* ------------------------ ppc64-aix5 ------------------------- */ + +#if defined(PLAT_ppc64_aix5) + +/* ARGREGS: r3 r4 r5 r6 r7 r8 r9 r10 (the rest on stack somewhere) */ + +/* These regs are trashed by the hidden call. */ +#define __CALLER_SAVED_REGS \ + "lr", "ctr", "xer", \ + "cr0", "cr1", "cr2", "cr3", "cr4", "cr5", "cr6", "cr7", \ + "r0", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", \ + "r11", "r12", "r13" + +/* Expand the stack frame, copying enough info that unwinding + still works. Trashes r3. */ + +#define VG_EXPAND_FRAME_BY_trashes_r3(_n_fr) \ + "addi 1,1,-" #_n_fr "\n\t" \ + "ld 3," #_n_fr "(1)\n\t" \ + "std 3,0(1)\n\t" + +#define VG_CONTRACT_FRAME_BY(_n_fr) \ + "addi 1,1," #_n_fr "\n\t" + +/* These CALL_FN_ macros assume that on ppc64-aix5, sizeof(unsigned + long) == 8. */ + +#define CALL_FN_W_v(lval, orig) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+0]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_W(lval, orig, arg1) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+1]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WW(lval, orig, arg1,arg2) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+2]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWW(lval, orig, arg1,arg2,arg3) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+3]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_WWWW(lval, orig, arg1,arg2,arg3,arg4) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+4]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_5W(lval, orig, arg1,arg2,arg3,arg4,arg5) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+5]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_6W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+6]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_7W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+7]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_8W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+8]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_9W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+9]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(128) \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(128) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_10W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+10]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(128) \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(128) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_11W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+11]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(144) \ + /* arg11 */ \ + "ld 3,88(11)\n\t" \ + "std 3,128(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(144) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#define CALL_FN_W_12W(lval, orig, arg1,arg2,arg3,arg4,arg5,arg6, \ + arg7,arg8,arg9,arg10,arg11,arg12) \ + do { \ + volatile OrigFn _orig = (orig); \ + volatile unsigned long _argvec[3+12]; \ + volatile unsigned long _res; \ + /* _argvec[0] holds current r2 across the call */ \ + _argvec[1] = (unsigned long)_orig.r2; \ + _argvec[2] = (unsigned long)_orig.nraddr; \ + _argvec[2+1] = (unsigned long)arg1; \ + _argvec[2+2] = (unsigned long)arg2; \ + _argvec[2+3] = (unsigned long)arg3; \ + _argvec[2+4] = (unsigned long)arg4; \ + _argvec[2+5] = (unsigned long)arg5; \ + _argvec[2+6] = (unsigned long)arg6; \ + _argvec[2+7] = (unsigned long)arg7; \ + _argvec[2+8] = (unsigned long)arg8; \ + _argvec[2+9] = (unsigned long)arg9; \ + _argvec[2+10] = (unsigned long)arg10; \ + _argvec[2+11] = (unsigned long)arg11; \ + _argvec[2+12] = (unsigned long)arg12; \ + __asm__ volatile( \ + "mr 11,%1\n\t" \ + VG_EXPAND_FRAME_BY_trashes_r3(512) \ + "std 2,-16(11)\n\t" /* save tocptr */ \ + "ld 2,-8(11)\n\t" /* use nraddr's tocptr */ \ + VG_EXPAND_FRAME_BY_trashes_r3(144) \ + /* arg12 */ \ + "ld 3,96(11)\n\t" \ + "std 3,136(1)\n\t" \ + /* arg11 */ \ + "ld 3,88(11)\n\t" \ + "std 3,128(1)\n\t" \ + /* arg10 */ \ + "ld 3,80(11)\n\t" \ + "std 3,120(1)\n\t" \ + /* arg9 */ \ + "ld 3,72(11)\n\t" \ + "std 3,112(1)\n\t" \ + /* args1-8 */ \ + "ld 3, 8(11)\n\t" /* arg1->r3 */ \ + "ld 4, 16(11)\n\t" /* arg2->r4 */ \ + "ld 5, 24(11)\n\t" /* arg3->r5 */ \ + "ld 6, 32(11)\n\t" /* arg4->r6 */ \ + "ld 7, 40(11)\n\t" /* arg5->r7 */ \ + "ld 8, 48(11)\n\t" /* arg6->r8 */ \ + "ld 9, 56(11)\n\t" /* arg7->r9 */ \ + "ld 10, 64(11)\n\t" /* arg8->r10 */ \ + "ld 11, 0(11)\n\t" /* target->r11 */ \ + VALGRIND_BRANCH_AND_LINK_TO_NOREDIR_R11 \ + "mr 11,%1\n\t" \ + "mr %0,3\n\t" \ + "ld 2,-16(11)\n\t" /* restore tocptr */ \ + VG_CONTRACT_FRAME_BY(144) \ + VG_CONTRACT_FRAME_BY(512) \ + : /*out*/ "=r" (_res) \ + : /*in*/ "r" (&_argvec[2]) \ + : /*trash*/ "cc", "memory", __CALLER_SAVED_REGS \ + ); \ + lval = (__typeof__(lval)) _res; \ + } while (0) + +#endif /* PLAT_ppc64_aix5 */ + + +/* ------------------------------------------------------------------ */ +/* ARCHITECTURE INDEPENDENT MACROS for CLIENT REQUESTS. */ +/* */ +/* ------------------------------------------------------------------ */ + +/* Some request codes. There are many more of these, but most are not + exposed to end-user view. These are the public ones, all of the + form 0x1000 + small_number. + + Core ones are in the range 0x00000000--0x0000ffff. The non-public + ones start at 0x2000. +*/ + +/* These macros are used by tools -- they must be public, but don't + embed them into other programs. */ +#define VG_USERREQ_TOOL_BASE(a,b) \ + ((unsigned int)(((a)&0xff) << 24 | ((b)&0xff) << 16)) +#define VG_IS_TOOL_USERREQ(a, b, v) \ + (VG_USERREQ_TOOL_BASE(a,b) == ((v) & 0xffff0000)) + +/* !! ABIWARNING !! ABIWARNING !! ABIWARNING !! ABIWARNING !! + This enum comprises an ABI exported by Valgrind to programs + which use client requests. DO NOT CHANGE THE ORDER OF THESE + ENTRIES, NOR DELETE ANY -- add new ones at the end. */ +typedef + enum { VG_USERREQ__RUNNING_ON_VALGRIND = 0x1001, + VG_USERREQ__DISCARD_TRANSLATIONS = 0x1002, + + /* These allow any function to be called from the simulated + CPU but run on the real CPU. Nb: the first arg passed to + the function is always the ThreadId of the running + thread! So CLIENT_CALL0 actually requires a 1 arg + function, etc. */ + VG_USERREQ__CLIENT_CALL0 = 0x1101, + VG_USERREQ__CLIENT_CALL1 = 0x1102, + VG_USERREQ__CLIENT_CALL2 = 0x1103, + VG_USERREQ__CLIENT_CALL3 = 0x1104, + + /* Can be useful in regression testing suites -- eg. can + send Valgrind's output to /dev/null and still count + errors. */ + VG_USERREQ__COUNT_ERRORS = 0x1201, + + /* These are useful and can be interpreted by any tool that + tracks malloc() et al, by using vg_replace_malloc.c. */ + VG_USERREQ__MALLOCLIKE_BLOCK = 0x1301, + VG_USERREQ__FREELIKE_BLOCK = 0x1302, + /* Memory pool support. */ + VG_USERREQ__CREATE_MEMPOOL = 0x1303, + VG_USERREQ__DESTROY_MEMPOOL = 0x1304, + VG_USERREQ__MEMPOOL_ALLOC = 0x1305, + VG_USERREQ__MEMPOOL_FREE = 0x1306, + VG_USERREQ__MEMPOOL_TRIM = 0x1307, + VG_USERREQ__MOVE_MEMPOOL = 0x1308, + VG_USERREQ__MEMPOOL_CHANGE = 0x1309, + VG_USERREQ__MEMPOOL_EXISTS = 0x130a, + + /* Allow printfs to valgrind log. */ + /* The first two pass the va_list argument by value, which + assumes it is the same size as or smaller than a UWord, + which generally isn't the case. Hence are deprecated. + The second two pass the vargs by reference and so are + immune to this problem. */ + /* both :: char* fmt, va_list vargs (DEPRECATED) */ + VG_USERREQ__PRINTF = 0x1401, + VG_USERREQ__PRINTF_BACKTRACE = 0x1402, + /* both :: char* fmt, va_list* vargs */ + VG_USERREQ__PRINTF_VALIST_BY_REF = 0x1403, + VG_USERREQ__PRINTF_BACKTRACE_VALIST_BY_REF = 0x1404, + + /* Stack support. */ + VG_USERREQ__STACK_REGISTER = 0x1501, + VG_USERREQ__STACK_DEREGISTER = 0x1502, + VG_USERREQ__STACK_CHANGE = 0x1503, + + /* Wine support */ + VG_USERREQ__LOAD_PDB_DEBUGINFO = 0x1601 + } Vg_ClientRequest; + +#if !defined(__GNUC__) +# define __extension__ /* */ +#endif + +/* Returns the number of Valgrinds this code is running under. That + is, 0 if running natively, 1 if running under Valgrind, 2 if + running under Valgrind which is running under another Valgrind, + etc. */ +#define RUNNING_ON_VALGRIND __extension__ \ + ({unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* if not */, \ + VG_USERREQ__RUNNING_ON_VALGRIND, \ + 0, 0, 0, 0, 0); \ + _qzz_res; \ + }) + + +/* Discard translation of code in the range [_qzz_addr .. _qzz_addr + + _qzz_len - 1]. Useful if you are debugging a JITter or some such, + since it provides a way to make sure valgrind will retranslate the + invalidated area. Returns no value. */ +#define VALGRIND_DISCARD_TRANSLATIONS(_qzz_addr,_qzz_len) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__DISCARD_TRANSLATIONS, \ + _qzz_addr, _qzz_len, 0, 0, 0); \ + } + + +/* These requests are for getting Valgrind itself to print something. + Possibly with a backtrace. This is a really ugly hack. The return value + is the number of characters printed, excluding the "**** " part at the + start and the backtrace (if present). */ + +#if defined(NVALGRIND) + +# define VALGRIND_PRINTF(...) +# define VALGRIND_PRINTF_BACKTRACE(...) + +#else /* NVALGRIND */ + +/* Modern GCC will optimize the static routine out if unused, + and unused attribute will shut down warnings about it. */ +static int VALGRIND_PRINTF(const char *format, ...) + __attribute__((format(__printf__, 1, 2), __unused__)); +static int +VALGRIND_PRINTF(const char *format, ...) +{ + unsigned long _qzz_res; + va_list vargs; + va_start(vargs, format); + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, + VG_USERREQ__PRINTF_VALIST_BY_REF, + (unsigned long)format, + (unsigned long)&vargs, + 0, 0, 0); + va_end(vargs); + return (int)_qzz_res; +} + +static int VALGRIND_PRINTF_BACKTRACE(const char *format, ...) + __attribute__((format(__printf__, 1, 2), __unused__)); +static int +VALGRIND_PRINTF_BACKTRACE(const char *format, ...) +{ + unsigned long _qzz_res; + va_list vargs; + va_start(vargs, format); + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, + VG_USERREQ__PRINTF_BACKTRACE_VALIST_BY_REF, + (unsigned long)format, + (unsigned long)&vargs, + 0, 0, 0); + va_end(vargs); + return (int)_qzz_res; +} + +#endif /* NVALGRIND */ + + +/* These requests allow control to move from the simulated CPU to the + real CPU, calling an arbitary function. + + Note that the current ThreadId is inserted as the first argument. + So this call: + + VALGRIND_NON_SIMD_CALL2(f, arg1, arg2) + + requires f to have this signature: + + Word f(Word tid, Word arg1, Word arg2) + + where "Word" is a word-sized type. + + Note that these client requests are not entirely reliable. For example, + if you call a function with them that subsequently calls printf(), + there's a high chance Valgrind will crash. Generally, your prospects of + these working are made higher if the called function does not refer to + any global variables, and does not refer to any libc or other functions + (printf et al). Any kind of entanglement with libc or dynamic linking is + likely to have a bad outcome, for tricky reasons which we've grappled + with a lot in the past. +*/ +#define VALGRIND_NON_SIMD_CALL0(_qyy_fn) \ + __extension__ \ + ({unsigned long _qyy_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qyy_res, 0 /* default return */, \ + VG_USERREQ__CLIENT_CALL0, \ + _qyy_fn, \ + 0, 0, 0, 0); \ + _qyy_res; \ + }) + +#define VALGRIND_NON_SIMD_CALL1(_qyy_fn, _qyy_arg1) \ + __extension__ \ + ({unsigned long _qyy_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qyy_res, 0 /* default return */, \ + VG_USERREQ__CLIENT_CALL1, \ + _qyy_fn, \ + _qyy_arg1, 0, 0, 0); \ + _qyy_res; \ + }) + +#define VALGRIND_NON_SIMD_CALL2(_qyy_fn, _qyy_arg1, _qyy_arg2) \ + __extension__ \ + ({unsigned long _qyy_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qyy_res, 0 /* default return */, \ + VG_USERREQ__CLIENT_CALL2, \ + _qyy_fn, \ + _qyy_arg1, _qyy_arg2, 0, 0); \ + _qyy_res; \ + }) + +#define VALGRIND_NON_SIMD_CALL3(_qyy_fn, _qyy_arg1, _qyy_arg2, _qyy_arg3) \ + __extension__ \ + ({unsigned long _qyy_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qyy_res, 0 /* default return */, \ + VG_USERREQ__CLIENT_CALL3, \ + _qyy_fn, \ + _qyy_arg1, _qyy_arg2, \ + _qyy_arg3, 0); \ + _qyy_res; \ + }) + + +/* Counts the number of errors that have been recorded by a tool. Nb: + the tool must record the errors with VG_(maybe_record_error)() or + VG_(unique_error)() for them to be counted. */ +#define VALGRIND_COUNT_ERRORS \ + __extension__ \ + ({unsigned int _qyy_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qyy_res, 0 /* default return */, \ + VG_USERREQ__COUNT_ERRORS, \ + 0, 0, 0, 0, 0); \ + _qyy_res; \ + }) + +/* Several Valgrind tools (Memcheck, Massif, Helgrind, DRD) rely on knowing + when heap blocks are allocated in order to give accurate results. This + happens automatically for the standard allocator functions such as + malloc(), calloc(), realloc(), memalign(), new, new[], free(), delete, + delete[], etc. + + But if your program uses a custom allocator, this doesn't automatically + happen, and Valgrind will not do as well. For example, if you allocate + superblocks with mmap() and then allocates chunks of the superblocks, all + Valgrind's observations will be at the mmap() level and it won't know that + the chunks should be considered separate entities. In Memcheck's case, + that means you probably won't get heap block overrun detection (because + there won't be redzones marked as unaddressable) and you definitely won't + get any leak detection. + + The following client requests allow a custom allocator to be annotated so + that it can be handled accurately by Valgrind. + + VALGRIND_MALLOCLIKE_BLOCK marks a region of memory as having been allocated + by a malloc()-like function. For Memcheck (an illustrative case), this + does two things: + + - It records that the block has been allocated. This means any addresses + within the block mentioned in error messages will be + identified as belonging to the block. It also means that if the block + isn't freed it will be detected by the leak checker. + + - It marks the block as being addressable and undefined (if 'is_zeroed' is + not set), or addressable and defined (if 'is_zeroed' is set). This + controls how accesses to the block by the program are handled. + + 'addr' is the start of the usable block (ie. after any + redzone), 'sizeB' is its size. 'rzB' is the redzone size if the allocator + can apply redzones -- these are blocks of padding at the start and end of + each block. Adding redzones is recommended as it makes it much more likely + Valgrind will spot block overruns. `is_zeroed' indicates if the memory is + zeroed (or filled with another predictable value), as is the case for + calloc(). + + VALGRIND_MALLOCLIKE_BLOCK should be put immediately after the point where a + heap block -- that will be used by the client program -- is allocated. + It's best to put it at the outermost level of the allocator if possible; + for example, if you have a function my_alloc() which calls + internal_alloc(), and the client request is put inside internal_alloc(), + stack traces relating to the heap block will contain entries for both + my_alloc() and internal_alloc(), which is probably not what you want. + + For Memcheck users: if you use VALGRIND_MALLOCLIKE_BLOCK to carve out + custom blocks from within a heap block, B, that has been allocated with + malloc/calloc/new/etc, then block B will be *ignored* during leak-checking + -- the custom blocks will take precedence. + + VALGRIND_FREELIKE_BLOCK is the partner to VALGRIND_MALLOCLIKE_BLOCK. For + Memcheck, it does two things: + + - It records that the block has been deallocated. This assumes that the + block was annotated as having been allocated via + VALGRIND_MALLOCLIKE_BLOCK. Otherwise, an error will be issued. + + - It marks the block as being unaddressable. + + VALGRIND_FREELIKE_BLOCK should be put immediately after the point where a + heap block is deallocated. + + In many cases, these two client requests will not be enough to get your + allocator working well with Memcheck. More specifically, if your allocator + writes to freed blocks in any way then a VALGRIND_MAKE_MEM_UNDEFINED call + will be necessary to mark the memory as addressable just before the zeroing + occurs, otherwise you'll get a lot of invalid write errors. For example, + you'll need to do this if your allocator recycles freed blocks, but it + zeroes them before handing them back out (via VALGRIND_MALLOCLIKE_BLOCK). + Alternatively, if your allocator reuses freed blocks for allocator-internal + data structures, VALGRIND_MAKE_MEM_UNDEFINED calls will also be necessary. + + Really, what's happening is a blurring of the lines between the client + program and the allocator... after VALGRIND_FREELIKE_BLOCK is called, the + memory should be considered unaddressable to the client program, but the + allocator knows more than the rest of the client program and so may be able + to safely access it. Extra client requests are necessary for Valgrind to + understand the distinction between the allocator and the rest of the + program. + + Note: there is currently no VALGRIND_REALLOCLIKE_BLOCK client request; it + has to be emulated with MALLOCLIKE/FREELIKE and memory copying. + + Ignored if addr == 0. +*/ +#define VALGRIND_MALLOCLIKE_BLOCK(addr, sizeB, rzB, is_zeroed) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MALLOCLIKE_BLOCK, \ + addr, sizeB, rzB, is_zeroed, 0); \ + } + +/* See the comment for VALGRIND_MALLOCLIKE_BLOCK for details. + Ignored if addr == 0. +*/ +#define VALGRIND_FREELIKE_BLOCK(addr, rzB) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__FREELIKE_BLOCK, \ + addr, rzB, 0, 0, 0); \ + } + +/* Create a memory pool. */ +#define VALGRIND_CREATE_MEMPOOL(pool, rzB, is_zeroed) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__CREATE_MEMPOOL, \ + pool, rzB, is_zeroed, 0, 0); \ + } + +/* Destroy a memory pool. */ +#define VALGRIND_DESTROY_MEMPOOL(pool) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__DESTROY_MEMPOOL, \ + pool, 0, 0, 0, 0); \ + } + +/* Associate a piece of memory with a memory pool. */ +#define VALGRIND_MEMPOOL_ALLOC(pool, addr, size) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MEMPOOL_ALLOC, \ + pool, addr, size, 0, 0); \ + } + +/* Disassociate a piece of memory from a memory pool. */ +#define VALGRIND_MEMPOOL_FREE(pool, addr) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MEMPOOL_FREE, \ + pool, addr, 0, 0, 0); \ + } + +/* Disassociate any pieces outside a particular range. */ +#define VALGRIND_MEMPOOL_TRIM(pool, addr, size) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MEMPOOL_TRIM, \ + pool, addr, size, 0, 0); \ + } + +/* Resize and/or move a piece associated with a memory pool. */ +#define VALGRIND_MOVE_MEMPOOL(poolA, poolB) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MOVE_MEMPOOL, \ + poolA, poolB, 0, 0, 0); \ + } + +/* Resize and/or move a piece associated with a memory pool. */ +#define VALGRIND_MEMPOOL_CHANGE(pool, addrA, addrB, size) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MEMPOOL_CHANGE, \ + pool, addrA, addrB, size, 0); \ + } + +/* Return 1 if a mempool exists, else 0. */ +#define VALGRIND_MEMPOOL_EXISTS(pool) \ + __extension__ \ + ({unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__MEMPOOL_EXISTS, \ + pool, 0, 0, 0, 0); \ + _qzz_res; \ + }) + +/* Mark a piece of memory as being a stack. Returns a stack id. */ +#define VALGRIND_STACK_REGISTER(start, end) \ + __extension__ \ + ({unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__STACK_REGISTER, \ + start, end, 0, 0, 0); \ + _qzz_res; \ + }) + +/* Unmark the piece of memory associated with a stack id as being a + stack. */ +#define VALGRIND_STACK_DEREGISTER(id) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__STACK_DEREGISTER, \ + id, 0, 0, 0, 0); \ + } + +/* Change the start and end address of the stack id. */ +#define VALGRIND_STACK_CHANGE(id, start, end) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__STACK_CHANGE, \ + id, start, end, 0, 0); \ + } + +/* Load PDB debug info for Wine PE image_map. */ +#define VALGRIND_LOAD_PDB_DEBUGINFO(fd, ptr, total_size, delta) \ + {unsigned int _qzz_res; \ + VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0, \ + VG_USERREQ__LOAD_PDB_DEBUGINFO, \ + fd, ptr, total_size, delta, 0); \ + } + + +#undef PLAT_x86_linux +#undef PLAT_amd64_linux +#undef PLAT_ppc32_linux +#undef PLAT_ppc64_linux +#undef PLAT_arm_linux +#undef PLAT_ppc32_aix5 +#undef PLAT_ppc64_aix5 + +#endif /* __VALGRIND_H */ diff --git a/packages/CLPBN/clpbn/connected.yap b/packages/CLPBN/clpbn/connected.yap index 7b0e90860..276184683 100644 --- a/packages/CLPBN/clpbn/connected.yap +++ b/packages/CLPBN/clpbn/connected.yap @@ -1,172 +1,144 @@ :- module(clpbn_connected, - [clpbn_subgraphs/2, - influences/4, + [influences/3, init_influences/3, - influences/5]). + influences/4]). :- use_module(library(dgraphs), [dgraph_new/1, dgraph_add_edges/3, dgraph_add_vertex/3, dgraph_neighbors/3, - dgraph_edge/3]). + dgraph_edge/3, + dgraph_transpose/2]). :- use_module(library(rbtrees), [rb_new/1, + rb_lookup/3, rb_insert/4, - rb_lookup/3]). + rb_visit/2]). -:- attribute component/1. - -% search for connected components, that is, where we know that A influences B or B influences A. -clpbn_subgraphs(Vs, Gs) :- - mark_components(Vs, Components), - keysort(Components, Ordered), - same_key(Ordered, Gs). - -% ignore variables with evidence, -% the others mark the MB. -mark_components([], []). -mark_components([V|Vs], Components) :- - clpbn:get_atts(V, [evidence(_),dist(_,Parents)]), !, - merge_parents(Parents, _), - mark_components(Vs, Components). -mark_components([V|Vs], [Mark-V|Components]) :- - mark_var(V, Mark), - mark_components(Vs, Components). - -mark_var(V, Mark) :- - get_atts(V, [component(Mark)]), !, - clpbn:get_atts(V, [dist(_,Parents)]), !, - merge_parents(Parents, Mark). -mark_var(V, Mark) :- - clpbn:get_atts(V, [dist(_,Parents)]), !, - put_atts(V,[component(Mark)]), - merge_parents(Parents, Mark). - -merge_parents([], _). -merge_parents([V|Parents], Mark) :- - clpbn:get_atts(V,[evidence(_)]), !, - merge_parents(Parents, Mark). -merge_parents([V|Parents], Mark) :- - get_atts(V,[component(Mark)]), !, - merge_parents(Parents, Mark). -merge_parents([V|Parents], Mark) :- - put_atts(V,[component(Mark)]), - merge_parents(Parents, Mark). - - -same_key([],[]). -same_key([K-El|More],[[El|Els]|Gs]) :- - same_keys(More, K, Els, Rest), - same_key(Rest,Gs). - -same_keys([], _, [], []). -same_keys([K1-El|More], K, [El|Els], Rest) :- - K == K1, !, - same_keys(More, K, Els, Rest). -same_keys(Rest, _, [], Rest). - -influences_more([], _, _, Is, Is, Evs, Evs, V2, V2). -influences_more([V|LV], G, RG, Is0, Is, Evs0, Evs, GV0, GV2) :- - rb_lookup(V, _, GV0), !, - influences_more(LV, G, RG, Is0, Is, Evs0, Evs, GV0, GV2). -influences_more([V|LV], G, RG, Is0, Is, Evs0, Evs, GV0, GV3) :- - rb_insert(GV0, V, _, GV1), - follow_dgraph(V, G, RG, [V|Is0], Is1, [V|Evs0], Evs1, GV1, GV2), - influences_more(LV, G, RG, Is1, Is, Evs1, Evs, GV2, GV3). - -% search for the set of variables that influence V -influences(Vs, LV, Is, Evs) :- +influences(Vs, QVars, LV) :- init_influences(Vs, G, RG), - influences(LV, Is, Evs, G, RG). + influences(QVars, G, RG, LV). init_influences(Vs, G, RG) :- dgraph_new(G0), - dgraph_new(RG0), - to_dgraph(Vs, G0, G, RG0, RG). + to_dgraph(Vs, G0, G), + dgraph_transpose(G, RG). -influences([], [], [], _, _). -influences([V|LV], Is, Evs, G, RG) :- - rb_new(V0), - rb_insert(V0, V, _, V1), - follow_dgraph(V, G, RG, [V], Is1, [V], Evs1, V1, V2), - influences_more(LV, G, RG, Is1, Is, Evs1, Evs, V2, _). +to_dgraph([], G, G). +to_dgraph([V|Vs], G0, G) :- + clpbn:get_atts(V, [dist(_,Parents)]), !, + dgraph_add_vertex(G0, V, G00), + build_edges(Parents, V, Edges), + dgraph_add_edges(G00, Edges, G1), + to_dgraph(Vs, G1, G). -to_dgraph([], G, G, RG, RG). -to_dgraph([V|Vs], G0, G, RG0, RG) :- - clpbn:get_atts(V, [evidence(_),dist(_,Parents)]), !, - build_edges(Parents, V, Edges, REdges), - dgraph_add_edges(G0,[V-e|Edges],G1), - dgraph_add_edges(RG0,REdges,RG1), - to_dgraph(Vs, G1, G, RG1, RG). -to_dgraph([V|Vs], G0, G, RG0, RG) :- - clpbn:get_atts(V, [dist(_,Parents)]), - build_edges(Parents, V, Edges, REdges), - dgraph_add_vertex(G0,V,G1), - dgraph_add_edges(G1, Edges, G2), - dgraph_add_vertex(RG0,V,RG1), - dgraph_add_edges(RG1, REdges, RG2), - to_dgraph(Vs, G2, G, RG2, RG). +build_edges([], _, []). +build_edges([P|Parents], V, [P-V|Edges]) :- + build_edges(Parents, V, Edges). +% search for the set of variables that influence V +influences(Vs, G, RG, Vars) :- + rb_new(Visited0), + influences(Vs, G, RG, Visited0, Visited), + all_top(Visited, Vars), +length(Vars,Leng), writeln(done:Leng). -build_edges([], _, [], []). -build_edges([P|Parents], V, [P-V|Edges], [V-P|REdges]) :- - build_edges(Parents, V, Edges, REdges). +influences([], _, _, Visited, Visited). +influences([V|LV], G, RG, Vs, NVs) :- + rb_lookup(V, T.B, Vs), T == t, B == b, !, + influences(LV, G, RG, Vs, NVs). +influences([V|LV], G, RG, Vs0, Vs3) :- + rb_insert(Vs0, V, t.b, Vs1), + process_new_variable(V, G, RG, Vs1, Vs2), + influences(LV, G, RG, Vs2, Vs3). -follow_dgraph(V, G, RG, Is0, IsF, Evs0, EvsF, Visited0, Visited) :- +process_new_variable(V, _G, _RG, _Vs0, _Vs1) :- + clpbn:get_atts(V,[evidence(Ev)]), !, + throw(error(bound_to_evidence(V/Ev))). +process_new_variable(V, G, RG, Vs0, Vs2) :- + dgraph_neighbors(V, G, Children), + throw_all_below(Children, G, RG, Vs0, Vs1), dgraph_neighbors(V, RG, Parents), - add_parents(Parents, G, RG, Is0, IsI, Evs0, EvsI, Visited0, Visited1), - dgraph_neighbors(V, G, Kids), - add_kids(Kids, G, RG, IsI, IsF, EvsI, EvsF, Visited1, Visited). + throw_all_above(Parents, G, RG, Vs1, Vs2). -add_parents([], _, _, Is, Is, Evs, Evs, Visited, Visited). -% been here already, can safely ignore. -add_parents([V|Vs], G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF) :- - rb_lookup(V, _, Visited0), !, - add_parents(Vs, G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF). -% evidence node, -% just say that we visited it -add_parents([V|Vs], G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF) :- - dgraph_edge(V,e,G), !, % has evidence - rb_insert(Visited0, V, _, VisitedI), - add_parents(Vs, G, RG, Is0, IsF, [V|Evs0], EvsF, VisitedI, VisitedF). -% non-evidence node, -% we will need to find its parents. -add_parents([V|Vs], G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF) :- - rb_insert(Visited0, V, _, VisitedI), - follow_dgraph(V, G, RG, [V|Is0], IsI, [V|Evs0], EvsI, VisitedI, VisitedII), - add_parents(Vs, G, RG, IsI, IsF, EvsI, EvsF, VisitedII, VisitedF). - -add_kids([], _, _, Is, Is, Evs, Evs, Visited, Visited). -add_kids([V|Vs], G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF) :- - dgraph_edge(V,e,G), % has evidence - % we will go there even if it was visited - ( rb_insert(Visited0, V, _, Visited1) -> - true - ; - % we've been there, but were we there as a father or as a kid? - not_in(Evs0, V), - Visited1 = Visited0 - ), - !, - dgraph_neighbors(V, RG, Parents), - add_parents(Parents, G, RG, Is0, Is1, [V|Evs0], EvsI, Visited1, VisitedI), - (Is1 = Is0 -> - % ignore whatever we did with this node, - % it didn't lead anywhere (all parents have evidence). - add_kids(Vs, G, RG, Is0, IsF, [V|Evs0], EvsF, Visited1, VisitedF) - ; - % insert parents - add_kids(Vs, G, RG, Is1, IsF, EvsI, EvsF, VisitedI, VisitedF) - ). -add_kids([_|Vs], G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF) :- - add_kids(Vs, G, RG, Is0, IsF, Evs0, EvsF, Visited0, VisitedF). +throw_all_below([], _, _, Vs, Vs). +throw_all_below(Child.Children, G, RG, Vs0, Vs2) :- +% clpbn:get_atts(Child,[key(K)]), rb_visit(Vs0, Pairs), writeln(down:Child:K:Pairs), + throw_below(Child, G, RG, Vs0, Vs1), + throw_all_below(Children, G, RG, Vs1, Vs2). + +% visited +throw_below(Child, G, RG, Vs0, Vs1) :- + rb_lookup(Child, _.B, Vs0), !, + ( + B == b -> + Vs0 = Vs1 % been there before + ; + B = b, % mark it + handle_ball_from_above(Child, G, RG, Vs0, Vs1) + ). +throw_below(Child, G, RG, Vs0, Vs2) :- + rb_insert(Vs0, Child, _.b, Vs1), + handle_ball_from_above(Child, G, RG, Vs1, Vs2). + +% share this with parents, if we have evidence +handle_ball_from_above(V, G, RG, Vs0, Vs1) :- + clpbn:get_atts(V,[evidence(_)]), !, + dgraph_neighbors(V, RG, Parents), + throw_all_above(Parents, G, RG, Vs0, Vs1). +% propagate to kids, if we do not +handle_ball_from_above(V, G, RG, Vs0, Vs1) :- + dgraph_neighbors(V, G, Children), + throw_all_below(Children, G, RG, Vs0, Vs1). +throw_all_above([], _, _, Vs, Vs). +throw_all_above(Parent.Parentren, G, RG, Vs0, Vs2) :- +% clpbn:get_atts(Parent,[key(K)]), rb_visit(Vs0, Pairs), writeln(up:Parent:K:Pairs), + throw_above(Parent, G, RG, Vs0, Vs1), + throw_all_above(Parentren, G, RG, Vs1, Vs2). -not_in([V1|_], V) :- V1 == V, !, fail. -not_in([_|Evs0], V) :- - not_in(Evs0, V). +% visited +throw_above(Parent, G, RG, Vs0, Vs1) :- + rb_lookup(Parent, T._, Vs0), !, + ( + T == t -> + Vs1 = Vs0 % been there before + ; + T = t, % mark it + handle_ball_from_below(Parent, G, RG, Vs0, Vs1) + ). +throw_above(Parent, G, RG, Vs0, Vs2) :- + rb_insert(Vs0, Parent, t._, Vs1), + handle_ball_from_below(Parent, G, RG, Vs1, Vs2). +% share this with parents, if we have evidence +handle_ball_from_below(V, _, _, Vs, Vs) :- + clpbn:get_atts(V,[evidence(_)]), !. +% propagate to kids, if we do not +handle_ball_from_below(V, G, RG, Vs0, Vs1) :- + dgraph_neighbors(V, RG, Parents), + propagate_ball_from_below(Parents, V, G, RG, Vs0, Vs1). + +propagate_ball_from_below([], V, G, RG, Vs0, Vs1) :- !, + dgraph_neighbors(V, G, Children), + throw_all_below(Children, G, RG, Vs0, Vs1). +propagate_ball_from_below(Parents, _V, G, RG, Vs0, Vs1) :- + throw_all_above(Parents, G, RG, Vs0, Vs1). + +all_top(T, Vs) :- + rb_visit(T, Pairs), + get_tops(Pairs, Vs). + +get_tops([], []). +get_tops([V-(T._)|Pairs], V.Vs) :- + T == t, !, + get_tops(Pairs, Vs). +get_tops([V-_|Pairs], V.Vs) :- + clpbn:get_atts(V,[evidence(_)]), !, + get_tops(Pairs, Vs). +get_tops(_.Pairs, Vs) :- + get_tops(Pairs, Vs). diff --git a/packages/CLPBN/clpbn/gibbs.yap b/packages/CLPBN/clpbn/gibbs.yap index 5e6323bf5..2a499b302 100644 --- a/packages/CLPBN/clpbn/gibbs.yap +++ b/packages/CLPBN/clpbn/gibbs.yap @@ -51,7 +51,7 @@ :- use_module(library('clpbn/connected'), [ - influences/4 + influences/3 ]). :- dynamic gibbs_params/3. @@ -73,7 +73,7 @@ init_gibbs_solver(GoalVs, Vs0, _, Vs) :- clean_up, term_variables(GoalVs, LVs), check_for_hidden_vars(Vs0, Vs0, Vs1), - influences(Vs1, LVs, _, Vs2), + influences(Vs1, LVs, Vs2), sort(Vs2,Vs). run_gibbs_solver(LVs, LPs, Vs) :- diff --git a/packages/CLPBN/clpbn/graphviz.yap b/packages/CLPBN/clpbn/graphviz.yap index 6d81cf3da..825fae3a1 100644 --- a/packages/CLPBN/clpbn/graphviz.yap +++ b/packages/CLPBN/clpbn/graphviz.yap @@ -22,7 +22,7 @@ output_var(Stream, V) :- Parents = [_|_], !, format(Stream, ' ',[]), output_parents(Stream, Parents), - format(' -> ',[]), + format(Stream,' -> ',[]), output_key(Stream,Key), nl(Stream). output_var(_, _). diff --git a/packages/CLPBN/clpbn/jt.yap b/packages/CLPBN/clpbn/jt.yap index bf5aef811..6828a002b 100644 --- a/packages/CLPBN/clpbn/jt.yap +++ b/packages/CLPBN/clpbn/jt.yap @@ -80,7 +80,7 @@ :- use_module(library('clpbn/connected'), [ init_influences/3, - influences/5 + influences/4 ]). @@ -98,7 +98,7 @@ init_jt_solver(LLVs, Vs0, _, State) :- init_jt_solver_for_questions([], _, _, []). init_jt_solver_for_questions([LLVs|MoreLLVs], G, RG, [state(JTree, Evidence)|State]) :- - influences(LLVs, _, NVs0, G, RG), + influences(LLVs, G, RG, NVs0), sort(NVs0, NVs), get_graph(NVs, BayesNet, CPTs, Evidence), build_jt(BayesNet, CPTs, JTree), diff --git a/packages/CLPBN/clpbn/table.yap b/packages/CLPBN/clpbn/table.yap index 0acd09478..9c07503bc 100644 --- a/packages/CLPBN/clpbn/table.yap +++ b/packages/CLPBN/clpbn/table.yap @@ -96,7 +96,7 @@ clpbn_table(F/N,M) :- Key =.. L1, atom_concat(F, '___tabled', NF), L2 = [_|Args], - S1 =.. [NF|Args], + _S1 =.. [NF|Args], L0 = [_|OArgs], S2 =.. [NF|OArgs], asserta(clpbn_table(S, M, S2)), diff --git a/packages/CLPBN/clpbn/vel.yap b/packages/CLPBN/clpbn/ve.yap similarity index 89% rename from packages/CLPBN/clpbn/vel.yap rename to packages/CLPBN/clpbn/ve.yap index 40940e272..41ed2b19f 100644 --- a/packages/CLPBN/clpbn/vel.yap +++ b/packages/CLPBN/clpbn/ve.yap @@ -14,10 +14,10 @@ *********************************/ -:- module(clpbn_vel, [vel/3, - check_if_vel_done/1, - init_vel_solver/4, - run_vel_solver/3]). +:- module(clpbn_ve, [ve/3, + check_if_ve_done/1, + init_ve_solver/4, + run_ve_solver/3]). :- attribute size/1, all_diffs/1. @@ -44,7 +44,7 @@ :- use_module(library('clpbn/connected'), [ init_influences/3, - influences/5 + influences/4 ]). :- use_module(library('clpbn/matrix_cpt_utils'), @@ -64,40 +64,41 @@ [check_for_agg_vars/2]). -check_if_vel_done(Var) :- +check_if_ve_done(Var) :- get_atts(Var, [size(_)]), !. % % implementation of the well known variable elimination algorithm % -vel([[]],_,_) :- !. -vel([LVs],Vs0,AllDiffs) :- - init_vel_solver([LVs], Vs0, AllDiffs, State), +ve([[]],_,_) :- !. +ve([LVs],Vs0,AllDiffs) :- + init_ve_solver([LVs], Vs0, AllDiffs, State), % variable elimination proper - run_vel_solver([LVs], [LPs], State), + run_ve_solver([LVs], [LPs], State), % bind Probs back to variables so that they can be output. clpbn_bind_vals([LVs],[LPs],AllDiffs). -init_vel_solver(Qs, Vs0, _, LVis) :- +init_ve_solver(Qs, Vs0, _, LVis) :- check_for_agg_vars(Vs0, Vs1), % LVi will have a list of CLPBN variables % Tables0 will have the full data on each variable init_influences(Vs1, G, RG), - init_vel_solver_for_questions(Qs, G, RG, _, LVis). + init_ve_solver_for_questions(Qs, G, RG, _, LVis). -init_vel_solver_for_questions([], _, _, [], []). -init_vel_solver_for_questions([Vs|MVs], G, RG, [NVs|MNVs0], [NVs|LVis]) :- - influences(Vs, _, NVs0, G, RG), +init_ve_solver_for_questions([], _, _, [], []). +init_ve_solver_for_questions([Vs|MVs], G, RG, [NVs|MNVs0], [NVs|LVis]) :- + influences(Vs, G, RG, NVs0), sort(NVs0, NVs), %clpbn_gviz:clpbn2gviz(user_error, test, NVs, Vs), - init_vel_solver_for_questions(MVs, G, RG, MNVs0, LVis). + init_ve_solver_for_questions(MVs, G, RG, MNVs0, LVis). % use a findall to recover space without needing for GC -run_vel_solver(LVs, LPs, LNVs) :- - findall(Ps, solve_vel(LVs, LNVs, Ps), LPs). +run_ve_solver(LVs, LPs, LNVs) :- + findall(Ps, solve_ve(LVs, LNVs, Ps), LPs). -solve_vel([LVs|_], [NVs0|_], Ps) :- -% length(NVs0, L), (L > 64 -> clpbn_gviz:clpbn2gviz(user_error,sort,NVs0,LVs) ; true ), +solve_ve([LVs|_], [NVs0|_], Ps) :- +% length(NVs0, L), (L > 415 -> clpbn_gviz:clpbn2gviz(user_error,sort,NVs0,LVs) ; true ), +% length(NVs0, L), writeln(+LVs:L), find_all_clpbn_vars(NVs0, NVs0, LV0, LVi, Tables0), sort(LV0, LV), % construct the graph @@ -108,8 +109,8 @@ solve_vel([LVs|_], [NVs0|_], Ps) :- % move from potentials back to probabilities normalise_CPT(Dist,MPs), list_from_CPT(MPs, Ps). -solve_vel([_|MoreLVs], [_|MoreLVis], Ps) :- - solve_vel(MoreLVs, MoreLVis, Ps). +solve_ve([_|MoreLVs], [_|MoreLVis], Ps) :- + solve_ve(MoreLVs, MoreLVis, Ps). exps([],[]). exps([L|LD],[O|LDE]) :- @@ -133,7 +134,7 @@ find_all_clpbn_vars([V|Vs], NVs0, [Var|LV], ProcessedVars, [table(I,Table,Parent % variables with evidence should not be processed. (var(Ev) -> Var = var(V,I,Sz,Vals,Parents,Ev,_,_), - vel_get_dist_size(V,Sz), + ve_get_dist_size(V,Sz), ProcessedVars = [Var|ProcessedVars0] ; ProcessedVars = ProcessedVars0 @@ -191,7 +192,7 @@ compute_size([tab(_,Vs,_)|Tabs],Vs0,K) :- multiply_sizes([],K,K). multiply_sizes([V|Vs],K0,K) :- - vel_get_dist_size(V, Sz), + ve_get_dist_size(V, Sz), KI is K0*Sz, multiply_sizes(Vs,KI,K). @@ -280,9 +281,9 @@ update_tables([tab(Tab0,Vs,Sz)|Tabs],[tab(Tab0,Vs,Sz)|NTabs],Table,V) :- update_tables([_|Tabs],NTabs,Table,V) :- update_tables(Tabs,NTabs,Table,V). -vel_get_dist_size(V,Sz) :- +ve_get_dist_size(V,Sz) :- get_atts(V, [size(Sz)]), !. -vel_get_dist_size(V,Sz) :- +ve_get_dist_size(V,Sz) :- clpbn:get_atts(V,dist(Id,_)), !, get_dist_domain_size(Id,Sz), put_atts(V, [size(Sz)]). diff --git a/packages/CLPBN/examples/sprinkler.yap b/packages/CLPBN/examples/sprinkler.yap index e8cc62742..f0be31fee 100644 --- a/packages/CLPBN/examples/sprinkler.yap +++ b/packages/CLPBN/examples/sprinkler.yap @@ -1,4 +1,6 @@ +:- style_check(all). + :- ensure_loaded(library(clpbn)). wet_grass(W) :- diff --git a/packages/CLPBN/learning/em.yap b/packages/CLPBN/learning/em.yap index 7e3f64c31..a09eac3f0 100644 --- a/packages/CLPBN/learning/em.yap +++ b/packages/CLPBN/learning/em.yap @@ -11,6 +11,7 @@ [clpbn_init_graph/1, clpbn_init_solver/5, clpbn_run_solver/4, + clpbn_finalize_solver/1, clpbn_flag/2]). :- use_module(library('clpbn/dists'), @@ -21,9 +22,6 @@ randomise_all_dists/0, uniformise_all_dists/0]). -:- use_module(library('clpbn/connected'), - [clpbn_subgraphs/2]). - :- use_module(library('clpbn/learning/learn_utils'), [run_all/1, clpbn_vars/2, @@ -53,6 +51,7 @@ em(Items, MaxError, MaxIts, Tables, Likelihood) :- catch(init_em(Items, State),Error,handle_em(Error)), em_loop(0, 0.0, State, MaxError, MaxIts, Likelihood, Tables), + clpbn_finalize_solver(State), assert(em_found(Tables, Likelihood)), fail. % get rid of new random variables the easy way :) @@ -90,7 +89,7 @@ init_em(Items, state( AllDists, AllDistInstances, MargVars, SolverVars)) :- em_loop(Its, Likelihood0, State, MaxError, MaxIts, LikelihoodF, FTables) :- estimate(State, LPs), maximise(State, Tables, LPs, Likelihood), - writeln(Likelihood:Its:Likelihood0:Tables), +% writeln(Likelihood:Its:Likelihood0:Tables), ( ( abs((Likelihood - Likelihood0)/Likelihood) < MaxError @@ -205,7 +204,7 @@ compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables], MDistTable, Lik0, empty_dist(Id, Table0), add_samples(Samples, Table0, MDistTable), soften_sample(Table0, SoftenedTable), - matrix:matrix_sum(Table0,TotM), +% matrix:matrix_sum(Table0,TotM), normalise_counts(SoftenedTable, NewTable), compute_likelihood(Table0, NewTable, DeltaLik), dist_new_table(Id, NewTable), diff --git a/packages/CLPBN/learning/example/school_params.yap b/packages/CLPBN/learning/example/school_params.yap index f97119b77..6f96a9d38 100644 --- a/packages/CLPBN/learning/example/school_params.yap +++ b/packages/CLPBN/learning/example/school_params.yap @@ -4,13 +4,14 @@ :- [pos:train]. -:- ['~/Yap/work/packages/CLPBN/clpbn/examples/School/school_32']. +:- ['../../examples/School/school_32']. -:- ['~/Yap/work/packages/CLPBN/learning/em']. +:- use_module(library(clpbn/learning/em)). %:- clpbn:set_clpbn_flag(em_solver,gibbs). -:- clpbn:set_clpbn_flag(em_solver,jt). -%:- clpbn:set_clpbn_flag(em_solver,vel). +%:- clpbn:set_clpbn_flag(em_solver,jt). +:- clpbn:set_clpbn_flag(em_solver,ve). +%:- clpbn:set_clpbn_flag(em_solver,bp). timed_main :- statistics(runtime, _), @@ -24,10 +25,23 @@ main :- em(L,0.01,10,CPTs,Lik), writeln(Lik:CPTs). +debug_school :- + graph(L), + em(L,0.01,10,CPTs,Lik), + writeln(Lik:CPTs). + +run_queries([]). +run_queries(Q.L) :- + call(Q), + run_queries(L). + +graph([professor_ability(p0,_G131367),professor_ability(p1,h),professor_ability(p2,_G131377),professor_ability(p3,_G131382),professor_ability(p4,_G131387),professor_ability(p5,_G131392),professor_ability(p6,_G131397),professor_ability(p7,l),professor_ability(p8,m),professor_ability(p9,h),professor_ability(p10,m),professor_ability(p11,_G131422),professor_ability(p12,_G131427),professor_ability(p13,_G131432),professor_ability(p14,_G131437),professor_ability(p15,_G131442),professor_ability(p16,_G131447),professor_ability(p17,m),professor_ability(p18,l),professor_ability(p19,h),professor_ability(p20,h),professor_ability(p21,_G131472),professor_ability(p22,m),professor_ability(p23,m),professor_ability(p24,l),professor_ability(p25,m),professor_ability(p26,_G131497),professor_ability(p27,h),professor_ability(p28,h),professor_ability(p29,_G131512),professor_ability(p30,_G131517),professor_ability(p31,_G131522),professor_popularity(p0,h),professor_popularity(p1,h),professor_popularity(p2,_G131537),professor_popularity(p3,h),professor_popularity(p4,h),professor_popularity(p5,h),professor_popularity(p6,l),professor_popularity(p7,l),professor_popularity(p8,_G131567),professor_popularity(p9,_G131572),professor_popularity(p10,l),professor_popularity(p11,_G131582),professor_popularity(p12,h),professor_popularity(p13,l),professor_popularity(p14,_G131597),professor_popularity(p15,h),professor_popularity(p16,m),professor_popularity(p17,_G131612),professor_popularity(p18,_G131617),professor_popularity(p19,_G131622),professor_popularity(p20,_G131627),professor_popularity(p21,h),professor_popularity(p22,_G131637),professor_popularity(p23,_G131642),professor_popularity(p24,l),professor_popularity(p25,_G131652),professor_popularity(p26,_G131657),professor_popularity(p27,h),professor_popularity(p28,h),professor_popularity(p29,_G131672),professor_popularity(p30,m),professor_popularity(p31,_G131682),registration_grade(r0,a),registration_grade(r1,_G131692),registration_grade(r2,_G131697),registration_grade(r3,c),registration_grade(r4,c),registration_grade(r5,c),registration_grade(r6,_G131717),registration_grade(r7,a),registration_grade(r8,b),registration_grade(r9,_G131732),registration_grade(r10,_G131737),registration_grade(r11,a),registration_grade(r12,_G131747),registration_grade(r13,a),registration_grade(r14,_G131757),registration_grade(r15,b),registration_grade(r16,a),registration_grade(r17,b),registration_grade(r18,_G131777),registration_grade(r19,_G131782),registration_grade(r20,c),registration_grade(r21,_G131792),registration_grade(r22,_G131797),registration_grade(r23,_G131802),registration_grade(r24,b),registration_grade(r25,a),registration_grade(r26,_G131817),registration_grade(r27,_G131822),registration_grade(r28,c),registration_grade(r29,b),registration_grade(r30,c),registration_grade(r31,b),registration_grade(r32,_G131847),registration_grade(r33,a),registration_grade(r34,c),registration_grade(r35,c),registration_grade(r36,a),registration_grade(r37,a),registration_grade(r38,c),registration_grade(r39,a),registration_grade(r40,_G131887),registration_grade(r41,_G131892),registration_grade(r42,_G131897),registration_grade(r43,a),registration_grade(r44,a),registration_grade(r45,a),registration_grade(r46,a),registration_grade(r47,_G131922),registration_grade(r48,_G131927),registration_grade(r49,b),registration_grade(r50,b),registration_grade(r51,b),registration_grade(r52,_G131947),registration_grade(r53,a),registration_grade(r54,_G131957),registration_grade(r55,a),registration_grade(r56,c),registration_grade(r57,_G131972),registration_grade(r58,_G131977),registration_grade(r59,_G131982),registration_grade(r60,_G131987),registration_grade(r61,a),registration_grade(r62,_G131997),registration_grade(r63,b),registration_grade(r64,b),registration_grade(r65,b),registration_grade(r66,_G132017),registration_grade(r67,b),registration_grade(r68,a),registration_grade(r69,_G132032),registration_grade(r70,_G132037),registration_grade(r71,_G132042),registration_grade(r72,_G132047),registration_grade(r73,_G132052),registration_grade(r74,a),registration_grade(r75,_G132062),registration_grade(r76,_G132067),registration_grade(r77,_G132072),registration_grade(r78,b),registration_grade(r79,_G132082),registration_grade(r80,_G132087),registration_grade(r81,_G132092),registration_grade(r82,_G132097),registration_grade(r83,_G132102),registration_grade(r84,_G132107),registration_grade(r85,b),registration_grade(r86,_G132117),registration_grade(r87,b),registration_grade(r88,_G132127),registration_grade(r89,_G132132),registration_grade(r90,_G132137),registration_grade(r91,a),registration_grade(r92,_G132147),registration_grade(r93,_G132152),registration_grade(r94,_G132157),registration_grade(r95,_G132162),registration_grade(r96,_G132167),registration_grade(r97,a),registration_grade(r98,b),registration_grade(r99,b),registration_grade(r100,a),registration_grade(r101,a),registration_grade(r102,a),registration_grade(r103,_G132202),registration_grade(r104,_G132207),registration_grade(r105,c),registration_grade(r106,b),registration_grade(r107,b),registration_grade(r108,_G132227),registration_grade(r109,_G132232),registration_grade(r110,a),registration_grade(r111,_G132242),registration_grade(r112,_G132247),registration_grade(r113,_G132252),registration_grade(r114,_G132257),registration_grade(r115,d),registration_grade(r116,b),registration_grade(r117,_G132272),registration_grade(r118,_G132277),registration_grade(r119,b),registration_grade(r120,b),registration_grade(r121,_G132292),registration_grade(r122,_G132297),registration_grade(r123,a),registration_grade(r124,a),registration_grade(r125,_G132312),registration_grade(r126,_G132317),registration_grade(r127,b),registration_grade(r128,a),registration_grade(r129,c),registration_grade(r130,a),registration_grade(r131,a),registration_grade(r132,b),registration_grade(r133,_G132352),registration_grade(r134,_G132357),registration_grade(r135,_G132362),registration_grade(r136,_G132367),registration_grade(r137,b),registration_grade(r138,a),registration_grade(r139,_G132382),registration_grade(r140,_G132387),registration_grade(r141,b),registration_grade(r142,_G132397),registration_grade(r143,b),registration_grade(r144,c),registration_grade(r145,b),registration_grade(r146,_G132417),registration_grade(r147,_G132422),registration_grade(r148,_G132427),registration_grade(r149,a),registration_grade(r150,_G132437),registration_grade(r151,a),registration_grade(r152,_G132447),registration_grade(r153,_G132452),registration_grade(r154,a),registration_grade(r155,c),registration_grade(r156,b),registration_grade(r157,b),registration_grade(r158,c),registration_grade(r159,b),registration_grade(r160,a),registration_grade(r161,_G132492),registration_grade(r162,_G132497),registration_grade(r163,_G132502),registration_grade(r164,b),registration_grade(r165,b),registration_grade(r166,_G132517),registration_grade(r167,a),registration_grade(r168,a),registration_grade(r169,_G132532),registration_grade(r170,_G132537),registration_grade(r171,a),registration_grade(r172,c),registration_grade(r173,b),registration_grade(r174,_G132557),registration_grade(r175,_G132562),registration_grade(r176,b),registration_grade(r177,c),registration_grade(r178,b),registration_grade(r179,d),registration_grade(r180,c),registration_grade(r181,a),registration_grade(r182,b),registration_grade(r183,a),registration_grade(r184,_G132607),registration_grade(r185,_G132612),registration_grade(r186,c),registration_grade(r187,a),registration_grade(r188,a),registration_grade(r189,_G132632),registration_grade(r190,_G132637),registration_grade(r191,_G132642),registration_grade(r192,b),registration_grade(r193,c),registration_grade(r194,b),registration_grade(r195,_G132662),registration_grade(r196,_G132667),registration_grade(r197,_G132672),registration_grade(r198,_G132677),registration_grade(r199,b),registration_grade(r200,_G132687),registration_grade(r201,c),registration_grade(r202,a),registration_grade(r203,_G132702),registration_grade(r204,_G132707),registration_grade(r205,_G132712),registration_grade(r206,a),registration_grade(r207,a),registration_grade(r208,_G132727),registration_grade(r209,b),registration_grade(r210,a),registration_grade(r211,d),registration_grade(r212,_G132747),registration_grade(r213,_G132752),registration_grade(r214,_G132757),registration_grade(r215,a),registration_grade(r216,_G132767),registration_grade(r217,_G132772),registration_grade(r218,_G132777),registration_grade(r219,_G132782),registration_grade(r220,_G132787),registration_grade(r221,b),registration_grade(r222,c),registration_grade(r223,_G132802),registration_grade(r224,_G132807),registration_grade(r225,b),registration_grade(r226,d),registration_grade(r227,b),registration_grade(r228,c),registration_grade(r229,b),registration_grade(r230,a),registration_grade(r231,_G132842),registration_grade(r232,_G132847),registration_grade(r233,b),registration_grade(r234,_G132857),registration_grade(r235,c),registration_grade(r236,b),registration_grade(r237,_G132872),registration_grade(r238,d),registration_grade(r239,b),registration_grade(r240,b),registration_grade(r241,_G132892),registration_grade(r242,b),registration_grade(r243,_G132902),registration_grade(r244,b),registration_grade(r245,a),registration_grade(r246,b),registration_grade(r247,_G132922),registration_grade(r248,b),registration_grade(r249,_G132932),registration_grade(r250,a),registration_grade(r251,_G132942),registration_grade(r252,b),registration_grade(r253,_G132952),registration_grade(r254,_G132957),registration_grade(r255,_G132962),registration_grade(r256,_G132967),registration_grade(r257,b),registration_grade(r258,_G132977),registration_grade(r259,a),registration_grade(r260,b),registration_grade(r261,a),registration_grade(r262,_G132997),registration_grade(r263,_G133002),registration_grade(r264,_G133007),registration_grade(r265,a),registration_grade(r266,_G133017),registration_grade(r267,_G133022),registration_grade(r268,c),registration_grade(r269,a),registration_grade(r270,_G133037),registration_grade(r271,_G133042),registration_grade(r272,_G133047),registration_grade(r273,b),registration_grade(r274,c),registration_grade(r275,a),registration_grade(r276,a),registration_grade(r277,_G133072),registration_grade(r278,_G133077),registration_grade(r279,_G133082),registration_grade(r280,_G133087),registration_grade(r281,b),registration_grade(r282,d),registration_grade(r283,_G133102),registration_grade(r284,b),registration_grade(r285,_G133112),registration_grade(r286,_G133117),registration_grade(r287,_G133122),registration_grade(r288,_G133127),registration_grade(r289,_G133132),registration_grade(r290,b),registration_grade(r291,c),registration_grade(r292,_G133147),registration_grade(r293,_G133152),registration_grade(r294,_G133157),registration_grade(r295,a),registration_grade(r296,b),registration_grade(r297,_G133172),registration_grade(r298,a),registration_grade(r299,a),registration_grade(r300,_G133187),registration_grade(r301,b),registration_grade(r302,b),registration_grade(r303,_G133202),registration_grade(r304,a),registration_grade(r305,_G133212),registration_grade(r306,_G133217),registration_grade(r307,_G133222),registration_grade(r308,c),registration_grade(r309,_G133232),registration_grade(r310,a),registration_grade(r311,a),registration_grade(r312,a),registration_grade(r313,_G133252),registration_grade(r314,_G133257),registration_grade(r315,c),registration_grade(r316,_G133267),registration_grade(r317,_G133272),registration_grade(r318,c),registration_grade(r319,c),registration_grade(r320,b),registration_grade(r321,b),registration_grade(r322,_G133297),registration_grade(r323,c),registration_grade(r324,b),registration_grade(r325,b),registration_grade(r326,_G133317),registration_grade(r327,c),registration_grade(r328,b),registration_grade(r329,_G133332),registration_grade(r330,_G133337),registration_grade(r331,_G133342),registration_grade(r332,_G133347),registration_grade(r333,_G133352),registration_grade(r334,_G133357),registration_grade(r335,d),registration_grade(r336,b),registration_grade(r337,b),registration_grade(r338,b),registration_grade(r339,_G133382),registration_grade(r340,_G133387),registration_grade(r341,_G133392),registration_grade(r342,_G133397),registration_grade(r343,a),registration_grade(r344,c),registration_grade(r345,_G133412),registration_grade(r346,b),registration_grade(r347,_G133422),registration_grade(r348,a),registration_grade(r349,a),registration_grade(r350,b),registration_grade(r351,b),registration_grade(r352,_G133447),registration_grade(r353,_G133452),registration_grade(r354,_G133457),registration_grade(r355,_G133462),registration_grade(r356,b),registration_grade(r357,b),registration_grade(r358,_G133477),registration_grade(r359,a),registration_grade(r360,_G133487),registration_grade(r361,_G133492),registration_grade(r362,c),registration_grade(r363,_G133502),registration_grade(r364,b),registration_grade(r365,_G133512),registration_grade(r366,b),registration_grade(r367,_G133522),registration_grade(r368,a),registration_grade(r369,c),registration_grade(r370,b),registration_grade(r371,_G133542),registration_grade(r372,_G133547),registration_grade(r373,_G133552),registration_grade(r374,b),registration_grade(r375,b),registration_grade(r376,a),registration_grade(r377,a),registration_grade(r378,a),registration_grade(r379,_G133582),registration_grade(r380,_G133587),registration_grade(r381,c),registration_grade(r382,_G133597),registration_grade(r383,_G133602),registration_grade(r384,b),registration_grade(r385,_G133612),registration_grade(r386,d),registration_grade(r387,_G133622),registration_grade(r388,_G133627),registration_grade(r389,a),registration_grade(r390,_G133637),registration_grade(r391,_G133642),registration_grade(r392,_G133647),registration_grade(r393,b),registration_grade(r394,c),registration_grade(r395,b),registration_grade(r396,_G133667),registration_grade(r397,a),registration_grade(r398,_G133677),registration_grade(r399,_G133682),registration_grade(r400,_G133687),registration_grade(r401,c),registration_grade(r402,_G133697),registration_grade(r403,_G133702),registration_grade(r404,a),registration_grade(r405,_G133712),registration_grade(r406,_G133717),registration_grade(r407,_G133722),registration_grade(r408,a),registration_grade(r409,a),registration_grade(r410,b),registration_grade(r411,b),registration_grade(r412,_G133747),registration_grade(r413,a),registration_grade(r414,_G133757),registration_grade(r415,_G133762),registration_grade(r416,_G133767),registration_grade(r417,_G133772),registration_grade(r418,a),registration_grade(r419,a),registration_grade(r420,a),registration_grade(r421,c),registration_grade(r422,b),registration_grade(r423,_G133802),registration_grade(r424,a),registration_grade(r425,b),registration_grade(r426,c),registration_grade(r427,c),registration_grade(r428,_G133827),registration_grade(r429,c),registration_grade(r430,_G133837),registration_grade(r431,_G133842),registration_grade(r432,c),registration_grade(r433,_G133852),registration_grade(r434,a),registration_grade(r435,_G133862),registration_grade(r436,_G133867),registration_grade(r437,c),registration_grade(r438,b),registration_grade(r439,_G133882),registration_grade(r440,c),registration_grade(r441,a),registration_grade(r442,c),registration_grade(r443,_G133902),registration_grade(r444,_G133907),registration_grade(r445,_G133912),registration_grade(r446,_G133917),registration_grade(r447,d),registration_grade(r448,_G133927),registration_grade(r449,b),registration_grade(r450,_G133937),registration_grade(r451,_G133942),registration_grade(r452,b),registration_grade(r453,_G133952),registration_grade(r454,_G133957),registration_grade(r455,_G133962),registration_grade(r456,c),registration_grade(r457,_G133972),registration_grade(r458,_G133977),registration_grade(r459,_G133982),registration_grade(r460,_G133987),registration_grade(r461,_G133992),registration_grade(r462,a),registration_grade(r463,d),registration_grade(r464,a),registration_grade(r465,_G134012),registration_grade(r466,_G134017),registration_grade(r467,b),registration_grade(r468,_G134027),registration_grade(r469,_G134032),registration_grade(r470,_G134037),registration_grade(r471,_G134042),registration_grade(r472,a),registration_grade(r473,c),registration_grade(r474,b),registration_grade(r475,_G134062),registration_grade(r476,_G134067),registration_grade(r477,b),registration_grade(r478,a),registration_grade(r479,b),registration_grade(r480,a),registration_grade(r481,_G134092),registration_grade(r482,b),registration_grade(r483,a),registration_grade(r484,_G134107),registration_grade(r485,_G134112),registration_grade(r486,_G134117),registration_grade(r487,_G134122),registration_grade(r488,a),registration_grade(r489,_G134132),registration_grade(r490,_G134137),registration_grade(r491,c),registration_grade(r492,b),registration_grade(r493,a),registration_grade(r494,_G134157),registration_grade(r495,_G134162),registration_grade(r496,_G134167),registration_grade(r497,c),registration_grade(r498,_G134177),registration_grade(r499,c),registration_grade(r500,b),registration_grade(r501,_G134192),registration_grade(r502,a),registration_grade(r503,_G134202),registration_grade(r504,_G134207),registration_grade(r505,_G134212),registration_grade(r506,c),registration_grade(r507,a),registration_grade(r508,_G134227),registration_grade(r509,_G134232),registration_grade(r510,_G134237),registration_grade(r511,_G134242),registration_grade(r512,b),registration_grade(r513,_G134252),registration_grade(r514,_G134257),registration_grade(r515,c),registration_grade(r516,_G134267),registration_grade(r517,_G134272),registration_grade(r518,_G134277),registration_grade(r519,a),registration_grade(r520,b),registration_grade(r521,a),registration_grade(r522,b),registration_grade(r523,_G134302),registration_grade(r524,b),registration_grade(r525,c),registration_grade(r526,c),registration_grade(r527,c),registration_grade(r528,a),registration_grade(r529,_G134332),registration_grade(r530,a),registration_grade(r531,_G134342),registration_grade(r532,a),registration_grade(r533,_G134352),registration_grade(r534,b),registration_grade(r535,c),registration_grade(r536,a),registration_grade(r537,_G134372),registration_grade(r538,_G134377),registration_grade(r539,_G134382),registration_grade(r540,_G134387),registration_grade(r541,c),registration_grade(r542,a),registration_grade(r543,a),registration_grade(r544,b),registration_grade(r545,a),registration_grade(r546,b),registration_grade(r547,_G134422),registration_grade(r548,c),registration_grade(r549,_G134432),registration_grade(r550,a),registration_grade(r551,_G134442),registration_grade(r552,c),registration_grade(r553,_G134452),registration_grade(r554,b),registration_grade(r555,_G134462),registration_grade(r556,_G134467),registration_grade(r557,_G134472),registration_grade(r558,_G134477),registration_grade(r559,b),registration_grade(r560,_G134487),registration_grade(r561,a),registration_grade(r562,_G134497),registration_grade(r563,_G134502),registration_grade(r564,_G134507),registration_grade(r565,d),registration_grade(r566,c),registration_grade(r567,a),registration_grade(r568,a),registration_grade(r569,_G134532),registration_grade(r570,_G134537),registration_grade(r571,_G134542),registration_grade(r572,b),registration_grade(r573,a),registration_grade(r574,_G134557),registration_grade(r575,a),registration_grade(r576,_G134567),registration_grade(r577,_G134572),registration_grade(r578,b),registration_grade(r579,a),registration_grade(r580,_G134587),registration_grade(r581,_G134592),registration_grade(r582,_G134597),registration_grade(r583,_G134602),registration_grade(r584,a),registration_grade(r585,c),registration_grade(r586,b),registration_grade(r587,_G134622),registration_grade(r588,_G134627),registration_grade(r589,c),registration_grade(r590,_G134637),registration_grade(r591,c),registration_grade(r592,b),registration_grade(r593,_G134652),registration_grade(r594,c),registration_grade(r595,b),registration_grade(r596,_G134667),registration_grade(r597,_G134672),registration_grade(r598,a),registration_grade(r599,_G134682),registration_grade(r600,a),registration_grade(r601,b),registration_grade(r602,_G134697),registration_grade(r603,d),registration_grade(r604,_G134707),registration_grade(r605,a),registration_grade(r606,_G134717),registration_grade(r607,_G134722),registration_grade(r608,a),registration_grade(r609,b),registration_grade(r610,_G134737),registration_grade(r611,_G134742),registration_grade(r612,c),registration_grade(r613,_G134752),registration_grade(r614,_G134757),registration_grade(r615,b),registration_grade(r616,_G134767),registration_grade(r617,a),registration_grade(r618,_G134777),registration_grade(r619,_G134782),registration_grade(r620,a),registration_grade(r621,_G134792),registration_grade(r622,b),registration_grade(r623,_G134802),registration_grade(r624,a),registration_grade(r625,_G134812),registration_grade(r626,a),registration_grade(r627,_G134822),registration_grade(r628,a),registration_grade(r629,_G134832),registration_grade(r630,_G134837),registration_grade(r631,_G134842),registration_grade(r632,a),registration_grade(r633,_G134852),registration_grade(r634,b),registration_grade(r635,_G134862),registration_grade(r636,d),registration_grade(r637,c),registration_grade(r638,a),registration_grade(r639,b),registration_grade(r640,_G134887),registration_grade(r641,_G134892),registration_grade(r642,c),registration_grade(r643,_G134902),registration_grade(r644,_G134907),registration_grade(r645,_G134912),registration_grade(r646,_G134917),registration_grade(r647,b),registration_grade(r648,a),registration_grade(r649,_G134932),registration_grade(r650,c),registration_grade(r651,b),registration_grade(r652,b),registration_grade(r653,_G134952),registration_grade(r654,b),registration_grade(r655,a),registration_grade(r656,_G134967),registration_grade(r657,a),registration_grade(r658,a),registration_grade(r659,a),registration_grade(r660,a),registration_grade(r661,c),registration_grade(r662,_G134997),registration_grade(r663,a),registration_grade(r664,_G135007),registration_grade(r665,a),registration_grade(r666,b),registration_grade(r667,_G135022),registration_grade(r668,d),registration_grade(r669,b),registration_grade(r670,a),registration_grade(r671,_G135042),registration_grade(r672,c),registration_grade(r673,a),registration_grade(r674,_G135057),registration_grade(r675,_G135062),registration_grade(r676,a),registration_grade(r677,a),registration_grade(r678,a),registration_grade(r679,a),registration_grade(r680,_G135087),registration_grade(r681,_G135092),registration_grade(r682,_G135097),registration_grade(r683,b),registration_grade(r684,_G135107),registration_grade(r685,_G135112),registration_grade(r686,b),registration_grade(r687,a),registration_grade(r688,c),registration_grade(r689,_G135132),registration_grade(r690,a),registration_grade(r691,_G135142),registration_grade(r692,_G135147),registration_grade(r693,b),registration_grade(r694,_G135157),registration_grade(r695,_G135162),registration_grade(r696,a),registration_grade(r697,_G135172),registration_grade(r698,_G135177),registration_grade(r699,_G135182),registration_grade(r700,a),registration_grade(r701,_G135192),registration_grade(r702,a),registration_grade(r703,_G135202),registration_grade(r704,c),registration_grade(r705,b),registration_grade(r706,_G135217),registration_grade(r707,a),registration_grade(r708,b),registration_grade(r709,_G135232),registration_grade(r710,_G135237),registration_grade(r711,b),registration_grade(r712,_G135247),registration_grade(r713,a),registration_grade(r714,_G135257),registration_grade(r715,a),registration_grade(r716,a),registration_grade(r717,a),registration_grade(r718,a),registration_grade(r719,_G135282),registration_grade(r720,_G135287),registration_grade(r721,_G135292),registration_grade(r722,_G135297),registration_grade(r723,_G135302),registration_grade(r724,_G135307),registration_grade(r725,c),registration_grade(r726,a),registration_grade(r727,_G135322),registration_grade(r728,b),registration_grade(r729,_G135332),registration_grade(r730,_G135337),registration_grade(r731,_G135342),registration_grade(r732,a),registration_grade(r733,a),registration_grade(r734,b),registration_grade(r735,_G135362),registration_grade(r736,a),registration_grade(r737,_G135372),registration_grade(r738,_G135377),registration_grade(r739,a),registration_grade(r740,_G135387),registration_grade(r741,_G135392),registration_grade(r742,_G135397),registration_grade(r743,_G135402),registration_grade(r744,a),registration_grade(r745,b),registration_grade(r746,_G135417),registration_grade(r747,_G135422),registration_grade(r748,b),registration_grade(r749,c),registration_grade(r750,_G135437),registration_grade(r751,c),registration_grade(r752,_G135447),registration_grade(r753,c),registration_grade(r754,_G135457),registration_grade(r755,c),registration_grade(r756,_G135467),registration_grade(r757,_G135472),registration_grade(r758,b),registration_grade(r759,_G135482),registration_grade(r760,_G135487),registration_grade(r761,a),registration_grade(r762,_G135497),registration_grade(r763,a),registration_grade(r764,a),registration_grade(r765,a),registration_grade(r766,_G135517),registration_grade(r767,c),registration_grade(r768,_G135527),registration_grade(r769,_G135532),registration_grade(r770,b),registration_grade(r771,_G135542),registration_grade(r772,a),registration_grade(r773,b),registration_grade(r774,b),registration_grade(r775,a),registration_grade(r776,_G135567),registration_grade(r777,c),registration_grade(r778,c),registration_grade(r779,b),registration_grade(r780,a),registration_grade(r781,_G135592),registration_grade(r782,a),registration_grade(r783,_G135602),registration_grade(r784,_G135607),registration_grade(r785,_G135612),registration_grade(r786,c),registration_grade(r787,a),registration_grade(r788,_G135627),registration_grade(r789,_G135632),registration_grade(r790,b),registration_grade(r791,b),registration_grade(r792,_G135647),registration_grade(r793,_G135652),registration_grade(r794,_G135657),registration_grade(r795,_G135662),registration_grade(r796,_G135667),registration_grade(r797,a),registration_grade(r798,_G135677),registration_grade(r799,_G135682),registration_grade(r800,_G135687),registration_grade(r801,b),registration_grade(r802,_G135697),registration_grade(r803,b),registration_grade(r804,_G135707),registration_grade(r805,_G135712),registration_grade(r806,_G135717),registration_grade(r807,a),registration_grade(r808,_G135727),registration_grade(r809,_G135732),registration_grade(r810,_G135737),registration_grade(r811,d),registration_grade(r812,c),registration_grade(r813,_G135752),registration_grade(r814,c),registration_grade(r815,_G135762),registration_grade(r816,_G135767),registration_grade(r817,a),registration_grade(r818,_G135777),registration_grade(r819,b),registration_grade(r820,d),registration_grade(r821,b),registration_grade(r822,_G135797),registration_grade(r823,a),registration_grade(r824,_G135807),registration_grade(r825,b),registration_grade(r826,b),registration_grade(r827,_G135822),registration_grade(r828,_G135827),registration_grade(r829,b),registration_grade(r830,_G135837),registration_grade(r831,_G135842),registration_grade(r832,b),registration_grade(r833,b),registration_grade(r834,_G135857),registration_grade(r835,a),registration_grade(r836,a),registration_grade(r837,c),registration_grade(r838,_G135877),registration_grade(r839,b),registration_grade(r840,b),registration_grade(r841,a),registration_grade(r842,a),registration_grade(r843,b),registration_grade(r844,_G135907),registration_grade(r845,c),registration_grade(r846,b),registration_grade(r847,b),registration_grade(r848,_G135927),registration_grade(r849,_G135932),registration_grade(r850,_G135937),registration_grade(r851,_G135942),registration_grade(r852,_G135947),registration_grade(r853,_G135952),registration_grade(r854,_G135957),registration_grade(r855,_G135962),registration_grade(r856,_G135967),student_intelligence(s0,l),student_intelligence(s1,_G135977),student_intelligence(s2,_G135982),student_intelligence(s3,h),student_intelligence(s4,h),student_intelligence(s5,h),student_intelligence(s6,m),student_intelligence(s7,h),student_intelligence(s8,h),student_intelligence(s9,_G136017),student_intelligence(s10,m),student_intelligence(s11,_G136027),student_intelligence(s12,h),student_intelligence(s13,h),student_intelligence(s14,_G136042),student_intelligence(s15,_G136047),student_intelligence(s16,_G136052),student_intelligence(s17,m),student_intelligence(s18,m),student_intelligence(s19,_G136067),student_intelligence(s20,m),student_intelligence(s21,_G136077),student_intelligence(s22,h),student_intelligence(s23,_G136087),student_intelligence(s24,_G136092),student_intelligence(s25,h),student_intelligence(s26,_G136102),student_intelligence(s27,m),student_intelligence(s28,m),student_intelligence(s29,_G136117),student_intelligence(s30,h),student_intelligence(s31,m),student_intelligence(s32,m),student_intelligence(s33,_G136137),student_intelligence(s34,l),student_intelligence(s35,m),student_intelligence(s36,l),student_intelligence(s37,_G136157),student_intelligence(s38,_G136162),student_intelligence(s39,h),student_intelligence(s40,h),student_intelligence(s41,m),student_intelligence(s42,_G136182),student_intelligence(s43,_G136187),student_intelligence(s44,_G136192),student_intelligence(s45,_G136197),student_intelligence(s46,l),student_intelligence(s47,h),student_intelligence(s48,_G136212),student_intelligence(s49,_G136217),student_intelligence(s50,_G136222),student_intelligence(s51,_G136227),student_intelligence(s52,_G136232),student_intelligence(s53,m),student_intelligence(s54,_G136242),student_intelligence(s55,h),student_intelligence(s56,l),student_intelligence(s57,_G136257),student_intelligence(s58,h),student_intelligence(s59,_G136267),student_intelligence(s60,m),student_intelligence(s61,h),student_intelligence(s62,_G136282),student_intelligence(s63,_G136287),student_intelligence(s64,l),student_intelligence(s65,_G136297),student_intelligence(s66,h),student_intelligence(s67,m),student_intelligence(s68,_G136312),student_intelligence(s69,_G136317),student_intelligence(s70,_G136322),student_intelligence(s71,m),student_intelligence(s72,_G136332),student_intelligence(s73,_G136337),student_intelligence(s74,_G136342),student_intelligence(s75,h),student_intelligence(s76,h),student_intelligence(s77,h),student_intelligence(s78,_G136362),student_intelligence(s79,m),student_intelligence(s80,_G136372),student_intelligence(s81,_G136377),student_intelligence(s82,_G136382),student_intelligence(s83,_G136387),student_intelligence(s84,_G136392),student_intelligence(s85,_G136397),student_intelligence(s86,_G136402),student_intelligence(s87,h),student_intelligence(s88,h),student_intelligence(s89,_G136417),student_intelligence(s90,h),student_intelligence(s91,_G136427),student_intelligence(s92,h),student_intelligence(s93,_G136437),student_intelligence(s94,_G136442),student_intelligence(s95,_G136447),student_intelligence(s96,_G136452),student_intelligence(s97,_G136457),student_intelligence(s98,_G136462),student_intelligence(s99,l),student_intelligence(s100,h),student_intelligence(s101,_G136477),student_intelligence(s102,m),student_intelligence(s103,h),student_intelligence(s104,l),student_intelligence(s105,m),student_intelligence(s106,_G136502),student_intelligence(s107,l),student_intelligence(s108,m),student_intelligence(s109,_G136517),student_intelligence(s110,m),student_intelligence(s111,h),student_intelligence(s112,m),student_intelligence(s113,h),student_intelligence(s114,_G136542),student_intelligence(s115,h),student_intelligence(s116,_G136552),student_intelligence(s117,m),student_intelligence(s118,_G136562),student_intelligence(s119,h),student_intelligence(s120,h),student_intelligence(s121,_G136577),student_intelligence(s122,m),student_intelligence(s123,_G136587),student_intelligence(s124,h),student_intelligence(s125,_G136597),student_intelligence(s126,m),student_intelligence(s127,m),student_intelligence(s128,_G136612),student_intelligence(s129,h),student_intelligence(s130,_G136622),student_intelligence(s131,h),student_intelligence(s132,_G136632),student_intelligence(s133,_G136637),student_intelligence(s134,h),student_intelligence(s135,_G136647),student_intelligence(s136,m),student_intelligence(s137,m),student_intelligence(s138,l),student_intelligence(s139,h),student_intelligence(s140,_G136672),student_intelligence(s141,_G136677),student_intelligence(s142,_G136682),student_intelligence(s143,_G136687),student_intelligence(s144,h),student_intelligence(s145,h),student_intelligence(s146,m),student_intelligence(s147,m),student_intelligence(s148,_G136712),student_intelligence(s149,_G136717),student_intelligence(s150,l),student_intelligence(s151,h),student_intelligence(s152,h),student_intelligence(s153,_G136737),student_intelligence(s154,_G136742),student_intelligence(s155,_G136747),student_intelligence(s156,m),student_intelligence(s157,m),student_intelligence(s158,h),student_intelligence(s159,_G136767),student_intelligence(s160,_G136772),student_intelligence(s161,_G136777),student_intelligence(s162,h),student_intelligence(s163,m),student_intelligence(s164,_G136792),student_intelligence(s165,m),student_intelligence(s166,m),student_intelligence(s167,_G136807),student_intelligence(s168,_G136812),student_intelligence(s169,_G136817),student_intelligence(s170,_G136822),student_intelligence(s171,m),student_intelligence(s172,_G136832),student_intelligence(s173,h),student_intelligence(s174,h),student_intelligence(s175,_G136847),student_intelligence(s176,_G136852),student_intelligence(s177,m),student_intelligence(s178,_G136862),student_intelligence(s179,m),student_intelligence(s180,m),student_intelligence(s181,h),student_intelligence(s182,m),student_intelligence(s183,h),student_intelligence(s184,_G136892),student_intelligence(s185,m),student_intelligence(s186,m),student_intelligence(s187,m),student_intelligence(s188,_G136912),student_intelligence(s189,m),student_intelligence(s190,h),student_intelligence(s191,l),student_intelligence(s192,_G136932),student_intelligence(s193,m),student_intelligence(s194,m),student_intelligence(s195,_G136947),student_intelligence(s196,h),student_intelligence(s197,_G136957),student_intelligence(s198,h),student_intelligence(s199,m),student_intelligence(s200,h),student_intelligence(s201,_G136977),student_intelligence(s202,h),student_intelligence(s203,m),student_intelligence(s204,h),student_intelligence(s205,_G136997),student_intelligence(s206,_G137002),student_intelligence(s207,h),student_intelligence(s208,_G137012),student_intelligence(s209,h),student_intelligence(s210,_G137022),student_intelligence(s211,_G137027),student_intelligence(s212,m),student_intelligence(s213,h),student_intelligence(s214,h),student_intelligence(s215,_G137047),student_intelligence(s216,h),student_intelligence(s217,_G137057),student_intelligence(s218,h),student_intelligence(s219,_G137067),student_intelligence(s220,_G137072),student_intelligence(s221,h),student_intelligence(s222,_G137082),student_intelligence(s223,_G137087),student_intelligence(s224,l),student_intelligence(s225,l),student_intelligence(s226,m),student_intelligence(s227,_G137107),student_intelligence(s228,h),student_intelligence(s229,_G137117),student_intelligence(s230,_G137122),student_intelligence(s231,_G137127),student_intelligence(s232,m),student_intelligence(s233,_G137137),student_intelligence(s234,_G137142),student_intelligence(s235,_G137147),student_intelligence(s236,_G137152),student_intelligence(s237,h),student_intelligence(s238,h),student_intelligence(s239,h),student_intelligence(s240,_G137172),student_intelligence(s241,_G137177),student_intelligence(s242,l),student_intelligence(s243,_G137187),student_intelligence(s244,_G137192),student_intelligence(s245,l),student_intelligence(s246,_G137202),student_intelligence(s247,h),student_intelligence(s248,m),student_intelligence(s249,_G137217),student_intelligence(s250,m),student_intelligence(s251,_G137227),student_intelligence(s252,_G137232),student_intelligence(s253,m),student_intelligence(s254,_G137242),student_intelligence(s255,m),course_difficulty(c0,_G137252),course_difficulty(c1,m),course_difficulty(c2,_G137262),course_difficulty(c3,_G137267),course_difficulty(c4,_G137272),course_difficulty(c5,l),course_difficulty(c6,m),course_difficulty(c7,h),course_difficulty(c8,h),course_difficulty(c9,_G137297),course_difficulty(c10,m),course_difficulty(c11,_G137307),course_difficulty(c12,m),course_difficulty(c13,_G137317),course_difficulty(c14,m),course_difficulty(c15,_G137327),course_difficulty(c16,l),course_difficulty(c17,h),course_difficulty(c18,_G137342),course_difficulty(c19,l),course_difficulty(c20,_G137352),course_difficulty(c21,_G137357),course_difficulty(c22,_G137362),course_difficulty(c23,_G137367),course_difficulty(c24,_G137372),course_difficulty(c25,m),course_difficulty(c26,_G137382),course_difficulty(c27,_G137387),course_difficulty(c28,m),course_difficulty(c29,_G137397),course_difficulty(c30,_G137402),course_difficulty(c31,m),course_difficulty(c32,l),course_difficulty(c33,m),course_difficulty(c34,_G137422),course_difficulty(c35,_G137427),course_difficulty(c36,h),course_difficulty(c37,m),course_difficulty(c38,m),course_difficulty(c39,_G137447),course_difficulty(c40,h),course_difficulty(c41,_G137457),course_difficulty(c42,_G137462),course_difficulty(c43,m),course_difficulty(c44,m),course_difficulty(c45,_G137477),course_difficulty(c46,m),course_difficulty(c47,_G137487),course_difficulty(c48,m),course_difficulty(c49,l),course_difficulty(c50,_G137502),course_difficulty(c51,h),course_difficulty(c52,_G137512),course_difficulty(c53,_G137517),course_difficulty(c54,_G137522),course_difficulty(c55,h),course_difficulty(c56,_G137532),course_difficulty(c57,_G137537),course_difficulty(c58,_G137542),course_difficulty(c59,m),course_difficulty(c60,_G137552),course_difficulty(c61,m),course_difficulty(c62,l),course_difficulty(c63,_G137567),registration_satisfaction(r0,_G137572),registration_satisfaction(r1,l),registration_satisfaction(r2,_G137582),registration_satisfaction(r3,_G137587),registration_satisfaction(r4,h),registration_satisfaction(r5,h),registration_satisfaction(r6,_G137602),registration_satisfaction(r7,h),registration_satisfaction(r8,_G137612),registration_satisfaction(r9,h),registration_satisfaction(r10,_G137622),registration_satisfaction(r11,_G137627),registration_satisfaction(r12,_G137632),registration_satisfaction(r13,h),registration_satisfaction(r14,m),registration_satisfaction(r15,h),registration_satisfaction(r16,h),registration_satisfaction(r17,l),registration_satisfaction(r18,l),registration_satisfaction(r19,_G137667),registration_satisfaction(r20,_G137672),registration_satisfaction(r21,_G137677),registration_satisfaction(r22,h),registration_satisfaction(r23,_G137687),registration_satisfaction(r24,_G137692),registration_satisfaction(r25,_G137697),registration_satisfaction(r26,_G137702),registration_satisfaction(r27,_G137707),registration_satisfaction(r28,h),registration_satisfaction(r29,_G137717),registration_satisfaction(r30,l),registration_satisfaction(r31,_G137727),registration_satisfaction(r32,_G137732),registration_satisfaction(r33,h),registration_satisfaction(r34,_G137742),registration_satisfaction(r35,h),registration_satisfaction(r36,m),registration_satisfaction(r37,h),registration_satisfaction(r38,_G137762),registration_satisfaction(r39,h),registration_satisfaction(r40,_G137772),registration_satisfaction(r41,_G137777),registration_satisfaction(r42,_G137782),registration_satisfaction(r43,h),registration_satisfaction(r44,_G137792),registration_satisfaction(r45,h),registration_satisfaction(r46,m),registration_satisfaction(r47,_G137807),registration_satisfaction(r48,_G137812),registration_satisfaction(r49,h),registration_satisfaction(r50,_G137822),registration_satisfaction(r51,_G137827),registration_satisfaction(r52,h),registration_satisfaction(r53,_G137837),registration_satisfaction(r54,h),registration_satisfaction(r55,h),registration_satisfaction(r56,_G137852),registration_satisfaction(r57,h),registration_satisfaction(r58,_G137862),registration_satisfaction(r59,_G137867),registration_satisfaction(r60,h),registration_satisfaction(r61,h),registration_satisfaction(r62,h),registration_satisfaction(r63,h),registration_satisfaction(r64,h),registration_satisfaction(r65,h),registration_satisfaction(r66,h),registration_satisfaction(r67,_G137907),registration_satisfaction(r68,h),registration_satisfaction(r69,m),registration_satisfaction(r70,_G137922),registration_satisfaction(r71,_G137927),registration_satisfaction(r72,_G137932),registration_satisfaction(r73,h),registration_satisfaction(r74,h),registration_satisfaction(r75,h),registration_satisfaction(r76,_G137952),registration_satisfaction(r77,_G137957),registration_satisfaction(r78,m),registration_satisfaction(r79,h),registration_satisfaction(r80,h),registration_satisfaction(r81,h),registration_satisfaction(r82,l),registration_satisfaction(r83,_G137987),registration_satisfaction(r84,m),registration_satisfaction(r85,h),registration_satisfaction(r86,_G138002),registration_satisfaction(r87,_G138007),registration_satisfaction(r88,h),registration_satisfaction(r89,_G138017),registration_satisfaction(r90,_G138022),registration_satisfaction(r91,h),registration_satisfaction(r92,_G138032),registration_satisfaction(r93,_G138037),registration_satisfaction(r94,l),registration_satisfaction(r95,_G138047),registration_satisfaction(r96,h),registration_satisfaction(r97,_G138057),registration_satisfaction(r98,h),registration_satisfaction(r99,h),registration_satisfaction(r100,_G138072),registration_satisfaction(r101,_G138077),registration_satisfaction(r102,h),registration_satisfaction(r103,h),registration_satisfaction(r104,h),registration_satisfaction(r105,_G138097),registration_satisfaction(r106,_G138102),registration_satisfaction(r107,l),registration_satisfaction(r108,l),registration_satisfaction(r109,h),registration_satisfaction(r110,_G138122),registration_satisfaction(r111,h),registration_satisfaction(r112,_G138132),registration_satisfaction(r113,_G138137),registration_satisfaction(r114,m),registration_satisfaction(r115,_G138147),registration_satisfaction(r116,h),registration_satisfaction(r117,_G138157),registration_satisfaction(r118,h),registration_satisfaction(r119,h),registration_satisfaction(r120,l),registration_satisfaction(r121,_G138177),registration_satisfaction(r122,_G138182),registration_satisfaction(r123,l),registration_satisfaction(r124,_G138192),registration_satisfaction(r125,m),registration_satisfaction(r126,h),registration_satisfaction(r127,h),registration_satisfaction(r128,h),registration_satisfaction(r129,h),registration_satisfaction(r130,h),registration_satisfaction(r131,_G138227),registration_satisfaction(r132,m),registration_satisfaction(r133,_G138237),registration_satisfaction(r134,m),registration_satisfaction(r135,_G138247),registration_satisfaction(r136,h),registration_satisfaction(r137,h),registration_satisfaction(r138,h),registration_satisfaction(r139,_G138267),registration_satisfaction(r140,h),registration_satisfaction(r141,_G138277),registration_satisfaction(r142,h),registration_satisfaction(r143,h),registration_satisfaction(r144,h),registration_satisfaction(r145,l),registration_satisfaction(r146,_G138302),registration_satisfaction(r147,l),registration_satisfaction(r148,m),registration_satisfaction(r149,h),registration_satisfaction(r150,_G138322),registration_satisfaction(r151,_G138327),registration_satisfaction(r152,h),registration_satisfaction(r153,_G138337),registration_satisfaction(r154,_G138342),registration_satisfaction(r155,m),registration_satisfaction(r156,h),registration_satisfaction(r157,_G138357),registration_satisfaction(r158,l),registration_satisfaction(r159,m),registration_satisfaction(r160,h),registration_satisfaction(r161,_G138377),registration_satisfaction(r162,m),registration_satisfaction(r163,_G138387),registration_satisfaction(r164,m),registration_satisfaction(r165,m),registration_satisfaction(r166,l),registration_satisfaction(r167,_G138407),registration_satisfaction(r168,h),registration_satisfaction(r169,h),registration_satisfaction(r170,_G138422),registration_satisfaction(r171,_G138427),registration_satisfaction(r172,h),registration_satisfaction(r173,_G138437),registration_satisfaction(r174,_G138442),registration_satisfaction(r175,_G138447),registration_satisfaction(r176,h),registration_satisfaction(r177,h),registration_satisfaction(r178,h),registration_satisfaction(r179,l),registration_satisfaction(r180,_G138472),registration_satisfaction(r181,_G138477),registration_satisfaction(r182,_G138482),registration_satisfaction(r183,_G138487),registration_satisfaction(r184,_G138492),registration_satisfaction(r185,_G138497),registration_satisfaction(r186,_G138502),registration_satisfaction(r187,h),registration_satisfaction(r188,m),registration_satisfaction(r189,_G138517),registration_satisfaction(r190,h),registration_satisfaction(r191,h),registration_satisfaction(r192,m),registration_satisfaction(r193,h),registration_satisfaction(r194,_G138542),registration_satisfaction(r195,_G138547),registration_satisfaction(r196,_G138552),registration_satisfaction(r197,h),registration_satisfaction(r198,h),registration_satisfaction(r199,h),registration_satisfaction(r200,_G138572),registration_satisfaction(r201,h),registration_satisfaction(r202,_G138582),registration_satisfaction(r203,_G138587),registration_satisfaction(r204,_G138592),registration_satisfaction(r205,_G138597),registration_satisfaction(r206,h),registration_satisfaction(r207,h),registration_satisfaction(r208,h),registration_satisfaction(r209,h),registration_satisfaction(r210,_G138622),registration_satisfaction(r211,_G138627),registration_satisfaction(r212,h),registration_satisfaction(r213,_G138637),registration_satisfaction(r214,_G138642),registration_satisfaction(r215,h),registration_satisfaction(r216,h),registration_satisfaction(r217,h),registration_satisfaction(r218,m),registration_satisfaction(r219,h),registration_satisfaction(r220,h),registration_satisfaction(r221,_G138677),registration_satisfaction(r222,_G138682),registration_satisfaction(r223,h),registration_satisfaction(r224,h),registration_satisfaction(r225,_G138697),registration_satisfaction(r226,_G138702),registration_satisfaction(r227,h),registration_satisfaction(r228,_G138712),registration_satisfaction(r229,l),registration_satisfaction(r230,h),registration_satisfaction(r231,_G138727),registration_satisfaction(r232,h),registration_satisfaction(r233,m),registration_satisfaction(r234,_G138742),registration_satisfaction(r235,h),registration_satisfaction(r236,_G138752),registration_satisfaction(r237,_G138757),registration_satisfaction(r238,m),registration_satisfaction(r239,m),registration_satisfaction(r240,h),registration_satisfaction(r241,h),registration_satisfaction(r242,m),registration_satisfaction(r243,_G138787),registration_satisfaction(r244,_G138792),registration_satisfaction(r245,_G138797),registration_satisfaction(r246,h),registration_satisfaction(r247,_G138807),registration_satisfaction(r248,_G138812),registration_satisfaction(r249,h),registration_satisfaction(r250,h),registration_satisfaction(r251,h),registration_satisfaction(r252,h),registration_satisfaction(r253,h),registration_satisfaction(r254,h),registration_satisfaction(r255,h),registration_satisfaction(r256,_G138852),registration_satisfaction(r257,m),registration_satisfaction(r258,h),registration_satisfaction(r259,_G138867),registration_satisfaction(r260,_G138872),registration_satisfaction(r261,_G138877),registration_satisfaction(r262,h),registration_satisfaction(r263,m),registration_satisfaction(r264,_G138892),registration_satisfaction(r265,_G138897),registration_satisfaction(r266,l),registration_satisfaction(r267,_G138907),registration_satisfaction(r268,_G138912),registration_satisfaction(r269,_G138917),registration_satisfaction(r270,l),registration_satisfaction(r271,h),registration_satisfaction(r272,_G138932),registration_satisfaction(r273,h),registration_satisfaction(r274,h),registration_satisfaction(r275,_G138947),registration_satisfaction(r276,_G138952),registration_satisfaction(r277,h),registration_satisfaction(r278,h),registration_satisfaction(r279,_G138967),registration_satisfaction(r280,_G138972),registration_satisfaction(r281,_G138977),registration_satisfaction(r282,_G138982),registration_satisfaction(r283,_G138987),registration_satisfaction(r284,_G138992),registration_satisfaction(r285,m),registration_satisfaction(r286,h),registration_satisfaction(r287,_G139007),registration_satisfaction(r288,_G139012),registration_satisfaction(r289,l),registration_satisfaction(r290,m),registration_satisfaction(r291,h),registration_satisfaction(r292,m),registration_satisfaction(r293,_G139037),registration_satisfaction(r294,h),registration_satisfaction(r295,_G139047),registration_satisfaction(r296,_G139052),registration_satisfaction(r297,_G139057),registration_satisfaction(r298,_G139062),registration_satisfaction(r299,_G139067),registration_satisfaction(r300,l),registration_satisfaction(r301,_G139077),registration_satisfaction(r302,_G139082),registration_satisfaction(r303,h),registration_satisfaction(r304,h),registration_satisfaction(r305,_G139097),registration_satisfaction(r306,_G139102),registration_satisfaction(r307,_G139107),registration_satisfaction(r308,l),registration_satisfaction(r309,m),registration_satisfaction(r310,_G139122),registration_satisfaction(r311,_G139127),registration_satisfaction(r312,h),registration_satisfaction(r313,_G139137),registration_satisfaction(r314,h),registration_satisfaction(r315,h),registration_satisfaction(r316,l),registration_satisfaction(r317,l),registration_satisfaction(r318,_G139162),registration_satisfaction(r319,_G139167),registration_satisfaction(r320,_G139172),registration_satisfaction(r321,l),registration_satisfaction(r322,h),registration_satisfaction(r323,_G139187),registration_satisfaction(r324,h),registration_satisfaction(r325,h),registration_satisfaction(r326,_G139202),registration_satisfaction(r327,m),registration_satisfaction(r328,h),registration_satisfaction(r329,h),registration_satisfaction(r330,_G139222),registration_satisfaction(r331,h),registration_satisfaction(r332,l),registration_satisfaction(r333,_G139237),registration_satisfaction(r334,_G139242),registration_satisfaction(r335,h),registration_satisfaction(r336,_G139252),registration_satisfaction(r337,h),registration_satisfaction(r338,h),registration_satisfaction(r339,_G139267),registration_satisfaction(r340,_G139272),registration_satisfaction(r341,l),registration_satisfaction(r342,h),registration_satisfaction(r343,_G139287),registration_satisfaction(r344,_G139292),registration_satisfaction(r345,m),registration_satisfaction(r346,h),registration_satisfaction(r347,m),registration_satisfaction(r348,_G139312),registration_satisfaction(r349,h),registration_satisfaction(r350,m),registration_satisfaction(r351,_G139327),registration_satisfaction(r352,l),registration_satisfaction(r353,h),registration_satisfaction(r354,h),registration_satisfaction(r355,_G139347),registration_satisfaction(r356,_G139352),registration_satisfaction(r357,m),registration_satisfaction(r358,_G139362),registration_satisfaction(r359,_G139367),registration_satisfaction(r360,_G139372),registration_satisfaction(r361,m),registration_satisfaction(r362,_G139382),registration_satisfaction(r363,_G139387),registration_satisfaction(r364,_G139392),registration_satisfaction(r365,_G139397),registration_satisfaction(r366,h),registration_satisfaction(r367,h),registration_satisfaction(r368,h),registration_satisfaction(r369,h),registration_satisfaction(r370,_G139422),registration_satisfaction(r371,_G139427),registration_satisfaction(r372,h),registration_satisfaction(r373,h),registration_satisfaction(r374,_G139442),registration_satisfaction(r375,h),registration_satisfaction(r376,_G139452),registration_satisfaction(r377,_G139457),registration_satisfaction(r378,_G139462),registration_satisfaction(r379,h),registration_satisfaction(r380,_G139472),registration_satisfaction(r381,_G139477),registration_satisfaction(r382,h),registration_satisfaction(r383,h),registration_satisfaction(r384,_G139492),registration_satisfaction(r385,m),registration_satisfaction(r386,_G139502),registration_satisfaction(r387,h),registration_satisfaction(r388,_G139512),registration_satisfaction(r389,_G139517),registration_satisfaction(r390,_G139522),registration_satisfaction(r391,l),registration_satisfaction(r392,_G139532),registration_satisfaction(r393,_G139537),registration_satisfaction(r394,h),registration_satisfaction(r395,_G139547),registration_satisfaction(r396,h),registration_satisfaction(r397,h),registration_satisfaction(r398,l),registration_satisfaction(r399,h),registration_satisfaction(r400,_G139572),registration_satisfaction(r401,l),registration_satisfaction(r402,h),registration_satisfaction(r403,h),registration_satisfaction(r404,h),registration_satisfaction(r405,h),registration_satisfaction(r406,_G139602),registration_satisfaction(r407,_G139607),registration_satisfaction(r408,_G139612),registration_satisfaction(r409,h),registration_satisfaction(r410,h),registration_satisfaction(r411,_G139627),registration_satisfaction(r412,_G139632),registration_satisfaction(r413,l),registration_satisfaction(r414,h),registration_satisfaction(r415,m),registration_satisfaction(r416,_G139652),registration_satisfaction(r417,h),registration_satisfaction(r418,_G139662),registration_satisfaction(r419,_G139667),registration_satisfaction(r420,_G139672),registration_satisfaction(r421,_G139677),registration_satisfaction(r422,_G139682),registration_satisfaction(r423,_G139687),registration_satisfaction(r424,h),registration_satisfaction(r425,h),registration_satisfaction(r426,_G139702),registration_satisfaction(r427,_G139707),registration_satisfaction(r428,_G139712),registration_satisfaction(r429,_G139717),registration_satisfaction(r430,l),registration_satisfaction(r431,m),registration_satisfaction(r432,_G139732),registration_satisfaction(r433,_G139737),registration_satisfaction(r434,h),registration_satisfaction(r435,m),registration_satisfaction(r436,_G139752),registration_satisfaction(r437,h),registration_satisfaction(r438,l),registration_satisfaction(r439,_G139767),registration_satisfaction(r440,h),registration_satisfaction(r441,h),registration_satisfaction(r442,_G139782),registration_satisfaction(r443,_G139787),registration_satisfaction(r444,_G139792),registration_satisfaction(r445,_G139797),registration_satisfaction(r446,h),registration_satisfaction(r447,m),registration_satisfaction(r448,l),registration_satisfaction(r449,_G139817),registration_satisfaction(r450,h),registration_satisfaction(r451,_G139827),registration_satisfaction(r452,_G139832),registration_satisfaction(r453,_G139837),registration_satisfaction(r454,_G139842),registration_satisfaction(r455,_G139847),registration_satisfaction(r456,h),registration_satisfaction(r457,h),registration_satisfaction(r458,_G139862),registration_satisfaction(r459,_G139867),registration_satisfaction(r460,l),registration_satisfaction(r461,h),registration_satisfaction(r462,h),registration_satisfaction(r463,_G139887),registration_satisfaction(r464,_G139892),registration_satisfaction(r465,_G139897),registration_satisfaction(r466,l),registration_satisfaction(r467,_G139907),registration_satisfaction(r468,_G139912),registration_satisfaction(r469,h),registration_satisfaction(r470,h),registration_satisfaction(r471,_G139927),registration_satisfaction(r472,_G139932),registration_satisfaction(r473,_G139937),registration_satisfaction(r474,_G139942),registration_satisfaction(r475,h),registration_satisfaction(r476,_G139952),registration_satisfaction(r477,_G139957),registration_satisfaction(r478,_G139962),registration_satisfaction(r479,_G139967),registration_satisfaction(r480,_G139972),registration_satisfaction(r481,_G139977),registration_satisfaction(r482,_G139982),registration_satisfaction(r483,h),registration_satisfaction(r484,_G139992),registration_satisfaction(r485,h),registration_satisfaction(r486,h),registration_satisfaction(r487,_G140007),registration_satisfaction(r488,_G140012),registration_satisfaction(r489,m),registration_satisfaction(r490,_G140022),registration_satisfaction(r491,_G140027),registration_satisfaction(r492,h),registration_satisfaction(r493,_G140037),registration_satisfaction(r494,_G140042),registration_satisfaction(r495,h),registration_satisfaction(r496,h),registration_satisfaction(r497,_G140057),registration_satisfaction(r498,_G140062),registration_satisfaction(r499,h),registration_satisfaction(r500,m),registration_satisfaction(r501,h),registration_satisfaction(r502,_G140082),registration_satisfaction(r503,_G140087),registration_satisfaction(r504,m),registration_satisfaction(r505,_G140097),registration_satisfaction(r506,_G140102),registration_satisfaction(r507,_G140107),registration_satisfaction(r508,_G140112),registration_satisfaction(r509,_G140117),registration_satisfaction(r510,_G140122),registration_satisfaction(r511,l),registration_satisfaction(r512,h),registration_satisfaction(r513,h),registration_satisfaction(r514,_G140142),registration_satisfaction(r515,_G140147),registration_satisfaction(r516,_G140152),registration_satisfaction(r517,m),registration_satisfaction(r518,_G140162),registration_satisfaction(r519,h),registration_satisfaction(r520,_G140172),registration_satisfaction(r521,h),registration_satisfaction(r522,h),registration_satisfaction(r523,h),registration_satisfaction(r524,h),registration_satisfaction(r525,_G140197),registration_satisfaction(r526,h),registration_satisfaction(r527,_G140207),registration_satisfaction(r528,_G140212),registration_satisfaction(r529,h),registration_satisfaction(r530,_G140222),registration_satisfaction(r531,_G140227),registration_satisfaction(r532,_G140232),registration_satisfaction(r533,_G140237),registration_satisfaction(r534,l),registration_satisfaction(r535,_G140247),registration_satisfaction(r536,h),registration_satisfaction(r537,h),registration_satisfaction(r538,_G140262),registration_satisfaction(r539,_G140267),registration_satisfaction(r540,_G140272),registration_satisfaction(r541,_G140277),registration_satisfaction(r542,h),registration_satisfaction(r543,h),registration_satisfaction(r544,_G140292),registration_satisfaction(r545,h),registration_satisfaction(r546,_G140302),registration_satisfaction(r547,_G140307),registration_satisfaction(r548,h),registration_satisfaction(r549,_G140317),registration_satisfaction(r550,_G140322),registration_satisfaction(r551,h),registration_satisfaction(r552,m),registration_satisfaction(r553,m),registration_satisfaction(r554,l),registration_satisfaction(r555,m),registration_satisfaction(r556,_G140352),registration_satisfaction(r557,_G140357),registration_satisfaction(r558,_G140362),registration_satisfaction(r559,_G140367),registration_satisfaction(r560,_G140372),registration_satisfaction(r561,_G140377),registration_satisfaction(r562,h),registration_satisfaction(r563,_G140387),registration_satisfaction(r564,h),registration_satisfaction(r565,_G140397),registration_satisfaction(r566,l),registration_satisfaction(r567,_G140407),registration_satisfaction(r568,h),registration_satisfaction(r569,h),registration_satisfaction(r570,h),registration_satisfaction(r571,_G140427),registration_satisfaction(r572,_G140432),registration_satisfaction(r573,_G140437),registration_satisfaction(r574,_G140442),registration_satisfaction(r575,_G140447),registration_satisfaction(r576,_G140452),registration_satisfaction(r577,_G140457),registration_satisfaction(r578,l),registration_satisfaction(r579,h),registration_satisfaction(r580,m),registration_satisfaction(r581,h),registration_satisfaction(r582,h),registration_satisfaction(r583,h),registration_satisfaction(r584,h),registration_satisfaction(r585,h),registration_satisfaction(r586,_G140502),registration_satisfaction(r587,_G140507),registration_satisfaction(r588,_G140512),registration_satisfaction(r589,l),registration_satisfaction(r590,h),registration_satisfaction(r591,_G140527),registration_satisfaction(r592,_G140532),registration_satisfaction(r593,_G140537),registration_satisfaction(r594,l),registration_satisfaction(r595,m),registration_satisfaction(r596,h),registration_satisfaction(r597,_G140557),registration_satisfaction(r598,_G140562),registration_satisfaction(r599,h),registration_satisfaction(r600,_G140572),registration_satisfaction(r601,m),registration_satisfaction(r602,h),registration_satisfaction(r603,_G140587),registration_satisfaction(r604,_G140592),registration_satisfaction(r605,h),registration_satisfaction(r606,h),registration_satisfaction(r607,l),registration_satisfaction(r608,_G140612),registration_satisfaction(r609,h),registration_satisfaction(r610,_G140622),registration_satisfaction(r611,h),registration_satisfaction(r612,l),registration_satisfaction(r613,_G140637),registration_satisfaction(r614,_G140642),registration_satisfaction(r615,_G140647),registration_satisfaction(r616,h),registration_satisfaction(r617,h),registration_satisfaction(r618,h),registration_satisfaction(r619,h),registration_satisfaction(r620,_G140672),registration_satisfaction(r621,_G140677),registration_satisfaction(r622,h),registration_satisfaction(r623,_G140687),registration_satisfaction(r624,_G140692),registration_satisfaction(r625,l),registration_satisfaction(r626,_G140702),registration_satisfaction(r627,h),registration_satisfaction(r628,h),registration_satisfaction(r629,h),registration_satisfaction(r630,h),registration_satisfaction(r631,h),registration_satisfaction(r632,h),registration_satisfaction(r633,_G140737),registration_satisfaction(r634,_G140742),registration_satisfaction(r635,_G140747),registration_satisfaction(r636,_G140752),registration_satisfaction(r637,_G140757),registration_satisfaction(r638,h),registration_satisfaction(r639,_G140767),registration_satisfaction(r640,h),registration_satisfaction(r641,h),registration_satisfaction(r642,_G140782),registration_satisfaction(r643,_G140787),registration_satisfaction(r644,h),registration_satisfaction(r645,_G140797),registration_satisfaction(r646,h),registration_satisfaction(r647,h),registration_satisfaction(r648,_G140812),registration_satisfaction(r649,_G140817),registration_satisfaction(r650,_G140822),registration_satisfaction(r651,_G140827),registration_satisfaction(r652,_G140832),registration_satisfaction(r653,_G140837),registration_satisfaction(r654,h),registration_satisfaction(r655,h),registration_satisfaction(r656,m),registration_satisfaction(r657,_G140857),registration_satisfaction(r658,h),registration_satisfaction(r659,h),registration_satisfaction(r660,h),registration_satisfaction(r661,_G140877),registration_satisfaction(r662,_G140882),registration_satisfaction(r663,h),registration_satisfaction(r664,_G140892),registration_satisfaction(r665,h),registration_satisfaction(r666,l),registration_satisfaction(r667,h),registration_satisfaction(r668,l),registration_satisfaction(r669,_G140917),registration_satisfaction(r670,h),registration_satisfaction(r671,_G140927),registration_satisfaction(r672,_G140932),registration_satisfaction(r673,_G140937),registration_satisfaction(r674,h),registration_satisfaction(r675,l),registration_satisfaction(r676,_G140952),registration_satisfaction(r677,_G140957),registration_satisfaction(r678,h),registration_satisfaction(r679,h),registration_satisfaction(r680,m),registration_satisfaction(r681,_G140977),registration_satisfaction(r682,_G140982),registration_satisfaction(r683,h),registration_satisfaction(r684,_G140992),registration_satisfaction(r685,h),registration_satisfaction(r686,h),registration_satisfaction(r687,_G141007),registration_satisfaction(r688,_G141012),registration_satisfaction(r689,_G141017),registration_satisfaction(r690,h),registration_satisfaction(r691,h),registration_satisfaction(r692,h),registration_satisfaction(r693,_G141037),registration_satisfaction(r694,h),registration_satisfaction(r695,_G141047),registration_satisfaction(r696,_G141052),registration_satisfaction(r697,_G141057),registration_satisfaction(r698,h),registration_satisfaction(r699,h),registration_satisfaction(r700,_G141072),registration_satisfaction(r701,h),registration_satisfaction(r702,_G141082),registration_satisfaction(r703,_G141087),registration_satisfaction(r704,l),registration_satisfaction(r705,_G141097),registration_satisfaction(r706,_G141102),registration_satisfaction(r707,_G141107),registration_satisfaction(r708,_G141112),registration_satisfaction(r709,m),registration_satisfaction(r710,l),registration_satisfaction(r711,h),registration_satisfaction(r712,h),registration_satisfaction(r713,h),registration_satisfaction(r714,m),registration_satisfaction(r715,_G141147),registration_satisfaction(r716,h),registration_satisfaction(r717,h),registration_satisfaction(r718,l),registration_satisfaction(r719,l),registration_satisfaction(r720,_G141172),registration_satisfaction(r721,h),registration_satisfaction(r722,h),registration_satisfaction(r723,h),registration_satisfaction(r724,h),registration_satisfaction(r725,_G141197),registration_satisfaction(r726,h),registration_satisfaction(r727,_G141207),registration_satisfaction(r728,_G141212),registration_satisfaction(r729,_G141217),registration_satisfaction(r730,h),registration_satisfaction(r731,h),registration_satisfaction(r732,_G141232),registration_satisfaction(r733,_G141237),registration_satisfaction(r734,h),registration_satisfaction(r735,h),registration_satisfaction(r736,_G141252),registration_satisfaction(r737,h),registration_satisfaction(r738,_G141262),registration_satisfaction(r739,h),registration_satisfaction(r740,h),registration_satisfaction(r741,h),registration_satisfaction(r742,h),registration_satisfaction(r743,_G141287),registration_satisfaction(r744,_G141292),registration_satisfaction(r745,m),registration_satisfaction(r746,h),registration_satisfaction(r747,_G141307),registration_satisfaction(r748,_G141312),registration_satisfaction(r749,_G141317),registration_satisfaction(r750,_G141322),registration_satisfaction(r751,_G141327),registration_satisfaction(r752,m),registration_satisfaction(r753,m),registration_satisfaction(r754,_G141342),registration_satisfaction(r755,l),registration_satisfaction(r756,_G141352),registration_satisfaction(r757,h),registration_satisfaction(r758,h),registration_satisfaction(r759,l),registration_satisfaction(r760,_G141372),registration_satisfaction(r761,h),registration_satisfaction(r762,_G141382),registration_satisfaction(r763,_G141387),registration_satisfaction(r764,_G141392),registration_satisfaction(r765,h),registration_satisfaction(r766,_G141402),registration_satisfaction(r767,_G141407),registration_satisfaction(r768,_G141412),registration_satisfaction(r769,_G141417),registration_satisfaction(r770,m),registration_satisfaction(r771,_G141427),registration_satisfaction(r772,_G141432),registration_satisfaction(r773,m),registration_satisfaction(r774,h),registration_satisfaction(r775,h),registration_satisfaction(r776,_G141452),registration_satisfaction(r777,_G141457),registration_satisfaction(r778,h),registration_satisfaction(r779,_G141467),registration_satisfaction(r780,h),registration_satisfaction(r781,m),registration_satisfaction(r782,m),registration_satisfaction(r783,m),registration_satisfaction(r784,l),registration_satisfaction(r785,l),registration_satisfaction(r786,h),registration_satisfaction(r787,h),registration_satisfaction(r788,_G141512),registration_satisfaction(r789,_G141517),registration_satisfaction(r790,_G141522),registration_satisfaction(r791,h),registration_satisfaction(r792,_G141532),registration_satisfaction(r793,_G141537),registration_satisfaction(r794,_G141542),registration_satisfaction(r795,_G141547),registration_satisfaction(r796,h),registration_satisfaction(r797,h),registration_satisfaction(r798,m),registration_satisfaction(r799,_G141567),registration_satisfaction(r800,m),registration_satisfaction(r801,h),registration_satisfaction(r802,h),registration_satisfaction(r803,h),registration_satisfaction(r804,_G141592),registration_satisfaction(r805,_G141597),registration_satisfaction(r806,_G141602),registration_satisfaction(r807,_G141607),registration_satisfaction(r808,_G141612),registration_satisfaction(r809,_G141617),registration_satisfaction(r810,h),registration_satisfaction(r811,_G141627),registration_satisfaction(r812,h),registration_satisfaction(r813,m),registration_satisfaction(r814,l),registration_satisfaction(r815,_G141647),registration_satisfaction(r816,_G141652),registration_satisfaction(r817,_G141657),registration_satisfaction(r818,_G141662),registration_satisfaction(r819,h),registration_satisfaction(r820,h),registration_satisfaction(r821,_G141677),registration_satisfaction(r822,m),registration_satisfaction(r823,_G141687),registration_satisfaction(r824,m),registration_satisfaction(r825,l),registration_satisfaction(r826,l),registration_satisfaction(r827,l),registration_satisfaction(r828,_G141712),registration_satisfaction(r829,_G141717),registration_satisfaction(r830,h),registration_satisfaction(r831,_G141727),registration_satisfaction(r832,m),registration_satisfaction(r833,_G141737),registration_satisfaction(r834,_G141742),registration_satisfaction(r835,_G141747),registration_satisfaction(r836,h),registration_satisfaction(r837,h),registration_satisfaction(r838,l),registration_satisfaction(r839,_G141767),registration_satisfaction(r840,m),registration_satisfaction(r841,_G141777),registration_satisfaction(r842,_G141782),registration_satisfaction(r843,h),registration_satisfaction(r844,_G141792),registration_satisfaction(r845,_G141797),registration_satisfaction(r846,_G141802),registration_satisfaction(r847,_G141807),registration_satisfaction(r848,l),registration_satisfaction(r849,_G141817),registration_satisfaction(r850,_G141822),registration_satisfaction(r851,h),registration_satisfaction(r852,h),registration_satisfaction(r853,h),registration_satisfaction(r854,m),registration_satisfaction(r855,_G141847),registration_satisfaction(r856,_G141852)]). + + % % change to 0.0, 0.1, 0.2 to make things simpler/harder % -missing(0.50). +missing(0.5). % miss 30% of the examples. goal(professor_ability(P,V)) :- diff --git a/packages/CLPBN/learning/learn_utils.yap b/packages/CLPBN/learning/learn_utils.yap index 9d0523dd9..713f19da4 100644 --- a/packages/CLPBN/learning/learn_utils.yap +++ b/packages/CLPBN/learning/learn_utils.yap @@ -38,7 +38,7 @@ run_all(M:Gs) :- run_all([],_). run_all([G|Gs],M) :- % (G = _:ge(ybr136w,t8,23,-1) -> nb_getval(clpbn_tables, Tab), writeln(Tab) ; true ), - ( call(M:G) -> true ; writeln(bad:M:G), start_low_level_trace, M:G ; halt ), + ( call(M:G) -> true ; throw(bad_call(M:G)) ), run_all(Gs,M). clpbn_vars(Vs,BVars) :- diff --git a/packages/PLStream/pl-incl.h b/packages/PLStream/pl-incl.h index a2ceba132..80e3d5a82 100755 --- a/packages/PLStream/pl-incl.h +++ b/packages/PLStream/pl-incl.h @@ -43,6 +43,7 @@ do_startCritical(void) { } static inline int do_endCritical(void) { + CACHE_REGS YAPLeaveCriticalSection(); return 1; } diff --git a/packages/PLStream/pl-yap.c b/packages/PLStream/pl-yap.c index ad608fdc5..34550abc0 100755 --- a/packages/PLStream/pl-yap.c +++ b/packages/PLStream/pl-yap.c @@ -1,6 +1,8 @@ /* YAP support for some low-level SWI stuff */ +#define PL_KERNEL 1 + #include #include "Yap.h" #include "Yatom.h" diff --git a/packages/chr b/packages/chr index bf6525f85..b2eb894ce 160000 --- a/packages/chr +++ b/packages/chr @@ -1 +1 @@ -Subproject commit bf6525f85cfcf3c08fff8cf91fb189fe71dc34fd +Subproject commit b2eb894ce3e41925070215f800d6df3a356dc29d diff --git a/packages/meld/examples/pagerank/l4.meld b/packages/meld/examples/pagerank/l4.meld index e727e038c..77d5acc62 100644 --- a/packages/meld/examples/pagerank/l4.meld +++ b/packages/meld/examples/pagerank/l4.meld @@ -1,7 +1,7 @@ %edge(0,1). -%edge(0,4). -%edge(1,4). +edge(0,4). %edge(1,2). -edge(2,3). +edge(1,4). +%edge(2,3). edge(2,4). edge(3,4). diff --git a/packages/meld/examples/pagerank/pagerank.meld b/packages/meld/examples/pagerank/pagerank.meld index 3167955ec..d0c4756e2 100644 --- a/packages/meld/examples/pagerank/pagerank.meld +++ b/packages/meld/examples/pagerank/pagerank.meld @@ -1,6 +1,5 @@ type rank(node, int, float). -type reachable(node, node). type calcRank(node, int, sum float). % type persistent numPages(node, int). type persistent numPages(node, sum int). @@ -8,21 +7,24 @@ type numLinks(node, sum int). type path(node, node). const damping = 0.85. -const num_iterations = 4. +const num_iterations = 100. % extern float to_float(int). % extern float float_abs(float). rank(A, 0, 1.0 / to_float(T)) :- numPages(A,T). rank(A, I, V) :- + numLinks(B,L), numPages(A, Ps), calcRank(A, I, T), - Before = I - 1, - rank(A, Before, VOld), - V = (damping + (1.0 - damping) * T)/to_float(Ps), +% Before = I - 1, +% rank(A, Before, VOld), + V = damping + (1.0 - damping) * T, I =< num_iterations. % //float_abs((damping + (1.0 - damping) * T) - VOld) > 0.001. +calcRank(A, I + 1, 0.0) :- + rank(A, I, _). calcRank(A, I + 1, O / to_float(C)) :- edge(B, A), rank(B, I, O), diff --git a/pl/tabling.yap b/pl/tabling.yap index 53b15ed78..65e5049cc 100644 --- a/pl/tabling.yap +++ b/pl/tabling.yap @@ -17,8 +17,72 @@ tabling_mode(:,?), abolish_table(:), show_table(:), + show_table(?,:), table_statistics(:), - table_statistics(:,:). + table_statistics(?,:). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% show_tabled_predicates/0 %% +%% show_global_trie/0 %% +%% show_all_tables/0 %% +%% show_all_local_tables/0 %% +%% global_trie_statistics/0 %% +%% tabling_statistics/0 %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +show_tabled_predicates :- + current_output(Stream), + show_tabled_predicates(Stream). + +show_global_trie :- + current_output(Stream), + show_global_trie(Stream). + +show_all_tables :- + current_output(Stream), + show_all_tables(Stream). + +show_all_local_tables :- + current_output(Stream), + show_all_local_tables(Stream). + +global_trie_statistics :- + current_output(Stream), + global_trie_statistics(Stream). + +tabling_statistics :- + current_output(Stream), + tabling_statistics(Stream). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% tabling_statistics/2 %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% should match with code in OPTYap/opt.preds.c +tabling_statistics(total_memory,[BytesInUse,BytesAllocated]) :- + '$c_get_optyap_statistics'(0,BytesInUse,BytesAllocated). +tabling_statistics(table_entries,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(1,BytesInUse,StructsInUse). +tabling_statistics(subgoal_frames,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(2,BytesInUse,StructsInUse). +tabling_statistics(dependency_frames,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(3,BytesInUse,StructsInUse). +tabling_statistics(subgoal_trie_nodes,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(6,BytesInUse,StructsInUse). +tabling_statistics(answer_trie_nodes,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(7,BytesInUse,StructsInUse). +tabling_statistics(subgoal_trie_hashes,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(8,BytesInUse,StructsInUse). +tabling_statistics(answer_trie_hashes,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(9,BytesInUse,StructsInUse). +tabling_statistics(global_trie_nodes,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(10,BytesInUse,StructsInUse). +tabling_statistics(global_trie_hashes,[BytesInUse,StructsInUse]) :- + '$c_get_optyap_statistics'(11,BytesInUse,StructsInUse). @@ -195,98 +259,80 @@ abolish_table(Pred) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% show_table/1 %% +%% show_table/2 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% show_table(Pred) :- - '$current_module'(Mod), - '$do_show_table'(Mod,Pred). + current_output(Stream), + show_table(Stream,Pred). -'$do_show_table'(Mod,Pred) :- +show_table(Stream,Pred) :- + '$current_module'(Mod), + '$do_show_table'(Stream,Mod,Pred). + +'$do_show_table'(_,Mod,Pred) :- var(Pred), !, '$do_error'(instantiation_error,show_table(Mod:Pred)). -'$do_show_table'(_,Mod:Pred) :- !, - '$do_show_table'(Mod,Pred). -'$do_show_table'(_,[]) :- !. -'$do_show_table'(Mod,[HPred|TPred]) :- !, - '$do_show_table'(Mod,HPred), - '$do_show_table'(Mod,TPred). -'$do_show_table'(Mod,(Pred1,Pred2)) :- !, - '$do_show_table'(Mod,Pred1), - '$do_show_table'(Mod,Pred2). -'$do_show_table'(Mod,PredName/PredArity) :- +'$do_show_table'(Stream,_,Mod:Pred) :- !, + '$do_show_table'(Stream,Mod,Pred). +'$do_show_table'(_,_,[]) :- !. +'$do_show_table'(Stream,Mod,[HPred|TPred]) :- !, + '$do_show_table'(Stream,Mod,HPred), + '$do_show_table'(Stream,Mod,TPred). +'$do_show_table'(Stream,Mod,(Pred1,Pred2)) :- !, + '$do_show_table'(Stream,Mod,Pred1), + '$do_show_table'(Stream,Mod,Pred2). +'$do_show_table'(Stream,Mod,PredName/PredArity) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), '$flags'(PredFunctor,Mod,Flags,Flags), !, ( - Flags /\ 0x000040 =\= 0, !, '$c_show_table'(Mod,PredFunctor) + Flags /\ 0x000040 =\= 0, !, '$c_show_table'(Stream,Mod,PredFunctor) ; '$do_error'(domain_error(table,Mod:PredName/PredArity),show_table(Mod:PredName/PredArity)) ). -'$do_show_table'(Mod,Pred) :- +'$do_show_table'(_,Mod,Pred) :- '$do_error'(type_error(callable,Mod:Pred),show_table(Mod:Pred)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% table_statistics/1 %% +%% table_statistics/2 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% table_statistics(Pred) :- - '$current_module'(Mod), - '$do_table_statistics'(Mod,Pred). + current_output(Stream), + table_statistics(Stream,Pred). -'$do_table_statistics'(Mod,Pred) :- +table_statistics(Stream,Pred) :- + '$current_module'(Mod), + '$do_table_statistics'(Stream,Mod,Pred). + +'$do_table_statistics'(_,Mod,Pred) :- var(Pred), !, '$do_error'(instantiation_error,table_statistics(Mod:Pred)). -'$do_table_statistics'(_,Mod:Pred) :- !, - '$do_table_statistics'(Mod,Pred). -'$do_table_statistics'(_,[]) :- !. -'$do_table_statistics'(Mod,[HPred|TPred]) :- !, - '$do_table_statistics'(Mod,HPred), - '$do_table_statistics'(Mod,TPred). -'$do_table_statistics'(Mod,(Pred1,Pred2)) :- !, - '$do_table_statistics'(Mod,Pred1), - '$do_table_statistics'(Mod,Pred2). -'$do_table_statistics'(Mod,PredName/PredArity) :- +'$do_table_statistics'(Stream,_,Mod:Pred) :- !, + '$do_table_statistics'(Stream,Mod,Pred). +'$do_table_statistics'(_,_,[]) :- !. +'$do_table_statistics'(Stream,Mod,[HPred|TPred]) :- !, + '$do_table_statistics'(Stream,Mod,HPred), + '$do_table_statistics'(Stream,Mod,TPred). +'$do_table_statistics'(Stream,Mod,(Pred1,Pred2)) :- !, + '$do_table_statistics'(Stream,Mod,Pred1), + '$do_table_statistics'(Stream,Mod,Pred2). +'$do_table_statistics'(Stream,Mod,PredName/PredArity) :- atom(PredName), integer(PredArity), functor(PredFunctor,PredName,PredArity), '$flags'(PredFunctor,Mod,Flags,Flags), !, ( - Flags /\ 0x000040 =\= 0, !, '$c_table_statistics'(Mod,PredFunctor) + Flags /\ 0x000040 =\= 0, !, '$c_table_statistics'(Stream,Mod,PredFunctor) ; '$do_error'(domain_error(table,Mod:PredName/PredArity),table_statistics(Mod:PredName/PredArity)) ). -'$do_table_statistics'(Mod,Pred) :- +'$do_table_statistics'(_,Mod,Pred) :- '$do_error'(type_error(callable,Mod:Pred),table_statistics(Mod:Pred)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% tabling_statistics/2 %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% should match with code in OPTYap/opt.preds.c -tabling_statistics(total_memory,[BytesInUse,BytesAllocated]) :- - '$c_get_optyap_statistics'(0,BytesInUse,BytesAllocated). -tabling_statistics(table_entries,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(1,BytesInUse,StructsInUse). -tabling_statistics(subgoal_frames,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(2,BytesInUse,StructsInUse). -tabling_statistics(dependency_frames,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(3,BytesInUse,StructsInUse). -tabling_statistics(subgoal_trie_nodes,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(6,BytesInUse,StructsInUse). -tabling_statistics(answer_trie_nodes,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(7,BytesInUse,StructsInUse). -tabling_statistics(subgoal_trie_hashes,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(8,BytesInUse,StructsInUse). -tabling_statistics(answer_trie_hashes,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(9,BytesInUse,StructsInUse). -tabling_statistics(global_trie_nodes,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(10,BytesInUse,StructsInUse). -tabling_statistics(global_trie_hashes,[BytesInUse,StructsInUse]) :- - '$c_get_optyap_statistics'(11,BytesInUse,StructsInUse). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \ No newline at end of file diff --git a/pl/yapor.yap b/pl/yapor.yap index 75f53b58a..eeae929cc 100644 --- a/pl/yapor.yap +++ b/pl/yapor.yap @@ -12,12 +12,25 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- meta_predicate - or_statistics(:,:), - opt_statistics(:,:), default_sequential(:). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% or_statistics/0 %% +%% opt_statistics/0 %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +or_statistics :- + current_output(Stream), + or_statistics(Stream). + +opt_statistics :- + current_output(Stream), + opt_statistics(Stream). + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% or_statistics/2 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%