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

memstream

Browse Source
This commit is contained in:
Vítor Santos Costa 2018-07-13 12:27:58 +01:00
parent c2e2ec8fcf
commit 4b474574d8
8 changed files with 153 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

170
C/text.c
View File

@ -215,10 +215,7 @@ void *Yap_InitTextAllocator(void) {
return new;
}
static size_t MaxTmp(USES_REGS1) {
return 1025;
}
static size_t MaxTmp(USES_REGS1) { return 1025; }
static Term Globalize(Term v USES_REGS) {
if (!IsVarTerm(v = Deref(v))) {
@ -231,7 +228,8 @@ static Term Globalize(Term v USES_REGS) {
return v;
}
static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) {
static void *codes2buf(Term t0, void *b0, bool get_codes,
bool fixed USES_REGS) {
unsigned char *st0, *st, ar[16];
Term t = t0;
size_t length = 0;
@ -242,13 +240,14 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS)
return st0;
}
if (!IsPairTerm(t)) {
Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes");
return NULL;
Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes");
return NULL;
}
bool codes = IsIntegerTerm(HeadOfTerm(t));
if (get_codes !=codes && fixed) {
if (get_codes != codes && fixed) {
if (codes) {
Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), "scanning list of codes");
Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t),
"scanning list of codes");
} else {
Yap_ThrowError(TYPE_ERROR_ATOM, HeadOfTerm(t), "scanning list of atoms");
}
@ -266,7 +265,8 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS)
}
Int code = IntegerOfTerm(hd);
if (code < 0) {
Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, "scanning list of character codes, found %d", code);
Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd,
"scanning list of character codes, found %d", code);
return NULL;
}
length += put_utf8(ar, code);
@ -420,136 +420,146 @@ static yap_error_number gen_type_error(int flags) {
// static int cnt;
unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
#define POPRET(x) return pop_output_text_stack(lvl, x)
int lvl = push_text_stack();
char *out = NULL;
yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {
LOCAL_Error_TYPE = TYPE_ERROR_TEXT;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
}
}
if (err0 != LOCAL_Error_TYPE) {
Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in");
}
}
if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) {
// this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t);
if (RepAtom(at)->UStrOfAE[0] == 0) {
unsigned char *o = Malloc(4);
memset(o, 0, 4);
return pop_output_text_stack(lvl, o);
out = Malloc(4);
memset(out, 0, 4);
POPRET( out );
}
if (inp->type & YAP_STRING_WITH_BUFFER) {
pop_text_stack(lvl);
return at->UStrOfAE;
}
size_t sz = strlen(at->StrOfAE);
void *o = Malloc(sz + 1);
strcpy(o, at->StrOfAE);
return pop_output_text_stack(lvl, o);
{
size_t sz = strlen(at->StrOfAE);
out = Malloc(sz + 1);
strcpy(out, at->StrOfAE);
POPRET( out );
}
}
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t);
const char *s = StringOfTerm(inp->val.t);
if (s[0] == 0) {
char *o = Malloc(4);
memset(o, 0, 4);
return pop_output_text_stack(lvl, o);
out = Malloc(4);
memset(out, 0, 4);
POPRET( out );
}
if (inp->type & YAP_STRING_WITH_BUFFER) {
pop_text_stack(lvl);
return (unsigned char *)UStringOfTerm(inp->val.t);
}
{
inp->type |= YAP_STRING_IN_TMP;
size_t sz = strlen(s);
out = Malloc(sz + 1);
strcpy(out, s);
POPRET( out );
}
} else if (IsPairOrNilTerm(inp->val.t)) {
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS))) {
// Yap_DebugPlWriteln(inp->val.t);
out = (char *)Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS);
POPRET( out );
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_CODES) {
// Yap_DebugPlWriteln(inp->val.t);
out = (char *)Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS);
// this is a term, extract to a sfer, and representation is wide
POPRET( out );
}
if (inp->type & YAP_STRING_ATOMS) {
// Yap_DebugPlWriteln(inp->val.t);
out = (char *)Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS);
// this is a term, extract to a buffer, and representation is wide
POPRET( out );
}
if (inp->type & YAP_STRING_WITH_BUFFER)
return (unsigned char *)UStringOfTerm(inp->val.t);
inp->type |= YAP_STRING_IN_TMP;
size_t sz = strlen(s);
char *o = Malloc(sz + 1);
strcpy(o, s);
return pop_output_text_stack(lvl, o);
}
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS)) &&
IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(
lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(
lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(
lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a buffer, and representation is wide
}
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
// ASCII, so both LATIN1 and UTF-8
// Yap_DebugPlWriteln(inp->val.t);
char *s;
s = Malloc(2 * MaxTmp(PASS_REGS1));
if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
out = Malloc(2 * MaxTmp(PASS_REGS1));
if (snprintf(out, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
IntegerOfTerm(inp->val.t)) < 0) {
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), out, char);
}
return pop_output_text_stack(lvl, s);
POPRET( out );
}
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
char *s;
// Yap_DebugPlWriteln(inp->val.t);
if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) {
out = Malloc(2 * MaxTmp(PASS_REGS1));
if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &out, 1024)) {
pop_text_stack(lvl);
return NULL;
}
return pop_output_text_stack(lvl, s);
}
POPRET(out);
}
#if USE_GMP
if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
char *s;
s = Malloc(MaxTmp());
if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) {
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
out = Malloc(MaxTmp());
if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), out, MaxTmp() - 1,
10)) {
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), out, char);
}
return inp->val.uc = pop_output_text_stack(lvl, s);
POPRET(out);
}
#endif
if (inp->type & YAP_STRING_TERM) {
// Yap_DebugPlWriteln(inp->val.t);
char *s = (char *)Yap_TermToBuffer(inp->val.t, 0);
}
if (inp->type & YAP_STRING_CHARS) {
pop_text_stack(lvl);
if (inp->enc == ENC_ISO_LATIN1) {
return latin2utf8(inp);
} else if (inp->enc == ENC_ISO_ASCII) {
return inp->val.uc;
} else { // if (inp->enc == ENC_ISO_UTF8) {
return Yap_TermToBuffer(inp->val.t, 0);
}
if (inp->type & YAP_STRING_CHARS) {
if (inp->enc == ENC_ISO_ASCII) {
pop_text_stack(lvl);
return inp->val.uc;
}
if (inp->enc == ENC_ISO_LATIN1) {
POPRET( (char*)latin2utf8(inp));
}
if (inp->enc == ENC_ISO_UTF8) {
pop_text_stack(lvl);
return inp->val.c;
}
}
pop_text_stack(lvl);
if (inp->type & YAP_STRING_WCHARS) {
// printf("%S\n",inp->val.w);
return wchar2utf8(inp);
POPRET( (char *)wchar2utf8(inp) );
}
pop_text_stack(lvl);
return NULL;
}

25
C/write.c
View File

@ -384,9 +384,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) {
wglb.lw = separator;
wglb.stream = GLOBAL_Stream + sno;
wrputf(f, &wglb);
so = Yap_MemExportStreamPtr(sno);
*s = BaseMalloc(strlen(so) + 1);
strcpy(*s, so);
*s = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
return true;
}
@ -1255,24 +1253,3 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
pop_text_stack(lvl);
}
char *Yap_TermToBuffer(Term t, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(LOCAL_encoding,flags);
const char *sf;
if (sno < 0)
return NULL;
if (t == 0)
return NULL;
else
t = Deref(t);
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
sf = Yap_MemExportStreamPtr(sno);
size_t len = strlen(sf);
char *new = realloc((void*)sf,len + 1);
Yap_CloseStream(sno);
return new;
}

54
os/fmem.c
View File

@ -203,7 +203,9 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
return -1;
st = GLOBAL_Stream + sno;
st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f;
st->status = Output_Stream_f | InMemory_Stream_f;
if (st->nbuf)
st->status |= FreeOnClose_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
@ -212,15 +214,15 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
st->buf.on = true;
st->nbuf = NULL;
st->nsize = 0;
st->status |= Seekable_Stream_f;
#if HAVE_OPEN_MEMSTREAM
st->file = open_memstream(&st->nbuf, &st->nsize);
// setbuf(st->file, NULL);
st->status |= Seekable_Stream_f;
#else
st->file = fmemopen((void *)st->nbuf, st->nsize, "w");
if (!st->nbuf) {
return -1;
}
#else
st->file = fmemopen((void *)st->nbuf, st->nsize, "w+");
#endif
Yap_DefaultStreamOps(st);
UNLOCK(st->streamlock);
@ -257,35 +259,41 @@ open_mem_write_stream(USES_REGS1) /* $open_mem_write_stream(-Stream) */
* by other writes..
*/
char *Yap_MemExportStreamPtr(int sno) {
char *s;
if (fflush(GLOBAL_Stream[sno].file) == 0) {
s = GLOBAL_Stream[sno].nbuf;
// s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0';
return s;
if (fflush(GLOBAL_Stream[sno].file) < 0) {
return NULL;
}
return NULL;
size_t len = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END);
char *buf = malloc(len+1);
#if HAVE_OPEN_MEMSTREAM
char *s = GLOBAL_Stream[sno].nbuf;
memcpy(buf, s, len);
// s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0';
#else
fread(buf, sz, 1, GLOBAL_Stream[sno].file);
#endif
buf[len] = '\0';
return buf;
}
static Int peek_mem_write_stream(
USES_REGS1) { /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */
Int sno =
Yap_CheckStream(ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2");
Int i;
Term tf = ARG2;
CELL *HI;
const char *ptr;
char *ptr;
int ch;
if (sno < 0)
return (FALSE);
restart:
char *p = ptr = Yap_MemExportStreamPtr(sno);
restart:
HI = HR;
if (fflush(GLOBAL_Stream[sno].file) == 0) {
i = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END);
ptr = GLOBAL_Stream[sno].nbuf;
}
while (i > 0) {
--i;
tf = MkPairTerm(MkIntTerm(ptr[i]), tf);
while ((ch = *p++)) {
HR[0] = MkIntTerm(ch);
HR[1] = AbsPair(HR+2);
HR += 2;
if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI;
@ -294,14 +302,14 @@ restart:
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return (FALSE);
}
i = GLOBAL_Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(GLOBAL_Stream[sno].streamlock);
goto restart;
}
}
HR[-1] = tf;
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify(ARG3, tf));
free(ptr);
return (Yap_unify(ARG3, AbsPair(HI)));
}
void Yap_MemOps(StreamDesc *st) {

19
os/writeterm.c
View File

@ -711,6 +711,25 @@ static Int term_to_atom(USES_REGS1) {
Yap_unify(rc, ARG1);
}
char *Yap_TermToBuffer(Term t, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(LOCAL_encoding,flags);
if (sno < 0)
return NULL;
if (t == 0)
return NULL;
else
t = Deref(t);
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
char *new = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
return new;
}
void Yap_InitWriteTPreds(void) {
Yap_InitCPred("write_term", 2, write_term2, SyncPredFlag);
Yap_InitCPred("write_term", 3, write_term3, SyncPredFlag);

7
pl/boot.yap
View File

@ -262,6 +262,7 @@ initialize_prolog :-
:- c_compile( 'preds.yap' ).
:- c_compile( 'modules.yap' ).
:- c_compile( 'grammar.yap' ).
:- c_compile( 'protect.yap' ).
:- ['absf.yap'].
@ -314,11 +315,7 @@ initialize_prolog :-
:- multifile prolog:'$system_predicate'/2.
:- ['protect.yap'].
version(yap,[6,4]).
:- op(1150,fx,(mode)).
:- '$opdec'(1150,fx,(mode),prolog).
:- dynamic 'extensions_to_present_answer'/1.

9
pl/consult.yap
View File

@ -274,11 +274,14 @@ load_files(_Files,_Opts).
setarg( Id, TOpts, Val ).
'$load_files'(Files, Opts, Call) :-
( '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) - '$lf_opt'(autoload, OldTOpts, OldAutoload)
(
'__NB_getval__'('$lf_status', OldTOpts, fail)
->
'$lf_opt'('$context_module', OldTOpts, Context),
'$lf_opt'(autoload, OldTOpts, OldAutoload)
;
'$lf_option'(last_opt, LastOpt),
functor( OldTOpts, opt, LastOpt ),
'$lf_opt'('$context_module', OldTOpts, user)
functor( OldTOpts, opt, LastOpt )
),
'$lf_option'(last_opt, LastOpt),
functor( TOpts, opt, LastOpt ),

2
pl/imports.yap
View File

@ -27,7 +27,6 @@
'$pred_exists'(G, user).
% autoload
'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :-
recorded('$dialect',swi,_),
prolog_flag(autoload, true),
prolog_flag(unknown, OldUnk, fail),
(
@ -67,4 +66,3 @@
*
* @}
*/

8
pl/protect.yap
View File

@ -36,12 +36,12 @@
*/
'$protect' :-
prolog:'$protect' :-
'$all_current_modules'(M),
( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ),
new_system_module( M ),
fail.
'$protect' :-
prolog:'$protect' :-
'$current_predicate'(Name,M,P,_),
'$is_system_module'(M),
functor(P,Name,Arity),
@ -50,13 +50,13 @@
functor(P,Name,Arity),
'$hide_predicate'(P,M),
fail.
'$protect' :-
prolog:'$protect' :-
current_atom(Name),
sub_atom(Name,0,1,_, '$'),
\+ '$visible'(Name),
hide_atom(Name),
fail.
'$protect'.
prolog:'$protect'.
% hide all atoms who start by '$'