314 lines
8.8 KiB
C
314 lines
8.8 KiB
C
/* fdescr.c
|
|
*
|
|
* $Id$
|
|
*
|
|
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
|
* Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
|
|
*
|
|
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
|
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
|
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
|
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
|
*
|
|
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
|
* owners or individual owners of copyright in this software, grant to any
|
|
* person or company a worldwide, royalty free, license to
|
|
*
|
|
* i) copy this software,
|
|
* ii) prepare derivative works based on this software,
|
|
* iii) distribute copies of this software or derivative works,
|
|
* iv) perform this software, or
|
|
* v) display this software,
|
|
*
|
|
* provided that this notice is not removed and that neither Oliver Laumann
|
|
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
|
* the suitability of this software for any purpose nor are held responsible
|
|
* for any defects of this software.
|
|
*
|
|
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
|
*/
|
|
|
|
#include "unix.h"
|
|
|
|
#include <string.h>
|
|
|
|
static SYMDESCR Open_Syms[] = {
|
|
{ "read", 1 },
|
|
{ "write", 2 },
|
|
{ "append", O_APPEND },
|
|
{ "create", O_CREAT },
|
|
{ "truncate", O_TRUNC },
|
|
{ "exclusive", O_EXCL },
|
|
#ifdef O_SYNC
|
|
{ "sync", O_SYNC },
|
|
#endif
|
|
#ifdef O_NOCTTY
|
|
{ "noctty", O_NOCTTY },
|
|
#endif
|
|
#ifdef O_NDELAY
|
|
{ "ndelay", O_NDELAY },
|
|
#endif
|
|
#ifdef O_NONBLOCK
|
|
{ "nonblock", O_NONBLOCK },
|
|
#endif
|
|
{ 0, 0 }
|
|
};
|
|
|
|
static SYMDESCR Fcntl_Flags[] = {
|
|
{ "append", O_APPEND },
|
|
#ifdef O_SYNC
|
|
{ "sync", O_SYNC },
|
|
#endif
|
|
#ifdef O_SYNCIO
|
|
{ "syncio", O_SYNCIO },
|
|
#endif
|
|
#ifdef O_NDELAY
|
|
{ "ndelay", O_NDELAY },
|
|
#endif
|
|
#ifdef O_NONBLOCK
|
|
{ "nonblock", O_NONBLOCK },
|
|
#endif
|
|
#ifdef O_LARGEFILE
|
|
{ "largefile", O_LARGEFILE },
|
|
#endif
|
|
#ifdef FASYNC
|
|
{ "async", FASYNC },
|
|
#endif
|
|
{ 0, 0 }
|
|
};
|
|
|
|
SYMDESCR Lseek_Syms[] = {
|
|
{ "set", 0 }, /* Should use symbolic constants, but */
|
|
{ "current", 1 }, /* how do we know whether it's SEEK_ */
|
|
{ "end", 2 }, /* or L_ (BSD), and what include files */
|
|
{ 0, 0 } /* are to be used? */
|
|
};
|
|
|
|
/* Dangerous: may be used to close the filedescriptor of a port.
|
|
*/
|
|
static Object P_Close(Object fd) {
|
|
if (close(Get_Integer(fd)) == -1)
|
|
Raise_System_Error("~E");
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Close_On_Exec(int argc, Object *argv) {
|
|
int flags = 0, fd;
|
|
|
|
fd = Get_Integer(argv[0]);
|
|
#ifndef WIN32
|
|
if ((flags = fcntl(fd, F_GETFD, 0)) == -1)
|
|
Raise_System_Error("fcntl(F_GETFD): ~E");
|
|
#endif
|
|
if (argc == 2) {
|
|
Check_Type(argv[1], T_Boolean);
|
|
#ifndef WIN32
|
|
if (fcntl(fd, F_SETFD, Truep(argv[1])) == -1)
|
|
Raise_System_Error("fcntl(F_SETFD): ~E");
|
|
#endif
|
|
}
|
|
return flags & 1 ? True : False;
|
|
}
|
|
|
|
static Object P_Dup(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");
|
|
return Make_Integer(ret);
|
|
}
|
|
|
|
static Object P_Filedescriptor_Flags(int argc, Object *argv) {
|
|
int flags = 0, fd;
|
|
|
|
fd = Get_Integer(argv[0]);
|
|
#ifndef WIN32
|
|
if ((flags = fcntl(fd, F_GETFL, 0)) == -1)
|
|
Raise_System_Error("fcntl(F_GETFL): ~E");
|
|
#endif
|
|
if (argc == 2) {
|
|
#ifndef WIN32
|
|
if (fcntl(fd, F_SETFL, Symbols_To_Bits(argv[1], 1, Fcntl_Flags)) == -1)
|
|
Raise_System_Error("fcntl(F_SETFL): ~E");
|
|
#endif
|
|
}
|
|
return Bits_To_Symbols((unsigned long)flags, 1, Fcntl_Flags);
|
|
}
|
|
|
|
static Object P_Fildescriptor_Port(Object fd, Object mode) {
|
|
int n, flags;
|
|
FILE *fp;
|
|
Object ret;
|
|
char *m, buf[32];
|
|
|
|
m = Get_String(mode);
|
|
switch (m[0]) {
|
|
case 'r':
|
|
flags = P_INPUT; break;
|
|
case 'w': case 'a':
|
|
flags = 0; break;
|
|
default:
|
|
Primitive_Error("invalid mode: ~s", mode);
|
|
}
|
|
if (m[1] == '+')
|
|
flags = P_BIDIR;
|
|
Disable_Interrupts;
|
|
if ((fp = fdopen(n = Get_Integer(fd), m)) == 0) {
|
|
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)));
|
|
Register_Object(ret, (GENERIC)0, Terminate_File, 0);
|
|
Enable_Interrupts;
|
|
return ret;
|
|
}
|
|
|
|
static Object P_Isatty(Object fd) {
|
|
return isatty(Get_Integer(fd)) ? True : False;
|
|
}
|
|
|
|
static Object P_List_Filedescriptor_Flags() {
|
|
return Syms_To_List(Fcntl_Flags);
|
|
}
|
|
|
|
static Object P_List_Open_Modes() {
|
|
return Syms_To_List(Open_Syms);
|
|
}
|
|
|
|
/* Bad assumption: off_t fits into an unsigned int.
|
|
*/
|
|
static Object P_Lseek(Object fd, Object off, Object 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");
|
|
return Make_Unsigned_Long((unsigned long)ret);
|
|
}
|
|
|
|
int Num_Filedescriptors() {
|
|
int ret;
|
|
#if defined(OPEN_MAX)
|
|
ret = OPEN_MAX;
|
|
#elif defined(HAVE_GETDTABLESIZE)
|
|
ret = getdtablesize();
|
|
#elif defined(_SC_OPEN_MAX)
|
|
static r;
|
|
if (r == 0) {
|
|
if ((r = sysconf(_SC_OPEN_MAX)) == -1)
|
|
r = 256;
|
|
}
|
|
ret = r;
|
|
#elif defined(NOFILE)
|
|
ret = NOFILE;
|
|
#else
|
|
ret = 256;
|
|
#endif
|
|
return ret;
|
|
}
|
|
|
|
static Object P_Num_Filedescriptors() {
|
|
return Make_Integer(Num_Filedescriptors());
|
|
}
|
|
|
|
static Object P_Open(int argc, Object *argv) {
|
|
Object fn;
|
|
int mode, n;
|
|
|
|
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");
|
|
mode &= ~3; mode |= n-1;
|
|
if (mode & O_CREAT && argc == 2)
|
|
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);
|
|
return Make_Integer(n);
|
|
}
|
|
|
|
static Object P_Pipe() {
|
|
int fd[2];
|
|
|
|
#ifdef WIN32
|
|
if (_pipe(fd, 256, O_BINARY) == -1)
|
|
#else
|
|
if (pipe(fd) == -1)
|
|
#endif
|
|
Raise_System_Error("~E");
|
|
return Integer_Pair(fd[0], fd[1]);
|
|
}
|
|
|
|
static Object P_Port_Filedescriptor(Object port) {
|
|
Check_Type(port, T_Port);
|
|
if ((PORT(port)->flags & (P_STRING|P_OPEN)) != P_OPEN)
|
|
Primitive_Error("~s: invalid port", port);
|
|
return Make_Integer(fileno(PORT(port)->file));
|
|
}
|
|
|
|
static Object Read_Write(int argc, Object *argv, int readflg) {
|
|
struct S_String *sp;
|
|
int len, fd;
|
|
|
|
fd = Get_Integer(argv[0]);
|
|
Check_Type(argv[1], T_String);
|
|
sp = STRING(argv[1]);
|
|
if (argc == 3) {
|
|
len = Get_Integer(argv[2]);
|
|
if (len < 0 || (unsigned int)len > sp->size)
|
|
Range_Error(argv[2]);
|
|
} else len = sp->size;
|
|
if (readflg)
|
|
len = read(fd, sp->data, len);
|
|
else
|
|
len = write(fd, sp->data, len);
|
|
if (len == -1)
|
|
Raise_System_Error("~E");
|
|
return Make_Integer(len);
|
|
}
|
|
|
|
/* Avoid name clash with P_Read/P_Write of interpreter kernel
|
|
*/
|
|
static Object P_Readx(int argc, Object *argv) {
|
|
return Read_Write(argc, argv, 1);
|
|
}
|
|
|
|
static Object P_Writex(int argc, Object *argv) {
|
|
return Read_Write(argc, argv, 0);
|
|
}
|
|
|
|
static Object P_Ttyname(Object fd) {
|
|
char *ret = NULL;
|
|
#ifndef WIN32
|
|
extern char *ttyname();
|
|
|
|
Disable_Interrupts;
|
|
ret = ttyname(Get_Integer(fd));
|
|
Enable_Interrupts;
|
|
#endif
|
|
return ret ? Make_String(ret, strlen(ret)) : False;
|
|
}
|
|
|
|
void elk_init_unix_fdescr() {
|
|
Def_Prim(P_Close, "unix-close", 1, 1, EVAL);
|
|
Def_Prim(P_Close_On_Exec, "unix-close-on-exec", 1, 2, VARARGS);
|
|
Def_Prim(P_Dup, "unix-dup", 1, 2, VARARGS);
|
|
Def_Prim(P_Filedescriptor_Flags,"unix-filedescriptor-flags",1, 2, VARARGS);
|
|
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);
|
|
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);
|
|
Def_Prim(P_Open, "unix-open", 2, 3, VARARGS);
|
|
Def_Prim(P_Pipe, "unix-pipe", 0, 0, EVAL);
|
|
Def_Prim(P_Port_Filedescriptor, "unix-port-filedescriptor", 1, 1, EVAL);
|
|
Def_Prim(P_Readx, "unix-read-string-fill!", 2, 3, VARARGS);
|
|
Def_Prim(P_Ttyname, "unix-ttyname", 1, 1, EVAL);
|
|
Def_Prim(P_Writex, "unix-write", 2, 3, VARARGS);
|
|
}
|