static foreign_t
pce_lock_owner(term_t owner, term_t count)
{ if ( PL_unify_integer(owner, lock_owner) &&
PL_unify_integer(count, lock_count) )
return TRUE;
return FALSE;
}
static foreign_t
turtle_read_name(term_t C0, term_t Stream, term_t C, term_t Name)
{ int c;
charbuf b;
IOSTREAM *in;
if ( !PL_get_integer(C0, &c) )
return type_error(C0, "code");
if ( !wcis_name_start_char(c) )
return FALSE;
if ( !PL_get_stream_handle(Stream, &in) )
return FALSE;
init_charbuf(&b);
add_charbuf(&b, c);
for(;;)
{ int c = Sgetcode(in);
if ( wcis_name_char(c) )
{ add_charbuf(&b, c);
} else
{ int rc = ( PL_unify_integer(C, c) &&
PL_unify_wchars(Name, PL_ATOM, b.here-b.base, b.base) );
free_charbuf(&b);
PL_release_stream(in);
return rc;
}
}
}
word
pl_open_dde_conversation(term_t service, term_t topic, term_t handle)
{ UINT i;
HSZ Hservice, Htopic;
if ( !dde_initialise() )
fail;
if ( !get_hsz(service, &Hservice) ||
!get_hsz(topic, &Htopic) )
fail;
/* Establish a connection and get a handle for it */
for (i=0; i < MAX_CONVERSATIONS; i++) /* Find an open slot */
{ if (conv_handle[i] == (HCONV)NULL)
break;
}
if (i == MAX_CONVERSATIONS)
return PL_error(NULL, 0, NULL, ERR_RESOURCE, ATOM_max_dde_handles);
if ( !(conv_handle[i] = DdeConnect(ddeInst, Hservice, Htopic, 0)) )
fail;
DdeFreeStringHandle(ddeInst, Hservice);
DdeFreeStringHandle(ddeInst, Htopic);
return PL_unify_integer(handle, i);
}
static foreign_t
pl_order_table_mapping(term_t handle, term_t from, term_t to, control_t ctrl)
{ OrdTable t;
int f;
if ( !get_order_table(handle, &t) )
return FALSE;
if ( PL_get_integer(from, &f) && f >= 0 && f <= 255 )
return unify_mapped_code(to, ORD(t, f));
if ( PL_is_variable(from) )
{ switch(PL_foreign_control(ctrl))
{ case PL_FIRST_CALL:
f = 0;
break;
case PL_REDO:
f = (int)PL_foreign_context(ctrl);
break;
case PL_PRUNED:
return TRUE;
}
while( f <= 255 && !unify_mapped_code(to, ORD(t, f)) )
f++;
if ( f <= 255 )
{ if ( !PL_unify_integer(from, f) )
return FALSE;
PL_retry(f+1);
}
return FALSE;
}
return FALSE;
}
static foreign_t
pl_bind(term_t Socket, term_t Address)
{ struct sockaddr_in sockaddr;
int socket;
memset(&sockaddr, 0, sizeof(sockaddr));
if ( !tcp_get_socket(Socket, &socket) ||
!nbio_get_sockaddr(Address, &sockaddr) )
return FALSE;
if ( nbio_bind(socket, (struct sockaddr*)&sockaddr, sizeof(sockaddr)) < 0 )
return FALSE;
if ( PL_is_variable(Address) )
{ SOCKET fd = nbio_fd(socket);
struct sockaddr_in addr;
#ifdef __WINDOWS__
int len = sizeof(addr);
#else
socklen_t len = sizeof(addr);
#endif
if ( getsockname(fd, (struct sockaddr *) &addr, &len) )
return nbio_error(errno, TCP_ERRNO);
return PL_unify_integer(Address, ntohs(addr.sin_port));
}
return TRUE;
}
word
pl_convert_time(term_t time, term_t year, term_t month,
term_t day, term_t hour, term_t minute,
term_t second, term_t usec)
{ double tf;
if ( PL_get_float(time, &tf) && tf <= PLMAXINT && tf >= PLMININT )
{ long t = (long) tf;
long us = (long)((tf - (double) t) * 1000.0);
struct tm *tm = LocalTime(&t);
if ( PL_unify_integer(year, tm->tm_year + 1900) &&
PL_unify_integer(month, tm->tm_mon + 1) &&
PL_unify_integer(day, tm->tm_mday) &&
PL_unify_integer(hour, tm->tm_hour) &&
PL_unify_integer(minute, tm->tm_min) &&
PL_unify_integer(second, tm->tm_sec) &&
PL_unify_integer(usec, us) )
succeed;
else
fail;
}
return PL_error("convert_time", 8, NULL, ERR_TYPE, ATOM_time_stamp, time);
}
static foreign_t
pl_wpiPinToGpio (term_t wPiPin_,term_t t){
int wPiPin;
if (!PL_get_integer(wPiPin_,&wPiPin))
{
PL_warning("Argument 'wPiPin' not number");
PL_fail;
}
return PL_unify_integer(t,wpiPinToGpio(wPiPin));
}
static foreign_t
pl_physPinToGpio (term_t physPin_,term_t t){
int physPin;
if (!PL_get_integer(physPin_,&physPin))
{
PL_warning("Argument 'physPin' not number");
PL_fail;
}
return PL_unify_integer(t,physPinToGpio(physPin));
}
word
pl_shell(term_t command, term_t status)
{ char *cmd;
if ( PL_get_chars(command, &cmd, CVT_ALL) )
{ int rval = System(cmd);
return PL_unify_integer(status, rval);
}
return warning("shell/1: instantiation fault");
}
static int
unify_address(term_t t, struct sockaddr_in *addr)
{ term_t av = PL_new_term_refs(2);
if ( !nbio_unify_ip4(av+0, ntohl(addr->sin_addr.s_addr)) ||
!PL_unify_integer(av+1, ntohs(addr->sin_port)) )
return FALSE;
return PL_unify_term(t, PL_FUNCTOR_CHARS, ":", 2,
PL_TERM, av+0,
PL_TERM, av+1);
}
foreign_t pl_number_of_words_of_length(term_t word_length,
term_t nwordsSize_t)
{
int n;
if(!PL_is_integer(word_length))
{
PL_warning("word_length should be a bound integer");
}
else
PL_get_integer(word_length,&n);
int nWordsSize = number_of_words_of_length(n);
return PL_unify_integer(nwordsSize_t,nWordsSize);
}
static int
unify_mapped_code(term_t to, int ti)
{ switch(ti)
{ case ORD_BREAK:
return PL_unify_atom(to, ATOM_break);
case ORD_IGNORE:
return PL_unify_atom(to, ATOM_ignore);
case ORD_TAG:
return PL_unify_atom(to, ATOM_tag);
default:
return PL_unify_integer(to, ti);
}
}
static foreign_t
turtle_read_relative_uri(term_t C0, term_t Stream, term_t C, term_t Value)
{ int c;
charbuf b;
IOSTREAM *in;
if ( !PL_get_integer(C0, &c) )
return type_error(C0, "code");
if ( c != '<' )
return FALSE;
if ( !PL_get_stream_handle(Stream, &in) )
return FALSE;
init_charbuf(&b);
c = Sgetcode(in);
for(; ; c = Sgetcode(in))
{ if ( c == '>' )
{ int rc;
c = Sgetcode(in);
rc = (PL_unify_integer(C, c) &&
PL_unify_wchars(Value, PL_ATOM, b.here-b.base, b.base));
PL_release_stream(in);
free_charbuf(&b);
return rc;
} else if ( c == '\\' )
{ int esc;
c = Sgetcode(in);
if ( c == '>' )
{ add_charbuf(&b, c);
} else if ( string_escape(in, c, &esc) )
{ add_charbuf(&b, esc);
} else
{ free_charbuf(&b);
PL_release_stream(in);
return FALSE;
}
} else if ( c == -1 )
{ free_charbuf(&b);
PL_release_stream(in);
return syntax_error("eof_in_uri", in);
} else
{ add_charbuf(&b, c);
}
}
}
static int unify_value(term_t t, clingo_symbol_t v) {
// NOTE: the clingo_symbol_* functions below only fail
// if applied to the wrong type
// they do not allocate
switch (clingo_symbol_type(v)) {
case clingo_symbol_type_number: {
int number;
clingo_symbol_number(v, &number);
return PL_unify_integer(t, number);
}
case clingo_symbol_type_string: {
char const *str;
clingo_symbol_string(v, &str);
return PL_unify_chars(t, PL_STRING | REP_UTF8, (size_t)-1, str);
}
case clingo_symbol_type_infimum: {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_hash1, PL_ATOM, ATOM_inf);
}
case clingo_symbol_type_supremum: {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_hash1, PL_ATOM, ATOM_sup);
}
case clingo_symbol_type_function: {
// FIXME: functions can have signs represented as -f(x) in gringo
char const *str;
clingo_symbol_t const *args;
size_t size;
int rc;
clingo_symbol_name(v, &str);
clingo_symbol_arguments(v, &args, &size);
if (size == 0) {
if (!(rc =
PL_unify_chars(t, PL_ATOM | REP_UTF8, (size_t)-1, str))) {
goto out_function;
}
} else {
clingo_symbol_t const *it, *ie;
atom_t name;
term_t arg;
int i;
name = PL_new_atom(str);
if (!(rc = PL_unify_functor(t, PL_new_functor(name, size)))) {
goto out_function;
}
PL_unregister_atom(name);
arg = PL_new_term_ref();
for (i = 1, it = args, ie = it + size; it != ie; ++it, i++) {
_PL_get_arg(i, t, arg);
if (!unify_value(arg, *it)) {
goto out_function;
}
}
}
out_function:
return rc;
}
default:
assert(FALSE);
return FALSE;
}
}
foreign_t pl_dictionary_max_word_length(term_t t)
{
int n = dictionaray_maximum_word_length();
return PL_unify_integer(t,n);
}
word
pl_current_functor(term_t name, term_t arity, control_t h)
{ GET_LD
atom_t nm = 0;
size_t index;
int i, last=FALSE;
int ar;
fid_t fid;
switch( ForeignControl(h) )
{ case FRG_FIRST_CALL:
if ( PL_get_atom(name, &nm) &&
PL_get_integer(arity, &ar) )
return isCurrentFunctor(nm, ar) ? TRUE : FALSE;
if ( !(PL_is_integer(arity) || PL_is_variable(arity)) )
return PL_error("current_functor", 2, NULL, ERR_DOMAIN,
ATOM_integer, arity);
if ( !(PL_is_atom(name) || PL_is_variable(name)) )
return PL_error("current_functor", 2, NULL, ERR_DOMAIN,
ATOM_atom, name);
index = 1;
break;
case FRG_REDO:
PL_get_atom(name, &nm);
index = ForeignContextInt(h);
break;
case FRG_CUTTED:
default:
succeed;
}
fid = PL_open_foreign_frame();
LOCK();
for(i=MSB(index); !last; i++)
{ size_t upto = (size_t)2<<i;
FunctorDef *b = GD->functors.array.blocks[i];
if ( upto >= GD->functors.highest )
{ upto = GD->functors.highest;
last = TRUE;
}
for(; index<upto; index++)
{ FunctorDef fd = b[index];
if ( fd && fd->arity > 0 && (!nm || nm == fd->name) )
{ if ( PL_unify_atom(name, fd->name) &&
PL_unify_integer(arity, fd->arity) )
{ UNLOCK();
ForeignRedoInt(index+1);
} else
{ PL_rewind_foreign_frame(fid);
}
}
}
}
UNLOCK();
return FALSE;
}
static foreign_t
archive_header_prop(term_t archive, term_t field)
{ archive_wrapper *ar;
functor_t prop;
if ( !get_archive(archive, &ar) )
return FALSE;
if ( !PL_get_functor(field, &prop) )
return PL_type_error("compound", field);
if ( ar->status != AR_NEW_ENTRY )
return PL_permission_error("access", "archive_entry", archive);
if ( prop == FUNCTOR_filetype1 )
{ __LA_MODE_T type = archive_entry_filetype(ar->entry);
atom_t name;
term_t arg = PL_new_term_ref();
_PL_get_arg(1, field, arg);
switch(type&AE_IFMT)
{ case AE_IFREG: name = ATOM_file; break;
case AE_IFLNK: name = ATOM_link; break;
case AE_IFSOCK: name = ATOM_socket; break;
case AE_IFCHR: name = ATOM_character_device; break;
case AE_IFBLK: name = ATOM_block_device; break;
case AE_IFDIR: name = ATOM_directory; break;
case AE_IFIFO: name = ATOM_fifo; break;
default:
return PL_unify_integer(arg, (type&AE_IFMT));
}
return PL_unify_atom(arg, name);
} else if ( prop == FUNCTOR_mtime1 )
{ time_t stamp = archive_entry_mtime(ar->entry);
term_t arg = PL_new_term_ref();
_PL_get_arg(1, field, arg);
return PL_unify_float(arg, (double)stamp);
} else if ( prop == FUNCTOR_size1 )
{ int64_t size = archive_entry_size(ar->entry);
term_t arg = PL_new_term_ref();
_PL_get_arg(1, field, arg);
return PL_unify_int64(arg, size);
} else if ( prop == FUNCTOR_link_target1 )
{ __LA_MODE_T type = archive_entry_filetype(ar->entry);
const wchar_t *target = NULL;
switch(type&AE_IFMT)
{ case AE_IFLNK:
target = archive_entry_symlink_w(ar->entry);
break;
}
if ( target )
{ term_t arg = PL_new_term_ref();
_PL_get_arg(1, field, arg);
return PL_unify_wchars(arg, PL_ATOM, (size_t)-1, target);
}
return FALSE;
} else if ( prop == FUNCTOR_format1 )
{ const char *s = archive_format_name(ar->archive);
if ( s )
{ char lwr[50];
char *o;
term_t arg = PL_new_term_ref();
_PL_get_arg(1, field, arg);
for(o=lwr; *s && o < lwr+sizeof(lwr); )
*o++ = tolower(*s++);
*o = '\0';
return PL_unify_atom_chars(arg, lwr);
}
}
return PL_domain_error("archive_header_property", field);
}
static int
get_ftm(term_t t, ftm *ftm)
{ GET_LD
term_t tmp = PL_new_term_ref();
int date9;
memset(ftm, 0, sizeof(*ftm));
if ( (date9=PL_is_functor(t, FUNCTOR_date9)) )
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) &&
get_int_arg (4, t, tmp, &ftm->tm.tm_hour) &&
get_int_arg (5, t, tmp, &ftm->tm.tm_min) &&
get_float_arg(6, t, tmp, &ftm->sec) &&
get_voff_arg (7, t, tmp, &ftm->utcoff) &&
get_tz_arg (8, t, tmp, &ftm->tzname) &&
get_dst_arg (9, t, tmp, &ftm->isdst) )
{ double fp, ip;
ftm->tm.tm_isdst = (ftm->isdst == -2 ? -1 : ftm->isdst);
fixup:
fp = modf(ftm->sec, &ip);
if ( fp < 0.0 )
{ fp += 1.0;
ip -= 1.0;
}
ftm->tm.tm_sec = (int)ip;
ftm->tm.tm_year -= 1900; /* 1900 based */
ftm->tm.tm_mon--; /* 0-based */
if ( ftm->utcoff == NO_UTC_OFFSET )
{ if ( ftm->tm.tm_isdst < 0 ) /* unknown DST */
{ int offset;
if ( mktime(&ftm->tm) == (time_t)-1 )
return PL_representation_error("dst");
ftm->flags |= HAS_WYDAY;
offset = tz_offset();
if ( ftm->tm.tm_isdst > 0 )
offset -= 3600;
ftm->utcoff = offset;
if ( date9 ) /* variable */
{ _PL_get_arg(7, t, tmp);
if ( !PL_unify_integer(tmp, ftm->utcoff) )
return FALSE;
} else
{ ftm->utcoff = offset;
}
}
if ( ftm->isdst == -2 )
{ ftm->isdst = ftm->tm.tm_isdst;
_PL_get_arg(9, t, tmp);
if ( ftm->isdst < 0 )
{ if ( !PL_unify_atom(tmp, ATOM_minus) )
return FALSE;
} else
{ if ( !PL_unify_bool(tmp, ftm->isdst) )
return FALSE;
}
}
if ( !ftm->tzname )
{ ftm->tzname = tz_name_as_atom(ftm->isdst);
_PL_get_arg(8, t, tmp);
if ( PL_is_variable(tmp) &&
!PL_unify_atom(tmp, ftm->tzname) )
return FALSE;
}
}
succeed;
}
} else if ( PL_is_functor(t, FUNCTOR_date3) )
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) )
{ ftm->tm.tm_isdst = -1;
ftm->utcoff = NO_UTC_OFFSET;
goto fixup;
}
}
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, t);
}
static HDDEDATA CALLBACK
DdeCallback(UINT type, UINT fmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{ GET_LD
DWORD ddeInst = LD->os.dde_instance;
switch(type)
{ case XTYP_CONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect3, MODULE_dde);
int rval;
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, dwData2 ? 1 : 0) ) /* same instance */
{ rval = PL_call_predicate(MODULE_dde, TRUE, pred, argv);
} else
{ rval = FALSE;
}
PL_discard_foreign_frame(cid);
return (void *)(intptr_t)rval;
}
case XTYP_CONNECT_CONFIRM:
{ int plhandle;
if ( (plhandle = allocServerHandle(hconv)) >= 0 )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, plhandle) )
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
}
return NULL;
}
case XTYP_DISCONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(1);
predicate_t pred = PL_pred(FUNCTOR_dde_disconnect1, MODULE_dde);
int plhandle = findServerHandle(hconv);
if ( plhandle >= 0 && plhandle < MAX_CONVERSATIONS )
server_handle[plhandle] = (HCONV)NULL;
PL_put_integer(argv+0, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return NULL;
}
case XTYP_EXECUTE:
{ int plhandle = findServerHandle(hconv);
HDDEDATA rval = DDE_FNOTPROCESSED;
fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_execute3, MODULE_dde);
DEBUG(1, Sdprintf("Got XTYP_EXECUTE request\n"));
PL_put_integer(argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1);
unify_hdata( argv+2, hData);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
rval = (void *) DDE_FACK;
PL_discard_foreign_frame(cid);
DdeFreeDataHandle(hData);
return rval;
}
case XTYP_REQUEST:
{ HDDEDATA data = (HDDEDATA) NULL;
if ( fmt == CF_UNICODETEXT )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(4);
predicate_t pred = PL_pred(FUNCTOR_dde_request4, MODULE_dde);
int plhandle = findServerHandle(hconv);
PL_put_integer( argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1); /* topic */
unify_hsz(ddeInst, argv+2, hsz2); /* item */
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
{ wchar_t *s;
size_t len;
/* TBD: error handling */
if ( PL_get_wchars(argv+3, &len, &s, CVT_ALL) )
data = DdeCreateDataHandle(ddeInst,
(unsigned char*) s,
(DWORD)(len+1)*sizeof(wchar_t),
0, hsz2, CF_UNICODETEXT, 0);
}
PL_discard_foreign_frame(cid);
}
return data;
}
default:
;
}
return (HDDEDATA)NULL;
}
static foreign_t
turtle_read_string(term_t C0, term_t Stream, term_t C, term_t Value)
{ int c;
charbuf b;
IOSTREAM *in;
int endlen = 1;
if ( !PL_get_integer(C0, &c) )
return type_error(C0, "code");
if ( c != '"' )
return FALSE;
if ( !PL_get_stream_handle(Stream, &in) )
return FALSE;
init_charbuf(&b);
c = Sgetcode(in);
if ( c == '"' )
{ c = Sgetcode(in);
if ( c == '"' ) /* """...""" */
{ endlen = 3;
c = Sgetcode(in);
} else
{ PL_release_stream(in);
return (PL_unify_integer(C, c) &&
PL_unify_atom(Value, ATOM_));
}
}
for(;;c = Sgetcode(in))
{ if ( c == -1 )
{ free_charbuf(&b);
PL_release_stream(in);
return syntax_error("eof_in_string", in);
} else if ( c == '"' )
{ int count = 1;
for(count=1; count<endlen; )
{ if ( (c=Sgetcode(in)) == '"' )
count++;
else
break;
}
if ( count == endlen )
{ int rc;
c = Sgetcode(in);
rc = (PL_unify_integer(C, c) &&
PL_unify_wchars(Value, PL_ATOM, b.here-b.base, b.base));
free_charbuf(&b);
PL_release_stream(in);
return rc;
}
while(count-- > 0)
add_charbuf(&b, '"');
add_charbuf(&b, c);
} else if ( c == '\\' )
{ int esc;
c = Sgetcode(in);
if ( !string_escape(in, c, &esc) )
{ free_charbuf(&b);
PL_release_stream(in);
return FALSE;
}
add_charbuf(&b, esc);
} else
{ add_charbuf(&b, c);
}
}
}
static foreign_t
pl_piBoardRev (term_t t){
return PL_unify_integer(t,piBoardRev());
}
static foreign_t
pl_getegid(term_t gid)
{ return PL_unify_integer(gid, getegid());
}
word
pl_get_pid(term_t pid)
{ return PL_unify_integer(pid, getpid());
}
static int
do_create_process(p_options *info)
{ int pid;
if ( !(pid=vfork()) ) /* child */
{ int fd;
PL_cleanup_fork();
if ( info->detached )
setsid();
if ( info->cwd )
{ if ( chdir(info->cwd) )
{ perror(info->cwd);
exit(1);
}
}
/* stdin */
switch( info->streams[0].type )
{ case std_pipe:
dup2(info->streams[0].fd[0], 0);
close(info->streams[0].fd[1]);
break;
case std_null:
if ( (fd = open("/dev/null", O_RDONLY)) >= 0 )
dup2(fd, 0);
break;
case std_std:
break;
}
/* stdout */
switch( info->streams[1].type )
{ case std_pipe:
dup2(info->streams[1].fd[1], 1);
close(info->streams[1].fd[0]);
break;
case std_null:
if ( (fd = open("/dev/null", O_WRONLY)) >= 0 )
dup2(fd, 1);
break;
case std_std:
break;
}
/* stderr */
switch( info->streams[2].type )
{ case std_pipe:
dup2(info->streams[2].fd[1], 2);
close(info->streams[2].fd[0]);
break;
case std_null:
if ( (fd = open("/dev/null", O_WRONLY)) >= 0 )
dup2(fd, 2);
break;
case std_std:
break;
}
if ( info->envp )
execve(info->exe, info->argv, info->envp);
else
execv(info->exe, info->argv);
perror(info->exe);
exit(1);
} else if ( pid < 0 ) /* parent */
{ term_t exe = PL_new_term_ref();
PL_put_atom_chars(exe, info->exe);
return pl_error(NULL, 0, "fork", ERR_ERRNO, errno, "fork", "process", exe);
} else
{ if ( info->pipes > 0 && info->pid == 0 )
{ IOSTREAM *s;
process_context *pc = PL_malloc(sizeof(*pc));
DEBUG(Sdprintf("Wait on pipes\n"));
memset(pc, 0, sizeof(*pc));
pc->magic = PROCESS_MAGIC;
pc->pid = pid;
if ( info->streams[0].type == std_pipe )
{ close(info->streams[0].fd[0]);
s = open_process_pipe(pc, 0, info->streams[0].fd[1]);
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ close(info->streams[1].fd[1]);
s = open_process_pipe(pc, 1, info->streams[1].fd[0]);
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ close(info->streams[2].fd[1]);
s = open_process_pipe(pc, 2, info->streams[2].fd[0]);
PL_unify_stream(info->streams[2].term, s);
}
return TRUE;
} else if ( info->pipes > 0 )
{ IOSTREAM *s;
if ( info->streams[0].type == std_pipe )
{ close(info->streams[0].fd[0]);
s = Sfdopen(info->streams[0].fd[1], "w");
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ close(info->streams[1].fd[1]);
s = Sfdopen(info->streams[1].fd[0], "r");
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ close(info->streams[2].fd[1]);
s = Sfdopen(info->streams[2].fd[0], "r");
PL_unify_stream(info->streams[2].term, s);
}
}
if ( info->pid )
return PL_unify_integer(info->pid, pid);
return wait_success(info->exe_name, pid);
}
}
static int
do_create_process(p_options *info)
{ int flags = 0;
PROCESS_INFORMATION pi;
STARTUPINFOW si;
switch(info->window)
{ case MAYBE:
if ( !console_app() )
flags |= CREATE_NO_WINDOW;
break;
case TRUE:
break;
case FALSE:
flags |= CREATE_NO_WINDOW;
break;
}
if ( info->detached )
flags |= CREATE_BREAKAWAY_FROM_JOB;
memset(&si, 0, sizeof(si));
si.cb = sizeof(si);
si.dwFlags = STARTF_USESTDHANDLES;
/* stdin */
switch( info->streams[0].type )
{ case std_pipe:
si.hStdInput = info->streams[0].fd[0];
SetHandleInformation(info->streams[0].fd[1],
HANDLE_FLAG_INHERIT, FALSE);
break;
case std_null:
si.hStdInput = open_null_stream(GENERIC_READ);
break;
case std_std:
si.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
break;
}
/* stdout */
switch( info->streams[1].type )
{ case std_pipe:
si.hStdOutput = info->streams[1].fd[1];
SetHandleInformation(info->streams[1].fd[0],
HANDLE_FLAG_INHERIT, FALSE);
break;
case std_null:
si.hStdOutput = open_null_stream(GENERIC_WRITE);
break;
case std_std:
si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
break;
}
/* stderr */
switch( info->streams[2].type )
{ case std_pipe:
si.hStdError = info->streams[2].fd[1];
SetHandleInformation(info->streams[2].fd[0],
HANDLE_FLAG_INHERIT, FALSE);
break;
case std_null:
si.hStdError = open_null_stream(GENERIC_WRITE);
break;
case std_std:
si.hStdError = GetStdHandle(STD_ERROR_HANDLE);
break;
}
if ( CreateProcessW(info->exe,
info->cmdline,
NULL, /* Process security */
NULL, /* Thread security */
TRUE, /* Inherit handles */
flags, /* Creation flags */
info->envbuf.buffer, /* Environment */
info->cwd, /* Directory */
&si, /* Startup info */
&pi) ) /* Process information */
{ CloseHandle(pi.hThread);
if ( info->pipes > 0 && info->pid == 0 )
{ IOSTREAM *s;
process_context *pc = PL_malloc(sizeof(*pc));
DEBUG(Sdprintf("Wait on pipes\n"));
memset(pc, 0, sizeof(*pc));
pc->magic = PROCESS_MAGIC;
pc->handle = pi.hProcess;
if ( info->streams[0].type == std_pipe )
{ CloseHandle(info->streams[0].fd[0]);
s = open_process_pipe(pc, 0, info->streams[0].fd[1]);
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ CloseHandle(info->streams[1].fd[1]);
s = open_process_pipe(pc, 1, info->streams[1].fd[0]);
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ CloseHandle(info->streams[2].fd[1]);
s = open_process_pipe(pc, 2, info->streams[2].fd[0]);
PL_unify_stream(info->streams[2].term, s);
}
return TRUE;
} else if ( info->pipes > 0 )
{ IOSTREAM *s;
if ( info->streams[0].type == std_pipe )
{ CloseHandle(info->streams[0].fd[0]);
s = Sopen_handle(info->streams[0].fd[1], "w");
PL_unify_stream(info->streams[0].term, s);
}
if ( info->streams[1].type == std_pipe )
{ CloseHandle(info->streams[1].fd[1]);
s = Sopen_handle(info->streams[1].fd[0], "r");
PL_unify_stream(info->streams[1].term, s);
}
if ( info->streams[2].type == std_pipe )
{ CloseHandle(info->streams[2].fd[1]);
s = Sopen_handle(info->streams[2].fd[0], "r");
PL_unify_stream(info->streams[2].term, s);
}
}
if ( info->pid )
{ register_process(pi.dwProcessId, pi.hProcess);
return PL_unify_integer(info->pid, pi.dwProcessId);
}
return win_wait_success(info->exe_name, pi.hProcess);
} else
{ return win_error("CreateProcess");
}
}
