diff --git a/C/absmi.c b/C/absmi.c index 144969a3d..bff4758aa 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -516,7 +516,7 @@ Term Yap_XREGS[MaxTemps]; /* 29 */ point or because we have goals to wake up. This routine saves the current live temporary registers into a structure pointed to by register ARG1. The registers are then recovered by a nasty builtin - called + called */ static Term push_live_regs(yamop *pco) @@ -525,14 +525,23 @@ push_live_regs(yamop *pco) CELL *lab = (CELL *)(pco->u.l.l); CELL max = lab[0]; CELL curr = lab[1]; + Term tp = MkIntegerTerm((Int)pco); + Term tcp = MkIntegerTerm((Int)CP); + Term tenv = MkIntegerTerm((Int)(LCL0-ENV)); + Term tyenv = MkIntegerTerm((Int)(LCL0-YENV)); CELL *start = HR; Int tot = 0; - if (max) { - CELL i; + HR++; + *HR++ = tp; + *HR++ = tcp; + *HR++ = tenv; + *HR++ = tyenv; + tot += 4; + { + CELL i; lab += 2; - HR++; for (i=0; i <= max; i++) { if (i == 8*CellSize) { curr = lab[0]; @@ -570,8 +579,6 @@ push_live_regs(yamop *pco) } start[0] = (CELL)Yap_MkFunctor(AtomTrue, tot); return(AbsAppl(start)); - } else { - return(TermNil); } } #endif @@ -588,12 +595,12 @@ char *Yap_op_names[_std_top + 1] = #endif static int -check_alarm_fail_int(int CONT USES_REGS) +check_alarm_fail_int(int CONT USES_REGS) { #if defined(_MSC_VER) || defined(__MINGW32__) - /* I need this for Windows and any system where SIGINT + /* I need this for Windows and any system where SIGINT is not proceesed by same thread as absmi */ - if (LOCAL_PrologMode & (AbortMode|InterruptMode)) + if (LOCAL_PrologMode & (AbortMode|InterruptMode)) { CalculateStackGap( PASS_REGS1 ); return CONT; @@ -601,25 +608,26 @@ check_alarm_fail_int(int CONT USES_REGS) #endif if (Yap_has_signals( YAP_INT_SIGNAL, YAP_FAIL_SIGNAL ) ) { if (Yap_undo_signal( YAP_INT_SIGNAL ) ) { - Yap_Error(PURE_ABORT, TermNil, "abort from console"); + Yap_Error(PURE_ABORT, TermNil, "abort from console"); } (void)Yap_undo_signal( YAP_FAIL_SIGNAL ); return FALSE; } if (!Yap_has_a_signal()) { /* no need to look into GC */ - CalculateStackGap( PASS_REGS1 ); + CalculateStackGap( PASS_REGS1 ); } // fail even if there are more signals, they will have to be dealt later. return -1; } static int -stack_overflow( CELL *env, yamop *cp USES_REGS ) +stack_overflow( PredEntry *pe, CELL *env, yamop *cp USES_REGS ) { if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap( PASS_REGS1 ) || Yap_undo_signal( YAP_STOVF_SIGNAL )) { - if (!Yap_locked_gc(((PredEntry *)(S))->ArityOfPE, env, cp)) { + S = (CELL *)pe; + if (!Yap_locked_gc(pe->ArityOfPE, env, cp)) { Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage); return 0; } @@ -632,7 +640,7 @@ static int code_overflow( CELL *yenv USES_REGS ) { if (Yap_undo_signal( YAP_CDOVF_SIGNAL )) { - CELL cut_b = LCL0-(CELL *)(S[E_CB]); + CELL cut_b = LCL0-(CELL *)(yenv[E_CB]); /* do a garbage collection first to check if we can recover memory */ if (!Yap_locked_growheap(FALSE, 0, NULL)) { @@ -640,8 +648,8 @@ code_overflow( CELL *yenv USES_REGS ) return 0; } CACHE_A1(); - if (S == ASP) { - S[E_CB] = (CELL)(LCL0-cut_b); + if (yenv == ASP) { + yenv[E_CB] = (CELL)(LCL0-cut_b); } return 1; } @@ -649,10 +657,9 @@ code_overflow( CELL *yenv USES_REGS ) } static int -interrupt_handler( USES_REGS1 ) +interrupt_handler( PredEntry *pe USES_REGS ) { - PredEntry *pe = (PredEntry *)S; - + // printf("D %lx %p\n", LOCAL_ActiveSignals, P); /* tell whether we can creep or not, this is hard because we will lose the info RSN @@ -710,7 +717,7 @@ interrupt_handler( USES_REGS1 ) pe = WakeUpCode; /* no more goals to wake up */ Yap_UpdateTimedVar(LOCAL_WokenGoals,TermNil); - } else + } else #endif { CalculateStackGap( PASS_REGS1 ); @@ -727,15 +734,110 @@ interrupt_handler( USES_REGS1 ) return TRUE; } +// interrupt handling code that sets up the case when we do not have +// a guaranteed environment. static int -interrupt_handlerc( USES_REGS1 ) +safe_interrupt_handler( PredEntry *pe USES_REGS ) +{ + CELL *npt = HR; + + // printf("D %lx %p\n", LOCAL_ActiveSignals, P); + /* tell whether we can creep or not, this is hard because we will + lose the info RSN + */ + BEGD(d0); + S = (CELL *)pe; + d0 = pe->ArityOfPE; + if (d0 == 0) { + HR[1] = MkAtomTerm((Atom) pe->FunctorOfPred); + } + else { + HR[d0 + 2] = AbsAppl(HR); + HR += d0+1+2; + *npt++ = (CELL) pe->FunctorOfPred; + BEGP(pt1); + pt1 = XREGS + 1; + for (; d0 > 0; --d0) { + BEGD(d1); + d1 = *pt1; + loop: + if (!IsVarTerm(d1)) { + /* just copy it to the heap */ + pt1++; + *npt++ = d1; + } else { + if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) { + d1 = Deref(d1); + if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) { + Term v = MkVarTerm(); + Bind( VarOfTerm(d1),v ); + } else { + goto loop; + } + } else { + *npt++ = d1; + } + } + ENDD(d1); + } + ENDP(pt1); + } + ENDD(d0); + npt[0] = Yap_Module_Name(pe); + ARG1 = AbsPair(npt); + + HR += 2; +#ifdef COROUTINING + if (Yap_undo_signal( YAP_WAKEUP_SIGNAL )) { + CalculateStackGap( PASS_REGS1 ); + ARG2 = Yap_ListOfWokenGoals(); + pe = WakeUpCode; + /* no more goals to wake up */ + Yap_UpdateTimedVar(LOCAL_WokenGoals,TermNil); + } else +#endif + { + CalculateStackGap( PASS_REGS1 ); + pe = CreepCode; + } + UNLOCK(LOCAL_SignalLock); + // allocate an fill out an environment + YENV = ASP; + CACHE_Y_AS_ENV(YREG); + ENV_YREG[E_CP] = (CELL) CP; + ENV_YREG[E_E] = (CELL) ENV; +#ifdef DEPTH_LIMIT + ENV_YREG[E_DEPTH] = DEPTH; +#endif /* DEPTH_LIMIT */ + ENV = ENV_YREG; + ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CP)); + WRITEBACK_Y_AS_ENV(); + ENDCACHE_Y_AS_ENV(); + CP = P; + P = pe->CodeOfPred; +#ifdef DEPTH_LIMIT + if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */ + if (pe->ModuleOfPred) { + if (DEPTH == MkIntTerm(0)) + return FALSE; + else DEPTH = RESET_DEPTH(); + } + } else if (pe->ModuleOfPred) { + DEPTH -= MkIntConstant(2); + } +#endif /* DEPTH_LIMIT */ + return TRUE; +} + +static int +interrupt_handlerc( PredEntry *pe USES_REGS ) { /* do creep in call */ ENV = YENV; CP = NEXTOP(P, Osbpp); YENV = (CELL *) (((char *) YENV) + P->u.Osbpp.s); #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (YENV > (CELL *) top_b || YENV < HR) YENV = (CELL *) top_b; @@ -753,18 +855,20 @@ interrupt_handlerc( USES_REGS1 ) #endif /* FROZEN_STACKS */ /* setup GB */ YENV[E_CB] = (CELL) B; - return interrupt_handler( PASS_REGS1 ); + return interrupt_handler( pe PASS_REGS ); } static int -interrupt_handler_either( USES_REGS1 ) +interrupt_handler_either( Term t_cut, PredEntry *pe USES_REGS ) { - ENV = YENV; - CP = NEXTOP(P, Osbpp); - YENV = (CELL *) (((char *) YENV) + P->u.Osbpp.s); + int rc; + + ARG1 = push_live_regs(NEXTOP(P, Osbpp)); #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); + // protect registers before we mess about. + // recompute YENV and get ASP #ifdef YAPOR_SBA if (YENV > (CELL *) top_b || YENV < HR) YENV = (CELL *) top_b; #else @@ -776,17 +880,18 @@ interrupt_handler_either( USES_REGS1 ) if (YENV > (CELL *) B) YENV = (CELL *) B; #endif /* FROZEN_STACKS */ - /* setup GB */ - ARG1 = push_live_regs(CP); - /* ARG0 has an extra argument for suspended cuts */ - ARG2 = XREGS[0]; - YENV[E_CB] = (CELL) B; - SET_ASP(YENV, E_CB*sizeof(CELL)); - return interrupt_handler( PASS_REGS1 ); + P = NEXTOP(P, Osbpp); + // should we cut? If t_cut == INT(0) no + ARG2 = t_cut; + // ASP + SET_ASP(YENV, E_CB*sizeof(CELL)); + // do the work. + rc = safe_interrupt_handler( pe PASS_REGS ); + return rc; } -/* totrace interrupt calls */ -//#define DEBUG_INTERRUPTS 1 +/* to trace interrupt calls */ +// #define DEBUG_INTERRUPTS 1 #ifdef DEBUG_INTERRUPTS static int trace_interrupts = TRUE; @@ -799,34 +904,33 @@ interrupt_fail( USES_REGS1 ) if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); #endif - LOCK(LOCAL_SignalLock); + LOCK(LOCAL_SignalLock); check_alarm_fail_int( FALSE PASS_REGS ); /* don't do debugging and stack expansion here: space will be recovered. automatically by fail, so better wait. */ - if (!Yap_has_a_signal() || + if (!Yap_has_a_signal() || Yap_has_signals( YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL )) { - UNLOCK(LOCAL_SignalLock); + UNLOCK(LOCAL_SignalLock); return FALSE; } - S = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomFail,0)); /* make sure we have the correct environment for continuation */ ENV = B->cp_env; YENV = (CELL *)B; - return interrupt_handler( PASS_REGS1 ); + return interrupt_handler( RepPredProp(Yap_GetPredPropByAtom(AtomFail,0)) PASS_REGS ); } static int interrupt_execute( USES_REGS1 ) { int v; - + #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); #endif - LOCK(LOCAL_SignalLock); + LOCK(LOCAL_SignalLock); if ((v = check_alarm_fail_int( TRUE PASS_REGS )) >= 0) { UNLOCK(LOCAL_SignalLock); return v; @@ -836,24 +940,23 @@ interrupt_execute( USES_REGS1 ) UNLOCK(LOCAL_SignalLock); return 2; } - S = (CELL *) P->u.pp.p; SET_ASP(YENV, E_CB*sizeof(CELL)); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } - if ((v = stack_overflow(ENV, CP PASS_REGS )) >= 0) { + if ((v = stack_overflow(P->u.pp.p, ENV, CP PASS_REGS )) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } - return interrupt_handler( PASS_REGS1 ); + return interrupt_handler( P->u.pp.p PASS_REGS ); } static int interrupt_call( USES_REGS1 ) { int v; - + #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); @@ -869,17 +972,16 @@ interrupt_call( USES_REGS1 ) UNLOCK(LOCAL_SignalLock); return 2; } - S = (CELL *) P->u.Osbpp.p; SET_ASP(YENV, P->u.Osbpp.s); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } - if ((v = stack_overflow(YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) { + if ((v = stack_overflow( P->u.Osbpp.p, YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } - return interrupt_handlerc( PASS_REGS1 ); + return interrupt_handlerc( P->u.Osbpp.p PASS_REGS ); } static int @@ -901,7 +1003,6 @@ interrupt_pexecute( PredEntry *pen USES_REGS ) UNLOCK(LOCAL_SignalLock); return 2; /* keep on creeping */ } - S = (CELL *) pen; SET_ASP(YENV, E_CB*sizeof(CELL)); /* setup GB */ YENV[E_CB] = (CELL) B; @@ -909,23 +1010,23 @@ interrupt_pexecute( PredEntry *pen USES_REGS ) UNLOCK(LOCAL_SignalLock); return v; } - if ((v = stack_overflow(ENV, NEXTOP(P, Osbmp) PASS_REGS )) >= 0) { + if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp) PASS_REGS )) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } CP = NEXTOP(P, Osbmp); - return interrupt_handler( PASS_REGS1 ); + return interrupt_handler( pen PASS_REGS ); } /* don't forget I cannot creep at deallocate (where to?) */ /* also, this is unusual in that I have already done deallocate, so I don't need to redo it. - */ + */ static int interrupt_deallocate( USES_REGS1 ) { int v; - + #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); @@ -935,7 +1036,7 @@ interrupt_deallocate( USES_REGS1 ) UNLOCK(LOCAL_SignalLock); return v; } - /* + /* don't do a creep here; also, if our instruction is followed by a execute_c, just wait a bit more */ if ( Yap_only_has_signal( YAP_CREEP_SIGNAL ) || @@ -953,17 +1054,19 @@ interrupt_deallocate( USES_REGS1 ) SET_ASP(YENV, E_CB*sizeof(CELL)); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { UNLOCK(LOCAL_SignalLock); - return v; + return v; } if (Yap_has_a_signal()) { + PredEntry *pe; + if (Yap_op_from_opcode(P->opc) == _cut_e) { - /* followed by a cut */ - ARG1 = MkIntegerTerm(LCL0-(CELL *)S[E_CB]); - S = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1)); + /* followed by a cut */ + ARG1 = MkIntegerTerm(LCL0-(CELL *)S[E_CB]); + pe = RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1)); } else { - S = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0)); + pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0)); } - return interrupt_handler( PASS_REGS1 ); + return interrupt_handler( pe PASS_REGS ); } if (!Yap_locked_gc(0, ENV, CP)) { Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage); @@ -978,6 +1081,7 @@ interrupt_deallocate( USES_REGS1 ) static int interrupt_cut( USES_REGS1 ) { + Term t_cut = MkIntegerTerm(LCL0-(CELL *)YENV[E_CB]); int v; #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ @@ -993,15 +1097,14 @@ interrupt_cut( USES_REGS1 ) return 2; } /* find something to fool S */ - S = (CELL *)PredRestoreRegs; - XREGS[0] = MkIntegerTerm(LCL0-(CELL *)YENV[E_CB]); P = NEXTOP(P,s); - return interrupt_handler_either( PASS_REGS1 ); + return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); } static int interrupt_cut_t( USES_REGS1 ) { + Term t_cut = MkIntegerTerm(LCL0-(CELL *)YENV[E_CB]); int v; #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ @@ -1018,17 +1121,41 @@ interrupt_cut_t( USES_REGS1 ) return 2; } /* find something to fool S */ - XREGS[0] = MkIntegerTerm(LCL0-(CELL *)S[E_CB]); - S = (CELL *)PredRestoreRegs; P = NEXTOP(P,s); - return interrupt_handler_either( PASS_REGS1 ); + return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); +} + +static int +interrupt_cut_e( USES_REGS1 ) +{ + Term t_cut = MkIntegerTerm(LCL0-(CELL *)S[E_CB]); + int v; +#ifdef DEBUG_INTERRUPTS + if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ + __FUNCTION__, __LINE__,YENV,ENV,ASP); +#endif + LOCK(LOCAL_SignalLock); + if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + UNLOCK(LOCAL_SignalLock); + return v; + } + if (!Yap_has_a_signal() + || Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) { + UNLOCK(LOCAL_SignalLock); + return 2; + } + /* find something to fool S */ + P = NEXTOP(P,s); + return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); } static int interrupt_commit_y( USES_REGS1 ) { int v; -#ifdef DEBUG_INTERRUPTS + Term t_cut = YENV[P->u.yps.y]; + + #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); #endif @@ -1043,17 +1170,17 @@ interrupt_commit_y( USES_REGS1 ) return 2; } /* find something to fool S */ - S = (CELL *)PredRestoreRegs; - XREGS[0] = YENV[P->u.yps.y]; P = NEXTOP(P,yps); - return interrupt_handler_either( PASS_REGS1 ); + return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); } static int interrupt_commit_x( USES_REGS1 ) { int v; -#ifdef DEBUG_INTERRUPTS + Term t_cut = XREG(P->u.xps.x); + + #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); #endif @@ -1069,7 +1196,6 @@ interrupt_commit_x( USES_REGS1 ) } PP = P->u.xps.p0; /* find something to fool S */ - S = (CELL *)PredRestoreRegs; if (P->opc == Yap_opcode(_fcall)) { /* fill it up */ CACHE_Y_AS_ENV(YREG); @@ -1080,16 +1206,15 @@ interrupt_commit_x( USES_REGS1 ) #endif /* DEPTH_LIMIT */ ENDCACHE_Y_AS_ENV(); } - XREGS[0] = XREG(P->u.xps.x); P = NEXTOP(P,xps); - return interrupt_handler_either( PASS_REGS1 ); + return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); } static int interrupt_either( USES_REGS1 ) { int v; - + #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); @@ -1105,7 +1230,6 @@ interrupt_either( USES_REGS1 ) } PP = P->u.Osblp.p0; /* find something to fool S */ - S = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)); SET_ASP(YENV, P->u.Osbpp.s); if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); @@ -1113,23 +1237,25 @@ interrupt_either( USES_REGS1 ) UNLOCK(LOCAL_SignalLock); return v; } - if ((v = stack_overflow(YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) { + if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P, Osbpp) PASS_REGS )) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } - return interrupt_handler_either( PASS_REGS1 ); + return interrupt_handler_either( MkIntTerm(0), RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)) PASS_REGS ); } static int interrupt_dexecute( USES_REGS1 ) { int v; + PredEntry *pe; #ifdef DEBUG_INTERRUPTS if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s/%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ __FUNCTION__, __LINE__,YENV,ENV,ASP); #endif PP = P->u.pp.p0; + pe = P->u.pp.p; LOCK(LOCAL_SignalLock); if (Yap_has_signal(YAP_CREEP_SIGNAL) && (PP->ExtraPredFlags & (NoDebugPredFlag|HiddenPredFlag))) { @@ -1137,7 +1263,6 @@ interrupt_dexecute( USES_REGS1 ) return 2; } /* set S for next instructions */ - S = (CELL *) P->u.pp.p; ASP = YENV+E_CB; if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); @@ -1145,7 +1270,7 @@ interrupt_dexecute( USES_REGS1 ) UNLOCK(LOCAL_SignalLock); return v; } - if ((v = stack_overflow((CELL *)YENV[E_E], (yamop *)YENV[E_CP] PASS_REGS )) >= 0) { + if ((v = stack_overflow( P->u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP] PASS_REGS )) >= 0) { UNLOCK(LOCAL_SignalLock); return v; } @@ -1156,7 +1281,7 @@ interrupt_dexecute( USES_REGS1 ) YENV[E_DEPTH] = DEPTH; #endif /* DEPTH_LIMIT */ #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (YENV > (CELL *) top_b || YENV < HR) YENV = (CELL *) top_b; @@ -1177,10 +1302,10 @@ interrupt_dexecute( USES_REGS1 ) YENV[E_CB] = (CELL) B; /* and now CREEP */ - return interrupt_handler( PASS_REGS1 ); + return interrupt_handler( pe PASS_REGS ); } -Int +Int Yap_absmi(int inp) { CACHE_REGS @@ -1195,8 +1320,8 @@ Yap_absmi(int inp) register CELL *pt0, *pt1; #endif /* LONG_LIVED_REGISTERS */ - -#ifdef SHADOW_P + +#ifdef SHADOW_P register yamop *PREG = P; #endif /* SHADOW_P */ @@ -1296,7 +1421,7 @@ Yap_absmi(int inp) /* the registers are all set up, let's swap */ #ifdef THREADS - pthread_setspecific(Yap_yaamregs_key, (const void *)&absmi_regs); + pthread_setspecific(Yap_yaamregs_key, (const void *)&absmi_regs); LOCAL_ThreadHandle.current_yaam_regs = &absmi_regs; regcache = &absmi_regs; LOCAL_PL_local_data_p->reg_cache = regcache; @@ -1325,7 +1450,7 @@ Yap_absmi(int inp) CACHE_A1(); reset_absmi: - + SP = SP0; #if USE_THREADED_CODE @@ -1407,7 +1532,7 @@ Yap_absmi(int inp) SET_ASP(YREG, E_CB*sizeof(CELL)); /* make sure ASP is initialised */ saveregs(); - + #if PUSH_REGS restore_absmi_regs(old_regs); #endif @@ -1523,7 +1648,7 @@ Yap_absmi(int inp) #endif PREG = pt; } - JMPNext(); + JMPNext(); ENDBOp(); /* check if enough space between trail and codespace */ @@ -1535,7 +1660,7 @@ Yap_absmi(int inp) * register, but sometimes (X86) not. In this case, have a * new register to point at YREG =*/ CACHE_Y(YREG); - { + { struct index_t *i = (struct index_t *)(PREG->u.lp.l); S_YREG[-1] = (CELL)LINK_TO_ADDRESS(i,i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]); } @@ -1596,7 +1721,7 @@ Yap_absmi(int inp) * register, but sometimes (X86) not. In this case, have a * new register to point at YREG =*/ CACHE_Y(YREG); - { + { S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */ } S_YREG--; @@ -1628,7 +1753,7 @@ Yap_absmi(int inp) * register, but sometimes (X86) not. In this case, have a * new register to point at YREG =*/ CACHE_Y(YREG); - { + { struct index_t *i = (struct index_t *)(PREG->u.lp.l); SREG = i->cls; S_YREG[-2] = (CELL)(SREG+i->arity); @@ -1946,7 +2071,7 @@ Yap_absmi(int inp) { UInt timestamp; CACHE_Y(B); - + timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.OtaLl.s]); if (!VALID_TIMESTAMP(timestamp, PREG->u.OtaLl.d)) { /* jump to next instruction */ @@ -2004,7 +2129,7 @@ Yap_absmi(int inp) if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) { if (PREG != FAILCODE) { /* I am the last one using this clause, hence I don't need a lock - to dispose of it + to dispose of it */ if (lcl->ClRefCount == 1) { /* make sure the clause isn't destroyed */ @@ -2030,7 +2155,7 @@ Yap_absmi(int inp) cl->ClFlags &= ~InUseMask; --B->cp_tr; #if FROZEN_STACKS - if (B->cp_tr > TR_FZ) + if (B->cp_tr > TR_FZ) #endif { TR = B->cp_tr; @@ -2100,14 +2225,14 @@ Yap_absmi(int inp) Yap_NilError(CALL_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { saveregs(); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } PREG = NEXTOP(PREG, p); GONext(); ENDOp(); @@ -2125,7 +2250,7 @@ Yap_absmi(int inp) Yap_NilError(RETRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { ENV = B->cp_env; @@ -2133,7 +2258,7 @@ Yap_absmi(int inp) Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } PREG = NEXTOP(PREG, p); GONext(); ENDOp(); @@ -2162,14 +2287,14 @@ Yap_absmi(int inp) Yap_NilError(RETRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { saveregs(); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } PREG = NEXTOP(PREG, Otapl); GONext(); ENDOp(); @@ -2206,14 +2331,14 @@ Yap_absmi(int inp) Yap_NilError(RETRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0) { saveregs(); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock); ((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.NOfRetries++; UNLOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock); @@ -2226,7 +2351,7 @@ Yap_absmi(int inp) { UInt timestamp; CACHE_Y(B); - + timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.OtaLl.s]); if (!VALID_TIMESTAMP(timestamp, PREG->u.OtaLl.d)) { /* jump to next instruction */ @@ -2241,14 +2366,14 @@ Yap_absmi(int inp) Yap_NilError(RETRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0) { saveregs(); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCK(PREG->u.OtaLl.d->ClPred->StatisticsForPred.lock); PREG->u.OtaLl.d->ClPred->StatisticsForPred.NOfRetries++; UNLOCK(PREG->u.OtaLl.d->ClPred->StatisticsForPred.lock); @@ -2286,14 +2411,14 @@ Yap_absmi(int inp) Yap_NilError(RETRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0) { saveregs(); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCK(ap->StatisticsForPred.lock); ap->StatisticsForPred.NOfRetries++; UNLOCK(ap->StatisticsForPred.lock); @@ -2312,7 +2437,7 @@ Yap_absmi(int inp) if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) { if (PREG != FAILCODE) { /* I am the last one using this clause, hence I don't need a lock - to dispose of it + to dispose of it */ if (lcl->ClRefCount == 1) { /* make sure the clause isn't destroyed */ @@ -2338,7 +2463,7 @@ Yap_absmi(int inp) cl->ClFlags &= ~InUseMask; --B->cp_tr; #if FROZEN_STACKS - if (B->cp_tr > TR_FZ) + if (B->cp_tr > TR_FZ) #endif { TR = B->cp_tr; @@ -2411,7 +2536,7 @@ Yap_absmi(int inp) PREG = NEXTOP(PREG, p); GONext(); ENDOp(); - + /* only meaningful with THREADS on! */ /* lock logical updates predicate. */ Op(unlock_lu, e); @@ -2422,11 +2547,11 @@ Yap_absmi(int inp) PREG = NEXTOP(PREG, e); GONext(); ENDOp(); - + /* enter logical pred */ BOp(alloc_for_logical_pred, L); - check_trail(TR); + check_trail(TR); /* say that an environment is using this clause */ /* we have our own copy for the clause */ #if MULTIPLE_STACKS @@ -2589,9 +2714,9 @@ Yap_absmi(int inp) /* ensure_space */ BOp(ensure_space, Osbpa); { - Int sz = PREG->u.Osbpa.i; + Int sz = PREG->u.Osbpa.i; UInt arity = PREG->u.Osbpa.p->ArityOfPE; - + if (Unsigned(HR) + sz > Unsigned(YREG)-StackGap( PASS_REGS1 )) { YENV[E_CP] = (CELL) CPREG; YENV[E_E] = (CELL) ENV; @@ -2695,14 +2820,14 @@ Yap_absmi(int inp) Yap_NilError(RETRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0) { saveregs(); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } /* enter a retry dynamic */ ENDBOp(); @@ -2758,7 +2883,7 @@ Yap_absmi(int inp) BOp(trust_fail, e); { while (POP_CHOICE_POINT(B->cp_b)) - { + { POP_EXECUTE(); } } @@ -2788,7 +2913,7 @@ Yap_absmi(int inp) if (PP) { UNLOCK(PP->PELock); PP = NULL; - } + } #ifdef COROUTINING CACHE_Y_AS_ENV(YREG); check_stack(NoStackFail, HR); @@ -2993,16 +3118,16 @@ Yap_absmi(int inp) #endif /* FROZEN_STACKS */ if (IN_BETWEEN(H0,pt1,HR)) { if (IsAttVar(pt1)) { - goto failloop; + goto failloop; } else if (*pt1 == (CELL)FunctorBigInt) { Yap_CleanOpaqueVariable(pt1); goto failloop; - } - } + } + } #ifdef FROZEN_STACKS /* TRAIL */ /* don't reset frozen variables */ if (pt0 < TR_FZ) - goto failloop; + goto failloop; #endif flags = *pt1; #if MULTIPLE_STACKS @@ -3033,14 +3158,14 @@ Yap_absmi(int inp) erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); if (erase) { saveregs(); - /* at this point, + /* at this point, we are the only ones accessing the clause, hence we don't need to have a lock it */ Yap_ErLogUpdIndex(cl); setregs(); } else if (cl->ClFlags & DirtyMask) { saveregs(); - /* at this point, + /* at this point, we are the only ones accessing the clause, hence we don't need to have a lock it */ Yap_CleanUpIndex(cl); @@ -3059,7 +3184,7 @@ Yap_absmi(int inp) erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); if (erase) { saveregs(); - /* at this point, + /* at this point, we are the only ones accessing the clause, hence we don't need to have a lock it */ Yap_ErLogUpdCl(cl); @@ -3070,14 +3195,14 @@ Yap_absmi(int inp) } else { DynamicClause *cl = ClauseFlagsToDynamicClause(pt1); int erase; - + LOCK(cl->ClLock); DEC_CLREF_COUNT(cl); erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); UNLOCK(cl->ClLock); if (erase) { saveregs(); - /* at this point, + /* at this point, we are the only ones accessing the clause, hence we don't need to have a lock it */ Yap_ErCl(cl); @@ -3119,7 +3244,7 @@ Yap_absmi(int inp) CELL *pt = RepAppl(d1); /* AbsAppl means */ /* multi-assignment variable */ - /* so the next cell is the old value */ + /* so the next cell is the old value */ #ifdef FROZEN_STACKS --pt0; pt[0] = TrailVal(pt0); @@ -3223,7 +3348,7 @@ Yap_absmi(int inp) #ifdef COROUTINING NoStackCutE: - PROCESS_INT(interrupt_cut_t, do_cut_e); + PROCESS_INT(interrupt_cut_e, do_cut_e); #endif ENDOp(); @@ -3355,7 +3480,7 @@ Yap_absmi(int inp) goto skip_do_execute; #endif do_execute: - FETCH_Y_FROM_ENV(YREG); + FETCH_Y_FROM_ENV(YREG); pt0 = PREG->u.pp.p; skip_do_execute: #ifdef LOW_LEVEL_TRACER @@ -3399,7 +3524,7 @@ Yap_absmi(int inp) #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) low_level_trace(enter_pred,PREG->u.pp.p,XREGS+1); -#endif /* LOW_LEVEL_TRACER */ +#endif /* LOW_LEVEL_TRACER */ CACHE_Y_AS_ENV(YREG); { PredEntry *pt0; @@ -3433,7 +3558,7 @@ Yap_absmi(int inp) CPREG = (yamop *) ENV_YREG[E_CP]; ENV_YREG = ENV = (CELL *) ENV_YREG[E_E]; #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; @@ -3512,7 +3637,7 @@ Yap_absmi(int inp) DEPTH -= MkIntConstant(2); #endif /* DEPTH_LIMIT */ #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; @@ -3583,7 +3708,7 @@ Yap_absmi(int inp) DEPTH = ENV_YREG[E_DEPTH]; #endif /* DEPTH_LIMIT */ #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; @@ -3661,7 +3786,7 @@ Yap_absmi(int inp) Yap_regp=old_regs; #endif return(0); - } + } saveregs(); if (!eam_am((PredEntry *) PREG->u.os.s)) FAIL(); @@ -3676,7 +3801,7 @@ Yap_absmi(int inp) HB = B->cp_h; /* cut_fail */ RECOVER_B(); - if (0) { register choiceptr ccp; + if (0) { register choiceptr ccp; /* initialize ccp */ #define NORM_CP(CP) ((choiceptr)(CP)) @@ -4606,7 +4731,7 @@ Yap_absmi(int inp) } if (Yap_gmp_tcmp_big_big(d0,PREG->u.xN.b)) FAIL(); - PREG = NEXTOP(PREG, xN); + PREG = NEXTOP(PREG, xN); ENDP(pt0); /* enter read mode */ GONext(); @@ -4642,7 +4767,7 @@ Yap_absmi(int inp) BEGD(d1); /* we have met a preexisting dbterm */ d1 = PREG->u.xD.D; - PREG = NEXTOP(PREG, xD); + PREG = NEXTOP(PREG, xD); UnifyBound(d0,d1); ENDD(d1); @@ -5441,7 +5566,7 @@ Yap_absmi(int inp) uvaly_nonvar: /* first argument is bound */ BEGP(pt1); - pt1 = YREG+PREG->u.oy.y; + pt1 = YREG+PREG->u.oy.y; d1 = *pt1; deref_head(d1, uvaly_nonvar_unk); @@ -5788,7 +5913,7 @@ Yap_absmi(int inp) derefa_body(d0, pt0, uvaly_loc_unk, uvaly_loc_nonvar); /* first argument is unbound */ BEGP(pt1); - pt1 = YREG+PREG->u.oy.y; + pt1 = YREG+PREG->u.oy.y; d1 = *pt1; deref_head(d1, uvaly_loc_var_unk); @@ -6120,7 +6245,7 @@ Yap_absmi(int inp) deref_head(d0, ufloat_unk); ufloat_nonvar: if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } /* look inside term */ BEGP(pt0); @@ -6169,7 +6294,7 @@ Yap_absmi(int inp) deref_head(d0, ulfloat_unk); ulfloat_nonvar: if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } BEGP(pt0); pt0 = RepAppl(d0); @@ -6217,7 +6342,7 @@ Yap_absmi(int inp) deref_head(d0, ustring_unk); ustring_nonvar: if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } /* look inside term */ BEGP(pt0); @@ -6258,7 +6383,7 @@ Yap_absmi(int inp) deref_head(d0, ulstring_unk); ulstring_nonvar: if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } BEGP(pt0); pt0 = RepAppl(d0); @@ -6299,7 +6424,7 @@ Yap_absmi(int inp) ulongint_nonvar: /* look inside term */ if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } BEGP(pt0); pt0 = RepAppl(d0); @@ -6342,7 +6467,7 @@ Yap_absmi(int inp) deref_head(d0, ullongint_unk); ullongint_nonvar: if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } BEGP(pt0); pt0 = RepAppl(d0); @@ -6387,7 +6512,7 @@ Yap_absmi(int inp) ubigint_nonvar: /* look inside term */ if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } BEGP(pt0); pt0 = RepAppl(d0); @@ -6427,7 +6552,7 @@ Yap_absmi(int inp) deref_head(d0, ulbigint_unk); ulbigint_nonvar: if (!IsApplTerm(d0)) { - FAIL(); + FAIL(); } BEGP(pt0); pt0 = RepAppl(d0); @@ -6897,7 +7022,7 @@ Yap_absmi(int inp) GONext(); ENDD(d0); ENDOp(); - + Op(put_dbterm, xD); BEGD(d0); d0 = PREG->u.xD.D; @@ -7288,7 +7413,7 @@ Yap_absmi(int inp) /* This instruction is called when the previous goal was interrupted when waking up goals - */ + */ BOp(move_back, l); PREG = (yamop *)(((char *)PREG)-(Int)(NEXTOP((yamop *)NULL,Osbpp))); JMPNext(); @@ -7296,7 +7421,7 @@ Yap_absmi(int inp) /* This instruction is called when the previous goal was interrupted when waking up goals - */ + */ BOp(skip, l); PREG = NEXTOP(PREG,l); JMPNext(); @@ -7320,7 +7445,7 @@ Yap_absmi(int inp) BEGCHO(pt1); pt1 = (choiceptr) ((char *) YREG + (yslot) d0); #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (pt1 > top_b || pt1 < (choiceptr)HR) pt1 = top_b; @@ -7477,7 +7602,7 @@ Yap_absmi(int inp) } do_c_call: #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA @@ -7515,7 +7640,7 @@ Yap_absmi(int inp) PROCESS_INT(interrupt_call, do_c_call); ENDBOp(); - + /* execute Label */ BOp(execute_cpred, pp); check_trail(TR); @@ -7529,7 +7654,7 @@ Yap_absmi(int inp) do_executec: #endif #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA @@ -7618,7 +7743,7 @@ Yap_absmi(int inp) } #endif /* LOW_LEVEL_TRACE */ #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b; @@ -7677,7 +7802,7 @@ Yap_absmi(int inp) } #endif /* LOW_LEVEL_TRACE */ #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b; @@ -7742,14 +7867,14 @@ Yap_absmi(int inp) saveregs(); SREG = (CELL *) ((f) (PASS_REGS1)); /* This last instruction changes B B*/ - while (POP_CHOICE_POINT(B)){ + while (POP_CHOICE_POINT(B)){ cut_c_pop(); } setregs(); } if (!SREG) { /* Removes the cut functions from the stack - without executing them because we have fail + without executing them because we have fail and not cuted the predicate*/ while(POP_CHOICE_POINT(B)) cut_c_pop(); @@ -7861,7 +7986,7 @@ Yap_absmi(int inp) LOCAL_PrologMode &= ~UserCCallMode; if (!SREG) { /* Removes the cut functions from the stack - without executing them because we have fail + without executing them because we have fail and not cuted the predicate*/ while(POP_CHOICE_POINT(B)) cut_c_pop(); @@ -8033,7 +8158,7 @@ Yap_absmi(int inp) if (!same_lu_block(PREG_ADDR, PREG)) { PREG = *PREG_ADDR; if (!PP) { - UNLOCKPE(16,pe); + UNLOCKPE(16,pe); } JMPNext(); } @@ -8054,7 +8179,7 @@ Yap_absmi(int inp) BOp(undef_p, e); /* save S for module name */ - { + { PredEntry *pe = PredFromDefCode(PREG); BEGD(d0); /* avoid trouble with undefined dynamic procedures */ @@ -8153,7 +8278,7 @@ Yap_absmi(int inp) Yap_NilError(CALL_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } + } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { UNLOCKPE(21,pe); @@ -8161,8 +8286,8 @@ Yap_absmi(int inp) Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,""); setregs(); JMPNext(); - } - if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) == + } + if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) == CountPredFlag) { PREG = pe->cs.p_code.TrueCodeOfPred; UNLOCKPE(22,pe); @@ -8181,7 +8306,7 @@ Yap_absmi(int inp) } } UNLOCKPE(25,pe); - + d0 = pe->ArityOfPE; /* save S for ModuleName */ if (d0 == 0) { @@ -8202,7 +8327,7 @@ Yap_absmi(int inp) /* just copy it to the heap */ *HR++ = d1; continue; - + derefa_body(d1, pt0, dospy_unk, dospy_nonvar); if (pt0 <= HR) { /* variable is safe */ @@ -8485,7 +8610,7 @@ Yap_absmi(int inp) check_trail(TR); { UInt timestamp; - + CACHE_Y(YREG); timestamp = IntegerOfTerm(S_YREG[0]); /* fprintf(stderr,"+ %p/%p %d %d %d--%u\n",PREG,PREG->u.OtaLl.d->ClPred,timestamp,PREG->u.OtaLl.d->ClPred->TimeStampOfPred,PREG->u.OtaLl.d->ClTimeStart,PREG->u.OtaLl.d->ClTimeEnd);*/ @@ -8518,7 +8643,7 @@ Yap_absmi(int inp) { UInt timestamp; CACHE_Y(B); - + #if defined(YAPOR) || defined(THREADS) if (!PP) { PP = PREG->u.OtaLl.d->ClPred; @@ -8606,7 +8731,7 @@ Yap_absmi(int inp) cl->ClFlags &= ~InUseMask; B->cp_tr--; #if FROZEN_STACKS - if (B->cp_tr > TR_FZ) + if (B->cp_tr > TR_FZ) #endif { TR = B->cp_tr; @@ -8726,7 +8851,7 @@ Yap_absmi(int inp) * the empty list; * some other atom; * a variable; - * + * */ BOp(switch_list_nl, ollll); ALWAYS_LOOKAHEAD(PREG->u.ollll.pop); @@ -9104,29 +9229,29 @@ Yap_absmi(int inp) I_R = AbsAppl(SREG-1); GONext(); ENDOp(); - + Op(index_blob, e); PREG = NEXTOP(PREG, e); I_R = Yap_DoubleP_key(SREG); GONext(); ENDOp(); - + Op(index_long, e); PREG = NEXTOP(PREG, e); I_R = Yap_IntP_key(SREG); GONext(); ENDOp(); - + /************************************************************************\ * Native Code Execution * \************************************************************************/ - - /* native_me */ - BOp(native_me, aFlp); - if (PREG->u.aFlp.n) + /* native_me */ + BOp(native_me, aFlp); + + if (PREG->u.aFlp.n) EXEC_NATIVE(PREG->u.aFlp.n); else { PREG->u.aFlp.n++; @@ -9136,7 +9261,7 @@ Yap_absmi(int inp) PREG = NEXTOP(PREG, aFlp); JMPNext(); - + ENDBOp(); @@ -9384,8 +9509,8 @@ Yap_absmi(int inp) default: PREG = PREG->u.xl.F; GONext(); - } - } + } + } } PREG = PREG->u.xl.F; GONext(); @@ -9431,7 +9556,7 @@ Yap_absmi(int inp) default: PREG = PREG->u.yl.F; GONext(); - } + } } } PREG = PREG->u.yl.F; @@ -11425,7 +11550,7 @@ Yap_absmi(int inp) PREG = nextp; ALWAYS_GONext(); ALWAYS_END_PREFETCH(); - } + } } else if (v < 0) { if (flags & LT_OK_IN_CMP) { yamop *nextp = NEXTOP(PREG, plxxs); @@ -11455,7 +11580,7 @@ Yap_absmi(int inp) ALWAYS_END_PREFETCH(); } } - } + } exec_bin_cmp_xx: { CmpPredicate f = PREG->u.plxxs.p->cs.d_code; @@ -11530,7 +11655,7 @@ Yap_absmi(int inp) JMPNext(); } } - } + } exec_bin_cmp_yx: { CmpPredicate f = PREG->u.plxys.p->cs.d_code; @@ -11603,7 +11728,7 @@ Yap_absmi(int inp) JMPNext(); } } - } + } exec_bin_cmp_xy: { CmpPredicate f = PREG->u.plxys.p->cs.d_code; @@ -11679,7 +11804,7 @@ Yap_absmi(int inp) JMPNext(); } } - } + } exec_bin_cmp_yy: { CmpPredicate f = PREG->u.plyys.p->cs.d_code; @@ -11804,7 +11929,7 @@ Yap_absmi(int inp) CELL *pt = RepAppl(d1); /* AbsAppl means */ /* multi-assignment variable */ - /* so the next cell is the old value */ + /* so the next cell is the old value */ #ifdef FROZEN_STACKS pt[0] = TrailVal(--TR); #else @@ -12002,7 +12127,7 @@ Yap_absmi(int inp) GONext(); } PREG = NEXTOP(PREG, l); - GONext(); + GONext(); ENDP(pt1); ENDD(d1); ENDP(pt0); @@ -12053,11 +12178,11 @@ Yap_absmi(int inp) } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor) d1)) { - /* don't complain here for Prolog compatibility + /* don't complain here for Prolog compatibility if ((Int)d0 <= 0) { saveregs(); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, - MkIntegerTerm(d0),"arg 1 of arg/3"); + MkIntegerTerm(d0),"arg 1 of arg/3"); setregs(); } */ @@ -12087,7 +12212,7 @@ Yap_absmi(int inp) } else { /* - don't complain here for SWI Prolog compatibility + don't complain here for SWI Prolog compatibility saveregs(); Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3"); setregs(); @@ -12118,7 +12243,7 @@ Yap_absmi(int inp) #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { CELL *Ho = HR; - Term t = MkIntegerTerm(PREG->u.xxn.c); + Term t = MkIntegerTerm(PREG->u.xxn.c); HR[0] = t; HR[1] = XREG(PREG->u.xxn.xi); RESET_VARIABLE(HR+2); @@ -12144,11 +12269,11 @@ Yap_absmi(int inp) } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor) d1)) { - /* don't complain here for Prolog compatibility + /* don't complain here for Prolog compatibility if ((Int)d0 <= 0) { saveregs(); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, - MkIntegerTerm(d0),"arg 1 of arg/3"); + MkIntegerTerm(d0),"arg 1 of arg/3"); setregs(); } */ @@ -12242,11 +12367,11 @@ Yap_absmi(int inp) } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor) d1)) { - /* don't complain here for Prolog compatibility + /* don't complain here for Prolog compatibility if ((Int)d0 <= 0) { saveregs(); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, - MkIntegerTerm(d0),"arg 1 of arg/3"); + MkIntegerTerm(d0),"arg 1 of arg/3"); saveregs(); } */ @@ -12282,7 +12407,7 @@ Yap_absmi(int inp) } else { /* - don't complain here for SWI Prolog compatibility + don't complain here for SWI Prolog compatibility saveregs(); Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3"); setregs(); @@ -12313,7 +12438,7 @@ Yap_absmi(int inp) #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { CELL *Ho = HR; - Term t = MkIntegerTerm(PREG->u.yxn.c); + Term t = MkIntegerTerm(PREG->u.yxn.c); HR[0] = t; HR[1] = XREG(PREG->u.yxn.xi); HR[2] = YREG[PREG->u.yxn.y]; @@ -12340,11 +12465,11 @@ Yap_absmi(int inp) } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor) d1)) { - /* don't complain here for Prolog compatibility + /* don't complain here for Prolog compatibility if ((Int)d0 <= 0) { saveregs(); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, - MkIntegerTerm(d0),"arg 1 of arg/3"); + MkIntegerTerm(d0),"arg 1 of arg/3"); setregs(); } */ @@ -12380,7 +12505,7 @@ Yap_absmi(int inp) } else { /* - don't complain here for SWI Prolog compatibility + don't complain here for SWI Prolog compatibility saveregs(); Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3"); setregs(); @@ -13054,7 +13179,7 @@ Yap_absmi(int inp) if (!IsAtomTerm(d0)) { FAIL(); } - else + else d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1); pt1 = HR; *pt1++ = d0; @@ -13490,7 +13615,7 @@ Yap_absmi(int inp) ENDOp(); /* join all the meta-call code into a single procedure with three entry points */ - { + { CACHE_Y_AS_ENV(YREG); BEGD(d0); /* term to be meta-called */ Term mod; /* module to be used */ @@ -13500,7 +13625,7 @@ Yap_absmi(int inp) /* we are doing the rhs of a , */ BOp(p_execute_tail, Osbmp); - + FETCH_Y_FROM_ENV(YREG); /* place to cut to */ b_ptr = (choiceptr)ENV_YREG[E_CB]; @@ -13514,7 +13639,7 @@ Yap_absmi(int inp) /* Try to preserve the environment */ ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.Osbmp.s); #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; @@ -13575,7 +13700,7 @@ Yap_absmi(int inp) /* Try to preserve the environment */ ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.Osbmp.s); #ifdef FROZEN_STACKS - { + { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; @@ -13676,7 +13801,7 @@ Yap_absmi(int inp) goto execute_metacall; } } - + /* copy arguments of meta-call to XREGS */ BEGP(pt1); pt1 = RepAppl(d0); diff --git a/C/adtdefs.c b/C/adtdefs.c index 9770a1c9e..3206870ba 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -109,7 +109,7 @@ Yap_MkFunctorWithAddress(Atom ap, unsigned int arity, FunctorEntry *p) } inline static Atom -SearchInInvisible(char *atom) +SearchInInvisible(const char *atom) { AtomEntry *chain; @@ -141,7 +141,7 @@ SearchAtom(unsigned char *p, Atom a) { } static inline Atom -SearchWideAtom(wchar_t *p, Atom a) { +SearchWideAtom(const wchar_t *p, Atom a) { AtomEntry *ae; /* search atom in chain */ @@ -156,7 +156,7 @@ SearchWideAtom(wchar_t *p, Atom a) { } static Atom -LookupAtom(char *atom) +LookupAtom(const char *atom) { /* lookup atom in atom table */ UInt hash; unsigned char *p; @@ -216,7 +216,7 @@ LookupAtom(char *atom) static Atom -LookupWideAtom(wchar_t *atom) +LookupWideAtom(const wchar_t *atom) { /* lookup atom in atom table */ CELL hash; wchar_t *p; @@ -226,7 +226,7 @@ LookupWideAtom(wchar_t *atom) WideAtomEntry *wae; /* compute hash */ - p = atom; + p = (wchar_t *)atom; hash = WideHashFunction(p) % WideAtomHashTableSize; /* we'll start by holding a read lock in order to avoid contention */ READ_LOCK(WideHashChain[hash].AERWLock); @@ -285,9 +285,9 @@ LookupWideAtom(wchar_t *atom) } Atom -Yap_LookupMaybeWideAtom(wchar_t *atom) +Yap_LookupMaybeWideAtom(const wchar_t *atom) { /* lookup atom in atom table */ - wchar_t *p = atom, c; + wchar_t *p = (wchar_t *)atom, c; size_t len = 0; char *ptr, *ptr0; Atom at; @@ -297,7 +297,7 @@ Yap_LookupMaybeWideAtom(wchar_t *atom) len++; } /* not really a wide atom */ - p = atom; + p = (wchar_t *)atom; ptr0 = ptr = Yap_AllocCodeSpace(len+1); if (!ptr) return NIL; @@ -308,7 +308,7 @@ Yap_LookupMaybeWideAtom(wchar_t *atom) } Atom -Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len0) +Yap_LookupMaybeWideAtomWithLength(const wchar_t *atom, size_t len0) { /* lookup atom in atom table */ Atom at; int wide = FALSE; @@ -354,7 +354,7 @@ Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len0) } Atom -Yap_LookupAtomWithLength(char *atom, size_t len0) +Yap_LookupAtomWithLength(const char *atom, size_t len0) { /* lookup atom in atom table */ Atom at; char *ptr; @@ -371,19 +371,19 @@ Yap_LookupAtomWithLength(char *atom, size_t len0) } Atom -Yap_LookupAtom(char *atom) +Yap_LookupAtom(const char *atom) { /* lookup atom in atom table */ return LookupAtom(atom); } Atom -Yap_LookupWideAtom(wchar_t *atom) +Yap_LookupWideAtom(const wchar_t *atom) { /* lookup atom in atom table */ return LookupWideAtom(atom); } Atom -Yap_FullLookupAtom(char *atom) +Yap_FullLookupAtom(const char *atom) { /* lookup atom in atom table */ Atom t; @@ -394,7 +394,7 @@ Yap_FullLookupAtom(char *atom) } void -Yap_LookupAtomWithAddress(char *atom, AtomEntry *ae) +Yap_LookupAtomWithAddress(const char *atom, AtomEntry *ae) { /* lookup atom in atom table */ register CELL hash; register unsigned char *p; diff --git a/C/amasm.c b/C/amasm.c index 1e5126d82..0a909ee86 100755 --- a/C/amasm.c +++ b/C/amasm.c @@ -3685,7 +3685,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp case count_retry_op: code_p = a_pl(_count_retry, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); break; - case fetch_args_for_bccall: + case fetch_args_for_bccall_op: if (cip->cpc->nextInst->op != bccall_op) { Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "compiling binary test", (int) cip->cpc->op); save_machine_regs(); diff --git a/C/c_interface.c b/C/c_interface.c index 70dca595e..298f2e05c 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -325,6 +325,11 @@ * * *************************************************************************/ +/** +@file c_interface.c +*/ + + #define Bool int #define flt double #define C_INTERFACE @@ -351,7 +356,7 @@ #include "iopreds.h" // we cannot consult YapInterface.h, that conflicts with what we declare, though // it shouldn't -#include "yap_structs.h" +#include "YapInterface.h" #define _yap_c_interface_h 1 #include "pl-shared.h" #include "YapText.h" @@ -379,124 +384,8 @@ #define X_API __declspec(dllexport) #endif -X_API Term YAP_A(int); -X_API Term YAP_Deref(Term); -X_API Term YAP_MkVarTerm(void); -X_API Bool YAP_IsVarTerm(Term); -X_API Bool YAP_IsNonVarTerm(Term); -X_API Bool YAP_IsIntTerm(Term); -X_API Bool YAP_IsLongIntTerm(Term); -X_API Bool YAP_IsBigNumTerm(Term); -X_API Bool YAP_IsNumberTerm(Term); -X_API Bool YAP_IsRationalTerm(Term); -X_API Bool YAP_IsFloatTerm(Term); -X_API Bool YAP_IsDbRefTerm(Term); -X_API Bool YAP_IsAtomTerm(Term); -X_API Bool YAP_IsPairTerm(Term); -X_API Bool YAP_IsApplTerm(Term); -X_API Bool YAP_IsCompoundTerm(Term); -X_API Bool YAP_IsExternalDataInStackTerm(Term); -X_API Bool YAP_IsOpaqueObjectTerm(Term, int); -X_API Term YAP_MkIntTerm(Int); -X_API Term YAP_MkBigNumTerm(void *); -X_API Term YAP_MkRationalTerm(void *); -X_API Int YAP_IntOfTerm(Term); -X_API void YAP_BigNumOfTerm(Term, void *); -X_API void YAP_RationalOfTerm(Term, void *); -X_API Term YAP_MkFloatTerm(flt); -X_API flt YAP_FloatOfTerm(Term); -X_API Term YAP_MkAtomTerm(Atom); -X_API Atom YAP_AtomOfTerm(Term); -X_API Atom YAP_LookupAtom(char *); -X_API Atom YAP_LookupWideAtom(wchar_t *); -X_API size_t YAP_AtomNameLength(Atom); -X_API Atom YAP_FullLookupAtom(char *); -X_API int YAP_IsWideAtom(Atom); -X_API char *YAP_AtomName(Atom); -X_API wchar_t *YAP_WideAtomName(Atom); -X_API Term YAP_MkPairTerm(Term,Term); -X_API Term YAP_MkListFromTerms(Term *,Int); -X_API Term YAP_MkNewPairTerm(void); -X_API Term YAP_HeadOfTerm(Term); -X_API Term YAP_TailOfTerm(Term); -X_API Int YAP_SkipList(Term *, Term **); -X_API Term YAP_MkApplTerm(Functor,UInt,Term *); -X_API Term YAP_MkNewApplTerm(Functor,UInt); -X_API Functor YAP_FunctorOfTerm(Term); -X_API Term YAP_ArgOfTerm(Int,Term); -X_API Term *YAP_ArgsOfTerm(Term); -X_API Functor YAP_MkFunctor(Atom,Int); -X_API Atom YAP_NameOfFunctor(Functor); -X_API Int YAP_ArityOfFunctor(Functor); -X_API void *YAP_ExtraSpace(void); -X_API void YAP_cut_up(void); -X_API Int YAP_Unify(Term,Term); -X_API int YAP_Unifiable(Term,Term); -X_API int YAP_Reset(void); -X_API Int YAP_ListLength(Term); -X_API Int YAP_Init(YAP_init_args *); -X_API Int YAP_FastInit(char *); -X_API PredEntry *YAP_FunctorToPred(Functor); -X_API PredEntry *YAP_AtomToPred(Atom); -X_API PredEntry *YAP_FunctorToPredInModule(Functor, Term); -X_API PredEntry *YAP_AtomToPredInModule(Atom, Term); -X_API Int YAP_CallProlog(Term); -X_API void *YAP_AllocSpaceFromYap(size_t); -X_API void *YAP_ReallocSpaceFromYap(void*,size_t); -X_API void YAP_FreeSpaceFromYap(void *); -X_API int YAP_StringToBuffer(Term, char *, unsigned int); -X_API Term YAP_ReadBuffer(char *,Term *); -X_API Term YAP_FloatsToList(double *, size_t); -X_API Int YAP_ListToFloats(Term, double *, size_t); -X_API Term YAP_IntsToList(Int *, size_t); -X_API Int YAP_ListToInts(Term, Int *, size_t); -X_API Term YAP_BufferToString(char *); -X_API Term YAP_NBufferToString(char *, size_t); -X_API Term YAP_WideBufferToString(wchar_t *); -X_API Term YAP_NWideBufferToString(wchar_t *, size_t); -X_API Term YAP_BufferToAtomList(char *); -X_API Term YAP_NBufferToAtomList(char *,size_t); -X_API Term YAP_WideBufferToAtomList(wchar_t *); -X_API Term YAP_NWideBufferToAtomList(wchar_t *, size_t); -X_API Term YAP_NWideBufferToAtomDiffList(wchar_t *, Term, size_t); -X_API Term YAP_BufferToDiffList(char *, Term); -X_API Term YAP_NBufferToDiffList(char *, Term, size_t); -X_API Term YAP_WideBufferToDiffList(wchar_t *, Term); -X_API Term YAP_NWideBufferToDiffList(wchar_t *, Term, size_t); -X_API void YAP_Error(int, Term, char *, ...); -X_API Int YAP_RunPredicate(PredEntry *, Term *); -X_API Int YAP_RunGoal(Term); -X_API Int YAP_RunGoalOnce(Term); -X_API int YAP_RestartGoal(void); -X_API int YAP_ShutdownGoal(int); -X_API int YAP_EnterGoal(PredEntry *, Term *, YAP_dogoalinfo *); -X_API int YAP_RetryGoal(YAP_dogoalinfo *); -X_API int YAP_LeaveGoal(int, YAP_dogoalinfo *); -X_API int YAP_GoalHasException(Term *); -X_API void YAP_ClearExceptions(void); -X_API int YAP_ContinueGoal(void); -X_API void YAP_PruneGoal(YAP_dogoalinfo *); -X_API IOSTREAM *YAP_TermToStream(Term); -X_API IOSTREAM *YAP_InitConsult(int, char *); -X_API void YAP_EndConsult(IOSTREAM *); -X_API Term YAP_Read(IOSTREAM *); -X_API void YAP_Write(Term, IOSTREAM *, int); -X_API Term YAP_CopyTerm(Term); -X_API int YAP_WriteBuffer(Term, char *, size_t, int); -X_API char *YAP_WriteDynamicBuffer(Term, char *, size_t, size_t *, int *, int); -X_API char *YAP_CompileClause(Term); -X_API void YAP_PutValue(Atom,Term); -X_API Term YAP_GetValue(Atom); -X_API int YAP_CompareTerms(Term,Term); -X_API void YAP_Exit(int); -X_API void YAP_InitSocks(char *, long); -X_API void YAP_SetOutputMessage(void); -X_API int YAP_StreamToFileNo(Term); -X_API void YAP_CloseAllOpenStreams(void); -X_API void YAP_FlushAllStreams(void); - /** -@group slotInterface Term Handles or Slots +@defgroup slotInterface Term Handles or Slots @{ Term handles correspond to SWI-Prolog's term_t datatype: they are a safe representation @@ -569,73 +458,6 @@ X_API void YAP_SlotsToArgs(int HowMany, YAP_Int slot); /// @} -X_API void YAP_Throw(Term); -X_API void YAP_AsyncThrow(Term); -X_API void YAP_Halt(int); -X_API Term *YAP_TopOfLocalStack(void); -X_API void *YAP_Predicate(Atom,UInt,Term); -X_API void YAP_PredicateInfo(void *,Atom *,UInt *,Term *); -X_API void YAP_UserCPredicate(char *,CPredicate,UInt); -X_API void YAP_UserBackCPredicate(char *,CPredicate,CPredicate,UInt,unsigned int); -X_API void YAP_UserCPredicateWithArgs(char *,CPredicate,UInt,Term); -X_API void YAP_UserBackCutCPredicate(char *,CPredicate,CPredicate,CPredicate,UInt,unsigned int); -X_API void *YAP_ExtraSpaceCut(void); -X_API Term YAP_SetCurrentModule(Term); -X_API Term YAP_CurrentModule(void); -X_API Term YAP_CreateModule(Atom); -X_API Term YAP_StripModule(Term, Term *); -X_API int YAP_ThreadSelf(void); -X_API int YAP_ThreadCreateEngine(struct thread_attr_struct *); -X_API int YAP_ThreadAttachEngine(int); -X_API int YAP_ThreadDetachEngine(int); -X_API int YAP_ThreadDestroyEngine(int); -X_API Term YAP_MkBlobTerm(unsigned int); -X_API void *YAP_BlobOfTerm(Term); -X_API Term YAP_TermNil(void); -X_API int YAP_IsTermNil(Term); -X_API int YAP_AtomGetHold(Atom); -X_API int YAP_AtomReleaseHold(Atom); -X_API Agc_hook YAP_AGCRegisterHook(Agc_hook); -X_API int YAP_HaltRegisterHook(HaltHookFunc, void *); -X_API char *YAP_cwd(void); -X_API Term YAP_OpenList(int); -X_API Term YAP_ExtendList(Term, Term); -X_API int YAP_CloseList(Term, Term); -X_API int YAP_IsAttVar(Term); -X_API Term YAP_AttsOfVar(Term); -X_API int YAP_FileNoFromStream(Term); -X_API void *YAP_FileDescriptorFromStream(Term); -X_API void *YAP_Record(Term); -X_API Term YAP_Recorded(void *); -X_API int YAP_Erase(void *); -X_API int YAP_Variant(Term, Term); -X_API Int YAP_NumberVars(Term, Int); -X_API Term YAP_UnNumberVars(Term); -X_API int YAP_IsNumberedVariable(Term); -X_API int YAP_ExactlyEqual(Term, Term); -X_API Int YAP_TermHash(Term, Int, Int, int); -X_API void YAP_signal(int); -X_API int YAP_SetYAPFlag(yap_flag_t, int); -X_API Int YAP_VarSlotToNumber(Int); -X_API Term YAP_ModuleUser(void); -X_API Int YAP_NumberOfClausesForPredicate(PredEntry *); -X_API int YAP_MaxOpPriority(Atom, Term); -X_API int YAP_OpInfo(Atom, Term, int, int *, int *); -X_API Term YAP_AllocExternalDataInStack(size_t); -X_API void *YAP_ExternalDataInStackFromTerm(Term); -X_API int YAP_NewOpaqueType(void *); -X_API Term YAP_NewOpaqueObject(int, size_t); -X_API void *YAP_OpaqueObjectFromTerm(Term); -X_API CELL *YAP_HeapStoreOpaqueTerm(Term t); -X_API int YAP_Argv(char *** argvp); -X_API YAP_tag_t YAP_TagOfTerm(Term); -X_API size_t YAP_ExportTerm(Term, char *, size_t); -X_API size_t YAP_SizeOfExportedTerm(char *); -X_API Term YAP_ImportTerm(char *); -X_API int YAP_RequiresExtraStack(size_t); -X_API Int YAP_AtomToInt(Atom At); -X_API Atom YAP_IntToAtom(Int i); - static UInt current_arity(void) { @@ -671,12 +493,6 @@ YAP_A(int i) return(Deref(XREGS[i])); } -X_API Term -YAP_Deref(Term t) -{ - return(Deref(t)); -} - X_API Bool YAP_IsIntTerm(Term t) { @@ -813,16 +629,19 @@ YAP_MkBigNumTerm(void *big) #endif /* USE_GMP */ } -X_API void +X_API int YAP_BigNumOfTerm(Term t, void *b) { #if USE_GMP MP_INT *bz = (MP_INT *)b; if (IsVarTerm(t)) - return; + return FALSE; if (!IsBigIntTerm(t)) - return; + return FALSE; mpz_set(bz,Yap_BigIntOfTerm(t)); + return TRUE; +#else + return FALSE; #endif /* USE_GMP */ } @@ -840,16 +659,19 @@ YAP_MkRationalTerm(void *big) #endif /* USE_GMP */ } -X_API void +X_API int YAP_RationalOfTerm(Term t, void *b) { #if USE_GMP MP_RAT *br = (MP_RAT *)b; if (IsVarTerm(t)) - return; + return FALSE; if (!IsBigIntTerm(t)) - return; + return FALSE; mpq_set(br,Yap_BigRatOfTerm(t)); + return TRUE; +#else + return FALSE; #endif /* USE_GMP */ } @@ -935,29 +757,29 @@ YAP_IsWideAtom(Atom a) return IsWideAtom(a); } -X_API char * +X_API const char * YAP_AtomName(Atom a) { - char *o; + const char *o; o = AtomName(a); return(o); } -X_API wchar_t * +X_API const wchar_t * YAP_WideAtomName(Atom a) { return RepAtom(a)->WStrOfAE; } X_API Atom -YAP_LookupAtom(char *c) +YAP_LookupAtom(const char *c) { CACHE_REGS Atom a; while (TRUE) { - a = Yap_LookupAtom(c); + a = Yap_LookupAtom((char *)c); LOCK(LOCAL_SignalLock); if (a == NIL || Yap_has_signal(YAP_CDOVF_SIGNAL)) { if (!Yap_locked_growheap(FALSE, 0, NULL)) { @@ -969,16 +791,17 @@ YAP_LookupAtom(char *c) return a; } } + return NULL; } X_API Atom -YAP_LookupWideAtom(wchar_t *c) +YAP_LookupWideAtom(const wchar_t *c) { CACHE_REGS Atom a; while (TRUE) { - a = Yap_LookupWideAtom(c); + a = Yap_LookupWideAtom((wchar_t *)c); LOCK(LOCAL_SignalLock); if (a == NIL || Yap_has_signal(YAP_CDOVF_SIGNAL)) { if (!Yap_locked_growheap(FALSE, 0, NULL)) { @@ -990,16 +813,17 @@ YAP_LookupWideAtom(wchar_t *c) return a; } } + return NULL; } X_API Atom -YAP_FullLookupAtom(char *c) +YAP_FullLookupAtom(const char *c) { CACHE_REGS Atom at; while (TRUE) { - at = Yap_FullLookupAtom(c); + at = Yap_FullLookupAtom((char *)c); LOCK(LOCAL_SignalLock); if (at == NIL || Yap_has_signal(YAP_CDOVF_SIGNAL)) { if (!Yap_locked_growheap(FALSE, 0, NULL)) { @@ -1011,6 +835,7 @@ YAP_FullLookupAtom(char *c) return at; } } + return NULL; } X_API size_t @@ -1164,7 +989,7 @@ YAP_SkipList(Term *l, Term **tailp) } X_API Term -YAP_MkApplTerm(Functor f,UInt arity, Term args[]) +YAP_MkApplTerm(Functor f, UInt arity, Term args[]) { CACHE_REGS Term t; @@ -1180,7 +1005,7 @@ YAP_MkApplTerm(Functor f,UInt arity, Term args[]) } X_API Term -YAP_MkNewApplTerm(Functor f,UInt arity) +YAP_MkNewApplTerm(Functor f, UInt arity) { CACHE_REGS Term t; @@ -1203,7 +1028,7 @@ YAP_FunctorOfTerm(Term t) X_API Term -YAP_ArgOfTerm(Int n, Term t) +YAP_ArgOfTerm(UInt n, Term t) { return (ArgOfTerm(n, t)); } @@ -1219,7 +1044,7 @@ YAP_ArgsOfTerm(Term t) } X_API Functor -YAP_MkFunctor(Atom a, Int n) +YAP_MkFunctor(Atom a, UInt n) { return (Yap_MkFunctor(a, n)); } @@ -1230,7 +1055,7 @@ YAP_NameOfFunctor(Functor f) return (NameOfFunctor(f)); } -X_API Int +X_API UInt YAP_ArityOfFunctor(Functor f) { return (ArityOfFunctor(f)); @@ -1309,7 +1134,7 @@ YAP_cut_up(void) RECOVER_B(); } -X_API Int +X_API int YAP_Unify(Term t1, Term t2) { Int out; @@ -1395,10 +1220,10 @@ YAP_InitSlot(Term t) } X_API int -YAP_RecoverSlots(int n, Int sl) +YAP_RecoverSlots(int n, Int top_slot) { CACHE_REGS - return Yap_RecoverSlots(n, sl PASS_REGS); + return Yap_RecoverSlots(n, top_slot PASS_REGS); } X_API Term @@ -2067,7 +1892,7 @@ YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) /* copy a string to a buffer */ X_API Term -YAP_BufferToString(char *s) +YAP_BufferToString(const char *s) { Term t; BACKUP_H(); @@ -2087,7 +1912,7 @@ YAP_BufferToString(char *s) /* copy a string to a buffer */ X_API Term -YAP_NBufferToString(char *s, size_t len) +YAP_NBufferToString(const char *s, size_t len) { Term t; BACKUP_H(); @@ -2109,7 +1934,7 @@ YAP_NBufferToString(char *s, size_t len) /* copy a string to a buffer */ X_API Term -YAP_WideBufferToString(wchar_t *s) +YAP_WideBufferToString(const wchar_t *s) { Term t; BACKUP_H(); @@ -2129,7 +1954,7 @@ YAP_WideBufferToString(wchar_t *s) /* copy a string to a buffer */ X_API Term -YAP_NWideBufferToString(wchar_t *s, size_t len) +YAP_NWideBufferToString(const wchar_t *s, size_t len) { Term t; BACKUP_H(); @@ -2151,7 +1976,7 @@ YAP_NWideBufferToString(wchar_t *s, size_t len) /* copy a string to a buffer */ X_API Term -YAP_ReadBuffer(char *s, Term *tp) +YAP_ReadBuffer(const char *s, Term *tp) { CACHE_REGS Int sl; @@ -2199,8 +2024,8 @@ YAP_ReadBuffer(char *s, Term *tp) } /* copy a string to a buffer */ -X_API Term -YAP_BufferToAtomList(char *s) +X_API YAP_Term +YAP_BufferToAtomList(const char *s) { Term t; BACKUP_H(); @@ -2220,7 +2045,7 @@ YAP_BufferToAtomList(char *s) /* copy a string of size len to a buffer */ X_API Term -YAP_NBufferToAtomList(char *s, size_t len) +YAP_NBufferToAtomList(const char *s, size_t len) { Term t; BACKUP_H(); @@ -2242,7 +2067,7 @@ YAP_NBufferToAtomList(char *s, size_t len) /* copy a string to a buffer */ X_API Term -YAP_WideBufferToAtomList(wchar_t *s) +YAP_WideBufferToAtomList(const wchar_t *s) { Term t; BACKUP_H(); @@ -2262,7 +2087,7 @@ YAP_WideBufferToAtomList(wchar_t *s) /* copy a string of size len to a buffer */ X_API Term -YAP_NWideBufferToAtomList(wchar_t *s, size_t len) +YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) { Term t; BACKUP_H(); @@ -2284,7 +2109,7 @@ YAP_NWideBufferToAtomList(wchar_t *s, size_t len) /* copy a string of size len to a buffer */ X_API Term -YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len) +YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) { Term t; BACKUP_H(); @@ -2307,7 +2132,7 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len) /* copy a string to a buffer */ X_API Term -YAP_BufferToDiffList(char *s, Term t0) +YAP_BufferToDiffList(const char *s, Term t0) { Term t; BACKUP_H(); @@ -2328,7 +2153,7 @@ YAP_BufferToDiffList(char *s, Term t0) /* copy a string of size len to a buffer */ X_API Term -YAP_NBufferToDiffList(char *s, Term t0, size_t len) +YAP_NBufferToDiffList(const char *s, Term t0, size_t len) { Term t; BACKUP_H(); @@ -2351,7 +2176,7 @@ YAP_NBufferToDiffList(char *s, Term t0, size_t len) /* copy a string to a buffer */ X_API Term -YAP_WideBufferToDiffList(wchar_t *s, Term t0) +YAP_WideBufferToDiffList(const wchar_t *s, Term t0) { Term t; BACKUP_H(); @@ -2372,7 +2197,7 @@ YAP_WideBufferToDiffList(wchar_t *s, Term t0) /* copy a string of size len to a buffer */ X_API Term -YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len) +YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len) { Term t; BACKUP_H(); @@ -2395,7 +2220,7 @@ YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len) X_API void -YAP_Error(int myerrno, Term t, char *buf,...) +YAP_Error(int myerrno, Term t, const char *buf,...) { #define YAP_BUF_SIZE 512 va_list ap; @@ -2624,7 +2449,8 @@ YAP_ExternalDataInStackFromTerm(Term t) return ExternalBlobFromTerm (t); } -int YAP_NewOpaqueType(void *f) +X_API YAP_opaque_tag_t +YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) { int i; if (!GLOBAL_OpaqueHandlers) { @@ -2642,7 +2468,7 @@ int YAP_NewOpaqueType(void *f) return i+USER_BLOB_START; } -Term YAP_NewOpaqueObject(int tag, size_t bytes) +Term YAP_NewOpaqueObject(YAP_opaque_tag_t tag, size_t bytes) { Term t = Yap_AllocExternalDataInStack((CELL)tag, bytes); if (t == TermNil) @@ -2651,7 +2477,7 @@ Term YAP_NewOpaqueObject(int tag, size_t bytes) } X_API Bool -YAP_IsOpaqueObjectTerm(Term t, int tag) +YAP_IsOpaqueObjectTerm(Term t, YAP_opaque_tag_t tag) { return IsExternalBlobTerm(t, (CELL)tag); } @@ -2875,7 +2701,7 @@ YAP_ClearExceptions(void) } X_API IOSTREAM * -YAP_InitConsult(int mode, char *filename) +YAP_InitConsult(int mode, const char *filename) { IOSTREAM *st; BACKUP_MACHINE_REGS(); @@ -3475,9 +3301,10 @@ YAP_Exit(int retval) Yap_exit(retval); } -X_API void -YAP_InitSocks(char *host, long port) +X_API int +YAP_InitSocks(const char *host, long port) { + return 0; } X_API void @@ -3575,13 +3402,13 @@ YAP_PredicateInfo(void *p, Atom* a, UInt* arity, Term* m) } X_API void -YAP_UserCPredicate(char *name, CPredicate def, UInt arity) +YAP_UserCPredicate(const char *name, CPredicate def, UInt arity) { Yap_InitCPred(name, arity, def, UserCPredFlag); } X_API void -YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont, +YAP_UserBackCPredicate(const char *name, CPredicate init, CPredicate cont, UInt arity, unsigned int extra) { Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL ,UserCPredFlag); @@ -3589,14 +3416,14 @@ YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont, } X_API void -YAP_UserBackCutCPredicate(char *name, CPredicate init, CPredicate cont, CPredicate cut, +YAP_UserBackCutCPredicate(const char *name, CPredicate init, CPredicate cont, CPredicate cut, UInt arity, unsigned int extra) { Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag); } X_API void -YAP_UserCPredicateWithArgs(char *a, CPredicate f, UInt arity, Term mod) +YAP_UserCPredicateWithArgs(const char *a, CPredicate f, UInt arity, Term mod) { CACHE_REGS PredEntry *pe; @@ -3658,7 +3485,7 @@ YAP_ThreadSelf(void) } X_API int -YAP_ThreadCreateEngine(struct thread_attr_struct * attr) +YAP_ThreadCreateEngine(struct YAP_thread_attr_struct * attr) { #if THREADS return Yap_thread_create_engine(attr); diff --git a/C/cdmgr.c b/C/cdmgr.c index 7a4c95806..48f176c32 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2671,7 +2671,7 @@ Yap_ConsultingFile ( USES_REGS1 ) /* consult file *file*, *mode* may be one of either consult or reconsult */ static void -init_consult(int mode, char *file) +init_consult(int mode, const char *file) { CACHE_REGS if (!LOCAL_ConsultSp) { @@ -2693,7 +2693,7 @@ init_consult(int mode, char *file) } void -Yap_init_consult(int mode, char *file) +Yap_init_consult(int mode, const char *file) { init_consult(mode,file); } diff --git a/C/compiler.c b/C/compiler.c index 897abbc35..087d0a0dd 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -447,7 +447,7 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct } break; case bt1_flag: - Yap_emit(fetch_args_for_bccall, t, 0, &cglobs->cint); + Yap_emit(fetch_args_for_bccall_op, t, 0, &cglobs->cint); break; case bt2_flag: Yap_emit(bccall_op, t, (CELL)cglobs->current_p0, &cglobs->cint); @@ -2196,7 +2196,7 @@ usesvar(compiler_vm_op ic) case save_pair_op: case f_val_op: case f_var_op: - case fetch_args_for_bccall: + case fetch_args_for_bccall_op: case bccall_op: return TRUE; default: @@ -2963,7 +2963,7 @@ c_layout(compiler_struct *cglobs) case unify_s_var_op: case unify_s_val_op: #endif - case fetch_args_for_bccall: + case fetch_args_for_bccall_op: case bccall_op: checktemp(arg, rn, ic, cglobs); break; diff --git a/C/computils.c b/C/computils.c index 68efd847d..e7316161e 100644 --- a/C/computils.c +++ b/C/computils.c @@ -67,7 +67,7 @@ static char SccsId[] = "%W% %G%"; #endif #ifdef DEBUG -static void ShowOp(char *, struct PSEUDO *); +static void ShowOp(const char *, struct PSEUDO *); #endif /* DEBUG */ /* @@ -446,7 +446,7 @@ write_functor(Functor f) } static void -ShowOp (char *f, struct PSEUDO *cpc) +ShowOp (const char *f, struct PSEUDO *cpc) { char ch; Int arg = cpc->rnd1; @@ -468,6 +468,7 @@ ShowOp (char *f, struct PSEUDO *cpc) #endif case 'a': case 'n': + case 'S': Yap_DebugPlWrite ((Term) arg); break; case 'b': @@ -666,143 +667,286 @@ ShowOp (char *f, struct PSEUDO *cpc) Yap_DebugErrorPutc ('\n'); } -static char *opformat[] = -{ - "nop", - "get_var\t\t%v,%r", - "put_var\t\t%v,%r", - "get_val\t\t%v,%r", - "put_val\t\t%v,%r", - "get_atom\t%a,%r", - "put_atom\t%a,%r", - "get_num\t\t%n,%r", - "put_num\t\t%n,%r", - "get_float\t\t%w,%r", - "put_float\t\t%w,%r", - "get_dbterm\t%w,%r", - "put_dbterm\t%w,%r", - "get_longint\t\t%w,%r", - "put_longint\t\t%w,%r", - "get_bigint\t\t%l,%r", - "put_bigint\t\t%l,%r", - "get_list\t%r", - "put_list\t%r", - "get_struct\t%f,%r", - "put_struct\t%f,%r", - "put_unsafe\t%v,%r", - "unify_var\t%v", - "write_var\t%v", - "unify_val\t%v", - "write_val\t%v", - "unify_atom\t%a", - "write_atom\t%a", - "unify_num\t%n", - "write_num\t%n", - "unify_float\t%w", - "write_float\t%w", - "unify_dbterm\t%w", - "write_dbterm\t%w", - "unify_longint\t%w", - "write_longint\t%w", - "unify_bigint\t%l", - "write_bigint\t%l", - "unify_list", - "write_list", - "unify_struct\t%f", - "write_struct\t%f", - "write_unsafe\t%v", - "unify_local\t%v", - "write local\t%v", - "unify_last_list", - "write_last_list", - "unify_last_struct\t%f", - "write_last_struct\t%f", - "unify_last_var\t%v", - "unify_last_val\t%v", - "unify_last_local\t%v", - "unify_last_atom\t%a", - "unify_last_num\t%n", - "unify_last_float\t%w", - "unify_last_dbterm\t%w", - "unify_last_longint\t%w", - "unify_last_bigint\t%l", - "ensure_space", - "native_code", - "function_to_var\t%v,%B", - "function_to_val\t%v,%B", - "function_to_0\t%B", - "align_float", - "fail", - "cut", - "cutexit", - "allocate", - "deallocate", - "try_me_else\t\t%l\t%x", - "jump\t\t%l", - "jump\t\t%l", - "proceed", - "call\t\t%p,%d,%z", - "execute\t\t%p", - "sys\t\t%p", - "%l:", - "name\t\t%m,%d", - "pop\t\t%l", - "retry_me_else\t\t%l\t%x", - "trust_me_else_fail\t%x", - "either_me\t\t%l,%d,%z", - "or_else\t\t%l,%z", - "or_last", - "push_or", - "pushpop_or", - "pop_or", - "save_by\t\t%v", - "commit_by\t\t%v", - "patch_by\t\t%v", - "try\t\t%g\t%x", - "retry\t\t%g\t%x", - "trust\t\t%g\t%x", - "try_in\t\t%g\t%x", - "jump_if_var\t\t%g", - "jump_if_nonvar\t\t%g", - "cache_arg\t%r", - "cache_sub_arg\t%d", - "user_index", - "switch_on_type\t%h\t%h\t%h\t%h", - "switch_on_constant\t%i\n%c", - "if_constant\t%i\n%c", - "switch_on_functor\t%i\n%e", - "if_functor\t%i\n%e", - "if_not_then\t%i\t%h\t%h\t%h", - "index_on_dbref", - "index_on_blob", - "index_on_long", - "check_var\t %r", - "save_pair\t%v", - "save_appl\t%v", - "pvar_bitmap\t%l,%b", - "pvar_live_regs\t%l,%b", - "fetch_reg1_reg2\t%N,%N", - "fetch_constant_reg\t%l,%N", - "fetch_reg_constant\t%l,%N", - "fetch_integer_reg\t%d,%N", - "fetch_reg_integer\t%d,%N", - "enter_profiling\t\t%g", - "retry_profiled\t\t%g", - "count_call_op\t\t%g", - "count_retry_op\t\t%g", - "restore_temps\t\t%l", - "restore_temps_and_skip\t\t%l", - "enter_lu", - "empty_call\t\t%l,%d", +static const char * +getFormat(compiler_vm_op ic) { + switch( ic ) { + case nop_op: + return "nop"; + case get_var_op: + return "get_var\t\t%v,%r"; + case put_var_op: + return "put_var\t\t%v,%r"; + case get_val_op: + return "get_val\t\t%v,%r"; + case put_val_op: + return "put_val\t\t%v,%r"; + case get_atom_op: + return "get_atom\t%a,%r"; + case put_atom_op: + return "put_atom\t%a,%r"; + case get_num_op: + return "get_num\t\t%n,%r"; + case put_num_op: + return "put_num\t\t%n,%r"; + case get_float_op: + return "get_float\t\t%w,%r"; + case put_float_op: + return "put_float\t\t%w,%r"; + case get_string_op: + return "get_string\t\t%w,%S"; + case put_string_op: + return "put_string\t\t%w,%S"; + case get_dbterm_op: + return "get_dbterm\t%w,%r"; + case put_dbterm_op: + return "put_dbterm\t%w,%r"; + case get_longint_op: + return "get_longint\t\t%w,%r"; + case put_longint_op: + return "put_longint\t\t%w,%r"; + case get_bigint_op: + return "get_bigint\t\t%l,%r"; + case put_bigint_op: + return "put_bigint\t\t%l,%r"; + case get_list_op: + return "get_list\t%r"; + case put_list_op: + return "put_list\t%r"; + case get_struct_op: + return "get_struct\t%f,%r"; + case put_struct_op: + return "put_struct\t%f,%r"; + case put_unsafe_op: + return "put_unsafe\t%v,%r"; + case unify_var_op: + return "unify_var\t%v"; + case write_var_op: + return "write_var\t%v"; + case unify_val_op: + return "unify_val\t%v"; + case write_val_op: + return "write_val\t%v"; + case unify_atom_op: + return "unify_atom\t%a"; + case write_atom_op: + return "write_atom\t%a"; + case unify_num_op: + return "unify_num\t%n"; + case write_num_op: + return "write_num\t%n"; + case unify_float_op: + return "unify_float\t%w"; + case write_float_op: + return "write_float\t%w"; + case unify_string_op: + return "unify_string\t%S"; + case write_string_op: + return "write_string\t%S"; + case unify_dbterm_op: + return "unify_dbterm\t%w"; + case write_dbterm_op: + return "write_dbterm\t%w"; + case unify_longint_op: + return "unify_longint\t%w"; + case write_longint_op: + return "write_longint\t%w"; + case unify_bigint_op: + return "unify_bigint\t%l"; + case write_bigint_op: + return "write_bigint\t%l"; + case unify_list_op: + return "unify_list"; + case write_list_op: + return "write_list"; + case unify_struct_op: + return "unify_struct\t%f"; + case write_struct_op: + return "write_struct\t%f"; + case write_unsafe_op: + return "write_unsafe\t%v"; + case unify_local_op: + return "unify_local\t%v"; + case write_local_op: + return "write local\t%v"; + case unify_last_list_op: + return "unify_last_list"; + case write_last_list_op: + return "write_last_list"; + case unify_last_struct_op: + return "unify_last_struct\t%f"; + case write_last_struct_op: + return "write_last_struct\t%f"; + case unify_last_var_op: + return "unify_last_var\t%v"; + case unify_last_val_op: + return "unify_last_val\t%v"; + case unify_last_local_op: + return "unify_last_local\t%v"; + case unify_last_atom_op: + return "unify_last_atom\t%a"; + case unify_last_num_op: + return "unify_last_num\t%n"; + case unify_last_float_op: + return "unify_last_float\t%w"; + case unify_last_string_op: + return "unify_last_string\t%S"; + case unify_last_dbterm_op: + return "unify_last_dbterm\t%w"; + case unify_last_longint_op: + return "unify_last_longint\t%w"; + case unify_last_bigint_op: + return "unify_last_bigint\t%l"; + case ensure_space_op: + return "ensure_space"; + case native_op: + return "native_code"; + case f_var_op: + return "function_to_var\t%v,%B"; + case f_val_op: + return "function_to_val\t%v,%B"; + case f_0_op: + return "function_to_0\t%B"; + case align_float_op: + return "align_float"; + case fail_op: + return "fail"; + case cut_op: + return "cut"; + case cutexit_op: + return "cutexit"; + case allocate_op: + return "allocate"; + case deallocate_op: + return "deallocate"; + case tryme_op: + return "try_me_else\t\t%l\t%x"; + case jump_op: + return "jump\t\t%l"; + case jumpi_op: + return "jump_in_indexing\t\t%i"; + case procceed_op: + return "proceed"; + case call_op: + return "call\t\t%p,%d,%z"; + case execute_op: + return "execute\t\t%p"; + case safe_call_op: + return "sys\t\t%p"; + case label_op: + return "%l:"; + case name_op: + return "name\t\t%m,%d"; + case pop_op: + return "pop\t\t%l"; + case retryme_op: + return "retry_me_else\t\t%l\t%x"; + case trustme_op: + return "trust_me_else_fail\t%x"; + case either_op: + return "either_me\t\t%l,%d,%z"; + case orelse_op: + return "or_else\t\t%l,%z"; + case orlast_op: + return "or_last"; + case push_or_op: + return "push_or"; + case pop_or_op: + return "pop_or"; + case pushpop_or_op: + return "pushpop_or"; + case save_b_op: + return "save_by\t\t%v"; + case commit_b_op: + return "commit_by\t\t%v"; + case patch_b_op: + return "patch_by\t\t%v"; + case try_op: + return "try\t\t%g\t%x"; + case retry_op: + return "retry\t\t%g\t%x"; + case trust_op: + return "trust\t\t%g\t%x"; + case try_in_op: + return "try_in\t\t%g\t%x"; + case jump_v_op: + return "jump_if_var\t\t%g"; + case jump_nv_op: + return "jump_if_nonvar\t\t%g"; + case cache_arg_op: + return "cache_arg\t%r"; + case cache_sub_arg_op: + return "cache_sub_arg\t%d"; + case user_switch_op: + return "user_switch"; + case switch_on_type_op: + return "switch_on_type\t%h\t%h\t%h\t%h"; + case switch_c_op: + return "switch_on_constant\t%i\n%c"; + case if_c_op: + return "if_constant\t%i\n%c"; + case switch_f_op: + return "switch_on_functor\t%i\n%e"; + case if_f_op: + return "if_functor\t%i\n%e"; + case if_not_op: + return "if_not_then\t%i\t%h\t%h\t%h"; + case index_dbref_op: + return "index_on_dbref"; + case index_blob_op: + return "index_on_blob"; + case index_long_op: + return "index_on_blob"; + case index_string_op: + return "index_on_string"; + case if_nonvar_op: + return "check_var\t %r"; + case save_pair_op: + return "save_pair\t%v"; + case save_appl_op: + return "save_appl\t%v"; + case mark_initialised_pvars_op: + return "pvar_bitmap\t%l,%b"; + case mark_live_regs_op: + return "pvar_live_regs\t%l,%b"; + case fetch_args_vv_op: + return "fetch_reg1_reg2\t%N,%N"; + case fetch_args_cv_op: + return "fetch_constant_reg\t%l,%N"; + case fetch_args_vc_op: + return "fetch_reg_constant\t%l,%N"; + case fetch_args_iv_op: + return "fetch_integer_reg\t%d,%N"; + case fetch_args_vi_op: + return "fetch_reg_integer\t%d,%N"; + case enter_profiling_op: + return "enter_profiling\t\t%g"; + case retry_profiled_op: + return "retry_profiled\t\t%g"; + case count_call_op: + return "count_call_op\t\t%g"; + case count_retry_op: + return "count_retry_op\t\t%g"; + case restore_tmps_op: + return "restore_temps\t\t%l"; + case restore_tmps_and_skip_op: + return "restore_temps_and_skip\t\t%l"; + case enter_lu_op: + return "enter_lu"; + case empty_call_op: + return "empty_call\t\t%l,%d"; #ifdef YAPOR - "sync", + case sync_op: + return "sync"; #endif /* YAPOR */ #ifdef TABLING - "table_new_answer", - "table_try_single\t%g\t%x", + case table_new_answer_op: + return "table_new_answer"; + case table_try_single_op: + return "table_try_single\t%g\t%x"; #endif /* TABLING */ #ifdef TABLING_INNER_CUTS - "clause_with_cut", + case "clause_with_cut": + return clause_with_cut_op; #endif /* TABLING_INNER_CUTS */ #ifdef BEAM "run_op %1,%4", @@ -828,10 +972,16 @@ static char *opformat[] = "equal_op", "exit", #endif - "fetch_args_for_bccall\t%v", - "binary_cfunc\t\t%v,%P", - "blob\t%O", - "label_control\t" + case fetch_args_for_bccall_op: + return "fetch_args_for_bccall\t%v"; + case bccall_op: + return "binary_cfunc\t\t%v,%P"; + case blob_op: + return "blob\t%O"; + case string_op: + return "string\t%O"; + case label_ctl_op: + return "label_control\t"; #ifdef SFUNC , "get_s_f_op\t%f,%r", @@ -849,14 +999,13 @@ static char *opformat[] = "unify_s_end", "write_s_end" #endif -}; - + } +} void Yap_ShowCode (struct intermediates *cint) { CACHE_REGS - CELL *oldH = HR; struct PSEUDO *cpc; cpc = cint->CodeStart; @@ -865,12 +1014,11 @@ Yap_ShowCode (struct intermediates *cint) while (cpc) { compiler_vm_op ic = cpc->op; if (ic != nop_op) { - ShowOp (opformat[ic], cpc); - } + } + ShowOp (getFormat(ic), cpc); cpc = cpc->nextInst; } Yap_DebugErrorPutc ('\n'); - HR = oldH; } #endif /* DEBUG */ diff --git a/C/exec.c b/C/exec.c index 124ce3c6f..652fb5e85 100755 --- a/C/exec.c +++ b/C/exec.c @@ -30,7 +30,6 @@ static Int EnterCreepMode(Term, Term CACHE_TYPE); static Int p_save_cp( USES_REGS1 ); static Int p_execute( USES_REGS1 ); static Int p_execute0( USES_REGS1 ); -static int execute_pred(PredEntry *ppe, CELL *pt USES_REGS); static Term cp_as_integer(choiceptr cp USES_REGS) @@ -676,7 +675,7 @@ p_do_goal_expansion( USES_REGS1 ) if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { out = TRUE; ARG3 = ARG2; goto complete; @@ -685,7 +684,7 @@ p_do_goal_expansion( USES_REGS1 ) if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { out = TRUE; ARG3 = ARG2; goto complete; @@ -696,7 +695,7 @@ p_do_goal_expansion( USES_REGS1 ) if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { out = TRUE; goto complete; } @@ -706,7 +705,7 @@ p_do_goal_expansion( USES_REGS1 ) (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { ARG3 = ARG2; out = TRUE; } @@ -738,7 +737,7 @@ p_do_term_expansion( USES_REGS1 ) if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { out = TRUE; goto complete; } @@ -746,7 +745,7 @@ p_do_term_expansion( USES_REGS1 ) if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { out = TRUE; goto complete; } @@ -755,7 +754,7 @@ p_do_term_expansion( USES_REGS1 ) (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - execute_pred(pe, NULL PASS_REGS) ) { + Yap_execute_pred(pe, NULL PASS_REGS) ) { out = TRUE; } complete: @@ -1215,8 +1214,8 @@ Yap_exec_absmi(int top) } -static int -execute_pred(PredEntry *ppe, CELL *pt USES_REGS) +int +Yap_execute_pred(PredEntry *ppe, CELL *pt USES_REGS) { yamop *saved_p, *saved_cp; yamop *CodeAdr; @@ -1226,15 +1225,9 @@ execute_pred(PredEntry *ppe, CELL *pt USES_REGS) saved_cp = CP; PELOCK(81,ppe); - if (ppe->ArityOfPE == 0) { - CodeAdr = ppe->CodeOfPred; - UNLOCK(ppe->PELock); - out = do_goal(CodeAdr, 0, pt, FALSE PASS_REGS); - } else { - CodeAdr = ppe->CodeOfPred; - UNLOCK(ppe->PELock); - out = do_goal(CodeAdr, ppe->ArityOfPE, pt, FALSE PASS_REGS); - } + CodeAdr = ppe->CodeOfPred; + UNLOCK(ppe->PELock); + out = do_goal(CodeAdr, ppe->ArityOfPE, pt, FALSE PASS_REGS); if (out == 1) { choiceptr cut_B; @@ -1335,7 +1328,7 @@ Yap_execute_goal(Term t, int nargs, Term mod) if (pe == NIL) { return CallMetaCall(t, mod PASS_REGS); } - return execute_pred(ppe, pt PASS_REGS); + return Yap_execute_pred(ppe, pt PASS_REGS); } @@ -1430,13 +1423,17 @@ Yap_RunTopGoal(Term t) } static void -restore_regs(Term t USES_REGS) +restore_regs(Term t, int restore_all USES_REGS) { if (IsApplTerm(t)) { Int i; - Int max = ArityOfFunctor(FunctorOfTerm(t)); - CELL *ptr = RepAppl(t)+1; + Int max = ArityOfFunctor(FunctorOfTerm(t))-4; + CELL *ptr = RepAppl(t)+5; + P = (yamop *)IntegerOfTerm(ptr[-4]); + CP = (yamop *)IntegerOfTerm(ptr[-3]); + ENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-2])); + YENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-1])); for (i = 0; i < max; i += 2) { Int j = IntOfTerm(ptr[0]); XREGS[j] = ptr[1]; @@ -1455,7 +1452,7 @@ p_restore_regs( USES_REGS1 ) return(FALSE); } if (IsAtomTerm(t)) return(TRUE); - restore_regs(t PASS_REGS); + restore_regs(t, FALSE PASS_REGS); return(TRUE); } @@ -1466,13 +1463,15 @@ p_restore_regs2( USES_REGS1 ) Term t = Deref(ARG1), d0; choiceptr pt0; + Int d; + if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining"); return(FALSE); } d0 = Deref(ARG2); if (!IsAtomTerm(t)) { - restore_regs(t PASS_REGS); + restore_regs(t, TRUE PASS_REGS); } if (IsVarTerm(d0)) { Yap_Error(INSTANTIATION_ERROR,d0,"support for coroutining"); @@ -1481,13 +1480,16 @@ p_restore_regs2( USES_REGS1 ) if (!IsIntegerTerm(d0)) { return(FALSE); } + d = IntegerOfTerm(d0); + if (!d) + return TRUE; #if YAPOR_SBA - pt0 = (choiceptr)IntegerOfTerm(d0); + pt0 = (choiceptr)d; #else - pt0 = (choiceptr)(LCL0-IntOfTerm(d0)); + pt0 = (choiceptr)(LCL0-d); #endif /* find where to cut to */ - if (pt0 > B) { + if ((CELL *)pt0 != LCL0 && pt0 > B) { /* Wow, we're gonna cut!!! */ while (B->cp_b < pt0) { while (POP_CHOICE_POINT(B->cp_b)) diff --git a/C/grow.c b/C/grow.c index 91ef8afcf..54b040fd5 100755 --- a/C/grow.c +++ b/C/grow.c @@ -1073,7 +1073,7 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS) case write_local_op: case f_var_op: case f_val_op: - case fetch_args_for_bccall: + case fetch_args_for_bccall_op: case bccall_op: case save_pair_op: case save_appl_op: diff --git a/C/init.c b/C/init.c index 889339e0b..48f3a26aa 100755 --- a/C/init.c +++ b/C/init.c @@ -121,7 +121,7 @@ Yap_IsOpType(char *type) } static int -OpDec(int p, char *type, Atom a, Term m) +OpDec(int p, const char *type, Atom a, Term m) { int i; AtomEntry *ae = RepAtom(a); @@ -399,7 +399,7 @@ update_flags_from_prolog(UInt flags, PredEntry *pe) } void -Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags) +Yap_InitCPred(const char *Name, UInt Arity, CPredicate code, UInt flags) { CACHE_REGS Atom atom = NIL; @@ -503,7 +503,7 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags) } void -Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, UInt flags) +Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, UInt flags) { CACHE_REGS Atom atom = NIL; @@ -581,7 +581,7 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, UInt } void -Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, UInt flags) +Yap_InitAsmPred(const char *Name, UInt Arity, int code, CPredicate def, UInt flags) { CACHE_REGS Atom atom = NIL; @@ -719,21 +719,21 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, CPredicate Cut) } void -Yap_InitCPredBack(char *Name, unsigned long int Arity, +Yap_InitCPredBack(const char *Name, UInt Arity, unsigned int Extra, CPredicate Start, CPredicate Cont, UInt flags){ Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,NULL,flags); } void -Yap_InitCPredBackCut(char *Name, unsigned long int Arity, +Yap_InitCPredBackCut(const char *Name, UInt Arity, unsigned int Extra, CPredicate Start, CPredicate Cont,CPredicate Cut, UInt flags){ Yap_InitCPredBack_(Name,Arity,Extra,Start,Cont,Cut,flags); } void -Yap_InitCPredBack_(char *Name, unsigned long int Arity, +Yap_InitCPredBack_(const char *Name, UInt Arity, unsigned int Extra, CPredicate Start, CPredicate Cont, CPredicate Cut, UInt flags) { diff --git a/C/qlyr.c b/C/qlyr.c index 3c4848335..7411ef7b9 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -1054,7 +1054,6 @@ static Int p_read_program( USES_REGS1 ) { IOSTREAM *stream; - void YAP_Reset(void); Term t1 = Deref(ARG1); if (IsVarTerm(t1)) { diff --git a/C/sysbits.c b/C/sysbits.c index 78b2b76f4..a22ac155d 100755 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -1110,6 +1110,64 @@ Yap_random (void) #endif } +#if HAVE_RANDOM +static Int +p_init_random_state ( USES_REGS1 ) +{ + register Term t0 = Deref (ARG1); + char *old, * new = (char *) malloc(256); + + if (IsVarTerm (t0)) { + return(Yap_unify(ARG1,MkIntegerTerm((Int)current_seed))); + } + if(!IsNumTerm (t0)) + return (FALSE); + if (IsIntTerm (t0)) + current_seed = (unsigned int) IntOfTerm (t0); + else if (IsFloatTerm (t0)) + current_seed = (unsigned int) FloatOfTerm (t0); + else + current_seed = (unsigned int) LongIntOfTerm (t0); + old = initstate(random(), new, 256); + return Yap_unify(ARG2, MkIntegerTerm((Int)old)) && + Yap_unify(ARG3, MkIntegerTerm((Int)new)); +} + +static Int +p_set_random_state ( USES_REGS1 ) +{ + register Term t0 = Deref (ARG1); + char *old, * new; + + if (IsVarTerm (t0)) { + return FALSE; + } + if (IsIntegerTerm (t0)) + new = (char *) IntegerOfTerm (t0); + else + return FALSE; + old = setstate( new ); + return Yap_unify(ARG2, MkIntegerTerm((Int)old)); +} + +static Int +p_release_random_state ( USES_REGS1 ) +{ + register Term t0 = Deref (ARG1); + char *old; + + if (IsVarTerm (t0)) { + return FALSE; + } + if (IsIntegerTerm (t0)) + old = (char *) IntegerOfTerm (t0); + else + return FALSE; + free( old ); + return TRUE; +} +#endif + static Int p_srandom ( USES_REGS1 ) { @@ -3018,6 +3076,11 @@ Yap_InitSysPreds(void) /* can only do after heap is initialised */ InitLastWtime(); Yap_InitCPred ("srandom", 1, p_srandom, SafePredFlag); +#if HAVE_RANDOM + Yap_InitCPred ("init_random_state", 3, p_init_random_state, SafePredFlag); + Yap_InitCPred ("set_random_state", 2, p_set_random_state, SafePredFlag); + Yap_InitCPred ("release_random_state", 1, p_release_random_state, SafePredFlag); +#endif Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag|UserCPredFlag); Yap_InitCPred ("system", 1, p_system, SafePredFlag|SyncPredFlag|UserCPredFlag); diff --git a/C/text.c b/C/text.c index 5ac19fab6..7b380c876 100644 --- a/C/text.c +++ b/C/text.c @@ -1275,7 +1275,7 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[], size_t lengv[] USES while ( (chr = *ptr++) != '\0' ) *buf++ = chr; } *buf++ = '\0'; - at = out->val.a = Yap_LookupAtom((char *)HR); + at = out->val.a = Yap_LookupAtom((const char *)HR); return at; } } diff --git a/C/threads.c b/C/threads.c index 527e5777d..f79f17cc8 100755 --- a/C/threads.c +++ b/C/threads.c @@ -509,9 +509,9 @@ Yap_thread_self(void) } CELL -Yap_thread_create_engine(thread_attr *ops) +Yap_thread_create_engine(YAP_thread_attr *ops) { - thread_attr opsv; + YAP_thread_attr opsv; int new_id = allocate_new_tid(); Term t = TermNil; diff --git a/H/Atoms.h b/H/Atoms.h index d5a0f8316..152a365e5 100644 --- a/H/Atoms.h +++ b/H/Atoms.h @@ -18,12 +18,13 @@ #ifndef ATOMS_H #define ATOMS_H 1 -#undef EXTERN +#ifndef EXTERN #ifndef ADTDEFS_C #define EXTERN static #else #define EXTERN #endif +#endif #include diff --git a/H/Tags_24bits.h b/H/Tags_24bits.h index 17019fa04..4b6aa805b 100644 --- a/H/Tags_24bits.h +++ b/H/Tags_24bits.h @@ -66,9 +66,10 @@ #define YAP_PROTECTED_MASK 0x00000000L #include "inline-only.h" -INLINE_ONLY inline EXTERN int IsVarTerm (Term); -INLINE_ONLY inline EXTERN int +INLINE_ONLY int IsVarTerm (Term); + +INLINE_ONLY int IsVarTerm (Term t) { return (int) (Signed (t) >= 0); @@ -76,9 +77,9 @@ IsVarTerm (Term t) -INLINE_ONLY inline EXTERN int IsNonVarTerm (Term); +INLINE_ONLY int IsNonVarTerm (Term); -INLINE_ONLY inline EXTERN int +INLINE_ONLY int IsNonVarTerm (Term t) { return (int) (Signed (t) < 0); @@ -86,9 +87,9 @@ IsNonVarTerm (Term t) -INLINE_ONLY inline EXTERN Term *RepPair (Term); +INLINE_ONLY Term *RepPair (Term); -INLINE_ONLY inline EXTERN Term * +INLINE_ONLY Term * RepPair (Term t) { return (Term *) (NonTagPart (t)); @@ -96,9 +97,9 @@ RepPair (Term t) -INLINE_ONLY inline EXTERN Term AbsPair (Term *); +INLINE_ONLY Term AbsPair (Term *); -INLINE_ONLY inline EXTERN Term +INLINE_ONLY Term AbsPair (Term * p) { return (Term) (TAGGEDA (PairTag, (p))); @@ -106,9 +107,9 @@ AbsPair (Term * p) -INLINE_ONLY inline EXTERN Int IsPairTerm (Term); +INLINE_ONLY Int IsPairTerm (Term); -INLINE_ONLY inline EXTERN Int +INLINE_ONLY Int IsPairTerm (Term t) { return (Int) (BitOn (PairBit, (t))); @@ -116,9 +117,9 @@ IsPairTerm (Term t) -INLINE_ONLY inline EXTERN Term *RepAppl (Term); +INLINE_ONLY Term *RepAppl (Term); -INLINE_ONLY inline EXTERN Term * +INLINE_ONLY Term * RepAppl (Term t) { return (Term *) (NonTagPart (t)); @@ -126,9 +127,9 @@ RepAppl (Term t) -INLINE_ONLY inline EXTERN Term AbsAppl (Term *); +INLINE_ONLY Term AbsAppl (Term *); -INLINE_ONLY inline EXTERN Term +INLINE_ONLY Term AbsAppl (Term * p) { return (Term) (TAGGEDA (ApplTag, (p))); @@ -136,9 +137,9 @@ AbsAppl (Term * p) -INLINE_ONLY inline EXTERN Int IsApplTerm (Term); +INLINE_ONLY Int IsApplTerm (Term); -INLINE_ONLY inline EXTERN Int +INLINE_ONLY Int IsApplTerm (Term t) { return (Int) (BitOn (ApplBit, (t))); @@ -146,9 +147,9 @@ IsApplTerm (Term t) -INLINE_ONLY inline EXTERN Int IsAtomOrIntTerm (Term); +INLINE_ONLY Int IsAtomOrIntTerm (Term); -INLINE_ONLY inline EXTERN Int +INLINE_ONLY Int IsAtomOrIntTerm (Term t) { return (Int) (!(Unsigned (t) & CompBits)); @@ -157,9 +158,9 @@ IsAtomOrIntTerm (Term t) -INLINE_ONLY inline EXTERN Term AdjustPtr (Term t, Term off); +INLINE_ONLY Term AdjustPtr (Term t, Term off); -INLINE_ONLY inline EXTERN Term +INLINE_ONLY Term AdjustPtr (Term t, Term off) { return (Term) ((t) + off); @@ -167,9 +168,9 @@ AdjustPtr (Term t, Term off) -INLINE_ONLY inline EXTERN Term AdjustIDBPtr (Term t, Term off); +INLINE_ONLY Term AdjustIDBPtr (Term t, Term off); -INLINE_ONLY inline EXTERN Term +INLINE_ONLY Term AdjustIDBPtr (Term t, Term off) { return (Term) ((t) + off); diff --git a/H/Tags_32LowTag.h b/H/Tags_32LowTag.h index 563cb16f6..f54202a72 100644 --- a/H/Tags_32LowTag.h +++ b/H/Tags_32LowTag.h @@ -14,6 +14,8 @@ * version: $Id: Tags_32LowTag.h,v 1.4 2008-01-30 10:35:43 vsc Exp $ * *************************************************************************/ +#if SIZEOF_INT_P==4 && USE_LOW32_TAGS + #define TAG_LOW_BITS_32 1 /* Version for 32 bit addresses machines, @@ -196,3 +198,6 @@ IntOfTerm (Term t) { return (Int) (((Int) (t << 1)) >> (SHIFT_LOW_TAG + SHIFT_HIGH_TAG + 1)); } + +#endif + diff --git a/H/Tags_32Ops.h b/H/Tags_32Ops.h index cb9a8fa95..848093cad 100644 --- a/H/Tags_32Ops.h +++ b/H/Tags_32Ops.h @@ -49,6 +49,8 @@ are now 1 in compound terms and structures. */ +#if SIZEOF_INT_P==4 && !defined(USE_LOW32_TAGS) + #define TAGS_FAST_OPS 1 #define SHIFT_HIGH_TAG 29 @@ -320,3 +322,8 @@ AdjustIDBPtr (Term t, Term off) #endif + +#endif /* SIZEOF_INT_P==4 */ + + + diff --git a/H/Tags_32bits.h b/H/Tags_32bits.h index 9b22bd861..325abb18d 100644 --- a/H/Tags_32bits.h +++ b/H/Tags_32bits.h @@ -37,6 +37,8 @@ property list */ +#if FALSE + #define SHIFT_HIGH_TAG 29 #define MKTAG(HI,LO) ((((UInt) (HI))<> (3 + 2)); } + +#endif /* NOT IN USE */ diff --git a/H/Tags_64bits.h b/H/Tags_64bits.h index 7eab07539..4f22e924a 100644 --- a/H/Tags_64bits.h +++ b/H/Tags_64bits.h @@ -21,6 +21,8 @@ * version: $Id: Tags_64bits.h,v 1.3 2008-05-15 13:41:46 vsc Exp $ * *************************************************************************/ +#if SIZEOF_INT_P==8 + #define TAG_64BITS 1 /* Version for 64 bit addresses machines, @@ -192,3 +194,7 @@ IntOfTerm (Term t) { return (Int) ((Int) (Unsigned (t) << 3) >> 6); } + +#endif /* 64 Bits */ + + diff --git a/H/Yap.h b/H/Yap.h index 8ecfe0b32..45689ea05 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -296,6 +296,14 @@ typedef pthread_rwlock_t rwlock_t; #define OUTSIDE(MIN,X,MAX) ((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX)) #endif +/************************************************************************************************* + main exports in YapInterface.h +*************************************************************************************************/ + +/* Basic exports */ + +#include "YapDefs.h" + /************************************************************************************************* Atoms *************************************************************************************************/ diff --git a/H/Yapproto.h b/H/Yapproto.h index 1e9f36dc1..074560add 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -25,13 +25,13 @@ int Yap_GetName(char *,UInt,Term); Term Yap_GetValue(Atom); int Yap_HasOp(Atom); struct operator_entry *Yap_GetOpPropForAModuleHavingALock(AtomEntry *, Term); -Atom Yap_LookupAtom(char *); -Atom Yap_LookupAtomWithLength(char *, size_t); -Atom Yap_LookupUTF8Atom(char *); -Atom Yap_LookupMaybeWideAtom(wchar_t *); -Atom Yap_LookupMaybeWideAtomWithLength(wchar_t *, size_t); -Atom Yap_FullLookupAtom(char *); -void Yap_LookupAtomWithAddress(char *,AtomEntry *); +Atom Yap_LookupAtom(const char *); +Atom Yap_LookupAtomWithLength(const char *, size_t); +Atom Yap_LookupUTF8Atom(const char *); +Atom Yap_LookupMaybeWideAtom(const wchar_t *); +Atom Yap_LookupMaybeWideAtomWithLength(const wchar_t *, size_t); +Atom Yap_FullLookupAtom(const char *); +void Yap_LookupAtomWithAddress(const char *,AtomEntry *); Prop Yap_NewPredPropByFunctor(struct FunctorEntryStruct *, Term); Prop Yap_NewPredPropByAtom(struct AtomEntryStruct *, Term); Prop Yap_PredPropByFunctorNonThreadLocal(struct FunctorEntryStruct *, Term); @@ -126,7 +126,7 @@ void Yap_InitCdMgr(void); struct pred_entry * Yap_PredFromClause( Term t USES_REGS ); int Yap_discontiguous(struct pred_entry *ap USES_REGS ); int Yap_multiple(struct pred_entry *ap USES_REGS ); -void Yap_init_consult(int, char *); +void Yap_init_consult(int, const char *); void Yap_end_consult(void); void Yap_Abolish(struct pred_entry *); void Yap_BuildMegaClause(struct pred_entry *); @@ -182,6 +182,7 @@ Int Yap_exec_absmi(int); void Yap_trust_last(void); Term Yap_GetException(void); void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS); +int Yap_execute_pred(struct pred_entry *ppe, CELL *pt USES_REGS); int Yap_dogc( int extra_args, Term *tp USES_REGS ); /* exo.c */ @@ -244,12 +245,12 @@ void Yap_DebugEndline(void); int Yap_DebugGetc(void); #endif int Yap_IsOpType(char *); -void Yap_InitCPred(char *, unsigned long int, CPredicate, UInt); -void Yap_InitAsmPred(char *, unsigned long int, int, CPredicate, UInt); -void Yap_InitCmpPred(char *, unsigned long int, CmpPredicate, UInt); -void Yap_InitCPredBack(char *, unsigned long int, unsigned int, CPredicate,CPredicate,UInt); -void Yap_InitCPredBackCut(char *, unsigned long int, unsigned int, CPredicate,CPredicate,CPredicate,UInt); -void Yap_InitCPredBack_(char *, unsigned long int, unsigned int, CPredicate,CPredicate,CPredicate,UInt); +void Yap_InitCPred(const char *, UInt, CPredicate, UInt); +void Yap_InitAsmPred(const char *, UInt, int, CPredicate, UInt); +void Yap_InitCmpPred(const char *, UInt, CmpPredicate, UInt); +void Yap_InitCPredBack(const char *, UInt, unsigned int, CPredicate,CPredicate,UInt); +void Yap_InitCPredBackCut(const char *, UInt, unsigned int, CPredicate,CPredicate,CPredicate,UInt); +void Yap_InitCPredBack_(const char *, UInt, unsigned int, CPredicate,CPredicate,CPredicate,UInt); void Yap_InitWorkspace(UInt,UInt,UInt,UInt,UInt,int,int,int); #ifdef YAPOR @@ -385,6 +386,7 @@ void Yap_WinError(char *); /* threads.c */ void Yap_InitThreadPreds(void); void Yap_InitFirstWorkerThreadHandle(void); +int Yap_ThreadID( void ); #if THREADS int Yap_InitThread(int); #endif diff --git a/H/clause.h b/H/clause.h index 82ddf657e..4dce4d03e 100644 --- a/H/clause.h +++ b/H/clause.h @@ -21,7 +21,7 @@ /* consulting files */ typedef union CONSULT_OBJ { - char *filename; + const char *filename; int mode; Prop p; UInt c; diff --git a/H/compile.h b/H/compile.h index c4a508006..60863826b 100644 --- a/H/compile.h +++ b/H/compile.h @@ -185,7 +185,7 @@ typedef enum compiler_op { equal_op, exit_op, #endif - fetch_args_for_bccall, + fetch_args_for_bccall_op, bccall_op, blob_op, string_op, diff --git a/H/inline-only.h b/H/inline-only.h index da291a26b..74fea6cb4 100644 --- a/H/inline-only.h +++ b/H/inline-only.h @@ -5,7 +5,7 @@ #define INLINE_ONLY __attribute__((gnu_inline,always_inline)) //#define INLINE_ONLY #else -#define INLINE_ONLY +#define INLINE_ONLY inline EXTERN #endif #endif diff --git a/H/nomachine.h b/H/nomachine.h deleted file mode 100644 index b6fba8089..000000000 --- a/H/nomachine.h +++ /dev/null @@ -1,33 +0,0 @@ -#define SHORT_ADDRESSES 0 - -#undef SHORT_INTS - -#undef SHORT_SPACE - -#define FUNCTION_ADRESSES 0 - -#define ALIGN_LONGS 1 - -#undef LOW_ABSMI - -#define MSHIFTOFFS 1 - -#define HAVE_SIGNAL 1 - -#define UInt unsigned int -#define UShort unsigned short -#define Int int - -#define FFIEEE 1 - -#define Float float -#define FAFloat double - - -#define FunAdr(X) X - -#define MIPSEL - -#define HAVE_PROTO 1 - - diff --git a/H/threads.h b/H/threads.h index bef71e0a5..5cdad1fe1 100644 --- a/H/threads.h +++ b/H/threads.h @@ -3,20 +3,12 @@ #define THREADS_H 1 -typedef struct thread_attr_struct { - UInt ssize; - UInt tsize; - UInt sysize; - int (*cancel)(int thread); - Term egoal; -} thread_attr; - #ifdef THREADS Int Yap_thread_self(void); int Yap_get_thread_ref_count(int); void Yap_set_thread_ref_count(int,int); -CELL Yap_thread_create_engine(thread_attr *); +CELL Yap_thread_create_engine(YAP_thread_attr *); Int Yap_thread_attach_engine(int); Int Yap_thread_detach_engine(int); Int Yap_thread_destroy_engine(int); diff --git a/H/udi_private.h b/H/udi_private.h index df61dc182..699099bba 100644 --- a/H/udi_private.h +++ b/H/udi_private.h @@ -30,7 +30,7 @@ typedef struct udi_info *UdiInfo; /* to ease code for a UdiInfo hash table*/ #define HASH_FIND_UdiInfo(head,find,out) \ - HASH_FIND(hh,head,find,sizeof(PredEntry *),out) + HASH_FIND(hh,head,find,sizeof(PredEntry),out) #define HASH_ADD_UdiInfo(head,p,add) \ HASH_ADD_KEYPTR(hh,head,p,sizeof(PredEntry *),add) diff --git a/H/yapio.h b/H/yapio.h index 68d3b0560..8198a2d55 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -273,7 +273,7 @@ int Yap_GetFreeStreamDForReading(void); Term Yap_WStringToList(wchar_t *); Term Yap_WStringToListOfAtoms(wchar_t *); -Atom Yap_LookupWideAtom( wchar_t * ); +Atom Yap_LookupWideAtom( const wchar_t * ); #define YAP_INPUT_STREAM 0x01 #define YAP_OUTPUT_STREAM 0x02 diff --git a/Makefile.in b/Makefile.in index 6d9f355e6..49ac681b0 100755 --- a/Makefile.in +++ b/Makefile.in @@ -149,7 +149,7 @@ IOLIB_HEADERS=os/pl-buffer.h \ os/pl-table.h \ os/pl-text.h \ os/pl-utf8.h \ - H/pl-yap.h @WINDOWS@ os/windows/dirent.h os/windows/utf8.h os/windows/utf8.c os/windows/uxnt.h os/windows/popen.c + H/pl-yap.h @WINDOWS@ os/windows/dirent.h os/windows/utf8.h os/windows/utf8.c os/windows/uxnt.h os/windows/popen.c HEADERS = \ H/Atoms.h \ @@ -550,7 +550,7 @@ INSTALLED_PACKAGES= \ @PKG_SGML@ \ @PKG_SWIG@ \ @PKG_WINCONSOLE@ \ - @PKG_ZLIB@ # @PKG_PLDOC@ + @PKG_ZLIB@ # @PKG_PLDOC@ PACKAGES= \ library \ @@ -564,7 +564,7 @@ all: startup.yss if [ -r $$p/Makefile ]; then $(MAKE) -C $$p || exit 1; fi; \ done -startup.yss: yap@EXEC_SUFFIX@ $(PL_SOURCES) $(SWI_LIB_SOURCES) +@STARTUP_DEFAULT@startup.yss: yap@EXEC_SUFFIX@ $(PL_SOURCES) $(SWI_LIB_SOURCES) -rm -f startup.yss echo "bootstrap('$(srcdir)/pl/init.yap'). module(user). qsave_program('startup.yss')." | @PRE_INSTALL_ENV@ ./yap@EXEC_SUFFIX@ -b $(srcdir)/pl/boot.yap @@ -579,20 +579,31 @@ yap-win@EXEC_SUFFIX@: $(PLCONS_OBJECTS) $(HEADERS) @YAPLIB@ (cd swi/console; $(MAKE)) $(MPI_CC) -municode -DUNICODE -D_UNICODE $(EXECUTABLE_CFLAGS) $(LDFLAGS) -Wl,-subsystem,windows -o yap-win@EXEC_SUFFIX@ $(PLCONS_OBJECTS) plterm.dll @YAPLIB@ $(LIBS) -lgdi32 @MPILDF@ -libYap.a: $(LIB_OBJECTS) +libYap.a: $(LIB_OBJECTS) -rm -f libYap.a $(AR) rc libYap.a $(LIB_OBJECTS) $(RANLIB) libYap.a -@DYNYAPLIB@: $(LIB_OBJECTS) yapi.o +@DYNYAPLIB@: $(LIB_OBJECTS) yapi.o libYap.a @YAPLIB_LD@ -o @YAPLIB@ $(LIB_OBJECTS) $(LIBS) $(LDFLAGS) $(SONAMEFLAG) for p in $(EXTRAYAPLIBS); do \ $(LN_S) -f @DYNYAPLIB@ $$p; \ done +@STARTUP_ANDROID@startup.yss: yap@EXEC_SUFFIX@ $(PL_SOURCES) $(SWI_LIB_SOURCES) + adb shell mkdir -p /data/yap + adb shell mkdir -p /data/yap/pl + adb shell mkdir -p /data/yap/swi/library + adb push yap /data/yap/ + adb push libYap.so.? /data/yap/ + adb push $(srcdir)/swi/library /data/yap/swi/library + adb push $(srcdir)/pl /data/yap/pl/ + adb shell "echo \"bootstrap('/data/yap/pl/init.yap'). module(user). qsave_program('/data/yap/startup.yss').\" | LD_LIBRARY_PATH=/data/yap /data/yap/yap@EXEC_SUFFIX@ -b /data/yap/pl/boot.yap" + adb pull /data/yap/startup.yss . + install: @INSTALL_COMMAND@ install_common -install_unix: install_ubins startup.yss @YAPLIB@ +install_unix: startup.yss @YAPLIB@ mkdir -p $(DESTDIR)$(BINDIR) mkdir -p $(DESTDIR)$(YAPLIBDIR) mkdir -p $(DESTDIR)$(SHAREDIR) @@ -645,12 +656,12 @@ install_library: @YAPLIB@ for h in $(HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done ########## -FULL_PATH_C_SOURCES=$(addprefix $(srcdir)/, $(C_SOURCES) ) -FULL_PATH_PL_SOURCES=$(addprefix $(srcdir)/, $(PL_SOURCES) ) -FULL_PATH_HEADERS=$(addprefix $(srcdir)/, $(HEADERS) ) +FULL_PATH_C_SOURCES=$(addprefix $(srcdir)/, $(C_SOURCES) ) +FULL_PATH_PL_SOURCES=$(addprefix $(srcdir)/, $(PL_SOURCES) ) +FULL_PATH_HEADERS=$(addprefix $(srcdir)/, $(HEADERS) ) TAGS: $(C_SOURCES) $(PL_SOURCES) $(HEADERS) - etags $(FULL_PATH_C_SOURCES) $(FULL_PATH_PL_SOURCES) $(FULL_PATH_HEADERS) + etags $(FULL_PATH_C_SOURCES) $(FULL_PATH_PL_SOURCES) $(FULL_PATH_HEADERS) for p in $(PACKAGES); do \ echo " ============== INSTALLING" $$p; \ if [ -r $$p/Makefile ]; then $(MAKE) -C $$p TAGS || exit 1; fi; \ @@ -668,7 +679,7 @@ clean: clean_docs clean_local for f in $(PACKAGES); do ( cd $$f ; $(MAKE) clean ); done clean_local: - rm -f *.o *~ *.BAK *.a + rm -f *.o *~ *.BAK *.a distclean: distclean_docs clean_local for p in $(PACKAGES); do \ @@ -767,4 +778,3 @@ installcheck: # DO NOT DELETE THIS LINE -- make depend depends on it. - diff --git a/OPTYap/or.sba_amiops.h b/OPTYap/or.sba_amiops.h index 63879de05..58bf24527 100644 --- a/OPTYap/or.sba_amiops.h +++ b/OPTYap/or.sba_amiops.h @@ -15,6 +15,9 @@ static char SccsId[] = "%W% %G%"; #endif /* SCCS */ +// keep eclipse happy, avoiding collisions with amiops.h +#ifdef YAPOR_SBA + #define IsArrayReference(a) ((a)->array_access_func == FunctorArrayAccess) /* dereferencing macros */ @@ -382,3 +385,4 @@ Binding Macros for Multiple Assignment Variables. #define LT_OK_IN_CMP 2 #define GT_OK_IN_CMP 4 +#endif /* YAPOR_SBA */ diff --git a/config.h.in b/config.h.in index b5c73417d..aaa48af1d 100644 --- a/config.h.in +++ b/config.h.in @@ -556,6 +556,9 @@ /* Define to 1 if you have the `rl_clear_pending_input' function. */ #undef HAVE_RL_CLEAR_PENDING_INPUT +/* Define to 1 if the system has the type `rl_completion_func_t'. */ +#undef HAVE_RL_COMPLETION_FUNC_T + /* Define to 1 if you have the `rl_completion_matches' function. */ #undef HAVE_RL_COMPLETION_MATCHES @@ -568,6 +571,9 @@ /* Define to 1 if you have the `rl_free_line_state' function. */ #undef HAVE_RL_FREE_LINE_STATE +/* Define to 1 if the system has the type `rl_hook_func_t'. */ +#undef HAVE_RL_HOOK_FUNC_T + /* Define to 1 if you have the `rl_insert_close' function. */ #undef HAVE_RL_INSERT_CLOSE diff --git a/configure b/configure index 82d3f4808..c78ed2bc4 100755 --- a/configure +++ b/configure @@ -752,6 +752,8 @@ SHLIB_CFLAGS MERGE_DLL_OBJS INSTALL_DLLS EXTRAYAPLIBS +STARTUP_DEFAULT +STARTUP_ANDROID ARCH M4GENHDRS M4 @@ -839,6 +841,7 @@ SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking +with_sysroot enable_abi enable_tabling enable_or_parallelism @@ -1550,6 +1553,7 @@ Optional Features: Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-sysroot=DIR set sysroot in compiler --with-gmp=DIR use GNU Multiple Precision in DIR --with-R=DIR interface to R language --with-judy=DIR UDI needs judy library @@ -1824,6 +1828,133 @@ fi } # ac_fn_c_try_link +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES +# ------------------------------------------- +# Tests whether TYPE exists after having included INCLUDES, setting cache +# variable VAR accordingly. +ac_fn_c_check_type () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_type + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + # ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists, giving a warning if it cannot be compiled using @@ -1915,79 +2046,6 @@ fi } # ac_fn_c_check_header_mongrel -# ac_fn_c_try_run LINENO -# ---------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes -# that executables *can* be run. -ac_fn_c_try_run () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then : - ac_retval=0 -else - $as_echo "$as_me: program exited with status $ac_status" >&5 - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=$ac_status -fi - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_run - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_compile - # ac_fn_c_check_func LINENO FUNC VAR # ---------------------------------- # Tests whether FUNC exists, setting the cache variable VAR accordingly @@ -2294,60 +2352,6 @@ $as_echo "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_member - -# ac_fn_c_check_type LINENO TYPE VAR INCLUDES -# ------------------------------------------- -# Tests whether TYPE exists after having included INCLUDES, setting cache -# variable VAR accordingly. -ac_fn_c_check_type () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=no" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof ($2)) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof (($2))) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - eval "$3=yes" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_type cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. @@ -2703,6 +2707,19 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu DOC_VERSION=4.2.9 + +# Check whether --with-sysroot was given. +if test "${with_sysroot+set}" = set; then : + withval=$with_sysroot; SYSROOT="$withval" + CPPFLAGS="$CPPFLAGS --sysroot=$SYSROOT" + CFLAGS="$CFLAGS --sysroot=$SYSROOT" + CPPFLAGS="$CPPFLAGS --sysroot=$SYSROOT" + LDFLAGS="$LDFLAGS --sysroot=$SYSROOT" +else + yap_cv_gmp=yes +fi + + ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -6445,104 +6462,6 @@ See \`config.log' for more details" "$LINENO" 5; } fi -fi - -if test "$yap_cv_gmp" != "no" -then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lgmp" >&5 -$as_echo_n "checking for main in -lgmp... " >&6; } -if ${ac_cv_lib_gmp_main+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgmp $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - -int -main () -{ -return main (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_gmp_main=yes -else - ac_cv_lib_gmp_main=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp_main" >&5 -$as_echo "$ac_cv_lib_gmp_main" >&6; } -if test "x$ac_cv_lib_gmp_main" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBGMP 1 -_ACEOF - - LIBS="-lgmp $LIBS" - -fi - -fi - -if test "$yap_cv_judy" != "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Judy1Set in -lJudy" >&5 -$as_echo_n "checking for Judy1Set in -lJudy... " >&6; } -if ${ac_cv_lib_Judy_Judy1Set+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lJudy $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char Judy1Set (); -int -main () -{ -return Judy1Set (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Judy_Judy1Set=yes -else - ac_cv_lib_Judy_Judy1Set=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Judy_Judy1Set" >&5 -$as_echo "$ac_cv_lib_Judy_Judy1Set" >&6; } -if test "x$ac_cv_lib_Judy_Judy1Set" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBJUDY 1 -_ACEOF - - LIBS="-lJudy $LIBS" - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: libJudy not found, UDI will only work with one Index at a time" >&5 -$as_echo "libJudy not found, UDI will only work with one Index at a time" >&6; } -fi - -fi - -if test "$threads" = yes -then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 $as_echo_n "checking for grep that handles long lines and -e... " >&6; } @@ -6803,7 +6722,124 @@ fi done -for ac_header in pthread.h +ac_fn_c_check_type "$LINENO" "rl_hook_func_t" "ac_cv_type_rl_hook_func_t" "$ac_includes_default" +if test "x$ac_cv_type_rl_hook_func_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_RL_HOOK_FUNC_T 1 +_ACEOF + + +fi +ac_fn_c_check_type "$LINENO" "rl_completion_func_t" "ac_cv_type_rl_completion_func_t" "$ac_includes_default" +if test "x$ac_cv_type_rl_completion_func_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_RL_COMPLETION_FUNC_T 1 +_ACEOF + + +fi + +fi + +if test "$yap_cv_gmp" != "no" +then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lgmp" >&5 +$as_echo_n "checking for main in -lgmp... " >&6; } +if ${ac_cv_lib_gmp_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgmp $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_gmp_main=yes +else + ac_cv_lib_gmp_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp_main" >&5 +$as_echo "$ac_cv_lib_gmp_main" >&6; } +if test "x$ac_cv_lib_gmp_main" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBGMP 1 +_ACEOF + + LIBS="-lgmp $LIBS" + +fi + +fi + +if test "$yap_cv_judy" != "no"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Judy1Set in -lJudy" >&5 +$as_echo_n "checking for Judy1Set in -lJudy... " >&6; } +if ${ac_cv_lib_Judy_Judy1Set+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lJudy $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char Judy1Set (); +int +main () +{ +return Judy1Set (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_Judy_Judy1Set=yes +else + ac_cv_lib_Judy_Judy1Set=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Judy_Judy1Set" >&5 +$as_echo "$ac_cv_lib_Judy_Judy1Set" >&6; } +if test "x$ac_cv_lib_Judy_Judy1Set" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBJUDY 1 +_ACEOF + + LIBS="-lJudy $LIBS" + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: libJudy not found, UDI will only work with one Index at a time" >&5 +$as_echo "libJudy not found, UDI will only work with one Index at a time" >&6; } +fi + +fi + +if test "$threads" = yes +then + for ac_header in pthread.h do : ac_fn_c_check_header_mongrel "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default" if test "x$ac_cv_header_pthread_h" = xyes; then : @@ -8612,6 +8648,19 @@ if test "x$ARCH" = "x"; then fi +case "$host" in + *android*) + STARTUP_ANDROID="" + STARTUP_DEFAULT="x" + ;; + **) + STARTUP_ANDROID="x" + STARTUP_DEFAULT="" + ;; +esac + + + CMDEXT=sh @@ -12432,7 +12481,7 @@ else JAVA_TEST=Test.java CLASS_TEST=Test.class cat << \EOF > $JAVA_TEST -/* #line 12435 "configure" */ +/* #line 12484 "configure" */ public class Test { } EOF @@ -12608,7 +12657,7 @@ EOF if uudecode$EXEEXT Test.uue; then ac_cv_prog_uudecode_base64=yes else - echo "configure: 12611: uudecode had trouble decoding base 64 file 'Test.uue'" >&5 + echo "configure: 12660: uudecode had trouble decoding base 64 file 'Test.uue'" >&5 echo "configure: failed file was:" >&5 cat Test.uue >&5 ac_cv_prog_uudecode_base64=no @@ -12739,7 +12788,7 @@ else JAVA_TEST=Test.java CLASS_TEST=Test.class cat << \EOF > $JAVA_TEST -/* #line 12742 "configure" */ +/* #line 12791 "configure" */ public class Test { } EOF @@ -12774,7 +12823,7 @@ JAVA_TEST=Test.java CLASS_TEST=Test.class TEST=Test cat << \EOF > $JAVA_TEST -/* [#]line 12777 "configure" */ +/* [#]line 12826 "configure" */ public class Test { public static void main (String args[]) { System.exit (0); @@ -15427,14 +15476,13 @@ if test "$PKG_SWIG" != ""; then mkdir -p packages/swig/python mkdir -p packages/swig/R mkdir -p packages/swig/java -mkdir -p packages/swig/src -mkdir -p packages/swig/jni +mkdir -p packages/swig/fli -ac_config_files="$ac_config_files packages/swig/Makefile packages/swig/jni/Android.mk" +ac_config_files="$ac_config_files packages/swig/Makefile packages/swig/Android.mk" fi @@ -16773,7 +16821,7 @@ do "library/matlab/Makefile") CONFIG_FILES="$CONFIG_FILES library/matlab/Makefile" ;; "packages/python/Makefile") CONFIG_FILES="$CONFIG_FILES packages/python/Makefile" ;; "packages/swig/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swig/Makefile" ;; - "packages/swig/jni/Android.mk") CONFIG_FILES="$CONFIG_FILES packages/swig/jni/Android.mk" ;; + "packages/swig/Android.mk") CONFIG_FILES="$CONFIG_FILES packages/swig/Android.mk" ;; "packages/cuda/Makefile") CONFIG_FILES="$CONFIG_FILES packages/cuda/Makefile" ;; "packages/gecode/Makefile") CONFIG_FILES="$CONFIG_FILES packages/gecode/Makefile" ;; "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; diff --git a/configure.in b/configure.in index 05ebc57ee..3dcca92ad 100755 --- a/configure.in +++ b/configure.in @@ -4,7 +4,7 @@ dnl AC_PREREQ([2.50]) -dnl VARIABLES EXPORTED +dnl VARIABLES EXPORTED dnl dnl ARCH dnl @@ -40,6 +40,15 @@ AC_INIT(YAP, 6.3.4, yap-users@sf.net, yap ) DOC_VERSION=4.2.9 +AC_ARG_WITH(sysroot, + [ --with-sysroot[=DIR] set sysroot in compiler], + [ SYSROOT="$withval" + CPPFLAGS="$CPPFLAGS --sysroot=$SYSROOT" + CFLAGS="$CFLAGS --sysroot=$SYSROOT" + CPPFLAGS="$CPPFLAGS --sysroot=$SYSROOT" + LDFLAGS="$LDFLAGS --sysroot=$SYSROOT" ], + [yap_cv_gmp=yes]) + AC_PROG_CC AC_PROG_CPP AC_PROG_CXX @@ -193,7 +202,7 @@ AC_ARG_WITH(gmp, CFLAGS="$CFLAGS -I${yap_cv_gmp}/include" fi, [yap_cv_gmp=yes]) - + AC_ARG_WITH(R, [ --with-R[=DIR] interface to R language], if test "$withval" = yes; then @@ -204,7 +213,7 @@ AC_ARG_WITH(R, yap_cv_R=$withval fi, [yap_cv_R=no]) - + AC_ARG_WITH(judy, [ --with-judy[=DIR] UDI needs judy library], if test "$withval" = yes; then @@ -317,7 +326,7 @@ AC_ARG_WITH(max-threads, [yap_cv_max_threads="1024"]) AC_DEFINE(MinHeapSpace, (2048*SIZEOF_INT_P), [at least 2M Cells for Heap]) - AC_DEFINE(MinStackSpace,(1024*SIZEOF_INT_P), [at least 1M Cells for Stack]) + AC_DEFINE(MinStackSpace,(1024*SIZEOF_INT_P), [at least 1M Cells for Stack]) AC_DEFINE(MinTrailSpace,(256*SIZEOF_INT_P), [at least 1/2M Cells for Trail]) if test "$orparallelism" = threads then @@ -352,7 +361,7 @@ fi AC_DEFINE_UNQUOTED(MAX_THREADS,$yap_cv_max_threads,[max number of threads, default 1 or 1024]) -if test "$yap_cv_prism" = no +if test "$yap_cv_prism" = no then INSTALL_PRISM="" else @@ -373,7 +382,7 @@ if test "$yap_cv_clpbn_bp"="yes"; then AC_LANG_POP() fi -if test "$yap_cv_clpbn_bp" = no +if test "$yap_cv_clpbn_bp" = no then PKG_CLPBN="packages/CLPBN" else @@ -383,7 +392,7 @@ fi dnl condor universe does not like dynamic linking on Linux, DEC, and HP-UX platforms. -if test "$use_condor" = yes +if test "$use_condor" = yes then static_compilation="yes" use_malloc="yes" @@ -403,7 +412,7 @@ fi dnl Compilation Flags if test "$GCC" = "yes" then - if test "$debugyap" = "yes" + if test "$debugyap" = "yes" then CXXFLAGS="-O -g -Wall $CXXFLAGS" C_INTERF_FLAGS="-O -g -Wall -Wstrict-prototypes -Wmissing-prototypes $CFLAGS" @@ -413,9 +422,9 @@ then C_INTERF_FLAGS="-O3 -Wall -Wstrict-prototypes -Wmissing-prototypes $CFLAGS" C_PARSER_FLAGS="-O3 -Wall -Wstrict-prototypes -Wmissing-prototypes $CFLAGS" CFLAGS="-O3 -fomit-frame-pointer -Wall -Wstrict-prototypes -Wmissing-prototypes $CFLAGS" - case "`$CC --version < /dev/null`" in - *3.4*) - CFLAGS="-fno-gcse -fno-crossjumping $CFLAGS" + case "`$CC --version < /dev/null`" in + *3.4*) + CFLAGS="-fno-gcse -fno-crossjumping $CFLAGS" ;; esac case "$target_cpu" in @@ -425,7 +434,7 @@ then ;; sparc*) case "$target_os" in - *solaris[2-9]*) dnl + *solaris[2-9]*) dnl CFLAGS="-mno-app-regs -DOPTIMISE_ALL_REGS_FOR_SPARC=1 $CFLAGS" CXXFLAGS="-mno-app-regs -DOPTIMISE_ALL_REGS_FOR_SPARC=1 $CXXFLAGS" ;; @@ -576,10 +585,10 @@ then esac fi WINDOWS="" - PKG_WINCONSOLE="swi/console" + PKG_WINCONSOLE="swi/console" else WINDOWS="#" - PKG_WINCONSOLE="" + PKG_WINCONSOLE="" LIBS="-lcygwin" EXTRA_LIBS_FOR_DLLS="\$(abs_top_builddir)/yap.dll" EXTRA_INCLUDES_FOR_WIN32="-I\$(srcdir)/packages/PLStream/windows" @@ -636,6 +645,7 @@ then [--with-readline was given, but test for readline failed]) fi ]) + AC_CHECK_TYPES([rl_hook_func_t, rl_completion_func_t]) fi if test "$yap_cv_gmp" != "no" @@ -649,7 +659,7 @@ fi if test "$threads" = yes then - AC_CHECK_HEADERS(pthread.h) + AC_CHECK_HEADERS(pthread.h) AC_CHECK_FUNCS(pthread_mutexattr_setkind_np pthread_mutexattr_settype) if test "$pthreadlocking" = yes then @@ -698,7 +708,7 @@ else fi if test "$use_clpqr" = no; then - PKG_CLPQR="" + PKG_CLPQR="" elif test -e "$srcdir"/packages/clpqr/Makefile.in; then PKG_CLPQR="packages/clpqr" else @@ -781,7 +791,7 @@ then AC_MSG_CHECKING([whether ld supports --enable-new-dtags]) AC_LINK_IFELSE([AC_LANG_PROGRAM([])], [AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no]) + [AC_MSG_RESULT([no]) LDFLAGS="$OLDLDFLAGS"] ) fi @@ -793,7 +803,7 @@ fi else AC_SYS_RESTARTABLE_SYSCALLS fi - + dnl defaults INSTALL_DLLS="no" EXTRA_OBJS="" @@ -803,10 +813,10 @@ fi M4="m4" MERGE_DLL_OBJS="#" IN_UNIX="" - + dnl This has to be before $target_os YAPLIB="libYap.a" - + dnl now this is where things get nasty. dnl trying to get the libraries case "$target_os" in @@ -853,7 +863,7 @@ fi LIBS="$LIBS -lnsl" fi if test "$dynamic_loading" = "yes" - then + then YAPLIB_LD="\$(CC) -shared" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-rpath=\$(YAPLIBDIR) -Wl,-rpath=\$(LIBDIR)" INSTALL_ENV="LD_LIBRARY_PATH=:\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)" @@ -978,14 +988,14 @@ dnl Linux has both elf and a.out, in this case we found elf have_dl=no) if test ${have_dl} = yes then - LIBS="$LIBS -ldl" + LIBS="$LIBS -ldl" fi fi SO="dylib" SOPATH="DYLD_LIBRARY_PATH" DO_SECOND_LD="" if test "$dynamic_loading" = "yes" - then + then SHLIB_LD="$CC -dynamiclib" SHLIB_CXX_LD="$CXX -dynamiclib" EXTRA_LIBS_FOR_DLLS="-L\$(abs_top_builddir) $LIBS $EXTRA_LIBS_FOR_DLLS -lYap -Wl,-install_name,\$(YAPLIBDIR)/\$@" @@ -1013,7 +1023,7 @@ dnl Linux has both elf and a.out, in this case we found elf *netbsd*|*openbsd*|*freebsd*|*dragonfly*) if echo __ELF__ | ${CC:-cc} -E - | grep -q __ELF__ then - #an a.out system + #an a.out system SHLIB_CFLAGS="$CFLAGS" SHLIB_CXXFLAGS="$CXXFLAGS" SO="o" @@ -1053,7 +1063,7 @@ dnl Linux has both elf and a.out, in this case we found elf DYNYAPLIB=libYap."$SO" SONAMEFLAG="-Wl,--soname=$DYNYAPLIB" if test "$dynamic_loading" = "yes" - then + then YAPLIB_LD="\$(CC)" EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)" PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir):\$(abs_top_builddir)/library/system:$LD_LIBRARY_PATH" @@ -1124,7 +1134,7 @@ dnl use the current files, even if older PRE_INSTALL_ENV="$PRE_INSTALL_ENV YAPLIBDIR=\$(abs_top_builddir):\$(abs_top_builddir)/library/system:\$(abs_top_builddir)/packages/clib " if test "$dynamic_loading" = "yes" -then +then YAPLIB_CFLAGS="$SHLIB_CFLAGS" YAPLIB="$DYNYAPLIB" else @@ -1147,29 +1157,29 @@ if test "$eam" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DBEAM" fi - + if test "$wamprofile" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DANALYST=1" fi - + if test "$depthlimit" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DDEPTH_LIMIT=1" fi - + if test "$use_april" = "yes" - then + then YAP_EXTRAS="$YAP_EXTRAS -DDEPTH_LIMIT=1 -DAPRIL" LDFLAGS="$LDFLAGS -L." LIBS="$LIBS -lApril" fi - + if test "$lowleveltracer" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DLOW_LEVEL_TRACER=1" fi - + if test "$threads" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DTHREADS=1" @@ -1256,7 +1266,7 @@ AC_TRY_COMPILE( , yap_cv_rl_catch=yes,yap_cv_rl_catch=no ) ] ) AC_MSG_RESULT($yap_cv_rl_catch) -if test "$yap_cv_rl_catch" = yes +if test "$yap_cv_rl_catch" = yes then AC_DEFINE(HAVE_RL_CATCH_SIGNAL, 1, [Defined if you can turn off readline's signal handling.]) fi @@ -1306,7 +1316,7 @@ AC_TRY_RUN( , yap_cv_gcc=yes,yap_cv_gcc=no,yap_cv_gcc=yes)]) AC_MSG_RESULT($yap_cv_gcc) -if test "$yap_cv_gcc" = yes +if test "$yap_cv_gcc" = yes then M4GENHDRS=m4/gcc_genhdrs.m4 AC_DEFINE(HAVE_GCC,1,[Old m4 auto-heder generation, not really useful now]) @@ -1335,6 +1345,19 @@ fi changequote([,])dnl AC_SUBST(ARCH) +case "$host" in + *android*) + STARTUP_ANDROID="" + STARTUP_DEFAULT="x" + ;; + **) + STARTUP_ANDROID="x" + STARTUP_DEFAULT="" + ;; +esac +AC_SUBST(STARTUP_ANDROID) +AC_SUBST(STARTUP_DEFAULT) + CMDEXT=sh dnl System stuff for dynamic linking. @@ -1417,7 +1440,7 @@ if test "$yap_cv_threaded_code" = yes && test "$yap_cv_gcc" = yes then AC_DEFINE(USE_THREADED_CODE,1,[threaded emulator]) M4GENABSMI=gen_gcc.m4 -else +else M4GENABSMI=gen_ansi.m4 fi @@ -1437,7 +1460,7 @@ AC_TRY_RUN( , yap_cv_ffieee=yes,yap_cv_ffieee=no,yap_cv_ffieee=yes)]) AC_MSG_RESULT($yap_cv_ffieee) -if test "$yap_cv_ffieee" = yes +if test "$yap_cv_ffieee" = yes then AC_DEFINE(FFIEEE,1,[IEEE floating-point, basically everyone except old VAXEN]) fi @@ -1454,7 +1477,7 @@ AC_TRY_COMPILE( , yap_cv_sigsetjmp=yes,yap_cv_sigsetjmp=no)]) AC_MSG_RESULT($yap_cv_sigsetjmp) -if test "$yap_cv_sigsetjmp" = yes +if test "$yap_cv_sigsetjmp" = yes then AC_DEFINE(HAVE_SIGSETJMP,1,[support for sigsetjmp]) fi @@ -1470,7 +1493,7 @@ AC_TRY_COMPILE( , yap_cv_sigsegv=yes,yap_cv_sigsegv=no)]) AC_MSG_RESULT($yap_cv_sigsegv) -if test "$yap_cv_sigsegv" = yes +if test "$yap_cv_sigsegv" = yes then AC_DEFINE(HAVE_SIGSEGV,1,[UNIX signal SEGV]) fi @@ -1486,7 +1509,7 @@ AC_TRY_COMPILE( , yap_cv_sigprof=yes,yap_cv_sigprof=no)]) AC_MSG_RESULT($yap_cv_sigprof) -if test "$yap_cv_sigsegv" = yes +if test "$yap_cv_sigsegv" = yes then AC_DEFINE(HAVE_SIGPROF,1, [UNIX Signal SIGPROF]) fi @@ -1502,7 +1525,7 @@ AC_TRY_COMPILE( , yap_cv_siginfo=yes,yap_cv_siginfo=no)]) AC_MSG_RESULT($yap_cv_siginfo) -if test "$yap_cv_siginfo" = yes +if test "$yap_cv_siginfo" = yes then AC_DEFINE(HAVE_SIGINFO,1, [Unix SIGINFO]) fi @@ -1518,7 +1541,7 @@ AC_TRY_COMPILE( , yap_cv_sigfpe=yes,yap_cv_sigfpe=no)]) AC_MSG_RESULT($yap_cv_sigfpe) -if test "$yap_cv_sigfpe" = yes +if test "$yap_cv_sigfpe" = yes then AC_DEFINE(HAVE_SIGFPE,1, [Unix SIGFPE]) fi @@ -1558,7 +1581,7 @@ AC_CHECK_MEMBER(struct tm.tm_gmtoff, dnl this is copied from the Tcl code dnl this code checks whether the system defines an union wait AC_MSG_CHECKING([union wait]) -AC_TRY_LINK([#include +AC_TRY_LINK([#include #include ], [ union wait x; wait(&x); /* make sure we can compile wait */ @@ -1627,7 +1650,7 @@ then AC_CHECK_FUNCS(alarm mmap popen shmat sleep system ttyname waitpid) fi -if test "$target_os" != "mingw32" +if test "$target_os" != "mingw32" then AC_CHECK_FUNCS(fetestexcept snprintf) fi @@ -1644,12 +1667,12 @@ AC_TRY_LINK( , yap_cv_mpz_xor=yes,yap_cv_mpz_xor=no)]) AC_MSG_RESULT($yap_cv_mpz_xor) -if test "$yap_cv_mpz_xor" = yes +if test "$yap_cv_mpz_xor" = yes then AC_DEFINE(HAVE_MPZ_XOR,1,[Older versions of MPZ didn't have XOR]) fi -if test "$use_malloc" = "yes" -a "$maxmemory" = "yes" +if test "$use_malloc" = "yes" -a "$maxmemory" = "yes" then maxmemory="no" fi @@ -1824,7 +1847,7 @@ AC_TRY_COMPILE( AC_MSG_RESULT(yes), AC_MSG_RESULT(no)) -if test "$yap_cv_minisat" = no -a "$INSTALL_DLLS" = "no" +if test "$yap_cv_minisat" = no -a "$INSTALL_DLLS" = "no" then PKG_MINISAT="" else @@ -1925,7 +1948,7 @@ dnl if test "$yap_cv_java" = no then - PKG_JPL="" + PKG_JPL="" elif test -e "$srcdir"/packages/jpl/Makefile.in then PKG_JPL="packages/jpl" diff --git a/docs/doxygen.rc b/docs/doxygen.rc index 198860f4f..e7338c491 100644 --- a/docs/doxygen.rc +++ b/docs/doxygen.rc @@ -38,7 +38,7 @@ PROJECT_NAME = yap-6 # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = +PROJECT_NUMBER = 6.3.4 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a @@ -330,7 +330,7 @@ AUTOLINK_SUPPORT = YES # diagrams that involve STL classes more complete and accurate. # The default value is: NO. -BUILTIN_STL_SUPPORT = NO +BUILTIN_STL_SUPPORT = YES # If you use Microsoft's C++/CLI language, you should set this option to YES to # enable parsing support. @@ -670,7 +670,7 @@ SHOW_FILES = YES # Folder Tree View (if specified). # The default value is: YES. -SHOW_NAMESPACES = YES +SHOW_NAMESPACES = NO # The FILE_VERSION_FILTER tag can be used to specify a program or script that # doxygen should invoke to get the current version for each file (typically from @@ -783,7 +783,8 @@ INPUT = docs/yap.md \ os \ packages \ library \ - CXX + CXX \ + OPTYap # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses @@ -862,7 +863,7 @@ RECURSIVE = YES # Note that relative paths are relative to the directory from which doxygen is # run. -EXCLUDE = +EXCLUDE = *pltotex.pl # The EXCLUDE_SYMLINKS tag can be used to select whether or not files or # directories that are symbolic links (a Unix file system feature) are excluded @@ -963,7 +964,7 @@ FILTER_SOURCE_PATTERNS = # (index.html). This can be useful if you have a project on for instance GitHub # and want to reuse the introduction page also for the doxygen output. -USE_MDFILE_AS_MAINPAGE = NO +USE_MDFILE_AS_MAINPAGE = docs/yap.md #--------------------------------------------------------------------------- # Configuration options related to source browsing @@ -989,19 +990,19 @@ INLINE_SOURCES = YES # Fortran comments will always remain visible. # The default value is: YES. -STRIP_CODE_COMMENTS = YES +STRIP_CODE_COMMENTS = NO # If the REFERENCED_BY_RELATION tag is set to YES then for each documented # function all documented functions referencing it will be listed. # The default value is: NO. -REFERENCED_BY_RELATION = NO +REFERENCED_BY_RELATION = YES # If the REFERENCES_RELATION tag is set to YES then for each documented function # all documented entities called/used by that function will be listed. # The default value is: NO. -REFERENCES_RELATION = NO +REFERENCES_RELATION = YES # If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set # to YES, then the hyperlinks from functions in REFERENCES_RELATION and @@ -2100,7 +2101,7 @@ PERL_PATH = /usr/bin/perl # powerful graphs. # The default value is: YES. -CLASS_DIAGRAMS = NO +CLASS_DIAGRAMS = YES # You can define message sequence charts within doxygen comments using the \msc # command. Doxygen will then run the mscgen tool (see: diff --git a/docs/yap.tex b/docs/yap.tex index 6ad193332..f5794cd37 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -84,49 +84,43 @@ Quintus Prolog, and especially with C-Prolog. @ifplaintext -
    -
  • @subpage Install discusses how to download, compile and install - YAP for your platform. -
    • -
  • @subpage Syntax describes the syntax of YAP. -
    • -
  • @subpage Run describes how to invoke YAP -
    • -
  • @subpage Syntax describe the syntax of YAP. -
    • -
  • @subpage Loading_Programs presents the main predicates and -directives available to load files and to control the Prolog -environment. + + @subpage Install discusses how to download, compile and install YAP for your platform. -
    • @subpage abs_file_name explains how to find a file full path. -
      • -
    - -
    • Built-Ins -
      @subpage page_arithmetic describes how arithmetic works in YAP. + + @subpage Syntax describes the syntax of YAP. -
    • @subpage Control describes the predicates for controlling the execution of Prolog programs. -
      • + + @subpage Run describes how to invoke YAP -
    • @subpage Testing_Terms describes the main predicates on terms -
      • + + @subpage Syntax describe the syntax of YAP. -
    • @subpage Input_Output goes into Input/Ouput. -
      • + + @subpage Loading_Programs presents the main predicates and + directives available to load files and to control the Prolog environment. + + + @subpage abs_file_name explains how to find a file full path. + + + Built-Ins describes predicates providing core YAP functionality: + + @subpage page_arithmetic describes how arithmetic works in YAP. + + + @subpage Control describes the predicates for controlling the execution of Prolog programs. + + + @subpage Testing_Terms describes the main predicates on terms + + + @subpage Input_Output goes into Input/Ouput. + + + @subpage Database discusses the clausal data-base + + + @subpage Grammars presents Grammar rules in Prolog that are + both a convenient way to express definite clause grammars and + an extension of the well known context-free grammars. + + + @subpage OS discusses access to Operating System functionality + + + Libraries + + + @ref maplist introduces macros to apply an operation over + all elements of a list -
    • @subpage Database discusses the clausal data-base -
      • -
    - -
  • @subpage Grammars presents Grammar rules in Prolog - that are both a convenient way to express definite clause grammars - and an extension - of the well known context-free grammars. -
    • -
  • @subpage OS discusses access to Operating System functionality -
    • @end ifplaintext @@ -1892,6 +1886,8 @@ Same as @code{file_filter/3}, but before starting the filter execute @end table +@texinfo + @node MapArgs, MapList, LineUtilities, Library @section Maplist @@ -1978,6 +1974,8 @@ collects a result in @var{Accumulator} (uses reverse order than foldargs). @end table +@texinfo + @node MapList, matrix, MapArgs, Library @section Maplist @@ -2245,6 +2243,9 @@ sumnodes(vars, [c(X), p(X,Y), q(Y)], [], [Y,Y,X,X]). maplist(mapargs(number_atom),[c(1),s(1,2,3)],[c('1'),s('1','2','3')]). @end pl_example +@end texinfo + + @node matrix, MATLAB, MapList, Library @section Matrix Library @cindex Matrix Library @@ -9761,6 +9762,15 @@ this is possible, @var{Goal} will become invalid after executing YAP_RecoverSlots(1); if (out == 0) return FALSE; @end example + +@ifplaintext + +@copydoc real + +@end ifplaintext + +@texinfo + Slots are safe houses in the stack, the garbage collector and the stack shifter know about them and make sure they have correct values. In this case, we use a slot to preserve @var{t} during the execution of @@ -9807,6 +9817,8 @@ Set the first @var{HowMany} arguments to the @var{HowMany} slots starting at @var{slot}. @end table +@end texinfo + The following functions complement @var{YAP_RunGoal}: @table @code @item @code{int} YAP_RestartGoal(@code{void}) @@ -9815,7 +9827,7 @@ Look for the next solution to the current query by forcing YAP to backtrack to the latest goal. Notice that slots allocated since the last @code{YAP_RunGoal} will become invalid. -@item @code{int} YAP_Reset(@code{void}) +@Item @code{int} YAP_Reset(@code{void}) @findex YAP_Reset (C-Interface function) Reset execution environment (similar to the @code{abort/0} built-in). This is useful when you want to start a new query before diff --git a/include/yap_structs.h b/include/YapDefs.h similarity index 92% rename from include/yap_structs.h rename to include/YapDefs.h index 23b5a466d..052ca55c3 100755 --- a/include/yap_structs.h +++ b/include/YapDefs.h @@ -13,44 +13,42 @@ * comments: Data structures and defines used in the Interface * * * *************************************************************************/ +#ifndef _YAPDEFS_H -#if defined(__STDC__) || defined(_MSC_VER) -#ifdef PROTO -#undef PROTO -#endif -#define PROTO(X,ARGS) X ARGS -#define CONST const +#define _YAPDEFS_H 1 -#else - -#define PROTO(X,ARGS) X() -#define CONST /* empty */ -#endif +#include #ifdef YAP_H /* if Yap.h is available, just reexport */ -typedef CELL YAP_CELL; +#define YAP_CELL CELL -typedef Term YAP_Term; +#define YAP_Term Term -typedef CELL YAP_Arity; +typedef UInt YAP_Arity; typedef Term YAP_Module; -typedef Functor YAP_Functor; +#define YAP_Functor Functor -typedef Atom YAP_Atom; +#define YAP_Atom Atom -typedef Int YAP_Int; +#define YAP_Int Int -typedef UInt YAP_UInt; +#define YAP_UInt UInt -typedef Float YAP_Float; +#define YAP_Float Float typedef int YAP_Bool; +#define YAP_PredEntryPtr struct pred_entry * + +#define YAP_UserCPred CPredicate + +#define YAP_agc_hook Agc_hook + #else /* Type definitions */ @@ -93,10 +91,26 @@ typedef double YAP_Float; #define FALSE 0 #endif +typedef struct YAP_pred_entry *YAP_PredEntryPtr; + +typedef YAP_Bool (* YAP_UserCPred)(void); + +typedef int (*YAP_agc_hook)(void *_Atom); + #include "YapError.h" #endif + +typedef struct YAP_thread_attr_struct { + size_t ssize; + size_t tsize; + size_t sysize; + int (*cancel)(int thread); + YAP_Term egoal, alias; +} YAP_thread_attr; + + typedef enum { YAP_TAG_ATT = 0x1, YAP_TAG_UNBOUND = 0x2, @@ -221,16 +235,6 @@ typedef struct yap_boot_params { Int Yap_InitDefaults( YAP_init_args *init_args, char saved_state[] ); #endif -/* from thread.h */ -typedef struct { - unsigned long int ssize; - unsigned long int tsize; - YAP_Term alias; - int (*cancel)(int); -} YAP_thread_attr; - -typedef struct YAP_pred_entry *YAP_PredEntryPtr; - /* this should be opaque to the user */ typedef struct { unsigned long b; @@ -238,7 +242,6 @@ typedef struct { struct yami *p, *cp; } YAP_dogoalinfo; -typedef int (*YAP_agc_hook)(void *_Atom); typedef void (*YAP_halt_hook)(int exit_code, void *closure); @@ -290,3 +293,4 @@ typedef enum YAPC_ENABLE_AGC /* enable or disable atom garbage collection */ } yap_flag_t; +#endif /* _YAPDEFS_H */ diff --git a/include/YapInterface.h b/include/YapInterface.h index dd4b784a3..bc32b7cbc 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -32,7 +32,7 @@ #define YAPVERSION 60000 #endif -#include "yap_structs.h" +#include "YapDefs.h" #if HAVE_STDARG_H #include @@ -140,10 +140,10 @@ extern X_API YAP_Term YAP_MkRationalTerm(void *); extern X_API YAP_Int YAP_IntOfTerm(YAP_Term); /* void * BigNumOfTerm(Term) */ -extern X_API void *YAP_BigNumOfTerm(YAP_Term, void *); +extern X_API YAP_Bool YAP_BigNumOfTerm(YAP_Term t, void *b); /* void * RationalOfTerm(Term) */ -extern X_API void *YAP_RationalOfTerm(YAP_Term, void *); +extern X_API YAP_Bool YAP_RationalOfTerm(YAP_Term, void *); /* Term MkFloatTerm(YAP_Float) */ extern X_API YAP_Term YAP_MkFloatTerm(YAP_Float); @@ -157,26 +157,20 @@ extern X_API YAP_Term YAP_MkAtomTerm(YAP_Atom); /* YAP_Atom AtomOfTerm(Term) */ extern X_API YAP_Atom YAP_AtomOfTerm(YAP_Term); -/* YAP_Atom LookupAtom(const char *) */ -extern X_API YAP_Atom YAP_LookupAtom(const char *); +extern X_API YAP_Atom YAP_LookupAtom(const char *c); -/* YAP_Atom LookupWideAtom(const wchar_t *) */ -extern X_API YAP_Atom YAP_LookupWideAtom(const wchar_t *); +extern X_API YAP_Atom YAP_LookupWideAtom(const wchar_t *c); -/* YAP_Atom FullLookupAtom(const char *) */ -extern X_API YAP_Atom YAP_FullLookupAtom(const char *); +extern X_API YAP_Atom YAP_FullLookupAtom(const char *c); /* int AtomNameLength(Atom) */ extern X_API size_t YAP_AtomNameLength(YAP_Atom); -/* const char* IsWideAtom(YAP_Atom) */ -extern X_API int *YAP_IsWideAtom(YAP_Atom); +extern X_API YAP_Bool YAP_IsWideAtom(YAP_Atom a); -/* const char* AtomName(YAP_Atom) */ -extern X_API const char *YAP_AtomName(YAP_Atom); +extern X_API const char *YAP_AtomName(YAP_Atom a); -/* const wchar_t* AtomWideName(YAP_Atom) */ -extern X_API const wchar_t *YAP_WideAtomName(YAP_Atom); +extern X_API const wchar_t *YAP_WideAtomName(YAP_Atom a); /* YAP_Term MkPairTerm(YAP_Term Head, YAP_Term Tail) */ extern X_API YAP_Term YAP_MkPairTerm(YAP_Term,YAP_Term); @@ -200,29 +194,21 @@ extern X_API YAP_Term YAP_TermNil(void); extern X_API int YAP_IsTermNil(YAP_Term); -/* YAP_Term MkApplTerm(YAP_Functor f, unsigned int n, YAP_Term[] args) */ -extern X_API YAP_Term YAP_MkApplTerm(YAP_Functor,unsigned int,YAP_Term *); +extern X_API YAP_Term YAP_MkApplTerm(YAP_Functor functor, YAP_UInt arity,YAP_Term args[]); -/* YAP_Term MkNewApplTerm(YAP_Functor f, unsigned int n) */ -extern X_API YAP_Term YAP_MkNewApplTerm(YAP_Functor,unsigned int); +extern X_API YAP_Term YAP_MkNewApplTerm( YAP_Functor f, YAP_UInt arity); -/* YAP_Functor YAP_FunctorOfTerm(Term) */ -extern X_API YAP_Functor YAP_FunctorOfTerm(YAP_Term); +extern X_API YAP_Functor YAP_FunctorOfTerm(YAP_Term t); -/* YAP_Term ArgOfTerm(unsigned int argno,YAP_Term t) */ -extern X_API YAP_Term YAP_ArgOfTerm(unsigned int,YAP_Term); +extern X_API YAP_Term YAP_ArgOfTerm(YAP_UInt n, YAP_Term t); -/* YAP_Term *ArgsOfTerm(YAP_Term t) */ -extern X_API YAP_Term *YAP_ArgsOfTerm(YAP_Term); +extern X_API YAP_Term *YAP_ArgsOfTerm(YAP_Term t); -/* YAP_Functor MkFunctor(YAP_Atom a,int arity) */ -extern X_API YAP_Functor YAP_MkFunctor(YAP_Atom,unsigned int); +extern X_API YAP_Functor YAP_MkFunctor(YAP_Atom a, YAP_UInt n); -/* YAP_Atom NameOfFunctor(Functor) */ -extern X_API YAP_Atom YAP_NameOfFunctor(YAP_Functor); +extern X_API YAP_Atom YAP_NameOfFunctor(YAP_Functor g); -/* unsigned unsigned int YAP_ArityOfFunctor(Functor) */ -extern X_API unsigned int YAP_ArityOfFunctor(YAP_Functor); +extern X_API YAP_UInt YAP_ArityOfFunctor(YAP_Functor f); /* void ExtraSpace(void) */ extern X_API void *YAP_ExtraSpace(void); @@ -232,28 +218,27 @@ extern X_API void *YAP_ExtraSpaceCut(void); #define YAP_PRESERVED_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace()) #define YAP_PRESERVED_DATA_CUT(ptr,type) (ptr = (type *)YAP_ExtraSpaceCut()) -/* YAP_Bool unify(YAP_Term a, YAP_Term b) */ -extern X_API YAP_Bool YAP_Unify(YAP_Term, YAP_Term); +extern X_API YAP_Bool YAP_Unify(YAP_Term t1, YAP_Term t2); /* void UserCPredicate(const char *name, int *fn(), int arity) */ -extern X_API void YAP_UserCPredicate(const char *, YAP_Bool (*)(void), unsigned int); +extern X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity); /* void UserCPredicateWithArgs(const char *name, int *fn(), unsigned int arity) */ -extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_Bool (*)(void), YAP_Arity, YAP_Term); +extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term); /* void UserBackCPredicate(const char *name, int *init(), int *cont(), int arity, int extra) */ -extern X_API void YAP_UserBackCPredicate(const char *, YAP_Bool (*)(void), YAP_Bool (*)(void), YAP_Arity, unsigned int); +extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int); /* YAP_Int YAP_ListLength(YAP_Term t) */ extern X_API YAP_Int YAP_ListLength(YAP_Term); /* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(), int arity, int extra) */ -extern X_API void YAP_UserBackCutCPredicate(const char *, YAP_Bool (*)(void), YAP_Bool (*)(void), YAP_Bool (*)(void), YAP_Arity, unsigned int); +extern X_API void YAP_UserBackCutCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int); /* void CallProlog(YAP_Term t) */ -extern X_API YAP_Bool YAP_CallProlog(YAP_Term t); +extern X_API YAP_Int YAP_CallProlog(YAP_Term t); /* void cut_fail(void) */ extern X_API void YAP_cut_up(void); @@ -318,24 +303,13 @@ extern X_API YAP_Bool YAP_GoalHasException(YAP_Term *); /* void YAP_ClearExceptions(void) */ extern X_API void YAP_ClearExceptions(void); -/* int YAP_Reset(void) */ -extern X_API void YAP_Reset(void); +extern X_API int YAP_Reset(void); -/* void YAP_Error(int, YAP_Term, const char *,...) */ -extern X_API void YAP_Error(int, YAP_Term, const char *, ...); +extern X_API void YAP_Error(int myerrno, YAP_Term t, const char *buf, ...); -/* YAP_Term YAP_Read(void *) */ -extern X_API YAP_Term YAP_Read(void *); - -/* void YAP_Write(YAP_Term,void (*)(int),int) */ -extern X_API void YAP_Write(YAP_Term,void *,int); - -/* void YAP_WriteBufffer(YAP_Term,char *,unsgined int,int) */ extern X_API int YAP_WriteBuffer(YAP_Term,char *,size_t,int); -/* char* YAP_WriteDynamicBufffer(YAP_Term,char *,unsigned int,unsigned int -*,int *,int) */ -extern X_API char* YAP_WriteDynamicBuffer(YAP_Term,char *,size_t *, int *, int); +extern X_API char* YAP_WriteDynamicBuffer(YAP_Term t,char *buf,size_t sze, size_t *lengthp, int *encp, int flags); /* void YAP_Term(YAP_Term) */ extern X_API YAP_Term YAP_CopyTerm(YAP_Term); @@ -344,21 +318,32 @@ extern X_API YAP_Term YAP_CopyTerm(YAP_Term); extern X_API char *YAP_CompileClause(YAP_Term); /* int YAP_Init(YAP_init_args *) */ -extern X_API int YAP_Init(YAP_init_args *); +extern X_API YAP_Int YAP_Init(YAP_init_args *); /* int YAP_FastInit(const char *) */ -extern X_API int YAP_FastInit(const char *); +extern X_API YAP_Int YAP_FastInit(char saved_state[]); -/* void * YAP_TermToStream(YAP_Term) */ -extern X_API void * YAP_TermToStream(YAP_Term); +#ifndef _PL_STREAM_H +// if we don't know what a stream is, just don't assume nothing about the pointer +#define IOSTREAM void +#endif /* FPL_STREAM_H */ -/* void * YAP_InitConsult(int, const char *) */ -extern X_API void * YAP_InitConsult(int, const char *); +extern X_API YAP_Term YAP_Read(IOSTREAM *s); + +extern X_API void YAP_Write(YAP_Term t,IOSTREAM *s,int); + +extern X_API IOSTREAM * YAP_TermToStream(YAP_Term t); + +extern X_API IOSTREAM * YAP_InitConsult(int mode, const char *filename); + +extern X_API void YAP_EndConsult(IOSTREAM *s); + +#ifndef _PL_STREAM_H +// if we don't know what a stream is, just don't assume nothing about the pointer +#undef IOSTREAM +#endif /* FPL_STREAM_H */ -/* int YAP_EndConsult(void) */ -extern X_API int YAP_EndConsult(void *); -/* void YAP_Exit(int) */ extern X_API void YAP_Exit(int); /* void YAP_PutValue(YAP_Atom, YAP_Term) */ @@ -376,50 +361,36 @@ extern X_API YAP_Int YAP_ListToInts(YAP_Term, YAP_Int *, size_t); /* int StringToBuffer(YAP_Term,char *,unsigned int) */ extern X_API int YAP_StringToBuffer(YAP_Term,char *,unsigned int); -/* int BufferToString(const char *) */ -extern X_API YAP_Term YAP_BufferToString(const char *); +extern X_API YAP_Term YAP_BufferToString(const char *s); -/* int BufferToString(const char *) */ -extern X_API YAP_Term YAP_NBufferToString(const char *, size_t len); +extern X_API YAP_Term YAP_NBufferToString(const char *s, size_t len); /* int BufferToString(const char *) */ extern X_API YAP_Term YAP_WideBufferToString(const wchar_t *); -/* int BufferToString(const char *) */ -extern X_API YAP_Term YAP_NWideBufferToString(const wchar_t *, size_t len); +extern X_API YAP_Term YAP_NWideBufferToString(const wchar_t *s, size_t len); -/* int BufferToAtomList(const char *) */ -extern X_API YAP_Term YAP_BufferToAtomList(const char *); +extern X_API YAP_Term YAP_BufferToAtomList(const char *s); -/* int BufferToAtomList(const char *) */ -extern X_API YAP_Term YAP_NBufferToAtomList(const char *, size_t len); +extern X_API YAP_Term YAP_NBufferToAtomList(const char *s, size_t len); -/* int BufferToAtomList(const char *) */ -extern X_API YAP_Term YAP_WideBufferToAtomList(const wchar_t *); +extern X_API YAP_Term YAP_WideBufferToAtomList(const wchar_t *s); -/* int BufferToAtomList(const char *) */ -extern X_API YAP_Term YAP_NWideBufferToAtomList(const wchar_t *, size_t len); +extern X_API YAP_Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len); -/* int BufferToDiffList(const char *) */ -extern X_API YAP_Term YAP_NWideBufferToAtomDiffList(const wchar_t *, YAP_Term, size_t len); +extern X_API YAP_Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, YAP_Term t0, size_t len); -/* int BufferToDiffList(const char *) */ -extern X_API YAP_Term YAP_BufferToDiffList(const char *); +extern X_API YAP_Term YAP_BufferToDiffList(const char *s, YAP_Term t0); -/* int BufferToDiffList(const char *) */ -extern X_API YAP_Term YAP_NBufferToDiffList(const char *, size_t len); +extern X_API YAP_Term YAP_NBufferToDiffList(const char *s, YAP_Term t0, size_t len); -/* int BufferToDiffList(const char *) */ -extern X_API YAP_Term YAP_WideBufferToDiffList(const wchar_t *); +extern X_API YAP_Term YAP_WideBufferToDiffList(const wchar_t *s, YAP_Term t0); -/* int BufferToDiffList(const char *) */ -extern X_API YAP_Term YAP_NWideBufferToDiffList(const wchar_t *, YAP_Term, size_t len); +extern X_API YAP_Term YAP_NWideBufferToDiffList(const wchar_t *s, YAP_Term t0, size_t len); -/* YAP_Term BufferToTerm(const char *) */ -extern X_API YAP_Term YAP_ReadBuffer(const char *,YAP_Term *); +extern X_API YAP_Term YAP_ReadBuffer(const char *s,YAP_Term *tp); -/* void YAP_InitSocks(const char *,long) */ -extern X_API int YAP_InitSocks(const char *,long); +extern X_API int YAP_InitSocks(const char *host,long port); #ifdef SFUNC @@ -469,13 +440,10 @@ extern X_API YAP_Term *YAP_AddressOfTermInSlot(YAP_Int); /* YAP_Term YAP_PutInSlots(t) */ extern X_API void YAP_PutInSlot(YAP_Int, YAP_Term); -/* void YAP_RecoverSlots() */ -extern X_API int YAP_RecoverSlots(int); +extern X_API int YAP_RecoverSlots(int n, YAP_Int top_slot); -/* void YAP_RecoverSlots() */ extern X_API YAP_Int YAP_ArgsToSlots(int); -/* void YAP_RecoverSlots() */ extern X_API void YAP_SlotsToArgs(int, YAP_Int); /* void YAP_Throw() */ @@ -490,7 +458,7 @@ extern X_API void YAP_AsyncThrow(YAP_Term); #define YAP_ModuleName(mod) (mod) /* int YAP_Halt() */ -extern X_API int YAP_Halt(int); +extern X_API void YAP_Halt(int); /* int YAP_TopOfLocalStack() */ extern X_API YAP_Term *YAP_TopOfLocalStack(void); @@ -520,7 +488,7 @@ extern X_API int YAP_AtomGetHold(YAP_Atom); extern X_API int YAP_AtomReleaseHold(YAP_Atom); /* void YAP_AtomReleaseHold(YAP_Atom) */ -extern X_API YAP_agc_hook YAP_AGCRegisterHook(YAP_agc_hook); +extern X_API YAP_agc_hook YAP_AGCRegisterHook(YAP_agc_hook hook); /* void YAP_AtomReleaseHold(YAP_Atom) */ extern X_API int YAP_HaltRegisterHook(YAP_halt_hook, void *); @@ -530,7 +498,7 @@ extern X_API char * YAP_cwd(void); /* thread stuff */ extern X_API int YAP_ThreadSelf(void); -extern X_API int YAP_ThreadCreateEngine(YAP_thread_attr *); +extern X_API int YAP_ThreadCreateEngine(YAP_thread_attr *attr); extern X_API int YAP_ThreadAttachEngine(int); extern X_API int YAP_ThreadDetachEngine(int); extern X_API int YAP_ThreadDestroyEngine(int); @@ -589,16 +557,23 @@ extern X_API int YAP_MaxOpPriority(YAP_Atom, YAP_Term); /* int YAP_OpInfo(Atom, Term, int, int *, int *) */ extern X_API int YAP_OpInfo(YAP_Atom, YAP_Term, int, int *, int *); -/* YAP_Bool YAP_IsExternalDataInStackTerm(YAP_Term) */ extern X_API YAP_Bool YAP_IsExternalDataInStackTerm(YAP_Term); -extern X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *); +extern X_API YAP_Term YAP_AllocExternalDataInStack(size_t bytes); -extern X_API YAP_Bool YAP_IsOpaqueObjectTerm(YAP_Term, YAP_opaque_tag_t); +extern X_API void *YAP_ExternalDataInStackFromTerm(YAP_Term t); -extern X_API YAP_Term YAP_NewOpaqueObject(YAP_opaque_tag_t, size_t); +extern X_API YAP_Bool YAP_IsExternalDataInStackTerm(YAP_Term t); -extern X_API void *YAP_OpaqueObjectFromTerm(YAP_Term); +extern X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f); + +extern X_API YAP_Bool YAP_IsOpaqueObjectTerm(YAP_Term t, YAP_opaque_tag_t tag); + +extern X_API YAP_Term YAP_NewOpaqueObject(YAP_opaque_tag_t tag, size_t bytes); + +extern X_API void *YAP_OpaqueObjectFromTerm(YAP_Term t); + +extern X_API YAP_CELL *YAP_HeapStoreOpaqueTerm(YAP_Term t); extern X_API int YAP_Argv(char ***); @@ -624,4 +599,3 @@ extern X_API YAP_Atom YAP_IntToAtom(YAP_Int i); __END_DECLS #endif - diff --git a/include/c_interface.h b/include/c_interface.h index c0c0e3227..0db0c5a3d 100644 --- a/include/c_interface.h +++ b/include/c_interface.h @@ -14,7 +14,7 @@ * * *************************************************************************/ -#ifndef _c_interface_h +#if !defined(_c_interface_h) && !defined(_YAP_NOT_INSTALLED_) #define _c_interface_h 1 diff --git a/library/aggregate.pl b/library/aggregate.pl deleted file mode 100644 index b0c1f2948..000000000 --- a/library/aggregate.pl +++ /dev/null @@ -1,544 +0,0 @@ -/* $Id: aggregate.pl,v 1.4 2008-07-22 23:34:49 vsc Exp $ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2008, University of Amsterdam - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(aggretate, - [ foreach/2, % :Generator, :Goal - aggregate/3, % +Templ, :Goal, -Result - aggregate/4, % +Templ, +Discrim, :Goal, -Result - aggregate_all/3, % +Templ, :Goal, -Result - aggregate_all/4, % +Templ, +Discrim, :Goal, -Result - free_variables/4 % :Generator, :Template, +Vars0, -Vars - ]). -:- use_module(library(ordsets)). -:- use_module(library(pairs)). -:- use_module(library(error)). -:- use_module(library(lists)). - -:- meta_predicate - foreach(0,0), - aggregate(?,0,-), - aggregate(?,?,0,-), - aggregate_all(?,0,-), - aggregate_all(?,?,0,-). - -/** Aggregation operators on backtrackable predicates - -This library provides aggregating operators over the solutions of a -predicate. The operations are a generalisation of the bagof/3, setof/3 -and findall/3 built-in predicates. The defined aggregation operations -are counting, computing the sum, minimum, maximum, a bag of solutions -and a set of solutions. We first give a simple example, computing the -country with the smallest area: - -== -average_country_area(Name, Area) :- - aggregate(min(A, N), country(N, A), min(Area, Name)). -== - -There are four aggregation predicates, distinguished on two properties. - - $ aggregate vs. aggregate_all : - The aggregate predicates use setof/3 (aggregate/4) or bagof/3 - (aggregate/3), dealing with existential qualified variables - (Var^Goal) and providing multiple solutions for the remaining free - variables in Goal. The aggregate_all/3 predicate uses findall/3, - implicitely qualifying all free variables and providing exactly one - solution, while aggregate_all/4 uses sort/2 over solutions and - Distinguish (see below) generated using findall/3. - - $ The Distinguish argument : - The versions with 4 arguments provide a Distinguish argument that - allow for keeping duplicate bindings of a variable in the result. - For example, if we wish to compute the total population of all - countries we do not want to loose results because two countries - have the same population. Therefore we use: - - == - aggregate(sum(P), Name, country(Name, P), Total) - == - -All aggregation predicates support the following operator below in -Template. In addition, they allow for an arbitrary named compound term -where each of the arguments is a term from the list below. I.e. the term -r(min(X), max(X)) computes both the minimum and maximum binding for X. - - * count - Count number of solutions. Same as sum(1). - * sum(Expr) - Sum of Expr for all solutions. - * min(Expr) - Minimum of Expr for all solutions. - * min(Expr, Witness) - A term min(Min, Witness), where Min is the minimal version - of Expr over all Solution and Witness is any other template - the applied to the solution that produced Min. If multiple - solutions provide the same minimum, Witness corresponds to - the first solution. - * max(Expr) - Maximum of Expr for all solutions. - * max(Expr, Witness) - As min(Expr, Witness), but producing the maximum result. - * set(X) - An ordered set with all solutions for X. - * bag(X) - A list of all solutions for X. - ----+++ Acknowledgements - -_|The development of this library was sponsored by SecuritEase, - http://www.securitease.com -|_ - -@compat Quintus, SICStus 4. The forall/2 is a SWI-Prolog built-in and - term_variables/3 is a SWI-Prolog with a *|different definition|*. -@tbd Analysing the aggregation template and compiling a predicate - for the list aggregation can be done at compile time. -@tbd aggregate_all/3 can be rewritten to run in constant space using - non-backtrackable assignment on a term. -*/ - - /******************************* - * AGGREGATE * - *******************************/ - -%% aggregate(+Template, :Goal, -Result) is nondet. -% -% Aggregate bindings in Goal according to Template. The aggregate/3 -% version performs bagof/3 on Goal. - -aggregate(Template, Goal0, Result) :- - template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate), - bagof(Pattern, Goal, List), - aggregate_list(Aggregate, List, Result). - -%% aggregate(+Template, +Discriminator, :Goal, -Result) is nondet. -% -% Aggregate bindings in Goal according to Template. The aggregate/3 -% version performs setof/3 on Goal. - -aggregate(Template, Discriminator, Goal0, Result) :- - template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate), - setof(Discriminator-Pattern, Goal, Pairs), - pairs_values(Pairs, List), - aggregate_list(Aggregate, List, Result). - -%% aggregate_all(+Template, :Goal, -Result) is semidet. -% -% Aggregate bindings in Goal according to Template. The aggregate_all/3 -% version performs findall/3 on Goal. - -aggregate_all(Template, Goal0, Result) :- - template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate), - findall(Pattern, Goal, List), - aggregate_list(Aggregate, List, Result). - -%% aggregate_all(+Template, +Discriminator, :Goal, -Result) is semidet. -% -% Aggregate bindings in Goal according to Template. The aggregate_all/3 -% version performs findall/3 followed by sort/2 on Goal. - -aggregate_all(Template, Discriminator, Goal0, Result) :- - template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate), - findall(Discriminator-Pattern, Goal, Pairs0), - sort(Pairs0, Pairs), - pairs_values(Pairs, List), - aggregate_list(Aggregate, List, Result). - - -template_to_pattern(_All, Template, Pattern, Goal0, Goal, Aggregate) :- - template_to_pattern(Template, Pattern, Post, Vars, Aggregate), - existential_vars(Goal0, Goal1, AllVars, Vars), - clean_body((Goal1, Post), Goal2), - add_existential_vars(AllVars, Goal2, Goal). - -existential_vars(Var, Var) --> - { var(Var) }, !. -existential_vars(Var^G0, G) --> !, - [Var], - existential_vars(G0, G). -existential_vars(G, G) --> - []. - -add_existential_vars([], G, G). -add_existential_vars([H|T], G0, H^G1) :- - add_existential_vars(T, G0, G1). - - -%% clean_body(+Goal0, -Goal) is det. -% -% Remove redundant =true= from Goal0. - -clean_body((Goal0,Goal1), Goal) :- !, - clean_body(Goal0, GoalA), - clean_body(Goal1, GoalB), - ( GoalA == true - -> Goal = GoalB - ; GoalB == true - -> Goal = GoalA - ; Goal = (GoalA,GoalB) - ). -clean_body(Goal, Goal). - - -%% template_to_pattern(+Template, -Pattern, -Post, -Vars, -Agregate) -% -% Determine which parts of the goal we must remember in the -% findall/3 pattern. -% -% @param Post is a body-term that evaluates expressions to reduce -% storage requirements. -% @param Vars is a list of intermediate variables that must be -% added to the existential variables for bagof/3. -% @param Agregate defines the aggregation operation to execute. - -template_to_pattern(sum(X), X, true, [], sum) :- var(X), !. -template_to_pattern(sum(X0), X, X is X0, [X0], sum) :- !. -template_to_pattern(count, 1, true, [], count) :- !. -template_to_pattern(min(X), X, true, [], min) :- var(X), !. -template_to_pattern(min(X0), X, X is X0, [X0], min) :- !. -template_to_pattern(min(X0, Witness), X-Witness, X is X0, [X0], min_witness) :- !. -template_to_pattern(max(X0), X, X is X0, [X0], max) :- !. -template_to_pattern(max(X0, Witness), X-Witness, X is X0, [X0], max_witness) :- !. -template_to_pattern(set(X), X, true, [], set) :- !. -template_to_pattern(bag(X), X, true, [], bag) :- !. -template_to_pattern(Term, Pattern, Goal, Vars, term(MinNeeded, Functor, AggregateArgs)) :- - compound(Term), !, - Term =.. [Functor|Args0], - templates_to_patterns(Args0, Args, Goal, Vars, AggregateArgs), - needs_one(AggregateArgs, MinNeeded), - Pattern =.. [Functor|Args]. -template_to_pattern(Term, _, _, _, _) :- - type_error(aggregate_template, Term). - -templates_to_patterns([], [], true, [], []). -templates_to_patterns([H0], [H], G, Vars, [A]) :- !, - template_to_pattern(H0, H, G, Vars, A). -templates_to_patterns([H0|T0], [H|T], (G0,G), Vars, [A0|A]) :- - template_to_pattern(H0, H, G0, V0, A0), - append(V0, RV, Vars), - templates_to_patterns(T0, T, G, RV, A). - -%% needs_one(+Ops, -OneOrZero) -% -% If one of the operations in Ops needs at least one answer, -% unify OneOrZero to 1. Else 0. - -needs_one(Ops, 1) :- - member(Op, Ops), - needs_one(Op), !. -needs_one(_, 0). - -needs_one(min). -needs_one(min_witness). -needs_one(max). -needs_one(max_witness). - -%% aggregate_list(+Op, +List, -Answer) is semidet. -% -% Aggregate the answer from the list produced by findall/3, -% bagof/3 or setof/3. The latter two cases deal with compound -% answers. -% -% @tbd Compile code for incremental state update, which we will use -% for aggregate_all/3 as well. We should be using goal_expansion -% to generate these clauses. - -aggregate_list(bag, List0, List) :- !, - List = List0. -aggregate_list(set, List, Set) :- !, - sort(List, Set). -aggregate_list(sum, List, Sum) :- - sumlist(List, Sum). -aggregate_list(count, List, Count) :- - length(List, Count). -aggregate_list(max, List, Sum) :- - max_list(List, Sum). -aggregate_list(max_witness, List, max(Max, Witness)) :- - max_pair(List, Max, Witness). -aggregate_list(min, List, Sum) :- - min_list(List, Sum). -aggregate_list(min_witness, List, min(Min, Witness)) :- - min_pair(List, Min, Witness). -aggregate_list(term(0, Functor, Ops), List, Result) :- !, - maplist(state0, Ops, StateArgs, FinishArgs), - State0 =.. [Functor|StateArgs], - aggregate_term_list(List, Ops, State0, Result0), - finish_result(Ops, FinishArgs, Result0, Result). -aggregate_list(term(1, Functor, Ops), [H|List], Result) :- - H =.. [Functor|Args], - maplist(state1, Ops, Args, StateArgs, FinishArgs), - State0 =.. [Functor|StateArgs], - aggregate_term_list(List, Ops, State0, Result0), - finish_result(Ops, FinishArgs, Result0, Result). - -aggregate_term_list([], _, State, State). -aggregate_term_list([H|T], Ops, State0, State) :- - step_term(Ops, H, State0, State1), - aggregate_term_list(T, Ops, State1, State). - - -%% min_pair(+Pairs, -Key, -Value) is det. -%% max_pair(+Pairs, -Key, -Value) is det. -% -% True if Key-Value has the smallest/largest key in Pairs. If -% multiple pairs share the smallest/largest key, the first pair is -% returned. - -min_pair([M0-W0|T], M, W) :- - min_pair(T, M0, W0, M, W). - -min_pair([], M, W, M, W). -min_pair([M0-W0|T], M1, W1, M, W) :- - ( M0 > M1 - -> min_pair(T, M0, W0, M, W) - ; min_pair(T, M1, W1, M, W) - ). - -max_pair([M0-W0|T], M, W) :- - max_pair(T, M0, W0, M, W). - -max_pair([], M, W, M, W). -max_pair([M0-W0|T], M1, W1, M, W) :- - ( M0 > M1 - -> max_pair(T, M0, W0, M, W) - ; max_pair(T, M1, W1, M, W) - ). - -%% step(+AggregateAction, +New, +State0, -State1). - -step(bag, X, [X|L], L). -step(set, X, [X|L], L). -step(count, _, X0, X1) :- - succ(X0, X1). -step(sum, X, X0, X1) :- - X1 is X0+X. -step(max, X, X0, X1) :- - X1 is max(X0, X). -step(min, X, X0, X1) :- - X1 is min(X0, X). -step(max_witness, X-W, X0-W0, X1-W1) :- - ( X > X0 - -> X1 = X, W1 = W - ; X1 = X0, W1 = W0 - ). -step(min_witness, X-W, X0-W0, X1-W1) :- - ( X < X0 - -> X1 = X, W1 = W - ; X1 = X0, W1 = W0 - ). -step(term(Ops), Row, Row0, Row1) :- - step_term(Ops, Row, Row0, Row1). - -step_term(Ops, Row, Row0, Row1) :- - functor(Row, Name, Arity), - functor(Row1, Name, Arity), - step_list(Ops, 1, Row, Row0, Row1). - -step_list([], _, _, _, _). -step_list([Op|OpT], Arg, Row, Row0, Row1) :- - arg(Arg, Row, X), - arg(Arg, Row0, X0), - arg(Arg, Row1, X1), - step(Op, X, X0, X1), - succ(Arg, Arg1), - step_list(OpT, Arg1, Row, Row0, Row1). - -finish_result(Ops, Finish, R0, R) :- - functor(R0, Functor, Arity), - functor(R, Functor, Arity), - finish_result(Ops, Finish, 1, R0, R). - -finish_result([], _, _, _, _). -finish_result([Op|OpT], [F|FT], I, R0, R) :- - arg(I, R0, A0), - arg(I, R, A), - finish_result1(Op, F, A0, A), - succ(I, I2), - finish_result(OpT, FT, I2, R0, R). - -finish_result1(bag, Bag0, [], Bag) :- !, - Bag = Bag0. -finish_result1(set, Bag, [], Set) :- !, - sort(Bag, Set). -finish_result1(max_witness, _, M-W, R) :- !, - R = max(M,W). -finish_result1(min_witness, _, M-W, R) :- !, - R = min(M,W). -finish_result1(_, _, A, A). - -%% state0(+Op, -State, -Finish) - -state0(bag, L, L). -state0(set, L, L). -state0(count, 0, _). -state0(sum, 0, _). - -%% state1(+Op, +First, -State, -Finish) - -state1(bag, X, [X|L], L). -state1(set, X, [X|L], L). -state1(_, X, X, _). - - - /******************************* - * FOREACH * - *******************************/ - -%% foreach(:Generator, :Goal) -% -% True if the conjunction of instances of Goal using the bindings -% from Generator is true. Unlike forall/2, which runs a -% failure-driven loop that proves Goal for each solution of -% Generator, foreach creates a conjunction. Each member of the -% conjunction is a copy of Goal, where the variables it shares -% with Generator are filled with the values from the corresponding -% solution. -% -% The implementation executes forall/2 if Goal does not contain -% any variables that are not shared with Generator. -% -% Here is an example: -% -% == -% ?- foreach(between(1,4,X), dif(X,Y)), Y = 5. -% Y = 5 -% ?- foreach(between(1,4,X), dif(X,Y)), Y = 3. -% No -% == -% -% @bug Goal is copied repeatetly, which may cause problems if -% attributed variables are involved. - -foreach(Generator, Goal0) :- - strip_module(Goal0, M, G), - Goal = M:G, - term_variables(Generator, GenVars0), sort(GenVars0, GenVars), - term_variables(Goal, GoalVars0), sort(GoalVars0, GoalVars), - ord_subtract(GoalVars, GenVars, SharedGoalVars), - ( SharedGoalVars == [] - -> \+ (Generator, \+Goal) % = forall(Generator, Goal) - ; ord_intersection(GenVars, GoalVars, SharedVars), - Templ =.. [v|SharedVars], - SharedTempl =.. [v|SharedGoalVars], - findall(Templ, Generator, List), - prove_list(List, Templ, SharedTempl, Goal) - ). - -prove_list([], _, _, _). -prove_list([H|T], Templ, SharedTempl, Goal) :- - copy_term(Templ+SharedTempl+Goal, - H+SharedTempl+Copy), - Copy, - prove_list(T, Templ, SharedTempl, Goal). - - -%% free_variables(:Generator, +Template, +VarList0, -VarList) is det. -% -% In order to handle variables properly, we have to find all the -% universally quantified variables in the Generator. All variables -% as yet unbound are universally quantified, unless -% -% 1. they occur in the template -% 2. they are bound by X^P, setof, or bagof -% -% free_variables(Generator, Template, OldList, NewList) finds this -% set, using OldList as an accumulator. -% -% @author Richard O'Keefe -% @author Jan Wielemaker (made some SWI-Prolog enhancements) -% @license Public domain (from DEC10 library). -% @tbd Distinguish between control-structures and data terms. -% @tbd Exploit our built-in term_variables/2 at some places? - -free_variables(Term, Bound, VarList, [Term|VarList]) :- - var(Term), - term_is_free_of(Bound, Term), - list_is_free_of(VarList, Term), !. -free_variables(Term, _Bound, VarList, VarList) :- - var(Term), !. -free_variables(Term, Bound, OldList, NewList) :- - explicit_binding(Term, Bound, NewTerm, NewBound), !, - free_variables(NewTerm, NewBound, OldList, NewList). -free_variables(Term, Bound, OldList, NewList) :- - functor(Term, _, N), - free_variables(N, Term, Bound, OldList, NewList). - -free_variables(0, _, _, VarList, VarList) :- !. -free_variables(N, Term, Bound, OldList, NewList) :- - arg(N, Term, Argument), - free_variables(Argument, Bound, OldList, MidList), - M is N-1, !, - free_variables(M, Term, Bound, MidList, NewList). - -% explicit_binding checks for goals known to existentially quantify -% one or more variables. In particular \+ is quite common. - -explicit_binding(\+ _Goal, Bound, fail, Bound ) :- !. -explicit_binding(not(_Goal), Bound, fail, Bound ) :- !. -explicit_binding(Var^Goal, Bound, Goal, Bound+Var) :- !. -explicit_binding(setof(Var,Goal,Set), Bound, Goal-Set, Bound+Var) :- !. -explicit_binding(bagof(Var,Goal,Bag), Bound, Goal-Bag, Bound+Var) :- !. - -%% term_is_free_of(+Term, +Var) is semidet. -% -% True if Var does not appear in Term. This has been rewritten -% from the DEC10 library source to exploit our non-deterministic -% arg/3. - -term_is_free_of(Term, Var) :- - \+ var_in_term(Term, Var). - -var_in_term(Term, Var) :- - Var == Term, !. -var_in_term(Term, Var) :- - compound(Term), - genarg(_, Term, Arg), - var_in_term(Arg, Var), !. - - -%% list_is_free_of(+List, +Var) is semidet. -% -% True if Var is not in List. - -list_is_free_of([Head|Tail], Var) :- - Head \== Var, !, - list_is_free_of(Tail, Var). -list_is_free_of([], _). - - -% term_variables(+Term, +Vars0, -Vars) is det. -% -% True if Vars is the union of variables in Term and Vars0. -% We cannot have this as term_variables/3 is already defined -% as a difference-list version of term_variables/2. - -%term_variables(Term, Vars0, Vars) :- -% term_variables(Term+Vars0, Vars). diff --git a/library/clp/clp_events.pl b/library/clp/clp_events.pl deleted file mode 100644 index 349348842..000000000 --- a/library/clp/clp_events.pl +++ /dev/null @@ -1,89 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Tom Schrijvers - E-mail: tom.schrijvers@cs.kuleuven.ac.be - WWW: http://www.swi-prolog.org - Copyright (C): 2005, K.U.Leuven - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Module for managing constraint solver events. -% -% Author: Tom Schrijvers -% E-mail: tom.schrijvers@cs.kuleuven.ac.be -% Copyright: 2005, K.U.Leuven -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -:-module(clp_events, - [ - notify/2, - subscribe/4, - unsubscribe/2 - ]). - -notify(V,NMod) :- - ( get_attr(V,clp_events,List) -> - notify_list(List,NMod) - ; - true - ). - -subscribe(V,NMod,SMod,Goal) :- - ( get_attr(V,clp_events,List) -> - put_attr(V,clp_events,[entry(NMod,SMod,Goal)|List]) - ; - put_attr(V,clp_events,[entry(NMod,SMod,Goal)]) - ). - -unsubscribe(V,SMod) :- - ( get_attr(V,clp_events,List) -> - unsubscribe_list(List,SMod,NList), - put_attr(V,clp_events,NList) - ; - true - ). - -notify_list([],_). -notify_list([entry(Mod,_,Goal)|Rest],NMod) :- - ( Mod == NMod -> - call(Goal) - ; - true - ), - notify_list(Rest,NMod). - -unsubscribe_list([],_,_). -unsubscribe_list([Entry|Rest],SMod,List) :- - Entry = entry(_,Mod,_), - ( Mod == SMod -> - List = Rest - ; - List = [Entry|Tail], - unsubscribe_list(Rest,SMod,Tail) - ). - -attr_unify_hook(_,_). diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 79ec09c0b..4b31ee038 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -2655,7 +2655,7 @@ X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr) yapt.ssize = attr->local_size; yapt.tsize = attr->global_size; - yapt.alias = (YAP_Term)attr->alias; + yapt.alias = MkAtomTerm(Yap_LookupAtom(attr->alias)); yapt.cancel = attr->cancel; wid = YAP_ThreadCreateEngine(&yapt); } else { @@ -2704,7 +2704,7 @@ PL_create_engine(const PL_thread_attr_t *attr) yapt.ssize = attr->local_size; yapt.tsize = attr->global_size; - yapt.alias = (YAP_Term)attr->alias; + yapt.alias = MkAtomTerm(Yap_LookupAtom(attr->alias)); yapt.cancel = attr->cancel; eng = YAP_ThreadCreateEngine(&yapt); diff --git a/library/maplist.yap b/library/maplist.yap index 31f7031fa..f361b5e08 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -11,9 +11,69 @@ % Purpose: Macros to apply a predicate to all elements % of a list or to all sub-terms of a term. +/** + * @file maplist.yap + * + * @defgroup maplist Map List and Term Operations + * + * This library provides a set of utilities for applying a predicate to + * all elements of a list. They allow one to easily perform the most common do-loop constructs in Prolog. + * To avoid performance degradation, each call creates an + * equivalent Prolog program, without meta-calls, which is executed by + * the Prolog engine instead. The library was based on code + * by Joachim Schimpf and on code from SWI-Prolog, and it is also inspired by the GHC + * libraries. + * + * The following routines are available once included with the + * `use_module(library(apply_macros))` command. + * @author : Lawrence Byrd + * @author Richard A. O'Keefe + * @author Joachim Schimpf + * @author Jan Wielemaker + * @author E. Alphonse + * @author Vitor Santos Costa + + +Examples: + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} +%given +plus(X,Y,Z) :- Z is X + Y. + +plus_if_pos(X,Y,Z) :- Y > 0, Z is X + Y. + +vars(X, Y, [X|Y]) :- var(X), !. +vars(_, Y, Y). + +trans(TermIn, TermOut) :- + nonvar(TermIn), + TermIn =.. [p|Args], + TermOut =..[q|Args], !. +trans(X,X). + +%success + + ?- maplist(plus(1), [1,2,3,4], [2,3,4,5]). + + ?- checklist(var, [X,Y,Z]). + + ?- selectlist(<(0), [-1,0,1], [1]). + + ?- convlist(plus_if_pos(1), [-1,0,1], [2]). + + ?- sumlist(plus, [1,2,3,4], 1, 11). + + ?- maplist(mapargs(number_atom),[c(1),s(1,2,3)],[c('1'),s('1','2','3')]). +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + @{ + + */ + :- module(maplist, [selectlist/3, selectlist/4, + selectlists/5, checklist/2, maplist/2, % :Goal, +List maplist/3, % :Goal, ?List1, ?List2 @@ -91,9 +151,15 @@ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/** include(+ _Pred_, + _ListIn_, ? _ListOut_) + Same as selectlist/3. +*/ include(G,In,Out) :- selectlist(G, In, Out). - + +/** selectlist(: _Pred_, + _ListIn_, ? _ListOut_)) + Creates _ListOut_ of all list elements of _ListIn_ that pass a given test +*/ selectlist(_, [], []). selectlist(Pred, [In|ListIn], ListOut) :- (call(Pred, In) -> @@ -103,6 +169,26 @@ selectlist(Pred, [In|ListIn], ListOut) :- ), selectlist(Pred, ListIn, NewListOut). +/** selectlist(: _Pred_, + _ListIn_, + _ListInAux_, ? _ListOut_, ? _ListOutAux_) + Creates _ListOut_ and _ListOutAux_ of all list elements of _ListIn_ and _ListInAux_ that + pass the given test _Pred_. +*/ +selectlists(_, [], [], [], []). +selectlists(Pred, [In|ListIn], [In1|ListIn1], ListOut, ListOut1) :- + (call(Pred, In, In1) -> + ListOut = [In|NewListOut], + ListOut1 = [In1|NewListOut1] + ; + ListOut1 = NewListOut1, + ListOut = NewListOut + ), + selectlist(Pred, ListIn, ListIn1, NewListOut, NewListOut1). + +/** selectlist(: _Pred_, + _ListIn_, + _ListInAux_, ? _ListOut_) + Creates _ListOut_ of all list elements of _ListIn_ that + pass the given test _Pred_ using + _ListInAux_ as an + auxiliary element. +*/ selectlist(_, [], [], []). selectlist(Pred, [In|ListIn], [In1|ListIn1], ListOut) :- (call(Pred, In, In1) -> @@ -112,6 +198,10 @@ selectlist(Pred, [In|ListIn], [In1|ListIn1], ListOut) :- ), selectlist(Pred, ListIn, ListIn1, NewListOut). +/** exclude(+ _Goal_, + _List1_, ? _List2_) + Filter elements for which _Goal_ fails. True if _List2_ contains + those elements _Xi_ of _List1_ for which `call(Goal, Xi)` fails. +*/ exclude(_, [], []). exclude(Pred, [In|ListIn], ListOut) :- (call(Pred, In) -> @@ -121,6 +211,11 @@ exclude(Pred, [In|ListIn], ListOut) :- ), exclude(Pred, ListIn, NewListOut). +/** partition(+ _Pred_, + _List1_, ? _Included_, ? _Excluded_) + Filter elements of _List_ according to _Pred_. True if + _Included_ contains all elements for which `call(Pred, X)` + succeeds and _Excluded_ contains the remaining elements. +*/ partition(_, [], [], []). partition(Pred, [In|ListIn], List1, List2) :- (call(Pred, In) -> @@ -132,6 +227,15 @@ partition(Pred, [In|ListIn], List1, List2) :- ), partition(Pred, ListIn, RList1, RList2). +/** partition(+ _Pred_, + _List1_, ? _Lesser_, ? _Equal_, ? _Greater_) + + Filter list according to _Pred_ in three sets. For each element + _Xi_ of _List_, its destination is determined by + `call(Pred, Xi, Place)`, where _Place_ must be unified to one + of `\<`, `=` or `\>`. `Pred` must be deterministic. + + +*/ partition(_, [], [], [], []). partition(Pred, [In|ListIn], List1, List2, List3) :- call(Pred, In, Diff), @@ -154,54 +258,77 @@ partition(Pred, [In|ListIn], List1, List2, List3) :- ), partition(Pred, ListIn, RList1, RList2, RList3). +/** checklist(: _Pred_, + _List_) + Succeeds if the predicate _Pred_ succeeds on all elements of _List_. +*/ checklist(_, []). checklist(Pred, [In|ListIn]) :- call(Pred, In), checklist(Pred, ListIn). -% maplist(Pred, OldList) -% succeeds when Pred(Old,New) succeeds for each corresponding -% Old in OldList, New in NewList. In InterLisp, this is MAPCAR. -% It is also MAP2C. Isn't bidirectionality wonderful? +/** maplist(: _Pred_, ? _ListIn_) + + Applies predicate _Pred_( _El_ ) to all + elements _El_ of _ListIn_. + +*/ maplist(_, []). maplist(Pred, [In|ListIn]) :- call(Pred, In), maplist(Pred, ListIn). -% maplist(Pred, OldList, NewList) -% succeeds when Pred(Old,New) succeeds for each corresponding -% Old in OldList, New in NewList. In InterLisp, this is MAPCAR. -% It is also MAP2C. Isn't bidirectionality wonderful? + +/** maplist(: _Pred_, ? _L1_, ? _L2_ ) + _L1_ and _L2_ are such that + `call( _Pred_, _A1_, _A2_)` holds for every + corresponding element in lists _L1_, _L2_. + + Comment from Richard O'Keefe: succeeds when _Pred( _Old_, _New_) succeeds for each corresponding + _Gi_ in _Listi_, _New_ in _NewList_. In InterLisp, this is MAPCAR. + It is also MAP2C. Isn't bidirectionality wonderful? +*/ maplist(_, [], []). maplist(Pred, [In|ListIn], [Out|ListOut]) :- call(Pred, In, Out), maplist(Pred, ListIn, ListOut). -% maplist(Pred, List1, List2, List3) -% succeeds when Pred(Old,New) succeeds for each corresponding -% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR. -% It is also MAP2C. Isn't bidirectionality wonderful? +/** maplist(: _Pred_, ? _L1_, ? _L2_, ? _L3_) + _L1_, _L2_, and _L3_ are such that + `call( _Pred_, _A1_, _A2_, _A3_)` holds for every + corresponding element in lists _L1_, _L2_, and _L3_. + +*/ maplist(_, [], [], []). maplist(Pred, [A1|L1], [A2|L2], [A3|L3]) :- call(Pred, A1, A2, A3), maplist(Pred, L1, L2, L3). -% maplist(Pred, List1, List2, List3, List4) -% succeeds when Pred(Old,New) succeeds for each corresponding -% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR. -% It is also MAP2C. Isn't bidirectionality wonderful? +/** maplist(: _Pred_, ? _L1_, ? _L2_, ? _L3_, ? _L4_) + _L1_, _L2_, _L3_, and _L4_ are such that + `call( _Pred_, _A1_, _A2_, _A3_, _A4_)` holds + for every corresponding element in lists _L1_, _L2_, _L3_, and + _L4_. +*/ maplist(_, [], [], [], []). maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4]) :- call(Pred, A1, A2, A3, A4), maplist(Pred, L1, L2, L3, L4). -% convlist(Rewrite, OldList, NewList) -% is a sort of hybrid of maplist/3 and sublist/3. -% Each element of NewList is the image under Rewrite of some -% element of OldList, and order is preserved, but elements of -% OldList on which Rewrite is undefined (fails) are not represented. -% Thus if foo(X,Y) :- integer(X), Y is X+1. -% then convlist(foo, [1,a,0,joe(99),101], [2,1,102]). +/** + convlist(: _Pred_, + _ListIn_, ? _ListOut_) @anchor convlist + + A combination of maplist/3 and selectlist/3: creates _ListOut_ by + applying the predicate _Pred_ to all list elements on which + _Pred_ succeeds. + + ROK: convlist(Rewrite, OldList, NewList) + is a sort of hybrid of maplist/3 and sublist/3. + Each element of NewList is the image under Rewrite of some + element of OldList, and order is preserved, but elements of + OldList on which Rewrite is undefined (fails) are not represented. + Thus if foo(X,Y) :- integer(X), Y is X+1. + then convlist(foo, [1,a,0,joe(99),101], [2,1,102]). +*/ convlist(_, [], []). convlist(Pred, [Old|Olds], NewList) :- call(Pred, Old, New), @@ -211,6 +338,12 @@ convlist(Pred, [Old|Olds], NewList) :- convlist(Pred, [_|Olds], News) :- convlist(Pred, Olds, News). +/** + mapnodes(+ _Pred_, + _TermIn_, ? _TermOut_) + + Creates _TermOut_ by applying the predicate _Pred_ + to all sub-terms of _TermIn_ (depth-first and left-to-right order). +*/ mapnodes(Pred, TermIn, TermOut) :- (atomic(TermIn); var(TermIn)), !, call(Pred, TermIn, TermOut). @@ -225,6 +358,12 @@ mapnodes_list(Pred, [TermIn|ArgsIn], [TermOut|ArgsOut]) :- mapnodes(Pred, TermIn, TermOut), mapnodes_list(Pred, ArgsIn, ArgsOut). +/** + checknodes(+ _Pred_, + _Term_) @anchor checknodes + + Succeeds if the predicate _Pred_ succeeds on all sub-terms of + _Term_ (depth-first and left-to-right order) +*/ checknodes(Pred, Term) :- (atomic(Term); var(Term)), !, call(Pred, Term). @@ -238,11 +377,24 @@ checknodes_list(Pred, [Term|Args]) :- checknodes_body(Pred, Term), checknodes_list(Pred, Args). +/** + sumlist(: _Pred_, + _List_, ? _AccIn_, ? _AccOut_) + + Calls _Pred_ on all elements of List and collects a result in + _Accumulator_. Same as fold/4. +*/ sumlist(_, [], Acc, Acc). sumlist(Pred, [H|T], AccIn, AccOut) :- call(Pred, H, AccIn, A1), sumlist(Pred, T, A1, AccOut). +/** + sumnodes(+ _Pred_, + _Term_, ? _AccIn_, ? _AccOut_) @anchor sumnodes + + Calls the predicate _Pred_ on all sub-terms of _Term_ and + collect a result in _Accumulator_ (depth-first and left-to-right + order) +*/ sumnodes(Pred, Term, A0, A2) :- call(Pred, Term, A0, A1), (compound(Term) -> @@ -268,16 +420,13 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :- %% foldl(:Goal, +List, +V0, -V, +W0, -WN). % -% Fold a list, using arguments of the list as left argument. The -% foldl family of predicates is defined by: -% -% == -% foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :- -% P(X11, V0, V1, W0, W1), -% ... -% P(X1n, Vn1, Vn, Wn1, Wn). -% == +/** + foldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_) + + Calls _Pred_ on all elements of `List1` and collects a result in _Accumulator_. Same as + foldr/3. +*/ foldl(Goal, List, V0, V) :- foldl_(List, Goal, V0, V). @@ -286,6 +435,21 @@ foldl_([H|T], Goal, V0, V) :- call(Goal, H, V0, V1), foldl_(T, Goal, V1, V). +/** + foldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_) + + Calls _Pred_ on all elements of _List1_ and + _List2_ and collects a result in _Accumulator_. Same as + foldr/4. + + The foldl family of predicates is defined + == + foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :- + P(X11, V0, V1, W0, W1), + ... + P(X1n, Vn1, Vn, Wn1, Wn). + == +*/ foldl(Goal, List1, List2, V0, V) :- foldl_(List1, List2, Goal, V0, V). @@ -294,7 +458,9 @@ foldl_([H1|T1], [H2|T2], Goal, V0, V) :- call(Goal, H1, H2, V0, V1), foldl_(T1, T2, Goal, V1, V). - +/** + +*/ foldl(Goal, List1, List2, List3, V0, V) :- foldl_(List1, List2, List3, Goal, V0, V). @@ -304,6 +470,9 @@ foldl_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V) :- foldl_(T1, T2, T3, Goal, V1, V). +/** + +*/ foldl(Goal, List1, List2, List3, List4, V0, V) :- foldl_(List1, List2, List3, List4, Goal, V0, V). @@ -313,21 +482,13 @@ foldl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V0, V) :- foldl_(T1, T2, T3, T4, Goal, V1, V). -%% foldl(:Goal, +List, +V0, -V). -%% foldl(:Goal, +List1, +List2, +V0, -V). -%% foldl(:Goal, +List1, +List2, +List3, +V0, -V). -%% foldl(:Goal, +List1, +List2, +List3, +List4, +V0, -V). -% -% Fold a list, using arguments of the list as left argument. The -% foldl family of predicates is defined by: -% -% == -% foldl(P, [X11,...,X1n], ..., [Xm1,...,Xmn], V0, Vn) :- -% P(X11, ..., Xm1, V0, V1), -% ... -% P(X1n, ..., Xmn, V', Vn). -% == +/** + foldl2(: _Pred_, + _List_, ? _X0_, ? _X_, ? _Y0_, ? _Y_) + + Calls _Pred_ on all elements of `List` and collects a result in + _X_ and _Y_. +*/ foldl2(Goal, List, V0, V, W0, W) :- foldl2_(List, Goal, V0, V, W0, W). @@ -336,7 +497,12 @@ foldl2_([H|T], Goal, V0, V, W0, W) :- call(Goal, H, V0, V1, W0, W1), foldl2_(T, Goal, V1, V, W1, W). +/** + foldl2(: _Pred_, + _List_, ? _List1_, ? _X0_, ? _X_, ? _Y0_, ? _Y_) + Calls _Pred_ on all elements of _List_ and _List1_ and collects a result in + _X_ and _Y_. +*/ foldl2(Goal, List1, List2, V0, V, W0, W) :- foldl2_(List1, List2, Goal, V0, V, W0, W). @@ -345,6 +511,13 @@ foldl2_([H1|T1], [H2|T2], Goal, V0, V, W0, W) :- call(Goal, H1, H2, V0, V1, W0, W1), foldl2_(T1, T2, Goal, V1, V, W1, W). +/** + foldl2(: _Pred_, + _List_, ? _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_) + + Calls _Pred_ on all elements of _List_, _List1_ and _List2_ and collects a result in + _X_ and _Y_. + +*/ foldl2(Goal, List1, List2, List3, V0, V, W0, W) :- foldl2_(List1, List2, List3, Goal, V0, V, W0, W). @@ -354,6 +527,13 @@ foldl2_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V, W0, W) :- foldl2_(T1, T2, T3, Goal, V1, V, W1, W). +/** + foldl3(: _Pred_, + _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_, ? _Z0_, ? _Z_) + + + Calls _Pred_ on all elements of `List` and collects a + result in _X_, _Y_ and _Z_. +*/ foldl3(Goal, List, V0, V, W0, W, X0, X) :- foldl3_(List, Goal, V0, V, W0, W, X0, X). @@ -362,6 +542,13 @@ foldl3_([H|T], Goal, V0, V, W0, W, X0, X) :- call(Goal, H, V0, V1, W0, W1, X0, X1), fold3_(T, Goal, V1, V, W1, W, X1, X). +/** + foldl4(: _Pred_, + _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_, ? _Z0_, ? _Z_, ? _W0_, ? _W_) + + + Calls _Pred_ on all elements of `List` and collects a + result in _X_, _Y_, _Z_ and _W_. +*/ foldl4(Goal, List, V0, V, W0, W, X0, X, Y0, Y) :- foldl4_(List, Goal, V0, V, W0, W, X0, X, Y0, Y). @@ -391,6 +578,20 @@ foldl4_([H|T], Goal, V0, V, W0, W, X0, X, Y0, Y) :- % P(X1n, ..., Xmn, V', Vn). % == +/** + scanl(: _Pred_, + _List_, + _V0_, ? _Values_) + + +Left scan of list. The scanl family of higher order list +operations is defined by: + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} + scanl(P, [X11,...,X1n], ..., [Xm1,...,Xmn], V0, [V0,V1,...,Vn]) :- + P(X11, ..., Xm1, V0, V1), + ... + P(X1n, ..., Xmn, Vn-1, Vn). +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +*/ scanl(Goal, List, V0, [V0|Values]) :- scanl_(List, Goal, V0, Values). @@ -399,7 +600,11 @@ scanl_([H|T], Goal, V, [VH|VT]) :- call(Goal, H, V, VH), scanl_(T, Goal, VH, VT). +/** + scanl(: _Pred_, + _List1_, + _List2_, ? _V0_, ? _Vs_) +Left scan of list. + */ scanl(Goal, List1, List2, V0, [V0|Values]) :- scanl_(List1, List2, Goal, V0, Values). @@ -408,7 +613,11 @@ scanl_([H1|T1], [H2|T2], Goal, V, [VH|VT]) :- call(Goal, H1, H2, V, VH), scanl_(T1, T2, Goal, VH, VT). +/** + scanl(: _Pred_, + _List1_, + _List2_, + _List3_, ? _V0_, ? _Vs_) +Left scan of list. +*/ scanl(Goal, List1, List2, List3, V0, [V0|Values]) :- scanl_(List1, List2, List3, Goal, V0, Values). @@ -417,7 +626,11 @@ scanl_([H1|T1], [H2|T2], [H3|T3], Goal, V, [VH|VT]) :- call(Goal, H1, H2, H3, V, VH), scanl_(T1, T2, T3, Goal, VH, VT). - +/** + scanl(: _Pred_, + _List1_, + _List2_, + _List3_, + _List4_, ? _V0_, ? _Vs_) + + Left scan of list. +*/ scanl(Goal, List1, List2, List3, List4, V0, [V0|Values]) :- scanl_(List1, List2, List3, List4, Goal, V0, Values). @@ -578,6 +791,29 @@ goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :- RecursiveCall) ], Mod). +goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :- + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(selectlist, 4, Proto, GoalName), + append(MetaVars, [ListIn, ListIn1, ListOut, ListOut1], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], []], Base), + append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs, Outs1], RecursionHead), + append_args(Pred, [In, In1], Apply), + append_args(HeadPrefix, [Ins, Ins1, NOuts, NOuts1], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [In|NOuts], Outs1 = [In1|NOuts1]; Outs = NOuts, Outs1 = NOuts1), + RecursiveCall) + ], Mod). + % same as selectlist goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, @@ -1022,3 +1258,7 @@ user:goal_expansion(phrase(NT,Xs0,Xs), Mod, NewGoal) :- :- hide('$translate_rule'). */ +/** +@} +*/ + diff --git a/library/maputils.yap b/library/maputils.yap index 8801d0aaf..4fd66a5a8 100644 --- a/library/maputils.yap +++ b/library/maputils.yap @@ -2,6 +2,15 @@ % map utilities %%%%%%%%%%%%%%%%%%%% +/** + * @file maputils.yap + * + * @addtogroup maplist + * + * Auxiliary routines + * + *@{ +*/ :- module(maputils, [compile_aux/2, goal_expansion_allowed/0, @@ -71,9 +80,9 @@ harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L) harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L) -%% contains_illegal_dcgnt(+Term) is semidet. +%% contains_illegal_dcgnt(+ Term) is semidet. % -% True if Term contains a non-terminal we cannot deal with using +% `True` if _Term_ contains a non-terminal we cannot deal with using % goal-expansion. The test is too general approximation, but safe. contains_illegal_dcgnt(NT) :- @@ -83,7 +92,14 @@ contains_illegal_dcgnt(NT) :- % write(contains_illegal_nt(NT)), % JW: we do not want to write % nl. +%% goal_expansion_allowed is semidet. +% +% `True` if we can use +% goal-expansion. goal_expansion_allowed :- once( prolog_load_context(_, _) ), % make sure we are compiling. \+ current_prolog_flag(xref, true). +/** + @} +*/ \ No newline at end of file diff --git a/library/matrix/matrix.c b/library/matrix/matrix.c index c8949ade3..efd002740 100644 --- a/library/matrix/matrix.c +++ b/library/matrix/matrix.c @@ -3244,7 +3244,7 @@ is_matrix(void) return TRUE; } -void PROTO(init_matrix, (void)); +void init_matrix( void ); void init_matrix(void) diff --git a/library/occurs.yap b/library/occurs.yap deleted file mode 100644 index d44ea70d1..000000000 --- a/library/occurs.yap +++ /dev/null @@ -1,141 +0,0 @@ -/* $Id: occurs.yap,v 1.1 2008-02-12 17:03:52 vsc Exp $ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(occurs, - [ contains_term/2, % +SubTerm, +Term - contains_var/2, % +SubTerm, +Term - free_of_term/2, % +SubTerm, +Term - free_of_var/2, % +SubTerm, +Term - occurrences_of_term/3, % +SubTerm, +Term, ?Tally - occurrences_of_var/3, % +SubTerm, +Term, ?Tally - sub_term/2, % -SubTerm, +Term - sub_var/2 % -SubTerm, +Term (SWI extra) - ]). - -:- use_module(library(arg), - [genarg/3]). - - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -This is a SWI-Prolog implementation of the corresponding Quintus -library, based on the generalised arg/3 predicate of SWI-Prolog. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -%% contains_term(+Sub, +Term) is semidet. -% -% Succeeds if Sub is contained in Term (=, deterministically) - -contains_term(X, X) :- !. -contains_term(X, Term) :- - compound(Term), - genarg(_, Term, Arg), - contains_term(X, Arg), !. - - -%% contains_var(+Sub, +Term) is det. -% -% Succeeds if Sub is contained in Term (==, deterministically) - -contains_var(X0, X1) :- - X0 == X1, !. -contains_var(X, Term) :- - compound(Term), - genarg(_, Term, Arg), - contains_var(X, Arg), !. - -%% free_of_term(+Sub, +Term) -% -% Succeeds of Sub does not unify to any subterm of Term - -free_of_term(Sub, Term) :- - \+ contains_term(Sub, Term). - -%% free_of_var(+Sub, +Term) -% -% Succeeds of Sub is not equal (==) to any subterm of Term - -free_of_var(Sub, Term) :- - \+ contains_var(Sub, Term). - -%% occurrences_of_term(+SubTerm, +Term, ?Count) -% -% Count the number of SubTerms in Term - -occurrences_of_term(Sub, Term, Count) :- - count(sub_term(Sub, Term), Count). - -%% occurrences_of_var(+SubTerm, +Term, ?Count) -% -% Count the number of SubTerms in Term - -occurrences_of_var(Sub, Term, Count) :- - count(sub_var(Sub, Term), Count). - -%% sub_term(-Sub, +Term) -% -% Generates (on backtracking) all subterms of Term. - -sub_term(X, X). -sub_term(X, Term) :- - compound(Term), - genarg(_, Term, Arg), - sub_term(X, Arg). - -%% sub_var(-Sub, +Term) -% -% Generates (on backtracking) all subterms (==) of Term. - -sub_var(X0, X1) :- - X0 == X1. -sub_var(X, Term) :- - compound(Term), - genarg(_, Term, Arg), - sub_var(X, Arg). - - - /******************************* - * UTIL * - *******************************/ - -%% count(+Goal, -Count) -% -% Count number of times Goal succeeds. - -count(Goal, Count) :- - State = count(0), - ( Goal, - arg(1, State, N0), - N is N0 + 1, - nb_setarg(1, State, N), - fail - ; arg(1, State, Count) - ). - diff --git a/library/pairs.pl b/library/pairs.pl deleted file mode 100644 index 2ebb595dd..000000000 --- a/library/pairs.pl +++ /dev/null @@ -1,162 +0,0 @@ -/* $Id: pairs.pl,v 1.1 2008-02-12 17:03:52 vsc Exp $ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2006, University of Amsterdam - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(pairs, - [ pairs_keys_values/3, - pairs_values/2, - pairs_keys/2, - group_pairs_by_key/2, - transpose_pairs/2, - map_list_to_pairs/3 - ]). - -/** Operations on key-value lists - -This module implements common operations on Key-Value lists, also known -as _Pairs_. Pairs have great practical value, especially due to -keysort/2 and the library assoc.pl. - -This library is based on disussion in the SWI-Prolog mailinglist, -including specifications from Quintus and a library proposal by Richard -O'Keefe. - -@see keysort/2, library(assoc) -@author Jan Wielemaker -*/ - -%% pairs_keys_values(?Pairs, ?Keys, ?Values) is det. -% -% True if Keys holds the keys of Pairs and Values the values. -% -% Deterministic if any argument is instantiated to a finite list -% and the others are either free or finite lists. - -pairs_keys_values(Pairs, Keys, Values) :- - ( nonvar(Pairs) -> - pairs_keys_values_(Pairs, Keys, Values) - ; nonvar(Keys) -> - keys_values_pairs(Keys, Values, Pairs) - ; values_keys_pairs(Values, Keys, Pairs) - ). - -pairs_keys_values_([], [], []). -pairs_keys_values_([K-V|Pairs], [K|Keys], [V|Values]) :- - pairs_keys_values_(Pairs, Keys, Values). - -keys_values_pairs([], [], []). -keys_values_pairs([K|Ks], [V|Vs], [K-V|Pairs]) :- - keys_values_pairs(Ks, Vs, Pairs). - -values_keys_pairs([], [], []). -values_keys_pairs([V|Vs], [K|Ks], [K-V|Pairs]) :- - values_keys_pairs(Vs, Ks, Pairs). - -%% pairs_values(+Pairs, -Values) is det. -% -% Remove the keys from a list of Key-Value pairs. Same as -% pairs_keys_values(Pairs, _, Values) - -pairs_values([], []). -pairs_values([_-V|T0], [V|T]) :- - pairs_values(T0, T). - - -%% pairs_keys(+Pairs, -Keys) is det. -% -% Remove the values from a list of Key-Value pairs. Same as -% pairs_keys_values(Pairs, Keys, _) - -pairs_keys([], []). -pairs_keys([K-_|T0], [K|T]) :- - pairs_keys(T0, T). - - -%% group_pairs_by_key(+Pairs, -Joined:list(Key-Values)) is det. -% -% Group values with the same key. For example: -% -% == -% ?- group_pairs_by_key([a-2, a-1, b-4], X). -% -% X = [a-[2,1], b-[4]] -% == -% -% @param Pairs Key-Value list, sorted to the standard order -% of terms (as keysort/2 does) -% @param Joined List of Key-Group, where Group is the -% list of Values associated with Key. - -group_pairs_by_key([], []). -group_pairs_by_key([M-N|T0], [M-[N|TN]|T]) :- - same_key(M, T0, TN, T1), - group_pairs_by_key(T1, T). - -same_key(M, [M-N|T0], [N|TN], T) :- !, - same_key(M, T0, TN, T). -same_key(_, L, [], L). - - -%% transpose_pairs(+Pairs, -Transposed) is det. -% -% Swap Key-Value to Value-Key and sort the result on Value -% (the new key) using keysort/2. - -transpose_pairs(Pairs, Transposed) :- - flip_pairs(Pairs, Flipped), - keysort(Flipped, Transposed). - -flip_pairs([], []). -flip_pairs([Key-Val|Pairs], [Val-Key|Flipped]) :- - flip_pairs(Pairs, Flipped). - - -%% map_list_to_pairs(:Function, +List, -Keyed) -% -% Create a key-value list by mapping each element of List. -% For example, if we have a list of lists we can create a -% list of Length-List using -% -% == -% map_list_to_pairs(length, ListOfLists, Pairs), -% == - -:- module_transparent - map_list_to_pairs/3, - map_list_to_pairs2/3. - -map_list_to_pairs(Function, List, Pairs) :- - map_list_to_pairs2(List, Function, Pairs). - -map_list_to_pairs2([], _, []). -map_list_to_pairs2([H|T0], Pred, [K-H|T]) :- - call(Pred, H, K), - map_list_to_pairs2(T0, Pred, T). - diff --git a/library/random/yap_random.c b/library/random/yap_random.c index fa33d4c92..dc8c84e42 100644 --- a/library/random/yap_random.c +++ b/library/random/yap_random.c @@ -22,7 +22,7 @@ #include #endif -void PROTO(init_random, (void)); +void init_random( void ); static short a1 = 27314, b1 = 9213, c1 = 17773; diff --git a/library/regex/regexp.c b/library/regex/regexp.c index 330e76a9d..8fdcd7e07 100644 --- a/library/regex/regexp.c +++ b/library/regex/regexp.c @@ -32,7 +32,7 @@ /* for the sake of NULL */ #include -void PROTO(init_regexp, (void)); +void init_regexp( void ); static int check_regexp(void) { diff --git a/library/system/sys.c b/library/system/sys.c index 89ebc52ec..35eadc50d 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -140,7 +140,7 @@ #endif #endif -void PROTO(init_sys, (void)); +void init_sys(void); #if defined(__MINGW32__) || _MSC_VER static YAP_Term @@ -494,7 +494,12 @@ p_mktemp(void) static int p_tmpnam(void) { -#if HAVE_TMPNAM +#if HAVE_MKTEMP + char *s; + if (!(s = mktemp("/tmp/YAP_tmpXXXXXXXX"))) + return FALSE; + return YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(s))); +#elif HAVE_TMPNAM char buf[L_tmpnam], *s; if (!(s = tmpnam(buf))) return FALSE; diff --git a/library/tries/core_tries.c b/library/tries/core_tries.c index aebc8d180..ffc0567d5 100644 --- a/library/tries/core_tries.c +++ b/library/tries/core_tries.c @@ -1364,7 +1364,7 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) { if (YAP_IsAtomTerm(t)) fprintf(file, "%lu %d %s%c ", ATOM_SAVE_MARK, index, YAP_AtomName(YAP_AtomOfTerm(t)), '\0'); else /* (ApplTag & t) */ - fprintf(file, "%lu %d %s %d ", FUNCTOR_SAVE_MARK, index, + fprintf(file, "%lu %d %s %lu ", FUNCTOR_SAVE_MARK, index, YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))), YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t))); } else diff --git a/os/pl-rl.c b/os/pl-rl.c index 735400d56..eb1f927ff 100755 --- a/os/pl-rl.c +++ b/os/pl-rl.c @@ -454,10 +454,15 @@ Sread_readline(void *handle, char *buf, size_t size) #endif #ifdef HAVE_RL_EVENT_HOOK - if ( PL_dispatch(0, PL_DISPATCH_INSTALLED) ) + if ( PL_dispatch(0, PL_DISPATCH_INSTALLED) ) { +#if HAVE_RL_HOOK_FUNC_T rl_event_hook = event_hook; - else +#else + rl_event_hook = (Function *)event_hook; +#endif + } else { rl_event_hook = NULL; + } #endif prompt = PL_prompt_string(fd); @@ -607,7 +612,11 @@ PL_install_readline(void) #else rl_basic_word_break_characters = ":\t\n\"\\'`@$><= [](){}+*!,|%&?"; #endif +#ifdef HAVE_RL_COMPLETION_FUNC_T rl_add_defun("prolog-complete", prolog_complete, '\t'); +#else + rl_add_defun("prolog-complete", (Function *)prolog_complete, '\t'); +#endif #if HAVE_RL_INSERT_CLOSE rl_add_defun("insert-close", rl_insert_close, ')'); #endif diff --git a/packages/CLPBN/horus/BayesBall.cpp b/packages/CLPBN/horus/BayesBall.cpp index f84b508b0..d6559ae8b 100644 --- a/packages/CLPBN/horus/BayesBall.cpp +++ b/packages/CLPBN/horus/BayesBall.cpp @@ -1,4 +1,8 @@ +#if __ANDROID__ +#define assert(P) +#else #include +#endif #include "BayesBall.h" diff --git a/packages/CLPBN/horus/BayesBallGraph.cpp b/packages/CLPBN/horus/BayesBallGraph.cpp index 898a0aa41..b7e38ecee 100644 --- a/packages/CLPBN/horus/BayesBallGraph.cpp +++ b/packages/CLPBN/horus/BayesBallGraph.cpp @@ -1,4 +1,9 @@ + +#if __ANDROID__ +#define assert(P) +#else #include +#endif #include #include diff --git a/packages/CLPBN/horus/HorusYap.cpp b/packages/CLPBN/horus/HorusYap.cpp index a4ea5bc86..b1d95ae5e 100644 --- a/packages/CLPBN/horus/HorusYap.cpp +++ b/packages/CLPBN/horus/HorusYap.cpp @@ -551,7 +551,7 @@ fillSolutionList (const std::vector& results) YAP_Term belief = YAP_MkFloatTerm (beliefs[j]); queryBeliefsL = YAP_MkPairTerm (belief, queryBeliefsL); list = YAP_GetFromSlot (sl); - YAP_RecoverSlots (1); + YAP_RecoverSlots (1, sl); } list = YAP_MkPairTerm (queryBeliefsL, list); } diff --git a/packages/swig/Android.mk.in b/packages/swig/Android.mk.in new file mode 100644 index 000000000..44b2617eb --- /dev/null +++ b/packages/swig/Android.mk.in @@ -0,0 +1,12 @@ +# File: Android.mk +LOCAL_PATH := $(call my-dir) +NDK_TOOLCHAIN_VERSION := 4.8 +include $(CLEAR_VARS) +LOCAL_LDLIBS += @abs_top_builddir@/libYap.a @abs_top_builddir@/yapi.o +LOCAL_MODULE := example +LOCAL_SRC_FILES := yap_wrap.cpp +LOCAL_C_INCLUDES := @abs_top_builddir@ @srcdir@/../../H @srcdir@/../../include @srcdir@/../../os @srcdir@/../../OPTYap @srcdir@/../../BEAM @srcdir@/../../CXX +LOCAL_CFLAGS := @DEFS@ -D_YAP_NOT_INSTALLED_=1 +LOCAL_CPP_FEATURES := rtti +# LOCAL_ALLOW_UNDEFINED_SYMBOLS := true +include $(BUILD_SHARED_LIBRARY) diff --git a/packages/swig/Makefile.in b/packages/swig/Makefile.in index 02b45fb93..b2c1cc087 100644 --- a/packages/swig/Makefile.in +++ b/packages/swig/Makefile.in @@ -7,6 +7,7 @@ JAR=@JAR@ include ../Makefile.defs DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1 -DDESTDIR=\"$(DESTDIR)\" YAP_EXTRAS=@YAP_EXTRAS@ +srcdir=@srcdir@ CPPFLAGS=@CPPFLAGS@ -I../.. -I$(srcdir)/../../H -I$(srcdir)/../../include -I$(srcdir)/../../os -I$(srcdir)/../../OPTYap -I$(srcdir)/../../BEAM -I$(srcdir)/../../CXX CXXFLAGS= @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) $(CPPFLAGS) @@ -34,16 +35,29 @@ java: jni/libyap.@SO@ java/yap.java jni/libyap.@SO@: jni/yap_wrap.o $(CXX) -shared $(LDSOFLAGS) -L ../.. -lYap -o $@ ../../yapi.o $< $(LIBS) @JPLLDFLAGS@ -L ../.. -lYap -lpthread -jni/yap_wrap.c: $(srcdir)/yap.i +jni/yap_wrap.cpp: $(srcdir)/yap.i $(SWIG) -c++ -java -package pt.up.fc.dcc.yap -outdir java -o $@ $(DEFS) $(CPPFLAGS) -Wall $< -jni/yap_wrap.o: jni/yap_wrap.c +jni/yap_wrap.o: jni/yap_wrap.cpp $(CXX) -c $(CXXFLAGS) @JPLCFLAGS@ $< -o $@ +android: android/jni/yap_wrap.cpp + +android/jni/yap_wrap.cpp: $(srcdir)/yap.i + android create project --target 1 --name SwigSimple --path ./android --activity SwigSimple --package org.swig.simple + ( cd android ; mkdir -p jni;\ + $(SWIG) -c++ -java -I$(srcdir)/../../CXX -package org.swig.simple -outdir src/org/swig/simple -o jni/yap_wrap.cpp $< ;\ + cp $(srcdir)/android/SwigSimple.java src/org/swig/simple/ ;\ + cp $(srcdir)/android/main.xml res/layout ;\ + cp ../Android.mk jni ;\ + ndk-build; \ + ant debug \ + ) + R: -yap.i: $(srcdir)/../../include/YapInterface.h +yap.i: $(srcdir)/../../../../include/YapInterface.h install: diff --git a/packages/swig/android/Application.mk b/packages/swig/android/Application.mk new file mode 100644 index 000000000..242e06845 --- /dev/null +++ b/packages/swig/android/Application.mk @@ -0,0 +1,2 @@ +# File: Application.mk +NDK_TOOLCHAIN_VERSION = 4.8 diff --git a/packages/swig/android/SwigSimple.java b/packages/swig/android/SwigSimple.java new file mode 100644 index 000000000..8d759acfc --- /dev/null +++ b/packages/swig/android/SwigSimple.java @@ -0,0 +1,55 @@ +package org.swig.simple; + +import android.app.Activity; +import android.os.Bundle; +import android.view.View; +import android.widget.TextView; +import android.widget.ScrollView; +import android.text.method.ScrollingMovementMethod; + +public class SwigSimple extends Activity +{ + TextView outputText = null; + ScrollView scroller = null; + + /** Called when the activity is first created. */ + @Override + public void onCreate(Bundle savedInstanceState) + { + super.onCreate(savedInstanceState); + setContentView(R.layout.main); + + outputText = (TextView)findViewById(R.id.OutputText); + outputText.setText("Press 'Run' to start...\n"); + outputText.setMovementMethod(new ScrollingMovementMethod()); + + scroller = (ScrollView)findViewById(R.id.Scroller); + } + + public void onRunButtonClick(View view) + { + outputText.append("Started...\n"); + nativeCall(); + outputText.append("Finished!\n"); + + // Ensure scroll to end of text + scroller.post(new Runnable() { + public void run() { + scroller.fullScroll(ScrollView.FOCUS_DOWN); + } + }); + } + + /** Calls into C/C++ code */ + public void nativeCall() + { + // YAPParams p = new YAPParams(); + //YAPEngine t = new YAPEngine( p ); // TODO + } + + /** static constructor */ + static { + System.loadLibrary("example"); + } + +} diff --git a/packages/swig/android/main.xml b/packages/swig/android/main.xml new file mode 100644 index 000000000..786da0304 --- /dev/null +++ b/packages/swig/android/main.xml @@ -0,0 +1,26 @@ + + +