conservatory/elk
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* No TABS !!

Browse Source 
git-svn-id: svn://svn.zoy.org/elk/trunk@66 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam
2003-09-02 08:12:11 +00:00
parent cd36edfd2a
commit 769b9f2fa6
123 changed files with 5933 additions and 5933 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/unix/error.c
+1 -1
View File
@@ -81,7 +81,7 @@ elk_init_unix_error() {
Global_GC_Link(Unix_Errobj);
Define_Variable(&V_Call_Errhandler, "unix-call-standard-error-handler?",
True);
True);
Def_Prim(P_Errorp, "unix-error?", 1, 1, EVAL);
Def_Prim(P_Errno, "unix-errno", 0, 0, EVAL);
lib/unix/fdescr.c
+32 -32
View File
@@ -54,7 +54,7 @@ SYMDESCR Lseek_Syms[] = {
*/
static Object P_Close(fd) Object fd; {
if (close(Get_Integer(fd)) == -1)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Void;
}
@@ -63,11 +63,11 @@ static Object P_Close_On_Exec(argc, argv) int argc; Object *argv; {
fd = Get_Integer(argv[0]);
if ((flags = fcntl(fd, F_GETFD, 0)) == -1)
Raise_System_Error("fcntl(F_GETFD): ~E");
Raise_System_Error("fcntl(F_GETFD): ~E");
if (argc == 2) {
Check_Type(argv[1], T_Boolean);
if (fcntl(fd, F_SETFD, Truep(argv[1])) == -1)
Raise_System_Error("fcntl(F_SETFD): ~E");
Check_Type(argv[1], T_Boolean);
if (fcntl(fd, F_SETFD, Truep(argv[1])) == -1)
Raise_System_Error("fcntl(F_SETFD): ~E");
}
return flags & 1 ? True : False;
}
@@ -76,7 +76,7 @@ static Object P_Dup(argc, argv) int argc; Object *argv; {
int fd = Get_Integer(argv[0]), ret;
if ((ret = (argc == 1 ? dup(fd) : dup2(fd, Get_Integer(argv[1])))) == -1)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Make_Integer(ret);
}
@@ -85,10 +85,10 @@ static Object P_Filedescriptor_Flags(argc, argv) int argc; Object *argv; {
fd = Get_Integer(argv[0]);
if ((flags = fcntl(fd, F_GETFL, 0)) == -1)
Raise_System_Error("fcntl(F_GETFL): ~E");
Raise_System_Error("fcntl(F_GETFL): ~E");
if (argc == 2) {
if (fcntl(fd, F_SETFL, Symbols_To_Bits(argv[1], 1, Fcntl_Flags)) == -1)
Raise_System_Error("fcntl(F_SETFL): ~E");
if (fcntl(fd, F_SETFL, Symbols_To_Bits(argv[1], 1, Fcntl_Flags)) == -1)
Raise_System_Error("fcntl(F_SETFL): ~E");
}
return Bits_To_Symbols((unsigned long)flags, 1, Fcntl_Flags);
}
@@ -102,19 +102,19 @@ static Object P_Fildescriptor_Port(fd, mode) Object fd, mode; {
m = Get_String(mode);
switch (m[0]) {
case 'r':
flags = P_INPUT; break;
flags = P_INPUT; break;
case 'w': case 'a':
flags = 0; break;
flags = 0; break;
default:
Primitive_Error("invalid mode: ~s", mode);
Primitive_Error("invalid mode: ~s", mode);
}
if (m[1] == '+')
flags = P_BIDIR;
flags = P_BIDIR;
Disable_Interrupts;
if ((fp = fdopen(n = Get_Integer(fd), m)) == 0) {
Saved_Errno = errno;
Enable_Interrupts;
Raise_System_Error("~E");
Saved_Errno = errno;
Enable_Interrupts;
Raise_System_Error("~E");
}
sprintf(buf, "unix-fildescriptor[%d]", n);
ret = Make_Port(flags, fp, Make_String(buf, strlen(buf)));
@@ -141,8 +141,8 @@ static Object P_Lseek(fd, off, whence) Object fd, off, whence; {
off_t ret;
if ((ret = lseek(Get_Integer(fd), (off_t)Get_Long(off),
(int)Symbols_To_Bits(whence, 0, Lseek_Syms))) == (off_t)-1)
Raise_System_Error("~E");
(int)Symbols_To_Bits(whence, 0, Lseek_Syms))) == (off_t)-1)
Raise_System_Error("~E");
return Make_Unsigned_Long((unsigned long)ret);
}
@@ -155,8 +155,8 @@ int Num_Filedescriptors() {
#elif defined(SC_OPEN_MAX_IN_UNISTD_H)
static r;
if (r == 0) {
if ((r = sysconf(_SC_OPEN_MAX)) == -1)
r = 256;
if ((r = sysconf(_SC_OPEN_MAX)) == -1)
r = 256;
}
ret = r;
#elif defined(NOFILE)
@@ -178,13 +178,13 @@ static Object P_Open(argc, argv) int argc; Object *argv; {
fn = argv[0];
mode = (int)Symbols_To_Bits(argv[1], 1, Open_Syms);
if (!(n = mode & 3))
Primitive_Error("mode must include 'read or 'write");
Primitive_Error("mode must include 'read or 'write");
mode &= ~3; mode |= n-1;
if (mode & O_CREAT && argc == 2)
Primitive_Error("third argument required for 'create");
Primitive_Error("third argument required for 'create");
if ((n = open(Get_Strsym(fn), mode, argc == 3 ? Get_Integer(argv[2]) : 0))
== -1)
Raise_System_Error1("~s: ~E", fn);
== -1)
Raise_System_Error1("~s: ~E", fn);
return Make_Integer(n);
}
@@ -192,14 +192,14 @@ static Object P_Pipe() {
int fd[2];
if (pipe(fd) == -1)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Integer_Pair(fd[0], fd[1]);
}
static Object P_Port_Filedescriptor(port) Object port; {
Check_Type(port, T_Port);
if ((PORT(port)->flags & (P_STRING|P_OPEN)) != P_OPEN)
Primitive_Error("~s: invalid port", port);
Primitive_Error("~s: invalid port", port);
return Make_Integer(fileno(PORT(port)->file));
}
@@ -211,15 +211,15 @@ static Object Read_Write(argc, argv, readflg) int argc; Object *argv; {
Check_Type(argv[1], T_String);
sp = STRING(argv[1]);
if (argc == 3) {
if ((len = Get_Integer(argv[2])) < 0 || len > sp->size)
Range_Error(argv[2]);
if ((len = Get_Integer(argv[2])) < 0 || len > sp->size)
Range_Error(argv[2]);
} else len = sp->size;
if (readflg)
len = read(fd, sp->data, len);
len = read(fd, sp->data, len);
else
len = write(fd, sp->data, len);
len = write(fd, sp->data, len);
if (len == -1)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Make_Integer(len);
}
@@ -251,7 +251,7 @@ void elk_init_unix_fdescr() {
Def_Prim(P_Fildescriptor_Port, "unix-filedescriptor->port",2, 2, EVAL);
Def_Prim(P_Isatty, "unix-isatty?", 1, 1, EVAL);
Def_Prim(P_List_Filedescriptor_Flags,
"unix-list-filedescriptor-flags", 0, 0, EVAL);
"unix-list-filedescriptor-flags", 0, 0, EVAL);
Def_Prim(P_List_Open_Modes, "unix-list-open-modes", 0, 0, EVAL);
Def_Prim(P_Lseek, "unix-lseek", 3, 3, EVAL);
Def_Prim(P_Num_Filedescriptors, "unix-num-filedescriptors", 0, 0, EVAL);
lib/unix/file.c
+34 -34
View File
@@ -27,39 +27,39 @@ static SYMDESCR Access_Syms[] = {
static Object P_Accessp(fn, mode) Object fn, mode; {
if (access(Get_Strsym(fn), (int)Symbols_To_Bits(mode, 1, Access_Syms))
== 0)
return True;
== 0)
return True;
Saved_Errno = errno;
return False;
}
static Object P_Chdir(fn) Object fn; {
if (chdir(Get_Strsym(fn)) == -1)
Raise_System_Error1("~s: ~E", fn);
Raise_System_Error1("~s: ~E", fn);
return Void;
}
static Object P_Chmod(fn, mode) Object fn, mode; {
if (chmod(Get_Strsym(fn), Get_Integer(mode)) == -1)
Raise_System_Error1("~s: ~E", fn);
Raise_System_Error1("~s: ~E", fn);
return Void;
}
static Object P_Chown(fn, uid, gid) Object fn, uid, gid; {
if (chown(Get_Strsym(fn), Get_Integer(uid), Get_Integer(gid)) == -1)
Raise_System_Error1("~s: ~E", fn);
Raise_System_Error1("~s: ~E", fn);
return Void;
}
static Object P_Link(fn1, fn2) Object fn1, fn2; {
if (link(Get_Strsym(fn1), Get_Strsym(fn2)) == -1)
Raise_System_Error2("(~s ~s): ~E", fn1, fn2);
Raise_System_Error2("(~s ~s): ~E", fn1, fn2);
return Void;
}
static Object P_Mkdir(fn, mode) Object fn, mode; {
if (mkdir(Get_Strsym(fn), Get_Integer(mode)) == -1)
Raise_System_Error1("~s: ~E", fn);
Raise_System_Error1("~s: ~E", fn);
return Void;
}
@@ -77,15 +77,15 @@ static Object P_Read_Directory(fn) Object fn; {
GC_Link(ret);
Disable_Interrupts;
if ((d = opendir(Get_Strsym(fn))) == NULL) {
Saved_Errno = errno;
Enable_Interrupts;
Raise_System_Error1("~s: cannot open", fn);
Saved_Errno = errno;
Enable_Interrupts;
Raise_System_Error1("~s: cannot open", fn);
}
while ((dp = readdir(d)) != NULL) {
Object x;
Object x;
x = Make_String(dp->d_name, strlen(dp->d_name));
ret = Cons(x, ret);
x = Make_String(dp->d_name, strlen(dp->d_name));
ret = Cons(x, ret);
}
/* closedir() is void under 4.3BSD, should check result elsewhere.
*/
@@ -98,21 +98,21 @@ static Object P_Read_Directory(fn) Object fn; {
static Object P_Rename(fromfn, tofn) Object fromfn, tofn; {
#ifdef HAVE_RENAME
if (rename(Get_Strsym(fromfn), Get_Strsym(tofn)) == -1)
Raise_System_Error2("(~s ~s): ~E", fromfn, tofn);
Raise_System_Error2("(~s ~s): ~E", fromfn, tofn);
#else
char *from = Get_Strsym(fromfn), *to = Get_Strsym(tofn);
Disable_Interrupts;
if (link(from, to) == -1) {
Saved_Errno = errno;
Enable_Interrupts;
Raise_System_Error2("(~s ~s): ~E", fromfn, tofn);
Saved_Errno = errno;
Enable_Interrupts;
Raise_System_Error2("(~s ~s): ~E", fromfn, tofn);
}
if (unlink(from) == -1) {
Saved_Errno = errno;
(void)unlink(to);
Enable_Interrupts;
Raise_Error1("~s: ~E", fromfn);
Saved_Errno = errno;
(void)unlink(to);
Enable_Interrupts;
Raise_Error1("~s: ~E", fromfn);
}
Enable_Interrupts;
#endif
@@ -129,14 +129,14 @@ static Object General_Stat(obj, ret, l) Object obj, ret; int l; {
Check_Result_Vector(ret, 11);
if (l) {
#ifdef SYMLINKS
result = lstat(Get_Strsym(obj), &st);
result = lstat(Get_Strsym(obj), &st);
#endif
} else {
Get_Filename_Or_Filedescr(obj, fd, fn);
Get_Filename_Or_Filedescr(obj, fd, fn);
result = fn ? stat(fn, &st) : fstat(fd, &st);
}
if (result == -1)
Raise_System_Error1("~s: ~E", obj);
Raise_System_Error1("~s: ~E", obj);
switch (st.st_mode & S_IFMT) {
case S_IFDIR: s = "directory"; break;
case S_IFCHR: s = "character-special"; break;
@@ -200,8 +200,8 @@ static Object P_Readlink(fn) Object fn; {
len = Path_Max();
Alloca(buf, char*, len);
if ((len = readlink(Get_Strsym(fn), buf, len)) == -1) {
Alloca_End;
Raise_System_Error1("~s: ~E", fn);
Alloca_End;
Raise_System_Error1("~s: ~E", fn);
}
ret = Make_String(buf, len);
Alloca_End;
@@ -210,20 +210,20 @@ static Object P_Readlink(fn) Object fn; {
static Object P_Rmdir(fn) Object fn; {
if (rmdir(Get_Strsym(fn)) == -1)
Raise_System_Error1("~s: ~E", fn);
Raise_System_Error1("~s: ~E", fn);
return Void;
}
static Object P_Symlink(fn1, fn2) Object fn1, fn2; {
if (symlink(Get_Strsym(fn1), Get_Strsym(fn2)) == -1)
Raise_System_Error2("(~s ~s): ~E", fn1, fn2);
Raise_System_Error2("(~s ~s): ~E", fn1, fn2);
return Void;
}
#endif
static Object P_Unlink(fn) Object fn; {
if (unlink(Get_Strsym(fn)) == -1)
Raise_System_Error1("~s: ~E", fn);
Raise_System_Error1("~s: ~E", fn);
return Void;
}
@@ -231,14 +231,14 @@ static Object P_Utime(argc, argv) int argc; Object *argv; {
struct utimbuf ut;
if (argc == 2)
Primitive_Error("wrong number of arguments");
Primitive_Error("wrong number of arguments");
if (argc == 3) {
ut.actime = (time_t)Get_Unsigned_Long(argv[1]);
ut.modtime = (time_t)Get_Unsigned_Long(argv[2]);
ut.actime = (time_t)Get_Unsigned_Long(argv[1]);
ut.modtime = (time_t)Get_Unsigned_Long(argv[2]);
}
if (utime(Get_Strsym(argv[0]), argc == 1 ? (struct utimbuf *)0 : &ut)
== -1)
Raise_System_Error1("~s: ~E", argv[0]);
== -1)
Raise_System_Error1("~s: ~E", argv[0]);
return Void;
}
lib/unix/lock.c
+24 -24
View File
@@ -14,7 +14,7 @@
#ifdef LOCKS
static Object P_Internal_Lock_Operation(fd, lck, block, what, ret)
Object fd, lck, block, what, ret; {
Object fd, lck, block, what, ret; {
#ifdef RECORD_LOCKS
struct flock fl;
#else
@@ -27,7 +27,7 @@ static Object P_Internal_Lock_Operation(fd, lck, block, what, ret)
Check_Type(what, T_Character);
op = CHAR(what);
if (op == 'q')
Check_Result_Vector(ret, 4);
Check_Result_Vector(ret, 4);
#ifdef RECORD_LOCKS
Check_Type(block, T_Boolean);
@@ -38,39 +38,39 @@ static Object P_Internal_Lock_Operation(fd, lck, block, what, ret)
fl.l_start = Get_Long(*++vp);
fl.l_len = Get_Long(*++vp);
if (fcntl(Get_Integer(fd), op == 'q' ? F_GETLK :
(Truep(block) ? F_SETLKW : F_SETLK), &fl) == -1) {
if (op == 's' && !Truep(block) && (errno == EAGAIN || errno == EACCES))
return False;
Raise_System_Error("fcntl: ~E");
(Truep(block) ? F_SETLKW : F_SETLK), &fl) == -1) {
if (op == 's' && !Truep(block) && (errno == EAGAIN || errno == EACCES))
return False;
Raise_System_Error("fcntl: ~E");
}
if (op == 'q') {
Object x;
GC_Node;
Object x;
GC_Node;
if (fl.l_type == F_UNLCK)
return False;
GC_Link(ret);
VECTOR(ret)->data[0] = fl.l_type == F_WRLCK ? True : False;
x = Bits_To_Symbols((unsigned long)fl.l_whence, 0, Lseek_Syms);
VECTOR(ret)->data[1] = x;
x = Make_Long(fl.l_start); VECTOR(ret)->data[2] = x;
x = Make_Long(fl.l_len); VECTOR(ret)->data[3] = x;
GC_Unlink;
return Make_Integer(fl.l_pid);
if (fl.l_type == F_UNLCK)
return False;
GC_Link(ret);
VECTOR(ret)->data[0] = fl.l_type == F_WRLCK ? True : False;
x = Bits_To_Symbols((unsigned long)fl.l_whence, 0, Lseek_Syms);
VECTOR(ret)->data[1] = x;
x = Make_Long(fl.l_start); VECTOR(ret)->data[2] = x;
x = Make_Long(fl.l_len); VECTOR(ret)->data[3] = x;
GC_Unlink;
return Make_Integer(fl.l_pid);
}
#else
Check_Type(block, T_Boolean);
if (op == 'q')
return False;
return False;
vp = VECTOR(lck)->data;
Check_Type(*vp, T_Boolean);
mode = op == 'r' ? LOCK_UN : (Truep(*vp) ? LOCK_EX : LOCK_SH);
if (op != 'r' && !Truep(block))
mode |= LOCK_NB;
mode |= LOCK_NB;
if (flock(Get_Integer(fd), mode) == -1) {
if (op == 's' && !Truep(block) && errno == EWOULDBLOCK)
return False;
Raise_System_Error("flock: ~E");
if (op == 's' && !Truep(block) && errno == EWOULDBLOCK)
return False;
Raise_System_Error("flock: ~E");
}
#endif
return op == 's' ? True : Void;
@@ -81,7 +81,7 @@ static Object P_Internal_Lock_Operation(fd, lck, block, what, ret)
elk_init_unix_lock() {
#ifdef LOCKS
Def_Prim(P_Internal_Lock_Operation, "unix-internal-lock-operation",
5, 5, EVAL);
5, 5, EVAL);
P_Provide(Intern("unix:file-locking"));
#ifdef RECORD_LOCKS
P_Provide(Intern("unix:record-locks"));
lib/unix/misc.c
+1 -1
View File
@@ -8,7 +8,7 @@ static Object P_Getpass(prompt) Object prompt; {
ret = getpass(Get_String(prompt));
Enable_Interrupts;
if (ret == 0)
Raise_Error("cannot read password from /dev/tty");
Raise_Error("cannot read password from /dev/tty");
return Make_String(ret, strlen(ret));
}
lib/unix/passwd.c
+40 -40
View File
@@ -10,26 +10,26 @@ static Object P_Get_Passwd(argc, argv) int argc; Object *argv; {
Check_Result_Vector(argv[0], 7);
Disable_Interrupts;
if (argc == 1) {
if ((p = getpwent()) == 0) {
Enable_Interrupts;
Raise_Error("no more passwd entries");
}
if ((p = getpwent()) == 0) {
Enable_Interrupts;
Raise_Error("no more passwd entries");
}
} else {
arg = argv[1];
switch (TYPE(arg)) {
case T_Fixnum: case T_Bignum:
p = getpwuid(Get_Integer(arg));
break;
case T_String: case T_Symbol:
p = getpwnam(Get_String(arg));
break;
default:
Wrong_Type_Combination(arg, "integer, string, or symbol");
}
if (p == 0) {
Enable_Interrupts;
Raise_Error1("no passwd entry for ~s", arg);
}
arg = argv[1];
switch (TYPE(arg)) {
case T_Fixnum: case T_Bignum:
p = getpwuid(Get_Integer(arg));
break;
case T_String: case T_Symbol:
p = getpwnam(Get_String(arg));
break;
default:
Wrong_Type_Combination(arg, "integer, string, or symbol");
}
if (p == 0) {
Enable_Interrupts;
Raise_Error1("no passwd entry for ~s", arg);
}
}
Enable_Interrupts;
x = Make_String(p->pw_name, strlen(p->pw_name));
@@ -72,26 +72,26 @@ static Object P_Get_Group(argc, argv) int argc; Object *argv; {
Check_Result_Vector(argv[0], 4);
Disable_Interrupts;
if (argc == 1) {
if ((p = getgrent()) == 0) {
Enable_Interrupts;
Raise_Error("no more group entries");
}
if ((p = getgrent()) == 0) {
Enable_Interrupts;
Raise_Error("no more group entries");
}
} else {
arg = argv[1];
switch (TYPE(arg)) {
case T_Fixnum: case T_Bignum:
p = getgrgid(Get_Integer(arg));
break;
case T_String: case T_Symbol:
p = getgrnam(Get_String(arg));
break;
default:
Wrong_Type_Combination(arg, "integer, string, or symbol");
}
if (p == 0) {
Enable_Interrupts;
Raise_Error1("no group entry for ~s", arg);
}
arg = argv[1];
switch (TYPE(arg)) {
case T_Fixnum: case T_Bignum:
p = getgrgid(Get_Integer(arg));
break;
case T_String: case T_Symbol:
p = getgrnam(Get_String(arg));
break;
default:
Wrong_Type_Combination(arg, "integer, string, or symbol");
}
if (p == 0) {
Enable_Interrupts;
Raise_Error1("no group entry for ~s", arg);
}
}
Enable_Interrupts;
x = Make_String(p->gr_name, strlen(p->gr_name));
@@ -103,8 +103,8 @@ static Object P_Get_Group(argc, argv) int argc; Object *argv; {
x = Null;
GC_Link(x);
for (pp = p->gr_mem; *pp; pp++) {
member = Intern(*pp);
x = Cons(member, x);
member = Intern(*pp);
x = Cons(member, x);
}
x = P_Reverse(x);
GC_Unlink;
lib/unix/process.c
+79 -79
View File
@@ -17,23 +17,23 @@ static Object P_Environ() {
cell = ret = Null;
GC_Link2(ret, cell);
for (ep = environ; *ep; ep++) {
cell = Cons(Null, Null);
if (p = index(*ep, '='))
*p++ = 0;
else p = c+1;
str = Make_String(p, strlen(p));
Cdr(cell) = str;
str = Make_String(*ep, strlen(*ep));
Car(cell) = str;
ret = Cons(cell, ret);
*--p = '=';
cell = Cons(Null, Null);
if (p = index(*ep, '='))
*p++ = 0;
else p = c+1;
str = Make_String(p, strlen(p));
Cdr(cell) = str;
str = Make_String(*ep, strlen(*ep));
Car(cell) = str;
ret = Cons(cell, ret);
*--p = '=';
}
GC_Unlink;
return P_Reverse(ret);
}
static Object General_Exec(argc, argv, path) int argc; Object *argv;
int path; {
int path; {
Object fn, args, p, e;
char *fnp, **argp, **envp;
int i, len;
@@ -45,42 +45,42 @@ static Object General_Exec(argc, argv, path) int argc; Object *argv;
len = Fast_Length(args);
Alloca(argp, char**, (len+1) * sizeof(char*));
for (i = 0, p = args; i < len; i++, p = Cdr(p)) {
e = Car(p);
Get_String_Stack(e, argp[i]);
e = Car(p);
Get_String_Stack(e, argp[i]);
}
argp[i] = 0;
if (argc == 3) {
args = argv[2];
Check_List(args);
len = Fast_Length(args);
Alloca(envp, char**, (len+1) * sizeof(char*));
for (i = 0, p = args; i < len; i++, p = Cdr(p)) {
struct S_String *s1, *s2;
args = argv[2];
Check_List(args);
len = Fast_Length(args);
Alloca(envp, char**, (len+1) * sizeof(char*));
for (i = 0, p = args; i < len; i++, p = Cdr(p)) {
struct S_String *s1, *s2;
e = Car(p);
Check_Type(e, T_Pair);
Check_Type(Car(e), T_String);
Check_Type(Cdr(e), T_String);
s1 = STRING(Car(e));
s2 = STRING(Cdr(e));
Alloca(envp[i], char*, s1->size + 1 + s2->size + 1);
sprintf(envp[i], "%.*s=%.*s", s1->size, s1->data,
s2->size, s2->data);
}
envp[i] = 0;
Exit_Handler();
e = Car(p);
Check_Type(e, T_Pair);
Check_Type(Car(e), T_String);
Check_Type(Cdr(e), T_String);
s1 = STRING(Car(e));
s2 = STRING(Cdr(e));
Alloca(envp[i], char*, s1->size + 1 + s2->size + 1);
sprintf(envp[i], "%.*s=%.*s", s1->size, s1->data,
s2->size, s2->data);
}
envp[i] = 0;
Exit_Handler();
#if 0
if (path)
(void)execvpe(fnp, argp, envp); /* ... doesn't exist */
else
if (path)
(void)execvpe(fnp, argp, envp); /* ... doesn't exist */
else
#endif
(void)execve(fnp, argp, envp);
(void)execve(fnp, argp, envp);
} else {
Exit_Handler();
if (path)
(void)execvp(fnp, argp);
else
(void)execv(fnp, argp);
Exit_Handler();
if (path)
(void)execvp(fnp, argp);
else
(void)execv(fnp, argp);
}
Alloca_End;
Raise_System_Error1("~s: ~E", fn);
@@ -92,7 +92,7 @@ static Object P_Exec(argc, argv) int argc; Object *argv; {
static Object P_Exec_Path(argc, argv) int argc; Object *argv; {
if (argc == 3) /* There is no execvpe (yet?). */
Primitive_Error("environment argument not supported");
Primitive_Error("environment argument not supported");
return General_Exec(argc, argv, 1);
}
@@ -101,9 +101,9 @@ static Object P_Fork() {
switch (pid = fork()) {
case -1:
Raise_System_Error("~E");
Raise_System_Error("~E");
case 0:
Call_Onfork();
Call_Onfork();
}
return Make_Integer(pid);
}
@@ -123,7 +123,7 @@ static Object P_Getlogin() {
s = getlogin();
Enable_Interrupts;
if (s == 0)
Raise_Error("cannot get login name");
Raise_Error("cannot get login name");
return Make_String(s, strlen(s));
}
@@ -146,19 +146,19 @@ static Object P_Getgroups() {
*/
if ((n = getgroups(0, (GETGROUPS_TYPE *)0)) == -1)
#ifdef NGROUPS
n = NGROUPS; /* 4.3BSD */
n = NGROUPS; /* 4.3BSD */
#else
Raise_System_Error("~E");
Raise_System_Error("~E");
#endif
Alloca(p, GETGROUPS_TYPE*, n*sizeof(GETGROUPS_TYPE));
(void)getgroups(n, p);
next = ret = P_Make_List(Make_Integer(n), Null);
GC_Link2(ret, next);
for (i = 0; i < n; i++, next = Cdr(next)) {
Object x;
Object x;
x = Make_Unsigned((unsigned)p[i]);
Car(next) = x;
x = Make_Unsigned((unsigned)p[i]);
Car(next) = x;
}
GC_Unlink;
Alloca_End;
@@ -170,7 +170,7 @@ static Object P_Nice(incr) Object incr; {
errno = 0;
if ((ret = nice(Get_Integer(incr))) == -1 && errno != 0)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Make_Integer(ret);
}
@@ -181,8 +181,8 @@ static Object Open_Pipe(cmd, flags) Object cmd; int flags; {
Disable_Interrupts;
if ((fp = popen(Get_String(cmd), flags == P_INPUT ? "r" : "w")) == 0) {
Enable_Interrupts;
Raise_Error("cannot open pipe to process");
Enable_Interrupts;
Raise_Error("cannot open pipe to process");
}
ret = Make_Port(flags, fp, Make_String("pipe-port", 9));
PORT(ret)->closefun = pclose;
@@ -207,15 +207,15 @@ static Object P_Process_Resources(ret1, ret2) Object ret1, ret2; {
if (hzval == 0) {
#ifdef HZ
hzval = HZ;
hzval = HZ;
#else
#ifdef CLK_TCK
hzval = CLK_TCK;
hzval = CLK_TCK;
#else
#ifdef _SC_CLK_TCK
hzval = (int)sysconf(_SC_CLK_TCK);
hzval = (int)sysconf(_SC_CLK_TCK);
#else
hzval = 60; /* Fallback for 4.3BSD. I don't have a better idea. */
hzval = 60; /* Fallback for 4.3BSD. I don't have a better idea. */
#endif
#endif
#endif
@@ -251,24 +251,24 @@ static Object P_System(cmd) Object cmd; {
switch (pid = fork()) {
#endif
case -1:
Raise_System_Error("fork: ~E");
Raise_System_Error("fork: ~E");
case 0:
for (n = Num_Filedescriptors(); n >= 3; n--)
(void)close(n);
execl("/bin/sh", "sh", "-c", s, (char *)0);
_exit(127);
for (n = Num_Filedescriptors(); n >= 3; n--)
(void)close(n);
execl("/bin/sh", "sh", "-c", s, (char *)0);
_exit(127);
default:
Disable_Interrupts;
while ((n = wait(&status)) != pid && n != -1)
;
Enable_Interrupts;
Disable_Interrupts;
while ((n = wait(&status)) != pid && n != -1)
;
Enable_Interrupts;
}
/* Can this happen?
if (n == -1)
return False;
return False;
*/
if (n = (status & 0377))
return Cons(Make_Integer(n), Null);
return Cons(Make_Integer(n), Null);
return Make_Integer((status >> 8) & 0377);
}
@@ -290,27 +290,27 @@ static Object P_Working_Directory() {
Disable_Interrupts;
#ifdef HAVE_GETCWD
if (getcwd(buf, max) == 0) {
Saved_Errno = errno;
Alloca_End;
Enable_Interrupts;
Raise_System_Error("~E");
Saved_Errno = errno;
Alloca_End;
Enable_Interrupts;
Raise_System_Error("~E");
}
#else
#ifdef HAVE_GETWD
if (getwd(buf) == 0) {
Alloca_End;
Enable_Interrupts;
Raise_Error(buf);
Alloca_End;
Enable_Interrupts;
Raise_Error(buf);
}
#else
if ((fp = popen("pwd", "r")) == 0) {
err:
Alloca_End;
Enable_Interrupts;
Raise_Error("cannot get output from pwd");
Alloca_End;
Enable_Interrupts;
Raise_Error("cannot get output from pwd");
}
if (fgets(buf, max, fp) == 0)
goto err;
goto err;
if (p = index(buf, '\n')) *p = '\0';
(void)pclose(fp);
#endif
@@ -336,7 +336,7 @@ elk_init_unix_process() {
Def_Prim(P_Open_Input_Pipe, "unix-open-input-pipe", 1, 1, EVAL);
Def_Prim(P_Open_Output_Pipe, "unix-open-output-pipe", 1, 1, EVAL);
Def_Prim(P_Process_Resources, "unix-process-resources-vector-fill!",
2, 2, EVAL);
2, 2, EVAL);
Def_Prim(P_Sleep, "unix-sleep", 1, 1, EVAL);
Def_Prim(P_System, "unix-system", 1, 1, EVAL);
Def_Prim(P_Umask, "unix-umask", 1, 1, EVAL);
lib/unix/signal.c
+29 -29
View File
@@ -152,13 +152,13 @@ static Object P_Kill(pid, sig) Object pid, sig; {
int t, s;
if ((t = TYPE(sig)) == T_Fixnum || t == T_Bignum)
s = Get_Integer(sig);
s = Get_Integer(sig);
else if (t == T_Symbol)
s = Symbols_To_Bits(sig, 0, Signal_Syms);
s = Symbols_To_Bits(sig, 0, Signal_Syms);
else
Wrong_Type_Combination(sig, "symbol or integer");
Wrong_Type_Combination(sig, "symbol or integer");
if (kill(Get_Integer(pid), s) == -1)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Void;
}
@@ -196,7 +196,7 @@ void General_Handler(sig) int sig; {
args = Cons(args, Null);
fun = VECTOR(Handlers)->data[sig];
if (TYPE(fun) != T_Compound)
Fatal_Error("no handler for signal %d", sig);
Fatal_Error("no handler for signal %d", sig);
(void)Funcall(fun, args, 0);
Format(Curr_Output_Port, "~%\7Signal!~%", 15, 0, (Object *)0);
(void)P_Reset();
@@ -207,13 +207,13 @@ static Object Action_To_Sym(act) void (*act)(); {
char *sym;
if (act == Signal_Exit)
sym = "exit";
sym = "exit";
else if (act == SIG_IGN)
sym = "ignore";
sym = "ignore";
else if (act == SIG_DFL || act == (void (*)())-1)
sym = "default";
sym = "default";
else
sym = "handler";
sym = "handler";
return Intern(sym);
}
@@ -224,7 +224,7 @@ void Add_To_Mask(sig) int sig; {
Sigmask_Block |= sigmask(sig);
#endif
if (Intr_Level > 0) /* make sure new signal gets blocked */
Force_Disable_Interrupts;
Force_Disable_Interrupts;
}
void Remove_From_Mask(sig) int sig; {
@@ -242,14 +242,14 @@ static Object P_Signal(argc, argv) int argc; Object *argv; {
sig = Symbols_To_Bits(argv[0], 0, Signal_Syms);
if (sig >= NSIG)
Fatal_Error("signal %d >= NSIG", sig);
Fatal_Error("signal %d >= NSIG", sig);
if (argc == 1) {
handler = VECTOR(Handlers)->data[sig];
if (Truep(handler))
return handler;
if ((disp = signal(sig, SIG_DFL)) != SIG_DFL)
(void)signal(sig, disp);
return Action_To_Sym(disp);
handler = VECTOR(Handlers)->data[sig];
if (Truep(handler))
return handler;
if ((disp = signal(sig, SIG_DFL)) != SIG_DFL)
(void)signal(sig, disp);
return Action_To_Sym(disp);
}
switch (sig) {
#ifdef SIGBUS
@@ -263,30 +263,30 @@ static Object P_Signal(argc, argv) int argc; Object *argv; {
#ifdef SIGABRT
case SIGABRT:
#endif
Primitive_Error("changing signal ~s not permitted", argv[0]);
Primitive_Error("changing signal ~s not permitted", argv[0]);
}
handler = argv[1];
if (EQ(handler, Sym_Exit)) {
disp = Signal_Exit;
disp = Signal_Exit;
} else if (EQ(handler, Sym_Default)) {
disp = SIG_DFL;
disp = SIG_DFL;
} else if (EQ(handler, Sym_Ignore)) {
disp = SIG_IGN;
disp = SIG_IGN;
} else if (TYPE(handler) == T_Compound) {
if (COMPOUND(handler)->min_args > 1 ||
COMPOUND(handler)->max_args == 0)
Primitive_Error("handler expects wrong number of args");
disp = General_Handler;
if (COMPOUND(handler)->min_args > 1 ||
COMPOUND(handler)->max_args == 0)
Primitive_Error("handler expects wrong number of args");
disp = General_Handler;
} else
Primitive_Error("invalid handler: ~s", handler);
Primitive_Error("invalid handler: ~s", handler);
old = VECTOR(Handlers)->data[sig];
VECTOR(Handlers)->data[sig] = (disp == General_Handler) ? handler : False;
if (disp == General_Handler)
Add_To_Mask(sig);
Add_To_Mask(sig);
else
Remove_From_Mask(sig);
Remove_From_Mask(sig);
if ((disp = signal(sig, disp)) == (void (*)())-1)
Raise_System_Error("~E");
Raise_System_Error("~E");
return Truep(old) ? old : Action_To_Sym(disp);
}
#endif /* RELIABLE_SIGNALS */
lib/unix/system.c
+26 -26
View File
@@ -27,68 +27,68 @@ static Object P_File_Limit(lim, f) Object lim, f; {
switch (Symbols_To_Bits(lim, 0, Limit_Syms)) {
case L_LINK_MAX:
#ifdef LINK_MAX
return Make_Integer(LINK_MAX);
return Make_Integer(LINK_MAX);
#else
#ifdef _PC_LINK_MAX
op = _PC_LINK_MAX;
op = _PC_LINK_MAX;
# define HAVEOP
#else
return Make_Integer(sizeof(short) * 8); /* guess */
return Make_Integer(sizeof(short) * 8); /* guess */
#endif
#endif
break;
break;
case L_NAME_MAX:
#ifdef NAME_MAX
return Make_Integer(NAME_MAX);
return Make_Integer(NAME_MAX);
#else
#ifdef _PC_NAME_MAX
op = _PC_NAME_MAX;
op = _PC_NAME_MAX;
# define HAVEOP
#else
return Make_Integer(255); /* guess */
return Make_Integer(255); /* guess */
#endif
#endif
break;
break;
case L_PATH_MAX:
#ifdef MAX_PATH
return Make_Integer(MAX_PATH);
return Make_Integer(MAX_PATH);
#else
#ifdef _PC_PATH_MAX
op = _PC_PATH_MAX;
op = _PC_PATH_MAX;
# define HAVEOP
#else
#ifdef MAXPATHLEN
return Make_Integer(MAXPATHLEN);
return Make_Integer(MAXPATHLEN);
#else
return Make_Integer(1024); /* guess */
return Make_Integer(1024); /* guess */
#endif
#endif
#endif
break;
break;
case L_PIPE_BUF:
#ifdef PIPE_BUF
return Make_Integer(PIPE_BUF);
return Make_Integer(PIPE_BUF);
#else
#ifdef _PC_PIPE_BUF
op = _PC_PIPE_BUF;
op = _PC_PIPE_BUF;
# define HAVEOP
#else
return Make_Integer(512); /* guess */
return Make_Integer(512); /* guess */
#endif
#endif
break;
break;
case L_NO_TRUNC:
#ifdef _PC_NO_TRUNC
op = _PC_NO_TRUNC;
op = _PC_NO_TRUNC;
# define HAVEOP
#else
return False; /* guess */
return False; /* guess */
#endif
break;
break;
}
#ifdef HAVEOP
/* If we get here, we have a _PC_XXX symbol in `op' and can invoke
@@ -99,17 +99,17 @@ static Object P_File_Limit(lim, f) Object lim, f; {
ret = fn ? pathconf(fn, op) : fpathconf(fd, op);
if (ret == -1) {
#ifdef _PC_NO_TRUNC
if (op == _PC_NO_TRUNC && errno == 0)
return False;
if (op == _PC_NO_TRUNC && errno == 0)
return False;
#endif
Raise_System_Error1("~s: ~E", f);
Raise_System_Error1("~s: ~E", f);
}
#ifdef _PC_NO_TRUNC
if (op == _PC_NO_TRUNC)
return ret ? True : False;
return ret ? True : False;
else
#endif
return Make_Long(ret);
return Make_Long(ret);
#endif
}
@@ -161,7 +161,7 @@ static Object P_System_Info(ret) Object ret; {
x = Make_String(p, strlen(p)); VECTOR(ret)->data[0] = x;
strcpy(systype, SYSTEMTYPE);
if ((p = index(systype, '-')) && (q = index(p+1, '-'))) {
*p++ = 0; *q = 0;
*p++ = 0; *q = 0;
} else p = "?";
x = Make_String(systype, strlen(systype)); VECTOR(ret)->data[1] = x;
x = Make_String(p, strlen(p)); VECTOR(ret)->data[2] = x;
lib/unix/temp.c
+19 -19
View File
@@ -33,9 +33,9 @@ static Object P_Tempname(argc, argv) int argc; Object *argv; {
#endif
if (argc > 0)
dir = Get_Strsym(argv[0]);
dir = Get_Strsym(argv[0]);
if (argc > 1)
pref = Get_Strsym(argv[1]);
pref = Get_Strsym(argv[1]);
#ifdef HAVE_TMPNAM
name = tmpnam((char *)0);
#else
@@ -46,7 +46,7 @@ static Object P_Tempname(argc, argv) int argc; Object *argv; {
if (!dir) dir = "/tmp";
if (!pref) pref = "elk";
if (strlen(dir) + strlen(pref) > 1000)
Primitive_Error("directory/prefix argument too long");
Primitive_Error("directory/prefix argument too long");
#ifdef HAVE_MKTEMP
sprintf(buf, "%s/%sXXXXXX", dir, pref);
name = mktemp(buf);
@@ -55,29 +55,29 @@ static Object P_Tempname(argc, argv) int argc; Object *argv; {
sprintf(buf, "%s/%sa%d", dir, pref, getpid());
p = buf+strlen(dir)+strlen(pref)+1;
while (stat(buf, &st) == 0) { /* Simple ersatz mktemp */
q = p;
while (1) {
if (*q == '\0') goto fail;
if (*q == 'z') {
*q++ = 'a';
} else {
if (*q >= '0' && *q <= '9')
*q = 'a';
else
*++q;
break;
}
}
q = p;
while (1) {
if (*q == '\0') goto fail;
if (*q == 'z') {
*q++ = 'a';
} else {
if (*q >= '0' && *q <= '9')
*q = 'a';
else
*++q;
break;
}
}
}
if (errno == ENOENT)
name = buf;
name = buf;
fail: ;
#endif
#endif
#endif
if (name == 0 || name[0] == '\0') {
Enable_Interrupts;
Raise_Error("cannot create temp file name");
Enable_Interrupts;
Raise_Error("cannot create temp file name");
}
ret = Make_String(name, strlen(name));
#ifdef HAVE_TEMPNAM
lib/unix/time.c
+17 -17
View File
@@ -89,20 +89,20 @@ static struct tm *Get_Tm(v) Object v; {
int i, n;
Object *op;
static struct { int min, max; } bounds[] = {
{ 0, 61 }, /* sec */
{ 0, 59 }, /* min */
{ 0, 23 }, /* hour */
{ 1, 31 }, /* mday */
{ 0, 11 }, /* mon */
{ 0, 65535 }, /* year */
{ 0, 7 }, /* wday */
{ 0, 365 } /* yday */
{ 0, 61 }, /* sec */
{ 0, 59 }, /* min */
{ 0, 23 }, /* hour */
{ 1, 31 }, /* mday */
{ 0, 11 }, /* mon */
{ 0, 65535 }, /* year */
{ 0, 7 }, /* wday */
{ 0, 365 } /* yday */
};
Check_Result_Vector(v, 9);
for (op = VECTOR(v)->data, i = 0; i < 7; i++, op++)
if ((n = Get_Integer(*op)) < bounds[i].min || n > bounds[i].max)
Range_Error(*op);
if ((n = Get_Integer(*op)) < bounds[i].min || n > bounds[i].max)
Range_Error(*op);
op = VECTOR(v)->data;
tm.tm_sec = Get_Integer(*op++);
tm.tm_min = Get_Integer(*op++);
@@ -122,15 +122,15 @@ static Object P_Time_To_String(t) Object t; {
switch (TYPE(t)) {
case T_Fixnum: case T_Bignum:
tt = (time_t)Get_Unsigned_Long(t);
ret = ctime(&tt);
break;
tt = (time_t)Get_Unsigned_Long(t);
ret = ctime(&tt);
break;
case T_Vector:
ret = asctime(Get_Tm(t));
break;
ret = asctime(Get_Tm(t));
break;
default:
Wrong_Type_Combination(t, "integer or vector");
/*NOTREACHED*/
Wrong_Type_Combination(t, "integer or vector");
/*NOTREACHED*/
}
return Make_String(ret, strlen(ret));
}
lib/unix/unix.c
+3 -3
View File
@@ -20,8 +20,8 @@ Object Syms_To_List(p) SYMDESCR *p; {
ret = Null;
GC_Link(ret);
for ( ; p->name; p++) {
mode = Intern(p->name);
ret = Cons(mode, ret);
mode = Intern(p->name);
ret = Cons(mode, ret);
}
GC_Unlink;
return P_Reverse(ret);
@@ -30,7 +30,7 @@ Object Syms_To_List(p) SYMDESCR *p; {
void Check_Result_Vector(x, len) Object x; {
Check_Type(x, T_Vector);
if (VECTOR(x)->size != len)
Primitive_Error("argument vector has the wrong length");
Primitive_Error("argument vector has the wrong length");
}
elk_init_unix_unix() {
lib/unix/unix.h
+6 -6
View File
@@ -24,11 +24,11 @@ Object Syms_To_List P_((SYMDESCR*));
#define Get_Filename_Or_Filedescr(obj,fd,fn) \
switch (TYPE(obj)) {\
case T_String: case T_Symbol:\
(fn) = Get_Strsym(obj); break;\
(fn) = Get_Strsym(obj); break;\
case T_Fixnum: case T_Bignum:\
(fd) = Get_Integer(obj); break;\
(fd) = Get_Integer(obj); break;\
default:\
Wrong_Type_Combination(obj, "symbol, string, or integer");\
Wrong_Type_Combination(obj, "symbol, string, or integer");\
}
#define Raise_System_Error(msg) {\
@@ -38,7 +38,7 @@ Object Syms_To_List P_((SYMDESCR*));
#define Raise_Error(msg) {\
if (Var_Is_True(V_Call_Errhandler))\
Primitive_Error(msg);\
Primitive_Error(msg);\
return Unix_Errobj;\
}
@@ -49,7 +49,7 @@ Object Syms_To_List P_((SYMDESCR*));
#define Raise_Error1(msg,a1) {\
if (Var_Is_True(V_Call_Errhandler))\
Primitive_Error(msg,a1);\
Primitive_Error(msg,a1);\
return Unix_Errobj;\
}
@@ -60,7 +60,7 @@ Object Syms_To_List P_((SYMDESCR*));
#define Raise_Error2(msg,a1,a2) {\
if (Var_Is_True(V_Call_Errhandler))\
Primitive_Error(msg,a1,a2);\
Primitive_Error(msg,a1,a2);\
return Unix_Errobj;\
}
lib/unix/wait.c
+17 -17
View File
@@ -44,7 +44,7 @@ static SYMDESCR Wait_Flags[] = {
static Object General_Wait(ret, ruret, haspid, pid, options)
Object ret, ruret; int haspid, pid, options; {
Object ret, ruret; int haspid, pid, options; {
int retpid, st, code;
char *status;
#ifdef WAIT_RUSAGE
@@ -59,47 +59,47 @@ static Object General_Wait(ret, ruret, haspid, pid, options)
Check_Result_Vector(ruret, 2);
if (haspid) {
#ifdef HAVE_WAIT4
retpid = wait4(pid, &st, options, &ru);
retpid = wait4(pid, &st, options, &ru);
#else
#ifdef HAVE_WAITPID
retpid = waitpid(pid, &st, options);
retpid = waitpid(pid, &st, options);
#endif
#endif
} else {
#ifdef HAVE_WAIT3
retpid = wait3(&st, options, &ru);
retpid = wait3(&st, options, &ru);
#else
retpid = wait(&st);
retpid = wait(&st);
#endif
}
if (retpid == -1 && errno != ECHILD)
Raise_System_Error("~E");
Raise_System_Error("~E");
GC_Link3(ret, ruret, x);
x = Make_Integer(retpid); VECTOR(ret)->data[0] = x;
if (retpid == 0 || retpid == -1) {
status = "none";
st = code = 0;
status = "none";
st = code = 0;
#ifdef WAIT_RUSAGE
bzero((char *)&ru, sizeof(ru));
bzero((char *)&ru, sizeof(ru));
#endif
} else if (WIFSTOPPED(st)) {
status = "stopped"; code = WSTOPSIG(st);
status = "stopped"; code = WSTOPSIG(st);
} else if (WIFSIGNALED(st)) {
status = "signaled"; code = WTERMSIG(st);
status = "signaled"; code = WTERMSIG(st);
} else {
status = "exited"; code = WEXITSTATUS(st);
status = "exited"; code = WEXITSTATUS(st);
}
x = Intern(status); VECTOR(ret)->data[1] = x;
x = Make_Integer(code); VECTOR(ret)->data[2] = x;
VECTOR(ret)->data[3] = st & 0200 ? True : False;
#ifdef WAIT_RUSAGE
x = Cons(Null, Make_Unsigned_Long((unsigned long)ru.ru_utime.tv_usec
* 1000));
* 1000));
sec = Make_Unsigned_Long((unsigned long)ru.ru_utime.tv_sec);
Car(x) = sec;
VECTOR(ruret)->data[0] = x;
x = Cons(Null, Make_Unsigned_Long((unsigned long)ru.ru_stime.tv_usec
* 1000));
* 1000));
sec = Make_Unsigned_Long((unsigned long)ru.ru_stime.tv_sec);
Car(x) = sec;
VECTOR(ruret)->data[1] = x;
@@ -113,9 +113,9 @@ static Object P_Wait(argc, argv) int argc; Object *argv; {
if (argc == 3)
#ifdef WAIT_OPTIONS
flags = (int)Symbols_To_Bits(argv[2], 1, Wait_Flags);
flags = (int)Symbols_To_Bits(argv[2], 1, Wait_Flags);
#else
Primitive_Error("wait options not supported");
Primitive_Error("wait options not supported");
#endif
return General_Wait(argv[0], argv[1], 0, 0, flags);
}
@@ -126,7 +126,7 @@ static Object P_Wait(argc, argv) int argc; Object *argv; {
*/
static Object P_Wait_Process(argc, argv) int argc; Object *argv; {
return General_Wait(argv[0], argv[1], 1, Get_Integer(argv[2]),
argc == 4 ? (int)Symbols_To_Bits(argv[3], 1, Wait_Flags) : 0);
argc == 4 ? (int)Symbols_To_Bits(argv[3], 1, Wait_Flags) : 0);
}
#endif