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

Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

Browse Source
This commit is contained in:
Tiago Gomes 2013-01-14 16:43:46 +00:00
commit cac748d41a
34 changed files with 257 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
C/absmi.c
View File

@ -968,7 +968,7 @@ Yap_absmi(int inp)
{
yamop *pt;
saveregs();
pt = Yap_ExoLookup(PredFromDefCode(PREG));
pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS);
setregs();
#ifdef SHADOW_S
SREG = S;
@ -1050,12 +1050,13 @@ Yap_absmi(int inp)
Op(retry_exo, lp);
BEGD(d0);
CACHE_Y(B);
saveregs();
d0 = Yap_NextExo(B_YREG, (struct index_t *)PREG->u.lp.l);
setregs();
#ifdef SHADOW_S
SREG = S;
#endif
{
struct index_t *it = (struct index_t *)(PREG->u.lp.l);
CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
d0 = it->links[offset];
((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, d0);
SREG = it->cls+it->arity*offset;
}
if (d0) {
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */

2
C/arith1.c
View File

@ -689,7 +689,7 @@ eval1(Int fi, Term t) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
case big_int_e:
#ifdef USE_GMP
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
return Yap_gmp_mul_float_big(Yap_random(), t);
#endif
default:
RERROR();

21
C/c_interface.c
View File

@ -333,6 +333,7 @@
#include "Yap.h"
#include "clause.h"
#include "yapio.h"
#include "Foreign.h"
#include "attvar.h"
#include "SWI-Stream.h"
#if HAVE_STDARG_H
@ -438,8 +439,8 @@ X_API PredEntry *STD_PROTO(YAP_AtomToPred,(Atom));
X_API PredEntry *STD_PROTO(YAP_FunctorToPredInModule,(Functor, Term));
X_API PredEntry *STD_PROTO(YAP_AtomToPredInModule,(Atom, Term));
X_API Int STD_PROTO(YAP_CallProlog,(Term));
X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
X_API void *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(size_t));
X_API void *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,size_t));
X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *));
@ -1909,7 +1910,7 @@ YAP_CallProlog(Term t)
}
X_API void *
YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) {
YAP_ReallocSpaceFromYap(void *ptr,size_t size) {
CACHE_REGS
void *new_ptr;
BACKUP_MACHINE_REGS();
@ -1923,7 +1924,7 @@ YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) {
return new_ptr;
}
X_API void *
YAP_AllocSpaceFromYap(unsigned int size)
YAP_AllocSpaceFromYap(size_t size)
{
CACHE_REGS
void *ptr;
@ -2836,7 +2837,7 @@ YAP_CompileClause(Term t)
{
CACHE_REGS
yamop *codeaddr;
int mod = CurrentModule;
Term mod = CurrentModule;
Term tn = TermNil;
BACKUP_MACHINE_REGS();
@ -3261,8 +3262,14 @@ YAP_FastInit(char saved_state[])
init_args.DelayedReleaseLoad = 3;
init_args.PrologShouldHandleInterrupts = FALSE;
init_args.ExecutionMode = INTERPRETED;
init_args.Argc = 0;
init_args.Argv = NULL;
init_args.Argc = 1;
{
size_t l1 = 2*sizeof(char *);
if (!(init_args.Argv = (char **)malloc(l1)))
return YAP_BOOT_ERROR;
init_args.Argv[0] = Yap_FindExecutable ();
init_args.Argv[1] = NULL;
}
init_args.ErrorNo = 0;
init_args.ErrorCause = NULL;
init_args.QuietMode = FALSE;

52
C/cdmgr.c
View File

@ -544,6 +544,9 @@ PredForChoicePt(yamop *p_code) {
case _retry_me:
case _trust_me:
return p_code->u.Otapl.p;
case _retry_exo:
case _retry_all_exo:
return p_code->u.lp.p;
case _try_logical:
case _retry_logical:
case _trust_logical:
@ -891,7 +894,7 @@ Yap_BuildMegaClause(PredEntry *ap)
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->PredFlags |= MegaClausePredFlag|SourcePredFlag;
Yap_inform_profiler_of_clause(mcl, (char *)mcl+required, ap, GPROF_MEGA);
}
@ -904,9 +907,13 @@ split_megaclause(PredEntry *ap)
yamop *ptr;
UInt ncls = ap->cs.p_code.NOfClauses, i;
RemoveIndexation(ap);
mcl =
ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,TermNil,"while deleting clause from exo predicate %s/%d\n",RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,ap->ArityOfPE);
return;
}
RemoveIndexation(ap);
for (i = 0, ptr = mcl->ClCode; i < ncls; i++) {
StaticClause *new = (StaticClause *)Yap_AllocCodeSpace(sizeof(StaticClause)+mcl->ClItemSize+(UInt)NEXTOP((yamop *)NULL,p));
if (new == NULL) {
@ -2707,7 +2714,7 @@ p_purge_clauses( USES_REGS1 )
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
MegaClause *before = DeadMegaClauses;
Yap_PutValue(AtomAbol, MkAtomTerm(AtomNil));
if (IsVarTerm(t))
return FALSE;
@ -3003,6 +3010,27 @@ p_is_source( USES_REGS1 )
return(out);
}
static Int
p_is_exo( USES_REGS1 )
{ /* '$is_dynamic'(+P) */
PredEntry *pe;
Int out;
MegaClause *mcl;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_exo");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(28,pe);
out = (pe->PredFlags & MegaClausePredFlag);
if (out) {
mcl =
ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
out = mcl->ClFlags & ExoMask;
}
UNLOCKPE(46,pe);
return(out);
}
static Int
p_owner_file( USES_REGS1 )
{ /* '$owner_file'(+P,M,F) */
@ -5228,6 +5256,15 @@ p_nth_clause( USES_REGS1 )
UNLOCK(pe->PELock);
return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
} else if (pe->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
Term tf[2];
tf[0] = pe->ModuleOfPred;
tf[1] = Yap_MkApplTerm(pe->FunctorOfPred, pe->ArityOfPE, (CELL *)((char *)mcl->ClCode+(ncls-1)*mcl->ClItemSize));
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkApplTerm(FunctorExoClause, 2, tf), ARG4);
}
/* fast access to nth element, all have same size */
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkMegaRefTerm(pe,(yamop *)cl), ARG4);
} else {
@ -5769,6 +5806,12 @@ p_choicepoint_info( USES_REGS1 )
pe = ipc->u.Otapl.p;
t = BuildActivePred(pe, cptr->cp_args);
break;
case _retry_exo:
case _retry_all_exo:
ncl = NULL;
pe = ipc->u.lp.p;
t = BuildActivePred(pe, cptr->cp_args);
break;
case _Nstop:
{
Atom at = AtomLive;
@ -5978,7 +6021,7 @@ p_dbload_get_space( USES_REGS1 )
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->PredFlags |= (MegaClausePredFlag|SourcePredFlag);
ap->cs.p_code.NOfClauses = ncls;
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
@ -6037,6 +6080,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_exo", 2, p_is_exo, TestPredFlag | SafePredFlag);
Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag);
Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);

7
C/dbase.c
View File

@ -4501,6 +4501,10 @@ p_erase_clause( USES_REGS1 )
Yap_EraseMegaClause(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1));
return TRUE;
}
if (FunctorOfTerm(t1) == FunctorExoClause) {
Yap_Error(TYPE_ERROR_DBREF, t1, "erase exo clause");
return FALSE;
}
}
Yap_Error(TYPE_ERROR_DBREF, t1, "erase");
return FALSE;
@ -4688,6 +4692,9 @@ p_instance( USES_REGS1 )
if (FunctorOfTerm(t1) == FunctorMegaClause) {
return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
}
if (FunctorOfTerm(t1) == FunctorExoClause) {
return Yap_unify(ARG2,ArgOfTerm(2,t1));
}
}
return FALSE;
} else {

78
C/exo.c
View File

@ -52,29 +52,29 @@ HASH(UInt hash0, UInt j, CELL *cl, struct index_t *it)
Term t = cl[j];
UInt sz = it->hsize;
if (IsIntTerm(t))
return (IntOfTerm(t) * 17* (hash0+1)*(j+1) ) % sz;
return (((UInt)AtomOfTerm(t) >> 5)* 17*(hash0+1)*(j+1) ) % sz;
}
/* search for matching elements */
static int
MATCH(CELL *clp, CELL *kvp, UInt j, struct index_t *it)
{
if ((kvp - it->cls)%it->arity != j)
return FALSE;
do {
if ( LOCAL_ibnds[j] && *clp != *kvp)
return FALSE;
clp--;
kvp--;
} while (j-- != 0);
return TRUE;
return (17*(IntOfTerm(t) + (hash0+1)*j ) ) % sz;
return (17*(((UInt)AtomOfTerm(t)>>5) + (hash0+1)*j ) ) % sz;
}
static UInt
NEXT(UInt hash, Term t, UInt j, struct index_t *it)
{
return (hash+(t>>4)+j+1) % (it->hsize);
return (hash+(j+1)*997) % (it->hsize);
}
/* search for matching elements */
static int
MATCH(CELL *clp, CELL *kvp, UInt j, struct index_t *it, UInt bnds[])
{
if ((kvp - it->cls)%it->arity != j)
return FALSE;
do {
if ( bnds[j] && *clp != *kvp)
return FALSE;
clp--;
kvp--;
} while (j-- != 0);
return TRUE;
}
static void
@ -112,14 +112,14 @@ ADD_TO_TRY_CHAIN(CELL *kvp, CELL *cl, struct index_t *it)
* else
*/
static void
INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0, UInt bnds[])
{
UInt j = base;
CELL *kvp;
UInt hash;
/* skip over argument */
while (!LOCAL_ibnds[j]) {
while (!bnds[j]) {
j++;
}
/* j is the firs bound element */
@ -134,16 +134,16 @@ INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
it->nentries++;
it->key[hash] = cl+j;
return;
} else if (MATCH(cl+j, kvp, j, it)) {
} else if (MATCH(cl+j, kvp, j, it, bnds)) {
/* collision */
UInt k;
CELL *target;
for (k =j+1, target = kvp+1; k < arity; k++,target++ ) {
if (LOCAL_ibnds[k]) {
if (bnds[k]) {
if (*target != cl[k]) {
/* found a new forking point */
INSERT(cl, it, arity, k, hash0);
INSERT(cl, it, arity, k, hash0, bnds);
return;
}
}
@ -160,8 +160,9 @@ INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
}
static yamop *
LOOKUP(struct index_t *it, UInt arity, UInt j)
LOOKUP(struct index_t *it, UInt arity, UInt j, UInt bnds[])
{
CACHE_REGS
CELL *kvp;
UInt hash, hash0 = 0;
@ -175,13 +176,13 @@ LOOKUP(struct index_t *it, UInt arity, UInt j)
if (kvp == NULL) {
/* simple case, no element */
return FAILCODE;
} else if (MATCH(XREGS+(j+1), kvp, j, it)) {
} else if (MATCH(XREGS+(j+1), kvp, j, it, bnds)) {
/* found element */
UInt k;
CELL *target;
for (k =j+1, target = kvp+1; k < arity; k++ ) {
if (LOCAL_ibnds[k]) {
if (bnds[k]) {
if (*target != XREGS[k+1]) {
j = k;
goto hash;
@ -202,14 +203,14 @@ LOOKUP(struct index_t *it, UInt arity, UInt j)
}
static void
fill_hash(UInt bmap, struct index_t *it)
fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
{
UInt i;
UInt arity = it->arity;
CELL *cl = it->cls;
for (i=0; i < it->nels; i++) {
INSERT(cl, it, arity, 0, 0);
INSERT(cl, it, arity, 0, 0, bnds);
cl += arity;
}
for (i=0; i < it->hsize; i++) {
@ -226,7 +227,7 @@ fill_hash(UInt bmap, struct index_t *it)
}
static struct index_t *
add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[])
{
UInt ncls = ap->cs.p_code.NOfClauses, j;
CELL *base = NULL;
@ -264,16 +265,16 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
bzero(base, 3*sizeof(CELL)*ncls);
}
i->key = (CELL **)base;
i->links = (CELL *)(base+2*ncls);
i->links = (CELL *)(base+i->hsize);
i->ncollisions = i->nentries = i->ntrys = 0;
i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *));
*ip = i;
if (count) {
fill_hash(bmap, i);
fill_hash(bmap, i, bnds);
printf("entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
if (!i->ntrys) {
i->is_key = TRUE;
if (base != realloc(base, 2*sizeof(CELL)*ncls))
if (base != realloc(base, i->hsize*sizeof(CELL)))
return FALSE;
}
}
@ -311,7 +312,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
}
yamop *
Yap_ExoLookup(PredEntry *ap)
Yap_ExoLookup(PredEntry *ap USES_REGS)
{
UInt arity = ap->ArityOfPE;
UInt bmap = 0L, bit = 1, count = 0, j, j0 = 0;
@ -345,10 +346,10 @@ Yap_ExoLookup(PredEntry *ap)
i = i->next;
}
if (!i) {
i = add_index(ip, bmap, ap, count);
i = add_index(ip, bmap, ap, count, LOCAL_ibnds);
}
if (count)
return LOOKUP(i, arity, j0);
return LOOKUP(i, arity, j0, LOCAL_ibnds);
else
return i->code;
}
@ -356,6 +357,7 @@ Yap_ExoLookup(PredEntry *ap)
CELL
Yap_NextExo(choiceptr cptr, struct index_t *it)
{
CACHE_REGS
CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
CELL next = it->links[offset];
((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, next);
@ -420,8 +422,8 @@ p_exodb_get_space( USES_REGS1 )
}
Yap_ClauseSpace += required;
/* cool, it's our turn to do the conversion */
mcl->ClFlags = MegaMask;
mcl->ClSize = required-sizeof(MegaClause);
mcl->ClFlags = MegaMask|ExoMask;
mcl->ClSize = required;
mcl->ClPred = ap;
mcl->ClItemSize = arity*sizeof(CELL);
mcl->ClNext = NULL;
@ -430,7 +432,7 @@ p_exodb_get_space( USES_REGS1 )
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->PredFlags |= MegaClausePredFlag|SourcePredFlag;
ap->cs.p_code.NOfClauses = ncls;
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);

8
C/heapgc.c
View File

@ -2307,6 +2307,10 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
mark_ref_in_use((DBRef)rtp->u.OtILl.block PASS_REGS);
nargs = rtp->u.OtILl.d->ClPred->ArityOfPE+1;
break;
case _retry_exo:
case _retry_all_exo:
nargs = rtp->u.lp.p->ArityOfPE;
break;
#ifdef DEBUG
case _retry_me:
case _trust_me:
@ -3223,6 +3227,10 @@ sweep_choicepoints(choiceptr gc_B USES_REGS)
case _retry4:
sweep_b(gc_B, 4 PASS_REGS);
break;
case _retry_exo:
case _retry_all_exo:
sweep_b(gc_B, rtp->u.lp.p->ArityOfPE PASS_REGS);
break;
case _retry_c:
case _retry_userc:
{

5
C/load_aix.c
View File

@ -26,9 +26,10 @@
* FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
return NULL;
}

6
C/load_aout.c
View File

@ -54,8 +54,8 @@ this code is no being maintained anymore
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
register char *cp, *cp2;
struct stat stbuf;
@ -94,7 +94,7 @@ Yap_FindExecutable(char *name)
strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]);
Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
if (oktox(GLOBAL_Executable))
return;
return GLOBAL_Executable;
else
Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(GLOBAL_Executable)),
"cannot find file being executed");

11
C/load_coff.c
View File

@ -50,8 +50,8 @@ this code is no being maintained anymore
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
register char *cp, *cp2;
struct stat stbuf;
@ -64,7 +64,7 @@ Yap_FindExecutable(char *name)
if (oktox(GLOBAL_argv[0])) {
strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]);
Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
return;
return NULL;
}
}
if (*cp == ':')
@ -84,16 +84,17 @@ Yap_FindExecutable(char *name)
if (!oktox(LOCAL_FileNameBuf))
continue;
Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
return;
return GLOBAL_Executable;
}
/* one last try for dual systems */
strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]);
Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
if (oktox(GLOBAL_Executable))
return;
return GLOBAL_Executable;
else
Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(GLOBAL_Executable)),
"cannot find file being executed");
return NULL;
}

32
C/load_dl.c
View File

@ -24,6 +24,10 @@
#include <dlfcn.h>
#include <string.h>
#include <stdio.h>
#if defined(__APPLE__)
#include <mach-o/dyld.h>
#endif
typedef void (*prismf)(void);
@ -57,9 +61,29 @@ Yap_CallFunctionByName(const char *thing_string)
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
if (GLOBAL_argv && GLOBAL_argv[0])
return GLOBAL_argv[0];
#if HAVE_GETEXECNAME
return getxecname();
#elif __APPLE__
char path[1024];
uint32_t size = sizeof(path);
if (!_NSGetExecutablePath(path, &size)) {
size_t sz = strlen(path);
char *rc = malloc(sz+1);
strncpy(rc, path, sz);
return rc;
} else {
char *rc = malloc(size+1);
if (_NSGetExecutablePath(rc, &size) == 0)
return "yap";
return rc;
}
#endif
return "yap";
}
void *
@ -200,7 +224,7 @@ Yap_ShutdownLoadForeign(void)
if (dlclose(objs->handle) != 0)
return; /* ERROR */
objs = objs->next;
Yap_FreeCodeSpace(old);
Yap_FreeCodeSpace((ADDR)old);
}
libs = f_code->libs;
while (libs != NULL) {
@ -208,7 +232,7 @@ Yap_ShutdownLoadForeign(void)
if (dlclose(libs->handle) != 0)
return; /* ERROR */
libs = libs->next;
Yap_FreeCodeSpace(old);
Yap_FreeCodeSpace((ADDR)old);
}
f_code = f_code->next;
Yap_FreeCodeSpace((ADDR)of_code);

8
C/load_dld.c
View File

@ -26,15 +26,15 @@ this code is no being maintained anymore
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
/* use dld_find_executable */
char *res;
if(name != NULL && (res=dld_find_executable(name))) {
strcpy(GLOBAL_Executable,res);
return GLOBAL_Executable;
} else {
strcpy(GLOBAL_Executable,"./yap");
return "yap";
}
}

1
C/load_dll.c
View File

@ -30,6 +30,7 @@
void
Yap_FindExecutable(char *name)
{
return NULL;
}
void *

12
C/load_dyld.c
View File

@ -65,6 +65,18 @@ mydlerror(void)
void
Yap_FindExecutable(char *name)
{
char path[1024];
uint32_t size = sizeof(path);
if (_NSGetExecutablePath(path, &size) == 0) {
char *rc = malloc(size+1);
strncpy(rc, path, size);
return rc;
} else {
char *rc = malloc(size+1);
if (_NSGetExecutablePath(rc, &size) == 0)
return "yap";
return rc;
}
}

4
C/load_foreign.c
View File

@ -225,10 +225,6 @@ p_open_shared_objects( USES_REGS1 ) {
void
Yap_InitLoadForeign( void )
{
if (GLOBAL_argv == NULL)
Yap_FindExecutable("yap");
else
Yap_FindExecutable(GLOBAL_argv[0]);
Yap_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag);
Yap_InitCPred("$open_shared_object", 3, p_open_shared_object, SyncPredFlag);

5
C/load_none.c
View File

@ -26,9 +26,10 @@
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap
*/
void
Yap_FindExecutable(char *name)
char *
Yap_FindExecutable(void)
{
return NULL;
}

2
C/load_shl.c
View File

@ -16,7 +16,7 @@
* locate the executable of Yap
*/
void Yap_FindExecutable(char *name)
char * Yap_FindExecutable(void)
{
}

11
C/qlyr.c
View File

@ -849,6 +849,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
} else if (pp->PredFlags & MegaClausePredFlag) {
CACHE_REGS
char *base = (void *)read_uint(stream);
UInt mask = read_uint(stream);
UInt size = read_uint(stream);
MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);
@ -857,12 +858,20 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
}
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
cl->ClFlags = mask;
pp->cs.p_code.FirstClause =
pp->cs.p_code.LastClause =
cl->ClCode;
pp->PredFlags |= MegaClausePredFlag;
/* enter index mode */
pp->OpcodeOfPred = INDEX_OPCODE;
if (mask & ExoMask) {
struct index_t **icl = (struct index_t **)(cl->ClCode);
pp->OpcodeOfPred = Yap_opcode(_enter_exo);
icl[0] = NULL;
icl[1] = NULL;
} else {
pp->OpcodeOfPred = INDEX_OPCODE;
}
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred));
/* This must be set for restoremegaclause */
pp->cs.p_code.NOfClauses = nclauses;

1
C/qlyw.c
View File

@ -649,6 +649,7 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
UInt size = cl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, (UInt)(cl->ClFlags)));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, cl, size));
} else if (pp->PredFlags & DynamicPredFlag) {

7
C/stdpreds.c
View File

@ -4007,8 +4007,11 @@ p_argv( USES_REGS1 )
static Int
p_executable( USES_REGS1 )
{
Yap_TrueFileName (GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE);
if (GLOBAL_argv && GLOBAL_argv[0])
Yap_TrueFileName (GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE);
else
strncpy(LOCAL_FileNameBuf,Yap_FindExecutable (), YAP_FILENAME_MAX) ;
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)),ARG1);
}

2
H/Foreign.h
View File

@ -105,7 +105,7 @@ typedef void (*YapInitProc)(void);
#define STD_PROTO(F,A) F A
#endif
void STD_PROTO(Yap_FindExecutable,(char *));
char *STD_PROTO(Yap_FindExecutable,(void));
void *STD_PROTO(Yap_LoadForeignFile,(char *, int));
int STD_PROTO(Yap_CallForeignFile,(void *, char *));
int STD_PROTO(Yap_CloseForeignFile,(void *));

2
H/clause.h
View File

@ -263,7 +263,7 @@ LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *, Term *, yamop *,yamop *));
/* exo.c */
yamop *Yap_ExoLookup(PredEntry *ap);
yamop *Yap_ExoLookup(PredEntry *ap USES_REGS);
CELL Yap_NextExo(choiceptr cpt, struct index_t *it);
#if USE_THREADED_CODE

2
H/iatoms.h
View File

@ -99,6 +99,7 @@
AtomExecuteWoMod = Yap_FullLookupAtom("$execute_wo_mod");
AtomExist = Yap_LookupAtom("exist");
AtomExistenceError = Yap_LookupAtom("existence_error");
AtomExoClause = Yap_FullLookupAtom("$exo_clause");
AtomExpectedNumber = Yap_LookupAtom("expected_number_syntax");
AtomExtendFileSearchPath = Yap_FullLookupAtom("$extend_file_search_path");
AtomFB = Yap_LookupAtom("fb");
@ -374,6 +375,7 @@
FunctorExecuteInMod = Yap_MkFunctor(AtomExecuteInMod,2);
FunctorExecuteWithin = Yap_MkFunctor(AtomExecuteWithin,1);
FunctorExistenceError = Yap_MkFunctor(AtomExistenceError,2);
FunctorExoClause = Yap_MkFunctor(AtomExoClause,2);
FunctorFunctor = Yap_MkFunctor(AtomFunctor,3);
FunctorGAtom = Yap_MkFunctor(AtomAtom,1);
FunctorGAtomic = Yap_MkFunctor(AtomAtomic,1);

2
H/ratoms.h
View File

@ -99,6 +99,7 @@
AtomExecuteWoMod = AtomAdjust(AtomExecuteWoMod);
AtomExist = AtomAdjust(AtomExist);
AtomExistenceError = AtomAdjust(AtomExistenceError);
AtomExoClause = AtomAdjust(AtomExoClause);
AtomExpectedNumber = AtomAdjust(AtomExpectedNumber);
AtomExtendFileSearchPath = AtomAdjust(AtomExtendFileSearchPath);
AtomFB = AtomAdjust(AtomFB);
@ -374,6 +375,7 @@
FunctorExecuteInMod = FuncAdjust(FunctorExecuteInMod);
FunctorExecuteWithin = FuncAdjust(FunctorExecuteWithin);
FunctorExistenceError = FuncAdjust(FunctorExistenceError);
FunctorExoClause = FuncAdjust(FunctorExoClause);
FunctorFunctor = FuncAdjust(FunctorFunctor);
FunctorGAtom = FuncAdjust(FunctorGAtom);
FunctorGAtomic = FuncAdjust(FunctorGAtomic);

19
H/rheap.h
View File

@ -588,10 +588,21 @@ RestoreMegaClause(MegaClause *cl USES_REGS)
}
max = (yamop *)((CODEADDR)cl+cl->ClSize);
for (ptr = cl->ClCode; ptr < max; ) {
nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
restore_opcodes(ptr, nextptr PASS_REGS);
ptr = nextptr;
if (cl->ClFlags & ExoMask) {
CELL *base = (CELL *)((ADDR)cl->ClCode+2*sizeof(struct index_t *));
CELL *end = (CELL*)max, *ptr;
for (ptr = base; ptr < end; ptr++) {
Term t = *ptr;
if (IsAtomTerm(t)) *ptr = AtomTermAdjust(t);
/* don't handle other complex terms just yet, ints are ok */
}
} else {
for (ptr = cl->ClCode; ptr < max; ) {
nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
restore_opcodes(ptr, nextptr PASS_REGS);
ptr = nextptr;
}
}
}

4
H/tatoms.h
View File

@ -196,6 +196,8 @@
#define AtomExist Yap_heap_regs->AtomExist_
Atom AtomExistenceError_;
#define AtomExistenceError Yap_heap_regs->AtomExistenceError_
Atom AtomExoClause_;
#define AtomExoClause Yap_heap_regs->AtomExoClause_
Atom AtomExpectedNumber_;
#define AtomExpectedNumber Yap_heap_regs->AtomExpectedNumber_
Atom AtomExtendFileSearchPath_;
@ -746,6 +748,8 @@
#define FunctorExecuteWithin Yap_heap_regs->FunctorExecuteWithin_
Functor FunctorExistenceError_;
#define FunctorExistenceError Yap_heap_regs->FunctorExistenceError_
Functor FunctorExoClause_;
#define FunctorExoClause Yap_heap_regs->FunctorExoClause_
Functor FunctorFunctor_;
#define FunctorFunctor Yap_heap_regs->FunctorFunctor_
Functor FunctorGAtom_;

1
config.h.in
View File

@ -186,6 +186,7 @@
#undef HAVE_FTIME
#undef HAVE_GETCWD
#undef HAVE_GETENV
#undef HAVE_GETEXECNAME
#undef HAVE_GETHOSTBYNAME
#undef HAVE_GETHOSTENT
#undef HAVE_GETHOSTID

11
configure vendored
View File

@ -10250,6 +10250,17 @@ _ACEOF
fi
done
for ac_func in getexecname
do :
ac_fn_c_check_func "$LINENO" "getexecname" "ac_cv_func_getexecname"
if test "x$ac_cv_func_getexecname" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_GETEXECNAME 1
_ACEOF
fi
done
for ac_func in gethostbyname gethostent gethostid gethostname
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`

1
configure.in
View File

@ -2069,6 +2069,7 @@ AC_CHECK_FUNCS(alloca asinh atanh chdir clock clock_gettime)
AC_CHECK_FUNCS(ctime dlopen dup2)
AC_CHECK_FUNCS(erf feclearexcept)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite fpclass ftime getcwd getenv)
AC_CHECK_FUNCS(getexecname)
AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpagesize)
AC_CHECK_FUNCS(getpwnam getrlimit getrusage gettimeofday getwd)

4
include/YapInterface.h
View File

@ -263,10 +263,10 @@ extern X_API void PROTO(YAP_cut_up,(void));
#define YAP_cut_fail() do { YAP_cut_up(); return FALSE; } while(0)
/* void *AllocSpaceFromYAP_(int) */
extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
extern X_API void *PROTO(YAP_AllocSpaceFromYap,(size_t));
/* void *ReallocSpaceFromYAP_(void*,int) */
extern X_API void *PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
extern X_API void *PROTO(YAP_ReallocSpaceFromYap,(void*,size_t));
/* void FreeSpaceFromYAP_(void *) */
extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *));

2
misc/ATOMS
View File

@ -104,6 +104,7 @@ A ExecuteWithin F "$execute_within"
A ExecuteWoMod F "$execute_wo_mod"
A Exist N "exist"
A ExistenceError N "existence_error"
A ExoClause F "$exo_clause"
A ExpectedNumber N "expected_number_syntax"
A ExtendFileSearchPath F "$extend_file_search_path"
A FB N "fb"
@ -379,6 +380,7 @@ F Execute2InMod ExecuteWoMod 2
F ExecuteInMod ExecuteInMod 2
F ExecuteWithin ExecuteWithin 1
F ExistenceError ExistenceError 2
F ExoClause ExoClause 2
F Functor Functor 3
F GAtom Atom 1
F GAtomic Atomic 1

2
packages/pldoc

@ -1 +1 @@
Subproject commit fa667ecacf4128c10dc51215ff54f25672a782c8
Subproject commit 9beecb39041e1faf95e5d2af257e7be8cdda467c

2
packages/zlib

@ -1 +1 @@
Subproject commit 980a0b9950ca0b52b327234fd2f66e0790f9c4e1
Subproject commit b98ea2bb69599c44bdda52c7f1d3e6e3152b97aa

13
pl/preds.yap
View File

@ -281,12 +281,19 @@ clause(V,Q,R) :-
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
'$clause'(V,M,Q,R) :- var(V), !,
'$do_error'(instantiation_error,clause(M:V,Q,R)).
'$clause'(C,M,Q,R) :- number(C), !,
'$clause'(C,M,Q,R) :-
number(C), !,
'$do_error'(type_error(callable,C),clause(M:C,Q,R)).
'$clause'(R,M,Q,R) :- db_reference(R), !,
'$do_error'(type_error(callable,R),clause(M:R,Q,R)).
'$clause'(C,M,Q,R) :-
db_reference(C), !,
'$do_error'(type_error(callable,C),clause(M:R,Q,R)).
'$clause'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
'$is_exo'(P, M), !,
Q = true,
R = '$exo_clause'(M,P),
'$execute0'(P, M).
'$clause'(P,M,Q,R) :-
'$is_source'(P, M), !,
'$static_clause'(P,M,Q,R).