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

Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

This commit is contained in:
Ricardo Rocha 2010-02-22 14:04:09 +00:00
parent 71a9be9742 4a53759fc1
commit 42b07768d6
23 changed files with 587 additions and 321 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/absmi.c
View File

@ -14297,11 +14297,11 @@ Yap_absmi(int inp)
goto creep; goto creep;
} }
UNLOCK(SignalLock); UNLOCK(SignalLock);
saveregs(); saveregs_and_ycache();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, Osbpp))) { if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, Osbpp))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
} }
setregs(); setregs_and_ycache();
goto execute_after_comma; goto execute_after_comma;
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();

1
C/dbase.c
View File

@ -4631,6 +4631,7 @@ p_instance(void)
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity))); Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity)));
} else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) { } else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
UNLOCK(ap->PELock);
return FALSE; return FALSE;
} }
ptr = RepAppl(t2)+1; ptr = RepAppl(t2)+1;

24
C/exec.c
View File

@ -782,25 +782,17 @@ p_execute_nonstop(void)
} }
/* N = arity; */ /* N = arity; */
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (ActiveSignals & YAP_CREEP_SIGNAL && !Yap_InterruptsDisabled) {
Yap_signal(YAP_CREEP_SIGNAL);
}
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (ActiveSignals & YAP_CREEP_SIGNAL && !Yap_InterruptsDisabled) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred); return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
} else if ((RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) && } else { if (ActiveSignals & YAP_CREEP_SIGNAL &&
RepPredProp(pe)->OpcodeOfPred != Yap_opcode(_call_bfunc_xx)) { !Yap_InterruptsDisabled &&
/* USER C-Code may walk over registers */ (!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) ||
if (RepPredProp(pe)->PredFlags & UserCPredFlag) { RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
save_machine_regs(); Yap_signal(YAP_CREEP_SIGNAL);
} }
if (RepPredProp(pe)->PredFlags & UserCPredFlag) {
Int out = RepPredProp(pe)->cs.f_code();
restore_machine_regs();
return out;
} else {
return RepPredProp(pe)->cs.f_code();
}
} else {
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred); return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
} }
} }

12
C/index.c
View File

@ -3450,15 +3450,17 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
if (cls->u.t_ptr != sp->extra) break; if (cls->u.t_ptr != sp->extra) break;
} else { } else {
CELL *pt = RepAppl(sp->extra); CELL *pt = RepAppl(sp->extra);
CELL *pt1 = RepAppl(cls->u.t_ptr); if (cls->u.t_ptr) {
CELL *pt1 = RepAppl(cls->u.t_ptr);
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
Term t = MkIntTerm(pt[1]^pt[2]), Term t = MkIntTerm(pt[1]^pt[2]),
t1 = MkIntTerm(pt1[1]^pt1[2]); t1 = MkIntTerm(pt1[1]^pt1[2]);
#else #else
Term t = MkIntTerm(pt[1]), Term t = MkIntTerm(pt[1]),
t1 = MkIntTerm(pt1[1]); t1 = MkIntTerm(pt1[1]);
#endif #endif
if (t != t1) break; if (t != t1) break;
}
} }
} }
} }

7
C/iopreds.c
View File

@ -2164,8 +2164,13 @@ check_bom(int sno, StreamDesc *st)
int ch; int ch;
ch = st->stream_getc(sno); ch = st->stream_getc(sno);
if (ch == EOFCHAR) if (ch == EOFCHAR) {
st->och = ch;
st->stream_getc = PlUnGetc;
st->stream_wgetc = get_wchar;
st->stream_gets = DefaultGets;
return TRUE; return TRUE;
}
switch(ch) { switch(ch) {
case 0xFE: case 0xFE:
{ {

2
C/parser.c
View File

@ -499,7 +499,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
if (func == NULL) { if (func == NULL) {
Yap_ErrorMessage = "Heap Overflow"; Yap_ErrorMessage = "Heap Overflow";
FAIL; FAIL;
} }
t = ParseTerm(oprprio, FailBuff); t = ParseTerm(oprprio, FailBuff);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */

1
H/iatoms.h
View File

@ -63,6 +63,7 @@
AtomDBTerm = Yap_LookupAtom("db_term"); AtomDBTerm = Yap_LookupAtom("db_term");
AtomDBref = Yap_FullLookupAtom("$dbref"); AtomDBref = Yap_FullLookupAtom("$dbref");
AtomDInteger = Yap_FullLookupAtom("$integer"); AtomDInteger = Yap_FullLookupAtom("$integer");
AtomDOUBLE = Yap_FullLookupAtom("Double");
AtomDec10 = Yap_LookupAtom("dec10"); AtomDec10 = Yap_LookupAtom("dec10");
AtomDefault = Yap_LookupAtom("default"); AtomDefault = Yap_LookupAtom("default");
AtomDevNull = Yap_LookupAtom("/dev/null"); AtomDevNull = Yap_LookupAtom("/dev/null");

5
include/SWI-Prolog.h
View File

@ -185,6 +185,7 @@ typedef void *PL_engine_t;
#define CVT_MASK 0x00ff #define CVT_MASK 0x00ff
#define CVT_EXCEPTION 0x10000 #define CVT_EXCEPTION 0x10000
#define CVT_VARNOFAIL 0x20000 /* return 2 if argument is unbound */
#define BUF_DISCARDABLE 0x0000 #define BUF_DISCARDABLE 0x0000
#define BUF_RING 0x0100 #define BUF_RING 0x0100
@ -409,6 +410,7 @@ extern X_API void PL_discard_foreign_frame(fid_t);
extern X_API void PL_rewind_foreign_frame(fid_t); extern X_API void PL_rewind_foreign_frame(fid_t);
extern X_API fid_t PL_open_foreign_frame(void); extern X_API fid_t PL_open_foreign_frame(void);
extern X_API int PL_raise_exception(term_t); extern X_API int PL_raise_exception(term_t);
extern X_API void PL_clear_exception(void);
extern X_API void PL_register_atom(atom_t); extern X_API void PL_register_atom(atom_t);
extern X_API void PL_unregister_atom(atom_t); extern X_API void PL_unregister_atom(atom_t);
extern X_API predicate_t PL_pred(functor_t, module_t); extern X_API predicate_t PL_pred(functor_t, module_t);
@ -420,6 +422,7 @@ extern X_API void PL_cut_query(qid_t);
extern X_API void PL_close_query(qid_t); extern X_API void PL_close_query(qid_t);
extern X_API int PL_toplevel(void); extern X_API int PL_toplevel(void);
extern X_API term_t PL_exception(qid_t); extern X_API term_t PL_exception(qid_t);
extern X_API term_t PL_exception(qid_t);
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t); extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
extern X_API int PL_call(term_t, module_t); extern X_API int PL_call(term_t, module_t);
extern X_API void PL_register_foreign(const char *, int, foreign_t (*)(void), int); extern X_API void PL_register_foreign(const char *, int, foreign_t (*)(void), int);
@ -436,7 +439,7 @@ extern X_API int PL_destroy_engine(PL_engine_t);
extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *); extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *);
extern X_API int PL_get_string_chars(term_t, char **, int *); extern X_API int PL_get_string_chars(term_t, char **, int *);
extern X_API record_t PL_record(term_t); extern X_API record_t PL_record(term_t);
extern X_API void PL_recorded(record_t, term_t); extern X_API int PL_recorded(record_t, term_t);
extern X_API void PL_erase(record_t); extern X_API void PL_erase(record_t);
extern X_API int PL_action(int,...); extern X_API int PL_action(int,...);
extern X_API void *PL_malloc(int); extern X_API void *PL_malloc(int);

2
library/system/sys.c
View File

@ -205,7 +205,7 @@ sysmktime(void)
loc.tm_hour = YAP_IntOfTerm(YAP_ARG4); loc.tm_hour = YAP_IntOfTerm(YAP_ARG4);
loc.tm_min = YAP_IntOfTerm(YAP_ARG5); loc.tm_min = YAP_IntOfTerm(YAP_ARG5);
loc.tm_sec = YAP_IntOfTerm(YAP_ARG6); loc.tm_sec = YAP_IntOfTerm(YAP_ARG6);
loc.tm_isdst = daylight; loc.tm_isdst = -1;
if ((tim = mktime(&loc)) == (time_t)-1) { if ((tim = mktime(&loc)) == (time_t)-1) {
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));

11
library/yap2swi/yap2swi.c
View File

@ -1858,11 +1858,14 @@ PL_record(term_t ts)
return (record_t)Yap_StoreTermInDB(t, 0); return (record_t)Yap_StoreTermInDB(t, 0);
} }
X_API void X_API int
PL_recorded(record_t db, term_t ts) PL_recorded(record_t db, term_t ts)
{ {
Term t = Yap_FetchTermFromDB((DBTerm *)db); Term t = Yap_FetchTermFromDB((DBTerm *)db);
if (t == 0L)
return FALSE;
Yap_PutInSlot(ts,t); Yap_PutInSlot(ts,t);
return TRUE;
} }
X_API void X_API void
@ -1959,6 +1962,12 @@ PL_exception(qid_t q)
} }
} }
X_API void
PL_clear_exception(void)
{
EX = 0L;
}
X_API int X_API int
PL_initialise(int myargc, char **myargv) PL_initialise(int myargc, char **myargv)
{ {

2
misc/ATOMS
View File

@ -72,7 +72,7 @@ A DBReference N "db_reference"
A DBTerm N "db_term" A DBTerm N "db_term"
A DBref F "$dbref" A DBref F "$dbref"
A DInteger F "$integer" A DInteger F "$integer"
A DOUBLE A "Double" A DOUBLE F "Double"
A Dec10 N "dec10" A Dec10 N "dec10"
A Default N "default" A Default N "default"
A DevNull N "/dev/null" A DevNull N "/dev/null"

4
packages/PLStream/Makefile.in
View File

@ -46,7 +46,7 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h \
$(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \ $(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \
$(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/pl-utf8.c $(srcdir)/uxnt/uxnt.h $(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/pl-utf8.c $(srcdir)/uxnt/uxnt.h
C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \ C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-error.c $(srcdir)/pl-feature.c \ $(srcdir)/pl-error.c \
$(srcdir)/pl-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \ $(srcdir)/pl-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \
$(srcdir)/pl-privitf.c \ $(srcdir)/pl-privitf.c \
$(srcdir)/pl-stream.c $(srcdir)/pl-string.c \ $(srcdir)/pl-stream.c $(srcdir)/pl-string.c \
@ -54,7 +54,7 @@ C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-text.c \ $(srcdir)/pl-text.c \
$(srcdir)/pl-utils.c \ $(srcdir)/pl-utils.c \
$(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.c $(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.c
OBJS=pl-buffer.o pl-ctype.o pl-error.o pl-feature.o \ OBJS=pl-buffer.o pl-ctype.o pl-error.o \
pl-file.o pl-files.o pl-os.o pl-privitf.o \ pl-file.o pl-files.o pl-os.o pl-privitf.o \
pl-stream.o pl-string.o pl-table.o \ pl-stream.o pl-string.o pl-table.o \
pl-text.o pl-utils.o pl-utf8.o \ pl-text.o pl-utils.o pl-utf8.o \

1
packages/PLStream/atoms.h
View File

@ -504,6 +504,7 @@
#define ATOM_term_position MK_ATOM("term_position") #define ATOM_term_position MK_ATOM("term_position")
#define ATOM_terminal MK_ATOM("terminal") #define ATOM_terminal MK_ATOM("terminal")
#define ATOM_terminal_capability MK_ATOM("terminal_capability") #define ATOM_terminal_capability MK_ATOM("terminal_capability")
#define ATOM_temporary_files MK_ATOM("temporary_files")
#define ATOM_text MK_ATOM("text") #define ATOM_text MK_ATOM("text")
#define ATOM_thread MK_ATOM("thread") #define ATOM_thread MK_ATOM("thread")
#define ATOM_thread_cputime MK_ATOM("thread_cputime") #define ATOM_thread_cputime MK_ATOM("thread_cputime")

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

@ -298,7 +298,8 @@ unify_char_type(term_t type, const char_type *ct, int context, int how)
static foreign_t static foreign_t
do_char_type(term_t chr, term_t class, control_t h, int how) do_char_type(term_t chr, term_t class, control_t h, int how)
{ generator *gen; { GET_LD
generator *gen;
fid_t fid; fid_t fid;
switch( ForeignControl(h) ) switch( ForeignControl(h) )
@ -399,7 +400,9 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
succeed; succeed;
} }
fid = PL_open_foreign_frame(); if ( !(fid = PL_open_foreign_frame()) )
goto error;
for(;;) for(;;)
{ int rval; { int rval;
@ -412,7 +415,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
{ if ( rval < 0 || { if ( rval < 0 ||
!unify_char_type(class, gen->class, rval, how) ) !unify_char_type(class, gen->class, rval, how) )
goto next; goto next;
} else if ( gen->do_enum & ENUM_CLASS ) } else if ( gen->do_enum & ENUM_CLASS )
{ if ( !unify_char_type(class, gen->class, rval, how) ) { if ( !unify_char_type(class, gen->class, rval, how) )
goto next; goto next;
@ -432,6 +435,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
break; break;
} }
error:
freeHeap(gen, sizeof(*gen)); freeHeap(gen, sizeof(*gen));
fail; fail;
} }
@ -440,13 +444,13 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
static static
PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC) PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CHAR_MODE); { return do_char_type(A1, A2, PL__ctx, PL_CHAR);
} }
static static
PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC) PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CODE_MODE); { return do_char_type(A1, A2, PL__ctx, PL_CODE);
} }
@ -513,7 +517,8 @@ get_chr_from_text(const PL_chars_t *t, size_t index)
static foreign_t static foreign_t
modify_case_atom(term_t in, term_t out, int down) modify_case_atom(term_t in, term_t out, int down)
{ PL_chars_t tin, tout; { GET_LD
PL_chars_t tin, tout;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) ) if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE; return FALSE;
@ -578,7 +583,7 @@ modify_case_atom(term_t in, term_t out, int down)
{ tout.text.t[i] = (char)c; { tout.text.t[i] = (char)c;
} }
} }
} }
} else } else
{ if ( down ) { if ( down )
{ for(i=0; i<tin.length; i++) { for(i=0; i<tin.length; i++)
@ -619,7 +624,8 @@ PRED_IMPL("upcase_atom", 2, upcase_atom, 0)
static int static int
write_normalize_space(IOSTREAM *out, term_t in) write_normalize_space(IOSTREAM *out, term_t in)
{ PL_chars_t tin; { GET_LD
PL_chars_t tin;
size_t i, end; size_t i, end;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) ) if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
@ -655,18 +661,12 @@ PRED_IMPL("normalize_space", 2, normalize_space, 0)
{ redir_context ctx; { redir_context ctx;
word rc; word rc;
EXCEPTION_GUARDED(/*code*/ if ( (rc = setupOutputRedirect(A1, &ctx, FALSE)) )
if ( setupOutputRedirect(A1, &ctx, FALSE) ) { if ( (rc = write_normalize_space(ctx.stream, A2)) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) ) rc = closeOutputRedirect(&ctx);
rc = closeOutputRedirect(&ctx); else
else discardOutputRedirect(&ctx);
discardOutputRedirect(&ctx); }
} else
rc = FALSE;
/*cleanup*/,
DEBUG(1, Sdprintf("Cleanup after throw()\n"));
discardOutputRedirect(&ctx);
rc = PL_rethrow(););
return rc; return rc;
} }
@ -730,7 +730,8 @@ static lccat lccats[] =
static static
PRED_IMPL("setlocale", 3, setlocale, 0) PRED_IMPL("setlocale", 3, setlocale, 0)
{ char *what; { PRED_LD
char *what;
char *locale; char *locale;
const lccat *lcp; const lccat *lcp;
@ -794,28 +795,28 @@ EndPredDefs
const char _PL_char_types[] = { const char _PL_char_types[] = {
/* ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O 0-15 */ /* ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O 0-15 */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_ 16-31 */ /* ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_ 16-31 */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* sp ! " # $ % & ' ( ) * + , - . / 32-47 */ /* sp ! " # $ % & ' ( ) * + , - . / 32-47 */
SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY, SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? 48-63 */ /* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? 48-63 */
DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY, DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY,
/* @ A B C D E F G H I J K L M N O 64-79 */ /* @ A B C D E F G H I J K L M N O 64-79 */
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
/* P Q R S T U V W X Y Z [ \ ] ^ _ 80-95 */ /* P Q R S T U V W X Y Z [ \ ] ^ _ 80-95 */
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC,
/* ` a b c d e f g h i j k l m n o 96-111 */ /* ` a b c d e f g h i j k l m n o 96-111 */
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
/* p q r s t u v w x y z { | } ~ ^? 112-127 */ /* p q r s t u v w x y z { | } ~ ^? 112-127 */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT,
/* 128-159 (C1 controls) */ /* 128-159 (C1 controls) */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* 160-255 (G1 graphics) */ /* 160-255 (G1 graphics) */
/* ISO Latin 1 is assumed */ /* ISO Latin 1 is assumed */
SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO, SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC, SO, UC, UC, UC, UC, UC, UC, UC, LC, UC, UC, UC, UC, UC, UC, UC, SO, UC, UC, UC, UC, UC, UC, UC, LC,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
@ -840,7 +841,9 @@ static const enc_map map[] =
IOENC IOENC
initEncoding(void) initEncoding(void)
{ if ( LD ) { GET_LD
if ( LD )
{ if ( !LD->encoding ) { if ( !LD->encoding )
{ char *enc; { char *enc;
@ -882,7 +885,8 @@ initCharTypes(void)
#if __SWI_PROLOG__ #if __SWI_PROLOG__
bool bool
systemMode(bool accept) systemMode(bool accept)
{ bool old = SYSTEM_MODE ? TRUE : FALSE; { GET_LD
bool old = SYSTEM_MODE ? TRUE : FALSE;
if ( accept ) if ( accept )
debugstatus.styleCheck |= DOLLAR_STYLE; debugstatus.styleCheck |= DOLLAR_STYLE;

10
packages/PLStream/pl-feature.c
View File

@ -1,10 +0,0 @@
int defFeature(const char *c, int f, ...) {
/**** add extra flags to engine: nowadays PL_set_prolog_flag */
return 0;
}
int trueFeature(int f) {
/**** define whether the feature is set or not */
return 0;
}

155
packages/PLStream/pl-file.c
View File

@ -69,7 +69,7 @@ handling times must be cleaned, but that not only holds for this module.
#undef LD /* fetch LD once per function */ #undef LD /* fetch LD once per function */
#define LD LOCAL_LD #define LD LOCAL_LD
static int bad_encoding(atom_t name); static int bad_encoding(const char *msg, atom_t name);
static int noprotocol(void); static int noprotocol(void);
static int streamStatus(IOSTREAM *s); static int streamStatus(IOSTREAM *s);
@ -261,9 +261,13 @@ freeStream(IOSTREAM *s)
if ( (symb=lookupHTable(streamContext, s)) ) if ( (symb=lookupHTable(streamContext, s)) )
{ stream_context *ctx = symb->value; { stream_context *ctx = symb->value;
if ( ctx->filename == source_file_name ) if ( ctx->filename != NULL_ATOM )
{ source_file_name = NULL_ATOM; /* TBD: pop? */ { PL_unregister_atom(ctx->filename);
source_line_no = -1;
if ( ctx->filename == source_file_name )
{ source_file_name = NULL_ATOM; /* TBD: pop? */
source_line_no = -1;
}
} }
freeHeap(ctx, sizeof(*ctx)); freeHeap(ctx, sizeof(*ctx));
@ -289,10 +293,18 @@ freeStream(IOSTREAM *s)
/* MT: locked by caller (openStream()) */ /* MT: locked by caller (openStream()) */
/* name must be registered by the caller */
static void static void
setFileNameStream(IOSTREAM *s, atom_t name) setFileNameStream(IOSTREAM *s, atom_t name)
{ getStreamContext(s)->filename = name; { stream_context *ctx = getStreamContext(s);
if ( ctx->filename )
{ PL_unregister_atom(ctx->filename);
ctx->filename = NULL_ATOM;
}
if ( name != NULL_ATOM )
ctx->filename = name;
} }
@ -520,13 +532,17 @@ PL_unify_stream_or_alias(term_t t, IOSTREAM *s)
} else } else
{ term_t a = PL_new_term_ref(); { term_t a = PL_new_term_ref();
PL_put_pointer(a, s); rval = ( (a=PL_new_term_ref()) &&
PL_cons_functor(a, FUNCTOR_dstream1, a); PL_put_pointer(a, s) &&
PL_cons_functor(a, FUNCTOR_dstream1, a) &&
rval = PL_unify(t, a); PL_unify(t, a)
);
} }
UNLOCK(); UNLOCK();
if ( !rval && !PL_is_variable(t) )
return PL_error(NULL, 0, "stream-argument", ERR_MUST_BE_VAR, 0);
return rval; return rval;
} }
@ -541,8 +557,10 @@ PL_unify_stream(term_t t, IOSTREAM *s)
ctx = getStreamContext(s); ctx = getStreamContext(s);
UNLOCK(); UNLOCK();
PL_put_pointer(a, s); if ( !(a = PL_new_term_ref()) ||
PL_cons_functor(a, FUNCTOR_dstream1, a); !PL_put_pointer(a, s) ||
!PL_cons_functor(a, FUNCTOR_dstream1, a) )
return FALSE; /* resource error */
if ( PL_unify(t, a) ) if ( PL_unify(t, a) )
return TRUE; return TRUE;
@ -666,14 +684,21 @@ reportStreamError(IOSTREAM *s)
if ( (s->flags & SIO_FERR) ) if ( (s->flags & SIO_FERR) )
{ if ( s->exception ) { if ( s->exception )
{ fid_t fid = PL_open_foreign_frame(); { fid_t fid;
term_t ex = PL_new_term_ref(); term_t ex;
PL_recorded(s->exception, ex); int rc;
LD->exception.processing = TRUE; /* allow using spare stack */
if ( !(fid = PL_open_foreign_frame()) )
return FALSE;
ex = PL_new_term_ref();
rc = PL_recorded(s->exception, ex);
PL_erase(s->exception); PL_erase(s->exception);
s->exception = NULL; s->exception = NULL;
PL_raise_exception(ex); if ( rc )
rc = PL_raise_exception(ex);
PL_close_foreign_frame(fid); PL_close_foreign_frame(fid);
return FALSE; return rc;
} }
if ( s->flags & SIO_INPUT ) if ( s->flags & SIO_INPUT )
@ -1038,11 +1063,11 @@ closeOutputRedirect(redir_context *ctx)
rval = PL_unify_wchars_diff(out, tail, ctx->out_format, rval = PL_unify_wchars_diff(out, tail, ctx->out_format,
ctx->size/sizeof(wchar_t), ctx->size/sizeof(wchar_t),
(wchar_t*)ctx->data); (wchar_t*)ctx->data);
if ( tail ) if ( rval && tail )
rval = PL_unify(tail, diff); rval = PL_unify(tail, diff);
if ( ctx->data != ctx->buffer ) if ( ctx->data != ctx->buffer )
free(ctx->data); Sfree(ctx->data);
} }
return rval; return rval;
@ -1064,7 +1089,7 @@ discardOutputRedirect(redir_context *ctx)
} else } else
{ closeStream(ctx->stream); { closeStream(ctx->stream);
if ( ctx->data != ctx->buffer ) if ( ctx->data != ctx->buffer )
free(ctx->data); Sfree(ctx->data);
} }
} }
@ -1397,6 +1422,22 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
goto error; goto error;
} }
goto ok;
} else if ( aname == ATOM_type ) /* type(Type) */
{ atom_t type;
if ( !PL_get_atom_ex(a, &type) )
return FALSE;
if ( type == ATOM_text )
{ s->flags |= SIO_TEXT;
} else if ( type == ATOM_binary )
{ s->flags &= ~SIO_TEXT;
} else
{ PL_error("set_stream", 2, NULL, ERR_DOMAIN,
ATOM_type, a);
goto error;
}
goto ok; goto ok;
} else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */ } else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */
{ int close; { int close;
@ -1428,6 +1469,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
if ( !PL_get_atom_ex(a, &fn) ) if ( !PL_get_atom_ex(a, &fn) )
goto error; goto error;
PL_register_atom(fn);
LOCK(); LOCK();
setFileNameStream(s, fn); setFileNameStream(s, fn);
UNLOCK(); UNLOCK();
@ -1467,7 +1509,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
if ( !PL_get_atom_ex(a, &val) ) if ( !PL_get_atom_ex(a, &val) )
goto error; goto error;
if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN ) if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN )
{ bad_encoding(val); { bad_encoding(NULL, val);
goto error; goto error;
} }
@ -2191,7 +2233,12 @@ PRED_IMPL("get_single_char", 1, get_single_char, 0)
int c = getSingleChar(s, TRUE); int c = getSingleChar(s, TRUE);
if ( c == EOF ) if ( c == EOF )
{ PL_unify_integer(A1, -1); { if ( PL_exception(0) )
{ releaseStream(s);
return FALSE;
}
PL_unify_integer(A1, -1);
return streamStatus(s); return streamStatus(s);
} }
@ -2512,12 +2559,12 @@ encoding_to_atom(IOENC enc)
static int static int
bad_encoding(atom_t name) bad_encoding(const char *msg, atom_t name)
{ GET_LD { GET_LD
term_t t = PL_new_term_ref(); term_t t = PL_new_term_ref();
PL_put_atom(t, name); PL_put_atom(t, name);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, t); return PL_error(NULL, 0, msg, ERR_DOMAIN, ATOM_encoding, t);
} }
@ -2630,10 +2677,23 @@ openStream(term_t file, term_t mode, term_t options)
if ( encoding != NULL_ATOM ) if ( encoding != NULL_ATOM )
{ enc = atom_to_encoding(encoding); { enc = atom_to_encoding(encoding);
if ( enc == ENC_UNKNOWN ) if ( enc == ENC_UNKNOWN )
{ bad_encoding(encoding); { bad_encoding(NULL, encoding);
return NULL; return NULL;
} }
if ( type == ATOM_binary && enc != ENC_OCTET )
{ bad_encoding("type(binary) implies encoding(octet)", encoding);
return NULL;
}
switch(enc) /* explicitely specified: do not */
{ case ENC_OCTET: /* switch to Unicode. For implicit */
case ENC_ASCII: /* and unicode types we must detect */
case ENC_ISO_LATIN_1: /* and skip the BOM */
case ENC_WCHAR:
bom = FALSE;
break;
default:
;
}
} else if ( type == ATOM_binary ) } else if ( type == ATOM_binary )
{ enc = ENC_OCTET; { enc = ENC_OCTET;
bom = FALSE; bom = FALSE;
@ -2675,10 +2735,12 @@ openStream(term_t file, term_t mode, term_t options)
} }
#ifdef HAVE_POPEN #ifdef HAVE_POPEN
else if ( PL_is_functor(file, FUNCTOR_pipe1) ) else if ( PL_is_functor(file, FUNCTOR_pipe1) )
{ term_t a = PL_new_term_ref(); { term_t a;
char *cmd; char *cmd;
PL_get_arg(1, file, a); PL_clear_exception();
a = PL_new_term_ref();
_PL_get_arg(1, file, a);
if ( !PL_get_chars(a, &cmd, CVT_ATOM|CVT_STRING|REP_FN) ) if ( !PL_get_chars(a, &cmd, CVT_ATOM|CVT_STRING|REP_FN) )
{ PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a); { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a);
return NULL; return NULL;
@ -3520,7 +3582,15 @@ PRED_IMPL("stream_property", 2, stream_property,
} }
fid = PL_open_foreign_frame(); if ( !(fid = PL_open_foreign_frame()) )
{ error:
if ( pe->e )
freeTableEnum(pe->e);
freeHeap(pe, sizeof(*pe));
return FALSE;
}
for(;;) for(;;)
{ if ( pe->s ) /* given stream */ { if ( pe->s ) /* given stream */
@ -3531,7 +3601,8 @@ PRED_IMPL("stream_property", 2, stream_property,
goto enum_e; goto enum_e;
} }
fid2 = PL_open_foreign_frame(); if ( !(fid2 = PL_open_foreign_frame()) )
goto error;
for( ; pe->p->functor ; pe->p++ ) for( ; pe->p->functor ; pe->p++ )
{ if ( PL_unify_functor(property, pe->p->functor) ) { if ( PL_unify_functor(property, pe->p->functor) )
{ int rval; { int rval;
@ -3559,6 +3630,9 @@ PRED_IMPL("stream_property", 2, stream_property,
} }
} }
if ( exception_term )
goto error;
if ( pe->fixed_p ) if ( pe->fixed_p )
break; break;
PL_rewind_foreign_frame(fid2); PL_rewind_foreign_frame(fid2);
@ -3579,6 +3653,8 @@ PRED_IMPL("stream_property", 2, stream_property,
pe->p = sprop_list; pe->p = sprop_list;
break; break;
} }
if ( exception_term )
goto error;
} }
} }
@ -4081,11 +4157,16 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0)
{ PRED_LD { PRED_LD
IOSTREAM *in = NULL, *out = NULL, *error = NULL; IOSTREAM *in = NULL, *out = NULL, *error = NULL;
int rval = FALSE; int rval = FALSE;
int wrapin = FALSE;
if ( !PL_get_stream_handle(A1, &in) || if ( !get_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED) ||
!PL_get_stream_handle(A2, &out) ) !get_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS) )
goto out; goto out;
wrapin = (LD->IO.streams[0] != in);
if ( wrapin )
in = getStream(in); /* lock it */
if ( PL_compare(A2, A3) == 0 ) /* == */ if ( PL_compare(A2, A3) == 0 ) /* == */
{ error = getStream(Snew(out->handle, out->flags, out->functions)); { error = getStream(Snew(out->handle, out->flags, out->functions));
error->flags &= ~SIO_ABUF; /* disable buffering */ error->flags &= ~SIO_ABUF; /* disable buffering */
@ -4099,20 +4180,22 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0)
out->flags &= ~SIO_ABUF; /* output: line buffered */ out->flags &= ~SIO_ABUF; /* output: line buffered */
out->flags |= SIO_LBUF; out->flags |= SIO_LBUF;
LD->IO.streams[0] = in; /* user_input */
LD->IO.streams[1] = out; /* user_output */ LD->IO.streams[1] = out; /* user_output */
LD->IO.streams[2] = error; /* user_error */ LD->IO.streams[2] = error; /* user_error */
LD->IO.streams[3] = in; /* current_input */
LD->IO.streams[4] = out; /* current_output */ LD->IO.streams[4] = out; /* current_output */
wrapIO(in, Sread_user, NULL); if ( wrapin )
LD->prompt.next = TRUE; { LD->IO.streams[3] = in; /* current_input */
LD->IO.streams[0] = in; /* user_input */
wrapIO(in, Sread_user, NULL);
LD->prompt.next = TRUE;
}
UNLOCK(); UNLOCK();
rval = TRUE; rval = TRUE;
out: out:
if ( in ) if ( wrapin && in )
releaseStream(in); releaseStream(in);
if ( out ) if ( out )
releaseStream(out); releaseStream(out);

116
packages/PLStream/pl-files.c
View File

@ -351,21 +351,25 @@ MarkExecutable(const char *name)
* FIND FILES FROM C * * FIND FILES FROM C *
*********************************/ *********************************/
int static int
unifyTime(term_t t, time_t time) unifyTime(term_t t, time_t time)
{ return PL_unify_float(t, (double)time); { return PL_unify_float(t, (double)time);
} }
static void static int
add_option(term_t options, functor_t f, atom_t val) add_option(term_t options, functor_t f, atom_t val)
{ GET_LD { GET_LD
term_t head = PL_new_term_ref(); term_t head;
PL_unify_list(options, head, options); if ( (head=PL_new_term_ref()) &&
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val); PL_unify_list(options, head, options) &&
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val) )
{ PL_reset_term_refs(head);
return TRUE;
}
PL_reset_term_refs(head); return FALSE;
} }
#define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST) #define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST)
@ -378,29 +382,36 @@ PL_get_file_name(term_t n, char **namep, int flags)
char ospath[MAXPATHLEN]; char ospath[MAXPATHLEN];
if ( flags & PL_FILE_SEARCH ) if ( flags & PL_FILE_SEARCH )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system"); { fid_t fid;
term_t av = PL_new_term_refs(3);
term_t options = PL_copy_term_ref(av+2);
int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
: PL_Q_PASS_EXCEPTION);
PL_put_term(av+0, n); if ( (fid = PL_open_foreign_frame()) )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system");
term_t av = PL_new_term_refs(3);
term_t options = PL_copy_term_ref(av+2);
int rc = TRUE;
int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
: PL_Q_PASS_EXCEPTION);
if ( flags & PL_FILE_EXIST ) PL_put_term(av+0, n);
add_option(options, FUNCTOR_access1, ATOM_exist);
if ( flags & PL_FILE_READ )
add_option(options, FUNCTOR_access1, ATOM_read);
if ( flags & PL_FILE_WRITE )
add_option(options, FUNCTOR_access1, ATOM_write);
if ( flags & PL_FILE_EXECUTE )
add_option(options, FUNCTOR_access1, ATOM_execute);
PL_unify_nil(options); if ( rc && flags & PL_FILE_EXIST )
rc = add_option(options, FUNCTOR_access1, ATOM_exist);
if ( rc && flags & PL_FILE_READ )
rc = add_option(options, FUNCTOR_access1, ATOM_read);
if ( rc && flags & PL_FILE_WRITE )
rc = add_option(options, FUNCTOR_access1, ATOM_write);
if ( rc && flags & PL_FILE_EXECUTE )
rc = add_option(options, FUNCTOR_access1, ATOM_execute);
if ( !PL_call_predicate(NULL, cflags, pred, av) ) if ( rc ) rc = PL_unify_nil(options);
return FALSE; if ( rc ) rc = PL_call_predicate(NULL, cflags, pred, av);
if ( rc ) rc = PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN);
return PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN); PL_discard_foreign_frame(fid);
return rc;
}
return FALSE;
} }
if ( flags & PL_FILE_NOERRORS ) if ( flags & PL_FILE_NOERRORS )
@ -642,9 +653,51 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
if ( !PL_get_chars(base, &n, CVT_ALL) ) if ( !PL_get_chars(base, &n, CVT_ALL) )
return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base); return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base);
return PL_unify_atom(name, TemporaryFile(n)); return PL_unify_atom(name, TemporaryFile(n, NULL));
} }
/** tmp_file_stream(+Mode, -File, -Stream)
*/
static
PRED_IMPL("tmp_file_stream", 3, tmp_file_stream, 0)
{ PRED_LD
atom_t fn;
int fd;
IOENC enc;
atom_t encoding;
const char *mode;
if ( !PL_get_atom_ex(A1, &encoding) )
return FALSE;
if ( (enc = atom_to_encoding(encoding)) == ENC_UNKNOWN )
{ if ( encoding == ATOM_binary )
{ enc = ENC_OCTET;
mode = "wb";
} else
{ return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, A1);
}
} else
{ mode = "w";
}
if ( (fn=TemporaryFile("", &fd)) )
{ IOSTREAM *s;
if ( !PL_unify_atom(A2, fn) )
{ close(fd);
return PL_error(NULL, 0, NULL, ERR_MUST_BE_VAR, 2);
}
s = Sfdopen(fd, mode);
s->encoding = enc;
return PL_unify_stream(A3, s);
} else
{ return PL_error(NULL, 0, NULL, ERR_RESOURCE, ATOM_temporary_files);
}
}
/******************************* /*******************************
* CHANGE FILESYSTEM * * CHANGE FILESYSTEM *
@ -653,7 +706,13 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
static static
PRED_IMPL("delete_file", 1, delete_file, 0) PRED_IMPL("delete_file", 1, delete_file, 0)
{ char *n; { PRED_LD
char *n;
atom_t aname;
if ( PL_get_atom(A1, &aname) &&
DeleteTemporaryFile(aname) )
return TRUE;
if ( !PL_get_file_name(A1, &n, 0) ) if ( !PL_get_file_name(A1, &n, 0) )
return FALSE; return FALSE;
@ -662,7 +721,7 @@ PRED_IMPL("delete_file", 1, delete_file, 0)
return TRUE; return TRUE;
return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION,
ATOM_delete, ATOM_file, A1); ATOM_delete, ATOM_file, A1);
} }
@ -799,7 +858,7 @@ has_extension(const char *name, const char *ext)
static int static int
name_too_long() name_too_long(void)
{ return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); { return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
} }
@ -941,6 +1000,7 @@ BeginPredDefs(files)
PRED_DEF("exists_file", 1, exists_file, 0) PRED_DEF("exists_file", 1, exists_file, 0)
PRED_DEF("exists_directory", 1, exists_directory, 0) PRED_DEF("exists_directory", 1, exists_directory, 0)
PRED_DEF("tmp_file", 2, tmp_file, 0) PRED_DEF("tmp_file", 2, tmp_file, 0)
PRED_DEF("tmp_file_stream", 3, tmp_file_stream, 0)
PRED_DEF("delete_file", 1, delete_file, 0) PRED_DEF("delete_file", 1, delete_file, 0)
PRED_DEF("delete_directory", 1, delete_directory, 0) PRED_DEF("delete_directory", 1, delete_directory, 0)
PRED_DEF("make_directory", 1, make_directory, 0) PRED_DEF("make_directory", 1, make_directory, 0)

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

@ -109,8 +109,7 @@ typedef struct {
} prolog_flag; } prolog_flag;
struct struct
{ TempFile _tmpfile_head; { Table tmp_files; /* Known temporary files */
TempFile _tmpfile_tail;
CanonicalDir _canonical_dirlist; CanonicalDir _canonical_dirlist;
char * myhome; /* expansion of ~ */ char * myhome; /* expansion of ~ */
char * fred; /* last expanded ~user */ char * fred; /* last expanded ~user */
@ -123,6 +122,25 @@ typedef struct {
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */ IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
} os; } os;
struct
{ size_t heap; /* heap in use */
size_t atoms; /* No. of atoms defined */
size_t atomspace; /* # bytes used to store atoms */
size_t stack_space; /* # bytes on stacks */
#ifdef O_ATOMGC
size_t atomspacefreed; /* Freed atom-space */
#endif
int functors; /* No. of functors defined */
int predicates; /* No. of predicates defined */
int modules; /* No. of modules in the system */
intptr_t codes; /* No. of byte codes generated */
#ifdef O_PLMT
int threads_created; /* # threads created */
int threads_finished; /* # finished threads */
double thread_cputime; /* Total CPU time of threads */
#endif
} statistics;
struct struct
{ atom_t * array; /* index --> atom */ { atom_t * array; /* index --> atom */
size_t count; /* elements in array */ size_t count; /* elements in array */
@ -136,6 +154,8 @@ extern gds_t gds;
#define GD (&gds) #define GD (&gds)
#define GLOBAL_LD (&gds) #define GLOBAL_LD (&gds)
typedef struct typedef struct
{ unsigned long flags; /* Fast access to some boolean Prolog flags */ { unsigned long flags; /* Fast access to some boolean Prolog flags */
} pl_features_t; } pl_features_t;
@ -280,6 +300,7 @@ typedef struct PL_local_data {
term_t tmp; /* tmp for errors */ term_t tmp; /* tmp for errors */
term_t pending; /* used by the debugger */ term_t pending; /* used by the debugger */
int in_hook; /* inside exception_hook() */ int in_hook; /* inside exception_hook() */
int processing; /* processing an exception */
exception_frame *throw_environment; /* PL_throw() environments */ exception_frame *throw_environment; /* PL_throw() environments */
} exception; } exception;
const char *float_format; /* floating point format */ const char *float_format; /* floating point format */
@ -290,6 +311,8 @@ typedef struct PL_local_data {
} PL_local_data_t; } PL_local_data_t;
#define usedStack(D) 0
#define features (LD->feature.mask) #define features (LD->feature.mask)
extern PL_local_data_t lds; extern PL_local_data_t lds;
@ -586,6 +609,8 @@ extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
/**** stuff from pl-files.c ****/ /**** stuff from pl-files.c ****/
void initFiles(void); void initFiles(void);
int RemoveFile(const char *path);
int PL_get_file_name(term_t n, char **namep, int flags);
/* empty stub */ /* empty stub */
void setPrologFlag(const char *name, int flags, ...); void setPrologFlag(const char *name, int flags, ...);

245
packages/PLStream/pl-os.c
View File

@ -119,7 +119,8 @@ have to be dropped. See the header of pl-incl.h for details.
bool bool
initOs(void) initOs(void)
{ DEBUG(1, Sdprintf("OS:initExpand() ...\n")); { GET_LD
DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
initExpand(); initExpand();
DEBUG(1, Sdprintf("OS:initEnviron() ...\n")); DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
initEnviron(); initEnviron();
@ -409,10 +410,10 @@ setOSPrologFlags(void)
* MEMORY * * MEMORY *
*******************************/ *******************************/
#if __SWI_PROLOG__
uintptr_t uintptr_t
UsedMemory(void) UsedMemory(void)
{ { GET_LD
#if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS) #if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS)
struct rusage usage; struct rusage usage;
@ -427,23 +428,15 @@ UsedMemory(void)
usedStack(local) + usedStack(local) +
usedStack(trail)); usedStack(trail));
} }
#else
uintptr_t
UsedMemory(void)
{
return 0;
}
#endif
uintptr_t uintptr_t
FreeMemory(void) FreeMemory(void)
{ {
#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA) #if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
uintptr_t used = UsedMemory(); uintptr_t used = UsedMemory();
struct rlimit limit; struct rlimit limit;
if ( getrlimit(RLIMIT_DATA, &limit) == 0 ) if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
return limit.rlim_cur - used; return limit.rlim_cur - used;
@ -511,7 +504,9 @@ setRandom(unsigned int *seedp)
uint64_t uint64_t
_PL_Random(void) _PL_Random(void)
{ if ( !LD->os.rand_initialised ) { GET_LD
if ( !LD->os.rand_initialised )
{ setRandom(NULL); { setRandom(NULL);
LD->os.rand_initialised = TRUE; LD->os.rand_initialised = TRUE;
} }
@ -530,9 +525,9 @@ _PL_Random(void)
#else #else
{ uint64_t l = rand(); /* 0<n<2^15-1 */ { uint64_t l = rand(); /* 0<n<2^15-1 */
l ^= rand()<<15; l ^= (uint64_t)rand()<<15;
l ^= rand()<<30; l ^= (uint64_t)rand()<<30;
l ^= rand()<<45; l ^= (uint64_t)rand()<<45;
return l; return l;
} }
@ -552,7 +547,7 @@ available to the Prolog user based on these functions. These functions
are in this module as non-UNIX OS probably don't have getpid() or put are in this module as non-UNIX OS probably don't have getpid() or put
temporaries on /tmp. temporaries on /tmp.
atom_t TemporaryFile(const char *id) atom_t TemporaryFile(const char *id, int *fdp)
The return value of this call is an atom, whose string represents The return value of this call is an atom, whose string represents
the path name of a unique file that can be used as temporary file. the path name of a unique file that can be used as temporary file.
@ -566,14 +561,6 @@ temporaries on /tmp.
not be created at all, or might already have been deleted. not be created at all, or might already have been deleted.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
struct tempfile
{ atom_t name;
TempFile next;
}; /* chain of temporary files */
#define tmpfile_head (GD->os._tmpfile_head)
#define tmpfile_tail (GD->os._tmpfile_tail)
#ifndef DEFTMPDIR #ifndef DEFTMPDIR
#ifdef __WINDOWS__ #ifdef __WINDOWS__
#define DEFTMPDIR "c:/tmp" #define DEFTMPDIR "c:/tmp"
@ -582,22 +569,64 @@ struct tempfile
#endif #endif
#endif #endif
static int
free_tmp_symbol(Symbol s)
{ int rc;
atom_t tname = (atom_t)s->name;
PL_chars_t txt;
get_atom_text(tname, &txt);
PL_mb_text(&txt, REP_FN);
rc = RemoveFile(txt.text.t);
PL_free_text(&txt);
PL_unregister_atom(tname);
return rc;
}
static void
void_free_tmp_symbol(Symbol s)
{ (void)free_tmp_symbol(s);
}
#ifndef O_EXCL
#define O_EXCL 0
#endif
#ifndef O_BINARY
#define O_BINARY 0
#endif
atom_t atom_t
TemporaryFile(const char *id) TemporaryFile(const char *id, int *fdp)
{ char temp[MAXPATHLEN]; { char temp[MAXPATHLEN];
TempFile tf = allocHeap(sizeof(struct tempfile)); static char *tmpdir = NULL;
char envbuf[MAXPATHLEN]; atom_t tname;
char *tmpdir; int retries = 0;
if ( !((tmpdir = Getenv("TEMP", envbuf, sizeof(envbuf))) || if ( !tmpdir )
(tmpdir = Getenv("TMP", envbuf, sizeof(envbuf)))) ) { LOCK();
tmpdir = DEFTMPDIR; if ( !tmpdir )
{ char envbuf[MAXPATHLEN];
char *td;
if ( (td = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
(td = Getenv("TMP", envbuf, sizeof(envbuf))) )
tmpdir = strdup(td);
else
tmpdir = DEFTMPDIR;
}
UNLOCK();
}
retry:
#ifdef __unix__ #ifdef __unix__
{ static int MTOK_temp_counter = 0; { static int MTOK_temp_counter = 0;
const char *sep = id[0] ? "_" : "";
Ssprintf(temp, "%s/pl_%s_%d_%d", Ssprintf(temp, "%s/pl_%s%s%d_%d",
tmpdir, id, (int) getpid(), MTOK_temp_counter++); tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++);
} }
#endif #endif
@ -612,49 +641,74 @@ TemporaryFile(const char *id)
#endif #endif
{ PrologPath(tmp, temp, sizeof(temp)); { PrologPath(tmp, temp, sizeof(temp));
} else } else
Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++); { const char *sep = id[0] ? "_" : "";
}
#endif
#if EMX Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++);
static int temp_counter = 0;
char *foo;
if ( (foo = tempnam(".", (const char *)id)) )
{ strcpy(temp, foo);
free(foo);
} else
Ssprintf(temp, "pl_%s_%d_%d", id, getpid(), temp_counter++);
#endif
tf->name = PL_new_atom(temp); /* locked: ok! */
tf->next = NULL;
startCritical;
if ( !tmpfile_tail )
{ tmpfile_head = tmpfile_tail = tf;
} else
{ tmpfile_tail->next = tf;
tmpfile_tail = tf;
} }
endCritical;
return tf->name;
} }
#endif
if ( fdp )
{ int fd;
if ( (fd=open(temp, O_CREAT|O_EXCL|O_WRONLY|O_BINARY, 0600)) < 0 )
{ if ( ++retries < 10000 )
goto retry;
else
return NULL_ATOM;
}
*fdp = fd;
}
tname = PL_new_atom(temp); /* locked: ok! */
LOCK();
if ( !GD->os.tmp_files )
{ GD->os.tmp_files = newHTable(4);
GD->os.tmp_files->free_symbol = void_free_tmp_symbol;
}
UNLOCK();
addHTable(GD->os.tmp_files, (void*)tname, (void*)TRUE);
return tname;
}
int
DeleteTemporaryFile(atom_t name)
{ int rc = FALSE;
if ( GD->os.tmp_files )
{ LOCK();
if ( GD->os.tmp_files && GD->os.tmp_files->size > 0 )
{ Symbol s = lookupHTable(GD->os.tmp_files, (void*)name);
if ( s )
{ rc = free_tmp_symbol(s);
deleteSymbolHTable(GD->os.tmp_files, s);
}
}
UNLOCK();
}
return rc;
}
void void
RemoveTemporaryFiles(void) RemoveTemporaryFiles(void)
{ TempFile tf, tf2; { LOCK();
if ( GD->os.tmp_files )
{ Table t = GD->os.tmp_files;
startCritical; GD->os.tmp_files = NULL;
for(tf = tmpfile_head; tf; tf = tf2) UNLOCK();
{ RemoveFile(stringAtom(tf->name)); destroyHTable(t);
tf2 = tf->next; } else
freeHeap(tf, sizeof(struct tempfile)); { UNLOCK();
} }
tmpfile_head = tmpfile_tail = NULL;
endCritical;
} }
@ -756,7 +810,8 @@ OsPath(const char *p, char *buf)
#if O_XOS #if O_XOS
char * char *
PrologPath(const char *p, char *buf, size_t len) PrologPath(const char *p, char *buf, size_t len)
{ int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE); { GET_LD
int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
return _xos_canonical_filename(p, buf, len, flags); return _xos_canonical_filename(p, buf, len, flags);
} }
@ -813,7 +868,7 @@ forwards char *canoniseDir(char *);
static void static void
initExpand(void) initExpand(void)
{ { GET_LD
#ifdef O_CANONISE_DIRS #ifdef O_CANONISE_DIRS
char *dir; char *dir;
char *cpaths; char *cpaths;
@ -923,6 +978,7 @@ verify_entry(CanonicalDir d)
d->inode = buf.st_ino; d->inode = buf.st_ino;
d->device = buf.st_dev; d->device = buf.st_dev;
return TRUE;
} else } else
{ DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical)); { DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical));
@ -939,6 +995,9 @@ verify_entry(CanonicalDir d)
} }
} }
remove_string(d->name);
if ( d->canonical != d->name )
remove_string(d->canonical);
free(d); free(d);
} }
@ -1139,7 +1198,9 @@ utf8_strlwr(char *s)
char * char *
canonisePath(char *path) canonisePath(char *path)
{ if ( !truePrologFlag(PLFLAG_FILE_CASE) ) { GET_LD
if ( !truePrologFlag(PLFLAG_FILE_CASE) )
utf8_strlwr(path); utf8_strlwr(path);
canoniseFileName(path); canoniseFileName(path);
@ -1186,7 +1247,8 @@ takeWord(const char **string, char *wrd, int maxlen)
bool bool
expandVars(const char *pattern, char *expanded, int maxlen) expandVars(const char *pattern, char *expanded, int maxlen)
{ int size = 0; { GET_LD
int size = 0;
char wordbuf[MAXPATHLEN]; char wordbuf[MAXPATHLEN];
if ( *pattern == '~' ) if ( *pattern == '~' )
@ -1338,7 +1400,8 @@ ExpandFile(const char *pattern, char **vector)
char * char *
ExpandOneFile(const char *spec, char *file) ExpandOneFile(const char *spec, char *file)
{ char *vector[256]; { GET_LD
char *vector[256];
int size; int size;
switch( (size=ExpandFile(spec, vector)) ) switch( (size=ExpandFile(spec, vector)) )
@ -1437,10 +1500,13 @@ IsAbsolutePath(const char *p)
char * char *
AbsoluteFile(const char *spec, char *path) AbsoluteFile(const char *spec, char *path)
{ char tmp[MAXPATHLEN]; { GET_LD
char tmp[MAXPATHLEN];
char buf[MAXPATHLEN]; char buf[MAXPATHLEN];
char *file = PrologPath(spec, buf, sizeof(buf)); char *file = PrologPath(spec, buf, sizeof(buf));
if ( !file )
return (char *) NULL;
if ( truePrologFlag(PLFLAG_FILEVARS) ) if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(file = ExpandOneFile(buf, tmp)) ) { if ( !(file = ExpandOneFile(buf, tmp)) )
return (char *) NULL; return (char *) NULL;
@ -1485,7 +1551,9 @@ AbsoluteFile(const char *spec, char *path)
void void
PL_changed_cwd(void) PL_changed_cwd(void)
{ if ( CWDdir ) { GET_LD
if ( CWDdir )
remove_string(CWDdir); remove_string(CWDdir);
CWDdir = NULL; CWDdir = NULL;
CWDlen = 0; CWDlen = 0;
@ -1494,7 +1562,9 @@ PL_changed_cwd(void)
const char * const char *
PL_cwd(void) PL_cwd(void)
{ if ( CWDlen == 0 ) { GET_LD
if ( CWDlen == 0 )
{ char buf[MAXPATHLEN]; { char buf[MAXPATHLEN];
char *rval; char *rval;
@ -1583,7 +1653,8 @@ DirName(const char *f, char *dir)
bool bool
ChDir(const char *path) ChDir(const char *path)
{ char ospath[MAXPATHLEN]; { GET_LD
char ospath[MAXPATHLEN];
char tmp[MAXPATHLEN]; char tmp[MAXPATHLEN];
OsPath(path, ospath); OsPath(path, ospath);
@ -1681,7 +1752,8 @@ ResetStdin(void)
static ssize_t static ssize_t
Sread_terminal(void *handle, char *buf, size_t size) Sread_terminal(void *handle, char *buf, size_t size)
{ intptr_t h = (intptr_t)handle; { GET_LD
intptr_t h = (intptr_t)handle;
int fd = (int)h; int fd = (int)h;
source_location oldsrc = LD->read_source; source_location oldsrc = LD->read_source;
@ -1708,7 +1780,8 @@ Sread_terminal(void *handle, char *buf, size_t size)
void void
ResetTty() ResetTty()
{ startCritical; { GET_LD
startCritical;
ResetStdin(); ResetStdin();
if ( !GD->os.iofunctions.read ) if ( !GD->os.iofunctions.read )
@ -1736,7 +1809,8 @@ ResetTty()
bool bool
PushTty(IOSTREAM *s, ttybuf *buf, int mode) PushTty(IOSTREAM *s, ttybuf *buf, int mode)
{ struct termios tio; { GET_LD
struct termios tio;
int fd; int fd;
buf->mode = ttymode; buf->mode = ttymode;
@ -1803,7 +1877,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool bool
PopTty(IOSTREAM *s, ttybuf *buf) PopTty(IOSTREAM *s, ttybuf *buf)
{ int fd; { GET_LD
int fd;
ttymode = buf->mode; ttymode = buf->mode;
if ( (fd = Sfileno(s)) < 0 || !isatty(fd) ) if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
@ -1898,7 +1973,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool bool
PopTty(IOSTREAM *s, ttybuf *buf) PopTty(IOSTREAM *s, ttybuf *buf)
{ ttymode = buf->mode; { GET_LD
ttymode = buf->mode;
if ( ttymode != TTY_RAW ) if ( ttymode != TTY_RAW )
LD->prompt.next = TRUE; LD->prompt.next = TRUE;
@ -2204,7 +2280,8 @@ argument to wait()
int int
System(char *cmd) System(char *cmd)
{ int pid; { GET_LD
int pid;
char *shell = "/bin/sh"; char *shell = "/bin/sh";
int rval; int rval;
void (*old_int)(); void (*old_int)();

5
packages/PLStream/pl-os.h
View File

@ -245,8 +245,9 @@ extern char *Getenv(const char *, char *buf, size_t buflen);
extern char *BaseName(const char *f); extern char *BaseName(const char *f);
extern time_t LastModifiedFile(const char *f); extern time_t LastModifiedFile(const char *f);
extern bool ExistsFile(const char *path); extern bool ExistsFile(const char *path);
extern atom_t TemporaryFile(const char *id); extern atom_t TemporaryFile(const char *id, int *fdp);
extern int RemoveFile(const char *path); extern atom_t TemporaryFile(const char *id, int *fdp);
extern int DeleteTemporaryFile(atom_t name);
extern bool ChDir(const char *path); extern bool ChDir(const char *path);
extern char *PrologPath(const char *ospath, char *path, size_t len); extern char *PrologPath(const char *ospath, char *path, size_t len);

191
packages/PLStream/pl-text.c
View File

@ -93,16 +93,40 @@ PL_save_text(PL_chars_t *text, int flags)
addMultipleBuffer(b, text->text.t, bl, char); addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char); text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING; text->storage = PL_CHARS_RING;
} }
} }
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PL_from_stack_text() moves a string from the stack, so it won't get
corrupted if GC/shift comes along.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
PL_from_stack_text(PL_chars_t *text)
{ if ( text->storage == PL_CHARS_STACK )
{ size_t bl = bufsize_text(text, text->length+1);
if ( bl < sizeof(text->buf) )
{ memcpy(text->buf, text->text.t, bl);
text->text.t = text->buf;
text->storage = PL_CHARS_LOCAL;
} else
{ Buffer b = findBuffer(BUF_RING);
addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING;
}
}
}
int int
PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD) PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
{ { word w = valHandle(l);
Word w = valHandle(l);
if ( (flags & CVT_ATOM) && isAtom(w) ) if ( (flags & CVT_ATOM) && isAtom(w) )
{ if ( !get_atom_text(w, text) ) { if ( !get_atom_text(w, text) )
@ -110,6 +134,7 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
} else if ( (flags & CVT_STRING) && isString(w) ) } else if ( (flags & CVT_STRING) && isString(w) )
{ if ( !get_string_text(w, text PASS_LD) ) { if ( !get_string_text(w, text PASS_LD) )
goto maybe_write; goto maybe_write;
PL_from_stack_text(text);
} else if ( (flags & CVT_INTEGER) && isInteger(w) ) } else if ( (flags & CVT_INTEGER) && isInteger(w) )
{ number n; { number n;
@ -141,8 +166,8 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
} }
text->encoding = ENC_ISO_LATIN_1; text->encoding = ENC_ISO_LATIN_1;
text->canonical = TRUE; text->canonical = TRUE;
} else if ( (flags & CVT_FLOAT) && isReal(w) ) } else if ( (flags & CVT_FLOAT) && isFloat(w) )
{ format_float(valReal(w), text->buf, LD->float_format); { format_float(valFloat(w), text->buf, LD->float_format);
text->text.t = text->buf; text->text.t = text->buf;
text->length = strlen(text->text.t); text->length = strlen(text->text.t);
text->encoding = ENC_ISO_LATIN_1; text->encoding = ENC_ISO_LATIN_1;
@ -182,11 +207,11 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
encodings[0] = ENC_ISO_LATIN_1; encodings[0] = ENC_ISO_LATIN_1;
encodings[1] = ENC_WCHAR; encodings[1] = ENC_WCHAR;
encodings[2] = ENC_UNKNOWN; encodings[2] = ENC_UNKNOWN;
for(enc = encodings; *enc != ENC_UNKNOWN; enc++) for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
{ size_t size; { size_t size;
IOSTREAM *fd; IOSTREAM *fd;
r = text->buf; r = text->buf;
size = sizeof(text->buf); size = sizeof(text->buf);
fd = Sopenmem(&r, &size, "w"); fd = Sopenmem(&r, &size, "w");
@ -228,6 +253,9 @@ maybe_write:
goto case_write; goto case_write;
error: error:
if ( canBind(w) && (flags & CVT_VARNOFAIL) )
return 2;
if ( (flags & CVT_EXCEPTION) ) if ( (flags & CVT_EXCEPTION) )
{ atom_t expected; { atom_t expected;
@ -237,7 +265,7 @@ error:
expected = ATOM_atomic; expected = ATOM_atomic;
else else
expected = ATOM_atom; expected = ATOM_atom;
return PL_error(NULL, 0, NULL, ERR_TYPE, expected, l); return PL_error(NULL, 0, NULL, ERR_TYPE, expected, l);
} }
@ -277,7 +305,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
{ case PL_ATOM: { case PL_ATOM:
{ atom_t a = textToAtom(text); { atom_t a = textToAtom(text);
int rval = _PL_unify_atomic(term, a); int rval = _PL_unify_atomic(term, a);
PL_unregister_atom(a); PL_unregister_atom(a);
return rval; return rval;
} }
@ -285,7 +313,10 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
#if __SWI_PROLOG__ #if __SWI_PROLOG__
{ word w = textToString(text); { word w = textToString(text);
return _PL_unify_atomic(term, w); if ( w )
return _PL_unify_atomic(term, w);
else
return FALSE;
} }
#endif #endif
case PL_CODE_LIST: case PL_CODE_LIST:
@ -300,35 +331,40 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
} }
} else } else
{ GET_LD { GET_LD
word p0, p; term_t l = PL_new_term_ref();
Word p0, p;
switch(text->encoding) switch(text->encoding)
{ case ENC_ISO_LATIN_1: { case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char *)text->text.t; { const unsigned char *s = (const unsigned char *)text->text.t;
const unsigned char *e = &s[text->length]; const unsigned char *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length); if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
if ( type == PL_CODE_LIST ) { return FALSE;
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s); if ( type == PL_CODE_LIST ) {
} else { for( ; s < e; s++)
for( ; s < e; s++) p = EXTEND_SEQ_CODES(p, *s);
p = EXTEND_SEQ_ATOMS(p, *s); } else {
} for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break; break;
} }
case ENC_WCHAR: case ENC_WCHAR:
{ const pl_wchar_t *s = (const pl_wchar_t *)text->text.t; { const pl_wchar_t *s = (const pl_wchar_t *)text->text.t;
const pl_wchar_t *e = &s[text->length]; const pl_wchar_t *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length); if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
if ( type == PL_CODE_LIST ) { return FALSE;
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s); if ( type == PL_CODE_LIST ) {
} else { for( ; s < e; s++)
for( ; s < e; s++) p = EXTEND_SEQ_CODES(p, *s);
p = EXTEND_SEQ_ATOMS(p, *s); } else {
} for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break; break;
} }
case ENC_UTF8: case ENC_UTF8:
@ -336,22 +372,24 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
const char *e = &s[text->length]; const char *e = &s[text->length];
size_t len = utf8_strlen(s, text->length); size_t len = utf8_strlen(s, text->length);
p0 = p = INIT_SEQ_CODES(len); if ( !(p0 = p = INIT_SEQ_CODES(len)) )
if ( type == PL_CODE_LIST ) { return FALSE;
while (s < e) {
int chr; if ( type == PL_CODE_LIST ) {
while (s < e) {
s = utf8_get_char(s, &chr); int chr;
p = EXTEND_SEQ_CODES(p, chr);
} s = utf8_get_char(s, &chr);
} else { p = EXTEND_SEQ_CODES(p, chr);
while (s < e) { }
int chr; } else {
while (s < e) {
s = utf8_get_char(s, &chr); int chr;
p = EXTEND_SEQ_ATOMS(p, chr);
} s = utf8_get_char(s, &chr);
} p = EXTEND_SEQ_ATOMS(p, chr);
}
}
break; break;
} }
case ENC_ANSI: case ENC_ANSI:
@ -367,18 +405,21 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
n -= rc; n -= rc;
s += rc; s += rc;
} }
p0 = p = INIT_SEQ_CODES(len);
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
return FALSE;
memset(&mbs, 0, sizeof(mbs)); memset(&mbs, 0, sizeof(mbs));
n = text->length; n = text->length;
while(n > 0) { while(n > 0)
rc = mbrtowc(&wc, s, n, &mbs); { rc = mbrtowc(&wc, s, n, &mbs);
if ( type == PL_CODE_LIST ) if ( type == PL_CODE_LIST )
p = EXTEND_SEQ_CODES(p, wc); p = EXTEND_SEQ_CODES(p, wc);
else else
p = EXTEND_SEQ_ATOMS(p, wc); p = EXTEND_SEQ_ATOMS(p, wc);
s += rc; s += rc;
n -= rc; n -= rc;
} }
@ -391,7 +432,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
} }
} }
return CLOSE_SEQ_OF_CODES(p, p0, tail, term ); return CLOSE_SEQ_OF_CODES(p, p0, tail, term, l );
} }
} }
default: default:
@ -430,7 +471,7 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
rc = PL_unify_text(term, 0, &sub, type); rc = PL_unify_text(term, 0, &sub, type);
PL_free_text(&sub); PL_free_text(&sub);
return rc; return rc;
} }
} }
@ -458,7 +499,7 @@ PL_promote_text(PL_chars_t *text)
PL_free(text->text.t); PL_free(text->text.t);
text->text.w = new; text->text.w = new;
text->encoding = ENC_WCHAR; text->encoding = ENC_WCHAR;
} else if ( text->storage == PL_CHARS_LOCAL && } else if ( text->storage == PL_CHARS_LOCAL &&
(text->length+1)*sizeof(pl_wchar_t) < sizeof(text->buf) ) (text->length+1)*sizeof(pl_wchar_t) < sizeof(text->buf) )
@ -512,7 +553,7 @@ PL_demote_text(PL_chars_t *text)
PL_free(text->text.t); PL_free(text->text.t);
text->text.t = new; text->text.t = new;
text->encoding = ENC_ISO_LATIN_1; text->encoding = ENC_ISO_LATIN_1;
} else if ( text->storage == PL_CHARS_LOCAL ) } else if ( text->storage == PL_CHARS_LOCAL )
{ pl_wchar_t buf[sizeof(text->buf)/sizeof(pl_wchar_t)]; { pl_wchar_t buf[sizeof(text->buf)/sizeof(pl_wchar_t)];
@ -601,7 +642,7 @@ utf8tobuffer(wchar_t c, Buffer buf)
{ char b[6]; { char b[6];
char *e = b; char *e = b;
const char *s; const char *s;
e = utf8_put_char(e, c); e = utf8_put_char(e, c);
for(s=b; s<e; s++) for(s=b; s<e; s++)
addBuffer(buf, *s, char); addBuffer(buf, *s, char);
@ -617,7 +658,7 @@ PL_mb_text(PL_chars_t *text, int flags)
if ( text->encoding != target ) if ( text->encoding != target )
{ Buffer b = findBuffer(BUF_RING); { Buffer b = findBuffer(BUF_RING);
switch(text->encoding) switch(text->encoding)
{ case ENC_ISO_LATIN_1: { case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char*)text->text.t; { const unsigned char *s = (const unsigned char*)text->text.t;
@ -658,7 +699,7 @@ PL_mb_text(PL_chars_t *text, int flags)
addBuffer(b, 0, char); addBuffer(b, 0, char);
} else /* if ( target == ENC_MB ) */ } else /* if ( target == ENC_MB ) */
{ mbstate_t mbs; { mbstate_t mbs;
memset(&mbs, 0, sizeof(mbs)); memset(&mbs, 0, sizeof(mbs));
for( ; w<e; w++) for( ; w<e; w++)
{ if ( !wctobuffer(*w, &mbs, b) ) { if ( !wctobuffer(*w, &mbs, b) )
@ -692,7 +733,7 @@ rep_error:
sprintf(msg, sprintf(msg,
"Cannot represent char U%04x using %s encoding", "Cannot represent char U%04x using %s encoding",
norep, norep,
target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale"); target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale");
return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding); return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding);
@ -711,7 +752,7 @@ PL_canonise_text(PL_chars_t *text)
case ENC_WCHAR: case ENC_WCHAR:
{ const pl_wchar_t *w = (const pl_wchar_t*)text->text.w; { const pl_wchar_t *w = (const pl_wchar_t*)text->text.w;
const pl_wchar_t *e = &w[text->length]; const pl_wchar_t *e = &w[text->length];
for(; w<e; w++) for(; w<e; w++)
{ if ( *w > 0xff ) { if ( *w > 0xff )
return FALSE; return FALSE;
@ -1013,7 +1054,7 @@ PL_cmp_text(PL_chars_t *t1, size_t o1, PL_chars_t *t2, size_t o2,
return ifeq; return ifeq;
else else
return *s > *q ? 1 : -1; return *s > *q ? 1 : -1;
} }
} }
@ -1098,35 +1139,3 @@ Sopen_text(PL_chars_t *txt, const char *mode)
return stream; return stream;
} }
int
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text;
term_t tail;
int rc;
if ( len == (size_t)-1 )
len = strlen(s);
text.text.t = (char *)s;
text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \
(flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1);
text.storage = PL_CHARS_HEAP;
text.length = len;
text.canonical = FALSE;
flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1);
if ( (flags & PL_DIFF_LIST) )
{ tail = t+1;
flags &= (~PL_DIFF_LIST);
} else
{ tail = 0;
}
rc = PL_unify_text(t, tail, &text, flags);
PL_free_text(&text);
return rc;
}

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

@ -250,7 +250,7 @@ scan_options(term_t options, int flags, atom_t optype,
term_t val = PL_new_term_ref(); term_t val = PL_new_term_ref();
int n; int n;
if ( trueFeature(ISO_FEATURE) ) if ( truePrologFlag(PLFLAG_ISO) )
flags |= OPT_ALL; flags |= OPT_ALL;
va_start(args, specs); va_start(args, specs);

7
packages/PLStream/pl-yap.h
View File

@ -148,7 +148,7 @@ EXTEND_SEQ_ATOMS(word gstore, int c) {
} }
static inline int static inline int
CLOSE_SEQ_OF_CODES(word gstore, word lp, word arg2, word arg3) { CLOSE_SEQ_OF_CODES(word gstore, word lp, word arg2, word arg3, term_t l) {
if (arg3 == (word)ATOM_nil) { if (arg3 == (word)ATOM_nil) {
if (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil())) if (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil()))
return FALSE; return FALSE;
@ -172,14 +172,17 @@ valHandle(term_t tt)
#define isAtom(A) YAP_IsAtomTerm((A)) #define isAtom(A) YAP_IsAtomTerm((A))
#define isList(A) YAP_IsPairTerm((A)) #define isList(A) YAP_IsPairTerm((A))
#define isNil(A) ((A) == YAP_TermNil()) #define isNil(A) ((A) == YAP_TermNil())
#define isReal(A)YAP_IsFloatTerm((A)) #define isReal(A) YAP_IsFloatTerm((A))
#define isFloat(A) YAP_IsFloatTerm((A))
#define isVar(A) YAP_IsVarTerm((A)) #define isVar(A) YAP_IsVarTerm((A))
#define varName(l, buf) buf #define varName(l, buf) buf
#define valReal(w) YAP_FloatOfTerm((w)) #define valReal(w) YAP_FloatOfTerm((w))
#define valFloat(w) YAP_FloatOfTerm((w))
#define AtomLength(w) YAP_AtomNameLength(w) #define AtomLength(w) YAP_AtomNameLength(w)
#define atomValue(atom) ((YAP_Atom)atom) #define atomValue(atom) ((YAP_Atom)atom)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i)))) #define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) (t = YAP_Deref(t)) #define deRef(t) (t = YAP_Deref(t))
#define canBind(t) FALSE
#define clearNumber(n) #define clearNumber(n)