diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/Makefile | 5 | ||||
| -rw-r--r-- | stdlib/filename.ml | 292 | ||||
| -rw-r--r-- | stdlib/header.c | 56 | ||||
| -rw-r--r-- | stdlib/sys.mli | 2 |
4 files changed, 188 insertions, 167 deletions
diff --git a/stdlib/Makefile b/stdlib/Makefile index 83a41085b..6c4cdd084 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -72,8 +72,9 @@ camlheader camlheader_ur: header.c ../config/Makefile echo '#!$(BINDIR)/ocamlrun' > camlheader && \ echo '#!' | tr -d '\012' > camlheader_ur; \ else \ - $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -DRUNTIME_NAME='"$(BINDIR)/ocamlrun"' header.c -o camlheader && \ - strip camlheader && \ + $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -DRUNTIME_NAME='"$(BINDIR)/ocamlrun"' header.c -o tmpheader$(EXE) && \ + strip tmpheader$(EXE) && \ + mv tmpheader$(EXE) camlheader && \ cp camlheader camlheader_ur; \ fi diff --git a/stdlib/filename.ml b/stdlib/filename.ml index e80389c2e..1547d4ace 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -12,181 +12,145 @@ (* $Id$ *) -let (current_dir_name, parent_dir_name) = - match Sys.os_type with - | "Unix" -> (".", "..") - | "Win32" -> (".", "..") - | "MacOS" -> (":", "::") - | _ -> assert false -;; - -let unix_concat dirname filename = - let l = String.length dirname in - if l = 0 or dirname.[l-1] = '/' - then dirname ^ filename - else dirname ^ "/" ^ filename - -let wnt_concat dirname filename = - let l = String.length dirname in - if l = 0 or (let c = dirname.[l-1] in c = '/' or c = '\\' or c = ':') - then dirname ^ filename - else dirname ^ "\\" ^ filename - -let mac_concat dirname filename = - let l = String.length dirname in - if l = 0 or dirname.[l-1] = ':' - then dirname ^ filename - else dirname ^ ":" ^ filename - -let concat = - match Sys.os_type with - | "Unix" -> unix_concat - | "Win32" -> wnt_concat - | "MacOS" -> mac_concat - | _ -> assert false - -let unix_is_relative n = String.length n < 1 || n.[0] <> '/';; - -let unix_is_implicit n = - unix_is_relative n - && (String.length n < 2 || String.sub n 0 2 <> "./") - && (String.length n < 3 || String.sub n 0 3 <> "../") -;; - -let wnt_is_relative n = - (String.length n < 1 || n.[0] <> '/') - && (String.length n < 1 || n.[0] <> '\\') - && (String.length n < 2 || n.[1] <> ':') -;; - -let wnt_is_implicit n = - wnt_is_relative n - && (String.length n < 2 || String.sub n 0 2 <> "./") - && (String.length n < 2 || String.sub n 0 2 <> ".\\") - && (String.length n < 3 || String.sub n 0 3 <> "../") - && (String.length n < 3 || String.sub n 0 3 <> "..\\") -;; - -let contains_colon n = String.contains n ':' ;; - -let mac_is_relative n = - (String.length n >= 1 && n.[0] = ':') - || not (contains_colon n) -;; - -let mac_is_implicit n = not (contains_colon n);; - -let (is_relative, is_implicit) = - match Sys.os_type with - | "Unix" -> (unix_is_relative, unix_is_implicit) - | "Win32" -> (wnt_is_relative, wnt_is_implicit) - | "MacOS" -> (mac_is_relative, mac_is_implicit) - | _ -> assert false - -let unix_check_suffix name suff = - String.length name >= String.length suff && - String.sub name (String.length name - String.length suff) (String.length suff) - = suff - -let wnt_check_suffix name suff = - String.length name >= String.length suff && - (let s = String.sub name (String.length name - String.length suff) - (String.length suff) in - String.lowercase s = String.lowercase suff) - -let mac_check_suffix = unix_check_suffix - -let check_suffix = +module Unix = struct + let current_dir_name = "." + let parent_dir_name = ".." + let concat dirname filename = + let l = String.length dirname in + if l = 0 or dirname.[l-1] = '/' + then dirname ^ filename + else dirname ^ "/" ^ filename + let is_relative n = String.length n < 1 || n.[0] <> '/';; + let is_implicit n = + is_relative n + && (String.length n < 2 || String.sub n 0 2 <> "./") + && (String.length n < 3 || String.sub n 0 3 <> "../") + let check_suffix name suff = + String.length name >= String.length suff && + String.sub name (String.length name - String.length suff) + (String.length suff) = suff + let basename name = + try + let p = String.rindex name '/' + 1 in + String.sub name p (String.length name - p) + with Not_found -> + name + let dirname name = + try + match String.rindex name '/' with + 0 -> "/" + | n -> String.sub name 0 n + with Not_found -> + "." + let temporary_directory = + try Sys.getenv "TMPDIR" with Not_found -> "/tmp" +end + +module Win32 = struct + let current_dir_name = "." + let parent_dir_name = ".." + let concat dirname filename = + let l = String.length dirname in + if l = 0 or (let c = dirname.[l-1] in c = '/' or c = '\\' or c = ':') + then dirname ^ filename + else dirname ^ "\\" ^ filename + let is_relative n = + (String.length n < 1 || n.[0] <> '/') + && (String.length n < 1 || n.[0] <> '\\') + && (String.length n < 2 || n.[1] <> ':') + let is_implicit n = + is_relative n + && (String.length n < 2 || String.sub n 0 2 <> "./") + && (String.length n < 2 || String.sub n 0 2 <> ".\\") + && (String.length n < 3 || String.sub n 0 3 <> "../") + && (String.length n < 3 || String.sub n 0 3 <> "..\\") + let check_suffix name suff = + String.length name >= String.length suff && + (let s = String.sub name (String.length name - String.length suff) + (String.length suff) in + String.lowercase s = String.lowercase suff) + let rindexsep s = + let rec pos i = + if i < 0 then raise Not_found + else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i + else pos (i - 1) + in pos (String.length s - 1) + let basename name = + try + let p = rindexsep name + 1 in + String.sub name p (String.length name - p) + with Not_found -> + name + let dirname name = + try + match rindexsep name with + 0 -> "\\" + | n -> + let n = + if name.[n] = ':' || (n > 0 && name.[n-1] = ':') + then n+1 else n in + String.sub name 0 n + with Not_found -> + "." + let temporary_directory = + try Sys.getenv "TEMP" with Not_found -> "C:\\temp" +end + +module MacOS = struct + let current_dir_name = "." + let parent_dir_name = ".." + let concat dirname filename = + let l = String.length dirname in + if l = 0 or dirname.[l-1] = ':' + then dirname ^ filename + else dirname ^ ":" ^ filename + let contains_colon n = String.contains n ':' + let is_relative n = + (String.length n >= 1 && n.[0] = ':') + || not (contains_colon n) + let is_implicit n = not (contains_colon n) + let check_suffix = Unix.check_suffix + let basename name = + try + let p = String.rindex name ':' + 1 in + String.sub name p (String.length name - p) + with Not_found -> name + let dirname name = + try match String.rindex name ':' with + | 0 -> ":" + | n -> String.sub name 0 n + with Not_found -> ":" + let temporary_directory = + try Sys.getenv "TempFolder" with Not_found -> ":" +end + +let (current_dir_name, parent_dir_name, concat, is_relative, is_implicit, + check_suffix, basename, dirname, temporary_directory) = match Sys.os_type with - | "Unix" -> unix_check_suffix - | "Win32" -> wnt_check_suffix - | "MacOS" -> mac_check_suffix + "Unix" | "Cygwin" -> + (Unix.current_dir_name, Unix.parent_dir_name, Unix.concat, + Unix.is_relative, Unix.is_implicit, Unix.check_suffix, + Unix.basename, Unix.dirname, Unix.temporary_directory) + | "Win32" -> + (Win32.current_dir_name, Win32.parent_dir_name, Win32.concat, + Win32.is_relative, Win32.is_implicit, Win32.check_suffix, + Win32.basename, Win32.dirname, Win32.temporary_directory) + | "MacOS" -> + (MacOS.current_dir_name, MacOS.parent_dir_name, MacOS.concat, + MacOS.is_relative, MacOS.is_implicit, MacOS.check_suffix, + MacOS.basename, MacOS.dirname, MacOS.temporary_directory) | _ -> assert false let chop_suffix name suff = let n = String.length name - String.length suff in if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n -let wnt_rindexsep s = - let rec pos i = - if i < 0 then raise Not_found - else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i - else pos (i - 1) - in pos (String.length s - 1) - let chop_extension name = try String.sub name 0 (String.rindex name '.') with Not_found -> invalid_arg "Filename.chop_extension" -let unix_basename name = - try - let p = String.rindex name '/' + 1 in - String.sub name p (String.length name - p) - with Not_found -> - name - -let unix_dirname name = - try - match String.rindex name '/' with - 0 -> "/" - | n -> String.sub name 0 n - with Not_found -> - "." - -let wnt_basename name = - try - let p = wnt_rindexsep name + 1 in - String.sub name p (String.length name - p) - with Not_found -> - name - -let wnt_dirname name = - try - match wnt_rindexsep name with - 0 -> "\\" - | n -> - let n = - if name.[n] = ':' || (n > 0 && name.[n-1] = ':') - then n+1 else n in - String.sub name 0 n - with Not_found -> - "." - -let mac_basename name = - try - let p = String.rindex name ':' + 1 in - String.sub name p (String.length name - p) - with Not_found -> name - -let mac_dirname name = - try match String.rindex name ':' with - | 0 -> ":" - | n -> String.sub name 0 n - with Not_found -> ":" - -let basename = - match Sys.os_type with - | "Unix" -> unix_basename - | "Win32" -> wnt_basename - | "MacOS" -> mac_basename - | _ -> assert false - -let dirname = - match Sys.os_type with - | "Unix" -> unix_dirname - | "Win32" -> wnt_dirname - | "MacOS" -> mac_dirname - | _ -> assert false - -let temporary_directory = - match Sys.os_type with - | "Unix" -> (try Sys.getenv "TMPDIR" with Not_found -> "/tmp") - | "Win32" -> (try Sys.getenv "TEMP" with Not_found -> "C:\\temp") - | "MacOS" -> (try Sys.getenv "TempFolder" with Not_found -> ":") - | _ -> assert false - external open_desc: string -> open_flag list -> int -> int = "sys_open" external close_desc: int -> unit = "sys_close" @@ -206,7 +170,8 @@ let temp_file prefix suffix = in try_name 0 let quote s = - let quotequote = match Sys.os_type with "MacOS" -> "'\182''" | _ -> "'\\''" in + let quotequote = + match Sys.os_type with "MacOS" -> "'\182''" | _ -> "'\\''" in let l = String.length s in let b = Buffer.create (l + 20) in Buffer.add_char b '\''; @@ -217,4 +182,3 @@ let quote s = done; Buffer.add_char b '\''; Buffer.contents b -;; diff --git a/stdlib/header.c b/stdlib/header.c index d1a3bffac..1fb0bfbf3 100644 --- a/stdlib/header.c +++ b/stdlib/header.c @@ -29,7 +29,9 @@ char * default_runtime_path = RUNTIME_NAME; +#ifndef MAXPATHLEN #define MAXPATHLEN 1024 +#endif #ifndef S_ISREG #define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) @@ -39,6 +41,10 @@ char * default_runtime_path = RUNTIME_NAME; #define SEEK_END 2 #endif +#ifndef __CYGWIN32__ + +/* Normal Unix search path function */ + static char * searchpath(char * name) { static char fullname[MAXPATHLEN + 1]; @@ -67,6 +73,55 @@ static char * searchpath(char * name) return fullname; } +#else + +/* Special version for Cygwin32: takes care of the ".exe" implicit suffix */ + +static int file_ok(char * name) +{ + int fd; + /* Cannot use stat() here because it adds ".exe" implicitly */ + fd = open(name, O_RDONLY); + if (fd == -1) return 0; + close(fd); + return 1; +} + +static char * searchpath(char * name) +{ + char * path, * fullname, * p; + + path = getenv("PATH"); + fullname = malloc(strlen(name) + (path == NULL ? 0 : strlen(path)) + 6); + /* 6 = "/" plus ".exe" plus final "\0" */ + if (fullname == NULL) return name; + /* Check for absolute path name */ + for (p = name; *p != 0; p++) { + if (*p == '/' || *p == '\\') { + if (file_ok(name)) return name; + strcpy(fullname, name); + strcat(fullname, ".exe"); + if (file_ok(fullname)) return fullname; + return name; + } + } + /* Search in path */ + if (path == NULL) return name; + while(1) { + for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path; + if (p != fullname) *p++ = '/'; + strcpy(p, name); + if (file_ok(fullname)) return fullname; + strcat(fullname, ".exe"); + if (file_ok(fullname)) return fullname; + if (*path == 0) break; + path++; + } + return name; +} + +#endif + static unsigned long read_size(char * ptr) { unsigned char * p = (unsigned char *) ptr; @@ -122,6 +177,7 @@ int main(int argc, char ** argv) errwrite(" not found or is not a bytecode executable file\n"); return 2; } + argv[0] = truename; execv(runtime_path, argv); errwrite("Cannot exec "); errwrite(runtime_path); diff --git a/stdlib/sys.mli b/stdlib/sys.mli index ad10484d6..cb493f77f 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -44,7 +44,7 @@ val interactive: bool ref the interactive toplevel system [ocaml]. *) val os_type: string (* Operating system currently executing the Caml program. - One of ["Unix"], ["Win32"], or ["MacOS"]. *) + One of ["Unix"], ["Win32"], ["Cygwin"] or ["MacOS"]. *) val word_size: int (* Size of one word on the machine currently executing the Caml program, in bits: 32 or 64. *) |