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

alias stuff.

Browse Source
This commit is contained in:
ubu32 2011-02-14 06:59:15 -08:00
parent b3fb1d1e73
commit f6befe5796
8 changed files with 126 additions and 548 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
C/c_interface.c
View File

@ -409,7 +409,7 @@ X_API Term STD_PROTO(YAP_MkPairTerm,(Term,Term));
X_API Term STD_PROTO(YAP_MkNewPairTerm,(void)); X_API Term STD_PROTO(YAP_MkNewPairTerm,(void));
X_API Term STD_PROTO(YAP_HeadOfTerm,(Term)); X_API Term STD_PROTO(YAP_HeadOfTerm,(Term));
X_API Term STD_PROTO(YAP_TailOfTerm,(Term)); X_API Term STD_PROTO(YAP_TailOfTerm,(Term));
X_API Int STD_PROTO(YAP_SkipList,(Term *, Term **)); X_API int STD_PROTO(YAP_SkipList,(Term *, Term **));
X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,UInt,Term *)); X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,UInt,Term *));
X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,UInt)); X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,UInt));
X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term)); X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term));
@ -928,7 +928,7 @@ YAP_TailOfTerm(Term t)
return (TailOfTerm(t)); return (TailOfTerm(t));
} }
X_API Int X_API int
YAP_SkipList(Term *l, Term **tailp) YAP_SkipList(Term *l, Term **tailp)
{ {
Int length = 0; Int length = 0;
@ -1527,6 +1527,8 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
Int val; Int val;
CPredicateV codev = (CPredicateV)exec_code; CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
struct open_query_struct *oexec = execution;
extern PL_close_foreign_frame(struct open_query_struct *);
PP = pe; PP = pe;
ctx->control = FRG_FIRST_CALL; ctx->control = FRG_FIRST_CALL;
@ -1537,6 +1539,9 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
} else { } else {
val = ((codev)((&ARG1)-LCL0,0,ctx)); val = ((codev)((&ARG1)-LCL0,0,ctx));
} }
/* make sure we clean up the frames left by the user */
while (execution != oexec)
PL_close_foreign_frame(execution);
PP = NULL; PP = NULL;
if (val == 0) { if (val == 0) {
Term t; Term t;
@ -1564,6 +1569,49 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
} }
} }
Int
YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code)
{
if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
struct open_query_struct *oexec = execution;
extern PL_close_foreign_frame(struct open_query_struct *);
PP = pe;
ctx->control = FRG_CUTTED;
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
ctx->context = NULL;
if (pe->PredFlags & CArgsPredFlag) {
val = execute_cargs_back(pe, exec_code, ctx);
} else {
val = ((codev)((&ARG1)-LCL0,0,ctx));
}
/* make sure we clean up the frames left by the user */
while (execution != oexec)
PL_close_foreign_frame(execution);
PP = NULL;
if (val == 0) {
Term t;
BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
Yap_JumpToEnv(t);
return FALSE;
}
return FALSE;
} else { /* TRUE */
return TRUE;
}
} else {
return (exec_code)();
}
}
Int Int
YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
@ -1572,6 +1620,8 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
Int val; Int val;
CPredicateV codev = (CPredicateV)exec_code; CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
struct open_query_struct *oexec = execution;
extern PL_close_foreign_frame(struct open_query_struct *);
PP = pe; PP = pe;
ctx->control = FRG_REDO; ctx->control = FRG_REDO;
@ -1580,6 +1630,9 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
} else { } else {
val = ((codev)((&ARG1)-LCL0,0,ctx)); val = ((codev)((&ARG1)-LCL0,0,ctx));
} }
/* make sure we clean up the frames left by the user */
while (execution != oexec)
PL_close_foreign_frame(execution);
PP = NULL; PP = NULL;
if (val == 0) { if (val == 0) {
Term t; Term t;

500
C/iopreds.c
View File

@ -106,17 +106,9 @@ STATIC_PROTO (int PlUnGetc, (int));
STATIC_PROTO (Term MkStream, (int)); STATIC_PROTO (Term MkStream, (int));
STATIC_PROTO (Int p_stream_flags, (void)); STATIC_PROTO (Int p_stream_flags, (void));
STATIC_PROTO (int AddAlias, (Atom, int)); STATIC_PROTO (int AddAlias, (Atom, int));
STATIC_PROTO (void SetAlias, (Atom, int));
STATIC_PROTO (void PurgeAlias, (int)); STATIC_PROTO (void PurgeAlias, (int));
STATIC_PROTO (int CheckAlias, (Atom)); STATIC_PROTO (int CheckAlias, (Atom));
STATIC_PROTO (Atom FetchAlias, (int));
STATIC_PROTO (int FindAliasForStream, (int, Atom));
STATIC_PROTO (int FindStreamForAlias, (Atom));
STATIC_PROTO (int CheckStream, (Term, int, char *)); STATIC_PROTO (int CheckStream, (Term, int, char *));
STATIC_PROTO (Int p_check_stream, (void));
STATIC_PROTO (Int p_check_if_stream, (void));
STATIC_PROTO (Int init_cur_s, (void));
STATIC_PROTO (Int cont_cur_s, (void));
STATIC_PROTO (Int p_close, (void)); STATIC_PROTO (Int p_close, (void));
STATIC_PROTO (Int p_set_input, (void)); STATIC_PROTO (Int p_set_input, (void));
STATIC_PROTO (Int p_set_output, (void)); STATIC_PROTO (Int p_set_output, (void));
@ -127,7 +119,6 @@ STATIC_PROTO (Int p_write2, (void));
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_cur_line_no, (void));
STATIC_PROTO (Int p_get, (void)); STATIC_PROTO (Int p_get, (void));
STATIC_PROTO (Int p_get0, (void)); STATIC_PROTO (Int p_get0, (void));
STATIC_PROTO (Int p_get_byte, (void)); STATIC_PROTO (Int p_get_byte, (void));
@ -140,15 +131,11 @@ STATIC_PROTO (Int p_flush, (void));
STATIC_PROTO (Int p_flush_all_streams, (void)); STATIC_PROTO (Int p_flush_all_streams, (void));
STATIC_PROTO (Int p_write_depth, (void)); STATIC_PROTO (Int p_write_depth, (void));
STATIC_PROTO (Int p_user_file_name, (void)); STATIC_PROTO (Int p_user_file_name, (void));
STATIC_PROTO (Int p_line_position, (void));
STATIC_PROTO (Int p_character_count, (void));
STATIC_PROTO (Int p_show_stream_flags, (void)); STATIC_PROTO (Int p_show_stream_flags, (void));
STATIC_PROTO (Int p_show_stream_position, (void)); STATIC_PROTO (Int p_show_stream_position, (void));
STATIC_PROTO (Int p_set_stream_position, (void)); STATIC_PROTO (Int p_set_stream_position, (void));
STATIC_PROTO (Int p_add_alias_to_stream, (void)); STATIC_PROTO (Int p_add_alias_to_stream, (void));
STATIC_PROTO (Int p_change_alias_to_stream, (void));
STATIC_PROTO (Int p_check_if_valid_new_alias, (void)); STATIC_PROTO (Int p_check_if_valid_new_alias, (void));
STATIC_PROTO (Int p_fetch_stream_alias, (void));
STATIC_PROTO (Int p_format, (void)); STATIC_PROTO (Int p_format, (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));
@ -1159,141 +1146,6 @@ PlUnGetc (int sno)
return(ch); return(ch);
} }
/* give back 0376+ch */
static int
PlUnGetc376 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc376)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc;
ch = s->och;
s->och = 0xFE;
return ch;
}
/* give back 0376+ch */
static int
PlUnGetc00 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc00)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc;
ch = s->och;
s->och = 0x00;
return ch;
}
/* give back 0377+ch */
static int
PlUnGetc377 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc377)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc;
ch = s->och;
s->och = 0xFF;
return ch;
}
/* give back 0357+ch */
static int
PlUnGetc357 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc357)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc;
ch = s->och;
s->och = 0xEF;
return ch;
}
/* give back 0357+0273+ch */
static int
PlUnGetc357273 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc357273)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc357;
ch = s->och;
s->och = 0xBB;
return ch;
}
/* give back 000+000+ch */
static int
PlUnGetc0000 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc0000)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc00;
ch = s->och;
s->och = 0x00;
return ch;
}
/* give back 000+000+ch */
static int
PlUnGetc0000fe (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc0000fe)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc0000;
ch = s->och;
s->och = 0xfe;
return ch;
}
/* give back 0377+0376+ch */
static int
PlUnGetc377376 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc377376)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc377;
ch = s->och;
s->och = 0xFE;
return ch;
}
/* give back 0377+0376+000+ch */
static int
PlUnGetc37737600 (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
if (s->stream_getc != PlUnGetc37737600)
return(s->stream_getc(sno));
s->stream_getc = PlUnGetc377376;
ch = s->och;
s->och = 0x00;
return ch;
}
static int static int
utf8_nof(char ch) utf8_nof(char ch)
{ {
@ -1712,30 +1564,6 @@ static Int p_add_alias_to_stream (void)
return (FALSE); return (FALSE);
} }
static Int p_change_alias_to_stream (void)
{
Term tname = Deref(ARG1);
Term tstream = Deref(ARG2);
Atom at;
Int sno;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "$change_alias_to_stream/2");
return (FALSE);
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "$change_alias_to_stream/2");
return (FALSE);
}
at = AtomOfTerm(tname);
if ((sno = CheckStream (tstream, Input_Stream_f | Output_Stream_f | Append_Stream_f, "change_stream_alias/2")) == -1) {
UNLOCK(Stream[sno].streamlock);
return(FALSE);
}
SetAlias(at, sno);
UNLOCK(Stream[sno].streamlock);
return(TRUE);
}
static Int p_check_if_valid_new_alias (void) static Int p_check_if_valid_new_alias (void)
{ {
Term tname = Deref(ARG1); Term tname = Deref(ARG1);
@ -1753,38 +1581,6 @@ static Int p_check_if_valid_new_alias (void)
} }
static Int
p_fetch_stream_alias (void)
{ /* '$fetch_stream_alias'(Stream,Alias) */
int sno;
Term t2 = Deref(ARG2);
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
return Yap_unify(ARG1,MkStream(FindStreamForAlias(AtomOfTerm(t2))));
}
if ((sno = CheckStream (t1, Input_Stream_f | Output_Stream_f,
"fetch_stream_alias/2")) == -1)
return FALSE;
if (IsVarTerm(t2)) {
Atom at = FetchAlias(sno);
UNLOCK(Stream[sno].streamlock);
if (at == AtomFoundVar)
return FALSE;
else
return Yap_unify_constant(t2, MkAtomTerm(at));
} else if (IsAtomTerm(t2)) {
Atom at = AtomOfTerm(t2);
Int out = (Int)FindAliasForStream(sno,at);
UNLOCK(Stream[sno].streamlock);
return out;
} else {
UNLOCK(Stream[sno].streamlock);
Yap_Error(TYPE_ERROR_ATOM, t2, "fetch_stream_alias/2");
return FALSE;
}
}
Term Term
Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
{ {
@ -1881,47 +1677,6 @@ AddAlias (Atom arg, int sno)
return(TRUE); return(TRUE);
} }
/* create a new alias arg for stream sno */
static void
SetAlias (Atom arg, int sno)
{
AliasDesc aliasp = FileAliases, aliasp_max = FileAliases+NOfFileAliases;
while (aliasp < aliasp_max) {
if (aliasp->name == arg) {
Int alno = aliasp-FileAliases;
aliasp->alias_stream = sno;
{
switch(alno) {
case 0:
Yap_stdin = Stream[sno].u.file.file;
break;
case 1:
Yap_stdout = Stream[sno].u.file.file;
break;
case 2:
Yap_stderr = Stream[sno].u.file.file;
break;
default:
break;
}
#if HAVE_SETBUF_COMMENTED_OUT
YP_setbuf (Stream[sno].u.file.file, NULL);
#endif /* HAVE_SETBUF */
}
return;
}
aliasp++;
}
/* we have not found an alias, create one */
if (aliasp == FileAliases+SzOfFileAliases)
ExtendAliasArray();
NOfFileAliases++;
aliasp->name = arg;
aliasp->alias_stream = sno;
}
/* purge all aliases for stream sno */ /* purge all aliases for stream sno */
static void static void
PurgeAlias (int sno) PurgeAlias (int sno)
@ -1979,50 +1734,6 @@ CheckAlias (Atom arg)
return(-1); return(-1);
} }
/* check if stream has an alias */
static Atom
FetchAlias (int sno)
{
AliasDesc aliasp = FileAliases, aliasp_max = FileAliases+NOfFileAliases;
while (aliasp < aliasp_max) {
if (aliasp->alias_stream == sno) {
return(aliasp->name);
}
aliasp++;
}
return(AtomFoundVar);
}
/* check if arg is an alias */
static int
FindAliasForStream (int sno, Atom al)
{
AliasDesc aliasp = FileAliases, aliasp_max = FileAliases+NOfFileAliases;
while (aliasp < aliasp_max) {
if (aliasp->alias_stream == sno && aliasp->name == al) {
return(TRUE);
}
aliasp++;
}
return(FALSE);
}
/* check if arg is an alias */
static int
FindStreamForAlias (Atom al)
{
AliasDesc aliasp = FileAliases, aliasp_max = FileAliases+NOfFileAliases;
while (aliasp < aliasp_max) {
if (aliasp->name == al) {
return(aliasp->alias_stream);
}
aliasp++;
}
return(FALSE);
}
static int static int
LookupSWIStream (struct io_stream *swi_s) LookupSWIStream (struct io_stream *swi_s)
@ -2084,29 +1795,10 @@ CheckStream (Term arg, int kind, char *msg)
Yap_Error(INSTANTIATION_ERROR, arg, msg); Yap_Error(INSTANTIATION_ERROR, arg, msg);
return -1; return -1;
} else if (IsAtomTerm (arg)) { } else if (IsAtomTerm (arg)) {
Atom sname = AtomOfTerm (arg); struct io_stream *swi_stream;
Atom sname = AtomOfTerm(arg);
if (sname == AtomUser) { if (IsBlob(sname)) {
if (kind & Input_Stream_f) {
if (kind & (Output_Stream_f|Append_Stream_f)) {
Yap_Error(PERMISSION_ERROR_INPUT_STREAM, arg,
"ambiguous use of 'user' as a stream");
return (-1);
}
sname = AtomUserIn;
} else {
sname = AtomUserOut;
}
}
if (kind & SWI_Stream_f) {
struct io_stream *swi_stream;
if (Yap_get_stream_handle(arg, kind & Input_Stream_f, kind & Output_Stream_f, &swi_stream)) {
sno = LookupSWIStream(swi_stream);
return sno;
}
}
if (IsBlob (sname)) {
struct io_stream *s; struct io_stream *s;
stream_ref *ref; stream_ref *ref;
@ -2124,19 +1816,10 @@ CheckStream (Term arg, int kind, char *msg)
sno = LookupSWIStream(s); sno = LookupSWIStream(s);
return sno; return sno;
} }
if ((sno = CheckAlias(sname)) == -1) {
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); if (Yap_get_stream_handle(arg, kind & Input_Stream_f, kind & Output_Stream_f, &swi_stream)) {
return -1; sno = LookupSWIStream(swi_stream);
} return sno;
} else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FunctorStream) {
arg = ArgOfTerm (1, arg);
if (!IsVarTerm (arg) && IsIntegerTerm (arg)) {
Int xsno = IntegerOfTerm(arg);
if (xsno > MaxStreams) {
sno = LookupSWIStream((struct io_stream *)xsno);
} else {
sno = xsno;
}
} }
} }
if (sno < 0) if (sno < 0)
@ -2184,27 +1867,6 @@ Yap_UnLockStream (int sno)
} }
#endif #endif
static Int
p_check_stream (void)
{ /* '$check_stream'(Stream,Mode) */
Term mode = Deref (ARG2);
int sno = CheckStream (ARG1,
AtomOfTerm (mode) == AtomRead ? Input_Stream_f : Output_Stream_f,
"check_stream/2");
if (sno != -1)
UNLOCK(Stream[sno].streamlock);
return sno != -1;
}
static Int
p_check_if_stream (void)
{ /* '$check_stream'(Stream) */
int sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f , "check_stream/1");
if (sno != -1)
UNLOCK(Stream[sno].streamlock);
return sno != -1;
}
static Term static Term
StreamName(int i) StreamName(int i)
{ {
@ -2212,64 +1874,6 @@ StreamName(int i)
return(Stream[i].u.file.user_name); return(Stream[i].u.file.user_name);
} }
static Int
init_cur_s (void)
{ /* Init current_stream */
Term t3 = Deref(ARG3);
/* make valgrind happy by always filling in memory */
EXTRA_CBACK_ARG (3, 1) = MkIntTerm (0);
if (!IsVarTerm(t3)) {
Int i;
Term t1, t2;
i = CheckStream (t3, Input_Stream_f|Output_Stream_f, "current_stream/3");
if (i < 0) {
return FALSE;
}
t1 = StreamName(i);
t2 = (Stream[i].status & Input_Stream_f ?
MkAtomTerm (AtomRead) :
MkAtomTerm (AtomWrite));
UNLOCK(Stream[i].streamlock);
if (Yap_unify(ARG1,t1) && Yap_unify(ARG2,t2)) {
cut_succeed();
} else {
cut_fail();
}
} else {
return (cont_cur_s ());
}
}
static Int
cont_cur_s (void)
{ /* current_stream */
Term t1, t2, t3;
int i = IntOfTerm (EXTRA_CBACK_ARG (3, 1));
while (i < MaxStreams) {
LOCK(Stream[i].streamlock);
if (Stream[i].status & Free_Stream_f) {
++i;
UNLOCK(Stream[i-1].streamlock);
continue;
}
t1 = StreamName(i);
t2 = (Stream[i].status & Input_Stream_f ?
MkAtomTerm (AtomRead) :
MkAtomTerm (AtomWrite));
t3 = MkStream (i++);
UNLOCK(Stream[i-1].streamlock);
EXTRA_CBACK_ARG (3, 1) = Unsigned (MkIntTerm (i));
if (Yap_unify (ARG3, t3) && Yap_unify_constant (ARG1, t1) && Yap_unify_constant (ARG2, t2)) {
return TRUE;
} else {
return FALSE;
}
}
cut_fail();
}
/* /*
* Called when you want to close all open streams, except for stdin, stdout * Called when you want to close all open streams, except for stdin, stdout
@ -3176,87 +2780,6 @@ p_user_file_name (void)
return (Yap_unify_constant (ARG2, tout)); return (Yap_unify_constant (ARG2, tout));
} }
static Int
p_cur_line_no (void)
{ /* '$current_line_number'(+Stream,-N) */
Term tout;
int sno =
CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"current_line_number/2");
if (sno < 0)
return (FALSE);
/* one has to be somewhat more careful because of terminals */
if (Stream[sno].status & Tty_Stream_f)
{
Int no = 1;
int i;
Atom my_stream;
my_stream = Stream[sno].u.file.name;
for (i = 0; i < MaxStreams; i++)
{
if (!(Stream[i].status & (Free_Stream_f)) &&
Stream[i].u.file.name == my_stream)
no += Stream[i].linecount - 1;
}
tout = MkIntTerm (no);
}
else
tout = MkIntTerm (Stream[sno].linecount);
UNLOCK(Stream[sno].streamlock);
return (Yap_unify_constant (ARG2, tout));
}
static Int
p_line_position (void)
{ /* '$line_position'(+Stream,-N) */
Term tout;
int sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "line_position/2");
if (sno < 0)
return (FALSE);
if (Stream[sno].status & Tty_Stream_f)
{
Int no = 0;
int i;
Atom my_stream = Stream[sno].u.file.name;
for (i = 0; i < MaxStreams; i++)
{
if (!(Stream[i].status & Free_Stream_f) &&
Stream[i].u.file.name == my_stream)
no += Stream[i].linepos;
}
tout = MkIntTerm (no);
}
else
tout = MkIntTerm (Stream[sno].linepos);
UNLOCK(Stream[sno].streamlock);
return (Yap_unify_constant (ARG2, tout));
}
static Int
p_character_count (void)
{ /* '$character_count'(+Stream,-N) */
Term tout;
int sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "character_count/2");
if (sno < 0)
return (FALSE);
if (Stream[sno].status & Tty_Stream_f)
{
Int no = 0;
int i;
Atom my_stream = Stream[sno].u.file.name;
for (i = 0; i < MaxStreams; i++)
{
if (!(Stream[i].status & Free_Stream_f) &&
Stream[i].u.file.name == my_stream)
no += Stream[i].charcount;
}
tout = MkIntTerm (no);
}
else
tout = MkIntTerm (YP_ftell (Stream[sno].u.file.file));
UNLOCK(Stream[sno].streamlock);
return (Yap_unify_constant (ARG2, tout));
}
static Int static Int
p_show_stream_flags(void) p_show_stream_flags(void)
{ /* '$show_stream_flags'(+Stream,Pos) */ { /* '$show_stream_flags'(+Stream,Pos) */
@ -4440,7 +3963,6 @@ static Int
format2(UInt stream_flag) format2(UInt stream_flag)
{ {
int old_c_stream = Yap_c_output_stream; int old_c_stream = Yap_c_output_stream;
int codes_stream = FALSE;
Int out; Int out;
Term tin = Deref(ARG1); Term tin = Deref(ARG1);
@ -5057,7 +4579,6 @@ Yap_FileDescriptorFromStream(Term t)
void void
Yap_InitBackIO (void) Yap_InitBackIO (void)
{ {
Yap_InitCPredBack ("$current_stream", 3, 1, init_cur_s, cont_cur_s, SafePredFlag|SyncPredFlag|HiddenPredFlag);
} }
@ -5072,8 +4593,6 @@ Yap_InitIOPreds(void)
if (!Stream) if (!Stream)
Stream = (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc)*MaxStreams); Stream = (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc)*MaxStreams);
/* here the Input/Output predicates */ /* here the Input/Output predicates */
Yap_InitCPred ("$check_stream", 2, p_check_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$check_stream", 1, p_check_if_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag|HiddenPredFlag);
Yap_InitCPred ("$stream_flags", 2, p_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$stream_flags", 2, p_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$close", 1, p_close, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$close", 1, p_close, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("flush_output", 1, p_flush, SafePredFlag|SyncPredFlag); Yap_InitCPred ("flush_output", 1, p_flush, SafePredFlag|SyncPredFlag);
@ -5100,9 +4619,6 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$write_with_prio", 4, p_write2_prio, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$write_with_prio", 4, p_write2_prio, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("format", 2, p_format, SyncPredFlag); Yap_InitCPred ("format", 2, p_format, SyncPredFlag);
Yap_InitCPred ("format", 3, p_format2, SyncPredFlag); Yap_InitCPred ("format", 3, p_format2, SyncPredFlag);
Yap_InitCPred ("$current_line_number", 2, p_cur_line_no, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$line_position", 2, p_line_position, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$character_count", 2, p_character_count, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$show_stream_flags", 2, p_show_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$show_stream_flags", 2, p_show_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag);
@ -5128,9 +4644,7 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$force_char_conversion", 0, p_force_char_conversion, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$force_char_conversion", 0, p_force_char_conversion, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$disable_char_conversion", 0, p_disable_char_conversion, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$disable_char_conversion", 0, p_disable_char_conversion, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$add_alias_to_stream", 2, p_add_alias_to_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$add_alias_to_stream", 2, p_add_alias_to_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$change_alias_to_stream", 2, p_change_alias_to_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$check_if_valid_new_alias", 1, p_check_if_valid_new_alias, TestPredFlag|SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$check_if_valid_new_alias", 1, p_check_if_valid_new_alias, TestPredFlag|SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$fetch_stream_alias", 2, p_fetch_stream_alias, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$stream", 1, p_stream, SafePredFlag|TestPredFlag); Yap_InitCPred ("$stream", 1, p_stream, SafePredFlag|TestPredFlag);
Yap_InitCPred ("$get_default_encoding", 1, p_get_default_encoding, SafePredFlag|TestPredFlag); Yap_InitCPred ("$get_default_encoding", 1, p_get_default_encoding, SafePredFlag|TestPredFlag);
Yap_InitCPred ("$encoding", 2, p_encoding, SafePredFlag|SyncPredFlag), Yap_InitCPred ("$encoding", 2, p_encoding, SafePredFlag|SyncPredFlag),

2
include/YapInterface.h
View File

@ -176,7 +176,7 @@ extern X_API YAP_Term PROTO(YAP_HeadOfTerm,(YAP_Term));
extern X_API YAP_Term PROTO(YAP_TailOfTerm,(YAP_Term)); extern X_API YAP_Term PROTO(YAP_TailOfTerm,(YAP_Term));
/* Int AddressOfTailOfTerm(Term *, Term **) */ /* Int AddressOfTailOfTerm(Term *, Term **) */
extern X_API YAP_Int PROTO(YAP_SkipList,(YAP_Term *, YAP_Term **)); extern X_API int PROTO(YAP_SkipList,(YAP_Term *, YAP_Term **));
/* Term TailOfTerm(Term) */ /* Term TailOfTerm(Term) */
extern X_API YAP_Term PROTO(YAP_TermNil,(void)); extern X_API YAP_Term PROTO(YAP_TermNil,(void));

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

@ -1072,7 +1072,7 @@ void PL_set_prolog_flag(const char *name, int flags, ...);
COMMON(int) saveWakeup(wakeup_state *state, int forceframe ARG_LD); COMMON(int) saveWakeup(wakeup_state *state, int forceframe ARG_LD);
COMMON(void) restoreWakeup(wakeup_state *state ARG_LD); COMMON(void) restoreWakeup(wakeup_state *state ARG_LD);
COMMON(intptr_t) skip_list(Word l, Word *tailp ARG_LD); COMMON(int) skip_list(Word l, Word *tailp ARG_LD);
COMMON(int) priorityOperator(Module m, atom_t atom); COMMON(int) priorityOperator(Module m, atom_t atom);
COMMON(int) currentOperator(Module m, atom_t name, int kind, COMMON(int) currentOperator(Module m, atom_t name, int kind,
int *type, int *priority); int *type, int *priority);

37
pl/boot.yap
View File

@ -36,7 +36,7 @@ true :- true.
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)). '$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
'$init_system' :- '$init_system' :-
'$change_alias_to_stream'('$loop_stream','$stream'(0)), set_stream(user_input,alias('$loop_stream')),
% do catch as early as possible % do catch as early as possible
( (
'$access_yap_flags'(15, 0), '$access_yap_flags'(15, 0),
@ -92,7 +92,8 @@ true :- true.
% '$startup_saved_state', % '$startup_saved_state',
'$startup_reconsult', '$startup_reconsult',
'$startup_goals', '$startup_goals',
'$set_input'(user_input),'$set_output'(user), '$set_input'(user_input),
'$set_output'(user_output),
'$init_or_threads', '$init_or_threads',
'$run_at_thread_start'. '$run_at_thread_start'.
@ -1107,7 +1108,6 @@ bootstrap(F) :-
'$loop'(Stream,Status) :- '$loop'(Stream,Status) :-
'$change_alias_to_stream'('$loop_stream',Stream),
repeat, repeat,
%VSC ( '$current_stream'(_,_,Stream) -> true %VSC ( '$current_stream'(_,_,Stream) -> true
%VSC ; '$abort_loop'(Stream) %VSC ; '$abort_loop'(Stream)
@ -1374,8 +1374,8 @@ prolog_to_os_filename(Prolog, OS) :-
swi_prolog_to_os_filename(Prolog, OS). swi_prolog_to_os_filename(Prolog, OS).
time_file(File, Time) :- time_file(File, Time) :-
swi_time_file(File, Time). swi_time_file(File, Time).
working_directory(OLD, NEW) :- working_directory(Old, New) :-
swi_working_directory(OLD, NEW). swi_working_directory(Old, New).
cd(Dir) :- working_directory(_, Dir). cd(Dir) :- working_directory(_, Dir).
@ -1393,8 +1393,6 @@ open(File, Type, Stream, Opts) :-
swi_open(File, Type, Stream, Opts). swi_open(File, Type, Stream, Opts).
open_null_stream(S) :- open_null_stream(S) :-
swi_open_null_stream(S). swi_open_null_stream(S).
stream_property(Stream, Property) :-
swi_stream_property(Stream, Property).
atom_to_term(Atom, Term, Bindings) :- atom_to_term(Atom, Term, Bindings) :-
swi_atom_to_term(Atom, Term, Bindings). swi_atom_to_term(Atom, Term, Bindings).
@ -1404,3 +1402,28 @@ term_to_atom(Term, Atom) :-
with_output_to(Output, G) :- with_output_to(Output, G) :-
swi_with_output_to(Output, G). swi_with_output_to(Output, G).
byte_count(Stream, Count) :-
% format('~w~n',byte_count(Stream, Count)),
swi_byte_count(Stream, Count).
character_count(Stream, Count) :-
% format('~w~n',character_count(Stream, Count)),
swi_character_count(Stream, Count).
current_stream(File,Mode,Stream) :-
swi_current_stream(File,Mode,Stream).
is_stream(Stream) :-
% format('~w~n',is_stream(Stream)),
swi_is_stream(Stream).
line_count(Stream, Lines) :-
% format('~w~n',line_count(Stream)),
swi_line_count(Stream, Lines).
line_position(Stream, Position) :-
% format('~w~n',line_position(Stream)),
swi_line_position(Stream, Position).
set_stream(Stream, Property) :-
% format('~w~n',set_stream(Stream,Property)),
swi_set_stream(Stream, Property).
stream_property(Stream, Property) :-
% format('~w~n',stream_property(Stream,Property)),
swi_stream_property(Stream, Property).

11
pl/consult.yap
View File

@ -159,8 +159,8 @@ 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),
(X = 'arith.yap' -> start_low_level_trace ; true),
'$valid_encoding'(Encoding, Enc), '$valid_encoding'(Encoding, Enc),
open(Y, read, Stream, [encoding(Encoding)]), !,
'$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).
@ -247,7 +247,8 @@ use_module(M,F,Is) :-
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$file_name'(Stream,File), '$file_name'(Stream,File),
'$fetch_stream_alias'(OldStream,'$loop_stream'), '$fetch_stream_alias'(OldStream,'$loop_stream'),
'$change_alias_to_stream'('$loop_stream',Stream), set_stream(Stream,alias('$loop_stream')),
format('this~n',[]),
nb_getval('$consulting',Old), nb_getval('$consulting',Old),
nb_setval('$consulting',false), nb_setval('$consulting',false),
'$access_yap_flags'(18,GenerateDebug), '$access_yap_flags'(18,GenerateDebug),
@ -283,7 +284,7 @@ use_module(M,F,Is) :-
; ;
true true
), ),
'$change_alias_to_stream'('$loop_stream',OldStream), set_stream(OldStream,alias('$loop_stream')),
'$set_yap_flags'(18,GenerateDebug), '$set_yap_flags'(18,GenerateDebug),
'$comp_mode'(CompMode, OldCompMode), '$comp_mode'(CompMode, OldCompMode),
nb_setval('$consulting',Old), nb_setval('$consulting',Old),
@ -1035,3 +1036,7 @@ make.
'$file_name'(user_error,user_error). '$file_name'(user_error,user_error).
'$fetch_stream_alias'(OldStream,Alias) :-
stream_property(OldStream, alias(Alias)), !.

1
pl/init.yap
View File

@ -207,4 +207,3 @@ 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).

62
pl/yio.yap
View File

@ -601,36 +601,11 @@ flush_output :-
flush_output(Stream). flush_output(Stream).
current_line_number(N) :- current_line_number(N) :-
current_input(Stream), '$current_line_number'(Stream,N). current_input(Stream),
line_count(Stream, N).
current_line_number(user,N) :- !, current_line_number(Stream,N) :-
'$current_line_number'(user_input,N). line_count(Stream, N).
current_line_number(A,N) :-
atom(A),
current_stream(_,_,S), '$user_file_name'(S,A), !,
'$current_line_number'(S,N).
current_line_number(S,N) :-
'$current_line_number'(S,N).
line_count(Stream,N) :- current_line_number(Stream,N).
character_count(user,N) :- !,
'$character_count'(user_input,N).
character_count(A,N) :-
atom(A),
current_stream(_,_,S), '$user_file_name'(S,A), !,
'$character_count'(S,N).
character_count(S,N) :-
'$character_count'(S,N).
line_position(user,N) :- !,
'$line_position'(user_input,N).
line_position(A,N) :-
atom(A),
current_stream(_,_,S), '$user_file_name'(S,A), !,
'$line_position'(S,N).
line_position(S,N) :-
'$line_position'(S,N).
stream_position(user,N) :- !, stream_position(user,N) :- !,
'$show_stream_position'(user_input,N). '$show_stream_position'(user_input,N).
@ -769,13 +744,26 @@ sformat(String, Form, Args) :-
write_depth(T,L) :- write_depth(T,L,_). write_depth(T,L) :- write_depth(T,L,_).
is_stream(S) :- %% stream_position_data(?Field, +Pos, ?Date)
catch('$check_stream'(S), _, fail), !. %
% Extract values from stream position objects. '$stream_position' is
% of the format '$stream_position'(Byte, Char, Line, LinePos)
stream_position_data(Prop, Term, Value) :-
nonvar(Prop), !,
( stream_position_field(Prop, Pos)
-> arg(Pos, Term, Value)
; throw(error(domain_error(stream_position_data, Prop)))
).
stream_position_data(Prop, Term, Value) :-
stream_position_field(Prop, Pos),
arg(Pos, Term, Value).
stream_position_field(char_count, 1).
stream_position_field(line_count, 2).
stream_position_field(line_position, 3).
stream_position_field(byte_count, 4).
stream_position_data(line_count, '$stream_position'(_,Data,_,_,_), Data).
stream_position_data(line_position, '$stream_position'(_,_,Data,_,_), Data).
%stream_position_data(char_count, '$stream_position'(Data,_,_,_,_), Data).
stream_position_data(byte_count, '$stream_position'(Data,_,_,_,_), Data).
'$default_expand'(Expand) :- '$default_expand'(Expand) :-
nb_getval('$open_expands_filename',Expand). nb_getval('$open_expands_filename',Expand).
@ -808,7 +796,3 @@ prolog_file_name(File, PrologFileName) :-