summaryrefslogtreecommitdiffstats
path: root/ioext.c
diff options
context:
space:
mode:
Diffstat (limited to 'ioext.c')
-rw-r--r--ioext.c227
1 files changed, 178 insertions, 49 deletions
diff --git a/ioext.c b/ioext.c
index 62ec8b2..6a8e6e1 100644
--- a/ioext.c
+++ b/ioext.c
@@ -70,6 +70,9 @@ SCM stat2scm P((struct stat *stat_temp));
#ifdef __FreeBSD__
# include <unistd.h>
#endif
+#ifdef __NetBSD__
+# include <unistd.h>
+#endif
#ifdef __OpenBSD__
# include <unistd.h>
#endif
@@ -134,7 +137,7 @@ SCM read_line(port)
SCM tok_buf = makstr((long) len);
register char *p = CHARS(tok_buf);
if UNBNDP(port) port = cur_inp;
- else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_line);
+ else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_line);
if (EOF==(c = lgetc(port))) return EOF_VAL;
while(1) {
switch (c) {
@@ -161,11 +164,11 @@ SCM read_line1(str, port)
register int j = 0;
register char *p;
sizet len;
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_read_line1);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_read_line1);
p = CHARS(str);
len = LENGTH(str);
if UNBNDP(port) port = cur_inp;
- else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG2, s_read_line1);
+ else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG2, s_read_line1);
c = lgetc(port);
if (EOF==c) return EOF_VAL;
while(1) {
@@ -197,7 +200,7 @@ SCM file_position(port)
SCM port;
{
long ans;
- ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position);
+ ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position);
SYSCALL(ans = ftell(STREAM(port)););
if CRDYP(port) ans--;
return MAKINUM(ans);
@@ -206,7 +209,7 @@ SCM file_set_position(port, pos)
SCM port, pos;
{
SCM ans;
- ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos);
+ ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos);
#ifndef RECKLESS
if (TRACKED & SCM_PORTFLAGS(port)) {
if (INUM0==pos) {
@@ -226,7 +229,7 @@ SCM file_set_position(port, pos)
#ifdef HAVE_PIPE
# ifdef ESPIPE
if (!OPIOPORTP(port))
- ASSERT(ESPIPE != errno, port, ARG1, s_file_set_pos);
+ ASRTER(ESPIPE != errno, port, ARG1, s_file_set_pos);
# endif
#endif
return ans;
@@ -239,12 +242,12 @@ SCM reopen_file(filename, modes, port)
FILE *f;
char cmodes[4];
long flags;
- ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file);
- ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_reopen_file);
+ ASRTER(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file);
+ ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_reopen_file);
flags = mode_bits(CHARS(modes), cmodes);
- ASSERT(flags, modes, ARG2, s_reopen_file);
+ ASRTER(flags, modes, ARG2, s_reopen_file);
DEFER_INTS;
- ASSERT(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file);
+ ASRTER(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file);
SCM_OPENCALL(f = freopen(CHARS(filename), cmodes, STREAM(port)));
if (!f) {
ALLOW_INTS;
@@ -272,10 +275,10 @@ SCM l_dup(oldpt, modes)
int tfd;
FILE *f;
SCM newpt;
- ASSERT(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup);
- ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_dup);
+ ASRTER(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup);
+ ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_dup);
flags = mode_bits(CHARS(modes), cmodes);
- ASSERT(flags, modes, ARG2, s_dup);
+ ASRTER(flags, modes, ARG2, s_dup);
NEWCELL(newpt);
DEFER_INTS;
SCM_OPENCALL(tfd = dup(fileno(STREAM(oldpt))));
@@ -303,8 +306,8 @@ SCM l_dup2(into_pt, from_pt)
{
int ans, oldfd, newfd;
DEFER_INTS;
- ASSERT(NIMP(into_pt) && OPFPORTP(into_pt), into_pt, ARG1, s_dup2);
- ASSERT(NIMP(from_pt) && OPFPORTP(from_pt), from_pt, ARG1, s_dup2);
+ ASRTER(NIMP(into_pt) && OPFPORTP(into_pt), into_pt, ARG1, s_dup2);
+ ASRTER(NIMP(from_pt) && OPFPORTP(from_pt), from_pt, ARG1, s_dup2);
oldfd = fileno(STREAM(into_pt));
newfd = fileno(STREAM(from_pt));
SCM_OPENCALL(ans = dup2(oldfd, newfd));
@@ -315,15 +318,18 @@ SCM l_dup2(into_pt, from_pt)
# endif
# ifndef vms
+static char s_opendir[]="opendir";
+static char s_readdir[]="readdir";
+static char s_rewinddir[]="rewinddir";
+static char s_closedir[]="closedir";
# ifndef _WIN32
# include <dirent.h>
-static char s_opendir[]="opendir";
SCM l_opendir(dirname)
SCM dirname;
{
DIR *ds;
SCM dir;
- ASSERT(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir);
+ ASRTER(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir);
NEWCELL(dir);
DEFER_INTS;
SCM_OPENCALL(ds = opendir(CHARS(dirname)));
@@ -333,33 +339,33 @@ SCM l_opendir(dirname)
ALLOW_INTS;
return dir;
}
-static char s_readdir[]="readdir";
+
SCM l_readdir(port)
SCM port;
{
struct dirent *rdent;
DEFER_INTS;
- ASSERT(OPDIRP(port), port, ARG1, s_readdir);
+ ASRTER(OPDIRP(port), port, ARG1, s_readdir);
SYSCALL(rdent = readdir((DIR *)CDR(port)););
if (!rdent) {ALLOW_INTS; return BOOL_F;}
ALLOW_INTS;
/* rdent could be overwritten by another readdir to the same handle */
return makfrom0str((char *)rdent->d_name);
}
-static char s_rewinddir[]="rewinddir";
+
SCM l_rewinddir(port)
SCM port;
{
- ASSERT(OPDIRP(port), port, ARG1, s_rewinddir);
+ ASRTER(OPDIRP(port), port, ARG1, s_rewinddir);
rewinddir((DIR *)CDR(port));
return UNSPECIFIED;
}
-static char s_closedir[]="closedir";
+
SCM l_closedir(port)
SCM port;
{
int sts;
- ASSERT(DIRP(port), port, ARG1, s_closedir);
+ ASRTER(DIRP(port), port, ARG1, s_closedir);
DEFER_INTS;
if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;}
SYSCALL(sts = closedir((DIR *)CDR(port)););
@@ -381,10 +387,117 @@ sizet dir_free(p)
if OPENP((SCM)p) closedir((DIR *)CDR((SCM)p));
return 0;
}
+# define dir_mark mark0
+# else /* _WIN32 */
+struct WDIR {
+ long handle; //-1 if at end of list.
+ struct _finddata_t info;
+ SCM fspec; //for rewind, needs gc protection.
+};
-long tc16_dir;
-static smobfuns dir_smob = {mark0, dir_free, dir_print, 0};
+SCM l_opendir(dirname)
+ SCM dirname;
+{
+ long handle;
+ SCM fspec, dir;
+ struct _finddata_t info;
+ struct WDIR *wdir;
+ int dlen;
+ ASRTER(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir);
+ dlen = LENGTH(dirname);
+ fspec = makstr(dlen + 2);
+ strcpy(CHARS(fspec), CHARS(dirname));
+ if ('/' != CHARS(fspec)[dlen - 1] && '\\' != CHARS(fspec)[dlen - 1])
+ CHARS(fspec)[dlen++] = '/';
+ CHARS(fspec)[dlen++] = '*';
+ CHARS(fspec)[dlen] = 0;
+ DEFER_INTS;
+ dir = must_malloc_cell(sizeof(struct WDIR)+0L, tc16_dir, s_opendir);
+ wdir = (struct WDIR*)CHARS(dir);
+ wdir->fspec = fspec;
+ SCM_OPENCALL(handle = _findfirst(CHARS(fspec), &(wdir->info)));
+ if (-1 == handle) {ALLOW_INTS; return BOOL_F;}
+ wdir->handle = handle;
+ CAR(dir) |= OPN;
+ ALLOW_INTS;
+ return dir;
+}
+
+SCM l_readdir(port)
+ SCM port;
+{
+ SCM fname;
+ struct WDIR *wdir;
+ int ret;
+ ASRTER(OPDIRP(port), port, ARG1, s_readdir);
+ wdir = (struct WDIR*)CHARS(port);
+ if (-1 == wdir->handle) return BOOL_F;
+ fname = makfrom0str(wdir->info.name);
+ DEFER_INTS;
+ SYSCALL(ret = _findnext(wdir->handle, &(wdir->info)););
+ if (0 != ret) {
+ SYSCALL(_findclose(wdir->handle););
+ wdir->handle = -1;
+ }
+ ALLOW_INTS;
+ return fname;
+}
+
+SCM l_rewinddir(port)
+ SCM port;
+{
+ struct WDIR *wdir;
+ ASRTER(OPDIRP(port), port, ARG1, s_rewinddir);
+ wdir = (struct WDIR*)CHARS(port);
+ DEFER_INTS;
+ if (-1 != wdir->handle)
+ SYSCALL(_findclose(wdir->handle););
+ SYSCALL(wdir->handle = _findfirst(CHARS(wdir->fspec), &(wdir->info)););
+ ALLOW_INTS;
+ return UNSPECIFIED;
+}
+
+SCM l_closedir(port)
+ SCM port;
+{
+ struct WDIR *wdir;
+ ASRTER(DIRP(port), port, ARG1, s_closedir);
+ wdir = (struct WDIR*)CHARS(port);
+ DEFER_INTS;
+ if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;}
+ if (-1 != wdir->handle) {
+ SYSCALL(_findclose(wdir->handle););
+ wdir->handle = -1;
+ }
+ CAR(port) = tc16_dir;
+ wdir->fspec = UNSPECIFIED;
+ ALLOW_INTS;
+ return BOOL_T;
+}
+
+int dir_print(sexp, port, writing)
+ SCM sexp; SCM port; int writing;
+{
+ prinport(sexp, port, "directory");
+ return !0;
+}
+sizet dir_free(p)
+ CELLPTR p;
+{
+ struct WDIR *wdir = (struct WDIR*)CHARS((SCM)p);
+ if (-1 != wdir->handle)
+ _findclose(wdir->handle);
+ must_free(CHARS((SCM)p), (sizet)sizeof(struct WDIR));
+ return 0;
+}
+SCM dir_mark(ptr)
+ SCM ptr;
+{
+ return ((struct WDIR*)CHARS(ptr))->fspec;
+}
# endif /* _WIN32 */
+long tc16_dir;
+static smobfuns dir_smob = {dir_mark, dir_free, dir_print, 0};
# endif /* vms */
static char s_mkdir[] = "mkdir";
@@ -392,8 +505,8 @@ SCM l_mkdir(path, mode)
SCM path, mode;
{
int val;
- ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_mkdir);
- ASSERT(INUMP(mode), mode, ARG2, s_mkdir);
+ ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_mkdir);
+ ASRTER(INUMP(mode), mode, ARG2, s_mkdir);
# ifdef _WIN32
SYSCALL(val = mkdir(CHARS(path)););
# else
@@ -410,7 +523,7 @@ SCM l_rmdir(path)
SCM path;
{
int val;
- ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_rmdir);
+ ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_rmdir);
# ifdef vms
return del_fil(st_append(cons2(path, s_dot_dir, EOL)));
# else
@@ -426,7 +539,7 @@ SCM lchdir(str)
SCM str;
{
int ans;
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_chdir);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_chdir);
SYSCALL(ans = chdir(CHARS(str)););
return ans ? BOOL_F : BOOL_T;
}
@@ -453,8 +566,8 @@ SCM l_chmod(pathname, mode)
SCM pathname, mode;
{
int val;
- ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_chmod);
- ASSERT(INUMP(mode), mode, ARG2, s_chmod);
+ ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_chmod);
+ ASRTER(INUMP(mode), mode, ARG2, s_chmod);
SYSCALL(val = chmod(CHARS(pathname), INUM(mode)););
return val ? BOOL_F : BOOL_T;
}
@@ -478,7 +591,7 @@ SCM l_utime(pathname, acctime, modtime)
struct utimbuf utm_tmp;
utm_tmp.actime = num2ulong(acctime, (char *)ARG2, s_utime);
utm_tmp.modtime = num2ulong(modtime, (char *)ARG3, s_utime);
- ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_utime);
+ ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_utime);
SYSCALL(val = utime(CHARS(pathname), &utm_tmp););
return val ? BOOL_F : BOOL_T;
}
@@ -489,7 +602,7 @@ static char s_umask[] = "umask";
SCM l_umask(mode)
SCM mode;
{
- ASSERT(INUMP(mode), mode, ARG1, s_umask);
+ ASRTER(INUMP(mode), mode, ARG1, s_umask);
return MAKINUM(umask(INUM(mode)));
}
# endif
@@ -501,8 +614,8 @@ SCM ren_fil(oldname, newname)
SCM oldname, newname;
{
SCM ans;
- ASSERT(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_ren_fil);
- ASSERT(NIMP(newname) && STRINGP(newname), newname, ARG2, s_ren_fil);
+ ASRTER(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_ren_fil);
+ ASRTER(NIMP(newname) && STRINGP(newname), newname, ARG2, s_ren_fil);
#if 1 /* def STDC_HEADERS */
SYSCALL(ans = (rename(CHARS(oldname), CHARS(newname))) ? BOOL_F: BOOL_T;);
return ans;
@@ -522,7 +635,7 @@ static char s_fileno[] = "fileno";
SCM l_fileno(port)
SCM port;
{
- ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_fileno);
+ ASRTER(NIMP(port) && OPPORTP(port), port, ARG1, s_fileno);
if (tc16_fport != TYP16(port)) return BOOL_F;
return MAKINUM(fileno(STREAM(port)));
}
@@ -540,10 +653,10 @@ SCM l_access(pathname, mode)
{
int val;
int imodes;
- ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_access);
+ ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_access);
if INUMP(mode) imodes = INUM(mode);
else {
- ASSERT(NIMP(mode) && STRINGP(mode), mode, ARG2, s_access);
+ ASRTER(NIMP(mode) && STRINGP(mode), mode, ARG2, s_access);
imodes = F_OK | (strchr(CHARS(mode), 'r') ? R_OK : 0)
| (strchr(CHARS(mode), 'w') ? W_OK : 0)
| (strchr(CHARS(mode), 'x') ? X_OK : 0);
@@ -630,8 +743,8 @@ SCM i_execv(modes, path, args)
{
char **execargv;
int i = ilength(args);
- ASSERT(i>0, args, WNA, s_execv);
- ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_execv);
+ ASRTER(i>0, args, WNA, s_execv);
+ ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_execv);
/* dowinds(EOL); */
args = cons(path, args);
DEFER_INTS;
@@ -667,7 +780,7 @@ static char s_putenv[] = "putenv";
SCM l_putenv(str)
SCM str;
{
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_putenv);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_putenv);
return putenv(CHARS(str)) ? BOOL_F : BOOL_T;
}
# endif
@@ -680,12 +793,10 @@ static iproc subr1s[] = {
{s_fileno, l_fileno},
#ifndef MCH_AMIGA
# ifndef vms
-# ifndef _WIN32
{s_opendir, l_opendir},
{s_readdir, l_readdir},
{s_rewinddir, l_rewinddir},
{s_closedir, l_closedir},
-# endif
# endif
{s_rmdir, l_rmdir},
#endif
@@ -734,11 +845,11 @@ SCM scm_try_create_file(fname, modes, perms)
# else
int cperms = 0666;
# endif
- ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_try_create_file);
- ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_try_create_file);
+ ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_try_create_file);
+ ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_try_create_file);
if (NNULLP(perms)) {
perms = CAR(perms);
- ASSERT(INUMP(perms), perms, ARG3, s_try_create_file);
+ ASRTER(INUMP(perms), perms, ARG3, s_try_create_file);
# ifdef S_IROTH
cperms = (mode_t)INUM(perms);
# else
@@ -746,7 +857,7 @@ SCM scm_try_create_file(fname, modes, perms)
# endif
}
flags = mode_bits(CHARS(modes), cmodes);
- ASSERT(flags, modes, ARG2, s_try_create_file);
+ ASRTER(flags, modes, ARG2, s_try_create_file);
fdflags |= (RDNG & flags) ? O_RDWR : O_WRONLY;
DEFER_INTS;
SCM_OPENCALL(fd = open(CHARS(fname), fdflags, cperms));
@@ -768,6 +879,8 @@ static iproc subr2os[] = {
{s_write_line, l_write_line},
{0, 0}};
+SCM_DLL_EXPORT void init_ioext P((void));
+
void init_ioext()
{
init_iprocs(subr1os, tc7_subr_1o);
@@ -787,8 +900,8 @@ void init_ioext()
# ifndef vms
# ifndef _WIN32
make_subr(s_utime, tc7_subr_3, l_utime);
- tc16_dir = newsmob(&dir_smob);
# endif
+ tc16_dir = newsmob(&dir_smob);
# endif
# endif
#endif
@@ -809,6 +922,11 @@ void init_ioext()
add_feature("line-i/o");
scm_ldstr("\n\
(define (file-exists? path) (access path \"r\"))\n\
+(define (make-directory path)\n\
+ (define umsk (umask 18))\n\
+ (umask umsk)\n\
+ (mkdir path (logxor #o777 umsk)))\n\
+(define current-directory getcwd)\n\
(define (directory-for-each proc dirname . args)\n\
(define dir (opendir (if (symbol? dirname)\n\
(symbol->string dirname)\n\
@@ -830,6 +948,17 @@ void init_ioext()
(do ((filename (readdir dir) (readdir dir)))\n\
((not filename) (closedir dir))\n\
(and (selector filename) (proc filename))))))\n\
+(define (system->line command . tmp)\n\
+ (require 'filename)\n\
+ (cond ((null? tmp)\n\
+ (call-with-tmpnam\n\
+ (lambda (tmp) (system->line command tmp))))\n\
+ (else\n\
+ (set! tmp (car tmp))\n\
+ (and (zero? (system (string-append command \" > \" tmp)))\n\
+ (file-exists? tmp)\n\
+ (let ((line (call-with-input-file tmp read-line)))\n\
+ (if (eof-object? line) \"\" line))))))\n\
");
- add_feature("directory-for-each");
+ add_feature("directory");
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-27 11:29:03 +0000