API tools faq
paste
Guest User

Untitled

a guest
Feb 18th, 2019
102
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 17.02 KB | None | 0 0
raw download clone embed print report
  1. diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
  2. index cfcb0c9..e6cb78d 100644
  3. --- a/asmcomp/arm/emit.mlp
  4. +++ b/asmcomp/arm/emit.mlp
  5. @@ -33,11 +33,23 @@ let fastcode_flag = ref true
  6. let emit_label lbl =
  7. emit_string ".L"; emit_int lbl
  8.  
  9. -(* Output a symbol *)
  10. +(* Symbols *)
  11.  
  12. let emit_symbol s =
  13. Emitaux.emit_symbol '$' s
  14.  
  15. +(* Returns true if the symbol s is local to the current unit *)
  16. +let is_local_symbol s =
  17. + let p = (Compilenv.make_symbol (Some "")) in
  18. + try p = (String.sub s 0 (String.length p))
  19. + with Invalid_argument _ -> false
  20. +
  21. +let emit_branch instr s =
  22. + (* Local symbols don't need to branch through the PLT *)
  23. + if not !Clflags.dlcode || is_local_symbol s
  24. + then `{emit_string instr} {emit_symbol s}`
  25. + else `{emit_string instr} {emit_symbol s}(PLT)`
  26. +
  27. (* Output a pseudo-register *)
  28.  
  29. let emit_reg r =
  30. @@ -77,16 +89,9 @@ let emit_addressing addr r n =
  31. Iindexed ofs ->
  32. `[{emit_reg r.(n)}, #{emit_int ofs}]`
  33.  
  34. -(* Record live pointers at call points *)
  35. -
  36. -type frame_descr =
  37. - { fd_lbl: int; (* Return address *)
  38. - fd_frame_size: int; (* Size of stack frame *)
  39. - fd_live_offset: int list } (* Offsets/regs of live addresses *)
  40. +(* Record live pointers at call points -- see Emitaux *)
  41.  
  42. -let frame_descriptors = ref([] : frame_descr list)
  43. -
  44. -let record_frame live =
  45. +let record_frame_label live dbg =
  46. let lbl = new_label() in
  47. let live_offset = ref [] in
  48. Reg.Set.iter
  49. @@ -100,18 +105,25 @@ let record_frame live =
  50. frame_descriptors :=
  51. { fd_lbl = lbl;
  52. fd_frame_size = frame_size();
  53. - fd_live_offset = !live_offset } :: !frame_descriptors;
  54. - `{emit_label lbl}:`
  55. -
  56. -let emit_frame fd =
  57. - ` .word {emit_label fd.fd_lbl} + 4\n`;
  58. - ` .short {emit_int fd.fd_frame_size}\n`;
  59. - ` .short {emit_int (List.length fd.fd_live_offset)}\n`;
  60. - List.iter
  61. - (fun n ->
  62. - ` .short {emit_int n}\n`)
  63. - fd.fd_live_offset;
  64. - ` .align 2\n`
  65. + fd_live_offset = !live_offset;
  66. + fd_debuginfo = dbg } :: !frame_descriptors;
  67. + lbl
  68. +
  69. +let record_frame live dbg =
  70. + let lbl = record_frame_label live dbg in `{emit_label lbl}:`
  71. +
  72. +(* Record calls to the GC -- we've moved them out of the way *)
  73. +
  74. +type gc_call =
  75. + { gc_lbl: label; (* Entry label *)
  76. + gc_return_lbl: label; (* Where to branch after GC *)
  77. + gc_frame_lbl: label } (* Label of frame descriptor *)
  78. +
  79. +let call_gc_sites = ref ([] : gc_call list)
  80. +
  81. +let emit_call_gc gc =
  82. + `{emit_label gc.gc_lbl}: {emit_branch "bl" "caml_invoke_gc"}\n`;
  83. + `{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
  84.  
  85. (* Names of various instructions *)
  86.  
  87. @@ -236,11 +248,11 @@ let label_constant tbl s size =
  88. let emit_constants () =
  89. Hashtbl.iter
  90. (fun s lbl ->
  91. - `{emit_label lbl}: .word {emit_symbol s}\n`)
  92. + `{emit_label lbl}: .word {emit_symbol s}\n`)
  93. symbol_constants;
  94. Hashtbl.iter
  95. (fun s lbl ->
  96. - `{emit_label lbl}: .double {emit_string s}\n`)
  97. + `{emit_label lbl}: .double {emit_string s}\n`)
  98. float_constants;
  99. Hashtbl.clear symbol_constants;
  100. Hashtbl.clear float_constants;
  101. @@ -285,9 +297,11 @@ let emit_instr i =
  102. ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_symbol s}\n`; 1
  103. | Lop(Icall_ind) ->
  104. ` mov lr, pc\n`;
  105. - `{record_frame i.live} bx {emit_reg i.arg.(0)}\n`; 2
  106. + ` bx {emit_reg i.arg.(0)}\n`;
  107. + record_frame i.live i.dbg; 2
  108. | Lop(Icall_imm s) ->
  109. - `{record_frame i.live} bl {emit_symbol s}\n`; 1
  110. + ` {emit_branch "bl" s}\n`;
  111. + record_frame i.live i.dbg; 1
  112. | Lop(Itailcall_ind) ->
  113. let n = frame_size() in
  114. if !contains_calls then
  115. @@ -306,14 +320,13 @@ let emit_instr i =
  116. ` b {emit_symbol s}\n`;
  117. 2 + ninstr
  118. end
  119. - | Lop(Iextcall(s, alloc)) ->
  120. - if alloc then begin
  121. - let lbl = label_constant symbol_constants s 1 in
  122. - ` ldr r12, {emit_label lbl} @ {emit_symbol s}\n`;
  123. - `{record_frame i.live} bl caml_c_call\n`; 2
  124. - end else begin
  125. - ` bl {emit_symbol s}\n`; 1
  126. - end
  127. + | Lop(Iextcall(s, true)) ->
  128. + let lbl = label_constant symbol_constants s 1 in
  129. + ` ldr r10, {emit_label lbl} @ {emit_symbol s}\n`;
  130. + ` {emit_branch "bl" "caml_c_invoke"}\n`;
  131. + record_frame i.live i.dbg; 2
  132. + | Lop(Iextcall(s, false)) ->
  133. + ` {emit_branch "bl" s}\n`; 1
  134. | Lop(Istackoffset n) ->
  135. assert (n mod 8 = 0);
  136. let ninstr =
  137. @@ -358,21 +371,37 @@ let emit_instr i =
  138. ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`;
  139. 1
  140. | Lop(Ialloc n) ->
  141. - if !fastcode_flag then begin
  142. + let lbl_frame = record_frame_label i.live Debuginfo.none in
  143. + if not !fastcode_flag && (n == 8 || n == 12 || n == 16) then begin
  144. + ` {emit_branch "bl" ("caml_alloc" ^ (string_of_int ((n-4)/4)))}\n`;
  145. + `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
  146. + 2
  147. + end else if not !fastcode_flag && not !Clflags.dlcode then begin
  148. let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in
  149. - ` sub alloc_ptr, alloc_ptr, r12\n`;
  150. - ` cmp alloc_ptr, alloc_limit\n`;
  151. - `{record_frame i.live} blcc caml_call_gc\n`;
  152. - ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
  153. - 4 + ni
  154. - end else if n = 8 || n = 12 || n = 16 then begin
  155. - `{record_frame i.live} bl caml_alloc{emit_int ((n-4)/4)}\n`;
  156. - ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; 2
  157. + ` {emit_branch "bl" "caml_allocN"}\n`;
  158. + `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
  159. + 2 + ni
  160. end else begin
  161. - let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in
  162. - `{record_frame i.live} bl caml_allocN\n`;
  163. + let lbl_return = new_label() in
  164. + `{emit_label lbl_return}:`;
  165. + let n = Nativeint.of_int n in
  166. + let ni = if is_immediate n then begin
  167. + ` sub alloc_ptr, alloc_ptr, #{emit_nativeint n}\n`;
  168. + 1
  169. + end else begin
  170. + let ni = emit_intconst (phys_reg 8 (*r12*)) n in
  171. + ` sub alloc_ptr, alloc_ptr, r12\n`;
  172. + 1 + ni
  173. + end in
  174. + ` cmp alloc_ptr, alloc_limit\n`;
  175. + let lbl_call_gc = new_label() in
  176. + ` bcc {emit_label lbl_call_gc}\n`;
  177. ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
  178. - 2 + ni
  179. + call_gc_sites :=
  180. + { gc_lbl = lbl_call_gc;
  181. + gc_return_lbl = lbl_return;
  182. + gc_frame_lbl = lbl_frame } :: !call_gc_sites;
  183. + 3 + ni
  184. end
  185. | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
  186. let shift = name_for_shift_operation op in
  187. @@ -384,7 +413,7 @@ let emit_instr i =
  188. ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3
  189. | Lop(Iintop(Icheckbound)) ->
  190. ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
  191. - ` blls caml_ml_array_bound_error\n`; 2
  192. + ` {emit_branch "blls" "caml_ml_array_bound_error"}\n`; 2
  193. | Lop(Iintop op) ->
  194. let instr = name_for_int_operation op in
  195. ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1
  196. @@ -421,7 +450,7 @@ let emit_instr i =
  197. ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3
  198. | Lop(Iintop_imm(Icheckbound, n)) ->
  199. ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
  200. - ` blls caml_ml_array_bound_error\n`; 2
  201. + ` {emit_branch "blls" "caml_ml_array_bound_error"}\n`; 2
  202. | Lop(Iintop_imm(op, n)) ->
  203. let instr = name_for_int_operation op in
  204. ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
  205. @@ -440,7 +469,7 @@ let emit_instr i =
  206. 1
  207. | Lop(Ispecific(Ishiftcheckbound shift)) ->
  208. ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
  209. - ` blcs caml_ml_array_bound_error\n`; 2
  210. + ` {emit_branch "blcs" "caml_ml_array_bound_error"}\n`; 2
  211. | Lop(Ispecific(Irevsubimm n)) ->
  212. ` rsb {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1
  213. | Lreloadretaddr ->
  214. @@ -551,11 +580,13 @@ let fundecl fundecl =
  215. fastcode_flag := fundecl.fun_fast;
  216. tailrec_entry_point := new_label();
  217. stack_offset := 0;
  218. + call_gc_sites := [];
  219. Hashtbl.clear symbol_constants;
  220. Hashtbl.clear float_constants;
  221. ` .text\n`;
  222. ` .align 2\n`;
  223. - ` .global {emit_symbol fundecl.fun_name}\n`;
  224. + ` .globl {emit_symbol fundecl.fun_name}\n`;
  225. + ` .type {emit_symbol fundecl.fun_name},%function\n`;
  226. `{emit_symbol fundecl.fun_name}:\n`;
  227. let n = frame_size() in
  228. ignore(emit_stack_adjustment "sub" n);
  229. @@ -563,7 +594,9 @@ let fundecl fundecl =
  230. ` str lr, [sp, #{emit_int(n - 4)}]\n`;
  231. `{emit_label !tailrec_entry_point}:\n`;
  232. emit_all 0 fundecl.fun_body;
  233. - emit_constants()
  234. + List.iter emit_call_gc !call_gc_sites;
  235. + emit_constants();
  236. + ` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n`
  237.  
  238. (* Emission of data *)
  239.  
  240. @@ -630,6 +663,13 @@ let end_assembly () =
  241. ` .data\n`;
  242. ` .global {emit_symbol lbl}\n`;
  243. `{emit_symbol lbl}:\n`;
  244. - ` .word {emit_int (List.length !frame_descriptors)}\n`;
  245. - List.iter emit_frame !frame_descriptors;
  246. - frame_descriptors := []
  247. + emit_frames
  248. + { efa_label = (fun l -> ` .word {emit_label l}\n`);
  249. + efa_16 = (fun n -> ` .short {emit_int n}\n`);
  250. + efa_32 = (fun n -> ` .word {emit_int32 n}\n`);
  251. + efa_word = (fun n -> ` .word {emit_int n}\n`);
  252. + efa_align = (fun n -> ` .align {emit_int(Misc.log2 n)}\n`);
  253. + efa_label_rel = (fun lbl ofs ->
  254. + ` .word {emit_label lbl} - . + {emit_int32 ofs}\n`);
  255. + efa_def_label = (fun l -> `{emit_label l}:\n`);
  256. + efa_string = (fun s -> emit_string_directive " .asciz " s) }
  257. diff --git a/asmrun/arm.S b/asmrun/arm.S
  258. index 8a47d18..4332148 100644
  259. --- a/asmrun/arm.S
  260. +++ b/asmrun/arm.S
  261. @@ -23,24 +23,11 @@ alloc_limit .req r10
  262.  
  263. /* Allocation functions and GC interface */
  264.  
  265. - .globl caml_call_gc
  266. -caml_call_gc:
  267. - /* Record return address and desired size */
  268. - /* Can use alloc_limit as a temporary since it will be reloaded by
  269. - invoke_gc */
  270. - ldr alloc_limit, .Lcaml_last_return_address
  271. - str lr, [alloc_limit, #0]
  272. - ldr alloc_limit, .Lcaml_requested_size
  273. - str r12, [alloc_limit, #0]
  274. - /* Branch to shared GC code */
  275. - bl .Linvoke_gc
  276. - /* Finish allocation */
  277. - ldr r12, .Lcaml_requested_size
  278. - ldr r12, [r12, #0]
  279. - sub alloc_ptr, alloc_ptr, r12
  280. - bx lr
  281. +/* Allocate 8 bytes in minor heap */
  282. +/* PIC safe */
  283.  
  284. .globl caml_alloc1
  285. + .type caml_alloc1, %function
  286. caml_alloc1:
  287. sub alloc_ptr, alloc_ptr, #8
  288. cmp alloc_ptr, alloc_limit
  289. @@ -53,7 +40,11 @@ caml_alloc1:
  290. /* Try again */
  291. b caml_alloc1
  292.  
  293. +/* Allocate 12 bytes in minor heap */
  294. +/* PIC safe */
  295. +
  296. .globl caml_alloc2
  297. + .type caml_alloc2, %function
  298. caml_alloc2:
  299. sub alloc_ptr, alloc_ptr, #12
  300. cmp alloc_ptr, alloc_limit
  301. @@ -66,7 +57,11 @@ caml_alloc2:
  302. /* Try again */
  303. b caml_alloc2
  304.  
  305. +/* Allocate 16 bytes in minor heap */
  306. +/* PIC safe */
  307. +
  308. .globl caml_alloc3
  309. + .type caml_alloc3, %function
  310. caml_alloc3:
  311. sub alloc_ptr, alloc_ptr, #16
  312. cmp alloc_ptr, alloc_limit
  313. @@ -79,11 +74,24 @@ caml_alloc3:
  314. /* Try again */
  315. b caml_alloc3
  316.  
  317. +/* Allocate N bytes in minor heap */
  318. +/* Number of bytes is in r12 (preserved) */
  319. +/* Not PIC safe */
  320. +
  321. .globl caml_allocN
  322. + .type caml_allocN, %function
  323. caml_allocN:
  324. sub alloc_ptr, alloc_ptr, r12
  325. cmp alloc_ptr, alloc_limit
  326. movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
  327. +
  328. +/* Call GC and allocate N bytes in minor heap */
  329. +/* Number of bytes is in r12 (preserved) */
  330. +/* Not PIC safe */
  331. +
  332. + .globl caml_call_gc
  333. + .type caml_call_gc, %function
  334. +caml_call_gc:
  335. /* Record return address and desired size */
  336. /* Can use alloc_limit as a temporary since it will be reloaded by
  337. invoke_gc */
  338. @@ -91,12 +99,23 @@ caml_allocN:
  339. str lr, [alloc_limit, #0]
  340. ldr alloc_limit, .Lcaml_requested_size
  341. str r12, [alloc_limit, #0]
  342. - /* Invoke GC */
  343. + /* Branch to shared GC code */
  344. bl .Linvoke_gc
  345. - /* Try again */
  346. - ldr r12, .Lcaml_requested_size
  347. - ldr r12, [r12, #0]
  348. - b caml_allocN
  349. + /* Finish allocation */
  350. + ldr r12, .Lcaml_requested_size
  351. + ldr r12, [r12, #0]
  352. + sub alloc_ptr, alloc_ptr, r12
  353. + bx lr
  354. +
  355. +/* Invoke the GC */
  356. +/* PIC safe */
  357. +
  358. + .globl caml_invoke_gc
  359. + .type caml_invoke_gc, %function
  360. +caml_invoke_gc:
  361. + /* Record return address */
  362. + ldr r12, .Lcaml_last_return_address
  363. + str lr, [r12, #0]
  364.  
  365. /* Shared code to invoke the GC */
  366. .Linvoke_gc:
  367. @@ -132,9 +151,20 @@ caml_allocN:
  368.  
  369. /* Call a C function from Caml */
  370. /* Function to call is in r12 */
  371. +/* Not PIC safe */
  372.  
  373. .globl caml_c_call
  374. + .type caml_c_call, %function
  375. caml_c_call:
  376. + mov r10, r12
  377. +
  378. +/* Invoke a C function from Caml (PIC) */
  379. +/* Function to call is in r10 (alloc_limit) */
  380. +/* PIC safe */
  381. +
  382. + .globl caml_c_invoke
  383. + .type caml_c_invoke, %function
  384. +caml_c_invoke:
  385. /* Preserve return address in callee-save register r4 */
  386. mov r4, lr
  387. /* Record lowest stack address and return address */
  388. @@ -149,7 +179,7 @@ caml_c_call:
  389. str trap_ptr, [r7, #0]
  390. /* Call the function */
  391. mov lr, pc
  392. - bx r12
  393. + bx r10
  394. /* Reload alloc ptr and alloc limit */
  395. ldr r5, .Lcaml_young_limit
  396. ldr alloc_ptr, [r6, #0] /* r6 still points to caml_young_ptr */
  397. @@ -158,8 +188,10 @@ caml_c_call:
  398. bx r4
  399.  
  400. /* Start the Caml program */
  401. +/* PIC safe */
  402.  
  403. .globl caml_start_program
  404. + .type caml_start_program, %function
  405. caml_start_program:
  406. ldr r12, .Lcaml_program
  407.  
  408. @@ -220,7 +252,7 @@ caml_start_program:
  409. str alloc_ptr, [r4, #0]
  410. /* Reload callee-save registers and return */
  411. ldmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr}
  412. - bx lr
  413. + bx lr
  414.  
  415. /* The trap handler */
  416. .Ltrap_handler:
  417. @@ -233,14 +265,16 @@ caml_start_program:
  418. b .Lreturn_result
  419.  
  420. /* Raise an exception from C */
  421. +/* PIC safe */
  422.  
  423. .globl caml_raise_exception
  424. + .type caml_raise_exception, %function
  425. caml_raise_exception:
  426. /* Reload Caml allocation pointers */
  427. - ldr r12, .Lcaml_young_ptr
  428. - ldr alloc_ptr, [r12, #0]
  429. - ldr r12, .Lcaml_young_limit
  430. - ldr alloc_limit, [r12, #0]
  431. + ldr alloc_ptr, .Lcaml_young_ptr
  432. + ldr alloc_limit, .Lcaml_young_limit
  433. + ldr alloc_ptr, [alloc_ptr, #0]
  434. + ldr alloc_limit, [alloc_limit, #0]
  435. /* Cut stack at current trap handler */
  436. ldr r12, .Lcaml_exception_pointer
  437. ldr sp, [r12, #0]
  438. @@ -250,6 +284,7 @@ caml_raise_exception:
  439. /* Callback from C to Caml */
  440.  
  441. .globl caml_callback_exn
  442. + .type caml_callback_exn, %function
  443. caml_callback_exn:
  444. /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */
  445. mov r12, r0
  446. @@ -259,6 +294,7 @@ caml_callback_exn:
  447. b .Ljump_to_caml
  448.  
  449. .globl caml_callback2_exn
  450. + .type caml_callback2_exn, %function
  451. caml_callback2_exn:
  452. /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */
  453. mov r12, r0
  454. @@ -269,6 +305,7 @@ caml_callback2_exn:
  455. b .Ljump_to_caml
  456.  
  457. .globl caml_callback3_exn
  458. + .type caml_callback3_exn, %function
  459. caml_callback3_exn:
  460. /* Initial shuffling of arguments */
  461. /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */
  462. @@ -281,11 +318,12 @@ caml_callback3_exn:
  463. b .Ljump_to_caml
  464.  
  465. .globl caml_ml_array_bound_error
  466. + .type caml_ml_array_bound_error, %function
  467. caml_ml_array_bound_error:
  468. - /* Load address of [caml_array_bound_error] in r12 */
  469. - ldr r12, .Lcaml_array_bound_error
  470. + /* Load address of [caml_array_bound_error] in r10 */
  471. + ldr r10, .Lcaml_array_bound_error
  472. /* Call that function */
  473. - b caml_c_call
  474. + b caml_c_invoke
  475.  
  476. /* Global references */
  477.  
  478. @@ -302,9 +340,9 @@ caml_ml_array_bound_error:
  479. .Lcaml_array_bound_error: .word caml_array_bound_error
  480. .Lcaml_requested_size: .word caml_requested_size
  481.  
  482. - .data
  483. + .data
  484. caml_requested_size:
  485. - .word 0
  486. + .word 0
  487.  
  488. /* GC roots for callback */
  489.  
  490. diff --git a/configure b/configure
  491. index 47cc203..9f66c93 100755
  492. --- a/configure
  493. +++ b/configure
  494. @@ -636,6 +636,7 @@ if test $withsharedlibs = "yes"; then
  495. i[345]86-*-netbsd*) natdynlink=true;;
  496. x86_64-*-netbsd*) natdynlink=true;;
  497. i386-*-gnu0.3) natdynlink=true;;
  498. + arm*-*-linux*) natdynlink=true;;
  499. esac
  500. fi
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!