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

new error handlong mechanism

Browse Source 
new YAP_ foreign interface
fix unbound_first_arg in call_with_args


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@582 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2002-09-09 17:40:12 +00:00
parent 708437b794
commit 21aab28a59
40 changed files with 1799 additions and 2383 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
library/random/random.c
View File

@@ -16,7 +16,7 @@
*************************************************************************/
#include "config.h"
#include "c_interface.h"
#include "YapInterface.h"
#include <math.h>
#if defined(__MINGW32__) || _MSC_VER
#include <windows.h>
@@ -29,8 +29,8 @@ static short a1 = 27314, b1 = 9213, c1 = 17773;
static int
p_random(void)
{
flt fli;
Int t1, t2, t3;
double fli;
long int t1, t2, t3;
t1 = (a1 * 171) % 30269;
t2 = (b1 * 172) % 30307;
@@ -39,32 +39,32 @@ p_random(void)
a1 = t1;
b1 = t2;
c1 = t3;
return(unify(ARG1, MkFloatTerm(fli-(int)(fli))));
return(YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli-(int)(fli))));
}
static int
p_setrand(void)
{
a1 = IntOfTerm(ARG1);
b1 = IntOfTerm(ARG2);
c1 = IntOfTerm(ARG3);
a1 = YAP_IntOfTerm(YAP_ARG1);
b1 = YAP_IntOfTerm(YAP_ARG2);
c1 = YAP_IntOfTerm(YAP_ARG3);
return(TRUE);
}
static int
p_getrand(void)
{
return(unify(ARG1,MkIntTerm(a1)) &&
unify(ARG2,MkIntTerm(b1)) &&
unify(ARG3,MkIntTerm(c1)));
return(YAP_Unify(YAP_ARG1,YAP_MkIntTerm(a1)) &&
YAP_Unify(YAP_ARG2,YAP_MkIntTerm(b1)) &&
YAP_Unify(YAP_ARG3,YAP_MkIntTerm(c1)));
}
void
init_random(void)
{
UserCPredicate("random", p_random, 1);
UserCPredicate("setrand", p_setrand, 3);
UserCPredicate("getrand", p_getrand, 3);
YAP_UserCPredicate("random", p_random, 1);
YAP_UserCPredicate("setrand", p_setrand, 3);
YAP_UserCPredicate("getrand", p_getrand, 3);
}
#ifdef _WIN32

92
library/regex/regexp.c
View File

@@ -19,7 +19,7 @@
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#include "c_interface.h"
#include "YapInterface.h"
#if HAVE_REGEX_H
#include "regex.h"
#define yap_regcomp(A,B,C) regcomp(A,B,C)
@@ -36,20 +36,21 @@ void PROTO(init_regexp, (void));
static int check_regexp(void)
{
unsigned int buflen = (unsigned int)IntOfTerm(ARG2)+1;
unsigned int sbuflen = (unsigned int)IntOfTerm(ARG4)+1;
unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1;
unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1;
char *buf, *sbuf;
regex_t reg;
int out;
int yap_flags = IntOfTerm(ARG5), regcomp_flags = REG_NOSUB|REG_EXTENDED;
int yap_flags = YAP_IntOfTerm(YAP_ARG5);
int regcomp_flags = REG_NOSUB|REG_EXTENDED;
if ((buf = (char *)AllocSpaceFromYap(buflen)) == NULL) {
if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) {
/* early exit */
return(FALSE);
}
if (StringToBuffer(ARG1,buf,buflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) {
/* something went wrong, possibly a type checking error */
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (yap_flags & 1)
@@ -57,23 +58,23 @@ static int check_regexp(void)
/* cool, now I have my string in the buffer, let's have some fun */
if (yap_regcomp(&reg,buf, regcomp_flags) != 0)
return(FALSE);
if ((sbuf = (char *)AllocSpaceFromYap(sbuflen)) == NULL) {
if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) {
/* early exit */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (StringToBuffer(ARG3,sbuf,sbuflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) {
/* something went wrong, possibly a type checking error */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
return(FALSE);
}
out = yap_regexec(&reg,sbuf,0,NULL,0);
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
if (out != 0 && out != REG_NOMATCH) {
return(FALSE);
}
@@ -82,23 +83,24 @@ static int check_regexp(void)
static int regexp(void)
{
unsigned int buflen = (unsigned int)IntOfTerm(ARG2)+1;
unsigned int sbuflen = (unsigned int)IntOfTerm(ARG4)+1;
unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1;
unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1;
char *buf, *sbuf;
regex_t reg;
int out;
Int nmatch = IntOfTerm(ARG7);
long int nmatch = YAP_IntOfTerm(YAP_ARG7);
regmatch_t *pmatch;
Term tout;
int yap_flags = IntOfTerm(ARG5), regcomp_flags = REG_EXTENDED;
long int tout;
int yap_flags = YAP_IntOfTerm(YAP_ARG5);
int regcomp_flags = REG_EXTENDED;
if ((buf = (char *)AllocSpaceFromYap(buflen)) == NULL) {
if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) {
/* early exit */
return(FALSE);
}
if (StringToBuffer(ARG1,buf,buflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) {
/* something went wrong, possibly a type checking error */
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (yap_flags & 1)
@@ -106,62 +108,62 @@ static int regexp(void)
/* cool, now I have my string in the buffer, let's have some fun */
if (yap_regcomp(&reg,buf, regcomp_flags) != 0)
return(FALSE);
if ((sbuf = (char *)AllocSpaceFromYap(sbuflen)) == NULL) {
if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) {
/* early exit */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (StringToBuffer(ARG3,sbuf,sbuflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) {
/* something went wrong, possibly a type checking error */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
return(FALSE);
}
pmatch = AllocSpaceFromYap(sizeof(regmatch_t)*nmatch);
pmatch = YAP_AllocSpaceFromYap(sizeof(regmatch_t)*nmatch);
out = yap_regexec(&reg,sbuf,(int)nmatch,pmatch,0);
if (out == 0) {
/* match succeed, let's fill the match in */
Int i;
Term TNil = MkAtomTerm(LookupAtom("[]"));
Functor FDiff = MkFunctor(LookupAtom("-"),2);
long int i;
YAP_Term TNil = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
YAP_Functor FDiff = YAP_MkFunctor(YAP_LookupAtom("-"),2);
tout = ARG6;
tout = YAP_ARG6;
for (i = 0; i < nmatch; i++) {
int j;
Term t = TNil;
YAP_Term t = TNil;
if (pmatch[i].rm_so == -1) break;
if (yap_flags & 2) {
Term to[2];
to[0] = MkIntTerm(pmatch[i].rm_so);
to[1] = MkIntTerm(pmatch[i].rm_eo);
t = MkApplTerm(FDiff,2,to);
YAP_Term to[2];
to[0] = YAP_MkIntTerm(pmatch[i].rm_so);
to[1] = YAP_MkIntTerm(pmatch[i].rm_eo);
t = YAP_MkApplTerm(FDiff,2,to);
} else {
for (j = pmatch[i].rm_eo-1; j >= pmatch[i].rm_so; j--) {
t = MkPairTerm(MkIntTerm(sbuf[j]),t);
t = YAP_MkPairTerm(YAP_MkIntTerm(sbuf[j]),t);
}
}
unify(t,HeadOfTerm(tout));
tout = TailOfTerm(tout);
YAP_Unify(t,YAP_HeadOfTerm(tout));
tout = YAP_TailOfTerm(tout);
}
}
else if (out != REG_NOMATCH) {
return(FALSE);
}
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
FreeSpaceFromYap(pmatch);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(pmatch);
return(out == 0);
}
void
init_regexp(void)
{
UserCPredicate("check_regexp", check_regexp, 5);
UserCPredicate("check_regexp", regexp, 7);
YAP_UserCPredicate("check_regexp", check_regexp, 5);
YAP_UserCPredicate("check_regexp", regexp, 7);
}
#if defined(_WIN32) || defined(__MINGW32__)

370
library/system/sys.c
View File

@@ -16,7 +16,7 @@
*************************************************************************/
#include "config.h"
#include "c_interface.h"
#include "YapInterface.h"
#if STDC_HEADERS
#include <stdlib.h>
#endif
@@ -70,7 +70,7 @@
void PROTO(init_sys, (void));
#if defined(__MINGW32__) || _MSC_VER
static Term
static YAP_Term
WinError(void)
{
char msg[256];
@@ -79,7 +79,7 @@ WinError(void)
NULL, GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
NULL);
return(MkAtomTerm(LookupAtom(msg)));
return(YAP_MkAtomTerm(YAP_LookupAtom(msg)));
}
#endif
@@ -87,34 +87,34 @@ WinError(void)
static int
datime(void)
{
Term tf, out[6];
YAP_Term tf, out[6];
#if defined(__MINGW32__) || _MSC_VER
SYSTEMTIME stime;
GetLocalTime(&stime);
out[0] = MkIntTerm(stime.wYear);
out[1] = MkIntTerm(stime.wMonth);
out[2] = MkIntTerm(stime.wDay);
out[3] = MkIntTerm(stime.wHour);
out[4] = MkIntTerm(stime.wMinute);
out[5] = MkIntTerm(stime.wSecond);
out[0] = YAP_MkIntTerm(stime.wYear);
out[1] = YAP_MkIntTerm(stime.wMonth);
out[2] = YAP_MkIntTerm(stime.wDay);
out[3] = YAP_MkIntTerm(stime.wHour);
out[4] = YAP_MkIntTerm(stime.wMinute);
out[5] = YAP_MkIntTerm(stime.wSecond);
#elif HAVE_TIME
time_t tp;
if ((tp = time(NULL)) == -1) {
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
#ifdef HAVE_LOCALTIME
{
struct tm *loc = localtime(&tp);
if (loc == NULL) {
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
out[0] = MkIntTerm(1900+loc->tm_year);
out[1] = MkIntTerm(1+loc->tm_mon);
out[2] = MkIntTerm(loc->tm_mday);
out[3] = MkIntTerm(loc->tm_hour);
out[4] = MkIntTerm(loc->tm_min);
out[5] = MkIntTerm(loc->tm_sec);
out[0] = YAP_MkIntTerm(1900+loc->tm_year);
out[1] = YAP_MkIntTerm(1+loc->tm_mon);
out[2] = YAP_MkIntTerm(loc->tm_mday);
out[3] = YAP_MkIntTerm(loc->tm_hour);
out[4] = YAP_MkIntTerm(loc->tm_min);
out[5] = YAP_MkIntTerm(loc->tm_sec);
}
#else
oops
@@ -122,8 +122,8 @@ datime(void)
#else
oops
#endif /* HAVE_TIME */
tf = MkApplTerm(MkFunctor(LookupAtom("datime"),6), 6, out);
return(unify(ARG1, tf));
tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out);
return(YAP_Unify(YAP_ARG1, tf));
}
#define BUF_SIZE 1024
@@ -132,9 +132,9 @@ datime(void)
static int
list_directory(void)
{
Term tf = MkAtomTerm(LookupAtom("[]"));
YAP_Term tf = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
char *buf = AtomName(AtomOfTerm(ARG1));
char *buf = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
struct _finddata_t c_file;
char bs[BUF_SIZE];
@@ -152,12 +152,12 @@ list_directory(void)
strncat(bs, "/*");
#endif
if ((hFile = _findfirst(bs, &c_file)) == -1L) {
return(unify(ARG2,tf));
return(YAP_Unify(YAP_ARG2,tf));
}
tf = MkPairTerm(MkAtomTerm(LookupAtom(c_file.name)), tf);
tf = YAP_MkPairTerm(YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)), tf);
while (_findnext( hFile, &c_file) == 0) {
Term ti = MkAtomTerm(LookupAtom(c_file.name));
tf = MkPairTerm(ti, tf);
YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(c_file.name));
tf = YAP_MkPairTerm(ti, tf);
}
_findclose( hFile );
#else
@@ -167,23 +167,23 @@ list_directory(void)
struct dirent *dp;
if ((de = opendir(buf)) == NULL) {
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
while ((dp = readdir(de))) {
Term ti = MkAtomTerm(LookupAtom(dp->d_name));
tf = MkPairTerm(ti, tf);
YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp->d_name));
tf = YAP_MkPairTerm(ti, tf);
}
closedir(de);
}
#endif /* HAVE_OPENDIR */
#endif
return(unify(ARG2, tf));
return(YAP_Unify(YAP_ARG2, tf));
}
static int
p_unlink(void)
{
char *fd = AtomName(AtomOfTerm(ARG1));
char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_unlink(fd) == -1)
#else
@@ -191,7 +191,7 @@ p_unlink(void)
#endif
{
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
@@ -199,14 +199,14 @@ p_unlink(void)
static int
p_mkdir(void)
{
char *fd = AtomName(AtomOfTerm(ARG1));
char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_mkdir(fd) == -1) {
#else
if (mkdir(fd, 0777) == -1) {
#endif
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
@@ -214,14 +214,14 @@ p_mkdir(void)
static int
p_rmdir(void)
{
char *fd = AtomName(AtomOfTerm(ARG1));
char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_rmdir(fd) == -1) {
#else
if (rmdir(fd) == -1) {
#endif
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
@@ -229,12 +229,12 @@ p_rmdir(void)
static int
rename_file(void)
{
char *s1 = AtomName(AtomOfTerm(ARG1));
char *s2 = AtomName(AtomOfTerm(ARG2));
char *s1 = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
char *s2 = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2));
#if HAVE_RENAME
if (rename(s1, s2) == -1) {
/* return an error number */
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
#endif
return(TRUE);
@@ -243,7 +243,7 @@ rename_file(void)
static int
dir_separator(void)
{
return(unify(ARG1,MkAtomTerm(LookupAtom("/"))));
return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/"))));
}
static int
@@ -253,75 +253,75 @@ file_property(void)
#if HAVE_LSTAT
struct stat buf;
fd = AtomName(AtomOfTerm(ARG1));
fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
if (lstat(fd, &buf) == -1) {
/* return an error number */
return(unify(ARG7, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno)));
}
if (S_ISREG(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("regular"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else if (S_ISDIR(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("directory"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else if (S_ISFIFO(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("fifo"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("fifo"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else if (S_ISLNK(buf.st_mode)) {
if (!unify(ARG2, MkAtomTerm(LookupAtom("symlink"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("symlink"))))
return(FALSE);
#if HAVE_READLINK
{
char tmp[256];
int n;
if ((n = readlink(fd,tmp,256)) == -1) {
return(unify(ARG7, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno)));
}
tmp[n] = '\0';
if(!unify(ARG6,MkAtomTerm(LookupAtom(tmp)))) {
if(!YAP_Unify(YAP_ARG6,YAP_MkAtomTerm(YAP_LookupAtom(tmp)))) {
return(FALSE);
}
}
#else
if (!unify(ARG6, YapMkIntTerm(0)))
if (!YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))
return(FALSE);
#endif
} else if (S_ISSOCK(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("socket"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("socket"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("unknown"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
}
#elif defined(__MINGW32__) || _MSC_VER
/* for some weird reason _stat did not work with mingw32 */
struct stat buf;
fd = AtomName(AtomOfTerm(ARG1));
fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
if (stat(fd, &buf) != 0) {
/* return an error number */
return(unify(ARG7, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno)));
}
if (buf.st_mode & S_IFREG) {
if (!unify(ARG2, MkAtomTerm(LookupAtom("regular"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))))
return(FALSE);
} else if (buf.st_mode & S_IFDIR) {
if (!unify(ARG2, MkAtomTerm(LookupAtom("directory"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))))
return(FALSE);
} else {
if (!unify(ARG2, MkAtomTerm(LookupAtom("unknown"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))))
return(FALSE);
}
#endif
return (
unify(ARG3, MkIntTerm(buf.st_size)) &&
unify(ARG4, MkIntTerm(buf.st_mtime)) &&
unify(ARG5, MkIntTerm(buf.st_mode))
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(buf.st_size)) &&
YAP_Unify(YAP_ARG4, YAP_MkIntTerm(buf.st_mtime)) &&
YAP_Unify(YAP_ARG5, YAP_MkIntTerm(buf.st_mode))
);
}
@@ -332,7 +332,7 @@ p_mktemp(void)
{
#if HAVE_MKTEMP
char *s, tmp[BUF_SIZE];
s = AtomName(AtomOfTerm(ARG1));
s = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if HAVE_STRNCPY
strncpy(tmp, s, BUF_SIZE);
#else
@@ -344,9 +344,9 @@ p_mktemp(void)
if ((s = mktemp(tmp)) == NULL) {
#endif
/* return an error number */
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
return(unify(ARG2,MkAtomTerm(LookupAtom(s))));
return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s))));
#else
oops
#endif
@@ -357,7 +357,7 @@ static int
p_tpmnam(void)
{
#if HAVE_TMPNAM
return(unify(ARG1,MkAtomTerm(LookupAtom(tmpnam(NULL)))));
return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(tmpnam(NULL)))));
#else
oops
#endif
@@ -373,10 +373,10 @@ p_environ(void)
#else
extern char **environ;
#endif
Term t1 = ARG1;
Int i;
YAP_Term t1 = YAP_ARG1;
long int i;
i = IntOfTerm(t1);
i = YAP_IntOfTerm(t1);
#if defined(__MINGW32__) || _MSC_VER
if (_environ[i] == NULL)
#else
@@ -384,20 +384,20 @@ p_environ(void)
#endif
return(FALSE);
else {
Term t = BufferToString(environ[i]);
return(unify(t, ARG2));
YAP_Term t = YAP_BufferToString(environ[i]);
return(YAP_Unify(t, YAP_ARG2));
}
#else
YapError("environ not available in this configuration");
YAP_Error("environ not available in this configuration");
return(FALSE);
#endif
}
#if defined(__MINGW32__) || _MSC_VER
static HANDLE
get_handle(Term ti, DWORD fd)
get_handle(YAP_Term ti, DWORD fd)
{
if (IsAtomTerm(ti)) {
if (YAP_IsAtomTerm(ti)) {
HANDLE out;
SECURITY_ATTRIBUTES satt;
@@ -413,17 +413,17 @@ get_handle(Term ti, DWORD fd)
NULL);
return(out);
} else {
if (IsIntTerm(ti)) {
if (YAP_IsIntTerm(ti)) {
return(GetStdHandle(fd));
} else
return((HANDLE)YapStreamToFileNo(ti));
return((HANDLE)YAP_StreamToFileNo(ti));
}
}
static void
close_handle(Term ti, HANDLE h)
close_handle(YAP_Term ti, HANDLE h)
{
if (IsAtomTerm(ti)) {
if (YAP_IsAtomTerm(ti)) {
CloseHandle(h);
}
}
@@ -434,7 +434,7 @@ close_handle(Term ti, HANDLE h)
static int
execute_command(void)
{
Term ti = ARG2, to = ARG3, te = ARG4;
YAP_Term ti = YAP_ARG2, to = YAP_ARG3, te = YAP_ARG4;
int res;
#if defined(__MINGW32__) || _MSC_VER
HANDLE inpf, outf, errf;
@@ -443,20 +443,20 @@ execute_command(void)
PROCESS_INFORMATION ProcessInformation;
inpf = get_handle(ti, STD_INPUT_HANDLE);
if (inpf == INVALID_HANDLE_VALUE) {
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
outf = get_handle(to, STD_OUTPUT_HANDLE);
if (outf == INVALID_HANDLE_VALUE) {
close_handle(ti, inpf);
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
errf = get_handle(te, STD_OUTPUT_HANDLE);
if (errf == INVALID_HANDLE_VALUE) {
close_handle(ti, inpf);
close_handle(to, outf);
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
if (!IsIntTerm(ti) && !IsIntTerm(to) && !IsIntTerm(te)) {
if (!YAP_IsIntTerm(ti) && !YAP_IsIntTerm(to) && !YAP_IsIntTerm(te)) {
/* we do not keep a current stream */
CreationFlags = DETACHED_PROCESS;
}
@@ -472,7 +472,7 @@ execute_command(void)
StartupInfo.hStdError = errf;
/* got stdin, stdout and error as I like it */
if (CreateProcess(NULL,
AtomName(AtomOfTerm(ARG1)),
YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)),
NULL,
NULL,
TRUE,
@@ -484,62 +484,62 @@ execute_command(void)
close_handle(ti, inpf);
close_handle(to, outf);
close_handle(te, errf);
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
close_handle(ti, inpf);
close_handle(to, outf);
close_handle(te, errf);
res = ProcessInformation.dwProcessId;
return(unify(ARG5,MkIntTerm(res)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res)));
#else /* UNIX CODE */
int inpf, outf, errf;
/* process input first */
if (IsAtomTerm(ti)) {
if (YAP_IsAtomTerm(ti)) {
inpf = open("/dev/null", O_RDONLY);
} else {
int sd;
if (IsIntTerm(ti))
if (YAP_IsIntTerm(ti))
sd = 0;
else
sd = YapStreamToFileNo(ti);
sd = YAP_StreamToFileNo(ti);
inpf = dup(sd);
}
if (inpf < 0) {
/* return an error number */
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
}
/* then output stream */
if (IsAtomTerm(to)) {
if (YAP_IsAtomTerm(to)) {
outf = open("/dev/zero", O_WRONLY);
} else {
int sd;
if (IsIntTerm(to))
if (YAP_IsIntTerm(to))
sd = 1;
else
sd = YapStreamToFileNo(to);
sd = YAP_StreamToFileNo(to);
outf = dup(sd);
}
if (outf < 0) {
/* return an error number */
close(inpf);
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
}
/* then error stream */
if (IsAtomTerm(te)) {
if (YAP_IsAtomTerm(te)) {
errf = open("/dev/zero", O_WRONLY);
} else {
int sd;
if (IsIntTerm(te))
if (YAP_IsIntTerm(te))
sd = 2;
else
sd = YapStreamToFileNo(te);
sd = YAP_StreamToFileNo(te);
errf = dup(sd);
}
if (errf < 0) {
/* return an error number */
close(inpf);
close(outf);
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
}
/* we are now ready to fork */
if ((res = fork()) < 0) {
@@ -548,13 +548,13 @@ execute_command(void)
close(outf);
close(errf);
/* return an error number */
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
} else if (res == 0) {
char *argv[4];
/* child */
/* close current streams, but not std streams */
YapCloseAllOpenStreams();
YAP_CloseAllOpenStreams();
close(0);
dup(inpf);
close(inpf);
@@ -566,7 +566,7 @@ execute_command(void)
close(errf);
argv[0] = "sh";
argv[1] = "-c";
argv[2] = AtomName(AtomOfTerm(ARG1));
argv[2] = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
argv[3] = NULL;
execv("/bin/sh", argv);
exit(127);
@@ -575,7 +575,7 @@ execute_command(void)
close(inpf);
close(outf);
close(errf);
return(unify(ARG5,MkIntTerm(res)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res)));
}
#endif /* UNIX code */
}
@@ -584,15 +584,15 @@ execute_command(void)
static int
do_system(void)
{
char *command = AtomName(AtomOfTerm(ARG1));
char *command = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if HAVE_SYSTEM
int sys = system(command);
if (sys < 0) {
return(unify(ARG3,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3,YAP_MkIntTerm(errno)));
}
return(unify(ARG2, MkIntTerm(sys)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(sys)));
#else
YapError("system not available in this configuration");
YAP_Error("system not available in this configuration");
return(FALSE);
#endif
}
@@ -604,35 +604,35 @@ static int
do_shell(void)
{
#if defined(__MINGW32__) || _MSC_VER
char *buf = YapAllocSpaceFromYap(BUF_SIZE);
char *buf = YAP_AllocSpaceFromYap(BUF_SIZE);
int sys;
if (buf == NULL) {
YapError("No Temporary Space for Shell");
YAP_Error("No Temporary Space for Shell");
return(FALSE);
}
#if HAVE_STRNCPY
strncpy(YapAtomName(AtomOfTerm(ARG1)), buf, BUF_SIZE);
strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), buf, BUF_SIZE);
strncpy(" ", buf, BUF_SIZE);
strncpy(YapAtomName(AtomOfTerm(ARG2)), buf, BUF_SIZE);
strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), buf, BUF_SIZE);
strncpy(" ", buf, BUF_SIZE);
strncpy(YapAtomName(AtomOfTerm(ARG3)), buf, BUF_SIZE);
strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), buf, BUF_SIZE);
#else
strcpy(YapAtomName(AtomOfTerm(ARG1)), buf);
strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), buf);
strcpy(" ", buf);
strcpy(YapAtomName(AtomOfTerm(ARG2)), buf);
strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), buf);
strcpy(" ", buf);
strcpy(YapAtomName(AtomOfTerm(ARG3)), buf);
strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), buf);
#endif
#if HAVE_SYSTEM
sys = system(buf);
YapFreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
if (sys < 0) {
return(unify(ARG5,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)));
}
return(unify(ARG4, MkIntTerm(sys)));
return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)));
#else
YapError("system not available in this configuration");
YAP_Error("system not available in this configuration");
return(FALSE);
#endif
#else
@@ -640,23 +640,23 @@ do_shell(void)
int t;
int sys;
cptr[0]= YapAtomName(AtomOfTerm(ARG1));
cptr[1]= YapAtomName(AtomOfTerm(ARG2));
cptr[2]= YapAtomName(AtomOfTerm(ARG3));
cptr[0]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
cptr[1]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2));
cptr[2]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3));
cptr[3]= NULL;
t = fork();
if (t < 0) {
return(unify(ARG5,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)));
} else if (t == 0) {
t = execvp(YapAtomName(AtomOfTerm(ARG1)),cptr);
t = execvp(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)),cptr);
return(t);
} else {
t = wait(&sys);
if (t < 0) {
return(unify(ARG5,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)));
}
}
return(unify(ARG4, MkIntTerm(sys)));
return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)));
#endif
}
@@ -664,21 +664,21 @@ do_shell(void)
static int
p_wait(void)
{
Int pid = IntOfTerm(ARG1);
long int pid = YAP_IntOfTerm(YAP_ARG1);
#if defined(__MINGW32__) || _MSC_VER
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid);
DWORD ExitCode;
if (proc == NULL) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
if (GetExitCodeProcess(proc, &ExitCode) == 0) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
CloseHandle(proc);
return(unify(ARG2, MkIntTerm(ExitCode)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(ExitCode)));
#else
do {
int status;
@@ -687,9 +687,9 @@ p_wait(void)
if (waitpid(pid, &status, 0) == -1) {
if (errno != EINTR)
return -1;
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
} else {
return(unify(ARG2, MkIntTerm(status)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(status)));
}
} while(TRUE);
#endif
@@ -699,10 +699,10 @@ p_wait(void)
static int
p_popen(void)
{
char *command = AtomName(AtomOfTerm(ARG1));
Int mode = IntOfTerm(ARG2);
char *command = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
long int mode = YAP_IntOfTerm(YAP_ARG2);
FILE *pfd;
Term tsno;
YAP_Term tsno;
int flags;
#if HAVE_POPEN
@@ -719,29 +719,29 @@ p_popen(void)
pfd = popen(command, "w");
#endif
if (pfd == NULL) {
return(unify(ARG4, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(errno)));
}
if (mode == 0)
flags = YAP_INPUT_STREAM | YAP_POPEN_STREAM;
else
flags = YAP_OUTPUT_STREAM | YAP_POPEN_STREAM;
tsno = YapOpenStream((void *)pfd,
tsno = YAP_OpenStream((void *)pfd,
"pipe",
MkAtomTerm(LookupAtom("pipe")),
YAP_MkAtomTerm(YAP_LookupAtom("pipe")),
flags);
#endif
return(unify(ARG3, tsno));
return(YAP_Unify(YAP_ARG3, tsno));
}
static int
p_sleep(void)
{
Term ts = ARG1;
Int secs = 0, usecs = 0, out;
if (IsIntTerm(ts)) {
secs = IntOfTerm(ts);
} else if (IsFloatTerm(ts)) {
flt tfl = FloatOfTerm(ts);
YAP_Term ts = YAP_ARG1;
long int secs = 0, usecs = 0, out;
if (YAP_IsIntTerm(ts)) {
secs = YAP_IntOfTerm(ts);
} else if (YAP_IsFloatTerm(ts)) {
double tfl = YAP_FloatOfTerm(ts);
if (tfl > 1.0)
secs = tfl;
else
@@ -764,7 +764,7 @@ p_sleep(void)
}
#endif
#endif /* defined(__MINGW32__) || _MSC_VER */
return(unify(ARG2, MkIntTerm(out)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out)));
}
/* host info */
@@ -776,27 +776,27 @@ host_name(void)
char name[MAX_COMPUTERNAME_LENGTH+1];
DWORD nSize = MAX_COMPUTERNAME_LENGTH+1;
if (GetComputerName(name, &nSize) == 0) {
return(unify(ARG2, WinError()));
return(YAP_Unify(YAP_ARG2, WinError()));
}
#else
#if HAVE_GETHOSTNAME
char name[256];
if (gethostname(name, 256) == -1) {
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
#endif
#endif /* defined(__MINGW32__) || _MSC_VER */
return(unify(ARG1, MkAtomTerm(LookupAtom(name))));
return(YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(name))));
}
static int
host_id(void)
{
#if HAVE_GETHOSTID
return(unify(ARG1, MkIntTerm(gethostid())));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(gethostid())));
#else
return(unify(ARG1, MkIntTerm(0)));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(0)));
#endif
}
@@ -804,9 +804,9 @@ static int
pid(void)
{
#if defined(__MINGW32__) || _MSC_VER
return(unify(ARG1, MkIntTerm(_getpid())));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(_getpid())));
#else
return(unify(ARG1, MkIntTerm(getpid())));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(getpid())));
#endif
}
@@ -827,18 +827,18 @@ p_kill(void)
/* Windows does not support cross-process signals, so we shall do the
SICStus thing and assume that a signal to a process will
always kill it */
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, IntOfTerm(ARG1));
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, YAP_IntOfTerm(YAP_ARG1));
if (proc == NULL) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
if (TerminateProcess(proc, -1) == 0) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
CloseHandle(proc);
#else
if (kill(IntOfTerm(ARG1), IntOfTerm(ARG2)) < 0) {
if (kill(YAP_IntOfTerm(YAP_ARG1), YAP_IntOfTerm(YAP_ARG2)) < 0) {
/* return an error number */
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
#endif /* defined(__MINGW32__) || _MSC_VER */
return(TRUE);
@@ -848,10 +848,10 @@ static int
error_message(void)
{
#if HAVE_STRERROR
return(unify(ARG2,MkAtomTerm(LookupAtom(strerror(IntOfTerm(ARG1))))));
return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(strerror(YAP_IntOfTerm(YAP_ARG1))))));
#else
#if HAVE_STRERROR
return(unify(ARG2,ARG1));
return(YAP_Unify(YAP_ARG2,YAP_ARG1));
#endif
#endif
}
@@ -859,29 +859,29 @@ error_message(void)
void
init_sys(void)
{
UserCPredicate("datime", datime, 2);
UserCPredicate("list_directory", list_directory, 3);
UserCPredicate("file_property", file_property, 7);
UserCPredicate("unlink", p_unlink, 2);
UserCPredicate("mkdir", p_mkdir, 2);
UserCPredicate("rmdir", p_rmdir, 2);
UserCPredicate("dir_separator", dir_separator, 1);
UserCPredicate("p_environ", p_environ, 2);
UserCPredicate("exec_command", execute_command, 6);
UserCPredicate("do_shell", do_shell, 5);
UserCPredicate("do_system", do_system, 3);
UserCPredicate("popen", p_popen, 4);
UserCPredicate("wait", p_wait, 3);
UserCPredicate("host_name", host_name, 2);
UserCPredicate("host_id", host_id, 2);
UserCPredicate("pid", pid, 2);
UserCPredicate("kill", p_kill, 3);
UserCPredicate("mktemp", p_mktemp, 3);
UserCPredicate("tmpnam", p_tpmnam, 2);
UserCPredicate("rename_file", rename_file, 3);
UserCPredicate("sleep", p_sleep, 2);
UserCPredicate("error_message", error_message, 2);
UserCPredicate("win", win, 0);
YAP_UserCPredicate("datime", datime, 2);
YAP_UserCPredicate("list_directory", list_directory, 3);
YAP_UserCPredicate("file_property", file_property, 7);
YAP_UserCPredicate("unlink", p_unlink, 2);
YAP_UserCPredicate("mkdir", p_mkdir, 2);
YAP_UserCPredicate("rmdir", p_rmdir, 2);
YAP_UserCPredicate("dir_separator", dir_separator, 1);
YAP_UserCPredicate("p_environ", p_environ, 2);
YAP_UserCPredicate("exec_command", execute_command, 6);
YAP_UserCPredicate("do_shell", do_shell, 5);
YAP_UserCPredicate("do_system", do_system, 3);
YAP_UserCPredicate("popen", p_popen, 4);
YAP_UserCPredicate("wait", p_wait, 3);
YAP_UserCPredicate("host_name", host_name, 2);
YAP_UserCPredicate("host_id", host_id, 2);
YAP_UserCPredicate("pid", pid, 2);
YAP_UserCPredicate("kill", p_kill, 3);
YAP_UserCPredicate("mktemp", p_mktemp, 3);
YAP_UserCPredicate("tmpnam", p_tpmnam, 2);
YAP_UserCPredicate("rename_file", rename_file, 3);
YAP_UserCPredicate("sleep", p_sleep, 2);
YAP_UserCPredicate("error_message", error_message, 2);
YAP_UserCPredicate("win", win, 0);
}
#ifdef _WIN32

524
library/yap2swi/yap2swi.c
View File

File diff suppressed because it is too large Load Diff

8
library/yap2swi/yap2swi.h
View File

@@ -12,7 +12,7 @@
//=== includes ===============================================================
#include <c_interface.h>
#include <YapInterface.h>
#include <stdarg.h>
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
@@ -24,8 +24,8 @@
typedef unsigned int fid_t;
typedef unsigned int term_t;
typedef int module_t;
typedef Atom atom_t;
typedef Term *predicate_t;
typedef YAP_Atom atom_t;
typedef YAP_Term *predicate_t;
typedef struct open_query_struct *qid_t;
typedef long functor_t;
typedef int (*PL_agc_hook_t)(atom_t);
@@ -95,7 +95,7 @@ extern X_API term_t PL_new_term_refs(int);
extern X_API void PL_reset_term_refs(term_t);
/* begin PL_get_* functions =============================*/
extern X_API int PL_get_arg(int, term_t, term_t);
extern X_API int PL_get_atom(term_t, Atom *);
extern X_API int PL_get_atom(term_t, YAP_Atom *);
extern X_API int PL_get_atom_chars(term_t, char **);
extern X_API int PL_get_chars(term_t, char **, unsigned);
extern X_API int PL_get_functor(term_t, functor_t *);