read works now.

This commit is contained in:
ubu32 2011-02-14 23:39:27 -08:00
parent 78ea2213d1
commit 140318ff16
13 changed files with 263 additions and 223 deletions

View File

@ -333,6 +333,7 @@
#include <stdlib.h>
#include "Yap.h"
#include "clause.h"
#include "SWI-Stream.h"
#include "yapio.h"
#include "attvar.h"
#if HAVE_STDARG_H
@ -457,9 +458,9 @@ X_API int STD_PROTO(YAP_GoalHasException,(Term *));
X_API void STD_PROTO(YAP_ClearExceptions,(void));
X_API int STD_PROTO(YAP_ContinueGoal,(void));
X_API void STD_PROTO(YAP_PruneGoal,(void));
X_API void STD_PROTO(YAP_InitConsult,(int, char *));
X_API void STD_PROTO(YAP_EndConsult,(void));
X_API Term STD_PROTO(YAP_Read, (int (*)(void)));
X_API IOSTREAM *STD_PROTO(YAP_InitConsult,(int, char *));
X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *));
X_API Term STD_PROTO(YAP_Read, (IOSTREAM *));
X_API void STD_PROTO(YAP_Write, (Term, int (*)(wchar_t), int));
X_API Term STD_PROTO(YAP_CopyTerm, (Term));
X_API Term STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned int, int));
@ -1512,7 +1513,18 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
}
return out;
} else {
return((exec_code)());
Int ret = (exec_code)();
if (!ret) {
Term t;
BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
return ret;
}
}
@ -1566,7 +1578,18 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
return TRUE;
}
} else {
return (exec_code)();
Int ret = (exec_code)();
if (!ret) {
Term t;
BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
return ret;
}
}
@ -1609,7 +1632,18 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code)
return TRUE;
}
} else {
return (exec_code)();
Int ret = (exec_code)();
if (!ret) {
Term t;
BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
return ret;
}
}
@ -1659,8 +1693,20 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
*/
}
return TRUE;
} else {
Int ret = (exec_code)();
if (!ret) {
Term t;
BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
return ret;
}
return (exec_code)();
}
X_API Int
@ -2355,31 +2401,34 @@ YAP_ClearExceptions(void)
UncaughtThrow = FALSE;
}
X_API void
X_API IOSTREAM *
YAP_InitConsult(int mode, char *filename)
{
IOSTREAM *st;
BACKUP_MACHINE_REGS();
if (mode == YAP_CONSULT_MODE)
Yap_init_consult(FALSE, filename);
else
Yap_init_consult(TRUE, filename);
st = Sopen_file(filename, "r");
RECOVER_MACHINE_REGS();
return st;
}
X_API void
YAP_EndConsult(void)
YAP_EndConsult(IOSTREAM *s)
{
BACKUP_MACHINE_REGS();
Yap_end_consult();
Sclose(s);
RECOVER_MACHINE_REGS();
}
X_API Term
YAP_Read(int (*mygetc)(void))
YAP_Read(IOSTREAM *inp)
{
Term t, tpos = TermNil;
int sno;
@ -2387,23 +2436,19 @@ YAP_Read(int (*mygetc)(void))
BACKUP_MACHINE_REGS();
do_getf = mygetc;
sno = Yap_GetFreeStreamDForReading();
if (sno < 0) {
Yap_Error(SYSTEM_ERROR,TermNil, "new stream not available for YAP_Read");
return TermNil;
}
Stream[sno].stream_getc = do_yap_getc;
Stream[sno].status |= Tty_Stream_f;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
Stream[sno].status = Free_Stream_f;
UNLOCK(Stream[sno].streamlock);
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp, &tpos);
if (Yap_ErrorMessage)
{
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
RECOVER_MACHINE_REGS();
return 0;
}
if (inp->flags & (SIO_FEOF|SIO_FEOF2)) {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
RECOVER_MACHINE_REGS();
return MkAtomTerm (AtomEof);
}
t = Yap_Parse();
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
@ -2513,21 +2558,20 @@ do_bootfile (char *bootfilename)
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"),1);
/* consult boot.pl */
bootfile = fopen (bootfilename, "r");
if (bootfile == NULL)
{
fprintf(stderr, "[ FATAL ERROR: could not open bootfile %s ]\n", bootfilename);
exit(1);
}
/* the consult mode does not matter here, really */
/*
To be honest, YAP_InitConsult does not really do much,
it's here for the future. It also makes what we want to do clearer.
*/
YAP_InitConsult(YAP_CONSULT_MODE,bootfilename);
bootfile = YAP_InitConsult(YAP_CONSULT_MODE,bootfilename);
if (bootfile == NULL)
{
fprintf(stderr, "[ FATAL ERROR: could not open bootfile %s ]\n", bootfilename);
exit(1);
}
while (!eof_found)
{
t = YAP_Read(mygetc);
t = YAP_Read(bootfile);
if (eof_found) {
break;
}
@ -2566,8 +2610,7 @@ do_bootfile (char *bootfilename)
/* do backtrack */
YAP_Reset();
}
YAP_EndConsult();
fclose (bootfile);
YAP_EndConsult(bootfile);
#ifdef DEBUG
if (output_msg)
fprintf(stderr,"Boot loaded\n");

View File

@ -1868,11 +1868,9 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
it's up to her to decide */
if (Yap_PrologMode & UserCCallMode) {
if (EX) {
if (!(EX = Yap_StoreTermInDB(Yap_MkApplTerm(fun, 2, nt), 0))) {
/* fat chance */
siglongjmp(Yap_RestartEnv,1);
}
if (!(EX = Yap_StoreTermInDB(Yap_MkApplTerm(fun, 2, nt), 0))) {
/* fat chance */
siglongjmp(Yap_RestartEnv,1);
}
} else {
if (type == PURE_ABORT) {

View File

@ -27,6 +27,7 @@ static char SccsId[] = "%W% %G%";
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "SWI-Stream.h"
#include "yapio.h"
#include "eval.h"
#include <stdlib.h>
@ -106,7 +107,6 @@ STATIC_PROTO (int CheckStream, (Term, int, char *));
STATIC_PROTO (Int p_set_read_error_handler, (void));
STATIC_PROTO (Int p_get_read_error_handler, (void));
STATIC_PROTO (Int p_read, (void));
STATIC_PROTO (Int p_past_eof, (void));
STATIC_PROTO (Int p_write_depth, (void));
STATIC_PROTO (Int p_startline, (void));
STATIC_PROTO (Int p_change_type_of_char, (void));
@ -114,7 +114,7 @@ STATIC_PROTO (Int p_type_of_char, (void));
STATIC_PROTO (void CloseStream, (int));
STATIC_PROTO (int get_wchar, (int));
STATIC_PROTO (int put_wchar, (int,wchar_t));
STATIC_PROTO (Term StreamPosition, (int));
STATIC_PROTO (Term StreamPosition, (IOSTREAM *));
static encoding_t
DefaultEncoding(void)
@ -1607,11 +1607,12 @@ Yap_UnLockStream (int sno)
}
#endif
extern Atom Yap_FileName(IOSTREAM *s);
static Term
StreamName(int i)
StreamName(IOSTREAM *s)
{
if (i < 3) return(MkAtomTerm(AtomUser));
return(Stream[i].u.file.user_name);
return MkAtomTerm(Yap_FileName(s));
}
@ -1709,7 +1710,7 @@ clean_vars(VarEntry *p)
}
static Term
syntax_error (TokEntry * tokptr, int sno, Term *outp)
syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
{
Term info;
int count = 0, out = 0;
@ -1821,7 +1822,7 @@ syntax_error (TokEntry * tokptr, int sno, Term *outp)
tf[2] = MkAtomTerm(AtomHERE);
tf[4] = MkIntegerTerm(out);
tf[5] = MkIntegerTerm(err);
tf[6] = StreamName(sno);
tf[6] = StreamName(st);
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
}
@ -1894,15 +1895,16 @@ p_get_read_error_handler(void)
}
int
Yap_readTerm(int sno, Term *tp, Term *varnames, Term *terror, Term *tpos)
Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos)
{
TokEntry *tokstart;
Term pt;
IOSTREAM *st = (IOSTREAM *)st0;
if (sno < 0) {
if (st == NULL) {
return FALSE;
}
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, tpos);
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(st, tpos);
if (Yap_ErrorMessage)
{
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
@ -1914,7 +1916,7 @@ Yap_readTerm(int sno, Term *tp, Term *varnames, Term *terror, Term *tpos)
pt = Yap_Parse();
if (Yap_ErrorMessage) {
Term t0 = MkVarTerm();
*terror = syntax_error(tokstart, sno, &t0);
*terror = syntax_error(tokstart, st, &t0);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
}
@ -1939,7 +1941,7 @@ Yap_readTerm(int sno, Term *tp, Term *varnames, Term *terror, Term *tpos)
Err: ARG6
*/
static Int
do_read(int inp_stream, int nargs)
do_read(IOSTREAM *inp_stream, int nargs)
{
Term t, v;
TokEntry *tokstart;
@ -1954,8 +1956,8 @@ static Int
Yap_Error(TYPE_ERROR_ATOM, tmod, "read_term/2");
return FALSE;
}
if (Stream[inp_stream].status & Binary_Stream_f) {
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[inp_stream].u.file.name), "read_term/2");
if (!(inp_stream->flags & SIO_TEXT)) {
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, StreamName(inp_stream), "read_term/2");
return FALSE;
}
Yap_Error_TYPE = YAP_NO_ERROR;
@ -1966,21 +1968,12 @@ static Int
}
while (TRUE) {
CELL *old_H;
UInt cpos = 0;
int seekable = Stream[inp_stream].status & Seekable_Stream_f;
#if HAVE_FGETPOS
fpos_t rpos;
#endif
int ungetc_oldc = 0;
int had_ungetc = FALSE;
int64_t cpos = 0;
int seekable = inp_stream->functions->seek != NULL;
/* two cases where we can seek: memory and console */
if (seekable) {
if (Stream[inp_stream].stream_getc == PlUnGetc) {
had_ungetc = TRUE;
ungetc_oldc = Stream[inp_stream].och;
}
cpos = Stream[inp_stream].charcount;
cpos = inp_stream->posbuf.byteno;
}
/* Scans the term using stack space */
while (TRUE) {
@ -1991,18 +1984,8 @@ static Int
if (Yap_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H;
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
if (had_ungetc) {
Stream[inp_stream].stream_getc = PlUnGetc;
Stream[inp_stream].och = ungetc_oldc;
}
if (seekable) {
if (Stream[inp_stream].status) {
#if HAVE_FGETPOS
fsetpos(Stream[inp_stream].u.file.file, &rpos);
#else
fseek(Stream[inp_stream].u.file.file, cpos, 0L);
#endif
}
Sseek64(inp_stream, cpos, SIO_SEEK_SET);
}
if (Yap_Error_TYPE == OUT_OF_TRAIL_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
@ -2034,27 +2017,17 @@ static Int
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
old_H = H;
if (Stream[inp_stream].status & Eof_Stream_f) {
if (Yap_eot_before_eof) {
/* next read should give out an end of file */
Stream[inp_stream].status |= Push_Eof_Stream_f;
if (tokstart != NULL && tokstart->Tok == Ord (eot_tok)) {
/* did we get the end of file from an abort? */
if (Yap_ErrorMessage &&
!strcmp(Yap_ErrorMessage,"Abort")) {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
} else {
if (tokstart != NULL && tokstart->Tok != Ord (eot_tok)) {
/* we got the end of file from an abort */
if (Yap_ErrorMessage &&
!strcmp(Yap_ErrorMessage,"Abort")) {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
}
/* we need to force the next reading to also give end of file.*/
Stream[inp_stream].status |= Push_Eof_Stream_f;
Yap_ErrorMessage = "end of file found before end of term";
} else {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof))
&& Yap_unify_constant(ARG4, TermNil);
}
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof))
&& Yap_unify_constant(ARG4, TermNil);
}
}
repeat_cycle:
@ -2159,36 +2132,40 @@ static Int
static Int
p_read (void)
{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
return do_read(Yap_c_input_stream, 6);
return do_read(NULL, 6);
}
extern int getInputStream(int, IOSTREAM **);
static Int
p_read2 (void)
{ /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream;
IOSTREAM *inp_stream;
Int out;
/* needs to change Yap_c_output_stream for write */
inp_stream = CheckStream (ARG7, Input_Stream_f, "read/3");
if (inp_stream == -1) {
if (!getInputStream(Yap_InitSlot(Deref(ARG7)), &inp_stream)) {
return(FALSE);
}
UNLOCK(Stream[inp_stream].streamlock);
out = do_read(inp_stream, 7);
return out;
}
static Term
StreamPosition(int sno)
StreamPosition(IOSTREAM *st)
{
return TermNil;
Term t[4];
t[0] = MkIntegerTerm(st->posbuf.charno);
t[1] = MkIntegerTerm(st->posbuf.lineno);
t[2] = MkIntegerTerm(st->posbuf.linepos);
t[3] = MkIntegerTerm(st->posbuf.byteno);
return Yap_MkApplTerm(FunctorStreamPos,4,t);
}
Term
Yap_StreamPosition(int sno)
Yap_StreamPosition(IOSTREAM *st)
{
return StreamPosition(sno);
return StreamPosition(st);
}
@ -2663,8 +2640,6 @@ Yap_InitBackIO (void)
void
Yap_InitIOPreds(void)
{
Term cm = CurrentModule;
Yap_stdin = stdin;
Yap_stdout = stdout;
Yap_stderr = stderr;

View File

@ -35,6 +35,7 @@
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "SWI-Stream.h"
#include "yapio.h"
#include "alloc.h"
#include "eval.h"
@ -58,9 +59,8 @@
#define my_isupper(C) ( C >= 'A' && C <= 'Z' )
#define my_islower(C) ( C >= 'a' && C <= 'z' )
STATIC_PROTO(int my_getch, (int (*) (int)));
STATIC_PROTO(Term float_send, (char *, int));
STATIC_PROTO(Term get_num, (int *, int *, int, int (*) (int), int (*) (int),char *,UInt,int));
STATIC_PROTO(Term get_num, (int *, int *, IOSTREAM *,char *,UInt,int));
/* token table with some help from Richard O'Keefe's PD scanner */
static char chtype0[NUMBER_OF_CHARS+1] =
@ -139,6 +139,27 @@ Yap_wide_chtype(Int ch) {
}
static inline int
getchr__(IOSTREAM *inp)
{ int c = Sgetcode(inp);
if ( !CharConversionTable || c < 0 || c >= 256 )
return c;
return CharConversionTable[c];
}
#define getchr(inp) getchr__(inp)
#define getchrq(inp) Sgetcode(inp)
EXTERN inline int
GetCurInpPos (IOSTREAM *inp_stream)
{
return inp_stream->posbuf.lineno;
}
/* in case there is an overflow */
typedef struct scanner_extra_alloc {
@ -202,17 +223,6 @@ Yap_AllocScannerMemory(unsigned int size)
return AllocScannerMemory(size);
}
inline static int
my_getch(int (*Nextch) (int))
{
int ch = (*Nextch) (Yap_c_input_stream);
#ifdef DEBUG
if (Yap_Option[1])
fprintf(Yap_stderr, "[getch %c]", ch);
#endif
return(ch);
}
extern double atof(const char *);
static Term
@ -251,18 +261,19 @@ read_int_overflow(const char *s, Int base, Int val, int sign)
#endif
}
static wchar_t
read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
{
int ch;
/* escape sequence */
restart:
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
switch (ch) {
case 10:
do {
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch == '\\') goto restart;
if (chtype(ch) != BS || ch == 10) {
return ch;
@ -278,7 +289,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
return 0;
} else {
/* sicstus */
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (chtype(ch) == SL) {
goto restart;
} else {
@ -303,7 +314,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
wchar_t wc='\0';
for (i=0; i< 4; i++) {
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch>='0' && ch <= '9') {
wc += (ch-'0')<<((3-i)*4);
} else if (ch>='a' && ch <= 'f') {
@ -323,7 +334,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
wchar_t wc='\0';
for (i=0; i< 8; i++) {
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch>='0' && ch <= '9') {
wc += (ch-'0')<<((7-i)*4);
} else if (ch>='a' && ch <= 'f') {
@ -352,7 +363,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
Yap_ErrorMessage = "invalid escape sequence";
return 0;
} else {
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch == '?') {/* delete character */
return 127;
} else if (ch >= 'a' && ch < 'z') {/* octal */
@ -374,13 +385,13 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
/* character in octal: maximum of 3 digits, terminates with \ */
if (yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
unsigned char so_far = ch-'0';
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') {/* octal */
so_far = so_far*8+(ch-'0');
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') { /* octal */
so_far = so_far*8+(ch-'0');
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch != '\\') {
Yap_ErrorMessage = "invalid octal escape sequence";
return 0;
@ -400,10 +411,10 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
} else {
/* sicstus */
unsigned char so_far = ch-'0';
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') {/* octal */
so_far = so_far*8+(ch-'0');
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') { /* octal */
return so_far*8+(ch-'0');
} else {
@ -419,15 +430,15 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
/* hexadecimal character (YAP allows empty hexadecimal */
if (yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
unsigned char so_far = 0;
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (my_isxdigit(ch,'f','F')) {/* hexa */
so_far = so_far * 16 + (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (my_isxdigit(ch,'f','F')) { /* hexa */
so_far = so_far * 16 + (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch == '\\') {
return so_far;
} else {
@ -449,11 +460,11 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
} else {
/* sicstus mode */
unsigned char so_far = 0;
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
so_far = (chtype(ch) == NU ? ch - '0' :
my_isupper(ch) ? ch - 'A' + 10 :
my_islower(ch) ? ch - 'a' +10 : 0);
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
return so_far*16 + (chtype(ch) == NU ? ch - '0' :
my_isupper(ch) ? ch - 'A' +10 :
my_islower(ch) ? ch - 'a' + 10 : 0);
@ -479,7 +490,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
/* reads a number, either integer or float */
static Term
get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*QuotedNxtch) (int), char *s, UInt max_size, int sign)
get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, int sign)
{
char *sp = s;
int ch = *chp;
@ -487,7 +498,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
int might_be_float = TRUE, has_overflow = FALSE;
*sp++ = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
/*
* because of things like 00'2, 03'2 and even better 12'2, I need to
* do this (have mercy)
@ -499,7 +510,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
base = 10 * base + ch - '0';
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
if (ch == '\'') {
if (base > 36) {
@ -512,18 +523,18 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
*sp++ = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
if (base == 0) {
wchar_t ascii = ch;
int scan_extra = TRUE;
if (ch == '\\' &&
yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES) {
ascii = read_quoted_char(&scan_extra, inp_stream, QuotedNxtch);
ascii = read_quoted_char(&scan_extra, inp_stream);
}
/* a quick way to represent ASCII */
if (scan_extra)
*chp = Nxtch(inp_stream);
*chp = getchr(inp_stream);
if (sign == -1) {
return MkIntegerTerm(-ascii);
}
@ -544,7 +555,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
val = oval * base + chval;
if (oval != (val-chval)/base) /* overflow */
has_overflow = (has_overflow || TRUE);
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
}
} else if (ch == 'x' && base == 0) {
@ -554,7 +565,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
*sp++ = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
while (my_isxdigit(ch, 'F', 'f')) {
Int oval = val;
int chval = (chtype(ch) == NU ? ch - '0' :
@ -567,18 +578,18 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
val = val * 16 + chval;
if (oval != (val-chval)/16) /* overflow */
has_overflow = TRUE;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
*chp = ch;
}
else if (ch == 'o' && base == 0) {
might_be_float = FALSE;
base = 8;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
} else if (ch == 'b' && base == 0) {
might_be_float = FALSE;
base = 2;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
} else {
val = base;
base = 10;
@ -600,7 +611,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
val = val * base + ch - '0';
if (val/base != oval || val -oval*base != ch-'0') /* overflow */
has_overflow = TRUE;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
if (might_be_float && ( ch == '.' || ch == 'e' || ch == 'E')) {
if (yap_flags[STRICT_ISO_FLAG] && (ch == 'e' || ch == 'E')) {
@ -613,7 +624,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
*sp++ = '.';
if (chtype(ch = Nxtch(inp_stream)) != NU) {
if (chtype(ch = getchr(inp_stream)) != NU) {
*chbuffp = '.';
*chp = ch;
*--sp = '\0';
@ -630,7 +641,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
}
*sp++ = ch;
}
while (chtype(ch = Nxtch(inp_stream)) == NU);
while (chtype(ch = getchr(inp_stream)) == NU);
}
if (ch == 'e' || ch == 'E') {
char *sp0 = sp;
@ -641,7 +652,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
*sp++ = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
if (ch == '-') {
cbuff = '-';
if (--max_size == 0) {
@ -649,10 +660,10 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
*sp++ = '-';
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
} else if (ch == '+') {
cbuff = '+';
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
if (chtype(ch) != NU) {
/* error */
@ -672,7 +683,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil;
}
*sp++ = ch;
} while (chtype(ch = Nxtch(inp_stream)) == NU);
} while (chtype(ch = getchr(inp_stream)) == NU);
}
*sp = '\0';
*chp = ch;
@ -698,10 +709,10 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
}
}
/* given a function Nxtch scan until we either find the number
/* given a function getchr scan until we either find the number
or end of file */
Term
Yap_scan_num(int (*Nxtch) (int))
Yap_scan_num(IOSTREAM *inp)
{
Term out;
int sign = 1;
@ -716,15 +727,15 @@ Yap_scan_num(int (*Nxtch) (int))
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
return TermNil;
}
ch = Nxtch(-1);
ch = getchr(inp);
while (chtype(ch) == BS) {
ch = Nxtch(-1);
ch = getchr(inp);
}
if (ch == '-') {
sign = -1;
ch = Nxtch(-1);
ch = getchr(inp);
} else if (ch == '+') {
ch = Nxtch(-1);
ch = getchr(inp);
}
if (chtype(ch) != NU) {
Yap_clean_tokenizer(NULL, NULL, NULL);
@ -733,7 +744,7 @@ Yap_scan_num(int (*Nxtch) (int))
cherr = '\0';
if (ASP-H < 1024)
return TermNil;
out = get_num(&ch, &cherr, -1, Nxtch, Nxtch, ptr, 4096, sign); /* */
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
PopScannerMemory(ptr, 4096);
Yap_clean_tokenizer(NULL, NULL, NULL);
if (Yap_ErrorMessage != NULL || ch != -1 || cherr)
@ -771,15 +782,13 @@ ch_to_wide(char *base, char *charp)
}
TokEntry *
Yap_tokenizer(int inp_stream, Term *tposp)
Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp)
{
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
int ch;
wchar_t *wcharp;
int (*Nxtch) (int) = Stream[inp_stream].stream_wgetc_for_read;
int (*QuotedNxtch) (int) = Stream[inp_stream].stream_wgetc;
Yap_ErrorMessage = NULL;
Yap_Error_Size = 0;
@ -790,9 +799,9 @@ Yap_tokenizer(int inp_stream, Term *tposp)
ScannerExtraBlocks = NULL;
l = NULL;
p = NULL; /* Just to make lint happy */
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
do {
@ -820,20 +829,20 @@ Yap_tokenizer(int inp_stream, Term *tposp)
p = t;
restart:
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
t->TokPos = GetCurInpPos(inp_stream);
switch (chtype(ch)) {
case CC:
while ((ch = Nxtch(inp_stream)) != 10 && chtype(ch) != EF);
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF);
if (chtype(ch) != EF) {
/* blank space */
if (t == l) {
/* we found a comment before reading characters */
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
}
@ -847,14 +856,14 @@ Yap_tokenizer(int inp_stream, Term *tposp)
case UL:
case LC:
och = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
scan_name:
TokImage = ((AtomEntry *) ( Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage;
wcharp = NULL;
isvar = (chtype(och) != LC);
add_ch_to_buff(och);
for (; chtype(ch) <= NU; ch = Nxtch(inp_stream)) {
for (; chtype(ch) <= NU; ch = getchr(inp_stream)) {
if (charp == (char *)AuxSp-1024) {
huge_var_error:
/* huge atom or variable, we are in trouble */
@ -873,7 +882,7 @@ Yap_tokenizer(int inp_stream, Term *tposp)
goto huge_var_error;
}
add_ch_to_buff(ch);
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
add_ch_to_buff('\0');
if (!isvar) {
@ -928,7 +937,7 @@ Yap_tokenizer(int inp_stream, Term *tposp)
/* serious error now */
return l;
}
if ((t->TokInfo = get_num(&cha,&cherr,inp_stream,Nxtch,QuotedNxtch,ptr,4096,1)) == 0L) {
if ((t->TokInfo = get_num(&cha,&cherr,inp_stream,ptr,4096,1)) == 0L) {
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
@ -1030,7 +1039,7 @@ Yap_tokenizer(int inp_stream, Term *tposp)
charp = TokImage;
quote = ch;
len = 0;
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
wcharp = NULL;
while (TRUE) {
@ -1045,17 +1054,17 @@ Yap_tokenizer(int inp_stream, Term *tposp)
break;
}
if (ch == quote) {
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
if (ch != quote)
break;
add_ch_to_buff(ch);
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
} else if (ch == '\\' && yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES) {
int scan_next = TRUE;
ch = read_quoted_char(&scan_next, inp_stream, QuotedNxtch);
ch = read_quoted_char(&scan_next, inp_stream);
add_ch_to_buff(ch);
if (scan_next) {
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
}
} else if (chtype(ch) == EF && ch <= MAX_ISO_LATIN1) {
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
@ -1063,7 +1072,7 @@ Yap_tokenizer(int inp_stream, Term *tposp)
break;
} else {
add_ch_to_buff(ch);
ch = QuotedNxtch(inp_stream);
ch = getchrq(inp_stream);
}
++len;
if (charp > (char *)AuxSp - 1024) {
@ -1127,20 +1136,20 @@ Yap_tokenizer(int inp_stream, Term *tposp)
case SY:
och = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
if (och == '/' && ch == '*') {
while ((och != '*' || ch != '/') && chtype(ch) != EF) {
och = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
if (chtype(ch) == EF) {
t->Tok = Ord(kind = eot_tok);
}
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
if (t == l) {
/* we found a comment before reading characters */
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
}
@ -1151,14 +1160,14 @@ Yap_tokenizer(int inp_stream, Term *tposp)
|| chtype(ch) == CC)) {
Yap_eot_before_eof = TRUE;
if (chtype(ch) == CC)
while ((ch = Nxtch(inp_stream)) != 10 && chtype(ch) != EF);
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF);
t->Tok = Ord(kind = eot_tok);
}
else {
TokImage = ((AtomEntry *) ( Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage;
*charp++ = och;
for (; chtype(ch) == SY; ch = Nxtch(inp_stream))
for (; chtype(ch) == SY; ch = getchr(inp_stream))
*charp++ = ch;
*charp = '\0';
t->TokInfo = Unsigned(Yap_LookupAtom(TokImage));
@ -1184,7 +1193,7 @@ Yap_tokenizer(int inp_stream, Term *tposp)
char chs[2];
chs[0] = ch;
chs[1] = '\0';
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
t->TokInfo = Unsigned(Yap_LookupAtom(chs));
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1194,26 +1203,26 @@ Yap_tokenizer(int inp_stream, Term *tposp)
case BK:
och = ch;
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
t->TokInfo = och;
if (t->TokInfo == '(' && !solo_flag) {
t->TokInfo = 'l';
solo_flag = TRUE;
} else if (och == '[') {
while (chtype(ch) == BS) { ch = Nxtch(inp_stream); };
while (chtype(ch) == BS) { ch = getchr(inp_stream); };
if (ch == ']') {
t->TokInfo = Unsigned(AtomNil);
t->Tok = Ord(kind = Name_tok);
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
solo_flag = FALSE;
break;
}
} else if (och == '{') {
while (chtype(ch) == BS) { ch = Nxtch(inp_stream); };
while (chtype(ch) == BS) { ch = getchr(inp_stream); };
if (ch == '}') {
t->TokInfo = Unsigned(AtomBraces);
t->Tok = Ord(kind = Name_tok);
ch = Nxtch(inp_stream);
ch = getchr(inp_stream);
solo_flag = FALSE;
break;
}

View File

@ -260,7 +260,7 @@ extern void Yap_DebugPlWrite (Term t);
extern void Yap_DebugErrorPutc (int n);
#endif
int STD_PROTO(Yap_LookupSWIStream,(void *));
int STD_PROTO(Yap_readTerm, (int, Term *, Term *, Term *, Term *));
int STD_PROTO(Yap_readTerm, (void *, Term *, Term *, Term *, Term *));
void STD_PROTO(Yap_PlWriteToStream, (Term, int, int));
/* depth_lim.c */
void STD_PROTO(Yap_InitItDeepenPreds,(void));

View File

@ -412,7 +412,7 @@
FunctorStaticClause = Yap_MkFunctor(AtomStaticClause,1);
FunctorStream = Yap_MkFunctor(AtomStream,1);
FunctorStreamEOS = Yap_MkFunctor(AtomEndOfStream,1);
FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,5);
FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,4);
FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,7);
FunctorShortSyntaxError = Yap_MkFunctor(AtomSyntaxError,1);
FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2);

View File

@ -114,11 +114,5 @@ StreamDesc;
#define ALIASES_BLOCK_SIZE 8
void STD_PROTO (Yap_InitStdStreams, (void));
Term STD_PROTO (Yap_StreamPosition, (int));
EXTERN inline int
GetCurInpPos (int inp_stream)
{
return (Stream[inp_stream].linecount);
}
Term STD_PROTO (Yap_StreamPosition, (struct io_stream *));

View File

@ -220,7 +220,8 @@ typedef struct AliasDescS {
/************ SWI compatible support for different encodings ************/
#ifndef SIO_NL_POSIX
#ifndef _PL_STREAM_H
typedef enum {
ENC_OCTET = 0,
ENC_ISO_LATIN1 = 1,
@ -232,6 +233,14 @@ typedef enum {
ENC_ISO_UTF32_BE = 64,
ENC_ISO_UTF32_LE = 128
} encoding_t;
#else
#define ENC_ISO_LATIN1 ENC_ISO_LATIN_1
#define ENC_ISO_UTF32_BE ENC_UNKNOWN //bogus
#define ENC_ISO_UTF32_LE ENC_WCHAR // bogus
#define ENC_ISO_UTF8 ENC_UTF8
#define ENC_ISO_ASCII ENC_ASCII
#define ENC_ISO_ANSI ENC_ANSI
typedef IOENC encoding_t;
#endif
#define MAX_ISO_LATIN1 255
@ -261,9 +270,9 @@ VarEntry STD_PROTO(*Yap_LookupVar,(char *));
Term STD_PROTO(Yap_VarNames,(VarEntry *,Term));
/* routines in scanner.c */
TokEntry STD_PROTO(*Yap_tokenizer,(int, Term *));
TokEntry STD_PROTO(*Yap_tokenizer,(struct io_stream *, Term *));
void STD_PROTO(Yap_clean_tokenizer,(TokEntry *, VarEntry *, VarEntry *));
Term STD_PROTO(Yap_scan_num,(int (*)(int)));
Term STD_PROTO(Yap_scan_num,(struct io_stream *));
char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));
/* routines in iopreds.c */

View File

@ -614,6 +614,12 @@ pl-write.o: $(srcdir)/packages/PLStream/pl-write.c
pl-yap.o: $(srcdir)/packages/PLStream/pl-yap.c
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-yap.c -o $@
iopreds.o : $(srcdir)/C/iopreds.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include $< -o $@
scanner.o : $(srcdir)/C/scanner.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include $< -o $@
# default rule
%.o : $(srcdir)/C/%.c config.h
$(CC) -c $(CFLAGS) $< -o $@

View File

@ -295,8 +295,8 @@ extern X_API void PROTO(YAP_Reset,(void));
/* void YAP_Error(int, YAP_Term, const char *,...) */
extern X_API void PROTO(YAP_Error,(int, YAP_Term, CONST char *, ...));
/* YAP_Term YAP_Read(int (*)(void)) */
extern X_API YAP_Term PROTO(YAP_Read,(int (*)(void)));
/* YAP_Term YAP_Read(void *) */
extern X_API YAP_Term PROTO(YAP_Read,(void *));
/* void YAP_Write(YAP_Term,void (*)(int),int) */
extern X_API void PROTO(YAP_Write,(YAP_Term,void (*)(int),int));
@ -316,11 +316,11 @@ extern X_API int PROTO(YAP_Init,(YAP_init_args *));
/* int YAP_FastInit(const char *) */
extern X_API int PROTO(YAP_FastInit,(CONST char *));
/* int YAP_InitConsult(int, const char *) */
extern X_API int PROTO(YAP_InitConsult,(int, CONST char *));
/* void * YAP_InitConsult(int, const char *) */
extern X_API void * PROTO(YAP_InitConsult,(int, CONST char *));
/* int YAP_EndConsult(void) */
extern X_API int PROTO(YAP_EndConsult,(void));
extern X_API int PROTO(YAP_EndConsult,(void *));
/* void YAP_Exit(int) */
extern X_API void PROTO(YAP_Exit,(int));

View File

@ -2809,6 +2809,13 @@ Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
return EX != NULL;
}
Atom
Yap_FileName(IOSTREAM *s)
{
atom_t a = fileNameStream(s);
return SWIAtomToAtom(a);
}
#ifdef _WIN32
#include <windows.h>

View File

@ -417,7 +417,7 @@ F Slash Slash 2
F StaticClause StaticClause 1
F Stream Stream 1
F StreamEOS EndOfStream 1
F StreamPos StreamPos 5
F StreamPos StreamPos 4
F SyntaxError SyntaxError 7
F ShortSyntaxError SyntaxError 1
F ThreadRun TopThreadGoal 2

View File

@ -66,12 +66,7 @@ load_files(Files,Opts) :-
'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,_,_,Call) :-
var(V), !,
'$do_error'(instantiation_error,Call).
'$process_lf_opts'([],_,InfLevel,_,_,_,_,_,Encoding,_,_,_,_,_) :-
(var(Encoding) ->
'$default_encoding'(Encoding)
;
true
).
'$process_lf_opts'([],_,InfLevel,_,_,_,_,_,_,_,_,_,_,_).
'$process_lf_opts'([Opt|Opts],Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call) :-
'$process_lf_opt'(Opt,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call), !,
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call).
@ -159,8 +154,15 @@ load_files(Files,Opts) :-
'$do_lf'(Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,CompMode,Reconsult,UseModule).
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,Enc,SkipUnixComments,CompMode,Reconsult,UseModule) :-
'$find_in_path'(X, Y, Call),
'$valid_encoding'(Encoding, Enc),
open(Y, read, Stream, [encoding(Encoding)]), !,
(
var(Encoding)
->
Opts = []
;
'$valid_encoding'(Encoding, Enc),
Opts = [encoding(Encoding)]
),
open(Y, read, Stream, Opts), !,
'$set_changed_lfmode'(Changed),
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,SkipUnixComments,CompMode,Reconsult,UseModule),
close(Stream).
@ -429,13 +431,11 @@ initialization(G,OPT) :-
nb_setval('$included_file', Y),
'$current_module'(Mod),
H0 is heapused, '$cputime'(T0,_),
'$default_encoding'(Enc),
'$valid_encoding'(Encoding, Enc),
( open(Y, read, Stream, [encoding(Encoding)]), !, % '$open'(Y, '$csult', Stream, 0, Encoding, X), !,
print_message(Verbosity, loading(including, Y)),
'$loop'(Stream,Status), close(Stream)
( open(Y, read, Stream), !,
print_message(Verbosity, loading(including, Y)),
'$loop'(Stream,Status), close(Stream)
;
'$do_error'(permission_error(input,stream,Y),include(X))
'$do_error'(permission_error(input,stream,Y),include(X))
),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
print_message(Verbosity, loaded(included, Y, Mod, T, H)),
@ -670,7 +670,6 @@ remove_from_path(New) :- '$check_path'(New,Path),
'$set_encoding'(EncAtom) :-
'$do_error'(type_error(atom,V),encoding(EncAtom)).
absolute_file_name(V,Out) :- var(V), !,
'$do_error'(instantiation_error, absolute_file_name(V, Out)).
absolute_file_name(user,user) :- !.