/* Copyright 1989-93 GROUPE BULL -- See license conditions in file COPYRIGHT */
/*****************************************************************************\
* *
* KLOS.c *
* *
* OS access routines *
* *
\*****************************************************************************/
#include <sys/types.h>
#include <sys/file.h>
#include <sys/times.h>
#include <sys/param.h>
#include <signal.h>
#include <sys/stat.h>
#ifdef NO_DIRENT
#include <sys/dir.h>
#define dirent direct
#else
#include <dirent.h>
#endif
#ifdef SYSV
#include <unistd.h>
#endif
#include "EXTERN.h"
#include "klone.h"
#include "kl_atom.h"
#include "kl_number.h"
#include "kl_list.h"
#include "kl_func.h"
#include "kl_string.h"
#include "kl_hash.h"
#include "kl_stream.h"
#include "kl_struct.h"
#include "klregexp.h"
#include "INTERN.h"
#include <sys/wait.h>
#ifdef SYSV_TIME
#else /* SYSV_TIME */
#include <sys/timeb.h>
#include <sys/time.h>
#include <sys/resource.h>
#endif /* SYSV_TIME */
#include <errno.h>
#ifdef SVR4
#include <limits.h>
#include <fcntl.h>
#endif /* SVR4 */
#ifdef SYSV_UTSNAME
#include <sys/utsname.h>
#endif
#ifdef sco
#ifdef SA_RESTART
#undef SA_RESTART
#endif /* SA_RESTART */
#endif /* sco */
KlO KlDeadChildGet();
static time_t start_time;
#define KlSTOPPED -1000000 /* N, with N < -128 or N > 128 */
#ifndef MAXPATHLEN
#define MAXPATHLEN KlMAX_TEMP_STRING_SIZE
#endif
#ifndef AMIGA
#ifdef __NUTC__
#define DEFAULT_SHELL "sh.exe"
#else
#define DEFAULT_SHELL "/bin/sh"
#endif /* NUTC */
#else /* AMIGA */
#define DEFAULT_SHELL "gnuemacs:etc/sh"
#endif
#ifdef SYSV_SIGNALS
#define KlWaitPid(statusp) waitpid(-1, statusp, WNOHANG)
#else
#define KlWaitPid(statusp) wait3(statusp, WNOHANG, 0)
#endif
DECLARE_strchr;
KlRSignal KlChildDeathHandler();
/* On SYSV signals where it is possible (AIX), use an emulation of the BSD
* signal call via sigaction.
* we must prevent these signals to terminate IOs
* WARNING! this is a low-level routine that must NEVER be called by the
* application which should use KlSignal
*/
#ifdef SA_RESTART
KlSetSignal(sig, handler)
int sig;
KlSignalHandler handler;
{
struct sigaction action;
sigaction(sig, 0, &action);
/* note that below, logically we should use a |= instead of a =.
* alas sigaction has no standard default (differ between SVR4 and BSD)
* so we must force the state. AIX has weird defaults, for instance.
*/
action.sa_flags = SA_RESTART;
#ifdef SA_ONESHOT
action.sa_flags &= ~SA_ONESHOT;
#endif
action.sa_handler = handler;
sigaction(sig, &action, 0);
}
#else /* !SA_RESTART */
#define KlSetSignal(sig, handler) signal(sig, handler)
#endif /* !SA_RESTART */
/*****************************************************************************\
* current directory *
\*****************************************************************************/
KlO
KlCurrentDirectoryGet(data)
KlO data;
{
char pathname[MAXPATHLEN];
#ifdef NO_GETCW
getcwd(pathname, MAXPATHLEN); /* this forks!!! */
#else
getwd(pathname);
#endif
return (KlO) KlStringMake(pathname);
}
KlO
KlCurrentDirectorySet(klpathname, data)
KlString klpathname;
KlO data;
{
char *path;
KlMustBeString(klpathname, 0);
path = KlExpandTildeForFilesC(klpathname->string);
return (chdir(path)
? KlError(KlE_BAD_DIRECTORY, klpathname) /* -1 = failure */
: (KlO) klpathname); /* 0 = success */
}
/*****************************************************************************\
* umask *
\*****************************************************************************/
static int KlUmask = -1;
KlO
KlUmaskGet(data)
KlO data;
{
if (KlUmask == -1) { /* umask is un-initialized */
int old_umask = umask(0);
umask(old_umask);
KlUmask = old_umask;
}
return (KlO) KlNumberMake(KlUmask);
}
KlO
KlUmaskSet(mask, data)
KlNumber mask;
KlO data;
{
KlMustBeNumber(mask, 0);
KlUmask = mask->number;
umask(KlUmask);
return (KlO) mask;
}
/*****************************************************************************\
* time *
\*****************************************************************************/
/* used time function expressed in milliseconds
*/
#ifndef CLK_TCK
# ifdef HZ
# define CLK_TCK HZ
# else
# define CLK_TCK 60
# endif
#endif
#define MS_PER_TICK ((1000 + CLK_TCK/2) / CLK_TCK)
#define TIME_UNIT CLK_TCK
static KlKeyword *KlOpenKV_type;
KlO
KlUsedTime(argc, argv)
int argc;
KlO *argv;
{
long real_time;
struct tms buffer;
KlKeyword type;
KlParseKeywords(argc, argv, 0);
type = (KlKeyword) KlKeyVal(KlK_type, KlK_real);
KlCheckUnvalidKeywords(argc, argv, 0);
type = (KlKeyword) KlCheckKeywordValue(KlK_type, type, KlOpenKV_type);
#ifdef SYSV_TIME
real_time = ((times(&buffer) - start_time) * 1000) / TIME_UNIT;
#else /* SYSV_TIME */
{
struct timeb time_bsd;
if (type == KlK_real) {
ftime(&time_bsd);
real_time = 1000 * time_bsd.time + time_bsd.millitm;
} else {
times(&buffer);
}
}
#endif /* SYSV_TIME */
if (type == KlK_real) {
return (KlO) KlNumberMake(real_time);
} else if (type == KlK_cpu) {
return (KlO) KlNumberMake(((buffer.tms_utime + buffer.tms_stime)
* 1000) / TIME_UNIT);
} else if (type == KlK_user) {
return (KlO) KlNumberMake((buffer.tms_utime * 1000) / TIME_UNIT);
} else if (type == KlK_sys) {
return (KlO) KlNumberMake((buffer.tms_stime * 1000) / TIME_UNIT);
} else { /* :all */
return (KlO) KlListTripletMake(
KlNumberMake(real_time),
KlNumberMake((buffer.tms_utime * 1000) / TIME_UNIT),
KlNumberMake((buffer.tms_stime * 1000) / TIME_UNIT));
}
}
/* current time in seconds since Jan 1 1970 */
KlO
KlAbsoluteTime()
{
return (KlO) KlNumberMake(time(0));
}
/*****************************************************************************\
* hostname *
\*****************************************************************************/
/* the host name as a string
*/
KlO
KlHostnameGet()
{
if (!KlHostName) {
char buf[256];
int maxlen = 256;
#ifdef SYSV_UTSNAME
struct utsname name;
int len;
uname(&name);
len = strlen(name.nodename);
if (len >= maxlen)
len = maxlen - 1;
strncpy(buf, name.nodename, len);
buf[len] = '\0';
#else /* SYSV_UTSNAME */
buf[0] = '\0';
(void) gethostname(buf, maxlen);
buf[maxlen - 1] = '\0';
#endif /* SYSV_UTSNAME */
KlIncRef(KlHostName = (KlO) KlStringMake(buf));
}
return KlHostName;
}
/*****************************************************************************\
* getenv - putenv *
\*****************************************************************************/
/*
* KlGetenv:
* makes the KlString out of getenv(Kl_string)
*/
KlO
KlGetenv(obj)
KlString obj;
{
char *s;
KlMustBeString(obj, 0);
if (s = (char *) getenv(obj->string))
return (KlO) KlStringMake(s);
else
return NIL;
}
/* putenv:
* we don't use the putenv of the C library, since it may not be implemented
* everywhere
* warning: we accept only the names of the form: [a-zA-Z_][a-zA-Z0-9_]*
* otherwise Errors:InvalidIdentifier is returned
*/
static char * KlEnvVarRegexp = "^[a-zA-Z_][a-zA-Z0-9_]*$";
KlO
KlPutenv(obj, value)
KlString obj;
KlString value;
{
int len;
char *string;
int remove = 0;
static regexp *prog;
if (!prog)
prog = Klregcomp(KlEnvVarRegexp);
KlMustBeString(obj, 0);
if (!Klregexec(prog, obj->string)) {
return KlError1(KlE_INVALID_IDENTIFIER, obj);
}
if (KlFalseP(value)) { /* putenv to () to unset */
remove = 1;
value = KlStringMake("");
} else {
KlMustBeString(value, 1);
}
len = KlStringLength(obj) + KlStringLength(value) + 2;
string = (char *) Malloc(len);
strcpy(stpcpy(stpcpy(string, obj->string),
"="),
value->string);
len = Kl_putenv(string, remove);
Free(string);
return len ? NIL : (KlO) value;
}
/* implementation of putenv */
extern char **environ; /* pointer to enviroment */
static char *environ_malloced; /* booleans: is it a malloced string? */
static reall = 0; /* flag to reallocate space, if called
more than once */
/* Kl_putenv - change environment variables
* input - char *change = a pointer to a string of the form
* "name=value"
* output - 0, if successful
* 1, otherwise
*/
/* Warning: since the C user migth be calling the existing libc putenv function
* which may be resizing by realloc (not Realloc) the rray of env string, we use
* these functions ourselves too.
*/
int
Kl_putenv(change, remove)
char *change; /* new value */
int remove; /* unset operation */
{
char **newenv; /* points to new environment */
register int which; /* index of variable to replace */
if (!environ_malloced) {
for (newenv = environ; *newenv; newenv++)
;
environ_malloced = (char *) Calloc(sizeof(char), (newenv-environ));
}
if ((which = Kl_find(change)) < 0) {
if (remove) /* unsetting unexistent var */
return 0;
/* if a new variable */
/* which is negative of table size, so invert and
count new element */
which = (-which) + 1;
if (reall) {
/* we have expanded environ before */
newenv = (char **)realloc(environ,
which*sizeof(char *));
if (newenv == NULL) return -1;
/* now that we have space, change environ */
environ = newenv;
} else {
/* environ points to the original space */
reall++;
newenv = (char **)malloc(which*sizeof(char *));
if (newenv == NULL) return -1;
(void)memcpy((char *)newenv, (char *)environ,
(int)(which*sizeof(char *)));
environ = newenv;
}
environ[which-2] = KlStrdup(change);
environ[which-1] = NULL;
environ_malloced = (char *) Realloc(environ_malloced,
which*sizeof(char));
environ_malloced[which-2] = 1;
} else {
if (environ_malloced[which])
Free(environ[which]); /* free old var if it was malloced */
if (remove) {
/* we are unsetting a variable, compact hole */
while (environ[which]) {
environ[which] = environ[which+1];
environ_malloced[which] = environ_malloced[which+1];
which++;
}
} else {
/* we are replacing an old variable */
environ[which] = KlStrdup(change);
environ_malloced[which] = 1;
}
}
return 0;
}
/* find - find where s2 is in environ
*
* input - str = string of form name=value
*
* output - index of name in environ that matches "name"
* -size of table, if none exists
*/
int
Kl_find(str)
register char *str;
{
register int ct = 0; /* index into environ */
while(environ[ct] != NULL) {
if (Kl_match(environ[ct], str) != 0)
return ct;
ct++;
}
return -(++ct);
}
/*
* s1 is either name, or name=value
* s2 is name=value
* if names match, return value of 1,
* else return 0
*/
int
Kl_match(s1, s2)
register char *s1, *s2;
{
while(*s1 == *s2++) {
if (*s1 == '=')
return 1;
s1++;
}
return 0;
}
KlO
KlListenv() {
KlList kllist = KlListNMake(0);
char **envp = environ;
char *pos;
while (*envp) {
if(pos = strchr(*envp, '=')) {
KlListAppendV(kllist, 2,
KlStringMakeFromBytes(pos - *envp, *envp),
KlStringMake(pos+1));
}
envp++;
}
return (KlO) kllist;
}
/*****************************************************************************\
* file stats *
\*****************************************************************************/
/* (file-stats filename/stream [do-not-follow-links])
* return nil if file do not exist or a structure with fields
* dev, ino, mode, nlink, uid, gid, rdev, size, atime, mtime, ctime, blksize,
* blocks
*/
#ifndef SYSV_STAT
#define KlFileStatsNumber 11
#else
#define KlFileStatsNumber 13
#endif
#ifdef NO_MODE_T
#define mode_t unsigned short
#define nlink_t short
#define uid_t short
#define gid_t short
#endif /* NO_MODE_T */
#ifdef VOID_FREE
#define FREE_RETURNS void
#else
#define FREE_RETURNS
#endif
#ifndef DO_NOT_REDEFINE_MALLOC
#ifndef NO_MALLOC_DECLARE
extern FREE_RETURNS free();
#endif /* !NO_MALLOC_DECLARE */
#else /* DO_NOT_REDEFINE_MALLOC */
extern FREE_RETURNS KlFree();
#endif /* DO_NOT_REDEFINE_MALLOC */
static KlStructClass KlStatsClass;
KlFileStatsStructInit()
{
/* struct stat sb;
* int foo = ((char *) &(sb.st_dev)) - ((char *) &sb);
*/
#define KlDeclareStatField(name, field, type) \
KlDeclareStructClassSlot(KlStatsClass, name, \
KlStructAccessorScalar[sizeof(type)], \
KlOffsetOf(struct stat, field), 0);
KlIncRef(KlStatsClass = KlStructClassMake("FileStats",
sizeof(struct stat),
KlFileStatsNumber));
KlStatsClass->free = (KlMethod) KlStructClassFreeDefault;
#ifdef DEBUG
KlStatsClass->print = (KlMethod) KlStructClassPrintDefault;
KlStatsClass->parse = (KlMethod) KlStructClassParseDefault;
#endif DEBUG
KlDeclareStatField("dev", st_dev, dev_t);
KlDeclareStatField("ino", st_ino, ino_t);
/* if you have a compile error
* `mode_t' undeclared
* define the compile flag NO_MODE_T in your Make.machine
*/
KlDeclareStatField("mode", st_mode, mode_t);
KlDeclareStatField("nlink", st_nlink, nlink_t);
KlDeclareStatField("uid", st_uid, uid_t);
KlDeclareStatField("gid", st_gid, gid_t);
KlDeclareStatField("rdev", st_rdev, dev_t);
KlDeclareStatField("size", st_size, off_t);
KlDeclareStatField("atime", st_atime, time_t);
KlDeclareStatField("mtime", st_mtime, time_t);
KlDeclareStatField("ctime", st_ctime, time_t);
#ifndef SYSV_STAT
KlDeclareStatField("blksize", st_blksize, long);
KlDeclareStatField("blocks", st_blocks, long);
#endif /* !SYSV_STAT */
#undef KlDeclareStatField
}
#ifdef NO_LSTAT
#define lstat stat
#endif
KlO
KlFileStats(argc, argv)
int argc;
KlString *argv;
{
struct stat *buffer;
char *filename;
if (argc < 1 || argc > 2)
return KlBadNumberOfArguments((char *) argc);
if (KlIsAStream(argv[0])) {
if (KlIsAStringStream((KlStream) argv[0])) {
return NIL; /* string stream: nil */
} else { /* file stream */
buffer = (struct stat *) malloc(sizeof(struct stat));
if (fstat(KlFp2Fd(((KlStream) argv[0])->fd), buffer))
return NIL;
else
return (KlO) KlStructMake(KlStatsClass, buffer);
}
} /* else do a stat on filename */
KlMustBeString(argv[0], 0);
filename = KlExpandTildeForFilesC(argv[0]->string);
buffer = (struct stat *) malloc(sizeof(struct stat));
if ((argc == 1 || KlFalseP(argv[1]))
? stat(filename, buffer) : lstat(filename, buffer)) {
return NIL; /* file do not exist */
} else { /* file exist */
return (KlO) KlStructMake(KlStatsClass, buffer);
}
}
/*****************************************************************************\
* directory *
\*****************************************************************************/
KlO
KlDirectory(argc, argv)
int argc;
KlString *argv;
{
struct dirent *dp;
DIR *dirp;
char *filename;
KlList result = KlListNMake(0);
if (argc > 1)
return KlBadNumberOfArguments((char *) argc);
if (argc) {
KlMustBeString(argv[0], 0);
filename = KlExpandTildeForFilesC(argv[0]->string);
} else {
filename = ".";
}
if (dirp = opendir(filename)) {
while ((dp = readdir(dirp))) {
/* skip . and .. */
char *name = dp->d_name;
if (!(*name == '.'
&& ((name[1] == '.' && name[2] == '\0') || name[1] == '\0')))
KlListAppend(result, KlStringMake(name));
}
closedir(dirp);
return (KlO) result;
} else {
return KlError(KlE_BAD_DIRECTORY, argc ? argv[0] : KlStringMake(0));
}
}
/*****************************************************************************\
* file functions *
\*****************************************************************************/
/* here are file functions that cannot be performed by existing standalone
* standard UNIX commands
*/
/* truncate a file to length
* (file-truncate path length)
* returns () for success or the KlE_ERROR_OPENING_FILE error in output mode
*/
KlO
KlFileTruncate(name, length)
KlString name;
KlNumber length;
{
#ifndef NO_TRUNCATE
char *filename;
KlMustBeString(name, 0);
KlMustBeNumber(length, 1);
filename = KlExpandTildeForFilesC(name->string);
if (truncate(filename, length->number))
return (KlO) KlOpenError(0, name, KlK_output, 1);
else
#endif
return NIL;
}
/*****************************************************************************\
* process IDs *
\*****************************************************************************/
/* a small subtype of number for specific purposes
*/
/*************************************************************** definitions */
typedef struct _KlProcessId {
KlKLONE_HEADER;
Int number; /* unix pid */
int pid; /* 0 if already wait-ed */
struct _KlProcessId *next; /* linked list */
int alive; /* forked, but not dead yet */
int status; /* returned status once dead */
} *KlProcessId;
#define KlIsAProcessId(obj) ((obj)->type == KlProcessIdType)
#define KlMustBeProcessId(o, n) KlArgumentMustBe(o, n, KlProcessIdType);
KlType KlProcessIdType;
KlProcessId KlProcessIdList = 0;
int KlProcessIdBeingCreated = 0;
int KlProcessIdBeingCreatedDied = 0;
int KlProcessIdBeingCreatedStatus = 0;
KlProcessId KlProcessIdFind();
/************************************************************ implementation */
int
KlFixStatus(status) /* extract the return code */
int status;
{
if (status & 0xff) { /* killed by a signal */
return status & 0x7f; /* return the signal number */
} else { /* else return the error code */
return (status >> 8) & 0xff; /* 2nd - byte */
}
}
KlProcessId
KlProcessIdMake(n)
int n; /* C pid */
{
KlProcessId pid = KlProcessIdFind(n);
if (pid) { /* was created by death handler */
if (KlProcessIdBeingCreatedDied && (n == KlProcessIdBeingCreated)) {
pid->status = KlFixStatus(KlProcessIdBeingCreatedStatus);
pid->alive = 0; /* but dead on arrival, adjust */
}
return pid; /* return the existing one */
}
/* else still alive, create it */
pid = (KlProcessId) KlOMake(KlProcessIdType);
pid->number = pid->pid = n;
pid->next = KlProcessIdList; /* add to list of alive processes */
KlIncRef(KlProcessIdList = pid); /* remove ref when reported */
if (KlProcessIdBeingCreatedDied && (n == KlProcessIdBeingCreated)) {
pid->status = KlFixStatus(KlProcessIdBeingCreatedStatus);
pid->alive = 0;
} else {
pid->status = 0;
pid->alive = 1;
}
return pid;
}
KlO
KlProcessIdFree(pid)
KlProcessId pid;
{
KlProcessId *p = &KlProcessIdList;
while (*p) {
if ((*p) == pid) { /* remove from list */
(*p) = pid->next;
break;
}
p = &((*p)->next);
ASSERT(*p); /* check process was in the list */
}
Free(pid);
return (KlO) pid;
}
/* from a C process id, find the created klone process Id, or 0
*/
KlProcessId
KlProcessIdFind(n)
int n;
{
KlProcessId pid = KlProcessIdList;
while (pid) {
if (pid->pid == n) {
return pid;
}
pid = pid->next;
}
return pid;
}
/* a process is signalled to be dead */
KlProcessIdDies(pid, status)
int pid;
int status;
{
KlProcessId klpid;
if (pid == 0)
return;
if ((status & 0xff) == KlSTOPPED) /* just stopped */
return;
klpid = KlProcessIdFind(pid);
if (klpid) {
if (klpid->alive) { /* only if not already done */
klpid->status = KlFixStatus(status);
klpid->alive = 0;
}
} else if (pid == KlProcessIdBeingCreated) {
KlProcessIdBeingCreatedDied = 1;
KlProcessIdBeingCreatedStatus = status;
klpid = KlProcessIdMake(pid);
} else { /* we create one, this case happens
when child died before register */
klpid = KlProcessIdMake(pid);
klpid->status = KlFixStatus(status);
klpid->alive = 0;
}
}
KlProcessIdReported(pid)
KlProcessId pid;
{
if (pid->pid) { /* check we dont do it twice */
pid->pid = 0;
KlDecRefNonNull(pid);
}
}
int
KlProcessIdCompare(o1, o2)
KlProcessId o1, o2;
{
if (KlIsAnInteger(o2))
return o1->pid - o2->number;
if (KlIsANumber(o2)) {
return -KlSend_compare(o2, KlNumberMake(o1->pid)); /* let the subclasses do the work */
} else {
return (int) KlBadArgument(o2, 1, KlTypeCName(KlNumberType));
}
}
KlProcessIdInit()
{
KlDeclareSubType(&KlProcessIdType, "ProcessId", KlNumberType,
sizeof(struct _KlProcessId));
KlDeclareMethod1(KlProcessIdType, KlSelFree, KlProcessIdFree);
KlDeclareGenericNumber(KlProcessIdType);
KlDeclareMethod1(KlProcessIdType, KlSelCompare, (KlMethod)
KlProcessIdCompare);
}
/*****************************************************************************\
* subprocesses *
\*****************************************************************************/
/* KlSystem
* Spawns a sub-process
* returns child process ID (son of Int)
* command can be a string (forked via /bin/sh) or a list of strings
* in, out, & err correspond to stdin, stdout & stderr of new process
* if these are:
* - nil nothing is done (son inherits of standard streams)
* - an atom, a stream is created on this stream (pipe) and the atom is set
* to this value
* - a string, a filename that will be opened and connected to the standard
* stream of the new process. out and err are opened in append mode.
*/
#define KlPipeRead 0
#define KlPipeWrite 1
KlO
KlSystemKl(argc, argv)
int argc;
KlO *argv;
{
KlList command;
KlAtom in, out, err, io;
Int nohup;
int shell_added = 0;
int i, fd;
int p_in[2], p_out[2], p_err[2]; /* pipes descriptors */
char *f_in, *f_out, *f_err; /* file descriptors */
char **Cargv;
/* arguments check & parse */
KlParseKeywords(argc, argv, 1);
in = (KlAtom) KlKeyVal(KlK_input, 0);
out = (KlAtom) KlKeyVal(KlK_output, 0);
err = (KlAtom) KlKeyVal(KlK_error, 0);
io = (KlAtom) KlKeyVal(KlK_io, 0);
nohup = (Int) KlKeyVal(KlK_nohup, 0);
KlCheckUnvalidKeywords(argc, argv, 1);
if (io)
in = out = io;
if (nohup)
nohup = KlTrueP(((KlO) nohup));
command = (KlList) argv[0];
if (KlIsAString(command)) {
KlList old_command = command;
command = KlListTripletMake(KlStringMake(DEFAULT_SHELL),
KlStringMake("-c"),
old_command);
shell_added = 1;
} else {
KlMustBeList(command, 0);
for (i = 0; i < command->size; i++) {
KlMustBeString(command->list[i], i);
}
}
/* set up command for execvp */
Cargv = (char **) KlAlloca((command->size + 1));
for (i = 0; i < command->size; i++) {
Cargv[i] = ((KlString)(command->list[i]))->string;
}
Cargv[command->size] = 0;
/* set up the pipes for redirection */
KlSystemSetPipe(&in, &f_in, p_in, command, KlK_output);
KlSystemSetPipe(&out, &f_out, p_out, command, KlK_input);
KlSystemSetPipe(&err, &f_err, p_err, command, KlK_input);
/* do the fork */
if (KlProcessIdBeingCreated = VFORK()) { /* *** FATHER *** */
char *comname;
KlO returned_pid = (KlO) KlProcessIdMake(KlProcessIdBeingCreated);
KlProcessIdBeingCreated = KlProcessIdBeingCreatedDied = 0;
comname = Cargv[0];
if (in) {
close(p_in[KlPipeRead]);
KlSend_setq(in, KlStreamMake(fdopen(p_in[KlPipeWrite], "w"),
2, comname));
}
if (out) {
close(p_out[KlPipeWrite]);
if (out != in) { /* true if in == 0, obviously */
KlSend_setq(out, KlStreamMake(fdopen(p_out[KlPipeRead], "r"),
1, comname));
} else { /* one fp opened read/write */
KlStream stream = (KlStream) in->c_val;
stream->direction = 3;
stream->write_fd = stream->fd; /* in becomes write */
stream->fd = fdopen(p_out[KlPipeRead], "r");
}
}
if (err) {
close(p_err[KlPipeWrite]);
if (err != out) { /* else merge err and out in son*/
if (err != in) {
KlSend_setq(err, KlStreamMake(fdopen(p_err[KlPipeRead], "r"),
1, comname));
} else { /* one fp opened read/write */
KlStream stream = (KlStream) in->c_val;
stream->direction = 3;
stream->write_fd = stream->fd; /* in becomes write */
stream->fd = fdopen(p_err[KlPipeRead], "r");
}
}
}
return returned_pid;
} else { /* *** SON *** */
if (in) {
dup2(p_in[KlPipeRead], 0);
} else if (f_in) {
if ((fd = open(f_in, O_RDONLY, 0666)) < 0)
KlExecError("reading (stdin): ", f_in);
else
dup2(fd, 0);
}
if (out) {
dup2(p_out[KlPipeWrite], 1);
} else if (f_out) {
if ((fd = open(f_out, O_APPEND|O_WRONLY|O_CREAT, 0666)) < 0)
KlExecError("writing (stdout): ", f_out);
else
dup2(fd, 1);
}
if (err) {
if (err != out)
dup2(p_err[KlPipeWrite], 2);
else /* err and out mixed */
dup2(1, 2);
} else if (f_err) {
if (f_out && (!strcmp(f_err, f_out))) {
dup2(1, 2); /* merge out and err */
} else if ((fd = open(f_err,
O_APPEND|O_WRONLY|O_CREAT, 0666)) < 0) {
KlExecError("writing (stderr): ", f_err);
} else {
dup2(fd, 2);
}
}
KlCloseStreamsForExec();
if (nohup) {
KlSetSignal(SIGHUP, SIG_IGN); /* avoid killing son */
KlSetSignal(SIGTERM, SIG_IGN);
}
execvp(Cargv[0], Cargv);
KlExecError(0, Cargv[0]);
return 0; /* NOTREACHED */
}
}
/* aux. function for KlSystem
*/
KlSystemSetPipe(in, f_in, p_in, command, mode)
KlAtom *in;
char **f_in;
int *p_in;
KlList command;
KlKeyword mode;
{
*f_in = 0;
if (*in) {
if (KlTrueP((*in))) {
if (KlIsASymbol((*in))) {
if (pipe(p_in) < 0) {
KlOpenError(0, command->list[0], mode, 1);
*in = 0;
}
} else if (KlIsAString((*in))) {
if (KlUmask == -1)
KlUmaskGet(0);
*f_in = (*in)->p_name;
*in = 0;
} else {
KlMustBeString((*in), 1);
}
} else {
*in = 0;
}
}
}
/* small C-callable function for being called in a signal handler
*/
int
KlSystemLite(argv)
char **argv;
{
if (!VFORK()) { /* son */
KlSetSignal(SIGHUP, SIG_IGN); /* avoid killing son */
KlCloseStreamsForExec();
execvp(argv[0], argv);
KlExecError(0, argv[0]);
}
}
/* code to close uneeded FD before execing a process */
KlCloseStreamsForExec()
{
int i, n;
int dts = getdtablesize();
KlCleanBeforeExec(); /* application-defined cleanup code */
if (KlA_keep_streams_exec->c_val != KlUndef
&& KlIsAList(KlA_keep_streams_exec->c_val)
&& (n = ((KlList) (KlA_keep_streams_exec->c_val))->size)) {
KlStream *fd_list = (KlStream *)
((KlList) (KlA_keep_streams_exec->c_val))->list;
int *excluded = (int *) KlAlloca(dts);
bzero(excluded, dts * sizeof(int));
for (i = 0; i < n; i++) {
if (KlIsAFileStream(fd_list[i])) {
excluded[KlFp2Fd((fd_list[i])->fd)] = 1;
excluded[KlFp2Fd((fd_list[i])->write_fd)] = 1;
}
}
for (i = 3; i < dts; i++) {
if (!excluded[i])
close(i);
}
} else {
for (i = 3; i < dts; i++)
close(i); /* close file descriptors > 2*/
}
}
/* KlExecvpKl = *:exec
* transforms this process into another one via execvp
*/
KlO
KlExecvpKl(argc, klargv)
int argc;
KlString *klargv;
{
int i;
char **argv;
if (!argc)
return KlBadNumberOfArguments(argc);
/* build up array of args plus terminating NULL pointer */
argv = (char **) Malloc((argc + 1) * sizeof (char *));
argv[argc] = 0;
for (i = 0; i < argc; i++) {
KlMustBeString(klargv[i], i);
argv[i] = KlStrdup(klargv[i]->string);
}
KlCloseStreamsForExec();
execvp(argv[0], argv);
KlExecError(0, argv[0]);
return NIL;
}
/********************************************************* KlKillChildren */
/* Sends a signal to all children still alive. useful to simulate setsid()
*/
KlKillChildren()
{
KlProcessId pid = KlSIGHUPOnExit ? KlProcessIdList : 0;
#ifdef AMIGA
int sig = SIGINT;
#else /* !AMIGA */
int sig = SIGHUP;
#endif /* !AMIGA */
while (pid) {
if (pid->alive)
kill(pid->pid, sig);
pid = pid->next;
}
}
/*****************************************************************************\
* fork *
\*****************************************************************************/
/* the raw fork() call
* The need of these call prouves that Klone is more and more used for
* non-trivial programs!
* returns PID of son or () if father
*/
KlO
KlFork()
{
if (KlProcessIdBeingCreated = fork()) { /* father */
KlO returned_pid = (KlO) KlProcessIdMake(KlProcessIdBeingCreated);
KlProcessIdBeingCreated = KlProcessIdBeingCreatedDied = 0;
return returned_pid;
} else { /* son */
return NIL;
}
}
/*****************************************************************************\
* wait *
\*****************************************************************************/
/* wait does some fancy footwork to avoid letting <defunct> processes
* pending termination when forked by the main process
*/
/* wait for the death of a child
* argument:
* - process id: waits for death or returns immediately if already dead
* - () just returns immediately with a list (pid, status) of dead son
* or nil if no more left to report, or blocks till one dies depending
* of the value of blocking
* - list: waits for all pids in list to terminate
* returns a list of results for EACH process:
* nil - child not terminated yet (if :blocking ())
* n < 0 - child killed by signal, n is the number of the signal
* 0 <= n < 255 - termination code
* if :blocking is 1, returns () if all have been reposter or a pair
* (id result) when the 1st terminates
*
* WARNING: only processes whose ID have been store (refcount non null)
* can be waited for
*
* if the keywored :blocking () is declared (defaults to t), then wait
* always returns immediately, returning () if the process is still alive, its
* exit code otherwise.
*/
KlO
KlWait(argc, argv)
int argc;
KlProcessId *argv;
{
int status;
int child;
KlProcessId pid;
KlO blocking;
KlProcessId id;
/* parses options */
KlParseKeywords(argc, argv, 1);
blocking = KlKeyVal(KlK_blocking, TRU);
KlCheckUnvalidKeywords(argc, argv, 1);
if (KlFalseP(blocking))
blocking = 0;
id = argv[0];
if (KlFalseP(id)) { /* () just return first dead child */
pid = KlProcessIdList;
while (pid) {
if (pid->pid && (!(pid->alive))) {
KlProcessIdReported(pid);
return (KlO) KlListPairMake(pid, KlNumberMake(pid->status));
}
pid = pid->next;
}
/* no already dead sons, wait or return NIL */
if (blocking && KlProcessIdList) {
if ((child = KlDoWait(&status)) != -1) {
if (pid = KlProcessIdFind(child)) {
pid->alive = 0;
KlProcessIdReported(pid);
return (KlO) KlListPairMake(pid,
KlNumberMake(pid->status));
}
}
}
return NIL;
} else if (KlIsAList(id)) { /* list: wait for all processes */
KlList list = (KlList) id;
KlNumber klnum = KlNumberMake(list->size);
KlList res = (KlList) KlListNMakeKl(1, &klnum);
int i;
if (blocking) { /* - blocking form */
/* wait for one process */
if (KlIsANumber(blocking) && ((KlNumber)blocking)->number == 1) {
int all_dead = 1;
for (i = 0; i < list->size; i++) {
KlProcessId pid = (KlProcessId)(list->list[i]);
KlMustBeProcessId (pid, i);
if (!(pid->alive) && pid->pid) {
/* not yet reported */
KlProcessIdReported(pid);
return (KlO)
KlListPairMake(pid, KlNumberMake(pid->status));
} else if (pid->alive && pid->pid) {
all_dead = 0;
}
}
if (all_dead)
return NIL;
for (;;) {
if ((child = KlDoWait(&status)) != -1) {
if ((pid = KlProcessIdFind(child))
&& -1 != KlPosition(list->size, list->list, pid)) {
pid->alive = 0;
KlProcessIdReported(pid);
return (KlO)
KlListPairMake(pid, KlNumberMake(pid->status));
}
}
}
} else { /* wait for all processes */
/* if no one yet dead, wait for one... */
for (;;) {
int all_dead = 1;
for (i = 0; i < list->size; i++) {
KlMustBeProcessId (((KlProcessId)(list->list[i])), i);
if ((((KlProcessId)(list->list[i]))->alive)
&& (((KlProcessId)(list->list[i]))->pid)) {
all_dead = 0;
}
}
if (all_dead) {
break;
} else {
if ((child = KlDoWait(&status)) == -1) {
if (errno == ECHILD) { /* no more children */
break;
} /* else something went wrong, retry */
} else if (pid = KlProcessIdFind(child)) {
pid->alive = 0;
}
}
}
for (i = 0; i < list->size; i++) {
KlProcessIdReported(list->list[i]);
KlDecRef(res->list[i]);
KlIncRef(res->list[i] = (KlO)
KlNumberMake(((KlProcessId)
(list->list[i]))->status));
}
}
} else { /* - non-blocking only lists deads */
for (i = 0; i < list->size; i++) {
KlMustBeProcessId (((KlProcessId)(list->list[i])), i);
if (!(((KlProcessId)(list->list[i]))->alive)) {
KlProcessIdReported(list->list[i]);
KlDecRef(res->list[i]);
KlIncRef(res->list[i] = (KlO)
KlNumberMake(((KlProcessId)
(list->list[i]))->status));
}
}
}
return (KlO) res;
} else { /* ID: find child and return status */
KlMustBeProcessId(id, 0);
if (id->alive) {
if (blocking) { /* blocks */
for (;;) {
child = KlDoWait(&status);
if (child == -1) {
if (errno == ECHILD || !errno) { /* no more children */
if (id->alive) {
id->alive = 0; /* then it must be dead... */
id->status = 0;
}
} else if (errno == EINTR) {
/* else retry (wait was interrupted by a signal) */
continue;
}
} else if (child == id->pid) {
int returned_status;
if ((returned_status = KlWaitReturnedStatus(status))
!= KlSTOPPED) {
KlProcessIdReported(id);
id->alive = 0;
return (KlO) KlNumberMake(returned_status);
} /* else just stopped, ignore */
} else { /* another child died, register it */
if (child)
KlProcessIdDies(child, status);
}
if (!id->alive) { /* safety check, just in case */
/* child has died meanwhile */
return (KlO) KlNumberMake(id->status);
}
}
} else { /* returns nil if non blocking */
return NIL;
}
} else { /* already dead, return stored value */
KlProcessIdReported(id);
return (KlO) KlNumberMake(id->status);
}
}
}
/* KlDoWait is wait but which sets signal handler not to call wait
*/
int
KlDoWait(statusp)
int *statusp;
{
int child;
child = KlWaitPid(statusp);
return child;
}
int
KlWaitReturnedStatus(status)
unsigned int status;
{
if (status & 0xff) {
if ((status & 0xff) == 0177) { /* stopped, return -1 */
return KlSTOPPED;
} else { /* killed, return No of killer sig */
return - (status & 0x7f);
}
} else { /* normal termination */
return (status & 0xffff) >> 8;
}
}
/*****************************************************************************\
* signals *
\*****************************************************************************/
/**************************************************** replacement for signal */
/* here we store the app-defined signals */
/* if you get a compile error "illegal pointer combination", then you need
* to #define (or #undef) VOID_SIGNALS
*/
/* Signal Handling in Klone:
*
* The application embedding klone is free to use the signals, except for the
* 3 special signals SIGCHLD SIGFPE SIGPIPE that Klones uses internally to
* operate. Blindly redefining them could either make some Klone features not
* working (Klone loosing track of subprocesses) or be overriden by Klone at
* a later time (SigPIPE).
*
* Thus each call to signal in the application should be replaced to calls to
* KlSignal(sig, handler), which basically will do a call to signal, or
* set wrappers (via the internal variables KlAppSignal_FPE, KlAppSignal_PIPE,
* KlAppSignal_CHLD) around the application handlers that will be called after
* Klone has performed its own handling for them
*/
static KlSignalHandler KlAppSignal_FPE = SIG_DFL;
static KlSignalHandler KlAppSignal_PIPE = SIG_DFL;
static KlSignalHandler KlAppSignal_CHLD = SIG_DFL;
KlSignalHandler
KlSignal(sig, handler)
int sig;
KlSignalHandler handler;
{
KlSignalHandler res = 0;
if (sig == KlSIGCHLD) {
res = KlAppSignal_CHLD;
KlAppSignal_CHLD = handler;
} else if (sig == SIGFPE) {
res = KlAppSignal_FPE;
KlAppSignal_FPE = handler;
} else if (sig == SIGPIPE) {
res = KlAppSignal_PIPE;
KlAppSignal_PIPE = handler;
} else {
return (KlSignalHandler) KlSetSignal(sig, handler);
}
return res;
}
/******************************************************************** SIGFPE */
KlRSignal
KlSigFpeHandler(sig)
int sig;
{
#ifdef RE_DECLARE_SIGNALS
KlSetSignal(SIGFPE, KlSigFpeHandler);
#endif
KlLastSignal = SIGFPE;
if (KlAppSignal_FPE != SIG_IGN) {
if (KlAppSignal_FPE == SIG_DFL) {
KlError0(KlE_NUMERIC_ERROR);
} else {
CFAPPLY(KlAppSignal_FPE, (sig));
}
}
#ifndef VOID_SIGNALS
return sig;
#endif
}
#ifdef TRACEALL
char *KlSigPipeHandler_mess;
#endif
/******************************************************************* SIGPIPE */
KlRSignal
KlSigPipeHandler(sig)
int sig;
{
int EOP_trapped;
#ifdef TRACEALL
KlSigPipeHandler_mess[46] = '0' + KlSigPipeHandler_notcalled;
write(2, KlSigPipeHandler_mess, 48);
#endif
if (KlSigPipeHandler_notcalled) {
KlSigPipeHandler_notcalled = 0;
goto end;
}
EOP_trapped = KlStackFrameLookForCatch(KlA_EOP);
#ifdef RE_DECLARE_SIGNALS
KlSetSignal(SIGPIPE, KlSigPipeHandler);
#endif
KlLastSignal = SIGPIPE;
if (KlAppSignal_PIPE != SIG_IGN) {
if (KlAppSignal_PIPE == SIG_DFL) {
if (EOP_trapped) {
KlThrow(KlA_EOP, NIL);
} else {
KlExit(0);
}
} else {
CFAPPLY(KlAppSignal_PIPE, (sig));
}
}
end:
#ifndef VOID_SIGNALS
return sig; /* NOTREACHED */
#else
return ; /* avoid one of the gazillion bugs of DEC alpha compilers */
#endif
}
/******************************************************************* SIGCHLD */
/* to avoid defunct processes
* for reentrancy, we only set a counter (which is atomic)
*/
KlRSignal
KlChildDeathHandler(sig)
int sig;
{
KlChildDeathReported = 1;
#ifdef RE_DECLARE_SIGNALS
KlSetSignal(KlSIGCHLD, KlChildDeathHandler);
#endif
if (KlChildDeathHook) (*KlChildDeathHook)();
}
#ifdef DEBUG
#ifdef SA_RESTART
int
KlSignalList()
{
struct sigaction oldact;
unsigned int i, n;
printf("***ChildDeath handler:\n");
if (sigaction(KlSIGCHLD, 0, &oldact)) {
printf(" sigaction returned error! aborted!\n");
return 0;
}
printf(" handler = 0x%x %s\n flags: ", oldact.sa_handler,
(oldact.sa_handler == KlChildDeathHandler ? "(KlChildDeathHandler)"
: ""));
for (i = 0; i < 32; i++) {
n = 1 << i;
if (n & oldact.sa_flags)
printf("0x%x ", n);
}
printf("\n");
return oldact.sa_flags;
}
#endif /* SA_RESTART */
#endif /* DEBUG */
/* then, we often check (at each GC) if we have zombies to bury,
* we process their death
* we set the counter to 0 before processing, to be sure we dont miss some
* (we may look for nothing which is not important as wait doesnt block)
*/
void
KlChildDeathProcess()
{
int status, pid;
KlLastSignal = KlSIGCHLD;
do { /* in case some happen now */
KlChildDeathReported = 0; /* re-init each time to trap sigs */
while ((pid = KlWaitPid(&status)) > 0) { /* 0 ==> no more child */
KlProcessIdDies(pid, KlWaitReturnedStatus(status));
if (KlAppSignal_CHLD != SIG_IGN && KlAppSignal_CHLD != SIG_DFL)
CFAPPLY(KlAppSignal_CHLD, (KlSIGCHLD));
}
} while (KlChildDeathReported);
}
/********************************************************************* inits */
KlSignalsInit()
{
KlSetSignal(KlSIGCHLD, KlChildDeathHandler);
KlSetSignal(SIGPIPE, KlSigPipeHandler);
KlSetSignal(SIGFPE, KlSigFpeHandler);
}
KlTrapSIGPIPE()
{
KlSetSignal(SIGPIPE, KlSigPipeHandler);
}
/*****************************************************************************\
* primitive redefinition of signals *
\*****************************************************************************/
/* the signal handler runner */
KlO *KlSignalHandlerList;
int KlSignalHandlerListSize = 0;
char *KlSignalHandlerArgv[4] = { DEFAULT_SHELL, "-c", 0, 0};
KlRSignal
KlSignalHandlerExecute(sig)
int sig;
{
KlLastSignal = sig;
if (KlSignalHandlerList[sig]->type == KlListType) { /* not vector */
int i;
KlList coll = (KlList) (KlSignalHandlerList[sig]);
for (i = 0; i < coll->size; i++) {
KlSignalHandlerExecuteAux(sig, coll->list[i]);
}
} else {
KlSignalHandlerExecuteAux(sig, KlSignalHandlerList[sig]);
}
#ifdef SYSV_SIGNALS
KlSetSignal(sig, KlSignalHandlerExecute);
#endif
#ifndef VOID_SIGNALS
return sig;
#endif
}
KlSignalHandlerExecuteAux(sig, handler)
int sig;
KlO handler;
{
if (KlIsAnAtom(handler)) {
KlAtomSetq(handler, TRU);
} else if (KlIsAString(handler)) {
KlSignalHandlerArgv[2] = ((KlString)handler)->string;
KlSystemLite(KlSignalHandlerArgv);
} else if (KlIsANumber(handler)) {
KlExit(((KlNumber)handler)->number);
} else if (KlIsAFSubr(handler)
|| KlIsASubr(handler)) {
switch (((KlSubr)(handler))->arity) {
case 0:
CFAPPLY((KlSignalHandler) handler, ());
/* case 1:
CFAPPLY((KlSignalHandler) handler, (sig));
*/
}
} else if (KlIsAVector(handler) && ((KlVector) handler)->size == 2) {
if ((((KlVector) handler)->list[0]) == TRU) { /* fork */
if (fork())
return; /* else (son), execute and quit */
}
{
KlO res = (((KlVector) handler)->list[1]);
KlExecuteKlone(1, &res);
KlExit(0);
}
}
}
KlSignalHandlerAdd(sig, handler)
int sig;
KlO handler;
{
if (!KlSignalHandlerListSize) {
KlSignalHandlerList = (KlO *) Calloc(sig + 1, KLSO);
KlSignalHandlerListSize = sig + 1;
} else if (sig >= KlSignalHandlerListSize) {
KlSignalHandlerList = (KlO *)
Realloc(KlSignalHandlerList, KLSO * (sig + 1));
bzero(KlSignalHandlerList + KlSignalHandlerListSize,
KLSO * (sig + 1 - KlSignalHandlerListSize));
}
KlDecRef(KlSignalHandlerList[sig]);
KlIncRef(KlSignalHandlerList[sig] = handler);
}
/* NOTE: this provides a minimal way to redefine signals
* to either:
* () ==> default handling SIG_DFL
* t ==> ignores signal SIG_IGN
* "string" ==> forks this /bin/sh command
* number ==> exit with code number
* atom ==> sets this variable to t
* subr: calls this subr (which must be coded especially)
* [() expr]: execute expr without args and exit
* [t expr]: forks a process executing expr while main process goes on
* klone code: may be able to be executed in another klone version
*/
KlO
KlTrapSignal(argc, argv)
int argc;
KlO *argv;
{
KlNumber sig;
KlO handler;
if (argc < 2)
return KlBadNumberOfArguments((char *) argc);
sig = (KlNumber) argv[0];
KlMustBeNumber(sig, 0);
if (argc > 2) {
int i;
KlList handlerlist = KlListNMake(0);
for (i = 1; i < argc; i++)
KlListAppend(handlerlist, argv[i]);
KlTrapSignalAux(sig->number, handlerlist);
} else {
KlTrapSignalAux(sig->number, argv[1]);
}
return argv[argc - 1];
}
KlTrapSignalAux(sig, handler)
int sig;
KlO handler;
{
if (KlFalseP(handler)) {
KlSignal(sig, SIG_DFL);
if (sig < KlSignalHandlerListSize)
KlSignalHandlerAdd(sig, NIL);
} else if (handler == TRU) {
KlSignal(sig, SIG_IGN);
if (sig < KlSignalHandlerListSize)
KlSignalHandlerAdd(sig, NIL);
} else if (KlIsANumber(handler)
|| KlIsAString(handler)
|| KlIsASubr(handler)
|| KlIsAFSubr(handler)
|| KlIsAVector(handler)
|| KlIsAList(handler)
) {
if (KlIsAnAtom(handler)) {
KlAtomSetq(handler, NIL);
}
KlSignalHandlerAdd(sig, handler);
KlSignal(sig, KlSignalHandlerExecute);
} else {
KlBadArgument(handler, 1, KlTypeCName(KlStringType));
}
}
/*****************************************************************************\
* errno *
\*****************************************************************************/
/* returns a string describing the errno unix error number
*/
KlO
KlErrnoGet(errnum)
int errnum;
{
#ifdef HAS_SYS_ERRLIST
if (errnum >= 0 && errnum < sys_nerr)
return (KlO) KlStringMake(sys_errlist[errnum]);
else {
char tmp[80]; /* hack: returns errno =...*/
sprintf(tmp, "errno = %d", errnum);
return (KlO) KlStringMake(tmp);
}
#else /* !HAS_SYS_ERRLIST */
# ifndef NO_STRERROR
return (KlO) KlStringMake(strerror(errnum));
# else /* NO_STRERROR */
char tmp[80]; /* hack: returns errno =...*/
sprintf(tmp, "errno = %d", errnum);
return (KlO) KlStringMake(tmp);
# endif /* NO_STRERROR */
#endif /* !HAS_SYS_ERRLIST */
}
/*****************************************************************************\
* INIT *
\*****************************************************************************/
KlOSInit()
{
/* initialize the origin of times */
int i;
struct tms buffer;
start_time = times(&buffer);
KlProcessIdInit();
KlFileStatsStructInit();
KlActiveMake("*current-directory*", KlCurrentDirectoryGet,
KlCurrentDirectorySet, 0);
KlActiveMake("*umask*", KlUmaskGet, KlUmaskSet, 0);
KlActiveMake("*errno*", KlErrnoGet, KlActivePointerToIntSet, &errno);
KlConstantMake("*current-process-id*", KlNumberMake(getpid()));
KlActiveMake("*hostname*", KlHostnameGet, 0, 0);
KlDeclareSubr(KlUsedTime, "get-internal-run-time", NARY);
KlDeclareFSubr(KlAbsoluteTime, "get-current-time", 0);
KlDeclareSubr(KlSystemKl, "system", NARY);
KlDeclareSubr(KlWait, "wait", NARY);
KlDeclareSubr(KlFileStats, "file-stats", NARY);
KlDeclareSubr(KlFileTruncate, "file-truncate", 2);
KlDeclareSubr(KlDirectory, "directory", NARY);
KlDeclareSubr(KlTrapSignal, "trap-signal", NARY);
KlDeclareSubr(KlGetenv, "getenv", 1);
KlDeclareSubr(KlPutenv, "putenv", 2);
KlDeclareSubr(KlListenv, "listenv", 0);
KlDeclareSubr(KlExecvpKl, "*:exec", NARY);
KlDeclareFSubr(KlFork, "*:fork", NARY);
/* keyword lists */
KlOpenKV_type = (KlKeyword *) Malloc(KLSO * 6); i = 0;
KlOpenKV_type[i++] = KlK_real;
KlOpenKV_type[i++] = KlK_cpu;
KlOpenKV_type[i++] = KlK_user;
KlOpenKV_type[i++] = KlK_sys;
KlOpenKV_type[i++] = KlK_all;
KlOpenKV_type[i++] = 0;
#ifdef TRACEALL
KlSigPipeHandler_mess = (char *) strdup("KlSigPipeHandler, KlSigPipeHandler_notcalled = \n");
#endif
}
syntax highlighted by Code2HTML, v. 0.9.1