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 */

66
C/adtdefs.c
View File

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

1792
C/atomic.c
View File

File diff suppressed because it is too large Load Diff

4
C/c_interface.c
View File

@ -83,7 +83,7 @@ X_API int YAP_Reset(yap_reset_t mode);
#define strncat(X, Y, Z) strcat(X, Y)
#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;

14
C/flags.c
View File

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

2
C/heapgc.c
View File

@ -2035,7 +2035,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, bool very_verbose
#endif /* TABLING */
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;
}

113
C/parser.c
View File

@ -164,9 +164,9 @@ typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
static void GNextToken(CACHE_TYPE1);
static void 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;
@ -512,8 +524,8 @@ 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) {
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
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;

23
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

16
library/matrix.yap
View File

@ -29,14 +29,8 @@
[(<==)/2, op(800, xfx, '<=='),
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(450, xfx, ..), % should bind more tightly than \/
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.

5
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
@ -265,7 +262,7 @@ void Yap_InitConsole(void) {
Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("prompt", 2, prompt, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$ensure_prompting", 0, ensure_prompting, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$ensure_prompting", 0, ensure_prompting, SafePredFlag|SyncPredFlag);
}

36
os/files.c
View File

@ -222,7 +222,11 @@ exists_file(USES_REGS1)
/* ignore errors while checking a file */
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));

2056
os/iopreds.c
View File

File diff suppressed because it is too large Load Diff

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

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

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

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

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

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

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

6
os/iopreds.h
View File

@ -152,7 +152,7 @@ typedef struct read_data_t {
} read_data, *ReadData;
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);

50
os/mem.c
View File

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

228
os/readutil.c
View File

@ -28,13 +28,16 @@ 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;
bool binary_stream;
bool binary_stream;
if (sno < 0)
return FALSE;
@ -42,167 +45,168 @@ static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) {
binary_stream = GLOBAL_Stream[sno].status & Binary_Stream_f;
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) {
GLOBAL_Stream[sno].status |= Binary_Stream_f;
}
if (st->status & Binary_Stream_f) {
char *b = (char *)TR;
sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file);
char *b = (char *)TR;
sz = fread( b,1 , buf_sz, GLOBAL_Stream[sno].file);
} else {
int ch;
int *pt = buf;
do {
int ch;
int *pt = buf;
do {
*pt++ = ch = st->stream_wgetc_for_read(sno);
if (pt + 1 == buf + buf_sz)
break;
} while (ch != '\n' && ch != EOF);
sz = pt - buf;
}
if (pt+1 == buf+buf_sz)
break;
} 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));
UNLOCK(GLOBAL_Stream[sno].streamlock);
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';
else
buf[sz - 1] = '\0';
UNLOCK(GLOBAL_Stream[sno].streamlock);
/* handle CR before NL */
if ((Int)sz-2 >= 0 && buf[sz-2] == 13)
buf[sz-2] = '\0';
else
buf[sz-1] = '\0';
} else {
UNLOCK(GLOBAL_Stream[sno].streamlock);
UNLOCK(GLOBAL_Stream[sno].streamlock);
}
if (arity == 2)
end = TermNil;
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));
end = Deref(XREGS[arity]);
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);
return FALSE;
return FALSE;
}
}
}
static Int read_line_to_codes(USES_REGS1) {
static Int
read_line_to_codes(USES_REGS1)
{
return rl_to_codes(TermNil, FALSE, 2 PASS_REGS);
}
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);
if (st->status & Binary_Stream_f) {
char *b = (char *)TR;
sz = fread( b,1 , buf_sz, GLOBAL_Stream[sno].file);
} else {
uint32_t ch;
unsigned char *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)
break;
} while (ch != '\n');
sz = pt - buf;
}
int ch;
int *pt = buf;
do {
*pt++ = ch = st->stream_wgetc_for_read(sno);
if (pt+1 == buf+buf_sz)
break;
} while (ch != '\n');
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);
return FALSE;
return FALSE;
}
}
}
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,17 +278,19 @@ static Int read_stream_to_terms(USES_REGS1) {
*pt = Deref(ARG3);
break;
} else {
CELL *newpt = (CELL *)Yap_GetFromSlot(news);
*pt = AbsPair(newpt - 1);
Yap_PutInSlot(tails, (CELL)newpt);
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) {
CACHE_REGS
void
Yap_InitReadUtil(void)
{
CACHE_REGS
Term cm = CurrentModule;
CurrentModule = READUTIL_MODULE;
@ -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;

10
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))
pclose(GLOBAL_Stream[sno].file);
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

75
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);
@ -589,23 +594,22 @@ static const char *myrealpath( const char *path, char *out)
}
#endif
strcat(rc, b);
return rc;
return rc;
}
}
}
#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
@ -621,7 +625,7 @@ expandVars(const char *spec)
if (IsPairTerm(t))
return RepAtom(AtomOfTerm(HeadOfTerm(t)))->StrOfAE;
return NULL;
}
}
return spec;
}
@ -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;
@ -650,7 +654,7 @@ Yap_AbsoluteFile(const char *spec, bool ok)
}
/**
* generate absolute path and stores path in an user given buffer. If
* generate absolute path and stores path in an user given buffer. If
* NULL, uses a temporary buffer that must be quickly released.
*
* if ok first expand variable names and do globbing
@ -667,14 +671,12 @@ Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok)
const char*p;
const char*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;
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;
@ -903,7 +904,7 @@ static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()};
static Term
do_expand_file_name(Term t1, Term opts USES_REGS)
{
{
xarg *args;
expand_filename_enum_choices_t i;
bool use_system_expansion = true;
@ -925,6 +926,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
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;
@ -971,7 +973,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
/* @pred expand_file_name( +Pattern, -ListOfPaths) is det
This builtin receives a pattern and expands it into a list of files.
In Unix-like systems, YAP applies glob to expand patterns such as '*', '.', and '?'. Further variable expansion
In Unix-like systems, YAP applies glob to expand patterns such as '*', '.', and '?'. Further variable expansion
may also happen. glob is shell-dependent: som Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0);
Yap_InitCPred ("real_path", 2, prolog_realpath, 0);
Yap_InitCPred ("true_file_name", 2,
@ -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;
}
@ -1788,7 +1790,7 @@ p_mv ( USES_REGS1 )
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
} else {
oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE;
newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE;
newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE;
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
unlink (newname);
if (r != 0) {
@ -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 );

179
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)));
hrtime_t tp = gethrtime();
/* return time in milliseconds */
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;
gettimeofday(&tp, NULL);
Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
}
void
Yap_InitLastWTime(void) {
GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeval));
LastWTime.tv_usec = StartOfWTimes.tv_usec;
LastWTime.tv_sec = StartOfWTimes.tv_sec;
}
Int
Yap_walltime (void)
/// returns time in nano-secs since the epoch
uint64_t
Yap_walltime(void)
{
struct timeval tp;
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,103 +588,68 @@ 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();
}
}
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,_ ) ),_), _ ) -->

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

5
utf8proc/utf8proc.h
View File

@ -83,7 +83,7 @@ typedef short utf8proc_int16_t;
typedef unsigned short utf8proc_uint16_t;
typedef int utf8proc_int32_t;
typedef unsigned int utf8proc_uint32_t;
# ifdef _WIN64
# ifdef _WIN64
typedef __int64 utf8proc_ssize_t;
typedef unsigned __int64 utf8proc_size_t;
# else
@ -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