Description: <short summary of the patch>
TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.
.
gcl (2.6.12-39) unstable; urgency=medium
.
* pathnames1.1
* ansi-test clean target
Author: Camm Maguire <camm@debian.org>
---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:
Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: 2016-10-12
--- gcl-2.6.12.orig/h/notcomp.h
+++ gcl-2.6.12/h/notcomp.h
@@ -296,6 +296,8 @@ gcl_init_cmp_anon(void);
char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX];
+#define coerce_to_filename(a_,b_) coerce_to_filename1(a_,b_,sizeof(b_))
+
#include <errno.h>
#define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);})
--- gcl-2.6.12.orig/h/protoize.h
+++ gcl-2.6.12/h/protoize.h
@@ -508,7 +508,7 @@ typedef void (*funcvoid)(void);
/* unexlin.c:808:OF */ extern int write_segment (int new, register char *ptr, register char *end); /* (new, ptr, end) int new; register char *ptr; register char *end; */
/* unixfasl.c:409:OF */ extern void gcl_init_unixfasl (void); /* () */
/* unixfsys.c:145:OF */ extern char *getwd (char *buffer); /* (buffer) char *buffer; */
-/* unixfsys.c:209:OF */ extern void coerce_to_filename (object pathname, char *p); /* (pathname, p) object pathname; char *p; */
+/* unixfsys.c:209:OF */ extern void coerce_to_filename1 (object pathname, char *p,unsigned sz); /* (pathname, p) object pathname; char *p; */
/* unixfsys.c:329:OF */ extern bool file_exists (object file); /* (file) object file; */
/* unixfsys.c:359:OF */ extern FILE *backup_fopen (char *filename, char *option); /* (filename, option) char *filename; char *option; */
/* unixfsys.c:359:OF */ extern FILE *fopen_not_dir (char *filename, char *option); /* (filename, option) char *filename; char *option; */
--- gcl-2.6.12.orig/lsp/gcl_directory.lsp
+++ gcl-2.6.12/lsp/gcl_directory.lsp
@@ -48,8 +48,12 @@
(expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME
((funcall f z y))))))
+(defun chdir (s)
+ (when (chdir1 (namestring (pathname s)));to expand ~/
+ (setq *current-directory* (current-directory-pathname))))
+
(defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p))
- (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/"))))
+ (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*))))
(lc (when c (length c)))
(filesp (or (pathname-name p) (pathname-type p)))
(v (compile-regexp (to-regexp p)))(*up-key* :back) r)
--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp
+++ gcl-2.6.12/lsp/gcl_rename_file.lsp
@@ -35,6 +35,7 @@
(check-type spec pathname-designator)
(multiple-value-bind
(tp sz tm) (stat (namestring (truename spec)))
+ (declare (ignore tp sz))
(+ tm (* (+ 17 (* 70 365)) (* 24 60 60)))))
@@ -43,5 +44,6 @@
(check-type spec pathname-designator)
(multiple-value-bind
(tp sz tm uid) (stat (namestring (truename spec)))
+ (declare (ignore tp sz tm))
(uid-to-name uid)))
--- gcl-2.6.12.orig/lsp/gcl_top.lsp
+++ gcl-2.6.12/lsp/gcl_top.lsp
@@ -607,8 +607,13 @@ First directory is checked for first nam
(defvar *ld* "ld")
(defvar *objdump* "objdump --source ")
+(defvar *current-directory* *system-directory*)
+
+(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/")))
+
(defun set-up-top-level (&aux (i (argc)) tem)
(declare (fixnum i))
+ (setq *current-directory* (current-directory-pathname))
(setq *tmp-dir* (get-temp-dir)
*cc* (get-path *cc*)
*ld* (get-path *ld*)
--- gcl-2.6.12.orig/lsp/gcl_truename.lsp
+++ gcl-2.6.12/lsp/gcl_truename.lsp
@@ -18,20 +18,18 @@
(pathname (typep x 'logical-pathname))
(stream (logical-pathname-designator-p (pathname x)))))
-;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir
-
-(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd)))
+(defun truename (pd &aux (ns (namestring (translate-logical-pathname pd))))
(declare (optimize (safety 1)))
(check-type pd pathname-designator)
(when (wild-pathname-p ns)
(error 'file-error :pathname pd :format-control "Pathname is wild"))
- (let* ((ns (ensure-dir-string (link-expand ns))))
+ (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns)))
(unless (or (zerop (length ns)) (stat ns))
(error 'file-error :pathname ns :format-control "Pathname does not exist"))
(let* ((d (pathname-directory ppd))
(d1 (subst :back :up d))
(ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd))))
- (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil)))))
+ (if (eq (car d) :absolute) ppd (merge-pathnames ppd *current-directory* nil)))))
(defun probe-file (pd &aux (pn (translate-logical-pathname pd)))
--- gcl-2.6.12.orig/o/file.d
+++ gcl-2.6.12/o/file.d
@@ -351,120 +351,86 @@ open_stream(object fn,enum smmode smm, o
vs_mark;
coerce_to_filename(fn,FN1);
- if (smm == smm_input || smm == smm_probe) {
- if(FN1[0]=='|')
- fp = popen(FN1+1,"r");
- else
- fp = fopen_not_dir(FN1, "r");
- if ((fp == NULL) &&
- (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) {
- union lispunion st;
- char buf[256];
- if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0)
- FEerror("Cannot write .gz filename",0);
- st.st.st_self=buf;
- st.st.st_dim=st.st.st_fillp=strlen(buf);
- set_type_of(&st,t_string);
- if (fSstat((object)&st)!=Cnil) {
+ switch(smm) {
+
+ case smm_input:
+ case smm_probe:
+
+ if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) {
+
+ struct stat ss;
+ massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0);
+
+ if (!stat(FN2,&ss)) {
+
FILE *pp;
int n;
- if (!(fp=tmpfile()))
- FEerror("Cannot create temporary file",0);
- if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0)
- FEerror("Cannot write zcat pipe name",0);
- if (!(pp=popen(buf,"r")))
- FEerror("Cannot open zcat pipe",0);
- while((n=fread(buf,1,sizeof(buf),pp)))
- if (!fwrite(buf,1,n,fp))
- FEerror("Cannot write pipe output to temporary file",0);
- if (pclose(pp)<0)
- FEerror("Cannot close zcat pipe",0);
- if (fseek(fp,0,SEEK_SET))
- FEerror("Cannot rewind temporary file\n",0);
+
+ massert((fp=tmpfile()));
+ massert(snprintf(FN3,sizeof(FN2),"zcat %s",FN2)>0);
+ massert(pp=popen(FN3,"r"));
+ while ((n=fread(FN4,1,sizeof(FN3),pp)))
+ massert(fwrite(FN4,1,n,fp)==n);
+ massert(pclose(pp)>=0);
+ massert(!fseek(fp,0,SEEK_SET));
+
}
+
}
- if (fp == NULL) {
- if (if_does_not_exist == sKerror)
- cannot_open(fn);
- else if (if_does_not_exist == sKcreate) {
- fp = fopen_not_dir(FN1, "w");
- if (fp == NULL)
- cannot_create(fn);
+
+ if (!fp) {
+
+ if (if_does_not_exist==sKerror) cannot_open(fn);
+ else if (if_does_not_exist==sKcreate) {
+ if (!(fp=fopen_not_dir(FN1,"w"))) cannot_create(fn);
fclose(fp);
- fp = fopen_not_dir(FN1, "r");
- if (fp == NULL)
- cannot_open(fn);
- } else if (if_does_not_exist == Cnil)
- return(Cnil);
- else
- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",
- 1, if_does_not_exist);
+ if (!(fp=fopen_not_dir(FN1,"r"))) cannot_open(fn);
+ } else if (if_does_not_exist==Cnil) return(Cnil);
+ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist);
+
}
- } else if (smm == smm_output || smm == smm_io) {
- if (FN1[0] == '|')
- fp = NULL;
- else
- fp = fopen_not_dir(FN1, "r");
- if (fp != NULL) {
+ break;
+
+ case smm_output:
+ case smm_io:
+
+ if ((fp=*FN1=='|' ? NULL : fopen_not_dir(FN1,"r"))) {
+
fclose(fp);
- if (if_exists == sKerror)
- FILE_ERROR(fn,"File exists");
- else if (if_exists == sKrename) {
+ if (if_exists==sKerror) FILE_ERROR(fn,"File exists");
+ else if (if_exists==sKrename) {
massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0);
massert(!rename(FN1,FN2));
- if (smm == smm_output)
- fp = fopen(FN1, "w");
- else
- fp = fopen(FN1, "w+");
- if (fp == NULL)
- cannot_create(fn);
- } else if (if_exists == sKrename_and_delete ||
- if_exists == sKnew_version ||
- if_exists == sKsupersede) {
- if (smm == smm_output)
- fp = fopen_not_dir(FN1, "w");
- else
- fp = fopen_not_dir(FN1, "w+");
- if (fp == NULL)
- cannot_create(fn);
- } else if (if_exists == sKoverwrite) {
- fp = fopen_not_dir(FN1, "r+");
- if (fp == NULL)
- cannot_open(fn);
- } else if (if_exists == sKappend) {
- if (smm == smm_output)
- fp = fopen_not_dir(FN1, "a");
- else
- fp = fopen_not_dir(FN1, "a+");
- if (fp == NULL)
+ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn);
+ } else if (if_exists==sKrename_and_delete ||
+ if_exists==sKnew_version ||
+ if_exists==sKsupersede) {
+ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn);
+ } else if (if_exists==sKoverwrite) {
+ if (!(fp=fopen_not_dir(FN1,"r+"))) cannot_open(fn);
+ } else if (if_exists==sKappend) {
+ if (!(fp = fopen_not_dir(FN1,smm==smm_output ? "a" : "a+")))
FEerror("Cannot append to the file ~A.",1,fn);
- } else if (if_exists == Cnil)
- return(Cnil);
- else
- FEerror("~S is an illegal IF-EXISTS option.",
- 1, if_exists);
+ } else if (if_exists == Cnil) return(Cnil);
+ else FEerror("~S is an illegal IF-EXISTS option.",1,if_exists);
+
} else {
+
if (if_does_not_exist == sKerror)
FILE_ERROR(fn,"The file does not exist");
else if (if_does_not_exist == sKcreate) {
- if (smm == smm_output) {
- if(FN1[0]=='|')
- fp = popen(FN1+1,"w");
- else
- fp = fopen_not_dir(FN1, "w");
- } else
- fp = fopen_not_dir(FN1, "w+");
- if (fp == NULL)
+ if (!(fp=smm==smm_output ? (*FN1=='|' ? popen(FN1+1,"w") : fopen_not_dir(FN1, "w")) : fopen_not_dir(FN1, "w+")))
cannot_create(fn);
- } else if (if_does_not_exist == Cnil)
- return(Cnil);
- else
- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",
- 1, if_does_not_exist);
+ } else if (if_does_not_exist==Cnil) return(Cnil);
+ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist);
}
- } else
+ break;
+
+ default:
FEerror("Illegal open mode for ~S.",1,fn);
+ break;
+ }
vs_push(make_simple_string(FN1));
x = alloc_object(t_stream);
@@ -600,10 +566,6 @@ close_stream(object strm) {
fclose(strm->sm.sm_fp);
strm->sm.sm_fp = NULL;
strm->sm.sm_fd = -1;
- if (strm->sm.sm_object0 &&
- type_of(strm->sm.sm_object0 )==t_cons &&
- Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA)
- ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0));
break;
case smm_file_synonym:
@@ -1762,9 +1724,7 @@ LFD(siLoutput_stream_string)()
}
DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
- RETURN1(type_of(x)==t_stream &&
- (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe)
- ? Ct : Cnil);
+ RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil);
}
DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
--- gcl-2.6.12.orig/o/unixfsys.c
+++ gcl-2.6.12/o/unixfsys.c
@@ -19,8 +19,6 @@ Foundation, 675 Mass Ave, Cambridge, MA
*/
-#include <string.h>
-#include <stdlib.h>
#include <unistd.h>
#include <errno.h>
@@ -32,140 +30,17 @@ Foundation, 675 Mass Ave, Cambridge, MA
#include <pwd.h>
#endif
-#ifdef __MINGW32__
-# include <windows.h>
+#ifdef __MINGW32__
+# include <windows.h>
/* Windows has no symlink, therefore no lstat. Without symlinks lstat
is equivalent to stat anyway. */
# define S_ISLNK(a) 0
# define lstat stat
-#endif
-
-#ifdef BSD
-#define HAVE_RENAME
#endif
-#ifdef NEED_GETWD
-#include <sys/dir.h>
-
-
-#ifndef HAVE_GETCWD
-char dotdot[3*16+2] = "../../../../../../../../../../../../../../../../.";
-#include <mnttab.h>
-static char *getwd_buf;
-static int getwd_bufp;
-
-static char *
-getwd(buffer)
-char *buffer;
-{
- getwd_buf = buffer;
- getwd1(0);
- if (getwd_bufp == 0)
- getwd_buf[getwd_bufp++] = '/';
- getwd_buf[getwd_bufp] = '\0';
- return(getwd_buf);
-}
-
-getwd1(n)
-int n;
-{
- struct stat st, dev_st;
- struct direct dir;
- ino_t ino;
- struct mnttab mnt;
- FILE *fp;
- register int i;
- char buf[BUFSIZ];
- static char dev_name[64];
-
- if (stat(dotdot+(16-n)*3, &st) < 0)
- FEerror("Can't get the current working directory.", 0);
- ino = st.st_ino;
- if (ino == 2)
- goto ROOT;
- getwd1(n+1);
- fp = fopen(dotdot+(16-n-1)*3, "r");
- if (fp == NULL)
- FEerror("Can't get the current working directory.", 0);
- setbuf(fp, buf);
- fread(&dir, sizeof(struct direct), 1, fp);
- fread(&dir, sizeof(struct direct), 1, fp);
- for (;;) {
- if (fread(&dir, sizeof(struct direct), 1, fp) <= 0)
- break;
- if (dir.d_ino == ino)
- goto FOUND;
- }
- fclose(fp);
- FEerror("Can't get the current working directory.", 0);
-
-FOUND:
- fclose(fp);
- getwd_buf[getwd_bufp++] = '/';
- for (i = 0; i < DIRSIZ && dir.d_name[i] != '\0'; i++)
- getwd_buf[getwd_bufp++] = dir.d_name[i];
- return;
-
-ROOT:
- fp = fopen("/etc/mnttab", "r");
- if (fp == NULL)
- FEerror("Can't get the current working directory.", 0);
- setbuf(fp, buf);
- for (;;) {
- if (fread(&mnt, sizeof(struct mnttab), 1, fp) <= 0)
- break;
- if (mnt.mt_dev[0] != '/') {
- strcpy(dev_name, "/dev/dsk/");
- strcat(dev_name, mnt.mt_dev);
- stat(dev_name, &dev_st);
- } else
- stat(mnt.mt_dev, &dev_st);
- if (dev_st.st_rdev == st.st_dev)
- goto DEV_FOUND;
- }
- fclose(fp);
- getwd_bufp = 0;
- return;
-
-DEV_FOUND:
- fclose(fp);
- getwd_bufp = 0;
- for (i = 0; mnt.mt_filsys[i] != '\0'; i++)
- getwd_buf[i] = mnt.mt_filsys[i];
- /* BUG FIX by Grant J. Munsey */
- if (i == 1 && *getwd_buf == '/')
- i = 0; /* don't add an empty directory name */
- /* END OF BUG FIX */
- getwd_bufp = i;
-}
-#endif /* not HAVE_GETCWD */
-#endif
-
-#ifndef MAXPATHLEN
-#define MAXPATHLEN 512
-#endif
-
-
-#ifdef HAVE_GETCWD
-char *
-getwd(char *buffer) {
-#ifndef _WIN32
- char *getcwd(char *, size_t);
-#endif
- return(getcwd(buffer, MAXPATHLEN));
-}
-#endif
-
-
-#define pcopy(a_,b_,c_,d_) ({\
- unsigned _c=c_,_d=d_;\
- if (_c+_d>=MAXPATHLEN-16) FEerror("Can't expand pathname ~a",1,namestring);\
- bcopy(a_,b_+_c,_d);\
- b_[_c+_d]=0;\
- })
-
static object
get_string(object x) {
+
switch(type_of(x)) {
case t_symbol:
case t_string:
@@ -180,182 +55,110 @@ get_string(object x) {
case smm_io:
return get_string(x->sm.sm_object1);
case smm_file_synonym:
- case smm_synonym:
return get_string(x->sm.sm_object0->s.s_dbind);
}
}
+
return Cnil;
-}
+}
void
-coerce_to_filename(object pathname,char *p) {
+coerce_to_filename1(object spec, char *p,unsigned sz) {
- object namestring=get_string(pathname);
- unsigned e=namestring->st.st_fillp;
- char *q=namestring->st.st_self,*qe=q+e;
+ object namestring=get_string(spec);
- if (pathname==Cnil||namestring==Cnil)
- FEerror ( "NIL argument.", 1, pathname );
-
- if (*q=='~' && e) {
+ massert(namestring->st.st_fillp<sz);
+ memcpy(p,namestring->st.st_self,namestring->st.st_fillp);
+ p[namestring->st.st_fillp]=0;
- unsigned m=0;
- char *s=++q,*c;
+#ifdef FIX_FILENAME
+ FIX_FILENAME(spec,p);
+#endif
- for (;s<qe && *s!='/';s++);
+}
- if (s==q && (c=getenv("HOME")))
+DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") {
+ struct passwd *pwent,pw;
+ long r;
- pcopy(c,p,0,m=strlen(c));
-
-#if !defined(NO_PWD_H) && !defined(STATIC_LINKING)
- else {
-#ifndef __STDC__
- extern struct passwd *getpwuid();
- extern struct passwd *getpwnam();
-#endif
- struct passwd *pwent;
-
- if (s==q)
- pwent=getpwuid(getuid());
- else {
- *s=0;
- pwent=getpwnam(q);
- *s='/';
- }
-
- if (!pwent)
- FEerror("Can't expand pathname ~a",1,namestring);
- pcopy(pwent->pw_dir,p,0,m=strlen(pwent->pw_dir));
-
- }
-#endif
+ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0);
+ massert(r<sizeof(FN1));
- pcopy(s,p,m,qe-s);
-
- } else
+ massert(!getpwuid_r(uid,&pw,FN1,r,&pwent));
+
+ RETURN1(make_simple_string(pwent->pw_name));
- pcopy(q,p,0,e);
-
-#ifdef FIX_FILENAME
- FIX_FILENAME(pathname,p);
-#endif
-
}
-object sSAallow_gzipped_fileA;
+DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") {
-bool
-file_exists(object file)
-{
- char filename[MAXPATHLEN];
- struct stat filestatus;
+ struct passwd *pwent,pw;
+ long r;
- coerce_to_filename(file, filename);
+ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0);
+ massert(r<sizeof(FN1));
-#ifdef __MINGW32__
- {
- char *p;
- for (p = filename; *p != '\0'; p++);
- if ( (p > filename) &&
- ( ( *(p-1) == '/' ) || ( *(p-1) == '\\' ) ) ) {
- *(p-1) = '\0';
- }
- }
-#endif
-
- if (stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode))
- {
-#ifdef AIX
- /* if /tmp/foo is not a directory /tmp/foo/ should not exist */
- if (filename[strlen(filename)-1] == '/' &&
- !( filestatus.st_mode & S_IFDIR))
- return(FALSE);
-#endif
-
- return TRUE;
- }
- else
- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil
- && (strcat(filename,".gz"),
- stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode)))
-
- return TRUE;
+ if (nm->st.st_fillp==1)
- else
- return(FALSE);
-}
+ if ((pw.pw_dir=getenv("HOME")))
+ pwent=&pw;
+ else
+ massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent);
-FILE *
-fopen_not_dir(char *filename,char * option) {
+ else {
- struct stat ss;
+ massert(nm->st.st_fillp<sizeof(FN2));
+ memcpy(FN2,nm->st.st_self+1,nm->st.st_fillp-1);
+ FN2[nm->st.st_fillp-1]=0;
- if (!stat(filename,&ss) && S_ISDIR(ss.st_mode))
- return NULL;
- else
- return fopen(filename,option);
+ massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent);
+
+ }
+
+ massert(strlen(pwent->pw_dir)+2<sizeof(FN3));
+ memcpy(FN3,pwent->pw_dir,strlen(pwent->pw_dir));
+ FN3[strlen(pwent->pw_dir)]='/';
+ FN3[strlen(pwent->pw_dir)+1]=0;
+ RETURN1(make_simple_string(FN3));
}
+#define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode)
+#define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode)
+
FILE *
-backup_fopen(char *filename, char *option)
-{
- char backupfilename[MAXPATHLEN];
- char command[MAXPATHLEN * 2];
+fopen_not_dir(char *filename,char *option) {
+
+ struct stat ss;
+
+ return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option);
- strcat(strcpy(backupfilename, filename), ".BAK");
- sprintf(command, "mv %s %s", filename, backupfilename);
- msystem(command);
- return(fopen(filename, option));
}
int
-file_len(FILE *fp)
-{
- struct stat filestatus;
+file_len(FILE *fp) {/*FIXME dir*/
- if (fstat(fileno(fp), &filestatus)==0)
- return(filestatus.st_size);
- else return 0;
-}
+ struct stat filestatus;
-DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,"");
-DEF_ORDINARY("LINK",sKlink,KEYWORD,"");
-DEF_ORDINARY("FILE",sKfile,KEYWORD,"");
+ return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size;
-/* export these for AXIOM */
-int gcl_putenv(char *s) {return putenv(s);}
-char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);}
-char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/
-#ifdef __MINGW32__
-#define uid_t int
-#endif
-uid_t gcl_geteuid(void) {
-#ifndef __MINGW32__
- return geteuid();
-#else
- return 0;
-#endif
-}
-uid_t gcl_getegid(void) {
-#ifndef __MINGW32__
- return getegid();
-#else
- return 0;
-#endif
}
-int gcl_dup2(int o,int n) {return dup2(o,n);}
-char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);}
-int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;}
+bool
+file_exists(object x) {
-int gcl_feof(void *v) {return feof(((FILE *)v));}
-int gcl_getc(void *v) {return getc(((FILE *)v));}
-int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));}
+ struct stat ss;
+
+ coerce_to_filename(x,FN1);
+ return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE;
+}
+
+DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,"");
+DEF_ORDINARY("LINK",sKlink,KEYWORD,"");
+DEF_ORDINARY("FILE",sKfile,KEYWORD,"");
DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
@@ -381,6 +184,31 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N
make_fixnum(ss.st_uid));
}
+#include <sys/types.h>
+#include <dirent.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") {
+ ssize_t l,z1;
+
+ check_type_string(&s);
+ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */
+ z1=length(s);
+ massert(z1<sizeof(FN1));
+ memcpy(FN1,s->st.st_self,z1);
+ FN1[z1]=0;
+ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l<sizeof(FN2));
+ FN2[l]=0;
+ RETURN1(make_simple_string(FN2));
+
+}
+
+DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
+ massert((getcwd(FN1,sizeof(FN1))));
+ RETURN1(make_simple_string(FN1));
+}
+
DEFUN_NEW("SETENV",object,fSsetenv,SI,2,2,NONE,OO,OO,OO,OO,(object variable,object value),"Set environment VARIABLE to VALUE")
{
@@ -407,13 +235,9 @@ DEFUN_NEW("SETENV",object,fSsetenv,SI,2,
#include <dirent.h>
DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {
- DIR *d;
- char filename[MAXPATHLEN];
check_type_string(&x);
- memcpy(filename,x->st.st_self,x->st.st_fillp);
- filename[x->st.st_fillp]=0;
- d=opendir(filename);
- return (object)d;
+ coerce_to_filename(x,FN1);
+ return (object)opendir(FN1);
}
#ifdef HAVE_D_TYPE
@@ -430,19 +254,27 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_
MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN"))
));
}
+#else
+#define DT_UNKNOWN 0
#endif
DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") {
+
struct dirent *e;
object z;
long tl;
size_t l;
+
if (!x) RETURN1(Cnil);
+
tl=telldir((DIR *)x);
-#ifdef HAVE_D_TYPE
- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;);
+
+#ifndef HAVE_D_TYPE
+ y=DT_UNKNOWN;
#endif
+ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;);
if (!e) RETURN1(Cnil);
+
if (s==Cnil)
z=make_simple_string(e->d_name);
else {
@@ -457,10 +289,13 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI,
RETURN1(make_fixnum(l));
}
}
+
#ifdef HAVE_D_TYPE
if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type));
#endif
+
RETURN1(z);
+
}
DEFUN_NEW("CLOSEDIR",object,fSclosedir,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") {
@@ -468,165 +303,174 @@ DEFUN_NEW("CLOSEDIR",object,fSclosedir,S
return Cnil;
}
-DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
-
- char filename[MAXPATHLEN];
+DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
check_type_string(&x);
+ check_type_string(&y);
- memcpy(filename,x->st.st_self,x->st.st_fillp);
- filename[x->st.st_fillp]=0;
-
-#ifdef __MINGW32__
- if (mkdir(filename) < 0)
-#else
- if (mkdir(filename,01777) < 0)
-#endif
- FEerror("Cannot make the directory ~S.", 1, vs_base[0]);
+ coerce_to_filename(x,FN1);
+ coerce_to_filename(y,FN2);
- RETURN1(x);
+ RETURN1(rename(FN1,FN2) ? Cnil : Ct);
}
-DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
+DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
+
check_type_string(&x);
coerce_to_filename(x,FN1);
- RETURN1(rmdir(FN1) ? Cnil : Ct);
+ RETURN1(unlink(FN1) ? Cnil : Ct);
}
+DEFUN_NEW("CHDIR1",object,fSchdir1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
-#include <sys/types.h>
-#include <dirent.h>
-#include <fcntl.h>
-#include <unistd.h>
+ check_type_string(&x);
-DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") {
- char *b1,*b2=NULL;
- ssize_t l,z1,z2;
- check_type_string(&s);
- /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */
- z1=length(s);
- massert((b1=alloca(z1+1)));
- memcpy(b1,s->st.st_self,z1);
- b1[z1]=0;
- for (l=z2=0;l>=z2;) {
- memset(b2,0,z2);
- z2+=z2+10;
- massert((b2=alloca(z2)));
- massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0);
- }
- b2[l]=0;
- s=make_simple_string(b2);
- memset(b1,0,z1);
- memset(b2,0,z2);
- RETURN1(s);
-}
+ coerce_to_filename(x,FN1);
-DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
- char *b=NULL;
- size_t z;
- object s;
-
- for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));}));
- massert((b=getcwd(b,z)));
- s=make_simple_string(b);
- memset(b,0,z);
- RETURN1(s);
+ RETURN1(chdir(FN1) ? Cnil : Ct);
}
-DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") {
- struct passwd *pwent,pw;
- char *b;
- long r;
+DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0);
- massert(b=alloca(r));
+ check_type_string(&x);
- massert(!getpwuid_r(uid,&pw,b,r,&pwent));
+ coerce_to_filename(x,FN1);
- RETURN1(make_simple_string(pwent->pw_name));
+ RETURN1(mkdir(FN1
+#ifndef __MINGW32__
+ ,01777
+#endif
+ ) ? Cnil : Ct);
}
-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") {
+DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
+ check_type_string(&x);
- struct passwd *pwent,pw;
- char *b;
- long r;
+ coerce_to_filename(x,FN1);
- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0);
- massert(b=alloca(r));
+ RETURN1(rmdir(FN1) ? Cnil : Ct);
- if (nm->st.st_fillp==1)
+}
- if ((pw.pw_dir=getenv("HOME")))
- pwent=&pw;
- else
- massert(!getpwuid_r(getuid(),&pw,b,r,&pwent));
+DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,"");
- else {
+#ifdef _WIN32
- char *name;
+void *
+get_mmap(FILE *fp,void **ve) {
- massert(name=alloca(nm->st.st_fillp));
- memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1);
- name[nm->st.st_fillp-1]=0;
+ int n;
+ void *st;
+ size_t sz;
+ HANDLE handle;
+
+ massert((sz=file_len(fp))>0);
+ if (sSAload_with_freadA->s.s_dbind==Cnil) {
+ n=fileno(fp);
+ massert((n=fileno(fp))>2);
+ massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL));
+ massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz));
+ CloseHandle(handle);
+ } else {
+ massert(st=malloc(sz));
+ massert(fread(st,sz,1,fp)==1);
+ }
- massert(!getpwnam_r(name,&pw,b,r,&pwent));
+ *ve=st+sz;
- }
+ return st;
+
+}
- massert((b=alloca(strlen(pwent->pw_dir)+2)));
- memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir));
- b[strlen(pwent->pw_dir)]='/';
- b[strlen(pwent->pw_dir)+1]=0;
- RETURN1(make_simple_string(b));
+int
+un_mmap(void *v1,void *ve) {
+
+ if (sSAload_with_freadA->s.s_dbind==Cnil)
+ return UnmapViewOfFile(v1) ? 0 : -1;
+ else {
+ free(v1);
+ return 0;
+ }
}
-DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
- check_type_string(&x);
- check_type_string(&y);
+#else
- coerce_to_filename(x,FN1);
- coerce_to_filename(y,FN2);
+#include <sys/mman.h>
- RETURN1(rename(FN1,FN2) ? Cnil : Ct);
+void *
+get_mmap(FILE *fp,void **ve) {
+
+ int n;
+ void *v1;
+ struct stat ss;
+
+ massert((n=fileno(fp))>2);
+ massert(!fstat(n,&ss));
+ if (sSAload_with_freadA->s.s_dbind==Cnil) {
+ massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1);
+ } else {
+ massert(v1=malloc(ss.st_size));
+ massert(fread(v1,ss.st_size,1,fp)==1);
+ }
+
+ *ve=v1+ss.st_size;
+ return v1;
}
-DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
- coerce_to_filename(x,FN1);
+int
+un_mmap(void *v1,void *ve) {
- RETURN1(unlink(FN1) ? Cnil : Ct);
+ if (sSAload_with_freadA->s.s_dbind==Cnil)
+ return munmap(v1,ve-v1);
+ else {
+ free(v1);
+ return 0;
+ }
}
+#endif
-static void
-FFN(siLchdir)(void)
-{
- char filename[MAXPATHLEN];
-
- check_arg(1);
- check_type_or_pathname_string_symbol_stream(&vs_base[0]);
- coerce_to_filename(vs_base[0], filename);
-
- if (chdir(filename) < 0)
- FEerror("Can't change the current directory to ~S.",
- 1, vs_base[0]);
+/* export these for AXIOM */
+int gcl_putenv(char *s) {return putenv(s);}
+char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);}
+char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/
+#ifdef __MINGW32__
+#define uid_t int
+#endif
+uid_t gcl_geteuid(void) {
+#ifndef __MINGW32__
+ return geteuid();
+#else
+ return 0;
+#endif
+}
+uid_t gcl_getegid(void) {
+#ifndef __MINGW32__
+ return getegid();
+#else
+ return 0;
+#endif
}
+int gcl_dup2(int o,int n) {return dup2(o,n);}
+char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);}
+int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;}
+
+int gcl_feof(void *v) {return feof(((FILE *)v));}
+int gcl_getc(void *v) {return getc(((FILE *)v));}
+int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));}
void
gcl_init_unixfsys(void) {
-
- make_si_function("CHDIR", siLchdir);
-
}
--- gcl-2.6.12.orig/o/unixsys.c
+++ gcl-2.6.12/o/unixsys.c
@@ -235,89 +235,6 @@ DEFUN_NEW("GETPID",object,fSgetpid,SI,0,
}
-DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,"");
-
-#ifdef _WIN32
-
-void *
-get_mmap(FILE *fp,void **ve) {
-
- int n;
- void *st;
- size_t sz;
- HANDLE handle;
-
- massert((sz=file_len(fp))>0);
- if (sSAload_with_freadA->s.s_dbind==Cnil) {
- n=fileno(fp);
- massert((n=fileno(fp))>2);
- massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL));
- massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz));
- CloseHandle(handle);
- } else {
- massert(st=malloc(sz));
- massert(fread(st,sz,1,fp)==1);
- }
-
- *ve=st+sz;
-
- return st;
-
-}
-
-int
-un_mmap(void *v1,void *ve) {
-
- if (sSAload_with_freadA->s.s_dbind==Cnil)
- return UnmapViewOfFile(v1) ? 0 : -1;
- else {
- free(v1);
- return 0;
- }
-
-}
-
-
-#else
-
-#include <sys/mman.h>
-
-void *
-get_mmap(FILE *fp,void **ve) {
-
- int n;
- void *v1;
- struct stat ss;
-
- massert((n=fileno(fp))>2);
- massert(!fstat(n,&ss));
- if (sSAload_with_freadA->s.s_dbind==Cnil) {
- massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1);
- } else {
- massert(v1=malloc(ss.st_size));
- massert(fread(v1,ss.st_size,1,fp)==1);
- }
-
- *ve=v1+ss.st_size;
- return v1;
-
-}
-
-
-int
-un_mmap(void *v1,void *ve) {
-
- if (sSAload_with_freadA->s.s_dbind==Cnil)
- return munmap(v1,ve-v1);
- else {
- free(v1);
- return 0;
- }
-
-}
-
-#endif
-
void
gcl_init_unixsys(void) {