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

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

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

5
.gitignore vendored
View File

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

24
C/absmi.c
View File

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

58
C/adtdefs.c
View File

@ -562,60 +562,60 @@ Yap_OpPropForModule(Atom a,
return info;
}
static OpEntry *
fetchOpWithModule( PropEntry *pp, Term tmod, op_type type )
{
OpEntry *
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)) {
OpEntry *info = NULL;
if (pp->KindOfPE != OpProperty) {
pp = RepProp(pp->NextOfPE);
continue;
}
info = (OpEntry *)pp;
if (info->OpModule != tmod) {
if (info->OpModule != CurrentModule && info->OpModule != PROLOG_MODULE) {
pp = RepProp(pp->NextOfPE);
continue;
}
if (type == INFIX_OP) {
if (!info->Infix) {
return NULL;
pp = RepProp(pp->NextOfPE);
continue;
}
} else if (type == POSFIX_OP) {
if (!info->Posfix) {
return NULL;
pp = RepProp(pp->NextOfPE);
continue;
}
} else {
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 NULL;
}
OpEntry *
Yap_GetOpProp(Atom a,
op_type type,
Term tmod
USES_REGS) { /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a);
PropEntry *pp;
OpEntry *info;
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
if (( (info = fetchOpWithModule( pp, tmod, type )) != NULL) ||
( (info = fetchOpWithModule( pp, USER_MODULE, type )) != NULL) ||
( (info = fetchOpWithModule( pp, PROLOG_MODULE, type )) != NULL)
) {
LOCK(info->OpRWLock);
return info;
}
if (oinfo) {
READ_LOCK(oinfo->OpRWLock);
READ_UNLOCK(ae->ARWLock);
return oinfo;
}
READ_UNLOCK(ae->ARWLock);
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)
#endif
#if defined(_WIN32)
#if defined(_WIN32) && !defined(X_API)
#define X_API __declspec(dllexport)
#endif
@ -2345,7 +2345,7 @@ static void construct_init_file(char *boot_file, char *BootFile) {
#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 do_bootstrap = (yap_init->YapPrologBootFile != NULL);
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);
if (fv == NULL)
fv = Yap_GetModuleEntry(TermUser);
fv = Yap_GetModuleEntry(AtomUser);
if (fv->flags & UNKNOWN_ERROR)
return TermError;
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 */
if (very_verbose) {
PredEntry *pe = Yap_PredForChoicePt(gc_B, NULL);
#if defined(ANALYST) || DEBUG
#if defined(ANALYST) || 0
if (pe == NULL) {
fprintf(stderr,"%% marked " UInt_FORMAT " (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]);
} else if (pe->ArityOfPE) {

54
C/init.c
View File

@ -196,52 +196,6 @@ int Yap_IsOpType(char *type) {
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) {
int i;
AtomEntry *ae = RepAtom(a);
@ -249,6 +203,8 @@ static int OpDec(int p, const char *type, Atom a, Term m) {
if (m == TermProlog)
m = PROLOG_MODULE;
else if (m == USER_MODULE)
m = PROLOG_MODULE;
for (i = 1; i <= 7; ++i)
if (strcmp(type, optypes[i]) == 0)
break;
@ -264,7 +220,7 @@ static int OpDec(int p, const char *type, Atom a, Term m) {
p |= DcrrpFlag;
}
WRITE_LOCK(ae->ARWLock);
info = fetchOpForModule(ae, m);
info = Yap_GetOpPropForAModuleHavingALock(ae, m);
if (EndOfPAEntr(info)) {
info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
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_UNLOCK(ae->ARWLock);
}
if (i <= 3) {
if (trueGlobalPrologFlag(ISO_FLAG) &&
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;
} else if (i <= 5) {
if (trueGlobalPrologFlag(ISO_FLAG) &&
info->Infix != 0) /* there is an infix operator */ {
/* ISO dictates */
@ -441,7 +397,7 @@ static void InitOps(void) {
/// @}
#if DEBUG
#ifdef HAVE_ISATTY
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#endif

2
C/modules.c
View File

@ -52,7 +52,6 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
n->KindOfPE = ModProperty;
n->PredForME = NULL;
n->NextME = CurrentModules;
n->ParentForME = CurrentModule;
CurrentModules = n;
n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
@ -260,6 +259,7 @@ static Int change_module(USES_REGS1) { /* $change_module(N) */
Term mod = Deref(ARG1);
LookupModule(mod);
CurrentModule = mod;
LOCAL_SourceModule = mod;
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 checkfor(wchar_t, JMPBUFF *CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *, Term CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *, Term CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *CACHE_TYPE);
const char *Yap_tokRep(TokEntry *tokptr);
@ -367,12 +367,16 @@ Term Yap_Variables(VarEntry *p, Term l) {
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;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, tmod PASS_REGS);
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Prefix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*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
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;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, tmod PASS_REGS);
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Infix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*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
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;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, tmod PASS_REGS);
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Posfix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*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
return IsPosfixOp(op, pptr, lpptr, tmod PASS_REGS);
return IsPosfixOp(op, pptr, lpptr PASS_REGS);
}
inline static void GNextToken(USES_REGS1) {
@ -460,9 +472,9 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
#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
Term t;
Term m = CurrentModule, t;
Atom at;
UInt arity;
Functor f;
@ -513,7 +525,7 @@ static int get_quasi_quotation(term_t t, unsigned char **here,
#endif /*O_QUASIQUOTATIONS*/
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
Term arg1, Term tmod USES_REGS) {
Term arg1 USES_REGS) {
int nargs = 0;
Term *p, t;
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);
FAIL;
}
*tp++ = Unsigned(ParseTerm(999, FailBuff, tmod PASS_REGS));
*tp++ = Unsigned(ParseTerm(999, FailBuff PASS_REGS));
ParserAuxSp = (char *)tp;
++nargs;
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);
}
static Term ParseList(JMPBUFF *FailBuff, Term tmod USES_REGS) {
static Term ParseList(JMPBUFF *FailBuff USES_REGS) {
Term o;
CELL *to_store;
o = AbsPair(HR);
loop:
to_store = HR;
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 (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken;
@ -629,7 +641,7 @@ loop:
}
} else if (((int)LOCAL_tokptr->TokInfo) == '|') {
NextToken;
to_store[1] = ParseTerm(999, FailBuff, tmod PASS_REGS);
to_store[1] = ParseTerm(999, FailBuff PASS_REGS);
} else {
to_store[1] = MkAtomTerm(AtomNil);
}
@ -641,7 +653,7 @@ loop:
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 */
Volatile Term t;
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) ||
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) {
Atom at = (Atom)LOCAL_tokptr->TokInfo;
#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);
FAIL;
}
t = ParseTerm(oprprio, FailBuff, tmod PASS_REGS);
t = ParseTerm(oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
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) &&
Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom)t, ')', FailBuff, 0L, tmod PASS_REGS);
t = ParseArgs((Atom)t, ')', FailBuff, 0L PASS_REGS);
else
t = MkAtomTerm((Atom)t);
break;
@ -737,7 +749,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
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) {
syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL;
@ -752,7 +764,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_WCharsToTDQ(p, tmod PASS_REGS);
t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \'%S\'",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo);
FAIL;
@ -768,7 +780,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
yap_error_number oerr = LOCAL_Error_TYPE;
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) {
syntax_msg("line %d: could not convert \'%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL;
@ -780,7 +792,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
case WBQString_tok: /* build list on the heap */
{
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
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -810,7 +822,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
case '(':
case 'l': /* non solo ( */
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS);
t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
checkfor(')', FailBuff PASS_REGS);
break;
case '[':
@ -821,7 +833,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
NextToken;
break;
}
t = ParseList(FailBuff, tmod PASS_REGS);
t = ParseList(FailBuff PASS_REGS);
checkfor(']', FailBuff PASS_REGS);
break;
case '{':
@ -832,7 +844,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
NextToken;
break;
}
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS);
t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -884,7 +896,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
}
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS);
t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
syntax_msg("expected to find quasi quotes, got \"%s\"", ,
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) &&
Yap_HasOp((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) {
/* try parsing as infix operator */
Volatile int oldprio = curprio;
@ -955,7 +967,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
{
Term args[2];
args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS);
args[1] = ParseTerm(oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
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;
curprio = oldprio;)
}
if (IsPosfixOp(opinfo, &opprio, &oplprio , tmod PASS_REGS) && opprio <= prio &&
if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio &&
oplprio >= curprio) {
/* parse as posfix operator */
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];
NextToken;
args[0] = t;
args[1] = ParseTerm(1000, FailBuff, tmod PASS_REGS);
args[1] = ParseTerm(1000, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -1003,12 +1015,12 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
curprio = 1000;
continue;
} 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) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS);
args[1] = ParseTerm(oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -1018,24 +1030,24 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, tmod PASS_REGS) &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, tmod PASS_REGS);
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&oplprio, tmod PASS_REGS) &&
&oplprio PASS_REGS) &&
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);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&oplprio, tmod PASS_REGS) &&
&oplprio PASS_REGS) &&
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);
curprio = opprio;
continue;
@ -1050,7 +1062,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) {
return t;
}
Term Yap_Parse(UInt prio, Term tmod) {
Term Yap_Parse(UInt prio) {
CACHE_REGS
Volatile Term t;
JMPBUFF FailBuff;
@ -1058,7 +1070,7 @@ Term Yap_Parse(UInt prio, Term tmod) {
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff, tmod PASS_REGS);
t = ParseTerm(prio, &FailBuff PASS_REGS);
#if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPutc(stderr, '[');
@ -1071,8 +1083,7 @@ Term Yap_Parse(UInt prio, Term tmod) {
}
#endif
Yap_CloseSlots(sls);
if (LOCAL_Error_TYPE == YAP_NO_ERROR &&
LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_ErrorMessage = "term does not end on . ";
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
int myread(FILE *fd, char *buffer, Int len) {
ssize_t nread;
size_t nread;
while (len > 0) {
nread = fread(buffer, 1, (int)len, fd);
@ -202,7 +202,7 @@ int myread(FILE *fd, char *buffer, Int len) {
inline static
Int
mywrite(FILE *fd, char *buff, Int len) {
ssize_t nwritten;
size_t nwritten;
while (len > 0) {
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
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))
return false;

21
C/stdpreds.c
View File

@ -385,8 +385,7 @@ static Int p_systime(USES_REGS1) {
}
static Int p_walltime(USES_REGS1) {
Int now, interval;
Yap_walltime_interval(&now, &interval);
uint64_t now, interval;
return (Yap_unify_constant(ARG1, MkIntegerTerm(now)) &&
Yap_unify_constant(ARG2, MkIntegerTerm(interval)));
}
@ -984,27 +983,24 @@ int Yap_IsOpMaxPrio(Atom at) {
return max;
}
static bool unify_op(OpEntry *op, Term emod USES_REGS) {
static Int unify_op(OpEntry *op USES_REGS) {
Term tmod = op->OpModule;
if (tmod != PROLOG_MODULE &&
tmod != USER_MODULE &&
tmod != emod &&
(op->Prefix || op->Infix || op->Posfix))
return false;
return Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
if (tmod == PROLOG_MODULE)
tmod = TermProlog;
return Yap_unify_constant(ARG2, tmod) &&
Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) &&
Yap_unify_constant(ARG4, MkIntegerTerm(op->Infix)) &&
Yap_unify_constant(ARG5, MkIntegerTerm(op->Posfix));
}
static Int cont_current_op(USES_REGS1) {
OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next;
Term emod = Deref(ARG2);
READ_LOCK(op->OpRWLock);
next = op->OpNext;
if (Yap_unify_constant(ARG1, MkAtomTerm(op->OpName)) &&
unify_op(op, emod PASS_REGS)) {
unify_op(op PASS_REGS)) {
READ_UNLOCK(op->OpRWLock);
if (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);
if (next) {
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next);
B->cp_h = HR;
return FALSE;
} else {
cut_fail();
@ -1036,7 +1033,7 @@ static Int cont_current_atom_op(USES_REGS1) {
READ_LOCK(op->OpRWLock);
next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS);
if (unify_op(op, CurrentModule PASS_REGS)) {
if (unify_op(op PASS_REGS)) {
READ_UNLOCK(op->OpRWLock);
if (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)
{
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:
out->val.l =
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:
out->val.a =
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 "blobs.h"
#include <stdio.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif

6
C/write.c
View File

@ -1007,7 +1007,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
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);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(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 == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp, CurrentModule)) {
Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
int bracket_left, offset;
@ -1087,7 +1087,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrclose_bracket(wglb, TRUE);
}
} 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 tright = ArgOfTerm(2, t);
int bracket_left =

36
CMakeLists.txt
View File

@ -128,8 +128,9 @@ set_property(DIRECTORY PROPERTY CXX_STANDARD 11)
#
include (Config)
IF (NOT MSVC)
target_link_libraries(libYap m)
ENDIF (NOT MSVC)
set_target_properties(libYap
PROPERTIES VERSION ${YAP_FULL_VERSION}
@ -286,18 +287,23 @@ include_directories ( utf8proc )
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS UTF8PROC=1)
ADD_SUBDIRECTORY ( utf8proc )
macro_optional_find_package (GMP ON)
find_package (GMP)
macro_log_feature (GMP_FOUND
"libgmp"
"GNU libgmp (in some cases MPIR"
"GNU big integers and rationals"
"http://gmplib.org")
set(YAP_SYSTEM_OPTIONS "big_numbers " ${YAP_SYSTEM_OPTIONS})
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})
target_link_libraries(libYap ${GMP_LIBRARIES})
#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} )
endif (GMP_FOUND)
@ -409,9 +415,19 @@ add_subDIRECTORY (packages/ProbLog)
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)
ENDIF()
add_subDIRECTORY (packages/raptor)
@ -426,7 +442,7 @@ add_subDIRECTORY (packages/xml)
option (WITH_DOCS
"generate YAP docs" OFF)
add_subDIRECTORY (docs)
# add_subDIRECTORY (docs)
# add_subDIRECTORY (packages/cuda)
@ -506,8 +522,10 @@ target_link_libraries(libYap
)
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()
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
#if _MSC_VER
// no support for __builtin_expect
#define __builtin_expect(Exp, Val) (Exp)
#endif
#include "inline-only.h"
INLINE_ONLY inline EXTERN void restore_machine_regs(void);
@ -586,10 +591,11 @@ INLINE_ONLY EXTERN inline void restore_TR(void) {
}
#else
#define CP Yap_REGS.CP_ /* continuation program counter */
/** continuation program counter: what to do when we exit the goal. */
#define CP (Yap_REGS.CP_)
#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 HR Yap_REGS.H_ /* top of heap (global) stack */
#define B Yap_REGS.B_ /* latest choice point */

4
H/YapTerm.h
View File

@ -34,8 +34,12 @@ typedef void *Atom;
#ifndef EXTERN
#ifdef _MSC_VER
#define EXTERN
#else
#define EXTERN extern
#endif
#endif
/* 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 */

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 $ *
*************************************************************************/
#if defined(_WIN32)
#define X_API __declspec(dllexport)
#endif
/* prototype file for Yap */
/* absmi.c */
@ -111,11 +115,11 @@ size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
/* c_interface.c */
#ifndef YAP_CPP_INTERFACE
Int YAP_Execute(struct pred_entry *, CPredicate);
Int YAP_ExecuteFirst(struct pred_entry *, CPredicate);
Int YAP_ExecuteNext(struct pred_entry *, CPredicate);
Int YAP_ExecuteOnCut(struct pred_entry *, CPredicate, struct cut_c_str *);
Int YAP_RunGoalOnce(Term);
X_API Int YAP_Execute(struct pred_entry *, CPredicate);
X_API Int YAP_ExecuteFirst(struct pred_entry *, CPredicate);
X_API Int YAP_ExecuteNext(struct pred_entry *, CPredicate);
X_API Int YAP_ExecuteOnCut(struct pred_entry *, CPredicate, struct cut_c_str *);
X_API Int YAP_RunGoalOnce(Term);
#endif
/* cdmgr.c */
@ -388,14 +392,14 @@ int Yap_IsOpMaxPrio(Atom);
void Yap_InitPageSize(void);
bool Yap_set_fpu_exceptions(Term);
UInt Yap_cputime(void);
Int Yap_walltime(void);
uint64_t Yap_walltime(void);
int Yap_dir_separator(int);
int Yap_volume_header(char *);
int Yap_signal_index(const char *);
#ifdef MAC
void Yap_SetTextFile(char *);
#endif
#if __ANDROIDD__
#if __ANDROID__
extern AAssetManager *Yap_assetManager;
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);
void Yap_cputime_interval(Int *, Int *);
void Yap_systime_interval(Int *, Int *);
void Yap_walltime_interval(Int *, Int *);
void Yap_InitSysbits(int wid);
void Yap_InitSysPreds(void);
void Yap_InitcTime(int);

25
H/Yatom.h
View File

@ -266,17 +266,16 @@ INLINE_ONLY inline EXTERN int IsWideAtom(Atom at) {
/* Module property */
typedef struct mod_entry {
Prop NextOfPE; /** used to chain properties */
PropFlags KindOfPE; /** kind of property */
struct pred_entry *PredForME; /** list of predicates for that module */
Atom AtomOfME; /** module's name */
Atom OwnerFile; /** module's owner file */
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
struct pred_entry *PredForME; /* index in module table */
Atom AtomOfME; /* module's name */
Atom OwnerFile; /* module's owner file */
#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
Term ParentForME; /** the module we wer created from */
unsigned int flags; /** Module local flags (from SWI compat): includes ops, strings */
struct mod_entry *NextME; /** next module */
unsigned int flags; /* Module local flags (from SWI compat) */
struct mod_entry *NextME; /* next module */
} ModEntry;
#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;
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_IsInfixOp(Atom, int *, int *, int *, Term);
int Yap_IsPosfixOp(Atom, int *, int *, Term);
int Yap_IsInfixOp(Atom, int *, int *, int *);
int Yap_IsPosfixOp(Atom, int *, int *);
/* defines related to operator specifications */
#define MaskPrio 0x0fff

31
H/amidefs.h
View File

@ -938,6 +938,15 @@ typedef struct choicept {
CELL *cp_env;
/* GNUCC understands empty arrays */
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_a2 cp_args[1]
#define cp_a3 cp_args[2]
@ -949,23 +958,6 @@ typedef struct choicept {
#define cp_a9 cp_args[8]
#define cp_a10 cp_args[9]
#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;
/* This has problems with \+ \+ a, !, b. */
@ -1062,10 +1054,9 @@ OPCODE ENV_ToOp(yamop *cp)
}
static inline
size_t EnvSize(yamop *cp)
int64_t EnvSize(yamop *cp)
{
return ((-ENV_Size(cp
))/(OPREG)sizeof(CELL));
return (-ENV_Size(cp)/sizeof(CELL));
}
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);
}
#ifndef OPTIMIZE_MULTIPLI
#if __clang__ && FALSE /* not in OSX yet */
#if defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P
#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; }
#elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DO_MULTI() {\
@ -98,7 +105,6 @@ mul_overflow(Int z, Int i1, Int i2)
z = (Int)w; \
}
#endif
#endif
inline static Term
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
//udi.c
//struct udi_control_block RtreeCmd void
EXTERNAL const char* GLOBAL_RestoreFile;
EXTERNAL char* GLOBAL_RestoreFile;
//gprof.c
EXTERNAL Int GLOBAL_ProfCalls;
EXTERNAL Int GLOBAL_ProfGCs;

2
H/generated/hglobals.h
View File

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

2
H/inline-only.h
View File

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

2
H/sshift.h
View File

@ -738,7 +738,7 @@ CodeVoidPAdjust__ (void * addr USES_REGS)
{
if (!addr)
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);

2
OPTYap/opt.init.c
View File

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

2
OPTYap/or.cow_engine.c
View File

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

2
OPTYap/or.memory.c
View File

@ -18,7 +18,9 @@
#include "Yap.h"
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
#include <signal.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <fcntl.h>
#include <string.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_ARITY_ARRAY_SIZE 10000
#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \
#define SHOW_TABLE_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) \
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)
new_subgoal_frame(sg_fr, preg, mode_directed);
*sg_fr_end = sg_fr;
#ifndef _MSC_VER
__sync_synchronize();
#endif
TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node);
UNLOCK_SUBGOAL_NODE(current_sg_node);
#else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */

57
cmake/FindGMP.cmake
View File

@ -1,23 +1,46 @@
# Try to find the GMP librairies
# GMP_FOUND - system has GMP lib
# GMP_INCLUDE_DIR - the GMP include directory
# GMP_LIBRARIES - Libraries needed to use GMP
# Copyright (c) 2006, Laurent Montel, <montel@kde.org>
# vim: set ts=2 shiftwidth=2 expandtab:
# - Find GMP/MPIR libraries and headers
# This module defines the following variables:
#
# Redistribution and use is allowed according to the terms of the BSD license.
# For details see the accompanying COPYING-CMAKE-SCRIPTS file.
# 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.
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)
# Already in cache, be silent
set(GMP_FIND_QUIETLY TRUE)
endif (GMP_INCLUDE_DIR AND GMP_LIBRARIES)
if(WIN32)
if(CMAKE_BUILD_TYPE STREQUAL "Debug" AND MSVC)
set(MPIR_LIB "mpird")
else()
set(MPIR_LIB "mpir")
endif()
find_path(GMP_INCLUDE_DIR NAMES gmp.h )
find_library(GMP_LIBRARIES NAMES gmp libgmp)
find_library(GMP_LIBRARIES NAMES ${MPIR_LIB}
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)
FIND_PACKAGE_HANDLE_STANDARD_ARGS(GMP DEFAULT_MSG GMP_INCLUDE_DIR GMP_LIBRARIES)
mark_as_advanced(GMP_INCLUDE_DIR GMP_LIBRARIES)
if(WIN32)
find_package_handle_standard_args(GMP DEFAULT_MSG GMP_LIBRARIES GMP_LIBRARY_DLL GMP_INCLUDE_DIRS)
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"
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
#endif
#ifdef _WIN32 /* Microsoft's Visual C++ Compiler */
#include <windows.h>
#include <io.h>
#endif
#include <stdio.h>
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
@ -57,6 +58,7 @@
#include <ieeefp.h>
#endif
static void do_top_goal(YAP_Term Goal);
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;
#endif
#ifdef USE_MYPUTC
static void
myputc (int ch)
{
putc(ch,stderr);
}
#endif
static void
do_top_goal (YAP_Term Goal)
@ -87,7 +83,7 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap)
{
int BootMode;
BootMode = YAP_parse_yap_arguments(argc,argv,iap);
// BootMode = YAP_parse_yap_arguments(argc,argv,iap);
/* init memory */
if (BootMode == YAP_BOOT_FROM_PROLOG ||
@ -142,16 +138,8 @@ main (int argc, char **argv)
#endif
{
int BootMode;
YAP_init_args init_args;
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);
if (BootMode == YAP_BOOT_ERROR) {
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 Sdprintf(const char *,...);
extern char *PL_prompt_string(int fd);
extern X_API char *PL_prompt_string(int fd);
/*******************************
* FILENAME SUPPORT *
@ -639,7 +639,7 @@ readline overhead.
#define PL_DISPATCH_WAIT 1 /* Dispatch till input available */
#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(void) PL_add_to_protocol(const char *buf, size_t count);
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,
UINT message,
WPARAM wParam,
// WPARAM wParam,
LPARAM lParam);
#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 wchar_t pl_wchar_t; /* wide character support */
#include <inttypes.h> /* more portable than stdint.h */
#if !defined(_MSC_VER)
typedef uintptr_t PL_fid_t; /* opaque foreign context handle */
#endif
typedef int (*PL_dispatch_hook_t)(int fd);
typedef void *pl_function_t;

2
library/CMakeLists.txt
View File

@ -8,14 +8,12 @@ set (LIBRARY_PL
autoloader.yap
avl.yap
bhash.yap
bootlists.yap
charsio.yap
clauses.yap
coinduction.yap
dbqueues.yap
dbusage.yap
dgraphs.yap
error.yap
exo_interval.yap
expand_macros.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;
}
} else if (f == FunctorDBRef) {
Term ta[0];
Term ta[1];
ta[0] = MkIntegerTerm((Int)DBRefOfTerm(t));
return Yap_InitSlot(Yap_MkApplTerm(FunctorDBREF, 1, ta));
}

5
library/lists.yap
View File

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

14
library/matrix.yap
View File

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

2
library/prandom.yap
View File

@ -43,7 +43,7 @@
% efficient.
%
% ranpkg.pl random number package Allen Van Gelder, Stanford
%
vvvvvv
% 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.
% 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(990, xfx, returns)] ).
:- (current_op(X,Y,O), write(M0:O), fail:nl).
:- use_module( library(clauses) ).
:- use_module( library(maplist) ).
:- use_module( library(gensym) ).
:- use_module( library(lists) ).
:- (current_op(X,Y,O), write(M0:O), fail:nl).
:- multifile test/1.
:- dynamic error/3, failed/3.

4
library/ytest/preds.yap
View File

@ -9,7 +9,7 @@
->
Flags1 = 0x200000
).
'$predicate_flags'(_P, _M, Flags0, Flags1) :-
'$predicate_flags'(P, M, Flags0, Flags1) :-
( Flags1 /\ 0x200000 =\= 0,
Flags0 /\ 0x200000 =:= 0
->
@ -23,7 +23,7 @@
predicate_property(M:G, imported_from(M0)), !.
'$get_undefined_pred'(G,M,G,OM) :-
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) :-
predicate_property(M:G, imported_from(M0)), !.
'$get_undefined_pred'(G,M,G,M).

2
misc/GLOBALS
View File

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

10
misc/buildlocalglobal
View File

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

1
os/alias.c
View File

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

3
os/console.c
View File

@ -14,9 +14,6 @@
* comments: Input/Output C implemented predicates *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/**
* @file console.c

36
os/files.c
View File

@ -222,7 +222,11 @@ exists_file(USES_REGS1)
/* ignore errors while checking a file */
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
return FALSE;
#endif
@ -373,6 +377,33 @@ access_file(USES_REGS1)
return FALSE;
}
#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;
@ -398,6 +429,7 @@ access_file(USES_REGS1)
}
return true;
}
#endif
#elif HAVE_STAT
{
struct SYSTEM_STAT ss;
@ -511,8 +543,6 @@ file_directory_name ( USES_REGS1 )
return false;
}
at = AtomOfTerm(t);
if (at == AtomEmptyAtom)
at = AtomDot;
if (IsWideAtom(at)) {
wchar_t s[YAP_FILENAME_MAX+1];
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: {
char buf[8];
int out;
wchar_t wch;
int wch;
mbstate_t mbstate;
memset((void *)&(mbstate), 0, sizeof(mbstate_t));

342
os/iopreds.c
View File

@ -96,6 +96,7 @@ static char SccsId[] = "%W% %G%";
#endif
#include "iopreds.h"
#define GETW get_wchar_from_FILE
#define GETC() fgetwc(st->file)
#include "getw.h"
@ -195,9 +196,6 @@ void Yap_DefaultStreamOps(StreamDesc *st) {
if (st->status & (Promptable_Stream_f)) {
st->stream_wgetc = get_wchar;
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) {
st->stream_wgetc = get_wchar_from_file;
} else
@ -224,8 +222,8 @@ static void unix_upd_stream_info(StreamDesc *s) {
}
#if _MSC_VER
/* standard error stream should never be buffered */
else if (StdErrStream == s - Stream) {
setvbuf(s->u.file.file, NULL, _IONBF, 0);
else if (StdErrStream == s - GLOBAL_Stream) {
setvbuf(s->file, NULL, _IONBF, 0);
}
#endif
s->status |= Seekable_Stream_f;
@ -268,6 +266,7 @@ static void unix_upd_stream_info(StreamDesc *s) {
s->status |= Seekable_Stream_f;
}
static void InitFileIO(StreamDesc *s) {
CACHE_REGS
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 */
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) {
return post_process_weof(s);
}
@ -661,6 +660,7 @@ int post_process_read_wchar(int ch, ssize_t n, StreamDesc *s) {
return ch;
}
int post_process_weof(StreamDesc *s) {
if (!ResetEOF(s)) {
s->status |= Eof_Stream_f;
@ -692,18 +692,19 @@ int PlGetc(int sno) {
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);
}
}
#ifndef MB_LEN_MAX
#define MB_LEN_MAX 6
#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) {
/* use HTML/XML encoding in ASCII */
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);
return -1;
}
}
}
int put_wchar(int sno, wchar_t ch) {
int put_wchar(int sno, wchar_t ch) {
/* pass the bucck if we can */
switch (GLOBAL_Stream[sno].encoding) {
case ENC_OCTET:
@ -792,7 +793,8 @@ int put_wchar(int sno, wchar_t ch) {
}
return ch;
break;
case ENC_UTF16_LE: {
case ENC_UTF16_LE:
{
if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff));
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -809,7 +811,8 @@ int put_wchar(int sno, wchar_t ch) {
}
return ch;
}
case ENC_UTF16_BE: {
case ENC_UTF16_BE:
{
// computations
if (ch < 0x10000) {
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, (trail >> 8));
GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff));
}
return ch;
}
case ENC_UCS2_LE: {
case ENC_UCS2_LE:
{
if (ch >= 0x10000) {
return 0;
}
@ -833,7 +838,8 @@ int put_wchar(int sno, wchar_t ch) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
return ch;
}
case ENC_UCS2_BE: {
case ENC_UCS2_BE:
{
// computations
if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -859,34 +865,34 @@ int put_wchar(int sno, wchar_t ch) {
}
}
return -1;
}
}
/* used by user-code to read characters from the current input stream */
int Yap_PlGetchar(void) {
/* used by user-code to read characters from the current input stream */
int Yap_PlGetchar(void) {
CACHE_REGS
return (
GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(LOCAL_c_input_stream));
}
return (GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(
LOCAL_c_input_stream));
}
int Yap_PlGetWchar(void) {
int Yap_PlGetWchar(void) {
CACHE_REGS
return get_wchar(LOCAL_c_input_stream);
}
}
/* avoid using a variable to call a function */
int Yap_PlFGetchar(void) {
/* avoid using a variable to call a function */
int Yap_PlFGetchar(void) {
CACHE_REGS
return (PlGetc(LOCAL_c_input_stream));
}
}
Term Yap_MkStream(int n) {
Term Yap_MkStream(int n) {
Term t[1];
t[0] = MkIntTerm(n);
return (Yap_MkApplTerm(FunctorStream, 1, t));
}
}
/* given a stream index, get the corresponding fd */
Int GetStreamFd(int sno) {
/* given a stream index, get the corresponding fd */
Int GetStreamFd(int sno) {
#if HAVE_SOCKET
if (GLOBAL_Stream[sno].status & Socket_Stream_f) {
return (GLOBAL_Stream[sno].u.socket.fd);
@ -898,11 +904,11 @@ Int GetStreamFd(int sno) {
return (-1);
}
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 _MSC_VER || defined(__MINGW32__)
struct _stat ss;
@ -919,9 +925,9 @@ static int binary_file(const char *file_name) {
#else
return (FALSE);
#endif
}
}
static int write_bom(int sno, StreamDesc *st) {
static int write_bom(int sno, StreamDesc *st) {
/* dump encoding */
switch (st->encoding) {
case ENC_ISO_UTF8:
@ -974,9 +980,9 @@ static int write_bom(int sno, StreamDesc *st) {
default:
return true;
}
}
}
static void check_bom(int sno, StreamDesc *st) {
static void check_bom(int sno, StreamDesc *st) {
int ch1, ch2, ch3, ch4;
ch1 = fgetc(st->file);
@ -1070,10 +1076,11 @@ static void check_bom(int sno, StreamDesc *st) {
default:
ungetc(ch1, st->file);
}
}
}
bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags, Atom open_mode) {
bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags,
Atom open_mode) {
StreamDesc *st = &GLOBAL_Stream[sno];
st->status = flags;
@ -1107,9 +1114,9 @@ bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
Yap_DefaultStreamOps(st);
}
return true;
}
}
static bool open_header(int sno, Atom open_mode) {
static bool open_header(int sno, Atom open_mode) {
if (open_mode == AtomWrite) {
const char *ptr;
const char s[] = "#!";
@ -1136,7 +1143,7 @@ static bool open_header(int sno, Atom open_mode) {
}
}
return true;
}
}
#define OPEN_DEFS() \
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)
#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
#define PAR(x, y, z) \
{ x, y, z }
static const param_t open_defs[] = {OPEN_DEFS()};
static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR
static Int
do_open(Term file_name, Term t2,
static Int do_open(
Term file_name, Term t2,
Term tlist USES_REGS) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
Atom open_mode;
int sno;
@ -1256,7 +1263,7 @@ do_open(Term file_name, Term t2,
s_encoding = "default";
}
// 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
bool ok = (args[OPEN_EXPAND_FILENAME].used
? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue
@ -1272,7 +1279,8 @@ do_open(Term file_name, Term t2,
// Skip scripts that start with !#/.. or similar
bool script =
(args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue : false);
(args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue
: false);
// binary type
if (args[OPEN_TYPE].used) {
Term t = args[OPEN_TYPE].tvalue;
@ -1320,11 +1328,11 @@ do_open(Term file_name, Term t2,
fname = LOCAL_FileNameBuf;
UNLOCK(st->streamlock);
if (errno == ENOENT)
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname,
strerror(errno)));
else {
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s",
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s",
fname, strerror(errno)));
else {
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name,
"%s: %s", fname, strerror(errno)));
}
}
#if MAC
@ -1333,9 +1341,11 @@ do_open(Term file_name, Term t2,
}
#endif
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;
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;
if (open_mode == AtomWrite) {
if (needs_bom && !write_bom(sno, st))
@ -1345,10 +1355,10 @@ do_open(Term file_name, Term t2,
}
// follow declaration unless there is v
if (st->status & HAS_BOM_f)
st->encoding = enc_id(s_encoding, st->encoding);
st->encoding = enc_id( s_encoding, st->encoding);
else
st->encoding = encoding;
Yap_DefaultStreamOps(st);
Yap_DefaultStreamOps( st);
if (script)
open_header(sno, open_mode);
@ -1357,101 +1367,102 @@ do_open(Term file_name, Term t2,
Term t = Yap_MkStream(sno);
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
`append`), returning _S_ unified with the stream name.
Opens the file with name _F_ in mode _M_ (`read`, `write` or
`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
an output stream but not both. There are always 3 open streams:
user_input for reading, user_output for writing and user_error for
writing. If there is no ambiguity, the atoms user_input and
user_output may be referred to as `user`.
The `file_errors` flag controls whether errors are reported when in
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
writable.
The `file_errors` flag controls whether errors are reported when in
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
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);
}
}
/** @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
`append`), returning _S_ unified with the stream name, and following
these options:
Opens the file with name _F_ in mode _M_ (`read`, `write` or
`append`), returning _S_ unified with the stream name, and following
these options:
+ `type(+ _T_)` is iso
+ `type(+ _T_)` is iso
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
not (`false`). By default, YAP enables repositioning for all
files, except terminal files and sockets.
not (`false`). By default, YAP enables repositioning for all
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
stream where we have previously found an `end_of_file`. The possible
actions are `error`, that raises an error, `reset`, that tries to
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).
stream where we have previously found an `end_of_file`. The possible
actions are `error`, that raises an error, `reset`, that tries to
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).
+ `alias(+ _Name_)` is iso
+ `alias(+ _Name_)` is iso
Specify an alias to the stream. The alias <tt>Name</tt> must be an atom.
The
alias can be used instead of the stream descriptor for every operation
concerning the stream.
The
alias can be used instead of the stream descriptor for every operation
concerning the stream.
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
one is returned by stream_property/2
in use. YAP allows several aliases for the same file, but only
one is returned by stream_property/2
+ `bom(+ _Bool_)`
+ `bom(+ _Bool_)`
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
opening the stream. See BOM for details.
detected while opening the file for reading or a BOM was written while
opening the stream. See BOM for details.
+ `encoding(+ _Encoding_)`
+ `encoding(+ _Encoding_)`
Set the encoding used for text. See Encoding for an overview of
wide character and encoding issues.
Set the encoding used for text. See Encoding for an overview of
wide character and encoding issues.
+ `representation_errors(+ _Mode_)`
+ `representation_errors(+ _Mode_)`
Change the behaviour when writing characters to the stream that cannot
be represented by the encoding. The behaviour is one of `error`
(throw and Input/Output error exception), `prolog` (write `\u...\`
escape code or `xml` (write `\&#...;` XML character entity).
The initial mode is `prolog` for the user streams and
`error` for all other streams. See also Encoding.
be represented by the encoding. The behaviour is one of `error`
(throw and Input/Output error exception), `prolog` (write `\u...\`
escape code or `xml` (write `\&#...;` XML character entity).
The initial mode is `prolog` for the user streams and
`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
to do file name expansion before actually trying to opening the file:
this includes processing `~` characters and processing `$`
environment variables at the beginning of the file. Otherwise, just try
to open the file using the given name.
to do file name expansion before actually trying to opening the file:
this includes processing `~` characters and processing `$`
environment variables at the beginning of the file. Otherwise, just try
to open the file using the given name.
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
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.
*/
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);
}
}
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);
/* 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,
"absolute_file_name/3"));
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;
StreamDesc *st;
int sno = GetFreeStreamD();
@ -1511,9 +1524,9 @@ static Int p_open_null_stream(USES_REGS1) {
UNLOCK(st->streamlock);
t = Yap_MkStream(sno);
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
int sno;
Atom at;
@ -1531,13 +1544,13 @@ int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) {
at = AtomRead;
Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at);
return sno;
}
}
#define CheckStream(arg, kind, msg) \
CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
static int CheckStream__(const char *file, const char *f, int line, Term arg,
int kind, const char *msg) {
static int CheckStream__(const char *file, const char *f, int line,
Term arg, int kind, const char *msg) {
int sno = -1;
arg = Deref(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);
}
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) {
return CheckStream__(file, f, line, arg, kind, msg);
}
}
int Yap_CheckTextStream__(const char *file, const char *f, int line, Term arg,
int kind, const char *msg) {
int Yap_CheckTextStream__(const char *file, const char *f, int line,
Term arg, int kind, const char *msg) {
int sno;
if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0)
return -1;
@ -1615,10 +1628,10 @@ int Yap_CheckTextStream__(const char *file, const char *f, int line, Term arg,
return -1;
}
return sno;
}
}
/* used from C-interface */
int Yap_GetFreeStreamDForReading(void) {
/* used from C-interface */
int Yap_GetFreeStreamDForReading(void) {
int sno = GetFreeStreamD();
StreamDesc *s;
@ -1632,16 +1645,16 @@ int Yap_GetFreeStreamDForReading(void) {
Yap_DefaultStreamOps(s);
UNLOCK(s->streamlock);
return sno;
}
}
/**
/**
* @pred always_prompt_user
*
* Ensure that the stream always prompts before asking the standard input
stream for data.
*/
static Int always_prompt_user(USES_REGS1) {
static Int always_prompt_user(USES_REGS1) {
StreamDesc *s = GLOBAL_Stream + StdInStream;
s->status |= Promptable_Stream_f;
@ -1655,9 +1668,9 @@ static Int always_prompt_user(USES_REGS1) {
} else
Yap_ConsoleOps(s, false);
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
@ -1669,7 +1682,8 @@ static Int close1 /** @pred close(+ _S_) is iso
(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
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)
return (FALSE);
if (sno <= StdErrStream) {
@ -1679,35 +1693,36 @@ static Int close1 /** @pred close(+ _S_) is iso
Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
}
#define CLOSE_DEFS() \
PAR("force", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END)
#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
#define PAR(x, y, z) \
{ x, y, z }
static const param_t close_defs[] = {CLOSE_DEFS()};
static const param_t close_defs[] = {CLOSE_DEFS()};
#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)`.
YAP currently ignores these options.
The only valid options are `force(true)` and `force(false)`.
YAP currently ignores these options.
*/
static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
*/
static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
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;
if (sno < 0)
return (FALSE);
@ -1731,9 +1746,9 @@ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
}
Term read_line(int sno) {
Term read_line(int sno) {
CACHE_REGS
Term tail;
Int ch;
@ -1743,7 +1758,7 @@ Term read_line(int sno) {
}
tail = read_line(sno);
return (MkPairTerm(MkIntTerm(ch), tail));
}
}
#define ABSOLUTE_FILE_NAME_DEFS() \
PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \
@ -1760,20 +1775,20 @@ Term read_line(int sno) {
#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_choices_t;
} absolute_file_name_choices_t;
#undef PAR
#define PAR(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()};
#undef PAR
static Int abs_file_parameters(USES_REGS1) {
static Int abs_file_parameters(USES_REGS1) {
Term t[ABSOLUTE_FILE_NAME_END];
Term tlist = Deref(ARG1), tf;
/* get options */
@ -1801,7 +1816,8 @@ static Int abs_file_parameters(USES_REGS1) {
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(TermDot);
}
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
t[ABSOLUTE_FILE_NAME_FILE_TYPE] = TermTxt;
if (args[ABSOLUTE_FILE_NAME_ACCESS].used)
@ -1814,7 +1830,8 @@ static Int abs_file_parameters(USES_REGS1) {
else
t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = TermError;
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
t[ABSOLUTE_FILE_NAME_SOLUTIONS] = TermFirst;
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;
else
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),
ABSOLUTE_FILE_NAME_END, t);
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;
/* get options */
/* done */
@ -1847,9 +1865,9 @@ static Int get_abs_file_parameter(USES_REGS1) {
return Yap_unify(ARG3, ArgOfTerm(i + 1, topts));
Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL);
return false;
}
}
void Yap_InitPlIO(void) {
void Yap_InitPlIO(void) {
Int i;
Yap_stdin = stdin;
@ -1862,9 +1880,9 @@ void Yap_InitPlIO(void) {
GLOBAL_Stream[i].status = Free_Stream_f;
}
InitStdStreams();
}
}
void Yap_InitIOPreds(void) {
void Yap_InitIOPreds(void) {
/* here the Input/Output predicates */
Yap_InitCPred("always_prompt_user", 0, always_prompt_user,
SafePredFlag | SyncPredFlag);
@ -1899,4 +1917,4 @@ void Yap_InitIOPreds(void) {
Yap_InitSignalPreds();
Yap_InitSysPreds();
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;
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);
@ -207,7 +207,7 @@ typedef struct stream_desc {
lockvar streamlock; /* protect stream access */
#endif
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_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_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 *);
bool is_same_tty(FILE *f1, FILE *f2);

10
os/mem.c
View File

@ -1,4 +1,4 @@
/*************************************************************************post/////85
/*************************************************************************
* *
* YAP Prolog *
* *
@ -74,7 +74,7 @@ static int MemGetc( int);
/* read from memory */
static int
MemGetc (int sno)
MemGetc(int sno)
{
register StreamDesc *s = &GLOBAL_Stream[sno];
Int ch;
@ -82,8 +82,9 @@ MemGetc (int sno)
spos = s->u.mem_string.pos;
if (spos == s->u.mem_string.max_size) {
return EOF;
} else {
return -1;
}
else {
ch = s->u.mem_string.buf[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);
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();
if (args[READ_MODULE].used) {
fe->cmod = args[READ_MODULE].tvalue;
if (fe->cmod == TermProlog)
fe->cmod = PROLOG_MODULE;
CurrentModule = args[READ_MODULE].tvalue;
}
if (args[READ_BACKQUOTED_STRING].used) {
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) {
fe->tcomms = args[READ_COMMENTS].tvalue;
if (fe->tcomms == TermProlog)
fe->tcomms = PROLOG_MODULE;
} else {
fe->tcomms = 0;
}
@ -451,7 +451,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
fe->np = 0;
}
if (args[READ_CHARACTER_ESCAPES].used ||
Yap_CharacterEscapes(fe->cmod)) {
Yap_CharacterEscapes(CurrentModule)) {
fe->ce = true;
} else {
fe->ce = false;
@ -625,6 +625,9 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v1, v2, v3, vc, tp;
CurrentModule = fe->cmod;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart);
else
@ -660,6 +663,9 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos;
CurrentModule = fe->cmod;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart);
else
@ -880,7 +886,7 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
TokEntry *tokstart = LOCAL_tokptr;
encoding_t e = LOCAL_encoding;
LOCAL_encoding = fe->enc;
fe->t = Yap_Parse(re->prio, fe->cmod);
fe->t = Yap_Parse(re->prio);
LOCAL_encoding = e;
fe->toklast = LOCAL_tokptr;
LOCAL_tokptr = tokstart;
@ -1018,7 +1024,15 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
}
re->bq = getBackQuotesFlag();
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->qq = 0;
if (args[READ_CLAUSE_TERM_POSITION].used) {
@ -1026,14 +1040,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} else {
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;
if (args[READ_CLAUSE_COMMENTS].used) {
fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue;
if (fe->tcomms == TermProlog)
fe->tcomms = PROLOG_MODULE;
} else {
fe->tcomms = 0L;
}
@ -1053,7 +1064,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} else {
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;
if (re->seekable) {
#if HAVE_FGETPOS

176
os/readutil.c
View File

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

2
os/sig.c
View File

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

8
os/streams.c
View File

@ -881,8 +881,14 @@ void Yap_CloseStreams(int loud) {
for (sno = 3; sno < MaxStreams; ++sno) {
if (GLOBAL_Stream[sno].status & Free_Stream_f)
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);
#endif
}
if (GLOBAL_Stream[sno].status & (Pipe_Stream_f | Socket_Stream_f))
close(GLOBAL_Stream[sno].u.pipe.fd);
#if USE_SOCKET

57
os/sysbits.c
View File

@ -23,7 +23,7 @@ static char SccsId[] = "%W% %G%";
/// File Error Handler
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) ) {
@ -53,7 +53,7 @@ static int chdir(char *);
/* #define signal skel_signal */
#endif /* MACYAP */
static const char *
expandVars(const char *spec);
expandVars(const char *spec, char *u);
void exit(int);
@ -245,7 +245,11 @@ has_access(const char *FileName, int mode)
static bool
exists( const char *f)
{
#if _MSC_VER
return has_access(f, 00);
#else
return has_access( f, F_OK );
#endif
}
static int
@ -279,7 +283,7 @@ bool
Yap_IsAbsolutePath(const char *p0)
{
// verify first if expansion is needed: ~/ or $HOME/
const char *p = expandVars( p0 );
const char *p = expandVars( p0, LOCAL_FileNameBuf );
bool nrc;
#if _WIN32 || __MINGW32__
nrc = !PathIsRelative(p);
@ -334,13 +338,13 @@ PlExpandVars (const char *source, const char *root, char *result)
res++, src++;
res[0] = '\0';
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;
}
strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
strcat(result, src);
#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;
#endif
}
@ -531,7 +535,7 @@ DirName(const char *X) {
if (!o)
return NULL;
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;
}
@ -541,14 +545,15 @@ DirName(const char *X) {
}
#endif
static const char *myrealpath( const char *path, char *out)
static const char *myrealpath( const char *path)
{
#if _WIN32 || defined(__MINGW32__)
DWORD retval=0;
char *out = LOCAL_FileNameBuf;
// notice that the file does not need to exist
retval = GetFullPathName(path,
MAX_PATH-1,
YAP_FILENAME_MAX,
out,
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
char *rc = malloc(strlen(path)+1);
strcpy( rc, path);
const char * f = rc;
return f;
}
static const char *
expandVars(const char *spec)
expandVars(const char *spec, char *u)
{
CACHE_REGS
#if _WIN32 || defined(__MINGW32__)
char u[YAP_FILENAME_MAX+1];
char *out;
// first pass, remove Unix style stuff
@ -641,7 +645,7 @@ Yap_AbsoluteFile(const char *spec, bool ok)
rc = PlExpandVars(spec, NULL, NULL);
if (!rc)
rc = spec;
if ((p = myrealpath(rc, NULL )) ) {
if ((p = myrealpath(rc) ) ) {
return p;
} else {
return NULL;
@ -667,14 +671,12 @@ Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok)
const char*p;
const char*rc;
if (ok) {
rc = expandVars(spec);
rc = expandVars(spec, LOCAL_FileNameBuf);
if (!rc)
return spec;
} else {
rc = spec;
}
if ((p = myrealpath(rc, out) ) ) {
if ((p = myrealpath(rc) ) ) {
if (!out) {
out = LOCAL_FileNameBuf;
sz = YAP_FILENAME_MAX-1;
@ -703,12 +705,12 @@ do_glob(const char *spec, bool glob_vs_wordexp)
{
WIN32_FIND_DATA find;
HANDLE hFind;
const char *espec;
CELL *dest;
char *espec;
Term tf;
// 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;
espec = (const char *)u;
@ -861,7 +863,6 @@ prolog_realpath( USES_REGS1 )
{
Term t1 = Deref(ARG1);
const char *cmd;
char out[YAP_FILENAME_MAX];
if (IsAtomTerm(t1)) {
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
@ -870,7 +871,7 @@ prolog_realpath( USES_REGS1 )
} else {
return false;
}
const char *rc = myrealpath( cmd , out);
const char *rc = myrealpath( cmd );
if (!rc) {
PlIOError( SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno));
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);
if (args == NULL) {
return TermNil;
}
tmpe = malloc(YAP_FILENAME_MAX+1);
@ -934,7 +936,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
switch (i) {
case EXPAND_FILENAME_PARAMETER_EXPANSION:
if (t == TermProlog) {
const char *s = expandVars( spec);
const char *s = expandVars( spec, LOCAL_FileNameBuf);
if (s == NULL) {
return TermNil;
}
@ -962,7 +964,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
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);
return tf;
@ -1203,7 +1205,7 @@ initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) {
while (*--pt != '\\') {
/* skip executable */
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 */
return FALSE;
}
@ -1211,7 +1213,7 @@ initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) {
while (*--pt != '\\') {
/* skip parent directory "bin\\" */
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 */
return FALSE;
}
@ -2299,3 +2301,4 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("rmdir", 2, p_rmdir, 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_InitOSSignals (int wid);
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>
static FILETIME StartOfTimes, last_time;
static FILETIME StartOfTimes, last_time;
static FILETIME StartOfTimes_sys, last_time_sys;
@ -530,6 +530,8 @@ real_cputime ()
#endif /* HAVE_GETRUSAGE */
uint64_t Yap_StartOfWTimes;
#if HAVE_GETHRTIME
#if HAVE_TIME_H
@ -537,92 +539,48 @@ real_cputime ()
#endif
/* since the point YAP was started */
static hrtime_t StartOfWTimes;
/* since last call to walltime */
#define LastWTime (*(hrtime_t *)ALIGN_BY_TYPE(GLOBAL_LastWTimePtr,hrtime_t))
static void
void
Yap_InitWTime (void)
{
StartOfWTimes = gethrtime();
Yap_StartOfWTimes = (uint64_t)gethrtime();
}
static void
Yap_InitLastWTime(void) {
/* 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)
/// returns time since Jan 1 1980 in nano-seconds
uint64_t Yap_walltime(uint64_t old)
{
hrtime_t tp = gethrtime();
/* 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
/* 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 */
void
Yap_InitWTime (void)
{
gettimeofday(&StartOfWTimes,NULL);
}
struct timeval tp;
void
Yap_InitLastWTime(void) {
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeval));
LastWTime.tv_usec = StartOfWTimes.tv_usec;
LastWTime.tv_sec = StartOfWTimes.tv_sec;
gettimeofday(&tp, NULL);
Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
}
Int
Yap_walltime (void)
/// returns time in nano-secs since the epoch
uint64_t
Yap_walltime(void)
{
struct timeval tp;
gettimeofday(&tp,NULL);
if (StartOfWTimes.tv_usec > tp.tv_usec)
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);
gettimeofday(&tp, NULL);
return (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.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)
@ -630,97 +588,62 @@ void Yap_walltime_interval(Int *now,Int *interval)
#include <time.h>
/* since the point YAP was started */
static struct _timeb StartOfWTimes;
/* since last call to walltime */
#define LastWTime (*(struct timeb *)GLOBAL_LastWTimePtr)
static LARGE_INTEGER Frequency;
/* store user time in this variable */
static void
InitWTime (void)
void
Yap_InitWTime (void)
{
_ftime(&StartOfWTimes);
}
static void
InitLastWTime(void) {
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeb));
LastWTime.time = StartOfWTimes.time;
LastWTime.millitm = StartOfWTimes.millitm;
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceFrequency(&Frequency);
QueryPerformanceCounter(&ElapsedNanoseconds);
ElapsedNanoseconds.QuadPart *= 1000000;
ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
Yap_StartOfWTimes = (uint64_t)ElapsedNanoseconds.QuadPart;
}
Int
uint64_t
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);
if (StartOfWTimes.millitm > tp.millitm)
return((tp.time - StartOfWTimes.time - 1) * 1000 +
(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;
ElapsedNanoseconds.QuadPart *= 1000000;
ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
return ElapsedNanoseconds.QuadPart;
}
#elif HAVE_TIMES
static clock_t StartOfWTimes;
#define LastWTime (*(clock_t *)GLOBAL_LastWTimePtr)
/* store user time in this variable */
static void
InitWTime (void)
void
Yap_InitWTime (void)
{
StartOfWTimes = times(NULL);
Yap_StartOfWTimes = ((uint64_t)times(NULL))*10000000/TicksPerSec;
}
static void
InitLastWTime(void) {
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(clock_t));
LastWTime = StartOfWTimes;
}
Int
uint64_t
Yap_walltime (void)
{
clock_t t;
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 */
void
Yap_ReInitWTime (void)
{
Yap_InitWTime();
if (GLOBAL_LastWTimePtr != NULL)
Yap_FreeCodeSpace(GLOBAL_LastWTimePtr);
Yap_InitLastWTime();
}
@ -728,5 +651,5 @@ void
Yap_InitTimePreds(void)
{
/* 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.
*/
INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) {
wchar_t cs[2];
int cs[2];
if (c < 0)
return MkAtomTerm(AtomEof);
cs[0] = c;

2
packages/CLPBN/CMakeLists.txt
View File

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

12
packages/jpl/CMakeLists.txt
View File

@ -1,21 +1,19 @@
#CHECK: JavaLibs
set (JPL_SOURCES
src/c/jpl.c)
find_package(Java COMPONENTS Runtime Development)
# find_package(Java COMPONENTS Development)
# find_package(Java COMPONENTS Runtime)
#find_package(JavaLibs)
set (JPL_SOURCES
src/c/jpl.c)
macro_log_feature (Java_Development_FOUND "Java"
"Use Java System"
"http://www.java.org" FALSE)
find_package(JNI)
if (Java_Development_FOUND AND JNI_FOUND)
if (Java_Development_FOUND)
find_package(JNI)
include(UseJava)
#
@ -56,4 +54,4 @@ if (Java_Development_FOUND AND JNI_FOUND)
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)
install(TARGETS jplYap
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_STATUS "alpha"
#if JPL_DEBUG
/*#define DEBUG(n, g) ((void)0) */
#define DEBUG_LEVEL 4
#define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 )
#endif
/* disable type-of-ref caching (at least until GC issues are resolved) */
#define JPL_CACHE_TYPE_OF_REF FALSE

2
packages/myddas/myddas_statistics.c
View File

@ -1,5 +1,7 @@
#include <stdlib.h>
#if HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#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:
#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)
{

3
pl/CMakeLists.txt
View File

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

7
pl/absf.yap
View File

@ -654,13 +654,6 @@ user:prolog_file_type(A, prolog) :-
A \== pl,
A \== yap.
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) :-
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) :- ! ,
source_module( prolog ), !.
system_module(_Mod, _SysExps, _Decls) :-
nb_setval('$if_skip_mode',skip).
system_module(_Mod, _SysExps, _Decls) :- ! .
% new_system_module(Mod).
use_system_module(_init, _SysExps) :- !.
@ -1421,8 +1417,8 @@ bootstrap(F) :-
!.
'$loop'(Stream,Status) :-
% start_low_level_trace,
'$current_module'( OldModule ),
repeat,
source_module( OldModule ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
user:'$LoopError'(Error, Status)

2
pl/consult.yap
View File

@ -708,7 +708,7 @@ db_files(Fs) :-
),
'$loop'(Stream,Reconsult),
'$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),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$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',[
op(1150, fx, block)
%dif/2,
%when/2,
%block/1,

2
pl/init.yap
View File

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

2
pl/messages.yap
View File

@ -213,7 +213,7 @@ compose_message(Term, Level) -->
main_message( Term, Level, LC ),
[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] ] .
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) :-
'$yap_strip_module'(V, M, N),
'$check_top_op'(P,T,N,M,op(P,T,V)).
'$check_op'(P,T,V,op(P,T,V)),
'$op'(P, T, V).
% 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)), !,
'$do_error'(instantiation_error,G).
'$check_top_op'(P,_,_,_,G) :-
'$check_op'(P,_,_,G) :-
\+ integer(P), !,
'$do_error'(type_error(integer,P),G).
'$check_top_op'(P,_,_,_,G) :-
'$check_op'(P,_,_,G) :-
P < 0, !,
'$do_error'(domain_error(operator_priority,P),G).
'$check_top_op'(_,T,_,_,G) :-
'$check_op'(_,T,_,G) :-
\+ atom(T), !,
'$do_error'(type_error(atom,T),G).
'$check_top_op'(_,T,_,_,G) :-
'$check_op'(_,T,_,G) :-
\+ '$associativity'(T), !,
'$do_error'(domain_error(operator_specifier,T),G).
'$check_top_op'(P, T, M:Op, _M, G) :- !,
'$vsc_strip_module'(M:Op, M1, Op1),
(
atom(M1)
->
'$check_top_op'(P, T, Op1, M1, G)
;
'$do_error'(type_error(atom,Op),G)
).
'$check_top_op'(P, T, [Op|NV], M, G) :- !,
'$check_top_op'(P, T, Op, M, G),
(NV = []
->
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).
'$check_op'(P,T,V,G) :-
'$check_module_for_op'(V, G, NV),
'$check_top_op'(P, T, NV, G).
'$check_top_op'(_, _, [], _) :- !.
'$check_top_op'(P, T, [Op|NV], G) :- !,
'$check_ops'(P, T, Op.NV, G).
'$check_top_op'(P, T, V, G) :-
atom(V), !,
'$check_op_name'(P, T, V, G).
'$check_top_op'(_P, _T, V, G) :-
'$do_error'(type_error(atom,V),G).
'$associativity'(xfx).
'$associativity'(xfy).
@ -97,16 +89,43 @@ a postfix operator.
'$associativity'(fx).
'$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), !,
'$do_error'(instantiation_error,G).
'$check_op_name'(_,_,',',_,G) :- !,
'$check_op_name'(_,_,',',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).
'$check_op_name'(_,_,'{}',_,G) :- T \= yf, T\= xf, !,
'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'{}'),G).
'$check_op_name'(P,T,'|',_,G) :-
'$check_op_name'(P,T,'|',G) :-
(
integer(P),
P < 1001, P > 0
@ -114,31 +133,77 @@ a postfix operator.
atom_codes(T,[_,_])
), !,
'$do_error'(permission_error(create,operator,'|'),G).
'$check_op_name'(P,T,A,M,_G) :-
atom(A), !,
'$opdec'( P, T, A, M).
'$check_op_name'(_,_,A,_,G) :-
'$check_op_name'(_,_,V,_) :-
atom(V), !.
'$check_op_name'(_,_,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
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) :-
'$yap_strip_module'(V,M,O),
'$do_current_op'(X, Y, O, M).
current_op(X,Y,V) :- var(V), !,
'$current_module'(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),
\+ '$associativity'(Y),
'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
'$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)
;

3
utf8proc/utf8proc.h
View File

@ -92,7 +92,8 @@ typedef unsigned int utf8proc_size_t;
# endif
# ifndef __cplusplus
typedef unsigned char utf8proc_bool;
enum {false, true};
#define false 0
#define true 1
# else
typedef bool utf8proc_bool;
# endif