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

assembly fixes

Browse Source 
more support for readline, including getting more stuff from read.
This commit is contained in:
Vitor Santos Costa 2011-02-17 00:57:49 +00:00
parent d4f11c9fda
commit 4a5ba35937
12 changed files with 1236 additions and 317 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/absmi.c
View File

@ -1667,7 +1667,7 @@ Yap_absmi(int inp)
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH; YENV[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, PREG->u.Osbpi.s);
saveregs(); saveregs();
if (!Yap_gcl(sz, arity, YENV, PREG)) { if (!Yap_gcl(sz, arity, YENV, PREG)) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -7469,7 +7469,7 @@ Yap_absmi(int inp)
else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s); else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s);
} }
#else #else
SET_ASP(YREG, 0); SET_ASP(YREG, PREG->u.Osbpp.s);
/* for slots to work */ /* for slots to work */
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
@ -7513,7 +7513,7 @@ Yap_absmi(int inp)
else ASP = YREG+E_CB; else ASP = YREG+E_CB;
} }
#else #else
SET_ASP(YREG, 0); SET_ASP(YREG, E_CB*sizeof(CELL));
/* for slots to work */ /* for slots to work */
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
pt0 = PREG->u.pp.p; pt0 = PREG->u.pp.p;
@ -7600,7 +7600,7 @@ Yap_absmi(int inp)
else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s); else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s);
} }
#else #else
SET_ASP(YREG, 0); SET_ASP(YREG, PREG->u.Osbpp.s);
/* for slots to work */ /* for slots to work */
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
{ {
@ -7833,7 +7833,7 @@ Yap_absmi(int inp)
ENDCACHE_Y(); ENDCACHE_Y();
Yap_PrologMode = UserCCallMode; Yap_PrologMode = UserCCallMode;
SET_ASP(YREG, 0); SET_ASP(YREG, E_CB*sizeof(CELL));
/* for slots to work */ /* for slots to work */
Yap_StartSlots(); Yap_StartSlots();
saveregs(); saveregs();

4
C/tracer.c
View File

@ -172,6 +172,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(Yap_heap_regs->low_level_trace_lock); LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs; sc = Yap_heap_regs;
vsc_count++; vsc_count++;
if (vsc_count == 471321)
jmp_deb(1);
if (vsc_count < 471300)
return;
#ifdef THREADS #ifdef THREADS
MY_ThreadHandle.thread_inst_count++; MY_ThreadHandle.thread_inst_count++;
#endif #endif

2
H/trim_trail.h
View File

@ -148,12 +148,10 @@
if (erase) { if (erase) {
/* at this point, we are the only ones accessing the clause, /* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */ hence we don't need to have a lock it */
saveregs();
if (cl->ClFlags & ErasedMask) if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
else else
Yap_CleanUpIndex(cl); Yap_CleanUpIndex(cl);
setregs();
} }
UNLOCK(ap->PELock); UNLOCK(ap->PELock);
} else { } else {

6
config.h.in
View File

@ -229,6 +229,10 @@
#undef HAVE_REGEXEC #undef HAVE_REGEXEC
#undef HAVE_RENAME #undef HAVE_RENAME
#undef HAVE_RINT #undef HAVE_RINT
#undef HAVE_RL_CLEAR_PENDING_INPUT
#undef HAVE_RL_COMPLETION_MATCHES
#undef HAVE_RL_FILENAME_COMPLETION_FUNCTION
#undef HAVE_RL_INSERT_CLOSE
#undef HAVE_RL_SET_PROMPT #undef HAVE_RL_SET_PROMPT
#undef HAVE_SBRK #undef HAVE_SBRK
#undef HAVE_SELECT #undef HAVE_SELECT
@ -281,8 +285,6 @@
#define TYPE_SELECT_ #define TYPE_SELECT_
#define MYTYPE(X) MYTYPE1#X #define MYTYPE(X) MYTYPE1#X
#undef HAVE_DECL_RL_CATCH_SIGNALS
/* define how to pass the address of a function */ /* define how to pass the address of a function */
#define FunAdr(Fn) Fn #define FunAdr(Fn) Fn

522
configure vendored
View File

File diff suppressed because it is too large Load Diff

6
configure.in
View File

@ -1380,7 +1380,11 @@ if test "$yap_cv_readline" != "no"
then then
AC_CHECK_HEADERS( readline/readline.h) AC_CHECK_HEADERS( readline/readline.h)
AC_CHECK_HEADERS( readline/history.h) AC_CHECK_HEADERS( readline/history.h)
AC_CHECK_DECL( rl_catch_signals ) AC_CHECK_FUNC( rl_completion_matches )
AC_CHECK_FUNC( rl_insert_close )
AC_CHECK_FUNC( rl_filename_completion_function )
AC_CHECK_FUNC( rl_set_prompt )
AC_CHECK_FUNC( rl_clear_pending_input )
fi fi
AC_CHECK_HEADERS(mpi.h) AC_CHECK_HEADERS(mpi.h)
AC_CHECK_HEADERS(mpe.h) AC_CHECK_HEADERS(mpe.h)

30
packages/PLStream/pl-ctype.c
View File

@ -26,36 +26,6 @@
#include <ctype.h> #include <ctype.h>
#include "pl-ctype.h" #include "pl-ctype.h"
#if __YAP_PROLOG__
/* support for blank space handling, stolen from pl-read.c */
#include <pl-umap.c>
/*******************************
* UNICODE CLASSIFIERS *
*******************************/
#define CharTypeW(c, t, w) \
((unsigned)(c) <= 0xff ? (_PL_char_types[(unsigned)(c)] t) \
: (uflagsW(c) & w))
#define PlBlankW(c) CharTypeW(c, <= SP, U_SEPARATOR)
#define PlUpperW(c) CharTypeW(c, == UC, U_UPPERCASE)
#define PlIdStartW(c) (c <= 0xff ? (isLower(c)||isUpper(c)||c=='_') \
: uflagsW(c) & U_ID_START)
#define PlIdContW(c) CharTypeW(c, >= UC, U_ID_CONTINUE)
#define PlSymbolW(c) CharTypeW(c, == SY, 0)
#define PlPunctW(c) CharTypeW(c, == PU, 0)
#define PlSoloW(c) CharTypeW(c, == SO, 0)
static int
unicode_separator(pl_wchar_t c)
{ return PlBlankW(c);
}
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module defines: This module defines:

19
packages/PLStream/pl-incl.h
View File

@ -191,6 +191,10 @@ typedef struct
word culprit; /* for CVT_nocode/CVT_nochar */ word culprit; /* for CVT_nocode/CVT_nochar */
} CVT_result; } CVT_result;
#define MAXNEWLINES 5 /* maximum # of newlines in atom */
#define LONGATOM_CHECK 0x01 /* read/1: error on intptr_t atoms */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Operator types. NOTE: if you change OP_*, check operatorTypeToAtom()! Operator types. NOTE: if you change OP_*, check operatorTypeToAtom()!
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@ -686,7 +690,8 @@ extern PL_local_data_t lds;
#define source_line_no (LD->read_source.line) #define source_line_no (LD->read_source.line)
#define source_file_name (LD->read_source.file) #define source_file_name (LD->read_source.file)
#define source_line_pos (LD->read_source.linepos)
#define source_char_no (LD->read_source.character)
/* Support PL_LOCK in the interface */ /* Support PL_LOCK in the interface */
#if THREADS #if THREADS
@ -982,7 +987,9 @@ word pl_noprotocol(void);
IOSTREAM *PL_current_input(void); IOSTREAM *PL_current_input(void);
IOSTREAM *PL_current_output(void); IOSTREAM *PL_current_output(void);
int reportStreamError(IOSTREAM *s); extern int reportStreamError(IOSTREAM *s);
extern int digitValue(int b, int c);
PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s); PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s);
PL_EXPORT(int) PL_unify_stream_or_alias(term_t t, IOSTREAM *s); PL_EXPORT(int) PL_unify_stream_or_alias(term_t t, IOSTREAM *s);
@ -990,6 +997,7 @@ PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s);
PL_EXPORT(void) PL_write_prompt(int); PL_EXPORT(void) PL_write_prompt(int);
PL_EXPORT(int) PL_release_stream(IOSTREAM *s); PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
COMMON(atom_t) fileNameStream(IOSTREAM *s); COMMON(atom_t) fileNameStream(IOSTREAM *s);
COMMON(int) streamStatus(IOSTREAM *s); COMMON(int) streamStatus(IOSTREAM *s);
@ -1005,6 +1013,11 @@ COMMON(atom_t) encoding_to_atom(IOENC enc);
COMMON(int) pl_see(term_t f); COMMON(int) pl_see(term_t f);
COMMON(int) pl_seen(void); COMMON(int) pl_seen(void);
COMMON(int) unicode_separator(pl_wchar_t c);
COMMON(word) pl_raw_read(term_t term);
COMMON(word) pl_raw_read2(term_t stream, term_t term);
/**** stuff from pl-error.c ****/ /**** stuff from pl-error.c ****/
extern void outOfCore(void); extern void outOfCore(void);
extern void fatalError(const char *fm, ...); extern void fatalError(const char *fm, ...);
@ -1102,8 +1115,6 @@ COMMON(int) numberVars(term_t t, nv_options *opts, int n ARG_LD);
COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags, COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags,
int wide, CVT_result *status); int wide, CVT_result *status);
COMMON(int) uflagsW(int code);
static inline word static inline word
setBoolean(int *flag, term_t old, term_t new) setBoolean(int *flag, term_t old, term_t new)
{ if ( !PL_unify_bool_ex(old, *flag) || { if ( !PL_unify_bool_ex(old, *flag) ||

934
packages/PLStream/pl-read.c
View File

@ -1,18 +1,74 @@
#include "pl-incl.h" #include "pl-incl.h"
#include "pl-ctype.h"
#include "pl-utf8.h"
#include "pl-dtoa.h"
#include "pl-umap.c" /* Unicode map */
typedef unsigned char * ucharp;
typedef const unsigned char * cucharp;
#define utf8_get_uchar(s, chr) (ucharp)utf8_get_char((char *)(s), chr)
#define FASTBUFFERSIZE 256 /* read quickly upto this size */
struct read_buffer
{ int size; /* current size of read buffer */
unsigned char *base; /* base of read buffer */
unsigned char *here; /* current position in read buffer */
unsigned char *end; /* end of the valid buffer */
IOSTREAM *stream; /* stream we are reading from */
unsigned char fast[FASTBUFFERSIZE]; /* Quick internal buffer */
};
typedef struct typedef struct
{ { unsigned char *here; /* current character */
term_t varnames; /* Report variables+names */ unsigned char *base; /* base of clause */
unsigned char *end; /* end of the clause */
unsigned char *token_start; /* start of most recent read token */
IOSTREAM *stream; IOSTREAM *stream;
int has_exception; /* exception is raised */ int has_exception; /* exception is raised */
unsigned char *posp; /* position pointer */
size_t posi; /* position number */
unsigned int flags; /* Module syntax flags */
int styleCheck; /* style-checking mask */
bool backquoted_string; /* Read `hello` as string */
int *char_conversion_table; /* active conversion table */
term_t exception; /* raised exception */ term_t exception; /* raised exception */
term_t varnames; /* Report variables+names */
int strictness; /* Strictness level */
term_t comments; /* Report comments */
struct read_buffer _rb; /* keep read characters here */
} read_data, *ReadData; } read_data, *ReadData;
#define rdhere (_PL_rd->here)
#define rdbase (_PL_rd->base)
#define rdend (_PL_rd->end)
#define last_token_start (_PL_rd->token_start)
#define rb (_PL_rd->_rb)
#define DO_CHARESCAPE true(_PL_rd, CHARESCAPE)
extern IOFUNCTIONS Sstringfunctions;
static bool
isStringStream(IOSTREAM *s)
{ return s->functions == &Sstringfunctions;
}
static void static void
init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD) init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
{ { memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */
_PL_rd->varnames = 0; _PL_rd->varnames = 0;
_PL_rd->stream = in; _PL_rd->stream = in;
_PL_rd->has_exception = 0; _PL_rd->has_exception = 0;
@ -31,6 +87,878 @@ read_term(term_t t, ReadData rd ARG_LD)
} }
static void addUTF8Buffer(Buffer b, int c);
static void
addUTF8Buffer(Buffer b, int c)
{ if ( c >= 0x80 )
{ char buf[6];
char *p, *end;
end = utf8_put_char(buf, c);
for(p=buf; p<end; p++)
{ addBuffer(b, *p&0xff, char);
}
} else
{ addBuffer(b, c, char);
}
}
/*******************************
* UNICODE CLASSIFIERS *
*******************************/
#define CharTypeW(c, t, w) \
((unsigned)(c) <= 0xff ? (_PL_char_types[(unsigned)(c)] t) \
: (uflagsW(c) & w))
#define PlBlankW(c) CharTypeW(c, <= SP, U_SEPARATOR)
#define PlUpperW(c) CharTypeW(c, == UC, U_UPPERCASE)
#define PlIdStartW(c) (c <= 0xff ? (isLower(c)||isUpper(c)||c=='_') \
: uflagsW(c) & U_ID_START)
#define PlIdContW(c) CharTypeW(c, >= UC, U_ID_CONTINUE)
#define PlSymbolW(c) CharTypeW(c, == SY, 0)
#define PlPunctW(c) CharTypeW(c, == PU, 0)
#define PlSoloW(c) CharTypeW(c, == SO, 0)
int
unicode_separator(pl_wchar_t c)
{ return PlBlankW(c);
}
/********************************
* RAW READING *
*********************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Scan the input, give prompts when necessary and return a char * holding
a stripped version of the next term. Contiguous white space is mapped
on a single space, block and % ... \n comment is deleted. Memory is
claimed automatically en enlarged if necessary.
(char *) NULL is returned on a syntax error.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define syntaxError(what, rd) { errorWarning(what, 0, rd); fail; }
static term_t
makeErrorTerm(const char *id_str, term_t id_term, ReadData _PL_rd)
{ GET_LD
term_t ex, loc=0; /* keep compiler happy */
unsigned char const *s, *ll = NULL;
int rc = TRUE;
if ( !(ex = PL_new_term_ref()) ||
!(loc = PL_new_term_ref()) )
rc = FALSE;
if ( rc && !id_term )
{ if ( !(id_term=PL_new_term_ref()) ||
!PL_put_atom_chars(id_term, id_str) )
rc = FALSE;
}
if ( rc )
rc = PL_unify_term(ex,
PL_FUNCTOR, FUNCTOR_error2,
PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_TERM, id_term,
PL_TERM, loc);
source_char_no += last_token_start - rdbase;
for(s=rdbase; s<last_token_start; s++)
{ if ( *s == '\n' )
{ source_line_no++;
ll = s+1;
}
}
if ( ll )
{ int lp = 0;
for(s = ll; s<last_token_start; s++)
{ switch(*s)
{ case '\b':
if ( lp > 0 ) lp--;
break;
case '\t':
lp |= 7;
default:
lp++;
}
}
source_line_pos = lp;
}
if ( rc )
{ if ( ReadingSource ) /* reading a file */
{ rc = PL_unify_term(loc,
PL_FUNCTOR, FUNCTOR_file4,
PL_ATOM, source_file_name,
PL_INT, source_line_no,
PL_INT, source_line_pos,
PL_INT64, source_char_no);
} else if ( isStringStream(rb.stream) )
{ size_t pos;
pos = utf8_strlen((char *)rdbase, last_token_start-rdbase);
rc = PL_unify_term(loc,
PL_FUNCTOR, FUNCTOR_string2,
PL_UTF8_STRING, rdbase,
PL_INT, (int)pos);
} else /* any stream */
{ term_t stream;
if ( !(stream=PL_new_term_ref()) ||
!PL_unify_stream_or_alias(stream, rb.stream) ||
!PL_unify_term(loc,
PL_FUNCTOR, FUNCTOR_stream4,
PL_TERM, stream,
PL_INT, source_line_no,
PL_INT, source_line_pos,
PL_INT64, source_char_no) )
rc = FALSE;
}
}
return (rc ? ex : (term_t)0);
}
static bool
errorWarning(const char *id_str, term_t id_term, ReadData _PL_rd)
{ GET_LD
term_t ex;
LD->exception.processing = TRUE; /* allow using spare stack */
ex = makeErrorTerm(id_str, id_term, _PL_rd);
if ( _PL_rd )
{ _PL_rd->has_exception = TRUE;
if ( ex )
PL_put_term(_PL_rd->exception, ex);
else
PL_put_term(_PL_rd->exception, exception_term);
} else
{ if ( ex )
PL_raise_exception(ex);
}
fail;
}
static void
clearBuffer(ReadData _PL_rd)
{ if (rb.size == 0)
{ rb.base = rb.fast;
rb.size = sizeof(rb.fast);
}
rb.end = rb.base + rb.size;
rdbase = rb.here = rb.base;
_PL_rd->posp = rdbase;
_PL_rd->posi = 0;
}
static void
growToBuffer(int c, ReadData _PL_rd)
{ if ( rb.base == rb.fast ) /* intptr_t clause: jump to use malloc() */
{ rb.base = PL_malloc(FASTBUFFERSIZE * 2);
memcpy(rb.base, rb.fast, FASTBUFFERSIZE);
} else
rb.base = PL_realloc(rb.base, rb.size*2);
DEBUG(8, Sdprintf("Reallocated read buffer at %ld\n", (intptr_t) rb.base));
_PL_rd->posp = rdbase = rb.base;
rb.here = rb.base + rb.size;
rb.size *= 2;
rb.end = rb.base + rb.size;
_PL_rd->posi = 0;
*rb.here++ = c;
}
static inline void
addByteToBuffer(int c, ReadData _PL_rd)
{ c &= 0xff;
if ( rb.here >= rb.end )
growToBuffer(c, _PL_rd);
else
*rb.here++ = c;
}
static void
addToBuffer(int c, ReadData _PL_rd)
{ if ( c <= 0x7f )
{ addByteToBuffer(c, _PL_rd);
} else
{ char buf[10];
char *s, *e;
e = utf8_put_char(buf, c);
for(s=buf; s<e; s++)
addByteToBuffer(*s, _PL_rd);
}
}
static void
setCurrentSourceLocation(IOSTREAM *s ARG_LD)
{ atom_t a;
if ( s->position )
{ source_line_no = s->position->lineno;
source_line_pos = s->position->linepos - 1; /* char just read! */
source_char_no = s->position->charno - 1; /* char just read! */
} else
{ source_line_no = -1;
source_line_pos = -1;
source_char_no = 0;
}
if ( (a = fileNameStream(s)) )
source_file_name = a;
else
source_file_name = NULL_ATOM;
}
static inline int
getchr__(ReadData _PL_rd)
{ int c = Sgetcode(rb.stream);
if ( !_PL_rd->char_conversion_table || c < 0 || c >= 256 )
return c;
return _PL_rd->char_conversion_table[c];
}
#define getchr() getchr__(_PL_rd)
#define getchrq() Sgetcode(rb.stream)
#define ensure_space(c) { if ( something_read && \
(c == '\n' || !isBlank(rb.here[-1])) ) \
addToBuffer(c, _PL_rd); \
}
#define set_start_line { if ( !something_read ) \
{ setCurrentSourceLocation(rb.stream PASS_LD); \
something_read++; \
} \
}
#define rawSyntaxError(what) { addToBuffer(EOS, _PL_rd); \
rdbase = rb.base, last_token_start = rb.here-1; \
syntaxError(what, _PL_rd); \
}
static int
raw_read_quoted(int q, ReadData _PL_rd)
{ int newlines = 0;
int c;
addToBuffer(q, _PL_rd);
while((c=getchrq()) != EOF && c != q)
{ if ( c == '\\' && DO_CHARESCAPE )
{ int base;
addToBuffer(c, _PL_rd);
switch( (c=getchrq()) )
{ case EOF:
goto eofinstr;
case 'u': /* \uXXXX */
case 'U': /* \UXXXXXXXX */
addToBuffer(c, _PL_rd);
continue;
case 'x': /* \xNN\ */
addToBuffer(c, _PL_rd);
c = getchrq();
if ( c == EOF )
goto eofinstr;
if ( digitValue(16, c) >= 0 )
{ base = 16;
addToBuffer(c, _PL_rd);
xdigits:
c = getchrq();
while( digitValue(base, c) >= 0 )
{ addToBuffer(c, _PL_rd);
c = getchrq();
}
}
if ( c == EOF )
goto eofinstr;
addToBuffer(c, _PL_rd);
if ( c == q )
return TRUE;
continue;
default:
addToBuffer(c, _PL_rd);
if ( digitValue(8, c) >= 0 ) /* \NNN\ */
{ base = 8;
goto xdigits;
} else if ( c == '\n' ) /* \<newline> */
{ c = getchrq();
if ( c == EOF )
goto eofinstr;
addToBuffer(c, _PL_rd);
if ( c == q )
return TRUE;
}
continue; /* \symbolic-control-char */
}
} else if (c == '\n' &&
newlines++ > MAXNEWLINES &&
(_PL_rd->styleCheck & LONGATOM_CHECK))
{ rawSyntaxError("long_string");
}
addToBuffer(c, _PL_rd);
}
if (c == EOF)
{ eofinstr:
rawSyntaxError("end_of_file_in_string");
}
addToBuffer(c, _PL_rd);
return TRUE;
}
static int
add_comment(Buffer b, IOPOS *pos, ReadData _PL_rd ARG_LD)
{ term_t head = PL_new_term_ref();
assert(_PL_rd->comments);
if ( !PL_unify_list(_PL_rd->comments, head, _PL_rd->comments) )
return FALSE;
if ( pos )
{ if ( !PL_unify_term(head,
PL_FUNCTOR, FUNCTOR_minus2,
PL_FUNCTOR, FUNCTOR_stream_position4,
PL_INT64, pos->charno,
PL_INT, pos->lineno,
PL_INT, pos->linepos,
PL_INT, 0,
PL_UTF8_STRING, baseBuffer(b, char)) )
return FALSE;
} else
{ if ( !PL_unify_term(head,
PL_FUNCTOR, FUNCTOR_minus2,
ATOM_minus,
PL_UTF8_STRING, baseBuffer(b, char)) )
return FALSE;
}
PL_reset_term_refs(head);
return TRUE;
}
static void
setErrorLocation(IOPOS *pos, ReadData _PL_rd)
{ if ( pos )
{ GET_LD
source_char_no = pos->charno;
source_line_pos = pos->linepos;
source_line_no = pos->lineno;
}
rb.here = rb.base+1; /* see rawSyntaxError() */
}
static unsigned char *
raw_read2(ReadData _PL_rd ARG_LD)
{ int c;
bool something_read = FALSE;
bool dotseen = FALSE;
IOPOS pbuf; /* comment start */
IOPOS *pos;
clearBuffer(_PL_rd); /* clear input buffer */
_PL_rd->strictness = truePrologFlag(PLFLAG_ISO);
source_line_no = -1;
for(;;)
{ c = getchr();
handle_c:
switch(c)
{ case EOF:
if ( isStringStream(rb.stream) ) /* do not require '. ' when */
{ addToBuffer(' ', _PL_rd); /* reading from a string */
addToBuffer('.', _PL_rd);
addToBuffer(' ', _PL_rd);
addToBuffer(EOS, _PL_rd);
return rb.base;
}
if (something_read)
{ if ( dotseen ) /* term.<EOF> */
{ if ( rb.here - rb.base == 1 )
rawSyntaxError("end_of_clause");
ensure_space(' ');
addToBuffer(EOS, _PL_rd);
return rb.base;
}
rawSyntaxError("end_of_file");
}
if ( Sfpasteof(rb.stream) )
{ term_t stream;
LD->exception.processing = TRUE;
stream = PL_new_term_ref();
PL_unify_stream_or_alias(stream, rb.stream);
PL_error(NULL, 0, NULL, ERR_PERMISSION,
ATOM_input, ATOM_past_end_of_stream, stream);
return NULL;
}
set_start_line;
strcpy((char *)rb.base, "end_of_file. ");
rb.here = rb.base + 14;
return rb.base;
case '/': if ( rb.stream->position )
{ pbuf = *rb.stream->position;
pbuf.charno--;
pbuf.linepos--;
pos = &pbuf;
} else
pos = NULL;
c = getchr();
if ( c == '*' )
{ int last;
int level = 1;
tmp_buffer ctmpbuf;
Buffer cbuf;
if ( _PL_rd->comments )
{ initBuffer(&ctmpbuf);
cbuf = (Buffer)&ctmpbuf;
addUTF8Buffer(cbuf, '/');
addUTF8Buffer(cbuf, '*');
} else
{ cbuf = NULL;
}
if ((last = getchr()) == EOF)
{ if ( cbuf )
discardBuffer(cbuf);
setErrorLocation(pos, _PL_rd);
rawSyntaxError("end_of_file_in_block_comment");
}
if ( cbuf )
addUTF8Buffer(cbuf, last);
if ( something_read )
{ addToBuffer(' ', _PL_rd); /* positions */
addToBuffer(' ', _PL_rd);
addToBuffer(last == '\n' ? last : ' ', _PL_rd);
}
for(;;)
{ c = getchr();
if ( cbuf )
addUTF8Buffer(cbuf, c);
switch( c )
{ case EOF:
if ( cbuf )
discardBuffer(cbuf);
setErrorLocation(pos, _PL_rd);
rawSyntaxError("end_of_file_in_block_comment");
case '*':
if ( last == '/' )
level++;
break;
case '/':
if ( last == '*' &&
(--level == 0 || _PL_rd->strictness) )
{ if ( cbuf )
{ addUTF8Buffer(cbuf, EOS);
if ( !add_comment(cbuf, pos, _PL_rd PASS_LD) )
{ discardBuffer(cbuf);
return FALSE;
}
discardBuffer(cbuf);
}
c = ' ';
goto handle_c;
}
break;
}
if ( something_read )
addToBuffer(c == '\n' ? c : ' ', _PL_rd);
last = c;
}
} else
{ set_start_line;
addToBuffer('/', _PL_rd);
if ( isSymbolW(c) )
{ while( c != EOF && isSymbolW(c) &&
!(c == '`' && _PL_rd->backquoted_string) )
{ addToBuffer(c, _PL_rd);
c = getchr();
}
}
dotseen = FALSE;
goto handle_c;
}
case '%': if ( something_read )
addToBuffer(' ', _PL_rd);
if ( _PL_rd->comments )
{ tmp_buffer ctmpbuf;
Buffer cbuf;
if ( rb.stream->position )
{ pbuf = *rb.stream->position;
pbuf.charno--;
pbuf.linepos--;
pos = &pbuf;
} else
pos = NULL;
initBuffer(&ctmpbuf);
cbuf = (Buffer)&ctmpbuf;
addUTF8Buffer(cbuf, '%');
for(;;)
{ while((c=getchr()) != EOF && c != '\n')
{ addUTF8Buffer(cbuf, c);
if ( something_read ) /* record positions */
addToBuffer(' ', _PL_rd);
}
if ( c == '\n' )
{ int c2 = Speekcode(rb.stream);
if ( c2 == '%' )
{ if ( something_read )
{ addToBuffer(c, _PL_rd);
addToBuffer(' ', _PL_rd);
}
addUTF8Buffer(cbuf, c);
c = Sgetcode(rb.stream);
assert(c==c2);
addUTF8Buffer(cbuf, c);
continue;
}
}
break;
}
addUTF8Buffer(cbuf, EOS);
if ( !add_comment(cbuf, pos, _PL_rd PASS_LD) )
{ discardBuffer(cbuf);
return FALSE;
}
discardBuffer(cbuf);
} else
{ while((c=getchr()) != EOF && c != '\n')
{ if ( something_read ) /* record positions */
addToBuffer(' ', _PL_rd);
}
}
goto handle_c; /* is the newline */
case '\'': if ( rb.here > rb.base && isDigit(rb.here[-1]) )
{ cucharp bs = &rb.here[-1];
if ( bs > rb.base && isDigit(bs[-1]) )
bs--;
if ( bs > rb.base && isSign(bs[-1]) )
bs--;
if ( bs == rb.base || !PlIdContW(bs[-1]) )
{ int base;
if ( isSign(bs[0]) )
bs++;
base = atoi((char*)bs);
if ( base <= 36 )
{ if ( base == 0 ) /* 0'<c> */
{ addToBuffer(c, _PL_rd);
{ if ( (c=getchr()) != EOF )
{ addToBuffer(c, _PL_rd);
if ( c == '\\' ) /* 0'\<c> */
{ if ( (c=getchr()) != EOF )
addToBuffer(c, _PL_rd);
} else if ( c == '\'' ) /* 0'' */
{ if ( (c=getchr()) != EOF )
{ if ( c == '\'' )
addToBuffer(c, _PL_rd);
else
goto handle_c;
}
}
break;
}
rawSyntaxError("end_of_file");
}
} else
{ int c2 = Speekcode(rb.stream);
if ( c2 != EOF )
{ if ( digitValue(base, c2) >= 0 )
{ addToBuffer(c, _PL_rd);
c = Sgetcode(rb.stream);
addToBuffer(c, _PL_rd);
dotseen = FALSE;
break;
}
goto sqatom;
}
rawSyntaxError("end_of_file");
}
}
}
}
sqatom:
set_start_line;
if ( !raw_read_quoted(c, _PL_rd) )
fail;
dotseen = FALSE;
break;
case '"': set_start_line;
if ( !raw_read_quoted(c, _PL_rd) )
fail;
dotseen = FALSE;
break;
case '.': addToBuffer(c, _PL_rd);
set_start_line;
dotseen++;
c = getchr();
if ( isSymbolW(c) )
{ while( c != EOF && isSymbolW(c) &&
!(c == '`' && _PL_rd->backquoted_string) )
{ addToBuffer(c, _PL_rd);
c = getchr();
}
dotseen = FALSE;
}
goto handle_c;
case '`': if ( _PL_rd->backquoted_string )
{ set_start_line;
if ( !raw_read_quoted(c, _PL_rd) )
fail;
dotseen = FALSE;
break;
}
/*FALLTHROUGH*/
default: if ( c < 0xff )
{ switch(_PL_char_types[c])
{ case SP:
case CT:
blank:
if ( dotseen )
{ if ( rb.here - rb.base == 1 )
rawSyntaxError("end_of_clause");
ensure_space(c);
addToBuffer(EOS, _PL_rd);
return rb.base;
}
do
{ if ( something_read ) /* positions, \0 --> ' ' */
addToBuffer(c ? c : ' ', _PL_rd);
else
ensure_space(c);
c = getchr();
} while( c != EOF && PlBlankW(c) );
goto handle_c;
case SY:
set_start_line;
do
{ addToBuffer(c, _PL_rd);
c = getchr();
if ( c == '`' && _PL_rd->backquoted_string )
break;
} while( c != EOF && c <= 0xff && isSymbol(c) );
/* TBD: wide symbols? */
dotseen = FALSE;
goto handle_c;
case LC:
case UC:
set_start_line;
do
{ addToBuffer(c, _PL_rd);
c = getchr();
} while( c != EOF && PlIdContW(c) );
dotseen = FALSE;
goto handle_c;
default:
addToBuffer(c, _PL_rd);
dotseen = FALSE;
set_start_line;
}
} else /* > 255 */
{ if ( PlIdStartW(c) )
{ set_start_line;
do
{ addToBuffer(c, _PL_rd);
c = getchr();
} while( c != EOF && PlIdContW(c) );
dotseen = FALSE;
goto handle_c;
} else if ( PlBlankW(c) )
{ goto blank;
} else
{ addToBuffer(c, _PL_rd);
dotseen = FALSE;
set_start_line;
}
}
}
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Raw reading returns a string in UTF-8 notation of the a Prolog term.
Comment inside the term is replaced by spaces or newline to ensure
proper reconstruction of source locations. Comment before the term is
skipped.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static unsigned char *
raw_read(ReadData _PL_rd, unsigned char **endp ARG_LD)
{ unsigned char *s;
if ( (rb.stream->flags & SIO_ISATTY) && Sfileno(rb.stream) >= 0 )
{ ttybuf tab;
PushTty(rb.stream, &tab, TTY_SAVE); /* make sure tty is sane */
PopTty(rb.stream, &ttytab, FALSE);
s = raw_read2(_PL_rd PASS_LD);
PopTty(rb.stream, &tab, TRUE);
} else
{ s = raw_read2(_PL_rd PASS_LD);
}
if ( endp )
*endp = _PL_rd->_rb.here;
return s;
}
/********************************
* PROLOG CONNECTION *
*********************************/
static unsigned char *
backSkipUTF8(unsigned const char *start, unsigned const char *end, int *chr)
{ const unsigned char *s;
for(s=end-1 ; s>start && *s&0x80; s--)
;
utf8_get_char((char*)s, chr);
return (unsigned char *)s;
}
static unsigned char *
backSkipBlanks(const unsigned char *start, const unsigned char *end)
{ const unsigned char *s;
for( ; end > start; end = s)
{ unsigned char *e;
int chr;
for(s=end-1 ; s>start && ISUTF8_CB(*s); s--)
;
e = (unsigned char*)utf8_get_char((char*)s, &chr);
assert(e == end);
if ( !PlBlankW(chr) )
return (unsigned char*)end;
}
return (unsigned char *)start;
}
static inline ucharp
skipSpaces(cucharp in)
{ int chr;
ucharp s;
for( ; *in; in=s)
{ s = utf8_get_uchar(in, &chr);
if ( !PlBlankW(chr) )
return (ucharp)in;
}
return (ucharp)in;
}
word
pl_raw_read2(term_t from, term_t term)
{ GET_LD
unsigned char *s, *e, *t2, *top;
read_data rd;
word rval;
IOSTREAM *in;
int chr;
PL_chars_t txt;
if ( !getInputStream(from, &in) )
fail;
init_read_data(&rd, in PASS_LD);
if ( !(s = raw_read(&rd, &e PASS_LD)) )
{ rval = PL_raise_exception(rd.exception);
goto out;
}
/* strip the input from blanks */
top = backSkipBlanks(s, e-1);
t2 = backSkipUTF8(s, top, &chr);
if ( chr == '.' )
top = backSkipBlanks(s, t2);
/* watch for "0' ." */
if ( top < e && top-2 >= s && top[-1] == '\'' && top[-2] == '0' )
top++;
*top = EOS;
s = skipSpaces(s);
txt.text.t = (char*)s;
txt.length = top-s;
txt.storage = PL_CHARS_HEAP;
txt.encoding = ENC_UTF8;
txt.canonical = FALSE;
rval = PL_unify_text(term, 0, &txt, PL_ATOM);
out:
free_read_data(&rd);
if ( Sferror(in) )
return streamStatus(in);
else
PL_release_stream(in);
return rval;
}
word
pl_raw_read(term_t term)
{ return pl_raw_read2(0, term);
}
/******************************* /*******************************
* TERM <->ATOM * * TERM <->ATOM *
*******************************/ *******************************/

14
packages/PLStream/pl-rl.c
View File

@ -78,6 +78,9 @@ SWI-Prolog.h and SWI-Stream.h
#endif #endif
#undef ESC /* will be redefined ... */ #undef ESC /* will be redefined ... */
#ifdef META
#undef META /* conflict with macports readline */
#endif
#include <stdio.h> /* readline needs it */ #include <stdio.h> /* readline needs it */
#include <errno.h> #include <errno.h>
#define savestring(x) /* avoid definition there */ #define savestring(x) /* avoid definition there */
@ -86,7 +89,7 @@ extern int rl_done; /* should be in readline.h, but */
/* isn't in some versions ... */ /* isn't in some versions ... */
#ifdef HAVE_READLINE_HISTORY_H #ifdef HAVE_READLINE_HISTORY_H
#include <readline/history.h> #include <readline/history.h>
#elif !defined(__APPLE__) #else
extern void add_history(char *); /* should be in readline.h */ extern void add_history(char *); /* should be in readline.h */
#endif #endif
/* missing prototypes in older */ /* missing prototypes in older */
@ -94,6 +97,7 @@ extern void add_history(char *); /* should be in readline.h */
extern int rl_begin_undo_group(void); /* delete when conflict arrises! */ extern int rl_begin_undo_group(void); /* delete when conflict arrises! */
extern int rl_end_undo_group(void); extern int rl_end_undo_group(void);
extern Function *rl_event_hook; extern Function *rl_event_hook;
#ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION #ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION
#define rl_filename_completion_function filename_completion_function #define rl_filename_completion_function filename_completion_function
extern char *filename_completion_function(const char *, int); extern char *filename_completion_function(const char *, int);
@ -335,7 +339,7 @@ rl_sighandler(int sig)
DEBUG(3, Sdprintf("Resetting after signal\n")); DEBUG(3, Sdprintf("Resetting after signal\n"));
prepare_signals(); prepare_signals();
#ifndef __APPLE__ #ifdef HAVE_RL_RESET_AFTER_SIGNAL
rl_reset_after_signal (); rl_reset_after_signal ();
#endif #endif
} }
@ -361,7 +365,7 @@ reentrant access is tried.
#ifdef HAVE_RL_EVENT_HOOK #ifdef HAVE_RL_EVENT_HOOK
static int static int
event_hook() event_hook(void)
{ if ( Sinput->position ) { if ( Sinput->position )
{ int64_t c0 = Sinput->position->charno; { int64_t c0 = Sinput->position->charno;
@ -469,7 +473,7 @@ Sread_readline(void *handle, char *buf, size_t size)
{ int state = rl_readline_state; { int state = rl_readline_state;
rl_clear_pending_input(); rl_clear_pending_input();
#ifndef __APPLE__ #ifdef HAVE_RL_DISCARD_ARGUMENT
rl_discard_argument(); rl_discard_argument();
#endif #endif
rl_deprep_terminal(); rl_deprep_terminal();
@ -516,7 +520,6 @@ Sread_readline(void *handle, char *buf, size_t size)
static int static int
prolog_complete(int ignore, int key) prolog_complete(int ignore, int key)
{ {
#ifndef __APPLE__
if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' ) if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' )
{ rl_begin_undo_group(); { rl_begin_undo_group();
rl_complete(ignore, key); rl_complete(ignore, key);
@ -532,7 +535,6 @@ prolog_complete(int ignore, int key)
rl_end_undo_group(); rl_end_undo_group();
} else } else
rl_complete(ignore, key); rl_complete(ignore, key);
#endif
return 0; return 0;
} }

2
packages/PLStream/pl-umap.c
View File

@ -1622,7 +1622,7 @@ static const char* const uflags_map[UNICODE_MAP_SIZE] =
F(0), F(3), ucp0xfa, ucp0xfb, F(3), ucp0xfd, ucp0xfe, ucp0xff F(0), F(3), ucp0xfa, ucp0xfb, F(3), ucp0xfd, ucp0xfe, ucp0xff
}; };
int static int
uflagsW(int code) uflagsW(int code)
{ int cp = (unsigned)code / 256; { int cp = (unsigned)code / 256;

2
pl/init.yap
View File

@ -52,7 +52,6 @@ otherwise.
:- compile_expressions. :- compile_expressions.
:- [ :- [
% lists is often used. % lists is often used.
'lists.yap', 'lists.yap',
@ -207,3 +206,4 @@ file_search_path(system, Dir) :-
file_search_path(foreign, yap('lib/Yap')). file_search_path(foreign, yap('lib/Yap')).
:- yap_flag(unknown,error). :- yap_flag(unknown,error).