API tools faq
paste
Guest User

Untitled

a guest
Feb 16th, 2019
205
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 31.28 KB | None | 0 0
raw download clone embed print report
  1. Index: driver/main_args.mli
  2. ===================================================================
  3. --- driver/main_args.mli (Revision 2)
  4. +++ driver/main_args.mli (Revision 27)
  5. @@ -142,6 +142,8 @@
  6. val _warn_help : unit -> unit
  7. val _where : unit -> unit
  8.  
  9. + val _linscan : unit -> unit
  10. +
  11. val _nopervasives : unit -> unit
  12. val _dparsetree : unit -> unit
  13. val _drawlambda : unit -> unit
  14. @@ -158,6 +160,7 @@
  15. val _dreload : unit -> unit
  16. val _dscheduling : unit -> unit
  17. val _dlinear : unit -> unit
  18. + val _dinterval : unit -> unit
  19. val _dstartup : unit -> unit
  20.  
  21. val anonymous : string -> unit
  22. @@ -185,6 +188,8 @@
  23. val _warn_error : string -> unit
  24. val _warn_help : unit -> unit
  25.  
  26. + val _linscan : unit -> unit
  27. +
  28. val _dparsetree : unit -> unit
  29. val _drawlambda : unit -> unit
  30. val _dlambda : unit -> unit
  31. @@ -200,6 +205,7 @@
  32. val _dreload : unit -> unit
  33. val _dscheduling : unit -> unit
  34. val _dlinear : unit -> unit
  35. + val _dinterval : unit -> unit
  36. val _dstartup : unit -> unit
  37.  
  38. val anonymous : string -> unit
  39. Index: driver/main_args.ml
  40. ===================================================================
  41. --- driver/main_args.ml (Revision 2)
  42. +++ driver/main_args.ml (Revision 27)
  43. @@ -298,6 +298,11 @@
  44. "-use-prims", Arg.String f, "<file> (undocumented)"
  45. ;;
  46.  
  47. +let mk_linscan f =
  48. + "-linscan", Arg.Unit f, " (undocumented)"
  49. +;;
  50. +
  51. +
  52. let mk_dparsetree f =
  53. "-dparsetree", Arg.Unit f, " (undocumented)"
  54. ;;
  55. @@ -362,6 +367,11 @@
  56. "-dlinear", Arg.Unit f, " (undocumented)"
  57. ;;
  58.  
  59. +let mk_dinterval f =
  60. + "-dinterval", Arg.Unit f, " (undocumented)"
  61. +;;
  62. +
  63. +
  64. let mk_dstartup f =
  65. "-dstartup", Arg.Unit f, " (undocumented)"
  66. ;;
  67. @@ -499,6 +509,8 @@
  68. val _warn_help : unit -> unit
  69. val _where : unit -> unit
  70.  
  71. + val _linscan : unit -> unit
  72. +
  73. val _nopervasives : unit -> unit
  74. val _dparsetree : unit -> unit
  75. val _drawlambda : unit -> unit
  76. @@ -515,6 +527,7 @@
  77. val _dreload : unit -> unit
  78. val _dscheduling : unit -> unit
  79. val _dlinear : unit -> unit
  80. + val _dinterval : unit -> unit
  81. val _dstartup : unit -> unit
  82.  
  83. val anonymous : string -> unit
  84. @@ -542,6 +555,8 @@
  85. val _warn_error : string -> unit
  86. val _warn_help : unit -> unit
  87.  
  88. + val _linscan : unit -> unit
  89. +
  90. val _dparsetree : unit -> unit
  91. val _drawlambda : unit -> unit
  92. val _dlambda : unit -> unit
  93. @@ -557,6 +572,7 @@
  94. val _dreload : unit -> unit
  95. val _dscheduling : unit -> unit
  96. val _dlinear : unit -> unit
  97. + val _dinterval : unit -> unit
  98. val _dstartup : unit -> unit
  99.  
  100. val anonymous : string -> unit
  101. @@ -709,6 +725,8 @@
  102. mk_warn_help F._warn_help;
  103. mk_where F._where;
  104.  
  105. + mk_linscan F._linscan;
  106. +
  107. mk_nopervasives F._nopervasives;
  108. mk_dparsetree F._dparsetree;
  109. mk_drawlambda F._drawlambda;
  110. @@ -718,12 +736,14 @@
  111. mk_dcombine F._dcombine;
  112. mk_dlive F._dlive;
  113. mk_dspill F._dspill;
  114. + mk_dsplit F._dspill;
  115. mk_dinterf F._dinterf;
  116. mk_dprefer F._dprefer;
  117. mk_dalloc F._dalloc;
  118. mk_dreload F._dreload;
  119. mk_dscheduling F._dscheduling;
  120. mk_dlinear F._dlinear;
  121. + mk_dinterval F._dinterval;
  122. mk_dstartup F._dstartup;
  123.  
  124. mk__ F.anonymous;
  125. @@ -753,6 +773,8 @@
  126. mk_warn_error F._warn_error;
  127. mk_warn_help F._warn_help;
  128.  
  129. + mk_linscan F._linscan;
  130. +
  131. mk_dparsetree F._dparsetree;
  132. mk_drawlambda F._drawlambda;
  133. mk_dcmm F._dcmm;
  134. @@ -760,12 +782,14 @@
  135. mk_dcombine F._dcombine;
  136. mk_dlive F._dlive;
  137. mk_dspill F._dspill;
  138. + mk_dsplit F._dspill;
  139. mk_dinterf F._dinterf;
  140. mk_dprefer F._dprefer;
  141. mk_dalloc F._dalloc;
  142. mk_dreload F._dreload;
  143. mk_dscheduling F._dscheduling;
  144. mk_dlinear F._dlinear;
  145. + mk_dinterval F._dinterval;
  146. mk_dstartup F._dstartup;
  147.  
  148. mk__ F.anonymous;
  149. Index: driver/optmain.ml
  150. ===================================================================
  151. --- driver/optmain.ml (Revision 2)
  152. +++ driver/optmain.ml (Revision 27)
  153. @@ -142,6 +142,8 @@
  154. let _warn_help = Warnings.help_warnings
  155. let _where () = print_standard_library ()
  156.  
  157. + let _linscan = set use_linscan
  158. +
  159. let _nopervasives = set nopervasives
  160. let _dparsetree = set dump_parsetree
  161. let _drawlambda = set dump_rawlambda
  162. @@ -158,6 +160,7 @@
  163. let _dreload = set dump_reload
  164. let _dscheduling = set dump_scheduling
  165. let _dlinear = set dump_linear
  166. + let _dinterval = set dump_interval
  167. let _dstartup = set keep_startup_file
  168.  
  169. let anonymous = anonymous
  170. Index: asmcomp/interval.mli
  171. ===================================================================
  172. --- asmcomp/interval.mli (Revision 0)
  173. +++ asmcomp/interval.mli (Revision 27)
  174. @@ -0,0 +1,40 @@
  175. +(***********************************************************************)
  176. +(* *)
  177. +(* Objective Caml *)
  178. +(* *)
  179. +(* Marcell Fischbach *)
  180. +(* *)
  181. +(* Copyright 2011 University of Siegen. All rights reserved. *)
  182. +(* This file is distributed under the terms of the *)
  183. +(* Q Public License version 1.0. *)
  184. +(* *)
  185. +(***********************************************************************)
  186. +
  187. +
  188. +
  189. +open Format
  190. +
  191. +
  192. +type range =
  193. + {
  194. + mutable rbegin : int;
  195. + mutable rend : int;
  196. + }
  197. +
  198. +type interval =
  199. + {
  200. + mutable reg : Reg.t;
  201. + mutable ibegin : int;
  202. + mutable iend : int;
  203. + mutable ranges : range list;
  204. + }
  205. +
  206. +
  207. +val all_intervals : unit -> interval list
  208. +val all_fixed_intervals: unit -> interval list
  209. +val debug_intervals: formatter -> Mach.fundecl -> unit
  210. +val build_intervals: Mach.fundecl -> unit
  211. +val live_on: interval -> int -> bool
  212. +val overlapping_ranges: range -> range -> bool
  213. +val overlapping: interval -> interval -> bool
  214. +val strip_expired_ranges: range list -> int -> range list
  215. Index: asmcomp/asmgen.ml
  216. ===================================================================
  217. --- asmcomp/asmgen.ml (Revision 2)
  218. +++ asmcomp/asmgen.ml (Revision 27)
  219. @@ -20,6 +20,8 @@
  220. open Misc
  221. open Cmm
  222.  
  223. +external sys_time : unit -> float = "caml_sys_time"
  224. +
  225. type error = Assembler_error of string
  226.  
  227. exception Error of error
  228. @@ -38,21 +40,53 @@
  229. phrase
  230.  
  231. let rec regalloc ppf round fd =
  232. - if round > 50 then
  233. - fatal_error(fd.Mach.fun_name ^
  234. - ": function too complex, cannot complete register allocation");
  235. - dump_if ppf dump_live "Liveness analysis" fd;
  236. - Interf.build_graph fd;
  237. - if !dump_interf then Printmach.interferences ppf ();
  238. - if !dump_prefer then Printmach.preferences ppf ();
  239. - Coloring.allocate_registers();
  240. - dump_if ppf dump_regalloc "After register allocation" fd;
  241. - let (newfd, redo_regalloc) = Reload.fundecl fd in
  242. - dump_if ppf dump_reload "After insertion of reloading code" newfd;
  243. - if redo_regalloc then begin
  244. - Reg.reinit(); Liveness.fundecl ppf newfd; regalloc ppf (round + 1) newfd
  245. - end else newfd
  246. + if not !use_linscan then begin
  247. + if round > 50 then
  248. + fatal_error(fd.Mach.fun_name ^
  249. + ": function too complex, cannot complete register allocation");
  250. + dump_if ppf dump_live "Liveness analysis" fd;
  251. + Interf.build_graph fd;
  252. + if !dump_interf then Printmach.interferences ppf ();
  253. + if !dump_prefer then Printmach.preferences ppf ();
  254. + Coloring.allocate_registers();
  255. + dump_if ppf dump_regalloc "After register allocation" fd;
  256. + let (newfd, redo_regalloc) = Reload.fundecl fd in
  257. + if redo_regalloc then begin
  258. + Reg.reinit();
  259. + Liveness.fundecl ppf newfd;
  260. + dump_if ppf dump_reload "After insertion of reloading code" newfd;
  261. + regalloc ppf (round + 1) newfd
  262. + end
  263. + else
  264. + begin
  265. + dump_if ppf dump_reload "After insertion of reloading code" newfd;
  266. + newfd
  267. + end
  268. + end
  269. + else
  270. + fd
  271.  
  272. +let rec regalloc_linscan ppf round fd =
  273. + if !use_linscan then begin
  274. + if round > 50 then
  275. + fatal_error(fd.Mach.fun_name ^
  276. + ": function too complex, cannot complete register allocation");
  277. +
  278. + Interval.build_intervals fd;
  279. + if !dump_interval then Interval.debug_intervals ppf fd;
  280. + Linscan.walk_intervals (Interval.all_intervals ()) (Interval.all_fixed_intervals()) fd;
  281. + let (newfd, redo_regalloc) = Reload.fundecl fd in
  282. + dump_if ppf dump_reload "After insertion of reloading code" newfd;
  283. + if redo_regalloc then begin
  284. + Reg.reinit();
  285. + Liveness.fundecl ppf newfd;
  286. + regalloc_linscan ppf (round + 1) newfd
  287. + end else newfd
  288. + end
  289. + else
  290. + fd
  291. +
  292. +
  293. let (++) x f = f x
  294.  
  295. let compile_fundecl (ppf : formatter) fd_cmm =
  296. @@ -70,7 +104,8 @@
  297. ++ Split.fundecl
  298. ++ pass_dump_if ppf dump_split "After live range splitting"
  299. ++ liveness ppf
  300. - ++ regalloc ppf 1
  301. + ++ regalloc ppf 1
  302. + ++ regalloc_linscan ppf 1
  303. ++ Linearize.fundecl
  304. ++ pass_dump_linear_if ppf dump_linear "Linearized code"
  305. ++ Scheduling.fundecl
  306. Index: asmcomp/interval.ml
  307. ===================================================================
  308. --- asmcomp/interval.ml (Revision 0)
  309. +++ asmcomp/interval.ml (Revision 27)
  310. @@ -0,0 +1,290 @@
  311. +(***********************************************************************)
  312. +(* *)
  313. +(* Objective Caml *)
  314. +(* *)
  315. +(* Marcell Fischbach *)
  316. +(* *)
  317. +(* Copyright 2011 University of Siegen. All rights reserved. *)
  318. +(* This file is distributed under the terms of the *)
  319. +(* Q Public License version 1.0. *)
  320. +(* *)
  321. +(***********************************************************************)
  322. +
  323. +
  324. +
  325. +open List
  326. +open Mach
  327. +open Reg
  328. +
  329. +type range =
  330. + {
  331. + mutable rbegin : int;
  332. + mutable rend : int;
  333. + }
  334. +
  335. +type interval =
  336. + {
  337. + mutable reg : Reg.t;
  338. + mutable ibegin : int;
  339. + mutable iend : int;
  340. + mutable ranges : range list;
  341. + }
  342. +
  343. +
  344. +let interval_list = ref ([] : interval list)
  345. +let fixed_interval_list = ref ([] : interval list)
  346. +let all_intervals() = !interval_list
  347. +let all_fixed_intervals() = !fixed_interval_list
  348. +
  349. +let overlapping_ranges r0 r1 =
  350. + r0.rend > r1.rbegin && r1.rend > r0.rbegin
  351. +
  352. +
  353. +let overlapping i0 i1 =
  354. +
  355. + let rec test_ranges r0s r1s =
  356. + begin match r0s, r1s with
  357. + | [], _ -> false
  358. + | _, [] -> false
  359. + | r0::r0tl, r1::r1tl ->
  360. + if overlapping_ranges r0 r1 then true
  361. + else if r0.rend < r1.rend then test_ranges r0tl r1s
  362. + else if r0.rend > r1.rend then test_ranges r0s r1tl
  363. + else test_ranges r0tl r1tl
  364. + end
  365. + in
  366. +
  367. + test_ranges i0.ranges i1.ranges
  368. +
  369. +let live_on i p =
  370. + let rec live_on_ranges r =
  371. + begin match r with
  372. + | [] -> false
  373. + | hd::tl ->
  374. + if p < hd.rbegin then false
  375. + else if p < hd.rend then true
  376. + else live_on_ranges tl
  377. + end in
  378. + live_on_ranges i.ranges
  379. +
  380. +
  381. +let rec strip_expired_ranges ranges pos =
  382. + begin match ranges with
  383. + | [] -> []
  384. + | hd::tl ->
  385. + if hd.rend > pos then ranges
  386. + else strip_expired_ranges tl pos
  387. + end
  388. +
  389. +
  390. +
  391. +
  392. +let debug_intervals ppf fd =
  393. + Format.fprintf ppf "*** Intervals\n";
  394. + Format.fprintf ppf "%s\n" fd.fun_name;
  395. +
  396. + let dump_interval i =
  397. + Format.fprintf ppf " ";
  398. + Printmach.reg ppf i.reg;
  399. + List.iter (fun r ->
  400. + Format.fprintf ppf " [%d;%d[ " r.rbegin r.rend
  401. + ) i.ranges;
  402. + Format.fprintf ppf "\n"
  403. + in
  404. + List.iter dump_interval !fixed_interval_list;
  405. + List.iter dump_interval !interval_list;
  406. + ()
  407. +
  408. +
  409. +let get_and_initialize_interval intervals reg pos_tst pos_set use_kind =
  410. + let interval = intervals.(reg.stamp) in
  411. + if interval.iend = 0 then begin
  412. + interval.ibegin <- pos_tst;
  413. + interval.iend <- pos_set;
  414. + interval.reg <- reg;
  415. + interval.ranges <- [{rbegin = pos_tst; rend = pos_set; }]
  416. + end;
  417. + interval
  418. +
  419. +
  420. +let update_interval_position intervals pos_tst pos_set use_kind reg =
  421. + let interval = get_and_initialize_interval intervals reg pos_tst pos_set use_kind in
  422. + let range = begin match interval.ranges with |[] -> Misc.fatal_error "Illegal empty range" | hd::_ -> hd end in
  423. +
  424. + interval.iend <- pos_set;
  425. +
  426. + if (range.rend = pos_tst || (range.rend + 1) = pos_tst) && use_kind != 1 then
  427. + range.rend <- pos_set
  428. + else if range.rbegin = pos_tst && range.rend = pos_tst && use_kind = 1 then
  429. + range.rend <- pos_set
  430. + else
  431. + interval.ranges <- {rbegin=pos_tst;rend=pos_set;} :: interval.ranges
  432. +
  433. +
  434. +
  435. +let update_interval_position_by_reg_array intervals regs pos_tst pos_set use_kind =
  436. + Array.iter (update_interval_position intervals pos_tst pos_set use_kind) regs
  437. +
  438. +let update_interval_position_by_reg_set intervals regs pos_tst pos_set use_kind =
  439. + Set.iter (update_interval_position intervals pos_tst pos_set use_kind) regs
  440. +
  441. +let update_interval_position_by_instr intervals instr pos_tst pos_set =
  442. + update_interval_position_by_reg_array intervals instr.arg pos_tst pos_set 0;
  443. + update_interval_position_by_reg_array intervals instr.res pos_set pos_set 1;
  444. + update_interval_position_by_reg_set intervals instr.live pos_tst pos_set 0
  445. +
  446. +
  447. +let insert_pos_for_live intervals instr pos =
  448. + if (not (Set.is_empty instr.live)) || Array.length instr.arg > 0 then
  449. + begin
  450. + pos := succ !pos;
  451. + update_interval_position_by_reg_set intervals instr.live !pos !pos 0;
  452. + update_interval_position_by_reg_array intervals instr.arg !pos !pos 0
  453. + end
  454. +
  455. +let insert_destroyed_at_oper intervals instr pos =
  456. + let destroyed = Proc.destroyed_at_oper instr.desc in
  457. + if Array.length destroyed > 0 then
  458. + update_interval_position_by_reg_array intervals destroyed pos pos 1
  459. +
  460. +let insert_destroyed_at_raise intervals pos =
  461. + let destroyed = Proc.destroyed_at_raise in
  462. + if Array.length destroyed > 0 then
  463. + update_interval_position_by_reg_array intervals destroyed pos pos 1
  464. +
  465. +
  466. +(* generate all intervals.
  467. + the intervals will be expanded by one step at the beginning and
  468. + the ending of a basic block
  469. +*)
  470. +let build_intervals fundecl =
  471. +
  472. + let intervals = Array.init (Reg.num_registers()) (fun i ->
  473. + { reg = Reg.dummy;
  474. + ibegin = 0;
  475. + iend = 0;
  476. + ranges = [];
  477. + }) in
  478. +
  479. +
  480. + let rec walk_instruction i pos shift =
  481. + pos := !pos + 1 + shift;
  482. + update_interval_position_by_instr intervals i (!pos - shift) !pos;
  483. +
  484. +
  485. + begin match i.desc with
  486. + | Iend ->
  487. + (* end ends a bb *)
  488. + insert_pos_for_live intervals i pos;
  489. +
  490. + | Iop(Icall_ind | Icall_imm _ | Iextcall(_, true) | Itailcall_ind | Itailcall_imm _) ->
  491. + walk_instruction i.next pos 0
  492. +
  493. + | Iop _ ->
  494. + insert_destroyed_at_oper intervals i !pos;
  495. + walk_instruction i.next pos 0
  496. +
  497. + | Ireturn ->
  498. + insert_destroyed_at_oper intervals i !pos;
  499. + (* returns ends a bb *)
  500. + insert_pos_for_live intervals i pos;
  501. + walk_instruction i.next pos 0
  502. +
  503. +
  504. + | Iifthenelse(test, ifso, ifnot) ->
  505. + insert_destroyed_at_oper intervals i !pos;
  506. + (* if ends a bb *)
  507. + insert_pos_for_live intervals i pos;
  508. +
  509. + (* ifso starts a new bb *)
  510. + walk_instruction ifso pos 1;
  511. +
  512. + (* ifnot starts a new bb *)
  513. + walk_instruction ifnot pos 1;
  514. +
  515. + (* next starts a new bb *)
  516. + walk_instruction i.next pos 1
  517. + | Iswitch(index, cases) ->
  518. + insert_destroyed_at_oper intervals i !pos;
  519. + (* switch ends a bb *)
  520. + insert_pos_for_live intervals i pos;
  521. +
  522. + for j = 0 to Array.length cases -1 do
  523. + (* each case starts a new bb *)
  524. + walk_instruction cases.(j) pos 1
  525. + done;
  526. + (* next starts a new bb *)
  527. + walk_instruction i.next pos 1
  528. + | Iloop body ->
  529. + insert_destroyed_at_oper intervals i !pos;
  530. + (* loop ends a bb *)
  531. + insert_pos_for_live intervals i pos;
  532. +
  533. + (* the body starts a new block *)
  534. + walk_instruction body pos 1;
  535. +
  536. + (* next starts a new bb *)
  537. + walk_instruction i.next pos 1
  538. + | Icatch(io, body, handler) ->
  539. + insert_destroyed_at_oper intervals i !pos;
  540. + (* catch ends a bb *)
  541. + insert_pos_for_live intervals i pos;
  542. +
  543. + (* the body starts a new bb *)
  544. + walk_instruction body pos 1;
  545. +
  546. + (* the handler starts a new bb *)
  547. + walk_instruction handler pos 1;
  548. +
  549. + (* next starts a new bb *)
  550. + walk_instruction i.next pos 1;
  551. + | Iexit nfail ->
  552. + insert_destroyed_at_oper intervals i !pos;
  553. + (* exit ends a bb *)
  554. + insert_pos_for_live intervals i pos;
  555. +
  556. + | Itrywith(body, handler) ->
  557. + insert_destroyed_at_oper intervals i !pos;
  558. + (* trywith ends a bb *)
  559. + insert_pos_for_live intervals i pos;
  560. +
  561. + (* the body starts a new bb *)
  562. + walk_instruction body pos 1;
  563. +
  564. + (* the handler starts a new bb *)
  565. + insert_pos_for_live intervals handler pos;
  566. + insert_destroyed_at_raise intervals !pos;
  567. + walk_instruction handler pos 0;
  568. +
  569. + (* nex starts a new bb *)
  570. + walk_instruction i.next pos 1
  571. + | Iraise ->
  572. + (* raise ends a bb *)
  573. + insert_pos_for_live intervals i pos;
  574. +
  575. + walk_instruction i.next pos 1
  576. + end
  577. +
  578. +
  579. +
  580. + in
  581. +
  582. + let pos = ref 0 in
  583. + walk_instruction fundecl.fun_body pos 1;
  584. +
  585. +
  586. + interval_list := [];
  587. + fixed_interval_list := [];
  588. + Array.iter (fun i ->
  589. + if i.iend != 0 then begin
  590. + i.ranges <- List.rev i.ranges;
  591. + begin match i.reg.loc with
  592. + | Reg r -> fixed_interval_list := i :: !fixed_interval_list
  593. + | _ -> interval_list := i :: !interval_list
  594. + end
  595. + end) intervals;
  596. +
  597. +
  598. + interval_list := List.sort (fun i0 i1 -> i0.ibegin - i1.ibegin) !interval_list;
  599. +
  600. + ()
  601. Index: asmcomp/linscan.ml
  602. ===================================================================
  603. --- asmcomp/linscan.ml (Revision 0)
  604. +++ asmcomp/linscan.ml (Revision 27)
  605. @@ -0,0 +1,295 @@
  606. +(***********************************************************************)
  607. +(* *)
  608. +(* Objective Caml *)
  609. +(* *)
  610. +(* Marcell Fischbach *)
  611. +(* *)
  612. +(* Copyright 2011 University of Siegen. All rights reserved. *)
  613. +(* This file is distributed under the terms of the *)
  614. +(* Q Public License version 1.0. *)
  615. +(* *)
  616. +(***********************************************************************)
  617. +
  618. +
  619. +open Interval
  620. +open Clflags
  621. +open List
  622. +open Format
  623. +open Mach
  624. +
  625. +
  626. +type active_t =
  627. +{
  628. + mutable active : interval list;
  629. + mutable inactive : interval list;
  630. + mutable fixed : interval list;
  631. +}
  632. +
  633. +
  634. +let active = Array.init Proc.num_register_classes (fun i -> {active = []; inactive = []; fixed= [] })
  635. +
  636. +let rec insert_into active current =
  637. + begin match active with
  638. + | [] -> [current]
  639. + | interval::tl ->
  640. + (* check code for <= or < *)
  641. + if interval.iend <= current.iend then
  642. + current :: active
  643. + else
  644. + interval :: insert_into tl current
  645. + end
  646. +
  647. +
  648. +let rec release_expired_fixed pos intervals =
  649. + begin match intervals with
  650. + | [] -> []
  651. + | interval::tl ->
  652. + if interval.iend > pos then begin
  653. + interval.ranges <- Interval.strip_expired_ranges interval.ranges pos;
  654. + interval :: release_expired_fixed pos tl
  655. + end
  656. + else
  657. + []
  658. + end
  659. +
  660. +
  661. +let rec release_expired_active active_cl pos intervals =
  662. + begin match intervals with
  663. + | [] -> []
  664. + | interval::tl ->
  665. + if interval.iend > pos then begin
  666. + interval.ranges <- Interval.strip_expired_ranges interval.ranges pos;
  667. + if Interval.live_on interval pos then
  668. + interval :: release_expired_active active_cl pos tl
  669. + else begin
  670. + active_cl.inactive <- insert_into active_cl.inactive interval;
  671. + release_expired_active active_cl pos tl
  672. + end
  673. + end
  674. + else
  675. + []
  676. + end
  677. +
  678. +let rec release_expired_inactive active_cl pos intervals =
  679. + begin match intervals with
  680. + | [] -> []
  681. + | interval::tl ->
  682. + if interval.iend > pos then begin
  683. + interval.ranges <- Interval.strip_expired_ranges interval.ranges pos;
  684. + if not (Interval.live_on interval pos) then
  685. + interval :: release_expired_inactive active_cl pos tl
  686. + else begin
  687. + active_cl.active <- insert_into active_cl.active interval;
  688. + release_expired_inactive active_cl pos tl
  689. + end
  690. + end
  691. + else
  692. + []
  693. + end
  694. +
  695. +
  696. +
  697. +
  698. +let get_stack_slot cl =
  699. + let nslots = Proc.num_stack_slots.(cl) in
  700. + Proc.num_stack_slots.(cl) <- nslots + 1;
  701. + nslots
  702. +
  703. +
  704. +
  705. +let pop_active active =
  706. + begin match active with
  707. + | [] -> []
  708. + | _::tl -> tl
  709. + end
  710. +
  711. +
  712. +(* find a register for the given interval and assigns this
  713. + register. The interval is inserted into active.
  714. + If there is no space available for this interval then
  715. + nothings happens and false is returned. Otherwise
  716. + returns true.
  717. + *)
  718. +let try_alloc_free_register interval =
  719. + let cl = Proc.register_class interval.reg in
  720. + (* this intervals has already been spilled *)
  721. + if interval.reg.Reg.spill then begin
  722. + begin match interval.reg.Reg.loc with
  723. + | Reg.Unknown -> interval.reg.Reg.loc <- Reg.Stack(Reg.Local (get_stack_slot cl));
  724. + | _ -> ()
  725. + end
  726. + end;
  727. +
  728. + let num = Proc.num_available_registers.(cl) in
  729. + if interval.reg.Reg.loc != Reg.Unknown then true (* this register is already allocated or spilled *)
  730. + else if num = 0 then false (* there are not registers for this class *)
  731. + else begin
  732. + let first_reg = Proc.first_available_register.(cl) in
  733. + let active_cl = active.(cl) in
  734. +
  735. + (* create array containing all possible free regs *)
  736. + let regs = Array.make num true in
  737. +
  738. + (* remove all assigned registers from the free array *)
  739. + let rec remove_bound actives =
  740. + begin match actives with
  741. + | [] -> ()
  742. + | i::tl ->
  743. + begin
  744. + begin match i.reg.Reg.loc with
  745. + | Reg.Reg(r) -> regs.(r - first_reg) <- false
  746. + | _ -> ()
  747. + end;
  748. + remove_bound tl
  749. + end
  750. + end
  751. + in
  752. +
  753. + remove_bound active_cl.active;
  754. +
  755. + (* remove all overlapping registers from the free array *)
  756. + let rec remove_bound_overlapping fix =
  757. + begin match fix with
  758. + | [] -> ()
  759. + | i::tl ->
  760. + begin
  761. + begin match i.reg.Reg.loc with
  762. + | Reg.Reg(r) ->
  763. + if regs.(r-first_reg) && Interval.overlapping i interval then
  764. + regs.(r - first_reg) <- false
  765. + | _ -> ()
  766. + end;
  767. + remove_bound_overlapping tl
  768. + end
  769. + end
  770. + in
  771. + remove_bound_overlapping active_cl.inactive;
  772. + remove_bound_overlapping active_cl.fixed;
  773. +
  774. +
  775. + let rec find_first_free_reg c =
  776. + if c = num then -1
  777. + else if regs.(c) then c
  778. + else find_first_free_reg (c+1) in
  779. +
  780. + let first_free_reg = find_first_free_reg 0 in
  781. +
  782. + if first_free_reg = -1 then false
  783. + else begin
  784. + (* assign the free register *)
  785. + interval.reg.Reg.loc <- Reg.Reg (first_reg + first_free_reg);
  786. + interval.reg.Reg.spill <- false;
  787. + (* and insert the current interval into active *)
  788. + active_cl.active <- insert_into active_cl.active interval;
  789. + true
  790. + end;
  791. + end
  792. +
  793. +
  794. +let allocate_blocked_register interval =
  795. + let cl = Proc.register_class interval.reg in
  796. + let active_cl = active.(cl) in
  797. +
  798. +
  799. + if active_cl.active = [] then begin
  800. + (* this is the special case when there are no register at all
  801. + in the register class. This can happen e.g. for float Regs on i386 *)
  802. + interval.reg.Reg.loc <- Reg.Stack(Reg.Local (get_stack_slot cl));
  803. + interval.reg.Reg.spill <- true
  804. + end
  805. + else begin
  806. +
  807. + (* get the latest interval in active *)
  808. + let last_active = List.hd active_cl.active in
  809. +
  810. + if last_active.iend > interval.iend then begin
  811. + (* last interval in active ends latest -> spill it*)
  812. +
  813. + (* transfer the register from the active in the current interval *)
  814. + begin match last_active.reg.Reg.loc with
  815. + | Reg.Reg r -> interval.reg.Reg.loc <- Reg.Reg r
  816. + | _ -> ()
  817. + end;
  818. +
  819. + (* remove the latest interval from active ... *)
  820. + active_cl.active <- pop_active active_cl.active;
  821. + (* ... and insert the current *)
  822. + active_cl.active <- insert_into active_cl.active interval;
  823. +
  824. + (* now get a new stack slot for the spilled register *)
  825. + last_active.reg.Reg.loc <- Reg.Stack(Reg.Local (get_stack_slot cl));
  826. + last_active.reg.Reg.spill <- true
  827. + end
  828. + else begin
  829. + (* the current interval ends latest -> spill it *)
  830. + interval.reg.Reg.loc <- Reg.Stack(Reg.Local (get_stack_slot cl));
  831. + interval.reg.Reg.spill <- true
  832. + end;
  833. + end;
  834. + ()
  835. +
  836. +
  837. +let handle_interval interval =
  838. + let position = interval.ibegin in
  839. +
  840. + (* release all intervals that have been expired at the current step*)
  841. + for i = 0 to Proc.num_register_classes - 1 do
  842. + let active_cl = active.(i) in
  843. + active_cl.active <- release_expired_active active_cl position active_cl.active;
  844. + active_cl.inactive <- release_expired_inactive active_cl position active_cl.inactive;
  845. + active_cl.fixed <- release_expired_fixed position active_cl.fixed;
  846. + done;
  847. +
  848. +
  849. + (* find a register for allocation *)
  850. + if not (try_alloc_free_register interval) then
  851. + (* a valid free register could not be found, so we have to
  852. + decide which interval is to be spilled *)
  853. + allocate_blocked_register interval
  854. +
  855. +(* create active liste for every register class *)
  856. +let initialize_interval_lists intervals =
  857. +
  858. +
  859. + for i=0 to Proc.num_register_classes - 1 do
  860. + let active_cl = active.(i) in
  861. + (* start with empty actives *)
  862. + active_cl.active <- [];
  863. + active_cl.inactive <- [];
  864. + active_cl.fixed <- [];
  865. + done;
  866. +
  867. + (* add all fixed intervals to the list of active_fixed intervals *)
  868. + let rec add_fixed_intervals intervals =
  869. + begin match intervals with
  870. + | [] -> ()
  871. + | i :: tl ->
  872. + let active_cl = active.(Proc.register_class i.reg) in
  873. + active_cl.fixed <- i :: active_cl.fixed;
  874. + add_fixed_intervals tl
  875. + end in
  876. + add_fixed_intervals intervals;
  877. +
  878. + for i = 0 to Proc.num_register_classes - 1 do
  879. + let active_cl = active.(i) in
  880. + active_cl.fixed <- List.sort (fun i0 i1 -> i1.iend - i0.iend) active_cl.fixed
  881. + done
  882. +
  883. +
  884. +
  885. +
  886. +
  887. +let walk_intervals intervals fixed_intervals fd =
  888. + (* Initialize the stack slots *)
  889. + for i = 0 to Proc.num_register_classes - 1 do
  890. + Proc.num_stack_slots.(i) <- 0
  891. + done;
  892. +
  893. +
  894. + (* create the active lists *)
  895. + initialize_interval_lists fixed_intervals;
  896. +
  897. +
  898. + (* Walk all the intervals within the list *)
  899. + List.iter handle_interval intervals
  900. +
  901. Index: asmcomp/linscan.mli
  902. ===================================================================
  903. --- asmcomp/linscan.mli (Revision 0)
  904. +++ asmcomp/linscan.mli (Revision 27)
  905. @@ -0,0 +1,16 @@
  906. +(***********************************************************************)
  907. +(* *)
  908. +(* Objective Caml *)
  909. +(* *)
  910. +(* Marcell Fischbach *)
  911. +(* *)
  912. +(* Copyright 2011 University of Siegen. All rights reserved. *)
  913. +(* This file is distributed under the terms of the *)
  914. +(* Q Public License version 1.0. *)
  915. +(* *)
  916. +(***********************************************************************)
  917. +
  918. +
  919. +
  920. +val walk_intervals: Interval.interval list -> Interval.interval list -> Mach.fundecl -> unit
  921. +
  922. Index: Makefile
  923. ===================================================================
  924. --- Makefile (Revision 2)
  925. +++ Makefile (Revision 27)
  926. @@ -79,6 +79,7 @@
  927. asmcomp/interf.cmo asmcomp/coloring.cmo \
  928. asmcomp/reloadgen.cmo asmcomp/reload.cmo \
  929. asmcomp/printlinear.cmo asmcomp/linearize.cmo \
  930. + asmcomp/interval.cmo asmcomp/linscan.cmo \
  931. asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
  932. asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
  933. asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo
  934. Index: toplevel/opttopmain.ml
  935. ===================================================================
  936. --- toplevel/opttopmain.ml (Revision 2)
  937. +++ toplevel/opttopmain.ml (Revision 27)
  938. @@ -85,6 +85,8 @@
  939. let _warn_error s = Warnings.parse_options true s
  940. let _warn_help = Warnings.help_warnings
  941.  
  942. + let _linscan = set use_linscan
  943. +
  944. let _dparsetree = set dump_parsetree
  945. let _drawlambda = set dump_rawlambda
  946. let _dlambda = set dump_lambda
  947. @@ -100,6 +102,7 @@
  948. let _dreload = set dump_reload
  949. let _dscheduling = set dump_scheduling
  950. let _dlinear = set dump_linear
  951. + let _dinterval = set dump_interval
  952. let _dstartup = set keep_startup_file
  953.  
  954. let anonymous = file_argument
  955. Index: Makefile.nt
  956. ===================================================================
  957. --- Makefile.nt (Revision 2)
  958. +++ Makefile.nt (Revision 27)
  959. @@ -76,6 +76,7 @@
  960. asmcomp/interf.cmo asmcomp/coloring.cmo \
  961. asmcomp/reloadgen.cmo asmcomp/reload.cmo \
  962. asmcomp/printlinear.cmo asmcomp/linearize.cmo \
  963. + asmcomp/interval.cmo asmcomp/linscan.cmo \
  964. asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
  965. asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
  966. asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo
  967. Index: utils/clflags.ml
  968. ===================================================================
  969. --- utils/clflags.ml (Revision 2)
  970. +++ utils/clflags.ml (Revision 27)
  971. @@ -26,6 +26,7 @@
  972. and make_archive = ref false (* -a *)
  973. and debug = ref false (* -g *)
  974. and fast = ref false (* -unsafe *)
  975. +and use_linscan = ref false (* -linscan *)
  976. and link_everything = ref false (* -linkall *)
  977. and custom_runtime = ref false (* -custom *)
  978. and output_c_object = ref false (* -output-obj *)
  979. @@ -73,6 +74,7 @@
  980. let dump_reload = ref false (* -dreload *)
  981. let dump_scheduling = ref false (* -dscheduling *)
  982. let dump_linear = ref false (* -dlinear *)
  983. +let dump_interval = ref false (* -dinterval *)
  984. let keep_startup_file = ref false (* -dstartup *)
  985. let dump_combine = ref false (* -dcombine *)
  986.  
  987. Index: utils/clflags.mli
  988. ===================================================================
  989. --- utils/clflags.mli (Revision 2)
  990. +++ utils/clflags.mli (Revision 27)
  991. @@ -23,6 +23,7 @@
  992. val make_archive : bool ref
  993. val debug : bool ref
  994. val fast : bool ref
  995. +val use_linscan : bool ref
  996. val link_everything : bool ref
  997. val custom_runtime : bool ref
  998. val output_c_object : bool ref
  999. @@ -67,6 +68,7 @@
  1000. val dump_reload : bool ref
  1001. val dump_scheduling : bool ref
  1002. val dump_linear : bool ref
  1003. +val dump_interval : bool ref
  1004. val keep_startup_file : bool ref
  1005. val dump_combine : bool ref
  1006. val native_code : bool ref
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!