From d6452b708e92d88fc510c27e2b955fda799f8db2 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Thu, 20 Dec 2001 17:20:18 +0000 Subject: [PATCH] Implement si::mkdir and FEfilesystem_error. Simplify other error handlers. --- src/c/all_functions.d | 1 + src/c/error.d | 58 ++++++----------------------- src/c/main.d | 3 +- src/c/unixfsys.d | 86 ++++++++++++++++++++++++++++++++++++------- src/h/external.h | 1 + src/h/lisp_external.h | 1 + 6 files changed, 89 insertions(+), 61 deletions(-) diff --git a/src/c/all_functions.d b/src/c/all_functions.d index 0c1b75ce7..9808f0f33 100644 --- a/src/c/all_functions.d +++ b/src/c/all_functions.d @@ -827,6 +827,7 @@ const struct function_info all_functions[] = { {"STRING-MATCH", siLstring_match, si}, {"DIRECTORY", clLdirectory, cl}, {"CHDIR", siLchdir, si}, + {"MKDIR", siLmkdir, si}, /* unixsys.c */ diff --git a/src/c/error.d b/src/c/error.d index 37f6cac5d..087608881 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -93,31 +93,24 @@ void FEerror(char *s, int narg, ...) { va_list args; - cl_object rest = Cnil, *r = &rest; - va_start(args, narg); - while (narg--) - r = &CDR(*r = CONS(va_arg(args, cl_object), Cnil)); funcall(4, @'si::universal-error-handler', Cnil, /* not correctable */ make_constant_string(s), /* condition text */ - rest); + va_grab_rest_args(narg, args)); + va_end(args); } cl_object CEerror(char *err, int narg, ...) { - int i = narg; va_list args; - cl_object rest = Cnil, *r = &rest; - va_start(args, narg); - while (i--) - r = &CDR(*r = CONS(va_arg(args, cl_object), Cnil)); return funcall(4, @'si::universal-error-handler', Ct, /* correctable */ make_constant_string(err), /* continue-format-string */ - rest); + va_grab_rest_args(narg, args)); + va_end(args); } /*********************** @@ -128,54 +121,39 @@ void FEcondition(int narg, cl_object name, ...) { va_list args; - cl_object rest = Cnil, *r = &rest; - va_start(args, name); - while (--narg) { - *r = CONS(va_arg(args, cl_object), Cnil); - r = &CDR(*r); - } funcall(4, @'si::universal-error-handler', Cnil, /* not correctable */ name, /* condition name */ - rest); + va_grab_rest_args(--narg, args)); + va_end(args); } void FEprogram_error(const char *s, int narg, ...) { va_list args; - cl_object rest = Cnil, *r = &rest; - gc(t_contiguous); va_start(args, narg); - while (narg--) { - *r = CONS(va_arg(args, cl_object), Cnil); - r = &CDR(*r); - } funcall(4, @'si::universal-error-handler', Cnil, /* not correctable */ @'si::simple-program-error', /* condition name */ list(4, @':format-control', make_constant_string(s), - @':format-arguments', rest)); + @':format-arguments', va_grab_rest_args(narg, args))); + va_end(args); } void FEcontrol_error(const char *s, int narg, ...) { va_list args; - cl_object rest = Cnil, *r = &rest; - va_start(args, narg); - while (narg--) { - *r = CONS(va_arg(args, cl_object), Cnil); - r = &CDR(*r); - } funcall(4, @'si::universal-error-handler', Cnil, /* not correctable */ @'si::simple-control-error', /* condition name */ list(4, @':format-control', make_constant_string(s), - @':format-arguments', rest)); + @':format-arguments', va_grab_rest_args(narg, args))); + va_end(args); } void @@ -299,31 +277,19 @@ not_a_variable(cl_object obj) ************************************/ @(defun error (eformat &rest args) - int i; - cl_object rest = Cnil, *r = &rest; @ - for (i=narg-1; i; i--) { - *r = CONS(va_arg(args, cl_object), Cnil); - r = &CDR(*r); - } funcall(4, @'si::universal-error-handler', Cnil, eformat, - rest); + va_grab_rest_args(narg-1, args)); @) @(defun cerror (cformat eformat &rest args) - int i; - cl_object rest = Cnil, *r = &rest; @ - for (i=narg-2; i; i--) { - *r = CONS(va_arg(args, cl_object), Cnil); - r = &CDR(*r); - } return(funcall(4, @'si::universal-error-handler', cformat, eformat, - rest)); + va_grab_rest_args(narg-2, args))); @) void diff --git a/src/c/main.d b/src/c/main.d index 5da4423d5..f0787340a 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -133,8 +133,7 @@ cl_boot(int argc, char **argv) @) @(defun si::getenv (var) - char name[256], *value; - cl_index i; + const char *value; @ assert_type_string(var); value = getenv(var->string.self); diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 40e0df438..1f9d7dd0f 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -14,6 +14,7 @@ See file '../Copyright' for full details. */ +#include #include #include #include @@ -23,11 +24,55 @@ #ifdef BSD #include #else -#include "" +#include #endif cl_object @':list-all'; +/* + * Interprets an error code from the C library according to the POSIX + * standard, and produces a suitable error message by combining the user + * supplied format with an explanation of the cause of the error. + */ +void +FEfilesystem_error(const char *msg, int narg, ...) +{ + va_list args; + cl_object rest; + const char *extra_msg; + + va_start(args, narg); + rest = va_grab_rest_args(narg, args); + va_end(args); + + switch (errno) { + case EPERM: + case EACCES: + case EROFS: + extra_msg = "Insufficient permissions"; + break; + case EEXIST: + extra_msg = "Already exists"; + break; + case ENAMETOOLONG: + extra_msg = "File or directory name too long"; + break; + case ENOENT: + case ENOTDIR: + case ELOOP: + extra_msg = "Invalid or not existent path"; + break; + case ENOSPC: + extra_msg = "Not enough space or quota exceeded"; + break; + default: + extra_msg = "Uknown reason"; + break; + } + FEerror("~?~%Explanation: ~A.", 3, make_constant_string(msg), rest, + make_constant_string(extra_msg)); +} + /* * string_to_pathanme, to be used when s is a real pathname */ @@ -98,8 +143,8 @@ get_file_system_type(const char *namestring) { */ static cl_object error_no_dir(cl_object pathname) { - FEerror("truedirectory: does not exist or cannot be accessed",1,pathname); - return OBJNULL; + FEfilesystem_error("truedirectory: ~S cannot be accessed", 1, pathname); + return Cnil; } cl_object @@ -225,7 +270,8 @@ file_len(FILE *fp) filename = coerce_to_filename(oldn); newfilename = coerce_to_filename(newn); if (rename(filename->string.self, newfilename->string.self) < 0) - FEerror("Cannot rename the file ~S to ~S.", 2, oldn, newn); + FEfilesystem_error("Cannot rename the file ~S to ~S.", 2, + oldn, newn); new_truename = truename(newn); @(return newn old_truename new_truename) @) @@ -236,7 +282,7 @@ file_len(FILE *fp) /* INV: coerce_to_filename() checks types */ filename = coerce_to_filename(file); if (unlink(filename->string.self) < 0) - FEerror("Cannot delete the file ~S.", 1, file); + FEfilesystem_error("Cannot delete the file ~S.", 1, file); @(return Ct) @) @@ -270,7 +316,8 @@ file_len(FILE *fp) /* INV: coerce_to_filename() checks types */ filename = coerce_to_filename(file); if (stat(filename->string.self, &filestatus) < 0) - FEerror("Cannot get the file status of ~S.", 1, file); + FEfilesystem_error("Cannot get the file status of ~S.", 1, + file); pwent = getpwuid(filestatus.st_uid); @(return make_string_copy(pwent->pw_name)) @) @@ -433,12 +480,12 @@ actual_directory(cl_object namestring, cl_object mask, bool all) if (chdir(namestring->string.self) < 0) { chdir(saved_dir->string.self); - FEerror("directory: cannot access ~A",1,namestring); + FEfilesystem_error("directory: cannot access ~A", 1, namestring); } dir = opendir("."); if (dir == NULL) { chdir(saved_dir->string.self); - FEerror("Can't open the directory ~S.", 1, dir); + FEfilesystem_error("Can't open the directory ~S.", 1, dir); } while ((entry = readdir(dir))) { @@ -462,12 +509,12 @@ actual_directory(cl_object namestring, cl_object mask, bool all) if (chdir(namestring->string.self) < 0) { chdir(saved_dir->string.self); - FEerror("directory: cannot access ~A",1,namestring); + FEfilesystem_error("directory: cannot access ~A",1,namestring); } fp = fopen(".", OPEN_R); if (fp == NULL) { chdir(saved_dir->string.self); - FEerror("Can't open the directory ~S.", 1, dir); + FEfilesystem_error("Can't open the directory ~S.", 1, dir); } setbuf(fp, iobuffer); @@ -549,12 +596,25 @@ actual_directory(cl_object namestring, cl_object mask, bool all) /* INV: coerce_to_filename() checks types */ filename = coerce_to_filename(directory); previous = current_dir(); - if (chdir(filename->string.self) < 0) - FEerror("Can't change the current directory to ~S.", - 1, directory); + if (chdir(filename->string.self) < 0) { + FEfilesystem_error("Can't change the current directory to ~S", + 1, filename); + } @(return previous) @) +@(defun si::mkdir (directory) + cl_object filename; +@ + /* INV: coerce_to_filename() checks types */ + filename = coerce_to_filename(directory); + if (mkdir(filename->string.self, 0777) < 0) { + FEfilesystem_error("Could not create directory ~S", 1, + filename); + } + @(return filename) +@) + #ifdef sun4sol2 /* These functions can't be used with static linking on Solaris */ struct passwd * diff --git a/src/h/external.h b/src/h/external.h index effb52e83..184875d4d 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -907,6 +907,7 @@ extern FILE *backup_fopen(const char *filename, const char *option); extern int file_len(FILE *fp); extern cl_object homedir_pathname(cl_object user); extern void init_unixfsys(void); +extern void FEfilesystem_error(const char *msg, int narg, ...); /* unixint.c */ diff --git a/src/h/lisp_external.h b/src/h/lisp_external.h index 1adbcd63a..b2b39b07b 100644 --- a/src/h/lisp_external.h +++ b/src/h/lisp_external.h @@ -1025,6 +1025,7 @@ extern cl_object clLfile_write_date _ARGS((int narg, cl_object file)); extern cl_object clLfile_author _ARGS((int narg, cl_object file)); extern cl_object clLuser_homedir_pathname _ARGS((int narg, ...)); extern cl_object siLchdir _ARGS((int narg, cl_object directory)); +extern cl_object siLmkdir _ARGS((int narg, cl_object directory)); extern cl_object siLstring_match _ARGS((int narg, cl_object string, cl_object pattern)); extern cl_object clLdirectory _ARGS((int narg, ...));