Skip to content

Commit cb77b1c

Browse files
bobzhangbobzhang
committed
Merge pull request #393 from bloomberg/consistent_stdlib
[refact] make stdlib consistent with ocaml/stdlib
2 parents e5f1975 + 7d64c59 commit cb77b1c

File tree

20 files changed

+870
-175
lines changed

20 files changed

+870
-175
lines changed

‎jscomp/stdlib/.ignore‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
camlheader
2+
target_camlheader
3+
camlheaderd
4+
target_camlheaderd
5+
camlheader_ur
6+
labelled-*
7+
caml
8+
sys.ml

‎jscomp/stdlib/Makefile.nt‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
#########################################################################
2+
# #
3+
# OCaml #
4+
# #
5+
# Xavier Leroy, projet Cristal, INRIA Rocquencourt #
6+
# #
7+
# Copyright 1999 Institut National de Recherche en Informatique et #
8+
# en Automatique. All rights reserved. This file is distributed #
9+
# under the terms of the GNU Library General Public License, with #
10+
# the special exception on linking described in file ../LICENSE. #
11+
# #
12+
#########################################################################
13+
14+
include Makefile.shared
15+
16+
allopt: stdlib.cmxa std_exit.cmx
17+
18+
installopt:
19+
cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(INSTALL_LIBDIR)
20+
21+
camlheader target_camlheader camlheader_ur: headernt.c ../config/Makefile
22+
$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
23+
-DRUNTIME_NAME='"ocamlrun"' headernt.c
24+
$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
25+
rm -f camlheader.exe
26+
mv tmpheader.exe camlheader
27+
cp camlheader target_camlheader
28+
cp camlheader camlheader_ur
29+
30+
camlheaderd target_camlheaderd: headernt.c ../config/Makefile
31+
$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
32+
-DRUNTIME_NAME='"ocamlrund"' headernt.c
33+
$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
34+
mv tmpheader.exe camlheaderd
35+
cp camlheaderd target_camlheaderd
36+
37+
# TODO: do not call flexlink to build tmpheader.exe (we don't need
38+
# the export table)

‎jscomp/stdlib/StdlibModules‎

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
# -*- Makefile -*-
2+
3+
#########################################################################
4+
# #
5+
# OCaml #
6+
# #
7+
# Xavier Leroy, projet Cristal, INRIA Rocquencourt #
8+
# #
9+
# Copyright 2002 Institut National de Recherche en Informatique et #
10+
# en Automatique. All rights reserved. This file is distributed #
11+
# under the terms of the GNU Library General Public License, with #
12+
# the special exception on linking described in file ../LICENSE. #
13+
# #
14+
#########################################################################
15+
16+
# This file lists all standard library modules.
17+
# It is used in particular to know what to expunge in toplevels.
18+
19+
STDLIB_MODULES=\
20+
arg \
21+
array \
22+
arrayLabels \
23+
buffer \
24+
bytes \
25+
bytesLabels \
26+
callback \
27+
camlinternalFormat \
28+
camlinternalFormatBasics \
29+
camlinternalLazy \
30+
camlinternalMod \
31+
camlinternalOO \
32+
char \
33+
complex \
34+
digest \
35+
filename \
36+
format \
37+
gc \
38+
genlex \
39+
hashtbl \
40+
int32 \
41+
int64 \
42+
lazy \
43+
lexing \
44+
list \
45+
listLabels \
46+
map \
47+
marshal \
48+
moreLabels \
49+
nativeint \
50+
obj \
51+
oo \
52+
parsing \
53+
pervasives \
54+
printexc \
55+
printf \
56+
queue \
57+
random \
58+
scanf \
59+
set \
60+
sort \
61+
stack \
62+
stdLabels \
63+
stream \
64+
string \
65+
stringLabels \
66+
sys \
67+
weak

‎jscomp/stdlib/bytes.ml‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ let cat s1 s2 =
122122
r
123123
;;
124124

125-
external is_printable: char -> bool = "caml_is_printable"
125+
126126
external char_code: char -> int = "%identity"
127127
external char_chr: int -> char = "%identity"
128128

@@ -151,7 +151,8 @@ let escaped s =
151151
n := !n +
152152
(match unsafe_get s i with
153153
| '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
154-
| c -> if is_printable c then 1 else 4)
154+
| ' ' .. '~' -> 1
155+
| _ -> 4)
155156
done;
156157
if !n = length s then copy s else begin
157158
let s' = create !n in
@@ -168,10 +169,8 @@ let escaped s =
168169
unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
169170
| '\b' ->
170171
unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
172+
| (' ' .. '~') as c -> unsafe_set s' !n c
171173
| c ->
172-
if is_printable c then
173-
unsafe_set s' !n c
174-
else begin
175174
let a = char_code c in
176175
unsafe_set s' !n '\\';
177176
incr n;
@@ -180,7 +179,7 @@ let escaped s =
180179
unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
181180
incr n;
182181
unsafe_set s' !n (char_chr (48 + a mod 10))
183-
end
182+
184183
end;
185184
incr n
186185
done;

‎jscomp/stdlib/char.ml‎

Lines changed: 18 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,13 @@ external unsafe_chr: int -> char = "%char_of_int"
1919
let chr n =
2020
if n < 0 || n > 255 then invalid_arg "Char.chr" else unsafe_chr n
2121

22-
external is_printable: char -> bool = "caml_is_printable"
2322

24-
external string_of_char_array : char array -> string = "caml_string_of_char_array"
23+
24+
external bytes_create: int -> bytes = "caml_create_string"
25+
external bytes_unsafe_set : bytes -> int -> char -> unit
26+
= "%bytes_unsafe_set"
27+
external unsafe_to_string : bytes -> string = "%bytes_to_string"
28+
2529

2630
let escaped = function
2731
| '\'' -> "\\'"
@@ -30,17 +34,19 @@ let escaped = function
3034
| '\t' -> "\\t"
3135
| '\r' -> "\\r"
3236
| '\b' -> "\\b"
33-
| c ->
34-
if is_printable c then begin
35-
string_of_char_array [|c|]
36-
end else begin
37+
| (' ' .. '~' as c) ->
38+
let s = bytes_create 1 in
39+
bytes_unsafe_set s 0 c;
40+
unsafe_to_string s
41+
| c ->
3742
let n = code c in
38-
string_of_char_array [|'\\';
39-
(unsafe_chr (48 + n / 100));
40-
(unsafe_chr (48 + (n / 10) mod 10));
41-
(unsafe_chr (48 + n mod 10));
42-
|]
43-
end
43+
let s = bytes_create 4 in
44+
bytes_unsafe_set s 0 '\\';
45+
bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100));
46+
bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));
47+
bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10));
48+
unsafe_to_string s
49+
4450

4551
let lowercase c =
4652
if (c >= 'A' && c <= 'Z')

‎jscomp/stdlib/header.c‎

Lines changed: 189 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,189 @@
1+
/***********************************************************************/
2+
/* */
3+
/* OCaml */
4+
/* */
5+
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6+
/* */
7+
/* Copyright 1998 Institut National de Recherche en Informatique et */
8+
/* en Automatique. All rights reserved. This file is distributed */
9+
/* under the terms of the GNU Library General Public License, with */
10+
/* the special exception on linking described in file ../LICENSE. */
11+
/* */
12+
/***********************************************************************/
13+
14+
/* The launcher for bytecode executables (if #! is not working) */
15+
16+
#include <stdio.h>
17+
#include <stdlib.h>
18+
#include <string.h>
19+
#include "../config/s.h"
20+
#ifdef HAS_UNISTD
21+
#include <unistd.h>
22+
#endif
23+
#include <fcntl.h>
24+
#include <sys/types.h>
25+
#include <sys/stat.h>
26+
#include "../byterun/caml/mlvalues.h"
27+
#include "../byterun/caml/exec.h"
28+
29+
char * default_runtime_path = RUNTIME_NAME;
30+
31+
#ifndef MAXPATHLEN
32+
#define MAXPATHLEN 1024
33+
#endif
34+
35+
#ifndef S_ISREG
36+
#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
37+
#endif
38+
39+
#ifndef SEEK_END
40+
#define SEEK_END 2
41+
#endif
42+
43+
#ifndef __CYGWIN__
44+
45+
/* Normal Unix search path function */
46+
47+
static char * searchpath(char * name)
48+
{
49+
static char fullname[MAXPATHLEN + 1];
50+
char * path;
51+
char * p;
52+
char * q;
53+
struct stat st;
54+
55+
for (p = name; *p != 0; p++) {
56+
if (*p == '/') return name;
57+
}
58+
path = getenv("PATH");
59+
if (path == NULL) return name;
60+
while(1) {
61+
for (p = fullname; *path != 0 && *path != ':'; p++, path++)
62+
if (p < fullname + MAXPATHLEN) *p = *path;
63+
if (p != fullname && p < fullname + MAXPATHLEN)
64+
*p++ = '/';
65+
for (q = name; *q != 0; p++, q++)
66+
if (p < fullname + MAXPATHLEN) *p = *q;
67+
*p = 0;
68+
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) break;
69+
if (*path == 0) return name;
70+
path++;
71+
}
72+
return fullname;
73+
}
74+
75+
#else
76+
77+
/* Special version for Cygwin32: takes care of the ".exe" implicit suffix */
78+
79+
static int file_ok(char * name)
80+
{
81+
int fd;
82+
/* Cannot use stat() here because it adds ".exe" implicitly */
83+
fd = open(name, O_RDONLY);
84+
if (fd == -1) return 0;
85+
close(fd);
86+
return 1;
87+
}
88+
89+
static char * searchpath(char * name)
90+
{
91+
char * path, * fullname, * p;
92+
93+
path = getenv("PATH");
94+
fullname = malloc(strlen(name) + (path == NULL ? 0 : strlen(path)) + 6);
95+
/* 6 = "/" plus ".exe" plus final "\0" */
96+
if (fullname == NULL) return name;
97+
/* Check for absolute path name */
98+
for (p = name; *p != 0; p++) {
99+
if (*p == '/' || *p == '\\') {
100+
if (file_ok(name)) return name;
101+
strcpy(fullname, name);
102+
strcat(fullname, ".exe");
103+
if (file_ok(fullname)) return fullname;
104+
return name;
105+
}
106+
}
107+
/* Search in path */
108+
if (path == NULL) return name;
109+
while(1) {
110+
for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path;
111+
if (p != fullname) *p++ = '/';
112+
strcpy(p, name);
113+
if (file_ok(fullname)) return fullname;
114+
strcat(fullname, ".exe");
115+
if (file_ok(fullname)) return fullname;
116+
if (*path == 0) break;
117+
path++;
118+
}
119+
return name;
120+
}
121+
122+
#endif
123+
124+
static unsigned long read_size(char * ptr)
125+
{
126+
unsigned char * p = (unsigned char *) ptr;
127+
return ((unsigned long) p[0] << 24) + ((unsigned long) p[1] << 16) +
128+
((unsigned long) p[2] << 8) + p[3];
129+
}
130+
131+
static char * read_runtime_path(int fd)
132+
{
133+
char buffer[TRAILER_SIZE];
134+
static char runtime_path[MAXPATHLEN];
135+
int num_sections, i;
136+
uint32 path_size;
137+
long ofs;
138+
139+
lseek(fd, (long) -TRAILER_SIZE, SEEK_END);
140+
if (read(fd, buffer, TRAILER_SIZE) < TRAILER_SIZE) return NULL;
141+
num_sections = read_size(buffer);
142+
ofs = TRAILER_SIZE + num_sections * 8;
143+
lseek(fd, -ofs, SEEK_END);
144+
path_size = 0;
145+
for (i = 0; i < num_sections; i++) {
146+
if (read(fd, buffer, 8) < 8) return NULL;
147+
if (buffer[0] == 'R' && buffer[1] == 'N' &&
148+
buffer[2] == 'T' && buffer[3] == 'M') {
149+
path_size = read_size(buffer + 4);
150+
ofs += path_size;
151+
} else if (path_size > 0)
152+
ofs += read_size(buffer + 4);
153+
}
154+
if (path_size == 0) return default_runtime_path;
155+
if (path_size >= MAXPATHLEN) return NULL;
156+
lseek(fd, -ofs, SEEK_END);
157+
if (read(fd, runtime_path, path_size) != path_size) return NULL;
158+
runtime_path[path_size - 1] = 0;
159+
return runtime_path;
160+
}
161+
162+
static void errwrite(char * msg)
163+
{
164+
write(2, msg, strlen(msg));
165+
}
166+
167+
#ifndef O_BINARY
168+
#define O_BINARY 0
169+
#endif
170+
171+
int main(int argc, char ** argv)
172+
{
173+
char * truename, * runtime_path;
174+
int fd;
175+
176+
truename = searchpath(argv[0]);
177+
fd = open(truename, O_RDONLY | O_BINARY);
178+
if (fd == -1 || (runtime_path = read_runtime_path(fd)) == NULL) {
179+
errwrite(truename);
180+
errwrite(" not found or is not a bytecode executable file\n");
181+
return 2;
182+
}
183+
argv[0] = truename;
184+
execv(runtime_path, argv);
185+
errwrite("Cannot exec ");
186+
errwrite(runtime_path);
187+
errwrite("\n");
188+
return 2;
189+
}

0 commit comments

Comments
 (0)