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

bootstrap

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-07-06 12:03:16 +01:00
parent 705a6e9b7f
commit 33de6766a5
9 changed files with 1288 additions and 900 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
os/format.c
View File

@ -40,7 +40,7 @@ static char SccsId[] = "%W% %G%";
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#endif
#if HAVE_SOCKET
#include <winsock2.h>
#endif
@ -220,7 +220,7 @@ format_copy_args(Term args, Term *targs, Int tsz)
n++;
}
return n;
}
static void
@ -251,7 +251,7 @@ fetch_index_from_args(Term t)
static wchar_t
base_dig(Int dig, Int ch)
{
if (dig < 10)
if (dig < 10)
return dig+'0';
else if (ch == 'r')
return (dig-10)+'a';
@ -335,7 +335,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
}
}
while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) {
fmod = ArgOfTerm(1,args);
args = ArgOfTerm(2,args);
@ -351,7 +351,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
}
}
}
if (IsPairTerm(args)) {
Int tsz = 8;
@ -422,6 +422,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (!IsAtomTerm(t))
goto do_type_atom_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200);
Yap_CloseSlots(sl);
LOCAL_FormatInfo = &finfo;
@ -550,7 +551,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
} else {
goto do_type_int_error;
}
if (tmpbase[0] == '-') {
f_putc(sno, (int) '-');
ptr++;
@ -678,7 +679,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
break;
case '@':
t = targs[targ++];
{
{
yhandle_t sl0 = Yap_StartSlots();
Int sl = Yap_InitSlot(args);
Int sl2;
@ -708,7 +709,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
{
{
Int sl = Yap_InitSlot(args);
Yap_plwrite(t, GLOBAL_Stream+sno, 0, Handle_vars_f|Use_portray_f|To_heap_f, 1200);
LOCAL_FormatInfo = &finfo;
@ -805,8 +806,8 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
case 't':
{
int nsno;
finfo.pad_entries[finfo.padders].len = sz;
finfo.pad_entries[finfo.padders].len = sz;
finfo.pad_entries[finfo.padders].pad = bufp;
bufp = NULL;
sz = 0;
@ -897,6 +898,71 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
return (TRUE);
}
/*
* @pred with_output_to( + _Stream_ , 0:_Goal )
*
* Evaluate goal _Goal, such that the output will be sent to _Stream_.
*
* As in format/3, we shall have the special streams `chars`/1, `codes/` and symbtw
*
*/
static Int
with_output_to( USES_REGS1 )
{
int old_out = LOCAL_c_output_stream;
int output_stream;
Term tin = Deref(ARG1);
Functor f;
bool out;
bool mem_stream = false;
if (IsVarTerm(tin)) {
Yap_Error(INSTANTIATION_ERROR,tin,"with_output_to/3");
return false;
}
if (IsApplTerm(tin) &&
(f = FunctorOfTerm(tin)) &&
(f == FunctorAtom || f == FunctorString ||
f == FunctorCodes1 || f == FunctorCodes ||
f == FunctorChars1 || f == FunctorChars) )
{
output_stream = Yap_OpenBufWriteStream( PASS_REGS1);
} else {
/* needs to change LOCAL_c_output_stream for write */
output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "format/3");
}
if (output_stream == -1) {
return false;
}
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
out = Yap_Execute( Deref(ARG2) PASS_REGS);
LOCAL_c_output_stream = old_out;
if (mem_stream) {
Term tat;
Term inp = Deref(ARG1);
if (out) {
char *s = GLOBAL_Stream[output_stream].u.mem_string.buf;
s[GLOBAL_Stream[output_stream].u.mem_string.pos] = '\0';
if (f == FunctorAtom) {
tat = MkAtomTerm(Yap_LookupAtom(s));
} else if (f == FunctorCodes) {
tat = Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2,inp) PASS_REGS);
} else if (f == FunctorCodes1) {
tat = Yap_CharsToListOfCodes(s PASS_REGS);
} else if (f == FunctorChars) {
tat = Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2,inp) PASS_REGS);
} else if (f == FunctorChars1) {
tat = Yap_CharsToListOfAtoms(s PASS_REGS);
} else if (f == FunctorString1) {
tat = MkStringTerm(s);
} else {
return false;
}
out = Yap_unify(tat,ArgOfTerm(1,inp));
}
}
return out;
}
static Int
format2(Term tin, Term tf, Term tas USES_REGS)
{
@ -909,7 +975,7 @@ format2(Term tin, Term tf, Term tas USES_REGS)
Yap_Error(INSTANTIATION_ERROR,tin,"format/3");
return false;
}
if (IsApplTerm(tin) &&
if (IsApplTerm(tin) &&
(f = FunctorOfTerm(tin)) &&
(f == FunctorAtom || f == FunctorString ||
f == FunctorCodes1 || f == FunctorCodes ||
@ -923,8 +989,8 @@ format2(Term tin, Term tf, Term tas USES_REGS)
if (output_stream == -1) {
return false;
}
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
out = doformat(tf,tas,output_stream PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
if (mem_stream) {
Term tat;
Term inp = Deref(ARG1);
@ -975,4 +1041,5 @@ Yap_InitFormat(void)
{
Yap_InitCPred ("format", 2, format, SyncPredFlag);
Yap_InitCPred ("format", 3, format3, SyncPredFlag);
Yap_InitCPred ("with_output_to", 2, with_output_to, SyncPredFlag);
}

55
os/iopreds.c
View File

@ -258,6 +258,17 @@ InitStdStream (int sno, SMALLUNSGN flags, FILE * file)
}
Term Yap_StreamUserName(int sno)
{
Term atname;
StreamDesc *s = &GLOBAL_Stream[sno];
if (s->user_name != 0L) {
return (s->user_name);
}
if ((atname = StreamName(sno)))
return atname;
return 0;
}
static void
InitStdStreams (void)
@ -287,7 +298,7 @@ Yap_InitStdStreams (void)
}
Int
PlIOError (yap_error_number type, Term culprit, char *who, ...)
PlIOError (yap_error_number type, Term culprit, const char *who, ...)
{
if (trueLocalPrologFlag(FILEERRORS_FLAG) == MkIntTerm(1) ||
type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) {
@ -521,8 +532,7 @@ int
console_post_process_eof(StreamDesc *s)
{
CACHE_REGS
s->status |= Eof_Stream_f;
s->stream_getc = EOFGetc;
s->stream_getc = EOFGetc;
s->stream_wgetc = get_wchar;
if (GLOBAL_CharConversionTable != NULL)
s->stream_wgetc_for_read = ISOWGetc;
@ -1366,9 +1376,8 @@ binary_file(char *file_name)
static Int
open4 ( USES_REGS1 )
do_open ( Term file_name, Term t2, Term tlist USES_REGS )
{ /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
Term file_name, t2, tenc;
Atom open_mode;
int sno;
SMALLUNSGN s;
@ -1377,11 +1386,10 @@ binary_file(char *file_name)
bool avoid_bom = false, needs_bom = true, bin = false;
char *fname;
stream_flags_t flags;
Term tlist;
FILE *fd;
encoding_t encoding;
Term tenc;
file_name = Deref(ARG1);
// original file name
if (IsVarTerm (file_name)) {
Yap_Error(INSTANTIATION_ERROR,file_name, "open/3");
@ -1398,7 +1406,6 @@ binary_file(char *file_name)
fname = RepAtom (AtomOfTerm (file_name))->StrOfAE;
}
// open mode
t2 = Deref (ARG2);
if (IsVarTerm (t2)) {
Yap_Error(INSTANTIATION_ERROR,t2, "open/3");
return FALSE;
@ -1428,7 +1435,7 @@ binary_file(char *file_name)
return(FALSE);
}
/* get options */
xarg *args = Yap_ArgListToVector ( (tlist = Deref(ARG4) ), open_defs, OPEN_END );
xarg *args = Yap_ArgListToVector ( tlist, open_defs, OPEN_END );
if (args == NULL)
return FALSE;
/* done */
@ -1559,12 +1566,17 @@ binary_file(char *file_name)
}
}
static Int
open3 ( USES_REGS1 )
{ /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
ARG4 = TermNil;
return open4( PASS_REGS1 );
}
static Int
open3 ( USES_REGS1 )
{ /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS );
}
static Int
open4 ( USES_REGS1 )
{ /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
return do_open(Deref(ARG1), Deref(ARG2), Deref( ARG4 ) PASS_REGS );
}
static Int
p_file_expansion (USES_REGS1)
@ -1666,7 +1678,7 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
} else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FunctorStream) {
arg = ArgOfTerm (1, arg);
if (!IsVarTerm (arg) && IsIntegerTerm (arg)) {
sno = IntegerOfTerm(arg);
sno = IntegerOfTerm(arg);
}
}
if (sno < 0)
@ -1678,19 +1690,18 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
if (GLOBAL_Stream[sno].status & Free_Stream_f)
{
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg);
PlIOError(EXISTENCE_ERROR_STREAM, arg, msg);
return (-1);
}
if ((GLOBAL_Stream[sno].status & kind) == 0)
{
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (kind & Input_Stream_f)
Yap_Error(PERMISSION_ERROR_INPUT_STREAM, arg, msg);
PlIOError(PERMISSION_ERROR_INPUT_STREAM, arg, msg);
else
Yap_Error(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg);
PlIOError(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg);
return (-1);
}
jmp_deb(1);
return (sno);
}
@ -1819,8 +1830,8 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
Yap_InitCPred ("always_prompt_user", 0, always_prompt_user, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("close", 1, close1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("close", 2, close2, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("open", 4, open4, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("open", 3, open3, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("open", 4, open4, SyncPredFlag);
Yap_InitCPred ("open", 3, open3, SyncPredFlag);
Yap_InitCPred ("$file_expansion", 2, p_file_expansion, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$open_null_stream", 1, p_open_null_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitIOStreams();

11
os/iopreds.h
View File

@ -162,11 +162,9 @@ typedef struct stream_desc
FILE* file;
union {
struct {
#if defined(__MINGW32__) || defined(_MSC_VER)
#define PLGETC_BUF_SIZE 4096
char *buf, *ptr;
int left;
#endif
} file;
memHandle mem_string;
struct {
@ -244,10 +242,15 @@ GetCurInpPos (StreamDesc * inp_stream)
return (inp_stream->linecount);
}
Int PlIOError( yap_error_number, Term, char *, ...);
Int PlIOError( yap_error_number, Term, const char *, ...);
int GetFreeStreamD(void);
Term Yap_MkStream (int n);
bool Yap_PrintWarning( Term twarning );
Int
PlIOError (yap_error_number type, Term culprit, const char *who, ...);
void Yap_plwrite(Term, struct stream_desc *, int, int, int);
int Yap_FormatFloat( Float f, const char *s, size_t sz );
@ -319,6 +322,8 @@ bool Yap_FetchStreamAlias (int sno, Term t2 USES_REGS);
INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s);
Term Yap_StreamUserName(int sno);
INLINE_ONLY inline EXTERN void
count_output_char(int ch, StreamDesc *s)
{

5
os/readline.c
View File

@ -208,8 +208,8 @@ prolog_complete(int ignore, int key)
static void
InitReadline(void) {
// don't call readline within emacs
if (getenv("ËMACS"))
return;
//if (getenv("ËMACS"))
// return;
GLOBAL_Stream[StdInStream].u.irl.buf = NULL;
GLOBAL_Stream[StdInStream].u.irl.ptr = NULL;
#if _MSC_VER || defined(__MINGW32__)
@ -251,6 +251,7 @@ getLine( int inp, int out )
LOCAL_PrologMode |= ConsoleGetcMode;
if (GLOBAL_Stream[out].linepos == 0) { // no output so far
fflush(NULL);
myrl_line = readline (LOCAL_Prompt);
} else {
LOCAL_PrologMode |= ConsoleGetcMode;

1806
os/readterm.c
View File

File diff suppressed because it is too large Load Diff

20
os/streams.c
View File

@ -581,7 +581,7 @@ do_stream_property (int sno, Term opts USES_REGS)
break;
case STREAM_PROPERTY_POSITION:
rc = rc &&
stream_position ( sno, args[STREAM_PROPERTY_MODE].tvalue PASS_REGS);
stream_position ( sno, args[STREAM_PROPERTY_POSITION].tvalue PASS_REGS);
break;
case STREAM_PROPERTY_REPOSITION:
rc = rc &&
@ -628,8 +628,10 @@ cont_stream_property (USES_REGS1)
EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i);
if (i == MaxStreams)
do_cut( true );
Yap_unify(ARG1, Yap_MkStream(i-1));
return do_stream_property(i-1, Deref(ARG2) PASS_REGS);
if ( do_stream_property(i-1, Deref(ARG2) PASS_REGS) ) {
Yap_unify(ARG1, Yap_MkStream(i-1));
return true;
}
}
UNLOCK(GLOBAL_Stream[i0].streamlock);
cut_fail();
@ -1018,17 +1020,7 @@ p_user_file_name ( USES_REGS1 )
int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"user_file_name/2");
if (sno < 0)
return (FALSE);
#if HAVE_SOCKET
if (GLOBAL_Stream[sno].status & Socket_Stream_f)
tout = MkAtomTerm(AtomSocket);
else
#endif
if (GLOBAL_Stream[sno].status & Pipe_Stream_f)
tout = MkAtomTerm(AtomPipe);
else if (GLOBAL_Stream[sno].status & InMemory_Stream_f)
tout = MkAtomTerm(AtomCharsio);
else
tout = GLOBAL_Stream[sno].user_name;
tout = Yap_StreamUserName(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify_constant (ARG2, tout));
}

156
os/sysbits.c
View File

@ -7,6 +7,7 @@
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* PrologPathProkoh
* *
* File: sysbits.c *
* Last rev: 4/03/88 *
@ -110,7 +111,7 @@ static char SccsId[] = "%W% %G%";
static void
Yap_FileError(yap_error_number type, Term where, const char *format,...)
{
if ( trueLocalPrologFlag(FILEERRORS_FLAG) ) {
va_list ap;
@ -195,7 +196,7 @@ Yap_AccessAsset( const char *name, int mode )
{
AAssetManager* mgr = Yap_assetManager;
const char *bufp=name+7;
if (bufp[0] == '/')
bufp++;
if ((mode & W_OK) == W_OK) {
@ -574,30 +575,18 @@ unix2win( const char *source, char *target, int max)
}
#endif
#if O_XOS
char *
PrologPath(const char *p, char *buf, size_t len)
{
int flags = (trueGlobalPrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
return _xos_canonical_filename(p, buf, len, flags);
}
static char *
OsPath(const char *p, char *buf)
{
if()z
trcpy(buf, p);
return buf;
return (char *)p;
}
#else
static char *
OsPath(const char *X, char *Y) {
if (X!=Y && Y) strcpy(Y,X);
PrologPath(const char *Y, char *X) {
return (char *)Y ;
}
#endif /* O_XOS */
#if _WIN32
#define HAVE_BASENAME 1
@ -633,7 +622,7 @@ static bool ChDir(const char *path) {
}
#endif
#if _WIN32 || defined(__MINGW32__)
if ((rc = (SetCurrentDirectory(qpath) != 0)) == 0)
{
Yap_WinError("SetCurrentDirectory failed" );
@ -719,7 +708,7 @@ static char *myrealpath( const char *path, char *out)
char *
Yap_AbsoluteFile(const char *spec, char *tmp)
{
char *rc;
char o[YAP_FILENAME_MAX+1];
#if _WIN32 || defined(__MINGW32__)
@ -777,7 +766,7 @@ absolute_file_name( USES_REGS1 )
const char *fp;
bool rc;
char s[MAXPATHLEN+1];
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "absolute_file_name");
return false;
@ -796,18 +785,29 @@ absolute_file_name( USES_REGS1 )
static Int
prolog_to_os_filename( USES_REGS1 )
{
Term t = Deref(ARG1);
const char *fp;
Term t = Deref(ARG1), t2 = Deref(ARG2);
char *fp;
char out[MAXPATHLEN+1];
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "absolute_file_name");
return false;
if (IsVarTerm(t)) {
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t, "prolog_to_os_filename");
return false;
} else if ( IsAtomTerm(t2) ) {
if (!(fp = PrologPath( RepAtom(AtomOfTerm(t2))->StrOfAE, out)))
return false;
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom( fp )));
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "prolog_to_os_filename");
return false;
}
} else if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_name");
Yap_Error(TYPE_ERROR_ATOM, t, "prolog_to_os_filename");
return false;
}
if (!(fp = OsPath( RepAtom(AtomOfTerm(t))->StrOfAE, out)))
if (!(fp = OsPath( RepAtom(AtomOfTerm(t))->StrOfAE, out)))
return false;
return Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2);
}
@ -839,6 +839,42 @@ Atom Yap_TemporaryFile( const char *prefix, int *fd) {
#endif
}
/** @pred make_directory(+ _Dir_)
Create a directory _Dir_. The name of the directory must be an atom.
*/
static Int
make_directory( USES_REGS1 )
{
const char *fd = AtomName(AtomOfTerm(ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_mkdir(fd) == -1) {
#else
if (mkdir(fd, 0777) == -1) {
#endif
/* return an error number */
return false; // errno?
}
return true;
}
static Int
p_rmdir( USES_REGS1 )
{
const char *fd = AtomName(AtomOfTerm(ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_rmdir(fd) == -1) {
#else
if (rmdir(fd) == -1) {
#endif
/* return an error number */
return(Yap_unify(ARG2, MkIntTerm(errno)));
}
return true;
}
static bool
initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) {
CACHE_REGS
@ -1837,10 +1873,10 @@ Srandom ( USES_REGS1 )
current_seed = (unsigned int) FloatOfTerm (t0);
else
current_seed = (unsigned int) LongIntOfTerm (t0);
#if HAVE_SRAND48
srand48(current_seed);
#elif HAVE_SRANDOM
srandom(current_seed);
#if HAVE_SRAND48
srand48(current_seed);
#elif HAVE_SRANDOM
srandom(current_seed);
#elif HAVE_SRAND
srand(current_seed);
@ -2398,7 +2434,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
t2 = Deref(ARG2);
if ( IsVarTerm( t2 ) ) {
Yap_Error(INSTANTIATION_ERROR, t2, "working_directory");
}
}
if ( !IsAtomTerm(t2) ) {
Yap_Error(TYPE_ERROR_ATOM, t2, "working_directory");
}
@ -2428,8 +2464,8 @@ MSCHandleSignal(DWORD dwCtrlType) {
}
/** Yap_trueFileName: tries to generate the true name of file
*
*
*
*
* @param isource the proper file
* @param idef the default name fo rthe file, ie, startup.yss
* @param root the prefix
@ -2438,26 +2474,26 @@ MSCHandleSignal(DWORD dwCtrlType) {
* @param ftype saved state, object, saved file, prolog file
* @param expand_root expand $ ~, etc
* @param in_lib library file
*
* @return
*
* @return
*/
bool
Yap_trueFileName (const char *isource, const char * idef, const char *iroot, char *result, bool access, file_type_t ftype, bool expand_root, bool in_lib)
{
char save_buffer[YAP_FILENAME_MAX+1];
char save_buffer[YAP_FILENAME_MAX+1];
const char *root, *source = isource;
int rc = FAIL_RESTORE;
int try = 0;
while ( rc == FAIL_RESTORE) {
bool done = false;
// { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "try=%d %s %s", try, isource, iroot) ; }
// { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "try=%d %s %s", try, isource, iroot) ; }
switch (try++) {
case 0: // path or file name is given;
root = iroot;
if (iroot || isource) {
source = ( isource ? isource : idef ) ;
root = iroot;
if (iroot || isource) {
source = ( isource ? isource : idef ) ;
} else {
done = true;
}
@ -2465,7 +2501,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
case 1: // library directory is given in command line
if ( in_lib && ftype == YAP_SAVED_STATE) {
root = iroot;
source = ( isource ? isource : idef ) ;
source = ( isource ? isource : idef ) ;
} else
done = true;
break;
@ -2473,11 +2509,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
#if HAVE_GETENV
if ( in_lib) {
if (ftype == YAP_SAVED_STATE || ftype == YAP_OBJ) {
root = getenv("YAPLIBDIR");
root = getenv("YAPLIBDIR");
} else {
root = getenv("YAPSHAREDIR");
}
source = ( isource ? isource : idef ) ;
source = ( isource ? isource : idef ) ;
} else
done = true;
break;
@ -2487,7 +2523,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
break;
case 3: // use compilation variable YAPLIBDIR
if ( in_lib) {
source = ( isource ? isource : idef ) ;
source = ( isource ? isource : idef ) ;
if (ftype == YAP_PL || ftype == YAP_QLY) {
root = YAP_SHAREDIR;
} else {
@ -2499,7 +2535,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
case 4: // WIN stuff: registry
#if __WINDOWS__
if ( in_lib) {
if ( in_lib) {
source = ( ftype == YAP_PL || ftype == YAP_QLY ? "library" : "startup" ) ;
source = Yap_RegistryGetString( source );
root = NULL;
@ -2520,7 +2556,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
source = ( ftype == YAP_SAVED_STATE || ftype == YAP_OBJ ? "../../lib/Yap" : "../../share/Yap" ) ;
if (Yap_trueFileName(source, NULL, pt, save_buffer, access, ftype, expand_root, in_lib) )
root = save_buffer;
else
else
done = true;
} else {
done = true;
@ -2536,7 +2572,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
default:
return false;
}
if (done)
continue;
if (expand_root && root) {
@ -2544,7 +2580,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
}
// { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "root= %s %s ", root, source) ; }
char *work = expandWithPrefix( source, root, result );
// expand names in case you have
// to add a prefix
if ( !access || exists( work ) )
@ -2556,13 +2592,13 @@ MSCHandleSignal(DWORD dwCtrlType) {
int
Yap_TrueFileName (const char *source, char *result, int in_lib)
{
return Yap_trueFileName (source, NULL, NULL, result, true, YAP_PL, true, in_lib);
return Yap_trueFileName (source, NULL, NULL, result, true, YAP_PL, true, in_lib);
}
int
Yap_TruePrefixedFileName (const char *source, const char *root, char *result, int in_lib)
{
return Yap_trueFileName (source, NULL, root, result, true, YAP_PL, true, in_lib);
return Yap_trueFileName (source, NULL, root, result, true, YAP_PL, true, in_lib);
}
static Int
@ -2578,7 +2614,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name");
return FALSE;
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, true, YAP_PL, false, false))
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, true, YAP_PL, false, false))
return FALSE;
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
}
@ -2596,7 +2632,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name");
return FALSE;
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, true, YAP_PL, true, false))
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, true, YAP_PL, true, false))
return false;
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
}
@ -2622,7 +2658,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
}
root = RepAtom(AtomOfTerm(t2))->StrOfAE;
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, root, LOCAL_FileNameBuf, true, YAP_PL, false, false))
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, root, LOCAL_FileNameBuf, true, YAP_PL, false, false))
return FALSE;
return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
}
@ -2860,9 +2896,9 @@ MSCHandleSignal(DWORD dwCtrlType) {
} else if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
}
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
return FALSE;
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t2))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t2))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
return FALSE;
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
unlink (newname);
@ -3717,7 +3753,9 @@ MSCHandleSignal(DWORD dwCtrlType) {
CurrentModule = OPERATING_SYSTEM_MODULE;
Yap_InitCPred ("true_file_name", 2, p_true_file_name, SyncPredFlag);
Yap_InitCPred ("true_file_name", 3, p_true_file_name3, SyncPredFlag);
Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag);
CurrentModule = cm;
Yap_InitCPred ("make_directory", 1, make_directory, SyncPredFlag);
}

41
os/writeterm.c
View File

@ -290,6 +290,7 @@ write_term ( int output_stream, Term t, xarg *args USES_REGS )
prio = 1200;
}
Yap_plwrite( t, GLOBAL_Stream+output_stream, depth, flags, prio);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
rc = true;
end:
@ -313,7 +314,9 @@ write_term2 ( USES_REGS1 )
return false;
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1;
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -333,10 +336,11 @@ write_term3 ( USES_REGS1 )
we cannot make recursive Prolog calls */
yhandle_t mySlots = Yap_StartSlots();
xarg *args = Yap_ArgListToVector ( ARG3, write_defs, WRITE_END );
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
if (args == NULL)
return false;
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
write_term( output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -357,10 +361,11 @@ write2 ( USES_REGS1 )
yhandle_t mySlots = Yap_StartSlots();
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
if (args == NULL)
return false;
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
write_term( output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -383,7 +388,9 @@ write1 ( USES_REGS1 )
xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
if (args == NULL)
return false;
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -410,7 +417,9 @@ write_canonical1 ( USES_REGS1 )
args[WRITE_IGNORE_OPS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -429,14 +438,15 @@ write_canonical ( USES_REGS1 )
we cannot make recursive Prolog calls */
yhandle_t mySlots = Yap_StartSlots();
xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
if (args == NULL)
if (args == NULL)
return false;
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
args[WRITE_IGNORE_OPS].used = true;
args[WRITE_IGNORE_OPS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
write_term( output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -462,7 +472,9 @@ writeq1 ( USES_REGS1 )
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
write_term( output_stream, ARG1, args PASS_REGS);
Yap_CloseSlots( mySlots );
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
EX = NULL;
@ -481,14 +493,15 @@ writeq ( USES_REGS1 )
we cannot make recursive Prolog calls */
yhandle_t mySlots = Yap_StartSlots();
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
if (args == NULL)
return false;
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
write_term( output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -516,8 +529,10 @@ print1 ( USES_REGS1 )
args[WRITE_PORTRAY].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG2, args PASS_REGS);
Yap_CloseSlots( mySlots );
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
EX = NULL;
@ -536,14 +551,15 @@ print ( USES_REGS1 )
we cannot make recursive Prolog calls */
yhandle_t mySlots = Yap_StartSlots();
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
if (args == NULL)
return false;
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2");
args[WRITE_PORTRAY].used = true;
args[WRITE_PORTRAY].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term( output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -568,7 +584,9 @@ writeln1 ( USES_REGS1 )
return false;
args[WRITE_NL].used = true;
args[WRITE_NL].tvalue = TermTrue;
write_term( output_stream, ARG1, args PASS_REGS);
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);
@ -588,12 +606,15 @@ writeln ( USES_REGS1 )
we cannot make recursive Prolog calls */
yhandle_t mySlots = Yap_StartSlots();
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
if (args == NULL )
return false;
int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "writeln/2");
if (args == NULL || output_stream < 0)
if (output_stream < 0)
return false;
args[WRITE_NL].used = true;
args[WRITE_NL].tvalue = TermTrue;
write_term( output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
if (EX != 0L) {
Term ball = Yap_PopTermFromDB(EX);

3
os/yapio.h
View File

@ -157,7 +157,7 @@ typedef enum mem_buf_source {
} memBufSource;
struct mem_desc *Yap_MemExportStreamPtrs( int sno );
extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings_p);
extern Term Yap_StringToNumberTerm(char *s, encoding_t encp);
int Yap_FormatFloat(Float f, const char *s, size_t sz);
@ -214,4 +214,3 @@ WideHashFunction(wchar_t *CHP)
}
#endif