Browse files

Started reentrant runtime changes --patch by Fabrice Le Fessant, port…

…ed, updated (and likely broken in part) by Luca Saiu
  • Loading branch information...
1 parent 3be87f1 commit 7d4891a0395abdac8e60f3cc788b71908c73a88d @lucasaiu committed Dec 10, 2012
Showing with 5,447 additions and 2,237 deletions.
  1. +169 −0 BOOTSTRAP
  2. +3 −36 Changes
  3. +19 −6 Makefile
  4. +3 −2 Makefile.nt
  5. +4 −0 README
  6. +62 −0 README.md
  7. +1 −1 VERSION
  8. +2 −0 asmcomp/amd64/arch.ml
  9. +71 −43 asmcomp/amd64/emit.mlp
  10. +2 −0 asmcomp/amd64/emit_nt.mlp
  11. +45 −22 asmcomp/amd64/proc.ml
  12. +2 −0 asmcomp/amd64/reload.ml
  13. +2 −0 asmcomp/amd64/scheduling.ml
  14. +8 −2 asmcomp/amd64/selection.ml
  15. +3 −4 asmcomp/arm/arch.ml
  16. +5 −8 asmcomp/arm/emit.mlp
  17. +6 −5 asmcomp/arm/proc.ml
  18. +2 −0 asmcomp/arm/reload.ml
  19. +4 −2 asmcomp/arm/scheduling.ml
  20. +7 −5 asmcomp/arm/selection.ml
  21. +2 −4 asmcomp/asmgen.ml
  22. +2 −0 asmcomp/asmgen.mli
  23. +2 −0 asmcomp/asmlibrarian.ml
  24. +2 −0 asmcomp/asmlibrarian.mli
  25. +2 −0 asmcomp/asmlink.ml
  26. +2 −0 asmcomp/asmlink.mli
  27. +2 −0 asmcomp/asmpackager.ml
  28. +2 −0 asmcomp/asmpackager.mli
  29. +2 −0 asmcomp/clambda.ml
  30. +2 −0 asmcomp/clambda.mli
  31. +2 −0 asmcomp/closure.ml
  32. +2 −0 asmcomp/closure.mli
  33. +8 −2 asmcomp/cmm.ml
  34. +8 −2 asmcomp/cmm.mli
  35. +202 −44 asmcomp/cmmgen.ml
  36. +2 −0 asmcomp/cmmgen.mli
  37. +2 −0 asmcomp/cmx_format.mli
  38. +2 −0 asmcomp/codegen.ml
  39. +2 −0 asmcomp/codegen.mli
  40. +2 −0 asmcomp/coloring.ml
  41. +2 −0 asmcomp/coloring.mli
  42. +2 −0 asmcomp/comballoc.ml
  43. +2 −0 asmcomp/comballoc.mli
  44. +2 −0 asmcomp/compilenv.ml
  45. +2 −0 asmcomp/compilenv.mli
  46. +2 −0 asmcomp/emit.mli
  47. +2 −0 asmcomp/emitaux.ml
  48. +2 −0 asmcomp/emitaux.mli
  49. +2 −0 asmcomp/i386/arch.ml
  50. +2 −0 asmcomp/i386/emit.mlp
  51. +2 −0 asmcomp/i386/emit_nt.mlp
  52. +2 −0 asmcomp/i386/proc.ml
  53. +2 −0 asmcomp/i386/reload.ml
  54. +2 −0 asmcomp/i386/scheduling.ml
  55. +2 −0 asmcomp/i386/selection.ml
  56. +2 −0 asmcomp/interf.ml
  57. +2 −0 asmcomp/interf.mli
  58. +2 −0 asmcomp/linearize.ml
  59. +2 −0 asmcomp/linearize.mli
  60. +2 −0 asmcomp/liveness.ml
  61. +2 −0 asmcomp/liveness.mli
  62. +3 −1 asmcomp/mach.ml
  63. +3 −1 asmcomp/mach.mli
  64. +2 −0 asmcomp/power/arch.ml
  65. +2 −0 asmcomp/power/emit.mlp
  66. +2 −0 asmcomp/power/proc.ml
  67. +2 −0 asmcomp/power/reload.ml
  68. +2 −0 asmcomp/power/scheduling.ml
  69. +2 −0 asmcomp/power/selection.ml
  70. +7 −8 asmcomp/printclambda.ml
  71. +9 −3 asmcomp/printcmm.ml
  72. +2 −0 asmcomp/printcmm.mli
  73. +2 −0 asmcomp/printlinear.ml
  74. +2 −0 asmcomp/printlinear.mli
  75. +6 −1 asmcomp/printmach.ml
  76. +2 −0 asmcomp/printmach.mli
  77. +2 −0 asmcomp/proc.mli
  78. +2 −0 asmcomp/reg.ml
  79. +2 −0 asmcomp/reg.mli
  80. +2 −0 asmcomp/reload.mli
  81. +2 −0 asmcomp/reloadgen.ml
  82. +2 −0 asmcomp/reloadgen.mli
  83. +2 −0 asmcomp/schedgen.ml
  84. +2 −0 asmcomp/schedgen.mli
  85. +2 −0 asmcomp/scheduling.mli
  86. +14 −6 asmcomp/selectgen.ml
  87. +2 −0 asmcomp/selectgen.mli
  88. +2 −0 asmcomp/selection.mli
  89. +2 −0 asmcomp/sparc/arch.ml
  90. +2 −0 asmcomp/sparc/emit.mlp
  91. +2 −0 asmcomp/sparc/proc.ml
  92. +2 −0 asmcomp/sparc/reload.ml
  93. +2 −0 asmcomp/sparc/scheduling.ml
  94. +2 −0 asmcomp/sparc/selection.ml
  95. +2 −0 asmcomp/spill.ml
  96. +2 −0 asmcomp/spill.mli
  97. +2 −0 asmcomp/split.ml
  98. +2 −0 asmcomp/split.mli
  99. +7 −3 asmrun/Makefile
  100. +2 −0 asmrun/Makefile.nt
  101. +172 −45 asmrun/amd64.S
  102. +2 −0 asmrun/amd64nt.asm
  103. +3 −11 asmrun/arm.S
  104. +19 −18 asmrun/backtrace.c
  105. +1 −0 asmrun/context.c
  106. +1 −0 asmrun/context.p.c
  107. +1 −0 asmrun/context_split.c
  108. +1 −0 asmrun/extensible_buffer.c
  109. +42 −41 asmrun/fail.c
  110. +2 −0 asmrun/i386.S
  111. +2 −0 asmrun/i386nt.asm
  112. +1 −0 asmrun/major_gc.p.c
  113. +23 −22 asmrun/natdynlink.c
  114. +2 −0 asmrun/power-elf.S
  115. +2 −0 asmrun/power-rhapsody.S
  116. +39 −53 asmrun/roots.c
  117. +22 −9 asmrun/signals_asm.c
  118. +2 −0 asmrun/signals_osdep.h
  119. +2 −0 asmrun/sparc.S
  120. +16 −11 asmrun/stack.h
  121. +97 −27 asmrun/startup.c
  122. BIN boot/arg.cmi
  123. BIN boot/array.cmi
  124. BIN boot/arrayLabels.cmi
  125. BIN boot/buffer.cmi
  126. BIN boot/callback.cmi
  127. +1 −0 boot/camlheader
  128. BIN boot/camlinternalLazy.cmi
  129. BIN boot/camlinternalMod.cmi
  130. BIN boot/camlinternalOO.cmi
  131. BIN boot/char.cmi
  132. BIN boot/complex.cmi
  133. BIN boot/context.cmi
  134. BIN boot/digest.cmi
  135. BIN boot/filename.cmi
  136. BIN boot/format.cmi
  137. BIN boot/gc.cmi
  138. BIN boot/genlex.cmi
  139. BIN boot/hashtbl.cmi
  140. BIN boot/int32.cmi
  141. BIN boot/int64.cmi
  142. BIN boot/lazy.cmi
  143. BIN boot/lexing.cmi
  144. BIN boot/libcamlrun.a
  145. BIN boot/list.cmi
  146. BIN boot/listLabels.cmi
  147. BIN boot/map.cmi
  148. BIN boot/marshal.cmi
  149. BIN boot/moreLabels.cmi
  150. BIN boot/myocamlbuild
  151. BIN boot/myocamlbuild.boot
  152. BIN boot/nativeint.cmi
  153. BIN boot/obj.cmi
  154. BIN boot/ocaml
  155. BIN boot/ocamlc
  156. BIN boot/ocamldep
  157. BIN boot/ocamllex
  158. BIN boot/ocamlrun
  159. BIN boot/ocamlrun.boot
  160. BIN boot/ocamlyacc
  161. BIN boot/oo.cmi
  162. BIN boot/parsing.cmi
  163. BIN boot/pervasives.cmi
  164. BIN boot/printexc.cmi
  165. BIN boot/printf.cmi
  166. BIN boot/queue.cmi
  167. BIN boot/random.cmi
  168. BIN boot/scanf.cmi
  169. BIN boot/set.cmi
  170. BIN boot/sort.cmi
  171. BIN boot/stack.cmi
  172. BIN boot/stdLabels.cmi
  173. BIN boot/std_exit.cmi
  174. BIN boot/std_exit.cmo
  175. BIN boot/stdlib.cma
  176. BIN boot/stream.cmi
  177. BIN boot/string.cmi
  178. BIN boot/stringLabels.cmi
  179. BIN boot/sys.cmi
  180. BIN boot/weak.cmi
  181. +49 −4 build/boot.sh
  182. +2 −0 build/camlp4-byte-only.sh
  183. +1 −0 build/camlp4-mkCamlp4Ast.sh
  184. +2 −0 build/camlp4-native-only.sh
  185. +1 −0 build/camlp4-targets.sh
  186. +2 −0 build/distclean.sh
  187. +2 −0 build/fastworld.sh
  188. +2 −0 build/install.sh
  189. +2 −0 build/mkmyocamlbuild_config.sh
  190. +1 −0 build/mkruntimedef.sh
  191. +2 −0 build/myocamlbuild.sh
  192. +2 −0 build/ocamlbuild-byte-only.sh
  193. +2 −0 build/ocamlbuild-native-only.sh
  194. +2 −0 build/ocamlbuildlib-native-only.sh
  195. +2 −0 build/otherlibs-targets.sh
  196. +2 −0 build/partial-install.sh
  197. +2 −0 build/targets.sh
  198. +1 −0 build/world.all.sh
  199. +1 −0 build/world.byte.sh
  200. +1 −0 build/world.native.sh
  201. +59 −58 bytecomp/bytegen.ml
  202. +2 −0 bytecomp/bytegen.mli
  203. +2 −0 bytecomp/bytelibrarian.ml
  204. +2 −0 bytecomp/bytelibrarian.mli
  205. +11 −5 bytecomp/bytelink.ml
  206. +2 −0 bytecomp/bytelink.mli
  207. +2 −0 bytecomp/bytepackager.ml
  208. +2 −0 bytecomp/bytepackager.mli
  209. +2 −0 bytecomp/bytesections.ml
  210. +2 −0 bytecomp/bytesections.mli
  211. +2 −0 bytecomp/cmo_format.mli
  212. +6 −4 bytecomp/dll.ml
  213. +2 −0 bytecomp/dll.mli
  214. +5 −3 bytecomp/emitcode.ml
  215. +2 −0 bytecomp/emitcode.mli
  216. +3 −1 bytecomp/instruct.ml
  217. +3 −1 bytecomp/instruct.mli
  218. +2 −2 bytecomp/lambda.ml
  219. +2 −2 bytecomp/lambda.mli
  220. +22 −19 bytecomp/matching.ml
  221. +2 −0 bytecomp/matching.mli
  222. +8 −6 bytecomp/meta.ml
  223. +8 −6 bytecomp/meta.mli
  224. +4 −2 bytecomp/printinstr.ml
  225. +2 −0 bytecomp/printinstr.mli
  226. +2 −1 bytecomp/printlambda.ml
  227. +2 −0 bytecomp/printlambda.mli
  228. +2 −0 bytecomp/runtimedef.mli
  229. +2 −0 bytecomp/simplif.ml
  230. +2 −0 bytecomp/simplif.mli
  231. +3 −1 bytecomp/symtable.ml
  232. +2 −0 bytecomp/symtable.mli
  233. +2 −0 bytecomp/translclass.ml
  234. +2 −0 bytecomp/translclass.mli
  235. +34 −35 bytecomp/translcore.ml
  236. +2 −0 bytecomp/translcore.mli
  237. +2 −0 bytecomp/translmod.ml
  238. +2 −0 bytecomp/translmod.mli
  239. +3 −1 bytecomp/translobj.ml
  240. +2 −0 bytecomp/translobj.mli
  241. +2 −0 bytecomp/typeopt.ml
  242. +2 −0 bytecomp/typeopt.mli
  243. +2 −0 byterun/Makefile
  244. +9 −4 byterun/Makefile.common
  245. +2 −0 byterun/Makefile.nt
  246. +48 −24 byterun/alloc.c
  247. +15 −13 byterun/alloc.h
  248. +67 −59 byterun/array.c
  249. +37 −34 byterun/backtrace.c
  250. +10 −8 byterun/backtrace.h
  251. +38 −47 byterun/callback.c
  252. +25 −11 byterun/callback.h
  253. +38 −35 byterun/compact.c
  254. +5 −2 byterun/compact.h
  255. +41 −52 byterun/compare.c
  256. +3 −1 byterun/compare.h
  257. +8 −6 byterun/compatibility.h
  258. +2 −0 byterun/config.h
  259. +664 −0 byterun/context.c
  260. +906 −0 byterun/context.h
  261. +348 −0 byterun/context_split.c
  262. +17 −0 byterun/context_split.h
  263. +21 −4 byterun/custom.c
  264. +41 −2 byterun/custom.h
  265. +88 −82 byterun/debugger.c
  266. +8 −6 byterun/debugger.h
  267. +34 −41 byterun/dynlink.c
  268. +5 −3 byterun/dynlink.h
  269. +2 −0 byterun/exec.h
  270. +38 −0 byterun/extensible_buffer.c
  271. +39 −0 byterun/extensible_buffer.h
  272. +198 −201 byterun/extern.c
  273. +47 −48 byterun/fail.c
  274. +23 −31 byterun/fail.h
  275. +44 −64 byterun/finalise.c
  276. +9 −7 byterun/finalise.h
  277. +19 −17 byterun/fix_code.c
  278. +8 −12 byterun/fix_code.h
  279. +87 −77 byterun/floats.c
  280. +26 −47 byterun/freelist.c
  281. +9 −9 byterun/freelist.h
  282. +2 −0 byterun/gc.h
  283. +75 −88 byterun/gc_ctrl.c
  284. +6 −2 byterun/gc_ctrl.h
  285. +44 −61 byterun/globroots.c
  286. +4 −2 byterun/globroots.h
  287. +30 −22 byterun/hash.c
  288. +2 −0 byterun/hash.h
  289. +12 −8 byterun/instrtrace.c
  290. +5 −3 byterun/instrtrace.h
  291. +2 −0 byterun/instruct.h
  292. +2 −0 byterun/int64_emul.h
  293. +2 −0 byterun/int64_format.h
  294. +2 −0 byterun/int64_native.h
  295. +117 −146 byterun/intern.c
  296. +44 −23 byterun/interp.c
  297. +3 −1 byterun/interp.h
  298. +40 −40 byterun/intext.h
  299. +247 −186 byterun/ints.c
  300. +189 −109 byterun/io.c
Sorry, we could not display the entire diff because too many files (1,440) changed.
View
169 BOOTSTRAP
@@ -0,0 +1,169 @@
+#!/bin/bash
+
+#MAKEFLAGS='-j 4'
+
+# This assumes we have already configured the sources in $UNPATCHED and $PATCHED .
+
+# cd ...
+# make clean
+# cp "$UNPATCHED/ocamlc" "$PATCHED/ocamlc"
+# cp "$UNPATCHED/boot/"* boot/
+# make -C byterun
+# make -C "$PATCHED/stdlib" CAMLC="$UNPATCHED/ocamlc" COMPILER="$UNPATCHED/ocamlc"
+# for t in compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo; do
+# make CAMLC="$UNPATCHED/ocamlc" $t
+# done
+# # This fails
+# ocamlc -o ocamlc stdlib/stdlib.cma compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo -use-runtime byterun/ocamlrun
+set -ex
+
+# # This assumes ../unpatched-trunk contains an unpatched, configured
+# # and compiled version of the OCaml source.
+# PATCHED="$(pwd)"
+PATCHED="/home/luca/reentrant-runtime/working/trunk/"
+UNPATCHED="$PATCHED/../unpatched-trunk/"
+OLD="/tmp/old/"
+COMPILERWITHOLDRUNTIME="/tmp/compiler-with-old-runtime/"
+COMPILERWITHNEWRUNTIME="/tmp/compiler-with-new-runtime/"
+export OLDOCAMLC="$OLD/byterun/ocamlrun $OLD/ocamlc"
+export COMPILERWITHOLDRUNTIMEOCAMLC="$OLD/byterun/ocamlrun $COMPILERWITHOLDRUNTIME/ocamlc-stage1 -nostdlib -I $COMPILERWITHOLDRUNTIME/stdlib -use-runtime $COMPILERWITHOLDRUNTIME/byterun/ocamlrun"
+export COMPILERWITHNEWRUNTIMEOCAMLC="$COMPILERWITHNEWRUNTIME/byterun/ocamlrun $COMPILERWITHNEWRUNTIME/ocamlc -nostdlib -I $COMPILERWITHNEWRUNTIME/stdlib -use-runtime $COMPILERWITHNEWRUNTIME/byterun/ocamlrun"
+
+echo "Preparing temporary directories..."
+rm -rf "$OLD" "$COMPILERWITHOLDRUNTIME" "$COMPILERWITHNEWRUNTIME"
+cp -af "$UNPATCHED" "$OLD"
+cp -af "$PATCHED" "$COMPILERWITHOLDRUNTIME"
+cp -af "$PATCHED" "$COMPILERWITHNEWRUNTIME"
+
+# FIXME: this is correct: I've just disabled it to save time
+# echo "Compiling the old runtime..."
+# cd "$OLD"
+# make clean
+# make -C byterun
+# make ocamlc
+# make -C stdlib # FIXME: is this needed?
+# if (! [ -e "$OLD/byterun/ocamlrun" ]) || (! [ -e "$OLD/ocamlc" ]); then exit -1; fi
+# echo "Now $OLDOCAMLC exists"
+
+echo "Compiling the patched compiler running on the old runtime..."
+cd "$COMPILERWITHOLDRUNTIME"
+make clean
+cp "$OLD/boot/ocamllex" boot/
+
+# We can start with the part written in C:
+make -C yacc
+cp yacc/ocamlyacc boot/
+make -C byterun
+cp byterun/ocamlrun boot/
+
+#cp "$OLD/ocamlc" ocamlc
+#cp "$OLD/boot/"* boot/
+#make -C byterun
+#make -C "$COMPILERWITHOLDRUNTIME/stdlib" CAMLC="$OLDOCAMLC" COMPILER="$OLDOCAMLC"
+
+# # Copy some sources from the unpatched version, so that we don't rely
+# # on the new C primitives we lack in our old runtime:
+cp "$OLD/utils/terminfo.ml"{,i} utils/
+cp "$OLD/bytecomp/dll.ml"{,i} bytecomp/
+cp "$OLD/bytecomp/meta.ml"{,i} bytecomp/
+# #cp "$OLD/bytecomp/runtimedef.ml"{,i} bytecomp/
+
+for t in compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo; do
+ make CAMLC="$OLDOCAMLC -I $OLD/boot" CAMLLEX="$OLD/boot/ocamlrun $COMPILERWITHOLDRUNTIME/boot/ocamllex" "$t"
+done
+
+$OLDOCAMLC -I "$OLD/boot" -o ocamlc-stage1 -use-runtime "$OLD/byterun/ocamlrun" compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo
+
+make -C stdlib/ RUNTIME="$OLD/byterun/ocamlrun" COMPILER="$COMPILERWITHOLDRUNTIME/ocamlc-stage1"
+
+# The generated runtime (in byterun/) should be the same in stages 1
+# and 2. The difference is the runtime *on top of which* the compiler
+# runs.
+
+echo "Compiling test programs with ocamlc-stage1, to be run with the new runtime..."
+$COMPILERWITHOLDRUNTIMEOCAMLC -o a ~/reentrant-runtime/tests/a.ml
+$COMPILERWITHOLDRUNTIMEOCAMLC -o b ~/reentrant-runtime/tests/b.ml
+$COMPILERWITHOLDRUNTIMEOCAMLC -o i ~/reentrant-runtime/tests/i.ml
+$COMPILERWITHOLDRUNTIMEOCAMLC -o l ~/reentrant-runtime/tests/length.ml
+
+#make -C lex CAMLC="$COMPILERWITHOLDRUNTIMEOCAMLC"
+#make -C tools CAMLRUN="$COMPILERWITHOLDRUNTIMEOCAMLC/byterun/ocamlrun" CAMLC="$COMPILERWITHOLDRUNTIMEOCAMLC"
+
+echo Generated the compiler running on the old runtime
+
+# FIXME: I suppose that before doing this I have to clean compilerlibs, util/ and and driver/
+#$OLDOCAMLC -nostdlib -o ocamlc compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo -I stdlib/ -use-runtime byterun/ocamlrun
+#Fails with
+#Error: Error while linking stdlib/stdlib.cma(Array):
+#The external function `caml_array_concat' is not available
+
+cd "$COMPILERWITHNEWRUNTIME"
+cp "$COMPILERWITHOLDRUNTIME/ocamlc-stage1" boot/ocamlc
+cp "$COMPILERWITHOLDRUNTIME/byterun/ocamlrun" boot/ocamlrun
+#echo '#!'"$OLD/boot/ocamlrun" > boot/ocamllex; tail --lines=+2 < "$OLD/boot/ocamllex" >> boot/ocamllex
+cp "$OLD/boot/ocamlyacc" boot/ocamlyacc
+#echo '#!'"$OLD/boot/ocamlrun" > boot/ocamldep; tail --lines=+2 < "$OLD/boot/ocamldep" >> boot/ocamldep
+#echo '#!'"$OLD/boot/ocamlrun" > boot/ocamlbuild; tail --lines=+2 < "$OLD/boot/ocamlbuild" >> boot/ocamlbuild
+
+make -C byterun clean
+make -C byterun
+make -C lex CAMLC="$COMPILERWITHOLDRUNTIMEOCAMLC" CAMLLEX="$OLD/boot/ocamlrun $COMPILERWITHOLDRUNTIME/boot/ocamllex"
+cp lex/ocamllex boot/
+make -C stdlib/ RUNTIME="$OLD/byterun/ocamlrun" COMPILER="$COMPILERWITHOLDRUNTIME/ocamlc-stage1"
+for t in compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo; do
+ make CAMLC="$COMPILERWITHOLDRUNTIMEOCAMLC" "$t"
+done
+$OLDOCAMLC -nostdlib -I stdlib -o ocamlc-stage2 -use-runtime "$COMPILERWITHNEWRUNTIME/byterun/ocamlrun" compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma driver/main.cmo
+cp ocamlc-stage2 boot/ocamlc
+cp ocamlc-stage2 ocamlc
+cp byterun/ocamlrun boot/ocamlrun # This shouldn't be needed, but let's play it safe
+
+make coldstart
+
+make ocamltools
+make -C tools
+#cp tools/ocamldep boot/ocamldep
+
+echo "Compiling test programs with ocamlc-stage2, to be run with the new runtime..."
+$COMPILERWITHNEWRUNTIMEOCAMLC -o a ~/reentrant-runtime/tests/a.ml
+$COMPILERWITHNEWRUNTIMEOCAMLC -o b ~/reentrant-runtime/tests/b.ml
+$COMPILERWITHNEWRUNTIMEOCAMLC -o i ~/reentrant-runtime/tests/i.ml
+$COMPILERWITHNEWRUNTIMEOCAMLC -o l ~/reentrant-runtime/tests/length.ml
+
+#make -C lex CAMLLEX="$COMPILERWITHNEWRUNTIME/boot/ocamllex"
+cp tools/ocamldep boot/
+#cp myocamlbuild_config.ml ocamlbuild/ocamlbuild_Myocamlbuild_config.ml
+#make -C ocamlbuild/
+
+# What we did up to this point has built a non-working
+# boot/myocamlbuild.boot; let's replace it with something that can
+# actually be run:
+echo '#!'"$OLD/boot/ocamlrun" > boot/myocamlbuild.boot; chmod a+x boot/myocamlbuild.boot; tail --lines=+2 < "$OLD/boot/myocamlbuild.boot" >> boot/myocamlbuild.boot
+
+# # ocamlbuild complains about this if I keep it:
+# rm -rf compilerlibs-from-unpatched-version
+
+cp $OLD/boot/ocamlrun boot/ocamlrun.boot
+
+# I can't run make world at this point, because ocamlcomp.sh is not
+# there yet. What's the clean way of producing it? "make bootstrap"
+# works.
+make bootstrap
+make install
+
+# Now we have bootstrapped. From now on, if the installation prefix
+# is accessible, we can directly compile from the current directory.
+# Just copy the executables from the previous stage into boot:
+rm boot/* &> /dev/null || true
+cp $COMPILERWITHNEWRUNTIME/ocamlc boot/
+cp $COMPILERWITHNEWRUNTIME/byterun/ocamlrun boot/
+cp $COMPILERWITHNEWRUNTIME/byterun/ocamlrun boot/ocamlrun.boot # Added by me, to be used in build/boot.sh
+cp $COMPILERWITHNEWRUNTIME/tools/ocamldep boot/
+cp $COMPILERWITHNEWRUNTIME/lex/ocamllex boot/
+cp $COMPILERWITHNEWRUNTIME/yacc/ocamlyacc boot/
+cp $COMPILERWITHNEWRUNTIME/_build/myocamlbuild boot/myocamlbuild
+cp $COMPILERWITHNEWRUNTIME/_build/myocamlbuild boot/myocamlbuild.boot # Not a mistake
+
+make world
+
+echo SUCCESS
View
39 Changes
@@ -4,14 +4,10 @@ Next version
Compilers:
- PR#5634: parsetree rewriter (-ppx flag)
- ocamldep now supports -absname
-- PR#5768: On "unbound identifier" errors, use spell-checking to suggest names present in the environment
-- ocamlc has a new option -dsource which visualize the parsetree
-- tools/eqparsetree compare two parsetree ignoring location
+
Bug fixes:
- PR#4762: ?? is not used at all, but registered as a lexer token
- PR#4994: ocaml-mode doesn't work with xemacs21
-* PR#5119: camlp4 now raises a specific exception when 'DELETE_RULE' fails,
- rather than raising 'Not_found'
- PR#5327: (Windows) Unix.select blocks if same socket listed in first and
third arguments
- PR#5468: ocamlbuild should preserve order of parametric tags
@@ -30,61 +26,32 @@ Bug fixes:
- PR#5747: 'unused open' warning not given when compiling with -annot
- PR#5758: Compiler bug when matching on floats
- PR#5763: ocamlbuild does not give correct flags when running menhir
-- PR#5784: -dclambda option is ignored
-- PR#5787: Bad behavior of 'Unused ...' warnings in the toplevel
-- PR#5770: Syntax error messages involving unclosed parens are sometimes incorrect
-- PR#5805: Assert failure with warning 34 on pre-processed file
Internals:
- Moved debugger/envaux.ml to typing/envaux.ml to publish env_of_only_summary
as part of compilerlibs, to be used on bin-annot files.
Feature wishes:
- PR#5597: add instruction trace option 't' to OCAMLRUNPARAM
-- PR#5762: Add primitives for fast access to bigarray dimensions
-
-
-OCaml 4.00.2:
--------------
-
-Bug fixes:
-- PR#5102: ocamlbuild fails when using an unbound variable in rule dependency
-- PR#5240: register exception printers for Unix.Unix_error and Dynlink.Error
-- PR#5300: verbose parameter should implicitly set classic display
-- PR#5772: problem with marshaling of mutually-recursive functions
-- PR#5775: several bug fixes for tools/pprintast.ml
-- PR#5785: misbehaviour with abstracted structural type used as GADT index
-- PR#5806: ensure that backtrace tests are always run (testsuite)
-- PR#5810: error in switch printing when using -dclambda
-
OCaml 4.00.1:
-------------
Bug fixes:
- PR#4019: better documentation of Str.matched_string
-- PR#5111: ocamldoc, heading tags inside spans tags is illegal in html
-- PR#5278: better error message when typing "make"
-- PR#5468: ocamlbuild should preserve order of parametric tags
- PR#5563: harden Unix.select against file descriptors above FD_SETSIZE
-- PR#5690: "ocamldoc ... -text README" raises exception
- PR#5700: crash with native-code stack backtraces under MacOS 10.8 x86-64
- PR#5707: AMD64 code generator: do not use r10 and r11 for parameter passing,
as these registers can be destroyed by the dynamic loader
- PR#5712: some documentation problems
- PR#5715: configuring with -no-shared-libs breaks under cygwin
-- PR#5718: false positive on 'unused constructor' warning
- PR#5719: ocamlyacc generates code that is not warning 33-compliant
-- PR#5725: ocamldoc output of preformatted code
- PR#5727: emacs caml-mode indents shebang line in toplevel scripts
-- PR#5729: tools/untypeast.ml creates unary Pexp_tuple
- PR#5731: instruction scheduling forgot to account for destroyed registers
- PR#5735: %apply and %revapply not first class citizens
- PR#5738: first class module patterns not handled by ocamldep
- PR#5742: missing bound checks in Array.sub
-- PR#5744: ocamldoc error on "val virtual"
- PR#5757: GC compaction bug (crash)
-- PR#5758: Compiler bug when matching on floats
- PR#5761: Incorrect bigarray custom block size
@@ -96,7 +63,7 @@ OCaml 4.00.0:
- The official name of the language is now OCaml.
Language features:
-- Added Generalized Algebraic Data Types (GADTs) to the language.
+- Added Generalized Abstract Data Types (GADTs) to the language.
See chapter "Language extensions" of the reference manual for documentation.
- It is now possible to omit type annotations when packing and unpacking
first-class modules. The type-checker attempts to infer it from the context.
@@ -1740,7 +1707,7 @@ Standard library:
- Module Printf:
added %S and %C formats (quoted, escaped strings and characters);
added kprintf (calls user-specified continuation on formatted string).
-- Module Queue: faster implementation (courtesy of Francois Pottier).
+- Module Queue: faster implementation (courtesy of Fran�ois Pottier).
- Module Random: added Random.bool.
- Module Stack: added Stack.is_empty.
- Module Pervasives:
View
25 Makefile
@@ -10,20 +10,29 @@
# #
#########################################################################
+# $Id$
+
# The main Makefile
include config/Makefile
include stdlib/StdlibModules
-CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
+#CAMLC=ocamlc -nostdlib -I boot
+CAMLC=./boot/ocamlrun ./boot/ocamlc -nostdlib -I boot # REENTRANTRUNTIME
CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
+#CAMLC=./boot-from-unpatched-version/ocamlrun ./boot/ocamlc -nostdlib -I boot # REENTRANTRUNTIME
+#CAMLOPT=boot-from-unpatched-version/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
COMPFLAGS=-strict-sequence -w +33..39 -warn-error A $(INCLUDES)
LINKFLAGS=
CAMLYACC=boot/ocamlyacc
+#CAMLYACC=boot-from-unpatched-version/ocamlyacc
YACCFLAGS=-v
-CAMLLEX=boot/ocamlrun boot/ocamllex
+#CAMLLEX=boot/ocamlrun boot/ocamllex
+CAMLLEX=./boot/ocamlrun boot/ocamllex # REENTRANTRUNTIME
+#CAMLLEX=./boot-from-unpatched-version/ocamlrun boot/ocamllex # REENTRANTRUNTIME
CAMLDEP=boot/ocamlrun tools/ocamldep
+#CAMLDEP=boot-from-unpatched-version/ocamlrun tools/ocamldep
DEPFLAGS=$(INCLUDES)
CAMLRUN=byterun/ocamlrun
SHELL=/bin/sh
@@ -41,8 +50,7 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
PARSING=parsing/location.cmo parsing/longident.cmo \
parsing/syntaxerr.cmo parsing/parser.cmo \
- parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
- parsing/pprintast.cmo
+ parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo
TYPING=typing/ident.cmo typing/path.cmo \
typing/primitive.cmo typing/types.cmo \
@@ -369,9 +377,14 @@ partialclean::
rm -f compilerlibs/ocamltoplevel.cma
ocaml: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART) expunge
+ # FIXME: is it ok to use the an ocaml from the old stage? --Luca Saiu REENTRANTRUNTIME
+ # byterun/ocamlrun ./boot/ocamlc $(LINKFLAGS) -linkall -o ocaml.tmp \
+ # compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
+ # compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART)
+ # - $(CAMLRUN) ./expunge ocaml.tmp ocaml $(PERVASIVES)
$(CAMLC) $(LINKFLAGS) -linkall -o ocaml.tmp \
- compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
- compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART)
+ compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
+ compilerlibs/ocamltoplevel.cma $(TOPLEVELSTART)
- $(CAMLRUN) ./expunge ocaml.tmp ocaml $(PERVASIVES)
rm -f ocaml.tmp
View
5 Makefile.nt
@@ -10,6 +10,8 @@
# #
#########################################################################
+# $Id$
+
# The main Makefile
include config/Makefile
@@ -38,8 +40,7 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
PARSING=parsing/location.cmo parsing/longident.cmo \
parsing/syntaxerr.cmo parsing/parser.cmo \
- parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
- parsing/pprintast.cmo
+ parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo
TYPING=typing/ident.cmo typing/path.cmo \
typing/primitive.cmo typing/types.cmo \
View
4 README
@@ -129,3 +129,7 @@ To be effective, bug reports should include a complete program
configuration you are using (machine type, etc).
You can also contact the implementors directly at caml@inria.fr.
+
+
+----
+$Id$
View
62 README.md
@@ -0,0 +1,62 @@
+Reentrant OCaml
+===============
+
+This branch is the first step towards multicore support in OCaml. The
+reentrant runtime will allow multiple runtimes to run independantly in
+the same process. It can be used either to run these runtimes in
+different threads, or when multiple OCaml runtimes are exposed as C
+libraries.
+
+Status
+------
+
+### DONE
+
+* Most static variables of the runtime have been moved into the context
+* Most C functions of the runtime have been renamed to _r(CAML_R, to take
+ as first parameter the runtime context containing all former static variables.
+* External functions in OCaml can now be declared as "reentrant", i.e. receiving
+ the context as first parameter.
+* The AMD64 backend of ocamlopt has been updated to use the runtime context and
+ provide it to reentrant external functions.
+* C functions in unix, str, bigarray have been updated, static variables have been moved
+ into library specific contexts.
+
+### TODO
+
+* Globals generated by ocamlopt are still shared
+* Only the AMD64 backend has been implemented. Implement the other ones.
+* Only TLS (Thread Local Storage) is currenty supported.
+* At the end, we need to provide all the functions that were renamed in _r in
+ their older format, for backward compatibility.
+* Update C functions in otherlibs/
+
+Principles
+----------
+
+Each function in the runtime takes as first argument a "runtime
+context", containing all the variables that used to be static. To
+decrease the size of the patch, the file context.h defines for each
+variable a macro that lookup the variable within the context. All
+these functions have a suffix _r, and the macro CAML_R defines their
+first argument.
+
+Once all functions will have been rewritten like that, we should
+implement the former version (without the first argument) by looking
+up the context in the thread local storage, using the function
+"caml_get_global_context()".
+
+Since we needed a global lock for all the runtimes, it has been
+implemented as "caml_enter_blocking_section()" (which should still be
+used for exclusion within a given runtime), by introducing two
+functions "caml_enter_lock_section()" and
+"caml_leave_lock_section()". These functions don't do anything right
+now, but locking should be added within the thread libraries by
+redefining "caml_enter_lock_section_hook" and
+"caml_leave_lock_section_hook".
+
+For static variables within libraries, the library should define its
+own runtime context, and use "caml_get_library_context_r(...)" to
+access it. Such contexts are currently limited to 24
+(MAX_OTHER_CONTEXTS), but the limitation should be removed soon.
+
View
2 VERSION
@@ -1,4 +1,4 @@
-4.01.0+dev10-2012-10-16
+4.01.0+dev8_2012-09-10+multiruntime
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
View
2 asmcomp/amd64/arch.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Machine-specific command-line options *)
let pic_code = ref true
View
114 asmcomp/amd64/emit.mlp
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Emission of x86-64 (AMD 64) assembly code *)
open Cmm
@@ -70,9 +72,10 @@ let emit_jump s =
let load_symbol_addr s =
if !Clflags.dlcode && not mingw64
then `movq {emit_symbol s}@GOTPCREL(%rip)`
+ (* `# REENTRANTRUNTIME: we use dlcode, whatever it is\n\tmovq {emit_symbol s}@GOTPCREL(%rip)` *)
else if !pic_code
- then `leaq {emit_symbol s}(%rip)`
- else `movq ${emit_symbol s}`
+ then `# REENTRANTRUNTIME: we don't use pic\n\tleaq {emit_symbol s}(%rip)`
+ else `# REENTRANTRUNTIME: third case\n\tmovq ${emit_symbol s}`
(* Output a label *)
@@ -107,17 +110,19 @@ let emit_reg = function
let reg_low_8_name =
[| "%al"; "%bl"; "%dil"; "%sil"; "%dl"; "%cl"; "%r8b"; "%r9b";
- "%r12b"; "%r13b"; "%bpl"; "%r10b"; "%r11b" |]
+ "%r12b"; (* "%r13b"; *) "%bpl"; "%r10b"; "%r11b" |]
let reg_low_16_name =
[| "%ax"; "%bx"; "%di"; "%si"; "%dx"; "%cx"; "%r8w"; "%r9w";
- "%r12w"; "%r13w"; "%bp"; "%r10w"; "%r11w" |]
+ "%r12w"; (* "%r13w"; *) "%bp"; "%r10w"; "%r11w" |]
let reg_low_32_name =
[| "%eax"; "%ebx"; "%edi"; "%esi"; "%edx"; "%ecx"; "%r8d"; "%r9d";
- "%r12d"; "%r13d"; "%ebp"; "%r10d"; "%r11d" |]
+ "%r12d"; (* "%r13d"; *) "%ebp"; "%r10d"; "%r11d" |]
+
+let int_reg_nbr = Array.length reg_low_8_name (* REENTRANTRUNTIME *)
let emit_subreg tbl r =
match r.loc with
- Reg r when r < 13 ->
+ Reg r when r < int_reg_nbr (*13 REENTRANTRUNTIME*) ->
emit_string tbl.(r)
| Stack s ->
let ofs = slot_offset s (register_class r) in
@@ -187,7 +192,7 @@ type gc_call =
let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
- `{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`;
+ `{emit_label gc.gc_lbl}: {emit_call "caml_call_gc_r13"}\n`;
`{emit_label gc.gc_frame}: jmp {emit_label gc.gc_return_lbl}\n`
(* Record calls to caml_ml_array_bound_error.
@@ -214,13 +219,13 @@ let bound_error_label dbg =
end
let emit_call_bound_error bd =
- `{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error"}\n`;
+ `{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error_r13"}\n`;
`{emit_label bd.bd_frame}:\n`
let emit_call_bound_errors () =
List.iter emit_call_bound_error !bound_error_sites;
if !bound_error_call > 0 then
- `{emit_label !bound_error_call}: {emit_call "caml_ml_array_bound_error"}\n`
+ `{emit_label !bound_error_call}: {emit_call "caml_ml_array_bound_error_r13"}\n`
(* Names for instructions *)
@@ -369,8 +374,19 @@ let emit_instr fallthrough i =
float_constants := (lbl, s) :: !float_constants;
` movsd {emit_label lbl}(%rip), {emit_reg i.res.(0)}\n`
end
- | Lop(Iconst_symbol s) ->
- ` {load_symbol_addr s}, {emit_reg i.res.(0)}\n`
+ | Lop(Iconst_symbol("caml_global_context", _)) ->
+ ` movq %r13, {emit_reg i.res.(0)}\n`
+ | Lop(Iconst_symbol(s, Cglobal_kind)) ->
+ (* ` {load_symbol_addr s}, {emit_reg i.res.(0)}\n` *)
+ (* The word named by the symbol contains a byte offset (set at
+ module registration time and identical for all contexts) at
+ which globals for the given module start in the per-context
+ global variable array caml_globals --Luca Saiu REENTRANTRUNTIME *)
+ ` movq {emit_symbol s}@GOTPCREL(%rip), {emit_reg i.res.(0)} # Load {emit_string s}'s offset address
+ movq ({emit_reg i.res.(0)}), {emit_reg i.res.(0)} # Load {emit_string s}'s offset
+ addq 56(%r13), {emit_reg i.res.(0)} # Add the offset to the global array base\n` (* FIXME: use symbolic expressions instead of 56 *)
+ | Lop(Iconst_symbol(s, Cconstant_kind)) ->
+ ` {load_symbol_addr s}, {emit_reg i.res.(0)} # Load constant {emit_string s}\n` (* the original solution, unchanged --Luca Saiu REENTRANTRUNTIME *)
| Lop(Icall_ind) ->
` call *{emit_reg i.arg.(0)}\n`;
record_frame i.live i.dbg
@@ -392,10 +408,12 @@ let emit_instr fallthrough i =
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
` {load_symbol_addr s}, %rax\n`;
- ` {emit_call "caml_c_call"}\n`;
+ (* ` {emit_call "caml_c_call"}\n`; REENTRANTRUNTIME *)
+ ` {emit_call "caml_c_call_r13"}\n`;
record_frame i.live i.dbg;
- ` {load_symbol_addr "caml_young_ptr"}, %r11\n`;
- ` movq (%r11), %r15\n`;
+ (* ` {load_symbol_addr "caml_young_ptr"}, %r11\n`; REENTRANTRUNTIME *)
+ (* ` movq (%r11), %r15\n`; REENTRANTRUNTIME *)
+ ` movq 8(%r13), %r15 # caml_young_ptr\n`; (* FIXME: use a symbolic offset *)
end else begin
` {emit_call s}\n`
end
@@ -409,49 +427,51 @@ let emit_instr fallthrough i =
let dest = i.res.(0) in
begin match chunk with
| Word ->
- ` movq {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movq {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Byte_unsigned ->
- ` movzbq {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movzbq {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Byte_signed ->
- ` movsbq {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movsbq {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Sixteen_unsigned ->
- ` movzwq {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movzwq {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Sixteen_signed ->
- ` movswq {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movswq {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Thirtytwo_unsigned ->
- ` movl {emit_addressing addr i.arg 0}, {emit_reg32 dest}\n`
+ ` movl {emit_addressing addr i.arg 0}, {emit_reg32 dest} # Lop(Iload(_,_))\n`
| Thirtytwo_signed ->
- ` movslq {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movslq {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Single ->
- ` cvtss2sd {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` cvtss2sd {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
| Double | Double_u ->
- ` movsd {emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+ ` movsd {emit_addressing addr i.arg 0}, {emit_reg dest} # Lop(Iload(_,_))\n`
end
| Lop(Istore(chunk, addr)) ->
begin match chunk with
| Word ->
- ` movq {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
+ ` movq {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1} # Lop(Istore(_,_))\n`
| Byte_unsigned | Byte_signed ->
- ` movb {emit_reg8 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
+ ` movb {emit_reg8 i.arg.(0)}, {emit_addressing addr i.arg 1} # Lop(Istore(_,_))\n`
| Sixteen_unsigned | Sixteen_signed ->
- ` movw {emit_reg16 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
+ ` movw {emit_reg16 i.arg.(0)}, {emit_addressing addr i.arg 1} # Lop(Istore(_,_))\n`
| Thirtytwo_signed | Thirtytwo_unsigned ->
- ` movl {emit_reg32 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
+ ` movl {emit_reg32 i.arg.(0)}, {emit_addressing addr i.arg 1} # Lop(Istore(_,_))\n`
| Single ->
- ` cvtsd2ss {emit_reg i.arg.(0)}, %xmm15\n`;
- ` movss %xmm15, {emit_addressing addr i.arg 1}\n`
+ ` cvtsd2ss {emit_reg i.arg.(0)}, %xmm15 # Lop(Istore(_,_)) [1/2]\n`;
+ ` movss %xmm15, {emit_addressing addr i.arg 1} # Lop(Istore(_,_)) [2/2]\n`
| Double | Double_u ->
- ` movsd {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
+ ` movsd {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1} # Lop(Istore(_,_))\n`
end
| Lop(Ialloc n) ->
if !fastcode_flag then begin
let lbl_redo = new_label() in
`{emit_label lbl_redo}: subq ${emit_int n}, %r15\n`;
if !Clflags.dlcode then begin
- ` {load_symbol_addr "caml_young_limit"}, %rax\n`;
- ` cmpq (%rax), %r15\n`;
+(* ` {load_symbol_addr "caml_young_limit"}, %rax\n`;
+ ` cmpq (%rax), %r15\n`; *)
+ ` cmpq 0(%r13), %r15\n`;
end else
- ` cmpq {emit_symbol "caml_young_limit"}(%rip), %r15\n`;
+(* ` cmpq {emit_symbol "caml_young_limit"}(%rip), %r15\n`; *)
+ ` cmpq 0(%r13), %r15\n`;
let lbl_call_gc = new_label() in
let lbl_frame = record_frame_label i.live Debuginfo.none in
` jb {emit_label lbl_call_gc}\n`;
@@ -462,11 +482,11 @@ let emit_instr fallthrough i =
gc_frame = lbl_frame } :: !call_gc_sites
end else begin
begin match n with
- 16 -> ` {emit_call "caml_alloc1"}\n`
- | 24 -> ` {emit_call "caml_alloc2"}\n`
- | 32 -> ` {emit_call "caml_alloc3"}\n`
+ 16 -> ` {emit_call "caml_alloc1_r13"}\n`
+ | 24 -> ` {emit_call "caml_alloc2_r13"}\n`
+ | 32 -> ` {emit_call "caml_alloc3_r13"}\n`
| _ -> ` movq ${emit_int n}, %rax\n`;
- ` {emit_call "caml_allocN"}\n`
+ ` {emit_call "caml_allocN_r13"}\n`
end;
`{record_frame i.live Debuginfo.none} leaq 8(%r15), {emit_reg i.res.(0)}\n`
end
@@ -640,7 +660,7 @@ let emit_instr fallthrough i =
stack_offset := !stack_offset - 16
| Lraise ->
if !Clflags.debug then begin
- ` {emit_call "caml_raise_exn"}\n`;
+ ` {emit_call "caml_raise_exn_r13"}\n`;
record_frame Reg.Set.empty i.dbg
end else begin
` movq %r14, %rsp\n`;
@@ -734,9 +754,12 @@ let emit_item = function
Cglobal_symbol s ->
` .globl {emit_symbol s}\n`;
| Cdefine_symbol s ->
- `{emit_symbol s}:\n`
+ `# emit.mlp: emit_item: Cdefine_symbol case [{emit_string s}]: BEGIN
+\t{emit_symbol s}:
+# emit.mlp: emit_item: Cdefine_symbol case [{emit_string s}]: END\n`
| Cdefine_label lbl ->
- `{emit_data_label lbl}:\n`
+ `# emit.mlp: emit_item: Cdefine_label case
+\t{emit_data_label lbl}:\n`
| Cint8 n ->
` .byte {emit_int n}\n`
| Cint16 n ->
@@ -750,11 +773,16 @@ let emit_item = function
| Cdouble f ->
emit_float64_directive ".quad" f
| Csymbol_address s ->
- ` .quad {emit_symbol s}\n`
+ `# emit.mlp: emit_item: Csymbol_address case [{emit_string s}]: BEGIN
+\t.quad {emit_symbol s}
+# emit.mlp: emit_item: Csymbol_address case [{emit_string s}]: END\n`
| Clabel_address lbl ->
- ` .quad {emit_data_label lbl}\n`
+ `# emit.mlp: emit_item: Clabel_address case
+ .quad {emit_data_label lbl}\n`
| Cstring s ->
- emit_string_directive " .ascii " s
+ `# emit.mlp: emit_item: Cstring case: BEGIN
+\t{emit_string_directive ".ascii " s}# emit.mlp: emit_item: Cstring case: END\n`
+ (* emit_string_directive " .ascii " s *)
| Cskip n ->
if n > 0 then ` .space {emit_int n}\n`
| Calign n ->
View
2 asmcomp/amd64/emit_nt.mlp
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Emission of x86-64 (AMD 64) assembly code, MASM syntax *)
module StringSet =
View
67 asmcomp/amd64/proc.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Description of the AMD64 processor *)
open Misc
@@ -44,17 +46,18 @@ let masm =
r8 6
r9 7
r12 8
- r13 9
- rbp 10
- r10 11
- r11 12
+ r13 context pointer
+ rbp 9
+ r10 10
+ r11 11
r14 trap pointer
r15 allocation pointer
xmm0 - xmm15 100 - 115 *)
(* Conventions:
- rax - r13: OCaml function arguments
+ (* Was: rax - r13: OCaml function arguments *)
+ rax - r12: OCaml function arguments [we reserve r13 --REENTRANTRUNTUME]
rax: OCaml and C function results
xmm0 - xmm9: OCaml function arguments
xmm0: OCaml and C function results
@@ -77,10 +80,10 @@ let int_reg_name =
match Config.ccomp_type with
| "msvc" ->
[| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
- "r12"; "r13"; "rbp"; "r10"; "r11" |]
+ "r12"; (* "r13"; REENTRANTRUNTIME *) "rbp"; "r10"; "r11" |]
| _ ->
[| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
- "%r12"; "%r13"; "%rbp"; "%r10"; "%r11" |]
+ "%r12"; (* "%r13"; REENTRANTRUNTIME *) "%rbp"; "%r10"; "%r11" |]
let float_reg_name =
match Config.ccomp_type with
@@ -101,7 +104,9 @@ let register_class r =
| Addr -> 0
| Float -> 1
-let num_available_registers = [| 13; 16 |]
+let int_reg_nbr = Array.length int_reg_name
+
+let num_available_registers = [| int_reg_nbr; 16 |]
let first_available_register = [| 0; 100 |]
@@ -115,8 +120,8 @@ let rotate_registers = false
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
- let v = Array.create 13 Reg.dummy in
- for i = 0 to 12 do v.(i) <- Reg.at_location Int (Reg i) done;
+ let v = Array.create int_reg_nbr Reg.dummy in
+ for i = 0 to int_reg_nbr - 1 do v.(i) <- Reg.at_location Int (Reg i) done;
v
let hard_float_reg =
@@ -176,9 +181,9 @@ let outgoing ofs = Outgoing ofs
let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
let loc_arguments arg =
- calling_conventions 0 9 100 109 outgoing arg
+ calling_conventions 0 (*9 [%r13 is not usable for this any more] REENTRANTRUNTIME*)8 100 109 outgoing arg
let loc_parameters arg =
- let (loc, ofs) = calling_conventions 0 9 100 109 incoming arg in loc
+ let (loc, ofs) = calling_conventions 0 (*9 [same as above] REENTRANTRUNTIME*)8 100 109 incoming arg in loc
let loc_results res =
let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc
@@ -199,7 +204,7 @@ let loc_external_results res =
let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc
let unix_loc_external_arguments arg =
- calling_conventions 2 7 100 107 outgoing arg
+ calling_conventions 2 (*%rdi..%r9: no need to touch this REENTRANTRUNTIME*)7 100 107 outgoing arg
let win64_int_external_arguments =
[| 5 (*rcx*); 4 (*rdx*); 6 (*r8*); 7 (*r9*) |]
@@ -242,12 +247,12 @@ let destroyed_at_c_call =
if win64 then
(* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *)
Array.of_list(List.map phys_reg
- [0;4;5;6;7;11;12;
+ [0;4;5;6;7;(*r10 REENTRANTRUNTIME*)(* 11 *)10;(*r11 REENTRANTRUNTIME*)(* 12 *)11;
100;101;102;103;104;105])
else
(* Unix: rbp, rbx, r12-r15 preserved *)
Array.of_list(List.map phys_reg
- [0;2;3;4;5;6;7;11;12;
+ [0;2;3;4;5;6;7;(*r10 REENTRANTRUNTIME*)(* 11 *)10;(*r11 REENTRANTRUNTIME*)(* 12 *)11;
100;101;102;103;104;105;106;107;
108;109;110;111;112;113;114;115])
@@ -265,17 +270,35 @@ let destroyed_at_raise = all_phys_regs
(* Maximal register pressure *)
+(* Pre-multi-runtime version: REENTRANTRUNTIME *)
+(* let safe_register_pressure = function *)
+(* Iextcall(_,_) -> if win64 then 8 else 0 *)
+(* | _ -> 11 *)
+(* let max_register_pressure = function *)
+(* Iextcall(_, _) -> if win64 then [| 8; 10 |] else [| 4; 0 |] *)
+(* | Iintop(Idiv | Imod) -> [| 11; 16 |] *)
+(* | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _) *)
+(* -> [| 12; 16 |] *)
+(* | Istore(Single, _) -> [| 13; 15 |] *)
+(* | _ -> [| 13; 16 |] *)
+
+(* Reduced the number of available integer registers, since we
+ reserved r13, which is not used any more by the generated
+ code. REENTRANTRUNTIME*)
let safe_register_pressure = function
- Iextcall(_,_) -> if win64 then 8 else 0
- | _ -> 11
+ Iextcall(_,_) -> if win64 then 7 else 0
+ | _ -> 10
+(* Reduced the number of available integer registers, since we
+ reserved r13, which is not used any more by the generated
+ code. REENTRANTRUNTIME*)
let max_register_pressure = function
- Iextcall(_, _) -> if win64 then [| 8; 10 |] else [| 4; 0 |]
- | Iintop(Idiv | Imod) -> [| 11; 16 |]
+ Iextcall(_, _) -> if win64 then [| 7; 10 |] else [| 3; 0 |]
+ | Iintop(Idiv | Imod) -> [| 10; 16 |]
| Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _)
- -> [| 12; 16 |]
- | Istore(Single, _) -> [| 13; 15 |]
- | _ -> [| 13; 16 |]
+ -> [| 11; 16 |]
+ | Istore(Single, _) -> [| 12; 15 |]
+ | _ -> [| 12; 16 |]
(* Layout of the stack frame *)
View
2 asmcomp/amd64/reload.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
open Cmm
open Arch
open Reg
View
2 asmcomp/amd64/scheduling.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
let _ = let module M = Schedgen in () (* to create a dependency *)
(* Scheduling is turned off because the processor schedules dynamically
View
10 asmcomp/amd64/selection.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Instruction selection for the AMD64 *)
open Arch
@@ -28,7 +30,7 @@ type addressing_expr =
let rec select_addr exp =
match exp with
- Cconst_symbol s when not !Clflags.dlcode ->
+ Cconst_symbol (s, _) when not !Clflags.dlcode ->
(Asymbol s, 0)
| Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
let (a, n) = select_addr arg in (a, n + m)
@@ -144,7 +146,11 @@ method! select_store addr exp =
(Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple [])
| Cconst_natpointer n when self#is_immediate_natint n ->
(Ispecific(Istore_int(n, addr)), Ctuple [])
- | Cconst_symbol s when not (!pic_code || !Clflags.dlcode) ->
+ | Cconst_symbol (s, Cconstant_kind) when not (!pic_code || !Clflags.dlcode) ->
+ Printf.printf "selection.ml: select_store: %s Cconstant_kind\n" s;
+ (Ispecific(Istore_symbol(s, addr)), Ctuple [])
+ | Cconst_symbol (s, Cglobal_kind) when not (!pic_code || !Clflags.dlcode) ->
+ Printf.printf "selection.ml: select_store: %s Cglobal_kind\n" s;
(Ispecific(Istore_symbol(s, addr)), Ctuple [])
| _ ->
super#select_store addr exp
View
7 asmcomp/arm/arch.ml
@@ -11,13 +11,15 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Specific operations for the ARM processor *)
open Format
type abi = EABI | EABI_VFP
type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7
-type fpu = Soft | VFPv2 | VFPv3_D16 | VFPv3
+type fpu = Soft | VFPv3_D16 | VFPv3
let abi =
match Config.system with
@@ -35,7 +37,6 @@ let string_of_arch = function
let string_of_fpu = function
Soft -> "soft"
- | VFPv2 -> "vfpv2"
| VFPv3_D16 -> "vfpv3-d16"
| VFPv3 -> "vfpv3"
@@ -51,7 +52,6 @@ let (arch, fpu, thumb) =
| EABI, "armv6t2" -> ARMv6T2, Soft, false
| EABI, "armv7" -> ARMv7, Soft, false
| EABI, _ -> ARMv4, Soft, false
- | EABI_VFP, "armv6" -> ARMv6, VFPv2, false
| EABI_VFP, _ -> ARMv7, VFPv3_D16, true
end in
(ref def_arch, ref def_fpu, ref def_thumb)
@@ -71,7 +71,6 @@ let farch spec =
let ffpu spec =
fpu := (match spec with
"soft" when abi <> EABI_VFP -> Soft
- | "vfpv2" when abi = EABI_VFP -> VFPv2
| "vfpv3-d16" when abi = EABI_VFP -> VFPv3_D16
| "vfpv3" when abi = EABI_VFP -> VFPv3
| spec -> raise (Arg.Bad spec))
View
13 asmcomp/arm/emit.mlp
@@ -11,6 +11,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Emission of ARM assembly code *)
open Misc
@@ -399,10 +401,6 @@ let emit_instr i =
` ldr {emit_reg i.res.(1)}, {emit_label lbl} + 4\n`;
2
end
- | Lop(Iconst_float f) when !fpu = VFPv2 ->
- let lbl = float_literal f in
- ` fldd {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n`;
- 1
| Lop(Iconst_float f) ->
let encode imm =
let sg = Int64.to_int (Int64.shift_right_logical imm 63) in
@@ -469,7 +467,7 @@ let emit_instr i =
let ninstr = emit_stack_adjustment (-n) in
stack_offset := !stack_offset + n;
ninstr
- | Lop(Iload(Single, addr)) when !fpu >= VFPv2 ->
+ | Lop(Iload(Single, addr)) when !fpu >= VFPv3_D16 ->
` flds s14, {emit_addressing addr i.arg 0}\n`;
` fcvtds {emit_reg i.res.(0)}, s14\n`; 2
| Lop(Iload((Double | Double_u), addr)) when !fpu = Soft ->
@@ -503,7 +501,7 @@ let emit_instr i =
| Double_u -> "fldd"
| _ (* 32-bit quantities *) -> "ldr" in
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1
- | Lop(Istore(Single, addr)) when !fpu >= VFPv2 ->
+ | Lop(Istore(Single, addr)) when !fpu >= VFPv3_D16 ->
` fcvtsd s14, {emit_reg i.arg.(0)}\n`;
` fsts s14, {emit_addressing addr i.arg 1}\n`; 2
| Lop(Istore((Double | Double_u), addr)) when !fpu = Soft ->
@@ -809,7 +807,7 @@ let rec emit_all ninstr i =
let n = emit_instr i in
let ninstr' = ninstr + n in
(* fldd can address up to +/-1KB, ldr can address up to +/-4KB *)
- let limit = (if !fpu >= VFPv2 && !float_literals <> []
+ let limit = (if !fpu >= VFPv3_D16 && !float_literals <> []
then 127
else 511) in
let limit = limit - !num_literals in
@@ -911,7 +909,6 @@ let begin_assembly() =
end;
begin match !fpu with
Soft -> ` .fpu softvfp\n`
- | VFPv2 -> ` .fpu vfpv2\n`
| VFPv3_D16 -> ` .fpu vfpv3-d16\n`
| VFPv3 -> ` .fpu vfpv3\n`
end;
View
11 asmcomp/arm/proc.ml
@@ -11,6 +11,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Description of the ARM processor *)
open Misc
@@ -36,7 +38,7 @@ let word_addressed = false
r13 stack pointer
r14 return address
r15 program counter
- Floating-point register map (VFPv{2,3}):
+ Floatinng-point register map (VFPv3):
d0 - d7 general purpose (not preserved)
d8 - d15 general purpose (preserved)
d16 - d31 generat purpose (not preserved), VFPv3 only
@@ -53,9 +55,9 @@ let float_reg_name =
(* We have three register classes:
0 for integer registers
- 1 for VFPv2 and VFPv3-D16
+ 1 for VFPv3-D16
2 for VFPv3
- This way we can choose between VFPv2/VFPv3-D16 and VFPv3
+ This way we can choose between VFPv3-D16 and VFPv3
at (ocamlopt) runtime using command line switches.
*)
@@ -64,7 +66,6 @@ let num_register_classes = 3
let register_class r =
match (r.typ, !fpu) with
(Int | Addr), _ -> 0
- | Float, VFPv2 -> 1
| Float, VFPv3_D16 -> 1
| Float, _ -> 2
@@ -124,7 +125,7 @@ let calling_conventions
end
| Float ->
assert (abi = EABI_VFP);
- assert (!fpu >= VFPv2);
+ assert (!fpu >= VFPv3_D16);
if !float <= last_float then begin
loc.(i) <- phys_reg !float;
incr float
View
2 asmcomp/arm/reload.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Reloading for the ARM *)
let fundecl f =
View
6 asmcomp/arm/scheduling.ml
@@ -11,6 +11,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
open Arch
open Mach
@@ -40,7 +42,7 @@ method oper_latency = function
| Imulf | Ispecific Inegmulf
| Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)
| Ispecific Isqrtf
- | Inegf | Iabsf when !fpu >= VFPv2 -> 2
+ | Inegf | Iabsf when !fpu >= VFPv3_D16 -> 2
(* Everything else *)
| _ -> 1
@@ -70,7 +72,7 @@ method oper_issue_cycles = function
| Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> 17
| Idivf
| Ispecific Isqrtf -> 27
- | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv2 -> 4
+ | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv3_D16 -> 4
(* Everything else *)
| _ -> 1
View
12 asmcomp/arm/selection.ml
@@ -11,6 +11,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Instruction selection for the ARM processor *)
open Arch
@@ -20,9 +22,9 @@ open Mach
let is_offset chunk n =
match chunk with
- (* VFPv{2,3} load/store have -1020 to 1020 *)
+ (* VFPv3 load/store have -1020 to 1020 *)
Single | Double | Double_u
- when !fpu >= VFPv2 ->
+ when !fpu >= VFPv3_D16 ->
n >= -1020 && n <= 1020
(* ARM load/store byte/word have -4095 to 4095 *)
| Byte_unsigned | Byte_signed
@@ -57,7 +59,7 @@ let pseudoregs_for_operation op arg res =
(* Soft-float Iabsf and Inegf: arg.(0) and res.(0) must be the same *)
| Iabsf | Inegf when !fpu = Soft ->
([|res.(0); arg.(1)|], res)
- (* VFPv{2,3} Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *)
+ (* VFPv3 Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *)
| Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) ->
let arg' = Array.copy arg in
arg'.(0) <- res.(0);
@@ -91,7 +93,7 @@ method is_immediate n =
method! is_simple_expr = function
(* inlined floating-point ops are simple if their arguments are *)
- | Cop(Cextcall("sqrt", _, _, _), args) when !fpu >= VFPv2 ->
+ | Cop(Cextcall("sqrt", _, _, _), args) when !fpu >= VFPv3_D16 ->
List.for_all self#is_simple_expr args
| e -> super#is_simple_expr e
@@ -176,7 +178,7 @@ method! select_operation op args =
(Iextcall("__aeabi_idivmod", false), args)
(* Turn floating-point operations into runtime ABI calls for softfp *)
| (op, args) when !fpu = Soft -> self#select_operation_softfp op args
- (* Select operations for VFPv{2,3} *)
+ (* Select operations for VFPv3 *)
| (op, args) -> self#select_operation_vfpv3 op args
method private select_operation_softfp op args =
View
6 asmcomp/asmgen.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* From lambda to assembly code *)
open Format
@@ -35,9 +37,6 @@ let pass_dump_linear_if ppf flag message phrase =
if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
phrase
-let clambda_dump_if ppf ulambda =
- if !dump_clambda then Printclambda.clambda ppf ulambda; ulambda
-
let rec regalloc ppf round fd =
if round > 50 then
fatal_error(fd.Mach.fun_name ^
@@ -105,7 +104,6 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) =
Emitaux.output_channel := oc;
Emit.begin_assembly();
Closure.intro size lam
- ++ clambda_dump_if ppf
++ Cmmgen.compunit size
++ List.iter (compile_phrase ppf) ++ (fun () -> ());
(match toplevel with None -> () | Some f -> compile_genfuns ppf f);
View
2 asmcomp/asmgen.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* From lambda to assembly code *)
val compile_implementation :
View
2 asmcomp/asmlibrarian.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Build libraries of .cmx files *)
open Misc
View
2 asmcomp/asmlibrarian.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Build libraries of .cmx files *)
open Format
View
2 asmcomp/asmlink.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Link a set of .cmx/.o files and produce an executable *)
open Misc
View
2 asmcomp/asmlink.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Link a set of .cmx/.o files and produce an executable or a plugin *)
open Format
View
2 asmcomp/asmpackager.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* "Package" a set of .cmx/.o files into one .cmx/.o file having the
original compilation units as sub-modules. *)
View
2 asmcomp/asmpackager.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* "Package" a set of .cmx/.o files into one .cmx/.o file having the
original compilation units as sub-modules. *)
View
2 asmcomp/clambda.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* A variant of the "lambda" code with direct / indirect calls explicit
and closures explicit too *)
View
2 asmcomp/clambda.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* A variant of the "lambda" code with direct / indirect calls explicit
and closures explicit too *)
View
2 asmcomp/closure.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Introduction of closures, uncurrying, recognition of direct calls *)
open Misc
View
2 asmcomp/closure.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Introduction of closures, uncurrying, recognition of direct calls *)
val intro: int -> Lambda.lambda -> Clambda.ulambda
View
10 asmcomp/cmm.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
type machtype_component =
Addr
| Int
@@ -66,7 +68,7 @@ type memory_chunk =
type operation =
Capply of machtype * Debuginfo.t
- | Cextcall of string * machtype * bool * Debuginfo.t
+ | Cextcall of string * machtype * bool * bool * Debuginfo.t
| Cload of memory_chunk
| Calloc
| Cstore of memory_chunk
@@ -82,11 +84,15 @@ type operation =
| Craise of Debuginfo.t
| Ccheckbound of Debuginfo.t
+type symbol_kind =
+ Cglobal_kind
+ | Cconstant_kind
+
type expression =
Cconst_int of int
| Cconst_natint of nativeint
| Cconst_float of string
- | Cconst_symbol of string
+ | Cconst_symbol of string * symbol_kind
| Cconst_pointer of int
| Cconst_natpointer of nativeint
| Cvar of Ident.t
View
10 asmcomp/cmm.mli
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Second intermediate language (machine independent) *)
type machtype_component =
@@ -52,7 +54,7 @@ type memory_chunk =
type operation =
Capply of machtype * Debuginfo.t
- | Cextcall of string * machtype * bool * Debuginfo.t
+ | Cextcall of string * machtype * bool * bool * Debuginfo.t
| Cload of memory_chunk
| Calloc
| Cstore of memory_chunk
@@ -68,11 +70,15 @@ type operation =
| Craise of Debuginfo.t
| Ccheckbound of Debuginfo.t
+type symbol_kind =
+ Cglobal_kind
+ | Cconstant_kind
+
type expression =
Cconst_int of int
| Cconst_natint of nativeint
| Cconst_float of string
- | Cconst_symbol of string
+ | Cconst_symbol of string * symbol_kind
| Cconst_pointer of int
| Cconst_natpointer of nativeint
| Cvar of Ident.t
View
246 asmcomp/cmmgen.ml
@@ -10,6 +10,8 @@
(* *)
(***********************************************************************)
+(* $Id$ *)
+
(* Translation from closed lambda to C-- *)
open Misc
@@ -175,7 +177,7 @@ let safe_divmod op c1 c2 dbg =
Cifthenelse(c2,
Cop(op, [c1; c2]),
Cop(Craise dbg,
- [Cconst_symbol "caml_bucket_Division_by_zero"])))
+ [Cconst_symbol ("caml_bucket_Division_by_zero", Cconstant_kind)])))
(* Division or modulo on boxed integers. The overflow case min_int / -1
can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)
@@ -196,7 +198,7 @@ let safe_divmod_bi mkop mkm1 c1 c2 bi dbg =
else
Cifthenelse(c2, c3,
Cop(Craise dbg,
- [Cconst_symbol "caml_bucket_Division_by_zero"]))))
+ [Cconst_symbol ("caml_bucket_Division_by_zero", Cconstant_kind)]))))
let safe_div_bi =
safe_divmod_bi (fun c1 c2 -> Cop(Cdivi, [c1;c2]))
@@ -258,8 +260,8 @@ let rec remove_unit = function
Clet(id, c1, remove_unit c2)
| Cop(Capply (mty, dbg), args) ->
Cop(Capply (typ_void, dbg), args)
- | Cop(Cextcall(proc, mty, alloc, dbg), args) ->
- Cop(Cextcall(proc, typ_void, alloc, dbg), args)
+ | Cop(Cextcall(proc, mty, alloc, ctx, dbg), args) ->
+ Cop(Cextcall(proc, typ_void, alloc, ctx, dbg), args)
| Cexit (_,_) as c -> c
| Ctuple [] as c -> c
| c -> Csequence