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