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

use SWI opts for read

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-11-20 22:25:27 +00:00
parent 04f3fa4d9d
commit 5f3ff4fc73
4 changed files with 8 additions and 367 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

360
C/iopreds.c
View File

@ -242,7 +242,7 @@ int beam_write (void)
{
Yap_StartSlots();
Yap_plwrite (ARG1, NULL, 0, 0, 1200);
Yap_CloseSlots();
LOCAL_CurSlot = CurSlot;
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
EX = 0L;
@ -615,9 +615,9 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
}
{
Term terror;
GenerateSyntaxError(&terror, tokstart, inp_stream, MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)) PASS_REGS);
if (LOCAL_ErrorMessage == NULL)
LOCAL_ErrorMessage = "SYNTAX ERROR";
GenerateSyntaxError(&terror, tokstart, inp_stream, MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)) PASS_REGS);
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
rd->has_exception = TRUE;
@ -707,360 +707,6 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
return TRUE;
}
/*
Assumes
Flag: ARG1
Term: ARG2
Module: ARG3
Vars: ARG4
Pos: ARG5
Err: ARG6
Comments: ARG7
*/
static Int
do_read(IOSTREAM *inp_stream, int nargs USES_REGS)
{
Term t, v;
TokEntry *tokstart;
Term tmod = Deref(ARG3), OCurrentModule = CurrentModule, tpos;
Term tcomms = Deref(ARG7);
int store_comments = IsVarTerm(tcomms);
if (IsVarTerm(tmod)) {
tmod = CurrentModule;
} else if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, tmod, "read_term/2");
return FALSE;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
while (TRUE) {
CELL *old_H;
int64_t cpos = 0;
int seekable = inp_stream->functions->seek != NULL;
/* two cases where we can seek: memory and console */
if (seekable) {
cpos = inp_stream->posbuf.byteno;
}
/* Scans the term using stack space */
while (TRUE) {
old_H = H;
tpos = Yap_StreamPosition(inp_stream);
LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos);
if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
if (seekable) {
Sseek64(inp_stream, cpos, SIO_SEEK_SET);
}
if (LOCAL_Error_TYPE == OUT_OF_TRAIL_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growtrail (sizeof(CELL) * K16, FALSE)) {
return FALSE;
}
} else if (LOCAL_Error_TYPE == OUT_OF_AUXSPACE_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
return FALSE;
}
} else if (LOCAL_Error_TYPE == OUT_OF_HEAP_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growheap(FALSE, 0, NULL)) {
return FALSE;
}
} else if (LOCAL_Error_TYPE == OUT_OF_STACK_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, nargs, ENV, CP)) {
return FALSE;
}
}
} else {
/* done with this */
break;
}
}
if (!Yap_unify(tpos,ARG5)) {
/* do this early so that we do not have to protect it in case of stack expansion */
return FALSE;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
old_H = H;
if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) {
/* did we get the end of file from an abort? */
if (LOCAL_ErrorMessage &&
!strcmp(LOCAL_ErrorMessage,"Abort")) {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE;
} else {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
if (store_comments && !Yap_unify(LOCAL_Comments, ARG7))
return FALSE;
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof))
&& Yap_unify_constant(ARG4, TermNil);
}
}
repeat_cycle:
CurrentModule = tmod;
if (LOCAL_ErrorMessage || (t = Yap_Parse()) == 0) {
CurrentModule = OCurrentModule;
if (LOCAL_ErrorMessage) {
int res;
if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow") ||
!strcmp(LOCAL_ErrorMessage,"Trail Overflow") ||
!strcmp(LOCAL_ErrorMessage,"Heap Overflow")) {
/* ignore term we just built */
tr_fr_ptr old_TR = TR;
H = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow"))
res = Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
else if (!strcmp(LOCAL_ErrorMessage,"Heap Overflow"))
res = Yap_growheap_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
else
res = Yap_growtrail_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
if (res) {
LOCAL_ScannerStack = (char *)TR;
TR = old_TR;
old_H = H;
LOCAL_tokptr = LOCAL_toktide = tokstart;
LOCAL_ErrorMessage = NULL;
goto repeat_cycle;
}
LOCAL_ScannerStack = (char *)TR;
TR = old_TR;
}
}
if (ParserErrorStyle == QUIET_ON_PARSER_ERROR) {
/* just fail */
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE;
} else if (ParserErrorStyle == CONTINUE_ON_PARSER_ERROR) {
LOCAL_ErrorMessage = NULL;
/* try again */
goto repeat_cycle;
} else {
Term terr = syntax_error(tokstart, inp_stream, &ARG2);
if (LOCAL_ErrorMessage == NULL)
LOCAL_ErrorMessage = "SYNTAX ERROR";
if (ParserErrorStyle == EXCEPTION_ON_PARSER_ERROR) {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage);
return FALSE;
} else /* FAIL ON PARSER ERROR */ {
Term t[2];
t[0] = terr;
t[1] = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(AtomError,2),2,t));
}
}
} else {
CurrentModule = OCurrentModule;
/* parsing succeeded */
break;
}
}
if (!Yap_unify(t, ARG2))
return FALSE;
if (store_comments && !Yap_unify(LOCAL_Comments, ARG7))
return FALSE;
if (AtomOfTerm (Deref (ARG1)) == AtomTrue) {
while (TRUE) {
CELL *old_H = H;
if (setjmp(LOCAL_IOBotch) == 0) {
v = Yap_VarNames(LOCAL_VarTable, TermNil);
break;
} else {
tr_fr_ptr old_TR;
restore_machine_regs();
old_TR = TR;
/* restart global */
H = old_H;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
Yap_growstack_in_parser(&old_TR, &tokstart, &LOCAL_VarTable);
LOCAL_ScannerStack = (char *)TR;
TR = old_TR;
}
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return Yap_unify (v, ARG4);
} else {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return TRUE;
}
}
static Int
p_read ( USES_REGS1 )
{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
IOSTREAM *Yap_Scurin(void);
return do_read(Yap_Scurin(), 7 PASS_REGS);
}
static Int
p_read2 ( USES_REGS1 )
{ /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
IOSTREAM *inp_stream;
Int out;
Term t8 = Deref(ARG8);
if (IsVarTerm(t8)) {
Yap_Error(INSTANTIATION_ERROR,t8,"read_term/3");
return FALSE;
}
if (!IsAtomTerm(t8)) {
Yap_Error(TYPE_ERROR_LIST,t8,"read_term/3");
return(FALSE);
}
if (!(inp_stream = Yap_GetInputStream(AtomOfTerm(t8))) ) {
return(FALSE);
}
out = do_read(inp_stream, 8 PASS_REGS);
return out;
}
#if HAVE_SELECT && FALSE
/* stream_select(+Streams,+TimeOut,-Result) */
static Int
p_stream_select( USES_REGS1 )
{
Term t1 = Deref(ARG1), t2;
fd_set readfds, writefds, exceptfds;
struct timeval timeout, *ptime;
#if _MSC_VER
u_int fdmax=0;
#else
int fdmax=0;
#endif
Term tout = TermNil, ti, Head;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"stream_select/3");
return FALSE;
}
if (!IsPairTerm(t1)) {
Yap_Error(TYPE_ERROR_LIST,t1,"stream_select/3");
return(FALSE);
}
FD_ZERO(&readfds);
FD_ZERO(&writefds);
FD_ZERO(&exceptfds);
ti = t1;
while (ti != TermNil) {
#if _MSC_VER
u_int fd;
#else
int fd;
#endif
int sno;
Head = HeadOfTerm(ti);
sno = CheckStream(Head, Input_Stream_f, "stream_select/3");
if (sno < 0)
return(FALSE);
fd = GetStreamFd(sno);
FD_SET(fd, &readfds);
UNLOCK(Stream[sno].streamlock);
if (fd > fdmax)
fdmax = fd;
ti = TailOfTerm(ti);
}
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"stream_select/3");
return(FALSE);
}
if (IsAtomTerm(t2)) {
if (t2 == MkAtomTerm(AtomOff)) {
/* wait indefinitely */
ptime = NULL;
} else {
Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t1,"stream_select/3");
return(FALSE);
}
} else {
Term t21, t22;
if (!IsApplTerm(t2) || FunctorOfTerm(t2) != FunctorModule) {
Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3");
return(FALSE);
}
t21 = ArgOfTerm(1, t2);
if (IsVarTerm(t21)) {
Yap_Error(INSTANTIATION_ERROR,t2,"stream_select/3");
return(FALSE);
}
if (!IsIntegerTerm(t21)) {
Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3");
return(FALSE);
}
timeout.tv_sec = IntegerOfTerm(t21);
if (timeout.tv_sec < 0) {
Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3");
return(FALSE);
}
t22 = ArgOfTerm(2, t2);
if (IsVarTerm(t22)) {
Yap_Error(INSTANTIATION_ERROR,t2,"stream_select/3");
return(FALSE);
}
if (!IsIntegerTerm(t22)) {
Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3");
return(FALSE);
}
timeout.tv_usec = IntegerOfTerm(t22);
if (timeout.tv_usec < 0) {
Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3");
return(FALSE);
}
ptime = &timeout;
}
/* do the real work */
if (select(fdmax+1, &readfds, &writefds, &exceptfds, ptime) < 0) {
#if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR, TermNil,
"stream_select/3 (select: %s)", strerror(errno));
#else
Yap_Error(SYSTEM_ERROR, TermNil,
"stream_select/3 (select)");
#endif
}
while (t1 != TermNil) {
int fd;
int sno;
Head = HeadOfTerm(t1);
sno = CheckStream(Head, Input_Stream_f, "stream_select/3");
fd = GetStreamFd(sno);
if (FD_ISSET(fd, &readfds))
tout = MkPairTerm(Head,tout);
else
tout = MkPairTerm(TermNil,tout);
UNLOCK(Stream[sno].streamlock);
t1 = TailOfTerm(t1);
}
/* we're done, just pass the info back */
return(Yap_unify(ARG3,tout));
}
#endif
static Int
p_change_type_of_char ( USES_REGS1 )
{ /* change_type_of_char(+char,+type) */
@ -1282,8 +928,6 @@ Yap_InitIOPreds(void)
/* here the Input/Output predicates */
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$read", 7, p_read, SyncPredFlag|UserCPredFlag);
Yap_InitCPred ("$read", 8, p_read2, SyncPredFlag|UserCPredFlag);
#ifdef DEBUG
Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag);
#endif

8
C/pl-yap.c
View File

@ -865,9 +865,9 @@ char *
Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int flags)
{
CACHE_REGS
Int l;
Int l, CurSlot;
Yap_StartSlots( PASS_REGS1 );
CurSlot = Yap_StartSlots( PASS_REGS1 );
l = Yap_InitSlot(t PASS_REGS );
{ IOENC encodings[3];
@ -910,8 +910,6 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int
strncpy(bf,buf,*length+1);
r = bf;
}
/* go away */
Yap_CloseSlots( PASS_REGS1 );
return r;
} else
{ Sclose(fd);
@ -922,7 +920,7 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int
Sfree(r);
}
}
Yap_CloseSlots( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
return NULL;
}

1
C/qlyr.c
View File

@ -1058,7 +1058,6 @@ p_read_program( USES_REGS1 )
read_module(stream);
Sclose( stream );
/* back to the top level we go */
Yap_CloseSlots(PASS_REGS1);
ReInitProlog();
Yap_RestartYap( 3 );
return TRUE;

6
C/save.c
View File

@ -617,7 +617,7 @@ do_save(int mode USES_REGS) {
static Int
p_save2( USES_REGS1 )
{
Int res;
Int res, CurSlot;
Term t;
#ifdef YAPOR
@ -640,9 +640,9 @@ p_save2( USES_REGS1 )
if (!Yap_unify(ARG2,MkIntTerm(1)))
return FALSE;
which_save = 2;
Yap_StartSlots( PASS_REGS1 );
CurSlot = Yap_StartSlots( PASS_REGS1 );
res = do_save(DO_EVERYTHING PASS_REGS);
Yap_CloseSlots( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
return res;
}