[refact] make stdlib consistent with ocaml/stdlib

jscomp/stdlib/.ignore

@@ -0,0 +1,8 @@
+camlheader
+target_camlheader
+camlheaderd
+target_camlheaderd
+camlheader_ur
+labelled-*
+caml
+sys.ml

jscomp/stdlib/Makefile.nt

@@ -0,0 +1,38 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 1999 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the GNU Library General Public License, with     #
+#   the special exception on linking described in file ../LICENSE.      #
+#                                                                       #
+#########################################################################
+
+include Makefile.shared
+
+allopt: stdlib.cmxa std_exit.cmx
+
+installopt:
+	cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(INSTALL_LIBDIR)
+
+camlheader target_camlheader camlheader_ur: headernt.c ../config/Makefile
+	$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
+	          -DRUNTIME_NAME='"ocamlrun"' headernt.c
+	$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
+	rm -f camlheader.exe
+	mv tmpheader.exe camlheader
+	cp camlheader target_camlheader
+	cp camlheader camlheader_ur
+
+camlheaderd target_camlheaderd: headernt.c ../config/Makefile
+	$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
+	          -DRUNTIME_NAME='"ocamlrund"' headernt.c
+	$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
+	mv tmpheader.exe camlheaderd
+	cp camlheaderd target_camlheaderd
+
+# TODO: do not call flexlink to build tmpheader.exe (we don't need
+# the export table)

jscomp/stdlib/StdlibModules

@@ -0,0 +1,67 @@
+# -*- Makefile -*-
+
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 2002 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the GNU Library General Public License, with     #
+#   the special exception on linking described in file ../LICENSE.      #
+#                                                                       #
+#########################################################################
+
+# This file lists all standard library modules.
+# It is used in particular to know what to expunge in toplevels.
+
+STDLIB_MODULES=\
+  arg \
+  array \
+  arrayLabels \
+  buffer \
+  bytes \
+  bytesLabels \
+  callback \
+  camlinternalFormat \
+  camlinternalFormatBasics \
+  camlinternalLazy \
+  camlinternalMod \
+  camlinternalOO \
+  char \
+  complex \
+  digest \
+  filename \
+  format \
+  gc \
+  genlex \
+  hashtbl \
+  int32 \
+  int64 \
+  lazy \
+  lexing \
+  list \
+  listLabels \
+  map \
+  marshal \
+  moreLabels \
+  nativeint \
+  obj \
+  oo \
+  parsing \
+  pervasives \
+  printexc \
+  printf \
+  queue \
+  random \
+  scanf \
+  set \
+  sort \
+  stack \
+  stdLabels \
+  stream \
+  string \
+  stringLabels \
+  sys \
+  weak

jscomp/stdlib/bytes.ml

@@ -122,7 +122,7 @@ let cat s1 s2 =
   r
 ;;
 
-external is_printable: char -> bool = "caml_is_printable"
+
 external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
@@ -151,7 +151,8 @@ let escaped s =
     n := !n +
       (match unsafe_get s i with
        | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
-       | c -> if is_printable c then 1 else 4)
+       | ' ' .. '~' -> 1
+       | _ ->  4)
   done;
   if !n = length s then copy s else begin
     let s' = create !n in
@@ -168,10 +169,8 @@ let escaped s =
           unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
       | '\b' ->
           unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
+      | (' ' .. '~') as c -> unsafe_set s' !n c
       | c ->
-          if is_printable c then
-            unsafe_set s' !n c
-          else begin
             let a = char_code c in
             unsafe_set s' !n '\\';
             incr n;
@@ -180,7 +179,7 @@ let escaped s =
             unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
             incr n;
             unsafe_set s' !n (char_chr (48 + a mod 10))
-          end
+
       end;
       incr n
     done;

jscomp/stdlib/char.ml

@@ -19,9 +19,13 @@ external unsafe_chr: int -> char = "%char_of_int"
 let chr n =
   if n < 0 || n > 255 then invalid_arg "Char.chr" else unsafe_chr n
 
-external is_printable: char -> bool = "caml_is_printable"
 
-external string_of_char_array : char array -> string = "caml_string_of_char_array"
+
+external bytes_create: int -> bytes = "caml_create_string"
+external bytes_unsafe_set : bytes -> int -> char -> unit
+                           = "%bytes_unsafe_set"
+external unsafe_to_string : bytes -> string = "%bytes_to_string"
+
 
 let escaped = function
   | '\'' -> "\\'"
@@ -30,17 +34,19 @@ let escaped = function
   | '\t' -> "\\t"
   | '\r' -> "\\r"
   | '\b' -> "\\b"
-  | c ->
-    if is_printable c then begin
-      string_of_char_array [|c|]
-    end else begin
+  | (' ' .. '~' as c) -> 
+      let s = bytes_create 1 in
+      bytes_unsafe_set s 0 c;
+      unsafe_to_string s
+  | c -> 
       let n = code c in
-      string_of_char_array [|'\\'; 
-                           (unsafe_chr (48 + n / 100));
-                           (unsafe_chr (48 + (n / 10) mod 10));
-                           (unsafe_chr (48 + n mod 10));
-                           |]
-    end
+      let s = bytes_create 4 in
+      bytes_unsafe_set s 0 '\\';
+      bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100));
+      bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));      
+      bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10));
+      unsafe_to_string s 
+
 
 let lowercase c =
   if (c >= 'A' && c <= 'Z')

jscomp/stdlib/header.c

@@ -0,0 +1,189 @@
+/***********************************************************************/
+/*                                                                     */
+/*                                OCaml                                */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1998 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
+/* The launcher for bytecode executables (if #! is not working) */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "../config/s.h"
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "../byterun/caml/mlvalues.h"
+#include "../byterun/caml/exec.h"
+
+char * default_runtime_path = RUNTIME_NAME;
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 1024
+#endif
+
+#ifndef S_ISREG
+#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef SEEK_END
+#define SEEK_END 2
+#endif
+
+#ifndef __CYGWIN__
+
+/* Normal Unix search path function */
+
+static char * searchpath(char * name)
+{
+  static char fullname[MAXPATHLEN + 1];
+  char * path;
+  char * p;
+  char * q;
+  struct stat st;
+
+  for (p = name; *p != 0; p++) {
+    if (*p == '/') return name;
+  }
+  path = getenv("PATH");
+  if (path == NULL) return name;
+  while(1) {
+    for (p = fullname; *path != 0 && *path != ':'; p++, path++)
+      if (p < fullname + MAXPATHLEN) *p = *path;
+    if (p != fullname && p < fullname + MAXPATHLEN)
+      *p++ = '/';
+    for (q = name; *q != 0; p++, q++)
+      if (p < fullname + MAXPATHLEN) *p = *q;
+    *p = 0;
+    if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) break;
+    if (*path == 0) return name;
+    path++;
+  }
+  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;
+  return ((unsigned long) p[0] << 24) + ((unsigned long) p[1] << 16) +
+         ((unsigned long) p[2] << 8) + p[3];
+}
+
+static char * read_runtime_path(int fd)
+{
+  char buffer[TRAILER_SIZE];
+  static char runtime_path[MAXPATHLEN];
+  int num_sections, i;
+  uint32 path_size;
+  long ofs;
+
+  lseek(fd, (long) -TRAILER_SIZE, SEEK_END);
+  if (read(fd, buffer, TRAILER_SIZE) < TRAILER_SIZE) return NULL;
+  num_sections = read_size(buffer);
+  ofs = TRAILER_SIZE + num_sections * 8;
+  lseek(fd, -ofs, SEEK_END);
+  path_size = 0;
+  for (i = 0; i < num_sections; i++) {
+    if (read(fd, buffer, 8) < 8) return NULL;
+    if (buffer[0] == 'R' && buffer[1] == 'N' &&
+        buffer[2] == 'T' && buffer[3] == 'M') {
+      path_size = read_size(buffer + 4);
+      ofs += path_size;
+    } else if (path_size > 0)
+      ofs += read_size(buffer + 4);
+  }
+  if (path_size == 0) return default_runtime_path;
+  if (path_size >= MAXPATHLEN) return NULL;
+  lseek(fd, -ofs, SEEK_END);
+  if (read(fd, runtime_path, path_size) != path_size) return NULL;
+  runtime_path[path_size - 1] = 0;
+  return runtime_path;
+}
+
+static void errwrite(char * msg)
+{
+  write(2, msg, strlen(msg));
+}
+
+#ifndef O_BINARY
+#define O_BINARY 0
+#endif
+
+int main(int argc, char ** argv)
+{
+  char * truename, * runtime_path;
+  int fd;
+
+  truename = searchpath(argv[0]);
+  fd = open(truename, O_RDONLY | O_BINARY);
+  if (fd == -1 || (runtime_path = read_runtime_path(fd)) == NULL) {
+    errwrite(truename);
+    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);
+  errwrite("\n");
+  return 2;
+}