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

new text conversion and string code (big changes, take care please)

Browse Source
This commit is contained in:
Vítor Santos Costa
2013-12-02 14:49:41 +00:00
parent 8b7fa9be36
commit d7397b43af
65 changed files with 1498 additions and 2098 deletions
Download Patch File Download Diff File Expand all files Collapse all files

138
C/absmi.c
View File

@@ -4409,6 +4409,52 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(get_string, xu);
BEGD(d0);
d0 = XREG(PREG->u.xu.x);
deref_head(d0, gstring_unk);
gstring_nonvar:
if (!IsApplTerm(d0))
FAIL();
/* we have met a preexisting string */
START_PREFETCH(xu);
BEGP(pt0);
pt0 = RepAppl(d0);
/* check functor */
if (*pt0 != (CELL)FunctorString) {
FAIL();
}
BEGP(pt1);
pt1 = RepAppl(PREG->u.xu.u);
PREG = NEXTOP(PREG, xu);
if (
pt1[1] != pt0[1] ||
strcmp((const char *)(pt1+2), (const char *)(pt0+2))
) FAIL();
ENDP(pt1);
ENDP(pt0);
/* enter read mode */
GONext();
END_PREFETCH();
BEGP(pt0);
deref_body(d0, pt0, gstring_unk, gstring_nonvar);
/* Enter Write mode */
/* set d1 to be the new structure we are going to create */
START_PREFETCH(xc);
BEGD(d1);
d1 = PREG->u.xu.u;
PREG = NEXTOP(PREG, xu);
Bind(pt0, d1);
GONext();
ENDD(d1);
END_PREFETCH();
ENDP(pt0);
ENDD(d0);
ENDOp();
Op(get_longint, xi);
BEGD(d0);
d0 = XREG(PREG->u.xi.x);
@@ -6072,6 +6118,87 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(unify_string, ou);
BEGD(d0);
BEGP(pt0);
pt0 = SREG++;
d0 = *pt0;
deref_head(d0, ustring_unk);
ustring_nonvar:
if (!IsApplTerm(d0)) {
FAIL();
}
/* look inside term */
BEGP(pt0);
pt0 = RepAppl(d0);
BEGD(d0);
d0 = *pt0;
if (d0 != (CELL)FunctorString) {
FAIL();
}
ENDD(d0);
BEGP(pt1);
pt1 = RepAppl(PREG->u.ou.u);
PREG = NEXTOP(PREG, ou);
if (
pt1[1] != pt0[1]
|| strcmp( (const char *)(pt1 + 2), (const char *)(pt0+2) )
) FAIL();
ENDP(pt1);
ENDP(pt0);
GONext();
derefa_body(d0, pt0, ustring_unk, ustring_nonvar);
BEGD(d1);
d1 = PREG->u.ou.u;
PREG = NEXTOP(PREG, ou);
Bind_Global(pt0, d1);
GONext();
ENDD(d1);
ENDP(pt0);
ENDD(d0);
ENDOp();
Op(unify_l_string, ou);
BEGD(d0);
CACHE_S();
READ_IN_S();
d0 = *S_SREG;
deref_head(d0, ulstring_unk);
ulstring_nonvar:
if (!IsApplTerm(d0)) {
FAIL();
}
BEGP(pt0);
pt0 = RepAppl(d0);
BEGD(d0);
d0 = *pt0;
if (d0 != (CELL)FunctorString) {
FAIL();
}
ENDD(d0);
BEGP(pt1);
pt1 = RepAppl(PREG->u.ou.u);
PREG = NEXTOP(PREG, ou);
if (
pt1[1] != pt0[1]
|| strcmp( (const char *)(pt1 + 2), (const char *)(pt0+2) )
) FAIL();
ENDP(pt1);
ENDP(pt0);
GONext();
derefa_body(d0, S_SREG, ulstring_unk, ulstring_nonvar);
BEGD(d1);
d1 = PREG->u.ou.u;
PREG = NEXTOP(PREG, ou);
Bind_Global(S_SREG, d1);
GONext();
ENDD(d1);
ENDCACHE_S();
ENDD(d0);
ENDOp();
Op(unify_longint, oi);
BEGD(d0);
BEGP(pt0);
@@ -11694,6 +11821,17 @@ Yap_absmi(int inp)
}
PREG = PREG->u.l.l;
GONext();
case (CELL)FunctorString:
if (f1 != FunctorString) {
PREG = PREG->u.l.l;
GONext();
}
if (strcmp((char *)(RepAppl(d0)+2),(char *)(RepAppl(d1)+2)) == 0) {
PREG = NEXTOP(PREG, l);
GONext();
}
PREG = PREG->u.l.l;
GONext();
#ifdef USE_GMP
case (CELL)FunctorBigInt:
if (f1 != FunctorBigInt) {

241
C/adtdefs.c
View File

@@ -30,6 +30,7 @@ static Prop PredPropByFunc(Functor, Term);
static Prop PredPropByAtom(Atom, Term);
#include "Yatom.h"
#include "yapio.h"
#include "pl-utf8.h"
#include <stdio.h>
#include <wchar.h>
#if HAVE_STRING_H
@@ -340,6 +341,25 @@ Yap_LookupMaybeWideAtomWithLength(wchar_t *atom, size_t len)
}
}
Atom
Yap_LookupAtomWithLength(char *atom, size_t len)
{ /* lookup atom in atom table */
char *p = atom;
Atom at;
char *ptr, *ptr0;
/* not really a wide atom */
p = atom;
ptr0 = ptr = Yap_AllocCodeSpace(len+1);
if (!ptr)
return NIL;
while (len--) {*ptr++ = *p++;}
ptr[0] = '\0';
at = LookupAtom(ptr0);
Yap_FreeCodeSpace(ptr0);
return at;
}
Atom
Yap_LookupAtom(char *atom)
{ /* lookup atom in atom table */
@@ -1060,6 +1080,9 @@ Yap_GetValue(Atom a)
} else if (f == FunctorLongInt) {
CACHE_REGS
out = MkLongIntTerm(LongIntOfTerm(out));
} else if (f == FunctorString) {
CACHE_REGS
out = MkStringTerm(StringOfTerm(out));
}
#ifdef USE_GMP
else {
@@ -1167,6 +1190,21 @@ Yap_PutValue(Atom a, Term v)
memcpy((void *)pt, (void *)ap, sz);
p->ValueOfVE = AbsAppl(pt);
#endif
} else if (IsStringTerm(v)) {
CELL *ap = RepAppl(v);
Int sz =
sizeof(CELL)*(3+ap[1]);
CELL *pt = (CELL *) Yap_AllocAtomSpace(sz);
if (pt == NULL) {
WRITE_UNLOCK(ae->ARWLock);
return;
}
if (IsApplTerm(t0)) {
Yap_FreeCodeSpace((char *) RepAppl(t0));
}
memcpy((void *)pt, (void *)ap, sz);
p->ValueOfVE = AbsAppl(pt);
} else {
if (IsApplTerm(t0)) {
/* recover space */
@@ -1201,209 +1239,6 @@ Yap_PutAtomTranslation(Atom a, Int i)
WRITE_UNLOCK(ae->ARWLock);
}
Term
Yap_StringToList(char *s)
{
CACHE_REGS
register Term t;
register unsigned char *cp = (unsigned char *)s + strlen(s);
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return (t);
}
Term
Yap_NStringToList(char *s, size_t len)
{
CACHE_REGS
Term t;
unsigned char *cp = (unsigned char *)s + len;
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_WideStringToList(wchar_t *s)
{
CACHE_REGS
Term t;
wchar_t *cp = s + wcslen(s);
t = MkAtomTerm(AtomNil);
while (cp > s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_NWideStringToList(wchar_t *s, size_t len)
{
CACHE_REGS
Term t;
wchar_t *cp = s + len;
t = MkAtomTerm(AtomNil);
while (cp > s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_StringToDiffList(char *s, Term t USES_REGS)
{
register unsigned char *cp = (unsigned char *)s + strlen(s);
t = Yap_Globalise(t);
while (cp > (unsigned char *)s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return t;
}
Term
Yap_NStringToDiffList(char *s, Term t, size_t len)
{
CACHE_REGS
register unsigned char *cp = (unsigned char *)s + len;
t = Yap_Globalise(t);
while (cp > (unsigned char *)s) {
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return t;
}
Term
Yap_WideStringToDiffList(wchar_t *s, Term t)
{
CACHE_REGS
wchar_t *cp = s + wcslen(s);
t = Yap_Globalise(t);
while (cp > s) {
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_NWideStringToDiffList(wchar_t *s, Term t, size_t len)
{
CACHE_REGS
wchar_t *cp = s + len;
t = Yap_Globalise(t);
while (cp > s) {
t = MkPairTerm(MkIntegerTerm(*--cp), t);
}
return t;
}
Term
Yap_StringToListOfAtoms(char *s)
{
CACHE_REGS
register Term t;
char so[2];
register unsigned char *cp = (unsigned char *)s + strlen(s);
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
}
return t;
}
Term
Yap_NStringToListOfAtoms(char *s, size_t len)
{
CACHE_REGS
register Term t;
char so[2];
register unsigned char *cp = (unsigned char *)s + len;
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > (unsigned char *)s) {
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupAtom(so)), t);
}
return t;
}
Term
Yap_WideStringToListOfAtoms(wchar_t *s)
{
CACHE_REGS
register Term t;
wchar_t so[2];
wchar_t *cp = s + wcslen(s);
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > s) {
so[0] = *--cp;
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
}
return t;
}
Term
Yap_NWideStringToListOfAtoms(wchar_t *s, size_t len)
{
CACHE_REGS
register Term t;
wchar_t so[2];
wchar_t *cp = s + len;
so[1] = '\0';
t = MkAtomTerm(AtomNil);
while (cp > s) {
if (ASP < H+1024)
return (CELL)0;
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
}
return t;
}
Term
Yap_NWideStringToDiffListOfAtoms(wchar_t *s, Term t0, size_t len)
{
CACHE_REGS
register Term t;
wchar_t so[2];
wchar_t *cp = s + len;
so[1] = '\0';
t = Yap_Globalise(t0);
while (cp > s) {
so[0] = *--cp;
t = MkPairTerm(MkAtomTerm(LookupWideAtom(so)), t);
}
return t;
}
Term
Yap_ArrayToList(register Term *tp, int nof)
{

2
C/agc.c
View File

@@ -324,6 +324,8 @@ mark_global_cell(CELL *pt)
#else
return pt + 3;
#endif
case (CELL)FunctorString:
return pt + 3 + pt[1];
case (CELL)FunctorBigInt:
{
Int sz = 3 +

61
C/amasm.c
View File

@@ -1144,6 +1144,22 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
return code_p;
}
// strings are blobs
inline static yamop *
a_ustring(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.ou.opcw = emit_op(opcode_w);
code_p->u.ou.u =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(ou);
return code_p;
}
inline static yamop *
a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
{
@@ -1384,6 +1400,19 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
return code_p;
}
inline static yamop *
a_rstring(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xu.x = emit_x(cip->cpc->rnd2);
code_p->u.xu.u = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(xu);
return code_p;
}
inline static yamop *
a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, struct intermediates *cip)
{
@@ -2421,6 +2450,16 @@ copy_blob(yamop *code_p, int pass_no, struct PSEUDO *cpc)
return code_p;
}
static yamop *
copy_string(yamop *code_p, int pass_no, struct PSEUDO *cpc)
{
/* copy the blob to code space, making no effort to align if a double */
int max = cpc->rnd1, i;
for (i = 0; i < max; i++)
code_p = fill_a(cpc->arnds[i], code_p, pass_no);
return code_p;
}
static void
a_fetch_vv(cmp_op_info *cmp_info, int pass_no, struct intermediates *cip)
@@ -3240,6 +3279,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case get_bigint_op:
code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case get_string_op:
code_p = a_rb(_get_string, clause_has_blobsp, code_p, pass_no, cip);
break;
case get_dbterm_op:
code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
@@ -3258,6 +3300,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case put_bigint_op:
code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_string_op:
code_p = a_rstring(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_dbterm_op:
code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
@@ -3318,6 +3363,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case unify_bigint_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break;
case unify_string_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_string, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break;
case unify_dbterm_op:
code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
break;
@@ -3336,6 +3384,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case unify_last_bigint_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break;
case unify_last_string_op:
code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
break;
case unify_last_dbterm_op:
code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write, clause_has_dbtermp, code_p, pass_no, cip);
break;
@@ -3354,6 +3405,9 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
case write_bigint_op:
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case write_string_op:
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case write_dbterm_op:
code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
@@ -3540,7 +3594,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cip->cpc->nextInst != NULL &&
(cip->cpc->nextInst->op == mark_initialised_pvars_op ||
cip->cpc->nextInst->op == mark_live_regs_op ||
cip->cpc->nextInst->op == blob_op)) {
cip->cpc->nextInst->op == blob_op ||
cip->cpc->nextInst->op == string_op)) {
ystop_found = TRUE;
code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
}
@@ -3746,6 +3801,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
/* install a blob */
code_p = copy_blob(code_p, pass_no, cip->cpc);
break;
case string_op:
/* install a blob */
code_p = copy_string(code_p, pass_no, cip->cpc);
break;
case empty_call_op:
/* create an empty call */
code_p = a_empty_call(&clinfo, code_p, pass_no, cip);

1358
C/atoms.c
View File

File diff suppressed because it is too large Load Diff

3
C/attvar.c
View File

@@ -950,6 +950,9 @@ AllAttVars( USES_REGS1 ) {
pt += 3;
#endif
break;
case (CELL)FunctorString:
pt += 3+pt[1];
break;
case (CELL)FunctorBigInt:
{
Int sz = 3 +

136
C/bignum.c
View File

@@ -469,142 +469,6 @@ p_rational( USES_REGS1 )
#endif
}
int
Yap_IsStringTerm(Term t)
{
CELL fl;
if (IsVarTerm(t))
return FALSE;
if (!IsApplTerm(t))
return FALSE;
if (FunctorOfTerm(t) != FunctorBigInt)
return FALSE;
fl = RepAppl(t)[1];
return fl == BLOB_STRING || fl == BLOB_WIDE_STRING;
}
int
Yap_IsWideStringTerm(Term t)
{
CELL fl;
if (IsVarTerm(t))
return FALSE;
if (!IsApplTerm(t))
return FALSE;
if (FunctorOfTerm(t) != FunctorBigInt)
return FALSE;
fl = RepAppl(t)[1];
return fl == BLOB_WIDE_STRING;
}
Term
Yap_MkBlobStringTerm(const char *s, size_t len)
{
CACHE_REGS
CELL *ret = H;
size_t sz;
MP_INT *dst = (MP_INT *)(H+2);
blob_string_t *sp;
size_t siz;
char *dest;
sz = strlen(s);
if (len > 0 && sz > len) sz = len;
if (len/sizeof(CELL) > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BLOB_STRING;
siz = ALIGN_YAPTYPE((len+1+sizeof(blob_string_t)),CELL);
dst->_mp_size = 0L;
dst->_mp_alloc = siz/sizeof(mp_limb_t);
sp = (blob_string_t *)(dst+1);
sp->len = sz;
dest = (char *)(sp+1);
strncpy(dest, s, sz);
dest[sz] = '\0';
H += (siz + 2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
H[-1] = EndSpecials;
return AbsAppl(ret);
}
Term
Yap_MkBlobWideStringTerm(const wchar_t *s, size_t len)
{
CACHE_REGS
CELL *ret = H;
size_t sz;
MP_INT *dst = (MP_INT *)(H+2);
blob_string_t *sp = (blob_string_t *)(dst+1);
size_t siz, i = 0;
H[0] = (CELL)FunctorBigInt;
dst->_mp_size = 0L;
sz = wcslen(s);
if (len > 0 && sz > len) {
sz = len;
}
if ((len/sizeof(CELL)) > (ASP-ret)-1024) {
return TermNil;
}
while (i < sz) {
if (s[i++] >= 255) break;
}
if (i == sz) {
/* we have a standard ascii string */
char *target;
size_t i = 0;
H[1] = BLOB_STRING;
siz = ALIGN_YAPTYPE((sz+1+sizeof(blob_string_t)),CELL);
dst->_mp_alloc = siz/sizeof(mp_limb_t);
sp->len = sz;
target = (char *)(sp+1);
for (i = 0 ; i < sz; i++) {
target[i] = s[i];
}
target[sz] = '\0';
H += (siz+2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
} else {
wchar_t * target;
H[1] = BLOB_WIDE_STRING;
siz = ALIGN_YAPTYPE((sz+1)*sizeof(wchar_t)+sizeof(blob_string_t),CELL);
dst->_mp_alloc = siz/sizeof(mp_limb_t);
sp->len = sz;
target = (wchar_t *)(sp+1);
wcsncpy(target, s, sz);
target[sz] = '\0';
H += (siz + 2*sizeof(CELL)+sizeof(MP_INT)+sizeof(Functor))/sizeof(CELL);
}
H[-1] = EndSpecials;
return AbsAppl(ret);
}
char *
Yap_BlobStringOfTerm(Term t)
{
blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
return (char *)(new+1);
}
wchar_t *
Yap_BlobWideStringOfTerm(Term t)
{
blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
return (wchar_t *)(new+1);
}
char *
Yap_BlobStringOfTermAndLength(Term t, size_t *sp)
{
blob_string_t *new = (blob_string_t *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
*sp = new->len;
return (char *)(new+1);
}
void
Yap_InitBigNums(void)
{

184
C/c_interface.c
View File

@@ -354,6 +354,7 @@
#include "yap_structs.h"
#define _yap_c_interface_h 1
#include "pl-shared.h"
#include "YapMirror.h"
#include "pl-read.h"
#ifdef TABLING
#include "tab.macros.h"
@@ -1984,42 +1985,16 @@ YAP_FreeSpaceFromYap(void *ptr)
X_API int
YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
{
unsigned int j = 0;
while (t != TermNil) {
register Term Head;
register Int i;
Head = HeadOfTerm(t);
if (IsVarTerm(Head)) {
Yap_Error(INSTANTIATION_ERROR,Head,"user defined procedure");
return(FALSE);
} else if (!IsIntTerm(Head)) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
return FALSE;
}
i = IntOfTerm(Head);
if (i < 0 || i > 255) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
return FALSE;
}
if (j == bufsize) {
buf[bufsize-1] = '\0';
return FALSE;
} else {
buf[j++] = i;
}
t = TailOfTerm(t);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"user defined procedure");
return FALSE;
} else if (!IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST, t, "user defined procedure");
return FALSE;
}
}
buf[j] = '\0';
return(TRUE);
CACHE_REGS
seq_tv_t inp, out;
inp.val.t = t;
inp.type = YAP_STRING_CODES|YAP_STRING_TRUNC;
inp.max = bufsize;
out.type = YAP_STRING_CHARS;
out.val.c = buf;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return FALSE;
return TRUE;
}
@@ -2030,7 +2005,14 @@ YAP_BufferToString(char *s)
Term t;
BACKUP_H();
t = Yap_StringToList(s);
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2043,7 +2025,16 @@ YAP_NBufferToString(char *s, size_t len)
Term t;
BACKUP_H();
t = Yap_NStringToList(s, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2056,7 +2047,14 @@ YAP_WideBufferToString(wchar_t *s)
Term t;
BACKUP_H();
t = Yap_WideStringToList(s);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2069,7 +2067,16 @@ YAP_NWideBufferToString(wchar_t *s, size_t len)
Term t;
BACKUP_H();
t = Yap_NWideStringToList(s, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2131,7 +2138,14 @@ YAP_BufferToAtomList(char *s)
Term t;
BACKUP_H();
t = Yap_StringToListOfAtoms(s);
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2144,7 +2158,16 @@ YAP_NBufferToAtomList(char *s, size_t len)
Term t;
BACKUP_H();
t = Yap_NStringToListOfAtoms(s, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2157,7 +2180,14 @@ YAP_WideBufferToAtomList(wchar_t *s)
Term t;
BACKUP_H();
t = Yap_WideStringToListOfAtoms(s);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2170,7 +2200,16 @@ YAP_NWideBufferToAtomList(wchar_t *s, size_t len)
Term t;
BACKUP_H();
t = Yap_NWideStringToListOfAtoms(s, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2183,7 +2222,17 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
Term t;
BACKUP_H();
t = Yap_NWideStringToDiffListOfAtoms(s, t0, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOMS|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
out.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2193,11 +2242,18 @@ YAP_NWideBufferToAtomDiffList(wchar_t *s, Term t0, size_t len)
X_API Term
YAP_BufferToDiffList(char *s, Term t0)
{
CACHE_REGS
Term t;
BACKUP_H();
t = Yap_StringToDiffList(s, t0 PASS_REGS);
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2210,7 +2266,17 @@ YAP_NBufferToDiffList(char *s, Term t0, size_t len)
Term t;
BACKUP_H();
t = Yap_NStringToDiffList(s, t0, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
out.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2223,7 +2289,15 @@ YAP_WideBufferToDiffList(wchar_t *s, Term t0)
Term t;
BACKUP_H();
t = Yap_WideStringToDiffList(s, t0);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_DIFF;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;
@@ -2236,7 +2310,17 @@ YAP_NWideBufferToDiffList(wchar_t *s, Term t0, size_t len)
Term t;
BACKUP_H();
t = Yap_NWideStringToDiffList(s, t0, len);
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_CODES|YAP_STRING_NCHARS|YAP_STRING_TRUNC|YAP_STRING_DIFF;
out.sz = len;
out.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
RECOVER_H();
return t;

58
C/cmppreds.c
View File

@@ -141,6 +141,26 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
}
if (out != 0)
goto done;
} else if (IsStringTerm(d0)) {
if (IsStringTerm(d1)){
out = strcmp(StringOfTerm(d0) , StringOfTerm(d1));
} else if (IsIntTerm(d1))
out = 1;
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = 1;
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = 1;
#endif
} else if (IsRefTerm(d1)) {
out = 1 ;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsLongIntTerm(d0)) {
if (IsIntTerm(d1))
out = LongIntOfTerm(d0) - IntOfTerm(d1);
@@ -319,24 +339,30 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return cmp_atoms(AtomOfTerm(t1),AtomOfTerm(t2));
if (IsPrimitiveTerm(t2))
return 1;
if (IsStringTerm(t2))
return 1;
return -1;
} else {
if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2);
}
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2)) {
return IntOfTerm(t1) - LongIntOfTerm(t2);
}
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
}
case big_int_e:
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
if (IsRefTerm(t2))
return 1;
case db_ref_e:
return 1;
case string_e:
return 1;
}
}
return -1;
}
} else if (IsPairTerm(t1)) {
@@ -408,6 +434,16 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return -1;
}
#endif
case string_e:
{
if (IsApplTerm(t2)) {
Functor f2 = FunctorOfTerm(t2);
if (f2 == FunctorString)
return strcmp(StringOfTerm(t1), StringOfTerm(t2));
return 1;
}
return -1;
}
case db_ref_e:
if (IsRefTerm(t2))
return Unsigned(RefOfTerm(t2)) -

43
C/compiler.c
View File

@@ -668,7 +668,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_atom_op
: unify_atom_op) :
write_atom_op), (CELL) t, Zero, &cglobs->cint);
} else if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t)) {
} else if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t) || IsStringTerm(t)) {
if (!IsIntTerm(t)) {
if (IsFloatTerm(t)) {
if (level == 0)
@@ -684,6 +684,41 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_longint_op
: unify_longint_op) :
write_longint_op), t, Zero, &cglobs->cint);
} else if (IsStringTerm(t)) {
/* we are taking a string, that is supposed to be
guarded in the clause itself. . */
CELL l1 = ++cglobs->labelno;
CELL *src = RepAppl(t);
PInstr *ocpc = cglobs->cint.cpc, *OCodeStart = cglobs->cint.CodeStart;
Int sz = (3+src[1])*sizeof(CELL);
CELL *dest;
/* use a special list to store the blobs */
cglobs->cint.cpc = cglobs->cint.icpc;
/* if (IsFloatTerm(t)) {
Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
}*/
Yap_emit(label_op, l1, Zero, &cglobs->cint);
dest =
Yap_emit_extra_size(blob_op, sz/CellSize, sz, &cglobs->cint);
/* copy the bignum */
memcpy(dest, src, sz);
/* note that we don't need to copy size info, unless we wanted
to garbage collect clauses ;-) */
cglobs->cint.icpc = cglobs->cint.cpc;
if (cglobs->cint.BlobsStart == NULL)
cglobs->cint.BlobsStart = cglobs->cint.CodeStart;
cglobs->cint.cpc = ocpc;
cglobs->cint.CodeStart = OCodeStart;
/* The argument to pass to the structure is now the label for
where we are storing the blob */
if (level == 0)
Yap_emit((cglobs->onhead ? get_string_op : put_string_op), t, argno, &cglobs->cint);
else
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_string_op
: unify_string_op) :
write_string_op), t, Zero, &cglobs->cint);
} else {
/* we are taking a blob, that is a binary that is supposed to be
guarded in the clause itself. Possible examples include
@@ -2585,6 +2620,7 @@ CheckVoids(compiler_struct *cglobs)
case get_float_op:
case get_dbterm_op:
case get_longint_op:
case get_string_op:
case get_bigint_op:
case get_list_op:
case get_struct_op:
@@ -2935,6 +2971,7 @@ c_layout(compiler_struct *cglobs)
case get_num_op:
case get_float_op:
case get_longint_op:
case get_string_op:
case get_dbterm_op:
case get_bigint_op:
--cglobs->Uses[rn];
@@ -3013,6 +3050,7 @@ c_layout(compiler_struct *cglobs)
case put_num_op:
case put_float_op:
case put_longint_op:
case put_string_op:
case put_dbterm_op:
case put_bigint_op:
rn = checkreg(arg, rn, ic, FALSE, cglobs);
@@ -3311,10 +3349,13 @@ c_optimize(PInstr *pc)
case unify_last_float_op:
case write_float_op:
case unify_longint_op:
case unify_string_op:
case unify_bigint_op:
case unify_last_longint_op:
case unify_last_string_op:
case unify_last_bigint_op:
case write_longint_op:
case write_string_op:
case write_bigint_op:
case unify_list_op:
case write_list_op:

2
C/computils.c
View File

@@ -435,6 +435,8 @@ write_functor(Functor f)
Yap_DebugPlWrite(MkAtomTerm(AtomLONGINT));
} else if (f == FunctorDouble) {
Yap_DebugPlWrite(MkAtomTerm(AtomDOUBLE));
} else if (f == FunctorString) {
Yap_DebugPlWrite(MkAtomTerm(AtomSTRING));
}
} else {
Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor (f)));

6
C/corout.c
View File

@@ -152,6 +152,9 @@ static int can_unify_complex(register CELL *pt0,
case (CELL)FunctorDouble:
if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue;
goto comparison_failed;
case (CELL)FunctorString:
if (strcmp(StringOfTerm(d0), StringOfTerm(d1)) == 0) continue;
goto comparison_failed;
#ifdef USE_GMP
case (CELL)FunctorBigInt:
if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue;
@@ -288,6 +291,9 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS)
case (CELL)FunctorLongInt:
if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE);
return FALSE;
case (CELL)FunctorString:
if (strcmp(StringOfTerm(t1), StringOfTerm(t2)) == 0) return(TRUE);
return FALSE;
case (CELL)FunctorDouble:
if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE);
return FALSE;

24
C/dbase.c
View File

@@ -596,6 +596,16 @@ copy_double(CELL *st, CELL *pt)
return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT);
}
static CELL *
copy_string(CELL *st, CELL *pt)
{
UInt sz = pt[1]+3;
/* first thing, store a link to the list before we move on */
memcpy(st,pt,sizeof(CELL)*sz);
/* now reserve space */
return st+sz;
}
#ifdef USE_GMP
static CELL *
copy_big_int(CELL *st, CELL *pt)
@@ -711,6 +721,17 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
++pt0;
continue;
#endif
case (CELL)FunctorString:
{
CELL *st = CodeMax;
CheckDBOverflow(3+ap2[1]);
/* first thing, store a link to the list before we move on */
*StoPoint++ = AbsAppl(st);
CodeMax = copy_string(CodeMax, ap2);
++pt0;
continue;
}
case (CELL)FunctorDouble:
{
CELL *st = CodeMax;
@@ -1478,6 +1499,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
case (CELL)FunctorDouble:
ntp = copy_double(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorString:
ntp = copy_string(ntp0, RepAppl(Tm));
break;
case (CELL)FunctorDBRef:
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return CreateDBWithDBRef(Tm, p, dbg);

110
C/errors.c
View File

@@ -29,6 +29,100 @@
#endif
#include "Foreign.h"
static Term
gen_syntax_error(Atom InpAtom, char *s)
{
CACHE_REGS
Term ts[7], ti[2];
ti[0] = ARG1;
ti[1] = ARG2;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(s),2),2,ti);
ts[1] = ts[4] = ts[5] = MkIntTerm(0);
ts[2] = MkAtomTerm(AtomExpectedNumber);
ts[3] = TermNil;
ts[6] = MkAtomTerm(InpAtom);
return(Yap_MkApplTerm(FunctorSyntaxError,7,ts));
}
int Yap_HandleError( const char *s, ... ) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = (char *)s;
}
switch (err) {
case OUT_OF_STACK_ERROR:
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
return(FALSE);
}
return TRUE;
case OUT_OF_AUXSPACE_ERROR:
if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
return FALSE;
}
return TRUE;
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return(FALSE);
}
}
int Yap_SWIHandleError( const char *s, ... )
{
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = (char *)s;
}
switch (err) {
case OUT_OF_STACK_ERROR:
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, serr);
return(FALSE);
}
return TRUE;
case OUT_OF_AUXSPACE_ERROR:
if (LOCAL_MAX_SIZE < (char *)AuxSp-AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE)) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, serr);
return FALSE;
}
return TRUE;
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return(FALSE);
}
}
void
Yap_RestartYap ( int flag )
@@ -1454,7 +1548,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomSyntaxError);
nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti);
nt[0] = gen_syntax_error(AtomNil, tmpbuf);
psize -= i;
fun = FunctorError;
serious = TRUE;
@@ -1535,6 +1629,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
break;
case TYPE_ERROR_BIGNUM:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomBigNum);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case TYPE_ERROR_BYTE:
{
int i;

16
C/globals.c
View File

@@ -395,6 +395,14 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
H += 3;
#endif
break;
case (CELL)FunctorString:
if (ASP - H > MIN_ARENA_SIZE+3+ap2[1]) {
goto overflow;
}
*ptf++ = AbsAppl(H);
memcpy(H, ap2, sizeof(CELL)*(3+ap2[1]));
H+=ap2[1]+3;
break;
default:
{
/* big int */
@@ -680,6 +688,14 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
H += 3;
#endif
break;
case (CELL)FunctorString:
if (H > ASP - MIN_ARENA_SIZE+3+ap[1]) {
res = -1;
goto error_handler;
}
memcpy(H, ap, sizeof(CELL)*(3+ap[1]));
H += ap[1]+3;
break;
default:
{
UInt sz = ArenaSz(t), i;

58
C/gmp_support.c
View File

@@ -1327,51 +1327,6 @@ Yap_gmp_tcmp_big_big(Term t1, Term t2)
return 1;
} else if (pt1[1] == BIG_RATIONAL) {
b1 = Yap_BigRatOfTerm(t1);
} else if (pt1[1] == BLOB_STRING) {
char *s1 = Yap_BlobStringOfTerm(t1);
if (pt2[1] == BLOB_STRING) {
char *s2 = Yap_BlobStringOfTerm(t2);
return strcmp(s1,s2);
} else if (pt2[1] == BLOB_WIDE_STRING) {
wchar_t *wcs2 = Yap_BlobWideStringOfTerm(t2), *wcs1, *tmp1;
int out;
size_t n = strlen(s1);
if (!(wcs1 = (wchar_t *)malloc((n+1)*sizeof(wchar_t)))) {
Yap_Error(OUT_OF_HEAP_ERROR, t1, "compare/3");
return 0;
}
tmp1 = wcs1;
while (*s1) {
*tmp1++ = *s1++;
}
out = wcscmp(wcs1, wcs2);
free(wcs1);
return out;
}
b1 = Yap_BigRatOfTerm(t1);
} else if (pt1[1] == BLOB_WIDE_STRING) {
wchar_t *wcs1 = Yap_BlobWideStringOfTerm(t1);
if (pt2[1] == BLOB_STRING) {
char *s2 = Yap_BlobStringOfTerm(t2);
wchar_t *wcs2, *tmp2;
int out;
size_t n = strlen(s2);
if (!(wcs2 = (wchar_t *)malloc((n+1)*sizeof(wchar_t)))) {
Yap_Error(OUT_OF_HEAP_ERROR, t2, "compare/3");
return 0;
}
tmp2 = wcs2;
while (*s2) {
*tmp2++ = *s2++;
}
out = wcscmp(wcs1, wcs2);
free(wcs2);
return out;
} else if (pt2[1] == BLOB_WIDE_STRING) {
wchar_t *wcs2 = Yap_BlobWideStringOfTerm(t2);
return wcscmp(wcs1,wcs2);
}
b1 = Yap_BigRatOfTerm(t1);
} else {
return pt1-pt2;
}
@@ -1686,6 +1641,19 @@ Yap_gmp_popcount(Term t)
}
}
char *
Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base)
{
if (s) {
size_t size = mpz_sizeinbase(b, base);
if (size+2 > sz) {
return NULL;
}
return mpz_get_str (s, base, b);
}
return NULL;
}
char *
Yap_gmp_to_string(Term t, char *s, size_t sz, int base)
{

21
C/grow.c
View File

@@ -559,6 +559,9 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
pt += 2;
#endif
break;
case (CELL)FunctorString:
pt += 3+pt[1];
break;
case (CELL)FunctorBigInt:
{
Int sz = 2+
@@ -1082,7 +1085,9 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case get_float_op:
case put_float_op:
case get_longint_op:
case get_string_op:
case put_longint_op:
case put_string_op:
case unify_float_op:
case unify_last_float_op:
case write_float_op:
@@ -1112,8 +1117,11 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
case unify_last_num_op:
case write_num_op:
case unify_longint_op:
case unify_string_op:
case unify_last_longint_op:
case unify_last_string_op:
case write_longint_op:
case write_string_op:
case unify_bigint_op:
case unify_last_bigint_op:
case unify_dbterm_op:
@@ -1416,6 +1424,18 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
int res;
int blob_overflow = (NOfBlobs > NOfBlobsMax);
#if (THREADS) || YAPOR
res = FALSE;
if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
}
LOCAL_ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(LOCAL_SignalLock);
return TRUE;
}
#else
if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
UInt n = NOfAtoms;
if (GLOBAL_AGcThreshold)
@@ -1446,6 +1466,7 @@ Yap_growheap(int fix_code, size_t in_size, void *cip)
res=do_growheap(fix_code, in_size, (struct intermediates *)cip, NULL, NULL, NULL PASS_REGS);
#endif
LeaveGrowMode(GrowHeapMode);
#endif
return res;
}

17
C/heapgc.c
View File

@@ -1378,6 +1378,23 @@ mark_variable(CELL_PTR current USES_REGS)
MARK(next+sz);
}
POP_CONTINUATION();
case (CELL)FunctorString:
MARK(next);
PUSH_POINTER(next PASS_REGS);
{
UInt sz = 2+next[1];
if (next < LOCAL_HGEN) {
LOCAL_total_oldies+= 1+sz;
} else {
DEBUG_printf0("%p 1\n", next);
DEBUG_printf1("%p %ld\n", next, (long int)(sz+1));
}
//fprintf(stderr,"%p M %d\n", next,1+sz);
LOCAL_total_marked += 1+sz;
PUSH_POINTER(next+sz PASS_REGS);
MARK(next+sz);
}
POP_CONTINUATION();
case (CELL)FunctorBigInt:
{
Opaque_CallOnGCMark f;

14
C/index.c
View File

@@ -1203,6 +1203,16 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
cl = NEXTOP(cl,oc);
argno--;
break;
case _unify_string:
case _unify_l_string:
if (argno == 1) {
clause->Tag = AbsAppl((CELL *)FunctorString);
clause->u.t_ptr = cl->u.ou.u;
return;
}
cl = NEXTOP(cl,ou);
argno--;
break;
case _unify_n_atoms:
if (argno <= cl->u.osc.s) {
clause->Tag = cl->u.osc.c;
@@ -2920,6 +2930,10 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
if (cls->u.t_ptr &&
Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr))
break;
} else if (f == FunctorString) {
if (cls->u.t_ptr &&
Yap_String_key(sp->extra) != Yap_String_key(cls->u.t_ptr))
break;
} else {
if (cls->u.t_ptr &&
Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr))

4
C/inlines.c
View File

@@ -325,6 +325,8 @@ eq(Term t1, Term t2 USES_REGS)
return (d0 == d1);
case (CELL)FunctorLongInt:
return(LongIntOfTerm(d0) == LongIntOfTerm(d1));
case (CELL)FunctorString:
return(strcmp(StringOfTerm(d0), StringOfTerm(d1)) == 0);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return (Yap_gmp_tcmp_big_big(d0, d1) == 0);
@@ -611,6 +613,8 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */
d1 = MkIntTerm(0);
} else if (d1 == (CELL)FunctorLongInt) {
d1 = MkIntTerm(0);
} else if (d1 == (CELL)FunctorString) {
d1 = MkIntTerm(0);
} else
return(FALSE);
} else {

7
C/iopreds.c
View File

@@ -31,6 +31,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h"
/* stuff we want to use in standard YAP code */
#include "pl-shared.h"
#include "YapMirror.h"
#include <stdlib.h>
#if HAVE_STDARG_H
#include <stdarg.h>
@@ -324,7 +325,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_StringToList(varinfo->VarRep);
t[1] = Yap_CharsToListOfCodes((const char *)varinfo->VarRep PASS_REGS);
if (varinfo->VarAdr == TermNil) {
t[2] = varinfo->VarAdr = MkVarTerm();
} else {
@@ -335,13 +336,13 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
break;
case String_tok:
{
Term t0 = Yap_StringToList((char *)info);
Term t0 = Yap_CharsToListOfCodes((const char *)info PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok:
{
Term t0 = Yap_WideStringToList((wchar_t *)info);
Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;

4
C/load_foreign.c
View File

@@ -21,6 +21,8 @@ static char SccsId[] = "%W% %G%.2";
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "pl-shared.h"
#include "YapMirror.h"
#include <stdlib.h>
#if HAVE_STRING_H
#include <string.h>
@@ -211,7 +213,7 @@ p_call_shared_object_function( USES_REGS1 ) {
static Int
p_obj_suffix( USES_REGS1 ) {
return Yap_unify(Yap_StringToList(SO_EXT),ARG1);
return Yap_unify(Yap_CharsToListOfCodes(SO_EXT PASS_REGS),ARG1);
}
static Int

45
C/parser.c
View File

@@ -53,6 +53,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h"
/* stuff we want to use in standard YAP code */
#include "pl-shared.h"
#include "YapMirror.h"
#include "pl-read.h"
#include "pl-text.h"
#if HAVE_STRING_H
@@ -392,7 +393,7 @@ checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS)
static int
is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
{ GET_LD
{ CACHE_REGS
Term m = CurrentModule, t;
Atom at;
UInt arity;
@@ -688,23 +689,9 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case String_tok: /* build list on the heap */
{
Volatile char *p = (char *) LOCAL_tokptr->TokInfo;
if (*p == 0)
t = MkAtomTerm(AtomNil);
else {
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & DBLQ_CHARS)
t = Yap_StringToListOfAtoms(p);
else if (flags & DBLQ_ATOM) {
Atom at = Yap_LookupAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else if (flags & DBLQ_STRING) {
t = Yap_MkBlobStringTerm(p, strlen(p));
} else
t = Yap_StringToList(p);
t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) {
FAIL;
}
NextToken;
}
@@ -713,26 +700,8 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case WString_tok: /* build list on the heap */
{
Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo;
if (*p == 0)
t = MkAtomTerm(AtomNil);
else {
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & DBLQ_CHARS)
t = Yap_WideStringToListOfAtoms(p);
else if (flags & DBLQ_ATOM) {
Atom at = Yap_LookupWideAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else if (flags & DBLQ_STRING) {
t = Yap_MkBlobWideStringTerm(p, wcslen(p));
} else
t = Yap_WideStringToList(p);
}
if (t == 0L) {
LOCAL_ErrorMessage = "Stack Overflow";
t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) {
FAIL;
}
NextToken;

22
C/pl-yap.c
View File

@@ -7,6 +7,7 @@
#include "Yap.h"
#include "Yatom.h"
#include "pl-incl.h"
#include "YapMirror.h"
#if HAVE_MATH_H
#include <math.h>
#endif
@@ -84,13 +85,17 @@ codeToAtom(int chrcode)
word
globalString(size_t size, char *s)
{
return Yap_MkBlobStringTerm(s, size);
CACHE_REGS
return Yap_CharsToString(s PASS_REGS);
}
word
globalWString(size_t size, wchar_t *s)
{
return Yap_MkBlobWideStringTerm(s, size);
CACHE_REGS
return Yap_WCharsToString(s PASS_REGS);
}
int
@@ -414,16 +419,9 @@ get_atom_text(atom_t atom, PL_chars_t *text)
int
get_string_text(word w, PL_chars_t *text ARG_LD)
{
CELL fl = RepAppl(w)[1];
if (fl == BLOB_STRING) {
text->text.t = Yap_BlobStringOfTerm(w);
text->encoding = ENC_ISO_LATIN_1;
text->length = strlen(text->text.t);
} else {
text->text.w = Yap_BlobWideStringOfTerm(w);
text->encoding = ENC_WCHAR;
text->length = wcslen(text->text.w);
}
text->text.t = (char *)StringOfTerm(w);
text->encoding = ENC_ISO_LATIN_1;
text->length = strlen(text->text.t);
text->storage = PL_CHARS_STACK;
text->canonical = TRUE;
return TRUE;

4
C/scanner.c
View File

@@ -42,7 +42,7 @@
/* stuff we want to use in standard YAP code */
#include "pl-shared.h"
#include "pl-read.h"
#include "pl-utf8.h"
#include "YapMirror.h"
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_FINITE==1
#undef HAVE_FINITE
@@ -780,7 +780,7 @@ extend_comment(int ch USES_REGS) {
static void
close_comment( USES_REGS1 ) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_MkBlobWideStringTerm(LOCAL_CommentsBuff, LOCAL_CommentsBuffPos);
*LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL;
LOCAL_CommentsBuffLim = 0;

9
C/sysbits.c
View File

@@ -186,12 +186,14 @@ Yap_InitSysPath(void) {
int commons_done = FALSE;
{
char *dir;
if ((dir = Yap_RegistryGetString("library"))) {
if ((dir = Yap_RegistryGetString("library")) &&
is_directory(dir)) {
Yap_PutValue(AtomSystemLibraryDir,
MkAtomTerm(Yap_LookupAtom(dir)));
dir_done = TRUE;
}
if ((dir = Yap_RegistryGetString("prolog_commons"))) {
if ((dir = Yap_RegistryGetString("prolog_commons")) &&
is_directory(dir)) {
Yap_PutValue(AtomPrologCommonsDir,
MkAtomTerm(Yap_LookupAtom(dir)));
commons_done = TRUE;
@@ -207,8 +209,7 @@ Yap_InitSysPath(void) {
int buflen;
char *pt;
if ((fatts = GetFileAttributes(LOCAL_FileNameBuf)) == 0xFFFFFFFFL ||
!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
if (!is_directory(LOCAL_FileNameBuf)) {
/* couldn't find it where it was supposed to be,
let's try using the executable */
if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {

6
C/unify.c
View File

@@ -376,6 +376,8 @@ oc_unify_nvar_nvar:
return(pt0[1] == pt1[1]);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char )(pt1+2)) == 0);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
@@ -505,6 +507,8 @@ unify_nvar_nvar:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char )(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
@@ -870,6 +874,8 @@ unifiable_nvar_nvar:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char )(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP

12
C/utilpreds.c
View File

@@ -169,6 +169,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
sz = sizeof(Float)/sizeof(CELL)+2;
} else if (f== FunctorLongInt) {
sz = 3;
} else if (f== FunctorString) {
sz = 3+ap2[1];
} else {
CELL *pt = ap2+1;
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
@@ -1333,6 +1335,8 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0,
sz = sizeof(Float)/sizeof(CELL)+2;
} else if (f== FunctorLongInt) {
sz = 3;
} else if (f== FunctorString) {
sz = 3+ap2[1];
} else {
CELL *pt = ap2+1;
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
@@ -3331,6 +3335,9 @@ SizeOfExtension(Term t)
if (f== FunctorDouble) {
return 2 + sizeof(Float)/sizeof(CELL);
}
if (f== FunctorString) {
return 3 + RepAppl(t)[1];
}
if (f== FunctorLongInt) {
return 2 + sizeof(Float)/sizeof(CELL);
}
@@ -3819,6 +3826,10 @@ hash_complex_term(register CELL *pt0,
case (CELL)FunctorLongInt:
*st++ = LongIntOfTerm(d0);
break;
case (CELL)FunctorString:
memcpy(st, RepAppl(d0), (3+RepAppl(d0)[1])*sizeof(CELL));
st += 3+RepAppl(d0)[1];
break;
#ifdef USE_GMP
case (CELL)FunctorBigInt:
{
@@ -5498,6 +5509,7 @@ Yap_SkipList(Term *l, Term **tailp)
return length;
}
static Int
p_skip_list( USES_REGS1 ) {
Term *tail;

97
C/write.c
View File

@@ -29,6 +29,7 @@ static char SccsId[] = "%W% %G%";
#include "attvar.h"
#endif
#include "pl-shared.h"
#include "pl-utf8.h"
#if HAVE_STRING_H
#include <string.h>
@@ -69,7 +70,7 @@ typedef struct rewind_term {
} rwts;
typedef struct write_globs {
void *stream;
IOSTREAM*stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
@@ -166,6 +167,35 @@ wrputn(Int n, struct write_globs *wglb) /* writes an integer */
#define wrputs(s, stream) Sfputs(s, stream)
static void
wrpututf8(const char *s, struct write_globs *wglb) /* writes an integer */
{
IOSTREAM *stream = wglb->stream;
if (wglb->Write_strings)
wrputc('`', stream);
else
wrputc('"', stream);
if (stream->encoding == ENC_UTF8) {
wrputs( s, stream);
} else {
int chr;
char *ptr = (char *)s;
do {
ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break;
wrputc(chr, stream);
} while (TRUE);
}
if (wglb->Write_strings)
wrputc('`', stream);
else
wrputc('"', stream);
}
static void
wrputws(wchar_t *s, wrf stream) /* writes a string */
{
@@ -242,8 +272,14 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
CELL *pt = RepAppl(t)+1;
CELL big_tag = pt[0];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
wrputc('{', wglb->stream);
wrputs("...", wglb->stream);
wrputc('}', wglb->stream);
lastw = separator;
return;
#ifdef USE_GMP
if (big_tag == BIG_INT)
} else if (big_tag == BIG_INT)
{
MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, wglb);
@@ -252,39 +288,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
Term trat = Yap_RatTermToApplTerm(t);
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
return;
}
#endif
if (big_tag == BLOB_STRING) {
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"',wglb->stream);
wrputs(Yap_BlobStringOfTerm(t),wglb->stream);
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"',wglb->stream);
return;
} else if (big_tag == BLOB_WIDE_STRING) {
wchar_t *s = Yap_BlobWideStringOfTerm(t);
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"', wglb->stream);
while (*s) {
wrputc(*s++, wglb->stream);
}
if (wglb->Write_strings)
wrputc('`',wglb->stream);
else
wrputc('"',wglb->stream);
return;
} else if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
wrputc('{', wglb->stream);
wrputs("...", wglb->stream);
wrputc('}', wglb->stream);
lastw = separator;
return;
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
Opaque_CallOnWrite f;
CELL blob_info;
@@ -391,6 +395,21 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
protect_close_number(wglb, ob);
}
int
Yap_FormatFloat( Float f, const char *s, size_t sz )
{
struct write_globs wglb;
char *ws = (char *)s;
IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
wglb.stream = smem;
wglb.lw = separator;
wglb.last_atom_minus = FALSE;
wrputf(f, &wglb);
Sclose(smem);
return TRUE;
}
/* writes a data base reference */
static void
wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb)
@@ -429,6 +448,7 @@ wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb)
wrputs(s, stream);
}
lastw = alphanum;
return 1;
}
static int
@@ -599,7 +619,7 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
}
static int
IsStringTerm(Term string) /* checks whether this is a string */
IsCodesTerm(Term string) /* checks whether this is a string */
{
if (IsVarTerm(string))
return FALSE;
@@ -888,7 +908,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (Yap_GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
return;
}
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) {
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
putString(t, wglb);
} else {
wrputc('[', wglb->stream);
@@ -909,6 +929,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t),wglb);
return;
case (CELL)FunctorString:
wrpututf8(StringOfTerm(t),wglb);
return;
case (CELL)FunctorAttVar:
write_var(RepAppl(t)+1, wglb, &nrwt);
return;
@@ -1099,7 +1122,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsStringTerm(ti) || IsAtomTerm(ti))) {
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti);
if (k == -1) {