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

read works now.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
C/c_interface.c
View File

@ -333,6 +333,7 @@
#include <stdlib.h> #include <stdlib.h>
#include "Yap.h" #include "Yap.h"
#include "clause.h" #include "clause.h"
#include "SWI-Stream.h"
#include "yapio.h" #include "yapio.h"
#include "attvar.h" #include "attvar.h"
#if HAVE_STDARG_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 void STD_PROTO(YAP_ClearExceptions,(void));
X_API int STD_PROTO(YAP_ContinueGoal,(void)); X_API int STD_PROTO(YAP_ContinueGoal,(void));
X_API void STD_PROTO(YAP_PruneGoal,(void)); X_API void STD_PROTO(YAP_PruneGoal,(void));
X_API void STD_PROTO(YAP_InitConsult,(int, char *)); X_API IOSTREAM *STD_PROTO(YAP_InitConsult,(int, char *));
X_API void STD_PROTO(YAP_EndConsult,(void)); X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *));
X_API Term STD_PROTO(YAP_Read, (int (*)(void))); X_API Term STD_PROTO(YAP_Read, (IOSTREAM *));
X_API void STD_PROTO(YAP_Write, (Term, int (*)(wchar_t), int)); 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_CopyTerm, (Term));
X_API Term STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned int, int)); 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; return out;
} else { } 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; return TRUE;
} }
} else { } 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; return TRUE;
} }
} else { } 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; 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 X_API Int
@ -2355,31 +2401,34 @@ YAP_ClearExceptions(void)
UncaughtThrow = FALSE; UncaughtThrow = FALSE;
} }
X_API void X_API IOSTREAM *
YAP_InitConsult(int mode, char *filename) YAP_InitConsult(int mode, char *filename)
{ {
IOSTREAM *st;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
if (mode == YAP_CONSULT_MODE) if (mode == YAP_CONSULT_MODE)
Yap_init_consult(FALSE, filename); Yap_init_consult(FALSE, filename);
else else
Yap_init_consult(TRUE, filename); Yap_init_consult(TRUE, filename);
st = Sopen_file(filename, "r");
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return st;
} }
X_API void X_API void
YAP_EndConsult(void) YAP_EndConsult(IOSTREAM *s)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
Yap_end_consult(); Yap_end_consult();
Sclose(s);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
X_API Term X_API Term
YAP_Read(int (*mygetc)(void)) YAP_Read(IOSTREAM *inp)
{ {
Term t, tpos = TermNil; Term t, tpos = TermNil;
int sno; int sno;
@ -2387,23 +2436,19 @@ YAP_Read(int (*mygetc)(void))
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
do_getf = mygetc;
sno = Yap_GetFreeStreamDForReading(); tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp, &tpos);
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);
if (Yap_ErrorMessage) if (Yap_ErrorMessage)
{ {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return 0; 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(); t = Yap_Parse();
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
@ -2513,21 +2558,20 @@ do_bootfile (char *bootfilename)
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"),1); Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"),1);
/* consult boot.pl */ /* 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 */ /* the consult mode does not matter here, really */
/* /*
To be honest, YAP_InitConsult does not really do much, 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. 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) while (!eof_found)
{ {
t = YAP_Read(mygetc); t = YAP_Read(bootfile);
if (eof_found) { if (eof_found) {
break; break;
} }
@ -2566,8 +2610,7 @@ do_bootfile (char *bootfilename)
/* do backtrack */ /* do backtrack */
YAP_Reset(); YAP_Reset();
} }
YAP_EndConsult(); YAP_EndConsult(bootfile);
fclose (bootfile);
#ifdef DEBUG #ifdef DEBUG
if (output_msg) if (output_msg)
fprintf(stderr,"Boot loaded\n"); fprintf(stderr,"Boot loaded\n");

8
C/errors.c
View File

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

111
C/iopreds.c
View File

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

179
C/scanner.c
View File

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

2
H/Yapproto.h
View File

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

2
H/iatoms.h
View File

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

8
H/iopreds.h
View File

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

15
H/yapio.h
View File

@ -220,7 +220,8 @@ typedef struct AliasDescS {
/************ SWI compatible support for different encodings ************/ /************ SWI compatible support for different encodings ************/
#ifndef SIO_NL_POSIX
#ifndef _PL_STREAM_H
typedef enum { typedef enum {
ENC_OCTET = 0, ENC_OCTET = 0,
ENC_ISO_LATIN1 = 1, ENC_ISO_LATIN1 = 1,
@ -232,6 +233,14 @@ typedef enum {
ENC_ISO_UTF32_BE = 64, ENC_ISO_UTF32_BE = 64,
ENC_ISO_UTF32_LE = 128 ENC_ISO_UTF32_LE = 128
} encoding_t; } 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 #endif
#define MAX_ISO_LATIN1 255 #define MAX_ISO_LATIN1 255
@ -261,9 +270,9 @@ VarEntry STD_PROTO(*Yap_LookupVar,(char *));
Term STD_PROTO(Yap_VarNames,(VarEntry *,Term)); Term STD_PROTO(Yap_VarNames,(VarEntry *,Term));
/* routines in scanner.c */ /* 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 *)); 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)); char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));
/* routines in iopreds.c */ /* routines in iopreds.c */

6
Makefile.in
View File

@ -614,6 +614,12 @@ pl-write.o: $(srcdir)/packages/PLStream/pl-write.c
pl-yap.o: $(srcdir)/packages/PLStream/pl-yap.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 $@ $(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 # default rule
%.o : $(srcdir)/C/%.c config.h %.o : $(srcdir)/C/%.c config.h
$(CC) -c $(CFLAGS) $< -o $@ $(CC) -c $(CFLAGS) $< -o $@

10
include/YapInterface.h
View File

@ -295,8 +295,8 @@ extern X_API void PROTO(YAP_Reset,(void));
/* void YAP_Error(int, YAP_Term, const char *,...) */ /* void YAP_Error(int, YAP_Term, const char *,...) */
extern X_API void PROTO(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)) */ /* YAP_Term YAP_Read(void *) */
extern X_API YAP_Term PROTO(YAP_Read,(int (*)(void))); extern X_API YAP_Term PROTO(YAP_Read,(void *));
/* void YAP_Write(YAP_Term,void (*)(int),int) */ /* void YAP_Write(YAP_Term,void (*)(int),int) */
extern X_API void PROTO(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 *) */ /* int YAP_FastInit(const char *) */
extern X_API int PROTO(YAP_FastInit,(CONST char *)); extern X_API int PROTO(YAP_FastInit,(CONST char *));
/* int YAP_InitConsult(int, const char *) */ /* void * YAP_InitConsult(int, const char *) */
extern X_API int PROTO(YAP_InitConsult,(int, CONST char *)); extern X_API void * PROTO(YAP_InitConsult,(int, CONST char *));
/* int YAP_EndConsult(void) */ /* int YAP_EndConsult(void) */
extern X_API int PROTO(YAP_EndConsult,(void)); extern X_API int PROTO(YAP_EndConsult,(void *));
/* void YAP_Exit(int) */ /* void YAP_Exit(int) */
extern X_API void PROTO(YAP_Exit,(int)); extern X_API void PROTO(YAP_Exit,(int));

7
library/dialect/swi/fli/swi.c
View File

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

2
misc/ATOMS
View File

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

29
pl/consult.yap
View File

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