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

blanks and backslashed strings

Browse Source
This commit is contained in:
Vitor Santos Costa 2015-02-10 00:03:02 +00:00
parent 888a58b715
commit afd8c9b9c4
20 changed files with 6953 additions and 2086 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/grow.c
View File

@ -737,6 +737,8 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep USES_REGS)
break; break;
case Var_tok: case Var_tok:
case String_tok: case String_tok:
case WString_tok:
case StringTerm_tok:
if (IsOldTrail(tks->TokInfo)) if (IsOldTrail(tks->TokInfo))
tks->TokInfo = TrailAdjust(tks->TokInfo); tks->TokInfo = TrailAdjust(tks->TokInfo);
break; break;

6
C/iopreds.c
View File

@ -356,6 +356,12 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
} }
break; break;
case StringTerm_tok:
{
Term t0 = MkStringTerm((const char *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok: case WString_tok:
{ {
Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS); Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS);

297
C/parser.c
View File

@ -136,7 +136,6 @@ dot with single quotes.
* *
*/ */
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
@ -157,12 +156,9 @@ dot with single quotes.
#define Volatile #define Volatile
#endif #endif
/* weak backtraking mechanism based on long_jump */ /* weak backtraking mechanism based on long_jump */
typedef struct jmp_buff_struct { typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
sigjmp_buf JmpBuff;
} JMPBUFF;
static void GNextToken(CACHE_TYPE1); static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE); static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE);
@ -170,9 +166,9 @@ static Term ParseArgs(read_data *, Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(read_data *, JMPBUFF *CACHE_TYPE); static Term ParseList(read_data *, JMPBUFF *CACHE_TYPE);
static Term ParseTerm(read_data *, int, JMPBUFF *CACHE_TYPE); static Term ParseTerm(read_data *, int, JMPBUFF *CACHE_TYPE);
#define TRY(S, P) \ #define TRY(S, P) \
{ Volatile JMPBUFF *saveenv, newenv; \ { \
Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT = LOCAL_tokptr; \ Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH = HR; \ Volatile CELL *saveH = HR; \
Volatile int savecurprio = curprio; \ Volatile int savecurprio = curprio; \
@ -182,8 +178,8 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
S; \ S; \
FailBuff = saveenv; \ FailBuff = saveenv; \
P; \ P; \
} \ } else { \
else { FailBuff=saveenv; \ FailBuff = saveenv; \
HR = saveH; \ HR = saveH; \
curprio = savecurprio; \ curprio = savecurprio; \
LOCAL_tokptr = saveT; \ LOCAL_tokptr = saveT; \
@ -191,7 +187,8 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
} }
#define TRY3(S, P, F) \ #define TRY3(S, P, F) \
{ Volatile JMPBUFF *saveenv, newenv; \ { \
Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT = LOCAL_tokptr; \ Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH = HR; \ Volatile CELL *saveH = HR; \
saveenv = FailBuff; \ saveenv = FailBuff; \
@ -200,19 +197,17 @@ static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
S; \ S; \
FailBuff = saveenv; \ FailBuff = saveenv; \
P; \ P; \
} \ } else { \
else { \
FailBuff = saveenv; \ FailBuff = saveenv; \
HR = saveH; \ HR = saveH; \
LOCAL_tokptr = saveT; \ LOCAL_tokptr = saveT; \
F } \ F \
} \
} }
#define FAIL siglongjmp(FailBuff->JmpBuff, 1) #define FAIL siglongjmp(FailBuff->JmpBuff, 1)
VarEntry * VarEntry *Yap_LookupVar(char *var) /* lookup variable in variables table */
Yap_LookupVar(char *var) /* lookup variable in variables table */
{ {
CACHE_REGS CACHE_REGS
VarEntry *p; VarEntry *p;
@ -271,9 +266,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
return (p); return (p);
} }
static Term static Term VarNames(VarEntry *p, Term l USES_REGS) {
VarNames(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) { if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) { if (strcmp(p->VarRep, "_") != 0) {
Term t[2]; Term t[2];
@ -297,16 +290,12 @@ VarNames(VarEntry *p,Term l USES_REGS)
} }
} }
Term Term Yap_VarNames(VarEntry *p, Term l) {
Yap_VarNames(VarEntry *p,Term l)
{
CACHE_REGS CACHE_REGS
return VarNames(p, l PASS_REGS); return VarNames(p, l PASS_REGS);
} }
static Term static Term Singletons(VarEntry *p, Term l USES_REGS) {
Singletons(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) { if (p != NULL) {
if (p->VarRep && p->VarRep[0] != '_' && p->refs == 1) { if (p->VarRep && p->VarRep[0] != '_' && p->refs == 1) {
Term t[2]; Term t[2];
@ -315,7 +304,8 @@ Singletons(VarEntry *p,Term l USES_REGS)
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep)); t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep));
t[1] = p->VarAdr; t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t); o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, Singletons(p->VarRight, o = MkPairTerm(o,
Singletons(p->VarRight,
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS)); Singletons(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
save_machine_regs(); save_machine_regs();
@ -323,27 +313,25 @@ Singletons(VarEntry *p,Term l USES_REGS)
} }
return (o); return (o);
} else { } else {
return Singletons(p->VarRight,Singletons(p->VarLeft,l PASS_REGS) PASS_REGS); return Singletons(p->VarRight,
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS);
} }
} else { } else {
return (l); return (l);
} }
} }
Term Term Yap_Singletons(VarEntry *p, Term l) {
Yap_Singletons(VarEntry *p,Term l)
{
CACHE_REGS CACHE_REGS
return Singletons(p, l PASS_REGS); return Singletons(p, l PASS_REGS);
} }
static Term Variables(VarEntry *p, Term l USES_REGS) {
static Term
Variables(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) { if (p != NULL) {
Term o; Term o;
o = MkPairTerm(p->VarAdr, Variables(p->VarRight,Variables(p->VarLeft,l PASS_REGS) PASS_REGS)); o = MkPairTerm(
p->VarAdr,
Variables(p->VarRight, Variables(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch, 1); siglongjmp(LOCAL_IOBotch, 1);
@ -354,23 +342,18 @@ Variables(VarEntry *p,Term l USES_REGS)
} }
} }
Term Term Yap_Variables(VarEntry *p, Term l) {
Yap_Variables(VarEntry *p,Term l)
{
CACHE_REGS CACHE_REGS
return Variables(p, l PASS_REGS); return Variables(p, l PASS_REGS);
} }
static int static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) {
IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
{
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && if (opp->OpModule && opp->OpModule != CurrentModule) {
opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return FALSE;
} }
@ -386,23 +369,18 @@ IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
} }
} }
int int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
Yap_IsPrefixOp(Atom op,int *pptr, int *rpptr)
{
CACHE_REGS CACHE_REGS
return IsPrefixOp(op, pptr, rpptr PASS_REGS); return IsPrefixOp(op, pptr, rpptr PASS_REGS);
} }
static int static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) {
IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
{
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && if (opp->OpModule && opp->OpModule != CurrentModule) {
opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return FALSE;
} }
@ -420,23 +398,18 @@ IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
} }
} }
int int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr)
{
CACHE_REGS CACHE_REGS
return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS); return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS);
} }
static int static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) {
IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
{
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && if (opp->OpModule && opp->OpModule != CurrentModule) {
opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return FALSE;
} }
@ -452,16 +425,12 @@ IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
} }
} }
int int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr)
{
CACHE_REGS CACHE_REGS
return IsPosfixOp(op, pptr, lpptr PASS_REGS); return IsPosfixOp(op, pptr, lpptr PASS_REGS);
} }
inline static void inline static void GNextToken(USES_REGS1) {
GNextToken( USES_REGS1 )
{
if (LOCAL_tokptr->Tok == Ord(eot_tok)) if (LOCAL_tokptr->Tok == Ord(eot_tok))
return; return;
if (LOCAL_tokptr == LOCAL_toktide) if (LOCAL_tokptr == LOCAL_toktide)
@ -470,21 +439,17 @@ GNextToken( USES_REGS1 )
LOCAL_tokptr = LOCAL_tokptr->TokNext; LOCAL_tokptr = LOCAL_tokptr->TokNext;
} }
inline static void inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
{ LOCAL_tokptr->TokInfo != (Term)c)
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)
|| LOCAL_tokptr->TokInfo != (Term)c)
FAIL; FAIL;
NextToken; NextToken;
} }
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
static int is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat) {
static int CACHE_REGS
is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
{ CACHE_REGS
Term m = CurrentModule, t; Term m = CurrentModule, t;
Atom at; Atom at;
UInt arity; UInt arity;
@ -499,19 +464,18 @@ is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
return FALSE; return FALSE;
} }
static int static int get_quasi_quotation(term_t t, unsigned char **here,
get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein, unsigned char *ein, ReadData _PL_rd) {
ReadData _PL_rd) unsigned char *in, *start = *here;
{ unsigned char *in, *start = *here;
for(in=start; in <= ein; in++) for (in = start; in <= ein; in++) {
{ if ( in[0] == '}' && if (in[0] == '}' && in[-1] == '|') {
in[-1] == '|' ) *here = in + 1; /* after } */
{ *here = in+1; /* after } */
in--; /* Before | */ in--; /* Before | */
if (_PL_rd->quasi_quotations) /* option; must return strings */ if (_PL_rd->quasi_quotations) /* option; must return strings */
{ PL_chars_t txt; {
PL_chars_t txt;
int rc; int rc;
txt.text.t = (char *)start; txt.text.t = (char *)start;
@ -524,10 +488,9 @@ get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein,
PL_free_text(&txt); PL_free_text(&txt);
return rc; return rc;
} else } else {
{ return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3, return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3,
PL_POINTER, _PL_rd, PL_POINTER, _PL_rd, PL_INTPTR, (intptr_t)(start),
PL_INTPTR, (intptr_t)(start),
PL_INTPTR, (intptr_t)(in - start)); PL_INTPTR, (intptr_t)(in - start));
} }
} }
@ -537,10 +500,8 @@ get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein,
} }
#endif /*O_QUASIQUOTATIONS*/ #endif /*O_QUASIQUOTATIONS*/
static Term ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff,
static Term Term arg1 USES_REGS) {
ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USES_REGS)
{
int nargs = 0; int nargs = 0;
Term *p, t; Term *p, t;
Functor func; Functor func;
@ -554,8 +515,8 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
*p = arg1; *p = arg1;
nargs++; nargs++;
ParserAuxSp = (char *)(p + 1); ParserAuxSp = (char *)(p + 1);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
&& LOCAL_tokptr->TokInfo == close) { LOCAL_tokptr->TokInfo == close) {
func = Yap_MkFunctor(a, 1); func = Yap_MkFunctor(a, 1);
if (func == NULL) { if (func == NULL) {
@ -620,8 +581,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
return t; return t;
} }
static Term MakeAccessor( Term t, Functor f USES_REGS ) static Term MakeAccessor(Term t, Functor f USES_REGS) {
{
UInt arity = ArityOfFunctor(FunctorOfTerm(t)), i; UInt arity = ArityOfFunctor(FunctorOfTerm(t)), i;
Term tf[2], tl = TermNil; Term tf[2], tl = TermNil;
@ -633,9 +593,7 @@ static Term MakeAccessor( Term t, Functor f USES_REGS )
return Yap_MkApplTerm(f, 2, tf); return Yap_MkApplTerm(f, 2, tf);
} }
static Term static Term ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS) {
ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
{
Term o; Term o;
CELL *to_store; CELL *to_store;
o = AbsPair(HR); o = AbsPair(HR);
@ -646,8 +604,8 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int)LOCAL_tokptr->TokInfo) == ',') { if (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken; NextToken;
if (LOCAL_tokptr->Tok == Ord(Name_tok) if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
&& strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) { strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) {
NextToken; NextToken;
to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS); to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS);
} else { } else {
@ -672,9 +630,7 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
return (o); return (o);
} }
static Term static Term ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS) {
ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
{
/* parse term with priority prio */ /* parse term with priority prio */
Volatile Term t; Volatile Term t;
Volatile Functor func; Volatile Functor func;
@ -705,10 +661,9 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
break; break;
} }
} }
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
|| Unsigned(LOCAL_tokptr->TokInfo) != 'l') Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
&& IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS) IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)) {
) {
if (LOCAL_tokptr->Tok == Name_tok) { if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo; Atom at = (Atom)LOCAL_tokptr->TokInfo;
#ifndef _MSC_VER #ifndef _MSC_VER
@ -743,22 +698,18 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; LOCAL_ErrorMessage = "Heap Overflow";
FAIL; FAIL;
} } t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} } curprio = opprio;
curprio = opprio; , break;)
,
break;
)
} }
} }
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
&& Unsigned(LOCAL_tokptr->TokInfo) == 'l') Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs(rd, (Atom)t, ')', FailBuff, 0L PASS_REGS); t = ParseArgs(rd, (Atom)t, ')', FailBuff, 0L PASS_REGS);
else else
t = MkAtomTerm((Atom)t); t = MkAtomTerm((Atom)t);
@ -777,8 +728,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
FAIL; FAIL;
} }
NextToken; NextToken;
} } break;
break;
case WString_tok: /* build list on the heap */ case WString_tok: /* build list on the heap */
{ {
@ -788,8 +738,17 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
FAIL; FAIL;
} }
NextToken; NextToken;
} break;
case StringTerm_tok: /* build list on the heap */
{
Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToString(p PASS_REGS);
if (!t) {
FAIL;
} }
break; NextToken;
} break;
case Var_tok: case Var_tok:
varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo); varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo);
@ -843,8 +802,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
} }
break; break;
case QuasiQuotes_tok: case QuasiQuotes_tok: {
{
qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo); qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo);
term_t pv, positions = rd->subtpos, to; term_t pv, positions = rd->subtpos, to;
Atom at; Atom at;
@ -855,23 +813,21 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
/* prepare (if we are the first in term) */ /* prepare (if we are the first in term) */
if (!rd->varnames) if (!rd->varnames)
rd->varnames = PL_new_term_ref(); rd->varnames = PL_new_term_ref();
if ( !rd->qq ) if (!rd->qq) {
{ if ( rd->quasi_quotations ) if (rd->quasi_quotations) {
{ rd->qq = rd->quasi_quotations; rd->qq = rd->quasi_quotations;
} else } else {
{ if ( !(rd->qq = PL_new_term_ref()) ) if (!(rd->qq = PL_new_term_ref()))
return FALSE; return FALSE;
} }
// create positions term // create positions term
if ( positions ) if (positions) {
{ if ( !(pv = PL_new_term_refs(3)) || if (!(pv = PL_new_term_refs(3)) ||
!PL_unify_term(positions, !PL_unify_term(positions, PL_FUNCTOR,
PL_FUNCTOR, FUNCTOR_quasi_quotation_position5, FUNCTOR_quasi_quotation_position5, PL_INTPTR,
PL_INTPTR, qq->start.charno, qq->start.charno, PL_VARIABLE, PL_TERM,
PL_VARIABLE, pv + 0, // leave three open slots
PL_TERM, pv+0, // leave three open slots PL_TERM, pv + 1, PL_TERM, pv + 2))
PL_TERM, pv+1,
PL_TERM, pv+2) )
return FALSE; return FALSE;
} else } else
pv = 0; pv = 0;
@ -892,21 +848,24 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4); tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
tnp = RepAppl(tn) + 1; tnp = RepAppl(tn) + 1;
tnp[0] = MkAtomTerm(at); tnp[0] = MkAtomTerm(at);
if ( !get_quasi_quotation(Yap_InitSlot( ArgOfTerm(2, tn) PASS_REGS), &qq->text, qq->text+strlen((const char *)qq->text), rd) ) if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn) PASS_REGS),
&qq->text,
qq->text + strlen((const char *)qq->text), rd))
FAIL; FAIL;
if ( positions ) if (positions) {
{ intptr_t qqend = qq->end.charno; intptr_t qqend = qq->end.charno;
// set_range_position(positions, -1, qqend PASS_LD); // set_range_position(positions, -1, qqend PASS_LD);
if ( !PL_unify_term( Yap_InitSlot( ArgOfTerm(2, t) PASS_REGS), if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t) PASS_REGS), PL_FUNCTOR,
PL_FUNCTOR, FUNCTOR_minus2, FUNCTOR_minus2, PL_INTPTR,
PL_INTPTR, qq->mid.charno+2, /* end of | token */ qq->mid.charno + 2, /* end of | token */
PL_INTPTR, qqend - 2)) /* end minus "|}" */ PL_INTPTR, qqend - 2)) /* end minus "|}" */
FAIL; FAIL;
} }
tnp[2] = Yap_GetFromSlot(rd->varnames PASS_REGS); /* Arg 3: the var dictionary */ tnp[2] =
Yap_GetFromSlot(rd->varnames PASS_REGS); /* Arg 3: the var dictionary */
/* Arg 4: the result */ /* Arg 4: the result */
t = ArgOfTerm(4, tn); t = ArgOfTerm(4, tn);
if (!(to = PL_new_term_ref()) || if (!(to = PL_new_term_ref()) ||
@ -923,20 +882,18 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
/* main loop to parse infix and posfix operators starts here */ /* main loop to parse infix and posfix operators starts here */
while (TRUE) { while (TRUE) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
&& Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) { Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo); Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) &&
&& opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */ /* try parsing as infix operator */
Volatile int oldprio = curprio; Volatile int oldprio = curprio;
TRY3( TRY3(func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
func = Yap_MkFunctor((Atom) LOCAL_tokptr->TokInfo, 2);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; LOCAL_ErrorMessage = "Heap Overflow";
FAIL; FAIL;
} } NextToken;
NextToken;
{ {
Term args[2]; Term args[2];
args[0] = t; args[0] = t;
@ -949,15 +906,11 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
} }
}, },
curprio = opprio; curprio = opprio;
opinfo = save_opinfo; opinfo = save_opinfo; continue;, opinfo = save_opinfo;
continue; curprio = oldprio;)
,
opinfo = save_opinfo;
curprio = oldprio;
)
} }
if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio &&
&& opprio <= prio && oplprio >= curprio) { oplprio >= curprio) {
/* parse as posfix operator */ /* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1); Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
if (func == NULL) { if (func == NULL) {
@ -977,8 +930,8 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
break; break;
} }
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 &&
prio >= 1000 && curprio <= 999) { curprio <= 999) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
@ -992,8 +945,8 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
curprio = 1000; curprio = 1000;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) &&
&& opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
@ -1007,21 +960,23 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) &&
&& opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptyBrackets, ')', FailBuff, t PASS_REGS); t = ParseArgs(rd, AtomEmptyBrackets, ')', FailBuff, t PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio PASS_REGS) IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&& opprio <= prio && oplprio >= curprio) { &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS); t = ParseArgs(rd, AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS); t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio PASS_REGS) IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&& opprio <= prio && oplprio >= curprio) { &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS); t = ParseArgs(rd, AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
curprio = opprio; curprio = opprio;
@ -1043,10 +998,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
return t; return t;
} }
Term Yap_Parse(read_data *rd) {
Term
Yap_Parse(read_data *rd)
{
CACHE_REGS CACHE_REGS
Volatile Term t; Volatile Term t;
JMPBUFF FailBuff; JMPBUFF FailBuff;
@ -1061,4 +1013,3 @@ Yap_Parse(read_data *rd)
} }
//! @} //! @}

361
C/scanner.c
View File

@ -104,7 +104,8 @@ Floating-point numbers are described by:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
where \a \\\<dot\\\> denotes the decimal-point character '.', where \a \\\<dot\\\> denotes the decimal-point character '.',
\a \\\<exponent-marker\\\> denotes one of 'e' or 'E', and \a \\\<sign\\\> denotes \a \\\<exponent-marker\\\> denotes one of 'e' or 'E', and \a \\\<sign\\\>
denotes
one of '+' or '-'. one of '+' or '-'.
Examples: Examples:
@ -122,8 +123,10 @@ Strings are described by the following rules:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
string --> '"' string_quoted_characters '"' string --> '"' string_quoted_characters '"'
string --> '`' string_quoted_characters '`'
string_quoted_characters --> '"' '"' string_quoted_characters string_quoted_characters --> '"' '"' string_quoted_characters
string_quoted_characters --> '`' '`' string_quoted_characters
string_quoted_characters --> '\' string_quoted_characters --> '\'
escape_sequence string_quoted_characters escape_sequence string_quoted_characters
string_quoted_characters --> string_quoted_characters -->
@ -172,6 +175,15 @@ versions of YAP up to 4.2.0. Escape sequences can be disable by using:
:- yap_flag(character_escapes,false). :- yap_flag(character_escapes,false).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Since 6.3.4 YAP supports compact strings, that are not represented as
lists of codes, but instead as a sequence of UTF-8 encoded characters
in the execution stack. These strings do not require allocating a
symbol, as atoms do, but are much more compact than using lists of
codes.
+ Atoms Atoms + Atoms Atoms
Atoms are defined by one of the following rules: Atoms are defined by one of the following rules:
@ -249,7 +261,8 @@ a token are ignored.
All the text appearing in a line after the character \a % is taken to All the text appearing in a line after the character \a % is taken to
be a comment and ignored (including \a %). Comments can also be be a comment and ignored (including \a %). Comments can also be
inserted by using the sequence `/\*` to start the comment and inserted by using the sequence `/\*` to start the comment and
`\*` followed by `/` to finish it. In the presence of any sequence of comments or `\*` followed by `/` to finish it. In the presence of any sequence of comments
or
layout characters, the YAP parser behaves as if it had found a layout characters, the YAP parser behaves as if it had found a
single blank character. The end of a file also counts as a blank single blank character. The end of a file also counts as a blank
character for this purpose. character for this purpose.
@ -390,7 +403,6 @@ writing, writing a BOM can be requested using the option
*/ */
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
@ -420,8 +432,8 @@ writing, writing a BOM can be requested using the option
#endif #endif
/* You just can't trust some machines */ /* You just can't trust some machines */
#define my_isxdigit(C,SU,SL) (chtype(C) == NU || (C >= 'A' && \ #define my_isxdigit(C, SU, SL) \
C <= (SU)) || (C >= 'a' && C <= (SL))) (chtype(C) == NU || (C >= 'A' && C <= (SU)) || (C >= 'a' && C <= (SL)))
#define my_isupper(C) (C >= 'A' && C <= 'Z') #define my_isupper(C) (C >= 'A' && C <= 'Z')
#define my_islower(C) (C >= 'a' && C <= 'z') #define my_islower(C) (C >= 'a' && C <= 'z')
@ -429,85 +441,106 @@ static Term float_send(char *, int);
static Term get_num(int *, int *, IOSTREAM *, char *, UInt, int); static Term get_num(int *, int *, IOSTREAM *, char *, UInt, int);
/* token table with some help from Richard O'Keefe's PD scanner */ /* token table with some help from Richard O'Keefe's PD scanner */
static char chtype0[NUMBER_OF_CHARS+1] = static char chtype0[NUMBER_OF_CHARS + 1] = {
{
EF, EF,
/* nul soh stx etx eot enq ack bel bs ht nl vt np cr so si */ /* nul soh stx etx eot enq ack bel bs ht nl vt np cr so si
BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, */
BS, BS, BS, BS, BS, BS, BS, BS, BS,
BS, BS, BS, BS, BS, BS, BS,
/* dle dc1 dc2 dc3 dc4 nak syn etb can em sub esc fs gs rs us */ /* dle dc1 dc2 dc3 dc4 nak syn etb can em sub esc fs gs rs us
BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, */
BS, BS, BS, BS, BS, BS, BS, BS, BS,
BS, BS, BS, BS, BS, BS, BS,
/* sp ! " # $ % & ' ( ) * + , - . / */ /* sp ! " # $ % & ' ( ) * + , - . / */
BS, SL, DC, SY, LC, CC, SY, QT, BK, BK, SY, SY, BK, SY, SY, SY, BS, SL, DC, SY, LC, CC, SY, QT, BK,
BK, SY, SY, BK, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */ /* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */
NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, SY, SL, SY, SY, SY, SY, NU, NU, NU, NU, NU, NU, NU, NU, NU,
NU, SY, SL, SY, SY, SY, SY,
/* @ A B C D E F G H I J K L M N O */ /* @ A B C D E F G H I J K L M N O */
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, SY, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC,
/* P Q R S T U V W X Y Z [ \ ] ^ _ */ /* P Q R S T U V W X Y Z [ \ ] ^ _ */
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, BK, SY, BK, SY, UL, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, BK, SY, BK, SY, UL,
/* ` a b c d e f g h i j k l m n o */ /* ` a b c d e f g h i j k l m n o */
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, SY, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, LC, LC, LC, LC, LC,
/* p q r s t u v w x y z { | } ~ del */ /* p q r s t u v w x y z { | } ~ del */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, BK, BK, BK, SY, BS, LC, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, BK, BK, BK, SY, BS,
/* 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 */ /* 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, */
BS, BS, BS, BS, BS, BS, BS, BS, BS,
BS, BS, BS, BS, BS, BS, BS,
/* 144 145 ’ 147 148 149 150 151 152 153 154 155 156 157 158 159 */ /* 144 145 ’ 147 148 149 150 151 152 153 154 155 156 157 158 159
BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, */
BS, BS, BS, BS, BS, BS, BS, BS, BS,
BS, BS, BS, BS, BS, BS, BS,
/*   ¡ ¢ £ ¤ ¥ ¦ § ¨ © ª « ¬ ­ ® ¯ */ /*   ¡ ¢ £ ¤ ¥ ¦ § ¨ © ª « ¬ ­ ® ¯ */
BS, SY, SY, SY, SY, SY, SY, SY, SY, SY, LC, SY, SY, SY, SY, SY, BS, SY, SY, SY, SY, SY, SY, SY, SY,
SY, LC, SY, SY, SY, SY, SY,
/* ° ± ² ³ ´ µ ¶ · ¸ ¹ º » ¼ ½ ¾ ¿ */ /* ° ± ² ³ ´ µ ¶ · ¸ ¹ º » ¼ ½ ¾ ¿ */
SY, SY, LC, LC, SY, SY, SY, SY, SY, LC, LC, SY, SY, SY, SY, SY, SY, SY, LC, LC, SY, SY, SY, SY, SY,
LC, LC, SY, SY, SY, SY, SY,
/* À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï */ /* À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï */
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC,
/* Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß */ /* Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß */
#ifdef vms #ifdef vms
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, LC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, LC,
#else #else
UC, UC, UC, UC, UC, UC, UC, SY, UC, UC, UC, UC, UC, UC, UC, LC, UC, UC, UC, UC, UC, UC, UC, SY, UC,
UC, UC, UC, UC, UC, UC, LC,
#endif #endif
/* à á â ã ä å æ ç è é ê ë ì í î ï */ /* à á â ã ä å æ ç è é ê ë ì í î ï */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, LC, LC, LC, LC, LC,
/* ð ñ ò ó ô õ ö ÷ ø ù ú û ü cannot write the last three because of lcc */ /* ð ñ ò ó ô õ ö ÷ ø ù ú û ü cannot write the last
* three because of lcc */
#ifdef vms #ifdef vms
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC LC, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, LC, LC, LC, LC, LC
#else #else
LC, LC, LC, LC, LC, LC, LC, SY, LC, LC, LC, LC, LC, LC, LC, LC LC, LC, LC, LC, LC, LC, LC, SY, LC,
LC, LC, LC, LC, LC, LC, LC
#endif #endif
}; };
char *Yap_chtype = chtype0 + 1; char *Yap_chtype = chtype0 + 1;
int int Yap_wide_chtype(Int ch) {
Yap_wide_chtype(Int ch) {
#if HAVE_WCTYPE_H #if HAVE_WCTYPE_H
if (iswalnum(ch)) { if (iswalnum(ch)) {
if (iswlower(ch)) return LC; if (iswlower(ch))
if (iswdigit(ch)) return NU; return LC;
if (iswdigit(ch))
return NU;
return UC; return UC;
} }
if (iswpunct(ch)) return SY; if (iswpunct(ch))
return SY;
#endif #endif
return BS; return BS;
} }
static inline int getchr__(IOSTREAM *inp) {
static inline int int c = Sgetcode(inp);
getchr__(IOSTREAM *inp)
{ int c = Sgetcode(inp);
if (!CharConversionTable || c < 0 || c >= 256) if (!CharConversionTable || c < 0 || c >= 256)
return c; return c;
@ -515,27 +548,20 @@ getchr__(IOSTREAM *inp)
return CharConversionTable[c]; return CharConversionTable[c];
} }
#define getchr(inp) getchr__(inp) #define getchr(inp) getchr__(inp)
#define getchrq(inp) Sgetcode(inp) #define getchrq(inp) Sgetcode(inp)
static int static int GetCurInpPos(IOSTREAM *inp_stream) {
GetCurInpPos (IOSTREAM *inp_stream)
{
return inp_stream->posbuf.lineno; return inp_stream->posbuf.lineno;
} }
/* in case there is an overflow */ /* in case there is an overflow */
typedef struct scanner_extra_alloc { typedef struct scanner_extra_alloc {
struct scanner_extra_alloc *next; struct scanner_extra_alloc *next;
void *filler; void *filler;
} ScannerExtraBlock; } ScannerExtraBlock;
static char * static char *AllocScannerMemory(unsigned int size) {
AllocScannerMemory(unsigned int size)
{
CACHE_REGS CACHE_REGS
char *AuxSpScan; char *AuxSpScan;
@ -544,7 +570,8 @@ AllocScannerMemory(unsigned int size)
if (LOCAL_ScannerExtraBlocks) { if (LOCAL_ScannerExtraBlocks) {
struct scanner_extra_alloc *ptr; struct scanner_extra_alloc *ptr;
if (!(ptr = (struct scanner_extra_alloc *)malloc(size+sizeof(ScannerExtraBlock)))) { if (!(ptr = (struct scanner_extra_alloc *)malloc(
size + sizeof(ScannerExtraBlock)))) {
return NULL; return NULL;
} }
ptr->next = LOCAL_ScannerExtraBlocks; ptr->next = LOCAL_ScannerExtraBlocks;
@ -558,7 +585,8 @@ AllocScannerMemory(unsigned int size)
if (!Yap_growtrail(alloc_size, TRUE)) { if (!Yap_growtrail(alloc_size, TRUE)) {
struct scanner_extra_alloc *ptr; struct scanner_extra_alloc *ptr;
if (!(ptr = (struct scanner_extra_alloc *)malloc(size+sizeof(ScannerExtraBlock)))) { if (!(ptr = (struct scanner_extra_alloc *)malloc(
size + sizeof(ScannerExtraBlock)))) {
return NULL; return NULL;
} }
ptr->next = LOCAL_ScannerExtraBlocks; ptr->next = LOCAL_ScannerExtraBlocks;
@ -570,9 +598,7 @@ AllocScannerMemory(unsigned int size)
return AuxSpScan; return AuxSpScan;
} }
static void static void PopScannerMemory(char *block, unsigned int size) {
PopScannerMemory(char *block, unsigned int size)
{
CACHE_REGS CACHE_REGS
if (block == LOCAL_ScannerStack - size) { if (block == LOCAL_ScannerStack - size) {
LOCAL_ScannerStack -= size; LOCAL_ScannerStack -= size;
@ -584,18 +610,14 @@ PopScannerMemory(char *block, unsigned int size)
} }
} }
char * char *Yap_AllocScannerMemory(unsigned int size) {
Yap_AllocScannerMemory(unsigned int size)
{
/* I assume memory has been initialised */ /* I assume memory has been initialised */
return AllocScannerMemory(size); return AllocScannerMemory(size);
} }
extern double atof(const char *); extern double atof(const char *);
static Term static Term float_send(char *s, int sign) {
float_send(char *s, int sign)
{
GET_LD GET_LD
Float f = (Float)(sign * atof(s)); Float f = (Float)(sign * atof(s));
#if HAVE_ISFINITE || defined(isfinite) #if HAVE_ISFINITE || defined(isfinite)
@ -617,9 +639,7 @@ float_send(char *s, int sign)
} }
/* we have an overflow at s */ /* we have an overflow at s */
static Term static Term read_int_overflow(const char *s, Int base, Int val, int sign) {
read_int_overflow(const char *s, Int base, Int val, int sign)
{
#ifdef USE_GMP #ifdef USE_GMP
/* try to scan it as a bignum */ /* try to scan it as a bignum */
mpz_t new; mpz_t new;
@ -638,17 +658,13 @@ read_int_overflow(const char *s, Int base, Int val, int sign)
#endif #endif
} }
static int static int send_error_message(char s[]) {
send_error_message(char s[])
{
CACHE_REGS CACHE_REGS
LOCAL_ErrorMessage = s; LOCAL_ErrorMessage = s;
return 0; return 0;
} }
static wchar_t static wchar_t read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream) {
read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
{
GET_LD GET_LD
int ch; int ch;
@ -665,7 +681,8 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
case 'b': case 'b':
return '\b'; return '\b';
case 'c': case 'c':
while (chtype((ch = getchrq(inp_stream))) == BS); while (chtype((ch = getchrq(inp_stream))) == BS)
;
{ {
if (ch == '\\') { if (ch == '\\') {
goto do_switch; goto do_switch;
@ -686,8 +703,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
return ' '; return ' ';
case 't': case 't':
return '\t'; return '\t';
case 'u': case 'u': {
{
int i; int i;
wchar_t wc = '\0'; wchar_t wc = '\0';
@ -705,8 +721,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
} }
return wc; return wc;
} }
case 'U': case 'U': {
{
int i; int i;
wchar_t wc = '\0'; wchar_t wc = '\0';
@ -789,12 +804,16 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
unsigned char so_far = 0; unsigned char so_far = 0;
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
if (my_isxdigit(ch, 'f', 'F')) { /* hexa */ if (my_isxdigit(ch, 'f', 'F')) { /* hexa */
so_far = so_far * 16 + (chtype(ch) == NU ? ch - '0' : so_far =
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); so_far * 16 + (chtype(ch) == NU
? ch - '0'
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
if (my_isxdigit(ch, 'f', 'F')) { /* hexa */ if (my_isxdigit(ch, 'f', 'F')) { /* hexa */
so_far = so_far * 16 + (chtype(ch) == NU ? ch - '0' : so_far =
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); so_far * 16 + (chtype(ch) == NU
? ch - '0'
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
if (ch == '\\') { if (ch == '\\') {
return so_far; return so_far;
@ -820,9 +839,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
} }
} }
static int static int num_send_error_message(char s[]) {
num_send_error_message(char s[])
{
CACHE_REGS CACHE_REGS
LOCAL_ErrorMessage = s; LOCAL_ErrorMessage = s;
return TermNil; return TermNil;
@ -830,10 +847,8 @@ num_send_error_message(char s[])
/* reads a number, either integer or float */ /* reads a number, either integer or float */
static Term get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s,
static Term UInt max_size, int sign) {
get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, int sign)
{
GET_LD GET_LD
char *sp = s; char *sp = s;
int ch = *chp; int ch = *chp;
@ -886,8 +901,9 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
while (my_isxdigit(ch, upper_case, lower_case)) { while (my_isxdigit(ch, upper_case, lower_case)) {
Int oval = val; Int oval = val;
int chval = (chtype(ch) == NU ? ch - '0' : int chval =
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (chtype(ch) == NU ? ch - '0'
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (--max_size == 0) { if (--max_size == 0) {
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
@ -907,8 +923,9 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
ch = getchr(inp_stream); ch = getchr(inp_stream);
while (my_isxdigit(ch, 'F', 'f')) { while (my_isxdigit(ch, 'F', 'f')) {
Int oval = val; Int oval = val;
int chval = (chtype(ch) == NU ? ch - '0' : int chval =
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (chtype(ch) == NU ? ch - '0'
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (--max_size == 0) { if (--max_size == 0) {
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
@ -919,8 +936,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
*chp = ch; *chp = ch;
} } else if (ch == 'o' && base == 0) {
else if (ch == 'o' && base == 0) {
might_be_float = FALSE; might_be_float = FALSE;
base = 8; base = 8;
ch = getchr(inp_stream); ch = getchr(inp_stream);
@ -959,7 +975,8 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
if (chtype(ch = getchr(inp_stream)) != NU) { if (chtype(ch = getchr(inp_stream)) != NU) {
if (ch == 'e' || ch == 'E') { if (ch == 'e' || ch == 'E') {
if (truePrologFlag(PLFLAG_ISO)) if (truePrologFlag(PLFLAG_ISO))
return num_send_error_message("Float format not allowed in ISO mode"); return num_send_error_message(
"Float format not allowed in ISO mode");
} else { /* followed by a letter, end of term? */ } else { /* followed by a letter, end of term? */
sp[0] = '\0'; sp[0] = '\0';
*chbuffp = '.'; *chbuffp = '.';
@ -972,7 +989,8 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
} }
} }
#if O_LOCALE #if O_LOCALE
if ((decimalpoint = (unsigned char*) ( localeconv()->decimal_point )) == NULL) if ((decimalpoint = (unsigned char *)(localeconv()->decimal_point)) ==
NULL)
#endif #endif
decimalpoint = (const unsigned char *)"."; decimalpoint = (const unsigned char *)".";
dp = (unsigned char *)decimalpoint; dp = (unsigned char *)decimalpoint;
@ -990,8 +1008,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
*sp++ = ch; *sp++ = ch;
} } while (chtype(ch = getchr(inp_stream)) == NU);
while (chtype(ch = getchr(inp_stream)) == NU);
} }
} }
if (ch == 'e' || ch == 'E') { if (ch == 'e' || ch == 'E') {
@ -1047,9 +1064,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
/* given a function getchr scan until we either find the number /* given a function getchr scan until we either find the number
or end of file */ or end of file */
Term Term Yap_scan_num(IOSTREAM *inp) {
Yap_scan_num(IOSTREAM *inp)
{
CACHE_REGS CACHE_REGS
Term out; Term out;
int sign = 1; int sign = 1;
@ -1089,7 +1104,6 @@ Yap_scan_num(IOSTREAM *inp)
return out; return out;
} }
#define CHECK_SPACE() \ #define CHECK_SPACE() \
if (ASP - HR < 1024) { \ if (ASP - HR < 1024) { \
LOCAL_ErrorMessage = "Stack Overflow"; \ LOCAL_ErrorMessage = "Stack Overflow"; \
@ -1101,9 +1115,7 @@ Yap_scan_num(IOSTREAM *inp)
return l; \ return l; \
} }
static void open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
static void
open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
CELL *h0 = HR; CELL *h0 = HR;
HR += 5; HR += 5;
h0[0] = AbsAppl(h0 + 2); h0[0] = AbsAppl(h0 + 2);
@ -1127,18 +1139,17 @@ open_comment(int ch, IOSTREAM *inp_stream USES_REGS) {
LOCAL_CommentsBuffPos = 1; LOCAL_CommentsBuffPos = 1;
} }
static void static void extend_comment(int ch USES_REGS) {
extend_comment(int ch USES_REGS) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = ch; LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = ch;
LOCAL_CommentsBuffPos++; LOCAL_CommentsBuffPos++;
if (LOCAL_CommentsBuffPos == LOCAL_CommentsBuffLim - 1) { if (LOCAL_CommentsBuffPos == LOCAL_CommentsBuffLim - 1) {
LOCAL_CommentsBuff = (wchar_t *)realloc(LOCAL_CommentsBuff,sizeof(wchar_t)*(LOCAL_CommentsBuffLim+4096)); LOCAL_CommentsBuff = (wchar_t *)realloc(
LOCAL_CommentsBuff, sizeof(wchar_t) * (LOCAL_CommentsBuffLim + 4096));
LOCAL_CommentsBuffLim += 4096; LOCAL_CommentsBuffLim += 4096;
} }
} }
static void static void close_comment(USES_REGS1) {
close_comment( USES_REGS1 ) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0'; LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS); *LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
free(LOCAL_CommentsBuff); free(LOCAL_CommentsBuff);
@ -1146,16 +1157,15 @@ close_comment( USES_REGS1 ) {
LOCAL_CommentsBuffLim = 0; LOCAL_CommentsBuffLim = 0;
} }
static wchar_t * static wchar_t *ch_to_wide(char *base, char *charp) {
ch_to_wide(char *base, char *charp)
{
CACHE_REGS CACHE_REGS
int n = charp - base, i; int n = charp - base, i;
wchar_t *nb = (wchar_t *)base; wchar_t *nb = (wchar_t *)base;
if ((nb + n) + 1024 > (wchar_t *)AuxSp) { if ((nb + n) + 1024 > (wchar_t *)AuxSp) {
LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; LOCAL_ErrorMessage =
"Heap Overflow While Scanning: please increase code space (-h)";
return NULL; return NULL;
} }
for (i = n; i > 0; i--) { for (i = n; i > 0; i--) {
@ -1165,23 +1175,37 @@ ch_to_wide(char *base, char *charp)
} }
#define add_ch_to_buff(ch) \ #define add_ch_to_buff(ch) \
if (wcharp) { *wcharp++ = (ch); if (wcharp >= (wchar_t *)AuxSp-1024) goto huge_var_error; charp = (char *)wcharp; } \ if (wcharp) { \
else { \ *wcharp++ = (ch); \
if (wcharp >= (wchar_t *)AuxSp - 1024) \
goto huge_var_error; \
charp = (char *)wcharp; \
} else { \
if (ch > MAX_ISO_LATIN1 && !wcharp) { \ if (ch > MAX_ISO_LATIN1 && !wcharp) { \
/* does not fit in ISO-LATIN */ \ /* does not fit in ISO-LATIN */ \
wcharp = ch_to_wide(TokImage, charp); \ wcharp = ch_to_wide(TokImage, charp); \
if (!wcharp) goto huge_var_error; \ if (!wcharp) \
*wcharp++ = (ch); charp = (char *)wcharp; \ goto huge_var_error; \
} else { if (charp >= (char *)AuxSp-1024) goto huge_var_error; *charp++ = ch; } \ *wcharp++ = (ch); \
charp = (char *)wcharp; \
} else { \
if (charp >= (char *)AuxSp - 1024) \
goto huge_var_error; \
*charp++ = ch; \
} \
} }
#define add_ch_to_utf8_buff(ch) \ #define add_ch_to_utf8_buff(ch) \
{ if ( (ch &0xff) == ch) { *charp++ = ch; } else \ { \
{ charp = _PL__utf8_put_char(charp, ch); } } if ((ch & 0xff) == ch) { \
*charp++ = ch; \
} else { \
charp = _PL__utf8_put_char(charp, ch); \
} \
}
TokEntry * TokEntry *Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp,
Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0) void *rd0) {
{
GET_LD GET_LD
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
enum TokenKinds kind; enum TokenKinds kind;
@ -1213,7 +1237,6 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
unsigned int len; unsigned int len;
char *TokImage = NULL; char *TokImage = NULL;
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
t->TokNext = NULL; t->TokNext = NULL;
if (t == NULL) { if (t == NULL) {
@ -1257,7 +1280,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
} }
close_comment(PASS_REGS1); close_comment(PASS_REGS1);
} else { } else {
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF); while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF)
;
} }
if (chtype(ch) != EF) { if (chtype(ch) != EF) {
/* blank space */ /* blank space */
@ -1341,8 +1365,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
} }
break; break;
case NU: case NU: {
{
int cherr; int cherr;
int cha = ch; int cha = ch;
char *ptr; char *ptr;
@ -1357,7 +1380,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
return l; return l;
} }
CHECK_SPACE(); CHECK_SPACE();
if ((t->TokInfo = get_num(&cha,&cherr,inp_stream,ptr,4096,1)) == 0L) { if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, ptr, 4096, 1)) ==
0L) {
if (p) if (p)
p->Tok = Ord(kind = eot_tok); p->Tok = Ord(kind = eot_tok);
/* serious error now */ /* serious error now */
@ -1450,11 +1474,11 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
} else { } else {
t->Tok = Ord(kind = Number_tok); t->Tok = Ord(kind = Number_tok);
} }
} } break;
break;
case QT: case QT:
case DC: case DC:
quoted_string:
TokImage = ((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE; TokImage = ((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage; charp = TokImage;
quote = ch; quote = ch;
@ -1465,7 +1489,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
while (TRUE) { while (TRUE) {
if (charp + 1024 > (char *)AuxSp) { if (charp + 1024 > (char *)AuxSp) {
LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; LOCAL_ErrorMessage =
"Heap Overflow While Scanning: please increase code space (-h)";
break; break;
} }
if (ch == 10 && truePrologFlag(PLFLAG_ISO)) { if (ch == 10 && truePrologFlag(PLFLAG_ISO)) {
@ -1479,7 +1504,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
break; break;
add_ch_to_buff(ch); add_ch_to_buff(ch);
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
} else if (ch == '\\' && Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) { } else if (ch == '\\' &&
Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) {
int scan_next = TRUE; int scan_next = TRUE;
if ((ch = read_quoted_char(&scan_next, inp_stream))) { if ((ch = read_quoted_char(&scan_next, inp_stream))) {
add_ch_to_buff(ch); add_ch_to_buff(ch);
@ -1499,7 +1525,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
if (charp > (char *)AuxSp - 1024) { if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */ /* Not enough space to read in the string. */
LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
LOCAL_ErrorMessage = "not enough space to read in string or quoted atom"; LOCAL_ErrorMessage =
"not enough space to read in string or quoted atom";
/* serious error now */ /* serious error now */
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
@ -1518,15 +1545,17 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
mp = AllocScannerMemory(len + 1); mp = AllocScannerMemory(len + 1);
} }
if (mp == NULL) { if (mp == NULL) {
LOCAL_ErrorMessage = "not enough heap space to read in string or quoted atom"; LOCAL_ErrorMessage =
"not enough heap space to read in string or quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
return l; return l;
} }
if (wcharp) if (wcharp) {
wcscpy((wchar_t *)mp, (wchar_t *)TokImage); wcscpy((wchar_t *)mp, (wchar_t *)TokImage);
else } else {
strcpy(mp, TokImage); strcpy(mp, TokImage);
}
t->TokInfo = Unsigned(mp); t->TokInfo = Unsigned(mp);
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
if (wcharp) { if (wcharp) {
@ -1534,6 +1563,27 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
} else { } else {
t->Tok = Ord(kind = String_tok); t->Tok = Ord(kind = String_tok);
} }
} else if (quote == '`') {
if (wcharp) {
mp = AllocScannerMemory( utf8_strlen1(TokImage) + 1 );
} else {
mp = AllocScannerMemory(len + 1);
}
if (mp == NULL) {
LOCAL_ErrorMessage =
"not enough heap space to read in string or quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
return l;
}
if (wcharp) {
utf8_wcscpy(mp, (const wchar_t *)TokImage);
} else {
strcpy(mp, TokImage);
}
t->TokInfo = Unsigned(mp);
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = StringTerm_tok);
} else { } else {
if (wcharp) { if (wcharp) {
t->TokInfo = Unsigned(Yap_LookupWideAtom((wchar_t *)TokImage)); t->TokInfo = Unsigned(Yap_LookupWideAtom((wchar_t *)TokImage));
@ -1556,6 +1606,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
break; break;
case SY: case SY:
if (ch == '`' && truePrologFlag(PLFLAG_BACKQUOTED_STRING))
goto quoted_string;
och = ch; och = ch;
ch = getchr(inp_stream); ch = getchr(inp_stream);
if (och == '/' && ch == '*') { if (och == '/' && ch == '*') {
@ -1597,10 +1649,11 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
goto restart; goto restart;
} }
enter_symbol: enter_symbol:
if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF if (och == '.' &&
|| chtype(ch) == CC)) { (chtype(ch) == BS || chtype(ch) == EF || chtype(ch) == CC)) {
if (chtype(ch) == CC) if (chtype(ch) == CC)
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF); while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF)
;
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
} else { } else {
Atom ae; Atom ae;
@ -1646,8 +1699,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
} }
break; break;
case SL: case SL: {
{
char chs[2]; char chs[2];
chs[0] = ch; chs[0] = ch;
chs[1] = '\0'; chs[1] = '\0';
@ -1656,15 +1708,16 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
} } break;
break;
case BK: case BK:
och = ch; och = ch;
ch = getchr(inp_stream); ch = getchr(inp_stream);
t->TokInfo = och; t->TokInfo = och;
if (och == '(') { if (och == '(') {
while (chtype(ch) == BS) { ch = getchr(inp_stream); }; while (chtype(ch) == BS) {
ch = getchr(inp_stream);
};
if (ch == ')') { if (ch == ')') {
t->TokInfo = Unsigned(AtomEmptyBrackets); t->TokInfo = Unsigned(AtomEmptyBrackets);
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
@ -1676,7 +1729,9 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
solo_flag = TRUE; solo_flag = TRUE;
} }
} else if (och == '[') { } else if (och == '[') {
while (chtype(ch) == BS) { ch = getchr(inp_stream); }; while (chtype(ch) == BS) {
ch = getchr(inp_stream);
};
if (ch == ']') { if (ch == ']') {
t->TokInfo = Unsigned(AtomNil); t->TokInfo = Unsigned(AtomNil);
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
@ -1712,7 +1767,9 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
solo_flag = FALSE; solo_flag = FALSE;
break; break;
} }
while (chtype(ch) == BS) { ch = getchr(inp_stream); }; while (chtype(ch) == BS) {
ch = getchr(inp_stream);
};
if (ch == '}') { if (ch == '}') {
t->TokInfo = Unsigned(AtomBraces); t->TokInfo = Unsigned(AtomBraces);
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
@ -1741,7 +1798,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
TokImage = Yap_PreAllocCodeSpace(); TokImage = Yap_PreAllocCodeSpace();
if (!TokImage) { if (!TokImage) {
LOCAL_ErrorMessage = "not enough heap space to read in a quasi quoted atom"; LOCAL_ErrorMessage =
"not enough heap space to read in a quasi quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
return l; return l;
@ -1773,7 +1831,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
if (charp > (char *)AuxSp - 1024) { if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */ /* Not enough space to read in the string. */
LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR; LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
LOCAL_ErrorMessage = "not enough space to read in string or quoted atom"; LOCAL_ErrorMessage =
"not enough space to read in string or quoted atom";
/* serious error now */ /* serious error now */
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
@ -1821,7 +1880,9 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
} }
#if DEBUG #if DEBUG
if(GLOBAL_Option[2]) fprintf(stderr,"[Token %d %ld]",Ord(kind),(unsigned long int)t->TokInfo); if (GLOBAL_Option[2])
fprintf(stderr, "[Token %d %ld]", Ord(kind),
(unsigned long int)t->TokInfo);
#endif #endif
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
/* insert an error token to inform the system of what happened */ /* insert an error token to inform the system of what happened */
@ -1845,9 +1906,8 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
return (l); return (l);
} }
void void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable, Term commentable) VarEntry *anonvartable, Term commentable) {
{
CACHE_REGS CACHE_REGS
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks; struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
while (ptr) { while (ptr) {
@ -1864,5 +1924,4 @@ Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartab
LOCAL_CommentsBuffLim = 0; LOCAL_CommentsBuffLim = 0;
} }
/// @} /// @}

273
C/write.c
View File

@ -60,7 +60,6 @@ typedef struct union_direct {
CELL *ptr; CELL *ptr;
} udirect; } udirect;
typedef struct rewind_term { typedef struct rewind_term {
struct rewind_term *parent; struct rewind_term *parent;
union { union {
@ -83,23 +82,22 @@ typedef struct write_globs {
#define lastw wglb->lw #define lastw wglb->lw
#define last_minus wglb->last_atom_minus #define last_minus wglb->last_atom_minus
static bool static bool callPortray(Term t, struct DB_TERM **old_EXp USES_REGS) {
callPortray(Term t, struct DB_TERM **old_EXp USES_REGS)
{
PredEntry *pe; PredEntry *pe;
Int b0 = LCL0 - (CELL *)B; Int b0 = LCL0 - (CELL *)B;
EX = NULL; EX = NULL;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) && if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t PASS_REGS)) { Yap_execute_pred(pe, &t PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0); choiceptr B0 = (choiceptr)(LCL0 - b0);
if (EX && !*old_EXp) *old_EXp = EX; if (EX && !*old_EXp)
*old_EXp = EX;
Yap_fail_all(B0 PASS_REGS); Yap_fail_all(B0 PASS_REGS);
return true; return true;
} }
if (EX && !*old_EXp) *old_EXp = EX; if (EX && !*old_EXp)
*old_EXp = EX;
return false; return false;
} }
@ -111,7 +109,8 @@ static int legalAtom(unsigned char *);
static int RightOpToProtect(Atom, int);*/ static int RightOpToProtect(Atom, int);*/
static wtype AtomIsSymbols(unsigned char *); static wtype AtomIsSymbols(unsigned char *);
static void putAtom(Atom, int, struct write_globs *); static void putAtom(Atom, int, struct write_globs *);
static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *);
#define wrputc(X, WF) Sputcode(X, WF) /* writes a character */ #define wrputc(X, WF) Sputcode(X, WF) /* writes a character */
@ -119,9 +118,7 @@ static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_t
protect bracket from merging with previoous character. protect bracket from merging with previoous character.
avoid stuff like not (2,3) -> not(2,3) or avoid stuff like not (2,3) -> not(2,3) or
*/ */
static void static void wropen_bracket(struct write_globs *wglb, int protect) {
wropen_bracket(struct write_globs *wglb, int protect)
{
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (lastw != separator && protect) if (lastw != separator && protect)
@ -130,33 +127,27 @@ wropen_bracket(struct write_globs *wglb, int protect)
lastw = separator; lastw = separator;
} }
static void static void wrclose_bracket(struct write_globs *wglb, int protect) {
wrclose_bracket(struct write_globs *wglb, int protect)
{
wrf stream = wglb->stream; wrf stream = wglb->stream;
wrputc(')', stream); wrputc(')', stream);
lastw = separator; lastw = separator;
} }
static int static int protect_open_number(struct write_globs *wglb, int lm,
protect_open_number(struct write_globs *wglb, int lm, int minus_required) int minus_required) {
{
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (lastw == symbol && lm && !minus_required) { if (lastw == symbol && lm && !minus_required) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
return TRUE; return TRUE;
} else if (lastw == alphanum || } else if (lastw == alphanum || (lastw == symbol && minus_required)) {
(lastw == symbol && minus_required)) {
wrputc(' ', stream); wrputc(' ', stream);
} }
return FALSE; return FALSE;
} }
static void static void protect_close_number(struct write_globs *wglb, int used_bracket) {
protect_close_number(struct write_globs *wglb, int used_bracket)
{
if (used_bracket) { if (used_bracket) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} else { } else {
@ -165,8 +156,8 @@ protect_close_number(struct write_globs *wglb, int used_bracket)
last_minus = FALSE; last_minus = FALSE;
} }
static void static void wrputn(Int n,
wrputn(Int n, struct write_globs *wglb) /* writes an integer */ struct write_globs *wglb) /* writes an integer */
{ {
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -187,9 +178,7 @@ wrputn(Int n, struct write_globs *wglb) /* writes an integer */
#define wrputs(s, stream) Sfputs(s, stream) #define wrputs(s, stream) Sfputs(s, stream)
static void wrputws(wchar_t *s, wrf stream) /* writes a string */
static void
wrputws(wchar_t *s, wrf stream) /* writes a string */
{ {
while (*s) while (*s)
wrputc(*s++, stream); wrputc(*s++, stream);
@ -197,8 +186,7 @@ wrputws(wchar_t *s, wrf stream) /* writes a string */
#ifdef USE_GMP #ifdef USE_GMP
static char * static char *ensure_space(size_t sz) {
ensure_space(size_t sz) {
CACHE_REGS CACHE_REGS
char *s; char *s;
@ -228,15 +216,15 @@ ensure_space(size_t sz) {
if (!s) { if (!s) {
s = (char *)HR; s = (char *)HR;
if (s + sz >= (char *)ASP) { if (s + sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz); Yap_Error(OUT_OF_STACK_ERROR, TermNil,
"not enough space to write bignum: it requires %d bytes", sz);
s = NULL; s = NULL;
} }
} }
return s; return s;
} }
static void static void write_mpint(MP_INT *big, struct write_globs *wglb) {
write_mpint(MP_INT *big, struct write_globs *wglb) {
char *s; char *s;
int has_minus = mpz_sgn(big); int has_minus = mpz_sgn(big);
int ob; int ob;
@ -258,9 +246,8 @@ write_mpint(MP_INT *big, struct write_globs *wglb) {
#endif #endif
/* writes a bignum */ /* writes a bignum */
static void static void writebig(Term t, int p, int depth, int rinfixarg,
writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt) struct write_globs *wglb, struct rewind_term *rwt) {
{
CELL *pt = RepAppl(t) + 1; CELL *pt = RepAppl(t) + 1;
CELL big_tag = pt[0]; CELL big_tag = pt[0];
@ -271,8 +258,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
lastw = separator; lastw = separator;
return; return;
#ifdef USE_GMP #ifdef USE_GMP
} else if (big_tag == BIG_INT) } else if (big_tag == BIG_INT) {
{
MP_INT *big = Yap_BigIntOfTerm(t); MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, wglb); write_mpint(big, wglb);
return; return;
@ -295,8 +281,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
wrputs("0", wglb->stream); wrputs("0", wglb->stream);
} }
static void static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
wrputf(Float f, struct write_globs *wglb) /* writes a float */
{ {
char s[256]; char s[256];
@ -304,7 +289,6 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
int sgn; int sgn;
int ob; int ob;
#if HAVE_ISNAN || defined(__WIN32) #if HAVE_ISNAN || defined(__WIN32)
if (isnan(f)) { if (isnan(f)) {
wrputs("(nan)", stream); wrputs("(nan)", stream);
@ -332,8 +316,8 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
int ch; int ch;
/* always use C locale for writing numbers */ /* always use C locale for writing numbers */
#if O_LOCALE #if O_LOCALE
const unsigned char *decimalpoint = (unsigned char*) const unsigned char *decimalpoint =
localeconv()->decimal_point; (unsigned char *)localeconv()->decimal_point;
size_t l1 = strlen((const char *)decimalpoint + 1); size_t l1 = strlen((const char *)decimalpoint + 1);
#else #else
const unsigned char decimalpoint[2] = "."; const unsigned char decimalpoint[2] = ".";
@ -354,7 +338,8 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
} }
while ((ch = *pt) != '\0') { while ((ch = *pt) != '\0') {
// skip locale // skip locale
if (ch == decimalpoint[0] && !strncmp(pt+1, (char *)decimalpoint+1, l1)) { if (ch == decimalpoint[0] &&
!strncmp(pt + 1, (char *)decimalpoint + 1, l1)) {
found_dot = TRUE; found_dot = TRUE;
pt += l1; pt += l1;
ch = '.'; ch = '.';
@ -381,15 +366,14 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
} }
/* use SWI's format_float */ /* use SWI's format_float */
buf = format_float(f, s); buf = format_float(f, s);
if (!buf) return; if (!buf)
return;
wrputs(buf, stream); wrputs(buf, stream);
#endif #endif
protect_close_number(wglb, ob); protect_close_number(wglb, ob);
} }
int int Yap_FormatFloat(Float f, const char *s, size_t sz) {
Yap_FormatFloat( Float f, const char *s, size_t sz )
{
struct write_globs wglb; struct write_globs wglb;
char *ws = (char *)s; char *ws = (char *)s;
IOSTREAM *smem = Sopenmem(&ws, &sz, "w"); IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
@ -401,11 +385,9 @@ Yap_FormatFloat( Float f, const char *s, size_t sz )
return TRUE; return TRUE;
} }
/* writes a data base reference */ /* writes a data base reference */
static void static void wrputref(CODEADDR ref, int Quote_illegal,
wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb) struct write_globs *wglb) {
{
char s[256]; char s[256];
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -420,9 +402,8 @@ wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb)
} }
/* writes a blob (default) */ /* writes a blob (default) */
static int static int wrputblob(AtomEntry *ref, int Quote_illegal,
wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb) struct write_globs *wglb) {
{
char s[256]; char s[256];
wrf stream = wglb->stream; wrf stream = wglb->stream;
PL_blob_t *type = RepBlobProp(ref->PropsOfAE)->blob_t; PL_blob_t *type = RepBlobProp(ref->PropsOfAE)->blob_t;
@ -443,8 +424,7 @@ wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb)
return 1; return 1;
} }
static int static int legalAtom(unsigned char *s) /* Is this a legal atom ? */
legalAtom(unsigned char *s) /* Is this a legal atom ? */
{ {
wchar_t ch = *s; wchar_t ch = *s;
@ -461,7 +441,8 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */
return FALSE; return FALSE;
} else { } else {
if (ch == '/') { if (ch == '/') {
if (s[1] == '*') return FALSE; if (s[1] == '*')
return FALSE;
} }
while (ch) { while (ch) {
if (Yap_chtype[ch] != SY) { if (Yap_chtype[ch] != SY) {
@ -491,9 +472,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
return symbol; return symbol;
} }
static void static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
write_quoted(wchar_t ch, wchar_t quote, wrf stream)
{
CACHE_REGS CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) { if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream); wrputc(ch, stream);
@ -501,7 +480,7 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('\'', stream); /* be careful about quotes */ wrputc('\'', stream); /* be careful about quotes */
return; return;
} }
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\') { if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' && ch != '`') {
wrputc(ch, stream); wrputc(ch, stream);
} else { } else {
switch (ch) { switch (ch) {
@ -519,6 +498,11 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('\\', stream); wrputc('\\', stream);
wrputc(ch, stream); wrputc(ch, stream);
break; break;
case '`':
if (ch == quote)
wrputc('`', stream);
wrputc(ch, stream);
break;
case 7: case 7:
wrputc('\\', stream); wrputc('\\', stream);
wrputc('a', stream); wrputc('a', stream);
@ -563,33 +547,29 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
} }
} }
static void static void write_string(const char *s,
write_string(const char *s, struct write_globs *wglb) /* writes an integer */ struct write_globs *wglb) /* writes an integer */
{ {
IOSTREAM *stream = wglb->stream; IOSTREAM *stream = wglb->stream;
int chr; int chr, qt;
char *ptr = (char *)s; char *ptr = (char *)s;
if (wglb->Write_strings) if (wglb->Write_strings)
wrputc('`', stream); qt = '`';
else else
wrputc('"', stream); qt = '"';
wrputc(qt, stream);
do { do {
ptr = utf8_get_char(ptr, &chr); ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break; if (chr == '\0')
write_quoted(chr, '"', stream); break;
write_quoted(chr, qt, stream);
} while (TRUE); } while (TRUE);
if (wglb->Write_strings) wrputc(qt, stream);
wrputc('`', stream);
else
wrputc('"', stream);
} }
/* writes an atom */ /* writes an atom */
static void static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
{
unsigned char *s; unsigned char *s;
wtype atom_or_symbol; wtype atom_or_symbol;
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -616,7 +596,8 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
s = (unsigned char *)RepAtom(atom)->StrOfAE; s = (unsigned char *)RepAtom(atom)->StrOfAE;
/* #define CRYPT_FOR_STEVE 1*/ /* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE #ifdef CRYPT_FOR_STEVE
if (Yap_GetValue(AtomCryptAtoms) != TermNil && Yap_GetAProp(atom, OpProperty) == NIL) { if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
Yap_GetAProp(atom, OpProperty) == NIL) {
char s[16]; char s[16];
sprintf(s, "x%x", (CELL)s); sprintf(s, "x%x", (CELL)s);
wrputs(s, stream); wrputs(s, stream);
@ -641,17 +622,14 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
} }
} }
void void Yap_WriteAtom(IOSTREAM *s, Atom atom) {
Yap_WriteAtom(IOSTREAM *s, Atom atom)
{
struct write_globs wglb; struct write_globs wglb;
wglb.stream = s; wglb.stream = s;
wglb.Quote_illegal = FALSE; wglb.Quote_illegal = FALSE;
putAtom(atom, 0, &wglb); putAtom(atom, 0, &wglb);
} }
static int static int IsCodesTerm(Term string) /* checks whether this is a string */
IsCodesTerm(Term string) /* checks whether this is a string */
{ {
if (IsVarTerm(string)) if (IsVarTerm(string))
return FALSE; return FALSE;
@ -659,22 +637,25 @@ IsCodesTerm(Term string) /* checks whether this is a string */
Term hd; Term hd;
int ch; int ch;
if (!IsPairTerm(string)) return(FALSE); if (!IsPairTerm(string))
return (FALSE);
hd = HeadOfTerm(string); hd = HeadOfTerm(string);
if (IsVarTerm(hd)) return(FALSE); if (IsVarTerm(hd))
if (!IsIntTerm(hd)) return(FALSE); return (FALSE);
if (!IsIntTerm(hd))
return (FALSE);
ch = IntOfTerm(HeadOfTerm(string)); ch = IntOfTerm(HeadOfTerm(string));
if ((ch < ' ' || ch > MAX_ISO_LATIN1) && ch != '\n' && ch != '\t') if ((ch < ' ' || ch > MAX_ISO_LATIN1) && ch != '\n' && ch != '\t')
return (FALSE); return (FALSE);
string = TailOfTerm(string); string = TailOfTerm(string);
if (IsVarTerm(string)) return(FALSE); if (IsVarTerm(string))
return (FALSE);
} while (string != TermNil); } while (string != TermNil);
return (TRUE); return (TRUE);
} }
/* writes a string */ /* writes a string */
static void static void putString(Term string, struct write_globs *wglb)
putString(Term string, struct write_globs *wglb)
{ {
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -689,8 +670,7 @@ putString(Term string, struct write_globs *wglb)
} }
/* writes a string */ /* writes a string */
static void static void putUnquotedString(Term string, struct write_globs *wglb)
putUnquotedString(Term string, struct write_globs *wglb)
{ {
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -702,10 +682,8 @@ putUnquotedString(Term string, struct write_globs *wglb)
lastw = alphanum; lastw = alphanum;
} }
static Term from_pointer(CELL *ptr0, struct rewind_term *rwt,
static Term struct write_globs *wglb) {
from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
{
CACHE_REGS CACHE_REGS
Term t; Term t;
CELL *ptr = ptr0; CELL *ptr = ptr0;
@ -742,9 +720,8 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
return t; return t;
} }
static CELL * static CELL *restore_from_write(struct rewind_term *rwt,
restore_from_write(struct rewind_term *rwt, struct write_globs *wglb) struct write_globs *wglb) {
{
CACHE_REGS CACHE_REGS
CELL *ptr; CELL *ptr;
@ -760,9 +737,8 @@ restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
} }
/* writes an unbound variable */ /* writes an unbound variable */
static void static void write_var(CELL *t, struct write_globs *wglb,
write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt) struct rewind_term *rwt) {
{
CACHE_REGS CACHE_REGS
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
@ -804,9 +780,8 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
} }
} }
static Term static Term check_infinite_loop(Term t, struct rewind_term *x,
check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb) struct write_globs *wglb) {
{
CACHE_REGS CACHE_REGS
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
while (x) { while (x) {
@ -824,9 +799,8 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
return t; return t;
} }
static void static void write_list(Term t, int direction, int depth,
write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) struct write_globs *wglb, struct rewind_term *rwt) {
{
Term ti; Term ti;
struct rewind_term nrwt; struct rewind_term nrwt;
nrwt.parent = rwt; nrwt.parent = rwt;
@ -836,7 +810,8 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
int ndirection; int ndirection;
int do_jump; int do_jump;
writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth+1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
wglb, &nrwt);
t = AbsPair(restore_from_write(&nrwt, wglb)); t = AbsPair(restore_from_write(&nrwt, wglb));
ti = TailOfTerm(t); ti = TailOfTerm(t);
if (IsVarTerm(ti)) if (IsVarTerm(ti))
@ -884,14 +859,14 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
} else if (ti != MkAtomTerm(AtomNil)) { } else if (ti != MkAtomTerm(AtomNil)) {
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepPair(t)+1, &nrwt, wglb), 999, depth, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
} }
} }
static void writeTerm(Term t, int p, int depth, int rinfixarg,
static void struct write_globs *wglb, struct rewind_term *rwt)
writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt)
/* term to write */ /* term to write */
/* context priority */ /* context priority */
@ -920,16 +895,19 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputs("'.'(", wglb->stream); wrputs("'.'(", wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
wglb, &nrwt);
t = AbsPair(restore_from_write(&nrwt, wglb)); t = AbsPair(restore_from_write(&nrwt, wglb));
wrputs(",", wglb->stream); wrputs(",", wglb->stream);
writeTerm(from_pointer(RepPair(t)+1, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
return; return;
} }
if (wglb->Use_portray) if (wglb->Use_portray)
if (callPortray(t, &EX PASS_REGS) ) return; if (callPortray(t, &EX PASS_REGS))
return;
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) { if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
putString(t, wglb); putString(t, wglb);
} else { } else {
@ -988,7 +966,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
*p++; *p++;
lastw = separator; lastw = separator;
/* cannot use the term directly with the SBA */ /* cannot use the term directly with the SBA */
writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb,
&nrwt);
p = restore_from_write(&nrwt, wglb) + 1; p = restore_from_write(&nrwt, wglb) + 1;
if (*p) if (*p)
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
@ -999,15 +978,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} }
#endif #endif
if (wglb->Use_portray) { if (wglb->Use_portray) {
if (callPortray(t, &EX PASS_REGS) ) return; if (callPortray(t, &EX PASS_REGS))
return;
} }
if (!wglb->Ignore_ops && if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Arity == 1 &&
Yap_IsPrefixOp(atom, &op, &rp)
) {
Term tright = ArgOfTerm(1, t); Term tright = ArgOfTerm(1, t);
int bracket_right = int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
!IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright)); Yap_IsOp(AtomOfTerm(tright));
if (op > p) { if (op > p) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
@ -1019,7 +995,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} else if (atom == AtomMinus) { } else if (atom == AtomMinus) {
last_minus = TRUE; last_minus = TRUE;
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), rp, depth + 1, TRUE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (bracket_right) { if (bracket_right) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -1028,7 +1005,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && } else if (!wglb->Ignore_ops &&
( Arity == 1 || ((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || atom == AtomEmptySquareBrackets) && Yap_IsListTerm(ArgOfTerm(1, t)))) && (Arity == 1 ||
((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets ||
atom == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp)) { Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
@ -1042,9 +1022,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
offset = 1; offset = 1;
} }
bracket_left = bracket_left =
!IsVarTerm(tleft) && !IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
IsAtomTerm(tleft) &&
Yap_IsOp(AtomOfTerm(tleft));
if (op > p) { if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */ /* avoid stuff such as \+ (a,b) being written as \+(a,b) */
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
@ -1052,7 +1030,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_left) { if (bracket_left) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(from_pointer(RepAppl(t)+offset, &nrwt, wglb), lp, depth + 1, rinfixarg, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + offset, &nrwt, wglb), lp, depth + 1,
rinfixarg, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (bracket_left) { if (bracket_left) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -1081,16 +1060,13 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (op > p) { if (op > p) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && } else if (!wglb->Ignore_ops && Arity == 2 &&
Arity == 2 && Yap_IsInfixOp(atom, &op, &lp, Yap_IsInfixOp(atom, &op, &lp, &rp)) {
&rp) ) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t); Term tright = ArgOfTerm(2, t);
int bracket_left = int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && !IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
Yap_IsOp(AtomOfTerm(tleft)); int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
int bracket_right =
!IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright)); Yap_IsOp(AtomOfTerm(tright));
if (op > p) { if (op > p) {
@ -1101,7 +1077,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_left) { if (bracket_left) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), lp, depth + 1, rinfixarg, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), lp, depth + 1,
rinfixarg, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - 1); t = AbsAppl(restore_from_write(&nrwt, wglb) - 1);
if (bracket_left) { if (bracket_left) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -1118,7 +1095,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_right) { if (bracket_right) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(from_pointer(RepAppl(t)+2, &nrwt, wglb), rp, depth + 1, TRUE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 2, &nrwt, wglb), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (bracket_right) { if (bracket_right) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -1131,7 +1109,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) { if (!IsVarTerm(ti) &&
(IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (IsIntTerm(ti)) { if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti); Int k = IntOfTerm(ti);
if (k == -1) { if (k == -1) {
@ -1155,14 +1134,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} else { } else {
wrputs("'$VAR'(", wglb->stream); wrputs("'$VAR'(", wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && functor == FunctorBraces) { } else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream); wrputc('{', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), 1200, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), 1200, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
lastw = separator; lastw = separator;
@ -1174,7 +1155,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputs("...", wglb->stream); wrputs("...", wglb->stream);
break; break;
} }
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - op); t = AbsAppl(restore_from_write(&nrwt, wglb) - op);
if (op != Arity) { if (op != Arity) {
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
@ -1194,7 +1176,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputc('.', wglb->stream); wrputc('.', wglb->stream);
break; break;
} }
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (op != Arity) { if (op != Arity) {
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
@ -1206,8 +1189,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} }
} }
void void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
/* term to be written */ /* term to be written */
/* consumer */ /* consumer */
/* write options */ /* write options */
@ -1239,4 +1221,3 @@ Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt); writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);
restore_from_write(&rwt, &wglb); restore_from_write(&rwt, &wglb);
} }

9
CMakeLists.txt
View File

@ -509,13 +509,18 @@ ADD_SUBDIRECTORY(swi/library)
# ADD_SUBDIRECTORY(os) # ADD_SUBDIRECTORY(os)
# ADD_SUBDIRECTORY(packages) # ADD_SUBDIRECTORY(packages)
if (BUILD_JIT) macro_optional_find_package (LLVM ON)
macro_log_feature (LLVM_FOUND "LLVM JIT generator"
"The LLVM Compiler Infrastructure" "http://www.llvm.org")
if (LLVM_FOUND)
add_definitions (-DYAP_JIT=1) add_definitions (-DYAP_JIT=1)
INCLUDE_DIRECTORIES(JIT JIT/HPP) INCLUDE_DIRECTORIES(JIT JIT/HPP)
macro_optional_add_subdirectory(JIT ON) macro_optional_add_subdirectory(JIT)
endif() endif()
macro_optional_add_subdirectory(library/mpi) macro_optional_add_subdirectory(library/mpi)
macro_optional_add_subdirectory(library/lammpi) macro_optional_add_subdirectory(library/lammpi)
macro_optional_add_subdirectory (packages/gecode) macro_optional_add_subdirectory (packages/gecode)

2
H/ScannerTypes.h
View File

@ -4,6 +4,7 @@ typedef enum TokenKinds {
Var_tok, Var_tok,
String_tok, String_tok,
WString_tok, WString_tok,
StringTerm_tok,
Ponctuation_tok, Ponctuation_tok,
Error_tok, Error_tok,
QuasiQuotes_tok, QuasiQuotes_tok,
@ -29,4 +30,3 @@ typedef struct VARSTRUCT {
struct VARSTRUCT *VarLeft, *VarRight; struct VARSTRUCT *VarLeft, *VarRight;
char VarRep[1]; char VarRep[1];
} VarEntry; } VarEntry;

2
H/amijit.h
View File

@ -336,7 +336,7 @@ typedef struct environment {
#if YAP_JIT #if YAP_JIT
/* Enumeration for types of basic blocks -- used on trace construction */ /* Enumeration for types of basic blocks -- used on trace construction */
typedef enum { typedef enum block_try {
NONE, // untyped NONE, // untyped
SIMPLE_ENTRY, // first basic block of any yaam opcode SIMPLE_ENTRY, // first basic block of any yaam opcode
SIMPLE, // any other basic block of any yaam opcode SIMPLE, // any other basic block of any yaam opcode

32
H/yapio.h
View File

@ -149,36 +149,6 @@ extern YP_FILE yp_iob[YP_MAX_FILES];
typedef YP_FILE *YP_File; typedef YP_FILE *YP_File;
/* ricardo
typedef enum TokenKinds {
Name_tok,
Number_tok,
Var_tok,
String_tok,
WString_tok,
Ponctuation_tok,
Error_tok,
eot_tok
} tkinds;
typedef struct TOKEN {
enum TokenKinds Tok;
Term TokInfo;
int TokPos;
struct TOKEN *TokNext;
} TokEntry;
#define Ord(X) ((enum TokenKinds) (X))
#define NextToken GNextToken( PASS_REGS1 )
typedef struct VARSTRUCT {
Term VarAdr;
CELL hv;
struct VARSTRUCT *VarLeft, *VarRight;
char VarRep[1];
} VarEntry;
*/
#ifndef _PL_WRITE_ #ifndef _PL_WRITE_
@ -351,5 +321,3 @@ WideHashFunction(wchar_t *CHP)
#define QUIET_ON_PARSER_ERROR 1 #define QUIET_ON_PARSER_ERROR 1
#define CONTINUE_ON_PARSER_ERROR 2 #define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3 #define EXCEPTION_ON_PARSER_ERROR 3

5
JIT/CMakeLists.txt
View File

@ -16,11 +16,6 @@ set(LIBJIT_SOURCES
JIT_Init.cpp JIT_Init.cpp
) )
macro_optional_find_package (LLVM ON)
macro_log_feature (LLVM_FOUND "LLVM JIT generator"
"The LLVM Compiler Infrastructure" "http://www.llvm.org")
# The following variables are defined: # The following variables are defined:
# LLVM_FOUND - true if LLVM was found # LLVM_FOUND - true if LLVM was found
# LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers. # LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers.

3
os/pl-prologflag.c
View File

@ -1194,7 +1194,7 @@ initPrologFlags(void)
setPrologFlag("colon_sets_calling_context", FT_BOOL|FF_READONLY, TRUE, 0); setPrologFlag("colon_sets_calling_context", FT_BOOL|FF_READONLY, TRUE, 0);
setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE); setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION); setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING); setPrologFlag("backquoted_string", FT_BOOL, TRUE, PLFLAG_BACKQUOTED_STRING);
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES); setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES);
#endif #endif
@ -1329,4 +1329,3 @@ BeginPredDefs(prologflag)
EndPredDefs EndPredDefs
//! @} //! @}

18
os/pl-utf8.c
View File

@ -252,3 +252,21 @@ utf8_strprefix(const char *s1, const char *s2)
return 0; return 0;
} }
char *
utf8_wcscpy(char *sf, const wchar_t *s0)
{
char *sf0 = sf;
while(1)
{ int chr1;
chr1 = * s0++;
if (chr1 == '\0') {
*sf++ = '\0';
return sf0;
}
sf = utf8_put_char(sf, chr1);
}
return NULL;
}

4
os/pl-utf8.h
View File

@ -26,6 +26,8 @@
#ifndef UTF8_H_INCLUDED #ifndef UTF8_H_INCLUDED
#define UTF8_H_INCLUDED #define UTF8_H_INCLUDED
#include <wchar.h>
#define PL_MB_LEN_MAX 16 #define PL_MB_LEN_MAX 16
#define UTF8_MALFORMED_REPLACEMENT 0xfffd #define UTF8_MALFORMED_REPLACEMENT 0xfffd
@ -66,6 +68,8 @@ extern size_t utf8_strlen1(const char *s);
extern const char * utf8_skip(const char *s, int n); extern const char * utf8_skip(const char *s, int n);
extern int utf8_strncmp(const char *s1, const char *s2, size_t n); extern int utf8_strncmp(const char *s1, const char *s2, size_t n);
extern int utf8_strprefix(const char *s1, const char *s2); extern int utf8_strprefix(const char *s1, const char *s2);
/// copy a wide string to an UTF-8 version.
extern char *utf8_wcscpy(char *sf, const wchar_t *s0);
typedef enum { typedef enum {
S_ASCII, S_ASCII,

4
os/pl-write.c
View File

@ -711,7 +711,7 @@ pl_write_canonical2(term_t stream, term_t term)
rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 && rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 &&
do_write2(stream, term, do_write2(stream, term,
PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS) PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS|PLFLAG_BACKQUOTED_STRING)
); );
END_NUMBERVARS(TRUE); END_NUMBERVARS(TRUE);
@ -796,5 +796,3 @@ pl_writeln(term_t term)
BeginPredDefs(write) BeginPredDefs(write)
EndPredDefs EndPredDefs

2
packages/clib

@ -1 +1 @@
Subproject commit 849232fea0f549f6704b16afa1c986e0d50ec177 Subproject commit 8257467ff9a7bb901d1688e6a75ad072e0246aba

4859
packages/gecode/gecode.yap
View File

File diff suppressed because it is too large Load Diff

2
packages/odbc

@ -1 +1 @@
Subproject commit d0d1ee4d58373cc611676103e0a50a3ae451a023 Subproject commit 9972458293415b2d72276bd67875767bfeed00df

4
packages/python/python.c
View File

@ -1,4 +1,7 @@
#ifdef _XOPEN_SOURCE
#undef _XOPEN_SOURCE // python does its own thing
#endif
#include <Python.h> #include <Python.h>
#include <SWI-Stream.h> #include <SWI-Stream.h>
#include <SWI-Prolog.h> #include <SWI-Prolog.h>
@ -1677,4 +1680,3 @@ install_python(void)
PL_register_foreign("python_run_command", 1, python_run_command, 0); PL_register_foreign("python_run_command", 1, python_run_command, 0);
PL_register_foreign("python_main_module", 1, python_main_module, 0); PL_register_foreign("python_main_module", 1, python_main_module, 0);
} }

2
packages/raptor

@ -1 +1 @@
Subproject commit 34d9f645721645aac9f4f40c815fe4fe2c6511e6 Subproject commit 36f99e3c3c978fef25f899dc4fab1ffee334d73c

32
packages/swig/android/JavaYap.java
View File

@ -1,5 +1,30 @@
package pt.up.fc.dcc.yap; package pt.up.fc.dcc.yap;
/**** using sqlite
For example,the following:
import android.database.sqlite.SQLiteDatabase;
should be replaced with:
import org.sqlite.database.sqlite.SQLiteDatabase;
As well as replacing all uses of the classes in the android.database.sqlite.* namespace, the application must also be sure to use the following two:
org.sqlite.database.SQLException
org.sqlite.database.DatabaseErrorHandler
instead of:
android.database.SQLException
android.database.DatabaseErrorHandler
Aside from namespace changes, there are other differences from the stock Android interface that applications need to be aware of:
The SQLiteStatement.simpleQueryForBlobFileDescriptor() API is not available. The collation sequence "UNICODE" is not available. The collation sequence "LOCALIZED", which normally changes with the system's current locale, is always equivalent to SQLite's built in collation BINARY.
****/
import android.app.Activity; import android.app.Activity;
import android.os.Bundle; import android.os.Bundle;
import android.view.View; import android.view.View;
@ -18,6 +43,7 @@ import org.sqlite.database.sqlite.SQLiteStatement;
import org.sqlite.database.sqlite.SQLiteDatabaseCorruptException; import org.sqlite.database.sqlite.SQLiteDatabaseCorruptException;
import org.sqlite.database.sqlite.SQLiteOpenHelper; import org.sqlite.database.sqlite.SQLiteOpenHelper;
import org.sqlite.database.SQLException;
import org.sqlite.database.DatabaseErrorHandler; import org.sqlite.database.DatabaseErrorHandler;
class DoNotDeleteErrorHandler implements DatabaseErrorHandler { class DoNotDeleteErrorHandler implements DatabaseErrorHandler {
private static final String TAG = "DoNotDeleteErrorHandler"; private static final String TAG = "DoNotDeleteErrorHandler";
@ -49,7 +75,7 @@ public class JavaYap extends Activity
// text.setText(""); // text.setText("");
if (vs0.nil()) { if (vs0.nil()) {
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q="); Log.i(TAG, "q0=\n");
} }
if (q.next()) { if (q.next()) {
outputText.append( "yes\n" ); outputText.append( "yes\n" );
@ -59,12 +85,12 @@ public class JavaYap extends Activity
} else { } else {
int i=1; int i=1;
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q="); Log.i(TAG, "q1= "+vs0.text()+"\n");
} }
while (rc = q.next()) { while (rc = q.next()) {
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q="); Log.i(TAG, "q= "+vs0.text()+"\n");
} }
YAPListTerm vs = vs0; YAPListTerm vs = vs0;