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

Merge /Users/vsc/tmp/yap-6.3w

Browse Source
This commit is contained in:
Vítor Santos Costa 2016-02-28 19:43:26 +00:00
commit 0ccee1aa55
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 */

58
C/adtdefs.c
View File

@ -562,60 +562,60 @@ 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;
} }
} }
/* 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; return info;
} }
return NULL; }
} if (oinfo) {
READ_LOCK(oinfo->OpRWLock);
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 oinfo;
} }
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
return NULL; return NULL;
} }

1306
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;

2
C/flags.c
View File

@ -1019,7 +1019,7 @@ Term Yap_UnknownFlag(Term mod) {
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)

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;
} }

111
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;
@ -513,7 +525,7 @@ 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;

21
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

14
library/matrix.yap
View File

@ -30,13 +30,7 @@
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.

3
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

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

342
os/iopreds.c
View File

@ -96,6 +96,7 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#include "iopreds.h" #include "iopreds.h"
#define GETW get_wchar_from_FILE #define GETW get_wchar_from_FILE
#define GETC() fgetwc(st->file) #define GETC() fgetwc(st->file)
#include "getw.h" #include "getw.h"
@ -195,9 +196,6 @@ void Yap_DefaultStreamOps(StreamDesc *st) {
if (st->status & (Promptable_Stream_f)) { if (st->status & (Promptable_Stream_f)) {
st->stream_wgetc = get_wchar; st->stream_wgetc = get_wchar;
Yap_ConsoleOps(st, true); Yap_ConsoleOps(st, true);
} else if (st->status & (InMemory_Stream_f)) {
st->stream_wgetc = get_wchar;
Yap_ConsoleOps(st, true);
} else if (st->encoding == LOCAL_encoding) { } else if (st->encoding == LOCAL_encoding) {
st->stream_wgetc = get_wchar_from_file; st->stream_wgetc = get_wchar_from_file;
} else } else
@ -224,8 +222,8 @@ static void unix_upd_stream_info(StreamDesc *s) {
} }
#if _MSC_VER #if _MSC_VER
/* standard error stream should never be buffered */ /* standard error stream should never be buffered */
else if (StdErrStream == s - Stream) { else if (StdErrStream == s - GLOBAL_Stream) {
setvbuf(s->u.file.file, NULL, _IONBF, 0); setvbuf(s->file, NULL, _IONBF, 0);
} }
#endif #endif
s->status |= Seekable_Stream_f; s->status |= Seekable_Stream_f;
@ -268,6 +266,7 @@ static void unix_upd_stream_info(StreamDesc *s) {
s->status |= Seekable_Stream_f; s->status |= Seekable_Stream_f;
} }
static void InitFileIO(StreamDesc *s) { static void InitFileIO(StreamDesc *s) {
CACHE_REGS CACHE_REGS
if (s->status & Socket_Stream_f) { if (s->status & Socket_Stream_f) {
@ -645,7 +644,7 @@ int console_post_process_eof(StreamDesc *s) {
} }
/* check if we read a newline or an EOF */ /* check if we read a newline or an EOF */
int post_process_read_wchar(int ch, ssize_t n, StreamDesc *s) { int post_process_read_wchar(int ch, size_t n, StreamDesc *s) {
if (ch == EOF) { if (ch == EOF) {
return post_process_weof(s); return post_process_weof(s);
} }
@ -661,6 +660,7 @@ int post_process_read_wchar(int ch, ssize_t n, StreamDesc *s) {
return ch; return ch;
} }
int post_process_weof(StreamDesc *s) { int post_process_weof(StreamDesc *s) {
if (!ResetEOF(s)) { if (!ResetEOF(s)) {
s->status |= Eof_Stream_f; s->status |= Eof_Stream_f;
@ -692,18 +692,19 @@ int PlGetc(int sno) {
return fgetc(s->file); return fgetc(s->file);
} }
// layered version
static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); }
static int get_wchar_from_file(int sno) { // layered version
static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); }
static int get_wchar_from_file(int sno) {
return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno); return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno);
} }
#ifndef MB_LEN_MAX #ifndef MB_LEN_MAX
#define MB_LEN_MAX 6 #define MB_LEN_MAX 6
#endif #endif
static int handle_write_encoding_error(int sno, wchar_t ch) { static int handle_write_encoding_error(int sno, wchar_t ch) {
if (GLOBAL_Stream[sno].status & RepError_Xml_f) { if (GLOBAL_Stream[sno].status & RepError_Xml_f) {
/* use HTML/XML encoding in ASCII */ /* use HTML/XML encoding in ASCII */
int i = ch, digits = 1; int i = ch, digits = 1;
@ -736,9 +737,9 @@ static int handle_write_encoding_error(int sno, wchar_t ch) {
(unsigned long int)ch, sno); (unsigned long int)ch, sno);
return -1; return -1;
} }
} }
int put_wchar(int sno, wchar_t ch) { int put_wchar(int sno, wchar_t ch) {
/* pass the bucck if we can */ /* pass the bucck if we can */
switch (GLOBAL_Stream[sno].encoding) { switch (GLOBAL_Stream[sno].encoding) {
case ENC_OCTET: case ENC_OCTET:
@ -792,7 +793,8 @@ int put_wchar(int sno, wchar_t ch) {
} }
return ch; return ch;
break; break;
case ENC_UTF16_LE: { case ENC_UTF16_LE:
{
if (ch < 0x10000) { if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff));
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -809,7 +811,8 @@ int put_wchar(int sno, wchar_t ch) {
} }
return ch; return ch;
} }
case ENC_UTF16_BE: { case ENC_UTF16_BE:
{
// computations // computations
if (ch < 0x10000) { if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -822,10 +825,12 @@ int put_wchar(int sno, wchar_t ch) {
GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff));
GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8));
GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff));
} }
return ch; return ch;
} }
case ENC_UCS2_LE: { case ENC_UCS2_LE:
{
if (ch >= 0x10000) { if (ch >= 0x10000) {
return 0; return 0;
} }
@ -833,7 +838,8 @@ int put_wchar(int sno, wchar_t ch) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
return ch; return ch;
} }
case ENC_UCS2_BE: { case ENC_UCS2_BE:
{
// computations // computations
if (ch < 0x10000) { if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -859,34 +865,34 @@ int put_wchar(int sno, wchar_t ch) {
} }
} }
return -1; return -1;
} }
/* used by user-code to read characters from the current input stream */ /* used by user-code to read characters from the current input stream */
int Yap_PlGetchar(void) { int Yap_PlGetchar(void) {
CACHE_REGS CACHE_REGS
return ( return (GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(
GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(LOCAL_c_input_stream)); LOCAL_c_input_stream));
} }
int Yap_PlGetWchar(void) { int Yap_PlGetWchar(void) {
CACHE_REGS CACHE_REGS
return get_wchar(LOCAL_c_input_stream); return get_wchar(LOCAL_c_input_stream);
} }
/* avoid using a variable to call a function */ /* avoid using a variable to call a function */
int Yap_PlFGetchar(void) { int Yap_PlFGetchar(void) {
CACHE_REGS CACHE_REGS
return (PlGetc(LOCAL_c_input_stream)); return (PlGetc(LOCAL_c_input_stream));
} }
Term Yap_MkStream(int n) { Term Yap_MkStream(int n) {
Term t[1]; Term t[1];
t[0] = MkIntTerm(n); t[0] = MkIntTerm(n);
return (Yap_MkApplTerm(FunctorStream, 1, t)); return (Yap_MkApplTerm(FunctorStream, 1, t));
} }
/* given a stream index, get the corresponding fd */ /* given a stream index, get the corresponding fd */
Int GetStreamFd(int sno) { Int GetStreamFd(int sno) {
#if HAVE_SOCKET #if HAVE_SOCKET
if (GLOBAL_Stream[sno].status & Socket_Stream_f) { if (GLOBAL_Stream[sno].status & Socket_Stream_f) {
return (GLOBAL_Stream[sno].u.socket.fd); return (GLOBAL_Stream[sno].u.socket.fd);
@ -898,11 +904,11 @@ Int GetStreamFd(int sno) {
return (-1); return (-1);
} }
return (fileno(GLOBAL_Stream[sno].file)); return (fileno(GLOBAL_Stream[sno].file));
} }
Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); } Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); }
static int binary_file(const char *file_name) { static int binary_file(const char *file_name) {
#if HAVE_STAT #if HAVE_STAT
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
struct _stat ss; struct _stat ss;
@ -919,9 +925,9 @@ static int binary_file(const char *file_name) {
#else #else
return (FALSE); return (FALSE);
#endif #endif
} }
static int write_bom(int sno, StreamDesc *st) { static int write_bom(int sno, StreamDesc *st) {
/* dump encoding */ /* dump encoding */
switch (st->encoding) { switch (st->encoding) {
case ENC_ISO_UTF8: case ENC_ISO_UTF8:
@ -974,9 +980,9 @@ static int write_bom(int sno, StreamDesc *st) {
default: default:
return true; return true;
} }
} }
static void check_bom(int sno, StreamDesc *st) { static void check_bom(int sno, StreamDesc *st) {
int ch1, ch2, ch3, ch4; int ch1, ch2, ch3, ch4;
ch1 = fgetc(st->file); ch1 = fgetc(st->file);
@ -1070,10 +1076,11 @@ static void check_bom(int sno, StreamDesc *st) {
default: default:
ungetc(ch1, st->file); ungetc(ch1, st->file);
} }
} }
bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags, Atom open_mode) { encoding_t encoding, stream_flags_t flags,
Atom open_mode) {
StreamDesc *st = &GLOBAL_Stream[sno]; StreamDesc *st = &GLOBAL_Stream[sno];
st->status = flags; st->status = flags;
@ -1107,9 +1114,9 @@ bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
Yap_DefaultStreamOps(st); Yap_DefaultStreamOps(st);
} }
return true; return true;
} }
static bool open_header(int sno, Atom open_mode) { static bool open_header(int sno, Atom open_mode) {
if (open_mode == AtomWrite) { if (open_mode == AtomWrite) {
const char *ptr; const char *ptr;
const char s[] = "#!"; const char s[] = "#!";
@ -1136,7 +1143,7 @@ static bool open_header(int sno, Atom open_mode) {
} }
} }
return true; return true;
} }
#define OPEN_DEFS() \ #define OPEN_DEFS() \
PAR("alias", isatom, OPEN_ALIAS), PAR("bom", booleanFlag, OPEN_BOM), \ PAR("alias", isatom, OPEN_ALIAS), PAR("bom", booleanFlag, OPEN_BOM), \
@ -1155,18 +1162,18 @@ static bool open_header(int sno, Atom open_mode) {
PAR("wait", booleanFlag, OPEN_WAIT), PAR(NULL, ok, OPEN_END) PAR("wait", booleanFlag, OPEN_WAIT), PAR(NULL, ok, OPEN_END)
#define PAR(x, y, z) z #define PAR(x, y, z) z
typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t; typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t;
#undef PAR #undef PAR
#define PAR(x, y, z) \ #define PAR(x, y, z) \
{ x, y, z } { x, y, z }
static const param_t open_defs[] = {OPEN_DEFS()}; static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR #undef PAR
static Int static Int do_open(
do_open(Term file_name, Term t2, Term file_name, Term t2,
Term tlist USES_REGS) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ Term tlist USES_REGS) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
Atom open_mode; Atom open_mode;
int sno; int sno;
@ -1256,7 +1263,7 @@ do_open(Term file_name, Term t2,
s_encoding = "default"; s_encoding = "default";
} }
// default encoding, no bom yet // default encoding, no bom yet
encoding = enc_id(s_encoding, ENC_OCTET); encoding = enc_id( s_encoding, ENC_OCTET);
// only set encoding after getting BOM // only set encoding after getting BOM
bool ok = (args[OPEN_EXPAND_FILENAME].used bool ok = (args[OPEN_EXPAND_FILENAME].used
? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue ? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue
@ -1272,7 +1279,8 @@ do_open(Term file_name, Term t2,
// Skip scripts that start with !#/.. or similar // Skip scripts that start with !#/.. or similar
bool script = bool script =
(args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue : false); (args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue
: false);
// binary type // binary type
if (args[OPEN_TYPE].used) { if (args[OPEN_TYPE].used) {
Term t = args[OPEN_TYPE].tvalue; Term t = args[OPEN_TYPE].tvalue;
@ -1320,11 +1328,11 @@ do_open(Term file_name, Term t2,
fname = LOCAL_FileNameBuf; fname = LOCAL_FileNameBuf;
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
if (errno == ENOENT) if (errno == ENOENT)
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname, return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s",
strerror(errno)));
else {
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s",
fname, strerror(errno))); fname, strerror(errno)));
else {
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name,
"%s: %s", fname, strerror(errno)));
} }
} }
#if MAC #if MAC
@ -1333,9 +1341,11 @@ do_open(Term file_name, Term t2,
} }
#endif #endif
flags &= ~(Free_Stream_f); flags &= ~(Free_Stream_f);
if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode)) if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags,
open_mode))
return false; return false;
if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode)) if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags,
open_mode))
return false; return false;
if (open_mode == AtomWrite) { if (open_mode == AtomWrite) {
if (needs_bom && !write_bom(sno, st)) if (needs_bom && !write_bom(sno, st))
@ -1345,10 +1355,10 @@ do_open(Term file_name, Term t2,
} }
// follow declaration unless there is v // follow declaration unless there is v
if (st->status & HAS_BOM_f) if (st->status & HAS_BOM_f)
st->encoding = enc_id(s_encoding, st->encoding); st->encoding = enc_id( s_encoding, st->encoding);
else else
st->encoding = encoding; st->encoding = encoding;
Yap_DefaultStreamOps(st); Yap_DefaultStreamOps( st);
if (script) if (script)
open_header(sno, open_mode); open_header(sno, open_mode);
@ -1357,101 +1367,102 @@ do_open(Term file_name, Term t2,
Term t = Yap_MkStream(sno); Term t = Yap_MkStream(sno);
return (Yap_unify(ARG3, t)); return (Yap_unify(ARG3, t));
} }
} }
/** @pred open(+ _F_,+ _M_,- _S_) is iso /** @pred open(+ _F_,+ _M_,- _S_) is iso
Opens the file with name _F_ in mode _M_ (`read`, `write` or Opens the file with name _F_ in mode _M_ (`read`, `write` or
`append`), returning _S_ unified with the stream name. `append`), returning _S_ unified with the stream name.
Yap allows 64 streams opened at the same time. If you need more, Yap allows 64 streams opened at the same time. If you need more,
redefine the MaxStreams constant. Each stream is either an input or redefine the MaxStreams constant. Each stream is either an input or
an output stream but not both. There are always 3 open streams: an output stream but not both. There are always 3 open streams:
user_input for reading, user_output for writing and user_error for user_input for reading, user_output for writing and user_error for
writing. If there is no ambiguity, the atoms user_input and writing. If there is no ambiguity, the atoms user_input and
user_output may be referred to as `user`. user_output may be referred to as `user`.
The `file_errors` flag controls whether errors are reported when in The `file_errors` flag controls whether errors are reported when in
mode `read` or `append` the file _F_ does not exist or is not mode `read` or `append` the file _F_ does not exist or is not
readable, and whether in mode `write` or `append` the file is not readable, and whether in mode `write` or `append` the file is not
writable. writable.
*/ */
static Int open3(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ static Int open3(
USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS);
} }
/** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso /** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso
Opens the file with name _F_ in mode _M_ (`read`, `write` or Opens the file with name _F_ in mode _M_ (`read`, `write` or
`append`), returning _S_ unified with the stream name, and following `append`), returning _S_ unified with the stream name, and following
these options: these options:
+ `type(+ _T_)` is iso + `type(+ _T_)` is iso
Specify whether the stream is a `text` stream (default), or a Specify whether the stream is a `text` stream (default), or a
`binary` stream. `binary` stream.
+ `reposition(+ _Bool_)` is iso + `reposition(+ _Bool_)` is iso
Specify whether it is possible to reposition the stream (`true`), or Specify whether it is possible to reposition the stream (`true`), or
not (`false`). By default, YAP enables repositioning for all not (`false`). By default, YAP enables repositioning for all
files, except terminal files and sockets. files, except terminal files and sockets.
+ `eof(+ _Action_)` is iso + `eof(+ _Action_)` is iso
Specify the action to take if attempting to input characters from a Specify the action to take if attempting to input characters from a
stream where we have previously found an `end_of_file`. The possible stream where we have previously found an `end_of_file`. The possible
actions are `error`, that raises an error, `reset`, that tries to actions are `error`, that raises an error, `reset`, that tries to
reset the stream and is used for `tty` type files, and `eof_code`, reset the stream and is used for `tty` type files, and `eof_code`,
which generates a new `end_of_file` (default for non-tty files). which generates a new `end_of_file` (default for non-tty files).
+ `alias(+ _Name_)` is iso + `alias(+ _Name_)` is iso
Specify an alias to the stream. The alias <tt>Name</tt> must be an atom. Specify an alias to the stream. The alias <tt>Name</tt> must be an atom.
The The
alias can be used instead of the stream descriptor for every operation alias can be used instead of the stream descriptor for every operation
concerning the stream. concerning the stream.
The operation will fail and give an error if the alias name is already The operation will fail and give an error if the alias name is already
in use. YAP allows several aliases for the same file, but only in use. YAP allows several aliases for the same file, but only
one is returned by stream_property/2 one is returned by stream_property/2
+ `bom(+ _Bool_)` + `bom(+ _Bool_)`
If present and `true`, a BOM (<em>Byte Order Mark</em>) was If present and `true`, a BOM (<em>Byte Order Mark</em>) was
detected while opening the file for reading or a BOM was written while detected while opening the file for reading or a BOM was written while
opening the stream. See BOM for details. opening the stream. See BOM for details.
+ `encoding(+ _Encoding_)` + `encoding(+ _Encoding_)`
Set the encoding used for text. See Encoding for an overview of Set the encoding used for text. See Encoding for an overview of
wide character and encoding issues. wide character and encoding issues.
+ `representation_errors(+ _Mode_)` + `representation_errors(+ _Mode_)`
Change the behaviour when writing characters to the stream that cannot Change the behaviour when writing characters to the stream that cannot
be represented by the encoding. The behaviour is one of `error` be represented by the encoding. The behaviour is one of `error`
(throw and Input/Output error exception), `prolog` (write `\u...\` (throw and Input/Output error exception), `prolog` (write `\u...\`
escape code or `xml` (write `\&#...;` XML character entity). escape code or `xml` (write `\&#...;` XML character entity).
The initial mode is `prolog` for the user streams and The initial mode is `prolog` for the user streams and
`error` for all other streams. See also Encoding. `error` for all other streams. See also Encoding.
+ `expand_filename(+ _Mode_)` + `expand_filename(+ _Mode_)`
If _Mode_ is `true` then do filename expansion, then ask Prolog If _Mode_ is `true` then do filename expansion, then ask Prolog
to do file name expansion before actually trying to opening the file: to do file name expansion before actually trying to opening the file:
this includes processing `~` characters and processing `$` this includes processing `~` characters and processing `$`
environment variables at the beginning of the file. Otherwise, just try environment variables at the beginning of the file. Otherwise, just try
to open the file using the given name. to open the file using the given name.
The default behavior is given by the Prolog flag The default behavior is given by the Prolog flag
open_expands_filename. open_expands_filename.
+ `script( + _Boolean_ )` YAP extension. + `script( + _Boolean_ )` YAP extension.
The file may be a Prolog script. In `read` mode just check for The file may be a Prolog script. In `read` mode just check for
initial lines if they start with the hash symbol, and skip them. In initial lines if they start with the hash symbol, and skip them. In
@ -1460,12 +1471,14 @@ open_expands_filename.
permissions as executable. In `append` mode ignore the flag. permissions as executable. In `append` mode ignore the flag.
*/ */
static Int open4(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ static Int open4(
USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS); return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS);
} }
static Int p_file_expansion(USES_REGS1) { /* '$file_expansion'(+File,-Name) */ static Int p_file_expansion(
USES_REGS1) { /* '$file_expansion'(+File,-Name) */
Term file_name = Deref(ARG1); Term file_name = Deref(ARG1);
/* we know file_name is bound */ /* we know file_name is bound */
@ -1478,9 +1491,9 @@ static Int p_file_expansion(USES_REGS1) { /* '$file_expansion'(+File,-Name) */
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name,
"absolute_file_name/3")); "absolute_file_name/3"));
return (Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))); return (Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))));
} }
static Int p_open_null_stream(USES_REGS1) { static Int p_open_null_stream(USES_REGS1) {
Term t; Term t;
StreamDesc *st; StreamDesc *st;
int sno = GetFreeStreamD(); int sno = GetFreeStreamD();
@ -1511,9 +1524,9 @@ static Int p_open_null_stream(USES_REGS1) {
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
t = Yap_MkStream(sno); t = Yap_MkStream(sno);
return (Yap_unify(ARG1, t)); return (Yap_unify(ARG1, t));
} }
int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) { int Yap_OpenStream(FILE * fd, char *name, Term file_name, int flags) {
CACHE_REGS CACHE_REGS
int sno; int sno;
Atom at; Atom at;
@ -1531,13 +1544,13 @@ int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) {
at = AtomRead; at = AtomRead;
Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at); Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at);
return sno; return sno;
} }
#define CheckStream(arg, kind, msg) \ #define CheckStream(arg, kind, msg) \
CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
static int CheckStream__(const char *file, const char *f, int line, Term arg, static int CheckStream__(const char *file, const char *f, int line,
int kind, const char *msg) { Term arg, int kind, const char *msg) {
int sno = -1; int sno = -1;
arg = Deref(arg); arg = Deref(arg);
if (IsVarTerm(arg)) { if (IsVarTerm(arg)) {
@ -1592,15 +1605,15 @@ static int CheckStream__(const char *file, const char *f, int line, Term arg,
PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg); PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg);
} }
return (sno); return (sno);
} }
int Yap_CheckStream__(const char *file, const char *f, int line, Term arg, int Yap_CheckStream__(const char *file, const char *f, int line, Term arg,
int kind, const char *msg) { int kind, const char *msg) {
return CheckStream__(file, f, line, arg, kind, msg); return CheckStream__(file, f, line, arg, kind, msg);
} }
int Yap_CheckTextStream__(const char *file, const char *f, int line, Term arg, int Yap_CheckTextStream__(const char *file, const char *f, int line,
int kind, const char *msg) { Term arg, int kind, const char *msg) {
int sno; int sno;
if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0) if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0)
return -1; return -1;
@ -1615,10 +1628,10 @@ int Yap_CheckTextStream__(const char *file, const char *f, int line, Term arg,
return -1; return -1;
} }
return sno; return sno;
} }
/* used from C-interface */ /* used from C-interface */
int Yap_GetFreeStreamDForReading(void) { int Yap_GetFreeStreamDForReading(void) {
int sno = GetFreeStreamD(); int sno = GetFreeStreamD();
StreamDesc *s; StreamDesc *s;
@ -1632,16 +1645,16 @@ int Yap_GetFreeStreamDForReading(void) {
Yap_DefaultStreamOps(s); Yap_DefaultStreamOps(s);
UNLOCK(s->streamlock); UNLOCK(s->streamlock);
return sno; return sno;
} }
/** /**
* @pred always_prompt_user * @pred always_prompt_user
* *
* Ensure that the stream always prompts before asking the standard input * Ensure that the stream always prompts before asking the standard input
stream for data. stream for data.
*/ */
static Int always_prompt_user(USES_REGS1) { static Int always_prompt_user(USES_REGS1) {
StreamDesc *s = GLOBAL_Stream + StdInStream; StreamDesc *s = GLOBAL_Stream + StdInStream;
s->status |= Promptable_Stream_f; s->status |= Promptable_Stream_f;
@ -1655,9 +1668,9 @@ static Int always_prompt_user(USES_REGS1) {
} else } else
Yap_ConsoleOps(s, false); Yap_ConsoleOps(s, false);
return (TRUE); return (TRUE);
} }
static Int close1 /** @pred close(+ _S_) is iso static Int close1 /** @pred close(+ _S_) is iso
Closes the stream _S_. If _S_ does not stand for a stream Closes the stream _S_. If _S_ does not stand for a stream
@ -1669,7 +1682,8 @@ static Int close1 /** @pred close(+ _S_) is iso
(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ (USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream( Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f),
"close/2");
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
if (sno <= StdErrStream) { if (sno <= StdErrStream) {
@ -1679,35 +1693,36 @@ static Int close1 /** @pred close(+ _S_) is iso
Yap_CloseStream(sno); Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
} }
#define CLOSE_DEFS() \ #define CLOSE_DEFS() \
PAR("force", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END) PAR("force", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END)
#define PAR(x, y, z) z #define PAR(x, y, z) z
typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t; typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t;
#undef PAR #undef PAR
#define PAR(x, y, z) \ #define PAR(x, y, z) \
{ x, y, z } { x, y, z }
static const param_t close_defs[] = {CLOSE_DEFS()}; static const param_t close_defs[] = {CLOSE_DEFS()};
#undef PAR #undef PAR
/** @pred close(+ _S_,+ _O_) is iso /** @pred close(+ _S_,+ _O_) is iso
Closes the stream _S_, following options _O_. Closes the stream _S_, following options _O_.
The only valid options are `force(true)` and `force(false)`. The only valid options are `force(true)` and `force(false)`.
YAP currently ignores these options. YAP currently ignores these options.
*/ */
static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream( Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f),
"close/2");
Term tlist; Term tlist;
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
@ -1731,9 +1746,9 @@ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Yap_CloseStream(sno); Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
} }
Term read_line(int sno) { Term read_line(int sno) {
CACHE_REGS CACHE_REGS
Term tail; Term tail;
Int ch; Int ch;
@ -1743,7 +1758,7 @@ Term read_line(int sno) {
} }
tail = read_line(sno); tail = read_line(sno);
return (MkPairTerm(MkIntTerm(ch), tail)); return (MkPairTerm(MkIntTerm(ch), tail));
} }
#define ABSOLUTE_FILE_NAME_DEFS() \ #define ABSOLUTE_FILE_NAME_DEFS() \
PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \
@ -1760,20 +1775,20 @@ Term read_line(int sno) {
#define PAR(x, y, z) z #define PAR(x, y, z) z
typedef enum ABSOLUTE_FILE_NAME_enum_ { typedef enum ABSOLUTE_FILE_NAME_enum_ {
ABSOLUTE_FILE_NAME_DEFS() ABSOLUTE_FILE_NAME_DEFS()
} absolute_file_name_choices_t; } absolute_file_name_choices_t;
#undef PAR #undef PAR
#define PAR(x, y, z) \ #define PAR(x, y, z) \
{ x, y, z } { x, y, z }
static const param_t absolute_file_name_search_defs[] = { static const param_t absolute_file_name_search_defs[] = {
ABSOLUTE_FILE_NAME_DEFS()}; ABSOLUTE_FILE_NAME_DEFS()};
#undef PAR #undef PAR
static Int abs_file_parameters(USES_REGS1) { static Int abs_file_parameters(USES_REGS1) {
Term t[ABSOLUTE_FILE_NAME_END]; Term t[ABSOLUTE_FILE_NAME_END];
Term tlist = Deref(ARG1), tf; Term tlist = Deref(ARG1), tf;
/* get options */ /* get options */
@ -1801,7 +1816,8 @@ static Int abs_file_parameters(USES_REGS1) {
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(TermDot); t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(TermDot);
} }
if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used)
t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; t[ABSOLUTE_FILE_NAME_FILE_TYPE] =
args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue;
else else
t[ABSOLUTE_FILE_NAME_FILE_TYPE] = TermTxt; t[ABSOLUTE_FILE_NAME_FILE_TYPE] = TermTxt;
if (args[ABSOLUTE_FILE_NAME_ACCESS].used) if (args[ABSOLUTE_FILE_NAME_ACCESS].used)
@ -1814,7 +1830,8 @@ static Int abs_file_parameters(USES_REGS1) {
else else
t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = TermError; t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = TermError;
if (args[ABSOLUTE_FILE_NAME_SOLUTIONS].used) if (args[ABSOLUTE_FILE_NAME_SOLUTIONS].used)
t[ABSOLUTE_FILE_NAME_SOLUTIONS] = args[ABSOLUTE_FILE_NAME_SOLUTIONS].tvalue; t[ABSOLUTE_FILE_NAME_SOLUTIONS] =
args[ABSOLUTE_FILE_NAME_SOLUTIONS].tvalue;
else else
t[ABSOLUTE_FILE_NAME_SOLUTIONS] = TermFirst; t[ABSOLUTE_FILE_NAME_SOLUTIONS] = TermFirst;
if (args[ABSOLUTE_FILE_NAME_EXPAND].used) if (args[ABSOLUTE_FILE_NAME_EXPAND].used)
@ -1831,13 +1848,14 @@ static Int abs_file_parameters(USES_REGS1) {
args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue; args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue;
else else
t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] =
(trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue : TermFalse); (trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue
: TermFalse);
tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt, ABSOLUTE_FILE_NAME_END), tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt, ABSOLUTE_FILE_NAME_END),
ABSOLUTE_FILE_NAME_END, t); ABSOLUTE_FILE_NAME_END, t);
return (Yap_unify(ARG2, tf)); return (Yap_unify(ARG2, tf));
} }
static Int get_abs_file_parameter(USES_REGS1) { static Int get_abs_file_parameter(USES_REGS1) {
Term t = Deref(ARG1), topts = ARG2; Term t = Deref(ARG1), topts = ARG2;
/* get options */ /* get options */
/* done */ /* done */
@ -1847,9 +1865,9 @@ static Int get_abs_file_parameter(USES_REGS1) {
return Yap_unify(ARG3, ArgOfTerm(i + 1, topts)); return Yap_unify(ARG3, ArgOfTerm(i + 1, topts));
Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL); Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL);
return false; return false;
} }
void Yap_InitPlIO(void) { void Yap_InitPlIO(void) {
Int i; Int i;
Yap_stdin = stdin; Yap_stdin = stdin;
@ -1862,9 +1880,9 @@ void Yap_InitPlIO(void) {
GLOBAL_Stream[i].status = Free_Stream_f; GLOBAL_Stream[i].status = Free_Stream_f;
} }
InitStdStreams(); InitStdStreams();
} }
void Yap_InitIOPreds(void) { void Yap_InitIOPreds(void) {
/* here the Input/Output predicates */ /* here the Input/Output predicates */
Yap_InitCPred("always_prompt_user", 0, always_prompt_user, Yap_InitCPred("always_prompt_user", 0, always_prompt_user,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
@ -1899,4 +1917,4 @@ void Yap_InitIOPreds(void) {
Yap_InitSignalPreds(); Yap_InitSignalPreds();
Yap_InitSysPreds(); Yap_InitSysPreds();
Yap_InitTimePreds(); Yap_InitTimePreds();
} }

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

10
os/mem.c
View File

@ -1,4 +1,4 @@
/*************************************************************************post/////85 /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
@ -74,7 +74,7 @@ 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;
@ -82,8 +82,9 @@ MemGetc (int sno)
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 { }
else {
ch = s->u.mem_string.buf[spos]; ch = s->u.mem_string.buf[spos];
s->u.mem_string.pos = ++spos; s->u.mem_string.pos = ++spos;
} }
@ -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

176
os/readutil.c
View File

@ -28,9 +28,12 @@ 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;
@ -42,13 +45,13 @@ 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) {
@ -56,37 +59,37 @@ static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
} }
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);
} }
@ -94,14 +97,14 @@ static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
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);
@ -110,88 +113,88 @@ static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
} }
} }
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;
}
pt += put_utf8(pt, ch);
if (pt + 4 == buf + buf_sz)
break; break;
} while (ch != '\n'); } while (ch != '\n');
sz = pt - buf; 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);
@ -200,9 +203,10 @@ static Int read_line_to_string(USES_REGS1) {
} }
} }
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,16 +278,18 @@ 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
Yap_InitReadUtil(void)
{
CACHE_REGS CACHE_REGS
Term cm = CurrentModule; Term cm = CurrentModule;
@ -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;

8
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)) {
#if _MSC_VER
_pclose(GLOBAL_Stream[sno].file);
#else
pclose(GLOBAL_Stream[sno].file); 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

57
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);
@ -593,19 +598,18 @@ static const char *myrealpath( const char *path, char *out)
} }
} }
} }
#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
@ -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;
@ -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, out) ) ) { if ((p = myrealpath(rc) ) ) {
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;
@ -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;
@ -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;
} }
@ -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 );

167
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;
}
void gettimeofday(&tp, NULL);
Yap_InitLastWTime(void) { Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeval));
LastWTime.tv_usec = StartOfWTimes.tv_usec;
LastWTime.tv_sec = StartOfWTimes.tv_sec;
} }
Int /// returns time in nano-secs since the epoch
Yap_walltime (void) uint64_t
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,97 +588,62 @@ 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();
} }
@ -728,5 +651,5 @@ 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,_ ) ),_), _ ) -->

149
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)
; ;

3
utf8proc/utf8proc.h
View File

@ -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