API tools faq
paste
Guest User

Untitled

a guest
Feb 18th, 2019
81
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.49 KB | None | 0 0
raw download clone embed print report
  1. diff -Bwiu --recursive ../Caml4.00/src.OLD/ocaml-4.00.1/utils/misc.ml build/ocaml-4.00.1/utils/misc.ml
  2. --- ../Caml4.00/src.OLD/ocaml-4.00.1/utils/misc.ml 2012-07-30 11:59:07.000000000 -0700
  3. +++ build/ocaml-4.00.1/utils/misc.ml 2013-03-25 13:29:03.077942186 -0700
  4. @@ -224,3 +224,52 @@
  5. let fst4 (x, _, _, _) = x
  6. let snd4 (_,x,_, _) = x
  7. let thd4 (_,_,x,_) = x
  8. +
  9. +(* Long string *)
  10. +
  11. +module LongString = struct
  12. + type t = string array
  13. +
  14. + let create str_size =
  15. + let tbl_size = str_size / Sys.max_string_length + 1 in
  16. + let tbl = Array.make tbl_size "" in
  17. + for i = 0 to tbl_size - 2 do
  18. + tbl.(i) <- String.create Sys.max_string_length;
  19. + done;
  20. + tbl.(tbl_size - 1) <- String.create (str_size mod Sys.max_string_length);
  21. + tbl
  22. + ;;
  23. +
  24. + let length tbl =
  25. + let tbl_size = Array.length tbl in
  26. + Sys.max_string_length * (tbl_size - 1) + String.length tbl.(tbl_size - 1)
  27. + ;;
  28. +
  29. + let get tbl ind =
  30. + tbl.(ind / Sys.max_string_length).[ind mod Sys.max_string_length]
  31. + ;;
  32. +
  33. + let set tbl ind c =
  34. + tbl.(ind / Sys.max_string_length).[ind mod Sys.max_string_length] <- c;
  35. + ;;
  36. +
  37. + let blit src srcoff dst dstoff len =
  38. + for i = 0 to len - 1 do set dst (dstoff + i) (get src (srcoff + i)) done
  39. + ;;
  40. +
  41. + let output oc tbl pos len =
  42. + for i = pos to pos + len - 1 do output_char oc (get tbl i) done;
  43. + ;;
  44. +
  45. + let unsafe_blit src srcoff dst dstoff len =
  46. + for i = 0 to len - 1 do
  47. + String.unsafe_set dst (dstoff + i) (get src (srcoff + i))
  48. + done;
  49. + ;;
  50. +
  51. + let input_bytes ic len =
  52. + let tbl = create len in
  53. + Array.iter (fun str -> really_input ic str 0 (String.length str)) tbl;
  54. + tbl
  55. + ;;
  56. +end;;
  57. diff -Bwiu --recursive ../Caml4.00/src.OLD/ocaml-4.00.1/utils/misc.mli build/ocaml-4.00.1/utils/misc.mli
  58. --- ../Caml4.00/src.OLD/ocaml-4.00.1/utils/misc.mli 2012-05-30 06:29:48.000000000 -0700
  59. +++ build/ocaml-4.00.1/utils/misc.mli 2013-03-25 13:29:03.077942186 -0700
  60. @@ -122,3 +122,16 @@
  61. val fst4: 'a * 'b * 'c * 'd -> 'a
  62. val snd4: 'a * 'b * 'c * 'd -> 'b
  63. val thd4: 'a * 'b * 'c * 'd -> 'c
  64. +
  65. +module LongString :
  66. + sig
  67. + type t = string array
  68. + val create : int -> string array
  69. + val length : string array -> int
  70. + val get : string array -> int -> char
  71. + val set : string array -> int -> char -> unit
  72. + val blit : string array -> int -> string array -> int -> int -> unit
  73. + val output : out_channel -> string array -> int -> int -> unit
  74. + val unsafe_blit : string array -> int -> string -> int -> int -> unit
  75. + val input_bytes : in_channel -> int -> t
  76. + end
  77. diff -Bwiu --recursive ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/bytelink.ml build/ocaml-4.00.1/bytecomp/bytelink.ml
  78. --- ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/bytelink.ml 2012-04-16 08:27:42.000000000 -0700
  79. +++ build/ocaml-4.00.1/bytecomp/bytelink.ml 2013-03-25 13:37:38.017927130 -0700
  80. @@ -188,21 +188,21 @@
  81.  
  82. (* Record compilation events *)
  83.  
  84. -let debug_info = ref ([] : (int * string) list)
  85. +let debug_info = ref ([] : (int * LongString.t) list)
  86.  
  87. (* Link in a compilation unit *)
  88.  
  89. let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
  90. check_consistency ppf file_name compunit;
  91. seek_in inchan compunit.cu_pos;
  92. - let code_block = input_bytes inchan compunit.cu_codesize in
  93. - Symtable.patch_object code_block compunit.cu_reloc;
  94. + let code_block = LongString.input_bytes inchan compunit.cu_codesize in
  95. + Symtable.ls_patch_object code_block compunit.cu_reloc;
  96. if !Clflags.debug && compunit.cu_debug > 0 then begin
  97. seek_in inchan compunit.cu_debug;
  98. - let buffer = input_bytes inchan compunit.cu_debugsize in
  99. + let buffer = LongString.input_bytes inchan compunit.cu_debugsize in
  100. debug_info := (currpos_fun(), buffer) :: !debug_info
  101. end;
  102. - output_fun code_block;
  103. + Array.iter output_fun code_block;
  104. if !Clflags.link_everything then
  105. List.iter Symtable.require_primitive compunit.cu_primitives
  106.  
  107. @@ -255,7 +255,7 @@
  108. let output_debug_info oc =
  109. output_binary_int oc (List.length !debug_info);
  110. List.iter
  111. - (fun (ofs, evl) -> output_binary_int oc ofs; output_string oc evl)
  112. + (fun (ofs, evl) -> output_binary_int oc ofs; Array.iter (output_string oc) evl)
  113. !debug_info;
  114. debug_info := []
  115.  
  116. diff -Bwiu --recursive ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/emitcode.ml build/ocaml-4.00.1/bytecomp/emitcode.ml
  117. --- ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/emitcode.ml 2011-07-27 07:17:02.000000000 -0700
  118. +++ build/ocaml-4.00.1/bytecomp/emitcode.ml 2013-03-25 13:29:03.077942186 -0700
  119. @@ -24,21 +24,21 @@
  120.  
  121. (* Buffering of bytecode *)
  122.  
  123. -let out_buffer = ref(String.create 1024)
  124. +let out_buffer = ref(LongString.create 1024)
  125. and out_position = ref 0
  126.  
  127. let out_word b1 b2 b3 b4 =
  128. let p = !out_position in
  129. - if p >= String.length !out_buffer then begin
  130. - let len = String.length !out_buffer in
  131. - let new_buffer = String.create (2 * len) in
  132. - String.blit !out_buffer 0 new_buffer 0 len;
  133. + if p >= LongString.length !out_buffer then begin
  134. + let len = LongString.length !out_buffer in
  135. + let new_buffer = LongString.create (2 * len) in
  136. + LongString.blit !out_buffer 0 new_buffer 0 len;
  137. out_buffer := new_buffer
  138. end;
  139. - String.unsafe_set !out_buffer p (Char.unsafe_chr b1);
  140. - String.unsafe_set !out_buffer (p+1) (Char.unsafe_chr b2);
  141. - String.unsafe_set !out_buffer (p+2) (Char.unsafe_chr b3);
  142. - String.unsafe_set !out_buffer (p+3) (Char.unsafe_chr b4);
  143. + LongString.set !out_buffer p (Char.unsafe_chr b1);
  144. + LongString.set !out_buffer (p+1) (Char.unsafe_chr b2);
  145. + LongString.set !out_buffer (p+2) (Char.unsafe_chr b3);
  146. + LongString.set !out_buffer (p+3) (Char.unsafe_chr b4);
  147. out_position := p + 4
  148.  
  149. let out opcode =
  150. @@ -88,10 +88,10 @@
  151.  
  152. let backpatch (pos, orig) =
  153. let displ = (!out_position - orig) asr 2 in
  154. - !out_buffer.[pos] <- Char.unsafe_chr displ;
  155. - !out_buffer.[pos+1] <- Char.unsafe_chr (displ asr 8);
  156. - !out_buffer.[pos+2] <- Char.unsafe_chr (displ asr 16);
  157. - !out_buffer.[pos+3] <- Char.unsafe_chr (displ asr 24)
  158. + LongString.set !out_buffer pos (Char.unsafe_chr displ);
  159. + LongString.set !out_buffer (pos+1) (Char.unsafe_chr (displ asr 8));
  160. + LongString.set !out_buffer (pos+2) (Char.unsafe_chr (displ asr 16));
  161. + LongString.set !out_buffer (pos+3) (Char.unsafe_chr (displ asr 24))
  162.  
  163. let define_label lbl =
  164. if lbl >= Array.length !label_table then extend_label_table lbl;
  165. @@ -359,7 +359,7 @@
  166. output_binary_int outchan 0;
  167. let pos_code = pos_out outchan in
  168. emit code;
  169. - output outchan !out_buffer 0 !out_position;
  170. + LongString.output outchan !out_buffer 0 !out_position;
  171. let (pos_debug, size_debug) =
  172. if !Clflags.debug then begin
  173. let p = pos_out outchan in
  174. @@ -392,7 +392,7 @@
  175. emit init_code;
  176. emit fun_code;
  177. let code = Meta.static_alloc !out_position in
  178. - String.unsafe_blit !out_buffer 0 code 0 !out_position;
  179. + LongString.unsafe_blit !out_buffer 0 code 0 !out_position;
  180. let reloc = List.rev !reloc_info
  181. and code_size = !out_position in
  182. init();
  183. @@ -403,7 +403,7 @@
  184. let to_packed_file outchan code =
  185. init();
  186. emit code;
  187. - output outchan !out_buffer 0 !out_position;
  188. + LongString.output outchan !out_buffer 0 !out_position;
  189. let reloc = !reloc_info in
  190. init();
  191. reloc
  192. diff -Bwiu --recursive ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/symtable.ml build/ocaml-4.00.1/bytecomp/symtable.ml
  193. --- ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/symtable.ml 2012-06-21 08:55:03.000000000 -0700
  194. +++ build/ocaml-4.00.1/bytecomp/symtable.ml 2013-03-25 13:29:03.077942186 -0700
  195. @@ -177,25 +177,28 @@
  196. (* Must use the unsafe String.set here because the block may be
  197. a "fake" string as returned by Meta.static_alloc. *)
  198.  
  199. -let patch_int buff pos n =
  200. - String.unsafe_set buff pos (Char.unsafe_chr n);
  201. - String.unsafe_set buff (pos + 1) (Char.unsafe_chr (n asr 8));
  202. - String.unsafe_set buff (pos + 2) (Char.unsafe_chr (n asr 16));
  203. - String.unsafe_set buff (pos + 3) (Char.unsafe_chr (n asr 24))
  204. +let gen_patch_int str_set buff pos n =
  205. + str_set buff pos (Char.unsafe_chr n);
  206. + str_set buff (pos + 1) (Char.unsafe_chr (n asr 8));
  207. + str_set buff (pos + 2) (Char.unsafe_chr (n asr 16));
  208. + str_set buff (pos + 3) (Char.unsafe_chr (n asr 24))
  209.  
  210. -let patch_object buff patchlist =
  211. +let gen_patch_object str_set buff patchlist =
  212. List.iter
  213. (function
  214. (Reloc_literal sc, pos) ->
  215. - patch_int buff pos (slot_for_literal sc)
  216. + gen_patch_int str_set buff pos (slot_for_literal sc)
  217. | (Reloc_getglobal id, pos) ->
  218. - patch_int buff pos (slot_for_getglobal id)
  219. + gen_patch_int str_set buff pos (slot_for_getglobal id)
  220. | (Reloc_setglobal id, pos) ->
  221. - patch_int buff pos (slot_for_setglobal id)
  222. + gen_patch_int str_set buff pos (slot_for_setglobal id)
  223. | (Reloc_primitive name, pos) ->
  224. - patch_int buff pos (num_of_prim name))
  225. + gen_patch_int str_set buff pos (num_of_prim name))
  226. patchlist
  227.  
  228. +let patch_object = gen_patch_object String.unsafe_set
  229. +let ls_patch_object = gen_patch_object LongString.set
  230. +
  231. (* Translate structured constants *)
  232.  
  233. let rec transl_const = function
  234. diff -Bwiu --recursive ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/symtable.mli build/ocaml-4.00.1/bytecomp/symtable.mli
  235. --- ../Caml4.00/src.OLD/ocaml-4.00.1/bytecomp/symtable.mli 2011-12-13 09:50:08.000000000 -0800
  236. +++ build/ocaml-4.00.1/bytecomp/symtable.mli 2013-03-25 13:29:03.077942186 -0700
  237. @@ -20,6 +20,7 @@
  238.  
  239. val init: unit -> unit
  240. val patch_object: string -> (reloc_info * int) list -> unit
  241. +val ls_patch_object: Misc.LongString.t -> (reloc_info * int) list -> unit
  242. val require_primitive: string -> unit
  243. val initial_global_table: unit -> Obj.t array
  244. val output_global_map: out_channel -> unit
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!