From: Chris Hanson Date: Wed, 9 May 2001 03:15:14 +0000 (+0000) Subject: Implement new primitives FILE-TYPE-DIRECT and FILE-TYPE-INDIRECT. X-Git-Tag: 20090517-FFI~2840 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=082ec775dd66449beea52f170c968c4861a018ec;p=mit-scheme.git Implement new primitives FILE-TYPE-DIRECT and FILE-TYPE-INDIRECT. --- diff --git a/v7/src/microcode/ntfs.c b/v7/src/microcode/ntfs.c index 11f09c66a..46a547694 100644 --- a/v7/src/microcode/ntfs.c +++ b/v7/src/microcode/ntfs.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: ntfs.c,v 1.26 2000/12/05 21:23:45 cph Exp $ +$Id: ntfs.c,v 1.27 2001/05/09 03:14:54 cph Exp $ -Copyright (c) 1992-2000 Massachusetts Institute of Technology +Copyright (c) 1992-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ #include "nt.h" @@ -29,12 +30,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #endif static enum get_file_info_result get_file_info_from_dir - (const char *, BY_HANDLE_FILE_INFORMATION *); + (const char *, BY_HANDLE_FILE_INFORMATION *, int); static int valid_drive_p (const char *); static HANDLE create_file_for_info (const char *); enum get_file_info_result -NT_get_file_info (const char * namestring, BY_HANDLE_FILE_INFORMATION * info) +NT_get_file_info (const char * namestring, BY_HANDLE_FILE_INFORMATION * info, + int inaccessible_ok) { char nscopy [MAX_PATH]; HANDLE hfile; @@ -52,7 +54,7 @@ NT_get_file_info (const char * namestring, BY_HANDLE_FILE_INFORMATION * info) if (STAT_NOT_FOUND_P (code)) return (gfi_not_found); if (STAT_NOT_ACCESSIBLE_P (code)) - return (get_file_info_from_dir (nscopy, info)); + return (get_file_info_from_dir (nscopy, info, inaccessible_ok)); NT_error_api_call (code, apicall_CreateFile); } if (!GetFileInformationByHandle (hfile, info)) @@ -61,7 +63,7 @@ NT_get_file_info (const char * namestring, BY_HANDLE_FILE_INFORMATION * info) (void) CloseHandle (hfile); if (STAT_NOT_FOUND_P (code)) return (gfi_not_found); - if (STAT_NOT_ACCESSIBLE_P (code)) + if (inaccessible_ok && (STAT_NOT_ACCESSIBLE_P (code))) return (gfi_not_accessible); NT_error_api_call (code, apicall_GetFileInformationByHandle); } @@ -74,7 +76,8 @@ NT_get_file_info (const char * namestring, BY_HANDLE_FILE_INFORMATION * info) is available by reading the directory. More M$ bullshit. */ static enum get_file_info_result get_file_info_from_dir (const char * namestring, - BY_HANDLE_FILE_INFORMATION * info) + BY_HANDLE_FILE_INFORMATION * info, + int inaccessible_ok) { WIN32_FIND_DATA fi; HANDLE handle = (FindFirstFile (namestring, (&fi))); @@ -109,7 +112,7 @@ get_file_info_from_dir (const char * namestring, else return (gfi_not_found); } - if (STAT_NOT_ACCESSIBLE_P (code)) + if (inaccessible_ok && (STAT_NOT_ACCESSIBLE_P (code))) return (gfi_not_accessible); NT_error_api_call (code, apicall_FindFirstFile); } @@ -160,7 +163,7 @@ OS_file_existence_test (const char * name) { BY_HANDLE_FILE_INFORMATION info; return - (((NT_get_file_info (name, (&info))) == gfi_ok) + (((NT_get_file_info (name, (&info), 1)) == gfi_ok) ? file_does_exist : file_doesnt_exist); } @@ -171,6 +174,24 @@ OS_file_existence_test_direct (const char * name) return (OS_file_existence_test (name)); } +enum file_type +OS_file_type_direct (const char * name) +{ + BY_HANDLE_FILE_INFORMATION info; + return + (((NT_get_file_info ((STRING_ARG (1)), (&info), 0)) == gfi_not_found) + ? file_type_nonexistent + : (((info . dwFileAttributes) & FILE_ATTRIBUTE_DIRECTORY) == 0) + ? file_type_regular + : file_type_directory); +} + +enum file_type +OS_file_type_indirect (const char * name) +{ + return (OS_file_type_direct (name)); +} + #define R_OK 4 #define W_OK 2 #define X_OK 1 @@ -179,7 +200,7 @@ int DEFUN (OS_file_access, (name, mode), CONST char * name AND unsigned int mode) { BY_HANDLE_FILE_INFORMATION info; - if ((NT_get_file_info (name, (&info))) != gfi_ok) + if ((NT_get_file_info (name, (&info), 1)) != gfi_ok) return (0); if (((mode & W_OK) != 0) && (((info . dwFileAttributes) & FILE_ATTRIBUTE_READONLY) != 0)) @@ -201,7 +222,7 @@ DEFUN (OS_file_directory_p, (name), CONST char * name) { BY_HANDLE_FILE_INFORMATION info; return - (((NT_get_file_info (name, (&info))) == gfi_ok) + (((NT_get_file_info (name, (&info), 0)) == gfi_ok) && (((info . dwFileAttributes) & FILE_ATTRIBUTE_DIRECTORY) != 0)); } diff --git a/v7/src/microcode/ntfs.h b/v7/src/microcode/ntfs.h index 615ddc5ef..a6ee8e019 100644 --- a/v7/src/microcode/ntfs.h +++ b/v7/src/microcode/ntfs.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: ntfs.h,v 1.4 1999/01/02 06:11:34 cph Exp $ +$Id: ntfs.h,v 1.5 2001/05/09 03:14:59 cph Exp $ -Copyright (c) 1997-1999 Massachusetts Institute of Technology +Copyright (c) 1997-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ #include "nt.h" @@ -25,7 +26,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. enum get_file_info_result { gfi_ok, gfi_not_found, gfi_not_accessible }; extern enum get_file_info_result NT_get_file_info - (const char *, BY_HANDLE_FILE_INFORMATION *); + (const char *, BY_HANDLE_FILE_INFORMATION *, int); #define STAT_NOT_FOUND_P(code) \ (((code) == ERROR_FILE_NOT_FOUND) \ diff --git a/v7/src/microcode/os2fs.c b/v7/src/microcode/os2fs.c index eedf50fc2..404868ada 100644 --- a/v7/src/microcode/os2fs.c +++ b/v7/src/microcode/os2fs.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: os2fs.c,v 1.12 2000/12/05 21:23:46 cph Exp $ +$Id: os2fs.c,v 1.13 2001/05/09 03:15:02 cph Exp $ -Copyright (c) 1994-2000 Massachusetts Institute of Technology +Copyright (c) 1994-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ #include "os2.h" @@ -106,6 +107,24 @@ OS_file_existence_test_direct (const char * filename) return (OS_file_existence_test (filename)); } +enum file_type +OS_file_type_direct (const char * filename) +{ + FILESTATUS3 * info = (OS2_read_file_status (STRING_ARG (1))); + return + ((info == 0) + ? file_type_nonexistent + : (((info -> attrFile) & FILE_DIRECTORY) == 0) + ? file_type_regular + : file_type_directory); +} + +enum file_type +OS_file_type_indirect (const char * filename) +{ + return (OS_file_type_direct (filename)); +} + #define R_OK 4 #define W_OK 2 #define X_OK 1 diff --git a/v7/src/microcode/osfs.h b/v7/src/microcode/osfs.h index e407bf62d..864fbbbfa 100644 --- a/v7/src/microcode/osfs.h +++ b/v7/src/microcode/osfs.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: osfs.h,v 1.9 2000/12/05 21:23:47 cph Exp $ +$Id: osfs.h,v 1.10 2001/05/09 03:15:05 cph Exp $ -Copyright (c) 1990-2000 Massachusetts Institute of Technology +Copyright (c) 1990-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ #ifndef SCM_OSFS_H @@ -26,9 +27,26 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. enum file_existence { file_does_exist, file_doesnt_exist, file_is_link }; +enum file_type +{ + file_type_nonexistent = (-1), + file_type_regular = 0, + file_type_directory, + file_type_unix_symbolic_link, + file_type_unix_character_device, + file_type_unix_block_device, + file_type_unix_fifo, + file_type_unix_stream_socket, + file_type_os2_named_pipe, + file_type_win32_named_pipe, + file_type_unknown = 0xFFFF +}; + extern enum file_existence EXFUN (OS_file_existence_test, (CONST char * name)); extern enum file_existence EXFUN (OS_file_existence_test_direct, (CONST char * name)); +extern enum file_type EXFUN (OS_file_type_direct, (CONST char *)); +extern enum file_type EXFUN (OS_file_type_indirect, (CONST char *)); extern int EXFUN (OS_file_access, (CONST char * name, unsigned int mode)); extern int EXFUN (OS_file_directory_p, (CONST char * name)); extern CONST char * EXFUN (OS_file_soft_link_p, (CONST char * name)); diff --git a/v7/src/microcode/prntfs.c b/v7/src/microcode/prntfs.c index f224ce813..f5aa5893a 100644 --- a/v7/src/microcode/prntfs.c +++ b/v7/src/microcode/prntfs.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: prntfs.c,v 1.16 2000/12/05 21:23:47 cph Exp $ +$Id: prntfs.c,v 1.17 2001/05/09 03:15:08 cph Exp $ -Copyright (c) 1993-2000 Massachusetts Institute of Technology +Copyright (c) 1993-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ /* NT-specific file-system primitives. */ @@ -82,7 +83,7 @@ DEFINE_PRIMITIVE ("FILE-MODES", Prim_file_modes, 1, 1, { BY_HANDLE_FILE_INFORMATION info; PRIMITIVE_HEADER (1); - switch (NT_get_file_info ((STRING_ARG (1)), (&info))) + switch (NT_get_file_info ((STRING_ARG (1)), (&info), 0)) { case gfi_ok: PRIMITIVE_RETURN @@ -110,7 +111,7 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME", Prim_file_mod_time, 1, 1, 0) { BY_HANDLE_FILE_INFORMATION info; PRIMITIVE_HEADER (1); - switch (NT_get_file_info ((STRING_ARG (1)), (&info))) + switch (NT_get_file_info ((STRING_ARG (1)), (&info), 0)) { case gfi_ok: PRIMITIVE_RETURN @@ -249,7 +250,7 @@ the result is #F.") BY_HANDLE_FILE_INFORMATION info; PRIMITIVE_HEADER (1); Primitive_GC_If_Needed (MAX_ATTRIBUTES_ALLOCATION); - switch (NT_get_file_info ((STRING_ARG (1)), (&info))) + switch (NT_get_file_info ((STRING_ARG (1)), (&info), 1)) { case gfi_not_found: PRIMITIVE_RETURN (SHARP_F); diff --git a/v7/src/microcode/prosfs.c b/v7/src/microcode/prosfs.c index f1a3b4a97..3b6cb0889 100644 --- a/v7/src/microcode/prosfs.c +++ b/v7/src/microcode/prosfs.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: prosfs.c,v 1.15 2000/12/05 21:23:47 cph Exp $ +$Id: prosfs.c,v 1.16 2001/05/09 03:15:11 cph Exp $ -Copyright (c) 1987-2000 Massachusetts Institute of Technology +Copyright (c) 1987-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ /* Primitives to perform file-system operations. */ @@ -79,6 +80,34 @@ Signal an error if the file's existence is indeterminate.") } } +DEFINE_PRIMITIVE ("FILE-TYPE-DIRECT", Prim_file_type_direct, 1, 1, + "Return type of FILE, as an exact non-negative integer.\n\ +Don't indirect through symbolic links.") +{ + PRIMITIVE_HEADER (1); + { + enum file_type t = (OS_file_type_direct (STRING_ARG (1))); + PRIMITIVE_RETURN + ((t == file_type_nonexistent) + ? SHARP_F + : (ulong_to_integer ((unsigned long) t))); + } +} + +DEFINE_PRIMITIVE ("FILE-TYPE-INDIRECT", Prim_file_type_indirect, 1, 1, + "Return type of FILE, as an exact non-negative integer.\n\ +Indirect through symbolic links.") +{ + PRIMITIVE_HEADER (1); + { + enum file_type t = (OS_file_type_indirect (STRING_ARG (1))); + PRIMITIVE_RETURN + ((t == file_type_nonexistent) + ? SHARP_F + : (ulong_to_integer ((unsigned long) t))); + } +} + DEFINE_PRIMITIVE ("FILE-ACCESS", Prim_file_access, 2, 2, "Return #T iff FILENAME exists and is accessible according to MODE.\n\ MODE is an integer between 0 and 7 inclusive, bitwise encoded:\n\ diff --git a/v7/src/microcode/uxfs.c b/v7/src/microcode/uxfs.c index 4cc89c4a7..066f7a8e9 100644 --- a/v7/src/microcode/uxfs.c +++ b/v7/src/microcode/uxfs.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: uxfs.c,v 1.20 2000/12/05 21:23:49 cph Exp $ +$Id: uxfs.c,v 1.21 2001/05/09 03:15:14 cph Exp $ -Copyright (c) 1990-2000 Massachusetts Institute of Technology +Copyright (c) 1990-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. */ #include "ux.h" @@ -170,6 +171,59 @@ DEFUN (OS_file_existence_test_direct, (name), CONST char * name) #endif return (file_does_exist); } + +#ifndef S_ISREG +# define S_ISREG(mode) (((mode) & S_IFREG) != 0) +#endif +#ifndef S_ISDIR +# define S_ISDIR(mode) (((mode) & S_IFDIR) != 0) +#endif +#ifndef S_ISLNK +# define S_ISLNK(mode) (((mode) & S_IFLNK) != 0) +#endif +#ifndef S_ISCHR +# define S_ISCHR(mode) (((mode) & S_IFCHR) != 0) +#endif +#ifndef S_ISBLK +# define S_ISBLK(mode) (((mode) & S_IFBLK) != 0) +#endif +#ifndef S_ISFIFO +# define S_ISFIFO(mode) (((mode) & S_IFIFO) != 0) +#endif +#ifndef S_ISSOCK +# define S_ISSOCK(mode) (((mode) & S_IFSOCK) != 0) +#endif + +#define COMPUTE_FILE_TYPE(proc, name) \ +{ \ + struct stat s; \ + if (!proc ((name), (&s))) \ + return (file_type_nonexistent); \ + else if (S_ISREG (s . st_mode)) \ + return (file_type_regular); \ + else if (S_ISDIR (s . st_mode)) \ + return (file_type_directory); \ + else if (S_ISLNK (s . st_mode)) \ + return (file_type_unix_symbolic_link); \ + else if (S_ISCHR (s . st_mode)) \ + return (file_type_unix_character_device); \ + else if (S_ISBLK (s . st_mode)) \ + return (file_type_unix_block_device); \ + else if (S_ISFIFO (s . st_mode)) \ + return (file_type_unix_fifo); \ + else if (S_ISSOCK (s . st_mode)) \ + return (file_type_unix_stream_socket); \ + else \ + return (file_type_unknown); \ +} + +enum file_type +DEFUN (OS_file_type_direct, (name), CONST char * name) +COMPUTE_FILE_TYPE (UX_read_file_status, name) + +enum file_type +DEFUN (OS_file_type_indirect, (name), CONST char * name) +COMPUTE_FILE_TYPE (UX_read_file_status_indirect, name) CONST char * DEFUN (UX_file_system_type, (name), CONST char * name)