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

make it compile under MSN vc. Unfortunately it has a weird crash at boot :(

Browse Source 
- Lots of indenting changes
- VC++ is strict with variadic macros
- VC++ does not accept unistd.h
- new interface for walltime
- VC++ does not seem to have support for integer overflow.
- VC++ defines YENV_REG?
- no access flags, x permissions ignored.
- new FindGMP supporting MPIR
- make horus optional (c++ is hard).
This commit is contained in:
Vítor Santos Costa 2016-02-28 19:32:55 +00:00
parent 56e9a8f8d9
commit 2192f73b11
84 changed files with 2717 additions and 2737 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

@ -79,7 +79,7 @@ GitSHA1.c
CMakeLists.txt.* CMakeLists.txt.*
FindPackageLog.txt FindPackageLog.txt
GitSHA1.c GitSHA1.c
out
GitSHA1.c GitSHA1.c
os/YapIOConfig.h os/YapIOConfig.h
@ -148,6 +148,5 @@ cmake/cmake-android
yap-6.3.workspace yap-6.3.workspace
YAP.project YAP.project
sublime
*.tmp *.tmp
CBlocks

24
C/absmi.c
View File

@ -644,7 +644,7 @@ push_live_regs(yamop *pco)
} }
#endif #endif
#if defined(ANALYST) || defined(DEBUG) #if USE_THREADED_CODE && (defined(ANALYST) || defined(DEBUG))
char *Yap_op_names[] = char *Yap_op_names[] =
{ {
@ -1066,27 +1066,27 @@ static void
execute_dealloc( USES_REGS1 ) execute_dealloc( USES_REGS1 )
{ {
/* other instructions do depend on S being set by deallocate /* other instructions do depend on S being set by deallocate
:-( */ */
CELL *ENV_YREG = YENV; CELL *ENVYREG = YENV;
S = ENV_YREG; S = ENVYREG;
CP = (yamop *) ENV_YREG[E_CP]; CP = (yamop *) ENVYREG[E_CP];
ENV = ENV_YREG = (CELL *) ENV_YREG[E_E]; ENV = ENVYREG = (CELL *) ENVYREG[E_E];
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH = ENV_YREG[E_DEPTH]; DEPTH = ENVYREG[E_DEPTH];
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; if (ENVYREG > (CELL *) top_b || ENVYREG < HR) ENVYREG = (CELL *) top_b;
#else #else
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b; if (ENVYREG > (CELL *) top_b) ENVYREG = (CELL *) top_b;
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
else ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CP)); else ENVYREG = (CELL *)((CELL) ENVYREG + ENV_Size(CP));
} }
#else #else
if (ENV_YREG > (CELL *) B) if (ENVYREG > (CELL *) B)
ENV_YREG = (CELL *) B; ENVYREG = (CELL *) B;
else else
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CP)); ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CP));
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */

66
C/adtdefs.c
View File

@ -562,62 +562,62 @@ Yap_OpPropForModule(Atom a,
return info; return info;
} }
static OpEntry * OpEntry *
fetchOpWithModule( PropEntry *pp, Term tmod, op_type type ) Yap_GetOpProp(Atom a,
{ op_type type
USES_REGS) { /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *oinfo = NULL;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp)) { while (!EndOfPAEntr(pp)) {
OpEntry *info = NULL; OpEntry *info = NULL;
if (pp->KindOfPE != OpProperty) { if (pp->KindOfPE != OpProperty) {
pp = RepProp(pp->NextOfPE); pp = RepProp(pp->NextOfPE);
continue; continue;
} }
info = (OpEntry *)pp; info = (OpEntry *)pp;
if (info->OpModule != tmod) { if (info->OpModule != CurrentModule && info->OpModule != PROLOG_MODULE) {
pp = RepProp(pp->NextOfPE); pp = RepProp(pp->NextOfPE);
continue; continue;
} }
if (type == INFIX_OP) { if (type == INFIX_OP) {
if (!info->Infix) { if (!info->Infix) {
return NULL; pp = RepProp(pp->NextOfPE);
continue;
} }
} else if (type == POSFIX_OP) { } else if (type == POSFIX_OP) {
if (!info->Posfix) { if (!info->Posfix) {
return NULL; pp = RepProp(pp->NextOfPE);
continue;
} }
} else { } else {
if (!info->Prefix) { if (!info->Prefix) {
return NULL; pp = RepProp(pp->NextOfPE);
continue;
} }
} }
return info; /* if it is not the latest module */
if (info->OpModule == PROLOG_MODULE) {
/* cannot commit now */
oinfo = info;
pp = RepProp(pp->NextOfPE);
} else {
READ_LOCK(info->OpRWLock);
READ_UNLOCK(ae->ARWLock);
return info;
}
} }
if (oinfo) {
READ_LOCK(oinfo->OpRWLock);
READ_UNLOCK(ae->ARWLock);
return oinfo;
}
READ_UNLOCK(ae->ARWLock);
return NULL; return NULL;
} }
OpEntry *
Yap_GetOpProp(Atom a,
op_type type,
Term tmod
USES_REGS) { /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *info;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
if (( (info = fetchOpWithModule( pp, tmod, type )) != NULL) ||
( (info = fetchOpWithModule( pp, USER_MODULE, type )) != NULL) ||
( (info = fetchOpWithModule( pp, PROLOG_MODULE, type )) != NULL)
) {
LOCK(info->OpRWLock);
return info;
READ_UNLOCK(ae->ARWLock);
}
READ_UNLOCK(ae->ARWLock);
return NULL;
}
inline static Prop GetPredPropByAtomHavingLock(AtomEntry *ae, Term cur_mod) inline static Prop GetPredPropByAtomHavingLock(AtomEntry *ae, Term cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */ /* get predicate entry for ap/arity; create it if neccessary. */

1792
C/atomic.c
View File

File diff suppressed because it is too large Load Diff

4
C/c_interface.c
View File

@ -83,7 +83,7 @@ X_API int YAP_Reset(yap_reset_t mode);
#define strncat(X, Y, Z) strcat(X, Y) #define strncat(X, Y, Z) strcat(X, Y)
#endif #endif
#if defined(_WIN32) #if defined(_WIN32) && !defined(X_API)
#define X_API __declspec(dllexport) #define X_API __declspec(dllexport)
#endif #endif
@ -2345,7 +2345,7 @@ static void construct_init_file(char *boot_file, char *BootFile) {
#define BOOT_FROM_SAVED_STATE TRUE #define BOOT_FROM_SAVED_STATE TRUE
X_API Int YAP_Init(YAP_init_args *yap_init) { Int YAP_Init(YAP_init_args *yap_init) {
int restore_result; int restore_result;
int do_bootstrap = (yap_init->YapPrologBootFile != NULL); int do_bootstrap = (yap_init->YapPrologBootFile != NULL);
CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;

14
C/flags.c
View File

@ -1018,13 +1018,13 @@ Term Yap_UnknownFlag(Term mod) {
mod = TermProlog; mod = TermProlog;
ModEntry *fv = Yap_GetModuleEntry(mod); ModEntry *fv = Yap_GetModuleEntry(mod);
if (fv == NULL) if (fv == NULL)
fv = Yap_GetModuleEntry(TermUser); fv = Yap_GetModuleEntry(AtomUser);
if (fv->flags & UNKNOWN_ERROR) if (fv->flags & UNKNOWN_ERROR)
return TermError; return TermError;
if (fv->flags & UNKNOWN_WARNING) if (fv->flags & UNKNOWN_WARNING)
return TermWarning; return TermWarning;
return TermFail; return TermFail;
} }
Term getYapFlag(Term tflag) { Term getYapFlag(Term tflag) {

2
C/heapgc.c
View File

@ -2035,7 +2035,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, bool very_verbose
#endif /* TABLING */ #endif /* TABLING */
if (very_verbose) { if (very_verbose) {
PredEntry *pe = Yap_PredForChoicePt(gc_B, NULL); PredEntry *pe = Yap_PredForChoicePt(gc_B, NULL);
#if defined(ANALYST) || DEBUG #if defined(ANALYST) || 0
if (pe == NULL) { if (pe == NULL) {
fprintf(stderr,"%% marked " UInt_FORMAT " (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]); fprintf(stderr,"%% marked " UInt_FORMAT " (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]);
} else if (pe->ArityOfPE) { } else if (pe->ArityOfPE) {

54
C/init.c
View File

@ -196,52 +196,6 @@ int Yap_IsOpType(char *type) {
return (i <= 7); return (i <= 7);
} }
static OpEntry *
fetchOpForModule(AtomEntry *ae, Term tmod )
{
OpEntry *oinfo = NULL;
PropEntry **prev = &ae->PropsOfAE;
PropEntry *pp = ae->PropsOfAE;
while (!EndOfPAEntr(pp)) {
OpEntry *info = RepOpProp(pp);
if (!info)
return NULL;
if (pp->KindOfPE == OpProperty) {
if (tmod == PROLOG_MODULE) {
if (info->OpModule != PROLOG_MODULE) {
info->Infix = info->Prefix = info->Posfix = 0;
info->OpModule = tmod;
if (oinfo == NULL)
oinfo = info;
else {
pp = RepProp(pp->NextOfPE);
*prev = pp;
//Yap_FreeCodeSpace( oinfo );
continue;
}
} else{
if (oinfo) {
// should never happen?
oinfo->Infix = info->Infix;
oinfo->Prefix = info->Prefix;
oinfo->Posfix = info->Posfix;
pp = RepProp(pp->NextOfPE);
*prev = pp;
// Yap_FreeCodeSpace( oinfo );
continue;
}
return info;
}
} else if (info->OpModule == tmod)
return info;
}
prev = & pp->NextOfPE;
pp = RepProp(pp->NextOfPE);
}
return oinfo;
}
static int OpDec(int p, const char *type, Atom a, Term m) { static int OpDec(int p, const char *type, Atom a, Term m) {
int i; int i;
AtomEntry *ae = RepAtom(a); AtomEntry *ae = RepAtom(a);
@ -249,6 +203,8 @@ static int OpDec(int p, const char *type, Atom a, Term m) {
if (m == TermProlog) if (m == TermProlog)
m = PROLOG_MODULE; m = PROLOG_MODULE;
else if (m == USER_MODULE)
m = PROLOG_MODULE;
for (i = 1; i <= 7; ++i) for (i = 1; i <= 7; ++i)
if (strcmp(type, optypes[i]) == 0) if (strcmp(type, optypes[i]) == 0)
break; break;
@ -264,7 +220,7 @@ static int OpDec(int p, const char *type, Atom a, Term m) {
p |= DcrrpFlag; p |= DcrrpFlag;
} }
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
info = fetchOpForModule(ae, m); info = Yap_GetOpPropForAModuleHavingALock(ae, m);
if (EndOfPAEntr(info)) { if (EndOfPAEntr(info)) {
info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry)); info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
info->KindOfPE = Ord(OpProperty); info->KindOfPE = Ord(OpProperty);
@ -283,7 +239,6 @@ static int OpDec(int p, const char *type, Atom a, Term m) {
WRITE_LOCK(info->OpRWLock); WRITE_LOCK(info->OpRWLock);
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
} }
if (i <= 3) { if (i <= 3) {
if (trueGlobalPrologFlag(ISO_FLAG) && if (trueGlobalPrologFlag(ISO_FLAG) &&
info->Posfix != 0) /* there is a posfix operator */ { info->Posfix != 0) /* there is a posfix operator */ {
@ -294,6 +249,7 @@ static int OpDec(int p, const char *type, Atom a, Term m) {
} }
info->Infix = p; info->Infix = p;
} else if (i <= 5) { } else if (i <= 5) {
if (trueGlobalPrologFlag(ISO_FLAG) && if (trueGlobalPrologFlag(ISO_FLAG) &&
info->Infix != 0) /* there is an infix operator */ { info->Infix != 0) /* there is an infix operator */ {
/* ISO dictates */ /* ISO dictates */
@ -441,7 +397,7 @@ static void InitOps(void) {
/// @} /// @}
#if DEBUG #if DEBUG
#ifdef HAVE_ISATTY #ifdef HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif #endif
#endif #endif

2
C/modules.c
View File

@ -52,7 +52,6 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
n->KindOfPE = ModProperty; n->KindOfPE = ModProperty;
n->PredForME = NULL; n->PredForME = NULL;
n->NextME = CurrentModules; n->NextME = CurrentModules;
n->ParentForME = CurrentModule;
CurrentModules = n; CurrentModules = n;
n->AtomOfME = ae; n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile( PASS_REGS1); n->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
@ -260,6 +259,7 @@ static Int change_module(USES_REGS1) { /* $change_module(N) */
Term mod = Deref(ARG1); Term mod = Deref(ARG1);
LookupModule(mod); LookupModule(mod);
CurrentModule = mod; CurrentModule = mod;
LOCAL_SourceModule = mod;
return TRUE; return TRUE;
} }

113
C/parser.c
View File

@ -164,9 +164,9 @@ typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
static void GNextToken(CACHE_TYPE1); static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE); static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, Term CACHE_TYPE); static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *, Term CACHE_TYPE); static Term ParseList(JMPBUFF *CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *, Term CACHE_TYPE); static Term ParseTerm(int, JMPBUFF *CACHE_TYPE);
const char *Yap_tokRep(TokEntry *tokptr); const char *Yap_tokRep(TokEntry *tokptr);
@ -367,12 +367,16 @@ Term Yap_Variables(VarEntry *p, Term l) {
return Variables(p, l PASS_REGS); return Variables(p, l PASS_REGS);
} }
static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod USES_REGS) { static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) {
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, tmod PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Prefix) != 0) { if ((p = opp->Prefix) != 0) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = p &MaskPrio; *pptr = *rpptr = p &MaskPrio;
@ -385,17 +389,21 @@ static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod USES_REGS) {
} }
} }
int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod) { int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
CACHE_REGS CACHE_REGS
return IsPrefixOp(op, pptr, rpptr, tmod PASS_REGS); return IsPrefixOp(op, pptr, rpptr PASS_REGS);
} }
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod USES_REGS) { static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) {
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, tmod PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Infix) != 0) { if ((p = opp->Infix) != 0) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = *lpptr = p &MaskPrio; *pptr = *rpptr = *lpptr = p &MaskPrio;
@ -410,17 +418,21 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod USES_
} }
} }
int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod) { int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
CACHE_REGS CACHE_REGS
return IsInfixOp(op, pptr, lpptr, rpptr, tmod PASS_REGS); return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS);
} }
static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod USES_REGS) { static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) {
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, tmod PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Posfix) != 0) { if ((p = opp->Posfix) != 0) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
*pptr = *lpptr = p &MaskPrio; *pptr = *lpptr = p &MaskPrio;
@ -433,9 +445,9 @@ static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod USES_REGS) {
} }
} }
int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod) { int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
CACHE_REGS CACHE_REGS
return IsPosfixOp(op, pptr, lpptr, tmod PASS_REGS); return IsPosfixOp(op, pptr, lpptr PASS_REGS);
} }
inline static void GNextToken(USES_REGS1) { inline static void GNextToken(USES_REGS1) {
@ -460,9 +472,9 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
static int is_quasi_quotation_syntax(Term goal, Term m, Atom *pat) { static int is_quasi_quotation_syntax(Term goal, Atom *pat) {
CACHE_REGS CACHE_REGS
Term t; Term m = CurrentModule, t;
Atom at; Atom at;
UInt arity; UInt arity;
Functor f; Functor f;
@ -512,8 +524,8 @@ static int get_quasi_quotation(term_t t, unsigned char **here,
} }
#endif /*O_QUASIQUOTATIONS*/ #endif /*O_QUASIQUOTATIONS*/
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
Term arg1, Term tmod USES_REGS) { Term arg1 USES_REGS) {
int nargs = 0; int nargs = 0;
Term *p, t; Term *p, t;
Functor func; Functor func;
@ -550,7 +562,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos); syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos);
FAIL; FAIL;
} }
*tp++ = Unsigned(ParseTerm(999, FailBuff, tmod PASS_REGS)); *tp++ = Unsigned(ParseTerm(999, FailBuff PASS_REGS));
ParserAuxSp = (char *)tp; ParserAuxSp = (char *)tp;
++nargs; ++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)) if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
@ -605,14 +617,14 @@ static Term MakeAccessor(Term t, Functor f USES_REGS) {
return Yap_MkApplTerm(f, 2, tf); return Yap_MkApplTerm(f, 2, tf);
} }
static Term ParseList(JMPBUFF *FailBuff, Term tmod USES_REGS) { static Term ParseList(JMPBUFF *FailBuff USES_REGS) {
Term o; Term o;
CELL *to_store; CELL *to_store;
o = AbsPair(HR); o = AbsPair(HR);
loop: loop:
to_store = HR; to_store = HR;
HR += 2; HR += 2;
to_store[0] = ParseTerm(999, FailBuff, tmod PASS_REGS); to_store[0] = ParseTerm(999, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int)LOCAL_tokptr->TokInfo) == ',') { if (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken; NextToken;
@ -629,7 +641,7 @@ loop:
} }
} else if (((int)LOCAL_tokptr->TokInfo) == '|') { } else if (((int)LOCAL_tokptr->TokInfo) == '|') {
NextToken; NextToken;
to_store[1] = ParseTerm(999, FailBuff, tmod PASS_REGS); to_store[1] = ParseTerm(999, FailBuff PASS_REGS);
} else { } else {
to_store[1] = MkAtomTerm(AtomNil); to_store[1] = MkAtomTerm(AtomNil);
} }
@ -641,7 +653,7 @@ loop:
return (o); return (o);
} }
static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) {
/* parse term with priority prio */ /* parse term with priority prio */
Volatile Term t; Volatile Term t;
Volatile Functor func; Volatile Functor func;
@ -674,7 +686,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
} }
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
Unsigned(LOCAL_tokptr->TokInfo) != 'l') && Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
IsPrefixOp((Atom)t, &opprio, &oprprio, tmod PASS_REGS)) { IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)) {
if (LOCAL_tokptr->Tok == Name_tok) { if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo; Atom at = (Atom)LOCAL_tokptr->TokInfo;
#ifndef _MSC_VER #ifndef _MSC_VER
@ -709,7 +721,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos); syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
FAIL; FAIL;
} }
t = ParseTerm(oprprio, FailBuff, tmod PASS_REGS); t = ParseTerm(oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
@ -721,7 +733,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
} }
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) && if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
Unsigned(LOCAL_tokptr->TokInfo) == 'l') Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom)t, ')', FailBuff, 0L, tmod PASS_REGS); t = ParseArgs((Atom)t, ')', FailBuff, 0L PASS_REGS);
else else
t = MkAtomTerm((Atom)t); t = MkAtomTerm((Atom)t);
break; break;
@ -737,7 +749,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
// we may be operating under a syntax error // we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE; yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_CharsToTDQ(p, tmod, LOCAL_encoding PASS_REGS); t = Yap_CharsToTDQ(p, CurrentModule, LOCAL_encoding PASS_REGS);
if (!t) { if (!t) {
syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo); syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL; FAIL;
@ -752,7 +764,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
// we may be operating under a syntax error // we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE; yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_WCharsToTDQ(p, tmod PASS_REGS); t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
syntax_msg("line %d: could not convert \'%S\'",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo); syntax_msg("line %d: could not convert \'%S\'",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo);
FAIL; FAIL;
@ -768,7 +780,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
yap_error_number oerr = LOCAL_Error_TYPE; yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_CharsToTBQ(p, tmod, LOCAL_encoding PASS_REGS); t = Yap_CharsToTBQ(p, CurrentModule, LOCAL_encoding PASS_REGS);
if (!t) { if (!t) {
syntax_msg("line %d: could not convert \'%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo); syntax_msg("line %d: could not convert \'%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL; FAIL;
@ -780,7 +792,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
case WBQString_tok: /* build list on the heap */ case WBQString_tok: /* build list on the heap */
{ {
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo; Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTBQ(p, tmod PASS_REGS); t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS);
// we may be operating under a syntax error // we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE; yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -810,7 +822,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
case '(': case '(':
case 'l': /* non solo ( */ case 'l': /* non solo ( */
NextToken; NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS); t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
checkfor(')', FailBuff PASS_REGS); checkfor(')', FailBuff PASS_REGS);
break; break;
case '[': case '[':
@ -821,7 +833,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
NextToken; NextToken;
break; break;
} }
t = ParseList(FailBuff, tmod PASS_REGS); t = ParseList(FailBuff PASS_REGS);
checkfor(']', FailBuff PASS_REGS); checkfor(']', FailBuff PASS_REGS);
break; break;
case '{': case '{':
@ -832,7 +844,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
NextToken; NextToken;
break; break;
} }
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS); t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t); t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
@ -884,7 +896,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
} }
NextToken; NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS); t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) { if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
syntax_msg("expected to find quasi quotes, got \"%s\"", , syntax_msg("expected to find quasi quotes, got \"%s\"", ,
Yap_tokRep(LOCAL_tokptr)); Yap_tokRep(LOCAL_tokptr));
@ -942,7 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) && if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) { Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo); Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, tmod PASS_REGS) && if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */ /* try parsing as infix operator */
Volatile int oldprio = curprio; Volatile int oldprio = curprio;
@ -955,7 +967,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
{ {
Term args[2]; Term args[2];
args[0] = t; args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS); args[1] = ParseTerm(oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 2, args); t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
@ -967,7 +979,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
opinfo = save_opinfo; continue;, opinfo = save_opinfo; opinfo = save_opinfo; continue;, opinfo = save_opinfo;
curprio = oldprio;) curprio = oldprio;)
} }
if (IsPosfixOp(opinfo, &opprio, &oplprio , tmod PASS_REGS) && opprio <= prio && if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio &&
oplprio >= curprio) { oplprio >= curprio) {
/* parse as posfix operator */ /* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1); Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
@ -993,7 +1005,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
args[1] = ParseTerm(1000, FailBuff, tmod PASS_REGS); args[1] = ParseTerm(1000, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args); t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
@ -1003,12 +1015,12 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
curprio = 1000; curprio = 1000;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, tmod PASS_REGS) && IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS); args[1] = ParseTerm(oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args); t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
@ -1018,24 +1030,24 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, tmod PASS_REGS) && IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, tmod PASS_REGS); t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&oplprio, tmod PASS_REGS) && &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, tmod PASS_REGS); t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS); t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&oplprio, tmod PASS_REGS) && &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, tmod PASS_REGS); t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
@ -1050,7 +1062,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
return t; return t;
} }
Term Yap_Parse(UInt prio, Term tmod) { Term Yap_Parse(UInt prio) {
CACHE_REGS CACHE_REGS
Volatile Term t; Volatile Term t;
JMPBUFF FailBuff; JMPBUFF FailBuff;
@ -1058,7 +1070,7 @@ Term Yap_Parse(UInt prio, Term tmod) {
if (!sigsetjmp(FailBuff.JmpBuff, 0)) { if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff, tmod PASS_REGS); t = ParseTerm(prio, &FailBuff PASS_REGS);
#if DEBUG #if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) { if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPutc(stderr, '['); Yap_DebugPutc(stderr, '[');
@ -1071,8 +1083,7 @@ Term Yap_Parse(UInt prio, Term tmod) {
} }
#endif #endif
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
if (LOCAL_Error_TYPE == YAP_NO_ERROR && if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_ErrorMessage = "term does not end on . "; LOCAL_ErrorMessage = "term does not end on . ";
t = 0; t = 0;

6
C/save.c
View File

@ -186,7 +186,7 @@ do_SYSTEM_ERROR_INTERNAL(yap_error_number etype, const char *msg)
inline static inline static
int myread(FILE *fd, char *buffer, Int len) { int myread(FILE *fd, char *buffer, Int len) {
ssize_t nread; size_t nread;
while (len > 0) { while (len > 0) {
nread = fread(buffer, 1, (int)len, fd); nread = fread(buffer, 1, (int)len, fd);
@ -202,7 +202,7 @@ int myread(FILE *fd, char *buffer, Int len) {
inline static inline static
Int Int
mywrite(FILE *fd, char *buff, Int len) { mywrite(FILE *fd, char *buff, Int len) {
ssize_t nwritten; size_t nwritten;
while (len > 0) { while (len > 0) {
nwritten = fwrite(buff, 1, (size_t)len, fd); nwritten = fwrite(buff, 1, (size_t)len, fd);
@ -1440,7 +1440,7 @@ OpenRestore(const char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL
CACHE_REGS CACHE_REGS
int mode; int mode;
char fname[PATH_MAX+1]; char fname[YAP_FILENAME_MAX +1];
if (!Yap_findFile( inpf, YAP_STARTUP, YapLibDir, fname, true, YAP_SAVED_STATE, true, true)) if (!Yap_findFile( inpf, YAP_STARTUP, YapLibDir, fname, true, YAP_SAVED_STATE, true, true))
return false; return false;

23
C/stdpreds.c
View File

@ -385,8 +385,7 @@ static Int p_systime(USES_REGS1) {
} }
static Int p_walltime(USES_REGS1) { static Int p_walltime(USES_REGS1) {
Int now, interval; uint64_t now, interval;
Yap_walltime_interval(&now, &interval);
return (Yap_unify_constant(ARG1, MkIntegerTerm(now)) && return (Yap_unify_constant(ARG1, MkIntegerTerm(now)) &&
Yap_unify_constant(ARG2, MkIntegerTerm(interval))); Yap_unify_constant(ARG2, MkIntegerTerm(interval)));
} }
@ -984,27 +983,24 @@ int Yap_IsOpMaxPrio(Atom at) {
return max; return max;
} }
static bool unify_op(OpEntry *op, Term emod USES_REGS) { static Int unify_op(OpEntry *op USES_REGS) {
Term tmod = op->OpModule; Term tmod = op->OpModule;
if (tmod != PROLOG_MODULE && if (tmod == PROLOG_MODULE)
tmod != USER_MODULE && tmod = TermProlog;
tmod != emod && return Yap_unify_constant(ARG2, tmod) &&
(op->Prefix || op->Infix || op->Posfix)) Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
return false;
return Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
Yap_unify_constant(ARG4, MkIntegerTerm(op->Infix)) && Yap_unify_constant(ARG4, MkIntegerTerm(op->Infix)) &&
Yap_unify_constant(ARG5, MkIntegerTerm(op->Posfix)); Yap_unify_constant(ARG5, MkIntegerTerm(op->Posfix));
} }
static Int cont_current_op(USES_REGS1) { static Int cont_current_op(USES_REGS1) {
OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next; OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next;
Term emod = Deref(ARG2);
READ_LOCK(op->OpRWLock); READ_LOCK(op->OpRWLock);
next = op->OpNext; next = op->OpNext;
if (Yap_unify_constant(ARG1, MkAtomTerm(op->OpName)) && if (Yap_unify_constant(ARG1, MkAtomTerm(op->OpName)) &&
unify_op(op, emod PASS_REGS)) { unify_op(op PASS_REGS)) {
READ_UNLOCK(op->OpRWLock); READ_UNLOCK(op->OpRWLock);
if (next) { if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
@ -1017,6 +1013,7 @@ static Int cont_current_op(USES_REGS1) {
READ_UNLOCK(op->OpRWLock); READ_UNLOCK(op->OpRWLock);
if (next) { if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
B->cp_h = HR;
return FALSE; return FALSE;
} else { } else {
cut_fail(); cut_fail();
@ -1036,7 +1033,7 @@ static Int cont_current_atom_op(USES_REGS1) {
READ_LOCK(op->OpRWLock); READ_LOCK(op->OpRWLock);
next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS); next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS);
if (unify_op(op, CurrentModule PASS_REGS)) { if (unify_op(op PASS_REGS)) {
READ_UNLOCK(op->OpRWLock); READ_UNLOCK(op->OpRWLock);
if (next) { if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);

4
C/text.c
View File

@ -931,7 +931,7 @@ write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
static ssize_t static size_t
write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{ {
size_t max = -1; size_t max = -1;
@ -998,7 +998,7 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
case YAP_STRING_LENGTH: case YAP_STRING_LENGTH:
out->val.l = out->val.l =
write_length( inp, out, enc, minimal, leng PASS_REGS); write_length( inp, out, enc, minimal, leng PASS_REGS);
return out->val.l != (ssize_t)(-1); return out->val.l != (size_t)(-1);
case YAP_STRING_ATOM: case YAP_STRING_ATOM:
out->val.a = out->val.a =
write_atom( inp, out, enc, minimal, leng PASS_REGS); write_atom( inp, out, enc, minimal, leng PASS_REGS);

2
C/threads.c
View File

@ -30,7 +30,9 @@ static char SccsId[] = "%W% %G%";
#include "yapio.h" #include "yapio.h"
#include "blobs.h" #include "blobs.h"
#include <stdio.h> #include <stdio.h>
#if HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif

6
C/write.c
View File

@ -1007,7 +1007,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
return; return;
} }
} }
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp, CurrentModule)) { if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t); Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) && int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright)); Yap_IsOp(AtomOfTerm(tright));
@ -1035,7 +1035,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || ((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets ||
atom == AtomEmptySquareBrackets) && atom == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) && Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp, CurrentModule)) { Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
int bracket_left, offset; int bracket_left, offset;
@ -1087,7 +1087,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && Arity == 2 && } else if (!wglb->Ignore_ops && Arity == 2 &&
Yap_IsInfixOp(atom, &op, &lp, &rp, CurrentModule)) { Yap_IsInfixOp(atom, &op, &lp, &rp)) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t); Term tright = ArgOfTerm(2, t);
int bracket_left = int bracket_left =

36
CMakeLists.txt
View File

@ -128,8 +128,9 @@ set_property(DIRECTORY PROPERTY CXX_STANDARD 11)
# #
include (Config) include (Config)
IF (NOT MSVC)
target_link_libraries(libYap m) target_link_libraries(libYap m)
ENDIF (NOT MSVC)
set_target_properties(libYap set_target_properties(libYap
PROPERTIES VERSION ${YAP_FULL_VERSION} PROPERTIES VERSION ${YAP_FULL_VERSION}
@ -286,18 +287,23 @@ include_directories ( utf8proc )
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS UTF8PROC=1) set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS UTF8PROC=1)
ADD_SUBDIRECTORY ( utf8proc ) ADD_SUBDIRECTORY ( utf8proc )
macro_optional_find_package (GMP ON) find_package (GMP)
macro_log_feature (GMP_FOUND macro_log_feature (GMP_FOUND
"libgmp" "GNU libgmp (in some cases MPIR"
"GNU big integers and rationals" "GNU big integers and rationals"
"http://gmplib.org") "http://gmplib.org")
set(YAP_SYSTEM_OPTIONS "big_numbers " ${YAP_SYSTEM_OPTIONS}) set(YAP_SYSTEM_OPTIONS "big_numbers " ${YAP_SYSTEM_OPTIONS})
if (GMP_FOUND) if (GMP_FOUND)
include_directories (${GMP_INCLUDE_DIR}) # GMP_FOUND - true if GMP/MPIR was found
# GMP_INCLUDE_DIRS - include search path
# GMP_LIBARIES - libraries to link with
# GMP_LIBARY_DLL - library DLL to install. Only available on WIN32.
# GMP_LIBRARIES_DIR - the directory the library we link with is found in.
include_directories (${GMP_INCLUDE_DIRS})
#add_executable(test ${SOURCES}) #add_executable(test ${SOURCES})
target_link_libraries(libYap ${GMP_LIBRARIES}) target_link_libraries(libYap ${GMP_LIBRARIES})
#config.h needs this (TODO: change in code latter) #config.h needs this (TODO: change in code latter)
set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} ) set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIRS} )
#set( CMAKE_REQUIRED_LIBRARIES ${GMP_LIBRARIES} ${CMAKE_REQUIRED_LIBRARIES} ) #set( CMAKE_REQUIRED_LIBRARIES ${GMP_LIBRARIES} ${CMAKE_REQUIRED_LIBRARIES} )
endif (GMP_FOUND) endif (GMP_FOUND)
@ -409,9 +415,19 @@ add_subDIRECTORY (packages/ProbLog)
add_subDIRECTORY (packages/swi-minisat2) add_subDIRECTORY (packages/swi-minisat2)
add_subDIRECTORY (packages/CLPBN) OPTION (WITH_CLPBN " Enable the CLPBN and PFL probabilistic languages" ON)
OPTION (WITH_CPLINT " Enable the cplint probabilistic language" ON)
OPTION (WITH_HORUS " Enable the CLPBN and PFL probabilistic languages" ON)
IF (WITH_CLPBN)
add_subDIRECTORY (packages/CLPBN)
ENDIF()
IF (WITH_CPLINT)
add_subDIRECTORY (packages/cplint) add_subDIRECTORY (packages/cplint)
ENDIF()
add_subDIRECTORY (packages/raptor) add_subDIRECTORY (packages/raptor)
@ -426,7 +442,7 @@ add_subDIRECTORY (packages/xml)
option (WITH_DOCS option (WITH_DOCS
"generate YAP docs" OFF) "generate YAP docs" OFF)
add_subDIRECTORY (docs) # add_subDIRECTORY (docs)
# add_subDIRECTORY (packages/cuda) # add_subDIRECTORY (packages/cuda)
@ -506,8 +522,10 @@ target_link_libraries(libYap
) )
if(WIN32) if(WIN32)
target_link_libraries(libYap wsock32 ws2_32 Shlwapi if(MSVC)
) set(MSVC_RUNTIME "dynamic")
ENDIF(MSVC)
target_link_libraries(libYap wsock32 ws2_32 Shlwapi)
endif() endif()
add_executable (yap-bin ${CONSOLE_SOURCES}) add_executable (yap-bin ${CONSOLE_SOURCES})

1
H/ *Minibuf-5*
View File

@ -1 +0,0 @@
M-x

1
H/ *Minibuf-6*
View File

@ -1 +0,0 @@
File to save in: ~/git/yap-6.3/H/

12
H/Regs.h
View File

@ -69,6 +69,11 @@
#endif #endif
#endif #endif
#if _MSC_VER
// no support for __builtin_expect
#define __builtin_expect(Exp, Val) (Exp)
#endif
#include "inline-only.h" #include "inline-only.h"
INLINE_ONLY inline EXTERN void restore_machine_regs(void); INLINE_ONLY inline EXTERN void restore_machine_regs(void);
@ -586,10 +591,11 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
} }
#else #else
/** continuation program counter: what to do when we exit the goal. */
#define CP Yap_REGS.CP_ /* continuation program counter */ #define CP (Yap_REGS.CP_)
#define P Yap_REGS.P_ /* prolog machine program counter */ #define P Yap_REGS.P_ /* prolog machine program counter */
#define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */ /** current environment (may be pointing at an enevironment frame before the neck sets ENV) */
#define YENV (Yap_REGS).YENV_
#define S Yap_REGS.S_ /* structure pointer */ #define S Yap_REGS.S_ /* structure pointer */
#define HR Yap_REGS.H_ /* top of heap (global) stack */ #define HR Yap_REGS.H_ /* top of heap (global) stack */
#define B Yap_REGS.B_ /* latest choice point */ #define B Yap_REGS.B_ /* latest choice point */

4
H/YapTerm.h
View File

@ -34,8 +34,12 @@ typedef void *Atom;
#ifndef EXTERN #ifndef EXTERN
#ifdef _MSC_VER
#define EXTERN
#else
#define EXTERN extern #define EXTERN extern
#endif #endif
#endif
/* defines integer types Int and UInt (unsigned) with the same size as a ptr /* defines integer types Int and UInt (unsigned) with the same size as a ptr
** and integer types Short and UShort with half the size of a ptr */ ** and integer types Short and UShort with half the size of a ptr */

19
H/Yapproto.h
View File

@ -13,6 +13,10 @@
* version: $Id: Yapproto.h,v 1.90 2008-08-07 20:51:23 vsc Exp $ * * version: $Id: Yapproto.h,v 1.90 2008-08-07 20:51:23 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#if defined(_WIN32)
#define X_API __declspec(dllexport)
#endif
/* prototype file for Yap */ /* prototype file for Yap */
/* absmi.c */ /* absmi.c */
@ -111,11 +115,11 @@ size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
/* c_interface.c */ /* c_interface.c */
#ifndef YAP_CPP_INTERFACE #ifndef YAP_CPP_INTERFACE
Int YAP_Execute(struct pred_entry *, CPredicate); X_API Int YAP_Execute(struct pred_entry *, CPredicate);
Int YAP_ExecuteFirst(struct pred_entry *, CPredicate); X_API Int YAP_ExecuteFirst(struct pred_entry *, CPredicate);
Int YAP_ExecuteNext(struct pred_entry *, CPredicate); X_API Int YAP_ExecuteNext(struct pred_entry *, CPredicate);
Int YAP_ExecuteOnCut(struct pred_entry *, CPredicate, struct cut_c_str *); X_API Int YAP_ExecuteOnCut(struct pred_entry *, CPredicate, struct cut_c_str *);
Int YAP_RunGoalOnce(Term); X_API Int YAP_RunGoalOnce(Term);
#endif #endif
/* cdmgr.c */ /* cdmgr.c */
@ -388,14 +392,14 @@ int Yap_IsOpMaxPrio(Atom);
void Yap_InitPageSize(void); void Yap_InitPageSize(void);
bool Yap_set_fpu_exceptions(Term); bool Yap_set_fpu_exceptions(Term);
UInt Yap_cputime(void); UInt Yap_cputime(void);
Int Yap_walltime(void); uint64_t Yap_walltime(void);
int Yap_dir_separator(int); int Yap_dir_separator(int);
int Yap_volume_header(char *); int Yap_volume_header(char *);
int Yap_signal_index(const char *); int Yap_signal_index(const char *);
#ifdef MAC #ifdef MAC
void Yap_SetTextFile(char *); void Yap_SetTextFile(char *);
#endif #endif
#if __ANDROIDD__ #if __ANDROID__
extern AAssetManager *Yap_assetManager; extern AAssetManager *Yap_assetManager;
extern void *Yap_openAssetFile(const char *path); extern void *Yap_openAssetFile(const char *path);
@ -404,7 +408,6 @@ extern bool Yap_isAsset(const char *path);
const char *Yap_getcwd(const char *, size_t); const char *Yap_getcwd(const char *, size_t);
void Yap_cputime_interval(Int *, Int *); void Yap_cputime_interval(Int *, Int *);
void Yap_systime_interval(Int *, Int *); void Yap_systime_interval(Int *, Int *);
void Yap_walltime_interval(Int *, Int *);
void Yap_InitSysbits(int wid); void Yap_InitSysbits(int wid);
void Yap_InitSysPreds(void); void Yap_InitSysPreds(void);
void Yap_InitcTime(int); void Yap_InitcTime(int);

25
H/Yatom.h
View File

@ -266,17 +266,16 @@ INLINE_ONLY inline EXTERN int IsWideAtom(Atom at) {
/* Module property */ /* Module property */
typedef struct mod_entry { typedef struct mod_entry {
Prop NextOfPE; /** used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /** kind of property */ PropFlags KindOfPE; /* kind of property */
struct pred_entry *PredForME; /** list of predicates for that module */ struct pred_entry *PredForME; /* index in module table */
Atom AtomOfME; /** module's name */ Atom AtomOfME; /* module's name */
Atom OwnerFile; /** module's owner file */ Atom OwnerFile; /* module's owner file */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
rwlock_t ModRWLock; /** a read-write lock to protect the entry */ rwlock_t ModRWLock; /* a read-write lock to protect the entry */
#endif #endif
Term ParentForME; /** the module we wer created from */ unsigned int flags; /* Module local flags (from SWI compat) */
unsigned int flags; /** Module local flags (from SWI compat): includes ops, strings */ struct mod_entry *NextME; /* next module */
struct mod_entry *NextME; /** next module */
} ModEntry; } ModEntry;
#if USE_OFFSETS_IN_PROPS #if USE_OFFSETS_IN_PROPS
@ -392,12 +391,12 @@ INLINE_ONLY inline EXTERN PropFlags IsOpProperty(int flags) {
typedef enum { INFIX_OP = 0, POSFIX_OP = 1, PREFIX_OP = 2 } op_type; typedef enum { INFIX_OP = 0, POSFIX_OP = 1, PREFIX_OP = 2 } op_type;
OpEntry *Yap_GetOpProp(Atom, op_type, Term CACHE_TYPE); OpEntry *Yap_GetOpProp(Atom, op_type CACHE_TYPE);
int Yap_IsPrefixOp(Atom, int *, int *, Term); int Yap_IsPrefixOp(Atom, int *, int *);
int Yap_IsOp(Atom); int Yap_IsOp(Atom);
int Yap_IsInfixOp(Atom, int *, int *, int *, Term); int Yap_IsInfixOp(Atom, int *, int *, int *);
int Yap_IsPosfixOp(Atom, int *, int *, Term); int Yap_IsPosfixOp(Atom, int *, int *);
/* defines related to operator specifications */ /* defines related to operator specifications */
#define MaskPrio 0x0fff #define MaskPrio 0x0fff

31
H/amidefs.h
View File

@ -938,6 +938,15 @@ typedef struct choicept {
CELL *cp_env; CELL *cp_env;
/* GNUCC understands empty arrays */ /* GNUCC understands empty arrays */
CELL cp_args[MIN_ARRAY]; CELL cp_args[MIN_ARRAY];
#else
/* Otherwise, we need a very dirty trick to access the arguments */
union {
CELL *cp_uenv;
CELL cp_xargs[1];
} cp_last;
#define cp_env cp_last.cp_uenv
#define cp_args cp_last.cp_xargs
#endif
#define cp_a1 cp_args[0] #define cp_a1 cp_args[0]
#define cp_a2 cp_args[1] #define cp_a2 cp_args[1]
#define cp_a3 cp_args[2] #define cp_a3 cp_args[2]
@ -949,23 +958,6 @@ typedef struct choicept {
#define cp_a9 cp_args[8] #define cp_a9 cp_args[8]
#define cp_a10 cp_args[9] #define cp_a10 cp_args[9]
#define EXTRA_CBACK_ARG(Arity,Offset) B->cp_args[(Arity)+(Offset)-1] #define EXTRA_CBACK_ARG(Arity,Offset) B->cp_args[(Arity)+(Offset)-1]
#else
/* Otherwise, we need a very dirty trick to access the arguments */
union {
CELL *cp_uenv;
CELL cp_args[1];
} cp_last;
#define cp_env cp_last.cp_uenv
#define cp_a1 cp_last.cp_args[1]
#define cp_a2 cp_last.cp_args[2]
#define cp_a3 cp_last.cp_args[3]
#define cp_a4 cp_last.cp_args[4]
#define cp_a5 cp_last.cp_args[5]
#define cp_a6 cp_last.cp_args[6]
#define cp_a7 cp_last.cp_args[7]
#define cp_a8 cp_last.cp_args[8]
#define EXTRA_CBACK_ARG(Arity,Offset) B->cp_last.cp_args[(Arity)+(Offset)]
#endif
} *choiceptr; } *choiceptr;
/* This has problems with \+ \+ a, !, b. */ /* This has problems with \+ \+ a, !, b. */
@ -1062,10 +1054,9 @@ OPCODE ENV_ToOp(yamop *cp)
} }
static inline static inline
size_t EnvSize(yamop *cp) int64_t EnvSize(yamop *cp)
{ {
return ((-ENV_Size(cp return (-ENV_Size(cp)/sizeof(CELL));
))/(OPREG)sizeof(CELL));
} }
static inline static inline

12
H/arith2.h
View File

@ -74,8 +74,15 @@ mul_overflow(Int z, Int i1, Int i2)
return (i2 && z/i2 != i1); return (i2 && z/i2 != i1);
} }
#ifndef OPTIMIZE_MULTIPLI #if defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P
#if __clang__ && FALSE /* not in OSX yet */ #define DO_MULTI() { \
uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32;\
uint64_t h2 = (12 > 0 ? i2 : -12) >> 32;\
if (h1 != 0 && h2 != 0) goto overflow;\
if ((uint64_t)(i1 & 0xfffffff)*h2 + ((uint64_t)(i2 & 0xfffffff)*h1) > 0x7fffffff) goto overflow;\
z = i1 * i2;\
}
#elif __clang__ && FALSE /* not in OSX yet */
#define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; } #define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; }
#elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P #elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DO_MULTI() {\ #define DO_MULTI() {\
@ -98,7 +105,6 @@ mul_overflow(Int z, Int i1, Int i2)
z = (Int)w; \ z = (Int)w; \
} }
#endif #endif
#endif
inline static Term inline static Term
times_int(Int i1, Int i2 USES_REGS) { times_int(Int i1, Int i2 USES_REGS) {

2
H/generated/h0globals.h
View File

@ -111,7 +111,7 @@ EXTERNAL char GLOBAL_pwd[YAP_FILENAME_MAX];
#endif #endif
//udi.c //udi.c
//struct udi_control_block RtreeCmd void //struct udi_control_block RtreeCmd void
EXTERNAL const char* GLOBAL_RestoreFile; EXTERNAL char* GLOBAL_RestoreFile;
//gprof.c //gprof.c
EXTERNAL Int GLOBAL_ProfCalls; EXTERNAL Int GLOBAL_ProfCalls;
EXTERNAL Int GLOBAL_ProfGCs; EXTERNAL Int GLOBAL_ProfGCs;

2
H/generated/hglobals.h
View File

@ -111,7 +111,7 @@ typedef struct global_data {
#endif #endif
//udi.c //udi.c
//struct udi_control_block RtreeCmd void //struct udi_control_block RtreeCmd void
const char* RestoreFile_; char* RestoreFile_;
//gprof.c //gprof.c
Int ProfCalls_; Int ProfCalls_;
Int ProfGCs_; Int ProfGCs_;

2
H/inline-only.h
View File

@ -5,7 +5,7 @@
#define INLINE_ONLY __attribute__((gnu_inline,always_inline)) #define INLINE_ONLY __attribute__((gnu_inline,always_inline))
//#define INLINE_ONLY //#define INLINE_ONLY
#else #else
#define INLINE_ONLY inline EXTERN #define INLINE_ONLY EXTERN
#endif #endif
#endif #endif

2
H/sshift.h
View File

@ -738,7 +738,7 @@ CodeVoidPAdjust__ (void * addr USES_REGS)
{ {
if (!addr) if (!addr)
return NULL; return NULL;
return addr + LOCAL_HDiff; return (void *)((char *)addr + LOCAL_HDiff);
} }
INLINE_ONLY inline EXTERN struct halt_hook *HaltHookAdjust__ (struct halt_hook * CACHE_TYPE); INLINE_ONLY inline EXTERN struct halt_hook *HaltHookAdjust__ (struct halt_hook * CACHE_TYPE);

2
OPTYap/opt.init.c
View File

@ -20,7 +20,9 @@
#define OPT_MAVAR_STATIC #define OPT_MAVAR_STATIC
#include "Yatom.h" #include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#if HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif
#include <signal.h> #include <signal.h>
#ifdef YAPOR #ifdef YAPOR
#include "or.macros.h" #include "or.macros.h"

2
OPTYap/or.cow_engine.c
View File

@ -18,7 +18,9 @@
#include "Yap.h" #include "Yap.h"
#ifdef YAPOR_COW #ifdef YAPOR_COW
#include <sys/types.h> #include <sys/types.h>
#if HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif
#include <stdio.h> #include <stdio.h>
#include "Yatom.h" #include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"

2
OPTYap/or.memory.c
View File

@ -18,7 +18,9 @@
#include "Yap.h" #include "Yap.h"
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
#include <signal.h> #include <signal.h>
#if HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif
#include <fcntl.h> #include <fcntl.h>
#include <string.h> #include <string.h>
#include <sys/shm.h> #include <sys/shm.h>

6
OPTYap/tab.tries.c
View File

@ -166,9 +166,9 @@ trie_stats;
#define SHOW_TABLE_STR_ARRAY_SIZE 100000 #define SHOW_TABLE_STR_ARRAY_SIZE 100000
#define SHOW_TABLE_ARITY_ARRAY_SIZE 10000 #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000
#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ #define SHOW_TABLE_STRUCTURE( ...) \
if (TrStat_show == SHOW_MODE_STRUCTURE) \ if (TrStat_show == SHOW_MODE_STRUCTURE) \
fprintf(TrStat_out, MESG, ##ARGS) fprintf(TrStat_out, __VA_ARGS__ )
#define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE) \ #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE) \
if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && \ if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && \
@ -1208,7 +1208,9 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
#if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING) #if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
new_subgoal_frame(sg_fr, preg, mode_directed); new_subgoal_frame(sg_fr, preg, mode_directed);
*sg_fr_end = sg_fr; *sg_fr_end = sg_fr;
#ifndef _MSC_VER
__sync_synchronize(); __sync_synchronize();
#endif
TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node); TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node);
UNLOCK_SUBGOAL_NODE(current_sg_node); UNLOCK_SUBGOAL_NODE(current_sg_node);
#else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ #else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */

57
cmake/FindGMP.cmake
View File

@ -1,23 +1,46 @@
# Try to find the GMP librairies # vim: set ts=2 shiftwidth=2 expandtab:
# GMP_FOUND - system has GMP lib # - Find GMP/MPIR libraries and headers
# GMP_INCLUDE_DIR - the GMP include directory # This module defines the following variables:
# GMP_LIBRARIES - Libraries needed to use GMP
# Copyright (c) 2006, Laurent Montel, <montel@kde.org>
# #
# Redistribution and use is allowed according to the terms of the BSD license. # GMP_FOUND - true if GMP/MPIR was found
# For details see the accompanying COPYING-CMAKE-SCRIPTS file. # GMP_INCLUDE_DIRS - include search path
# GMP_LIBARIES - libraries to link with
# GMP_LIBARY_DLL - library DLL to install. Only available on WIN32.
# GMP_LIBRARIES_DIR - the directory the library we link with is found in.
find_path(GMP_INCLUDE_DIRS NAMES gmp.h
PATHS "$ENV{PROGRAMFILES}/mpir/include"
DOC "The gmp include directory"
)
if (GMP_INCLUDE_DIR AND GMP_LIBRARIES) if(WIN32)
# Already in cache, be silent if(CMAKE_BUILD_TYPE STREQUAL "Debug" AND MSVC)
set(GMP_FIND_QUIETLY TRUE) set(MPIR_LIB "mpird")
endif (GMP_INCLUDE_DIR AND GMP_LIBRARIES) else()
set(MPIR_LIB "mpir")
endif()
find_path(GMP_INCLUDE_DIR NAMES gmp.h ) find_library(GMP_LIBRARIES NAMES ${MPIR_LIB}
find_library(GMP_LIBRARIES NAMES gmp libgmp) PATHS "$ENV{PROGRAMFILES}/mpir/lib"
DOC "The MPIR library"
)
find_library(GMP_LIBRARY_DLL NAMES ${MPIR_LIB}
PATHS "$ENV{PROGRAMFILES}/mpir/bin"
DOC "The MPIR library DLL"
)
else(WIN32)
find_library(GMP_LIBRARIES NAMES gmp
DOC "The GMP library"
)
endif(WIN32)
get_filename_component(GMP_LIBRARIES_DIR "${GMP_LIBRARIES}" PATH)
# handle the QUIET and REQUIRED arguments and set GMP_FOUND to TRUE if
# all listed variables are true
include(FindPackageHandleStandardArgs) include(FindPackageHandleStandardArgs)
FIND_PACKAGE_HANDLE_STANDARD_ARGS(GMP DEFAULT_MSG GMP_INCLUDE_DIR GMP_LIBRARIES) if(WIN32)
find_package_handle_standard_args(GMP DEFAULT_MSG GMP_LIBRARIES GMP_LIBRARY_DLL GMP_INCLUDE_DIRS)
mark_as_advanced(GMP_INCLUDE_DIR GMP_LIBRARIES) else()
find_package_handle_standard_args(GMP DEFAULT_MSG GMP_LIBRARIES GMP_INCLUDE_DIRS)
endif()

24
console/yap.c
View File

@ -22,11 +22,12 @@
#include "cut_c.h" #include "cut_c.h"
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H #undef HAVE_UNISTD_H
#endif #endif
#ifdef _WIN32 /* Microsoft's Visual C++ Compiler */
#include <windows.h>
#include <io.h>
#endif #endif
#include <stdio.h> #include <stdio.h>
#if HAVE_SYS_TYPES_H #if HAVE_SYS_TYPES_H
#include <sys/types.h> #include <sys/types.h>
@ -57,6 +58,7 @@
#include <ieeefp.h> #include <ieeefp.h>
#endif #endif
static void do_top_goal(YAP_Term Goal); static void do_top_goal(YAP_Term Goal);
static void exec_top_level(int BootMode, YAP_init_args *iap); static void exec_top_level(int BootMode, YAP_init_args *iap);
@ -68,13 +70,7 @@ static void exec_top_level(int BootMode, YAP_init_args *iap);
long _stksize = 32000; long _stksize = 32000;
#endif #endif
#ifdef USE_MYPUTC
static void
myputc (int ch)
{
putc(ch,stderr);
}
#endif
static void static void
do_top_goal (YAP_Term Goal) do_top_goal (YAP_Term Goal)
@ -87,7 +83,7 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
{ {
int BootMode; int BootMode;
BootMode = YAP_parse_yap_arguments(argc,argv,iap); // BootMode = YAP_parse_yap_arguments(argc,argv,iap);
/* init memory */ /* init memory */
if (BootMode == YAP_BOOT_FROM_PROLOG || if (BootMode == YAP_BOOT_FROM_PROLOG ||
@ -142,16 +138,8 @@ main (int argc, char **argv)
#endif #endif
{ {
int BootMode; int BootMode;
YAP_init_args init_args;
int i; int i;
#if DEBUG_LOCKS
char buf[1024];
sprintf(buf, "/tmp/yap%d", getpid());
debugf= fopen(buf, "w");
if (!debugf) fprintf(stderr,"ERROR %s\n", strerror(errno));
setvbuf( debugf,NULL, _IOLBF, 1024);
#endif
BootMode = init_standard_system(argc, argv, &init_args); BootMode = init_standard_system(argc, argv, &init_args);
if (BootMode == YAP_BOOT_ERROR) { if (BootMode == YAP_BOOT_ERROR) {
fprintf(stderr,"[ FATAL ERROR: could not find saved state ]\n"); fprintf(stderr,"[ FATAL ERROR: could not find saved state ]\n");

6
include/SWI-Prolog.h
View File

@ -607,7 +607,7 @@ extern X_API void PL_fatal_error(const char *msg);
extern X_API int Sprintf(const char * fm,...); extern X_API int Sprintf(const char * fm,...);
extern X_API int Sdprintf(const char *,...); extern X_API int Sdprintf(const char *,...);
extern char *PL_prompt_string(int fd); extern X_API char *PL_prompt_string(int fd);
/******************************* /*******************************
* FILENAME SUPPORT * * FILENAME SUPPORT *
@ -639,7 +639,7 @@ readline overhead.
#define PL_DISPATCH_WAIT 1 /* Dispatch till input available */ #define PL_DISPATCH_WAIT 1 /* Dispatch till input available */
#define PL_DISPATCH_INSTALLED 2 /* dispatch function installed? */ #define PL_DISPATCH_INSTALLED 2 /* dispatch function installed? */
extern X_API int PL_dispatch(int fd, int wait); PL_EXPORT(int) PL_dispatch(int fd, int wait);
PL_EXPORT(PL_dispatch_hook_t) PL_dispatch_hook(PL_dispatch_hook_t); PL_EXPORT(PL_dispatch_hook_t) PL_dispatch_hook(PL_dispatch_hook_t);
PL_EXPORT(void) PL_add_to_protocol(const char *buf, size_t count); PL_EXPORT(void) PL_add_to_protocol(const char *buf, size_t count);
PL_EXPORT(char *) PL_prompt_string(int fd); PL_EXPORT(char *) PL_prompt_string(int fd);
@ -667,7 +667,7 @@ PL_EXPORT(pl_wchar_t*) PL_atom_generator_w(const pl_wchar_t *pref,
PL_EXPORT(LRESULT) PL_win_message_proc(HWND hwnd, PL_EXPORT(LRESULT) PL_win_message_proc(HWND hwnd,
UINT message, UINT message,
WPARAM wParam, // WPARAM wParam,
LPARAM lParam); LPARAM lParam);
#endif /*_WINDOWS_*/ #endif /*_WINDOWS_*/

2
include/pl-types.h
View File

@ -37,9 +37,7 @@ typedef int (*PL_agc_hook_t)(atom_t);
typedef uintptr_t foreign_t; /* return type of foreign functions */ typedef uintptr_t foreign_t; /* return type of foreign functions */
typedef wchar_t pl_wchar_t; /* wide character support */ typedef wchar_t pl_wchar_t; /* wide character support */
#include <inttypes.h> /* more portable than stdint.h */ #include <inttypes.h> /* more portable than stdint.h */
#if !defined(_MSC_VER)
typedef uintptr_t PL_fid_t; /* opaque foreign context handle */ typedef uintptr_t PL_fid_t; /* opaque foreign context handle */
#endif
typedef int (*PL_dispatch_hook_t)(int fd); typedef int (*PL_dispatch_hook_t)(int fd);
typedef void *pl_function_t; typedef void *pl_function_t;

2
library/CMakeLists.txt
View File

@ -8,14 +8,12 @@ set (LIBRARY_PL
autoloader.yap autoloader.yap
avl.yap avl.yap
bhash.yap bhash.yap
bootlists.yap
charsio.yap charsio.yap
clauses.yap clauses.yap
coinduction.yap coinduction.yap
dbqueues.yap dbqueues.yap
dbusage.yap dbusage.yap
dgraphs.yap dgraphs.yap
error.yap
exo_interval.yap exo_interval.yap
expand_macros.yap expand_macros.yap
gensym.yap gensym.yap

139
library/bootlists.yap
View File

@ -1,139 +0,0 @@
/**
* @file pl/lists.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 09:54:00 2015
*
* @addtogroup lists
* @{
*/
:- system_module( '$_lists', [], []).
:- set_prolog_flag(source, true). % source.
% memberchk(+Element, +Set)
% means the same thing, but may only be used to test whether a known
% Element occurs in a known Set. In return for this limited use, it
% is more efficient when it is applicable.
/** @pred memberchk(+ _Element_, + _Set_)
As member/2, but may only be used to test whether a known
_Element_ occurs in a known Set. In return for this limited use, it
is more efficient when it is applicable.
*/
lists:memberchk(X,[X|_]) :- !.
lists:memberchk(X,[_|L]) :-
lists:memberchk(X,L).
%% member(?Element, ?Set)
% is true when Set is a list, and Element occurs in it. It may be used
% to test for an element or to enumerate all the elements by backtracking.
% Indeed, it may be used to generate the Set!
/** @pred member(? _Element_, ? _Set_)
True when _Set_ is a list, and _Element_ occurs in it. It may be used
to test for an element or to enumerate all the elements by backtracking.
*/
lists:member(X,[X|_]).
lists:member(X,[_|L]) :-
lists:member(X,L).
%% @pred identical_member(?Element, ?Set) is nondet
%
% identical_member holds true when Set is a list, and Element is
% exactly identical to one of the elements that occurs in it.
lists:identical_member(X,[Y|M]) :-
(
X == Y
;
M \= [], lists:identical_member(X,M)
).
/** @pred append(? _List1_,? _List2_,? _List3_)
Succeeds when _List3_ unifies with the concatenation of _List1_
and _List2_. The predicate can be used with any instantiation
pattern (even three variables).
*/
lists:append([], L, L).
lists:append([H|T], L, [H|R]) :-
lists:append(T, L, R).
:- set_prolog_flag(source, true). % :- no_source.
% lists:delete(List, Elem, Residue)
% is true when List is a list, in which Elem may or may not occur, and
% Residue is a copy of List with all elements identical to Elem lists:deleted.
/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
True when _List_ is a list, in which _Element_ may or may not
occur, and _Residue_ is a copy of _List_ with all elements
identical to _Element_ deleted.
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
*/
lists:delete([], _, []).
lists:delete([Head|List], Elem, Residue) :-
Head = Elem,
lists:delete(List, Elem, Residue).
lists:delete([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, Residue).
:- set_prolog_flag(source, false). % disable source.
% length of a list.
/** @pred length(? _L_,? _S_)
Unify the well-defined list _L_ with its length. The procedure can
be used to find the length of a pre-defined list, or to build a list
of length _S_.
*/
prolog:length(L, M) :-
'$skip_list'(L, M, M0, R),
( var(R) -> '$$_length'(R, M, M0) ;
R == []
).
%
% in case A1 is unbound or a difference list, things get tricky
%
'$$_length'(R, M, M0) :-
( var(M) -> '$$_length1'(R,M,M0)
; M >= M0 -> '$$_length2'(R,M,M0) ).
%
% Size is unbound, generate lists
%
'$$_length1'([], M, M).
'$$_length1'([_|L], O, N) :-
M is N + 1,
'$$_length1'(L, O, M).
%
% Size is bound, generate single list
%
'$$_length2'(NL, O, N) :-
( N =:= O -> NL = [];
M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ).
%% @}

2
library/dialect/swi/fli/swi.c
View File

@ -3343,7 +3343,7 @@ term_t Yap_CvtTerm(term_t ts)
return ts; return ts;
} }
} else if (f == FunctorDBRef) { } else if (f == FunctorDBRef) {
Term ta[0]; Term ta[1];
ta[0] = MkIntegerTerm((Int)DBRefOfTerm(t)); ta[0] = MkIntegerTerm((Int)DBRefOfTerm(t));
return Yap_InitSlot(Yap_MkApplTerm(FunctorDBREF, 1, ta)); return Yap_InitSlot(Yap_MkApplTerm(FunctorDBREF, 1, ta));
} }

5
library/lists.yap
View File

@ -47,11 +47,6 @@
sumlist/2 sumlist/2
]). ]).
:- if( source_module(prolog) ).
:- reconsult(bootlists).
:- endif.
/** @defgroup lists List Manipulation /** @defgroup lists List Manipulation
@ingroup library @ingroup library

16
library/matrix.yap
View File

@ -29,14 +29,8 @@
[(<==)/2, op(800, xfx, '<=='), [(<==)/2, op(800, xfx, '<=='),
op(700, xfx, in), op(700, xfx, in),
op(700, xfx, ins), op(700, xfx, ins),
op(450, xfx, ..), % should bind more tightly than \/ op(450, xfx, ..), % should bind more tightly than \/
op(720, fx, ..), % should bind more tightly than of op(710, xfx, of), of/2,
op(710, xfx, of),
(of)/2,
op(50, yf, '[]'),
op(50, yf, '()'),
op(100, xfy, '.'),
op(100, fy, '.'),
matrix_new/3, matrix_new/3,
matrix_new/4, matrix_new/4,
matrix_new_set/4, matrix_new_set/4,
@ -87,7 +81,11 @@
matrix_get/2, matrix_get/2,
matrix_set/2, matrix_set/2,
foreach/2, foreach/2,
foreach/4 foreach/4,
op(50, yf, []),
op(50, yf, '()'),
op(100, xfy, '.'),
op(100, fy, '.')
]). ]).
/** @defgroup matrix Matrix Library /** @defgroup matrix Matrix Library

2
library/prandom.yap
View File

@ -43,7 +43,7 @@
% efficient. % efficient.
% %
% ranpkg.pl random number package Allen Van Gelder, Stanford % ranpkg.pl random number package Allen Van Gelder, Stanford
% vvvvvv
% rannum produces a random non-negative integer whose low bits are not % rannum produces a random non-negative integer whose low bits are not
% all that random, so it should be scaled to a smaller range in general. % all that random, so it should be scaled to a smaller range in general.
% The integer is in the range 0 .. 2^(w-1) - 1, % The integer is in the range 0 .. 2^(w-1) - 1,

4
library/ytest.yap
View File

@ -6,15 +6,11 @@
op(995, xfx, given), op(995, xfx, given),
op(990, xfx, returns)] ). op(990, xfx, returns)] ).
:- (current_op(X,Y,O), write(M0:O), fail:nl).
:- use_module( library(clauses) ). :- use_module( library(clauses) ).
:- use_module( library(maplist) ). :- use_module( library(maplist) ).
:- use_module( library(gensym) ). :- use_module( library(gensym) ).
:- use_module( library(lists) ). :- use_module( library(lists) ).
:- (current_op(X,Y,O), write(M0:O), fail:nl).
:- multifile test/1. :- multifile test/1.
:- dynamic error/3, failed/3. :- dynamic error/3, failed/3.

4
library/ytest/preds.yap
View File

@ -9,7 +9,7 @@
-> ->
Flags1 = 0x200000 Flags1 = 0x200000
). ).
'$predicate_flags'(_P, _M, Flags0, Flags1) :- '$predicate_flags'(P, M, Flags0, Flags1) :-
( Flags1 /\ 0x200000 =\= 0, ( Flags1 /\ 0x200000 =\= 0,
Flags0 /\ 0x200000 =:= 0 Flags0 /\ 0x200000 =:= 0
-> ->
@ -23,7 +23,7 @@
predicate_property(M:G, imported_from(M0)), !. predicate_property(M:G, imported_from(M0)), !.
'$get_undefined_pred'(G,M,G,OM) :- '$get_undefined_pred'(G,M,G,OM) :-
functor(G,F,N), functor(G,F,N),
( system_predicate(F/N), OM = prolog ; current_predicate(M:F/N), OM= user), !. ( system_predicate(F/N), OM = prolog ; current_predicate(user:F/N), OM= user), !.
'$get_undefined_pred'(G,M,G,M0) :- '$get_undefined_pred'(G,M,G,M0) :-
predicate_property(M:G, imported_from(M0)), !. predicate_property(M:G, imported_from(M0)), !.
'$get_undefined_pred'(G,M,G,M). '$get_undefined_pred'(G,M,G,M).

2
misc/GLOBALS
View File

@ -131,7 +131,7 @@ char pwd[YAP_FILENAME_MAX] void
//udi.c //udi.c
//struct udi_control_block RtreeCmd void //struct udi_control_block RtreeCmd void
const char* RestoreFile void char* RestoreFile void
//gprof.c //gprof.c
Int ProfCalls void Int ProfCalls void

10
misc/buildlocalglobal
View File

@ -121,19 +121,19 @@ gen_0struct(Inp,Out) :-
Inp = "ATOMS", !, Inp = "ATOMS", !,
Out = "#include \"tatoms.h\"". Out = "#include \"tatoms.h\"".
gen_0struct(Inp,Out) :- gen_0struct(Inp,Out) :-
split(Inp," ",["struct"|_L]), !, split(Inp," ",["struct",Type, Field|L]), !,
extract("struct", Inp, NInp), extract("struct", Inp, NInp),
gen_0struct( NInp, NOut ), gen_0struct( NInp, NOut ),
extract("EXTERNAL", NOut, IOut), extract("EXTERNAL", NOut, IOut),
append("EXTERNAL struct ", IOut, Out). append("EXTERNAL struct ", IOut, Out).
gen_0struct(Inp,Out) :- gen_0struct(Inp,Out) :-
split(Inp," ",["const"|_L]), !, split(Inp," ",["const",Type, Field|L]), !,
extract("const", Inp, NInp), extract("const", Inp, NInp),
gen_0struct( NInp, NOut ), gen_0struct( NInp, NOut ),
extract("EXTERNAL", NOut, IOut), extract("EXTERNAL", NOut, IOut),
append("EXTERNAL const ", IOut, Out). append("EXTERNAL const ", IOut, Out).
gen_0struct(Inp,Out) :- gen_0struct(Inp,Out) :-
split(Inp," ",["union"|_L]), !, split(Inp," ",["union",Type, Field|L]), !,
extract("union", Inp, NInp), extract("union", Inp, NInp),
gen_0struct( NInp, NOut ), gen_0struct( NInp, NOut ),
extract("EXTERNAL", NOut, IOut), extract("EXTERNAL", NOut, IOut),
@ -495,3 +495,7 @@ extract([0'\t |H], IF) :- !,
extract( H, IF). extract( H, IF).
extract(H,H). extract(H,H).

1
os/alias.c
View File

@ -68,7 +68,6 @@ static char SccsId[] = "%W% %G%";
#include <stdarg.h> #include <stdarg.h>
#endif #endif
#ifdef HAVE_UNISTD_H #ifdef HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif #endif
#if HAVE_CTYPE_H #if HAVE_CTYPE_H

9
os/chartypes.yap
View File

@ -1,4 +1,11 @@
%:- module('$char_type',[]). :- module('$char_type',[
op(1150, fx, block)
%dif/2,
%when/2,
%block/1,
%wait/1,
%frozen/2
]).
/** /**
@defgroup CharacterCodes Character Encoding and Manipulation. @defgroup CharacterCodes Character Encoding and Manipulation.

5
os/console.c
View File

@ -14,9 +14,6 @@
* comments: Input/Output C implemented predicates * * comments: Input/Output C implemented predicates *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/** /**
* @file console.c * @file console.c
@ -265,7 +262,7 @@ void Yap_InitConsole(void) {
Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("prompt", 2, prompt, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt", 2, prompt, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$ensure_prompting", 0, ensure_prompting, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$ensure_prompting", 0, ensure_prompting, SafePredFlag|SyncPredFlag);
} }

36
os/files.c
View File

@ -222,7 +222,11 @@ exists_file(USES_REGS1)
/* ignore errors while checking a file */ /* ignore errors while checking a file */
return FALSE; return FALSE;
} }
return (S_ISREG(ss.st_mode)); #if _MSC_VER
return ss.st_mode & S_IFREG;
#else
return (_stat(ss.st_mode));
#endif
#else #else
return FALSE; return FALSE;
#endif #endif
@ -373,6 +377,33 @@ access_file(USES_REGS1)
return FALSE; return FALSE;
} }
#if HAVE_ACCESS #if HAVE_ACCESS
#if _WIN32
{
int mode;
if (atmode == AtomExist)
mode = 00;
else if (atmode == AtomWrite)
mode = 02;
else if (atmode == AtomRead)
mode = 04;
else if (atmode == AtomAppend)
mode = 03;
else if (atmode == AtomCsult)
mode = 04;
else if (atmode == AtomExecute)
mode = 00; // can always execute?
else {
Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
return FALSE;
}
if (access(ares, mode) < 0) {
/* ignore errors while checking a file */
return false;
}
return true;
}
#else
{ {
int mode; int mode;
@ -398,6 +429,7 @@ access_file(USES_REGS1)
} }
return true; return true;
} }
#endif
#elif HAVE_STAT #elif HAVE_STAT
{ {
struct SYSTEM_STAT ss; struct SYSTEM_STAT ss;
@ -511,8 +543,6 @@ file_directory_name ( USES_REGS1 )
return false; return false;
} }
at = AtomOfTerm(t); at = AtomOfTerm(t);
if (at == AtomEmptyAtom)
at = AtomDot;
if (IsWideAtom(at)) { if (IsWideAtom(at)) {
wchar_t s[YAP_FILENAME_MAX+1]; wchar_t s[YAP_FILENAME_MAX+1];
wchar_t *c = RepAtom(at)->WStrOfAE; wchar_t *c = RepAtom(at)->WStrOfAE;

2
os/getw.h
View File

@ -24,7 +24,7 @@ static int GETW(int sno) {
case ENC_ISO_ANSI: { case ENC_ISO_ANSI: {
char buf[8]; char buf[8];
int out; int out;
wchar_t wch; int wch;
mbstate_t mbstate; mbstate_t mbstate;
memset((void *)&(mbstate), 0, sizeof(mbstate_t)); memset((void *)&(mbstate), 0, sizeof(mbstate_t));

2056
os/iopreds.c
View File

File diff suppressed because it is too large Load Diff

0
os/iopreds.c:1351 in C-function do_open
View File

0
os/iopreds.c:1352 in C-function do_open
View File

0
os/iopreds.c:1374 in C-function do_open
View File

0
os/iopreds.c:1376 in C-function do_open
View File

0
os/iopreds.c:1379 in C-function do_open
View File

0
os/iopreds.c:1382 in C-function do_open
View File

0
os/iopreds.c:1413 in C-function do_open
View File

6
os/iopreds.h
View File

@ -152,7 +152,7 @@ typedef struct read_data_t {
} read_data, *ReadData; } read_data, *ReadData;
Term Yap_read_term(int inp_stream, Term opts, int nargs); Term Yap_read_term(int inp_stream, Term opts, int nargs);
Term Yap_Parse(UInt prio, Term tmod); Term Yap_Parse(UInt prio);
void init_read_data(ReadData _PL_rd, struct stream_desc *s); void init_read_data(ReadData _PL_rd, struct stream_desc *s);
@ -207,7 +207,7 @@ typedef struct stream_desc {
lockvar streamlock; /* protect stream access */ lockvar streamlock; /* protect stream access */
#endif #endif
int (*stream_putc)(int, int); /** function the stream uses for writing a single octet */ int (*stream_putc)(int, int); /** function the stream uses for writing a single octet */
int (*stream_wputc)(int, wchar_t); /** function the stream uses for writing a character */ int (*stream_wputc)(int, int); /** function the stream uses for writing a character */
int (*stream_getc)(int); /** function the stream uses for reading an octet. */ int (*stream_getc)(int); /** function the stream uses for reading an octet. */
int (*stream_wgetc)(int); /** function the stream uses for reading a character. */ int (*stream_wgetc)(int); /** function the stream uses for reading a character. */
@ -305,7 +305,7 @@ Term Yap_syntax_error(TokEntry *tokptr, int sno);
int console_post_process_read_char(int, StreamDesc *); int console_post_process_read_char(int, StreamDesc *);
int console_post_process_eof(StreamDesc *); int console_post_process_eof(StreamDesc *);
int post_process_read_wchar(int, ssize_t, StreamDesc *); int post_process_read_wchar(int, size_t, StreamDesc *);
int post_process_weof(StreamDesc *); int post_process_weof(StreamDesc *);
bool is_same_tty(FILE *f1, FILE *f2); bool is_same_tty(FILE *f1, FILE *f2);

50
os/mem.c
View File

@ -1,4 +1,4 @@
/*************************************************************************post/////85 /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
@ -38,7 +38,7 @@ static char SccsId[] = "%W% %G%";
#if HAVE_IO_H #if HAVE_IO_H
/* Windows */ /* Windows */
#include <io.h> #include <io.h>
#endif #endif
#if HAVE_SOCKET #if HAVE_SOCKET
#include <winsock2.h> #include <winsock2.h>
#endif #endif
@ -55,11 +55,11 @@ static char SccsId[] = "%W% %G%";
FILE * open_memstream (char **buf, size_t *len); FILE * open_memstream (char **buf, size_t *len);
#endif #endif
#if HAVE_FMEMOPEN #if HAVE_FMEMOPEN
#define MAY_READ 1 #define MAY_READ 1
#endif #endif
#if HAVE_OPEN_MEMSTREAM #if HAVE_OPEN_MEMSTREAM
#define MAY_READ 1 #define MAY_READ 1
#define MAY_WRITE 1 #define MAY_WRITE 1
#endif #endif
@ -74,20 +74,21 @@ static int MemGetc( int);
/* read from memory */ /* read from memory */
static int static int
MemGetc (int sno) MemGetc(int sno)
{ {
register StreamDesc *s = &GLOBAL_Stream[sno]; register StreamDesc *s = &GLOBAL_Stream[sno];
Int ch; Int ch;
int spos; int spos;
spos = s->u.mem_string.pos; spos = s->u.mem_string.pos;
if (spos == s->u.mem_string.max_size) { if (spos == s->u.mem_string.max_size) {
return EOF; return -1;
} else { }
ch = s->u.mem_string.buf[spos]; else {
s->u.mem_string.pos = ++spos; ch = s->u.mem_string.buf[spos];
} s->u.mem_string.pos = ++spos;
return ch; }
return ch;
} }
#endif #endif
@ -166,7 +167,7 @@ MemPutc(int sno, int ch)
FILE *f; FILE *f;
encoding_t encoding; encoding_t encoding;
stream_flags_t flags; stream_flags_t flags;
sno = GetFreeStreamD(); sno = GetFreeStreamD();
if (sno < 0) if (sno < 0)
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_mem_read_stream/1")); return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_mem_read_stream/1"));
@ -254,7 +255,7 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSou
int sno; int sno;
StreamDesc *st; StreamDesc *st;
sno = GetFreeStreamD(); sno = GetFreeStreamD();
if (sno < 0) if (sno < 0)
return -1; return -1;
@ -322,11 +323,11 @@ open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */
return (Yap_unify (ARG1, t)); return (Yap_unify (ARG1, t));
} }
/** /**
* Yap_PeekMemwriteStream() shows the current buffer for a memory stream. * Yap_PeekMemwriteStream() shows the current buffer for a memory stream.
* *
* @param sno, the in-memory stream * @param sno, the in-memory stream
* *
* @return temporary buffer, discarded by close and may be moved away * @return temporary buffer, discarded by close and may be moved away
* by other writes.. * by other writes..
*/ */
@ -413,13 +414,13 @@ bool Yap_CloseMemoryStream( int sno )
fclose(GLOBAL_Stream[sno].file); fclose(GLOBAL_Stream[sno].file);
if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f) if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f)
free( GLOBAL_Stream[sno].nbuf ); free( GLOBAL_Stream[sno].nbuf );
#else #else
if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE)
Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf);
else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) {
free(GLOBAL_Stream[sno].u.mem_string.buf); free(GLOBAL_Stream[sno].u.mem_string.buf);
} }
#endif #endif
} else { } else {
#if MAY_READ #if MAY_READ
fclose(GLOBAL_Stream[sno].file); fclose(GLOBAL_Stream[sno].file);
@ -430,7 +431,7 @@ bool Yap_CloseMemoryStream( int sno )
else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) {
free(GLOBAL_Stream[sno].u.mem_string.buf); free(GLOBAL_Stream[sno].u.mem_string.buf);
} }
#endif #endif
} }
return true; return true;
} }
@ -446,3 +447,4 @@ Yap_InitMems( void )
Yap_InitCPred ("peek_mem_write_stream", 3, peek_mem_write_stream, SyncPredFlag); Yap_InitCPred ("peek_mem_write_stream", 3, peek_mem_write_stream, SyncPredFlag);
CurrentModule = cm; CurrentModule = cm;
} }

35
os/readterm.c
View File

@ -407,9 +407,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
re->bq = getBackQuotesFlag(); re->bq = getBackQuotesFlag();
if (args[READ_MODULE].used) { if (args[READ_MODULE].used) {
fe->cmod = args[READ_MODULE].tvalue; CurrentModule = args[READ_MODULE].tvalue;
if (fe->cmod == TermProlog)
fe->cmod = PROLOG_MODULE;
} }
if (args[READ_BACKQUOTED_STRING].used) { if (args[READ_BACKQUOTED_STRING].used) {
if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue))
@ -422,6 +420,8 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
} }
if (args[READ_COMMENTS].used) { if (args[READ_COMMENTS].used) {
fe->tcomms = args[READ_COMMENTS].tvalue; fe->tcomms = args[READ_COMMENTS].tvalue;
if (fe->tcomms == TermProlog)
fe->tcomms = PROLOG_MODULE;
} else { } else {
fe->tcomms = 0; fe->tcomms = 0;
} }
@ -451,7 +451,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
fe->np = 0; fe->np = 0;
} }
if (args[READ_CHARACTER_ESCAPES].used || if (args[READ_CHARACTER_ESCAPES].used ||
Yap_CharacterEscapes(fe->cmod)) { Yap_CharacterEscapes(CurrentModule)) {
fe->ce = true; fe->ce = true;
} else { } else {
fe->ce = false; fe->ce = false;
@ -625,6 +625,9 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v1, v2, v3, vc, tp; Term v1, v2, v3, vc, tp;
CurrentModule = fe->cmod;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart); v1 = get_variables(fe, tokstart);
else else
@ -660,6 +663,9 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos; Term v_vp, v_vnames, v_comments, v_pos;
CurrentModule = fe->cmod;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart); v_vp = get_variables(fe, tokstart);
else else
@ -880,7 +886,7 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
TokEntry *tokstart = LOCAL_tokptr; TokEntry *tokstart = LOCAL_tokptr;
encoding_t e = LOCAL_encoding; encoding_t e = LOCAL_encoding;
LOCAL_encoding = fe->enc; LOCAL_encoding = fe->enc;
fe->t = Yap_Parse(re->prio, fe->cmod); fe->t = Yap_Parse(re->prio);
LOCAL_encoding = e; LOCAL_encoding = e;
fe->toklast = LOCAL_tokptr; fe->toklast = LOCAL_tokptr;
LOCAL_tokptr = tokstart; LOCAL_tokptr = tokstart;
@ -1018,7 +1024,15 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} }
re->bq = getBackQuotesFlag(); re->bq = getBackQuotesFlag();
fe->enc = GLOBAL_Stream[inp_stream].encoding; fe->enc = GLOBAL_Stream[inp_stream].encoding;
fe->cmod = LOCAL_SourceModule; fe->cmod = CurrentModule;
CurrentModule = LOCAL_SourceModule;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (args[READ_CLAUSE_MODULE].used) {
fe->tcomms = args[READ_CLAUSE_MODULE].tvalue;
} else {
fe->tcomms = 0L;
}
fe->sp = 0; fe->sp = 0;
fe->qq = 0; fe->qq = 0;
if (args[READ_CLAUSE_TERM_POSITION].used) { if (args[READ_CLAUSE_TERM_POSITION].used) {
@ -1026,14 +1040,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} else { } else {
fe->tp = 0; fe->tp = 0;
} }
if (args[READ_CLAUSE_MODULE].used) {
fe->cmod = args[READ_CLAUSE_MODULE].tvalue;
if (fe->cmod == TermProlog)
fe->cmod = PROLOG_MODULE;
}
fe->sp = 0; fe->sp = 0;
if (args[READ_CLAUSE_COMMENTS].used) { if (args[READ_CLAUSE_COMMENTS].used) {
fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue; fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue;
if (fe->tcomms == TermProlog)
fe->tcomms = PROLOG_MODULE;
} else { } else {
fe->tcomms = 0L; fe->tcomms = 0L;
} }
@ -1053,7 +1064,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} else { } else {
fe->vp = 0; fe->vp = 0;
} }
fe->ce = Yap_CharacterEscapes(fe->cmod); fe->ce = Yap_CharacterEscapes(CurrentModule);
re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0;
if (re->seekable) { if (re->seekable) {
#if HAVE_FGETPOS #if HAVE_FGETPOS

228
os/readutil.c
View File

@ -28,13 +28,16 @@ static char SccsId[] = "%W% %G%";
/// @addtogroup readutil /// @addtogroup readutil
static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2"); static Int
StreamDesc *st = GLOBAL_Stream + sno; rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
StreamDesc *st = GLOBAL_Stream+sno;
Int status; Int status;
UInt max_inp, buf_sz, sz; UInt max_inp, buf_sz, sz;
int *buf; int *buf;
bool binary_stream; bool binary_stream;
if (sno < 0) if (sno < 0)
return FALSE; return FALSE;
@ -42,167 +45,168 @@ static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
binary_stream = GLOBAL_Stream[sno].status & Binary_Stream_f; binary_stream = GLOBAL_Stream[sno].status & Binary_Stream_f;
if (status & Eof_Stream_f) { if (status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
} }
max_inp = (ASP - HR) / 2 - 1024; max_inp = (ASP-HR)/2-1024;
buf = (int *)TR; buf = (int *)TR;
buf_sz = (int *)LOCAL_TrailTop - buf; buf_sz = (int *)LOCAL_TrailTop-buf;
while (TRUE) { while (TRUE) {
if (buf_sz > max_inp) { if ( buf_sz > max_inp ) {
buf_sz = max_inp; buf_sz = max_inp;
} }
if (do_as_binary && !binary_stream) { if (do_as_binary && !binary_stream) {
GLOBAL_Stream[sno].status |= Binary_Stream_f; GLOBAL_Stream[sno].status |= Binary_Stream_f;
} }
if (st->status & Binary_Stream_f) { if (st->status & Binary_Stream_f) {
char *b = (char *)TR; char *b = (char *)TR;
sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file); sz = fread( b,1 , buf_sz, GLOBAL_Stream[sno].file);
} else { } else {
int ch; int ch;
int *pt = buf; int *pt = buf;
do { do {
*pt++ = ch = st->stream_wgetc_for_read(sno); *pt++ = ch = st->stream_wgetc_for_read(sno);
if (pt + 1 == buf + buf_sz) if (pt+1 == buf+buf_sz)
break; break;
} while (ch != '\n' && ch != EOF); } while (ch != '\n');
sz = pt - buf; sz = pt-buf;
} }
if (do_as_binary && !binary_stream) if (do_as_binary && !binary_stream)
GLOBAL_Stream[sno].status &= ~Binary_Stream_f; GLOBAL_Stream[sno].status &= ~Binary_Stream_f;
if (sz == -1 || sz == 0) { if (sz == -1 || sz == 0) {
if (GLOBAL_Stream[sno].status & Eof_Stream_f) { if (GLOBAL_Stream[sno].status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return FALSE; return FALSE;
} }
if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz - 1] == 10) { if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) {
/* we're done */ /* we're done */
Term end; Term end;
if (!(do_as_binary || GLOBAL_Stream[sno].status & Eof_Stream_f)) { if (!(do_as_binary || GLOBAL_Stream[sno].status & Eof_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
/* handle CR before NL */ /* handle CR before NL */
if ((Int)sz - 2 >= 0 && buf[sz - 2] == 13) if ((Int)sz-2 >= 0 && buf[sz-2] == 13)
buf[sz - 2] = '\0'; buf[sz-2] = '\0';
else else
buf[sz - 1] = '\0'; buf[sz-1] = '\0';
} else { } else {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
} }
if (arity == 2) if (arity == 2)
end = TermNil; end = TermNil;
else else
end = Deref(XREGS[arity]); end = Deref(XREGS[arity]);
return Yap_unify(ARG2, Yap_WCharsToDiffListOfCodes((const wchar_t *)TR, if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8)
end PASS_REGS)); return Yap_unify(ARG2, Yap_UTF8ToDiffListOfCodes((const char *)TR, end PASS_REGS)) ;
return Yap_unify(ARG2, else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR)
Yap_CharsToDiffListOfCodes((const char *)TR, end, return Yap_unify(ARG2, Yap_WCharsToDiffListOfCodes((const wchar_t *)TR, end PASS_REGS)) ;
ENC_ISO_LATIN1 PASS_REGS)); return Yap_unify(ARG2, Yap_CharsToDiffListOfCodes((const char *)TR, end, ENC_ISO_LATIN1 PASS_REGS)) ;
} }
buf += (buf_sz - 1); buf += (buf_sz-1);
max_inp -= (buf_sz - 1); max_inp -= (buf_sz-1);
if (max_inp <= 0) { if (max_inp <= 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_line_to_codes/%d", arity); Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_line_to_codes/%d", arity);
return FALSE; return FALSE;
} }
} }
} }
static Int read_line_to_codes(USES_REGS1) { static Int
read_line_to_codes(USES_REGS1)
{
return rl_to_codes(TermNil, FALSE, 2 PASS_REGS); return rl_to_codes(TermNil, FALSE, 2 PASS_REGS);
} }
static Int read_line_to_codes2(USES_REGS1) { static Int
read_line_to_codes2(USES_REGS1)
{
return rl_to_codes(TermNil, TRUE, 3 PASS_REGS); return rl_to_codes(TermNil, TRUE, 3 PASS_REGS);
} }
static Int read_line_to_string(USES_REGS1) { static Int
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2"); read_line_to_string( USES_REGS1 )
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Int status; Int status;
size_t max_inp, buf_sz; UInt max_inp, buf_sz;
unsigned char *buf; int *buf;
StreamDesc *st = GLOBAL_Stream + sno; StreamDesc *st = GLOBAL_Stream+sno;
if (sno < 0) if (sno < 0)
return FALSE; return FALSE;
status = GLOBAL_Stream[sno].status; status = GLOBAL_Stream[sno].status;
if (status & Eof_Stream_f) { if (status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
} }
max_inp = (ASP - HR) / 2 - 1024; max_inp = (ASP-HR)/2-1024;
buf = (unsigned char *)TR; buf = (int *)TR;
buf_sz = (unsigned char *)LOCAL_TrailTop - buf; buf_sz = (int *)LOCAL_TrailTop-buf;
while (true) { while (true) {
size_t sz; size_t sz;
if (buf_sz > max_inp) { if ( buf_sz > max_inp ) {
buf_sz = max_inp; buf_sz = max_inp;
} }
if (st->status & Binary_Stream_f) { if (st->status & Binary_Stream_f) {
char *b = (char *)TR; char *b = (char *)TR;
sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file); sz = fread( b,1 , buf_sz, GLOBAL_Stream[sno].file);
} else { } else {
uint32_t ch; int ch;
unsigned char *pt = buf; int *pt = buf;
do { do {
ch = st->stream_wgetc_for_read(sno); *pt++ = ch = st->stream_wgetc_for_read(sno);
if (ch == EOF) { if (pt+1 == buf+buf_sz)
sz = -1; break;
break; } while (ch != '\n');
} sz = pt-buf;
pt += put_utf8(pt, ch); }
if (pt + 4 == buf + buf_sz)
break;
} while (ch != '\n');
sz = pt - buf;
}
if (sz == -1 || sz == 0) { if (sz == -1 || sz == 0) {
if (GLOBAL_Stream[sno].status & Eof_Stream_f) { if (GLOBAL_Stream[sno].status & Eof_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return false;
} }
if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz - 1] == 10) { if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) {
/* we're done */ /* we're done */
if (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) { if (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
/* handle CR before NL */ /* handle CR before NL */
if ((Int)sz - 2 >= 0 && buf[sz - 2] == 13) if ((Int)sz-2 >= 0 && buf[sz-2] == 13)
buf[sz - 2] = '\0'; buf[sz-2] = '\0';
else { else {
buf[sz - 1] = '\0'; buf[sz-1] = '\0';
} }
} else { } else {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
} }
} }
if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8) { if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8) {
return Yap_unify(ARG2, Yap_UTF8ToString((const char *)TR PASS_REGS)); return Yap_unify(ARG2, Yap_UTF8ToString((const char *)TR PASS_REGS)) ;
} else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR) { } else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR) {
return Yap_unify(ARG2, Yap_WCharsToString((const wchar_t *)TR PASS_REGS)); return Yap_unify(ARG2, Yap_WCharsToString((const wchar_t *)TR PASS_REGS)) ;
} else { }else {
return Yap_unify( return Yap_unify(ARG2, Yap_CharsToString((const char *)TR, ENC_ISO_LATIN1 PASS_REGS) );
ARG2, Yap_CharsToString((const char *)TR, ENC_ISO_LATIN1 PASS_REGS));
} }
buf += (buf_sz - 1); buf += (buf_sz-1);
max_inp -= (buf_sz - 1); max_inp -= (buf_sz-1);
if (max_inp <= 0) { if (max_inp <= 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, ARG1, NULL); Yap_Error(RESOURCE_ERROR_STACK, ARG1, NULL);
return FALSE; return FALSE;
} }
} }
} }
static Int read_stream_to_codes(USES_REGS1) { static Int
int sno = Yap_CheckStream(ARG1, Input_Stream_f, read_stream_to_codes(USES_REGS1)
"reaMkAtomTerm (AtomEofd_line_to_codes/2"); {
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "reaMkAtomTerm (AtomEofd_line_to_codes/2");
CELL *HBASE = HR; CELL *HBASE = HR;
CELL *h0 = &ARG4; CELL *h0 = &ARG4;
@ -217,33 +221,36 @@ static Int read_stream_to_codes(USES_REGS1) {
t = MkIntegerTerm(ch); t = MkIntegerTerm(ch);
h0[0] = AbsPair(HR); h0[0] = AbsPair(HR);
*HR = t; *HR = t;
HR += 2; HR+=2;
h0 = HR - 1; h0 = HR-1;
yhandle_t news, news1, st = Yap_StartSlots(); yhandle_t news, news1, st = Yap_StartSlots();
if (HR >= ASP - 1024) { if (HR >= ASP-1024) {
RESET_VARIABLE(h0); RESET_VARIABLE(h0);
news = Yap_InitSlot(AbsPair(HBASE)); news = Yap_InitSlot(AbsPair(HBASE));
news1 = Yap_InitSlot((CELL)(h0)); news1 = Yap_InitSlot( (CELL)(h0));
if (!Yap_gcl((ASP - HBASE) * sizeof(CELL), 3, ENV, Yap_gcP())) { if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 3, ENV, Yap_gcP())) {
Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_stream_to_codes/3"); Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_stream_to_codes/3");
return false; return false;
} }
/* build a legal term again */ /* build a legal term again */
h0 = (CELL *)(Yap_GetFromSlot(news1)); h0 = (CELL*)(Yap_GetFromSlot(news1));
HBASE = RepPair(Yap_GetFromSlot(news)); HBASE = RepPair(Yap_GetFromSlot(news));
} }
Yap_CloseSlots(st); Yap_CloseSlots(st);
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
if (HR == HBASE) if (HR == HBASE)
return Yap_unify(ARG2, ARG3); return Yap_unify(ARG2,ARG3);
RESET_VARIABLE(HR - 1); RESET_VARIABLE(HR-1);
Yap_unify(HR[-1], ARG3); Yap_unify(HR[-1],ARG3);
return Yap_unify(AbsPair(HBASE), ARG2); return Yap_unify(AbsPair(HBASE),ARG2);
} }
static Int read_stream_to_terms(USES_REGS1) { static Int
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2"); read_stream_to_terms(USES_REGS1)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t, hd; Term t, hd;
yhandle_t tails, news; yhandle_t tails, news;
@ -252,18 +259,18 @@ static Int read_stream_to_terms(USES_REGS1) {
t = AbsPair(HR); t = AbsPair(HR);
RESET_VARIABLE(HR); RESET_VARIABLE(HR);
Yap_InitSlot((CELL)(HR)); Yap_InitSlot( (CELL)(HR) );
tails = Yap_InitSlot((CELL)(HR)); tails = Yap_InitSlot( (CELL)(HR) );
news = Yap_InitSlot((CELL)(HR)); news = Yap_InitSlot( (CELL)(HR) );
HR++; HR++;
while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) { while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
RESET_VARIABLE(HR); RESET_VARIABLE(HR);
RESET_VARIABLE(HR + 1); RESET_VARIABLE(HR+1);
hd = (CELL)HR; hd = (CELL)HR;
Yap_PutInSlot(news, (CELL)(HR + 1)); Yap_PutInSlot(news, (CELL)(HR+1));
HR += 2; HR += 2;
while ((hd = Yap_read_term(sno, TermNil, 2)) == 0L) while ((hd=Yap_read_term(sno, TermNil, 2)) == 0L)
; ;
// just ignore failure // just ignore failure
CELL *pt = VarOfTerm(Yap_GetFromSlot(tails)); CELL *pt = VarOfTerm(Yap_GetFromSlot(tails));
@ -271,17 +278,19 @@ static Int read_stream_to_terms(USES_REGS1) {
*pt = Deref(ARG3); *pt = Deref(ARG3);
break; break;
} else { } else {
CELL *newpt = (CELL *)Yap_GetFromSlot(news); CELL *newpt = (CELL*)Yap_GetFromSlot(news);
*pt = AbsPair(newpt - 1); *pt =AbsPair(newpt-1);
Yap_PutInSlot(tails, (CELL)newpt); Yap_PutInSlot(tails, (CELL)newpt);
} }
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify(t, ARG2); return Yap_unify(t,ARG2);
} }
void Yap_InitReadUtil(void) { void
CACHE_REGS Yap_InitReadUtil(void)
{
CACHE_REGS
Term cm = CurrentModule; Term cm = CurrentModule;
CurrentModule = READUTIL_MODULE; CurrentModule = READUTIL_MODULE;
@ -292,3 +301,4 @@ void Yap_InitReadUtil(void) {
Yap_InitCPred("read_stream_to_terms", 3, read_stream_to_terms, SyncPredFlag); Yap_InitCPred("read_stream_to_terms", 3, read_stream_to_terms, SyncPredFlag);
CurrentModule = cm; CurrentModule = cm;
} }

2
os/sig.c
View File

@ -363,7 +363,7 @@ Yap_MathException__( USES_REGS1 )
return EVALUATION_ERROR_UNDEFINED; return EVALUATION_ERROR_UNDEFINED;
} }
} }
#elif _WIN32 && FALSE #elif _WIN32
unsigned int raised; unsigned int raised;
int err; int err;

10
os/streams.c
View File

@ -881,8 +881,14 @@ void Yap_CloseStreams(int loud) {
for (sno = 3; sno < MaxStreams; ++sno) { for (sno = 3; sno < MaxStreams; ++sno) {
if (GLOBAL_Stream[sno].status & Free_Stream_f) if (GLOBAL_Stream[sno].status & Free_Stream_f)
continue; continue;
if ((GLOBAL_Stream[sno].status & Popen_Stream_f)) if ((GLOBAL_Stream[sno].status & Popen_Stream_f)) {
pclose(GLOBAL_Stream[sno].file); #if _MSC_VER
_pclose(GLOBAL_Stream[sno].file);
#else
pclose(GLOBAL_Stream[sno].file);
#endif
}
if (GLOBAL_Stream[sno].status & (Pipe_Stream_f | Socket_Stream_f)) if (GLOBAL_Stream[sno].status & (Pipe_Stream_f | Socket_Stream_f))
close(GLOBAL_Stream[sno].u.pipe.fd); close(GLOBAL_Stream[sno].u.pipe.fd);
#if USE_SOCKET #if USE_SOCKET

75
os/sysbits.c
View File

@ -23,7 +23,7 @@ static char SccsId[] = "%W% %G%";
/// File Error Handler /// File Error Handler
static void static void
Yap_FileError(yap_error_number type, Term where, const char *format,...) FileError(yap_error_number type, Term where, const char *format,...)
{ {
if ( trueLocalPrologFlag(FILEERRORS_FLAG) ) { if ( trueLocalPrologFlag(FILEERRORS_FLAG) ) {
@ -53,7 +53,7 @@ static int chdir(char *);
/* #define signal skel_signal */ /* #define signal skel_signal */
#endif /* MACYAP */ #endif /* MACYAP */
static const char * static const char *
expandVars(const char *spec); expandVars(const char *spec, char *u);
void exit(int); void exit(int);
@ -245,7 +245,11 @@ has_access(const char *FileName, int mode)
static bool static bool
exists( const char *f) exists( const char *f)
{ {
#if _MSC_VER
return has_access(f, 00);
#else
return has_access( f, F_OK ); return has_access( f, F_OK );
#endif
} }
static int static int
@ -279,7 +283,7 @@ bool
Yap_IsAbsolutePath(const char *p0) Yap_IsAbsolutePath(const char *p0)
{ {
// verify first if expansion is needed: ~/ or $HOME/ // verify first if expansion is needed: ~/ or $HOME/
const char *p = expandVars( p0 ); const char *p = expandVars( p0, LOCAL_FileNameBuf );
bool nrc; bool nrc;
#if _WIN32 || __MINGW32__ #if _WIN32 || __MINGW32__
nrc = !PathIsRelative(p); nrc = !PathIsRelative(p);
@ -334,13 +338,13 @@ PlExpandVars (const char *source, const char *root, char *result)
res++, src++; res++, src++;
res[0] = '\0'; res[0] = '\0';
if ((user_passwd = getpwnam (result)) == NULL) { if ((user_passwd = getpwnam (result)) == NULL) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s does not exist in %s", result, source); FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s does not exist in %s", result, source);
return NULL; return NULL;
} }
strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX); strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
strcat(result, src); strcat(result, src);
#else #else
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s cannot be found in %s, missing getpwnam", result, source); FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s cannot be found in %s, missing getpwnam", result, source);
return NULL; return NULL;
#endif #endif
} }
@ -531,7 +535,7 @@ DirName(const char *X) {
if (!o) if (!o)
return NULL; return NULL;
if (( err = _splitpath_s(o, drive, YAP_FILENAME_MAX-1, dir, YAP_FILENAME_MAX-1,NULL, 0, NULL, 0) ) != 0) { if (( err = _splitpath_s(o, drive, YAP_FILENAME_MAX-1, dir, YAP_FILENAME_MAX-1,NULL, 0, NULL, 0) ) != 0) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno)); FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno));
return NULL; return NULL;
} }
@ -541,14 +545,15 @@ DirName(const char *X) {
} }
#endif #endif
static const char *myrealpath( const char *path, char *out) static const char *myrealpath( const char *path)
{ {
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
DWORD retval=0; DWORD retval=0;
char *out = LOCAL_FileNameBuf;
// notice that the file does not need to exist // notice that the file does not need to exist
retval = GetFullPathName(path, retval = GetFullPathName(path,
MAX_PATH-1, YAP_FILENAME_MAX,
out, out,
NULL); NULL);
@ -589,23 +594,22 @@ static const char *myrealpath( const char *path, char *out)
} }
#endif #endif
strcat(rc, b); strcat(rc, b);
return rc; return rc;
} }
} }
} }
#else
char *out = malloc(strlen(path)+1);
strcpy( out, path);
return out;
#endif #endif
char *rc = malloc(strlen(path)+1);
strcpy( rc, path);
const char * f = rc;
return f;
} }
static const char * static const char *
expandVars(const char *spec) expandVars(const char *spec, char *u)
{ {
CACHE_REGS CACHE_REGS
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
char u[YAP_FILENAME_MAX+1];
char *out; char *out;
// first pass, remove Unix style stuff // first pass, remove Unix style stuff
@ -621,7 +625,7 @@ expandVars(const char *spec)
if (IsPairTerm(t)) if (IsPairTerm(t))
return RepAtom(AtomOfTerm(HeadOfTerm(t)))->StrOfAE; return RepAtom(AtomOfTerm(HeadOfTerm(t)))->StrOfAE;
return NULL; return NULL;
} }
return spec; return spec;
} }
@ -641,7 +645,7 @@ Yap_AbsoluteFile(const char *spec, bool ok)
rc = PlExpandVars(spec, NULL, NULL); rc = PlExpandVars(spec, NULL, NULL);
if (!rc) if (!rc)
rc = spec; rc = spec;
if ((p = myrealpath(rc, NULL )) ) { if ((p = myrealpath(rc) ) ) {
return p; return p;
} else { } else {
return NULL; return NULL;
@ -650,7 +654,7 @@ Yap_AbsoluteFile(const char *spec, bool ok)
} }
/** /**
* generate absolute path and stores path in an user given buffer. If * generate absolute path and stores path in an user given buffer. If
* NULL, uses a temporary buffer that must be quickly released. * NULL, uses a temporary buffer that must be quickly released.
* *
* if ok first expand variable names and do globbing * if ok first expand variable names and do globbing
@ -667,14 +671,12 @@ Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok)
const char*p; const char*p;
const char*rc; const char*rc;
if (ok) { if (ok) {
rc = expandVars(spec); rc = expandVars(spec, LOCAL_FileNameBuf);
if (!rc) if (!rc)
return spec; return spec;
} else { }
rc = spec;
} if ((p = myrealpath(rc) ) ) {
if ((p = myrealpath(rc, out) ) ) {
if (!out) { if (!out) {
out = LOCAL_FileNameBuf; out = LOCAL_FileNameBuf;
sz = YAP_FILENAME_MAX-1; sz = YAP_FILENAME_MAX-1;
@ -703,12 +705,12 @@ do_glob(const char *spec, bool glob_vs_wordexp)
{ {
WIN32_FIND_DATA find; WIN32_FIND_DATA find;
HANDLE hFind; HANDLE hFind;
const char *espec;
CELL *dest; CELL *dest;
char *espec; Term tf;
Term tf;
// first pass, remove Unix style stuff // first pass, remove Unix style stuff
if ((espec =unix2win(spec, u, YAP_FILENAME_MAX)) == NULL) if (unix2win(espec, u, YAP_FILENAME_MAX) == NULL)
return TermNil; return TermNil;
espec = (const char *)u; espec = (const char *)u;
@ -861,7 +863,6 @@ prolog_realpath( USES_REGS1 )
{ {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
const char *cmd; const char *cmd;
char out[YAP_FILENAME_MAX];
if (IsAtomTerm(t1)) { if (IsAtomTerm(t1)) {
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
@ -870,7 +871,7 @@ prolog_realpath( USES_REGS1 )
} else { } else {
return false; return false;
} }
const char *rc = myrealpath( cmd , out); const char *rc = myrealpath( cmd );
if (!rc) { if (!rc) {
PlIOError( SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno)); PlIOError( SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno));
return false; return false;
@ -903,7 +904,7 @@ static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()};
static Term static Term
do_expand_file_name(Term t1, Term opts USES_REGS) do_expand_file_name(Term t1, Term opts USES_REGS)
{ {
xarg *args; xarg *args;
expand_filename_enum_choices_t i; expand_filename_enum_choices_t i;
bool use_system_expansion = true; bool use_system_expansion = true;
@ -925,6 +926,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END); args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
if (args == NULL) { if (args == NULL) {
return TermNil; return TermNil;
} }
tmpe = malloc(YAP_FILENAME_MAX+1); tmpe = malloc(YAP_FILENAME_MAX+1);
@ -934,7 +936,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
switch (i) { switch (i) {
case EXPAND_FILENAME_PARAMETER_EXPANSION: case EXPAND_FILENAME_PARAMETER_EXPANSION:
if (t == TermProlog) { if (t == TermProlog) {
const char *s = expandVars( spec); const char *s = expandVars( spec, LOCAL_FileNameBuf);
if (s == NULL) { if (s == NULL) {
return TermNil; return TermNil;
} }
@ -962,7 +964,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
if (!use_system_expansion) { if (!use_system_expansion) {
return MkPairTerm(MkAtomTerm(Yap_LookupAtom(expandVars(spec))), TermNil); return MkPairTerm(MkAtomTerm(Yap_LookupAtom(expandVars(spec, NULL))), TermNil);
} }
tf = do_glob(spec, true); tf = do_glob(spec, true);
return tf; return tf;
@ -971,7 +973,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
/* @pred expand_file_name( +Pattern, -ListOfPaths) is det /* @pred expand_file_name( +Pattern, -ListOfPaths) is det
This builtin receives a pattern and expands it into a list of files. This builtin receives a pattern and expands it into a list of files.
In Unix-like systems, YAP applies glob to expand patterns such as '*', '.', and '?'. Further variable expansion In Unix-like systems, YAP applies glob to expand patterns such as '*', '.', and '?'. Further variable expansion
may also happen. glob is shell-dependent: som Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0); may also happen. glob is shell-dependent: som Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0);
Yap_InitCPred ("real_path", 2, prolog_realpath, 0); Yap_InitCPred ("real_path", 2, prolog_realpath, 0);
Yap_InitCPred ("true_file_name", 2, Yap_InitCPred ("true_file_name", 2,
@ -1203,7 +1205,7 @@ initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) {
while (*--pt != '\\') { while (*--pt != '\\') {
/* skip executable */ /* skip executable */
if (pt == LOCAL_FileNameBuf) { if (pt == LOCAL_FileNameBuf) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name"); FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name");
/* do nothing */ /* do nothing */
return FALSE; return FALSE;
} }
@ -1211,7 +1213,7 @@ initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) {
while (*--pt != '\\') { while (*--pt != '\\') {
/* skip parent directory "bin\\" */ /* skip parent directory "bin\\" */
if (pt == LOCAL_FileNameBuf) { if (pt == LOCAL_FileNameBuf) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name"); FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name");
/* do nothing */ /* do nothing */
return FALSE; return FALSE;
} }
@ -1788,7 +1790,7 @@ p_mv ( USES_REGS1 )
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom"); Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
} else { } else {
oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE; oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE;
newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE; newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE;
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0) if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
unlink (newname); unlink (newname);
if (r != 0) { if (r != 0) {
@ -2299,3 +2301,4 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag); Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag);
Yap_InitCPred ("make_directory", 1, make_directory, SyncPredFlag); Yap_InitCPred ("make_directory", 1, make_directory, SyncPredFlag);
} }

2
os/sysbits.h
View File

@ -153,6 +153,6 @@ void Yap_InitRandom (void);
void Yap_InitTime (int wid); void Yap_InitTime (int wid);
void Yap_InitOSSignals (int wid); void Yap_InitOSSignals (int wid);
void Yap_InitWTime(void); void Yap_InitWTime(void);
void Yap_InitLastWTime ( void );

179
os/time.c
View File

@ -152,7 +152,7 @@ void Yap_systime_interval(Int *now,Int *interval)
#include <time.h> #include <time.h>
static FILETIME StartOfTimes, last_time; static FILETIME StartOfTimes, last_time;
static FILETIME StartOfTimes_sys, last_time_sys; static FILETIME StartOfTimes_sys, last_time_sys;
@ -530,6 +530,8 @@ real_cputime ()
#endif /* HAVE_GETRUSAGE */ #endif /* HAVE_GETRUSAGE */
uint64_t Yap_StartOfWTimes;
#if HAVE_GETHRTIME #if HAVE_GETHRTIME
#if HAVE_TIME_H #if HAVE_TIME_H
@ -537,92 +539,48 @@ real_cputime ()
#endif #endif
/* since the point YAP was started */ /* since the point YAP was started */
static hrtime_t StartOfWTimes;
/* since last call to walltime */ void
#define LastWTime (*(hrtime_t *)ALIGN_BY_TYPE(GLOBAL_LastWTimePtr,hrtime_t))
static void
Yap_InitWTime (void) Yap_InitWTime (void)
{ {
StartOfWTimes = gethrtime(); Yap_StartOfWTimes = (uint64_t)gethrtime();
} }
static void /// returns time since Jan 1 1980 in nano-seconds
Yap_InitLastWTime(void) { uint64_t Yap_walltime(uint64_t old)
/* ask for twice the space in order to guarantee alignment */
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(2*sizeof(hrtime_t));
LastWTime = StartOfWTimes;
}
Int
Yap_walltime (void)
{ {
hrtime_t tp = gethrtime(); hrtime_t tp = gethrtime();
/* return time in milliseconds */ /* return time in milliseconds */
return((Int)((tp-StartOfWTimes)/((hrtime_t)1000000))); return = (uint64_t)tp;
} }
void Yap_walltime_interval(Int *now,Int *interval)
{
hrtime_t tp = gethrtime();
/* return time in milliseconds */
*now = (Int)((tp-StartOfWTimes)/((hrtime_t)1000000));
*interval = (Int)((tp-LastWTime)/((hrtime_t)1000000));
LastWTime = tp;
}
#elif HAVE_GETTIMEOFDAY #elif HAVE_GETTIMEOFDAY
/* since the point YAP was started */ /* since the point YAP was started */
static struct timeval StartOfWTimes;
/* since last call to walltime */
#define LastWTime (*(struct timeval *)GLOBAL_LastWTimePtr)
/* store user time in this variable */ /* store user time in this variable */
void void
Yap_InitWTime (void) Yap_InitWTime (void)
{ {
gettimeofday(&StartOfWTimes,NULL); struct timeval tp;
gettimeofday(&tp, NULL);
Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
} }
void
Yap_InitLastWTime(void) { /// returns time in nano-secs since the epoch
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeval)); uint64_t
LastWTime.tv_usec = StartOfWTimes.tv_usec; Yap_walltime(void)
LastWTime.tv_sec = StartOfWTimes.tv_sec;
}
Int
Yap_walltime (void)
{ {
struct timeval tp; struct timeval tp;
gettimeofday(&tp,NULL); gettimeofday(&tp, NULL);
if (StartOfWTimes.tv_usec > tp.tv_usec) return (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
return((tp.tv_sec - StartOfWTimes.tv_sec - 1) * 1000 +
(StartOfWTimes.tv_usec - tp.tv_usec) /1000);
else
return((tp.tv_sec - StartOfWTimes.tv_sec)) * 1000 +
((tp.tv_usec - LastWTime.tv_usec) / 1000);
} }
void Yap_walltime_interval(Int *now,Int *interval)
{
struct timeval tp;
gettimeofday(&tp,NULL);
*now = (tp.tv_sec - StartOfWTimes.tv_sec) * 1000 +
(tp.tv_usec - StartOfWTimes.tv_usec) / 1000;
*interval = (tp.tv_sec - LastWTime.tv_sec) * 1000 +
(tp.tv_usec - LastWTime.tv_usec) / 1000;
LastWTime.tv_usec = tp.tv_usec;
LastWTime.tv_sec = tp.tv_sec;
}
#elif defined(_WIN32) #elif defined(_WIN32)
@ -630,103 +588,68 @@ void Yap_walltime_interval(Int *now,Int *interval)
#include <time.h> #include <time.h>
/* since the point YAP was started */ /* since the point YAP was started */
static struct _timeb StartOfWTimes; static LARGE_INTEGER Frequency;
/* since last call to walltime */
#define LastWTime (*(struct timeb *)GLOBAL_LastWTimePtr)
/* store user time in this variable */ /* store user time in this variable */
static void void
InitWTime (void) Yap_InitWTime (void)
{ {
_ftime(&StartOfWTimes); LARGE_INTEGER ElapsedNanoseconds;
} QueryPerformanceFrequency(&Frequency);
QueryPerformanceCounter(&ElapsedNanoseconds);
static void ElapsedNanoseconds.QuadPart *= 1000000;
InitLastWTime(void) { ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeb)); Yap_StartOfWTimes = (uint64_t)ElapsedNanoseconds.QuadPart;
LastWTime.time = StartOfWTimes.time;
LastWTime.millitm = StartOfWTimes.millitm;
} }
Int
uint64_t
Yap_walltime (void) Yap_walltime (void)
{ {
struct _timeb tp; LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceCounter(&ElapsedNanoseconds);
//
// We now have the elapsed number of ticks, along with the
// number of ticks-per-second. We use these values
// to convert to the number of elapsed microseconds.
// To guard against loss-of-precision, we convert
// to microseconds *before* dividing by ticks-per-second.
//
_ftime(&tp); ElapsedNanoseconds.QuadPart *= 1000000;
if (StartOfWTimes.millitm > tp.millitm) ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
return((tp.time - StartOfWTimes.time - 1) * 1000 + return ElapsedNanoseconds.QuadPart;
(StartOfWTimes.millitm - tp.millitm));
else
return((tp.time - StartOfWTimes.time)) * 1000 +
((tp.millitm - LastWTime.millitm) / 1000);
}
void Yap_walltime_interval(Int *now,Int *interval)
{
struct _timeb tp;
_ftime(&tp);
*now = (tp.time - StartOfWTimes.time) * 1000 +
(tp.millitm - StartOfWTimes.millitm);
*interval = (tp.time - LastWTime.time) * 1000 +
(tp.millitm - LastWTime.millitm) ;
LastWTime.millitm = tp.millitm;
LastWTime.time = tp.time;
} }
#elif HAVE_TIMES #elif HAVE_TIMES
static clock_t StartOfWTimes;
#define LastWTime (*(clock_t *)GLOBAL_LastWTimePtr)
/* store user time in this variable */ /* store user time in this variable */
static void void
InitWTime (void) Yap_InitWTime (void)
{ {
StartOfWTimes = times(NULL); Yap_StartOfWTimes = ((uint64_t)times(NULL))*10000000/TicksPerSec;
} }
static void uint64_t
InitLastWTime(void) {
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(clock_t));
LastWTime = StartOfWTimes;
}
Int
Yap_walltime (void) Yap_walltime (void)
{ {
clock_t t; clock_t t;
t = times(NULL); t = times(NULL);
return ((t - StartOfWTimes)*1000 / TicksPerSec)); return = ((uint64_t)times(NULL)) * 10000000 / TicksPerSec;
} }
void Yap_walltime_interval(Int *now,Int *interval)
{
clock_t t;
t = times(NULL);
*now = ((t - StartOfWTimes)*1000) / TicksPerSec;
*interval = (t - GLOBAL_LastWTime) * 1000 / TicksPerSec;
}
#endif /* HAVE_TIMES */ #endif /* HAVE_TIMES */
void void
Yap_ReInitWTime (void) Yap_ReInitWTime (void)
{ {
Yap_InitWTime(); Yap_InitWTime();
if (GLOBAL_LastWTimePtr != NULL) }
Yap_FreeCodeSpace(GLOBAL_LastWTimePtr);
Yap_InitLastWTime();
}
void void
Yap_InitTimePreds(void) Yap_InitTimePreds(void)
{ {
/* can only do after heap is initialized */ /* can only do after heap is initialized */
Yap_InitLastWTime(); Yap_InitWTime();
} }

2
os/yapio.h
View File

@ -161,7 +161,7 @@ INLINE_ONLY inline EXTERN Term MkCharTerm(Int c);
* @return the term. * @return the term.
*/ */
INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) { INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) {
wchar_t cs[2]; int cs[2];
if (c < 0) if (c < 0)
return MkAtomTerm(AtomEof); return MkAtomTerm(AtomEof);
cs[0] = c; cs[0] = c;

2
packages/CLPBN/CMakeLists.txt
View File

@ -89,7 +89,9 @@ set(
ex/learning/train.yap ex/learning/train.yap
) )
IF (WITH_HORUS)
add_subDIRECTORY (horus) add_subDIRECTORY (horus)
ENDIF()
install(FILES install(FILES
${CLPBN_TOP} ${CLPBN_TOP}

12
packages/jpl/CMakeLists.txt
View File

@ -1,21 +1,19 @@
#CHECK: JavaLibs #CHECK: JavaLibs
set (JPL_SOURCES
src/c/jpl.c)
find_package(Java COMPONENTS Runtime Development) find_package(Java COMPONENTS Runtime Development)
# find_package(Java COMPONENTS Development) # find_package(Java COMPONENTS Development)
# find_package(Java COMPONENTS Runtime) # find_package(Java COMPONENTS Runtime)
#find_package(JavaLibs) #find_package(JavaLibs)
set (JPL_SOURCES
src/c/jpl.c)
macro_log_feature (Java_Development_FOUND "Java" macro_log_feature (Java_Development_FOUND "Java"
"Use Java System" "Use Java System"
"http://www.java.org" FALSE) "http://www.java.org" FALSE)
find_package(JNI) if (Java_Development_FOUND)
if (Java_Development_FOUND AND JNI_FOUND)
find_package(JNI)
include(UseJava) include(UseJava)
# #
@ -56,4 +54,4 @@ if (Java_Development_FOUND AND JNI_FOUND)
DESTINATION ${libpl} DESTINATION ${libpl}
) )
endif (Java_Development_FOUND AND JNI_FOUND) endif (Java_Development_FOUND)

1
packages/jpl/src/c/CMakeLists.txt
View File

@ -12,6 +12,7 @@ include_directories (${JAVA_INCLUDE_DIRS} ${JNI_INCLUDE_DIRS} )
# set(YAP_SYSTEM_OPTIONS "jpl " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) # set(YAP_SYSTEM_OPTIONS "jpl " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE)
install(TARGETS jplYap install(TARGETS jplYap
LIBRARY DESTINATION ${dlls} LIBRARY DESTINATION ${dlls}
ARCHIVE DESTINATION ${dlls}
) )

2
packages/jpl/src/c/jpl.c
View File

@ -48,9 +48,11 @@ refactoring (trivial):
#define JPL_C_LIB_VERSION_PATCH 4 #define JPL_C_LIB_VERSION_PATCH 4
#define JPL_C_LIB_VERSION_STATUS "alpha" #define JPL_C_LIB_VERSION_STATUS "alpha"
#if JPL_DEBUG
/*#define DEBUG(n, g) ((void)0) */ /*#define DEBUG(n, g) ((void)0) */
#define DEBUG_LEVEL 4 #define DEBUG_LEVEL 4
#define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 ) #define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 )
#endif
/* disable type-of-ref caching (at least until GC issues are resolved) */ /* disable type-of-ref caching (at least until GC issues are resolved) */
#define JPL_CACHE_TYPE_OF_REF FALSE #define JPL_CACHE_TYPE_OF_REF FALSE

2
packages/myddas/myddas_statistics.c
View File

@ -1,5 +1,7 @@
#include <stdlib.h> #include <stdlib.h>
#if HAVE_SYS_TIME_H
#include <sys/time.h> #include <sys/time.h>
#endif
#if defined MYDDAS_STATS #if defined MYDDAS_STATS

2
packages/swi-minisat2/C/Solver.h
View File

@ -264,7 +264,7 @@ inline bool Solver::okay () const { return ok; }
// Debug + etc: // Debug + etc:
#define reportf(format, args...) ( fflush(stdout), fprintf(stderr, format, ## args), fflush(stderr) ) #define reportf(...) ( fflush(stdout), fprintf(stderr, __VA_ARGS__), fflush(stderr) )
static inline void logLit(FILE* f, Lit l) static inline void logLit(FILE* f, Lit l)
{ {

3
pl/CMakeLists.txt
View File

@ -18,7 +18,6 @@ set(PL_SOURCES
directives.yap directives.yap
eam.yap eam.yap
eval.yap eval.yap
error.yap
errors.yap errors.yap
flags.yap flags.yap
grammar.yap grammar.yap
@ -26,6 +25,7 @@ set(PL_SOURCES
hacks.yap hacks.yap
init.yap init.yap
listing.yap listing.yap
lists.yap
load_foreign.yap load_foreign.yap
messages.yap messages.yap
meta.yap meta.yap
@ -48,6 +48,7 @@ set(PL_SOURCES
udi.yap udi.yap
undefined.yap undefined.yap
utils.yap utils.yap
history.pl
swi.yap swi.yap
yapor.yap yapor.yap
yio.yap yio.yap

7
pl/absf.yap
View File

@ -654,13 +654,6 @@ user:prolog_file_type(A, prolog) :-
A \== pl, A \== pl,
A \== yap. A \== yap.
user:prolog_file_type(qly, qly). user:prolog_file_type(qly, qly).
user:prolog_file_type(c, c).
user:prolog_file_type(h, c).
user:prolog_file_type(py, python).
user:prolog_file_type(r, 'R').
user:prolog_file_type(cc, 'c++').
user:prolog_file_type(hh, 'c++').
user:prolog_file_type(java, 'c++').
user:prolog_file_type(A, executable) :- user:prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A). current_prolog_flag(shared_object_extension, A).

8
pl/boot.yap
View File

@ -171,11 +171,7 @@ list, since backtracking could not "pass through" the cut.
*/ */
system_module(_Mod, _SysExps, _Decls) :- ! , system_module(_Mod, _SysExps, _Decls) :- ! .
source_module( prolog ), !.
system_module(_Mod, _SysExps, _Decls) :-
nb_setval('$if_skip_mode',skip).
% new_system_module(Mod). % new_system_module(Mod).
use_system_module(_init, _SysExps) :- !. use_system_module(_init, _SysExps) :- !.
@ -1421,8 +1417,8 @@ bootstrap(F) :-
!. !.
'$loop'(Stream,Status) :- '$loop'(Stream,Status) :-
% start_low_level_trace, % start_low_level_trace,
'$current_module'( OldModule ),
repeat, repeat,
source_module( OldModule ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status), '$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error, OldModule, Error,
user:'$LoopError'(Error, Status) user:'$LoopError'(Error, Status)

2
pl/consult.yap
View File

@ -708,7 +708,7 @@ db_files(Fs) :-
), ),
'$loop'(Stream,Reconsult), '$loop'(Stream,Reconsult),
'$lf_opt'(imports, TOpts, Imports), '$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, SourceModule, Imports, _, TOpts), '$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$current_module'(Mod, SourceModule), '$current_module'(Mod, SourceModule),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$early_print'(Verbosity, loaded(EndMsg, File, Mod, T, H)), '$early_print'(Verbosity, loaded(EndMsg, File, Mod, T, H)),

2
pl/corout.yap
View File

@ -26,9 +26,9 @@
* *
*/ */
:- op(1150, fx, prolog:block).
:- module('$coroutining',[ :- module('$coroutining',[
op(1150, fx, block)
%dif/2, %dif/2,
%when/2, %when/2,
%block/1, %block/1,

2
pl/init.yap
View File

@ -115,7 +115,7 @@ otherwise.
:- compile_expressions. :- compile_expressions.
:- bootstrap('../library/bootlists.yap'). :- bootstrap('lists.yap').
:- bootstrap('consult.yap'). :- bootstrap('consult.yap').
:- bootstrap('preddecls.yap'). :- bootstrap('preddecls.yap').
:- bootstrap('preddyns.yap'). :- bootstrap('preddyns.yap').

2
pl/messages.yap
View File

@ -213,7 +213,7 @@ compose_message(Term, Level) -->
main_message( Term, Level, LC ), main_message( Term, Level, LC ),
[nl,nl]. [nl,nl].
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)), _), _ ) --> location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_))), _ ) -->
!, !,
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0: ' - [FileName,LN] ] .
location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ ) --> location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ ) -->

151
pl/utils.yap
View File

@ -48,45 +48,37 @@ a postfix operator.
*/ */
op(P,T,V) :- op(P,T,V) :-
'$yap_strip_module'(V, M, N), '$check_op'(P,T,V,op(P,T,V)),
'$check_top_op'(P,T,N,M,op(P,T,V)). '$op'(P, T, V).
% just check the operator declarations for correctness. % just check the operator declarations for correctness.
'$check_top_op'(P,T,Op,_M,G) :- '$check_op'(P,T,Op,G) :-
( var(P) ; var(T); var(Op)), !, ( var(P) ; var(T); var(Op)), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_top_op'(P,_,_,_,G) :- '$check_op'(P,_,_,G) :-
\+ integer(P), !, \+ integer(P), !,
'$do_error'(type_error(integer,P),G). '$do_error'(type_error(integer,P),G).
'$check_top_op'(P,_,_,_,G) :- '$check_op'(P,_,_,G) :-
P < 0, !, P < 0, !,
'$do_error'(domain_error(operator_priority,P),G). '$do_error'(domain_error(operator_priority,P),G).
'$check_top_op'(_,T,_,_,G) :- '$check_op'(_,T,_,G) :-
\+ atom(T), !, \+ atom(T), !,
'$do_error'(type_error(atom,T),G). '$do_error'(type_error(atom,T),G).
'$check_top_op'(_,T,_,_,G) :- '$check_op'(_,T,_,G) :-
\+ '$associativity'(T), !, \+ '$associativity'(T), !,
'$do_error'(domain_error(operator_specifier,T),G). '$do_error'(domain_error(operator_specifier,T),G).
'$check_top_op'(P, T, M:Op, _M, G) :- !, '$check_op'(P,T,V,G) :-
'$vsc_strip_module'(M:Op, M1, Op1), '$check_module_for_op'(V, G, NV),
( '$check_top_op'(P, T, NV, G).
atom(M1)
-> '$check_top_op'(_, _, [], _) :- !.
'$check_top_op'(P, T, Op1, M1, G) '$check_top_op'(P, T, [Op|NV], G) :- !,
; '$check_ops'(P, T, Op.NV, G).
'$do_error'(type_error(atom,Op),G) '$check_top_op'(P, T, V, G) :-
). atom(V), !,
'$check_top_op'(P, T, [Op|NV], M, G) :- !, '$check_op_name'(P, T, V, G).
'$check_top_op'(P, T, Op, M, G), '$check_top_op'(_P, _T, V, G) :-
(NV = [] '$do_error'(type_error(atom,V),G).
->
true
;
'$check_top_op'(P, T, NV, M, G)
).
'$check_top_op'(P, T, V, M, G) :-
'$check_op_name'(P, T, V, M, G),
'$opdec'(P, T, V, M).
'$associativity'(xfx). '$associativity'(xfx).
'$associativity'(xfy). '$associativity'(xfy).
@ -97,16 +89,43 @@ a postfix operator.
'$associativity'(fx). '$associativity'(fx).
'$associativity'(fy). '$associativity'(fy).
'$check_op_name'(_,_,V,_,G) :- '$check_module_for_op'(MOp, G, _) :-
var(MOp), !,
'$do_error'(instantiation_error,G).
'$check_module_for_op'(M:_V, G, _) :-
var(M), !,
'$do_error'(instantiation_error,G).
'$check_module_for_op'(M:V, G, NV) :-
atom(M), !,
'$check_module_for_op'(V, G, NV).
'$check_module_for_op'(M:_V, G, _) :- !,
'$do_error'(type_error(atom,M),G).
'$check_module_for_op'(V, _G, V).
'$check_ops'(_P, _T, [], _G) :- !.
'$check_ops'(P, T, [Op|NV], G) :- !,
(
var(NV)
->
'$do_error'(instantiation_error,G)
;
'$check_module_for_op'(Op, G, NOp),
'$check_op_name'(P, T, NOp, G),
'$check_ops'(P, T, NV, G)
).
'$check_ops'(_P, _T, Ops, G) :-
'$do_error'(type_error(list,Ops),G).
'$check_op_name'(_,_,V,G) :-
var(V), !, var(V), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_op_name'(_,_,',',_,G) :- !, '$check_op_name'(_,_,',',G) :- !,
'$do_error'(permission_error(modify,operator,','),G). '$do_error'(permission_error(modify,operator,','),G).
'$check_op_name'(_,_,'[]',_,G) :- T \= yf, T\= xf, !, '$check_op_name'(_,_,'[]',G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'[]'),G). '$do_error'(permission_error(create,operator,'[]'),G).
'$check_op_name'(_,_,'{}',_,G) :- T \= yf, T\= xf, !, '$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'{}'),G). '$do_error'(permission_error(create,operator,'{}'),G).
'$check_op_name'(P,T,'|',_,G) :- '$check_op_name'(P,T,'|',G) :-
( (
integer(P), integer(P),
P < 1001, P > 0 P < 1001, P > 0
@ -114,31 +133,77 @@ a postfix operator.
atom_codes(T,[_,_]) atom_codes(T,[_,_])
), !, ), !,
'$do_error'(permission_error(create,operator,'|'),G). '$do_error'(permission_error(create,operator,'|'),G).
'$check_op_name'(P,T,A,M,_G) :- '$check_op_name'(_,_,V,_) :-
atom(A), !, atom(V), !.
'$opdec'( P, T, A, M). '$check_op_name'(_,_,A,G) :-
'$check_op_name'(_,_,A,_,G) :-
'$do_error'(type_error(atom,A),G). '$do_error'(type_error(atom,A),G).
'$op'(P, T, ML) :-
strip_module(ML, M, [A|As]), !,
'$opl'(P, T, M, [A|As]).
'$op'(P, T, A) :-
'$op2'(P,T,A).
'$opl'(_P, _T, _, []).
'$opl'(P, T, M, [A|As]) :-
'$op2'(P, T, M:A),
'$opl'(P, T, M, As).
'$op2'(P,T,A) :-
atom(A), !,
'$opdec'(P,T,A,prolog).
'$op2'(P,T,A) :-
strip_module(A,M,N),
'$opdec'(P,T,N,M).
/** @pred current_op( _P_, _T_, _F_) is iso /** @pred current_op( _P_, _T_, _F_) is iso
Defines the relation: _P_ is a currently defined operator of type Defines the relation: _P_ is a currently defined operator of type
b*c _T_ and precedence _P_. Returns only operators defined in current module. _T_ and precedence _P_.
*/ */
current_op(X,Y,V) :- current_op(X,Y,V) :- var(V), !,
'$yap_strip_module'(V,M,O), '$current_module'(M),
'$do_current_op'(X, Y, O, M). '$do_current_op'(X,Y,V,M).
current_op(X,Y,M:Z) :- !,
'$current_opm'(X,Y,Z,M).
current_op(X,Y,Z) :-
'$current_module'(M),
'$do_current_op'(X,Y,Z,M).
'$do_current_op'(X,Y,Z, M) :-
'$current_opm'(X,Y,Z,M) :-
nonvar(Y),
\+ '$associativity'(Y),
'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
'$current_opm'(X,Y,Z,M) :-
var(Z), !,
'$do_current_op'(X,Y,Z,M).
'$current_opm'(X,Y,M:Z,_) :- !,
'$current_opm'(X,Y,Z,M).
'$current_opm'(X,Y,Z,M) :-
'$do_current_op'(X,Y,Z,M).
'$do_current_op'(X,Y,Z,M) :-
nonvar(Y), nonvar(Y),
\+ '$associativity'(Y), \+ '$associativity'(Y),
'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)). '$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
'$do_current_op'(X,Y,Z,M) :- '$do_current_op'(X,Y,Z,M) :-
'$current_op'(Z, M, Prefix, Infix, Posfix), atom(Z), !,
'$current_atom_op'(Z, M1, Prefix, Infix, Posfix),
( M1 = prolog -> true ; M1 = M ),
(
'$get_prefix'(Prefix, X, Y)
;
'$get_infix'(Infix, X, Y)
;
'$get_posfix'(Posfix, X, Y)
).
'$do_current_op'(X,Y,Z,M) :-
'$current_op'(Z, M1, Prefix, Infix, Posfix),
( M1 = prolog -> true ; M1 = M ),
( (
'$get_prefix'(Prefix, X, Y) '$get_prefix'(Prefix, X, Y)
; ;

5
utf8proc/utf8proc.h
View File

@ -83,7 +83,7 @@ typedef short utf8proc_int16_t;
typedef unsigned short utf8proc_uint16_t; typedef unsigned short utf8proc_uint16_t;
typedef int utf8proc_int32_t; typedef int utf8proc_int32_t;
typedef unsigned int utf8proc_uint32_t; typedef unsigned int utf8proc_uint32_t;
# ifdef _WIN64 # ifdef _WIN64
typedef __int64 utf8proc_ssize_t; typedef __int64 utf8proc_ssize_t;
typedef unsigned __int64 utf8proc_size_t; typedef unsigned __int64 utf8proc_size_t;
# else # else
@ -92,7 +92,8 @@ typedef unsigned int utf8proc_size_t;
# endif # endif
# ifndef __cplusplus # ifndef __cplusplus
typedef unsigned char utf8proc_bool; typedef unsigned char utf8proc_bool;
enum {false, true}; #define false 0
#define true 1
# else # else
typedef bool utf8proc_bool; typedef bool utf8proc_bool;
# endif # endif