From c7d035ae1a729232579a0fe41ed5affa131d3623 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:27 -0800 Subject: Import Upstream version 5d9 --- ioext.c | 227 ++++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 178 insertions(+), 49 deletions(-) (limited to 'ioext.c') 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 #endif +#ifdef __NetBSD__ +# include +#endif #ifdef __OpenBSD__ # include #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 -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"); } -- cgit v1.2.3