Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6
This commit is contained in:
Ricardo Rocha
commit
42b07768d6
|
|
@ -14297,11 +14297,11 @@ Yap_absmi(int inp)
|
|||
goto creep;
|
||||
}
|
||||
UNLOCK(SignalLock);
|
||||
saveregs();
|
||||
saveregs_and_ycache();
|
||||
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, Osbpp))) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
|
||||
}
|
||||
setregs();
|
||||
setregs_and_ycache();
|
||||
goto execute_after_comma;
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
|
||||
|
|
|
|||
|
|
@ -4631,6 +4631,7 @@ p_instance(void)
|
|||
if (IsVarTerm(t2)) {
|
||||
Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity)));
|
||||
} else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
|
||||
UNLOCK(ap->PELock);
|
||||
return FALSE;
|
||||
}
|
||||
ptr = RepAppl(t2)+1;
|
||||
|
|
|
|||
24
C/exec.c
24
C/exec.c
|
|
@ -782,25 +782,17 @@ p_execute_nonstop(void)
|
|||
}
|
||||
/* N = arity; */
|
||||
/* 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 (ActiveSignals & YAP_CREEP_SIGNAL && !Yap_InterruptsDisabled) {
|
||||
Yap_signal(YAP_CREEP_SIGNAL);
|
||||
}
|
||||
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
|
||||
} else if ((RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) &&
|
||||
RepPredProp(pe)->OpcodeOfPred != Yap_opcode(_call_bfunc_xx)) {
|
||||
/* USER C-Code may walk over registers */
|
||||
if (RepPredProp(pe)->PredFlags & UserCPredFlag) {
|
||||
save_machine_regs();
|
||||
} else { if (ActiveSignals & YAP_CREEP_SIGNAL &&
|
||||
!Yap_InterruptsDisabled &&
|
||||
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) ||
|
||||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
12
C/index.c
12
C/index.c
|
|
@ -3450,15 +3450,17 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
|
|||
if (cls->u.t_ptr != sp->extra) break;
|
||||
} else {
|
||||
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
|
||||
Term t = MkIntTerm(pt[1]^pt[2]),
|
||||
t1 = MkIntTerm(pt1[1]^pt1[2]);
|
||||
Term t = MkIntTerm(pt[1]^pt[2]),
|
||||
t1 = MkIntTerm(pt1[1]^pt1[2]);
|
||||
#else
|
||||
Term t = MkIntTerm(pt[1]),
|
||||
t1 = MkIntTerm(pt1[1]);
|
||||
Term t = MkIntTerm(pt[1]),
|
||||
t1 = MkIntTerm(pt1[1]);
|
||||
#endif
|
||||
if (t != t1) break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2164,8 +2164,13 @@ check_bom(int sno, StreamDesc *st)
|
|||
int ch;
|
||||
|
||||
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;
|
||||
}
|
||||
switch(ch) {
|
||||
case 0xFE:
|
||||
{
|
||||
|
|
|
|||
|
|
@ -499,7 +499,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
|
|||
if (func == NULL) {
|
||||
Yap_ErrorMessage = "Heap Overflow";
|
||||
FAIL;
|
||||
}
|
||||
}
|
||||
t = ParseTerm(oprprio, FailBuff);
|
||||
t = Yap_MkApplTerm(func, 1, &t);
|
||||
/* check for possible overflow against local stack */
|
||||
|
|
|
|||
|
|
@ -63,6 +63,7 @@
|
|||
AtomDBTerm = Yap_LookupAtom("db_term");
|
||||
AtomDBref = Yap_FullLookupAtom("$dbref");
|
||||
AtomDInteger = Yap_FullLookupAtom("$integer");
|
||||
AtomDOUBLE = Yap_FullLookupAtom("Double");
|
||||
AtomDec10 = Yap_LookupAtom("dec10");
|
||||
AtomDefault = Yap_LookupAtom("default");
|
||||
AtomDevNull = Yap_LookupAtom("/dev/null");
|
||||
|
|
|
|||
|
|
@ -185,6 +185,7 @@ typedef void *PL_engine_t;
|
|||
#define CVT_MASK 0x00ff
|
||||
|
||||
#define CVT_EXCEPTION 0x10000
|
||||
#define CVT_VARNOFAIL 0x20000 /* return 2 if argument is unbound */
|
||||
|
||||
#define BUF_DISCARDABLE 0x0000
|
||||
#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 fid_t PL_open_foreign_frame(void);
|
||||
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_unregister_atom(atom_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 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 int PL_call_predicate(module_t, int, predicate_t, term_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);
|
||||
|
|
@ -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_get_string_chars(term_t, char **, int *);
|
||||
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 int PL_action(int,...);
|
||||
extern X_API void *PL_malloc(int);
|
||||
|
|
|
|||
|
|
@ -205,7 +205,7 @@ sysmktime(void)
|
|||
loc.tm_hour = YAP_IntOfTerm(YAP_ARG4);
|
||||
loc.tm_min = YAP_IntOfTerm(YAP_ARG5);
|
||||
loc.tm_sec = YAP_IntOfTerm(YAP_ARG6);
|
||||
loc.tm_isdst = daylight;
|
||||
loc.tm_isdst = -1;
|
||||
|
||||
if ((tim = mktime(&loc)) == (time_t)-1) {
|
||||
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
|
||||
|
|
|
|||
|
|
@ -1858,11 +1858,14 @@ PL_record(term_t ts)
|
|||
return (record_t)Yap_StoreTermInDB(t, 0);
|
||||
}
|
||||
|
||||
X_API void
|
||||
X_API int
|
||||
PL_recorded(record_t db, term_t ts)
|
||||
{
|
||||
Term t = Yap_FetchTermFromDB((DBTerm *)db);
|
||||
if (t == 0L)
|
||||
return FALSE;
|
||||
Yap_PutInSlot(ts,t);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
X_API void
|
||||
|
|
@ -1959,6 +1962,12 @@ PL_exception(qid_t q)
|
|||
}
|
||||
}
|
||||
|
||||
X_API void
|
||||
PL_clear_exception(void)
|
||||
{
|
||||
EX = 0L;
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_initialise(int myargc, char **myargv)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ A DBReference N "db_reference"
|
|||
A DBTerm N "db_term"
|
||||
A DBref F "$dbref"
|
||||
A DInteger F "$integer"
|
||||
A DOUBLE A "Double"
|
||||
A DOUBLE F "Double"
|
||||
A Dec10 N "dec10"
|
||||
A Default N "default"
|
||||
A DevNull N "/dev/null"
|
||||
|
|
|
|||
|
|
@ -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-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 \
|
||||
$(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-privitf.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-utils.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-stream.o pl-string.o pl-table.o \
|
||||
pl-text.o pl-utils.o pl-utf8.o \
|
||||
|
|
|
|||
|
|
@ -504,6 +504,7 @@
|
|||
#define ATOM_term_position MK_ATOM("term_position")
|
||||
#define ATOM_terminal MK_ATOM("terminal")
|
||||
#define ATOM_terminal_capability MK_ATOM("terminal_capability")
|
||||
#define ATOM_temporary_files MK_ATOM("temporary_files")
|
||||
#define ATOM_text MK_ATOM("text")
|
||||
#define ATOM_thread MK_ATOM("thread")
|
||||
#define ATOM_thread_cputime MK_ATOM("thread_cputime")
|
||||
|
|
|
|||
|
|
@ -298,7 +298,8 @@ unify_char_type(term_t type, const char_type *ct, int context, int how)
|
|||
|
||||
static foreign_t
|
||||
do_char_type(term_t chr, term_t class, control_t h, int how)
|
||||
{ generator *gen;
|
||||
{ GET_LD
|
||||
generator *gen;
|
||||
fid_t fid;
|
||||
|
||||
switch( ForeignControl(h) )
|
||||
|
|
@ -399,7 +400,9 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
|
|||
succeed;
|
||||
}
|
||||
|
||||
fid = PL_open_foreign_frame();
|
||||
if ( !(fid = PL_open_foreign_frame()) )
|
||||
goto error;
|
||||
|
||||
for(;;)
|
||||
{ int rval;
|
||||
|
||||
|
|
@ -412,7 +415,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
|
|||
{ if ( rval < 0 ||
|
||||
!unify_char_type(class, gen->class, rval, how) )
|
||||
goto next;
|
||||
|
||||
|
||||
} else if ( gen->do_enum & ENUM_CLASS )
|
||||
{ if ( !unify_char_type(class, gen->class, rval, how) )
|
||||
goto next;
|
||||
|
|
@ -432,6 +435,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
|
|||
break;
|
||||
}
|
||||
|
||||
error:
|
||||
freeHeap(gen, sizeof(*gen));
|
||||
fail;
|
||||
}
|
||||
|
|
@ -440,13 +444,13 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
|
|||
|
||||
static
|
||||
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
|
||||
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
|
||||
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) )
|
||||
return FALSE;
|
||||
|
|
@ -578,7 +583,7 @@ modify_case_atom(term_t in, term_t out, int down)
|
|||
{ tout.text.t[i] = (char)c;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
} else
|
||||
{ if ( down )
|
||||
{ for(i=0; i<tin.length; i++)
|
||||
|
|
@ -619,7 +624,8 @@ PRED_IMPL("upcase_atom", 2, upcase_atom, 0)
|
|||
|
||||
static int
|
||||
write_normalize_space(IOSTREAM *out, term_t in)
|
||||
{ PL_chars_t tin;
|
||||
{ GET_LD
|
||||
PL_chars_t tin;
|
||||
size_t i, end;
|
||||
|
||||
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;
|
||||
word rc;
|
||||
|
||||
EXCEPTION_GUARDED(/*code*/
|
||||
if ( setupOutputRedirect(A1, &ctx, FALSE) )
|
||||
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
|
||||
rc = closeOutputRedirect(&ctx);
|
||||
else
|
||||
discardOutputRedirect(&ctx);
|
||||
} else
|
||||
rc = FALSE;
|
||||
/*cleanup*/,
|
||||
DEBUG(1, Sdprintf("Cleanup after throw()\n"));
|
||||
discardOutputRedirect(&ctx);
|
||||
rc = PL_rethrow(););
|
||||
if ( (rc = setupOutputRedirect(A1, &ctx, FALSE)) )
|
||||
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
|
||||
rc = closeOutputRedirect(&ctx);
|
||||
else
|
||||
discardOutputRedirect(&ctx);
|
||||
}
|
||||
|
||||
return rc;
|
||||
}
|
||||
|
|
@ -730,7 +730,8 @@ static lccat lccats[] =
|
|||
|
||||
static
|
||||
PRED_IMPL("setlocale", 3, setlocale, 0)
|
||||
{ char *what;
|
||||
{ PRED_LD
|
||||
char *what;
|
||||
char *locale;
|
||||
const lccat *lcp;
|
||||
|
||||
|
|
@ -794,28 +795,28 @@ EndPredDefs
|
|||
|
||||
const char _PL_char_types[] = {
|
||||
/* ^@ ^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 */
|
||||
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, 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 */
|
||||
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 */
|
||||
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 */
|
||||
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 */
|
||||
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 */
|
||||
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) */
|
||||
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) */
|
||||
/* ISO Latin 1 is assumed */
|
||||
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, 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,
|
||||
|
|
@ -840,7 +841,9 @@ static const enc_map map[] =
|
|||
|
||||
IOENC
|
||||
initEncoding(void)
|
||||
{ if ( LD )
|
||||
{ GET_LD
|
||||
|
||||
if ( LD )
|
||||
{ if ( !LD->encoding )
|
||||
{ char *enc;
|
||||
|
||||
|
|
@ -882,7 +885,8 @@ initCharTypes(void)
|
|||
#if __SWI_PROLOG__
|
||||
bool
|
||||
systemMode(bool accept)
|
||||
{ bool old = SYSTEM_MODE ? TRUE : FALSE;
|
||||
{ GET_LD
|
||||
bool old = SYSTEM_MODE ? TRUE : FALSE;
|
||||
|
||||
if ( accept )
|
||||
debugstatus.styleCheck |= DOLLAR_STYLE;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
@ -69,7 +69,7 @@ handling times must be cleaned, but that not only holds for this module.
|
|||
#undef LD /* fetch LD once per function */
|
||||
#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 streamStatus(IOSTREAM *s);
|
||||
|
|
@ -261,9 +261,13 @@ freeStream(IOSTREAM *s)
|
|||
if ( (symb=lookupHTable(streamContext, s)) )
|
||||
{ stream_context *ctx = symb->value;
|
||||
|
||||
if ( ctx->filename == source_file_name )
|
||||
{ source_file_name = NULL_ATOM; /* TBD: pop? */
|
||||
source_line_no = -1;
|
||||
if ( ctx->filename != NULL_ATOM )
|
||||
{ PL_unregister_atom(ctx->filename);
|
||||
|
||||
if ( ctx->filename == source_file_name )
|
||||
{ source_file_name = NULL_ATOM; /* TBD: pop? */
|
||||
source_line_no = -1;
|
||||
}
|
||||
}
|
||||
|
||||
freeHeap(ctx, sizeof(*ctx));
|
||||
|
|
@ -289,10 +293,18 @@ freeStream(IOSTREAM *s)
|
|||
|
||||
|
||||
/* MT: locked by caller (openStream()) */
|
||||
/* name must be registered by the caller */
|
||||
|
||||
static void
|
||||
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
|
||||
{ term_t a = PL_new_term_ref();
|
||||
|
||||
PL_put_pointer(a, s);
|
||||
PL_cons_functor(a, FUNCTOR_dstream1, a);
|
||||
|
||||
rval = PL_unify(t, a);
|
||||
rval = ( (a=PL_new_term_ref()) &&
|
||||
PL_put_pointer(a, s) &&
|
||||
PL_cons_functor(a, FUNCTOR_dstream1, a) &&
|
||||
PL_unify(t, a)
|
||||
);
|
||||
}
|
||||
UNLOCK();
|
||||
|
||||
if ( !rval && !PL_is_variable(t) )
|
||||
return PL_error(NULL, 0, "stream-argument", ERR_MUST_BE_VAR, 0);
|
||||
|
||||
return rval;
|
||||
}
|
||||
|
||||
|
|
@ -541,8 +557,10 @@ PL_unify_stream(term_t t, IOSTREAM *s)
|
|||
ctx = getStreamContext(s);
|
||||
UNLOCK();
|
||||
|
||||
PL_put_pointer(a, s);
|
||||
PL_cons_functor(a, FUNCTOR_dstream1, a);
|
||||
if ( !(a = PL_new_term_ref()) ||
|
||||
!PL_put_pointer(a, s) ||
|
||||
!PL_cons_functor(a, FUNCTOR_dstream1, a) )
|
||||
return FALSE; /* resource error */
|
||||
|
||||
if ( PL_unify(t, a) )
|
||||
return TRUE;
|
||||
|
|
@ -666,14 +684,21 @@ reportStreamError(IOSTREAM *s)
|
|||
|
||||
if ( (s->flags & SIO_FERR) )
|
||||
{ if ( s->exception )
|
||||
{ fid_t fid = PL_open_foreign_frame();
|
||||
term_t ex = PL_new_term_ref();
|
||||
PL_recorded(s->exception, ex);
|
||||
{ fid_t fid;
|
||||
term_t 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);
|
||||
s->exception = NULL;
|
||||
PL_raise_exception(ex);
|
||||
if ( rc )
|
||||
rc = PL_raise_exception(ex);
|
||||
PL_close_foreign_frame(fid);
|
||||
return FALSE;
|
||||
return rc;
|
||||
}
|
||||
|
||||
if ( s->flags & SIO_INPUT )
|
||||
|
|
@ -1038,11 +1063,11 @@ closeOutputRedirect(redir_context *ctx)
|
|||
rval = PL_unify_wchars_diff(out, tail, ctx->out_format,
|
||||
ctx->size/sizeof(wchar_t),
|
||||
(wchar_t*)ctx->data);
|
||||
if ( tail )
|
||||
if ( rval && tail )
|
||||
rval = PL_unify(tail, diff);
|
||||
|
||||
if ( ctx->data != ctx->buffer )
|
||||
free(ctx->data);
|
||||
Sfree(ctx->data);
|
||||
}
|
||||
|
||||
return rval;
|
||||
|
|
@ -1064,7 +1089,7 @@ discardOutputRedirect(redir_context *ctx)
|
|||
} else
|
||||
{ closeStream(ctx->stream);
|
||||
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 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;
|
||||
} else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */
|
||||
{ int close;
|
||||
|
|
@ -1428,6 +1469,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
|
|||
if ( !PL_get_atom_ex(a, &fn) )
|
||||
goto error;
|
||||
|
||||
PL_register_atom(fn);
|
||||
LOCK();
|
||||
setFileNameStream(s, fn);
|
||||
UNLOCK();
|
||||
|
|
@ -1467,7 +1509,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
|
|||
if ( !PL_get_atom_ex(a, &val) )
|
||||
goto error;
|
||||
if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN )
|
||||
{ bad_encoding(val);
|
||||
{ bad_encoding(NULL, val);
|
||||
goto error;
|
||||
}
|
||||
|
||||
|
|
@ -2191,7 +2233,12 @@ PRED_IMPL("get_single_char", 1, get_single_char, 0)
|
|||
int c = getSingleChar(s, TRUE);
|
||||
|
||||
if ( c == EOF )
|
||||
{ PL_unify_integer(A1, -1);
|
||||
{ if ( PL_exception(0) )
|
||||
{ releaseStream(s);
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
PL_unify_integer(A1, -1);
|
||||
return streamStatus(s);
|
||||
}
|
||||
|
||||
|
|
@ -2512,12 +2559,12 @@ encoding_to_atom(IOENC enc)
|
|||
|
||||
|
||||
static int
|
||||
bad_encoding(atom_t name)
|
||||
bad_encoding(const char *msg, atom_t name)
|
||||
{ GET_LD
|
||||
term_t t = PL_new_term_ref();
|
||||
|
||||
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 )
|
||||
{ enc = atom_to_encoding(encoding);
|
||||
if ( enc == ENC_UNKNOWN )
|
||||
{ bad_encoding(encoding);
|
||||
|
||||
{ bad_encoding(NULL, encoding);
|
||||
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 )
|
||||
{ enc = ENC_OCTET;
|
||||
bom = FALSE;
|
||||
|
|
@ -2675,10 +2735,12 @@ openStream(term_t file, term_t mode, term_t options)
|
|||
}
|
||||
#ifdef HAVE_POPEN
|
||||
else if ( PL_is_functor(file, FUNCTOR_pipe1) )
|
||||
{ term_t a = PL_new_term_ref();
|
||||
{ term_t a;
|
||||
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) )
|
||||
{ PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a);
|
||||
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(;;)
|
||||
{ if ( pe->s ) /* given stream */
|
||||
|
|
@ -3531,7 +3601,8 @@ PRED_IMPL("stream_property", 2, stream_property,
|
|||
goto enum_e;
|
||||
}
|
||||
|
||||
fid2 = PL_open_foreign_frame();
|
||||
if ( !(fid2 = PL_open_foreign_frame()) )
|
||||
goto error;
|
||||
for( ; pe->p->functor ; pe->p++ )
|
||||
{ if ( PL_unify_functor(property, pe->p->functor) )
|
||||
{ int rval;
|
||||
|
|
@ -3559,6 +3630,9 @@ PRED_IMPL("stream_property", 2, stream_property,
|
|||
}
|
||||
}
|
||||
|
||||
if ( exception_term )
|
||||
goto error;
|
||||
|
||||
if ( pe->fixed_p )
|
||||
break;
|
||||
PL_rewind_foreign_frame(fid2);
|
||||
|
|
@ -3579,6 +3653,8 @@ PRED_IMPL("stream_property", 2, stream_property,
|
|||
pe->p = sprop_list;
|
||||
break;
|
||||
}
|
||||
if ( exception_term )
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -4081,11 +4157,16 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0)
|
|||
{ PRED_LD
|
||||
IOSTREAM *in = NULL, *out = NULL, *error = NULL;
|
||||
int rval = FALSE;
|
||||
int wrapin = FALSE;
|
||||
|
||||
if ( !PL_get_stream_handle(A1, &in) ||
|
||||
!PL_get_stream_handle(A2, &out) )
|
||||
if ( !get_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED) ||
|
||||
!get_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS) )
|
||||
goto out;
|
||||
|
||||
wrapin = (LD->IO.streams[0] != in);
|
||||
if ( wrapin )
|
||||
in = getStream(in); /* lock it */
|
||||
|
||||
if ( PL_compare(A2, A3) == 0 ) /* == */
|
||||
{ error = getStream(Snew(out->handle, out->flags, out->functions));
|
||||
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_LBUF;
|
||||
|
||||
LD->IO.streams[0] = in; /* user_input */
|
||||
LD->IO.streams[1] = out; /* user_output */
|
||||
LD->IO.streams[2] = error; /* user_error */
|
||||
LD->IO.streams[3] = in; /* current_input */
|
||||
LD->IO.streams[4] = out; /* current_output */
|
||||
|
||||
wrapIO(in, Sread_user, NULL);
|
||||
LD->prompt.next = TRUE;
|
||||
if ( wrapin )
|
||||
{ LD->IO.streams[3] = in; /* current_input */
|
||||
LD->IO.streams[0] = in; /* user_input */
|
||||
wrapIO(in, Sread_user, NULL);
|
||||
LD->prompt.next = TRUE;
|
||||
}
|
||||
|
||||
UNLOCK();
|
||||
rval = TRUE;
|
||||
|
||||
out:
|
||||
if ( in )
|
||||
if ( wrapin && in )
|
||||
releaseStream(in);
|
||||
if ( out )
|
||||
releaseStream(out);
|
||||
|
|
|
|||
|
|
@ -351,21 +351,25 @@ MarkExecutable(const char *name)
|
|||
* FIND FILES FROM C *
|
||||
*********************************/
|
||||
|
||||
int
|
||||
static int
|
||||
unifyTime(term_t t, time_t time)
|
||||
{ return PL_unify_float(t, (double)time);
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
static int
|
||||
add_option(term_t options, functor_t f, atom_t val)
|
||||
{ GET_LD
|
||||
term_t head = PL_new_term_ref();
|
||||
term_t head;
|
||||
|
||||
PL_unify_list(options, head, options);
|
||||
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val);
|
||||
if ( (head=PL_new_term_ref()) &&
|
||||
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)
|
||||
|
|
@ -378,29 +382,36 @@ PL_get_file_name(term_t n, char **namep, int flags)
|
|||
char ospath[MAXPATHLEN];
|
||||
|
||||
if ( flags & PL_FILE_SEARCH )
|
||||
{ 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 cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
|
||||
: PL_Q_PASS_EXCEPTION);
|
||||
{ fid_t fid;
|
||||
|
||||
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 )
|
||||
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_put_term(av+0, n);
|
||||
|
||||
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) )
|
||||
return FALSE;
|
||||
if ( rc ) rc = PL_unify_nil(options);
|
||||
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 )
|
||||
|
|
@ -642,9 +653,51 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
|
|||
if ( !PL_get_chars(base, &n, CVT_ALL) )
|
||||
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 *
|
||||
|
|
@ -653,7 +706,13 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
|
|||
|
||||
static
|
||||
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) )
|
||||
return FALSE;
|
||||
|
|
@ -662,7 +721,7 @@ PRED_IMPL("delete_file", 1, delete_file, 0)
|
|||
return TRUE;
|
||||
|
||||
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
|
||||
name_too_long()
|
||||
name_too_long(void)
|
||||
{ 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_directory", 1, exists_directory, 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_directory", 1, delete_directory, 0)
|
||||
PRED_DEF("make_directory", 1, make_directory, 0)
|
||||
|
|
|
|||
|
|
@ -109,8 +109,7 @@ typedef struct {
|
|||
} prolog_flag;
|
||||
|
||||
struct
|
||||
{ TempFile _tmpfile_head;
|
||||
TempFile _tmpfile_tail;
|
||||
{ Table tmp_files; /* Known temporary files */
|
||||
CanonicalDir _canonical_dirlist;
|
||||
char * myhome; /* expansion of ~ */
|
||||
char * fred; /* last expanded ~user */
|
||||
|
|
@ -123,6 +122,25 @@ typedef struct {
|
|||
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
|
||||
} 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
|
||||
{ atom_t * array; /* index --> atom */
|
||||
size_t count; /* elements in array */
|
||||
|
|
@ -136,6 +154,8 @@ extern gds_t gds;
|
|||
#define GD (&gds)
|
||||
#define GLOBAL_LD (&gds)
|
||||
|
||||
|
||||
|
||||
typedef struct
|
||||
{ unsigned long flags; /* Fast access to some boolean Prolog flags */
|
||||
} pl_features_t;
|
||||
|
|
@ -280,6 +300,7 @@ typedef struct PL_local_data {
|
|||
term_t tmp; /* tmp for errors */
|
||||
term_t pending; /* used by the debugger */
|
||||
int in_hook; /* inside exception_hook() */
|
||||
int processing; /* processing an exception */
|
||||
exception_frame *throw_environment; /* PL_throw() environments */
|
||||
} exception;
|
||||
const char *float_format; /* floating point format */
|
||||
|
|
@ -290,6 +311,8 @@ typedef struct PL_local_data {
|
|||
|
||||
} PL_local_data_t;
|
||||
|
||||
#define usedStack(D) 0
|
||||
|
||||
#define features (LD->feature.mask)
|
||||
|
||||
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 ****/
|
||||
void initFiles(void);
|
||||
int RemoveFile(const char *path);
|
||||
int PL_get_file_name(term_t n, char **namep, int flags);
|
||||
|
||||
/* empty stub */
|
||||
void setPrologFlag(const char *name, int flags, ...);
|
||||
|
|
|
|||
|
|
@ -119,7 +119,8 @@ have to be dropped. See the header of pl-incl.h for details.
|
|||
|
||||
bool
|
||||
initOs(void)
|
||||
{ DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
|
||||
{ GET_LD
|
||||
DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
|
||||
initExpand();
|
||||
DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
|
||||
initEnviron();
|
||||
|
|
@ -409,10 +410,10 @@ setOSPrologFlags(void)
|
|||
* MEMORY *
|
||||
*******************************/
|
||||
|
||||
#if __SWI_PROLOG__
|
||||
uintptr_t
|
||||
UsedMemory(void)
|
||||
{
|
||||
{ GET_LD
|
||||
|
||||
#if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS)
|
||||
struct rusage usage;
|
||||
|
||||
|
|
@ -427,23 +428,15 @@ UsedMemory(void)
|
|||
usedStack(local) +
|
||||
usedStack(trail));
|
||||
}
|
||||
#else
|
||||
uintptr_t
|
||||
UsedMemory(void)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
uintptr_t
|
||||
FreeMemory(void)
|
||||
{
|
||||
|
||||
#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
|
||||
uintptr_t used = UsedMemory();
|
||||
|
||||
struct rlimit limit;
|
||||
struct rlimit limit;
|
||||
|
||||
if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
|
||||
return limit.rlim_cur - used;
|
||||
|
|
@ -511,7 +504,9 @@ setRandom(unsigned int *seedp)
|
|||
|
||||
uint64_t
|
||||
_PL_Random(void)
|
||||
{ if ( !LD->os.rand_initialised )
|
||||
{ GET_LD
|
||||
|
||||
if ( !LD->os.rand_initialised )
|
||||
{ setRandom(NULL);
|
||||
LD->os.rand_initialised = TRUE;
|
||||
}
|
||||
|
|
@ -530,9 +525,9 @@ _PL_Random(void)
|
|||
#else
|
||||
{ uint64_t l = rand(); /* 0<n<2^15-1 */
|
||||
|
||||
l ^= rand()<<15;
|
||||
l ^= rand()<<30;
|
||||
l ^= rand()<<45;
|
||||
l ^= (uint64_t)rand()<<15;
|
||||
l ^= (uint64_t)rand()<<30;
|
||||
l ^= (uint64_t)rand()<<45;
|
||||
|
||||
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
|
||||
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 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.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
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
|
||||
#ifdef __WINDOWS__
|
||||
#define DEFTMPDIR "c:/tmp"
|
||||
|
|
@ -582,22 +569,64 @@ struct tempfile
|
|||
#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
|
||||
TemporaryFile(const char *id)
|
||||
TemporaryFile(const char *id, int *fdp)
|
||||
{ char temp[MAXPATHLEN];
|
||||
TempFile tf = allocHeap(sizeof(struct tempfile));
|
||||
char envbuf[MAXPATHLEN];
|
||||
char *tmpdir;
|
||||
static char *tmpdir = NULL;
|
||||
atom_t tname;
|
||||
int retries = 0;
|
||||
|
||||
if ( !((tmpdir = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
|
||||
(tmpdir = Getenv("TMP", envbuf, sizeof(envbuf)))) )
|
||||
tmpdir = DEFTMPDIR;
|
||||
if ( !tmpdir )
|
||||
{ LOCK();
|
||||
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__
|
||||
{ static int MTOK_temp_counter = 0;
|
||||
const char *sep = id[0] ? "_" : "";
|
||||
|
||||
Ssprintf(temp, "%s/pl_%s_%d_%d",
|
||||
tmpdir, id, (int) getpid(), MTOK_temp_counter++);
|
||||
Ssprintf(temp, "%s/pl_%s%s%d_%d",
|
||||
tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
@ -612,49 +641,74 @@ TemporaryFile(const char *id)
|
|||
#endif
|
||||
{ PrologPath(tmp, temp, sizeof(temp));
|
||||
} else
|
||||
Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++);
|
||||
}
|
||||
#endif
|
||||
{ const char *sep = id[0] ? "_" : "";
|
||||
|
||||
#if EMX
|
||||
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;
|
||||
Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++);
|
||||
}
|
||||
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
|
||||
RemoveTemporaryFiles(void)
|
||||
{ TempFile tf, tf2;
|
||||
{ LOCK();
|
||||
if ( GD->os.tmp_files )
|
||||
{ Table t = GD->os.tmp_files;
|
||||
|
||||
startCritical;
|
||||
for(tf = tmpfile_head; tf; tf = tf2)
|
||||
{ RemoveFile(stringAtom(tf->name));
|
||||
tf2 = tf->next;
|
||||
freeHeap(tf, sizeof(struct tempfile));
|
||||
GD->os.tmp_files = NULL;
|
||||
UNLOCK();
|
||||
destroyHTable(t);
|
||||
} else
|
||||
{ UNLOCK();
|
||||
}
|
||||
|
||||
tmpfile_head = tmpfile_tail = NULL;
|
||||
endCritical;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -756,7 +810,8 @@ OsPath(const char *p, char *buf)
|
|||
#if O_XOS
|
||||
char *
|
||||
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);
|
||||
}
|
||||
|
|
@ -813,7 +868,7 @@ forwards char *canoniseDir(char *);
|
|||
|
||||
static void
|
||||
initExpand(void)
|
||||
{
|
||||
{ GET_LD
|
||||
#ifdef O_CANONISE_DIRS
|
||||
char *dir;
|
||||
char *cpaths;
|
||||
|
|
@ -923,6 +978,7 @@ verify_entry(CanonicalDir d)
|
|||
|
||||
d->inode = buf.st_ino;
|
||||
d->device = buf.st_dev;
|
||||
return TRUE;
|
||||
} else
|
||||
{ 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);
|
||||
}
|
||||
|
||||
|
|
@ -1139,7 +1198,9 @@ utf8_strlwr(char *s)
|
|||
|
||||
char *
|
||||
canonisePath(char *path)
|
||||
{ if ( !truePrologFlag(PLFLAG_FILE_CASE) )
|
||||
{ GET_LD
|
||||
|
||||
if ( !truePrologFlag(PLFLAG_FILE_CASE) )
|
||||
utf8_strlwr(path);
|
||||
|
||||
canoniseFileName(path);
|
||||
|
|
@ -1186,7 +1247,8 @@ takeWord(const char **string, char *wrd, int maxlen)
|
|||
|
||||
bool
|
||||
expandVars(const char *pattern, char *expanded, int maxlen)
|
||||
{ int size = 0;
|
||||
{ GET_LD
|
||||
int size = 0;
|
||||
char wordbuf[MAXPATHLEN];
|
||||
|
||||
if ( *pattern == '~' )
|
||||
|
|
@ -1338,7 +1400,8 @@ ExpandFile(const char *pattern, char **vector)
|
|||
|
||||
char *
|
||||
ExpandOneFile(const char *spec, char *file)
|
||||
{ char *vector[256];
|
||||
{ GET_LD
|
||||
char *vector[256];
|
||||
int size;
|
||||
|
||||
switch( (size=ExpandFile(spec, vector)) )
|
||||
|
|
@ -1437,10 +1500,13 @@ IsAbsolutePath(const char *p)
|
|||
|
||||
char *
|
||||
AbsoluteFile(const char *spec, char *path)
|
||||
{ char tmp[MAXPATHLEN];
|
||||
{ GET_LD
|
||||
char tmp[MAXPATHLEN];
|
||||
char buf[MAXPATHLEN];
|
||||
char *file = PrologPath(spec, buf, sizeof(buf));
|
||||
|
||||
if ( !file )
|
||||
return (char *) NULL;
|
||||
if ( truePrologFlag(PLFLAG_FILEVARS) )
|
||||
{ if ( !(file = ExpandOneFile(buf, tmp)) )
|
||||
return (char *) NULL;
|
||||
|
|
@ -1485,7 +1551,9 @@ AbsoluteFile(const char *spec, char *path)
|
|||
|
||||
void
|
||||
PL_changed_cwd(void)
|
||||
{ if ( CWDdir )
|
||||
{ GET_LD
|
||||
|
||||
if ( CWDdir )
|
||||
remove_string(CWDdir);
|
||||
CWDdir = NULL;
|
||||
CWDlen = 0;
|
||||
|
|
@ -1494,7 +1562,9 @@ PL_changed_cwd(void)
|
|||
|
||||
const char *
|
||||
PL_cwd(void)
|
||||
{ if ( CWDlen == 0 )
|
||||
{ GET_LD
|
||||
|
||||
if ( CWDlen == 0 )
|
||||
{ char buf[MAXPATHLEN];
|
||||
char *rval;
|
||||
|
||||
|
|
@ -1583,7 +1653,8 @@ DirName(const char *f, char *dir)
|
|||
|
||||
bool
|
||||
ChDir(const char *path)
|
||||
{ char ospath[MAXPATHLEN];
|
||||
{ GET_LD
|
||||
char ospath[MAXPATHLEN];
|
||||
char tmp[MAXPATHLEN];
|
||||
|
||||
OsPath(path, ospath);
|
||||
|
|
@ -1681,7 +1752,8 @@ ResetStdin(void)
|
|||
|
||||
static ssize_t
|
||||
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;
|
||||
source_location oldsrc = LD->read_source;
|
||||
|
||||
|
|
@ -1708,7 +1780,8 @@ Sread_terminal(void *handle, char *buf, size_t size)
|
|||
|
||||
void
|
||||
ResetTty()
|
||||
{ startCritical;
|
||||
{ GET_LD
|
||||
startCritical;
|
||||
ResetStdin();
|
||||
|
||||
if ( !GD->os.iofunctions.read )
|
||||
|
|
@ -1736,7 +1809,8 @@ ResetTty()
|
|||
|
||||
bool
|
||||
PushTty(IOSTREAM *s, ttybuf *buf, int mode)
|
||||
{ struct termios tio;
|
||||
{ GET_LD
|
||||
struct termios tio;
|
||||
int fd;
|
||||
|
||||
buf->mode = ttymode;
|
||||
|
|
@ -1803,7 +1877,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
|
|||
|
||||
bool
|
||||
PopTty(IOSTREAM *s, ttybuf *buf)
|
||||
{ int fd;
|
||||
{ GET_LD
|
||||
int fd;
|
||||
ttymode = buf->mode;
|
||||
|
||||
if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
|
||||
|
|
@ -1898,7 +1973,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
|
|||
|
||||
bool
|
||||
PopTty(IOSTREAM *s, ttybuf *buf)
|
||||
{ ttymode = buf->mode;
|
||||
{ GET_LD
|
||||
ttymode = buf->mode;
|
||||
if ( ttymode != TTY_RAW )
|
||||
LD->prompt.next = TRUE;
|
||||
|
||||
|
|
@ -2204,7 +2280,8 @@ argument to wait()
|
|||
|
||||
int
|
||||
System(char *cmd)
|
||||
{ int pid;
|
||||
{ GET_LD
|
||||
int pid;
|
||||
char *shell = "/bin/sh";
|
||||
int rval;
|
||||
void (*old_int)();
|
||||
|
|
|
|||
|
|
@ -245,8 +245,9 @@ extern char *Getenv(const char *, char *buf, size_t buflen);
|
|||
extern char *BaseName(const char *f);
|
||||
extern time_t LastModifiedFile(const char *f);
|
||||
extern bool ExistsFile(const char *path);
|
||||
extern atom_t TemporaryFile(const char *id);
|
||||
extern int RemoveFile(const char *path);
|
||||
extern atom_t TemporaryFile(const char *id, int *fdp);
|
||||
extern atom_t TemporaryFile(const char *id, int *fdp);
|
||||
extern int DeleteTemporaryFile(atom_t name);
|
||||
extern bool ChDir(const char *path);
|
||||
extern char *PrologPath(const char *ospath, char *path, size_t len);
|
||||
|
||||
|
|
|
|||
|
|
@ -93,16 +93,40 @@ PL_save_text(PL_chars_t *text, int flags)
|
|||
|
||||
addMultipleBuffer(b, text->text.t, bl, char);
|
||||
text->text.t = baseBuffer(b, char);
|
||||
|
||||
|
||||
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
|
||||
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 ( !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) )
|
||||
{ if ( !get_string_text(w, text PASS_LD) )
|
||||
goto maybe_write;
|
||||
PL_from_stack_text(text);
|
||||
} else if ( (flags & CVT_INTEGER) && isInteger(w) )
|
||||
{ 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->canonical = TRUE;
|
||||
} else if ( (flags & CVT_FLOAT) && isReal(w) )
|
||||
{ format_float(valReal(w), text->buf, LD->float_format);
|
||||
} else if ( (flags & CVT_FLOAT) && isFloat(w) )
|
||||
{ format_float(valFloat(w), text->buf, LD->float_format);
|
||||
text->text.t = text->buf;
|
||||
text->length = strlen(text->text.t);
|
||||
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[1] = ENC_WCHAR;
|
||||
encodings[2] = ENC_UNKNOWN;
|
||||
|
||||
|
||||
for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
|
||||
{ size_t size;
|
||||
IOSTREAM *fd;
|
||||
|
||||
|
||||
r = text->buf;
|
||||
size = sizeof(text->buf);
|
||||
fd = Sopenmem(&r, &size, "w");
|
||||
|
|
@ -228,6 +253,9 @@ maybe_write:
|
|||
goto case_write;
|
||||
|
||||
error:
|
||||
if ( canBind(w) && (flags & CVT_VARNOFAIL) )
|
||||
return 2;
|
||||
|
||||
if ( (flags & CVT_EXCEPTION) )
|
||||
{ atom_t expected;
|
||||
|
||||
|
|
@ -237,7 +265,7 @@ error:
|
|||
expected = ATOM_atomic;
|
||||
else
|
||||
expected = ATOM_atom;
|
||||
|
||||
|
||||
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:
|
||||
{ atom_t a = textToAtom(text);
|
||||
int rval = _PL_unify_atomic(term, a);
|
||||
|
||||
|
||||
PL_unregister_atom(a);
|
||||
return rval;
|
||||
}
|
||||
|
|
@ -285,7 +313,10 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
|
|||
#if __SWI_PROLOG__
|
||||
{ word w = textToString(text);
|
||||
|
||||
return _PL_unify_atomic(term, w);
|
||||
if ( w )
|
||||
return _PL_unify_atomic(term, w);
|
||||
else
|
||||
return FALSE;
|
||||
}
|
||||
#endif
|
||||
case PL_CODE_LIST:
|
||||
|
|
@ -300,35 +331,40 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
|
|||
}
|
||||
} else
|
||||
{ GET_LD
|
||||
word p0, p;
|
||||
|
||||
term_t l = PL_new_term_ref();
|
||||
Word p0, p;
|
||||
|
||||
switch(text->encoding)
|
||||
{ case ENC_ISO_LATIN_1:
|
||||
{ const unsigned char *s = (const unsigned char *)text->text.t;
|
||||
const unsigned char *e = &s[text->length];
|
||||
|
||||
p0 = p = INIT_SEQ_CODES(text->length);
|
||||
if ( type == PL_CODE_LIST ) {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_CODES(p, *s);
|
||||
} else {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_ATOMS(p, *s);
|
||||
}
|
||||
if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
|
||||
return FALSE;
|
||||
|
||||
if ( type == PL_CODE_LIST ) {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_CODES(p, *s);
|
||||
} else {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_ATOMS(p, *s);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case ENC_WCHAR:
|
||||
{ const pl_wchar_t *s = (const pl_wchar_t *)text->text.t;
|
||||
const pl_wchar_t *e = &s[text->length];
|
||||
|
||||
p0 = p = INIT_SEQ_CODES(text->length);
|
||||
if ( type == PL_CODE_LIST ) {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_CODES(p, *s);
|
||||
} else {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_ATOMS(p, *s);
|
||||
}
|
||||
|
||||
if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
|
||||
return FALSE;
|
||||
|
||||
if ( type == PL_CODE_LIST ) {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_CODES(p, *s);
|
||||
} else {
|
||||
for( ; s < e; s++)
|
||||
p = EXTEND_SEQ_ATOMS(p, *s);
|
||||
}
|
||||
break;
|
||||
}
|
||||
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];
|
||||
size_t len = utf8_strlen(s, text->length);
|
||||
|
||||
p0 = p = INIT_SEQ_CODES(len);
|
||||
if ( type == PL_CODE_LIST ) {
|
||||
while (s < e) {
|
||||
int chr;
|
||||
|
||||
s = utf8_get_char(s, &chr);
|
||||
p = EXTEND_SEQ_CODES(p, chr);
|
||||
}
|
||||
} else {
|
||||
while (s < e) {
|
||||
int chr;
|
||||
|
||||
s = utf8_get_char(s, &chr);
|
||||
p = EXTEND_SEQ_ATOMS(p, chr);
|
||||
}
|
||||
}
|
||||
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
|
||||
return FALSE;
|
||||
|
||||
if ( type == PL_CODE_LIST ) {
|
||||
while (s < e) {
|
||||
int chr;
|
||||
|
||||
s = utf8_get_char(s, &chr);
|
||||
p = EXTEND_SEQ_CODES(p, chr);
|
||||
}
|
||||
} else {
|
||||
while (s < e) {
|
||||
int chr;
|
||||
|
||||
s = utf8_get_char(s, &chr);
|
||||
p = EXTEND_SEQ_ATOMS(p, chr);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
case ENC_ANSI:
|
||||
|
|
@ -367,18 +405,21 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
|
|||
n -= rc;
|
||||
s += rc;
|
||||
}
|
||||
p0 = p = INIT_SEQ_CODES(len);
|
||||
|
||||
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
|
||||
return FALSE;
|
||||
|
||||
memset(&mbs, 0, sizeof(mbs));
|
||||
n = text->length;
|
||||
|
||||
while(n > 0) {
|
||||
rc = mbrtowc(&wc, s, n, &mbs);
|
||||
while(n > 0)
|
||||
{ rc = mbrtowc(&wc, s, n, &mbs);
|
||||
|
||||
if ( type == PL_CODE_LIST )
|
||||
p = EXTEND_SEQ_CODES(p, wc);
|
||||
else
|
||||
p = EXTEND_SEQ_ATOMS(p, wc);
|
||||
|
||||
|
||||
s += 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:
|
||||
|
|
@ -430,7 +471,7 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
|
|||
rc = PL_unify_text(term, 0, &sub, type);
|
||||
|
||||
PL_free_text(&sub);
|
||||
|
||||
|
||||
return rc;
|
||||
}
|
||||
}
|
||||
|
|
@ -458,7 +499,7 @@ PL_promote_text(PL_chars_t *text)
|
|||
|
||||
PL_free(text->text.t);
|
||||
text->text.w = new;
|
||||
|
||||
|
||||
text->encoding = ENC_WCHAR;
|
||||
} else if ( text->storage == PL_CHARS_LOCAL &&
|
||||
(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);
|
||||
text->text.t = new;
|
||||
|
||||
|
||||
text->encoding = ENC_ISO_LATIN_1;
|
||||
} else if ( text->storage == PL_CHARS_LOCAL )
|
||||
{ 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 *e = b;
|
||||
const char *s;
|
||||
|
||||
|
||||
e = utf8_put_char(e, c);
|
||||
for(s=b; s<e; s++)
|
||||
addBuffer(buf, *s, char);
|
||||
|
|
@ -617,7 +658,7 @@ PL_mb_text(PL_chars_t *text, int flags)
|
|||
|
||||
if ( text->encoding != target )
|
||||
{ Buffer b = findBuffer(BUF_RING);
|
||||
|
||||
|
||||
switch(text->encoding)
|
||||
{ case ENC_ISO_LATIN_1:
|
||||
{ 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);
|
||||
} else /* if ( target == ENC_MB ) */
|
||||
{ mbstate_t mbs;
|
||||
|
||||
|
||||
memset(&mbs, 0, sizeof(mbs));
|
||||
for( ; w<e; w++)
|
||||
{ if ( !wctobuffer(*w, &mbs, b) )
|
||||
|
|
@ -692,7 +733,7 @@ rep_error:
|
|||
|
||||
sprintf(msg,
|
||||
"Cannot represent char U%04x using %s encoding",
|
||||
norep,
|
||||
norep,
|
||||
target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale");
|
||||
|
||||
return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding);
|
||||
|
|
@ -711,7 +752,7 @@ PL_canonise_text(PL_chars_t *text)
|
|||
case ENC_WCHAR:
|
||||
{ const pl_wchar_t *w = (const pl_wchar_t*)text->text.w;
|
||||
const pl_wchar_t *e = &w[text->length];
|
||||
|
||||
|
||||
for(; w<e; w++)
|
||||
{ if ( *w > 0xff )
|
||||
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;
|
||||
else
|
||||
return *s > *q ? 1 : -1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1098,35 +1139,3 @@ Sopen_text(PL_chars_t *txt, const char *mode)
|
|||
|
||||
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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -250,7 +250,7 @@ scan_options(term_t options, int flags, atom_t optype,
|
|||
term_t val = PL_new_term_ref();
|
||||
int n;
|
||||
|
||||
if ( trueFeature(ISO_FEATURE) )
|
||||
if ( truePrologFlag(PLFLAG_ISO) )
|
||||
flags |= OPT_ALL;
|
||||
|
||||
va_start(args, specs);
|
||||
|
|
|
|||
|
|
@ -148,7 +148,7 @@ EXTEND_SEQ_ATOMS(word gstore, int c) {
|
|||
}
|
||||
|
||||
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 (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil()))
|
||||
return FALSE;
|
||||
|
|
@ -172,14 +172,17 @@ valHandle(term_t tt)
|
|||
#define isAtom(A) YAP_IsAtomTerm((A))
|
||||
#define isList(A) YAP_IsPairTerm((A))
|
||||
#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 varName(l, buf) buf
|
||||
#define valReal(w) YAP_FloatOfTerm((w))
|
||||
#define valFloat(w) YAP_FloatOfTerm((w))
|
||||
#define AtomLength(w) YAP_AtomNameLength(w)
|
||||
#define atomValue(atom) ((YAP_Atom)atom)
|
||||
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
|
||||
#define deRef(t) (t = YAP_Deref(t))
|
||||
#define canBind(t) FALSE
|
||||
|
||||
#define clearNumber(n)
|
||||
|
||||
|
|
|
|||
Reference in New Issue