From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001
From: Erlang/OTP <otp@erlang.org>
Date: Fri, 20 Nov 2009 14:54:40 +0000
Subject: The R13B03 release.
---
lib/hipe/Makefile | 63 +
lib/hipe/TODO | 130 +
lib/hipe/amd64/Makefile | 127 +
lib/hipe/amd64/hipe_amd64_assemble.erl | 19 +
lib/hipe/amd64/hipe_amd64_defuse.erl | 20 +
lib/hipe/amd64/hipe_amd64_encode.erl | 1484 ++++++
lib/hipe/amd64/hipe_amd64_frame.erl | 20 +
lib/hipe/amd64/hipe_amd64_liveness.erl | 20 +
lib/hipe/amd64/hipe_amd64_main.erl | 20 +
lib/hipe/amd64/hipe_amd64_pp.erl | 20 +
lib/hipe/amd64/hipe_amd64_ra.erl | 20 +
lib/hipe/amd64/hipe_amd64_ra_finalise.erl | 20 +
lib/hipe/amd64/hipe_amd64_ra_ls.erl | 20 +
lib/hipe/amd64/hipe_amd64_ra_naive.erl | 20 +
lib/hipe/amd64/hipe_amd64_ra_postconditions.erl | 20 +
.../amd64/hipe_amd64_ra_sse2_postconditions.erl | 188 +
lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl | 20 +
lib/hipe/amd64/hipe_amd64_registers.erl | 288 ++
lib/hipe/amd64/hipe_amd64_spill_restore.erl | 20 +
lib/hipe/amd64/hipe_amd64_x87.erl | 20 +
lib/hipe/amd64/hipe_rtl_to_amd64.erl | 20 +
lib/hipe/arm/Makefile | 116 +
lib/hipe/arm/TODO | 20 +
lib/hipe/arm/hipe_arm.erl | 380 ++
lib/hipe/arm/hipe_arm.hrl | 124 +
lib/hipe/arm/hipe_arm_assemble.erl | 665 +++
lib/hipe/arm/hipe_arm_cfg.erl | 131 +
lib/hipe/arm/hipe_arm_defuse.erl | 157 +
lib/hipe/arm/hipe_arm_encode.erl | 994 ++++
lib/hipe/arm/hipe_arm_finalise.erl | 73 +
lib/hipe/arm/hipe_arm_frame.erl | 639 +++
lib/hipe/arm/hipe_arm_liveness_gpr.erl | 38 +
lib/hipe/arm/hipe_arm_main.erl | 58 +
lib/hipe/arm/hipe_arm_pp.erl | 351 ++
lib/hipe/arm/hipe_arm_ra.erl | 56 +
lib/hipe/arm/hipe_arm_ra_finalise.erl | 285 ++
lib/hipe/arm/hipe_arm_ra_ls.erl | 56 +
lib/hipe/arm/hipe_arm_ra_naive.erl | 29 +
lib/hipe/arm/hipe_arm_ra_postconditions.erl | 278 ++
lib/hipe/arm/hipe_arm_registers.erl | 207 +
lib/hipe/arm/hipe_rtl_to_arm.erl | 836 ++++
lib/hipe/cerl/Makefile | 107 +
lib/hipe/cerl/cerl_cconv.erl | 777 +++
lib/hipe/cerl/cerl_closurean.erl | 862 ++++
lib/hipe/cerl/cerl_hipe_primops.hrl | 88 +
lib/hipe/cerl/cerl_hipeify.erl | 655 +++
lib/hipe/cerl/cerl_hybrid_transform.erl | 153 +
lib/hipe/cerl/cerl_lib.erl | 462 ++
lib/hipe/cerl/cerl_messagean.erl | 1105 +++++
lib/hipe/cerl/cerl_pmatch.erl | 624 +++
lib/hipe/cerl/cerl_prettypr.erl | 883 ++++
lib/hipe/cerl/cerl_to_icode.erl | 2717 +++++++++++
lib/hipe/cerl/cerl_typean.erl | 1003 ++++
lib/hipe/cerl/erl_bif_types.erl | 5021 ++++++++++++++++++++
lib/hipe/cerl/erl_types.erl | 3847 +++++++++++++++
lib/hipe/doc/Makefile | 29 +
lib/hipe/doc/html/.gitignore | 0
lib/hipe/doc/overview.edoc | 9 +
lib/hipe/doc/pdf/.gitignore | 0
lib/hipe/doc/src/Makefile | 113 +
lib/hipe/doc/src/book.xml | 38 +
lib/hipe/doc/src/fascicules.xml | 12 +
lib/hipe/doc/src/make.dep | 13 +
lib/hipe/doc/src/notes.xml | 350 ++
lib/hipe/doc/src/part_notes.xml | 35 +
lib/hipe/ebin/.gitignore | 0
lib/hipe/flow/Makefile | 105 +
lib/hipe/flow/cfg.hrl | 53 +
lib/hipe/flow/cfg.inc | 949 ++++
lib/hipe/flow/ebb.inc | 247 +
lib/hipe/flow/hipe_bb.erl | 81 +
lib/hipe/flow/hipe_bb.hrl | 30 +
lib/hipe/flow/hipe_dominators.erl | 715 +++
lib/hipe/flow/hipe_gen_cfg.erl | 37 +
lib/hipe/flow/liveness.inc | 332 ++
lib/hipe/icode/Makefile | 144 +
lib/hipe/icode/hipe_beam_to_icode.erl | 2326 +++++++++
lib/hipe/icode/hipe_icode.erl | 1820 +++++++
lib/hipe/icode/hipe_icode.hrl | 188 +
lib/hipe/icode/hipe_icode_bincomp.erl | 178 +
lib/hipe/icode/hipe_icode_callgraph.erl | 217 +
lib/hipe/icode/hipe_icode_cfg.erl | 203 +
lib/hipe/icode/hipe_icode_coordinator.erl | 274 ++
lib/hipe/icode/hipe_icode_ebb.erl | 30 +
lib/hipe/icode/hipe_icode_exceptions.erl | 474 ++
lib/hipe/icode/hipe_icode_fp.erl | 1043 ++++
lib/hipe/icode/hipe_icode_heap_test.erl | 200 +
lib/hipe/icode/hipe_icode_inline_bifs.erl | 240 +
lib/hipe/icode/hipe_icode_instruction_counter.erl | 135 +
lib/hipe/icode/hipe_icode_liveness.erl | 101 +
lib/hipe/icode/hipe_icode_mulret.erl | 1323 ++++++
lib/hipe/icode/hipe_icode_pp.erl | 303 ++
lib/hipe/icode/hipe_icode_primops.erl | 963 ++++
lib/hipe/icode/hipe_icode_primops.hrl | 40 +
lib/hipe/icode/hipe_icode_range.erl | 1966 ++++++++
lib/hipe/icode/hipe_icode_split_arith.erl | 553 +++
lib/hipe/icode/hipe_icode_ssa.erl | 98 +
lib/hipe/icode/hipe_icode_ssa_const_prop.erl | 728 +++
lib/hipe/icode/hipe_icode_ssa_copy_prop.erl | 41 +
lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl | 1444 ++++++
lib/hipe/icode/hipe_icode_type.erl | 2266 +++++++++
lib/hipe/icode/hipe_icode_type.hrl | 25 +
lib/hipe/info | 2 +
lib/hipe/main/Makefile | 117 +
lib/hipe/main/hipe.app.src | 222 +
lib/hipe/main/hipe.appup.src | 19 +
lib/hipe/main/hipe.erl | 1555 ++++++
lib/hipe/main/hipe.hrl.src | 322 ++
lib/hipe/main/hipe_main.erl | 549 +++
lib/hipe/misc/Makefile | 113 +
lib/hipe/misc/hipe_consttab.erl | 503 ++
lib/hipe/misc/hipe_consttab.hrl | 27 +
lib/hipe/misc/hipe_data_pp.erl | 158 +
lib/hipe/misc/hipe_gensym.erl | 244 +
lib/hipe/misc/hipe_pack_constants.erl | 211 +
lib/hipe/misc/hipe_sdi.erl | 378 ++
lib/hipe/misc/hipe_sdi.hrl | 25 +
lib/hipe/native.mk | 5 +
lib/hipe/opt/Makefile | 101 +
lib/hipe/opt/hipe_schedule.erl | 1489 ++++++
lib/hipe/opt/hipe_schedule_prio.erl | 58 +
lib/hipe/opt/hipe_spillmin.erl | 111 +
lib/hipe/opt/hipe_spillmin_color.erl | 556 +++
lib/hipe/opt/hipe_spillmin_scan.erl | 559 +++
lib/hipe/opt/hipe_target_machine.erl | 93 +
lib/hipe/opt/hipe_ultra_mod2.erl | 239 +
lib/hipe/opt/hipe_ultra_prio.erl | 304 ++
lib/hipe/ppc/Makefile | 120 +
lib/hipe/ppc/hipe_ppc.erl | 415 ++
lib/hipe/ppc/hipe_ppc.hrl | 118 +
lib/hipe/ppc/hipe_ppc_assemble.erl | 603 +++
lib/hipe/ppc/hipe_ppc_cfg.erl | 131 +
lib/hipe/ppc/hipe_ppc_defuse.erl | 145 +
lib/hipe/ppc/hipe_ppc_encode.erl | 1558 ++++++
lib/hipe/ppc/hipe_ppc_finalise.erl | 65 +
lib/hipe/ppc/hipe_ppc_frame.erl | 657 +++
lib/hipe/ppc/hipe_ppc_liveness_all.erl | 38 +
lib/hipe/ppc/hipe_ppc_liveness_fpr.erl | 34 +
lib/hipe/ppc/hipe_ppc_liveness_gpr.erl | 38 +
lib/hipe/ppc/hipe_ppc_main.erl | 51 +
lib/hipe/ppc/hipe_ppc_pp.erl | 350 ++
lib/hipe/ppc/hipe_ppc_ra.erl | 56 +
lib/hipe/ppc/hipe_ppc_ra_finalise.erl | 271 ++
lib/hipe/ppc/hipe_ppc_ra_ls.erl | 56 +
lib/hipe/ppc/hipe_ppc_ra_naive.erl | 29 +
lib/hipe/ppc/hipe_ppc_ra_postconditions.erl | 243 +
lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl | 130 +
lib/hipe/ppc/hipe_ppc_registers.erl | 246 +
lib/hipe/ppc/hipe_rtl_to_ppc.erl | 1249 +++++
lib/hipe/prebuild.skip | 1 +
lib/hipe/regalloc/Makefile | 123 +
lib/hipe/regalloc/hipe_adj_list.erl | 143 +
lib/hipe/regalloc/hipe_amd64_specific.erl | 20 +
lib/hipe/regalloc/hipe_amd64_specific_sse2.erl | 175 +
lib/hipe/regalloc/hipe_amd64_specific_x87.erl | 20 +
lib/hipe/regalloc/hipe_arm_specific.erl | 168 +
lib/hipe/regalloc/hipe_coalescing_regalloc.erl | 1029 ++++
lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl | 806 ++++
lib/hipe/regalloc/hipe_ig.erl | 776 +++
lib/hipe/regalloc/hipe_ig_moves.erl | 81 +
lib/hipe/regalloc/hipe_ls_regalloc.erl | 788 +++
lib/hipe/regalloc/hipe_moves.erl | 165 +
lib/hipe/regalloc/hipe_node_sets.erl | 48 +
lib/hipe/regalloc/hipe_optimistic_regalloc.erl | 2043 ++++++++
lib/hipe/regalloc/hipe_ppc_specific.erl | 168 +
lib/hipe/regalloc/hipe_ppc_specific_fp.erl | 146 +
lib/hipe/regalloc/hipe_reg_worklists.erl | 360 ++
lib/hipe/regalloc/hipe_regalloc_loop.erl | 68 +
lib/hipe/regalloc/hipe_sparc_specific.erl | 168 +
lib/hipe/regalloc/hipe_sparc_specific_fp.erl | 146 +
lib/hipe/regalloc/hipe_spillcost.erl | 101 +
lib/hipe/regalloc/hipe_spillcost.hrl | 27 +
lib/hipe/regalloc/hipe_temp_map.erl | 125 +
lib/hipe/regalloc/hipe_x86_specific.erl | 203 +
lib/hipe/regalloc/hipe_x86_specific_x87.erl | 164 +
lib/hipe/rtl/Makefile | 142 +
lib/hipe/rtl/hipe_icode2rtl.erl | 727 +++
lib/hipe/rtl/hipe_rtl.erl | 1655 +++++++
lib/hipe/rtl/hipe_rtl.hrl | 61 +
lib/hipe/rtl/hipe_rtl_arch.erl | 612 +++
lib/hipe/rtl/hipe_rtl_arith.inc | 177 +
lib/hipe/rtl/hipe_rtl_arith_32.erl | 50 +
lib/hipe/rtl/hipe_rtl_arith_64.erl | 38 +
lib/hipe/rtl/hipe_rtl_binary.erl | 80 +
lib/hipe/rtl/hipe_rtl_binary_construct.erl | 1363 ++++++
lib/hipe/rtl/hipe_rtl_binary_match.erl | 1134 +++++
lib/hipe/rtl/hipe_rtl_cfg.erl | 201 +
lib/hipe/rtl/hipe_rtl_cleanup_const.erl | 85 +
lib/hipe/rtl/hipe_rtl_exceptions.erl | 120 +
lib/hipe/rtl/hipe_rtl_lcm.erl | 1696 +++++++
lib/hipe/rtl/hipe_rtl_liveness.erl | 145 +
lib/hipe/rtl/hipe_rtl_mk_switch.erl | 985 ++++
lib/hipe/rtl/hipe_rtl_primops.erl | 1259 +++++
lib/hipe/rtl/hipe_rtl_ssa.erl | 93 +
lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl | 357 ++
lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl | 1082 +++++
lib/hipe/rtl/hipe_rtl_ssapre.erl | 1679 +++++++
lib/hipe/rtl/hipe_rtl_symbolic.erl | 99 +
lib/hipe/rtl/hipe_rtl_varmap.erl | 161 +
lib/hipe/rtl/hipe_tagscheme.erl | 1209 +++++
lib/hipe/sparc/Makefile | 120 +
lib/hipe/sparc/hipe_rtl_to_sparc.erl | 972 ++++
lib/hipe/sparc/hipe_sparc.erl | 407 ++
lib/hipe/sparc/hipe_sparc.hrl | 116 +
lib/hipe/sparc/hipe_sparc_assemble.erl | 588 +++
lib/hipe/sparc/hipe_sparc_cfg.erl | 134 +
lib/hipe/sparc/hipe_sparc_defuse.erl | 143 +
lib/hipe/sparc/hipe_sparc_encode.erl | 476 ++
lib/hipe/sparc/hipe_sparc_finalise.erl | 138 +
lib/hipe/sparc/hipe_sparc_frame.erl | 636 +++
lib/hipe/sparc/hipe_sparc_liveness_all.erl | 38 +
lib/hipe/sparc/hipe_sparc_liveness_fpr.erl | 34 +
lib/hipe/sparc/hipe_sparc_liveness_gpr.erl | 38 +
lib/hipe/sparc/hipe_sparc_main.erl | 58 +
lib/hipe/sparc/hipe_sparc_pp.erl | 342 ++
lib/hipe/sparc/hipe_sparc_ra.erl | 56 +
lib/hipe/sparc/hipe_sparc_ra_finalise.erl | 254 +
lib/hipe/sparc/hipe_sparc_ra_ls.erl | 56 +
lib/hipe/sparc/hipe_sparc_ra_naive.erl | 29 +
lib/hipe/sparc/hipe_sparc_ra_postconditions.erl | 222 +
lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl | 120 +
lib/hipe/sparc/hipe_sparc_registers.erl | 291 ++
lib/hipe/ssa/hipe_ssa.inc | 978 ++++
lib/hipe/ssa/hipe_ssa_const_prop.inc | 522 ++
lib/hipe/ssa/hipe_ssa_copy_prop.inc | 198 +
lib/hipe/ssa/hipe_ssa_liveness.inc | 328 ++
lib/hipe/tools/Makefile | 111 +
lib/hipe/tools/hipe_ceach.erl | 74 +
lib/hipe/tools/hipe_jit.erl | 87 +
lib/hipe/tools/hipe_profile.erl | 191 +
lib/hipe/tools/hipe_timer.erl | 159 +
lib/hipe/tools/hipe_tool.erl | 513 ++
lib/hipe/util/Makefile | 109 +
lib/hipe/util/hipe_digraph.erl | 238 +
lib/hipe/util/hipe_dot.erl | 217 +
lib/hipe/util/hipe_timing.erl | 131 +
lib/hipe/util/hipe_vectors.erl | 111 +
lib/hipe/util/hipe_vectors.hrl | 28 +
lib/hipe/vsn.mk | 1 +
lib/hipe/x86/Makefile | 134 +
lib/hipe/x86/NOTES.OPTIM | 200 +
lib/hipe/x86/NOTES.RA | 32 +
lib/hipe/x86/TODO | 31 +
lib/hipe/x86/hipe_rtl_to_x86.erl | 865 ++++
lib/hipe/x86/hipe_x86.erl | 496 ++
lib/hipe/x86/hipe_x86.hrl | 116 +
lib/hipe/x86/hipe_x86_assemble.erl | 1014 ++++
lib/hipe/x86/hipe_x86_cfg.erl | 147 +
lib/hipe/x86/hipe_x86_defuse.erl | 160 +
lib/hipe/x86/hipe_x86_encode.erl | 1302 +++++
lib/hipe/x86/hipe_x86_encode.txt | 213 +
lib/hipe/x86/hipe_x86_frame.erl | 687 +++
lib/hipe/x86/hipe_x86_liveness.erl | 57 +
lib/hipe/x86/hipe_x86_main.erl | 70 +
lib/hipe/x86/hipe_x86_postpass.erl | 276 ++
lib/hipe/x86/hipe_x86_pp.erl | 350 ++
lib/hipe/x86/hipe_x86_ra.erl | 99 +
lib/hipe/x86/hipe_x86_ra_finalise.erl | 335 ++
lib/hipe/x86/hipe_x86_ra_ls.erl | 85 +
lib/hipe/x86/hipe_x86_ra_naive.erl | 409 ++
lib/hipe/x86/hipe_x86_ra_postconditions.erl | 452 ++
lib/hipe/x86/hipe_x86_ra_x87_ls.erl | 63 +
lib/hipe/x86/hipe_x86_registers.erl | 254 +
lib/hipe/x86/hipe_x86_spill_restore.erl | 345 ++
lib/hipe/x86/hipe_x86_x87.erl | 635 +++
265 files changed, 102773 insertions(+)
create mode 100644 lib/hipe/Makefile
create mode 100644 lib/hipe/TODO
create mode 100644 lib/hipe/amd64/Makefile
create mode 100644 lib/hipe/amd64/hipe_amd64_assemble.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_defuse.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_encode.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_frame.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_liveness.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_main.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_pp.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra_finalise.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra_ls.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra_naive.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra_postconditions.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_registers.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_spill_restore.erl
create mode 100644 lib/hipe/amd64/hipe_amd64_x87.erl
create mode 100644 lib/hipe/amd64/hipe_rtl_to_amd64.erl
create mode 100644 lib/hipe/arm/Makefile
create mode 100644 lib/hipe/arm/TODO
create mode 100644 lib/hipe/arm/hipe_arm.erl
create mode 100644 lib/hipe/arm/hipe_arm.hrl
create mode 100644 lib/hipe/arm/hipe_arm_assemble.erl
create mode 100644 lib/hipe/arm/hipe_arm_cfg.erl
create mode 100644 lib/hipe/arm/hipe_arm_defuse.erl
create mode 100644 lib/hipe/arm/hipe_arm_encode.erl
create mode 100644 lib/hipe/arm/hipe_arm_finalise.erl
create mode 100644 lib/hipe/arm/hipe_arm_frame.erl
create mode 100644 lib/hipe/arm/hipe_arm_liveness_gpr.erl
create mode 100644 lib/hipe/arm/hipe_arm_main.erl
create mode 100644 lib/hipe/arm/hipe_arm_pp.erl
create mode 100644 lib/hipe/arm/hipe_arm_ra.erl
create mode 100644 lib/hipe/arm/hipe_arm_ra_finalise.erl
create mode 100644 lib/hipe/arm/hipe_arm_ra_ls.erl
create mode 100644 lib/hipe/arm/hipe_arm_ra_naive.erl
create mode 100644 lib/hipe/arm/hipe_arm_ra_postconditions.erl
create mode 100644 lib/hipe/arm/hipe_arm_registers.erl
create mode 100644 lib/hipe/arm/hipe_rtl_to_arm.erl
create mode 100644 lib/hipe/cerl/Makefile
create mode 100644 lib/hipe/cerl/cerl_cconv.erl
create mode 100644 lib/hipe/cerl/cerl_closurean.erl
create mode 100644 lib/hipe/cerl/cerl_hipe_primops.hrl
create mode 100644 lib/hipe/cerl/cerl_hipeify.erl
create mode 100644 lib/hipe/cerl/cerl_hybrid_transform.erl
create mode 100644 lib/hipe/cerl/cerl_lib.erl
create mode 100644 lib/hipe/cerl/cerl_messagean.erl
create mode 100644 lib/hipe/cerl/cerl_pmatch.erl
create mode 100644 lib/hipe/cerl/cerl_prettypr.erl
create mode 100644 lib/hipe/cerl/cerl_to_icode.erl
create mode 100644 lib/hipe/cerl/cerl_typean.erl
create mode 100644 lib/hipe/cerl/erl_bif_types.erl
create mode 100644 lib/hipe/cerl/erl_types.erl
create mode 100644 lib/hipe/doc/Makefile
create mode 100644 lib/hipe/doc/html/.gitignore
create mode 100644 lib/hipe/doc/overview.edoc
create mode 100644 lib/hipe/doc/pdf/.gitignore
create mode 100644 lib/hipe/doc/src/Makefile
create mode 100644 lib/hipe/doc/src/book.xml
create mode 100644 lib/hipe/doc/src/fascicules.xml
create mode 100644 lib/hipe/doc/src/make.dep
create mode 100644 lib/hipe/doc/src/notes.xml
create mode 100644 lib/hipe/doc/src/part_notes.xml
create mode 100644 lib/hipe/ebin/.gitignore
create mode 100644 lib/hipe/flow/Makefile
create mode 100644 lib/hipe/flow/cfg.hrl
create mode 100644 lib/hipe/flow/cfg.inc
create mode 100644 lib/hipe/flow/ebb.inc
create mode 100644 lib/hipe/flow/hipe_bb.erl
create mode 100644 lib/hipe/flow/hipe_bb.hrl
create mode 100644 lib/hipe/flow/hipe_dominators.erl
create mode 100644 lib/hipe/flow/hipe_gen_cfg.erl
create mode 100644 lib/hipe/flow/liveness.inc
create mode 100644 lib/hipe/icode/Makefile
create mode 100644 lib/hipe/icode/hipe_beam_to_icode.erl
create mode 100644 lib/hipe/icode/hipe_icode.erl
create mode 100644 lib/hipe/icode/hipe_icode.hrl
create mode 100644 lib/hipe/icode/hipe_icode_bincomp.erl
create mode 100644 lib/hipe/icode/hipe_icode_callgraph.erl
create mode 100644 lib/hipe/icode/hipe_icode_cfg.erl
create mode 100644 lib/hipe/icode/hipe_icode_coordinator.erl
create mode 100644 lib/hipe/icode/hipe_icode_ebb.erl
create mode 100644 lib/hipe/icode/hipe_icode_exceptions.erl
create mode 100644 lib/hipe/icode/hipe_icode_fp.erl
create mode 100644 lib/hipe/icode/hipe_icode_heap_test.erl
create mode 100644 lib/hipe/icode/hipe_icode_inline_bifs.erl
create mode 100644 lib/hipe/icode/hipe_icode_instruction_counter.erl
create mode 100644 lib/hipe/icode/hipe_icode_liveness.erl
create mode 100644 lib/hipe/icode/hipe_icode_mulret.erl
create mode 100755 lib/hipe/icode/hipe_icode_pp.erl
create mode 100644 lib/hipe/icode/hipe_icode_primops.erl
create mode 100644 lib/hipe/icode/hipe_icode_primops.hrl
create mode 100644 lib/hipe/icode/hipe_icode_range.erl
create mode 100644 lib/hipe/icode/hipe_icode_split_arith.erl
create mode 100755 lib/hipe/icode/hipe_icode_ssa.erl
create mode 100644 lib/hipe/icode/hipe_icode_ssa_const_prop.erl
create mode 100644 lib/hipe/icode/hipe_icode_ssa_copy_prop.erl
create mode 100644 lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
create mode 100644 lib/hipe/icode/hipe_icode_type.erl
create mode 100644 lib/hipe/icode/hipe_icode_type.hrl
create mode 100644 lib/hipe/info
create mode 100644 lib/hipe/main/Makefile
create mode 100644 lib/hipe/main/hipe.app.src
create mode 100644 lib/hipe/main/hipe.appup.src
create mode 100644 lib/hipe/main/hipe.erl
create mode 100644 lib/hipe/main/hipe.hrl.src
create mode 100644 lib/hipe/main/hipe_main.erl
create mode 100644 lib/hipe/misc/Makefile
create mode 100644 lib/hipe/misc/hipe_consttab.erl
create mode 100644 lib/hipe/misc/hipe_consttab.hrl
create mode 100644 lib/hipe/misc/hipe_data_pp.erl
create mode 100644 lib/hipe/misc/hipe_gensym.erl
create mode 100644 lib/hipe/misc/hipe_pack_constants.erl
create mode 100644 lib/hipe/misc/hipe_sdi.erl
create mode 100644 lib/hipe/misc/hipe_sdi.hrl
create mode 100644 lib/hipe/native.mk
create mode 100644 lib/hipe/opt/Makefile
create mode 100644 lib/hipe/opt/hipe_schedule.erl
create mode 100644 lib/hipe/opt/hipe_schedule_prio.erl
create mode 100644 lib/hipe/opt/hipe_spillmin.erl
create mode 100644 lib/hipe/opt/hipe_spillmin_color.erl
create mode 100644 lib/hipe/opt/hipe_spillmin_scan.erl
create mode 100644 lib/hipe/opt/hipe_target_machine.erl
create mode 100644 lib/hipe/opt/hipe_ultra_mod2.erl
create mode 100644 lib/hipe/opt/hipe_ultra_prio.erl
create mode 100644 lib/hipe/ppc/Makefile
create mode 100644 lib/hipe/ppc/hipe_ppc.erl
create mode 100644 lib/hipe/ppc/hipe_ppc.hrl
create mode 100644 lib/hipe/ppc/hipe_ppc_assemble.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_cfg.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_defuse.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_encode.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_finalise.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_frame.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_liveness_all.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_liveness_fpr.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_liveness_gpr.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_main.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_pp.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_ra.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_ra_finalise.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_ra_ls.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_ra_naive.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_ra_postconditions.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl
create mode 100644 lib/hipe/ppc/hipe_ppc_registers.erl
create mode 100644 lib/hipe/ppc/hipe_rtl_to_ppc.erl
create mode 100644 lib/hipe/prebuild.skip
create mode 100644 lib/hipe/regalloc/Makefile
create mode 100644 lib/hipe/regalloc/hipe_adj_list.erl
create mode 100644 lib/hipe/regalloc/hipe_amd64_specific.erl
create mode 100644 lib/hipe/regalloc/hipe_amd64_specific_sse2.erl
create mode 100644 lib/hipe/regalloc/hipe_amd64_specific_x87.erl
create mode 100644 lib/hipe/regalloc/hipe_arm_specific.erl
create mode 100644 lib/hipe/regalloc/hipe_coalescing_regalloc.erl
create mode 100644 lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl
create mode 100644 lib/hipe/regalloc/hipe_ig.erl
create mode 100644 lib/hipe/regalloc/hipe_ig_moves.erl
create mode 100644 lib/hipe/regalloc/hipe_ls_regalloc.erl
create mode 100644 lib/hipe/regalloc/hipe_moves.erl
create mode 100644 lib/hipe/regalloc/hipe_node_sets.erl
create mode 100644 lib/hipe/regalloc/hipe_optimistic_regalloc.erl
create mode 100644 lib/hipe/regalloc/hipe_ppc_specific.erl
create mode 100644 lib/hipe/regalloc/hipe_ppc_specific_fp.erl
create mode 100644 lib/hipe/regalloc/hipe_reg_worklists.erl
create mode 100644 lib/hipe/regalloc/hipe_regalloc_loop.erl
create mode 100644 lib/hipe/regalloc/hipe_sparc_specific.erl
create mode 100644 lib/hipe/regalloc/hipe_sparc_specific_fp.erl
create mode 100644 lib/hipe/regalloc/hipe_spillcost.erl
create mode 100644 lib/hipe/regalloc/hipe_spillcost.hrl
create mode 100644 lib/hipe/regalloc/hipe_temp_map.erl
create mode 100644 lib/hipe/regalloc/hipe_x86_specific.erl
create mode 100644 lib/hipe/regalloc/hipe_x86_specific_x87.erl
create mode 100644 lib/hipe/rtl/Makefile
create mode 100644 lib/hipe/rtl/hipe_icode2rtl.erl
create mode 100644 lib/hipe/rtl/hipe_rtl.erl
create mode 100644 lib/hipe/rtl/hipe_rtl.hrl
create mode 100644 lib/hipe/rtl/hipe_rtl_arch.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_arith.inc
create mode 100644 lib/hipe/rtl/hipe_rtl_arith_32.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_arith_64.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_binary.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_binary_construct.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_binary_match.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_cfg.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_cleanup_const.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_exceptions.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_lcm.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_liveness.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_mk_switch.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_primops.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_ssa.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_ssapre.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_symbolic.erl
create mode 100644 lib/hipe/rtl/hipe_rtl_varmap.erl
create mode 100644 lib/hipe/rtl/hipe_tagscheme.erl
create mode 100644 lib/hipe/sparc/Makefile
create mode 100644 lib/hipe/sparc/hipe_rtl_to_sparc.erl
create mode 100644 lib/hipe/sparc/hipe_sparc.erl
create mode 100644 lib/hipe/sparc/hipe_sparc.hrl
create mode 100644 lib/hipe/sparc/hipe_sparc_assemble.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_cfg.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_defuse.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_encode.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_finalise.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_frame.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_liveness_all.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_liveness_fpr.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_liveness_gpr.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_main.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_pp.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_ra.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_ra_finalise.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_ra_ls.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_ra_naive.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_ra_postconditions.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl
create mode 100644 lib/hipe/sparc/hipe_sparc_registers.erl
create mode 100644 lib/hipe/ssa/hipe_ssa.inc
create mode 100644 lib/hipe/ssa/hipe_ssa_const_prop.inc
create mode 100644 lib/hipe/ssa/hipe_ssa_copy_prop.inc
create mode 100644 lib/hipe/ssa/hipe_ssa_liveness.inc
create mode 100644 lib/hipe/tools/Makefile
create mode 100644 lib/hipe/tools/hipe_ceach.erl
create mode 100644 lib/hipe/tools/hipe_jit.erl
create mode 100644 lib/hipe/tools/hipe_profile.erl
create mode 100644 lib/hipe/tools/hipe_timer.erl
create mode 100644 lib/hipe/tools/hipe_tool.erl
create mode 100644 lib/hipe/util/Makefile
create mode 100644 lib/hipe/util/hipe_digraph.erl
create mode 100755 lib/hipe/util/hipe_dot.erl
create mode 100644 lib/hipe/util/hipe_timing.erl
create mode 100644 lib/hipe/util/hipe_vectors.erl
create mode 100644 lib/hipe/util/hipe_vectors.hrl
create mode 100644 lib/hipe/vsn.mk
create mode 100644 lib/hipe/x86/Makefile
create mode 100644 lib/hipe/x86/NOTES.OPTIM
create mode 100644 lib/hipe/x86/NOTES.RA
create mode 100644 lib/hipe/x86/TODO
create mode 100644 lib/hipe/x86/hipe_rtl_to_x86.erl
create mode 100644 lib/hipe/x86/hipe_x86.erl
create mode 100644 lib/hipe/x86/hipe_x86.hrl
create mode 100644 lib/hipe/x86/hipe_x86_assemble.erl
create mode 100644 lib/hipe/x86/hipe_x86_cfg.erl
create mode 100644 lib/hipe/x86/hipe_x86_defuse.erl
create mode 100644 lib/hipe/x86/hipe_x86_encode.erl
create mode 100644 lib/hipe/x86/hipe_x86_encode.txt
create mode 100644 lib/hipe/x86/hipe_x86_frame.erl
create mode 100644 lib/hipe/x86/hipe_x86_liveness.erl
create mode 100644 lib/hipe/x86/hipe_x86_main.erl
create mode 100644 lib/hipe/x86/hipe_x86_postpass.erl
create mode 100644 lib/hipe/x86/hipe_x86_pp.erl
create mode 100644 lib/hipe/x86/hipe_x86_ra.erl
create mode 100644 lib/hipe/x86/hipe_x86_ra_finalise.erl
create mode 100644 lib/hipe/x86/hipe_x86_ra_ls.erl
create mode 100644 lib/hipe/x86/hipe_x86_ra_naive.erl
create mode 100644 lib/hipe/x86/hipe_x86_ra_postconditions.erl
create mode 100644 lib/hipe/x86/hipe_x86_ra_x87_ls.erl
create mode 100644 lib/hipe/x86/hipe_x86_registers.erl
create mode 100644 lib/hipe/x86/hipe_x86_spill_restore.erl
create mode 100644 lib/hipe/x86/hipe_x86_x87.erl
(limited to 'lib/hipe')
diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile
new file mode 100644
index 0000000000..be3a618e34
--- /dev/null
+++ b/lib/hipe/Makefile
@@ -0,0 +1,63 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+SHELL=/bin/sh
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+ifdef HIPE_ENABLED
+HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools
+else
+HIPE_SUBDIRS =
+endif
+
+ALWAYS_SUBDIRS = misc main cerl icode flow util
+
+ifdef HIPE_ENABLED
+# "rtl" below must be the first directory so that file rtl/hipe_literals.hrl
+# which is needed by many other HiPE files is built first
+SUB_DIRECTORIES = rtl $(ALWAYS_SUBDIRS) $(HIPE_SUBDIRS)
+else
+SUB_DIRECTORIES = $(ALWAYS_SUBDIRS)
+endif
+
+#
+# Default Subdir Targets
+#
+include $(ERL_TOP)/make/otp_subdir.mk
+
+# This overrides the default recursive-make edocs target in otp_subdir.mk
+# It is not pretty, but it will have to do for now.
+docs:
+ @if [ -d $(ERL_TOP)/lib/edoc/ebin ]; then \
+ erl -noshell -pa $(ERL_TOP)/lib/edoc/ebin $(ERL_TOP)/lib/syntax_tools/ebin $(ERL_TOP)/lib/xmerl/ebin -run edoc_run application 'hipe' '"."' '[new,no_packages]' -s init stop ; \
+ fi
+
+edocs: docs
+
+all-subdirs:
+ -for dir in $(SUB_DIRECTORIES); do \
+ (cd $$dir; $(MAKE) $(MAKETARGET) EBIN=../ebin; cd ..); \
+ done
+
+distclean:
+ $(MAKE) MAKETARGET="distclean" all-subdirs
+realclean:
+ $(MAKE) MAKETARGET="realclean" all-subdirs
+
diff --git a/lib/hipe/TODO b/lib/hipe/TODO
new file mode 100644
index 0000000000..f166472df6
--- /dev/null
+++ b/lib/hipe/TODO
@@ -0,0 +1,130 @@
+Bugfix
+======
+ P->current (Fix observable behaviour?)
+ New calling convention for guard bifs (Recognize at load time).
+ Long branches:
+ timer:tc(hipe,c,[megaco_text_parser,[{timeout,infinity}]]).
+ {4801210531,
+ {error,[{problem,too_long_branch},{address,3381732},{length,-828622}]}}
+
+Performance
+===========
+
+ Better handling of multimove in regalloc.
+ Faster closure creation. (Can static fields be preallocated?)
+ Expand pseudo-ops before scheduler (SPARC)
+ Stack maps for SPARC + Make frames in Sparc not in RTL.
+ Coalesce spill locations.
+
+Feature
+=======
+
+ Stack traces from stack maps.
+
+Cleanup
+=======
+
+ Speedup renaming and other bottlenecks in the compiler.
+ Only calls with fail label should end basic blocks.
+ Remove fail-entry-points from RTL (sparc/x86).
+ Cleanup hipe_*_registers.erl and interface/rules with regalloc.
+ HiPE in bootstrap.
+ Cleanup and merge loaders. (Better handling of data.)
+ Re-examine switching code.
+
+Extensions
+==========
+
+ Design strategy for finding all processes holding a certain closure.
+ Design strategy for native code unloading.
+ mbufs: In guards -> throw away, in bifs -> trigger special GC. (fix for native.)
+ Unified heap + process optimization (+ PE).
+ Incremental GC.
+
+
+Old list compiled by Thomas Lindgren (needs cleaning up)
+========================================================
+
+<h1>Experimental implementations</h1>
+<h2>RTL</h2>
+<UL>
+ <LI> Algebraiska f�renklingar av uttryck (ex. reducera integer multiply,
+ ta bort addition med 0, etc)
+ <LI> Partial redundancy elimination
+</UL>
+
+<h1>Unimplemented optimizations</h1>
+
+<H2>Erlang/Core source-level-optimizations</H2>
+<UL>
+ <LI> "Context compilation"
+ <LI> CDR-kodning
+ <LI> List reuse
+ <LI> Compilation by transformation
+</UL>
+
+<H2>Icode-optimizations</H2>
+<UL>
+ <LI> Convertion to loops from recursive programs
+ <LI> Dominatorer
+ (<a href="./thomasl/icode/dominators.erl">l�ngsamma</a>, snabba)
+</UL>
+
+<H2>RTL-optimizations</H2>
+<UL>
+ <LI> Common subexpression elimination
+ <LI> Ta bort redundanta tester globalt (ex. upprepade typtester)
+ <LI> Ordna om hopp (ex. byt ordning p� nil/cons-tester)
+ <LI> Goto eliminering (= expandera uncond. jumps m. k�nd m�ltavla)
+ <LI> Save/restore-placering: datafl�desanalys, interaktion m. catch-frames
+ <LI> Loop optimeringar
+ <UL>
+ <LI> Dominatorer (se dominatorer f�r icode)
+ <LI> Unrolling
+ <LI> Invariant expression removal
+ </UL>
+ <LI> Partial redundancy elimination by lazy code motion
+ <LI> Partially dead code
+</UL>
+
+<H2>Sparc-optimizations</H2>
+<UL>
+ <LI> Global register allocation
+ <UL>
+ <LI> <a href="./thomasl/regalloc/regalloc.erl">
+ Pessimistisk f�rgning</a>
+ <LI> Optimistisk f�rgning (kan sl�s p� i samma fil som pessimistisk
+ f�rgning ovan).
+ <LI> B�ttre ber�kning av spillkostnader
+ <LI> Renaming
+ <LI> Callee-saves register
+ <LI> Live-range splitting
+ </UL>
+ <LI> Instruktionsschedulering
+ <UL>
+ <LI> Branch delay slot scheduling
+ <LI> Load delay slot scheduling
+ <LI> Spekulativa loads med lduwa
+ <LI> Kollapsa serier av tester med bpr
+ <LI> Begr�nsad predicated execution med movcc
+ </UL>
+ <LI> Kodlayout: statiska f�ruts�gelser om riktning av hopp,
+ layout, s�tta branch prediction bits i hopp, etc.
+ <LI> Prefetching av kod med SparcV9:s bpn.
+</UL>
+
+<H2>Other optimizations</H2>
+
+Profile driven optimizations.
+<UL>
+ <LI> Utplacering av r�knare i CFG:er (per block, per b�ge)
+ <LI> Statiska metoder att uppskatta exekveringstid (inom och mellan proc.)
+ <LI> Feedback till program, annotering av CFG:er med profileringsinfo.
+ <LI> Kodlayout med profileringsinfo.
+ <LI> Skapa superblock
+ <LI> Skapa hyperblock
+ <LI> Plocka fram heta block, skapa en 'het' sub-CFG som hoppar
+ till den kalla huvud-CFG:n vid behov.
+ <LI> Optimering av het CFG, kodf�rflyttning fr�n het till kall CFG.
+ <LI> Spawn-time specialization
+</UL>
diff --git a/lib/hipe/amd64/Makefile b/lib/hipe/amd64/Makefile
new file mode 100644
index 0000000000..93e5f086d9
--- /dev/null
+++ b/lib/hipe/amd64/Makefile
@@ -0,0 +1,127 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+# Please keep this list sorted.
+MODULES=hipe_amd64_assemble \
+ hipe_amd64_defuse \
+ hipe_amd64_encode \
+ hipe_amd64_frame \
+ hipe_amd64_liveness \
+ hipe_amd64_main \
+ hipe_amd64_pp \
+ hipe_amd64_ra \
+ hipe_amd64_ra_finalise \
+ hipe_amd64_ra_ls \
+ hipe_amd64_ra_naive \
+ hipe_amd64_ra_postconditions \
+ hipe_amd64_ra_sse2_postconditions \
+ hipe_amd64_ra_x87_ls \
+ hipe_amd64_registers \
+ hipe_amd64_spill_restore \
+ hipe_amd64_x87 \
+ hipe_rtl_to_amd64
+
+ERL_FILES=$(MODULES:%=%.erl)
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += -DHIPE_AMD64 +warn_exported_vars
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+# Please keep this list sorted.
+$(EBIN)/hipe_amd64_assemble.beam: ../main/hipe.hrl ../rtl/hipe_literals.hrl ../x86/hipe_x86.hrl ../../kernel/src/hipe_ext_format.hrl ../misc/hipe_sdi.hrl ../x86/hipe_x86_assemble.erl
+$(EBIN)/hipe_amd64_defuse.beam: ../x86/hipe_x86.hrl ../x86/hipe_x86_defuse.erl
+$(EBIN)/hipe_amd64_frame.beam: ../main/hipe.hrl ../x86/hipe_x86.hrl ../x86/hipe_x86_frame.erl ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_amd64_liveness.beam: ../flow/liveness.inc ../x86/hipe_x86_liveness.erl
+$(EBIN)/hipe_amd64_main.beam: ../main/hipe.hrl ../x86/hipe_x86_main.erl
+$(EBIN)/hipe_amd64_pp.beam: ../x86/hipe_x86.hrl ../x86/hipe_x86_pp.erl
+$(EBIN)/hipe_amd64_ra.beam: ../main/hipe.hrl ../x86/hipe_x86_ra.erl
+$(EBIN)/hipe_amd64_ra_dummy.beam: ../main/hipe.hrl ../x86/hipe_x86.hrl
+$(EBIN)/hipe_amd64_ra_finalise.beam: ../x86/hipe_x86.hrl ../x86/hipe_x86_ra_finalise.erl
+$(EBIN)/hipe_amd64_ra_ls.beam: ../main/hipe.hrl ../x86/hipe_x86_ra_ls.erl
+$(EBIN)/hipe_amd64_ra_naive.beam: ../main/hipe.hrl ../x86/hipe_x86.hrl ../x86/hipe_x86_ra_naive.erl
+$(EBIN)/hipe_amd64_ra_postconditions.beam: ../main/hipe.hrl ../x86/hipe_x86.hrl ../x86/hipe_x86_ra_postconditions.erl
+$(EBIN)/hipe_amd64_ra_sse2_postconditions.beam: ../main/hipe.hrl
+$(EBIN)/hipe_amd64_ra_x87_ls.beam: ../main/hipe.hrl ../x86/hipe_x86_ra_x87_ls.erl
+$(EBIN)/hipe_amd64_registers.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_amd64_spill_restore.beam: ../main/hipe.hrl ../x86/hipe_x86.hrl ../flow/cfg.hrl ../x86/hipe_x86_spill_restore.erl
+$(EBIN)/hipe_amd64_x87.beam: ../x86/hipe_x86_x87.erl
+$(EBIN)/hipe_rtl_to_amd64.beam: ../x86/hipe_rtl_to_x86.erl ../rtl/hipe_rtl.hrl
+
+$(TARGET_FILES): ../x86/hipe_x86.hrl ../misc/hipe_consttab.hrl
diff --git a/lib/hipe/amd64/hipe_amd64_assemble.erl b/lib/hipe/amd64/hipe_amd64_assemble.erl
new file mode 100644
index 0000000000..db3cfcc6bd
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_assemble.erl
@@ -0,0 +1,19 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-include("../x86/hipe_x86_assemble.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_defuse.erl b/lib/hipe/amd64/hipe_amd64_defuse.erl
new file mode 100644
index 0000000000..c48e80f3f1
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_defuse.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_defuse.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_encode.erl b/lib/hipe/amd64/hipe_amd64_encode.erl
new file mode 100644
index 0000000000..ee68dfb3b8
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_encode.erl
@@ -0,0 +1,1484 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Copyright (C) 2000-2004 Mikael Pettersson
+%%% Copyright (C) 2004 Daniel Luna
+%%%
+%%% This is the syntax of amd64 r/m operands:
+%%%
+%%% opnd ::= reg mod == 11
+%%% | MEM[ea] mod != 11
+%%%
+%%% ea ::= disp32(reg) mod == 10, r/m != ESP
+%%% | disp32 sib12 mod == 10, r/m == 100
+%%% | disp8(reg) mod == 01, r/m != ESP
+%%% | disp8 sib12 mod == 01, r/m == 100
+%%% | (reg) mod == 00, r/m != ESP and EBP
+%%% | sib0 mod == 00, r/m == 100
+%%% | disp32(%rip) mod == 00, r/m == 101
+%%%
+%%% // sib0: mod == 00
+%%% sib0 ::= disp32(,index,scale) base == EBP, index != ESP
+%%% | disp32 base == EBP, index == 100
+%%% | (base,index,scale) base != EBP, index != ESP
+%%% | (base) base != EBP, index == 100
+%%%
+%%% // sib12: mod == 01 or 10
+%%% sib12 ::= (base,index,scale) index != ESP
+%%% | (base) index == 100
+%%%
+%%% scale ::= 00 | 01 | 10 | 11 index << scale
+%%%
+%%% Notes:
+%%%
+%%% 1. ESP cannot be used as index register.
+%%% 2. Use of ESP as base register requires a SIB byte.
+%%% 3. disp(reg), when reg != ESP, can be represented without
+%%% [r/m == reg] or with [r/m == 100, base == reg] a SIB byte.
+%%% 4. disp32 can be represented without [mod == 00, r/m == 101]
+%%% or with [mod == 00, r/m == 100, base == 101, index == 100]
+%%% a SIB byte.
+%%% 5. AMD64 and x86 interpret mod==00b r/m==101b EAs differently:
+%%% on x86 the disp32 is an absolute address, but on AMD64 the
+%%% disp32 is relative to the %rip of the next instruction.
+
+-module(hipe_amd64_encode).
+
+-export([% condition codes
+ cc/1,
+ % 8-bit registers
+ %% al/0, cl/0, dl/0, bl/0, ah/0, ch/0, dh/0, bh/0,
+ % 32-bit registers
+ %% eax/0, ecx/0, edx/0, ebx/0, esp/0, ebp/0, esi/0, edi/0,
+ % operands
+ sindex/2, sib/1, sib/2,
+ ea_disp32_base/2, ea_disp32_sib/2,
+ ea_disp8_base/2, ea_disp8_sib/2,
+ ea_base/1,
+ ea_disp32_sindex/1, %%ea_disp32_sindex/2,
+ ea_sib/1, %ea_disp32_rip/1,
+ rm_reg/1, rm_mem/1,
+ % instructions
+ insn_encode/3, insn_sizeof/2]).
+
+%%-define(DO_HIPE_AMD64_ENCODE_TEST,true).
+-ifdef(DO_HIPE_AMD64_ENCODE_TEST).
+-export([dotest/0, dotest/1]). % for testing, don't use
+-endif.
+
+-define(ASSERT(F,G), if G -> [] ; true -> exit({?MODULE,F}) end).
+%-define(ASSERT(F,G), []).
+
+%%% condition codes
+
+-define(CC_O, 2#0000). % overflow
+-define(CC_NO, 2#0001). % no overflow
+-define(CC_B, 2#0010). % below, <u
+-define(CC_AE, 2#0011). % above or equal, >=u
+-define(CC_E, 2#0100). % equal
+-define(CC_NE, 2#0101). % not equal
+-define(CC_BE, 2#0110). % below or equal, <=u
+-define(CC_A, 2#0111). % above, >u
+-define(CC_S, 2#1000). % sign, +
+-define(CC_NS, 2#1001). % not sign, -
+-define(CC_PE, 2#1010). % parity even
+-define(CC_PO, 2#1011). % parity odd
+-define(CC_L, 2#1100). % less than, <s
+-define(CC_GE, 2#1101). % greater or equal, >=s
+-define(CC_LE, 2#1110). % less or equal, <=s
+-define(CC_G, 2#1111). % greater than, >s
+
+cc(o) -> ?CC_O;
+cc(no) -> ?CC_NO;
+cc(b) -> ?CC_B;
+cc(ae) -> ?CC_AE;
+cc(e) -> ?CC_E;
+cc(ne) -> ?CC_NE;
+cc(be) -> ?CC_BE;
+cc(a) -> ?CC_A;
+cc(s) -> ?CC_S;
+cc(ns) -> ?CC_NS;
+cc(pe) -> ?CC_PE;
+cc(po) -> ?CC_PO;
+cc(l) -> ?CC_L;
+cc(ge) -> ?CC_GE;
+cc(le) -> ?CC_LE;
+cc(g) -> ?CC_G.
+
+%%% 8-bit registers
+
+-define(AL, 2#000).
+-define(CL, 2#001).
+-define(DL, 2#010).
+-define(BL, 2#011).
+-define(AH, 2#100).
+-define(CH, 2#101).
+-define(DH, 2#110).
+-define(BH, 2#111).
+
+%% al() -> ?AL.
+%% cl() -> ?CL.
+%% dl() -> ?DL.
+%% bl() -> ?BL.
+%% ah() -> ?AH.
+%% ch() -> ?CH.
+%% dh() -> ?DH.
+%% bh() -> ?BH.
+
+%%% 32-bit registers
+
+-define(EAX, 2#000).
+-define(ECX, 2#001).
+-define(EDX, 2#010).
+-define(EBX, 2#011).
+-define(ESP, 2#100).
+-define(EBP, 2#101).
+-define(ESI, 2#110).
+-define(EDI, 2#111).
+
+%% eax() -> ?EAX.
+%% ecx() -> ?ECX.
+%% edx() -> ?EDX.
+%% ebx() -> ?EBX.
+%% esp() -> ?ESP.
+%% ebp() -> ?EBP.
+%% esi() -> ?ESI.
+%% edi() -> ?EDI.
+
+%%% r/m operands
+
+sindex(Scale, Index) when is_integer(Scale), is_integer(Index) ->
+ ?ASSERT(sindex, Scale >= 0),
+ ?ASSERT(sindex, Scale =< 3),
+ ?ASSERT(sindex, Index =/= ?ESP),
+ {sindex, Scale, Index}.
+
+-record(sib, {sindex_opt, base :: integer()}).
+sib(Base) when is_integer(Base) -> #sib{sindex_opt=none, base=Base}.
+sib(Base, Sindex) when is_integer(Base) -> #sib{sindex_opt=Sindex, base=Base}.
+
+ea_disp32_base(Disp32, Base) when is_integer(Base) ->
+ ?ASSERT(ea_disp32_base, Base =/= ?ESP),
+ {ea_disp32_base, Disp32, Base}.
+ea_disp32_sib(Disp32, SIB) -> {ea_disp32_sib, Disp32, SIB}.
+ea_disp8_base(Disp8, Base) when is_integer(Base) ->
+ ?ASSERT(ea_disp8_base, Base =/= ?ESP),
+ {ea_disp8_base, Disp8, Base}.
+ea_disp8_sib(Disp8, SIB) -> {ea_disp8_sib, Disp8, SIB}.
+ea_base(Base) when is_integer(Base) ->
+ ?ASSERT(ea_base, Base =/= ?ESP),
+ ?ASSERT(ea_base, Base =/= ?EBP),
+ {ea_base, Base}.
+ea_disp32_sindex(Disp32) -> {ea_disp32_sindex, Disp32, none}.
+%% ea_disp32_sindex(Disp32, Sindex) -> {ea_disp32_sindex, Disp32, Sindex}.
+ea_sib(SIB) ->
+ ?ASSERT(ea_sib, SIB#sib.base =/= ?EBP),
+ {ea_sib, SIB}.
+%ea_disp32_rip(Disp32) -> {ea_disp32_rip, Disp32}.
+
+rm_reg(Reg) -> {rm_reg, Reg}.
+rm_mem(EA) -> {rm_mem, EA}.
+
+mk_modrm(Mod, RO, RM) ->
+ {rex([{r,RO}, {b,RM}]),
+ (Mod bsl 6) bor ((RO band 2#111) bsl 3) bor (RM band 2#111)}.
+
+mk_sib(Scale, Index, Base) ->
+ {rex([{x,Index}, {b,Base}]),
+ (Scale bsl 6) bor ((Index band 2#111) bsl 3) bor (Base band 2#111)}.
+
+rex(REXs) -> {rex, rex_(REXs)}.
+rex_([]) -> 0;
+rex_([{r8, Reg8}| Rest]) -> % 8 bit registers
+ case Reg8 of
+ {rm_mem, _} -> rex_(Rest);
+ 4 -> (1 bsl 8) bor rex_(Rest);
+ 5 -> (1 bsl 8) bor rex_(Rest);
+ 6 -> (1 bsl 8) bor rex_(Rest);
+ 7 -> (1 bsl 8) bor rex_(Rest);
+ X when is_integer(X) -> rex_(Rest)
+ end;
+rex_([{w, REXW}| Rest]) -> % 64-bit mode
+ (REXW bsl 3) bor rex_(Rest);
+rex_([{r, ModRM_regRegister}| Rest]) when is_integer(ModRM_regRegister) ->
+ REXR = if (ModRM_regRegister > 7) -> 1;
+ true -> 0
+ end,
+ (REXR bsl 2) bor rex_(Rest);
+rex_([{x, SIB_indexRegister}| Rest]) when is_integer(SIB_indexRegister) ->
+ REXX = if (SIB_indexRegister > 7) -> 1;
+ true -> 0
+ end,
+ (REXX bsl 1) bor rex_(Rest);
+rex_([{b, OtherRegister}| Rest]) when is_integer(OtherRegister) ->
+ %% ModRM r/m, SIB base or opcode reg
+ REXB = if (OtherRegister > 7) -> 1;
+ true -> 0
+ end,
+ REXB bor rex_(Rest).
+
+le16(Word, Tail) ->
+ [Word band 16#FF, (Word bsr 8) band 16#FF | Tail].
+
+le32(Word, Tail) when is_integer(Word) ->
+ [Word band 16#FF, (Word bsr 8) band 16#FF,
+ (Word bsr 16) band 16#FF, (Word bsr 24) band 16#FF | Tail];
+le32({Tag,Val}, Tail) -> % a relocatable datum
+ [{le32,Tag,Val} | Tail].
+
+le64(Word, Tail) when is_integer(Word) ->
+ [ Word band 16#FF, (Word bsr 8) band 16#FF,
+ (Word bsr 16) band 16#FF, (Word bsr 24) band 16#FF,
+ (Word bsr 32) band 16#FF, (Word bsr 40) band 16#FF,
+ (Word bsr 48) band 16#FF, (Word bsr 56) band 16#FF | Tail];
+le64({Tag,Val}, Tail) ->
+ [{le64,Tag,Val} | Tail].
+
+enc_sindex_opt({sindex,Scale,Index}) -> {Scale, Index};
+enc_sindex_opt(none) -> {2#00, 2#100}.
+
+enc_sib(#sib{sindex_opt=SindexOpt, base=Base}) ->
+ {Scale, Index} = enc_sindex_opt(SindexOpt),
+ mk_sib(Scale, Index, Base).
+
+enc_ea(EA, RO, Tail) ->
+ case EA of
+ {ea_disp32_base, Disp32, Base} ->
+ [mk_modrm(2#10, RO, Base) | le32(Disp32, Tail)];
+ {ea_disp32_sib, Disp32, SIB} ->
+ [mk_modrm(2#10, RO, 2#100), enc_sib(SIB) | le32(Disp32, Tail)];
+ {ea_disp8_base, Disp8, Base} ->
+ [mk_modrm(2#01, RO, Base), Disp8 | Tail];
+ {ea_disp8_sib, Disp8, SIB} ->
+ [mk_modrm(2#01, RO, 2#100), enc_sib(SIB), Disp8 | Tail];
+ {ea_base, Base} ->
+ [mk_modrm(2#00, RO, Base) | Tail];
+ {ea_disp32_sindex, Disp32, SindexOpt} ->
+ {Scale, Index} = enc_sindex_opt(SindexOpt),
+ SIB = mk_sib(Scale, Index, 2#101),
+ MODRM = mk_modrm(2#00, RO, 2#100),
+ [MODRM, SIB | le32(Disp32, Tail)];
+ {ea_sib, SIB} ->
+ [mk_modrm(2#00, RO, 2#100), enc_sib(SIB) | Tail];
+ {ea_disp32_rip, Disp32} ->
+ [mk_modrm(2#00, RO, 2#101) | le32(Disp32, Tail)]
+ end.
+
+encode_rm(RM, RO, Tail) ->
+ case RM of
+ {rm_reg, Reg} -> [mk_modrm(2#11, RO, Reg) | Tail];
+ {rm_mem, EA} -> enc_ea(EA, RO, Tail)
+ end.
+
+%% sizeof_ea(EA) ->
+%% case element(1, EA) of
+%% ea_disp32_base -> 5;
+%% ea_disp32_sib -> 6;
+%% ea_disp8_base -> 2;
+%% ea_disp8_sib -> 3;
+%% ea_base -> 1;
+%% ea_disp32_sindex -> 6;
+%% ea_sib -> 2;
+%% ea_disp32_rip -> 5
+%% end.
+
+%% sizeof_rm(RM) ->
+%% case RM of
+%% {rm_reg, _} -> 1;
+%% {rm_mem, EA} -> sizeof_ea(EA)
+%% end.
+
+%%% x87 stack postitions
+
+-define(ST0, 2#000).
+-define(ST1, 2#001).
+-define(ST2, 2#010).
+-define(ST3, 2#011).
+-define(ST4, 2#100).
+-define(ST5, 2#101).
+-define(ST6, 2#110).
+-define(ST7, 2#111).
+
+st(0) -> ?ST0;
+st(1) -> ?ST1;
+st(2) -> ?ST2;
+st(3) -> ?ST3;
+st(4) -> ?ST4;
+st(5) -> ?ST5;
+st(6) -> ?ST6;
+st(7) -> ?ST7.
+
+
+%%% Instructions
+%%%
+%%% Insn ::= {Op,Opnds}
+%%% Opnds ::= {Opnd1,...,Opndn} (n >= 0)
+%%% Opnd ::= eax | ax | al | 1 | cl
+%%% | {imm32,Imm32} | {imm16,Imm16} | {imm8,Imm8}
+%%% | {rm32,RM32} | {rm16,RM16} | {rm8,RM8}
+%%% | {rel32,Rel32} | {rel8,Rel8}
+%%% | {moffs32,Moffs32} | {moffs16,Moffs16} | {moffs8,Moffs8}
+%%% | {cc,CC}
+%%% | {reg32,Reg32} | {reg16,Reg16} | {reg8,Reg8}
+%%% | {ea,EA}
+
+-define(PFX_OPND_16BITS, 16#66).
+
+arith_binop_encode(SubOpcode, Opnds) ->
+ %% add, or, adc, sbb, and, sub, xor, cmp
+ case Opnds of
+ {eax, {imm32,Imm32}} ->
+ [16#05 bor (SubOpcode bsl 3) | le32(Imm32, [])];
+ {{rm32,RM32}, {imm32,Imm32}} ->
+ [16#81 | encode_rm(RM32, SubOpcode, le32(Imm32, []))];
+ {{rm32,RM32}, {imm8,Imm8}} ->
+ [16#83 | encode_rm(RM32, SubOpcode, [Imm8])];
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#01 bor (SubOpcode bsl 3) | encode_rm(RM32, Reg32, [])];
+ {{reg32,Reg32}, {rm32,RM32}} ->
+ [16#03 bor (SubOpcode bsl 3) | encode_rm(RM32, Reg32, [])];
+ %% Below starts amd64 stuff with rex prefix
+ {rax, {imm32,Imm32}} ->
+ [rex([{w,1}]), 16#05 bor (SubOpcode bsl 3) | le32(Imm32, [])];
+ {{rm64,RM64}, {imm32,Imm32}} ->
+ [rex([{w,1}]), 16#81
+ | encode_rm(RM64, SubOpcode, le32(Imm32, []))];
+ {{rm64,RM64}, {imm8,Imm8}} ->
+ [rex([{w,1}]), 16#83 | encode_rm(RM64, SubOpcode, [Imm8])];
+ {{rm64,RM64}, {reg64,Reg64}} ->
+ [rex([{w,1}]), 16#01 bor (SubOpcode bsl 3)
+ | encode_rm(RM64, Reg64, [])];
+ {{reg64,Reg64}, {rm64,RM64}} ->
+ [rex([{w,1}]), 16#03 bor (SubOpcode bsl 3)
+ | encode_rm(RM64, Reg64, [])]
+ end.
+
+sse2_arith_binop_encode(Prefix, Opcode, {{xmm, XMM64}, {rm64fp, RM64}}) ->
+ %% addpd, cmpsd, divsd, maxsd, minsd, mulsd, sqrtsd, subsd
+ [Prefix, 16#0F, Opcode | encode_rm(RM64, XMM64, [])].
+
+sse2_cvtsi2sd_encode({{xmm,XMM64}, {rm64,RM64}}) ->
+ [rex([{w, 1}]), 16#F2, 16#0F, 16#2A�| encode_rm(RM64, XMM64, [])].
+
+sse2_mov_encode(Opnds) ->
+ case Opnds of
+ {{xmm, XMM64}, {rm64fp, RM64}} -> % movsd
+ [16#F2, 16#0F, 16#10�| encode_rm(RM64, XMM64, [])];
+ {{rm64fp, RM64}, {xmm, XMM64}} -> % movsd
+ [16#F2, 16#0F, 16#11�| encode_rm(RM64, XMM64, [])]
+% {{xmm, XMM64}, {rm64, RM64}} -> % cvtsi2sd
+% [rex([{w, 1}]), 16#F2, 16#0F, 16#2A�| encode_rm(RM64, XMM64, [])]
+ end.
+
+%% arith_binop_sizeof(Opnds) ->
+%% %% add, or, adc, sbb, and, sub, xor, cmp
+%% case Opnds of
+%% {eax, {imm32,_}} ->
+%% 1 + 4;
+%% {{rm32,RM32}, {imm32,_}} ->
+%% 1 + sizeof_rm(RM32) + 4;
+%% {{rm32,RM32}, {imm8,_}} ->
+%% 1 + sizeof_rm(RM32) + 1;
+%% {{rm32,RM32}, {reg32,_}} ->
+%% 1 + sizeof_rm(RM32);
+%% {{reg32,_}, {rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32)
+%% end.
+
+bs_op_encode(Opcode, {{reg32,Reg32}, {rm32,RM32}}) -> % bsf, bsr
+ [16#0F, Opcode | encode_rm(RM32, Reg32, [])].
+
+%% bs_op_sizeof({{reg32,_}, {rm32,RM32}}) -> % bsf, bsr
+%% 2 + sizeof_rm(RM32).
+
+bswap_encode(Opnds) ->
+ case Opnds of
+ {{reg32,Reg32}} ->
+ [rex([{b, Reg32}]), 16#0F, 16#C8 bor (Reg32 band 2#111)];
+ {{reg64,Reg64}} ->
+ [rex([{w, 1}, {b, Reg64}]), 16#0F, 16#C8 bor (Reg64 band 2#111)]
+ end.
+
+%% bswap_sizeof({{reg32,_}}) ->
+%% 2.
+
+bt_op_encode(SubOpcode, Opnds) -> % bt, btc, btr, bts
+ case Opnds of
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#0F, 16#A3 bor (SubOpcode bsl 3) | encode_rm(RM32, Reg32, [])];
+ {{rm32,RM32}, {imm8,Imm8}} ->
+ [16#0F, 16#BA | encode_rm(RM32, SubOpcode, [Imm8])]
+ end.
+
+%% bt_op_sizeof(Opnds) -> % bt, btc, btr, bts
+%% case Opnds of
+%% {{rm32,RM32}, {reg32,_}} ->
+%% 2 + sizeof_rm(RM32);
+%% {{rm32,RM32}, {imm8,_}} ->
+%% 2 + sizeof_rm(RM32) + 1
+%% end.
+
+call_encode(Opnds) ->
+ case Opnds of
+ {{rel32,Rel32}} ->
+ [16#E8 | le32(Rel32, [])];
+%%% {{rm32,RM32}} ->
+%%% [16#FF | encode_rm(RM32, 2#010, [])];
+ {{rm64,RM64}} -> % Defaults to 64 bits on amd64
+ [16#FF | encode_rm(RM64, 2#010, [])]
+ end.
+
+%% call_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rel32,_}} ->
+%% 1 + 4;
+%% {{rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32)
+%% end.
+
+cbw_encode({}) ->
+ [?PFX_OPND_16BITS, 16#98].
+
+cbw_sizeof({}) ->
+ 2.
+
+nullary_op_encode(Opcode, {}) ->
+ %% cdq, clc, cld, cmc, cwde, into, leave, nop, prefix_fs, stc, std
+ [Opcode].
+
+nullary_op_sizeof({}) ->
+ %% cdq, clc, cld, cmc, cwde, into, leave, nop, prefix_fs, stc, std
+ 1.
+
+cmovcc_encode({{cc,CC}, {reg32,Reg32}, {rm32,RM32}}) ->
+ [16#0F, 16#40 bor CC | encode_rm(RM32, Reg32, [])].
+
+%% cmovcc_sizeof({{cc,_}, {reg32,_}, {rm32,RM32}}) ->
+%% 2 + sizeof_rm(RM32).
+
+incdec_encode(SubOpcode, Opnds) -> % SubOpcode is either 0 or 1
+ case Opnds of
+ {{rm32,RM32}} ->
+ [16#FF | encode_rm(RM32, SubOpcode, [])];
+ {{rm64,RM64}} ->
+ [rex([{w, 1}]), 16#FF | encode_rm(RM64, SubOpcode, [])]
+ end.
+
+%% incdec_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32);
+%% {{reg32,_}} ->
+%% 1
+%% end.
+
+arith_unop_encode(Opcode, Opnds) -> % div, idiv, mul, neg, not
+ case Opnds of
+ {{rm32,RM32}} ->
+ [16#F7 | encode_rm(RM32, Opcode, [])];
+ {{rm64,RM64}} ->
+ [rex([{w,1}]), 16#F7 | encode_rm(RM64, Opcode, [])]
+ end.
+
+%% arith_unop_sizeof({{rm32,RM32}}) -> % div, idiv, mul, neg, not
+%% 1 + sizeof_rm(RM32).
+
+enter_encode({{imm16,Imm16}, {imm8,Imm8}}) ->
+ [16#C8 | le16(Imm16, [Imm8])].
+
+enter_sizeof({{imm16,_}, {imm8,_}}) ->
+ 1 + 2 + 1.
+
+imul_encode(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} -> % <edx,eax> *= rm32
+ [16#F7 | encode_rm(RM32, 2#101, [])];
+ {{rm64,RM64}} ->
+ [rex([{w,1}]), 16#F7 | encode_rm(RM64, 2#101, [])];
+ {{reg32,Reg32}, {rm32,RM32}} -> % reg *= rm32
+ [16#0F, 16#AF | encode_rm(RM32, Reg32, [])];
+ {{reg64,Reg64}, {rm64,RM64}} ->
+ [rex([{w,1}]), 16#0F, 16#AF | encode_rm(RM64, Reg64, [])];
+ {{reg32,Reg32}, {rm32,RM32}, {imm8,Imm8}} -> % reg := rm32 * sext(imm8)
+ [16#6B | encode_rm(RM32, Reg32, [Imm8])];
+ {{reg64,Reg64}, {rm64,RM64}, {imm8,Imm8}} ->
+ [rex([{w,1}]), 16#6B | encode_rm(RM64, Reg64, [Imm8])];
+ {{reg32,Reg32}, {rm32,RM32}, {imm32,Imm32}} -> % reg := rm32 * imm32
+ [16#69 | encode_rm(RM32, Reg32, le32(Imm32, []))];
+ {{reg64,Reg64}, {rm64,RM64}, {imm32,Imm32}} ->
+ [rex([{w,1}]), 16#69 | encode_rm(RM64, Reg64, le32(Imm32, []))]
+ end.
+
+%% imul_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32);
+%% {{reg32,_}, {rm32,RM32}} ->
+%% 2 + sizeof_rm(RM32);
+%% {{reg32,_}, {rm32,RM32}, {imm8,_}} ->
+%% 1 + sizeof_rm(RM32) + 1;
+%% {{reg32,_}, {rm32,RM32}, {imm32,_}} ->
+%% 1 + sizeof_rm(RM32) + 4
+%% end.
+
+jcc_encode(Opnds) ->
+ case Opnds of
+ {{cc,CC}, {rel8,Rel8}} ->
+ [16#70 bor CC, Rel8];
+ {{cc,CC}, {rel32,Rel32}} ->
+ [16#0F, 16#80 bor CC | le32(Rel32, [])]
+ end.
+
+jcc_sizeof(Opnds) ->
+ case Opnds of
+ {{cc,_}, {rel8,_}} ->
+ 2;
+ {{cc,_}, {rel32,_}} ->
+ 2 + 4
+ end.
+
+jmp8_op_encode(Opcode, {{rel8,Rel8}}) -> % jecxz, loop, loope, loopne
+ [Opcode, Rel8].
+
+jmp8_op_sizeof({{rel8,_}}) -> % jecxz, loop, loope, loopne
+ 2.
+
+jmp_encode(Opnds) ->
+ case Opnds of
+ {{rel8,Rel8}} ->
+ [16#EB, Rel8];
+ {{rel32,Rel32}} ->
+ [16#E9 | le32(Rel32, [])];
+%%% {{rm32,RM32}} ->
+%%% [16#FF | encode_rm(RM32, 2#100, [])]
+ {{rm64,RM64}} ->
+ [16#FF | encode_rm(RM64, 2#100, [])]
+ end.
+
+%% jmp_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rel8,_}} ->
+%% 2;
+%% {{rel32,_}} ->
+%% 1 + 4;
+%% {{rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32)
+%% end.
+
+lea_encode({{reg32,Reg32}, {ea,EA}}) ->
+ [16#8D | enc_ea(EA, Reg32, [])];
+lea_encode({{reg64,Reg64}, {ea,EA}}) ->
+ [rex([{w, 1}]), 16#8D | enc_ea(EA, Reg64, [])].
+
+%% lea_sizeof({{reg32,_}, {ea,EA}}) ->
+%% 1 + sizeof_ea(EA).
+
+mov_encode(Opnds) ->
+ case Opnds of
+ {{rm8,RM8}, {reg8,Reg8}} ->
+ [rex([{r8, RM8}, {r8, Reg8}]), 16#88 | encode_rm(RM8, Reg8, [])];
+ {{rm16,RM16}, {reg16,Reg16}} ->
+ [?PFX_OPND_16BITS, 16#89 | encode_rm(RM16, Reg16, [])];
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#89 | encode_rm(RM32, Reg32, [])];
+ {{rm64,RM64}, {reg64,Reg64}} ->
+ [rex([{w, 1}]), 16#89 | encode_rm(RM64, Reg64, [])];
+ {{reg8,Reg8}, {rm8,RM8}} ->
+ [rex([{r8, RM8}, {r8, Reg8}]), 16#8A |
+ encode_rm(RM8, Reg8, [])];
+ {{reg16,Reg16}, {rm16,RM16}} ->
+ [?PFX_OPND_16BITS, 16#8B | encode_rm(RM16, Reg16, [])];
+ {{reg32,Reg32}, {rm32,RM32}} ->
+ [16#8B | encode_rm(RM32, Reg32, [])];
+ {{reg64,Reg64}, {rm64,RM64}} ->
+ [rex([{w, 1}]), 16#8B | encode_rm(RM64, Reg64, [])];
+ {al, {moffs8,Moffs8}} ->
+ [16#A0 | le32(Moffs8, [])];
+ {ax, {moffs16,Moffs16}} ->
+ [?PFX_OPND_16BITS, 16#A1 | le32(Moffs16, [])];
+ {eax, {moffs32,Moffs32}} ->
+ [16#A1 | le32(Moffs32, [])];
+ {rax, {moffs32,Moffs32}} ->
+ [rex([{w, 1}]), 16#A1 | le32(Moffs32, [])];
+ {{moffs8,Moffs8}, al} ->
+ [16#A2 | le32(Moffs8, [])];
+ {{moffs16,Moffs16}, ax} ->
+ [?PFX_OPND_16BITS, 16#A3 | le32(Moffs16, [])];
+ {{moffs32,Moffs32}, eax} ->
+ [16#A3 | le32(Moffs32, [])];
+ {{moffs32,Moffs32}, rax} ->
+ [rex([{w, 1}]), 16#A3 | le32(Moffs32, [])];
+ {{reg8,Reg8}, {imm8,Imm8}} ->
+ [rex([{b, Reg8}, {r8, Reg8}]), 16#B0 bor (Reg8 band 2#111), Imm8];
+ {{reg16,Reg16}, {imm16,Imm16}} ->
+ [?PFX_OPND_16BITS, rex([{b, Reg16}]), 16#B8 bor (Reg16 band 2#111)
+ | le16(Imm16, [])];
+ {{reg32,Reg32}, {imm32,Imm32}} ->
+ [rex([{b, Reg32}]), 16#B8 bor (Reg32 band 2#111)
+ | le32(Imm32, [])];
+ {{reg64,Reg64}, {imm64,Imm64}} ->
+ [rex([{w, 1}, {b, Reg64}]), 16#B8 bor (Reg64 band 2#111)
+ | le64(Imm64, [])];
+ {{rm8,RM8}, {imm8,Imm8}} ->
+ [rex([{r8, RM8}]), 16#C6 | encode_rm(RM8, 2#000, [Imm8])];
+ {{rm16,RM16}, {imm16,Imm16}} ->
+ [?PFX_OPND_16BITS, 16#C7 |
+ encode_rm(RM16, 2#000, le16(Imm16, []))];
+ {{rm32,RM32}, {imm32,Imm32}} ->
+ [16#C7 | encode_rm(RM32, 2#000, le32(Imm32, []))];
+ {{rm64,RM64}, {imm32,Imm32}} ->
+ [rex([{w, 1}]), 16#C7 | encode_rm(RM64, 2#000, le32(Imm32, []))]
+ end.
+
+%% mov_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm8,RM8}, {reg8,_}} ->
+%% 1 + sizeof_rm(RM8);
+%% {{rm16,RM16}, {reg16,_}} ->
+%% 2 + sizeof_rm(RM16);
+%% {{rm32,RM32}, {reg32,_}} ->
+%% 1 + sizeof_rm(RM32);
+%% {{reg8,_}, {rm8,RM8}} ->
+%% 1 + sizeof_rm(RM8);
+%% {{reg16,_}, {rm16,RM16}} ->
+%% 2 + sizeof_rm(RM16);
+%% {{reg32,_}, {rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32);
+%% {al, {moffs8,_}} ->
+%% 1 + 4;
+%% {ax, {moffs16,_}} ->
+%% 2 + 4;
+%% {eax, {moffs32,_}} ->
+%% 1 + 4;
+%% {{moffs8,_}, al} ->
+%% 1 + 4;
+%% {{moffs16,_}, ax} ->
+%% 2 + 4;
+%% {{moffs32,_}, eax} ->
+%% 1 + 4;
+%% {{reg8,_}, {imm8,_}} ->
+%% 2;
+%% {{reg16,_}, {imm16,_}} ->
+%% 2 + 2;
+%% {{reg32,_}, {imm32,_}} ->
+%% 1 + 4;
+%% {{rm8,RM8}, {imm8,_}} ->
+%% 1 + sizeof_rm(RM8) + 1;
+%% {{rm16,RM16}, {imm16,_}} ->
+%% 2 + sizeof_rm(RM16) + 2;
+%% {{rm32,RM32}, {imm32,_}} ->
+%% 1 + sizeof_rm(RM32) + 4
+%% end.
+
+movx_op_encode(Opcode, Opnds) -> % movsx, movzx
+ case Opnds of
+ {{reg16,Reg16}, {rm8,RM8}} ->
+ [?PFX_OPND_16BITS, rex([{r8, RM8}]), 16#0F, Opcode |
+ encode_rm(RM8, Reg16, [])];
+ {{reg32,Reg32}, {rm8,RM8}} ->
+ [rex([{r8, RM8}]), 16#0F, Opcode | encode_rm(RM8, Reg32, [])];
+ {{reg32,Reg32}, {rm16,RM16}} ->
+ [16#0F, Opcode bor 1 | encode_rm(RM16, Reg32, [])];
+ {{reg64,Reg64}, {rm8,RM8}} ->
+ [rex([{w,1}]), 16#0F, Opcode | encode_rm(RM8, Reg64, [])];
+ {{reg64,Reg64}, {rm16,RM16}} ->
+ [rex([{w,1}]), 16#0F, Opcode bor 1 | encode_rm(RM16, Reg64, [])];
+ {{reg64,Reg64}, {rm32,RM32}} ->
+ %% This is magic... /Luna
+ [rex([{w,(1 band (Opcode bsr 3))}]), 16#63 |
+ encode_rm(RM32, Reg64, [])]
+ end.
+
+%% movx_op_sizeof(Opnds) ->
+%% case Opnds of
+%% {{reg16,_}, {rm8,RM8}} ->
+%% 3 + sizeof_rm(RM8);
+%% {{reg32,_}, {rm8,RM8}} ->
+%% 1 + 2 + sizeof_rm(RM8);
+%% {{reg32,_}, {rm16,RM16}} ->
+%% 1 + 2 + sizeof_rm(RM16)
+%% end.
+
+pop_encode(Opnds) ->
+ case Opnds of
+ {{rm64,RM64}} ->
+ [16#8F | encode_rm(RM64, 2#000, [])];
+ {{reg64,Reg64}} ->
+ [rex([{b,Reg64}]),16#58 bor (Reg64 band 2#111)]
+ end.
+
+%% pop_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32);
+%% {{reg32,_}} ->
+%% 1
+%% end.
+
+push_encode(Opnds) ->
+ case Opnds of
+%%% {{rm32,RM32}} ->
+%%% [16#FF | encode_rm(RM32, 2#110, [])];
+ {{rm64,RM64}} ->
+ [16#FF | encode_rm(RM64, 2#110, [])];
+%%% {{reg32,Reg32}} ->
+%%% [rex([{b, 1}]), 16#50 bor (Reg32 band 2#111)];
+ {{reg64,Reg64}} ->
+ [rex([{b, Reg64}]), 16#50 bor (Reg64 band 2#111)];
+ {{imm8,Imm8}} -> % sign-extended
+ [16#6A, Imm8];
+ {{imm32,Imm32}} -> % Sign extended to 64 bits
+ [16#68 | le32(Imm32, [])]
+ end.
+
+%% push_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm32,RM32}} ->
+%% 1 + sizeof_rm(RM32);
+%% {{reg32,_}} ->
+%% 1;
+%% {{imm8,_}} ->
+%% 2;
+%% {{imm32,_}} ->
+%% 1 + 4
+%% end.
+
+shift_op_encode(SubOpcode, Opnds) -> % rol, ror, rcl, rcr, shl, shr, sar
+ case Opnds of
+ {{rm32,RM32}, 1} ->
+ [16#D1 | encode_rm(RM32, SubOpcode, [])];
+ {{rm32,RM32}, cl} ->
+ [16#D3 | encode_rm(RM32, SubOpcode, [])];
+ {{rm32,RM32}, {imm8,Imm8}} ->
+ [16#C1 | encode_rm(RM32, SubOpcode, [Imm8])];
+ {{rm64,RM64}, 1} ->
+ [rex([{w,1}]), 16#D1 | encode_rm(RM64, SubOpcode, [])];
+ {{rm64,RM64}, cl} ->
+ [rex([{w,1}]), 16#D3 | encode_rm(RM64, SubOpcode, [])];
+ {{rm64,RM64}, {imm8,Imm8}} ->
+ [rex([{w,1}]), 16#C1 | encode_rm(RM64, SubOpcode, [Imm8])]
+ end.
+
+%% shift_op_sizeof(Opnds) -> % rcl, rcr, rol, ror, sar, shl, shr
+%% case Opnds of
+%% {{rm32,RM32}, 1} ->
+%% 1 + sizeof_rm(RM32);
+%% {{rm32,RM32}, cl} ->
+%% 1 + sizeof_rm(RM32);
+%% {{rm32,RM32}, {imm8,_Imm8}} ->
+%% 1 + sizeof_rm(RM32) + 1
+%% end.
+
+ret_encode(Opnds) ->
+ case Opnds of
+ {} ->
+ [16#C3];
+ {{imm16,Imm16}} ->
+ [16#C2 | le16(Imm16, [])]
+ end.
+
+ret_sizeof(Opnds) ->
+ case Opnds of
+ {} ->
+ 1;
+ {{imm16,_}} ->
+ 1 + 2
+ end.
+
+setcc_encode({{cc,CC}, {rm8,RM8}}) ->
+ [rex([{r8, RM8}]), 16#0F, 16#90 bor CC | encode_rm(RM8, 2#000, [])].
+
+%% setcc_sizeof({{cc,_}, {rm8,RM8}}) ->
+%% 2 + sizeof_rm(RM8).
+
+shd_op_encode(Opcode, Opnds) ->
+ case Opnds of
+ {{rm32,RM32}, {reg32,Reg32}, {imm8,Imm8}} ->
+ [16#0F, Opcode | encode_rm(RM32, Reg32, [Imm8])];
+ {{rm32,RM32}, {reg32,Reg32}, cl} ->
+ [16#0F, Opcode bor 1 | encode_rm(RM32, Reg32, [])]
+ end.
+
+%% shd_op_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm32,RM32}, {reg32,_}, {imm8,_}} ->
+%% 2 + sizeof_rm(RM32) + 1;
+%% {{rm32,RM32}, {reg32,_}, cl} ->
+%% 2 + sizeof_rm(RM32)
+%% end.
+
+test_encode(Opnds) ->
+ case Opnds of
+ {eax, {imm32,Imm32}} ->
+ [16#A9 | le32(Imm32, [])];
+ {{rm32,RM32}, {imm32,Imm32}} ->
+ [16#F7 | encode_rm(RM32, 2#000, le32(Imm32, []))];
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#85 | encode_rm(RM32, Reg32, [])]
+ end.
+
+%% test_sizeof(Opnds) ->
+%% case Opnds of
+%% {eax, {imm32,_}} ->
+%% 1 + 4;
+%% {{rm32,RM32}, {imm32,_}} ->
+%% 1 + sizeof_rm(RM32) + 4;
+%% {{rm32,RM32}, {reg32,_}} ->
+%% 1 + sizeof_rm(RM32)
+%% end.
+
+fild_encode(Opnds) ->
+ %% The operand cannot be a register!
+ {{rm64, RM64}} = Opnds,
+ [16#DB | encode_rm(RM64, 2#000, [])].
+
+%% fild_sizeof(Opnds) ->
+%% {{rm32, RM32}} = Opnds,
+%% 1 + sizeof_rm(RM32).
+
+fld_encode(Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DD | encode_rm(RM64fp, 2#000, [])];
+ {{fpst, St}} ->
+ [16#D9, 16#C0 bor st(St)]
+ end.
+
+%% fld_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm64fp, RM64fp}} ->
+%% 1 + sizeof_rm(RM64fp);
+%% {{fpst, _}} ->
+%% 2
+%% end.
+
+x87_comm_arith_encode(OpCode, Opnds) ->
+ %% fadd, fmul
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DC | encode_rm(RM64fp, OpCode, [])];
+ {{fpst,0}, {fpst,St}} ->
+ [16#D8, (16#C0 bor (OpCode bsl 3)) bor st(St)];
+ {{fpst,St}, {fpst,0}} ->
+ [16#DC, (16#C0 bor (OpCode bsl 3)) bor st(St)]
+ end.
+
+x87_comm_arith_pop_encode(OpCode, Opnds) ->
+ %% faddp, fmulp
+ case Opnds of
+ [] ->
+ [16#DE, 16#C0 bor (OpCode bsl 3) bor st(1)];
+ {{fpst,St},{fpst,0}} ->
+ [16#DE, 16#C0 bor (OpCode bsl 3) bor st(St)]
+ end.
+
+x87_arith_encode(OpCode, Opnds) ->
+ %% fdiv, fsub
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DC | encode_rm(RM64fp, OpCode, [])];
+ {{fpst,0}, {fpst,St}} ->
+ OpCode0 = OpCode band 2#110,
+ [16#D8, 16#C0 bor (OpCode0 bsl 3) bor st(St)];
+ {{fpst,St}, {fpst,0}} ->
+ OpCode0 = OpCode bor 1,
+ [16#DC, 16#C0 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+x87_arith_pop_encode(OpCode, Opnds) ->
+ %% fdivp, fsubp
+ OpCode0 = OpCode bor 1,
+ case Opnds of
+ [] ->
+ [16#DE, 16#C8 bor (OpCode0 bsl 3) bor st(1)];
+ {{fpst,St}, {fpst,0}} ->
+ [16#DE, 16#C8 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+x87_arith_rev_encode(OpCode, Opnds) ->
+ %% fdivr, fsubr
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DC | encode_rm(RM64fp, OpCode, [])];
+ {{fpst,0}, {fpst,St}} ->
+ OpCode0 = OpCode bor 1,
+ [16#D8, 16#C0 bor (OpCode0 bsl 3) bor st(St)];
+ {{fpst,St}, {fpst,0}} ->
+ OpCode0 = OpCode band 2#110,
+ [16#DC, 16#C0 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+x87_arith_rev_pop_encode(OpCode, Opnds) ->
+ %% fdivrp, fsubrp
+ OpCode0 = OpCode band 2#110,
+ case Opnds of
+ [] ->
+ [16#DE, 16#C0 bor (OpCode0 bsl 3) bor st(1)];
+ {{fpst,St}, {fpst, 0}} ->
+ [16#DE, 16#C0 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+%% x87_arith_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm64fp, RM64fp}} ->
+%% 1 + sizeof_rm(RM64fp);
+%% {{fpst,0}, {fpst,_}} ->
+%% 2;
+%% {{fpst,_}, {fpst,0}} ->
+%% 2
+%% end.
+
+fst_encode(OpCode, Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DD | encode_rm(RM64fp, OpCode, [])];
+ {{fpst, St}} ->
+ [16#DD, 16#C0 bor (OpCode bsl 3) bor st(St)]
+ end.
+
+%% fst_sizeof(Opnds) ->
+%% case Opnds of
+%% {{rm64fp, RM64fp}} ->
+%% 1 + sizeof_rm(RM64fp);
+%% {{fpst, _}} ->
+%% 2
+%% end.
+
+fchs_encode() ->
+ [16#D9, 16#E0].
+
+fchs_sizeof() ->
+ 2.
+
+ffree_encode({{fpst, St}})->
+ [16#DD, 16#C0 bor st(St)].
+
+ffree_sizeof() ->
+ 2.
+
+fwait_encode() ->
+ [16#9B].
+
+fwait_sizeof() ->
+ 1.
+
+fxch_encode(Opnds) ->
+ case Opnds of
+ [] ->
+ [16#D9, 16#C8 bor st(1)];
+ {{fpst, St}} ->
+ [16#D9, 16#C8 bor st(St)]
+ end.
+
+fxch_sizeof() ->
+ 2.
+
+insn_encode(Op, Opnds, Offset) ->
+ Bytes_and_REX = insn_encode_internal(Op, Opnds),
+ Bytes = fix_rex(Bytes_and_REX),
+ case has_relocs(Bytes) of
+ false -> % the common case
+ {Bytes, []};
+ _ ->
+ fix_relocs(Bytes, Offset, [], [])
+ end.
+
+fix_rex(Bytes) ->
+ fix_rex(Bytes, 2#0100 bsl 4, []).
+
+fix_rex([{rex, REX} | Rest], REXAcc, Bytes) ->
+ fix_rex(Rest, REXAcc bor REX, Bytes);
+fix_rex([{{rex, REX}, Byte} | Rest], REXAcc, Bytes) ->
+ fix_rex(Rest, REXAcc bor REX, [Byte | Bytes]);
+fix_rex([Byte | Rest], REXAcc, Bytes) ->
+ fix_rex(Rest, REXAcc, [Byte | Bytes]);
+fix_rex([], 2#01000000, Bytes) -> % no rex prefix
+ lists:reverse(Bytes);
+fix_rex([], REX0, Bytes) -> % rex prefix...
+ REX = REX0 band 16#FF, % for 8 bit registers
+ [Head|Tail] = lists:reverse(Bytes),
+ case Head of
+ 16#66 -> % ...and 16 bit/sse2 prefix
+ [16#66, REX | Tail];
+ 16#F2 -> % ...and sse2 prefix
+ [16#F2, REX | Tail];
+ _ -> % ...only
+ [REX, Head | Tail]
+ end.
+
+has_relocs([{le32,_,_}|_]) -> true;
+has_relocs([{le64,_,_}|_]) -> true;
+has_relocs([_|Bytes]) -> has_relocs(Bytes);
+has_relocs([]) -> false.
+
+fix_relocs([{le32,Tag,Val}|Bytes], Offset, Code, Relocs) ->
+ fix_relocs(Bytes, Offset+4,
+ [16#00, 16#00, 16#00, 16#00 | Code],
+ [{Tag,Offset,Val}|Relocs]);
+fix_relocs([{le64,Tag,Val}|Bytes], Offset, Code, Relocs) ->
+ fix_relocs(Bytes, Offset+8,
+ [16#00, 16#00, 16#00, 16#00,
+ 16#00, 16#00, 16#00, 16#00 | Code],
+ [{Tag,Offset,Val}|Relocs]);
+fix_relocs([Byte|Bytes], Offset, Code, Relocs) ->
+ fix_relocs(Bytes, Offset+1, [Byte|Code], Relocs);
+fix_relocs([], _Offset, Code, Relocs) ->
+ {lists:reverse(Code), lists:reverse(Relocs)}.
+
+insn_encode_internal(Op, Opnds) ->
+ case Op of
+ 'adc' -> arith_binop_encode(2#010, Opnds);
+ 'add' -> arith_binop_encode(2#000, Opnds);
+ 'and' -> arith_binop_encode(2#100, Opnds);
+ 'bsf' -> bs_op_encode(16#BC, Opnds);
+ 'bsr' -> bs_op_encode(16#BD, Opnds);
+ 'bswap' -> bswap_encode(Opnds);
+ 'bt' -> bt_op_encode(2#100, Opnds);
+ 'btc' -> bt_op_encode(2#111, Opnds);
+ 'btr' -> bt_op_encode(2#110, Opnds);
+ 'bts' -> bt_op_encode(2#101, Opnds);
+ 'call' -> call_encode(Opnds);
+ 'cbw' -> cbw_encode(Opnds);
+ 'cdq' -> nullary_op_encode(16#99, Opnds);
+ 'clc' -> nullary_op_encode(16#F8, Opnds);
+ 'cld' -> nullary_op_encode(16#FC, Opnds);
+ 'cmc' -> nullary_op_encode(16#F5, Opnds);
+ 'cmovcc' -> cmovcc_encode(Opnds);
+ 'cmp' -> arith_binop_encode(2#111, Opnds);
+ 'cwde' -> nullary_op_encode(16#98, Opnds);
+ 'dec' -> incdec_encode(2#001, Opnds);
+ 'div' -> arith_unop_encode(2#110, Opnds);
+ 'enter' -> enter_encode(Opnds);
+ 'idiv' -> arith_unop_encode(2#111, Opnds);
+ 'imul' -> imul_encode(Opnds);
+ 'inc' -> incdec_encode(2#000, Opnds);
+ 'into' -> case get(hipe_target_arch) of
+ x86 -> nullary_op_encode(16#CE, Opnds);
+ amd64 -> exit({invalid_amd64_opcode,
+ hipe_amd64_encode__erl})
+ end;
+ 'jcc' -> jcc_encode(Opnds);
+ 'jecxz' -> jmp8_op_encode(16#E3, Opnds);
+ 'jmp' -> jmp_encode(Opnds);
+ 'lea' -> lea_encode(Opnds);
+ 'leave' -> nullary_op_encode(16#C9, Opnds);
+ 'loop' -> jmp8_op_encode(16#E2, Opnds);
+ 'loope' -> jmp8_op_encode(16#E1, Opnds);
+ 'loopne' -> jmp8_op_encode(16#E0, Opnds);
+ 'mov' -> mov_encode(Opnds);
+ 'movsx' -> movx_op_encode(16#BE, Opnds);
+ 'movzx' -> movx_op_encode(16#B6, Opnds);
+ 'mul' -> arith_unop_encode(2#100, Opnds);
+ 'neg' -> arith_unop_encode(2#011, Opnds);
+ 'nop' -> nullary_op_encode(16#90, Opnds);
+ 'not' -> arith_unop_encode(2#010, Opnds);
+ 'or' -> arith_binop_encode(2#001, Opnds);
+ 'pop' -> pop_encode(Opnds);
+ 'prefix_fs' -> nullary_op_encode(16#64, Opnds);
+ 'push' -> push_encode(Opnds);
+ 'rcl' -> shift_op_encode(2#010, Opnds);
+ 'rcr' -> shift_op_encode(2#011, Opnds);
+ 'ret' -> ret_encode(Opnds);
+ 'rol' -> shift_op_encode(2#000, Opnds);
+ 'ror' -> shift_op_encode(2#001, Opnds);
+ 'sar' -> shift_op_encode(2#111, Opnds);
+ 'sbb' -> arith_binop_encode(2#011, Opnds);
+ 'setcc' -> setcc_encode(Opnds);
+ 'shl' -> shift_op_encode(2#100, Opnds);
+ 'shld' -> shd_op_encode(16#A4, Opnds);
+ 'shr' -> shift_op_encode(2#101, Opnds);
+ 'shrd' -> shd_op_encode(16#AC, Opnds);
+ 'stc' -> nullary_op_encode(16#F9, Opnds);
+ 'std' -> nullary_op_encode(16#FD, Opnds);
+ 'sub' -> arith_binop_encode(2#101, Opnds);
+ 'test' -> test_encode(Opnds);
+ 'xor' -> arith_binop_encode(2#110, Opnds);
+
+ %% sse2
+ 'addsd' -> sse2_arith_binop_encode(16#F2, 16#58, Opnds);
+ 'cmpsd' -> sse2_arith_binop_encode(16#F2, 16#C2, Opnds);
+ 'comisd' -> sse2_arith_binop_encode(16#66, 16#2F, Opnds);
+ 'cvtsi2sd' -> sse2_cvtsi2sd_encode(Opnds);
+ 'divsd' -> sse2_arith_binop_encode(16#F2, 16#5E, Opnds);
+ 'maxsd' -> sse2_arith_binop_encode(16#F2, 16#5F, Opnds);
+ 'minsd' -> sse2_arith_binop_encode(16#F2, 16#5D, Opnds);
+ 'movsd' -> sse2_mov_encode(Opnds);
+ 'mulsd' -> sse2_arith_binop_encode(16#F2, 16#59, Opnds);
+ 'sqrtsd' -> sse2_arith_binop_encode(16#F2, 16#51, Opnds);
+ 'subsd' -> sse2_arith_binop_encode(16#F2, 16#5C, Opnds);
+ 'ucomisd' -> sse2_arith_binop_encode(16#66, 16#2E, Opnds);
+ 'xorpd' -> sse2_arith_binop_encode(16#66, 16#57, Opnds);
+ %% End of sse2
+
+ %% x87
+ 'fadd' -> x87_comm_arith_encode(2#000, Opnds);
+ 'faddp' -> x87_comm_arith_pop_encode(2#000, Opnds);
+ 'fchs' -> fchs_encode();
+ 'fdiv' -> x87_arith_encode(2#110, Opnds);
+ 'fdivp' -> x87_arith_pop_encode(2#110, Opnds);
+ 'fdivr' -> x87_arith_rev_encode(2#111, Opnds);
+ 'fdivrp' -> x87_arith_rev_pop_encode(2#111, Opnds);
+ 'ffree' -> ffree_encode(Opnds);
+ 'fild' -> fild_encode(Opnds);
+ 'fld' -> fld_encode(Opnds);
+ 'fmul' -> x87_comm_arith_encode(2#001, Opnds);
+ 'fmulp' -> x87_comm_arith_pop_encode(2#001, Opnds);
+ 'fst' -> fst_encode(2#010, Opnds);
+ 'fstp' -> fst_encode(2#011, Opnds);
+ 'fsub' -> x87_arith_encode(2#100, Opnds);
+ 'fsubp' -> x87_arith_pop_encode(2#100, Opnds);
+ 'fsubr' -> x87_arith_rev_encode(2#101, Opnds);
+ 'fsubrp' -> x87_arith_rev_pop_encode(2#101, Opnds);
+ 'fwait' -> fwait_encode();
+ 'fxch' -> fxch_encode(Opnds);
+ %% End of x87
+
+ _ -> exit({?MODULE,insn_encode,Op})
+ end.
+
+insn_sizeof(Op, Opnds) ->
+ case Op of
+ 'cbw' -> cbw_sizeof(Opnds);
+ 'cdq' -> nullary_op_sizeof(Opnds);
+ 'clc' -> nullary_op_sizeof(Opnds);
+ 'cld' -> nullary_op_sizeof(Opnds);
+ 'cmc' -> nullary_op_sizeof(Opnds);
+ 'cwde' -> nullary_op_sizeof(Opnds);
+ 'enter' -> enter_sizeof(Opnds);
+ 'into' -> nullary_op_sizeof(Opnds);
+ 'jcc' -> jcc_sizeof(Opnds);
+ 'jecxz' -> jmp8_op_sizeof(Opnds);
+ 'leave' -> nullary_op_sizeof(Opnds);
+ 'loop' -> jmp8_op_sizeof(Opnds);
+ 'loope' -> jmp8_op_sizeof(Opnds);
+ 'loopne' -> jmp8_op_sizeof(Opnds);
+ 'nop' -> nullary_op_sizeof(Opnds);
+ 'prefix_fs' -> nullary_op_sizeof(Opnds);
+ 'ret' -> ret_sizeof(Opnds);
+ 'stc' -> nullary_op_sizeof(Opnds);
+ 'std' -> nullary_op_sizeof(Opnds);
+
+%% %% x87
+%% 'fadd' -> x87_arith_sizeof(Opnds);
+%% 'faddp' -> x87_arith_sizeof(Opnds);
+ 'fchs' -> fchs_sizeof();
+%% 'fdiv' -> x87_arith_sizeof(Opnds);
+%% 'fdivp' -> x87_arith_sizeof(Opnds);
+%% 'fdivr' -> x87_arith_sizeof(Opnds);
+%% 'fdivrp' -> x87_arith_sizeof(Opnds);
+ 'ffree' -> ffree_sizeof();
+%% 'fild' -> fild_sizeof(Opnds);
+%% 'fld' -> fld_sizeof(Opnds);
+%% 'fmul' -> x87_arith_sizeof(Opnds);
+%% 'fmulp' -> x87_arith_sizeof(Opnds);
+%% 'fst' -> fst_sizeof(Opnds);
+%% 'fstp' -> fst_sizeof(Opnds);
+%% 'fsub' -> x87_arith_sizeof(Opnds);
+%% 'fsubp' -> x87_arith_sizeof(Opnds);
+%% 'fsubr' -> x87_arith_sizeof(Opnds);
+%% 'fsubrp' -> x87_arith_sizeof(Opnds);
+ 'fwait' -> fwait_sizeof();
+ 'fxch' -> fxch_sizeof();
+%% %% End of x87
+ _ -> %% Hack that is to be removed some day... Maybe...
+ {Bytes, _} = insn_encode(Op, Opnds, 0),
+ length(Bytes)
+%% 'adc' -> arith_binop_sizeof(Opnds);
+%% 'add' -> arith_binop_sizeof(Opnds);
+%% 'and' -> arith_binop_sizeof(Opnds);
+%% 'bsf' -> bs_op_sizeof(Opnds);
+%% 'bsr' -> bs_op_sizeof(Opnds);
+%% 'bswap' -> bswap_sizeof(Opnds);
+%% 'bt' -> bt_op_sizeof(Opnds);
+%% 'btc' -> bt_op_sizeof(Opnds);
+%% 'btr' -> bt_op_sizeof(Opnds);
+%% 'bts' -> bt_op_sizeof(Opnds);
+%% 'call' -> call_sizeof(Opnds);
+%% 'cmovcc' -> cmovcc_sizeof(Opnds);
+%% 'cmp' -> arith_binop_sizeof(Opnds);
+%% 'dec' -> incdec_sizeof(Opnds);
+%% 'div' -> arith_unop_sizeof(Opnds);
+%% 'idiv' -> arith_unop_sizeof(Opnds);
+%% 'imul' -> imul_sizeof(Opnds);
+%% 'inc' -> incdec_sizeof(Opnds);
+%% 'jmp' -> jmp_sizeof(Opnds);
+%% 'lea' -> lea_sizeof(Opnds);
+%% 'mov' -> mov_sizeof(Opnds);
+%% 'movsx' -> movx_op_sizeof(Opnds);
+%% 'movzx' -> movx_op_sizeof(Opnds);
+%% 'mul' -> arith_unop_sizeof(Opnds);
+%% 'neg' -> arith_unop_sizeof(Opnds);
+%% 'not' -> arith_unop_sizeof(Opnds);
+%% 'or' -> arith_binop_sizeof(Opnds);
+%% 'pop' -> pop_sizeof(Opnds);
+%% 'push' -> push_sizeof(Opnds);
+%% 'rcl' -> shift_op_sizeof(Opnds);
+%% 'rcr' -> shift_op_sizeof(Opnds);
+%% 'rol' -> shift_op_sizeof(Opnds);
+%% 'ror' -> shift_op_sizeof(Opnds);
+%% 'sar' -> shift_op_sizeof(Opnds);
+%% 'sbb' -> arith_binop_sizeof(Opnds);
+%% 'setcc' -> setcc_sizeof(Opnds);
+%% 'shl' -> shift_op_sizeof(Opnds);
+%% 'shld' -> shd_op_sizeof(Opnds);
+%% 'shr' -> shift_op_sizeof(Opnds);
+%% 'shrd' -> shd_op_sizeof(Opnds);
+%% 'sub' -> arith_binop_sizeof(Opnds);
+%% 'test' -> test_sizeof(Opnds);
+%% 'xor' -> arith_binop_sizeof(Opnds);
+%% _ -> exit({?MODULE,insn_sizeof,Op})
+ end.
+
+%%=====================================================================
+%% testing interface
+%%=====================================================================
+
+-ifdef(DO_HIPE_AMD64_ENCODE_TEST).
+
+say(OS, Str) ->
+ file:write(OS, Str).
+
+digit16(Dig0) ->
+ Dig = Dig0 band 16#F,
+ if Dig >= 16#A -> $A + (Dig - 16#A);
+ true -> $0 + Dig
+ end.
+
+say_byte(OS, Byte) ->
+ say(OS, "0x"),
+ say(OS, [digit16(Byte bsr 4)]),
+ say(OS, [digit16(Byte)]).
+
+init(OS) ->
+ say(OS, "\t.text\n").
+
+say_bytes(OS, Byte0, Bytes0) ->
+ say_byte(OS, Byte0),
+ case Bytes0 of
+ [] ->
+ say(OS, "\n");
+ [Byte1|Bytes1] ->
+ say(OS, ","),
+ say_bytes(OS, Byte1, Bytes1)
+ end.
+
+t(OS, Op, Opnds) ->
+ insn_sizeof(Op, Opnds),
+ {[Byte|Bytes],[]} = insn_encode(Op, Opnds, 0),
+ say(OS, "\t.byte "),
+ say_bytes(OS, Byte, Bytes).
+
+dotest1(OS) ->
+ init(OS),
+ % exercise all rm32 types
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_rip(16#87654321)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_sib(sib(?ECX))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_sib(sib(?ECX,sindex(2#10,?EDI)))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sindex(16#87654321)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sindex(16#87654321,sindex(2#10,?EDI))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_base(?ECX)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp8_sib(16#03,sib(?ECX))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp8_sib(16#03,sib(?ECX,sindex(2#10,?EDI)))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp8_base(16#3,?ECX)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sib(16#87654321,sib(?ECX))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sib(16#87654321,sib(?ECX,sindex(2#10,?EDI)))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_base(16#87654321,?EBP)}}),
+ t(OS,call,{{rm32,rm_reg(?EAX)}}),
+ t(OS,call,{{rm32,rm_mem(ea_disp32_sindex(16#87654321,sindex(2#10,?EDI)))}}),
+ t(OS,call,{{rel32,-5}}),
+ % default parameters for the tests below
+ Word32 = 16#87654321,
+ Word16 = 16#F00F,
+ Word8 = 16#80,
+ Imm32 = {imm32,Word32},
+ Imm16 = {imm16,Word16},
+ Imm8 = {imm8,Word8},
+ RM32 = {rm32,rm_reg(?EDX)},
+ RM16 = {rm16,rm_reg(?EDX)},
+ RM8 = {rm8,rm_reg(?EDX)},
+ Rel32 = {rel32,Word32},
+ Rel8 = {rel8,Word8},
+ Moffs32 = {moffs32,Word32},
+ Moffs16 = {moffs16,Word32},
+ Moffs8 = {moffs8,Word32},
+ CC = {cc,?CC_G},
+ Reg32 = {reg32,?EAX},
+ Reg16 = {reg16,?EAX},
+ Reg8 = {reg8,?AH},
+ EA = {ea,ea_base(?ECX)},
+ % exercise each instruction definition
+ t(OS,'adc',{eax,Imm32}),
+ t(OS,'adc',{RM32,Imm32}),
+ t(OS,'adc',{RM32,Imm8}),
+ t(OS,'adc',{RM32,Reg32}),
+ t(OS,'adc',{Reg32,RM32}),
+ t(OS,'add',{eax,Imm32}),
+ t(OS,'add',{RM32,Imm32}),
+ t(OS,'add',{RM32,Imm8}),
+ t(OS,'add',{RM32,Reg32}),
+ t(OS,'add',{Reg32,RM32}),
+ t(OS,'and',{eax,Imm32}),
+ t(OS,'and',{RM32,Imm32}),
+ t(OS,'and',{RM32,Imm8}),
+ t(OS,'and',{RM32,Reg32}),
+ t(OS,'and',{Reg32,RM32}),
+ t(OS,'bsf',{Reg32,RM32}),
+ t(OS,'bsr',{Reg32,RM32}),
+ t(OS,'bswap',{Reg32}),
+ t(OS,'bt',{RM32,Reg32}),
+ t(OS,'bt',{RM32,Imm8}),
+ t(OS,'btc',{RM32,Reg32}),
+ t(OS,'btc',{RM32,Imm8}),
+ t(OS,'btr',{RM32,Reg32}),
+ t(OS,'btr',{RM32,Imm8}),
+ t(OS,'bts',{RM32,Reg32}),
+ t(OS,'bts',{RM32,Imm8}),
+ t(OS,'call',{Rel32}),
+ t(OS,'call',{RM32}),
+ t(OS,'cbw',{}),
+ t(OS,'cdq',{}),
+ t(OS,'clc',{}),
+ t(OS,'cld',{}),
+ t(OS,'cmc',{}),
+ t(OS,'cmovcc',{CC,Reg32,RM32}),
+ t(OS,'cmp',{eax,Imm32}),
+ t(OS,'cmp',{RM32,Imm32}),
+ t(OS,'cmp',{RM32,Imm8}),
+ t(OS,'cmp',{RM32,Reg32}),
+ t(OS,'cmp',{Reg32,RM32}),
+ t(OS,'cwde',{}),
+ t(OS,'dec',{RM32}),
+ t(OS,'dec',{Reg32}),
+ t(OS,'div',{RM32}),
+ t(OS,'enter',{Imm16,{imm8,3}}),
+ t(OS,'idiv',{RM32}),
+ t(OS,'imul',{RM32}),
+ t(OS,'imul',{Reg32,RM32}),
+ t(OS,'imul',{Reg32,RM32,Imm8}),
+ t(OS,'imul',{Reg32,RM32,Imm32}),
+ t(OS,'inc',{RM32}),
+ t(OS,'inc',{Reg32}),
+ t(OS,'into',{}),
+ t(OS,'jcc',{CC,Rel8}),
+ t(OS,'jcc',{CC,Rel32}),
+ t(OS,'jecxz',{Rel8}),
+ t(OS,'jmp',{Rel8}),
+ t(OS,'jmp',{Rel32}),
+ t(OS,'jmp',{RM32}),
+ t(OS,'lea',{Reg32,EA}),
+ t(OS,'leave',{}),
+ t(OS,'loop',{Rel8}),
+ t(OS,'loope',{Rel8}),
+ t(OS,'loopne',{Rel8}),
+ t(OS,'mov',{RM8,Reg8}),
+ t(OS,'mov',{RM16,Reg16}),
+ t(OS,'mov',{RM32,Reg32}),
+ t(OS,'mov',{Reg8,RM8}),
+ t(OS,'mov',{Reg16,RM16}),
+ t(OS,'mov',{Reg32,RM32}),
+ t(OS,'mov',{al,Moffs8}),
+ t(OS,'mov',{ax,Moffs16}),
+ t(OS,'mov',{eax,Moffs32}),
+ t(OS,'mov',{Moffs8,al}),
+ t(OS,'mov',{Moffs16,ax}),
+ t(OS,'mov',{Moffs32,eax}),
+ t(OS,'mov',{Reg8,Imm8}),
+ t(OS,'mov',{Reg16,Imm16}),
+ t(OS,'mov',{Reg32,Imm32}),
+ t(OS,'mov',{RM8,Imm8}),
+ t(OS,'mov',{RM16,Imm16}),
+ t(OS,'mov',{RM32,Imm32}),
+ t(OS,'movsx',{Reg16,RM8}),
+ t(OS,'movsx',{Reg32,RM8}),
+ t(OS,'movsx',{Reg32,RM16}),
+ t(OS,'movzx',{Reg16,RM8}),
+ t(OS,'movzx',{Reg32,RM8}),
+ t(OS,'movzx',{Reg32,RM16}),
+ t(OS,'mul',{RM32}),
+ t(OS,'neg',{RM32}),
+ t(OS,'nop',{}),
+ t(OS,'not',{RM32}),
+ t(OS,'or',{eax,Imm32}),
+ t(OS,'or',{RM32,Imm32}),
+ t(OS,'or',{RM32,Imm8}),
+ t(OS,'or',{RM32,Reg32}),
+ t(OS,'or',{Reg32,RM32}),
+ t(OS,'pop',{RM32}),
+ t(OS,'pop',{Reg32}),
+ t(OS,'push',{RM32}),
+ t(OS,'push',{Reg32}),
+ t(OS,'push',{Imm8}),
+ t(OS,'push',{Imm32}),
+ t(OS,'rcl',{RM32,1}),
+ t(OS,'rcl',{RM32,cl}),
+ t(OS,'rcl',{RM32,Imm8}),
+ t(OS,'rcr',{RM32,1}),
+ t(OS,'rcr',{RM32,cl}),
+ t(OS,'rcr',{RM32,Imm8}),
+ t(OS,'ret',{}),
+ t(OS,'ret',{Imm16}),
+ t(OS,'rol',{RM32,1}),
+ t(OS,'rol',{RM32,cl}),
+ t(OS,'rol',{RM32,Imm8}),
+ t(OS,'ror',{RM32,1}),
+ t(OS,'ror',{RM32,cl}),
+ t(OS,'ror',{RM32,Imm8}),
+ t(OS,'sar',{RM32,1}),
+ t(OS,'sar',{RM32,cl}),
+ t(OS,'sar',{RM32,Imm8}),
+ t(OS,'sbb',{eax,Imm32}),
+ t(OS,'sbb',{RM32,Imm32}),
+ t(OS,'sbb',{RM32,Imm8}),
+ t(OS,'sbb',{RM32,Reg32}),
+ t(OS,'sbb',{Reg32,RM32}),
+ t(OS,'setcc',{CC,RM8}),
+ t(OS,'shl',{RM32,1}),
+ t(OS,'shl',{RM32,cl}),
+ t(OS,'shl',{RM32,Imm8}),
+ t(OS,'shld',{RM32,Reg32,Imm8}),
+ t(OS,'shld',{RM32,Reg32,cl}),
+ t(OS,'shr',{RM32,1}),
+ t(OS,'shr',{RM32,cl}),
+ t(OS,'shr',{RM32,Imm8}),
+ t(OS,'shrd',{RM32,Reg32,Imm8}),
+ t(OS,'shrd',{RM32,Reg32,cl}),
+ t(OS,'stc',{}),
+ t(OS,'std',{}),
+ t(OS,'sub',{eax,Imm32}),
+ t(OS,'sub',{RM32,Imm32}),
+ t(OS,'sub',{RM32,Imm8}),
+ t(OS,'sub',{RM32,Reg32}),
+ t(OS,'sub',{Reg32,RM32}),
+ t(OS,'test',{eax,Imm32}),
+ t(OS,'test',{RM32,Imm32}),
+ t(OS,'test',{RM32,Reg32}),
+ t(OS,'xor',{eax,Imm32}),
+ t(OS,'xor',{RM32,Imm32}),
+ t(OS,'xor',{RM32,Imm8}),
+ t(OS,'xor',{RM32,Reg32}),
+ t(OS,'xor',{Reg32,RM32}),
+ t(OS,'prefix_fs',{}), t(OS,'add',{{reg32,?EAX},{rm32,rm_mem(ea_disp32_rip(16#20))}}),
+ [].
+
+dotest() -> dotest1(group_leader()). % stdout == group_leader
+
+dotest(File) ->
+ {ok,OS} = file:open(File, [write]),
+ dotest1(OS),
+ file:close(OS).
+-endif.
diff --git a/lib/hipe/amd64/hipe_amd64_frame.erl b/lib/hipe/amd64/hipe_amd64_frame.erl
new file mode 100644
index 0000000000..2bc319f40f
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_frame.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_frame.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_liveness.erl b/lib/hipe/amd64/hipe_amd64_liveness.erl
new file mode 100644
index 0000000000..be878773cb
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_liveness.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_liveness.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_main.erl b/lib/hipe/amd64/hipe_amd64_main.erl
new file mode 100644
index 0000000000..4de7364170
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_main.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_main.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_pp.erl b/lib/hipe/amd64/hipe_amd64_pp.erl
new file mode 100644
index 0000000000..93ed7b9073
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_pp.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_pp.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_ra.erl b/lib/hipe/amd64/hipe_amd64_ra.erl
new file mode 100644
index 0000000000..b9ac0338f0
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_ra.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_ra_finalise.erl b/lib/hipe/amd64/hipe_amd64_ra_finalise.erl
new file mode 100644
index 0000000000..a6a787c340
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra_finalise.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_ra_finalise.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_ra_ls.erl b/lib/hipe/amd64/hipe_amd64_ra_ls.erl
new file mode 100644
index 0000000000..7ff2a7c082
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra_ls.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_ra_ls.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_ra_naive.erl b/lib/hipe/amd64/hipe_amd64_ra_naive.erl
new file mode 100644
index 0000000000..194ea8b597
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra_naive.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_ra_naive.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl b/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl
new file mode 100644
index 0000000000..ef3c284c45
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_ra_postconditions.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl b/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl
new file mode 100644
index 0000000000..9ed3d01a56
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl
@@ -0,0 +1,188 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_amd64_ra_sse2_postconditions).
+
+-export([check_and_rewrite/2]).
+
+-include("../x86/hipe_x86.hrl").
+-define(HIPE_INSTRUMENT_COMPILER, true).
+-include("../main/hipe.hrl").
+-define(count_temp(T), ?cons_counter(counter_mfa_mem_temps, T)).
+
+
+check_and_rewrite(AMD64Defun, Coloring) ->
+ %%io:format("Converting\n"),
+ TempMap = hipe_temp_map:cols2tuple(Coloring,hipe_amd64_specific_sse2),
+ %%io:format("Rewriting\n"),
+ #defun{code=Code0} = AMD64Defun,
+ {Code1, DidSpill} = do_insns(Code0, TempMap, [], false),
+ {AMD64Defun#defun{code=Code1, var_range={0, hipe_gensym:get_var(x86)}},
+ DidSpill}.
+
+do_insns([I|Insns], TempMap, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap),
+ do_insns(Insns, TempMap, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap) -> % Insn -> {Insn list, DidSpill}
+ case I of
+ #fmove{} ->
+ do_fmove(I, TempMap);
+ #fp_unop{} ->
+ do_fp_unop(I, TempMap);
+ #fp_binop{} ->
+ do_fp_binop(I, TempMap);
+ _ ->
+ %% All non sse2 ops
+ {[I], false}
+ end.
+
+%%% Fix an fp_binop.
+do_fp_binop(I, TempMap) ->
+ #fp_binop{src=Src,dst=Dst} = I,
+ case is_mem_opnd(Dst, TempMap) of
+ true ->
+ Tmp = clone(Dst),
+ {[#fmove{src=Dst, dst=Tmp},
+ I#fp_binop{src=Src,dst=Tmp},
+ #fmove{src=Tmp,dst=Dst}],
+ true};
+ false ->
+ {[I], false}
+ end.
+
+do_fp_unop(I, TempMap) ->
+ #fp_unop{arg=Arg} = I,
+ case is_mem_opnd(Arg, TempMap) of
+ true ->
+ Tmp = clone(Arg),
+ {[#fmove{src=Arg, dst=Tmp},
+ I#fp_unop{arg=Tmp},
+ #fmove{src=Tmp,dst=Arg}],
+ true};
+ false ->
+ {[I], false}
+ end.
+
+%%% Fix an fmove op.
+do_fmove(I, TempMap) ->
+ #fmove{src=Src,dst=Dst} = I,
+ case is_mem_opnd(Dst, TempMap) and is_mem_opnd(Src, TempMap) of
+ true ->
+ Tmp = clone(Src),
+ {[#fmove{src=Src, dst=Tmp},I#fmove{src=Tmp,dst=Dst}],
+ true};
+ false ->
+ {[I], false}
+ end.
+
+%%% Check if an operand denotes a memory cell (mem or pseudo).
+
+is_mem_opnd(Opnd, TempMap) ->
+ R =
+ case Opnd of
+ #x86_mem{} -> true;
+ #x86_temp{} ->
+ Reg = hipe_x86:temp_reg(Opnd),
+ case hipe_x86:temp_is_allocatable(Opnd) of
+ true ->
+ case tuple_size(TempMap) > Reg of
+ true ->
+ case
+ hipe_temp_map:is_spilled(Reg, TempMap) of
+ true ->
+ ?count_temp(Reg),
+ true;
+ false -> false
+ end;
+ _ -> false
+ end;
+ false -> true
+ end;
+ _ -> false
+ end,
+ %% io:format("Op ~w mem: ~w\n",[Opnd,R]),
+ R.
+
+%%% Check if an operand is a spilled Temp.
+
+%%src_is_spilled(Src, TempMap) ->
+%% case hipe_x86:is_temp(Src) of
+%% true ->
+%% Reg = hipe_x86:temp_reg(Src),
+%% case hipe_x86:temp_is_allocatable(Src) of
+%% true ->
+%% case tuple_size(TempMap) > Reg of
+%% true ->
+%% case hipe_temp_map:is_spilled(Reg, TempMap) of
+%% true ->
+%% ?count_temp(Reg),
+%% true;
+%% false ->
+%% false
+%% end;
+%% false ->
+%% false
+%% end;
+%% false -> true
+%% end;
+%% false -> false
+%% end.
+
+%% is_spilled(Temp, TempMap) ->
+%% case hipe_x86:temp_is_allocatable(Temp) of
+%% true ->
+%% Reg = hipe_x86:temp_reg(Temp),
+%% case tuple_size(TempMap) > Reg of
+%% true ->
+%% case hipe_temp_map:is_spilled(Reg, TempMap) of
+%% true ->
+%% ?count_temp(Reg),
+%% true;
+%% false ->
+%% false
+%% end;
+%% false ->
+%% false
+%% end;
+%% false -> true
+%% end.
+
+%%% Make Reg a clone of Dst (attach Dst's type to Reg).
+
+clone(Dst) ->
+ Type =
+ case Dst of
+ #x86_mem{} -> hipe_x86:mem_type(Dst);
+ #x86_temp{} -> hipe_x86:temp_type(Dst)
+ end,
+ hipe_x86:mk_new_temp(Type).
+
+%%% Make a certain reg into a clone of Dst
+
+%% clone2(Dst, Reg) ->
+%% Type =
+%% case Dst of
+%% #x86_mem{} -> hipe_x86:mem_type(Dst);
+%% #x86_temp{} -> hipe_x86:temp_type(Dst)
+%% end,
+%% hipe_x86:mk_temp(Reg,Type).
diff --git a/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl b/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl
new file mode 100644
index 0000000000..267f3335aa
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_ra_x87_ls.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_registers.erl b/lib/hipe/amd64/hipe_amd64_registers.erl
new file mode 100644
index 0000000000..4c49eeb00a
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_registers.erl
@@ -0,0 +1,288 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_amd64_registers).
+
+-export([
+ all_precoloured/0,
+ allocatable/0,
+ allocatable_sse2/0,
+ allocatable_x87/0,
+ arg/1,
+ args/1,
+ call_clobbered/0,
+ fcalls/0,
+ float_size/0,
+ first_virtual/0,
+ heap_limit/0,
+ is_arg/1,
+ is_fixed/1,
+ is_precoloured/1,
+ is_precoloured_sse2/1,
+ is_precoloured_x87/1,
+ live_at_return/0,
+ nr_args/0,
+ proc_offset/1,
+ proc_pointer/0,
+ rax/0,
+ rcx/0,
+ ret/1,
+ sp/0,
+ sp_limit_offset/0,
+ reg_name/1,
+ alignment/0,
+ tailcall_clobbered/0,
+ temp0/0,
+ temp1/0,
+ %% fixed/0,
+ wordsize/0
+ ]).
+
+-include("../rtl/hipe_literals.hrl").
+
+-ifdef(AMD64_HP_IN_REGISTER).
+-export([heap_pointer/0]).
+-endif.
+
+-ifdef(AMD64_FCALLS_IN_REGISTER).
+fcalls_offset() -> false.
+-else.
+fcalls_offset() -> ?P_FCALLS.
+-define(AMD64_FCALLS_REGISTER,16).
+-endif.
+
+-ifdef(AMD64_HEAP_LIMIT_IN_REGISTER).
+heap_limit_offset() -> false.
+-else.
+-define(AMD64_HEAP_LIMIT_REGISTER, 17).
+heap_limit_offset() -> ?P_HP_LIMIT.
+-endif.
+
+
+-define(RAX, 0).
+-define(RCX, 1).
+-define(RDX, 2).
+-define(RBX, 3).
+-define(RSP, 4).
+-define(RBP, 5).
+-define(RSI, 6).
+-define(RDI, 7).
+-define(R8 , 8).
+-define(R9 , 9).
+-define(R10, 10).
+-define(R11, 11).
+-define(R12, 12).
+-define(R13, 13).
+-define(R14, 14).
+-define(R15, 15).
+-define(FCALLS, ?AMD64_FCALLS_REGISTER).
+-define(HEAP_LIMIT, ?AMD64_HEAP_LIMIT_REGISTER).
+-define(LAST_PRECOLOURED, 17).
+
+-define(ARG0, ?RSI).
+-define(ARG1, ?RDX).
+-define(ARG2, ?RCX).
+-define(ARG3, ?R8).
+-define(ARG4, ?R9).
+-define(ARG5, ?RDI).
+
+-define(TEMP0, ?R14).
+-define(TEMP1, ?R13).
+
+-define(PROC_POINTER, ?RBP).
+
+reg_name(R) ->
+ case R of
+ ?RAX -> "%rax";
+ ?RCX -> "%rcx";
+ ?RDX -> "%rdx";
+ ?RBX -> "%rbx";
+ ?RSP -> "%rsp";
+ ?RBP -> "%rbp";
+ ?RSI -> "%rsi";
+ ?RDI -> "%rdi";
+ ?FCALLS -> "%fcalls";
+ ?HEAP_LIMIT -> "%hplim";
+ Other -> "%r" ++ integer_to_list(Other)
+ end.
+
+alignment() -> 8.
+
+float_size() -> 8.
+
+first_virtual() -> ?LAST_PRECOLOURED + 1.
+
+is_precoloured(X) -> X =< ?LAST_PRECOLOURED.
+
+is_precoloured_sse2(X) -> X =< 15.
+
+is_precoloured_x87(X) -> X =< 6.
+
+all_precoloured() ->
+ [?RAX,
+ ?RCX,
+ ?RDX,
+ ?RBX,
+ ?RSP,
+ ?RBP,
+ ?RSI,
+ ?RDI,
+ ?R8 ,
+ ?R9 ,
+ ?R10,
+ ?R11,
+ ?R12,
+ ?R13,
+ ?R14,
+ ?R15,
+ ?FCALLS,
+ ?HEAP_LIMIT].
+
+rax() -> ?RAX.
+rcx() -> ?RCX.
+temp0() -> ?TEMP0.
+temp1() -> ?TEMP1.
+sp() -> ?RSP.
+proc_pointer() -> ?PROC_POINTER.
+fcalls() -> ?FCALLS.
+heap_limit() -> ?HEAP_LIMIT.
+
+
+-ifdef(AMD64_HP_IN_REGISTER).
+-define(HEAP_POINTER, ?AMD64_HEAP_POINTER).
+heap_pointer() -> ?HEAP_POINTER.
+-define(LIST_HP_LIVE_AT_RETURN,[{?HEAP_POINTER,untagged}]).
+is_heap_pointer(?HEAP_POINTER) -> true;
+is_heap_pointer(_) -> false.
+%% -define(LIST_HP_FIXED,[?HEAP_POINTER]).
+
+-else.
+-define(HEAP_POINTER, -1).
+is_heap_pointer(_) -> false.
+%% -define(LIST_HP_FIXED,[]).
+-define(LIST_HP_LIVE_AT_RETURN,[]).
+-endif.
+
+proc_offset(?FCALLS) -> fcalls_offset();
+proc_offset(?HEAP_LIMIT) -> heap_limit_offset();
+proc_offset(_) -> false.
+
+sp_limit_offset() -> ?P_NSP_LIMIT.
+
+is_fixed(?RSP) -> true;
+is_fixed(?PROC_POINTER) -> true;
+is_fixed(?FCALLS) -> true;
+is_fixed(?HEAP_LIMIT) -> true;
+is_fixed(R) -> is_heap_pointer(R).
+
+%% fixed() ->
+%% [?ESP, ?PROC_POINTER, ?FCALLS, ?HEAP_LIMIT | ?LIST_HP_FIXED].
+
+allocatable() ->
+ [?RDX, ?RCX, ?RBX, ?RAX, ?RSI, ?RDI,
+ ?R8 , ?R9 , ?R10, ?R11, ?R12, ?R13, ?R14, ?R15]
+ -- [?FCALLS, ?HEAP_POINTER, ?HEAP_LIMIT].
+
+allocatable_sse2() ->
+ [00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15]. %% xmm0 - xmm15
+
+allocatable_x87() ->
+ [0,1,2,3,4,5,6].
+
+nr_args() -> ?AMD64_NR_ARG_REGS.
+
+arg(N) ->
+ if N < ?AMD64_NR_ARG_REGS ->
+ case N of
+ 0 -> ?ARG0;
+ 1 -> ?ARG1;
+ 2 -> ?ARG2;
+ 3 -> ?ARG3;
+ 4 -> ?ARG4;
+ 5 -> ?ARG5;
+ _ -> exit({?MODULE, arg, N})
+ end;
+ true ->
+ exit({?MODULE, arg, N})
+ end.
+
+is_arg(R) ->
+ case R of
+ ?ARG0 -> ?AMD64_NR_ARG_REGS > 0;
+ ?ARG1 -> ?AMD64_NR_ARG_REGS > 1;
+ ?ARG2 -> ?AMD64_NR_ARG_REGS > 2;
+ ?ARG3 -> ?AMD64_NR_ARG_REGS > 3;
+ ?ARG4 -> ?AMD64_NR_ARG_REGS > 4;
+ ?ARG5 -> ?AMD64_NR_ARG_REGS > 5;
+ _ -> false
+ end.
+
+args(Arity) when is_integer(Arity), Arity >= 0 ->
+ N = erlang:min(Arity, ?AMD64_NR_ARG_REGS),
+ args(N-1, []).
+
+args(I, Rest) when I < 0 -> Rest;
+args(I, Rest) -> args(I-1, [arg(I) | Rest]).
+
+ret(N) ->
+ case N of
+ 0 -> ?RAX;
+ _ -> exit({?MODULE, ret, N})
+ end.
+
+call_clobbered() ->
+ [{?RAX,tagged},{?RAX,untagged}, % does the RA strip the type or not?
+ {?RDX,tagged},{?RDX,untagged},
+ {?RCX,tagged},{?RCX,untagged},
+ {?RBX,tagged},{?RBX,untagged},
+ {?RDI,tagged},{?RDI,untagged},
+ {?RSI,tagged},{?RSI,untagged},
+ {?R8 ,tagged},{?R8 ,untagged},
+ {?R9 ,tagged},{?R9 ,untagged},
+ {?R10,tagged},{?R10,untagged},
+ {?R11,tagged},{?R11,untagged},
+ {?R12,tagged},{?R12,untagged},
+ {?R13,tagged},{?R13,untagged},
+ {?R14,tagged},{?R14,untagged},
+ {?R15,tagged},{?R15,untagged}
+ | fp_call_clobbered()]
+ --
+ [{?FCALLS,tagged},{?FCALLS,untagged},
+ {?HEAP_POINTER,tagged},{?HEAP_POINTER,untagged},
+ {?HEAP_LIMIT,tagged},{?HEAP_LIMIT,untagged}
+ ].
+
+fp_call_clobbered() -> %% sse2 since it has more registers than x87
+ [{Reg,double} || Reg <- allocatable_sse2()].
+
+tailcall_clobbered() -> % tailcall crapola needs two temps
+ [{?TEMP0,tagged},{?TEMP0,untagged},
+ {?TEMP1,tagged},{?TEMP1,untagged}
+ | fp_call_clobbered()].
+
+live_at_return() ->
+ [{?RSP,untagged}
+ ,{?PROC_POINTER,untagged}
+ ,{?FCALLS,untagged}
+ ,{?HEAP_LIMIT,untagged}
+ | ?LIST_HP_LIVE_AT_RETURN
+ ].
+
+wordsize() -> 8.
diff --git a/lib/hipe/amd64/hipe_amd64_spill_restore.erl b/lib/hipe/amd64/hipe_amd64_spill_restore.erl
new file mode 100644
index 0000000000..56e3ffd24d
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_spill_restore.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_spill_restore.erl").
diff --git a/lib/hipe/amd64/hipe_amd64_x87.erl b/lib/hipe/amd64/hipe_amd64_x87.erl
new file mode 100644
index 0000000000..e7bf1c1866
--- /dev/null
+++ b/lib/hipe/amd64/hipe_amd64_x87.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_x86_x87.erl").
diff --git a/lib/hipe/amd64/hipe_rtl_to_amd64.erl b/lib/hipe/amd64/hipe_rtl_to_amd64.erl
new file mode 100644
index 0000000000..17aef0eeac
--- /dev/null
+++ b/lib/hipe/amd64/hipe_rtl_to_amd64.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-include("../x86/hipe_rtl_to_x86.erl").
diff --git a/lib/hipe/arm/Makefile b/lib/hipe/arm/Makefile
new file mode 100644
index 0000000000..571a1da0fc
--- /dev/null
+++ b/lib/hipe/arm/Makefile
@@ -0,0 +1,116 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2005-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+# Please keep this list sorted.
+MODULES=hipe_arm \
+ hipe_arm_assemble \
+ hipe_arm_cfg \
+ hipe_arm_defuse \
+ hipe_arm_encode \
+ hipe_arm_finalise \
+ hipe_arm_frame \
+ hipe_arm_liveness_gpr \
+ hipe_arm_main \
+ hipe_arm_pp \
+ hipe_arm_ra \
+ hipe_arm_ra_finalise \
+ hipe_arm_ra_ls \
+ hipe_arm_ra_naive \
+ hipe_arm_ra_postconditions \
+ hipe_arm_registers \
+ hipe_rtl_to_arm
+
+HRL_FILES=hipe_arm.hrl
+ERL_FILES=$(MODULES:%=%.erl)
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+# Please keep this list sorted.
+$(EBIN)/hipe_arm_assemble.beam: ../main/hipe.hrl ../../kernel/src/hipe_ext_format.hrl ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_arm_cfg.beam: ../flow/cfg.hrl ../flow/cfg.inc
+$(EBIN)/hipe_arm_frame.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_arm_liveness_gpr.beam: ../flow/liveness.inc
+$(EBIN)/hipe_arm_registers.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_rtl_to_arm.beam: ../rtl/hipe_rtl.hrl
+
+$(TARGET_FILES): hipe_arm.hrl ../misc/hipe_consttab.hrl
diff --git a/lib/hipe/arm/TODO b/lib/hipe/arm/TODO
new file mode 100644
index 0000000000..546d22737a
--- /dev/null
+++ b/lib/hipe/arm/TODO
@@ -0,0 +1,20 @@
+Assembler:
+
+Peephole optimiser:
+- Could e.g. turn "ldr lr,[sp,#OFF]; mov pc,lr"
+ into "ldr pc,[sp#OFF]", but then the LR save slot must
+ be in the caller's frame not the callee's.
+- Also kill "mov r0,r0" which seems to occur often.
+
+hipe_arm:
+- Handle more non-trivial immediates in mk_li/mk_load/mk_store.
+ See e.g. big_list, which has many 11-bit character constants.
+
+Floating point:
+- Drop no_inline_fp. Implement FP ops as calls to C or ASM
+ primops. All FP values passed by reference in memory.
+ This should at least reduce consing costs.
+
+Linear scan:
+- Do not hardcode temp1/temp2/temp3. Instead just take three
+ regs from (All\Fixed)\Params. (Ditto in PowerPC.)
diff --git a/lib/hipe/arm/hipe_arm.erl b/lib/hipe/arm/hipe_arm.erl
new file mode 100644
index 0000000000..391f84ca47
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm.erl
@@ -0,0 +1,380 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm).
+-export([
+ mk_temp/2,
+ mk_new_temp/1,
+ mk_new_nonallocatable_temp/1,
+ is_temp/1,
+ temp_reg/1,
+ temp_type/1,
+ temp_is_allocatable/1,
+ temp_is_precoloured/1,
+
+ mk_mfa/3,
+
+ mk_prim/1,
+ is_prim/1,
+ prim_prim/1,
+
+ mk_sdesc/4,
+
+ mk_am2/3,
+ mk_am3/3,
+
+ mk_alu/5,
+
+ mk_b_fun/2,
+
+ mk_b_label/2,
+ mk_b_label/1,
+
+ mk_bl/3,
+
+ mk_blx/2,
+
+ mk_cmp/3,
+
+ mk_comment/1,
+
+ mk_label/1,
+ is_label/1,
+ label_label/1,
+
+ mk_load/3,
+ mk_load/6,
+
+ mk_ldrsb/2,
+
+ mk_move/3,
+ mk_move/2,
+
+ mk_pseudo_bc/4,
+
+ mk_pseudo_call/4,
+ pseudo_call_contlab/1,
+ pseudo_call_funv/1,
+ pseudo_call_sdesc/1,
+ pseudo_call_linkage/1,
+
+ mk_pseudo_call_prepare/1,
+ pseudo_call_prepare_nrstkargs/1,
+
+ mk_pseudo_li/2,
+
+ mk_pseudo_move/2,
+ is_pseudo_move/1,
+ pseudo_move_dst/1,
+ pseudo_move_src/1,
+
+ mk_pseudo_switch/3,
+
+ mk_pseudo_tailcall/4,
+ pseudo_tailcall_funv/1,
+ pseudo_tailcall_stkargs/1,
+ pseudo_tailcall_linkage/1,
+
+ mk_pseudo_tailcall_prepare/0,
+
+ mk_smull/4,
+
+ mk_store/3,
+ mk_store/6,
+
+ mk_pseudo_blr/0,
+ mk_bx/1,
+ mk_mflr/1,
+ mk_mtlr/1,
+ mk_lr/0,
+ mk_pc/0,
+
+ mk_li/2,
+ mk_li/3,
+
+ mk_addi/4,
+
+ try_aluop_imm/2,
+
+ mk_defun/8,
+ defun_mfa/1,
+ defun_formals/1,
+ defun_is_closure/1,
+ defun_is_leaf/1,
+ defun_code/1,
+ defun_data/1,
+ defun_var_range/1
+ ]).
+
+-include("hipe_arm.hrl").
+
+mk_temp(Reg, Type, Allocatable) ->
+ #arm_temp{reg=Reg, type=Type, allocatable=Allocatable}.
+mk_temp(Reg, Type) -> mk_temp(Reg, Type, true).
+mk_new_temp(Type, Allocatable) ->
+ mk_temp(hipe_gensym:get_next_var(arm), Type, Allocatable).
+mk_new_temp(Type) -> mk_new_temp(Type, true).
+mk_new_nonallocatable_temp(Type) -> mk_new_temp(Type, false).
+is_temp(X) -> case X of #arm_temp{} -> true; _ -> false end.
+temp_reg(#arm_temp{reg=Reg}) -> Reg.
+temp_type(#arm_temp{type=Type}) -> Type.
+temp_is_allocatable(#arm_temp{allocatable=A}) -> A.
+temp_is_precoloured(#arm_temp{reg=Reg}) ->
+ hipe_arm_registers:is_precoloured_gpr(Reg).
+
+mk_mfa(M, F, A) -> #arm_mfa{m=M, f=F, a=A}.
+
+mk_prim(Prim) -> #arm_prim{prim=Prim}.
+is_prim(X) -> case X of #arm_prim{} -> true; _ -> false end.
+prim_prim(#arm_prim{prim=Prim}) -> Prim.
+
+mk_am2(Src, Sign, Offset) -> #am2{src=Src, sign=Sign, offset=Offset}.
+mk_am3(Src, Sign, Offset) -> #am3{src=Src, sign=Sign, offset=Offset}.
+
+mk_alu(AluOp, S, Dst, Src, Am1) ->
+ #alu{aluop=AluOp, s=S, dst=Dst, src=Src, am1=Am1}.
+mk_alu(AluOp, Dst, Src, Am1) -> mk_alu(AluOp, false, Dst, Src, Am1).
+
+mk_b_fun(Fun, Linkage) -> #b_fun{'fun'=Fun, linkage=Linkage}.
+
+mk_b_label(Cond, Label) -> #b_label{'cond'=Cond, label=Label}.
+mk_b_label(Label) -> mk_b_label('al', Label).
+
+mk_bl(Fun, SDesc, Linkage) -> #bl{'fun'=Fun, sdesc=SDesc, linkage=Linkage}.
+
+mk_blx(Src, SDesc) -> #blx{src=Src, sdesc=SDesc}.
+
+mk_cmp(CmpOp, Src, Am1) -> #cmp{cmpop=CmpOp, src=Src, am1=Am1}.
+
+mk_sdesc(ExnLab, FSize, Arity, Live) ->
+ #arm_sdesc{exnlab=ExnLab, fsize=FSize, arity=Arity, live=Live}.
+
+mk_comment(Term) -> #comment{term=Term}.
+
+mk_label(Label) -> #label{label=Label}.
+is_label(I) -> case I of #label{} -> true; _ -> false end.
+label_label(#label{label=Label}) -> Label.
+
+mk_load(LdOp, Dst, Am2) -> #load{ldop=LdOp, dst=Dst, am2=Am2}.
+
+mk_load(LdOp, Dst, Base, Offset, Scratch, Rest) when is_integer(Offset) ->
+ {Sign,AbsOffset} =
+ if Offset < 0 -> {'-', -Offset};
+ true -> {'+', Offset}
+ end,
+ if AbsOffset =< 4095 ->
+ Am2 = #am2{src=Base,sign=Sign,offset=AbsOffset},
+ [mk_load(LdOp, Dst, Am2) | Rest];
+ true ->
+ Index =
+ begin
+ DstReg = temp_reg(Dst),
+ BaseReg = temp_reg(Base),
+ if DstReg =/= BaseReg -> Dst;
+ true -> mk_scratch(Scratch)
+ end
+ end,
+ Am2 = #am2{src=Base,sign=Sign,offset=Index},
+ mk_li(Index, AbsOffset,
+ [mk_load(LdOp, Dst, Am2) | Rest])
+ end.
+
+mk_scratch(Scratch) ->
+ case Scratch of
+ 'temp2' -> mk_temp(hipe_arm_registers:temp2(), 'untagged');
+ 'new' -> mk_new_temp('untagged')
+ end.
+
+mk_ldrsb(Dst, Am3) -> #ldrsb{dst=Dst, am3=Am3}.
+
+mk_move(MovOp, S, Dst, Am1) -> #move{movop=MovOp, s=S, dst=Dst, am1=Am1}.
+mk_move(S, Dst, Am1) -> mk_move('mov', S, Dst, Am1).
+mk_move(Dst, Am1) -> mk_move('mov', false, Dst, Am1).
+
+mk_pseudo_bc(Cond, TrueLab, FalseLab, Pred) ->
+ if Pred >= 0.5 ->
+ mk_pseudo_bc_simple(negate_cond(Cond), FalseLab,
+ TrueLab, 1.0-Pred);
+ true ->
+ mk_pseudo_bc_simple(Cond, TrueLab, FalseLab, Pred)
+ end.
+
+mk_pseudo_bc_simple(Cond, TrueLab, FalseLab, Pred) when Pred =< 0.5 ->
+ #pseudo_bc{'cond'=Cond, true_label=TrueLab,
+ false_label=FalseLab, pred=Pred}.
+
+negate_cond(Cond) ->
+ case Cond of
+ 'lt' -> 'ge'; % <, >=
+ 'ge' -> 'lt'; % >=, <
+ 'gt' -> 'le'; % >, <=
+ 'le' -> 'gt'; % <=, >
+ 'eq' -> 'ne'; % ==, !=
+ 'ne' -> 'eq'; % !=, ==
+ 'hi' -> 'ls'; % >u, <=u
+ 'ls' -> 'hi'; % <=u, >u
+ 'hs' -> 'lo'; % >=u, <u
+ 'lo' -> 'hs'; % <u, >=u
+ 'vs' -> 'vc'; % overflow, not_overflow
+ 'vc' -> 'vs' % not_overflow, overflow
+ end.
+
+mk_pseudo_call(FunV, SDesc, ContLab, Linkage) ->
+ #pseudo_call{funv=FunV, sdesc=SDesc, contlab=ContLab, linkage=Linkage}.
+pseudo_call_funv(#pseudo_call{funv=FunV}) -> FunV.
+pseudo_call_sdesc(#pseudo_call{sdesc=SDesc}) -> SDesc.
+pseudo_call_contlab(#pseudo_call{contlab=ContLab}) -> ContLab.
+pseudo_call_linkage(#pseudo_call{linkage=Linkage}) -> Linkage.
+
+mk_pseudo_call_prepare(NrStkArgs) ->
+ #pseudo_call_prepare{nrstkargs=NrStkArgs}.
+pseudo_call_prepare_nrstkargs(#pseudo_call_prepare{nrstkargs=NrStkArgs}) ->
+ NrStkArgs.
+
+mk_pseudo_li(Dst, Imm) ->
+ #pseudo_li{dst=Dst, imm=Imm, label=hipe_gensym:get_next_label(arm)}.
+
+mk_pseudo_move(Dst, Src) -> #pseudo_move{dst=Dst, src=Src}.
+is_pseudo_move(I) -> case I of #pseudo_move{} -> true; _ -> false end.
+pseudo_move_dst(#pseudo_move{dst=Dst}) -> Dst.
+pseudo_move_src(#pseudo_move{src=Src}) -> Src.
+
+mk_pseudo_switch(JTab, Index, Labels) ->
+ #pseudo_switch{jtab=JTab, index=Index, labels=Labels}.
+
+mk_pseudo_tailcall(FunV, Arity, StkArgs, Linkage) ->
+ #pseudo_tailcall{funv=FunV, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
+pseudo_tailcall_funv(#pseudo_tailcall{funv=FunV}) -> FunV.
+pseudo_tailcall_stkargs(#pseudo_tailcall{stkargs=StkArgs}) -> StkArgs.
+pseudo_tailcall_linkage(#pseudo_tailcall{linkage=Linkage}) -> Linkage.
+
+mk_pseudo_tailcall_prepare() -> #pseudo_tailcall_prepare{}.
+
+mk_smull(DstLo, DstHi, Src1, Src2) ->
+ #smull{dstlo=DstLo, dsthi=DstHi, src1=Src1, src2=Src2}.
+
+mk_store(StOp, Src, Am2) -> #store{stop=StOp, src=Src, am2=Am2}.
+
+mk_store(StOp, Src, Base, Offset, Scratch, Rest) when is_integer(Offset) ->
+ {Sign,AbsOffset} =
+ if Offset < 0 -> {'-', -Offset};
+ true -> {'+', Offset}
+ end,
+ if AbsOffset =< 4095 ->
+ Am2 = #am2{src=Base,sign=Sign,offset=AbsOffset},
+ [mk_store(StOp, Src, Am2) | Rest];
+ true ->
+ Index = mk_scratch(Scratch),
+ Am2 = #am2{src=Base,sign=Sign,offset=Index},
+ mk_li(Index, AbsOffset,
+ [mk_store(StOp, Src, Am2) | Rest])
+ end.
+
+mk_pseudo_blr() -> #pseudo_blr{}.
+mk_bx(Src) -> #pseudo_bx{src=Src}.
+mk_mflr(Dst) -> mk_move(Dst, mk_lr()).
+mk_mtlr(Src) -> mk_move(mk_lr(), Src).
+mk_lr() -> mk_temp(hipe_arm_registers:lr(), 'untagged').
+mk_pc() -> mk_temp(hipe_arm_registers:pc(), 'untagged').
+
+%%% Load an integer constant into a register.
+mk_li(Dst, Value) -> mk_li(Dst, Value, []).
+
+mk_li(Dst, Value, Rest) ->
+ %% XXX: expand to handle 2-instruction sequences
+ case try_aluop_imm('mov', Value) of
+ {NewMovOp,Am1} ->
+ [mk_move(NewMovOp, false, Dst, Am1) | Rest];
+ [] ->
+ [mk_pseudo_li(Dst, Value) | Rest]
+ end.
+
+%%% Add an integer constant. Dst may equal Src,
+%%% in which case temp2 may be clobbered.
+
+mk_addi(Dst, Src, Value, Rest) ->
+ case try_aluop_imm('add', Value) of
+ {NewAluOp,Am1} ->
+ [mk_alu(NewAluOp, Dst, Src, Am1) | Rest];
+ [] ->
+ Tmp =
+ begin
+ DstReg = temp_reg(Dst),
+ SrcReg = temp_reg(Src),
+ if DstReg =:= SrcReg ->
+ mk_temp(hipe_arm_registers:temp2(), 'untagged');
+ true -> Dst
+ end
+ end,
+ [mk_pseudo_li(Tmp, Value), mk_alu('add', Dst, Src, Tmp) | Rest]
+ end.
+
+try_aluop_imm(AluOp, Imm) -> % -> {NewAluOp,Am1} or []
+ case imm_to_am1(Imm) of
+ (Am1={_Imm8,_Imm4}) -> {AluOp, Am1};
+ [] ->
+ case invert_aluop_imm(AluOp, Imm) of
+ {NewAluOp,NewImm} ->
+ case imm_to_am1(NewImm) of
+ (Am1={_Imm8,_Imm4}) -> {NewAluOp, Am1};
+ [] -> []
+ end;
+ [] -> []
+ end
+ end.
+
+invert_aluop_imm(AluOp, Imm) ->
+ case AluOp of
+ 'mov' -> {'mvn', bnot Imm};
+ 'mvn' -> {'mov', bnot Imm};
+ 'cmp' -> {'cmn', -Imm};
+ 'cmn' -> {'cmp', -Imm};
+ 'and' -> {'bic', bnot Imm};
+ 'bic' -> {'and', bnot Imm};
+ 'orr' -> {'orn', bnot Imm};
+ 'orn' -> {'orr', bnot Imm};
+ 'add' -> {'sub', -Imm};
+ 'sub' -> {'add', -Imm};
+ _ -> [] % no inverted form available
+ end.
+
+imm_to_am1(Imm) -> imm_to_am1(Imm band 16#FFFFFFFF, 16).
+imm_to_am1(Imm, RotCnt) ->
+ if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15};
+ true ->
+ NewRotCnt = RotCnt - 1,
+ if NewRotCnt =:= 0 -> []; % full circle, no joy
+ true ->
+ NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30),
+ imm_to_am1(NewImm, NewRotCnt)
+ end
+ end.
+
+mk_defun(MFA, Formals, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
+ #defun{mfa=MFA, formals=Formals, code=Code, data=Data,
+ isclosure=IsClosure, isleaf=IsLeaf,
+ var_range=VarRange, label_range=LabelRange}.
+defun_mfa(#defun{mfa=MFA}) -> MFA.
+defun_formals(#defun{formals=Formals}) -> Formals.
+defun_is_closure(#defun{isclosure=IsClosure}) -> IsClosure.
+defun_is_leaf(#defun{isleaf=IsLeaf}) -> IsLeaf.
+defun_code(#defun{code=Code}) -> Code.
+defun_data(#defun{data=Data}) -> Data.
+defun_var_range(#defun{var_range=VarRange}) -> VarRange.
diff --git a/lib/hipe/arm/hipe_arm.hrl b/lib/hipe/arm/hipe_arm.hrl
new file mode 100644
index 0000000000..9ee2cb3d06
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm.hrl
@@ -0,0 +1,124 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%--------------------------------------------------------------------
+%%% Basic Values:
+%%%
+%%% temp ::= #arm_temp{reg, type, allocatable}
+%%% reg ::= <token from hipe_arm_registers>
+%%% type ::= tagged | untagged
+%%% allocatable ::= true | false
+%%%
+%%% sdesc ::= #arm_sdesc{exnlab, fsize, arity, live}
+%%% exnlab ::= [] | label
+%%% fsize ::= int32 (frame size in words)
+%%% live ::= <tuple of int32> (word offsets)
+%%% arity ::= uint8
+%%%
+%%% mfa ::= #arm_mfa{atom, atom, arity}
+%%% prim ::= #arm_prim{atom}
+
+-record(arm_mfa, {m::atom(), f::atom(), a::arity()}).
+-record(arm_prim, {prim}).
+-record(arm_sdesc, {exnlab, fsize, arity::arity(), live}).
+-record(arm_temp, {reg, type, allocatable}).
+
+%%% Instruction Operands:
+%%%
+%%% aluop ::= adc | add | and | bic | eor | orr | rsb | rsc | sbc | sub
+%%% cmpop ::= cmn | cmp | tst | teq (alu with s flag and no dst)
+%%% cond ::= eq | ne | hs | lo | mi | pl | vs | vc | hi | ls | ge | lt | gt | le | al
+%%% ldop ::= ldr | ldrb (am2)
+%%% movop ::= mov | mvn (alu with no src)
+%%% stop ::= str | strb (am2)
+%%%
+%%% dst ::= temp
+%%% src ::= temp
+%%%
+%%% s ::= true | false
+%%%
+%%% imm<N> ::= <an N-bit non-negative integer>
+%%%
+%%% Note: am1 represents all 11 variants of "Adressing Mode 1".
+%%%
+%%% am1 ::= {imm8,imm4} imm8 rotated right 2*imm4 bits
+%%% | src
+%%% | {src,rrx}
+%%% | {src,shiftop,imm5}
+%%% | {src,shiftop,src}
+%%% shiftop ::= lsl | lsr | asr | ror
+%%%
+%%% Note: am2 can represent the first 3 variants of "Addressing Mode 2",
+%%% i.e., not the pre- or post-indexed variants.
+%%%
+%%% am2 ::= #am2{src, sign, am2offset}
+%%% am2offset ::= imm12 | src | {src,rrx} | {src,shiftop,imm5}
+%%% sign ::= + | -
+%%%
+%%% Note: am3 can represent the first 2 variants of "Addressing Mode 3",
+%%% i.e., not the pre- or post-indexed variants.
+%%%
+%%% am3 ::= #am3{src, sign, am3offset}
+%%% am3offset ::= imm8 | src
+%%%
+%%% fun ::= mfa | prim
+%%% funv ::= mfa | prim | temp
+%%%
+%%% immediate ::= int32 | atom | {label,label_type}
+%%% label_type ::= constant | closure | c_const
+
+-record(am2, {src, sign, offset}).
+-record(am3, {src, sign, offset}).
+
+%%% Instructions:
+
+-record(alu, {aluop, s, dst, src, am1}).% cond not included
+-record(b_fun, {'fun', linkage}). % known tailcall; cond not included
+-record(b_label, {'cond', label}). % local jump
+-record(bl, {'fun', sdesc, linkage}). % known recursive call; cond not included
+-record(blx, {src, sdesc}). % computed recursive call; cond not included
+-record(cmp, {cmpop, src, am1}). % cond not included
+-record(comment, {term}).
+-record(label, {label}).
+-record(load, {ldop, dst, am2}). % cond not included; ldrh/ldrsh not included
+-record(ldrsb, {dst, am3}). % cond not included
+-record(move, {movop, s, dst, am1}). % cond not included
+-record(pseudo_bc, {'cond', true_label, false_label, pred}).
+-record(pseudo_blr, {}). % alias for "mov pc,lr" to help cfg
+-record(pseudo_bx, {src}). % alias for "mov pc,src" to help cfg
+-record(pseudo_call, {funv, sdesc, contlab, linkage}).
+-record(pseudo_call_prepare, {nrstkargs}).
+-record(pseudo_li, {dst, imm, label}). % pre-generated label for use by the assembler
+-record(pseudo_move, {dst, src}).
+-record(pseudo_switch, {jtab, index, labels}).
+-record(pseudo_tailcall, {funv, arity, stkargs, linkage}).
+-record(pseudo_tailcall_prepare, {}).
+-record(smull, {dstlo, dsthi, src1, src2}). % cond not included, s not included
+-record(store, {stop, src, am2}). % cond not included; strh not included
+
+%%% Function definitions.
+
+-include("../misc/hipe_consttab.hrl").
+
+-record(defun, {mfa :: mfa(), formals, code,
+ data :: hipe_consttab(),
+ isclosure :: boolean(),
+ isleaf :: boolean(),
+ var_range, label_range}).
diff --git a/lib/hipe/arm/hipe_arm_assemble.erl b/lib/hipe/arm/hipe_arm_assemble.erl
new file mode 100644
index 0000000000..2af786994e
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_assemble.erl
@@ -0,0 +1,665 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_assemble).
+-export([assemble/4]).
+
+-include("../main/hipe.hrl"). % for VERSION_STRING, when_option
+-include("hipe_arm.hrl").
+-include("../../kernel/src/hipe_ext_format.hrl").
+-include("../rtl/hipe_literals.hrl").
+-undef(ASSERT).
+-define(ASSERT(G), if G -> [] ; true -> exit({assertion_failed,?MODULE,?LINE,??G}) end).
+
+assemble(CompiledCode, Closures, Exports, Options) ->
+ print("****************** Assembling *******************\n", [], Options),
+ %%
+ Code = [{MFA,
+ hipe_arm:defun_code(Defun),
+ hipe_arm:defun_data(Defun)}
+ || {MFA, Defun} <- CompiledCode],
+ %%
+ {ConstAlign,ConstSize,ConstMap,RefsFromConsts} =
+ hipe_pack_constants:pack_constants(Code, 4),
+ %%
+ {CodeSize,CodeBinary,AccRefs,LabelMap,ExportMap} =
+ encode(translate(Code, ConstMap), Options),
+ print("Total num bytes=~w\n", [CodeSize], Options),
+ %%
+ SC = hipe_pack_constants:slim_constmap(ConstMap),
+ DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap),
+ SSE = slim_sorted_exportmap(ExportMap,Closures,Exports),
+ SlimRefs = hipe_pack_constants:slim_refs(AccRefs),
+ Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC},
+ ConstAlign, ConstSize,
+ SC,
+ DataRelocs, % nee LM, LabelMap
+ SSE,
+ CodeSize,CodeBinary,SlimRefs,
+ 0,[] % ColdCodeSize, SlimColdRefs
+ ]),
+ %%
+ Bin.
+
+%%%
+%%% Assembly Pass 1.
+%%% Process initial {MFA,Code,Data} list.
+%%% Translate each MFA's body, choosing operand & instruction kinds.
+%%% Manage placement of large immediates in the code segment. (ARM-specific)
+%%%
+%%% Assembly Pass 2.
+%%% Perform short/long form optimisation for jumps.
+%%% (Trivial on ARM.)
+%%%
+%%% Result is {MFA,NewCode,CodeSize,LabelMap} list.
+%%%
+
+translate(Code, ConstMap) ->
+ translate_mfas(Code, ConstMap, []).
+
+translate_mfas([{MFA,Insns,_Data}|Code], ConstMap, NewCode) ->
+ {NewInsns,CodeSize,LabelMap} = translate_insns(Insns, MFA, ConstMap),
+ translate_mfas(Code, ConstMap, [{MFA,NewInsns,CodeSize,LabelMap}|NewCode]);
+translate_mfas([], _ConstMap, NewCode) ->
+ lists:reverse(NewCode).
+
+translate_insns(Insns, MFA, ConstMap) ->
+ translate_insns(Insns, MFA, ConstMap, gb_trees:empty(), 0, [],
+ previous_empty(), pending_empty()).
+
+translate_insns([I|Is] = Insns, MFA, ConstMap, LabelMap, Address, NewInsns, PrevImms, PendImms) ->
+ IsNotFallthroughInsn = is_not_fallthrough_insn(I),
+ MustFlushPending = must_flush_pending(PendImms, Address),
+ {NewIs,Insns1,PendImms1,DoFlushPending} =
+ case {MustFlushPending,IsNotFallthroughInsn} of
+ {true,false} ->
+ %% To avoid having to create new symbolic labels, which is problematic
+ %% in the assembler, we emit a forward branch with an offset computed
+ %% from the size of the pending literals.
+ N = pending_size(PendImms), % N >= 1 since MustFlushPending is true
+ BranchOffset = N - 1, % in units of 32-bit words!
+ NewIs0 = [{b, {do_cond('al'),{imm24,BranchOffset}}, #comment{term='skip'}}],
+ %% io:format("~w: forced flush of pending literals in ~w at ~w\n", [?MODULE,MFA,Address]),
+ {NewIs0,Insns,PendImms,true};
+ {_,_} ->
+ {NewIs0,PendImms0} = translate_insn(I, MFA, ConstMap, Address, PrevImms, PendImms),
+ {NewIs0,Is,PendImms0,IsNotFallthroughInsn}
+ end,
+ add_insns(NewIs, Insns1, MFA, ConstMap, LabelMap, Address, NewInsns, PrevImms, PendImms1, DoFlushPending);
+translate_insns([], _MFA, _ConstMap, LabelMap, Address, NewInsns, PrevImms, PendImms) ->
+ {LabelMap1, Address1, NewInsns1, _PrevImms1} = % at end-of-function we ignore PrevImms1
+ flush_pending(PendImms, LabelMap, Address, NewInsns, PrevImms),
+ {lists:reverse(NewInsns1), Address1, LabelMap1}.
+
+add_insns([I|Is], Insns, MFA, ConstMap, LabelMap, Address, NewInsns, PrevImms, PendImms, DoFlushPending) ->
+ NewLabelMap =
+ case I of
+ {'.label',L,_} ->
+ gb_trees:insert(L, Address, LabelMap);
+ _ ->
+ LabelMap
+ end,
+ Address1 = Address + insn_size(I),
+ add_insns(Is, Insns, MFA, ConstMap, NewLabelMap, Address1, [I|NewInsns], PrevImms, PendImms, DoFlushPending);
+add_insns([], Insns, MFA, ConstMap, LabelMap, Address, NewInsns, PrevImms, PendImms, DoFlushPending) ->
+ {LabelMap1, Address1, NewInsns1, PrevImms1, PendImms1} =
+ case DoFlushPending of
+ true ->
+ {LabelMap0,Address0,NewInsns0,PrevImms0} =
+ flush_pending(PendImms, LabelMap, Address, NewInsns, PrevImms),
+ {LabelMap0,Address0,NewInsns0,PrevImms0,pending_empty()};
+ false ->
+ PrevImms0 = expire_previous(PrevImms, Address),
+ {LabelMap,Address,NewInsns,PrevImms0,PendImms}
+ end,
+ translate_insns(Insns, MFA, ConstMap, LabelMap1, Address1, NewInsns1, PrevImms1, PendImms1).
+
+must_flush_pending(PendImms, Address) ->
+ case pending_firstref(PendImms) of
+ [] -> false;
+ LP0 ->
+ Distance = Address - LP0,
+ %% In "LP0: ldr R,[PC +/- imm12]", the PC value is LP0+8 so the
+ %% range for the ldr is [LP0-4084, LP0+4100] (32-bit alignment!).
+ %% LP0+4096 is the last point where we can emit a branch (4 bytes)
+ %% followed by the pending immediates.
+ %%
+ %% The translation of an individual instruction must not advance
+ %% . by more than 4 bytes, because that could cause us to miss
+ %% the point where PendImms must be flushed.
+ ?ASSERT(Distance =< 4096),
+ Distance =:= 4096
+ end.
+
+flush_pending(PendImms, LabelMap, Address, Insns, PrevImms) ->
+ Address1 = Address + 4*pending_size(PendImms),
+ PrevImms1 = expire_previous(PrevImms, Address1),
+ {LabelMap1,Address1,Insns1,PrevImms2} =
+ flush_pending2(pending_to_list(PendImms), LabelMap, Address, Insns, PrevImms1),
+ PrevImms3 = expire_previous(PrevImms2, Address1),
+ {LabelMap1,Address1,Insns1,PrevImms3}.
+
+flush_pending2([{Lab,RelocOrInt,Imm}|Imms], LabelMap, Address, Insns, PrevImms) ->
+ PrevImms1 = previous_append(PrevImms, Address, Lab, Imm),
+ LabelMap1 = gb_trees:insert(Lab, Address, LabelMap),
+ {RelocOpt,LongVal} =
+ if is_integer(RelocOrInt) ->
+ {[],RelocOrInt};
+ true ->
+ {[RelocOrInt],0}
+ end,
+ Insns1 =
+ [{'.long', LongVal, #comment{term=Imm}} |
+ RelocOpt ++
+ [{'.label', Lab, #comment{term=Imm}} |
+ Insns]],
+ flush_pending2(Imms, LabelMap1, Address+4, Insns1, PrevImms1);
+flush_pending2([], LabelMap, Address, Insns, PrevImms) ->
+ {LabelMap, Address, Insns, PrevImms}.
+
+expire_previous(PrevImms, CodeAddress) ->
+ case previous_findmin(PrevImms) of
+ [] -> PrevImms;
+ {ImmAddress,_Imm} ->
+ if CodeAddress - ImmAddress > 4084 ->
+ expire_previous(previous_delmin(PrevImms), CodeAddress);
+ true ->
+ PrevImms
+ end
+ end.
+
+is_not_fallthrough_insn(I) ->
+ case I of
+ #b_fun{} -> true;
+ #b_label{'cond'='al'} -> true;
+ %% bl and blx are not included since they return to ".+4"
+ %% a load to PC was originally a pseudo_switch insn
+ #load{dst=#arm_temp{reg=15,type=Type}} when Type =/= 'double' -> true;
+ %% a move to PC was originally a pseudo_blr or pseudo_bx insn
+ #move{dst=#arm_temp{reg=15,type=Type}} when Type =/= 'double' -> true;
+ _ -> false
+ end.
+
+insn_size(I) ->
+ case I of
+ {'.label',_,_} -> 0;
+ {'.reloc',_,_} -> 0;
+ _ -> 4
+ end.
+
+translate_insn(I, MFA, ConstMap, Address, PrevImms, PendImms) ->
+ case I of
+ %% pseudo_li is the only insn using MFA, ConstMap, Address, PrevImms, or PendLits
+ #pseudo_li{} -> do_pseudo_li(I, MFA, ConstMap, Address, PrevImms, PendImms);
+ _ -> {translate_insn(I), PendImms}
+ end.
+
+translate_insn(I) -> % -> [{Op,Opnd,OrigI}]
+ case I of
+ #alu{} -> do_alu(I);
+ #b_fun{} -> do_b_fun(I);
+ #b_label{} -> do_b_label(I);
+ #bl{} -> do_bl(I);
+ #blx{} -> do_blx(I);
+ #cmp{} -> do_cmp(I);
+ #comment{} -> [];
+ #label{} -> do_label(I);
+ #load{} -> do_load(I);
+ #ldrsb{} -> do_ldrsb(I);
+ #move{} -> do_move(I);
+ %% pseudo_b: eliminated by finalise
+ %% pseudo_blr: eliminated by finalise
+ %% pseudo_call: eliminated by finalise
+ %% pseudo_call_prepare: eliminated by frame
+ %% pseudo_li: handled separately
+ %% pseudo_move: eliminated by frame
+ %% pseudo_switch: eliminated by finalise
+ %% pseudo_tailcall: eliminated by frame
+ %% pseudo_tailcall_prepare: eliminated by finalise
+ #smull{} -> do_smull(I);
+ #store{} -> do_store(I)
+ end.
+
+do_alu(I) ->
+ #alu{aluop=AluOp,s=S,dst=Dst,src=Src,am1=Am1} = I,
+ NewCond = do_cond('al'),
+ NewS = do_s(S),
+ NewDst = do_reg(Dst),
+ NewSrc = do_reg(Src),
+ NewAm1 = do_am1(Am1),
+ {NewI,NewOpnds} = {AluOp, {NewCond,NewS,NewDst,NewSrc,NewAm1}},
+ [{NewI, NewOpnds, I}].
+
+do_b_fun(I) ->
+ #b_fun{'fun'=Fun,linkage=Linkage} = I,
+ [{'.reloc', {b_fun,Fun,Linkage}, #comment{term='fun'}},
+ {b, {do_cond('al'),{imm24,0}}, I}].
+
+do_b_label(I) ->
+ #b_label{'cond'=Cond,label=Label} = I,
+ [{b, {do_cond(Cond),do_label_ref(Label)}, I}].
+
+do_bl(I) ->
+ #bl{'fun'=Fun,sdesc=SDesc,linkage=Linkage} = I,
+ [{'.reloc', {b_fun,Fun,Linkage}, #comment{term='fun'}},
+ {bl, {do_cond('al'),{imm24,0}}, I},
+ {'.reloc', {sdesc,SDesc}, #comment{term=sdesc}}].
+
+do_blx(I) ->
+ #blx{src=Src,sdesc=SDesc} = I,
+ [{blx, {do_cond('al'),do_reg(Src)}, I},
+ {'.reloc', {sdesc,SDesc}, #comment{term=sdesc}}].
+
+do_cmp(I) ->
+ #cmp{cmpop=CmpOp,src=Src,am1=Am1} = I,
+ NewCond = do_cond('al'),
+ NewSrc = do_reg(Src),
+ NewAm1 = do_am1(Am1),
+ [{CmpOp, {NewCond,NewSrc,NewAm1}, I}].
+
+do_label(I) ->
+ #label{label=Label} = I,
+ [{'.label', Label, I}].
+
+do_load(I) ->
+ #load{ldop=LdOp,dst=Dst,am2=Am2} = I,
+ NewCond = do_cond('al'),
+ NewDst = do_reg(Dst),
+ NewAm2 = do_am2(Am2),
+ [{LdOp, {NewCond,NewDst,NewAm2}, I}].
+
+do_ldrsb(I) ->
+ #ldrsb{dst=Dst,am3=Am3} = I,
+ NewCond = do_cond('al'),
+ NewDst = do_reg(Dst),
+ NewAm3 = do_am3(Am3),
+ [{'ldrsb', {NewCond,NewDst,NewAm3}, I}].
+
+do_move(I) ->
+ #move{movop=MovOp,s=S,dst=Dst,am1=Am1} = I,
+ NewCond = do_cond('al'),
+ NewS = do_s(S),
+ NewDst = do_reg(Dst),
+ NewAm1 = do_am1(Am1),
+ [{MovOp, {NewCond,NewS,NewDst,NewAm1}, I}].
+
+do_pseudo_li(I, MFA, ConstMap, Address, PrevImms, PendImms) ->
+ #pseudo_li{dst=Dst,imm=Imm,label=Label0} = I,
+ {Label1,PendImms1} =
+ case previous_lookup(PrevImms, Imm) of
+ {value,Lab} -> {Lab,PendImms};
+ none ->
+ case pending_lookup(PendImms, Imm) of
+ {value,Lab} -> {Lab,PendImms};
+ none ->
+ RelocOrInt =
+ if is_integer(Imm) ->
+ %% This is for immediates that require too much work
+ %% to reconstruct using only arithmetic instructions.
+ Imm;
+ true ->
+ RelocData =
+ case Imm of
+ Atom when is_atom(Atom) ->
+ {load_atom, Atom};
+ {Label,constant} ->
+ ConstNo = find_const({MFA,Label}, ConstMap),
+ {load_address, {constant,ConstNo}};
+ {Label,closure} ->
+ {load_address, {closure,Label}};
+ {Label,c_const} ->
+ {load_address, {c_const,Label}}
+ end,
+ {'.reloc', RelocData, #comment{term=reloc}}
+ end,
+ Lab = Label0, % preallocated: creating labels in the assembler doesn't work
+ {Lab, pending_append(PendImms, Address, Lab, RelocOrInt, Imm)}
+ end
+ end,
+ NewDst = do_reg(Dst),
+ {[{'.pseudo_li', {NewDst,do_label_ref(Label1)}, I}], PendImms1}.
+
+do_smull(I) ->
+ #smull{dstlo=DstLo,dsthi=DstHi,src1=Src1,src2=Src2} = I,
+ NewCond = do_cond('al'),
+ NewS = do_s(false),
+ NewDstLo = do_reg(DstLo),
+ NewDstHi = do_reg(DstHi),
+ NewSrc1 = do_reg(Src1),
+ NewSrc2 = do_reg(Src2),
+ [{'smull', {NewCond,NewS,NewDstLo,NewDstHi,NewSrc1,NewSrc2}, I}].
+
+do_store(I) ->
+ #store{stop=StOp,src=Src,am2=Am2} = I,
+ NewCond = do_cond('al'),
+ NewSrc = do_reg(Src),
+ NewAm2 = do_am2(Am2),
+ [{StOp, {NewCond,NewSrc,NewAm2}, I}].
+
+do_reg(#arm_temp{reg=Reg,type=Type})
+ when is_integer(Reg), 0 =< Reg, Reg < 16, Type =/= 'double' ->
+ {r,Reg}.
+
+do_cond(Cond) -> {'cond',Cond}.
+
+do_s(S) -> {'s', case S of false -> 0; true -> 1 end}.
+
+do_label_ref(Label) when is_integer(Label) ->
+ {label,Label}. % symbolic, since offset is not yet computable
+
+do_am1(Am1) ->
+ case Am1 of
+ #arm_temp{} -> do_reg(Am1);
+ {Src1,'rrx'} -> {do_reg(Src1),'rrx'};
+ {Src1,ShiftOp,Src2=#arm_temp{}} -> {do_reg(Src1),{ShiftOp,do_reg(Src2)}};
+ {Src1,ShiftOp,Imm5} -> {do_reg(Src1),{ShiftOp,{imm5,Imm5}}};
+ {Imm8,Imm4} -> {{imm8,Imm8},{imm4,Imm4}}
+ end.
+
+do_am2(#am2{src=Src,sign=Sign,offset=Offset}) ->
+ NewSrc = do_reg(Src),
+ case Offset of
+ #arm_temp{} -> {'register_offset',NewSrc,Sign,do_reg(Offset)};
+ {Src3,'rrx'} -> {'scaled_register_offset',NewSrc,Sign,do_reg(Src3),'rrx'};
+ {Src3,ShiftOp,Imm5} -> {'scaled_register_offset',NewSrc,Sign,do_reg(Src3),{ShiftOp,{imm5,Imm5}}};
+ Imm12 -> {'immediate_offset',NewSrc,Sign,{imm12,Imm12}}
+ end.
+
+do_am3(#am3{src=Src,sign=Sign,offset=Offset}) ->
+ NewSrc = do_reg(Src),
+ case Offset of
+ #arm_temp{} -> {'register_offset',NewSrc,Sign,do_reg(Offset)};
+ _ -> {'immediate_offset',NewSrc,Sign,{'imm8',Offset}}
+ end.
+
+%%%
+%%% Assembly Pass 3.
+%%% Process final {MFA,Code,CodeSize,LabelMap} list from pass 2.
+%%% Translate to a single binary code segment.
+%%% Collect relocation patches.
+%%% Build ExportMap (MFA-to-address mapping).
+%%% Combine LabelMaps to a single one (for mk_data_relocs/2 compatibility).
+%%% Return {CombinedCodeSize,BinaryCode,Relocs,CombinedLabelMap,ExportMap}.
+%%%
+
+encode(Code, Options) ->
+ CodeSize = compute_code_size(Code, 0),
+ ExportMap = build_export_map(Code, 0, []),
+ {AccCode,Relocs} = encode_mfas(Code, 0, [], [], Options),
+ CodeBinary = list_to_binary(lists:reverse(AccCode)),
+ ?ASSERT(CodeSize =:= byte_size(CodeBinary)),
+ CombinedLabelMap = combine_label_maps(Code, 0, gb_trees:empty()),
+ {CodeSize,CodeBinary,Relocs,CombinedLabelMap,ExportMap}.
+
+compute_code_size([{_MFA,_Insns,CodeSize,_LabelMap}|Code], Size) ->
+ compute_code_size(Code, Size+CodeSize);
+compute_code_size([], Size) -> Size.
+
+build_export_map([{{M,F,A},_Insns,CodeSize,_LabelMap}|Code], Address, ExportMap) ->
+ build_export_map(Code, Address+CodeSize, [{Address,M,F,A}|ExportMap]);
+build_export_map([], _Address, ExportMap) -> ExportMap.
+
+combine_label_maps([{MFA,_Insns,CodeSize,LabelMap}|Code], Address, CLM) ->
+ NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM),
+ combine_label_maps(Code, Address+CodeSize, NewCLM);
+combine_label_maps([], _Address, CLM) -> CLM.
+
+merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) ->
+ NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM),
+ merge_label_map(Rest, MFA, Address, NewCLM);
+merge_label_map([], _MFA, _Address, CLM) -> CLM.
+
+encode_mfas([{MFA,Insns,CodeSize,LabelMap}|Code], Address, AccCode, Relocs, Options) ->
+ print("Generating code for: ~w\n", [MFA], Options),
+ print("Offset | Opcode | Instruction\n", [], Options),
+ {Address1,Relocs1,AccCode1} =
+ encode_insns(Insns, Address, Address, LabelMap, Relocs, AccCode, Options),
+ ExpectedAddress = Address + CodeSize,
+ ?ASSERT(Address1 =:= ExpectedAddress),
+ print("Finished.\n", [], Options),
+ encode_mfas(Code, Address1, AccCode1, Relocs1, Options);
+encode_mfas([], _Address, AccCode, Relocs, _Options) ->
+ {AccCode,Relocs}.
+
+encode_insns([I|Insns], Address, FunAddress, LabelMap, Relocs, AccCode, Options) ->
+ case I of
+ {'.label',L,_} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ ?ASSERT(Address =:= LabelAddress), % sanity check
+ print_insn(Address, [], I, Options),
+ encode_insns(Insns, Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ {'.reloc',Data,_} ->
+ print_insn(Address, [], I, Options),
+ Reloc = encode_reloc(Data, Address, FunAddress, LabelMap),
+ encode_insns(Insns, Address, FunAddress, LabelMap, [Reloc|Relocs], AccCode, Options);
+ {'.long',Value,_} ->
+ print_insn(Address, Value, I, Options),
+ Segment = <<Value:32/integer-native>>,
+ NewAccCode = [Segment|AccCode],
+ encode_insns(Insns, Address+4, FunAddress, LabelMap, Relocs, NewAccCode, Options);
+ _ ->
+ {Op,Arg,_} = fix_pc_refs(I, Address, FunAddress, LabelMap),
+ Word = hipe_arm_encode:insn_encode(Op, Arg),
+ print_insn(Address, Word, I, Options),
+ Segment = <<Word:32/integer-native>>,
+ NewAccCode = [Segment|AccCode],
+ encode_insns(Insns, Address+4, FunAddress, LabelMap, Relocs, NewAccCode, Options)
+ end;
+encode_insns([], Address, _FunAddress, _LabelMap, Relocs, AccCode, _Options) ->
+ {Address,Relocs,AccCode}.
+
+encode_reloc(Data, Address, FunAddress, LabelMap) ->
+ case Data of
+ {b_fun,MFAorPrim,Linkage} ->
+ %% b and bl are patched the same, so no need to distinguish
+ %% call from tailcall
+ PatchTypeExt =
+ case Linkage of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ {PatchTypeExt, Address, untag_mfa_or_prim(MFAorPrim)};
+ {load_atom,Atom} ->
+ {?LOAD_ATOM, Address, Atom};
+ {load_address,X} ->
+ {?LOAD_ADDRESS, Address, X};
+ {sdesc,SDesc} ->
+ #arm_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live} = SDesc,
+ ExnRA =
+ case ExnLab of
+ [] -> []; % don't cons up a new one
+ ExnLab -> gb_trees:get(ExnLab, LabelMap) + FunAddress
+ end,
+ {?SDESC, Address,
+ ?STACK_DESC(ExnRA, FSize, Arity, Live)}
+ end.
+
+untag_mfa_or_prim(#arm_mfa{m=M,f=F,a=A}) -> {M,F,A};
+untag_mfa_or_prim(#arm_prim{prim=Prim}) -> Prim.
+
+fix_pc_refs(I, InsnAddress, FunAddress, LabelMap) ->
+ case I of
+ {b, {Cond,{label,L}}, OrigI} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ Imm24 = (LabelAddress - (InsnAddress+8)) div 4,
+ %% ensure Imm24 fits in a 24 bit sign-extended field
+ ?ASSERT(Imm24 =< 16#7FFFFF),
+ ?ASSERT(Imm24 >= -(16#800000)),
+ {b, {Cond,{imm24,Imm24 band 16#FFFFFF}}, OrigI};
+ {'.pseudo_li', {Dst,{label,L}}, OrigI} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ Offset = LabelAddress - (InsnAddress+8),
+ {Sign,Imm12} =
+ if Offset < 0 -> {'-', -Offset};
+ true -> {'+', Offset}
+ end,
+ ?ASSERT(Imm12 =< 16#FFF),
+ Am2 = {'immediate_offset',{r,15},Sign,{imm12,Imm12}},
+ {ldr, {do_cond('al'),Dst,Am2}, OrigI};
+ _ -> I
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+mk_data_relocs(RefsFromConsts, LabelMap) ->
+ lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])).
+
+mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) ->
+ Map = [case Label of
+ {L,Pos} ->
+ Offset = find({MFA,L}, LabelMap),
+ {Pos,Offset};
+ {sorted,Base,OrderedLabels} ->
+ {sorted, Base, [begin
+ Offset = find({MFA,L}, LabelMap),
+ {Order, Offset}
+ end
+ || {L,Order} <- OrderedLabels]}
+ end
+ || Label <- Labels],
+ %% msg("Map: ~w Map\n",[Map]),
+ mk_data_relocs(Rest, LabelMap, [Map,Acc]);
+mk_data_relocs([],_,Acc) -> Acc.
+
+find({_MFA,_L} = MFAL, LabelMap) ->
+ gb_trees:get(MFAL, LabelMap).
+
+slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) ->
+ IsClosure = lists:member({M,F,A}, Closures),
+ IsExported = is_exported(F, A, Exports),
+ [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)];
+slim_sorted_exportmap([],_,_) -> [].
+
+is_exported(F, A, Exports) -> lists:member({F,A}, Exports).
+
+%%%
+%%% Assembly listing support (pp_asm option).
+%%%
+
+print(String, Arglist, Options) ->
+ ?when_option(pp_asm, Options, io:format(String, Arglist)).
+
+print_insn(Address, Word, I, Options) ->
+ ?when_option(pp_asm, Options, print_insn_2(Address, Word, I)).
+
+print_insn_2(Address, Word, {NewI,NewArgs,OrigI}) ->
+ io:format("~8.16.0b | ", [Address]),
+ print_code_list(word_to_bytes(Word), 0),
+ case NewI of
+ '.long' ->
+ io:format("\t.long ~.16x\n", [Word, "0x"]);
+ '.reloc' ->
+ io:format("\t.reloc ~w\n", [NewArgs]);
+ _ ->
+ hipe_arm_pp:pp_insn(OrigI)
+ end.
+
+word_to_bytes(W) ->
+ case W of
+ [] -> []; % label or other pseudo instruction
+ _ -> [(W bsr 24) band 16#FF, (W bsr 16) band 16#FF,
+ (W bsr 8) band 16#FF, W band 16#FF]
+ end.
+
+print_code_list([Byte|Rest], Len) ->
+ print_byte(Byte),
+ print_code_list(Rest, Len+1);
+print_code_list([], Len) ->
+ fill_spaces(8-(Len*2)),
+ io:format(" | ").
+
+print_byte(Byte) ->
+ io:format("~2.16.0b", [Byte band 16#FF]).
+
+fill_spaces(N) when N > 0 ->
+ io:format(" "),
+ fill_spaces(N-1);
+fill_spaces(0) ->
+ [].
+
+%%%
+%%% Lookup a constant in a ConstMap.
+%%%
+
+find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) ->
+ ConstNo;
+find_const(N,[_|R]) ->
+ find_const(N,R);
+find_const(C,[]) ->
+ ?EXIT({constant_not_found,C}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%
+%%% ADT for previous immediates.
+%%% This is a queue (fifo) of the previously defined immediates,
+%%% plus a mapping from these immediates to their labels.
+%%%
+-record(previous, {set, head, tail}). % INV: tail=[] if head=[]
+
+previous_empty() -> #previous{set=gb_trees:empty(), head=[], tail=[]}.
+
+previous_lookup(#previous{set=S}, Imm) -> gb_trees:lookup(Imm, S).
+
+previous_findmin(#previous{head=H}) ->
+ case H of
+ [X|_] -> X;
+ _ -> []
+ end.
+
+previous_delmin(#previous{set=S, head=[{_Address,Imm}|H], tail=T}) ->
+ {NewH,NewT} =
+ case H of
+ [] -> {lists:reverse(T), []};
+ _ -> {H, T}
+ end,
+ #previous{set=gb_trees:delete(Imm, S), head=NewH, tail=NewT}.
+
+previous_append(#previous{set=S, head=H, tail=T}, Address, Lab, Imm) ->
+ {NewH,NewT} =
+ case H of
+ [] -> {[{Address,Imm}], []};
+ _ -> {H, [{Address,Imm}|T]}
+ end,
+ #previous{set=gb_trees:insert(Imm, Lab, S), head=NewH, tail=NewT}.
+
+%%%
+%%% ADT for pending immediates.
+%%% This is a queue (fifo) of immediates pending definition,
+%%% plus a mapping from these immediates to their labels,
+%%% and a recording of the first (lowest) code address referring
+%%% to a pending immediate.
+%%%
+-record(pending, {set, list, firstref}).
+
+pending_empty() -> #pending{set=gb_trees:empty(), list=[], firstref=[]}.
+
+pending_to_list(#pending{list=L}) -> lists:reverse(L).
+
+pending_lookup(#pending{set=S}, Imm) -> gb_trees:lookup(Imm, S).
+
+pending_firstref(#pending{firstref=F}) -> F.
+
+pending_append(#pending{set=S, list=L, firstref=F}, Address, Lab, RelocOrInt, Imm) ->
+ #pending{set=gb_trees:insert(Imm, Lab, S),
+ list=[{Lab,RelocOrInt,Imm}|L],
+ firstref=case F of [] -> Address; _ -> F end}.
+
+pending_size(#pending{list=L}) -> length(L).
diff --git a/lib/hipe/arm/hipe_arm_cfg.erl b/lib/hipe/arm/hipe_arm_cfg.erl
new file mode 100644
index 0000000000..984a3ccf9e
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_cfg.erl
@@ -0,0 +1,131 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_cfg).
+
+-export([init/1,
+ labels/1, start_label/1,
+ succ/2,
+ bb/2, bb_add/3]).
+-export([postorder/1]).
+-export([linearise/1]).
+-export([params/1, reverse_postorder/1]).
+-export([arity/1]). % for linear scan
+%%-export([redirect_jmp/3]).
+
+%%% these tell cfg.inc what to define (ugly as hell)
+-define(BREADTH_ORDER,true). % for linear scan
+-define(PARAMS_NEEDED,true).
+-define(START_LABEL_UPDATE_NEEDED,true).
+
+-include("hipe_arm.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/cfg.inc").
+
+init(Defun) ->
+ Code = hipe_arm:defun_code(Defun),
+ StartLab = hipe_arm:label_label(hd(Code)),
+ Data = hipe_arm:defun_data(Defun),
+ IsClosure = hipe_arm:defun_is_closure(Defun),
+ Name = hipe_arm:defun_mfa(Defun),
+ IsLeaf = hipe_arm:defun_is_leaf(Defun),
+ Formals = hipe_arm:defun_formals(Defun),
+ CFG0 = mk_empty_cfg(Name, StartLab, Data, IsClosure, IsLeaf, Formals),
+ take_bbs(Code, CFG0).
+
+is_branch(I) ->
+ case I of
+ #b_fun{} -> true;
+ #b_label{'cond'='al'} -> true;
+ #pseudo_bc{} -> true;
+ #pseudo_blr{} -> true;
+ #pseudo_bx{} -> true;
+ #pseudo_call{} -> true;
+ #pseudo_switch{} -> true;
+ #pseudo_tailcall{} -> true;
+ _ -> false
+ end.
+
+branch_successors(Branch) ->
+ case Branch of
+ #b_fun{} -> [];
+ #b_label{'cond'='al',label=Label} -> [Label];
+ #pseudo_bc{true_label=TrueLab,false_label=FalseLab} -> [FalseLab,TrueLab];
+ #pseudo_blr{} -> [];
+ #pseudo_bx{} -> [];
+ #pseudo_call{contlab=ContLab, sdesc=#arm_sdesc{exnlab=ExnLab}} ->
+ case ExnLab of
+ [] -> [ContLab];
+ _ -> [ContLab,ExnLab]
+ end;
+ #pseudo_switch{labels=Labels} -> Labels;
+ #pseudo_tailcall{} -> []
+ end.
+
+-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
+fails_to(_Instr) -> [].
+-endif.
+
+-ifdef(notdef).
+redirect_jmp(I, Old, New) ->
+ case I of
+ #b_label{label=Label} ->
+ if Old =:= Label -> I#b_label{label=New};
+ true -> I
+ end;
+ #pseudo_bc{true_label=TrueLab, false_label=FalseLab} ->
+ I1 = if Old =:= TrueLab -> I#pseudo_bc{true_label=New};
+ true -> I
+ end,
+ if Old =:= FalseLab -> I1#pseudo_bc{false_label=New};
+ true -> I1
+ end;
+ %% handle pseudo_call too?
+ _ -> I
+ end.
+-endif.
+
+mk_goto(Label) ->
+ hipe_arm:mk_b_label(Label).
+
+is_label(I) ->
+ hipe_arm:is_label(I).
+
+label_name(Label) ->
+ hipe_arm:label_label(Label).
+
+mk_label(Name) ->
+ hipe_arm:mk_label(Name).
+
+linearise(CFG) -> % -> defun, not insn list
+ MFA = function(CFG),
+ Formals = params(CFG),
+ Code = linearize_cfg(CFG),
+ Data = data(CFG),
+ VarRange = hipe_gensym:var_range(arm),
+ LabelRange = hipe_gensym:label_range(arm),
+ IsClosure = is_closure(CFG),
+ IsLeaf = is_leaf(CFG),
+ hipe_arm:mk_defun(MFA, Formals, IsClosure, IsLeaf,
+ Code, Data, VarRange, LabelRange).
+
+arity(CFG) ->
+ {_M, _F, A} = function(CFG),
+ A.
diff --git a/lib/hipe/arm/hipe_arm_defuse.erl b/lib/hipe/arm/hipe_arm_defuse.erl
new file mode 100644
index 0000000000..8d6efebc21
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_defuse.erl
@@ -0,0 +1,157 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_defuse).
+-export([insn_def_all/1, insn_use_all/1]).
+-export([insn_def_gpr/1, insn_use_gpr/1]).
+-include("hipe_arm.hrl").
+
+%%%
+%%% Defs and uses for both general-purpose and floating-point registers.
+%%% This is needed for the frame module, alas.
+%%%
+insn_def_all(I) ->
+ insn_def_gpr(I).
+
+insn_use_all(I) ->
+ insn_use_gpr(I).
+
+%%%
+%%% Defs and uses for general-purpose (integer) registers only.
+%%%
+insn_def_gpr(I) ->
+ case I of
+ #alu{dst=Dst} -> [Dst];
+ #load{dst=Dst} -> [Dst];
+ #ldrsb{dst=Dst} -> [Dst];
+ #move{dst=Dst} -> [Dst];
+ #pseudo_call{} -> call_clobbered_gpr();
+ #pseudo_li{dst=Dst} -> [Dst];
+ #pseudo_move{dst=Dst} -> [Dst];
+ #pseudo_tailcall_prepare{} -> tailcall_clobbered_gpr();
+ #smull{dstlo=DstLo,dsthi=DstHi,src1=Src1} ->
+ %% ARM requires DstLo, DstHi, and Src1 to be distinct.
+ %% Add fake DEF of Src1 to prevent regalloc from reusing
+ %% it as DstLo or DstHi.
+ [DstLo, DstHi, Src1];
+ _ -> []
+ end.
+
+call_clobbered_gpr() ->
+ [hipe_arm:mk_temp(R, T)
+ || {R,T} <- hipe_arm_registers:call_clobbered() ++ all_fp_pseudos()].
+
+all_fp_pseudos() -> []. % XXX: for now
+
+tailcall_clobbered_gpr() ->
+ [hipe_arm:mk_temp(R, T)
+ || {R,T} <- hipe_arm_registers:tailcall_clobbered() ++ all_fp_pseudos()].
+
+insn_use_gpr(I) ->
+ case I of
+ #alu{src=Src,am1=Am1} -> am1_use(Am1, [Src]);
+ #blx{src=Src} -> [Src];
+ #cmp{src=Src,am1=Am1} -> am1_use(Am1, [Src]);
+ #load{am2=Am2} -> am2_use(Am2, []);
+ #ldrsb{am3=Am3} -> am3_use(Am3, []);
+ #move{am1=Am1} -> am1_use(Am1, []);
+ #pseudo_blr{} ->
+ LR = hipe_arm:mk_temp(hipe_arm_registers:lr(), 'untagged'),
+ RV = hipe_arm:mk_temp(hipe_arm_registers:return_value(), 'tagged'),
+ [RV, LR];
+ #pseudo_bx{src=Src} ->
+ io:format("~w: whoa there! insn_use of ~w occurred\n", [?MODULE,I]),
+ [Src];
+ #pseudo_call{funv=FunV,sdesc=#arm_sdesc{arity=Arity}} ->
+ funv_use(FunV, arity_use_gpr(Arity));
+ #pseudo_move{src=Src} -> [Src];
+ #pseudo_switch{jtab=JTabR,index=IndexR} -> addtemp(JTabR, [IndexR]);
+ #pseudo_tailcall{funv=FunV,arity=Arity,stkargs=StkArgs} ->
+ addargs(StkArgs, addtemps(tailcall_clobbered_gpr(), funv_use(FunV, arity_use_gpr(Arity))));
+ #smull{src1=Src1,src2=Src2} -> addtemp(Src1, [Src2]);
+ #store{src=Src,am2=Am2} -> am2_use(Am2, [Src]);
+ _ -> []
+ end.
+
+addargs([Arg|Args], Set) ->
+ addargs(Args, addarg(Arg, Set));
+addargs([], Set) ->
+ Set.
+
+addarg(Arg, Set) ->
+ case Arg of
+ #arm_temp{} -> addtemp(Arg, Set);
+ _ -> Set
+ end.
+
+arity_use_gpr(Arity) ->
+ [hipe_arm:mk_temp(R, 'tagged')
+ || R <- hipe_arm_registers:args(Arity)].
+
+funv_use(FunV, Set) ->
+ case FunV of
+ #arm_temp{} -> addtemp(FunV, Set);
+ _ -> Set
+ end.
+
+am1_use(Am1, Set) ->
+ case Am1 of
+ #arm_temp{} -> addtemp(Am1, Set);
+ {Src,rrx} -> addtemp(Src, Set);
+ {Src,_,ShiftArg} ->
+ Set1 = addtemp(Src, Set),
+ case ShiftArg of
+ #arm_temp{} -> addtemp(ShiftArg, Set1);
+ _ -> Set1
+ end;
+ _ -> Set
+ end.
+
+am2_use(#am2{src=Src,offset=Am2Offset}, Set) ->
+ Set1 = addtemp(Src, Set),
+ case Am2Offset of
+ #arm_temp{} -> addtemp(Am2Offset, Set1);
+ {Src2,_} -> addtemp(Src2, Set1);
+ {Src2,_,_} -> addtemp(Src2, Set1);
+ _ -> Set1
+ end.
+
+am3_use(#am3{src=Src,offset=Am3Offset}, Set) ->
+ Set1 = addtemp(Src, Set),
+ case Am3Offset of
+ #arm_temp{} -> addtemp(Am3Offset, Set1);
+ _ -> Set1
+ end.
+
+%%%
+%%% Auxiliary operations on sets of temps
+%%% These sets are small. No point using gb_trees, right?
+%%%
+
+addtemps([Arg|Args], Set) ->
+ addtemps(Args, addtemp(Arg, Set));
+addtemps([], Set) ->
+ Set.
+
+addtemp(Temp, Set) ->
+ case lists:member(Temp, Set) of
+ false -> [Temp|Set];
+ _ -> Set
+ end.
diff --git a/lib/hipe/arm/hipe_arm_encode.erl b/lib/hipe/arm/hipe_arm_encode.erl
new file mode 100644
index 0000000000..19e507fdbd
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_encode.erl
@@ -0,0 +1,994 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Encode symbolic ARM instructions to binary form.
+%%% Copyright (C) 2005 Mikael Pettersson
+%%%
+%%% Implementation Notes:
+%%% - The Thumb instruction set is a different entity, and is
+%%% not and never will be supported by this module.
+%%% - Instructions and instruction forms that are unpredictable
+%%% or useless in User mode are not supported. They include:
+%%% + Data Processing Instructions with S=1 and Rd=15.
+%%% + The LDM(2), LDM(3), and STM(2) instructions.
+%%% + MRS instructions that access the SPSR.
+%%% + MSR instructions that access the SPSR.
+%%% + The LDBRT, LDRT, STBRT, and STRT instructions.
+%%%
+%%% Instruction Operands:
+%%%
+%%% S ::= {s,0} | {s,1}
+%%% L ::= {l,0} | {l,1}
+%%% R ::= {r,RNum}
+%%% CR ::= {cr,CRNum}
+%%%
+%%% Cond ::= {cond,CondName}
+%%% CondName ::= eq | ne | cs | hs | cc | lo | mi | pl | vs
+%%% | vc | hi | ls | ge | lt | gt | ge | al
+%%%
+%%% Imm<N> ::= {imm<N>,<N bits>} for N in 4, 5, 8, 12, 16, 24, and 25
+%%%
+%%% Am1ShifterOperand
+%%% ::= {Imm8,Imm4}
+%%% | Rm
+%%% | {Rm,Am1ShiftOp}
+%%% Am1ShiftOp ::= {ShiftOp,Imm5}
+%%% | {ShiftOp,Rs}
+%%% | rrx
+%%% ShiftOp ::= lsl | lsr | asr | ror
+%%%
+%%% Am2LSWUBOperand ::= {immediate_offset,Rn,Sign,Imm12}
+%%% | {register_offset,Rn,Sign,Rm} // redundant
+%%% | {scaled_register_offset,Rn,Sign,Rm,Am2ShiftOp}
+%%% | {immediate_pre_indexed,Rn,Sign,Imm12}
+%%% | {register_pre_indexed,Rn,Sign,Rm} // redundant
+%%% | {scaled_register_pre_indexed,Rn,Sign,Rm,Am2ShiftOp}
+%%% | {immediate_post_indexed,Rn,Sign,Imm12}
+%%% | {register_post_indexed,Rn,Sign,Rm} // redundant
+%%% | {scaled_register_post_indexed,Rn,Sign,Rm,Am2ShiftOp}
+%%% Am2ShiftOp ::= {ShiftOp,Imm5}
+%%% | rrx
+%%% Sign ::= + | -
+%%%
+%%% Am3MiscLSOperand::= {immediate_offset,Rn,Sign,Imm8}
+%%% | {register_offset,Rn,Sign,Rm}
+%%% | {immediate_pre_indexed,Rn,Sign,Imm8}
+%%% | {register_pre_indexed,Rn,Sign,Rm}
+%%% | {immediate_post_indexed,Rn,Sign,Imm8}
+%%% | {register_post_indexed,Rn,Sign,Rm}
+%%%
+%%% Am4LSMultiple ::= ia | ib | da | db
+%%% | fd | ed | fa | ea
+%%%
+%%% Am5LSCoprocessor::= {offset,Rn,Sign,Imm8}
+%%% | {pre_indexed,Rn,Sign,Imm8}
+%%% | {post_indexed,Rn,Sign,Imm8}
+%%% | {unindexed,Rn,Imm8}
+
+-module(hipe_arm_encode).
+
+-export([insn_encode/2]).
+
+%%-define(TESTING,1).
+-ifdef(TESTING).
+-export([dotest/0, dotest/1]).
+-endif.
+
+-define(ASSERT(G),
+ if G -> [];
+ true -> exit({assertion_failed,?MODULE,?LINE,??G})
+ end).
+
+bf(LeftBit, RightBit, Value) ->
+ ?ASSERT(32 > LeftBit),
+ ?ASSERT(LeftBit >= RightBit),
+ ?ASSERT(RightBit >= 0),
+ ?ASSERT(Value >= 0),
+ ?ASSERT(Value < (1 bsl ((LeftBit - RightBit) + 1))),
+ Value bsl RightBit.
+
+-define(BF(LB,RB,V), bf(LB,RB,V)).
+-define(BIT(Pos,Val), ?BF(Pos,Pos,Val)).
+%%-define(BITS(N,Val), ?BF(N,0,Val)).
+
+%%%
+%%% Addressing Modes
+%%%
+
+am1_shifter_operand(Rn, Rd, ShifterOperand) ->
+ case ShifterOperand of
+ {{imm8,Imm8},{imm4,RotImm4}} ->
+ ?BIT(25,1) bor ?BF(11,8,RotImm4) bor ?BF(7,0,Imm8);
+ {r,Rm} ->
+ %% same as Rm LSL #0
+ ?BF(3,0,Rm);
+ {{r,Rm},ShiftOp} ->
+ am1_shift_op(Rn, Rd, Rm, ShiftOp) bor ?BF(3,0,Rm)
+ end.
+
+am1_shift_op(_Rn, _Rd, _Rm, {ShiftOp,{imm5,ShiftImm5}}) ->
+ case ShiftOp of
+ 'ror' -> ?ASSERT(ShiftImm5 =/= 0); % denotes RRX form
+ _ -> []
+ end,
+ ?BF(11,7,ShiftImm5) bor shift_op_bits65(ShiftOp);
+am1_shift_op(Rn, Rd, Rm, {ShiftOp,{r,Rs}}) ->
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rs =/= 15), % UNPREDICTABLE
+ ?BF(11,8,Rs) bor shift_op_bits65(ShiftOp) bor ?BIT(4,1);
+am1_shift_op(_Rn, _Rd, _Rm, 'rrx') ->
+ ?BF(6,5,2#11).
+
+shift_op_bits65(ShiftOp) ->
+ case ShiftOp of
+ 'lsl' -> ?BF(6,5,2#00);
+ 'lsr' -> ?BF(6,5,2#01);
+ 'asr' -> ?BF(6,5,2#10);
+ 'ror' -> ?BF(6,5,2#11)
+ end.
+
+sign('+') -> ?BIT(23,1);
+sign('-') -> 0.
+
+am2_lswub(Rd, AddressingMode) ->
+ case AddressingMode of
+ {immediate_offset,{r,Rn},Sign,{imm12,Imm12}} ->
+ ?BIT(24,1) bor sign(Sign) bor ?BF(19,16,Rn) bor ?BF(11,0,Imm12);
+ {register_offset,{r,Rn},Sign,{r,Rm}} ->
+ %% same as scaled_register_offset LSL #0
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?BIT(25,1) bor ?BIT(24,1) bor sign(Sign) bor ?BF(19,16,Rn) bor ?BF(3,0,Rm);
+ {scaled_register_offset,{r,Rn},Sign,{r,Rm},ShiftOp} ->
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?BIT(25,1) bor ?BIT(24,1) bor sign(Sign) bor ?BF(19,16,Rn) bor am2_shift_op(ShiftOp) bor ?BF(3,0,Rm);
+ {immediate_pre_indexed,{r,Rn},Sign,{imm12,Imm12}} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?BIT(24,1) bor sign(Sign) bor ?BIT(21,1) bor ?BF(19,16,Rn) bor ?BF(11,0,Imm12);
+ {register_pre_indexed,{r,Rn},Sign,{r,Rm}} ->
+ %% same as scaled_register_pre_indexed LSL #0
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= Rm), % UNPREDICTABLE
+ ?BIT(25,1) bor ?BIT(24,1) bor sign(Sign) bor ?BIT(21,1) bor ?BF(19,16,Rn) bor ?BF(3,0,Rm);
+ {scaled_register_pre_indexed,{r,Rn},Sign,{r,Rm},ShiftOp} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= Rm), % UNPREDICTABLE
+ ?BIT(25,1) bor ?BIT(24,1) bor sign(Sign) bor ?BIT(21,1) bor ?BF(19,16,Rn) bor am2_shift_op(ShiftOp) bor ?BF(3,0,Rm);
+ {immediate_post_indexed,{r,Rn},Sign,{imm12,Imm12}} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ sign(Sign) bor ?BF(19,16,Rn) bor ?BF(11,0,Imm12);
+ {register_post_indexed,{r,Rn},Sign,{r,Rm}} ->
+ %% same as scaled_register_post_indexed LSL #0
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?BIT(25,1) bor sign(Sign) bor ?BF(19,6,Rn) bor ?BF(3,0,Rm);
+ {scaled_register_post_indexed,{r,Rn},Sign,{r,Rm},ShiftOp} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= Rm), % UNPREDICTABLE
+ ?BIT(25,1) bor sign(Sign) bor ?BF(19,16,Rn) bor am2_shift_op(ShiftOp) bor ?BF(3,0,Rm)
+ end.
+
+am2_shift_op({ShiftOp,{imm5,ShiftImm5}}) ->
+ case ShiftOp of
+ 'ror' -> ?ASSERT(ShiftImm5 =/= 0); % denotes RRX form
+ _ -> []
+ end,
+ ?BF(11,7,ShiftImm5) bor shift_op_bits65(ShiftOp);
+am2_shift_op('rrx') ->
+ ?BF(6,5,2#11).
+
+am3_miscls(Rd, AddressingMode) ->
+ case AddressingMode of
+ {immediate_offset,{r,Rn},Sign,{imm8,Imm8}} ->
+ ?BIT(24,1) bor sign(Sign) bor ?BF(22,21,2#10) bor ?BF(19,16,Rn) bor ?BF(11,8,Imm8 bsr 4) bor ?BF(3,0,Imm8 band 2#1111);
+ {register_offset,{r,Rn},Sign,{r,Rm}} ->
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?BIT(24,1) bor sign(Sign) bor ?BF(22,21,2#00) bor ?BF(19,16,Rn) bor ?BF(3,0,Rm);
+ {immediate_pre_indexed,{r,Rn},Sign,{imm8,Imm8}} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?BIT(24,1) bor sign(Sign) bor ?BF(22,21,2#11) bor ?BF(19,16,Rn) bor ?BF(11,8,Imm8 bsr 4) bor ?BF(3,0,Imm8 band 2#1111);
+ {register_pre_indexed,{r,Rn},Sign,{r,Rm}} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= Rn), % UNPREDICTABLE
+ ?BIT(24,1) bor sign(Sign) bor ?BF(22,21,2#01) bor ?BF(19,16,Rn) bor ?BF(3,0,Rm);
+ {immediate_post_indexed,{r,Rn},Sign,{imm8,Imm8}} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?BIT(24,0) bor sign(Sign) bor ?BF(22,21,2#10) bor ?BF(19,16,Rn) bor ?BF(11,8,Imm8 bsr 4) bor ?BF(3,0,Imm8 band 2#1111);
+ {register_post_indexed,{r,Rn},Sign,{r,Rm}} ->
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= Rn), % UNPREDICTABLE
+ ?BIT(24,0) bor sign(Sign) bor ?BF(22,21,2#00) bor ?BF(19,16,Rn) bor ?BF(3,0,Rm)
+ end.
+
+am4_ls_multiple(L, AddressingMode) ->
+ case AddressingMode of
+ 'ia' -> ?BF(24,23,2#01);
+ 'ib' -> ?BF(24,23,2#11);
+ 'da' -> ?BF(24,23,2#00);
+ 'db' -> ?BF(24,23,2#10);
+ _ ->
+ %% context-sensitive alias crap
+ case {L,AddressingMode} of
+ {1,'fa'} -> ?BF(24,23,2#00);
+ {1,'fd'} -> ?BF(24,23,2#01);
+ {1,'ea'} -> ?BF(24,23,2#10);
+ {1,'ed'} -> ?BF(24,23,2#11);
+ {0,'ed'} -> ?BF(24,23,2#00);
+ {0,'ea'} -> ?BF(24,23,2#01);
+ {0,'fd'} -> ?BF(24,23,2#10);
+ {0,'fa'} -> ?BF(24,23,2#11)
+ end
+ end.
+
+am5_ls_coprocessor(AddressingMode) ->
+ case AddressingMode of
+ {offset,{r,Rn},Sign,{imm8,Imm8}} ->
+ ?BIT(24,1) bor sign(Sign) bor ?BF(19,16,Rn) bor ?BF(7,0,Imm8);
+ {pre_indexed,{r,Rn},Sign,{imm8,Imm8}} ->
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?BIT(24,1) bor sign(Sign) bor ?BIT(21,1) bor ?BF(19,16,Rn) bor ?BF(7,0,Imm8);
+ {post_indexed,{r,Rn},Sign,{imm8,Imm8}} ->
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ sign(Sign) bor ?BIT(21,1) bor ?BF(19,16,Rn) bor ?BF(7,0,Imm8);
+ {unindexed,{r,Rn},{imm8,Imm8}} ->
+ ?BIT(23,1) bor ?BF(19,16,Rn) bor ?BF(7,0,Imm8)
+ end.
+
+%%%
+
+'cond'(Cond) ->
+ case Cond of
+ 'eq' -> ?BF(31,28,2#0000); % equal
+ 'ne' -> ?BF(31,28,2#0001); % not equal
+ 'cs' -> ?BF(31,28,2#0010); % carry set
+ 'hs' -> ?BF(31,28,2#0010); % unsigned higher or same
+ 'cc' -> ?BF(31,28,2#0011); % carry clear
+ 'lo' -> ?BF(31,28,2#0011); % unsigned lower
+ 'mi' -> ?BF(31,28,2#0100); % minus/negative
+ 'pl' -> ?BF(31,28,2#0101); % plus/positive or zero
+ 'vs' -> ?BF(31,28,2#0110); % overflow
+ 'vc' -> ?BF(31,28,2#0111); % no overflow
+ 'hi' -> ?BF(31,28,2#1000); % unsigned higher
+ 'ls' -> ?BF(31,28,2#1001); % unsigned lower or same
+ 'ge' -> ?BF(31,28,2#1010); % signed greater than or equal
+ 'lt' -> ?BF(31,28,2#1011); % signed less than
+ 'gt' -> ?BF(31,28,2#1100); % signed greater than
+ 'le' -> ?BF(31,28,2#1101); % signed less than or equal
+ 'al' -> ?BF(31,28,2#1110) % always
+ end.
+
+%%%
+%%% ARM Instructions
+%%%
+
+data_processing_form(Cond, OpCode, S, Rn, Rd, ShifterOperand) ->
+ case S of
+ 1 -> ?ASSERT(Rd =/= 15); % UNPREDICTABLE in User or System mode
+ _ -> []
+ end,
+ 'cond'(Cond) bor ?BF(24,21,OpCode) bor ?BIT(20,S) bor ?BF(19,16,Rn) bor ?BF(15,12,Rd) bor am1_shifter_operand(Rn,Rd,ShifterOperand).
+
+data_processing_form(OpCode, {{'cond',Cond},{s,S},{r,Rd},{r,Rn},ShifterOperand}) ->
+ data_processing_form(Cond, OpCode, S, Rn, Rd, ShifterOperand).
+
+adc(Opnds) -> data_processing_form(2#0101, Opnds).
+add(Opnds) -> data_processing_form(2#0100, Opnds).
+'and'(Opnds) -> data_processing_form(2#0000, Opnds).
+bic(Opnds) -> data_processing_form(2#1110, Opnds).
+eor(Opnds) -> data_processing_form(2#0001, Opnds).
+orr(Opnds) -> data_processing_form(2#1100, Opnds).
+rsb(Opnds) -> data_processing_form(2#0011, Opnds).
+rsc(Opnds) -> data_processing_form(2#0111, Opnds).
+sbc(Opnds) -> data_processing_form(2#0110, Opnds).
+sub(Opnds) -> data_processing_form(2#0010, Opnds).
+
+cmp_form(OpCode, {{'cond',Cond},{r,Rn},ShifterOperand}) ->
+ data_processing_form(Cond, OpCode, 1, Rn, 0, ShifterOperand).
+
+cmn(Opnds) -> cmp_form(2#1011, Opnds).
+cmp(Opnds) -> cmp_form(2#1010, Opnds).
+teq(Opnds) -> cmp_form(2#1001, Opnds).
+tst(Opnds) -> cmp_form(2#1000, Opnds).
+
+mov_form(OpCode, {{'cond',Cond},{s,S},{r,Rd},ShifterOperand}) ->
+ data_processing_form(Cond, OpCode, S, 0, Rd, ShifterOperand).
+
+mov(Opnds) -> mov_form(2#1101, Opnds).
+mvn(Opnds) -> mov_form(2#1111, Opnds).
+
+%%%
+
+b_form(L, {{'cond',Cond},{imm24,Imm24}}) ->
+ 'cond'(Cond) bor ?BF(27,25,2#101) bor ?BIT(24,L) bor ?BF(23,0,Imm24).
+
+b(Opnds) -> b_form(0, Opnds).
+bl(Opnds) -> b_form(1, Opnds).
+
+bkpt({{imm16,Imm16}}) ->
+ ?BF(31,28,2#1110) bor ?BF(27,20,2#00010010) bor ?BF(19,8,Imm16 bsr 4) bor ?BF(7,4,2#0111) bor ?BF(3,0,Imm16 band 2#1111).
+
+bx_form(SubOpcode, {{'cond',Cond},{r,Rm}}, IsBlx) ->
+ case IsBlx of
+ true -> ?ASSERT(Rm =/= 15); % UNPREDICTABLE
+ _ -> []
+ end,
+ 'cond'(Cond) bor ?BF(27,20,2#00010010) bor ?BF(19,16,2#1111) bor ?BF(15,12,2#1111) bor ?BF(11,8,2#1111) bor ?BF(7,4,SubOpcode) bor ?BF(3,0,Rm).
+
+blx(Opnds) ->
+ case Opnds of
+ {{imm25,Imm25}} -> % u16-offset!
+ ?BF(31,28,2#1111) bor ?BF(27,25,2#101) bor ?BIT(24,Imm25 band 1) bor ?BF(23,0,Imm25 bsr 1);
+ _ ->
+ bx_form(2#0011, Opnds, true)
+ end.
+
+bx(Opnds) -> bx_form(2#0001, Opnds, false).
+
+cdp_form(Cond, CpOp4, CRn, CRd, CpNum, CpOp3, CRm) ->
+ Cond bor ?BF(27,24,2#1110) bor ?BF(23,20,CpOp4) bor ?BF(19,16,CRn) bor ?BF(15,12,CRd) bor ?BF(11,8,CpNum) bor ?BF(7,5,CpOp3) bor ?BF(3,0,CRm).
+
+cdp({{'cond',Cond},{cpnum,CpNum},{cpop4,CpOp4},{cr,CRd},{cr,CRn},{cr,CRm},{cpop3,CpOp3}}) ->
+ cdp_form('cond'(Cond), CpOp4, CRn, CRd, CpNum, CpOp3, CRm).
+
+cdp2({{cpnum,CpNum},{cpop4,CpOp4},{cr,CRd},{cr,CRn},{cr,CRm},{cpop3,CpOp3}}) ->
+ cdp_form(?BF(31,28,2#1111), CpOp4, CRn, CRd, CpNum, CpOp3, CRm).
+
+clz({{'cond',Cond},{r,Rd},{r,Rm}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BF(27,20,2#00010110) bor ?BF(19,16,2#1111) bor ?BF(15,12,Rd) bor ?BF(11,8,2#1111) bor ?BF(7,4,2#0001) bor ?BF(3,0,Rm).
+
+ldstc_form(Cond, L, B20, CRd, CpNum, AddressingMode) ->
+ Cond bor ?BF(27,25,2#110) bor ?BIT(22,L) bor ?BIT(20,B20) bor ?BF(15,12,CRd) bor ?BF(11,8,CpNum) bor am5_ls_coprocessor(AddressingMode).
+
+ldstc(B20, {{'cond',Cond},{l,L},{cpnum,CpNum},{cr,CRd},AddressingMode}) ->
+ ldstc_form('cond'(Cond), L, B20, CRd, CpNum, AddressingMode).
+
+ldc(Opnds) -> ldstc(1, Opnds).
+stc(Opnds) -> ldstc(0, Opnds).
+
+ldstc2(B20, {{l,L},{cpnum,CpNum},{cr,CRd},AddressingMode}) ->
+ ldstc_form(?BF(31,28,2#1111), L, B20, CRd, CpNum, AddressingMode).
+
+ldc2(Opnds) -> ldstc2(1, Opnds).
+stc2(Opnds) -> ldstc2(0, Opnds).
+
+ldstm_form(Cond, AddressingMode, W, L, Rn, Registers) ->
+ RegisterList = register_list(Registers),
+ ?ASSERT(RegisterList =/= 0), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ case W of
+ 1 ->
+ BitRn = 1 bsl Rn,
+ case L of
+ 1 ->
+ %% LDM! Rn in Registers is UNPREDICTABLE
+ ?ASSERT((RegisterList band BitRn) =:= 0);
+ 0 ->
+ %% STM! Rn in Registers and not lowest is UNPREDICTABLE
+ case RegisterList band BitRn of
+ 0 -> [];
+ _ ->
+ ?ASSERT((RegisterList band (-RegisterList)) =:= BitRn)
+ end
+ end;
+ _ -> []
+ end,
+ 'cond'(Cond) bor ?BF(27,25,2#100) bor am4_ls_multiple(L, AddressingMode) bor ?BIT(21,W) bor ?BIT(20,L) bor ?BF(19,16,Rn) bor ?BF(15,0,RegisterList).
+
+register_list(Registers) -> register_list(Registers, 0).
+
+register_list([{r,R}|Rs], Mask) -> register_list(Rs, Mask bor (1 bsl R));
+register_list([], Mask) -> Mask.
+
+ldstm(L, Opnds) ->
+ case Opnds of
+ {{'cond',Cond},AddressingMode,{r,Rn},'!',Registers} ->
+ ldstm_form(Cond, AddressingMode, 1, L, Rn, Registers);
+ {{'cond',Cond},AddressingMode,{r,Rn},Registers} ->
+ ldstm_form(Cond, AddressingMode, 0, L, Rn, Registers)
+ %% the ldm(2), ldm(3), and stm(2) forms are UNPREDICTABLE
+ %% in User or System mode
+ end.
+
+ldm(Opnds) -> ldstm(1, Opnds).
+stm(Opnds) -> ldstm(0, Opnds).
+
+ldstr_form2(B, L, {{'cond',Cond},{r,Rd},AddressingMode}) ->
+ 'cond'(Cond) bor ?BF(27,26,2#01) bor am2_lswub(Rd, AddressingMode) bor ?BIT(22,B) bor ?BIT(20,L) bor ?BF(15,12,Rd).
+
+ldr(Opnds) -> ldstr_form2(0, 1, Opnds).
+ldrb(Opnds) -> ldstr_form2(1, 1, Opnds).
+str(Opnds) -> ldstr_form2(0, 0, Opnds).
+strb(Opnds) -> ldstr_form2(1, 0, Opnds).
+
+ldstr_form3(L, SubOpcode, {{'cond',Cond},{r,Rd},AddressingMode}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ 'cond'(Cond) bor am3_miscls(Rd, AddressingMode) bor ?BIT(20,L) bor ?BF(15,12,Rd) bor ?BF(7,4,SubOpcode).
+
+ldrh(Opnds) -> ldstr_form3(1, 2#1011, Opnds).
+ldrsb(Opnds) -> ldstr_form3(1, 2#1101, Opnds).
+ldrsh(Opnds) -> ldstr_form3(1, 2#1111, Opnds).
+strh(Opnds) -> ldstr_form3(0, 2#1011, Opnds).
+
+mcr_form(Cond, OP1, CRn, Rd, CpNum, OP2, CRm) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ Cond bor ?BF(27,24,2#1110) bor ?BF(23,21,OP1) bor ?BF(19,16,CRn) bor ?BF(15,12,Rd) bor ?BF(11,8,CpNum) bor ?BF(7,5,OP2) bor ?BIT(4,1) bor ?BF(3,0,CRm).
+
+mcr({{'cond',Cond},{cpnum,CpNum},{cpop3,OP1},{r,Rd},{cr,CRn},{cr,CRm},{cpop3,OP2}}) ->
+ mcr_form('cond'(Cond), OP1, CRn, Rd, CpNum, OP2, CRm).
+
+mcr2({{cpnum,CpNum},{cpop3,OP1},{r,Rd},{cr,CRn},{cr,CRm},{cpop3,OP2}}) ->
+ mcr_form(?BF(31,28,2#1111), OP1, CRn, Rd, CpNum, OP2, CRm).
+
+mla({{'cond',Cond},{s,S},{r,Rd},{r,Rm},{r,Rs},{r,Rn}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rs =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rd =/= Rm), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BIT(21,1) bor ?BIT(20,S) bor ?BF(19,16,Rd) bor ?BF(15,12,Rn) bor ?BF(11,8,Rs) bor ?BF(7,4,2#1001) bor ?BF(3,0,Rm).
+
+mrc_form(Cond, OP1, CRn, Rd, CpNum, OP2, CRm) ->
+ Cond bor ?BF(27,24,2#1110) bor ?BF(23,21,OP1) bor ?BIT(20,1) bor ?BF(19,16,CRn) bor ?BF(15,12,Rd) bor ?BF(11,8,CpNum) bor ?BF(7,5,OP2) bor ?BIT(4,1) bor ?BF(3,0,CRm).
+
+mrc({{'cond',Cond},{cpnum,CpNum},{cpop3,OP1},{r,Rd},{cr,CRn},{cr,CRm},{cpop3,OP2}}) ->
+ mrc_form('cond'(Cond), OP1, CRn, Rd, CpNum, OP2, CRm).
+
+mrc2({{cpnum,CpNum},{cpop3,OP1},{r,Rd},{cr,CRn},{cr,CRm},{cpop3,OP2}}) ->
+ mrc_form(?BF(31,28,2#1111), OP1, CRn, Rd, CpNum, OP2, CRm).
+
+mrs({{'cond',Cond},{r,Rd},'cpsr'}) ->
+ %% the SPSR form is UNPREDICTABLE in User or System mode
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BIT(24,1) bor ?BF(19,16,2#1111) bor ?BF(15,12,Rd).
+
+msr_form(Cond, FieldMask4, Operand) ->
+ 'cond'(Cond) bor ?BIT(24,1) bor ?BIT(21,1) bor ?BF(19,16,FieldMask4) bor ?BF(15,12,2#1111) bor Operand.
+
+msr(Opnds) ->
+ %% the SPSR form is UNPREDICTABLE in User or System mode
+ case Opnds of
+ {{'cond',Cond},'cpsr',{field_mask,FieldMask4},{imm8,Imm8},{imm4,RotImm4}} ->
+ msr_form(Cond, FieldMask4, ?BIT(25,1) bor ?BF(11,8,RotImm4) bor ?BF(7,0,Imm8));
+ {{'cond',Cond},'cpsr',{field_mask,FieldMask4},{r,Rm}} ->
+ msr_form(Cond, FieldMask4, ?BF(3,0,Rm))
+ end.
+
+mul({{'cond',Cond},{s,S},{r,Rd},{r,Rm},{r,Rs}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rs =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rd =/= Rm), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BIT(20,S) bor ?BF(19,16,Rd) bor ?BF(11,8,Rs) bor ?BF(7,4,2#1001) bor ?BF(3,0,Rm).
+
+ml_form2(OpCode, Cond, S, RdLo, RdHi, Rm, Rs) ->
+ ?ASSERT(RdHi =/= 15), % UNPREDICTABLE
+ ?ASSERT(RdLo =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rs =/= 15), % UNPREDICTABLE
+ ?ASSERT(RdHi =/= RdLo),% UNPREDICTABLE
+ ?ASSERT(RdHi =/= Rm), % UNPREDICTABLE
+ ?ASSERT(RdLo =/= Rm), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BF(27,21,OpCode) bor ?BIT(20,S) bor ?BF(19,16,RdHi) bor ?BF(15,12,RdLo) bor ?BF(11,8,Rs) bor ?BF(7,4,2#1001) bor ?BF(3,0,Rm).
+
+ml_form(OpCode, {{'cond',Cond},{s,S},{r,RdLo},{r,RdHi},{r,Rm},{r,Rs}}) ->
+ ml_form2(OpCode, Cond, S, RdLo, RdHi, Rm, Rs).
+
+%%smlal(Opnds) -> ml_form(2#0000111, Opnds).
+smull(Opnds) -> ml_form(2#0000110, Opnds).
+umlal(Opnds) -> ml_form(2#0000101, Opnds).
+umull(Opnds) -> ml_form(2#0000100, Opnds).
+
+swi({{'cond',Cond},{imm24,Imm24}}) ->
+ 'cond'(Cond) bor ?BF(27,24,2#1111) bor ?BF(23,0,Imm24).
+
+swp_form(B22, {{'cond',Cond},{r,Rd},{r,Rm},{r,Rn}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= Rm), % UNPREDICTABLE
+ ?ASSERT(Rn =/= Rd), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BIT(24,1) bor ?BIT(22,B22) bor ?BF(19,16,Rn) bor ?BF(15,12,Rd) bor ?BF(7,4,2#1001) bor ?BF(3,0,Rm).
+
+swp(Opnds) -> swp_form(0, Opnds).
+swpb(Opnds) -> swp_form(1, Opnds).
+
+%%%
+%%% Enhanced DSP Extension Instructions
+%%%
+
+ldstrd_form(OpCode, {{'cond',Cond},{r,Rd},AddressingMode}) ->
+ ?ASSERT(Rd =/= 14), % UNPREDICTABLE
+ ?ASSERT((Rd band 1) =:= 0), % UNDEFINED
+ %% XXX: unpredictable if write-back and base reg Rn equals Rd or Rd+1
+ %% XXX: if is load then unpredictable if index reg Rm and Rm equals Rd or Rd+1
+ 'cond'(Cond) bor am3_miscls(Rd, AddressingMode) bor ?BF(15,12,Rd) bor ?BF(7,4,OpCode).
+
+ldrd(Opnds) -> ldstrd_form(2#1101, Opnds).
+strd(Opnds) -> ldstrd_form(2#1111, Opnds).
+
+mcrr({{'cond',Cond},{cpnum,CpNum},{cpop4,OP},{r,Rd},{r,Rn},{cr,CRm}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BF(27,20,2#11000100) bor ?BF(19,16,Rn) bor ?BF(15,12,Rd) bor ?BF(11,8,CpNum) bor ?BF(7,4,OP) bor ?BF(3,0,CRm).
+
+mrrc({{'cond',Cond},{cpnum,CpNum},{cpop4,OP},{r,Rd},{r,Rn},{cr,CRm}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rd =/= Rn), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BF(27,20,2#11000101) bor ?BF(19,16,Rn) bor ?BF(15,12,Rd) bor ?BF(11,8,CpNum) bor ?BF(7,4,OP) bor ?BF(3,0,CRm).
+
+pld({AddressingMode}) ->
+ AM = am2_lswub(42, AddressingMode), % 42 is a dummy reg nr
+ %% not all adressing modes are allowed: bit 24 must be 1
+ %% and bit 21 must be 0
+ ?ASSERT(((AM bsr 21) band 2#1001) =:= 2#1000),
+ 16#F550F000 bor AM.
+
+q_form(OpCode, {{'cond',Cond},{r,Rd},{r,Rm},{r,Rn}}) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BF(27,20,OpCode) bor ?BF(19,16,Rn) bor ?BF(15,11,Rd) bor ?BF(7,4,2#0101) bor ?BF(3,0,Rm).
+
+qadd(Opnds) -> q_form(2#00010000, Opnds).
+qdadd(Opnds) -> q_form(2#00010100, Opnds).
+qdsub(Opnds) -> q_form(2#00010110, Opnds).
+qsub(Opnds) -> q_form(2#00010010, Opnds).
+
+smlaxy_form(Cond, OpCode, Rd, Rn, Rs, Y, X, Rm) ->
+ ?ASSERT(Rd =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rm =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rs =/= 15), % UNPREDICTABLE
+ ?ASSERT(Rn =/= 15), % UNPREDICTABLE
+ 'cond'(Cond) bor ?BF(27,20,OpCode) bor ?BF(19,16,Rd) bor ?BF(15,12,Rn) bor ?BF(11,8,Rs) bor ?BIT(7,1) bor ?BIT(6,Y) bor ?BIT(5,X) bor ?BF(3,0,Rm).
+
+smla({{bt,X},{bt,Y},{'cond',Cond},{r,Rd},{r,Rm},{r,Rs},{r,Rn}}) ->
+ smlaxy_form(Cond, 2#00010000, Rd, Rn, Rs, Y, X, Rm).
+
+smlal(Opnds) -> % may be regular ARM or DSP insn :-(
+ case Opnds of
+ {{'cond',Cond},{s,S},{r,RdLo},{r,RdHi},{r,Rm},{r,Rs}} ->
+ ml_form2(2#0000111, Cond, S, RdLo, RdHi, Rm, Rs);
+ {{bt,X},{bt,Y},{'cond',Cond},{r,RdLo},{r,RdHi},{r,Rm},{r,Rs}} ->
+ ?ASSERT(RdLo =/= RdHi), % UNPREDICTABLE
+ smlaxy_form(Cond, 2#00010100, RdHi, RdLo, Rs, Y, X, Rm)
+ end.
+
+smlaw({{bt,Y},{'cond',Cond},{r,Rd},{r,Rm},{r,Rs},{r,Rn}}) ->
+ smlaxy_form(Cond, 2#00010010, Rd, Rn, Rs, Y, 0, Rm).
+
+smul({{bt,X},{bt,Y},{'cond',Cond},{r,Rd},{r,Rm},{r,Rs}}) ->
+ smlaxy_form(Cond, 2#00010110, Rd, 0, Rs, Y, X, Rm).
+
+smulw({{bt,Y},{'cond',Cond},{r,Rd},{r,Rm},{r,Rs}}) ->
+ smlaxy_form(Cond, 2#00010010, Rd, 0, Rs, Y, 1, Rm).
+
+%%%
+%%% Main Encode Dispatch
+%%%
+
+insn_encode(Op, Opnds) ->
+ case Op of
+ 'adc' -> adc(Opnds);
+ 'add' -> add(Opnds);
+ 'and' -> 'and'(Opnds);
+ 'b' -> b(Opnds);
+ 'bic' -> bic(Opnds);
+ 'bkpt' -> bkpt(Opnds);
+ 'bl' -> bl(Opnds);
+ 'blx' -> blx(Opnds);
+ 'bx' -> bx(Opnds);
+ 'cdp' -> cdp(Opnds);
+ 'cdp2' -> cdp2(Opnds);
+ 'clz' -> clz(Opnds);
+ 'cmn' -> cmn(Opnds);
+ 'cmp' -> cmp(Opnds);
+ 'eor' -> eor(Opnds);
+ 'ldc' -> ldc(Opnds);
+ 'ldc2' -> ldc2(Opnds);
+ 'ldm' -> ldm(Opnds);
+ 'ldr' -> ldr(Opnds);
+ 'ldrb' -> ldrb(Opnds);
+ 'ldrd' -> ldrd(Opnds);
+ %% ldrbt: omitted
+ 'ldrh' -> ldrh(Opnds);
+ 'ldrsb' -> ldrsb(Opnds);
+ 'ldrsh' -> ldrsh(Opnds);
+ %% ldrt: omitted
+ 'mcr' -> mcr(Opnds);
+ 'mcr2' -> mcr2(Opnds);
+ 'mcrr' -> mcrr(Opnds);
+ 'mla' -> mla(Opnds);
+ 'mov' -> mov(Opnds);
+ 'mrc' -> mrc(Opnds);
+ 'mrc2' -> mrc2(Opnds);
+ 'mrrc' -> mrrc(Opnds);
+ 'mrs' -> mrs(Opnds);
+ 'msr' -> msr(Opnds);
+ 'mul' -> mul(Opnds);
+ 'mvn' -> mvn(Opnds);
+ 'orr' -> orr(Opnds);
+ 'pld' -> pld(Opnds);
+ 'qadd' -> qadd(Opnds);
+ 'qdadd' -> qdadd(Opnds);
+ 'qdsub' -> qdsub(Opnds);
+ 'qsub' -> qsub(Opnds);
+ 'rsb' -> rsb(Opnds);
+ 'rsc' -> rsc(Opnds);
+ 'sbc' -> sbc(Opnds);
+ 'smla' -> smla(Opnds);
+ 'smlal' -> smlal(Opnds); % may be regular ARM or DSP insn :-(
+ 'smlaw' -> smlaw(Opnds);
+ 'smull' -> smull(Opnds);
+ 'smul' -> smul(Opnds);
+ 'smulw' -> smulw(Opnds);
+ 'stc' -> stc(Opnds);
+ 'stc2' -> stc2(Opnds);
+ 'stm' -> stm(Opnds);
+ 'str' -> str(Opnds);
+ 'strb' -> strb(Opnds);
+ %% strbt: omitted
+ 'strd' -> strd(Opnds);
+ 'strh' -> strh(Opnds);
+ %% strt: omitted
+ 'sub' -> sub(Opnds);
+ 'swi' -> swi(Opnds);
+ 'swp' -> swp(Opnds);
+ 'swpb' -> swpb(Opnds);
+ 'teq' -> teq(Opnds);
+ 'tst' -> tst(Opnds);
+ 'umlal' -> umlal(Opnds);
+ 'umull' -> umull(Opnds);
+ _ -> exit({?MODULE,insn_encode,Op})
+ end.
+
+%%%
+%%% Testing Interface
+%%%
+
+-ifdef(TESTING).
+
+say(OS, Str) ->
+ file:write(OS, Str).
+
+hex_digit(Dig0) ->
+ Dig = Dig0 band 16#F,
+ if Dig >= 16#A -> $A + (Dig - 16#A);
+ true -> $0 + Dig
+ end.
+
+say_byte(OS, Byte) ->
+ say(OS, [hex_digit(Byte bsr 4)]),
+ say(OS, [hex_digit(Byte)]).
+
+say_word(OS, Word) ->
+ say(OS, "0x"),
+ say_byte(OS, Word bsr 24),
+ say_byte(OS, Word bsr 16),
+ say_byte(OS, Word bsr 8),
+ say_byte(OS, Word).
+
+t(OS, Op, Opnds) ->
+ Word = insn_encode(Op, Opnds),
+ say(OS, "\t.long "),
+ say_word(OS, Word),
+ say(OS, "\n").
+
+dotest1(OS) ->
+ say(OS, "\t.text\n\t.align 4\n"),
+ %%
+ Rn = {r,9},
+ Rd = {r,8}, % must be even and less than 14 for some insns
+ Rm = {r,7},
+ Rs = {r,6},
+ RdLo = Rn,
+ RdHi = Rd,
+ Registers = [Rm,Rs,Rd], % must exclude Rn for some insns
+ CRd = {cr,15},
+ CRn = {cr,14},
+ CRm = {cr,13},
+ BT0 = {bt,0},
+ BT1 = {bt,1},
+ CpNum = {cpnum,15},
+ CpOp3 = {cpop3,16#3},
+ CpOp4 = {cpop4,16#F},
+ L0 = {l,0},
+ L1 = {l,1},
+ S0 = {s,0},
+ S1 = {s,1},
+ FieldMask4 = {field_mask,16#F},
+ Imm4 = {imm4,16#F},
+ Imm5 = {imm5,16#1F},
+ Imm8 = {imm8,16#FF},
+ Imm12 = {imm12,16#FFF},
+ Imm16 = {imm16,16#FFFF},
+ Imm24 = {imm24,16#FFFFF},
+ Imm25 = {imm25,16#FFFFF1},
+ %%
+ AM1_1 = {Imm8,Imm4},
+ AM1_2 = Rm,
+ AM1_3_1 = {Rm,{'lsl',Imm5}},
+ AM1_3_2 = {Rm,{'lsr',Imm5}},
+ AM1_3_3 = {Rm,{'asr',Imm5}},
+ AM1_3_4 = {Rm,{'ror',Imm5}},
+ AM1_3_5 = {Rm,{'lsl',Rs}},
+ AM1_3_6 = {Rm,{'lsr',Rs}},
+ AM1_3_7 = {Rm,{'asr',Rs}},
+ AM1_3_8 = {Rm,{'ror',Rs}},
+ AM1_3_9 = {Rm,'rrx'},
+ %%
+ AM2ShiftOp1 = {'lsl',Imm5},
+ AM2ShiftOp2 = {'lsr',Imm5},
+ AM2ShiftOp3 = {'asr',Imm5},
+ AM2ShiftOp4 = {'ror',Imm5},
+ AM2ShiftOp5 = 'rrx',
+ SignP = '+',
+ SignM = '-',
+ AM2_1_1 = {immediate_offset,Rn,SignP,Imm12},
+ AM2_1_2 = {immediate_offset,Rn,SignM,Imm12},
+ AM2_2_1 = {register_offset,Rn,SignP,Rm},
+ AM2_2_2 = {register_offset,Rn,SignM,Rm},
+ AM2_3_1 = {scaled_register_offset,Rn,SignP,Rm,AM2ShiftOp1},
+ AM2_3_2 = {scaled_register_offset,Rn,SignM,Rm,AM2ShiftOp2},
+ AM2_3_3 = {scaled_register_offset,Rn,SignP,Rm,AM2ShiftOp3},
+ AM2_3_4 = {scaled_register_offset,Rn,SignM,Rm,AM2ShiftOp4},
+ AM2_3_5 = {scaled_register_offset,Rn,SignP,Rm,AM2ShiftOp5},
+ AM2_4_1 = {immediate_pre_indexed,Rn,SignP,Imm12},
+ AM2_4_2 = {immediate_pre_indexed,Rn,SignM,Imm12},
+ AM2_5_1 = {register_pre_indexed,Rn,SignP,Rm},
+ AM2_5_2 = {register_pre_indexed,Rn,SignM,Rm},
+ AM2_6_1 = {scaled_register_pre_indexed,Rn,SignP,Rm,AM2ShiftOp1},
+ AM2_6_2 = {scaled_register_pre_indexed,Rn,SignM,Rm,AM2ShiftOp2},
+ AM2_6_3 = {scaled_register_pre_indexed,Rn,SignP,Rm,AM2ShiftOp3},
+ AM2_6_4 = {scaled_register_pre_indexed,Rn,SignM,Rm,AM2ShiftOp4},
+ AM2_6_5 = {scaled_register_pre_indexed,Rn,SignP,Rm,AM2ShiftOp5},
+ AM2_7_1 = {immediate_post_indexed,Rn,SignP,Imm12},
+ AM2_7_2 = {immediate_post_indexed,Rn,SignM,Imm12},
+ AM2_8_1 = {register_post_indexed,Rn,SignP,Rm},
+ AM2_8_2 = {register_post_indexed,Rn,SignM,Rm},
+ AM2_9_1 = {scaled_register_post_indexed,Rn,SignP,Rm,AM2ShiftOp1},
+ AM2_9_2 = {scaled_register_post_indexed,Rn,SignM,Rm,AM2ShiftOp2},
+ AM2_9_3 = {scaled_register_post_indexed,Rn,SignP,Rm,AM2ShiftOp3},
+ AM2_9_4 = {scaled_register_post_indexed,Rn,SignM,Rm,AM2ShiftOp4},
+ AM2_9_5 = {scaled_register_post_indexed,Rn,SignP,Rm,AM2ShiftOp5},
+ %%
+ AM3_1_1 = {immediate_offset,Rn,SignP,Imm8},
+ AM3_1_2 = {immediate_offset,Rn,SignM,Imm8},
+ AM3_2_1 = {register_offset,Rn,SignP,Rm},
+ AM3_2_2 = {register_offset,Rn,SignM,Rm},
+ AM3_3_1 = {immediate_pre_indexed,Rn,SignP,Imm8},
+ AM3_3_2 = {immediate_pre_indexed,Rn,SignM,Imm8},
+ AM3_4_1 = {register_pre_indexed,Rn,SignP,Rm},
+ AM3_4_2 = {register_pre_indexed,Rn,SignM,Rm},
+ AM3_5_1 = {immediate_post_indexed,Rn,SignP,Imm8},
+ AM3_5_2 = {immediate_post_indexed,Rn,SignM,Imm8},
+ AM3_6_1 = {register_post_indexed,Rn,SignP,Rm},
+ AM3_6_2 = {register_post_indexed,Rn,SignM,Rm},
+ %%
+ AM4_1 = 'ia',
+ AM4_2 = 'ib',
+ AM4_3 = 'da',
+ AM4_4 = 'db',
+ AM4_5 = 'fa',
+ AM4_6 = 'fd',
+ AM4_7 = 'ea',
+ AM4_8 = 'ed',
+ %%
+ AM5_1_1 = {offset,Rn,SignP,Imm8},
+ AM5_1_2 = {offset,Rn,SignM,Imm8},
+ AM5_2_1 = {pre_indexed,Rn,SignP,Imm8},
+ AM5_2_2 = {pre_indexed,Rn,SignM,Imm8},
+ AM5_3_1 = {post_indexed,Rn,SignP,Imm8},
+ AM5_3_2 = {post_indexed,Rn,SignM,Imm8},
+ AM5_4 = {unindexed,Rn,Imm8},
+ %%
+ Cond_eq = {'cond','eq'},
+ Cond_ne = {'cond','ne'},
+ Cond_cs = {'cond','cs'},
+ Cond_hs = {'cond','hs'},
+ Cond_cc = {'cond','cc'},
+ Cond_lo = {'cond','lo'},
+ Cond_mi = {'cond','mi'},
+ Cond_pl = {'cond','pl'},
+ Cond_vs = {'cond','vs'},
+ Cond_vc = {'cond','vc'},
+ Cond_hi = {'cond','hi'},
+ Cond_ls = {'cond','ls'},
+ Cond_ge = {'cond','ge'},
+ Cond_lt = {'cond','lt'},
+ Cond_gt = {'cond','gt'},
+ Cond_le = {'cond','le'},
+ Cond_al = {'cond','al'},
+ %%
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_1}), % test all AM1 operands
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_2}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_1}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_2}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_3}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_4}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_5}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_6}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_7}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_8}),
+ t(OS,'adc',{Cond_al,S0,Rd,Rn,AM1_3_9}),
+ t(OS,'add',{Cond_al,S0,Rd,Rn,AM1_1}), % test all S operands
+ t(OS,'add',{Cond_al,S1,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_eq,S0,Rd,Rn,AM1_1}), % test all Cond operands
+ t(OS,'and',{Cond_ne,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_cs,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_hs,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_cc,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_lo,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_mi,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_pl,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_vs,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_vc,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_hi,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_ls,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_ge,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_lt,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_gt,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_le,S0,Rd,Rn,AM1_1}),
+ t(OS,'and',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'b',{Cond_al,Imm24}),
+ t(OS,'bic',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'bkpt',{Imm16}),
+ t(OS,'bl',{Cond_al,Imm24}),
+ t(OS,'blx',{Imm25}),
+ t(OS,'blx',{Cond_al,Rm}),
+ t(OS,'bx',{Cond_al,Rm}),
+ t(OS,'cdp',{Cond_al,CpNum,CpOp4,CRd,CRn,CRm,CpOp3}),
+ t(OS,'cdp2',{CpNum,CpOp4,CRd,CRn,CRm,CpOp3}),
+ t(OS,'clz',{Cond_al,Rd,Rm}),
+ t(OS,'cmn',{Cond_al,Rn,AM1_1}),
+ t(OS,'cmp',{Cond_al,Rn,AM1_1}),
+ t(OS,'eor',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'ldc',{Cond_al,L0,CpNum,CRd,AM5_1_1}), % test all AM5 operands
+ t(OS,'ldc',{Cond_al,L1,CpNum,CRd,AM5_1_2}),
+ t(OS,'ldc',{Cond_al,L0,CpNum,CRd,AM5_2_1}),
+ t(OS,'ldc',{Cond_al,L1,CpNum,CRd,AM5_2_2}),
+ t(OS,'ldc',{Cond_al,L0,CpNum,CRd,AM5_3_1}),
+ t(OS,'ldc',{Cond_al,L1,CpNum,CRd,AM5_3_2}),
+ t(OS,'ldc',{Cond_al,L0,CpNum,CRd,AM5_4}),
+ t(OS,'ldc2',{L0,CpNum,CRd,AM5_1_1}),
+ t(OS,'ldm',{Cond_al,AM4_1,Rn,'!',Registers}),
+ t(OS,'ldm',{Cond_al,AM4_1,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_2,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_3,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_4,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_5,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_6,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_7,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldm',{Cond_al,AM4_8,Rn,Registers}), % test all AM4 operands
+ t(OS,'ldr',{Cond_al,Rd,AM2_1_1}), % test all AM2 operands
+ t(OS,'ldr',{Cond_al,Rd,AM2_1_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_2_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_2_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_3_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_3_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_3_3}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_3_4}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_3_5}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_4_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_4_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_5_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_5_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_6_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_6_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_6_3}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_6_4}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_6_5}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_7_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_7_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_8_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_8_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_9_1}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_9_2}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_9_3}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_9_4}),
+ t(OS,'ldr',{Cond_al,Rd,AM2_9_5}),
+ t(OS,'ldrb',{Cond_al,Rd,AM2_1_1}),
+ t(OS,'ldrd',{Cond_al,Rd,AM3_1_1}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_1_1}), % test all AM3 operands
+ t(OS,'ldrh',{Cond_al,Rd,AM3_1_2}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_2_1}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_2_2}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_3_1}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_3_2}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_4_1}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_4_2}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_5_1}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_5_2}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_6_1}),
+ t(OS,'ldrh',{Cond_al,Rd,AM3_6_2}),
+ t(OS,'ldrsb',{Cond_al,Rd,AM3_1_1}),
+ t(OS,'ldrsh',{Cond_al,Rd,AM3_1_1}),
+ t(OS,'mcr',{Cond_al,CpNum,CpOp3,Rd,CRn,CRm,CpOp3}),
+ t(OS,'mcr2',{CpNum,CpOp3,Rd,CRn,CRm,CpOp3}),
+ t(OS,'mcrr',{Cond_al,CpNum,CpOp4,Rd,Rn,CRm}),
+ t(OS,'mla',{Cond_al,S0,Rd,Rm,Rs,Rn}),
+ t(OS,'mov',{Cond_al,S0,Rd,AM1_1}),
+ t(OS,'mrc',{Cond_al,CpNum,CpOp3,Rd,CRn,CRm,CpOp3}),
+ t(OS,'mrc2',{CpNum,CpOp3,Rd,CRn,CRm,CpOp3}),
+ t(OS,'mrrc',{Cond_al,CpNum,CpOp4,Rd,Rn,CRm}),
+ t(OS,'mrs',{Cond_al,Rd,'cpsr'}),
+ t(OS,'msr',{Cond_al,'cpsr',FieldMask4,Imm8,Imm4}),
+ t(OS,'msr',{Cond_al,'cpsr',FieldMask4,Rm}),
+ t(OS,'mul',{Cond_al,S0,Rd,Rm,Rs}),
+ t(OS,'mvn',{Cond_al,S1,Rd,AM1_1}),
+ t(OS,'orr',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'pld',{AM2_1_1}),
+ t(OS,'qadd',{Cond_al,Rd,Rm,Rn}),
+ t(OS,'qdadd',{Cond_al,Rd,Rm,Rn}),
+ t(OS,'qdsub',{Cond_al,Rd,Rm,Rn}),
+ t(OS,'qsub',{Cond_al,Rd,Rm,Rn}),
+ t(OS,'rsb',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'rsc',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'sbc',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'smla',{BT0,BT0,Cond_al,Rd,Rm,Rs,Rn}),
+ t(OS,'smla',{BT0,BT1,Cond_al,Rd,Rm,Rs,Rn}),
+ t(OS,'smla',{BT1,BT0,Cond_al,Rd,Rm,Rs,Rn}),
+ t(OS,'smla',{BT1,BT1,Cond_al,Rd,Rm,Rs,Rn}),
+ t(OS,'smlal',{Cond_al,S0,RdLo,RdHi,Rm,Rs}),
+ t(OS,'smlal',{BT0,BT1,Cond_al,RdLo,RdHi,Rm,Rs}),
+ t(OS,'smlaw',{BT1,Cond_al,Rd,Rm,Rs,Rn}),
+ t(OS,'smull',{Cond_al,S0,RdLo,RdHi,Rm,Rs}),
+ t(OS,'smul',{BT1,BT0,Cond_al,Rd,Rm,Rs}),
+ t(OS,'smulw',{BT1,Cond_al,Rd,Rm,Rs}),
+ t(OS,'stc',{Cond_al,L0,CpNum,CRd,AM5_1_1}),
+ t(OS,'stc2',{L0,CpNum,CRd,AM5_1_1}),
+ t(OS,'stm',{Cond_al,AM4_1,Rn,Registers}),
+ t(OS,'str',{Cond_al,Rd,AM2_1_1}),
+ t(OS,'strb',{Cond_al,Rd,AM2_1_1}),
+ t(OS,'strd',{Cond_al,Rd,AM3_1_1}),
+ t(OS,'strh',{Cond_al,Rd,AM3_1_1}),
+ t(OS,'sub',{Cond_al,S0,Rd,Rn,AM1_1}),
+ t(OS,'swi',{Cond_al,Imm24}),
+ t(OS,'swp',{Cond_al,Rd,Rm,Rn}),
+ t(OS,'swpb',{Cond_al,Rd,Rm,Rn}),
+ t(OS,'teq',{Cond_al,Rn,AM1_1}),
+ t(OS,'tst',{Cond_al,Rn,AM1_1}),
+ t(OS,'umlal',{Cond_al,S0,RdLo,RdHi,Rm,Rs}),
+ t(OS,'umull',{Cond_al,S0,RdLo,RdHi,Rm,Rs}),
+ [].
+
+dotest() -> dotest1(group_leader()).
+
+dotest(File) ->
+ {ok,OS} = file:open(File, [write]),
+ dotest1(OS),
+ file:close(OS).
+
+-endif.
diff --git a/lib/hipe/arm/hipe_arm_finalise.erl b/lib/hipe/arm/hipe_arm_finalise.erl
new file mode 100644
index 0000000000..38e3efd223
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_finalise.erl
@@ -0,0 +1,73 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_finalise).
+-export([finalise/1]).
+-include("hipe_arm.hrl").
+
+finalise(Defun) ->
+ #defun{code=Code0} = Defun,
+ Code1 = peep(expand(Code0)),
+ Defun#defun{code=Code1}.
+
+expand(Insns) ->
+ expand_list(Insns, []).
+
+expand_list([I|Insns], Accum) ->
+ expand_list(Insns, expand_insn(I, Accum));
+expand_list([], Accum) ->
+ lists:reverse(Accum).
+
+expand_insn(I, Accum) ->
+ case I of
+ #pseudo_bc{'cond'=Cond,true_label=TrueLab,false_label=FalseLab} ->
+ [hipe_arm:mk_b_label(FalseLab),
+ hipe_arm:mk_b_label(Cond, TrueLab) |
+ Accum];
+ #pseudo_blr{} ->
+ [hipe_arm:mk_move(hipe_arm:mk_pc(), hipe_arm:mk_lr()) | Accum];
+ #pseudo_bx{src=Src} ->
+ [hipe_arm:mk_move(hipe_arm:mk_pc(), Src) | Accum];
+ #pseudo_call{funv=FunV,sdesc=SDesc,contlab=ContLab,linkage=Linkage} ->
+ [hipe_arm:mk_b_label(ContLab),
+ case FunV of
+ #arm_temp{} -> hipe_arm:mk_blx(FunV, SDesc);
+ _ -> hipe_arm:mk_bl(FunV, SDesc, Linkage)
+ end |
+ Accum];
+ #pseudo_switch{jtab=JTab,index=Index} ->
+ PC = hipe_arm:mk_pc(),
+ Am2 = hipe_arm:mk_am2(JTab, '+', {Index,'lsl',2}),
+ [hipe_arm:mk_load('ldr', PC, Am2) | Accum];
+ #pseudo_tailcall_prepare{} ->
+ Accum;
+ _ ->
+ [I|Accum]
+ end.
+
+peep(Insns) ->
+ peep_list(Insns, []).
+
+peep_list([#b_label{'cond'='al',label=Label} | (Insns = [#label{label=Label}|_])], Accum) ->
+ peep_list(Insns, Accum);
+peep_list([I|Insns], Accum) ->
+ peep_list(Insns, [I|Accum]);
+peep_list([], Accum) ->
+ lists:reverse(Accum).
diff --git a/lib/hipe/arm/hipe_arm_frame.erl b/lib/hipe/arm/hipe_arm_frame.erl
new file mode 100644
index 0000000000..316aa2ef82
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_frame.erl
@@ -0,0 +1,639 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_frame).
+-export([frame/1]).
+
+-include("hipe_arm.hrl").
+-include("../rtl/hipe_literals.hrl").
+
+-define(LIVENESS_ALL, hipe_arm_liveness_gpr). % since we have no FP yet
+
+frame(Defun) ->
+ Formals = fix_formals(hipe_arm:defun_formals(Defun)),
+ Temps0 = all_temps(hipe_arm:defun_code(Defun), Formals),
+ MinFrame = defun_minframe(Defun),
+ Temps = ensure_minframe(MinFrame, Temps0),
+ ClobbersLR = clobbers_lr(hipe_arm:defun_code(Defun)),
+ CFG0 = hipe_arm_cfg:init(Defun),
+ Liveness = ?LIVENESS_ALL:analyse(CFG0),
+ CFG1 = do_body(CFG0, Liveness, Formals, Temps, ClobbersLR),
+ hipe_arm_cfg:linearise(CFG1).
+
+fix_formals(Formals) ->
+ fix_formals(hipe_arm_registers:nr_args(), Formals).
+
+fix_formals(0, Rest) -> Rest;
+fix_formals(N, [_|Rest]) -> fix_formals(N-1, Rest);
+fix_formals(_, []) -> [].
+
+do_body(CFG0, Liveness, Formals, Temps, ClobbersLR) ->
+ Context = mk_context(Liveness, Formals, Temps, ClobbersLR),
+ CFG1 = do_blocks(CFG0, Context),
+ do_prologue(CFG1, Context).
+
+do_blocks(CFG, Context) ->
+ Labels = hipe_arm_cfg:labels(CFG),
+ do_blocks(Labels, CFG, Context).
+
+do_blocks([Label|Labels], CFG, Context) ->
+ Liveness = context_liveness(Context),
+ LiveOut = ?LIVENESS_ALL:liveout(Liveness, Label),
+ Block = hipe_arm_cfg:bb(CFG, Label),
+ Code = hipe_bb:code(Block),
+ NewCode = do_block(Code, LiveOut, Context),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ NewCFG = hipe_arm_cfg:bb_add(CFG, Label, NewBlock),
+ do_blocks(Labels, NewCFG, Context);
+do_blocks([], CFG, _) ->
+ CFG.
+
+do_block(Insns, LiveOut, Context) ->
+ do_block(Insns, LiveOut, Context, context_framesize(Context), []).
+
+do_block([I|Insns], LiveOut, Context, FPoff0, RevCode) ->
+ {NewIs, FPoff1} = do_insn(I, LiveOut, Context, FPoff0),
+ do_block(Insns, LiveOut, Context, FPoff1, lists:reverse(NewIs, RevCode));
+do_block([], _, Context, FPoff, RevCode) ->
+ FPoff0 = context_framesize(Context),
+ if FPoff =:= FPoff0 -> [];
+ true -> exit({?MODULE,do_block,FPoff})
+ end,
+ lists:reverse(RevCode, []).
+
+do_insn(I, LiveOut, Context, FPoff) ->
+ case I of
+ #pseudo_blr{} ->
+ {do_pseudo_blr(I, Context, FPoff), context_framesize(Context)};
+ #pseudo_call{} ->
+ do_pseudo_call(I, LiveOut, Context, FPoff);
+ #pseudo_call_prepare{} ->
+ do_pseudo_call_prepare(I, FPoff);
+ #pseudo_move{} ->
+ {do_pseudo_move(I, Context, FPoff), FPoff};
+ #pseudo_tailcall{} ->
+ {do_pseudo_tailcall(I, Context), context_framesize(Context)};
+ _ ->
+ {[I], FPoff}
+ end.
+
+%%%
+%%% Moves, with Dst or Src possibly a pseudo
+%%%
+
+do_pseudo_move(I, Context, FPoff) ->
+ Dst = hipe_arm:pseudo_move_dst(I),
+ Src = hipe_arm:pseudo_move_src(I),
+ case temp_is_pseudo(Dst) of
+ true ->
+ Offset = pseudo_offset(Dst, FPoff, Context),
+ mk_store('str', Src, Offset, mk_sp(), []);
+ _ ->
+ case temp_is_pseudo(Src) of
+ true ->
+ Offset = pseudo_offset(Src, FPoff, Context),
+ mk_load('ldr', Dst, Offset, mk_sp(), []);
+ _ ->
+ [hipe_arm:mk_move(Dst, Src)]
+ end
+ end.
+
+pseudo_offset(Temp, FPoff, Context) ->
+ FPoff + context_offset(Context, Temp).
+
+%%%
+%%% Return - deallocate frame and emit 'ret $N' insn.
+%%%
+
+do_pseudo_blr(I, Context, FPoff) ->
+ %% XXX: perhaps use explicit pseudo_move;mtlr,
+ %% avoiding the need to hard-code Temp1 here
+ %% XXX: typically only one instruction between
+ %% the mtlr and the blr, ouch
+ restore_lr(FPoff, Context,
+ adjust_sp(FPoff + word_size() * context_arity(Context),
+ [I])).
+
+restore_lr(FPoff, Context, Rest) ->
+ case context_clobbers_lr(Context) of
+ false -> Rest;
+ true ->
+ LR = hipe_arm:mk_lr(),
+ mk_load('ldr', LR, FPoff - word_size(), mk_sp(),
+ Rest)
+ end.
+
+adjust_sp(N, Rest) ->
+ if N =:= 0 ->
+ Rest;
+ true ->
+ SP = mk_sp(),
+ hipe_arm:mk_addi(SP, SP, N, Rest)
+ end.
+
+%%%
+%%% Recursive calls.
+%%%
+
+do_pseudo_call_prepare(I, FPoff0) ->
+ %% Create outgoing arguments area on the stack.
+ NrStkArgs = hipe_arm:pseudo_call_prepare_nrstkargs(I),
+ Offset = NrStkArgs * word_size(),
+ {adjust_sp(-Offset, []), FPoff0 + Offset}.
+
+do_pseudo_call(I, LiveOut, Context, FPoff0) ->
+ #arm_sdesc{exnlab=ExnLab,arity=OrigArity} = hipe_arm:pseudo_call_sdesc(I),
+ FunV = hipe_arm:pseudo_call_funv(I),
+ LiveTemps = [Temp || Temp <- LiveOut, temp_is_pseudo(Temp)],
+ SDesc = mk_sdesc(ExnLab, Context, LiveTemps),
+ ContLab = hipe_arm:pseudo_call_contlab(I),
+ Linkage = hipe_arm:pseudo_call_linkage(I),
+ CallCode = [hipe_arm:mk_pseudo_call(FunV, SDesc, ContLab, Linkage)],
+ StkArity = erlang:max(0, OrigArity - hipe_arm_registers:nr_args()),
+ context_need_stack(Context, stack_need(FPoff0, StkArity, FunV)),
+ ArgsBytes = word_size() * StkArity,
+ {CallCode, FPoff0 - ArgsBytes}.
+
+stack_need(FPoff, StkArity, FunV) ->
+ case FunV of
+ #arm_prim{} -> FPoff;
+ #arm_mfa{m=M,f=F,a=A} ->
+ case erlang:is_builtin(M, F, A) of
+ true -> FPoff;
+ false -> stack_need_general(FPoff, StkArity)
+ end;
+ _ -> stack_need_general(FPoff, StkArity)
+ end.
+
+stack_need_general(FPoff, StkArity) ->
+ erlang:max(FPoff, FPoff + (?ARM_LEAF_WORDS - StkArity) * word_size()).
+
+%%%
+%%% Create stack descriptors for call sites.
+%%%
+
+mk_sdesc(ExnLab, Context, Temps) -> % for normal calls
+ Temps0 = only_tagged(Temps),
+ Live = mk_live(Context, Temps0),
+ Arity = context_arity(Context),
+ FSize = context_framesize(Context),
+ hipe_arm:mk_sdesc(ExnLab, (FSize div word_size())-1, Arity,
+ list_to_tuple(Live)).
+
+only_tagged(Temps)->
+ [X || X <- Temps, hipe_arm:temp_type(X) =:= 'tagged'].
+
+mk_live(Context, Temps) ->
+ lists:sort([temp_to_slot(Context, Temp) || Temp <- Temps]).
+
+temp_to_slot(Context, Temp) ->
+ (context_framesize(Context) + context_offset(Context, Temp))
+ div word_size().
+
+mk_minimal_sdesc(Context) -> % for inc_stack_0 calls
+ hipe_arm:mk_sdesc([], 0, context_arity(Context), {}).
+
+%%%
+%%% Tailcalls.
+%%%
+
+do_pseudo_tailcall(I, Context) -> % always at FPoff=context_framesize(Context)
+ Arity = context_arity(Context),
+ Args = hipe_arm:pseudo_tailcall_stkargs(I),
+ FunV = hipe_arm:pseudo_tailcall_funv(I),
+ Linkage = hipe_arm:pseudo_tailcall_linkage(I),
+ {Insns, FPoff1} = do_tailcall_args(Args, Context),
+ context_need_stack(Context, FPoff1),
+ StkArity = length(Args),
+ FPoff2 = FPoff1 + (Arity - StkArity) * word_size(),
+ context_need_stack(Context, stack_need(FPoff2, StkArity, FunV)),
+ I2 =
+ case FunV of
+ #arm_temp{} ->
+ hipe_arm:mk_bx(FunV);
+ Fun ->
+ hipe_arm:mk_b_fun(Fun, Linkage)
+ end,
+ %% XXX: break out the LR restore, just like for pseudo_blr?
+ restore_lr(context_framesize(Context), Context,
+ Insns ++ adjust_sp(FPoff2, [I2])).
+
+do_tailcall_args(Args, Context) ->
+ FPoff0 = context_framesize(Context),
+ Arity = context_arity(Context),
+ FrameTop = word_size()*Arity,
+ DangerOff = FrameTop - word_size()*length(Args),
+ %%
+ Moves = mk_moves(Args, FrameTop, []),
+ %%
+ {Stores, Simple, Conflict} =
+ split_moves(Moves, Context, DangerOff, [], [], []),
+ %% sanity check (shouldn't trigger any more)
+ if DangerOff < -FPoff0 ->
+ exit({?MODULE,do_tailcall_args,DangerOff,-FPoff0});
+ true -> []
+ end,
+ FPoff1 = FPoff0,
+ %%
+ {Pushes, Pops, FPoff2} = split_conflict(Conflict, FPoff1, [], []),
+ %%
+ TempReg = hipe_arm_registers:temp1(),
+ %%
+ {adjust_sp(-(FPoff2 - FPoff1),
+ simple_moves(Pushes, FPoff2, TempReg,
+ store_moves(Stores, FPoff2, TempReg,
+ simple_moves(Simple, FPoff2, TempReg,
+ simple_moves(Pops, FPoff2, TempReg,
+ []))))),
+ FPoff2}.
+
+mk_moves([Arg|Args], Off, Moves) ->
+ Off1 = Off - word_size(),
+ mk_moves(Args, Off1, [{Arg,Off1}|Moves]);
+mk_moves([], _, Moves) ->
+ Moves.
+
+split_moves([Move|Moves], Context, DangerOff, Stores, Simple, Conflict) ->
+ {Src,DstOff} = Move,
+ case src_is_pseudo(Src) of
+ false ->
+ split_moves(Moves, Context, DangerOff, [Move|Stores],
+ Simple, Conflict);
+ true ->
+ SrcOff = context_offset(Context, Src),
+ Type = typeof_temp(Src),
+ if SrcOff =:= DstOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, Conflict);
+ SrcOff >= DangerOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, [{SrcOff,DstOff,Type}|Conflict]);
+ true ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ [{SrcOff,DstOff,Type}|Simple], Conflict)
+ end
+ end;
+split_moves([], _, _, Stores, Simple, Conflict) ->
+ {Stores, Simple, Conflict}.
+
+split_conflict([{SrcOff,DstOff,Type}|Conflict], FPoff, Pushes, Pops) ->
+ FPoff1 = FPoff + word_size(),
+ Push = {SrcOff,-FPoff1,Type},
+ Pop = {-FPoff1,DstOff,Type},
+ split_conflict(Conflict, FPoff1, [Push|Pushes], [Pop|Pops]);
+split_conflict([], FPoff, Pushes, Pops) ->
+ {lists:reverse(Pushes), Pops, FPoff}.
+
+simple_moves([{SrcOff,DstOff,Type}|Moves], FPoff, TempReg, Rest) ->
+ Temp = hipe_arm:mk_temp(TempReg, Type),
+ SP = mk_sp(),
+ LoadOff = FPoff+SrcOff,
+ StoreOff = FPoff+DstOff,
+ simple_moves(Moves, FPoff, TempReg,
+ mk_load('ldr', Temp, LoadOff, SP,
+ mk_store('str', Temp, StoreOff, SP,
+ Rest)));
+simple_moves([], _, _, Rest) ->
+ Rest.
+
+store_moves([{Src,DstOff}|Moves], FPoff, TempReg, Rest) ->
+ %%Type = typeof_temp(Src),
+ SP = mk_sp(),
+ StoreOff = FPoff+DstOff,
+ {NewSrc,FixSrc} =
+ case hipe_arm:is_temp(Src) of
+ true ->
+ {Src, []};
+ _ ->
+ Temp = hipe_arm:mk_temp(TempReg, 'untagged'),
+ {Temp, hipe_arm:mk_li(Temp, Src)}
+ end,
+ store_moves(Moves, FPoff, TempReg,
+ FixSrc ++ mk_store('str', NewSrc, StoreOff, SP, Rest));
+store_moves([], _, _, Rest) ->
+ Rest.
+
+%%%
+%%% Contexts
+%%%
+
+-record(context, {liveness, framesize, arity, map, clobbers_lr, ref_maxstack}).
+
+mk_context(Liveness, Formals, Temps, ClobbersLR) ->
+ {Map, MinOff} = mk_temp_map(Formals, ClobbersLR, Temps),
+ FrameSize = (-MinOff),
+ RefMaxStack = hipe_bifs:ref(FrameSize),
+ #context{liveness=Liveness,
+ framesize=FrameSize, arity=length(Formals),
+ map=Map, clobbers_lr=ClobbersLR, ref_maxstack=RefMaxStack}.
+
+context_need_stack(#context{ref_maxstack=RM}, N) ->
+ M = hipe_bifs:ref_get(RM),
+ if N > M -> hipe_bifs:ref_set(RM, N);
+ true -> []
+ end.
+
+context_maxstack(#context{ref_maxstack=RM}) ->
+ hipe_bifs:ref_get(RM).
+
+context_arity(#context{arity=Arity}) ->
+ Arity.
+
+context_framesize(#context{framesize=FrameSize}) ->
+ FrameSize.
+
+context_liveness(#context{liveness=Liveness}) ->
+ Liveness.
+
+context_offset(#context{map=Map}, Temp) ->
+ tmap_lookup(Map, Temp).
+
+context_clobbers_lr(#context{clobbers_lr=ClobbersLR}) -> ClobbersLR.
+
+mk_temp_map(Formals, ClobbersLR, Temps) ->
+ {Map, 0} = enter_vars(Formals, word_size() * length(Formals),
+ tmap_empty()),
+ TempsList = tset_to_list(Temps),
+ AllTemps =
+ case ClobbersLR of
+ false -> TempsList;
+ true ->
+ RA = hipe_arm:mk_new_temp('untagged'),
+ [RA|TempsList]
+ end,
+ enter_vars(AllTemps, 0, Map).
+
+enter_vars([V|Vs], PrevOff, Map) ->
+ Off =
+ case hipe_arm:temp_type(V) of
+ 'double' -> PrevOff - 2*word_size();
+ _ -> PrevOff - word_size()
+ end,
+ enter_vars(Vs, Off, tmap_bind(Map, V, Off));
+enter_vars([], Off, Map) ->
+ {Map, Off}.
+
+tmap_empty() ->
+ gb_trees:empty().
+
+tmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+tmap_lookup(Map, Key) ->
+ gb_trees:get(Key, Map).
+
+%%%
+%%% do_prologue: prepend stack frame allocation code.
+%%%
+%%% NewStart:
+%%% temp1 = *(P + P_SP_LIMIT)
+%%% temp2 = SP - MaxStack
+%%% cmp temp2, temp1
+%%% if (ltu) goto IncStack else goto AllocFrame
+%%% AllocFrame:
+%%% SP = temp2 [if FrameSize == MaxStack]
+%%% SP -= FrameSize [if FrameSize != MaxStack]
+%%% *(SP + FrameSize-WordSize) = LR [if ClobbersLR]
+%%% goto OldStart
+%%% OldStart:
+%%% ...
+%%% IncStack:
+%%% temp1 = LR
+%%% bl inc_stack
+%%% LR = temp1
+%%% goto NewStart
+
+do_prologue(CFG, Context) ->
+ MaxStack = context_maxstack(Context),
+ if MaxStack > 0 ->
+ FrameSize = context_framesize(Context),
+ OldStartLab = hipe_arm_cfg:start_label(CFG),
+ NewStartLab = hipe_gensym:get_next_label(arm),
+ %%
+ P = hipe_arm:mk_temp(hipe_arm_registers:proc_pointer(), 'untagged'),
+ Temp1 = mk_temp1(),
+ SP = mk_sp(),
+ %%
+ LR = hipe_arm:mk_lr(),
+ ClobbersLR = context_clobbers_lr(Context),
+ GotoOldStartCode = [hipe_arm:mk_b_label(OldStartLab)],
+ AllocFrameCodeTail =
+ case ClobbersLR of
+ false -> GotoOldStartCode;
+ true -> mk_store('str', LR, FrameSize-word_size(), SP, GotoOldStartCode)
+ end,
+ %%
+ Arity = context_arity(Context),
+ Guaranteed = erlang:max(0, (?ARM_LEAF_WORDS - Arity) * word_size()),
+ %%
+ {CFG1,NewStartCode} =
+ if MaxStack =< Guaranteed ->
+ %% io:format("~w: MaxStack ~w =< Guaranteed ~w :-)\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameCode = adjust_sp(-FrameSize, AllocFrameCodeTail),
+ NewStartCode0 = AllocFrameCode, % no mflr needed
+ {CFG,NewStartCode0};
+ true ->
+ %% io:format("~w: MaxStack ~w > Guaranteed ~w :-(\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameLab = hipe_gensym:get_next_label(arm),
+ IncStackLab = hipe_gensym:get_next_label(arm),
+ Temp2 = mk_temp2(),
+ %%
+ NewStartCodeTail2 =
+ [hipe_arm:mk_pseudo_bc('lo', IncStackLab, AllocFrameLab, 0.01)],
+ NewStartCodeTail1 = NewStartCodeTail2, % no mflr needed
+ NewStartCode0 =
+ mk_load('ldr', Temp1, ?P_NSP_LIMIT, P,
+ hipe_arm:mk_addi(Temp2, SP, -MaxStack,
+ [hipe_arm:mk_cmp('cmp', Temp2, Temp1) |
+ NewStartCodeTail1])),
+ %%
+ AllocFrameCode =
+ if MaxStack =:= FrameSize ->
+ %% io:format("~w: MaxStack =:= FrameSize =:= ~w :-)\n", [?MODULE,MaxStack]),
+ [hipe_arm:mk_move(SP, Temp2) |
+ AllocFrameCodeTail];
+ true ->
+ %% io:format("~w: MaxStack ~w =/= FrameSize ~w :-(\n", [?MODULE,MaxStack,FrameSize]),
+ adjust_sp(-FrameSize, AllocFrameCodeTail)
+ end,
+ %%
+ IncStackCodeTail =
+ [hipe_arm:mk_bl(hipe_arm:mk_prim('inc_stack_0'),
+ mk_minimal_sdesc(Context), not_remote),
+ hipe_arm:mk_mtlr(Temp1),
+ hipe_arm:mk_b_label(NewStartLab)],
+ IncStackCode =
+ [hipe_arm:mk_mflr(Temp1) | IncStackCodeTail], % mflr always needed
+ %%
+ CFG0a = hipe_arm_cfg:bb_add(CFG, AllocFrameLab,
+ hipe_bb:mk_bb(AllocFrameCode)),
+ CFG0b = hipe_arm_cfg:bb_add(CFG0a, IncStackLab,
+ hipe_bb:mk_bb(IncStackCode)),
+ %%
+ {CFG0b,NewStartCode0}
+ end,
+ %%
+ CFG2 = hipe_arm_cfg:bb_add(CFG1, NewStartLab,
+ hipe_bb:mk_bb(NewStartCode)),
+ hipe_arm_cfg:start_label_update(CFG2, NewStartLab);
+ true ->
+ CFG
+ end.
+
+%%% Create a load instruction.
+%%% May clobber Dst early for large offsets. In principle we could
+%%% clobber TEMP2 if Dst =:= Base, but Dst =/= Base here in frame.
+
+mk_load(LdOp, Dst, Offset, Base, Rest) ->
+ hipe_arm:mk_load(LdOp, Dst, Base, Offset, 'error', Rest).
+
+%%% Create a store instruction.
+%%% May clobber TEMP2 for large offsets.
+
+mk_store(StOp, Src, Offset, Base, Rest) ->
+ hipe_arm:mk_store(StOp, Src, Base, Offset, 'temp2', Rest).
+
+%%% typeof_temp -- what's temp's type?
+
+typeof_temp(Temp) ->
+ hipe_arm:temp_type(Temp).
+
+%%% Cons up an 'SP' Temp.
+
+mk_sp() ->
+ hipe_arm:mk_temp(hipe_arm_registers:stack_pointer(), 'untagged').
+
+%%% Cons up a 'TEMP1' Temp.
+
+mk_temp1() ->
+ hipe_arm:mk_temp(hipe_arm_registers:temp1(), 'untagged').
+
+%%% Cons up a 'TEMP2' Temp.
+
+mk_temp2() ->
+ hipe_arm:mk_temp(hipe_arm_registers:temp2(), 'untagged').
+
+%%% Check if an operand is a pseudo-Temp.
+
+src_is_pseudo(Src) ->
+ hipe_arm:is_temp(Src) andalso temp_is_pseudo(Src).
+
+temp_is_pseudo(Temp) ->
+ not(hipe_arm:temp_is_precoloured(Temp)).
+
+%%%
+%%% Detect if a Defun's body clobbers LR.
+%%%
+
+clobbers_lr(Insns) ->
+ LRreg = hipe_arm_registers:lr(),
+ LRtagged = hipe_arm:mk_temp(LRreg, 'tagged'),
+ LRuntagged = hipe_arm:mk_temp(LRreg, 'untagged'),
+ clobbers_lr(Insns, LRtagged, LRuntagged).
+
+clobbers_lr([I|Insns], LRtagged, LRuntagged) ->
+ Defs = hipe_arm_defuse:insn_def_gpr(I),
+ case lists:member(LRtagged, Defs) of
+ true -> true;
+ false ->
+ case lists:member(LRuntagged, Defs) of
+ true -> true;
+ false -> clobbers_lr(Insns, LRtagged, LRuntagged)
+ end
+ end;
+clobbers_lr([], _LRtagged, _LRuntagged) -> false.
+
+%%%
+%%% Build the set of all temps used in a Defun's body.
+%%%
+
+all_temps(Code, Formals) ->
+ S0 = find_temps(Code, tset_empty()),
+ S1 = tset_del_list(S0, Formals),
+ tset_filter(S1, fun(T) -> temp_is_pseudo(T) end).
+
+find_temps([I|Insns], S0) ->
+ S1 = tset_add_list(S0, hipe_arm_defuse:insn_def_all(I)),
+ S2 = tset_add_list(S1, hipe_arm_defuse:insn_use_all(I)),
+ find_temps(Insns, S2);
+find_temps([], S) ->
+ S.
+
+tset_empty() ->
+ gb_sets:new().
+
+tset_size(S) ->
+ gb_sets:size(S).
+
+tset_insert(S, T) ->
+ gb_sets:add_element(T, S).
+
+tset_add_list(S, Ts) ->
+ gb_sets:union(S, gb_sets:from_list(Ts)).
+
+tset_del_list(S, Ts) ->
+ gb_sets:subtract(S, gb_sets:from_list(Ts)).
+
+tset_filter(S, F) ->
+ gb_sets:filter(F, S).
+
+tset_to_list(S) ->
+ gb_sets:to_list(S).
+
+%%%
+%%% Compute minimum permissible frame size, ignoring spilled temps.
+%%% This is done to ensure that we won't have to adjust the frame size
+%%% in the middle of a tailcall.
+%%%
+
+defun_minframe(Defun) ->
+ MaxTailArity = body_mta(hipe_arm:defun_code(Defun), 0),
+ MyArity = length(fix_formals(hipe_arm:defun_formals(Defun))),
+ erlang:max(MaxTailArity - MyArity, 0).
+
+body_mta([I|Code], MTA) ->
+ body_mta(Code, insn_mta(I, MTA));
+body_mta([], MTA) ->
+ MTA.
+
+insn_mta(I, MTA) ->
+ case I of
+ #pseudo_tailcall{arity=Arity} ->
+ erlang:max(MTA, Arity - hipe_arm_registers:nr_args());
+ _ -> MTA
+ end.
+
+%%%
+%%% Ensure that we have enough temps to satisfy the minimum frame size,
+%%% if necessary by prepending unused dummy temps.
+%%%
+
+ensure_minframe(MinFrame, Temps) ->
+ ensure_minframe(MinFrame, tset_size(Temps), Temps).
+
+ensure_minframe(MinFrame, Frame, Temps) ->
+ if MinFrame > Frame ->
+ Temp = hipe_arm:mk_new_temp('untagged'),
+ ensure_minframe(MinFrame, Frame+1, tset_insert(Temps, Temp));
+ true -> Temps
+ end.
+
+word_size() ->
+ 4.
diff --git a/lib/hipe/arm/hipe_arm_liveness_gpr.erl b/lib/hipe/arm/hipe_arm_liveness_gpr.erl
new file mode 100644
index 0000000000..cab81c47a1
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_liveness_gpr.erl
@@ -0,0 +1,38 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_liveness_gpr).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_arm.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_arm_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_arm_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_arm_cfg:succ(CFG, L).
+uses(Insn) -> hipe_arm_defuse:insn_use_gpr(Insn).
+defines(Insn) -> hipe_arm_defuse:insn_def_gpr(Insn).
+liveout_no_succ() ->
+ ordsets:from_list(lists:map(fun({Reg,Type}) ->
+ hipe_arm:mk_temp(Reg, Type)
+ end,
+ hipe_arm_registers:live_at_return())).
diff --git a/lib/hipe/arm/hipe_arm_main.erl b/lib/hipe/arm/hipe_arm_main.erl
new file mode 100644
index 0000000000..5243b3579e
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_main.erl
@@ -0,0 +1,58 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_main).
+-export([rtl_to_arm/3]).
+
+rtl_to_arm(MFA, RTL, Options) ->
+ Defun1 = hipe_rtl_to_arm:translate(RTL),
+ %% io:format("~w: after translate\n", [?MODULE]),
+ %% hipe_arm_pp:pp(Defun1),
+ Defun2 = hipe_arm_ra:ra(Defun1, Options),
+ %% io:format("~w: after regalloc\n", [?MODULE]),
+ %% hipe_arm_pp:pp(Defun2),
+ Defun3 = hipe_arm_frame:frame(Defun2),
+ %% io:format("~w: after frame\n", [?MODULE]),
+ %% hipe_arm_pp:pp(Defun3),
+ Defun4 = hipe_arm_finalise:finalise(Defun3),
+ %% io:format("~w: after finalise\n", [?MODULE]),
+ pp(Defun4, MFA, Options),
+ {native, arm, {unprofiled, Defun4}}.
+
+pp(Defun, MFA, Options) ->
+ case proplists:get_value(pp_native, Options) of
+ true ->
+ hipe_arm_pp:pp(Defun);
+ {only,Lst} when is_list(Lst) ->
+ case lists:member(MFA,Lst) of
+ true ->
+ hipe_arm_pp:pp(Defun);
+ false ->
+ ok
+ end;
+ {only,MFA} ->
+ hipe_arm_pp:pp(Defun);
+ {file,FileName} ->
+ {ok, File} = file:open(FileName, [write,append]),
+ hipe_arm_pp:pp(File, Defun),
+ ok = file:close(File);
+ _ ->
+ ok
+ end.
diff --git a/lib/hipe/arm/hipe_arm_pp.erl b/lib/hipe/arm/hipe_arm_pp.erl
new file mode 100644
index 0000000000..7ce8421994
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_pp.erl
@@ -0,0 +1,351 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_pp).
+-export([pp/1, pp/2, pp_insn/1]).
+
+-include("hipe_arm.hrl").
+
+pp(Defun) ->
+ pp(standard_io, Defun).
+
+pp(Dev, #defun{mfa={M,F,A}, code=Code, data=Data}) ->
+ Fname = atom_to_list(M)++"_"++atom_to_list(F)++"_"++integer_to_list(A),
+ io:format(Dev, "\t.text\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ io:format(Dev, "\t.global ~s\n", [Fname]),
+ io:format(Dev, "~s:\n", [Fname]),
+ pp_insns(Dev, Code, Fname),
+ io:format(Dev, "\t.rodata\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ hipe_data_pp:pp(Dev, Data, arm, Fname),
+ io:format(Dev, "\n", []).
+
+pp_insns(Dev, [I|Is], Fname) ->
+ pp_insn(Dev, I, Fname),
+ pp_insns(Dev, Is, Fname);
+pp_insns(_, [], _) ->
+ [].
+
+pp_insn(I) ->
+ pp_insn(standard_io, I, "").
+
+pp_insn(Dev, I, Pre) ->
+ case I of
+ #alu{aluop=AluOp, s=S, dst=Dst, src=Src, am1=Am1} ->
+ io:format(Dev, "\t~s~s ", [alu_op_name(AluOp), s_name(S)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_am1(Dev, Am1),
+ io:format(Dev, "\n", []);
+ #b_fun{'fun'=Fun, linkage=Linkage} ->
+ io:format(Dev, "\tb ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " # ~w\n", [Linkage]);
+ #b_label{'cond'=Cond, label=Label} ->
+ io:format(Dev, "\tb~s .~s_~w\n", [cond_name(Cond), Pre, Label]);
+ #bl{'fun'=Fun, sdesc=SDesc, linkage=Linkage} ->
+ io:format(Dev, "\tbl ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " #", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #blx{src=Src, sdesc=SDesc} ->
+ io:format(Dev, "\tblx ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, " # ", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, "\n", []);
+ #cmp{cmpop=CmpOp, src=Src, am1=Am1} ->
+ io:format(Dev, "\t~s ", [cmp_op_name(CmpOp)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_am1(Dev, Am1),
+ io:format(Dev, "\n", []);
+ #comment{term=Term} ->
+ io:format(Dev, "\t# ~p\n", [Term]);
+ #label{label=Label} ->
+ io:format(Dev, ".~s_~w:~n", [Pre, Label]);
+ #load{ldop=LdOp, dst=Dst, am2=Am2} ->
+ io:format(Dev, "\t~w ", [ldop_name(LdOp)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_am2(Dev, Am2),
+ io:format(Dev, "\n", []);
+ #ldrsb{dst=Dst, am3=Am3} ->
+ io:format(Dev, "\tldrsb ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_am3(Dev, Am3),
+ io:format(Dev, "\n", []);
+ #move{movop=MovOp, s=S, dst=Dst, am1=Am1} ->
+ io:format(Dev, "\t~s~s ", [mov_op_name(MovOp), s_name(S)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_am1(Dev, Am1),
+ io:format(Dev, "\n", []);
+ #pseudo_bc{'cond'=Cond, true_label=TrueLab, false_label=FalseLab, pred=Pred} ->
+ io:format(Dev, "\tpseudo_bc ~w, .~s_~w # .~s_~w ~.2f\n",
+ [cond_name(Cond), Pre, TrueLab, Pre, FalseLab, Pred]);
+ #pseudo_blr{} ->
+ io:format(Dev, "\tpseudo_blr\n", []);
+ #pseudo_bx{src=Src} ->
+ io:format(Dev, "\tpseudo_bx ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #pseudo_call{funv=FunV, sdesc=SDesc, contlab=ContLab, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_call ", []),
+ pp_funv(Dev, FunV),
+ io:format(Dev, " # contlab .~s_~w", [Pre, ContLab]),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #pseudo_call_prepare{nrstkargs=NrStkArgs} ->
+ SP = hipe_arm_registers:reg_name_gpr(hipe_arm_registers:stack_pointer()),
+ io:format(Dev, "\tsub ~s, ~s, ~w # pseudo_call_prepare\n",
+ [SP, SP, (4*NrStkArgs)]);
+ #pseudo_li{dst=Dst, imm=Imm} ->
+ io:format(Dev, "\tpseudo_li ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_imm(Dev, Imm),
+ io:format(Dev, "\n", []);
+ #pseudo_move{dst=Dst, src=Src} ->
+ io:format(Dev, "\tpseudo_move ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #pseudo_switch{jtab=JTab, index=Index, labels=Labels} ->
+ io:format(Dev, "\tpseudo_switch ", []),
+ pp_temp(Dev, JTab),
+ io:format(Dev, "[", []),
+ pp_temp(Dev, Index),
+ io:format(Dev, "]", []),
+ case Labels of
+ [] -> [];
+ _ ->
+ io:format(Dev, " #", []),
+ pp_labels(Dev, Labels, Pre)
+ end,
+ io:format(Dev, "\n", []);
+ #pseudo_tailcall{funv=FunV, arity=Arity, stkargs=StkArgs, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_tailcall ", []),
+ pp_funv(Dev, FunV),
+ io:format(Dev, "/~w (", [Arity]),
+ pp_args(Dev, StkArgs),
+ io:format(Dev, ") ~w\n", [Linkage]);
+ #pseudo_tailcall_prepare{} ->
+ io:format(Dev, "\tpseudo_tailcall_prepare\n", []);
+ #smull{dstlo=DstLo, dsthi=DstHi, src1=Src1, src2=Src2} ->
+ io:format(Dev, "\tsmull ", []),
+ pp_temp(Dev, DstLo),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, DstHi),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src2),
+ io:format(Dev, "\n", []);
+ #store{stop=StOp, src=Src, am2=Am2} ->
+ io:format(Dev, "\tstr~s ", [stop_suffix(StOp)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_am2(Dev, Am2),
+ io:format(Dev, "\n", []);
+ _ ->
+ exit({?MODULE, pp_insn, I})
+ end.
+
+to_hex(N) ->
+ io_lib:format("~.16x", [N, "0x"]).
+
+pp_sdesc(Dev, Pre, #arm_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live}) ->
+ pp_sdesc_exnlab(Dev, Pre, ExnLab),
+ io:format(Dev, " ~s ~w [", [to_hex(FSize), Arity]),
+ pp_sdesc_live(Dev, Live),
+ io:format(Dev, "]", []).
+
+pp_sdesc_exnlab(Dev, _, []) -> io:format(Dev, " []", []);
+pp_sdesc_exnlab(Dev, Pre, ExnLab) -> io:format(Dev, " .~s_~w", [Pre, ExnLab]).
+
+pp_sdesc_live(_, {}) -> [];
+pp_sdesc_live(Dev, Live) -> pp_sdesc_live(Dev, Live, 1).
+
+pp_sdesc_live(Dev, Live, I) ->
+ io:format(Dev, "~s", [to_hex(element(I, Live))]),
+ if I < tuple_size(Live) ->
+ io:format(Dev, ",", []),
+ pp_sdesc_live(Dev, Live, I+1);
+ true -> []
+ end.
+
+pp_labels(Dev, [Label|Labels], Pre) ->
+ io:format(Dev, " .~s_~w", [Pre, Label]),
+ pp_labels(Dev, Labels, Pre);
+pp_labels(_, [], _) ->
+ [].
+
+pp_fun(Dev, Fun) ->
+ case Fun of
+ #arm_mfa{m=M, f=F, a=A} ->
+ io:format(Dev, "~w:~w/~w", [M, F, A]);
+ #arm_prim{prim=Prim} ->
+ io:format(Dev, "~w", [Prim])
+ end.
+
+pp_funv(Dev, FunV) ->
+ case FunV of
+ #arm_temp{} ->
+ pp_temp(Dev, FunV);
+ Fun ->
+ pp_fun(Dev, Fun)
+ end.
+
+alu_op_name(Op) -> Op.
+
+cond_name(Cond) ->
+ case Cond of
+ 'al' -> "";
+ _ -> Cond
+ end.
+
+s_name(S) ->
+ case S of
+ true -> "s";
+ false -> ""
+ end.
+
+cmp_op_name(Op) -> Op.
+
+mov_op_name(Op) -> Op.
+
+ldop_name(LdOp) -> LdOp.
+
+stop_suffix(StOp) ->
+ case StOp of
+ 'str' -> "";
+ 'strb' -> "b"
+ end.
+
+pp_temp(Dev, Temp=#arm_temp{reg=Reg, type=Type}) ->
+ case hipe_arm:temp_is_precoloured(Temp) of
+ true ->
+ Name =
+%%% case Type of
+%%% 'double' ->
+%%% hipe_arm_registers:reg_name_fpr(Reg);
+%%% _ ->
+ hipe_arm_registers:reg_name_gpr(Reg)
+%%% end
+ ,
+ io:format(Dev, "~s", [Name]);
+ false ->
+ Tag =
+ case Type of
+%%% double -> "f";
+ tagged -> "t";
+ untagged -> "u"
+ end,
+ io:format(Dev, "~s~w", [Tag, Reg])
+ end.
+
+pp_hex(Dev, Value) -> io:format(Dev, "~s", [to_hex(Value)]).
+
+pp_imm(Dev, Value) ->
+ if is_integer(Value) -> pp_hex(Dev, Value);
+ true -> io:format(Dev, "~w", [Value])
+ end.
+
+pp_am1(Dev, Am1) ->
+ case Am1 of
+ #arm_temp{} ->
+ pp_temp(Dev, Am1);
+ {Src,rrx} ->
+ pp_temp(Dev, Src),
+ io:format(Dev, ", rrx", []);
+ {Src,ShiftOp,ShiftArg} ->
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ~w ", [ShiftOp]),
+ case ShiftArg of
+ #arm_temp{} ->
+ pp_temp(Dev, ShiftArg);
+ Imm5 ->
+ io:format(Dev, "#~w", [Imm5])
+ end;
+ {Imm8,Imm4} ->
+ io:format(Dev, "#~w, 2*~w", [Imm8,Imm4])
+ end.
+
+pp_am2(Dev, #am2{src=Src,sign=Sign,offset=Am2Offset}) ->
+ io:format(Dev, "[", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ",~s", [sign_name(Sign)]),
+ case Am2Offset of
+ #arm_temp{} ->
+ pp_temp(Dev, Am2Offset);
+ {Src2,rrx} ->
+ pp_temp(Dev, Src2),
+ io:format(Dev, ", rrx", []);
+ {Src2,ShiftOp,Imm5} ->
+ pp_temp(Dev, Src2),
+ io:format(Dev, ",~w #~w", [ShiftOp,Imm5]);
+ Imm12 ->
+ io:format(Dev, "#~w", [Imm12])
+ end,
+ io:format(Dev, "]", []).
+
+pp_am3(Dev, #am3{src=Src,sign=Sign,offset=Am3Offset}) ->
+ io:format(Dev, "[", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ",~s", [sign_name(Sign)]),
+ case Am3Offset of
+ #arm_temp{} -> pp_temp(Dev, Am3Offset);
+ Imm8 -> io:format(Dev, "~w", [Imm8])
+ end,
+ io:format(Dev, "]", []).
+
+sign_name(Sign) ->
+ case Sign of
+ '+' -> "";
+ '-' -> "-"
+ end.
+
+pp_arg(Dev, Arg) ->
+ case Arg of
+ #arm_temp{} ->
+ pp_temp(Dev, Arg);
+ _ ->
+ pp_hex(Dev, Arg)
+ end.
+
+pp_args(Dev, [A|As]) ->
+ pp_arg(Dev, A),
+ pp_comma_args(Dev, As);
+pp_args(_, []) ->
+ [].
+
+pp_comma_args(Dev, [A|As]) ->
+ io:format(Dev, ", ", []),
+ pp_arg(Dev, A),
+ pp_comma_args(Dev, As);
+pp_comma_args(_, []) ->
+ [].
diff --git a/lib/hipe/arm/hipe_arm_ra.erl b/lib/hipe/arm/hipe_arm_ra.erl
new file mode 100644
index 0000000000..bdd9e228e0
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_ra.erl
@@ -0,0 +1,56 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_ra).
+-export([ra/2]).
+
+ra(Defun0, Options) ->
+ %% hipe_arm_pp:pp(Defun0),
+ {Defun1, Coloring_fp, SpillIndex}
+ = case proplists:get_bool(inline_fp, Options) of
+%% true ->
+%% hipe_regalloc_loop:ra_fp(Defun0, Options,
+%% hipe_coalescing_regalloc,
+%% hipe_arm_specific_fp);
+ false ->
+ {Defun0,[],0}
+ end,
+ %% hipe_arm_pp:pp(Defun1),
+ {Defun2, Coloring}
+ = case proplists:get_value(regalloc, Options, coalescing) of
+ coalescing ->
+ ra(Defun1, SpillIndex, Options, hipe_coalescing_regalloc);
+ optimistic ->
+ ra(Defun1, SpillIndex, Options, hipe_optimistic_regalloc);
+ graph_color ->
+ ra(Defun1, SpillIndex, Options, hipe_graph_coloring_regalloc);
+ linear_scan ->
+ hipe_arm_ra_ls:ra(Defun1, SpillIndex, Options);
+ naive ->
+ hipe_arm_ra_naive:ra(Defun1, Coloring_fp, Options);
+ _ ->
+ exit({unknown_regalloc_compiler_option,
+ proplists:get_value(regalloc,Options)})
+ end,
+ %% hipe_arm_pp:pp(Defun2),
+ hipe_arm_ra_finalise:finalise(Defun2, Coloring, Coloring_fp).
+
+ra(Defun, SpillIndex, Options, RegAllocMod) ->
+ hipe_regalloc_loop:ra(Defun, SpillIndex, Options, RegAllocMod, hipe_arm_specific).
diff --git a/lib/hipe/arm/hipe_arm_ra_finalise.erl b/lib/hipe/arm/hipe_arm_ra_finalise.erl
new file mode 100644
index 0000000000..9edc362e90
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_ra_finalise.erl
@@ -0,0 +1,285 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_ra_finalise).
+-export([finalise/3]).
+-include("hipe_arm.hrl").
+
+finalise(Defun, TempMap, _FPMap0=[]) ->
+ Code = hipe_arm:defun_code(Defun),
+ {_, SpillLimit} = hipe_arm:defun_var_range(Defun),
+ Map = mk_ra_map(TempMap, SpillLimit),
+ NewCode = ra_code(Code, Map, []),
+ Defun#defun{code=NewCode}.
+
+ra_code([I|Insns], Map, Accum) ->
+ ra_code(Insns, Map, [ra_insn(I, Map) | Accum]);
+ra_code([], _Map, Accum) ->
+ lists:reverse(Accum).
+
+ra_insn(I, Map) ->
+ case I of
+ #alu{} -> ra_alu(I, Map);
+ #cmp{} -> ra_cmp(I, Map);
+ #load{} -> ra_load(I, Map);
+ #ldrsb{} -> ra_ldrsb(I, Map);
+ #move{} -> ra_move(I, Map);
+ #pseudo_call{} -> ra_pseudo_call(I, Map);
+ #pseudo_li{} -> ra_pseudo_li(I, Map);
+ #pseudo_move{} -> ra_pseudo_move(I, Map);
+ #pseudo_switch{} -> ra_pseudo_switch(I, Map);
+ #pseudo_tailcall{} -> ra_pseudo_tailcall(I, Map);
+ #smull{} -> ra_smull(I, Map);
+ #store{} -> ra_store(I, Map);
+ _ -> I
+ end.
+
+ra_alu(I=#alu{dst=Dst,src=Src,am1=Am1}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewSrc = ra_temp(Src, Map),
+ NewAm1 = ra_am1(Am1, Map),
+ I#alu{dst=NewDst,src=NewSrc,am1=NewAm1}.
+
+ra_cmp(I=#cmp{src=Src,am1=Am1}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewAm1 = ra_am1(Am1, Map),
+ I#cmp{src=NewSrc,am1=NewAm1}.
+
+ra_load(I=#load{dst=Dst,am2=Am2}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewAm2 = ra_am2(Am2, Map),
+ I#load{dst=NewDst,am2=NewAm2}.
+
+ra_ldrsb(I=#ldrsb{dst=Dst,am3=Am3}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewAm3 = ra_am3(Am3, Map),
+ I#ldrsb{dst=NewDst,am3=NewAm3}.
+
+ra_move(I=#move{dst=Dst,am1=Am1}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewAm1 = ra_am1(Am1, Map),
+ I#move{dst=NewDst,am1=NewAm1}.
+
+ra_pseudo_call(I=#pseudo_call{funv=FunV}, Map) ->
+ NewFunV = ra_funv(FunV, Map),
+ I#pseudo_call{funv=NewFunV}.
+
+ra_pseudo_li(I=#pseudo_li{dst=Dst}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ I#pseudo_li{dst=NewDst}.
+
+ra_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewSrc = ra_temp(Src, Map),
+ I#pseudo_move{dst=NewDst,src=NewSrc}.
+
+ra_pseudo_switch(I=#pseudo_switch{jtab=JTab,index=Index}, Map) ->
+ NewJTab = ra_temp(JTab, Map),
+ NewIndex = ra_temp(Index, Map),
+ I#pseudo_switch{jtab=NewJTab,index=NewIndex}.
+
+ra_pseudo_tailcall(I=#pseudo_tailcall{funv=FunV,stkargs=StkArgs}, Map) ->
+ NewFunV = ra_funv(FunV, Map),
+ NewStkArgs = ra_args(StkArgs, Map),
+ I#pseudo_tailcall{funv=NewFunV,stkargs=NewStkArgs}.
+
+ra_smull(I=#smull{dstlo=DstLo,dsthi=DstHi,src1=Src1,src2=Src2}, Map) ->
+ NewDstLo = ra_temp(DstLo, Map),
+ NewDstHi = ra_temp(DstHi, Map),
+ NewSrc1 = ra_temp(Src1, Map),
+ NewSrc2 = ra_temp(Src2, Map),
+ I#smull{dstlo=NewDstLo,dsthi=NewDstHi,src1=NewSrc1,src2=NewSrc2}.
+
+ra_store(I=#store{src=Src,am2=Am2}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewAm2 = ra_am2(Am2, Map),
+ I#store{src=NewSrc,am2=NewAm2}.
+
+%%% Tailcall stack arguments.
+
+ra_args([Arg|Args], Map) ->
+ [ra_temp_or_imm(Arg, Map) | ra_args(Args, Map)];
+ra_args([], _) ->
+ [].
+
+ra_temp_or_imm(Arg, Map) ->
+ case hipe_arm:is_temp(Arg) of
+ true ->
+ ra_temp(Arg, Map);
+ false ->
+ Arg
+ end.
+
+%%% FunV, Am, and Temp operands.
+
+ra_funv(FunV, Map) ->
+ case FunV of
+ #arm_temp{} -> ra_temp(FunV, Map);
+ _ -> FunV
+ end.
+
+ra_am1(Am1, Map) ->
+ case Am1 of
+ #arm_temp{} ->
+ ra_temp(Am1, Map);
+ {Src2,rrx} ->
+ NewSrc2 = ra_temp(Src2, Map),
+ {NewSrc2,rrx};
+ {Src2,ShiftOp,ShiftArg} ->
+ NewSrc2 = ra_temp(Src2, Map),
+ NewArg =
+ case ShiftArg of
+ #arm_temp{} -> ra_temp(ShiftArg, Map);
+ _ -> ShiftArg
+ end,
+ {NewSrc2,ShiftOp,NewArg};
+ _ ->
+ Am1
+ end.
+
+ra_am2(Am2=#am2{src=Src2,offset=Offset}, Map) ->
+ NewSrc2 = ra_temp(Src2, Map),
+ NewOffset = ra_am2offset(Offset, Map),
+ Am2#am2{src=NewSrc2,offset=NewOffset}.
+
+ra_am2offset(Offset, Map) ->
+ case Offset of
+ #arm_temp{} ->
+ ra_temp(Offset, Map);
+ {Src3,rrx} ->
+ NewSrc3 = ra_temp(Src3, Map),
+ {NewSrc3,rrx};
+ {Src3,ShiftOp,Imm5} ->
+ NewSrc3 = ra_temp(Src3, Map),
+ {NewSrc3,ShiftOp,Imm5};
+ _ ->
+ Offset
+ end.
+
+ra_am3(Am3=#am3{src=Src2,offset=Offset}, Map) ->
+ NewSrc2 = ra_temp(Src2, Map),
+ NewOffset = ra_am3offset(Offset, Map),
+ Am3#am3{src=NewSrc2,offset=NewOffset}.
+
+ra_am3offset(Offset, Map) ->
+ case Offset of
+ #arm_temp{} -> ra_temp(Offset, Map);
+ _ -> Offset
+ end.
+
+-ifdef(notdef). % for FP regalloc
+ra_temp_fp(Temp, FPMap) ->
+ Reg = hipe_arm:temp_reg(Temp),
+ case hipe_arm:temp_type(Temp) of
+ 'double' ->
+ case hipe_arm_registers:is_precoloured_fpr(Reg) of
+ true -> Temp;
+ _ -> ra_temp_common(Reg, Temp, FPMap)
+ end
+ end.
+-endif.
+
+ra_temp(Temp, Map) ->
+ Reg = hipe_arm:temp_reg(Temp),
+ case hipe_arm:temp_type(Temp) of
+ 'double' ->
+ exit({?MODULE,ra_temp,Temp});
+ _ ->
+ case hipe_arm_registers:is_precoloured_gpr(Reg) of
+ true -> Temp;
+ _ -> ra_temp_common(Reg, Temp, Map)
+ end
+ end.
+
+ra_temp_common(Reg, Temp, Map) ->
+ case gb_trees:lookup(Reg, Map) of
+ {value,NewReg} -> Temp#arm_temp{reg=NewReg};
+ _ -> Temp
+ end.
+
+mk_ra_map(TempMap, SpillLimit) ->
+ %% Build a partial map from pseudo to reg or spill.
+ %% Spills are represented as pseudos with indices above SpillLimit.
+ %% (I'd prefer to use negative indices, but that breaks
+ %% hipe_arm_registers:is_precoloured/1.)
+ %% The frame mapping proper is unchanged, since spills look just like
+ %% ordinary (un-allocated) pseudos.
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit, is_precoloured_gpr),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ TempMap).
+
+conv_ra_maplet(MapLet = {From,To}, SpillLimit, IsPrecoloured) ->
+ %% From should be a pseudo, or a hard reg mapped to itself.
+ if is_integer(From), From =< SpillLimit ->
+ case hipe_arm_registers:IsPrecoloured(From) of
+ false -> [];
+ _ ->
+ case To of
+ {reg, From} -> [];
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of From check
+ case To of
+ {reg, NewReg} ->
+ %% NewReg should be a hard reg, or a pseudo mapped
+ %% to itself (formals are handled this way).
+ if is_integer(NewReg) ->
+ case hipe_arm_registers:IsPrecoloured(NewReg) of
+ true -> [];
+ _ -> if From =:= NewReg -> [];
+ true ->
+ exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of NewReg check
+ {From, NewReg};
+ {spill, SpillIndex} ->
+ %% SpillIndex should be >= 0.
+ if is_integer(SpillIndex), SpillIndex >= 0 -> [];
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of SpillIndex check
+ ToTempNum = SpillLimit+SpillIndex+1,
+ MaxTempNum = hipe_gensym:get_var(arm),
+ if MaxTempNum >= ToTempNum -> ok;
+ true -> hipe_gensym:set_var(arm, ToTempNum)
+ end,
+ {From, ToTempNum};
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end.
+
+-ifdef(notdef). % for FP regalloc
+mk_ra_map_fp(FPMap, SpillLimit) ->
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit,
+ is_precoloured_fpr),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ FPMap).
+-endif.
diff --git a/lib/hipe/arm/hipe_arm_ra_ls.erl b/lib/hipe/arm/hipe_arm_ra_ls.erl
new file mode 100644
index 0000000000..53bfd5b2a3
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_ra_ls.erl
@@ -0,0 +1,56 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Linear Scan register allocator for ARM
+
+-module(hipe_arm_ra_ls).
+-export([ra/3]).
+
+ra(Defun, SpillIndex, Options) ->
+ NewDefun = Defun, %% hipe_${ARCH}_ra_rename:rename(Defun,Options),
+ CFG = hipe_arm_cfg:init(NewDefun),
+ SpillLimit = hipe_arm_specific:number_of_temporaries(CFG),
+ alloc(NewDefun, SpillIndex, SpillLimit, Options).
+
+alloc(Defun, SpillIndex, SpillLimit, Options) ->
+ CFG = hipe_arm_cfg:init(Defun),
+ {Coloring, _NewSpillIndex} =
+ regalloc(
+ CFG,
+ hipe_arm_registers:allocatable_gpr()--
+ [hipe_arm_registers:temp3(),
+ hipe_arm_registers:temp2(),
+ hipe_arm_registers:temp1()],
+ [hipe_arm_cfg:start_label(CFG)],
+ SpillIndex, SpillLimit, Options,
+ hipe_arm_specific),
+ {NewDefun, _DidSpill} =
+ hipe_arm_ra_postconditions:check_and_rewrite(
+ Defun, Coloring, 'linearscan'),
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_arm_specific),
+ {SpillMap, _NewSpillIndex2} =
+ hipe_spillmin:stackalloc(CFG, [], SpillIndex, Options,
+ hipe_arm_specific, TempMap),
+ Coloring2 =
+ hipe_spillmin:mapmerge(hipe_temp_map:to_substlist(TempMap), SpillMap),
+ {NewDefun, Coloring2}.
+
+regalloc(CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target) ->
+ hipe_ls_regalloc:regalloc(
+ CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target).
diff --git a/lib/hipe/arm/hipe_arm_ra_naive.erl b/lib/hipe/arm/hipe_arm_ra_naive.erl
new file mode 100644
index 0000000000..786895f2ca
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_ra_naive.erl
@@ -0,0 +1,29 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_ra_naive).
+-export([ra/3]).
+
+-include("hipe_arm.hrl").
+
+ra(Defun, _Coloring_fp, _Options) -> % -> {Defun, Coloring}
+ {NewDefun,_DidSpill} =
+ hipe_arm_ra_postconditions:check_and_rewrite2(Defun, [], 'naive'),
+ {NewDefun, []}.
diff --git a/lib/hipe/arm/hipe_arm_ra_postconditions.erl b/lib/hipe/arm/hipe_arm_ra_postconditions.erl
new file mode 100644
index 0000000000..96b0d5733f
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_ra_postconditions.erl
@@ -0,0 +1,278 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_ra_postconditions).
+
+-export([check_and_rewrite/3, check_and_rewrite2/3]).
+
+-include("hipe_arm.hrl").
+
+check_and_rewrite(Defun, Coloring, Allocator) ->
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_arm_specific),
+ check_and_rewrite2(Defun, TempMap, Allocator).
+
+check_and_rewrite2(Defun, TempMap, Allocator) ->
+ Strategy = strategy(Allocator),
+ #defun{code=Code0} = Defun,
+ {Code1,DidSpill} = do_insns(Code0, TempMap, Strategy, [], false),
+ VarRange = {0, hipe_gensym:get_var(arm)},
+ {Defun#defun{code=Code1, var_range=VarRange},
+ DidSpill}.
+
+strategy(Allocator) ->
+ case Allocator of
+ 'normal' -> 'new';
+ 'linearscan' -> 'fixed';
+ 'naive' -> 'fixed'
+ end.
+
+do_insns([I|Insns], TempMap, Strategy, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap, Strategy),
+ do_insns(Insns, TempMap, Strategy, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, _Strategy, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap, Strategy) ->
+ case I of
+ #alu{} -> do_alu(I, TempMap, Strategy);
+ #cmp{} -> do_cmp(I, TempMap, Strategy);
+ #load{} -> do_load(I, TempMap, Strategy);
+ #ldrsb{} -> do_ldrsb(I, TempMap, Strategy);
+ #move{} -> do_move(I, TempMap, Strategy);
+ #pseudo_call{} -> do_pseudo_call(I, TempMap, Strategy);
+ #pseudo_li{} -> do_pseudo_li(I, TempMap, Strategy);
+ #pseudo_move{} -> do_pseudo_move(I, TempMap, Strategy);
+ #pseudo_switch{} -> do_pseudo_switch(I, TempMap, Strategy);
+ #pseudo_tailcall{} -> do_pseudo_tailcall(I, TempMap, Strategy);
+ #smull{} -> do_smull(I, TempMap, Strategy);
+ #store{} -> do_store(I, TempMap, Strategy);
+ _ -> {[I], false}
+ end.
+
+%%% Fix relevant instruction types.
+
+do_alu(I=#alu{dst=Dst,src=Src,am1=Am1}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixSrc,NewSrc,DidSpill2} = fix_src1(Src, TempMap, Strategy),
+ {FixAm1,NewAm1,DidSpill3} = fix_am1(Am1, TempMap, Strategy),
+ NewI = I#alu{dst=NewDst,src=NewSrc,am1=NewAm1},
+ {FixSrc ++ FixAm1 ++ [NewI | FixDst], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_cmp(I=#cmp{src=Src,am1=Am1}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill1} = fix_src1(Src, TempMap, Strategy),
+ {FixAm1,NewAm1,DidSpill2} = fix_am1(Am1, TempMap, Strategy),
+ NewI = I#cmp{src=NewSrc,am1=NewAm1},
+ {FixSrc ++ FixAm1 ++ [NewI], DidSpill1 or DidSpill2}.
+
+do_load(I=#load{dst=Dst,am2=Am2}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixAm2,NewAm2,DidSpill2} = fix_am2(Am2, TempMap, Strategy),
+ NewI = I#load{dst=NewDst,am2=NewAm2},
+ {FixAm2 ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_ldrsb(I=#ldrsb{dst=Dst,am3=Am3}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixAm3,NewAm3,DidSpill2} = fix_am3(Am3, TempMap, Strategy),
+ NewI = I#ldrsb{dst=NewDst,am3=NewAm3},
+ {FixAm3 ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_move(I=#move{dst=Dst,am1=Am1}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixAm1,NewAm1,DidSpill2} = fix_am1(Am1, TempMap, Strategy),
+ NewI = I#move{dst=NewDst,am1=NewAm1},
+ {FixAm1 ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_pseudo_call(I=#pseudo_call{funv=FunV}, TempMap, Strategy) ->
+ {FixFunV,NewFunV,DidSpill} = fix_funv(FunV, TempMap, Strategy),
+ NewI = I#pseudo_call{funv=NewFunV},
+ {FixFunV ++ [NewI], DidSpill}.
+
+do_pseudo_li(I=#pseudo_li{dst=Dst}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap, Strategy),
+ NewI = I#pseudo_li{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, TempMap, Strategy) ->
+ %% Either Dst or Src (but not both) may be a pseudo temp.
+ %% pseudo_move and pseudo_tailcall are special cases: in
+ %% all other instructions, all temps must be non-pseudos
+ %% after register allocation.
+ case temp_is_spilled(Dst, TempMap) of
+ true -> % Src must not be a pseudo
+ {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#pseudo_move{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill};
+ _ ->
+ {[I], false}
+ end.
+
+do_pseudo_switch(I=#pseudo_switch{jtab=JTab,index=Index}, TempMap, Strategy) ->
+ {FixJTab,NewJTab,DidSpill1} = fix_src1(JTab, TempMap, Strategy),
+ {FixIndex,NewIndex,DidSpill2} = fix_src2(Index, TempMap, Strategy),
+ NewI = I#pseudo_switch{jtab=NewJTab,index=NewIndex},
+ {FixJTab ++ FixIndex ++ [NewI], DidSpill1 or DidSpill2}.
+
+do_pseudo_tailcall(I=#pseudo_tailcall{funv=FunV}, TempMap, Strategy) ->
+ {FixFunV,NewFunV,DidSpill} = fix_funv(FunV, TempMap, Strategy),
+ NewI = I#pseudo_tailcall{funv=NewFunV},
+ {FixFunV ++ [NewI], DidSpill}.
+
+do_smull(I=#smull{dstlo=DstLo,dsthi=DstHi,src1=Src1,src2=Src2}, TempMap, Strategy) ->
+ %% ARM requires that DstLo, DstHi, and Src1 are distinct.
+ %% We furthermore require Src1 and Src2 to be different in the fixed strategy.
+ {FixDstLo,NewDstLo,DidSpill1} = fix_dst(DstLo, TempMap, Strategy), % temp1
+ {FixDstHi,NewDstHi,DidSpill2} = fix_dst2(DstHi, TempMap, Strategy), % temp3
+ {FixSrc1,NewSrc1,DidSpill3} = fix_src2(Src1, TempMap, Strategy), % temp2
+ {FixSrc2,NewSrc2,DidSpill4} = fix_src1(Src2, TempMap, Strategy), % temp1; temp3 would be OK
+ NewI = I#smull{dstlo=NewDstLo,dsthi=NewDstHi,src1=NewSrc1,src2=NewSrc2},
+ {FixSrc1 ++ FixSrc2 ++ [NewI | FixDstLo ++ FixDstHi],
+ DidSpill1 or DidSpill2 or DidSpill3 or DidSpill4}.
+
+do_store(I=#store{src=Src,am2=Am2}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill1} = fix_src1(Src, TempMap, Strategy),
+ {FixAm2,NewAm2,DidSpill2} = fix_am2(Am2, TempMap, Strategy),
+ NewI = I#store{src=NewSrc,am2=NewAm2},
+ {FixSrc ++ FixAm2 ++ [NewI], DidSpill1 or DidSpill2}.
+
+%%% Fix Dst and Src operands.
+
+fix_funv(FunV, TempMap, Strategy) ->
+ case FunV of
+ #arm_temp{} -> fix_src3(FunV, TempMap, Strategy);
+ _ -> {[], FunV, false}
+ end.
+
+fix_am1(Am1, TempMap, Strategy) ->
+ case Am1 of
+ #arm_temp{} ->
+ fix_src2(Am1, TempMap, Strategy);
+ {Src2,rrx} ->
+ {Fix,New,DidSpill} = fix_src2(Src2, TempMap, Strategy),
+ {Fix, {New,rrx}, DidSpill};
+ {Src2,ShiftOp,ShiftArg} ->
+ {FixSrc2,NewSrc2,DidSpill1} = fix_src2(Src2, TempMap, Strategy),
+ {FixArg,NewArg,DidSpill2} =
+ case ShiftArg of
+ #arm_temp{} -> fix_src3(ShiftArg, TempMap, Strategy);
+ _ -> {[], ShiftArg, false}
+ end,
+ %% order matters: FixArg may clobber temp2/Src2
+ {FixArg ++ FixSrc2, {NewSrc2,ShiftOp,NewArg}, DidSpill1 or DidSpill2};
+ _ -> {[], Am1, false}
+ end.
+
+fix_am2(Am2=#am2{src=Src2,offset=Offset}, TempMap, Strategy) ->
+ {FixSrc2,NewSrc2,DidSpill1} = fix_src2(Src2, TempMap, Strategy),
+ {FixOffset,NewOffset,DidSpill2} = fix_am2offset(Offset, TempMap, Strategy),
+ NewAm2 = Am2#am2{src=NewSrc2,offset=NewOffset},
+ %% order matters: FixOffset may clobber temp2/Src2
+ {FixOffset ++ FixSrc2, NewAm2, DidSpill1 or DidSpill2}.
+
+fix_am2offset(Offset, TempMap, Strategy) ->
+ case Offset of
+ #arm_temp{} ->
+ fix_src3(Offset, TempMap, Strategy);
+ {Src3,rrx} ->
+ {Fix,New,DidSpill} = fix_src3(Src3, TempMap, Strategy),
+ {Fix, {New,rrx}, DidSpill};
+ {Src3,ShiftOp,Imm5} ->
+ {Fix,New,DidSpill} = fix_src3(Src3, TempMap, Strategy),
+ {Fix, {New,ShiftOp,Imm5}, DidSpill};
+ _ ->
+ {[], Offset, false}
+ end.
+
+fix_am3(Am3=#am3{src=Src2,offset=Offset}, TempMap, Strategy) ->
+ {FixSrc2,NewSrc2,DidSpill1} = fix_src2(Src2, TempMap, Strategy),
+ {FixOffset,NewOffset,DidSpill2} = fix_am3offset(Offset, TempMap, Strategy),
+ NewAm3 = Am3#am3{src=NewSrc2,offset=NewOffset},
+ %% order matters: FixOffset may clobber temp2/Src2
+ {FixOffset ++ FixSrc2, NewAm3, DidSpill1 or DidSpill2}.
+
+fix_am3offset(Offset, TempMap, Strategy) ->
+ case Offset of
+ #arm_temp{} -> fix_src3(Offset, TempMap, Strategy);
+ _ -> {[], Offset, false}
+ end.
+
+fix_src1(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp1(Strategy)).
+
+temp1('new') -> [];
+temp1('fixed') -> hipe_arm_registers:temp1().
+
+fix_src2(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp2(Strategy)).
+
+temp2('new') -> [];
+temp2('fixed') -> hipe_arm_registers:temp2().
+
+fix_src3(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp3(Strategy)).
+
+temp3('new') -> [];
+temp3('fixed') -> hipe_arm_registers:temp3().
+
+fix_src(Src, TempMap, RegOpt) ->
+ case temp_is_spilled(Src, TempMap) of
+ true ->
+ NewSrc = clone(Src, RegOpt),
+ {[hipe_arm:mk_pseudo_move(NewSrc, Src)],
+ NewSrc,
+ true};
+ _ ->
+ {[], Src, false}
+ end.
+
+fix_dst(Dst, TempMap, Strategy) ->
+ fix_dst_common(Dst, TempMap, temp1(Strategy)).
+
+fix_dst2(Dst, TempMap, Strategy) -> % only used for smull's DstHi
+ fix_dst_common(Dst, TempMap, temp3(Strategy)).
+
+fix_dst_common(Dst, TempMap, RegOpt) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ NewDst = clone(Dst, RegOpt),
+ {[hipe_arm:mk_pseudo_move(Dst, NewDst)], NewDst, true};
+ _ ->
+ {[], Dst, false}
+ end.
+
+%%% Check if an operand is a pseudo-temp.
+
+temp_is_spilled(Temp, []) -> % special case for naive regalloc
+ not(hipe_arm:temp_is_precoloured(Temp));
+temp_is_spilled(Temp, TempMap) ->
+ case hipe_arm:temp_is_allocatable(Temp) of
+ true ->
+ Reg = hipe_arm:temp_reg(Temp),
+ tuple_size(TempMap) > Reg andalso hipe_temp_map:is_spilled(Reg, TempMap);
+ false -> true
+ end.
+
+%%% Make a certain reg into a clone of Temp.
+
+clone(Temp, RegOpt) ->
+ Type = hipe_arm:temp_type(Temp),
+ case RegOpt of
+ [] -> hipe_arm:mk_new_temp(Type);
+ Reg -> hipe_arm:mk_temp(Reg, Type)
+ end.
diff --git a/lib/hipe/arm/hipe_arm_registers.erl b/lib/hipe/arm/hipe_arm_registers.erl
new file mode 100644
index 0000000000..ff6a163e9c
--- /dev/null
+++ b/lib/hipe/arm/hipe_arm_registers.erl
@@ -0,0 +1,207 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_registers).
+
+-export([reg_name_gpr/1,
+ first_virtual/0,
+ is_precoloured_gpr/1,
+ all_precoloured/0, % for coalescing
+ return_value/0,
+ temp1/0, % C callee-save, not parameter, may be allocatable
+ temp2/0, % not parameter, must not be allocatable (frame)
+ temp3/0, % not parameter, may be allocatable
+ heap_pointer/0,
+ stack_pointer/0,
+ proc_pointer/0,
+ lr/0,
+ pc/0,
+ %% heap_limit/0,
+ %% fcalls/0,
+ allocatable_gpr/0, % for coalescing
+ is_fixed/1, % for graph coloring
+ nr_args/0,
+ arg/1,
+ args/1,
+ is_arg/1, % for linear scan
+ call_clobbered/0,
+ tailcall_clobbered/0,
+ live_at_return/0
+ ]).
+
+-include("../rtl/hipe_literals.hrl").
+
+-define(R0, 0).
+-define(R1, 1).
+-define(R2, 2).
+-define(R3, 3).
+-define(R4, 4).
+-define(R5, 5).
+-define(R6, 6).
+-define(R7, 7).
+-define(R8, 8).
+-define(R9, 9).
+-define(R10, 10).
+-define(R11, 11).
+-define(R12, 12).
+-define(R13, 13). % XXX: see all_precoloured()
+-define(R14, 14).
+-define(R15, 15).
+-define(LAST_PRECOLOURED, 15). % must handle both GPR and FPR ranges
+
+-define(ARG0, ?R1).
+-define(ARG1, ?R2).
+-define(ARG2, ?R3).
+-define(ARG3, ?R4).
+-define(ARG4, ?R5).
+-define(ARG5, ?R6).
+
+-define(TEMP1, ?R8). % stores LR around inc_stack calls, must be C calleE-save
+-define(TEMP2, ?R12).
+-define(TEMP3, ?R7).
+
+-define(RETURN_VALUE, ?R0).
+-define(HEAP_POINTER, ?R9).
+-define(STACK_POINTER, ?R10).
+-define(PROC_POINTER, ?R11).
+
+reg_name_gpr(R) -> [$r | integer_to_list(R)].
+
+%%% Must handle both GPR and FPR ranges.
+first_virtual() -> ?LAST_PRECOLOURED + 1.
+
+%%% These two tests have the same implementation, but that's
+%%% not something we should cast in stone in the interface.
+is_precoloured_gpr(R) -> R =< ?LAST_PRECOLOURED.
+
+all_precoloured() ->
+ %% XXX: R13 should be skipped as it never is used anywhere.
+ %% Unfortunately, gaps in the list of precoloured registers
+ %% cause the graph_color register allocator to create bogus
+ %% assignments for those "registers", which in turn causes
+ %% the "precoloured reg must map to itself" sanity check in
+ %% the frame module to signal errors.
+ [ ?R0, ?R1, ?R2, ?R3, ?R4, ?R5, ?R6, ?R7,
+ ?R8, ?R9, ?R10, ?R11, ?R12, ?R13, ?R14, ?R15].
+
+return_value() -> ?RETURN_VALUE.
+
+temp1() -> ?TEMP1.
+temp2() -> ?TEMP2.
+temp3() -> ?TEMP3. % for base2 in storeix :-(
+
+heap_pointer() -> ?HEAP_POINTER.
+
+stack_pointer() -> ?STACK_POINTER.
+
+proc_pointer() -> ?PROC_POINTER.
+
+lr() -> ?R14.
+
+pc() -> ?R15.
+
+allocatable_gpr() ->
+ %% r9, r10, and r11 are fixed global registers.
+ %% r12 may be used by the frame module for large load/store offsets.
+ %% r13 is reserved for C.
+ %% r15 is the PC, and is not usable as a variable.
+ [ ?R0, ?R1, ?R2, ?R3, ?R4, ?R5, ?R6, ?R7,
+ ?R8, ?R14].
+
+%% Needed for hipe_graph_coloring_regalloc.
+%% Presumably true for Reg in AllPrecoloured \ Allocatable.
+is_fixed(Reg) ->
+ case Reg of
+ ?HEAP_POINTER -> true;
+ ?STACK_POINTER -> true;
+ ?PROC_POINTER -> true;
+ %% The following cases are required for linear scan:
+ %% it gets confused if it sees a register which is
+ %% neither allocatable nor global (fixed or one of
+ %% the scratch registers set aside for linear scan).
+ ?R15 -> true;
+ ?R13 -> true; % XXX: see all_precoloured()
+ ?R12 -> true;
+ _ -> false
+ end.
+
+nr_args() -> ?ARM_NR_ARG_REGS.
+
+args(Arity) when is_integer(Arity) ->
+ N = erlang:min(Arity, ?ARM_NR_ARG_REGS),
+ args(N-1, []).
+
+args(-1, Rest) -> Rest;
+args(I, Rest) -> args(I-1, [arg(I) | Rest]).
+
+arg(N) ->
+ if N < ?ARM_NR_ARG_REGS ->
+ case N of
+ 0 -> ?ARG0;
+ 1 -> ?ARG1;
+ 2 -> ?ARG2;
+ 3 -> ?ARG3;
+ 4 -> ?ARG4;
+ 5 -> ?ARG5;
+ _ -> exit({?MODULE, arg, N})
+ end;
+ true ->
+ exit({?MODULE, arg, N})
+ end.
+
+is_arg(R) ->
+ case R of
+ ?ARG0 -> ?ARM_NR_ARG_REGS > 0;
+ ?ARG1 -> ?ARM_NR_ARG_REGS > 1;
+ ?ARG2 -> ?ARM_NR_ARG_REGS > 2;
+ ?ARG3 -> ?ARM_NR_ARG_REGS > 3;
+ ?ARG4 -> ?ARM_NR_ARG_REGS > 4;
+ ?ARG5 -> ?ARM_NR_ARG_REGS > 5;
+ _ -> false
+ end.
+
+call_clobbered() -> % does the RA strip the type or not?
+ [{?R0,tagged},{?R0,untagged},
+ {?R1,tagged},{?R1,untagged},
+ {?R2,tagged},{?R2,untagged},
+ {?R3,tagged},{?R3,untagged},
+ {?R4,tagged},{?R4,untagged},
+ {?R5,tagged},{?R5,untagged},
+ {?R6,tagged},{?R6,untagged},
+ {?R7,tagged},{?R7,untagged},
+ {?R8,tagged},{?R8,untagged},
+ %% R9 is fixed (HP)
+ %% R10 is fixed (NSP)
+ %% R11 is fixed (P)
+ {?R12,tagged},{?R12,untagged},
+ %% R13 is reserved for C
+ {?R14,tagged},{?R14,untagged}
+ %% R15 is the non-allocatable PC
+ ].
+
+tailcall_clobbered() -> % tailcall crapola needs one temp
+ [{?TEMP1,tagged},{?TEMP1,untagged}].
+
+live_at_return() ->
+ [%%{?LR,untagged},
+ {?HEAP_POINTER,untagged},
+ {?STACK_POINTER,untagged},
+ {?PROC_POINTER,untagged}
+ ].
diff --git a/lib/hipe/arm/hipe_rtl_to_arm.erl b/lib/hipe/arm/hipe_rtl_to_arm.erl
new file mode 100644
index 0000000000..a4dc5db978
--- /dev/null
+++ b/lib/hipe/arm/hipe_rtl_to_arm.erl
@@ -0,0 +1,836 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_rtl_to_arm).
+-export([translate/1]).
+
+-include("../rtl/hipe_rtl.hrl").
+
+translate(RTL) ->
+ hipe_gensym:init(arm),
+ hipe_gensym:set_var(arm, hipe_arm_registers:first_virtual()),
+ hipe_gensym:set_label(arm, hipe_gensym:get_label(rtl)),
+ Map0 = vmap_empty(),
+ {Formals, Map1} = conv_formals(hipe_rtl:rtl_params(RTL), Map0),
+ OldData = hipe_rtl:rtl_data(RTL),
+ {Code0, NewData} = conv_insn_list(hipe_rtl:rtl_code(RTL), Map1, OldData),
+ {RegFormals,_} = split_args(Formals),
+ Code =
+ case RegFormals of
+ [] -> Code0;
+ _ -> [hipe_arm:mk_label(hipe_gensym:get_next_label(arm)) |
+ move_formals(RegFormals, Code0)]
+ end,
+ IsClosure = hipe_rtl:rtl_is_closure(RTL),
+ IsLeaf = hipe_rtl:rtl_is_leaf(RTL),
+ hipe_arm:mk_defun(hipe_rtl:rtl_fun(RTL),
+ Formals,
+ IsClosure,
+ IsLeaf,
+ Code,
+ NewData,
+ [],
+ []).
+
+conv_insn_list([H|T], Map, Data) ->
+ {NewH, NewMap, NewData1} = conv_insn(H, Map, Data),
+ %% io:format("~w \n ==>\n ~w\n- - - - - - - - -\n",[H,NewH]),
+ {NewT, NewData2} = conv_insn_list(T, NewMap, NewData1),
+ {NewH ++ NewT, NewData2};
+conv_insn_list([], _, Data) ->
+ {[], Data}.
+
+conv_insn(I, Map, Data) ->
+ case I of
+ #alu{} -> conv_alu(I, Map, Data);
+ #alub{} -> conv_alub(I, Map, Data);
+ #branch{} -> conv_branch(I, Map, Data);
+ #call{} -> conv_call(I, Map, Data);
+ #comment{} -> conv_comment(I, Map, Data);
+ #enter{} -> conv_enter(I, Map, Data);
+ #goto{} -> conv_goto(I, Map, Data);
+ #label{} -> conv_label(I, Map, Data);
+ #load{} -> conv_load(I, Map, Data);
+ #load_address{} -> conv_load_address(I, Map, Data);
+ #load_atom{} -> conv_load_atom(I, Map, Data);
+ #move{} -> conv_move(I, Map, Data);
+ #return{} -> conv_return(I, Map, Data);
+ #store{} -> conv_store(I, Map, Data);
+ #switch{} -> conv_switch(I, Map, Data);
+ _ -> exit({?MODULE,conv_insn,I})
+ end.
+
+conv_alu(I, Map, Data) ->
+ %% dst = src1 aluop src2
+ {Dst, Map0} = conv_dst(hipe_rtl:alu_dst(I), Map),
+ {Src1, Map1} = conv_src(hipe_rtl:alu_src1(I), Map0),
+ {Src2, Map2} = conv_src(hipe_rtl:alu_src2(I), Map1),
+ RtlAluOp = hipe_rtl:alu_op(I),
+ S = false,
+ I2 = mk_alu(S, Dst, Src1, RtlAluOp, Src2),
+ {I2, Map2, Data}.
+
+conv_shift(RtlShiftOp) ->
+ case RtlShiftOp of
+ 'sll' -> 'lsl';
+ 'srl' -> 'lsr';
+ 'sra' -> 'asr'
+ end.
+
+conv_arith(RtlAluOp) -> % RtlAluOp \ RtlShiftOp -> ArmArithOp
+ case RtlAluOp of
+ 'add' -> 'add';
+ 'sub' -> 'sub';
+ 'mul' -> 'mul';
+ 'or' -> 'orr';
+ 'and' -> 'and';
+ 'xor' -> 'eor'
+ end.
+
+commute_arithop(ArithOp) ->
+ case ArithOp of
+ 'sub' -> 'rsb';
+ _ -> ArithOp
+ end.
+
+mk_alu(S, Dst, Src1, RtlAluOp, Src2) ->
+ case hipe_rtl:is_shift_op(RtlAluOp) of
+ true ->
+ mk_shift(S, Dst, Src1, conv_shift(RtlAluOp), Src2);
+ false ->
+ mk_arith(S, Dst, Src1, conv_arith(RtlAluOp), Src2)
+ end.
+
+mk_shift(S, Dst, Src1, ShiftOp, Src2) ->
+ case hipe_arm:is_temp(Src1) of
+ true ->
+ case hipe_arm:is_temp(Src2) of
+ true ->
+ mk_shift_rr(S, Dst, Src1, ShiftOp, Src2);
+ _ ->
+ mk_shift_ri(S, Dst, Src1, ShiftOp, Src2)
+ end;
+ _ ->
+ case hipe_arm:is_temp(Src2) of
+ true ->
+ mk_shift_ir(S, Dst, Src1, ShiftOp, Src2);
+ _ ->
+ mk_shift_ii(S, Dst, Src1, ShiftOp, Src2)
+ end
+ end.
+
+mk_shift_ii(S, Dst, Src1, ShiftOp, Src2) ->
+ io:format("~w: RTL alu with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_shift_ri(S, Dst, Tmp, ShiftOp, Src2)).
+
+mk_shift_ir(S, Dst, Src1, ShiftOp, Src2) ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_shift_rr(S, Dst, Tmp, ShiftOp, Src2)).
+
+mk_shift_ri(S, Dst, Src1, ShiftOp, Src2) when is_integer(Src2) ->
+ if Src2 >= 0, Src2 < 32 -> ok;
+ true -> io:format("~w: excessive immediate shift ~w\n", [?MODULE,Src2])
+ end,
+ Am1 = {Src1,ShiftOp,Src2},
+ [hipe_arm:mk_move(S, Dst, Am1)].
+
+mk_shift_rr(S, Dst, Src1, ShiftOp, Src2) ->
+ Am1 = {Src1,ShiftOp,Src2},
+ [hipe_arm:mk_move(S, Dst, Am1)].
+
+mk_arith(S, Dst, Src1, ArithOp, Src2) ->
+ case hipe_arm:is_temp(Src1) of
+ true ->
+ case hipe_arm:is_temp(Src2) of
+ true ->
+ mk_arith_rr(S, Dst, Src1, ArithOp, Src2);
+ _ ->
+ mk_arith_ri(S, Dst, Src1, ArithOp, Src2)
+ end;
+ _ ->
+ case hipe_arm:is_temp(Src2) of
+ true ->
+ mk_arith_ir(S, Dst, Src1, ArithOp, Src2);
+ _ ->
+ mk_arith_ii(S, Dst, Src1, ArithOp, Src2)
+ end
+ end.
+
+mk_arith_ii(S, Dst, Src1, ArithOp, Src2) ->
+ io:format("~w: RTL alu with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_arith_ri(S, Dst, Tmp, ArithOp, Src2)).
+
+mk_arith_ir(S, Dst, Src1, ArithOp, Src2) ->
+ mk_arith_ri(S, Dst, Src2, commute_arithop(ArithOp), Src1).
+
+mk_arith_ri(S, Dst, Src1, ArithOp, Src2) ->
+ case ArithOp of
+ 'mul' -> % mul/smull only take reg/reg operands
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src2,
+ mk_arith_rr(S, Dst, Src1, ArithOp, Tmp));
+ _ -> % add/sub/orr/and/eor have reg/am1 operands
+ {FixAm1,NewArithOp,Am1} = fix_aluop_imm(ArithOp, Src2),
+ FixAm1 ++ [hipe_arm:mk_alu(NewArithOp, S, Dst, Src1, Am1)]
+ end.
+
+mk_arith_rr(S, Dst, Src1, ArithOp, Src2) ->
+ case {ArithOp,S} of
+ {'mul',true} ->
+ %% To check for overflow in 32x32->32 multiplication:
+ %% smull Dst,TmpHi,Src1,Src2
+ %% mov TmpSign,Dst,ASR #31
+ %% cmp TmpSign,TmpHi
+ %% [bne OverflowLabel]
+ TmpHi = new_untagged_temp(),
+ TmpSign = new_untagged_temp(),
+ [hipe_arm:mk_smull(Dst, TmpHi, Src1, Src2),
+ hipe_arm:mk_move(TmpSign, {Dst,'asr',31}),
+ hipe_arm:mk_cmp('cmp', TmpSign, TmpHi)];
+ _ ->
+ [hipe_arm:mk_alu(ArithOp, S, Dst, Src1, Src2)]
+ end.
+
+fix_aluop_imm(AluOp, Imm) -> % {FixAm1,NewAluOp,Am1}
+ case hipe_arm:try_aluop_imm(AluOp, Imm) of
+ {NewAluOp,Am1} -> {[], NewAluOp, Am1};
+ [] ->
+ Tmp = new_untagged_temp(),
+ {mk_li(Tmp, Imm), AluOp, Tmp}
+ end.
+
+conv_alub(I, Map, Data) ->
+ %% dst = src1 aluop src2; if COND goto label
+ {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map),
+ {Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0),
+ {Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1),
+ RtlAluOp = hipe_rtl:alub_op(I),
+ Cond0 = conv_alub_cond(RtlAluOp, hipe_rtl:alub_cond(I)),
+ Cond =
+ case {RtlAluOp,Cond0} of
+ {'mul','vs'} -> 'ne'; % overflow becomes not-equal
+ {'mul','vc'} -> 'eq'; % no-overflow becomes equal
+ {'mul',_} -> exit({?MODULE,I});
+ {_,_} -> Cond0
+ end,
+ I2 = mk_pseudo_bc(
+ Cond,
+ hipe_rtl:alub_true_label(I),
+ hipe_rtl:alub_false_label(I),
+ hipe_rtl:alub_pred(I)),
+ S = true,
+ I1 = mk_alu(S, Dst, Src1, RtlAluOp, Src2),
+ {I1 ++ I2, Map2, Data}.
+
+conv_branch(I, Map, Data) ->
+ %% <unused> = src1 - src2; if COND goto label
+ {Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map),
+ {Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0),
+ Cond = conv_branch_cond(hipe_rtl:branch_cond(I)),
+ I2 = mk_branch(Src1, Cond, Src2,
+ hipe_rtl:branch_true_label(I),
+ hipe_rtl:branch_false_label(I),
+ hipe_rtl:branch_pred(I)),
+ {I2, Map1, Data}.
+
+mk_branch(Src1, Cond, Src2, TrueLab, FalseLab, Pred) ->
+ case hipe_arm:is_temp(Src1) of
+ true ->
+ case hipe_arm:is_temp(Src2) of
+ true ->
+ mk_branch_rr(Src1, Src2, Cond, TrueLab, FalseLab, Pred);
+ _ ->
+ mk_branch_ri(Src1, Cond, Src2, TrueLab, FalseLab, Pred)
+ end;
+ _ ->
+ case hipe_arm:is_temp(Src2) of
+ true ->
+ NewCond = commute_cond(Cond),
+ mk_branch_ri(Src2, NewCond, Src1, TrueLab, FalseLab, Pred);
+ _ ->
+ mk_branch_ii(Src1, Cond, Src2, TrueLab, FalseLab, Pred)
+ end
+ end.
+
+mk_branch_ii(Imm1, Cond, Imm2, TrueLab, FalseLab, Pred) ->
+ io:format("~w: RTL branch with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Imm1,
+ mk_branch_ri(Tmp, Cond, Imm2,
+ TrueLab, FalseLab, Pred)).
+
+mk_branch_ri(Src, Cond, Imm, TrueLab, FalseLab, Pred) ->
+ {FixAm1,NewCmpOp,Am1} = fix_aluop_imm('cmp', Imm),
+ FixAm1 ++ mk_cmp_bc(NewCmpOp, Src, Am1, Cond, TrueLab, FalseLab, Pred).
+
+mk_branch_rr(Src1, Src2, Cond, TrueLab, FalseLab, Pred) ->
+ mk_cmp_bc('cmp', Src1, Src2, Cond, TrueLab, FalseLab, Pred).
+
+mk_cmp_bc(CmpOp, Src, Am1, Cond, TrueLab, FalseLab, Pred) ->
+ [hipe_arm:mk_cmp(CmpOp, Src, Am1) |
+ mk_pseudo_bc(Cond, TrueLab, FalseLab, Pred)].
+
+conv_call(I, Map, Data) ->
+ {Args, Map0} = conv_src_list(hipe_rtl:call_arglist(I), Map),
+ {Dsts, Map1} = conv_dst_list(hipe_rtl:call_dstlist(I), Map0),
+ {Fun, Map2} = conv_fun(hipe_rtl:call_fun(I), Map1),
+ ContLab = hipe_rtl:call_continuation(I),
+ ExnLab = hipe_rtl:call_fail(I),
+ Linkage = hipe_rtl:call_type(I),
+ I2 = mk_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage),
+ {I2, Map2, Data}.
+
+mk_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_arm:is_prim(Fun) of
+ true ->
+ mk_primop_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage);
+ false ->
+ mk_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage)
+ end.
+
+mk_primop_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_arm:prim_prim(Prim) of
+ %% no ARM-specific primops defined yet
+ _ ->
+ mk_general_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage)
+ end.
+
+mk_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ %% The backend does not support pseudo_calls without a
+ %% continuation label, so we make sure each call has one.
+ {RealContLab, Tail} =
+ case mk_call_results(Dsts) of
+ [] ->
+ %% Avoid consing up a dummy basic block if the moves list
+ %% is empty, as is typical for calls to suspend/0.
+ %% This should be subsumed by a general "optimise the CFG"
+ %% module, and could probably be removed.
+ case ContLab of
+ [] ->
+ NewContLab = hipe_gensym:get_next_label(arm),
+ {NewContLab, [hipe_arm:mk_label(NewContLab)]};
+ _ ->
+ {ContLab, []}
+ end;
+ Moves ->
+ %% Change the call to continue at a new basic block.
+ %% In this block move the result registers to the Dsts,
+ %% then continue at the call's original continuation.
+ NewContLab = hipe_gensym:get_next_label(arm),
+ case ContLab of
+ [] ->
+ %% This is just a fallthrough
+ %% No jump back after the moves.
+ {NewContLab,
+ [hipe_arm:mk_label(NewContLab) |
+ Moves]};
+ _ ->
+ %% The call has a continuation. Jump to it.
+ {NewContLab,
+ [hipe_arm:mk_label(NewContLab) |
+ Moves ++
+ [hipe_arm:mk_b_label(ContLab)]]}
+ end
+ end,
+ SDesc = hipe_arm:mk_sdesc(ExnLab, 0, length(Args), {}),
+ CallInsn = hipe_arm:mk_pseudo_call(Fun, SDesc, RealContLab, Linkage),
+ {RegArgs,StkArgs} = split_args(Args),
+ mk_push_args(StkArgs, move_actuals(RegArgs, [CallInsn | Tail])).
+
+mk_call_results([]) ->
+ [];
+mk_call_results([Dst]) ->
+ RV = hipe_arm:mk_temp(hipe_arm_registers:return_value(), 'tagged'),
+ [hipe_arm:mk_pseudo_move(Dst, RV)];
+mk_call_results(Dsts) ->
+ exit({?MODULE,mk_call_results,Dsts}).
+
+mk_push_args(StkArgs, Tail) ->
+ case length(StkArgs) of
+ 0 ->
+ Tail;
+ NrStkArgs ->
+ [hipe_arm:mk_pseudo_call_prepare(NrStkArgs) |
+ mk_store_args(StkArgs, NrStkArgs * word_size(), Tail)]
+ end.
+
+mk_store_args([Arg|Args], PrevOffset, Tail) ->
+ Offset = PrevOffset - word_size(),
+ {Src,FixSrc} =
+ case hipe_arm:is_temp(Arg) of
+ true ->
+ {Arg, []};
+ _ ->
+ Tmp = new_tagged_temp(),
+ {Tmp, mk_li(Tmp, Arg)}
+ end,
+ NewTail = hipe_arm:mk_store('str', Src, mk_sp(), Offset, 'new', Tail),
+ mk_store_args(Args, Offset, FixSrc ++ NewTail);
+mk_store_args([], _, Tail) ->
+ Tail.
+
+conv_comment(I, Map, Data) ->
+ I2 = [hipe_arm:mk_comment(hipe_rtl:comment_text(I))],
+ {I2, Map, Data}.
+
+conv_enter(I, Map, Data) ->
+ {Args, Map0} = conv_src_list(hipe_rtl:enter_arglist(I), Map),
+ {Fun, Map1} = conv_fun(hipe_rtl:enter_fun(I), Map0),
+ I2 = mk_enter(Fun, Args, hipe_rtl:enter_type(I)),
+ {I2, Map1, Data}.
+
+mk_enter(Fun, Args, Linkage) ->
+ Arity = length(Args),
+ {RegArgs,StkArgs} = split_args(Args),
+ move_actuals(RegArgs,
+ [hipe_arm:mk_pseudo_tailcall_prepare(),
+ hipe_arm:mk_pseudo_tailcall(Fun, Arity, StkArgs, Linkage)]).
+
+conv_goto(I, Map, Data) ->
+ I2 = [hipe_arm:mk_b_label(hipe_rtl:goto_label(I))],
+ {I2, Map, Data}.
+
+conv_label(I, Map, Data) ->
+ I2 = [hipe_arm:mk_label(hipe_rtl:label_name(I))],
+ {I2, Map, Data}.
+
+conv_load(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_dst(I), Map),
+ {Base1, Map1} = conv_src(hipe_rtl:load_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:load_offset(I), Map1),
+ LoadSize = hipe_rtl:load_size(I),
+ LoadSign = hipe_rtl:load_sign(I),
+ I2 = mk_load(Dst, Base1, Base2, LoadSize, LoadSign),
+ {I2, Map2, Data}.
+
+mk_load(Dst, Base1, Base2, LoadSize, LoadSign) ->
+ case {LoadSize,LoadSign} of
+ {byte,signed} ->
+ case hipe_arm:is_temp(Base1) of
+ true ->
+ case hipe_arm:is_temp(Base2) of
+ true ->
+ mk_ldrsb_rr(Dst, Base1, Base2);
+ _ ->
+ mk_ldrsb_ri(Dst, Base1, Base2)
+ end;
+ _ ->
+ case hipe_arm:is_temp(Base2) of
+ true ->
+ mk_ldrsb_ri(Dst, Base2, Base1);
+ _ ->
+ mk_ldrsb_ii(Dst, Base1, Base2)
+ end
+ end;
+ _ ->
+ LdOp =
+ case LoadSize of
+ byte -> 'ldrb';
+ int32 -> 'ldr';
+ word -> 'ldr'
+ end,
+ case hipe_arm:is_temp(Base1) of
+ true ->
+ case hipe_arm:is_temp(Base2) of
+ true ->
+ mk_load_rr(Dst, Base1, Base2, LdOp);
+ _ ->
+ mk_load_ri(Dst, Base1, Base2, LdOp)
+ end;
+ _ ->
+ case hipe_arm:is_temp(Base2) of
+ true ->
+ mk_load_ri(Dst, Base2, Base1, LdOp);
+ _ ->
+ mk_load_ii(Dst, Base1, Base2, LdOp)
+ end
+ end
+ end.
+
+mk_load_ii(Dst, Base1, Base2, LdOp) ->
+ io:format("~w: RTL load with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Base1,
+ mk_load_ri(Dst, Tmp, Base2, LdOp)).
+
+mk_load_ri(Dst, Base, Offset, LdOp) ->
+ hipe_arm:mk_load(LdOp, Dst, Base, Offset, 'new', []).
+
+mk_load_rr(Dst, Base1, Base2, LdOp) ->
+ Am2 = hipe_arm:mk_am2(Base1, '+', Base2),
+ [hipe_arm:mk_load(LdOp, Dst, Am2)].
+
+mk_ldrsb_ii(Dst, Base1, Base2) ->
+ io:format("~w: RTL load signed byte with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Base1,
+ mk_ldrsb_ri(Dst, Tmp, Base2)).
+
+mk_ldrsb_ri(Dst, Base, Offset) when is_integer(Offset) ->
+ {Sign,AbsOffset} =
+ if Offset < 0 -> {'-', -Offset};
+ true -> {'+', Offset}
+ end,
+ if AbsOffset =< 255 ->
+ Am3 = hipe_arm:mk_am3(Base, Sign, AbsOffset),
+ [hipe_arm:mk_ldrsb(Dst, Am3)];
+ true ->
+ Index = new_untagged_temp(),
+ Am3 = hipe_arm:mk_am3(Base, Sign, Index),
+ mk_li(Index, AbsOffset,
+ [hipe_arm:mk_ldrsb(Dst, Am3)])
+ end.
+
+mk_ldrsb_rr(Dst, Base1, Base2) ->
+ Am3 = hipe_arm:mk_am3(Base1, '+', Base2),
+ [hipe_arm:mk_ldrsb(Dst, Am3)].
+
+conv_load_address(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_address_dst(I), Map),
+ Addr = hipe_rtl:load_address_addr(I),
+ Type = hipe_rtl:load_address_type(I),
+ Src = {Addr,Type},
+ I2 = [hipe_arm:mk_pseudo_li(Dst, Src)],
+ {I2, Map0, Data}.
+
+conv_load_atom(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_atom_dst(I), Map),
+ Src = hipe_rtl:load_atom_atom(I),
+ I2 = [hipe_arm:mk_pseudo_li(Dst, Src)],
+ {I2, Map0, Data}.
+
+conv_move(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:move_dst(I), Map),
+ {Src, Map1} = conv_src(hipe_rtl:move_src(I), Map0),
+ I2 = mk_move(Dst, Src, []),
+ {I2, Map1, Data}.
+
+mk_move(Dst, Src, Tail) ->
+ case hipe_arm:is_temp(Src) of
+ true -> [hipe_arm:mk_pseudo_move(Dst, Src) | Tail];
+ _ -> mk_li(Dst, Src, Tail)
+ end.
+
+conv_return(I, Map, Data) ->
+ %% TODO: multiple-value returns
+ {[Arg], Map0} = conv_src_list(hipe_rtl:return_varlist(I), Map),
+ I2 = mk_move(mk_rv(), Arg,
+ [hipe_arm:mk_pseudo_blr()]),
+ {I2, Map0, Data}.
+
+conv_store(I, Map, Data) ->
+ {Base, Map0} = conv_dst(hipe_rtl:store_base(I), Map),
+ {Src, Map1} = conv_src(hipe_rtl:store_src(I), Map0),
+ {Offset, Map2} = conv_src(hipe_rtl:store_offset(I), Map1),
+ StoreSize = hipe_rtl:store_size(I),
+ I2 = mk_store(Src, Base, Offset, StoreSize),
+ {I2, Map2, Data}.
+
+mk_store(Src, Base, Offset, StoreSize) ->
+ StOp =
+ case StoreSize of
+ byte -> 'strb';
+ int32 -> 'str';
+ word -> 'str'
+ end,
+ case hipe_arm:is_temp(Src) of
+ true ->
+ mk_store2(Src, Base, Offset, StOp);
+ _ ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src,
+ mk_store2(Tmp, Base, Offset, StOp))
+ end.
+
+mk_store2(Src, Base, Offset, StOp) ->
+ case hipe_arm:is_temp(Offset) of
+ true ->
+ mk_store_rr(Src, Base, Offset, StOp);
+ _ ->
+ mk_store_ri(Src, Base, Offset, StOp)
+ end.
+
+mk_store_ri(Src, Base, Offset, StOp) ->
+ hipe_arm:mk_store(StOp, Src, Base, Offset, 'new', []).
+
+mk_store_rr(Src, Base, Index, StOp) ->
+ Am2 = hipe_arm:mk_am2(Base, '+', Index),
+ [hipe_arm:mk_store(StOp, Src, Am2)].
+
+conv_switch(I, Map, Data) ->
+ Labels = hipe_rtl:switch_labels(I),
+ LMap = [{label,L} || L <- Labels],
+ {NewData, JTabLab} =
+ case hipe_rtl:switch_sort_order(I) of
+ [] ->
+ hipe_consttab:insert_block(Data, word, LMap);
+ SortOrder ->
+ hipe_consttab:insert_sorted_block(
+ Data, word, LMap, SortOrder)
+ end,
+ %% no immediates allowed here
+ {IndexR, Map1} = conv_dst(hipe_rtl:switch_src(I), Map),
+ JTabR = new_untagged_temp(),
+ I2 =
+ [hipe_arm:mk_pseudo_li(JTabR, {JTabLab,constant}),
+ hipe_arm:mk_pseudo_switch(JTabR, IndexR, Labels)],
+ {I2, Map1, NewData}.
+
+%%% Create a conditional branch.
+
+mk_pseudo_bc(Cond, TrueLabel, FalseLabel, Pred) ->
+ [hipe_arm:mk_pseudo_bc(Cond, TrueLabel, FalseLabel, Pred)].
+
+%%% Load an integer constant into a register.
+
+mk_li(Dst, Value) -> mk_li(Dst, Value, []).
+
+mk_li(Dst, Value, Tail) ->
+ hipe_arm:mk_li(Dst, Value, Tail).
+
+%%% Convert an RTL condition code.
+
+conv_alub_cond(RtlAluOp, Cond) -> % may be unsigned, depends on aluop
+ %% Note: ARM has a non-standard definition of the Carry flag:
+ %% 'cmp', 'sub', and 'rsb' define Carry as the NEGATION of Borrow.
+ %% This means that the mapping between C/Z combinations and
+ %% conditions like "lower" and "higher" becomes non-standard.
+ %% (See conv_branch_cond/1 which maps ltu to lo/carry-clear,
+ %% while x86 maps ltu to b/carry-set.)
+ %% Here in conv_alub_cond/2 it means that the mapping of unsigned
+ %% conditions also has to consider the alu operator, since e.g.
+ %% 'add' and 'sub' behave differently with regard to Carry.
+ case {RtlAluOp, Cond} of % handle allowed alub unsigned conditions
+ {'add', 'ltu'} -> 'hs'; % add+ltu == unsigned overflow == carry set == hs
+ %% add more cases when needed
+ _ -> conv_cond(Cond)
+ end.
+
+conv_cond(Cond) -> % only signed
+ case Cond of
+ eq -> 'eq';
+ ne -> 'ne';
+ gt -> 'gt';
+ ge -> 'ge';
+ lt -> 'lt';
+ le -> 'le';
+ overflow -> 'vs';
+ not_overflow -> 'vc'
+ end.
+
+conv_branch_cond(Cond) -> % may be unsigned
+ case Cond of
+ gtu -> 'hi';
+ geu -> 'hs';
+ ltu -> 'lo';
+ leu -> 'ls';
+ _ -> conv_cond(Cond)
+ end.
+
+%%% Commute an ARM condition code.
+
+commute_cond(Cond) -> % if x Cond y, then y commute_cond(Cond) x
+ case Cond of
+ 'eq' -> 'eq'; % ==, ==
+ 'ne' -> 'ne'; % !=, !=
+ 'gt' -> 'lt'; % >, <
+ 'ge' -> 'le'; % >=, <=
+ 'lt' -> 'gt'; % <, >
+ 'le' -> 'ge'; % <=, >=
+ 'hi' -> 'lo'; % >u, <u
+ 'hs' -> 'ls'; % >=u, <=u
+ 'lo' -> 'hi'; % <u, >u
+ 'ls' -> 'hs'; % <=u, >=u
+ %% vs/vc: n/a
+ _ -> exit({?MODULE,commute_cond,Cond})
+ end.
+
+%%% Split a list of formal or actual parameters into the
+%%% part passed in registers and the part passed on the stack.
+%%% The parameters passed in registers are also tagged with
+%%% the corresponding registers.
+
+split_args(Args) ->
+ split_args(0, hipe_arm_registers:nr_args(), Args, []).
+
+split_args(I, N, [Arg|Args], RegArgs) when I < N ->
+ Reg = hipe_arm_registers:arg(I),
+ Temp = hipe_arm:mk_temp(Reg, 'tagged'),
+ split_args(I+1, N, Args, [{Arg,Temp}|RegArgs]);
+split_args(_, _, StkArgs, RegArgs) ->
+ {RegArgs, StkArgs}.
+
+%%% Convert a list of actual parameters passed in
+%%% registers (from split_args/1) to a list of moves.
+
+move_actuals([{Src,Dst}|Actuals], Rest) ->
+ move_actuals(Actuals, mk_move(Dst, Src, Rest));
+move_actuals([], Rest) ->
+ Rest.
+
+%%% Convert a list of formal parameters passed in
+%%% registers (from split_args/1) to a list of moves.
+
+move_formals([{Dst,Src}|Formals], Rest) ->
+ move_formals(Formals, [hipe_arm:mk_pseudo_move(Dst, Src) | Rest]);
+move_formals([], Rest) ->
+ Rest.
+
+%%% Convert a 'fun' operand (MFA, prim, or temp)
+
+conv_fun(Fun, Map) ->
+ case hipe_rtl:is_var(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ case hipe_rtl:is_reg(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ if is_atom(Fun) ->
+ {hipe_arm:mk_prim(Fun), Map};
+ true ->
+ {conv_mfa(Fun), Map}
+ end
+ end
+ end.
+
+%%% Convert an MFA operand.
+
+conv_mfa({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) ->
+ hipe_arm:mk_mfa(M, F, A).
+
+%%% Convert an RTL source operand (imm/var/reg).
+%%% Returns a temp or a naked integer.
+
+conv_src(Opnd, Map) ->
+ case hipe_rtl:is_imm(Opnd) of
+ true ->
+ Value = hipe_rtl:imm_value(Opnd),
+ if is_integer(Value) ->
+ {Value, Map}
+ end;
+ false ->
+ conv_dst(Opnd, Map)
+ end.
+
+conv_src_list([O|Os], Map) ->
+ {V, Map1} = conv_src(O, Map),
+ {Vs, Map2} = conv_src_list(Os, Map1),
+ {[V|Vs], Map2};
+conv_src_list([], Map) ->
+ {[], Map}.
+
+%%% Convert an RTL destination operand (var/reg).
+
+conv_dst(Opnd, Map) ->
+ {Name, Type} =
+ case hipe_rtl:is_var(Opnd) of
+ true ->
+ {hipe_rtl:var_index(Opnd), 'tagged'};
+ false ->
+ case hipe_rtl:is_fpreg(Opnd) of
+ true ->
+ {hipe_rtl:fpreg_index(Opnd), 'double'};
+ false ->
+ {hipe_rtl:reg_index(Opnd), 'untagged'}
+ end
+ end,
+ IsPrecoloured =
+ case Type of
+ 'double' -> false; %hipe_arm_registers:is_precoloured_fpr(Name);
+ _ -> hipe_arm_registers:is_precoloured_gpr(Name)
+ end,
+ case IsPrecoloured of
+ true ->
+ {hipe_arm:mk_temp(Name, Type), Map};
+ false ->
+ case vmap_lookup(Map, Opnd) of
+ {value, NewTemp} ->
+ {NewTemp, Map};
+ _ ->
+ NewTemp = hipe_arm:mk_new_temp(Type),
+ {NewTemp, vmap_bind(Map, Opnd, NewTemp)}
+ end
+ end.
+
+conv_dst_list([O|Os], Map) ->
+ {Dst, Map1} = conv_dst(O, Map),
+ {Dsts, Map2} = conv_dst_list(Os, Map1),
+ {[Dst|Dsts], Map2};
+conv_dst_list([], Map) ->
+ {[], Map}.
+
+conv_formals(Os, Map) ->
+ conv_formals(hipe_arm_registers:nr_args(), Os, Map, []).
+
+conv_formals(N, [O|Os], Map, Res) ->
+ Type =
+ case hipe_rtl:is_var(O) of
+ true -> 'tagged';
+ _ -> 'untagged'
+ end,
+ Dst =
+ if N > 0 -> hipe_arm:mk_new_temp(Type); % allocatable
+ true -> hipe_arm:mk_new_nonallocatable_temp(Type)
+ end,
+ Map1 = vmap_bind(Map, O, Dst),
+ conv_formals(N-1, Os, Map1, [Dst|Res]);
+conv_formals(_, [], Map, Res) ->
+ {lists:reverse(Res), Map}.
+
+%%% Create a temp representing the stack pointer register.
+
+mk_sp() ->
+ hipe_arm:mk_temp(hipe_arm_registers:stack_pointer(), 'untagged').
+
+%%% Create a temp representing the return value register.
+
+mk_rv() ->
+ hipe_arm:mk_temp(hipe_arm_registers:return_value(), 'tagged').
+
+%%% new_untagged_temp -- conjure up an untagged scratch reg
+
+new_untagged_temp() ->
+ hipe_arm:mk_new_temp('untagged').
+
+%%% new_tagged_temp -- conjure up a tagged scratch reg
+
+new_tagged_temp() ->
+ hipe_arm:mk_new_temp('tagged').
+
+%%% Map from RTL var/reg operands to temps.
+
+vmap_empty() ->
+ gb_trees:empty().
+
+vmap_lookup(Map, Key) ->
+ gb_trees:lookup(Key, Map).
+
+vmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+word_size() ->
+ 4.
diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile
new file mode 100644
index 0000000000..fb7ca1153b
--- /dev/null
+++ b/lib/hipe/cerl/Makefile
@@ -0,0 +1,107 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_hybrid_transform \
+ cerl_lib cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \
+ cerl_typean erl_bif_types erl_types
+
+HRL_FILES= cerl_hipe_primops.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +inline +warn_exported_vars +warn_unused_import +warn_missing_spec# +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/cerl
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/cerl
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl
+$(EBIN)/cerl_hipeify.beam: cerl_hipe_primops.hrl
+$(EBIN)/cerl_lambdalift.beam: cerl_hipe_primops.hrl
+$(EBIN)/erl_bif_types.beam: ../icode/hipe_icode_primops.hrl
diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl
new file mode 100644
index 0000000000..cf4d317b0d
--- /dev/null
+++ b/lib/hipe/cerl/cerl_cconv.erl
@@ -0,0 +1,777 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <richardc@it.uu.se>
+%% @copyright 2000-2004 Richard Carlsson
+%% @doc Closure conversion of Core Erlang modules. This is done as a
+%% step in the translation from Core Erlang down to HiPE Icode, and is
+%% very much tied to the calling conventions used in HiPE native code.
+%% @see cerl_to_icode
+
+%% Some information about function closures in Beam and HiPE:
+%%
+%% - In Beam, each fun-expression is lifted to a top-level function such
+%% that the arity of the new function is equal to the arity of the fun
+%% *plus* the number of free variables. The original fun-expression is
+%% replaced by a call to 'make_fun' which takes the *label* of the new
+%% function and the number of free variables as arguments (the arity
+%% of the fun can be found via the label). When a call is made through
+%% the closure, the free variables are extracted from the closure by
+%% the 'call_fun' operation and are placed in the X registers
+%% following the ones used for the normal parameters; then the call is
+%% made to the function label.
+%%
+%% - In HiPE (when compiling from Beam bytecode), the Beam-to-Icode
+%% translation rewrites the fun-functions (those referenced by
+%% 'make_fun' operations) so that the code expects only the normal
+%% parameters, plus *one* extra parameter containing the closure
+%% itself, and then immediately extracts the free variables from the
+%% closure - the code knows how many free variables it expects.
+%% However, the arity part of the function name is *not* changed;
+%% thus, the native code and the Beam code still use the same
+%% fun-table entry. The arity value used in native-code 'make_fun'
+%% operations should therefore be the same as in Beam, i.e., the sum
+%% of the number of parameters and the number of free variables.
+
+-module(cerl_cconv).
+
+-export([transform/2]).
+-export([core_transform/2]).
+
+-include("cerl_hipe_primops.hrl").
+
+%% A descriptor for top-level and letrec-bound functions. (Top-level
+%% functions always have an empty list of free variables.) The 'name'
+%% field is the name of the lifted function, and is thus unique over the
+%% whole module.
+
+-record(function, {name :: {atom(), arity()}, free}).
+
+%% A record for holding fun-information (if such information is attached
+%% as an annotation on a fun, it should preferably be preserved).
+
+-record(fun_info, {name :: atom(),
+ id = 0 :: integer(),
+ hash = 0 :: integer()}).
+
+%% @spec core_transform(Module::cerl_records(), Options::[term()]) ->
+%% cerl_records()
+%%
+%% @doc Transforms a module represented by records. See
+%% <code>transform/2</code> for details.
+%%
+%% <p>Use the compiler option <code>{core_transform, cerl_cconv}</code>
+%% to insert this function as a compilation pass.</p>
+%%
+%% @see transform/2
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(M, Opts) ->
+ cerl:to_records(transform(cerl:from_records(M), Opts)).
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%% cerl() = cerl:cerl()
+%%
+%% @doc Rewrites a Core Erlang module so that all fun-expressions
+%% (lambda expressions) in the code are in top level function
+%% definitions, and the operators of all `apply'-expressions are names
+%% of such top-level functions. The primitive operations `make_fun' and
+%% `call_fun' are inserted in the code to create and apply functional
+%% values; this transformation is known as "Closure Conversion"
+%%
+%% <p>See the module {@link cerl_to_icode} for details.</p>
+
+-spec transform(cerl:c_module(), [term()]) -> cerl:c_module().
+
+transform(E, _Options) ->
+ M = cerl:module_name(E),
+ S0 = s__new(cerl:atom_val(M)),
+ {Defs1, S1} = module_defs(cerl:module_defs(E), env__new(),
+ ren__new(), S0),
+ Defs2 = lists:reverse(s__get_defs(S1) ++ Defs1),
+ cerl:update_c_module(E, M, cerl:module_exports(E),
+ cerl:module_attrs(E), Defs2).
+
+%% Note that the environment is defined on the renamed variables.
+
+expr(E, Env, Ren, S0) ->
+ case cerl:type(E) of
+ literal ->
+ {E, S0};
+ var ->
+ var(E, Env, Ren, S0);
+ values ->
+ {Es, S1} = expr_list(cerl:values_es(E), Env, Ren, S0),
+ {cerl:update_c_values(E, Es), S1};
+ cons ->
+ {E1, S1} = expr(cerl:cons_hd(E), Env, Ren, S0),
+ {E2, S2} = expr(cerl:cons_tl(E), Env, Ren, S1),
+ {cerl:update_c_cons(E, E1, E2), S2};
+ tuple ->
+ {Es, S1} = expr_list(cerl:tuple_es(E), Env, Ren, S0),
+ {cerl:update_c_tuple(E, Es), S1};
+ 'let' ->
+ {A, S1} = expr(cerl:let_arg(E), Env, Ren, S0),
+ Vs = cerl:let_vars(E),
+ {Vs1, Env1, Ren1} = bind_vars(Vs, Env, Ren),
+ {B, S2} = expr(cerl:let_body(E), Env1, Ren1, S1),
+ {cerl:update_c_let(E, Vs1, A, B), S2};
+ seq ->
+ {A, S1} = expr(cerl:seq_arg(E), Env, Ren, S0),
+ {B, S2} = expr(cerl:seq_body(E), Env, Ren, S1),
+ {cerl:update_c_seq(E, A, B), S2};
+ apply ->
+ apply_expr(E, Env, Ren, S0);
+ call ->
+ {M, S1} = expr(cerl:call_module(E), Env, Ren, S0),
+ {N, S2} = expr(cerl:call_name(E), Env, Ren, S1),
+ {As, S3} = expr_list(cerl:call_args(E), Env, Ren, S2),
+ {cerl:update_c_call(E, M, N, As), S3};
+ primop ->
+ {As, S1} = expr_list(cerl:primop_args(E), Env, Ren, S0),
+ N = cerl:primop_name(E),
+ {cerl:update_c_primop(E, N, As), S1};
+ 'case' ->
+ {A, S1} = expr(cerl:case_arg(E), Env, Ren, S0),
+ {Cs, S2} = expr_list(cerl:case_clauses(E), Env, Ren, S1),
+ {cerl:update_c_case(E, A, Cs), S2};
+ clause ->
+ Vs = cerl:clause_vars(E),
+ {_, Env1, Ren1} = bind_vars(Vs, Env, Ren),
+ %% Visit patterns to rename variables.
+ Ps = pattern_list(cerl:clause_pats(E), Env1, Ren1),
+ {G, S1} = expr(cerl:clause_guard(E), Env1, Ren1, S0),
+ {B, S2} = expr(cerl:clause_body(E), Env1, Ren1, S1),
+ {cerl:update_c_clause(E, Ps, G, B), S2};
+ 'fun' ->
+ fun_expr(E, Env, Ren, S0);
+ 'receive' ->
+ {Cs, S1} = expr_list(cerl:receive_clauses(E), Env, Ren, S0),
+ {T, S2} = expr(cerl:receive_timeout(E), Env, Ren, S1),
+ {A, S3} = expr(cerl:receive_action(E), Env, Ren, S2),
+ {cerl:update_c_receive(E, Cs, T, A), S3};
+ 'try' ->
+ {A, S1} = expr(cerl:try_arg(E), Env, Ren, S0),
+ Vs = cerl:try_vars(E),
+ {Vs1, Env1, Ren1} = bind_vars(Vs, Env, Ren),
+ {B, S2} = expr(cerl:try_body(E), Env1, Ren1, S1),
+ Evs = cerl:try_evars(E),
+ {Evs1, Env2, Ren2} = bind_vars(Evs, Env, Ren),
+ {H, S3} = expr(cerl:try_handler(E), Env2, Ren2, S2),
+ {cerl:update_c_try(E, A, Vs1, B, Evs1, H), S3};
+ 'catch' ->
+ {B, S1} = expr(cerl:catch_body(E), Env, Ren, S0),
+ {cerl:update_c_catch(E, B), S1};
+ letrec ->
+ {Env1, Ren1, S1} = letrec_defs(cerl:letrec_defs(E), Env,
+ Ren, S0),
+ expr(cerl:letrec_body(E), Env1, Ren1, S1);
+ binary ->
+ {Segs, S1} = expr_list(cerl:binary_segments(E), Env, Ren, S0),
+ {cerl:update_c_binary(E, Segs),S1};
+ bitstr ->
+ {E1,S1} = expr(cerl:bitstr_val(E), Env, Ren, S0),
+ {E2,S2} = expr(cerl:bitstr_size(E), Env, Ren, S1),
+ E3 = cerl:bitstr_unit(E),
+ E4 = cerl:bitstr_type(E),
+ E5 = cerl:bitstr_flags(E),
+ {cerl:update_c_bitstr(E, E1, E2, E3, E4, E5), S2}
+ end.
+
+expr_list([E | Es], Env, Ren, S0) ->
+ {E1, S1} = expr(E, Env, Ren, S0),
+ {Es1, S2} = expr_list(Es, Env, Ren, S1),
+ {[E1 | Es1], S2};
+expr_list([], _, _, S) ->
+ {[], S}.
+
+pattern(E, Env, Ren) ->
+ case cerl:type(E) of
+ literal ->
+ E;
+ var ->
+ cerl:update_c_var(E, ren__map(cerl:var_name(E), Ren));
+ values ->
+ Es = pattern_list(cerl:values_es(E), Env, Ren),
+ cerl:update_c_values(E, Es);
+ cons ->
+ E1 = pattern(cerl:cons_hd(E), Env, Ren),
+ E2 = pattern(cerl:cons_tl(E), Env, Ren),
+ cerl:update_c_cons(E, E1, E2);
+ tuple ->
+ Es = pattern_list(cerl:tuple_es(E), Env, Ren),
+ cerl:update_c_tuple(E, Es);
+ binary ->
+ Es = pattern_list(cerl:binary_segments(E), Env, Ren),
+ cerl:update_c_binary(E, Es);
+ bitstr ->
+ E1 = pattern(cerl:bitstr_val(E), Env, Ren),
+ E2 = pattern(cerl:bitstr_size(E), Env, Ren),
+ E3 = cerl:bitstr_unit(E),
+ E4 = cerl:bitstr_type(E),
+ E5 = cerl:bitstr_flags(E),
+ cerl:update_c_bitstr(E, E1, E2, E3, E4, E5);
+ alias ->
+ V = pattern(cerl:alias_var(E), Env, Ren),
+ P = pattern(cerl:alias_pat(E), Env, Ren),
+ cerl:update_c_alias(E, V, P)
+ end.
+
+pattern_list([E | Es], Env, Ren) ->
+ [pattern(E, Env, Ren) | pattern_list(Es, Env, Ren)];
+pattern_list([], _, _) ->
+ [].
+
+%% First we set up the environment, binding the function names to the
+%% corresponding descriptors. (For the top level functions, we don't
+%% want to cause renaming.) After that, we can visit each function body
+%% and return the new function definitions and the final state.
+
+module_defs(Ds, Env, Ren, S) ->
+ {Env1, S1} = bind_module_defs(Ds, Env, S),
+ module_defs_1(Ds, [], Env1, Ren, S1).
+
+bind_module_defs([{V, _F} | Ds], Env, S) ->
+ Name = cerl:var_name(V),
+ check_function_name(Name, S),
+ S1 = s__add_function_name(Name, S),
+ Info = #function{name = Name, free = []},
+ Env1 = env__bind(Name, Info, Env),
+ bind_module_defs(Ds, Env1, S1);
+bind_module_defs([], Env, S) ->
+ {Env, S}.
+
+%% Checking that top-level function names are not reused
+
+check_function_name(Name, S) ->
+ case s__is_function_name(Name, S) of
+ true ->
+ error_msg("multiple definitions of function `~w'.", [Name]),
+ exit(error);
+ false ->
+ ok
+ end.
+
+%% We must track which top-level function we are in, for name generation
+%% purposes.
+
+module_defs_1([{V, F} | Ds], Ds1, Env, Ren, S) ->
+ S1 = s__enter_function(cerl:var_name(V), S),
+ %% The parameters should never need renaming, but this is easiest.
+ {Vs, Env1, Ren1} = bind_vars(cerl:fun_vars(F), Env, Ren),
+ {B, S2} = expr(cerl:fun_body(F), Env1, Ren1, S1),
+ F1 = cerl:update_c_fun(F, Vs, B),
+ module_defs_1(Ds, [{V, F1} | Ds1], Env, Ren, S2);
+module_defs_1([], Ds, _, _, S) ->
+ {Ds, S}.
+
+%% First we must create the new function names and set up the
+%% environment with descriptors for the letrec-bound functions.
+%%
+%% Since we never shadow variables, the free variables of any
+%% letrec-bound fun can always be referenced directly wherever the
+%% fun-variable itself is referenced - this is important when we create
+%% direct calls to lifted letrec-bound functions, and is the main reason
+%% why we do renaming. For example:
+%%
+%% 'f'/0 = fun () ->
+%% let X = 42 in
+%% letrec 'g'/1 = fun (Y) -> {X, Y} in
+%% let X = 17 in
+%% apply 'g'/1(X)
+%%
+%% will become something like
+%%
+%% 'f'/0 = fun () ->
+%% let X = 42 in
+%% let X1 = 17 in
+%% apply 'g'/2(X1, X)
+%% 'g'/2 = fun (Y, X) -> {X, Y}
+%%
+%% where the innermost X has been renamed so that the outermost X can be
+%% referenced in the call to the lifted function 'g'/2. (Renaming must
+%% of course also be applied also to letrec-bound function variables.)
+%%
+%% Furthermore, if some variable X occurs free in a fun 'f'/N, and 'f'/N
+%% it its turn occurs free in a fun 'g'/M, then we transitively count X
+%% as free in 'g'/M, even if it has no occurrence there. This allows us
+%% to rewrite code such as the following:
+%%
+%% 'f'/0 = fun () ->
+%% let X = 42 in
+%% letrec 'g'/1 = fun (Y) -> {X, Y}
+%% 'h'/1 = fun (Z) -> {'bar', apply 'g'/1(Z)}
+%% in let X = 17 in
+%% apply 'h'/1(X)
+%%
+%% into something like:
+%%
+%% 'f'/0 = fun () ->
+%% let X = 42 in
+%% let X1 = 17 in
+%% apply 'h'/2(X1, X)
+%% 'g'/2 = fun (Y, X) -> {X, Y}
+%% 'h'/2 = fun (Z, X) -> {'bar', apply 'g'/2(Z, X)}
+%%
+%% which uses only direct calls. The drawback is that if the occurrence
+%% of 'f'/N in 'g'/M instead would cause a closure to be created, then
+%% that closure could have been formed earlier (at the point where 'f'/N
+%% was defined), rather than passing on all the free variables of 'f'/N
+%% into 'g'/M. Since we must know the interface to 'g'/M (i.e., the
+%% total number of parameters) before we begin processing its body, and
+%% the interface depends on what we do to the body (and functions can be
+%% mutually recursive), this problem can only be solved by finding out
+%% _what_ we are going to do before we can even define the interfaces of
+%% the functions, by looking at _how_ variables are being referenced
+%% when we look for free variables. Currently, we don't do that.
+
+letrec_defs(Ds, Env, Ren, S) ->
+ {Env1, Ren1, S1} = bind_letrec_defs(Ds, Env, Ren, S),
+ {Env1, Ren1, lift_letrec_defs(Ds, Env1, Ren1, S1)}.
+
+%% Note: it is important that we store the *renamed* free variables for
+%% each function to be lifted.
+
+bind_letrec_defs(Ds, Env, Ren, S) ->
+ bind_letrec_defs(Ds, free_in_defs(Ds, Env, Ren), Env, Ren, S).
+
+bind_letrec_defs([{V, _F} | Ds], Free, Env, Ren, S) ->
+ Name = cerl:var_name(V),
+ {Env1, Ren1, S1} = bind_letrec_fun(Name, Free, Env, Ren, S),
+ bind_letrec_defs(Ds, Free, Env1, Ren1, S1);
+bind_letrec_defs([], _Free, Env, Ren, S) ->
+ {Env, Ren, S}.
+
+bind_letrec_fun(Name = {_,A}, Free, Env, Ren, S) ->
+ A1 = A + length(Free),
+ {Name1, Ren1, S1} = rename_letrec_fun(Name, A1, Env, Ren, S),
+ Info = #function{name = Name1, free = Free},
+ {env__bind(Name1, Info, Env), Ren1, S1}.
+
+%% Creating a new name for the lifted function that is informative, is
+%% not in the environment, and is not already used for some other lifted
+%% function.
+
+rename_letrec_fun(Name, NewArity, Env, Ren, S) ->
+ {New, S1} = new_letrec_fun_name(Name, NewArity, Env, S),
+ {New, ren__add(Name, New, Ren), s__add_function_name(New, S1)}.
+
+new_letrec_fun_name({N,_}, Arity, Env, S) ->
+ {FName, FArity} = s__get_function(S),
+ Base = fun_name_base(FName, FArity)
+ ++ "-letrec-" ++ atom_to_list(N) ++ "-",
+ %% We try the base as name first. This will usually work.
+ Name = {list_to_atom(Base), Arity},
+ case env__is_defined(Name, Env) of
+ true ->
+ new_fun_name(Base, Arity, Env, S);
+ false ->
+ case s__is_function_name(Name, S) of
+ true ->
+ new_fun_name(Base, Arity, Env, S);
+ false ->
+ {Name, S}
+ end
+ end.
+
+%% Processing the actual functions of a letrec
+
+lift_letrec_defs([{V, F} | Ds], Env, Ren, S) ->
+ Info = env__get(ren__map(cerl:var_name(V), Ren), Env),
+ S1 = lift_letrec_fun(F, Info, Env, Ren, S),
+ lift_letrec_defs(Ds, Env, Ren, S1);
+lift_letrec_defs([], _, _, S) ->
+ S.
+
+%% The direct calling convention for letrec-defined functions is to pass
+%% the free variables as additional parameters. Note that the free
+%% variables (if any) are already in the environment when we get here.
+%% We only have to append them to the parameter list so that they are in
+%% scope in the lifted function; they are already renamed.
+%%
+%% It should not be possible for the original parameters to clash with
+%% the free ones (in that case they cannot be free), but we do the full
+%% bind-and-rename anyway, since it's easiest.
+
+lift_letrec_fun(F, Info, Env, Ren, S) ->
+ {Vs, Env1, Ren1} = bind_vars(cerl:fun_vars(F), Env, Ren),
+ {B, S1} = expr(cerl:fun_body(F), Env1, Ren1, S),
+ Fs = [cerl:c_var(V) || V <- Info#function.free],
+ F1 = cerl:c_fun(Vs ++ Fs, B),
+ s__add_def(cerl:c_var(Info#function.name), F1, S1).
+
+%% This is a simple way of handling mutual recursion in a group of
+%% letrec-definitions: classify a variable as free in all the functions
+%% if it is free in any of them. (The preferred way would be to actually
+%% take the transitive closure for each function.)
+
+free_in_defs(Ds, Env, Ren) ->
+ {Vs, Fs} = free_in_defs(Ds, [], [], Ren),
+ closure_vars(ordsets:subtract(Fs, Vs), Env, Ren).
+
+free_in_defs([{V, F} | Ds], Vs, Free, Ren) ->
+ Fs = cerl_trees:free_variables(F),
+ free_in_defs(Ds, [ren__map(cerl:var_name(V), Ren) | Vs], Fs ++ Free,
+ Ren);
+free_in_defs([], Vs, Free, _Ren) ->
+ {ordsets:from_list(Vs), ordsets:from_list(Free)}.
+
+%% Replacing function variables with the free variables of the function
+
+closure_vars(Vs, Env, Ren) ->
+ closure_vars(Vs, [], Env, Ren).
+
+closure_vars([V = {_, _} | Vs], As, Env, Ren) ->
+ V1 = ren__map(V, Ren),
+ case env__lookup(V1, Env) of
+ {ok, #function{free = Vs1}} ->
+ closure_vars(Vs, Vs1 ++ As, Env, Ren);
+ _ ->
+ closure_vars(Vs, As, Env, Ren)
+ end;
+closure_vars([V | Vs], As, Env, Ren) ->
+ closure_vars(Vs, [V | As], Env, Ren);
+closure_vars([], As, _Env, _Ren) ->
+ ordsets:from_list(As).
+
+%% We use the no-shadowing strategy, renaming variables on the fly and
+%% only when necessary to uphold the invariant.
+
+bind_vars(Vs, Env, Ren) ->
+ bind_vars(Vs, [], Env, Ren).
+
+bind_vars([V | Vs], Vs1, Env, Ren) ->
+ Name = cerl:var_name(V),
+ {Name1, Ren1} = rename_var(Name, Env, Ren),
+ bind_vars(Vs, [cerl:update_c_var(V, Name1) | Vs1],
+ env__bind(Name1, variable, Env), Ren1);
+bind_vars([], Vs, Env, Ren) ->
+ {lists:reverse(Vs), Env, Ren}.
+
+rename_var(Name, Env, Ren) ->
+ case env__is_defined(Name, Env) of
+ false ->
+ {Name, Ren};
+ true ->
+ New = env__new_name(Env),
+ {New, ren__add(Name, New, Ren)}
+ end.
+
+%% This handles variable references *except* in function application
+%% operator positions (see apply_expr/4).
+%%
+%% The Beam compiler annotates function-variable references with 'id'
+%% info, eventually transforming a direct reference such as "fun f/2"
+%% into a new fun-expression "fun (X1,X2) -> apply f/2(X1,X2)" for which
+%% the info is used to create the lifted function as for any other fun.
+%% We do the same thing for function-bound variables.
+
+var(V, Env, Ren, S) ->
+ Name = ren__map(cerl:var_name(V), Ren),
+ case lookup_var(Name, Env) of
+ #function{name = F, free = Vs} ->
+ {_, Arity} = F,
+ Vs1 = make_vars(Arity),
+ C = cerl:c_apply(cerl:c_var(F), Vs1),
+ E = cerl:ann_c_fun(cerl:get_ann(V), Vs1, C),
+ fun_expr_1(E, Vs, Env, Ren, S);
+ variable ->
+ {cerl:update_c_var(V, Name), S}
+ end.
+
+lookup_var(V, Env) ->
+ case env__lookup(V, Env) of
+ {ok, X} ->
+ X;
+ error ->
+ error_msg("unbound variable `~P'.", [V, 5]),
+ exit(error)
+ end.
+
+make_vars(N) when N > 0 ->
+ [cerl:c_var(list_to_atom("X" ++ integer_to_list(N)))
+ | make_vars(N - 1)];
+make_vars(0) ->
+ [].
+
+%% All funs that are not bound by module or letrec definitions will be
+%% rewritten to create explicit closures using "make fun". We don't
+%% currently track ordinary let-bindings of funs, as in "let F = fun
+%% ... in ...apply F(...)...".
+%%
+%% Note that we (currently) follow the Beam naming convention, including
+%% the free variables in the arity of the name, even though the actual
+%% function typically expects a different number of parameters.
+
+fun_expr(F, Env, Ren, S) ->
+ Free = closure_vars(cerl_trees:free_variables(F), Env, Ren),
+ Vs = [cerl:c_var(V) || V <- Free],
+ fun_expr_1(F, Vs, Env, Ren, S).
+
+fun_expr_1(F, Vs, Env, Ren, S) ->
+ Arity = cerl:fun_arity(F) + length(Vs), % for the name only
+ {Info, S1} = fun_info(F, Env, S),
+ Name = {Info#fun_info.name, Arity},
+ S2 = lift_fun(Name, F, Vs, Env, Ren, S1),
+ {make_fun_primop(Name, Vs, Info, F, S2), S2}.
+
+make_fun_primop({Name, Arity}, Free, #fun_info{id = Id, hash = Hash},
+ F, S) ->
+ Module = s__get_module_name(S),
+ cerl:update_c_primop(F, cerl:c_atom(?PRIMOP_MAKE_FUN),
+ [cerl:c_atom(Module),
+ cerl:c_atom(Name),
+ cerl:c_int(Arity),
+ cerl:c_int(Hash),
+ cerl:c_int(Id),
+ cerl:make_list(Free)]).
+
+%% Getting attached fun-info, if present; otherwise making it up.
+
+fun_info(E, Env, S) ->
+ case lists:keyfind(id, 1, cerl:get_ann(E)) of
+ {id, {Id, H, Name}} ->
+ %% io:fwrite("Got fun-info: ~w: {~w,~w}.\n", [Name,Id,H]),
+ {#fun_info{name = Name, id = Id, hash = H}, S};
+ _ ->
+ io:fwrite("Warning - fun not annotated: "
+ "making up new name.\n"), % for now
+ {{Name,_Arity}, S1} = new_fun_name(E, Env, S),
+ {#fun_info{name = Name, id = 0, hash = 0}, S1}
+ end.
+
+fun_name_base(FName, FArity) ->
+ "-" ++ atom_to_list(FName) ++ "/" ++ integer_to_list(FArity).
+
+%% Generate a name for the new function, using a the same convention
+%% that is used by the Beam compiler.
+new_fun_name(F, Env, S) ->
+ {FName, FArity} = s__get_function(S),
+ Base = fun_name_base(FName, FArity) ++ "-fun-",
+ Arity = cerl:fun_arity(F),
+ new_fun_name(Base, Arity, Env, S).
+
+%% Creating a new function name that is not in the environment and is
+%% not already used for some other lifted function.
+
+new_fun_name(Base, Arity, Env, S) ->
+ F = fun (N) ->
+ {list_to_atom(Base ++ integer_to_list(N)), Arity}
+ end,
+ new_fun_name(Base, Arity, Env, S, F).
+
+new_fun_name(Base, Arity, Env, S, F) ->
+ %% Note that repeated calls to env__new_function_name/2 will yield
+ %% different names even though Env and F are the same.
+ Name = env__new_function_name(F, Env),
+ case s__is_function_name(Name, S) of
+ true ->
+ new_fun_name(Base, Arity, Env, S, F);
+ false ->
+ {Name, S}
+ end.
+
+%% This lifts the fun to a new top-level function which uses the calling
+%% convention for closures, with the closure itself as the final
+%% parameter. Note that the free variables (if any) are already in the
+%% environment.
+%%
+%% It should not be possible for the original parameters to clash with
+%% the free ones (in that case they cannot be free), but we do the full
+%% bind-and-rename anyway, since it's easiest.
+
+lift_fun(Name, F, Free, Env, Ren, S) ->
+ %% If the name is already in the list of top-level definitions, we
+ %% assume we have already generated this function, and do not need
+ %% to do it again (typically, this happens for 'fun f/n'-variables
+ %% that have been duplicated before being rewritten to actual
+ %% fun-expressions, and the name is taken from their annotations).
+ %% Otherwise, we add the name to the list.
+ case s__is_function_name(Name, S) of
+ true ->
+ S;
+ false ->
+ S1 = s__add_function_name(Name, S),
+ lift_fun_1(Name, F, Free, Env, Ren, S1)
+ end.
+
+lift_fun_1(Name, F, Free, Env, Ren, S) ->
+ %% (The original parameters must be added to the environment before
+ %% we generate the new variable for the closure parameter.)
+ {Vs, Env1, Ren1} = bind_vars(cerl:fun_vars(F), Env, Ren),
+ V = env__new_name(Env1),
+ Env2 = env__bind(V, variable, Env1),
+ {B, S1} = expr(cerl:fun_body(F), Env2, Ren1, S),
+ %% We unpack all free variables from the closure upon entering.
+ %% (Adding this to the body before we process it would introduce
+ %% unnecessary, although harmless, renaming of the free variables.)
+ Es = closure_elements(length(Free), cerl:c_var(V)),
+ B1 = cerl:c_let(Free, cerl:c_values(Es), B),
+ %% The closure itself is passed as the last argument. The new
+ %% function is annotated as being a closure-call entry point.
+ E = cerl:ann_c_fun([closure, {closure_orig_arity, cerl:fun_arity(F)}], Vs ++ [cerl:c_var(V)], B1),
+ s__add_def(cerl:c_var(Name), E, S1).
+
+closure_elements(N, V) ->
+ closure_elements(N, N + 1, V).
+
+closure_elements(0, _, _) -> [];
+closure_elements(N, M, V) ->
+ [cerl:c_primop(cerl:c_atom(?PRIMOP_FUN_ELEMENT),
+ [cerl:c_int(M - N), V])
+ | closure_elements(N - 1, M, V)].
+
+
+%% Function applications must be rewritten depending on the
+%% operator. For a call to a known top-level function or letrec-bound
+%% function, we make a direct call, passing the free variables as extra
+%% parameters (we know they are in scope, since variables may not be
+%% shadowed). Otherwise, we create an "apply fun" primop call that
+%% expects a closure.
+
+apply_expr(E, Env, Ren, S) ->
+ {As, S1} = expr_list(cerl:apply_args(E), Env, Ren, S),
+ Op = cerl:apply_op(E),
+ case cerl:is_c_var(Op) of
+ true ->
+ Name = ren__map(cerl:var_name(Op), Ren),
+ case lookup_var(Name, Env) of
+ #function{name = F, free = Vs} ->
+ Vs1 = As ++ [cerl:c_var(V) || V <- Vs],
+ {cerl:update_c_apply(E, cerl:c_var(F), Vs1), S1};
+ variable ->
+ apply_expr_1(E, Op, As, Env, Ren, S1)
+ end;
+ _ ->
+ apply_expr_1(E, Op, As, Env, Ren, S1)
+ end.
+
+%% Note that this primop call only communicates the necessary
+%% information to the core-to-icode stage, which rewrites it to use the
+%% real calling convention for funs.
+
+apply_expr_1(E, Op, As, Env, Ren, S) ->
+ {Op1, S1} = expr(Op, Env, Ren, S),
+ Call = cerl:update_c_primop(E, cerl:c_atom(?PRIMOP_APPLY_FUN),
+ [Op1, cerl:make_list(As)]),
+ {Call, S1}.
+
+
+%% ---------------------------------------------------------------------
+%% Environment
+
+env__new() ->
+ rec_env:empty().
+
+env__bind(Key, Value, Env) ->
+ rec_env:bind(Key, Value, Env).
+
+env__lookup(Key, Env) ->
+ rec_env:lookup(Key, Env).
+
+env__get(Key, Env) ->
+ rec_env:get(Key, Env).
+
+env__is_defined(Key, Env) ->
+ rec_env:is_defined(Key, Env).
+
+env__new_name(Env) ->
+ rec_env:new_key(Env).
+
+env__new_function_name(F, Env) ->
+ rec_env:new_key(F, Env).
+
+
+%% ---------------------------------------------------------------------
+%% Renaming
+
+ren__new() ->
+ dict:new().
+
+ren__add(Key, Value, Ren) ->
+ dict:store(Key, Value, Ren).
+
+ren__map(Key, Ren) ->
+ case dict:find(Key, Ren) of
+ {ok, Value} ->
+ Value;
+ error ->
+ Key
+ end.
+
+
+%% ---------------------------------------------------------------------
+%% State
+
+-record(state, {module :: module(), function :: {atom(), arity()},
+ names, refs, defs = []}).
+
+s__new(Module) ->
+ #state{module = Module, names = sets:new(), refs = dict:new()}.
+
+s__add_function_name(Name, S) ->
+ S#state{names = sets:add_element(Name, S#state.names)}.
+
+s__is_function_name(Name, S) ->
+ sets:is_element(Name, S#state.names).
+
+s__get_module_name(S) ->
+ S#state.module.
+
+s__enter_function(F, S) ->
+ S#state{function = F}.
+
+s__get_function(S) ->
+ S#state.function.
+
+s__add_def(V, F, S) ->
+ S#state{defs = [{V, F} | S#state.defs]}.
+
+s__get_defs(S) ->
+ S#state.defs.
+
+
+%% ---------------------------------------------------------------------
+%% Reporting
+
+%% internal_error_msg(S) ->
+%% internal_error_msg(S, []).
+
+%% internal_error_msg(S, Vs) ->
+%% error_msg(lists:concat(["Internal error: ", S]), Vs).
+
+%% error_msg(S) ->
+%% error_msg(S, []).
+
+error_msg(S, Vs) ->
+ error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
+
+%% warning_msg(S) ->
+%% warning_msg(S, []).
+
+%% warning_msg(S, Vs) ->
+%% info_msg(lists:concat(["warning: ", S]), Vs).
+
+%% info_msg(S) ->
+%% info_msg(S, []).
+
+%% info_msg(S, Vs) ->
+%% error_logger:info_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
diff --git a/lib/hipe/cerl/cerl_closurean.erl b/lib/hipe/cerl/cerl_closurean.erl
new file mode 100644
index 0000000000..12771668ac
--- /dev/null
+++ b/lib/hipe/cerl/cerl_closurean.erl
@@ -0,0 +1,862 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% =====================================================================
+%% Closure analysis of Core Erlang programs.
+%%
+%% Copyright (C) 2001-2002 Richard Carlsson
+%%
+%% Author contact: richardc@it.uu.se
+%% =====================================================================
+
+%% TODO: might need a "top" (`any') element for any-length value lists.
+
+-module(cerl_closurean).
+
+-export([analyze/1, annotate/1]).
+%% The following functions are exported from this module since they
+%% are also used by Dialyzer (file dialyzer/src/dialyzer_dep.erl)
+-export([is_escape_op/2, is_escape_op/3, is_literal_op/2, is_literal_op/3]).
+
+-import(cerl, [ann_c_apply/3, ann_c_fun/3, ann_c_var/2, apply_args/1,
+ apply_op/1, atom_val/1, bitstr_size/1, bitstr_val/1,
+ binary_segments/1, c_letrec/2, c_seq/2, c_tuple/1,
+ c_nil/0, call_args/1, call_module/1, call_name/1,
+ case_arg/1, case_clauses/1, catch_body/1, clause_body/1,
+ clause_guard/1, clause_pats/1, cons_hd/1, cons_tl/1,
+ fun_body/1, fun_vars/1, get_ann/1, is_c_atom/1,
+ let_arg/1, let_body/1, let_vars/1, letrec_body/1,
+ letrec_defs/1, module_defs/1, module_defs/1,
+ module_exports/1, pat_vars/1, primop_args/1,
+ primop_name/1, receive_action/1, receive_clauses/1,
+ receive_timeout/1, seq_arg/1, seq_body/1, set_ann/2,
+ try_arg/1, try_body/1, try_vars/1, try_evars/1,
+ try_handler/1, tuple_es/1, type/1, values_es/1]).
+
+-import(cerl_trees, [get_label/1]).
+
+%% ===========================================================================
+
+-type label() :: integer() | 'top' | 'external' | 'external_call'.
+-type ordset(X) :: [X]. % XXX: TAKE ME OUT
+-type labelset() :: ordset(label()).
+-type outlist() :: [labelset()] | 'none'.
+-type escapes() :: labelset().
+
+%% ===========================================================================
+%% annotate(Tree) -> {Tree1, OutList, Outputs, Escapes, Dependencies, Parents}
+%%
+%% Tree = cerl:cerl()
+%%
+%% Analyzes `Tree' (see `analyze') and appends terms `{callers,
+%% Labels}' and `{calls, Labels}' to the annotation list of each
+%% fun-expression node and apply-expression node of `Tree',
+%% respectively, where `Labels' is an ordered-set list of labels of
+%% fun-expressions in `Tree', possibly also containing the atom
+%% `external', corresponding to the dependency information derived
+%% by the analysis. Any previous such annotations are removed from
+%% `Tree'. `Tree1' is the modified tree; for details on `OutList',
+%% `Outputs' , `Dependencies', `Escapes' and `Parents', see
+%% `analyze'.
+%%
+%% Note: `Tree' must be annotated with labels in order to use this
+%% function; see `analyze' for details.
+
+-spec annotate(cerl:cerl()) ->
+ {cerl:cerl(), outlist(), dict(), escapes(), dict(), dict()}.
+
+annotate(Tree) ->
+ {Xs, Out, Esc, Deps, Par} = analyze(Tree),
+ F = fun (T) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ X = case dict:find(L, Deps) of
+ {ok, X1} -> X1;
+ error -> set__new()
+ end,
+ set_ann(T, append_ann(callers,
+ set__to_list(X),
+ get_ann(T)));
+ apply ->
+ L = get_label(T),
+ X = case dict:find(L, Deps) of
+ {ok, X1} -> X1;
+ error -> set__new()
+ end,
+ set_ann(T, append_ann(calls,
+ set__to_list(X),
+ get_ann(T)));
+ _ ->
+%%% set_ann(T, []) % debug
+ T
+ end
+ end,
+ {cerl_trees:map(F, Tree), Xs, Out, Esc, Deps, Par}.
+
+append_ann(Tag, Val, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ append_ann(Tag, Val, Xs);
+ true ->
+ [X | append_ann(Tag, Val, Xs)]
+ end;
+append_ann(Tag, Val, []) ->
+ [{Tag, Val}].
+
+%% =====================================================================
+%% analyze(Tree) -> {OutList, Outputs, Escapes, Dependencies, Parents}
+%%
+%% Tree = cerl()
+%% OutList = [LabelSet] | none
+%% Outputs = dict(Label, OutList)
+%% Escapes = LabelSet
+%% Dependencies = dict(Label, LabelSet)
+%% LabelSet = ordset(Label)
+%% Label = integer() | top | external | external_call
+%% Parents = dict(Label, Label)
+%%
+%% Analyzes a module or an expression represented by `Tree'.
+%%
+%% The returned `OutList' is a list of sets of labels of
+%% fun-expressions which correspond to the possible closures in the
+%% value list produced by `Tree' (viewed as an expression; the
+%% "value" of a module contains its exported functions). The atom
+%% `none' denotes missing or conflicting information.
+%%
+%% The atom `external' in any label set denotes any possible
+%% function outside `Tree', including those in `Escapes'. The atom
+%% `top' denotes the top-level expression `Tree'.
+%%
+%% `Outputs' is a mapping from the labels of fun-expressions in
+%% `Tree' to corresponding lists of sets of labels of
+%% fun-expressions (or the atom `none'), representing the possible
+%% closures in the value lists returned by the respective
+%% functions.
+%%
+%% `Dependencies' is a similar mapping from the labels of
+%% fun-expressions and apply-expressions in `Tree' to sets of
+%% labels of corresponding fun-expressions which may contain call
+%% sites of the functions or be called from the call sites,
+%% respectively. Any such label not defined in `Dependencies'
+%% represents an unreachable function or a dead or faulty
+%% application.
+%%
+%% `Escapes' is the set of labels of fun-expressions in `Tree' such
+%% that corresponding closures may be accessed from outside `Tree'.
+%%
+%% `Parents' is a mapping from labels of fun-expressions in `Tree'
+%% to the corresponding label of the nearest containing
+%% fun-expression or top-level expression. This can be used to
+%% extend the dependency graph, for certain analyses.
+%%
+%% Note: `Tree' must be annotated with labels (as done by the
+%% function `cerl_trees:label/1') in order to use this function.
+%% The label annotation `{label, L}' (where L should be an integer)
+%% must be the first element of the annotation list of each node in
+%% the tree. Instances of variables bound in `Tree' which denote
+%% the same variable must have the same label; apart from this,
+%% labels should be unique. Constant literals do not need to be
+%% labeled.
+
+-record(state, {vars, out, dep, work, funs, par}).
+
+%% Note: In order to keep our domain simple, we assume that all remote
+%% calls and primops return a single value, if any.
+
+%% We use the terms `closure', `label', `lambda' and `fun-expression'
+%% interchangeably. The exact meaning in each case can be grasped from
+%% the context.
+%%
+%% Rules:
+%% 1) The implicit top level lambda escapes.
+%% 2) A lambda returned by an escaped lambda also escapes.
+%% 3) An escaped lambda can be passed an external lambda as argument.
+%% 4) A lambda passed as argument to an external lambda also escapes.
+%% 5) An argument passed to an unknown operation escapes.
+%% 6) A call to an unknown operation can return an external lambda.
+%%
+%% Escaped lambdas become part of the set of external lambdas, but this
+%% does not need to be represented explicitly.
+
+%% We wrap the given syntax tree T in a fun-expression labeled `top',
+%% which is initially in the set of escaped labels. `top' will be
+%% visited at least once.
+%%
+%% We create a separate function labeled `external', defined as:
+%% "'external'/1 = fun (Escape) -> do apply 'external'/1(apply Escape())
+%% 'external'/1", which will represent any and all functions outside T,
+%% and which returns itself, and contains a recursive call; this models
+%% rules 2 and 4 above. It will be revisited if the set of escaped
+%% labels changes, or at least once. Its parameter `Escape' is a
+%% variable labeled `escape', which will hold the set of escaped labels.
+%% initially it contains `top' and `external'.
+
+-spec analyze(cerl:cerl()) -> {outlist(), dict(), escapes(), dict(), dict()}.
+
+analyze(Tree) ->
+ %% Note that we use different name spaces for variable labels and
+ %% function/call site labels, so we can reuse some names here. We
+ %% assume that the labeling of Tree only uses integers, not atoms.
+ External = ann_c_var([{label, external}], {external, 1}),
+ Escape = ann_c_var([{label, escape}], 'Escape'),
+ ExtBody = c_seq(ann_c_apply([{label, loop}], External,
+ [ann_c_apply([{label, external_call}],
+ Escape, [])]),
+ External),
+ ExtFun = ann_c_fun([{label, external}], [Escape], ExtBody),
+%%% io:fwrite("external fun:\n~s.\n",
+%%% [cerl_prettypr:format(ExtFun, [noann])]),
+ Top = ann_c_var([{label, top}], {top, 0}),
+ TopFun = ann_c_fun([{label, top}], [], Tree),
+
+ %% The "start fun" just makes the initialisation easier. It will not
+ %% be marked as escaped, and thus cannot be called.
+ StartFun = ann_c_fun([{label, start}], [],
+ c_letrec([{External, ExtFun}, {Top, TopFun}],
+ c_nil())),
+%%% io:fwrite("start fun:\n~s.\n",
+%%% [cerl_prettypr:format(StartFun, [noann])]),
+
+ %% Gather a database of all fun-expressions in Tree and initialise
+ %% all their outputs and parameter variables. Bind all module- and
+ %% letrec-defined variables to their corresponding labels.
+ Funs0 = dict:new(),
+ Vars0 = dict:new(),
+ Out0 = dict:new(),
+ Empty = empty(),
+ F = fun (T, S = {Fs, Vs, Os}) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ As = fun_vars(T),
+ {dict:store(L, T, Fs),
+ bind_vars_single(As, Empty, Vs),
+ dict:store(L, none, Os)};
+ letrec ->
+ {Fs, bind_defs(letrec_defs(T), Vs), Os};
+ module ->
+ {Fs, bind_defs(module_defs(T), Vs), Os};
+ _ ->
+ S
+ end
+ end,
+ {Funs, Vars, Out} = cerl_trees:fold(F, {Funs0, Vars0, Out0},
+ StartFun),
+
+ %% Initialise Escape to the minimal set of escaped labels.
+ Vars1 = dict:store(escape, from_label_list([top, external]), Vars),
+
+ %% Enter the fixpoint iteration at the StartFun.
+ St = loop(StartFun, start, #state{vars = Vars1,
+ out = Out,
+ dep = dict:new(),
+ work = init_work(),
+ funs = Funs,
+ par = dict:new()}),
+%%% io:fwrite("dependencies: ~p.\n",
+%%% [[{X, set__to_list(Y)}
+%%% || {X, Y} <- dict:to_list(St#state.dep)]]),
+ {dict:fetch(top, St#state.out),
+ tidy_dict([start, top, external], St#state.out),
+ dict:fetch(escape, St#state.vars),
+ tidy_dict([loop], St#state.dep),
+ St#state.par}.
+
+tidy_dict([X | Xs], D) ->
+ tidy_dict(Xs, dict:erase(X, D));
+tidy_dict([], D) ->
+ D.
+
+loop(T, L, St0) ->
+%%% io:fwrite("analyzing: ~w.\n", [L]),
+%%% io:fwrite("work: ~w.\n", [St0#state.work]),
+ Xs0 = dict:fetch(L, St0#state.out),
+ {Xs, St1} = visit(fun_body(T), L, St0),
+ {W, M} = case equal(Xs0, Xs) of
+ true ->
+ {St1#state.work, St1#state.out};
+ false ->
+%%% io:fwrite("out (~w) changed: ~w <- ~w.\n",
+%%% [L, Xs, Xs0]),
+ M1 = dict:store(L, Xs, St1#state.out),
+ case dict:find(L, St1#state.dep) of
+ {ok, S} ->
+ {add_work(set__to_list(S), St1#state.work),
+ M1};
+ error ->
+ {St1#state.work, M1}
+ end
+ end,
+ St2 = St1#state{out = M},
+ case take_work(W) of
+ {ok, L1, W1} ->
+ T1 = dict:fetch(L1, St2#state.funs),
+ loop(T1, L1, St2#state{work = W1});
+ none ->
+ St2
+ end.
+
+visit(T, L, St) ->
+ case type(T) of
+ literal ->
+ {[empty()], St};
+ var ->
+ %% If a variable is not already in the store here, we
+ %% initialize it to empty().
+ L1 = get_label(T),
+ Vars = St#state.vars,
+ case dict:find(L1, Vars) of
+ {ok, X} ->
+ {[X], St};
+ error ->
+ X = empty(),
+ St1 = St#state{vars = dict:store(L1, X, Vars)},
+ {[X], St1}
+ end;
+ 'fun' ->
+ %% Must revisit the fun also, because its environment might
+ %% have changed. (We don't keep track of such dependencies.)
+ L1 = get_label(T),
+ St1 = St#state{work = add_work([L1], St#state.work),
+ par = set_parent([L1], L, St#state.par)},
+ {[singleton(L1)], St1};
+ values ->
+ visit_list(values_es(T), L, St);
+ cons ->
+ {Xs, St1} = visit_list([cons_hd(T), cons_tl(T)], L, St),
+ {[join_single_list(Xs)], St1};
+ tuple ->
+ {Xs, St1} = visit_list(tuple_es(T), L, St),
+ {[join_single_list(Xs)], St1};
+ 'let' ->
+ {Xs, St1} = visit(let_arg(T), L, St),
+ Vars = bind_vars(let_vars(T), Xs, St1#state.vars),
+ visit(let_body(T), L, St1#state{vars = Vars});
+ seq ->
+ {_, St1} = visit(seq_arg(T), L, St),
+ visit(seq_body(T), L, St1);
+ apply ->
+ {Xs, St1} = visit(apply_op(T), L, St),
+ {As, St2} = visit_list(apply_args(T), L, St1),
+ case Xs of
+ [X] ->
+ %% We store the dependency from the call site to the
+ %% called functions
+ Ls = set__to_list(X),
+ Out = St2#state.out,
+ Xs1 = join_list([dict:fetch(Lx, Out) || Lx <- Ls]),
+ St3 = call_site(Ls, L, As, St2),
+ L1 = get_label(T),
+ D = dict:store(L1, X, St3#state.dep),
+ {Xs1, St3#state{dep = D}};
+ none ->
+ {none, St2}
+ end;
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ {_, St1} = visit(M, L, St),
+ {_, St2} = visit(F, L, St1),
+ {Xs, St3} = visit_list(call_args(T), L, St2),
+ remote_call(M, F, Xs, St3);
+ primop ->
+ As = primop_args(T),
+ {Xs, St1} = visit_list(As, L, St),
+ primop_call(atom_val(primop_name(T)), length(Xs), Xs, St1);
+ 'case' ->
+ {Xs, St1} = visit(case_arg(T), L, St),
+ visit_clauses(Xs, case_clauses(T), L, St1);
+ 'receive' ->
+ X = singleton(external),
+ {Xs1, St1} = visit_clauses([X], receive_clauses(T), L, St),
+ {_, St2} = visit(receive_timeout(T), L, St1),
+ {Xs2, St3} = visit(receive_action(T), L, St2),
+ {join(Xs1, Xs2), St3};
+ 'try' ->
+ {Xs1, St1} = visit(try_arg(T), L, St),
+ X = singleton(external),
+ Vars = bind_vars(try_vars(T), [X], St1#state.vars),
+ {Xs2, St2} = visit(try_body(T), L, St1#state{vars = Vars}),
+ Evars = bind_vars(try_evars(T), [X, X, X], St2#state.vars),
+ {Xs3, St3} = visit(try_handler(T), L, St2#state{vars = Evars}),
+ {join(join(Xs1, Xs2), Xs3), St3};
+ 'catch' ->
+ {_, St1} = visit(catch_body(T), L, St),
+ {[singleton(external)], St1};
+ binary ->
+ {_, St1} = visit_list(binary_segments(T), L, St),
+ {[empty()], St1};
+ bitstr ->
+ %% The other fields are constant literals.
+ {_, St1} = visit(bitstr_val(T), L, St),
+ {_, St2} = visit(bitstr_size(T), L, St1),
+ {none, St2};
+ letrec ->
+ %% All the bound funs should be revisited, because the
+ %% environment might have changed.
+ Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
+ St1 = St#state{work = add_work(Ls, St#state.work),
+ par = set_parent(Ls, L, St#state.par)},
+ visit(letrec_body(T), L, St1);
+ module ->
+ %% All the exported functions escape, and can thus be passed
+ %% any external closures as arguments. We regard a module as
+ %% a tuple of function variables in the body of a `letrec'.
+ visit(c_letrec(module_defs(T), c_tuple(module_exports(T))),
+ L, St)
+ end.
+
+visit_clause(T, Xs, L, St) ->
+ Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
+ {_, St1} = visit(clause_guard(T), L, St#state{vars = Vars}),
+ visit(clause_body(T), L, St1).
+
+%% We assume correct value-list typing.
+
+visit_list([T | Ts], L, St) ->
+ {Xs, St1} = visit(T, L, St),
+ {Xs1, St2} = visit_list(Ts, L, St1),
+ X = case Xs of
+ [X1] -> X1;
+ none -> none
+ end,
+ {[X | Xs1], St2};
+visit_list([], _L, St) ->
+ {[], St}.
+
+visit_clauses(Xs, [T | Ts], L, St) ->
+ {Xs1, St1} = visit_clause(T, Xs, L, St),
+ {Xs2, St2} = visit_clauses(Xs, Ts, L, St1),
+ {join(Xs1, Xs2), St2};
+visit_clauses(_, [], _L, St) ->
+ {none, St}.
+
+bind_defs([{V, F} | Ds], Vars) ->
+ bind_defs(Ds, dict:store(get_label(V), singleton(get_label(F)),
+ Vars));
+bind_defs([], Vars) ->
+ Vars.
+
+bind_pats(Ps, none, Vars) ->
+ bind_pats_single(Ps, empty(), Vars);
+bind_pats(Ps, Xs, Vars) ->
+ if length(Xs) =:= length(Ps) ->
+ bind_pats_list(Ps, Xs, Vars);
+ true ->
+ bind_pats_single(Ps, empty(), Vars)
+ end.
+
+bind_pats_list([P | Ps], [X | Xs], Vars) ->
+ bind_pats_list(Ps, Xs, bind_vars_single(pat_vars(P), X, Vars));
+bind_pats_list([], [], Vars) ->
+ Vars.
+
+bind_pats_single([P | Ps], X, Vars) ->
+ bind_pats_single(Ps, X, bind_vars_single(pat_vars(P), X, Vars));
+bind_pats_single([], _X, Vars) ->
+ Vars.
+
+bind_vars(Vs, none, Vars) ->
+ bind_vars_single(Vs, empty(), Vars);
+bind_vars(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_vars_list(Vs, Xs, Vars);
+ true ->
+ bind_vars_single(Vs, empty(), Vars)
+ end.
+
+bind_vars_list([V | Vs], [X | Xs], Vars) ->
+ bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
+bind_vars_list([], [], Vars) ->
+ Vars.
+
+bind_vars_single([V | Vs], X, Vars) ->
+ bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
+bind_vars_single([], _X, Vars) ->
+ Vars.
+
+%% This handles a call site - adding dependencies and updating parameter
+%% variables with respect to the actual parameters. The 'external'
+%% function is handled specially, since it can get an arbitrary number
+%% of arguments, which must be unified into a single argument.
+
+call_site(Ls, L, Xs, St) ->
+%%% io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, Xs]),
+ {D, W, V} = call_site(Ls, L, Xs, St#state.dep, St#state.work,
+ St#state.vars, St#state.funs),
+ St#state{dep = D, work = W, vars = V}.
+
+call_site([external | Ls], T, Xs, D, W, V, Fs) ->
+ D1 = add_dep(external, T, D),
+ X = join_single_list(Xs),
+ case bind_arg(escape, X, V) of
+ {V1, true} ->
+%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n",
+%%% [dict:fetch(escape, V1), dict:fetch(escape, V),
+%%% X]),
+ {W1, V2} = update_esc(set__to_list(X), W, V1, Fs),
+ call_site(Ls, T, Xs, D1, add_work([external], W1), V2, Fs);
+ {V1, false} ->
+ call_site(Ls, T, Xs, D1, W, V1, Fs)
+ end;
+call_site([L | Ls], T, Xs, D, W, V, Fs) ->
+ D1 = add_dep(L, T, D),
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args(Vs, Xs, V) of
+ {V1, true} ->
+ call_site(Ls, T, Xs, D1, add_work([L], W), V1, Fs);
+ {V1, false} ->
+ call_site(Ls, T, Xs, D1, W, V1, Fs)
+ end;
+call_site([], _, _, D, W, V, _) ->
+ {D, W, V}.
+
+%% Note that `visit' makes sure all lambdas are visited at least once.
+%% For every called function, we add a dependency from the *called*
+%% function to the function containing the call site.
+
+add_dep(Source, Target, Deps) ->
+ case dict:find(Source, Deps) of
+ {ok, X} ->
+ case set__is_member(Target, X) of
+ true ->
+ Deps;
+ false ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__add(Target, X), Deps)
+ end;
+ error ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__singleton(Target), Deps)
+ end.
+
+%% If the arity does not match the call, nothing is done here.
+
+bind_args(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_args(Vs, Xs, Vars, false);
+ true ->
+ {Vars, false}
+ end.
+
+bind_args([V | Vs], [X | Xs], Vars, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Ch),
+ bind_args(Vs, Xs, Vars1, Ch1);
+bind_args([], [], Vars, Ch) ->
+ {Vars, Ch}.
+
+bind_args_single(Vs, X, Vars) ->
+ bind_args_single(Vs, X, Vars, false).
+
+bind_args_single([V | Vs], X, Vars, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Ch),
+ bind_args_single(Vs, X, Vars1, Ch1);
+bind_args_single([], _, Vars, Ch) ->
+ {Vars, Ch}.
+
+bind_arg(L, X, Vars) ->
+ bind_arg(L, X, Vars, false).
+
+bind_arg(L, X, Vars, Ch) ->
+ X0 = dict:fetch(L, Vars),
+ X1 = join_single(X, X0),
+ case equal_single(X0, X1) of
+ true ->
+ {Vars, Ch};
+ false ->
+%%% io:fwrite("arg (~w) changed: ~w <- ~w + ~w.\n",
+%%% [L, X1, X0, X]),
+ {dict:store(L, X1, Vars), true}
+ end.
+
+%% This handles escapes from things like primops and remote calls.
+
+%% escape(none, St) ->
+%% St;
+escape([X], St) ->
+ Vars = St#state.vars,
+ X0 = dict:fetch(escape, Vars),
+ X1 = join_single(X, X0),
+ case equal_single(X0, X1) of
+ true ->
+ St;
+ false ->
+%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]),
+%%% io:fwrite("updating escaping funs: ~w.\n", [set__to_list(X)]),
+ Vars1 = dict:store(escape, X1, Vars),
+ {W, Vars2} = update_esc(set__to_list(set__subtract(X, X0)),
+ St#state.work, Vars1,
+ St#state.funs),
+ St#state{work = add_work([external], W), vars = Vars2}
+ end.
+
+%% For all escaping lambdas, since they might be called from outside the
+%% program, all their arguments may be an external lambda. (Note that we
+%% only have to include the `external' label once per escaping lambda.)
+%% If the escape set has changed, we need to revisit the `external' fun.
+
+update_esc(Ls, W, V, Fs) ->
+ update_esc(Ls, singleton(external), W, V, Fs).
+
+%% The external lambda is skipped here - the Escape variable is known to
+%% contain `external' from the start.
+
+update_esc([external | Ls], X, W, V, Fs) ->
+ update_esc(Ls, X, W, V, Fs);
+update_esc([L | Ls], X, W, V, Fs) ->
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args_single(Vs, X, V) of
+ {V1, true} ->
+ update_esc(Ls, X, add_work([L], W), V1, Fs);
+ {V1, false} ->
+ update_esc(Ls, X, W, V1, Fs)
+ end;
+update_esc([], _, W, V, _) ->
+ {W, V}.
+
+set_parent([L | Ls], L1, D) ->
+ set_parent(Ls, L1, dict:store(L, L1, D));
+set_parent([], _L1, D) ->
+ D.
+
+%% Handle primop calls: (At present, we assume that all unknown primops
+%% yield exactly one value. This might have to be changed.)
+
+primop_call(F, A, Xs, St0) ->
+ case is_pure_op(F, A) of
+ %% XXX: this case is currently not possible -- commented out.
+ %% true ->
+ %% case is_literal_op(F, A) of
+ %% true -> {[empty()], St0};
+ %% false -> {[join_single_list(Xs)], St0}
+ %% end;
+ false ->
+ St1 = case is_escape_op(F, A) of
+ true -> escape([join_single_list(Xs)], St0);
+ false -> St0
+ end,
+ case is_literal_op(F, A) of
+ true -> {none, St1};
+ false -> {[singleton(external)], St1}
+ end
+ end.
+
+%% Handle remote-calls: (At present, we assume that all unknown calls
+%% yield exactly one value. This might have to be changed.)
+
+remote_call(M, F, Xs, St) ->
+ case is_c_atom(M) andalso is_c_atom(F) of
+ true ->
+ remote_call_1(atom_val(M), atom_val(F), length(Xs), Xs, St);
+ false ->
+ %% Unknown function
+ {[singleton(external)], escape([join_single_list(Xs)], St)}
+ end.
+
+remote_call_1(M, F, A, Xs, St0) ->
+ case is_pure_op(M, F, A) of
+ true ->
+ case is_literal_op(M, F, A) of
+ true -> {[empty()], St0};
+ false -> {[join_single_list(Xs)], St0}
+ end;
+ false ->
+ St1 = case is_escape_op(M, F, A) of
+ true -> escape([join_single_list(Xs)], St0);
+ false -> St0
+ end,
+ case is_literal_op(M, F, A) of
+ true -> {[empty()], St1};
+ false -> {[singleton(external)], St1}
+ end
+ end.
+
+%% Domain: none | [Vs], where Vs = set(integer()).
+
+join(none, Xs2) -> Xs2;
+join(Xs1, none) -> Xs1;
+join(Xs1, Xs2) ->
+ if length(Xs1) =:= length(Xs2) ->
+ join_1(Xs1, Xs2);
+ true ->
+ none
+ end.
+
+join_1([X1 | Xs1], [X2 | Xs2]) ->
+ [join_single(X1, X2) | join_1(Xs1, Xs2)];
+join_1([], []) ->
+ [].
+
+empty() -> set__new().
+
+singleton(X) -> set__singleton(X).
+
+from_label_list(X) -> set__from_list(X).
+
+join_single(none, Y) -> Y;
+join_single(X, none) -> X;
+join_single(X, Y) -> set__union(X, Y).
+
+join_list([Xs | Xss]) ->
+ join(Xs, join_list(Xss));
+join_list([]) ->
+ none.
+
+join_single_list([X | Xs]) ->
+ join_single(X, join_single_list(Xs));
+join_single_list([]) ->
+ empty().
+
+equal(none, none) -> true;
+equal(none, _) -> false;
+equal(_, none) -> false;
+equal(X1, X2) -> equal_1(X1, X2).
+
+equal_1([X1 | Xs1], [X2 | Xs2]) ->
+ equal_single(X1, X2) andalso equal_1(Xs1, Xs2);
+equal_1([], []) -> true;
+equal_1(_, _) -> false.
+
+equal_single(X, Y) -> set__equal(X, Y).
+
+%% Set abstraction for label sets in the domain.
+
+set__new() -> [].
+
+set__singleton(X) -> [X].
+
+set__to_list(S) -> S.
+
+set__from_list(S) -> ordsets:from_list(S).
+
+set__union(X, Y) -> ordsets:union(X, Y).
+
+set__add(X, S) -> ordsets:add_element(X, S).
+
+set__is_member(X, S) -> ordsets:is_element(X, S).
+
+set__subtract(X, Y) -> ordsets:subtract(X, Y).
+
+set__equal(X, Y) -> X =:= Y.
+
+%% A simple but efficient functional queue.
+
+queue__new() -> {[], []}.
+
+queue__put(X, {In, Out}) -> {[X | In], Out}.
+
+queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
+queue__get({[], _}) -> empty;
+queue__get({In, _}) ->
+ [X | In1] = lists:reverse(In),
+ {ok, X, {[], In1}}.
+
+%% The work list - a queue without repeated elements.
+
+init_work() ->
+ {queue__new(), sets:new()}.
+
+add_work(Ls, {Q, Set}) ->
+ add_work(Ls, Q, Set).
+
+%% Note that the elements are enqueued in order.
+
+add_work([L | Ls], Q, Set) ->
+ case sets:is_element(L, Set) of
+ true ->
+ add_work(Ls, Q, Set);
+ false ->
+ add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
+ end;
+add_work([], Q, Set) ->
+ {Q, Set}.
+
+take_work({Queue0, Set0}) ->
+ case queue__get(Queue0) of
+ {ok, L, Queue1} ->
+ Set1 = sets:del_element(L, Set0),
+ {ok, L, {Queue1, Set1}};
+ empty ->
+ none
+ end.
+
+%% Escape operators may let their arguments escape. Unless we know
+%% otherwise, and the function is not pure, we assume this is the case.
+%% Error-raising functions (fault/match_fail) are not considered as
+%% escapes (but throw/exit are). Zero-argument functions need not be
+%% listed.
+
+-spec is_escape_op(atom(), arity()) -> boolean().
+
+is_escape_op(match_fail, 1) -> false;
+is_escape_op(F, A) when is_atom(F), is_integer(A) -> true.
+
+-spec is_escape_op(module(), atom(), arity()) -> boolean().
+
+is_escape_op(erlang, error, 1) -> false;
+is_escape_op(erlang, error, 2) -> false;
+is_escape_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> true.
+
+%% "Literal" operators will never return functional values even when
+%% found in their arguments. Unless we know otherwise, we assume this is
+%% not the case. (More functions can be added to this list, if needed
+%% for better precision. Note that the result of `term_to_binary' still
+%% contains an encoding of the closure.)
+
+-spec is_literal_op(atom(), arity()) -> boolean().
+
+is_literal_op(match_fail, 1) -> true;
+is_literal_op(F, A) when is_atom(F), is_integer(A) -> false.
+
+-spec is_literal_op(module(), atom(), arity()) -> boolean().
+
+is_literal_op(erlang, '+', 2) -> true;
+is_literal_op(erlang, '-', 2) -> true;
+is_literal_op(erlang, '*', 2) -> true;
+is_literal_op(erlang, '/', 2) -> true;
+is_literal_op(erlang, '=:=', 2) -> true;
+is_literal_op(erlang, '==', 2) -> true;
+is_literal_op(erlang, '=/=', 2) -> true;
+is_literal_op(erlang, '/=', 2) -> true;
+is_literal_op(erlang, '<', 2) -> true;
+is_literal_op(erlang, '=<', 2) -> true;
+is_literal_op(erlang, '>', 2) -> true;
+is_literal_op(erlang, '>=', 2) -> true;
+is_literal_op(erlang, 'and', 2) -> true;
+is_literal_op(erlang, 'or', 2) -> true;
+is_literal_op(erlang, 'not', 1) -> true;
+is_literal_op(erlang, length, 1) -> true;
+is_literal_op(erlang, size, 1) -> true;
+is_literal_op(erlang, fun_info, 1) -> true;
+is_literal_op(erlang, fun_info, 2) -> true;
+is_literal_op(erlang, fun_to_list, 1) -> true;
+is_literal_op(erlang, throw, 1) -> true;
+is_literal_op(erlang, exit, 1) -> true;
+is_literal_op(erlang, error, 1) -> true;
+is_literal_op(erlang, error, 2) -> true;
+is_literal_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> false.
+
+%% Pure functions neither affect the state, nor depend on it.
+
+is_pure_op(F, A) when is_atom(F), is_integer(A) -> false.
+
+is_pure_op(M, F, A) -> erl_bifs:is_pure(M, F, A).
+
+%% =====================================================================
diff --git a/lib/hipe/cerl/cerl_hipe_primops.hrl b/lib/hipe/cerl/cerl_hipe_primops.hrl
new file mode 100644
index 0000000000..36b1b62901
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hipe_primops.hrl
@@ -0,0 +1,88 @@
+%% ========================-*-erlang-*-=================================
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Predefined Core Erlang primitive operations used by HiPE
+%%
+%% Copyright (C) 2000 Richard Carlsson
+%%
+%% Author contact: richardc@it.uu.se
+%% =====================================================================
+
+%% These definitions give the names of Core Erlang primops recognized by
+%% HiPE. Many of them (e.g., 'not'/'and'/'or', and the type tests), are
+%% not primops on the Icode level, but are inline-expanded by the
+%% translation from Core Erlang to Icode, or are renamed/rewritten to a
+%% corresponding ICode primop; they only exist to help the translation.
+
+%%-define(PRIMOP_IDENTITY, identity). % arity 1
+-define(PRIMOP_NOT, 'not'). % arity 1
+-define(PRIMOP_AND, 'and'). % arity 2
+-define(PRIMOP_OR, 'or'). % arity 2
+-define(PRIMOP_XOR, 'xor'). % arity 2
+-define(PRIMOP_ADD, '+'). % arity 2
+-define(PRIMOP_SUB, '-'). % arity 2
+-define(PRIMOP_NEG, neg). % arity 1
+-define(PRIMOP_MUL, '*'). % arity 2
+-define(PRIMOP_DIV, '/'). % arity 2
+-define(PRIMOP_INTDIV, 'div'). % arity 2
+-define(PRIMOP_REM, 'rem'). % arity 2
+-define(PRIMOP_BAND, 'band'). % arity 2
+-define(PRIMOP_BOR, 'bor'). % arity 2
+-define(PRIMOP_BXOR, 'bxor'). % arity 2
+-define(PRIMOP_BNOT, 'bnot'). % arity 1
+-define(PRIMOP_BSL, 'bsl'). % arity 2
+-define(PRIMOP_BSR, 'bsr'). % arity 2
+-define(PRIMOP_EQ, '=='). % arity 2
+-define(PRIMOP_NE, '/='). % arity 2
+-define(PRIMOP_EXACT_EQ, '=:='). % arity 2
+-define(PRIMOP_EXACT_NE, '=/='). % arity 2
+-define(PRIMOP_LT, '<'). % arity 2
+-define(PRIMOP_GT, '>'). % arity 2
+-define(PRIMOP_LE, '=<'). % arity 2
+-define(PRIMOP_GE, '>='). % arity 2
+-define(PRIMOP_IS_ATOM, 'is_atom'). % arity 1
+-define(PRIMOP_IS_BIGNUM, 'is_bignum'). % arity 1
+-define(PRIMOP_IS_BINARY, 'is_binary'). % arity 1
+-define(PRIMOP_IS_CONSTANT, 'is_constant'). % arity 1
+-define(PRIMOP_IS_FIXNUM, 'is_fixnum'). % arity 1
+-define(PRIMOP_IS_FLOAT, 'is_float'). % arity 1
+-define(PRIMOP_IS_FUNCTION, 'is_function'). % arity 1
+-define(PRIMOP_IS_INTEGER, 'is_integer'). % arity 1
+-define(PRIMOP_IS_LIST, 'is_list'). % arity 1
+-define(PRIMOP_IS_NUMBER, 'is_number'). % arity 1
+-define(PRIMOP_IS_PID, 'is_pid'). % arity 1
+-define(PRIMOP_IS_PORT, 'is_port'). % arity 1
+-define(PRIMOP_IS_REFERENCE, 'is_reference'). % arity 1
+-define(PRIMOP_IS_TUPLE, 'is_tuple'). % arity 1
+-define(PRIMOP_IS_RECORD, 'is_record'). % arity 3
+-define(PRIMOP_EXIT, exit). % arity 1
+-define(PRIMOP_THROW, throw). % arity 1
+-define(PRIMOP_ERROR, error). % arity 1,2
+-define(PRIMOP_RETHROW, raise). % arity 2
+-define(PRIMOP_RECEIVE_SELECT, receive_select). % arity 0
+-define(PRIMOP_RECEIVE_NEXT, receive_next). % arity 0
+-define(PRIMOP_ELEMENT, element). % arity 2
+-define(PRIMOP_DSETELEMENT, dsetelement). % arity 3
+-define(PRIMOP_MAKE_FUN, make_fun). % arity 6
+-define(PRIMOP_APPLY_FUN, apply_fun). % arity 2
+-define(PRIMOP_FUN_ELEMENT, closure_element). % arity 2
+-define(PRIMOP_SET_LABEL, set_label). % arity 1
+-define(PRIMOP_GOTO_LABEL, goto_label). % arity 1
+-define(PRIMOP_REDUCTION_TEST, reduction_test). % arity 0
+-define(PRIMOP_BS_CONTEXT_TO_BINARY, bs_context_to_binary). % arity 1
diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl
new file mode 100644
index 0000000000..8f6c3561c9
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hipeify.erl
@@ -0,0 +1,655 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <richardc@it.uu.se>
+%% @copyright 2000-2004 Richard Carlsson
+%% @doc HiPE-ification of Core Erlang code. Prepares Core Erlang code
+%% for translation to ICode.
+%% @see cerl_to_icode
+
+-module(cerl_hipeify).
+
+-define(NO_UNUSED, true).
+
+-export([transform/2]).
+-ifndef(NO_UNUSED).
+-export([core_transform/2]).
+-endif.
+
+-include("cerl_hipe_primops.hrl").
+
+-record(ctxt, {class = expr}).
+
+
+%% @spec core_transform(Module::cerl_records(), Options::[term()]) ->
+%% cerl_records()
+%%
+%% @doc Transforms a module represented by records. See
+%% <code>transform/2</code> for details.
+%%
+%% <p>Use the compiler option <code>{core_transform,
+%% cerl_hipeify}</code> to insert this function as a compilation
+%% pass.</p>
+%%
+%% @see transform/2
+
+-ifndef(NO_UNUSED).
+core_transform(M, Opts) ->
+ cerl:to_records(transform(cerl:from_records(M), Opts)).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%% cerl() = cerl:cerl()
+%%
+%% @doc Rewrites a Core Erlang module to a form suitable for further
+%% translation to HiPE Icode. See module <code>cerl_to_icode</code> for
+%% details.
+%%
+%% @see cerl_to_icode
+%% @see cerl_cconv
+
+-spec transform(cerl:c_module(), [term()]) -> cerl:c_module().
+
+transform(E, Opts) ->
+ %% Start by closure converting the code
+ module(cerl_cconv:transform(E, Opts), Opts).
+
+module(E, Opts) ->
+ {Ds, Env, Ren} = add_defs(cerl:module_defs(E), env__new(),
+ ren__new()),
+ M = cerl:module_name(E),
+ S0 = s__new(cerl:atom_val(M)),
+ S = s__set_pmatch(proplists:get_value(pmatch, Opts, true), S0),
+ {Ds1, _} = defs(Ds, true, Env, Ren, S),
+ cerl:update_c_module(E, M, cerl:module_exports(E),
+ cerl:module_attrs(E), Ds1).
+
+%% Note that the environment is defined on the renamed variables.
+
+expr(E0, Env, Ren, Ctxt, S0) ->
+ %% Do peephole optimizations as we traverse the code.
+ E = cerl_lib:reduce_expr(E0),
+ case cerl:type(E) of
+ literal ->
+ {E, S0};
+ var ->
+ variable(E, Env, Ren, Ctxt, S0);
+ values ->
+ {Es, S1} = expr_list(cerl:values_es(E), Env, Ren, Ctxt, S0),
+ {cerl:update_c_values(E, Es), S1};
+ cons ->
+ {E1, S1} = expr(cerl:cons_hd(E), Env, Ren, Ctxt, S0),
+ {E2, S2} = expr(cerl:cons_tl(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_cons(E, E1, E2), S2};
+ tuple ->
+ {Es, S1} = expr_list(cerl:tuple_es(E), Env, Ren, Ctxt, S0),
+ {cerl:update_c_tuple(E, Es), S1};
+ 'let' ->
+ let_expr(E, Env, Ren, Ctxt, S0);
+ seq ->
+ {A, S1} = expr(cerl:seq_arg(E), Env, Ren, Ctxt, S0),
+ {B, S2} = expr(cerl:seq_body(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_seq(E, A, B), S2};
+ apply ->
+ {Op, S1} = expr(cerl:apply_op(E), Env, Ren, Ctxt, S0),
+ {As, S2} = expr_list(cerl:apply_args(E), Env, Ren, Ctxt, S1),
+ {cerl:update_c_apply(E, Op, As), S2};
+ call ->
+ {M, S1} = expr(cerl:call_module(E), Env, Ren, Ctxt, S0),
+ {N, S2} = expr(cerl:call_name(E), Env, Ren, Ctxt, S1),
+ {As, S3} = expr_list(cerl:call_args(E), Env, Ren, Ctxt, S2),
+ {rewrite_call(E, M, N, As, S3), S3};
+ primop ->
+ {As, S1} = expr_list(cerl:primop_args(E), Env, Ren, Ctxt, S0),
+ N = cerl:primop_name(E),
+ {rewrite_primop(E, N, As, S1), S1};
+ 'case' ->
+ case_expr(E, Env, Ren, Ctxt, S0);
+ 'fun' ->
+ Vs = cerl:fun_vars(E),
+ {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ {B, S1} = expr(cerl:fun_body(E), Env1, Ren1, Ctxt, S0),
+ {cerl:update_c_fun(E, Vs1, B), S1};
+ 'receive' ->
+ receive_expr(E, Env, Ren, Ctxt, S0);
+ 'try' ->
+ {A, S1} = expr(cerl:try_arg(E), Env, Ren, Ctxt, S0),
+ Vs = cerl:try_vars(E),
+ {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ {B, S2} = expr(cerl:try_body(E), Env1, Ren1, Ctxt, S1),
+ Evs = cerl:try_evars(E),
+ {Evs1, Env2, Ren2} = add_vars(Evs, Env, Ren),
+ {H, S3} = expr(cerl:try_handler(E), Env2, Ren2, Ctxt, S2),
+ {cerl:update_c_try(E, A, Vs1, B, Evs1, H), S3};
+ 'catch' ->
+ catch_expr(E, Env, Ren, Ctxt, S0);
+ letrec ->
+ {Ds, Env1, Ren1} = add_defs(cerl:letrec_defs(E), Env, Ren),
+ {Ds1, S1} = defs(Ds, false, Env1, Ren1, S0),
+ {B, S2} = expr(cerl:letrec_body(E), Env1, Ren1, Ctxt, S1),
+ {cerl:update_c_letrec(E, Ds1, B), S2};
+ binary ->
+ {Segs, S1} = expr_list(cerl:binary_segments(E), Env, Ren,
+ Ctxt, S0),
+ {cerl:update_c_binary(E, Segs), S1};
+ bitstr ->
+ {E1,S1} = expr(cerl:bitstr_val(E), Env, Ren, Ctxt, S0),
+ {E2,S2} = expr(cerl:bitstr_size(E), Env, Ren, Ctxt, S1),
+ E3 = cerl:bitstr_unit(E),
+ E4 = cerl:bitstr_type(E),
+ E5 = cerl:bitstr_flags(E),
+ {cerl:update_c_bitstr(E, E1, E2, E3, E4, E5), S2}
+ end.
+
+guard_expr(E, Env, Ren, Ctxt, S) ->
+ expr(E, Env, Ren, Ctxt#ctxt{class = guard}, S).
+
+expr_list(Es, Env, Ren, Ctxt, S0) ->
+ list(Es, Env, Ren, Ctxt, S0, fun expr/5).
+
+list([E | Es], Env, Ren, Ctxt, S0, F) ->
+ {E1, S1} = F(E, Env, Ren, Ctxt, S0),
+ {Es1, S2} = list(Es, Env, Ren, Ctxt, S1, F),
+ {[E1 | Es1], S2};
+list([], _, _, _, S, _) ->
+ {[], S}.
+
+pattern(E, Env, Ren) ->
+ case cerl:type(E) of
+ literal ->
+ E;
+ var ->
+ cerl:update_c_var(E, ren__map(cerl:var_name(E), Ren));
+ values ->
+ Es = pattern_list(cerl:values_es(E), Env, Ren),
+ cerl:update_c_values(E, Es);
+ cons ->
+ E1 = pattern(cerl:cons_hd(E), Env, Ren),
+ E2 = pattern(cerl:cons_tl(E), Env, Ren),
+ cerl:update_c_cons(E, E1, E2);
+ tuple ->
+ Es = pattern_list(cerl:tuple_es(E), Env, Ren),
+ cerl:update_c_tuple(E, Es);
+ alias ->
+ V = pattern(cerl:alias_var(E), Env, Ren),
+ P = pattern(cerl:alias_pat(E), Env, Ren),
+ cerl:update_c_alias(E, V, P);
+ binary ->
+ Segs = pattern_list(cerl:binary_segments(E), Env, Ren),
+ cerl:update_c_binary(E, Segs);
+ bitstr ->
+ E1 = pattern(cerl:bitstr_val(E), Env, Ren),
+ E2 = pattern(cerl:bitstr_size(E), Env, Ren),
+ E3 = cerl:bitstr_unit(E),
+ E4 = cerl:bitstr_type(E),
+ E5 = cerl:bitstr_flags(E),
+ cerl:update_c_bitstr(E, E1, E2, E3, E4, E5)
+ end.
+
+pattern_list(ExprList, Env, Ren) ->
+ [pattern(E, Env, Ren) || E <- ExprList].
+
+%% Visit the function body of each definition. We insert an explicit
+%% reduction test at the start of each function.
+
+defs(Ds, Top, Env, Ren, S) ->
+ defs(Ds, [], Top, Env, Ren, S).
+
+defs([{V, F} | Ds], Ds1, Top, Env, Ren, S0) ->
+ S1 = case Top of
+ true -> s__enter_function(cerl:var_name(V), S0);
+ false -> S0
+ end,
+ {B, S2} = expr(cerl:fun_body(F), Env, Ren, #ctxt{}, S1),
+ B1 = cerl:c_seq(cerl:c_primop(cerl:c_atom(?PRIMOP_REDUCTION_TEST), []),
+ B),
+ F1 = cerl:update_c_fun(F, cerl:fun_vars(F), B1),
+ defs(Ds, [{V, F1} | Ds1], Top, Env, Ren, S2);
+defs([], Ds, _Top, _Env, _Ren, S) ->
+ {lists:reverse(Ds), S}.
+
+case_expr(E, Env, Ren, Ctxt, S0) ->
+ {A, S1} = expr(cerl:case_arg(E), Env, Ren, Ctxt, S0),
+ {Cs, S2} = clause_list(cerl:case_clauses(E), Env, Ren, Ctxt, S1),
+ case s__get_revisit(S2) of
+ false ->
+ {E1, Vs, S3} = pmatch(Cs, Env, Ren, Ctxt, S2),
+ {cerl:c_let(Vs, A, E1), S3};
+ true ->
+ {cerl:c_case(A, Cs), S2}
+ end.
+
+%% Note: There is an ordering problem with switch-clauses and pattern
+%% matching compilation. We must process any receive-clauses first,
+%% making the message queue operations explicit, before we can do
+%% pattern matching compilation. However, the latter can introduce new
+%% expressions - in particular new guards - which also need processing.
+%% Hence, we must process the clauses, then do pattern matching
+%% compilation, and then re-visit the resulting expression with pattern
+%% matching compilation disabled.
+
+pmatch(Cs, Env, _Ren, Ctxt, S0) ->
+ {E, Vs} = case s__get_pmatch(S0) of
+ true ->
+ cerl_pmatch:clauses(Cs, Env);
+ no_duplicates ->
+ put('cerl_pmatch_duplicate_code', never),
+ cerl_pmatch:clauses(Cs, Env);
+ duplicate_all ->
+ put('cerl_pmatch_duplicate_code', always),
+ cerl_pmatch:clauses(Cs, Env);
+ false ->
+ Vs0 = new_vars(cerl:clause_arity(hd(Cs)), Env),
+ {cerl:c_case(cerl:c_values(Vs0), Cs), Vs0}
+ end,
+ %% Revisit the resulting expression. Pass an empty renaming, since
+ %% all variables in E have already been properly renamed and must
+ %% not be renamed again by accident.
+ {E1, S1} = expr(E, Env, ren__new(), Ctxt, s__set_revisit(true, S0)),
+ {E1, Vs, s__set_revisit(false, S1)}.
+
+clause_list(Cs, Env, Ren, Ctxt, S) ->
+ list(Cs, Env, Ren, Ctxt, S, fun clause/5).
+
+clause(E, Env, Ren, Ctxt, S0) ->
+ Vs = cerl:clause_vars(E),
+ {_, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ %% Visit patterns to rename variables.
+ Ps = pattern_list(cerl:clause_pats(E), Env1, Ren1),
+ {G, S1} = guard_expr(cerl:clause_guard(E), Env1, Ren1, Ctxt, S0),
+ {B, S2} = expr(cerl:clause_body(E), Env1, Ren1, Ctxt, S1),
+ {cerl:update_c_clause(E, Ps, G, B), S2}.
+
+%% We use the no-shadowing strategy, renaming variables on the fly and
+%% only when necessary to uphold the invariant.
+
+add_vars(Vs, Env, Ren) ->
+ add_vars(Vs, [], Env, Ren).
+
+add_vars([V | Vs], Vs1, Env, Ren) ->
+ Name = cerl:var_name(V),
+ {Name1, Ren1} = rename(Name, Env, Ren),
+ add_vars(Vs, [cerl:update_c_var(V, Name1) | Vs1],
+ env__bind(Name1, variable, Env), Ren1);
+add_vars([], Vs, Env, Ren) ->
+ {lists:reverse(Vs), Env, Ren}.
+
+rename(Name, Env, Ren) ->
+ case env__is_defined(Name, Env) of
+ false ->
+ {Name, Ren};
+ true ->
+ New = env__new_name(Env),
+ {New, ren__add(Name, New, Ren)}
+ end.
+
+%% Setting up the environment for a list of letrec-bound definitions.
+
+add_defs(Ds, Env, Ren) ->
+ add_defs(Ds, [], Env, Ren).
+
+add_defs([{V, F} | Ds], Ds1, Env, Ren) ->
+ Name = cerl:var_name(V),
+ {Name1, Ren1} =
+ case env__is_defined(Name, Env) of
+ false ->
+ {Name, Ren};
+ true ->
+ {N, A} = Name,
+ S = atom_to_list(N) ++ "_",
+ F1 = fun (Num) ->
+ {list_to_atom(S ++ integer_to_list(Num)), A}
+ end,
+ New = env__new_function_name(F1, Env),
+ {New, ren__add(Name, New, Ren)}
+ end,
+ add_defs(Ds, [{cerl:update_c_var(V, Name1), F} | Ds1],
+ env__bind(Name1, function, Env), Ren1);
+add_defs([], Ds, Env, Ren) ->
+ {lists:reverse(Ds), Env, Ren}.
+
+%% We change remote calls to important built-in functions into primop
+%% calls. In some cases (e.g., for the boolean operators), this is
+%% mainly to allow the cerl_to_icode module to handle them more
+%% straightforwardly. In most cases however, it is simply because they
+%% are supposed to be represented as primop calls on the Icode level.
+
+rewrite_call(E, M, F, As, S) ->
+ case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
+ true ->
+ case call_to_primop(cerl:atom_val(M),
+ cerl:atom_val(F),
+ length(As))
+ of
+ {yes, ?PRIMOP_IS_RECORD} ->
+ %% Needs additional testing
+ [_, Tag, Arity] = As,
+ case (cerl:is_c_atom(Tag) andalso
+ cerl:is_c_int(Arity)) of
+ true ->
+ %% The primop might need further handling
+ N1 = cerl:c_atom(?PRIMOP_IS_RECORD),
+ E1 = cerl:update_c_primop(E, N1, As),
+ rewrite_primop(E1, N1, As, S);
+ false ->
+ cerl:update_c_call(E, M, F, As)
+ end;
+ {yes, N} ->
+ %% The primop might need further handling
+ N1 = cerl:c_atom(N),
+ E1 = cerl:update_c_primop(E, N1, As),
+ rewrite_primop(E1, N1, As, S);
+ no ->
+ cerl:update_c_call(E, M, F, As)
+ end;
+ false ->
+ cerl:update_c_call(E, M, F, As)
+ end.
+
+call_to_primop(erlang, 'not', 1) -> {yes, ?PRIMOP_NOT};
+call_to_primop(erlang, 'and', 2) -> {yes, ?PRIMOP_AND};
+call_to_primop(erlang, 'or', 2) -> {yes, ?PRIMOP_OR};
+call_to_primop(erlang, 'xor', 2) -> {yes, ?PRIMOP_XOR};
+call_to_primop(erlang, '+', 2) -> {yes, ?PRIMOP_ADD};
+%%call_to_primop(erlang, '+', 1) -> {yes, ?PRIMOP_IDENTITY};
+call_to_primop(erlang, '-', 2) -> {yes, ?PRIMOP_SUB};
+call_to_primop(erlang, '-', 1) -> {yes, ?PRIMOP_NEG};
+call_to_primop(erlang, '*', 2) -> {yes, ?PRIMOP_MUL};
+call_to_primop(erlang, '/', 2) -> {yes, ?PRIMOP_DIV};
+call_to_primop(erlang, 'div', 2) -> {yes, ?PRIMOP_INTDIV};
+call_to_primop(erlang, 'rem', 2) -> {yes, ?PRIMOP_REM};
+call_to_primop(erlang, 'band', 2) -> {yes, ?PRIMOP_BAND};
+call_to_primop(erlang, 'bor', 2) -> {yes, ?PRIMOP_BOR};
+call_to_primop(erlang, 'bxor', 2) -> {yes, ?PRIMOP_BXOR};
+call_to_primop(erlang, 'bnot', 1) -> {yes, ?PRIMOP_BNOT};
+call_to_primop(erlang, 'bsl', 2) -> {yes, ?PRIMOP_BSL};
+call_to_primop(erlang, 'bsr', 2) -> {yes, ?PRIMOP_BSR};
+call_to_primop(erlang, '==', 2) -> {yes, ?PRIMOP_EQ};
+call_to_primop(erlang, '/=', 2) -> {yes, ?PRIMOP_NE};
+call_to_primop(erlang, '=:=', 2) -> {yes, ?PRIMOP_EXACT_EQ};
+call_to_primop(erlang, '=/=', 2) -> {yes, ?PRIMOP_EXACT_NE};
+call_to_primop(erlang, '<', 2) -> {yes, ?PRIMOP_LT};
+call_to_primop(erlang, '>', 2) -> {yes, ?PRIMOP_GT};
+call_to_primop(erlang, '=<', 2) -> {yes, ?PRIMOP_LE};
+call_to_primop(erlang, '>=', 2) -> {yes, ?PRIMOP_GE};
+call_to_primop(erlang, is_atom, 1) -> {yes, ?PRIMOP_IS_ATOM};
+call_to_primop(erlang, is_binary, 1) -> {yes, ?PRIMOP_IS_BINARY};
+call_to_primop(erlang, is_constant, 1) -> {yes, ?PRIMOP_IS_CONSTANT};
+call_to_primop(erlang, is_float, 1) -> {yes, ?PRIMOP_IS_FLOAT};
+call_to_primop(erlang, is_function, 1) -> {yes, ?PRIMOP_IS_FUNCTION};
+call_to_primop(erlang, is_integer, 1) -> {yes, ?PRIMOP_IS_INTEGER};
+call_to_primop(erlang, is_list, 1) -> {yes, ?PRIMOP_IS_LIST};
+call_to_primop(erlang, is_number, 1) -> {yes, ?PRIMOP_IS_NUMBER};
+call_to_primop(erlang, is_pid, 1) -> {yes, ?PRIMOP_IS_PID};
+call_to_primop(erlang, is_port, 1) -> {yes, ?PRIMOP_IS_PORT};
+call_to_primop(erlang, is_reference, 1) -> {yes, ?PRIMOP_IS_REFERENCE};
+call_to_primop(erlang, is_tuple, 1) -> {yes, ?PRIMOP_IS_TUPLE};
+call_to_primop(erlang, internal_is_record, 3) -> {yes, ?PRIMOP_IS_RECORD};
+call_to_primop(erlang, is_record, 3) -> {yes, ?PRIMOP_IS_RECORD};
+call_to_primop(erlang, element, 2) -> {yes, ?PRIMOP_ELEMENT};
+call_to_primop(erlang, exit, 1) -> {yes, ?PRIMOP_EXIT};
+call_to_primop(erlang, throw, 1) -> {yes, ?PRIMOP_THROW};
+call_to_primop(erlang, error, 1) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(erlang, error, 2) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> no.
+
+%% Also, some primops (introduced by Erlang to Core Erlang translation
+%% and possibly other stages) must be recognized and rewritten.
+
+rewrite_primop(E, N, As, S) ->
+ case {cerl:atom_val(N), As} of
+ {match_fail, [R]} ->
+ M = s__get_module_name(S),
+ {F, A} = s__get_function_name(S),
+ Stack = cerl:abstract([{M, F, A}]),
+ case cerl:type(R) of
+ tuple ->
+ %% Function clause failures have a special encoding
+ %% as '{function_clause, Arg1, ..., ArgN}'.
+ case cerl:tuple_es(R) of
+ [X | Xs] ->
+ case cerl:is_c_atom(X) of
+ true ->
+ case cerl:atom_val(X) of
+ function_clause ->
+ FStack = cerl:make_list(
+ [cerl:c_tuple(
+ [cerl:c_atom(M),
+ cerl:c_atom(F),
+ cerl:make_list(Xs)])]),
+ match_fail(E, X, FStack);
+ _ ->
+ match_fail(E, R, Stack)
+ end;
+ false ->
+ match_fail(E, R, Stack)
+ end;
+ _ ->
+ match_fail(E, R, Stack)
+ end;
+ _ ->
+ match_fail(E, R, Stack)
+ end;
+ _ ->
+ cerl:update_c_primop(E, N, As)
+ end.
+
+match_fail(E, R, Stack) ->
+ cerl:update_c_primop(E, cerl:c_atom(?PRIMOP_ERROR), [R, Stack]).
+
+%% Simple let-definitions (of degree 1) in guard context are always
+%% inline expanded. This is allowable, since they cannot have side
+%% effects, and it makes it easy to generate good code for boolean
+%% expressions. It could cause repeated evaluations, but typically,
+%% local definitions within guards are used exactly once.
+
+let_expr(E, Env, Ren, Ctxt, S) ->
+ if Ctxt#ctxt.class =:= guard ->
+ case cerl:let_vars(E) of
+ [V] ->
+ {Name, Ren1} = rename(cerl:var_name(V), Env, Ren),
+ Env1 = env__bind(Name, {expr, cerl:let_arg(E)}, Env),
+ expr(cerl:let_body(E), Env1, Ren1, Ctxt, S);
+ _ ->
+ let_expr_1(E, Env, Ren, Ctxt, S)
+ end;
+ true ->
+ let_expr_1(E, Env, Ren, Ctxt, S)
+ end.
+
+let_expr_1(E, Env, Ren, Ctxt, S0) ->
+ {A, S1} = expr(cerl:let_arg(E), Env, Ren, Ctxt, S0),
+ Vs = cerl:let_vars(E),
+ {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+ {B, S2} = expr(cerl:let_body(E), Env1, Ren1, Ctxt, S1),
+ {cerl:update_c_let(E, Vs1, A, B), S2}.
+
+variable(E, Env, Ren, Ctxt, S) ->
+ V = ren__map(cerl:var_name(E), Ren),
+ if Ctxt#ctxt.class =:= guard ->
+ case env__lookup(V, Env) of
+ {ok, {expr, E1}} ->
+ expr(E1, Env, Ren, Ctxt, S); % inline
+ _ ->
+ %% Since we don't track all bindings when we revisit
+ %% guards, some names will not be in the environment.
+ variable_1(E, V, S)
+ end;
+ true ->
+ variable_1(E, V, S)
+ end.
+
+variable_1(E, V, S) ->
+ {cerl:update_c_var(E, V), S}.
+
+%% A catch-expression 'catch Expr' is rewritten as:
+%%
+%% try Expr
+%% of (V) -> V
+%% catch (T, V, E) ->
+%% letrec 'wrap'/1 = fun (V) -> {'EXIT', V}
+%% in case T of
+%% 'throw' when 'true' -> V
+%% 'exit' when 'true' -> 'wrap'/1(V)
+%% V when 'true' ->
+%% 'wrap'/1({V, erlang:get_stacktrace()})
+%% end
+
+catch_expr(E, Env, Ren, Ctxt, S) ->
+ T = cerl:c_var('T'),
+ V = cerl:c_var('V'),
+ X = cerl:c_var('X'),
+ W = cerl:c_var({wrap,1}),
+ G = cerl:c_call(cerl:c_atom('erlang'),cerl:c_atom('get_stacktrace'),[]),
+ Cs = [cerl:c_clause([cerl:c_atom('throw')], V),
+ cerl:c_clause([cerl:c_atom('exit')], cerl:c_apply(W, [V])),
+ cerl:c_clause([T], cerl:c_apply(W, [cerl:c_tuple([V,G])]))
+ ],
+ C = cerl:c_case(T, Cs),
+ F = cerl:c_fun([V], cerl:c_tuple([cerl:c_atom('EXIT'), V])),
+ H = cerl:c_letrec([{W,F}], C),
+ As = cerl:get_ann(E),
+ {B, S1} = expr(cerl:catch_body(E),Env, Ren, Ctxt, S),
+ {cerl:ann_c_try(As, B, [V], V, [T,V,X], H), S1}.
+
+%% Receive-expressions are rewritten as follows:
+%%
+%% receive
+%% P1 when G1 -> B1
+%% ...
+%% Pn when Gn -> Bn
+%% after T -> A end
+%% becomes:
+%% receive
+%% M when 'true' ->
+%% case M of
+%% P1 when G1 -> do primop RECEIVE_SELECT B1
+%% ...
+%% Pn when Gn -> do primop RECEIVE_SELECT Bn
+%% Pn+1 when 'true' -> primop RECEIVE_NEXT()
+%% end
+%% after T -> A end
+
+receive_expr(E, Env, Ren, Ctxt, S0) ->
+ case s__get_revisit(S0) of
+ false ->
+ Cs = receive_clauses(cerl:receive_clauses(E)),
+ {Cs1, S1} = clause_list(Cs, Env, Ren, Ctxt, S0),
+ {B, Vs, S2} = pmatch(Cs1, Env, Ren, Ctxt, S1),
+ {T, S3} = expr(cerl:receive_timeout(E), Env, Ren, Ctxt, S2),
+ {A, S4} = expr(cerl:receive_action(E), Env, Ren, Ctxt, S3),
+ {cerl:update_c_receive(E, [cerl:c_clause(Vs, B)], T, A), S4};
+ true ->
+ %% we should never enter a receive-expression twice
+ {E, S0}
+ end.
+
+receive_clauses([C | Cs]) ->
+ Call = cerl:c_primop(cerl:c_atom(?PRIMOP_RECEIVE_SELECT), []),
+ B = cerl:c_seq(Call, cerl:clause_body(C)),
+ C1 = cerl:update_c_clause(C, cerl:clause_pats(C),
+ cerl:clause_guard(C), B),
+ [C1 | receive_clauses(Cs)];
+receive_clauses([]) ->
+ Call = cerl:c_primop(cerl:c_atom(?PRIMOP_RECEIVE_NEXT), []),
+ V = cerl:c_var('X'), % any name is ok
+ [cerl:c_clause([V], Call)].
+
+new_vars(N, Env) ->
+ [cerl:c_var(V) || V <- env__new_names(N, Env)].
+
+%% ---------------------------------------------------------------------
+%% Environment
+
+env__new() ->
+ rec_env:empty().
+
+env__bind(Key, Value, Env) ->
+ rec_env:bind(Key, Value, Env).
+
+%% env__get(Key, Env) ->
+%% rec_env:get(Key, Env).
+
+env__lookup(Key, Env) ->
+ rec_env:lookup(Key, Env).
+
+env__is_defined(Key, Env) ->
+ rec_env:is_defined(Key, Env).
+
+env__new_name(Env) ->
+ rec_env:new_key(Env).
+
+env__new_names(N, Env) ->
+ rec_env:new_keys(N, Env).
+
+env__new_function_name(F, Env) ->
+ rec_env:new_key(F, Env).
+
+%% ---------------------------------------------------------------------
+%% Renaming
+
+ren__new() ->
+ dict:new().
+
+ren__add(Key, Value, Ren) ->
+ dict:store(Key, Value, Ren).
+
+ren__map(Key, Ren) ->
+ case dict:find(Key, Ren) of
+ {ok, Value} ->
+ Value;
+ error ->
+ Key
+ end.
+
+%% ---------------------------------------------------------------------
+%% State
+
+%% pmatch = 'true' | 'false' | 'no_duplicates' | 'duplicate_all'
+
+-record(state, {module::atom(),
+ function::{atom(), 0..256},
+ pmatch=true,
+ revisit = false}).
+
+s__new(Module) ->
+ #state{module = Module}.
+
+s__get_module_name(S) ->
+ S#state.module.
+
+s__enter_function(F, S) ->
+ S#state{function = F}.
+
+s__get_function_name(S) ->
+ S#state.function.
+
+s__set_pmatch(V, S) ->
+ S#state{pmatch = V}.
+
+s__get_pmatch(S) ->
+ S#state.pmatch.
+
+s__set_revisit(V, S) ->
+ S#state{revisit = V}.
+
+s__get_revisit(S) ->
+ S#state.revisit.
diff --git a/lib/hipe/cerl/cerl_hybrid_transform.erl b/lib/hipe/cerl/cerl_hybrid_transform.erl
new file mode 100644
index 0000000000..b248b0ccd0
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hybrid_transform.erl
@@ -0,0 +1,153 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(cerl_hybrid_transform).
+
+%% Use compile option `{core_transform, cerl_hybrid_transform}' to
+%% insert this as a compilation pass.
+
+-export([transform/2, core_transform/2]).
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(Code, Opts) ->
+ cerl:to_records(transform(cerl:from_records(Code), Opts)).
+
+-spec transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+transform(Code, _Opts) ->
+ Code0 = cerl_trees:map(fun unfold_literal/1, Code),
+ {Code1, _} = cerl_trees:label(Code0),
+ io:fwrite("Running hybrid heap analysis..."),
+ {T1,_} = statistics(runtime),
+ {Code2, _, Vars} = cerl_messagean:annotate(Code1),
+ {T2,_} = statistics(runtime),
+ io:fwrite("(~w ms), transform...", [T2 - T1]),
+ Code3 = rewrite(Code2, Vars),
+ io:fwrite("done.\n"),
+ cerl_trees:map(fun fold_literal/1, Code3).
+
+unfold_literal(T) ->
+ cerl:unfold_literal(T).
+
+fold_literal(T) ->
+ cerl:fold_literal(T).
+
+%% If escape-annotated:
+%% {...} => hybrid:tuple([...])
+%% [H | T] => hybrid:cons(H, T)
+%%
+%% Wrapper for args to hybrid:cons/hybrid:tuple that may need copying:
+%% hybrid:copy(A)
+
+rewrite(Node, Vars) ->
+ case cerl:type(Node) of
+ tuple ->
+ Es = rewrite_list(cerl:tuple_es(Node), Vars),
+ case is_escaping(Node) of
+ false ->
+ cerl:update_c_tuple(Node, Es);
+ true ->
+ Es1 = wrap(Es, Node, Vars),
+ cerl:update_c_call(Node,
+ cerl:abstract(hybrid),
+ cerl:abstract(tuple),
+ [cerl:make_list(Es1)])
+%%% cerl:update_c_call(Node, cerl:abstract(hybrid),
+%%% cerl:abstract(tuple), Es1)
+ end;
+ cons ->
+ H = rewrite(cerl:cons_hd(Node), Vars),
+ T = rewrite(cerl:cons_tl(Node), Vars),
+ case is_escaping(Node) of
+ false ->
+ cerl:update_c_cons(Node, H, T);
+ true ->
+ Es = wrap([H, T], Node, Vars),
+ cerl:update_c_call(Node,
+ cerl:abstract(hybrid),
+ cerl:abstract(cons),
+ Es)
+ end;
+%%% call ->
+%%% M = rewrite(cerl:call_module(Node)),
+%%% F = rewrite(cerl:call_name(Node)),
+%%% As = rewrite_list(cerl:call_args(Node)),
+%%% case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
+%%% true ->
+%%% case {cerl:atom_val(M), cerl:atom_val(F), length(As)} of
+%%% {erlang, '!', 2} ->
+%%% cerl:update_c_call(Node,
+%%% cerl:abstract(hipe_bifs),
+%%% cerl:abstract(send),
+%%% [cerl:make_list(As)]);
+%%% _ ->
+%%% cerl:update_c_call(Node, M, F, As)
+%%% end;
+%%% false ->
+%%% cerl:update_c_call(Node, M, F, As)
+%%% end;
+ clause ->
+ B = rewrite(cerl:clause_body(Node), Vars),
+ cerl:update_c_clause(Node, cerl:clause_pats(Node),
+ cerl:clause_guard(Node), B);
+ primop ->
+ case cerl:atom_val(cerl:primop_name(Node)) of
+ match_fail ->
+ Node;
+ _ ->
+ As = rewrite_list(cerl:primop_args(Node), Vars),
+ cerl:update_c_primop(Node, cerl:primop_name(Node), As)
+ end;
+ _T ->
+ case cerl:subtrees(Node) of
+ [] ->
+ Node;
+ Gs ->
+ cerl:update_tree(Node, [rewrite_list(Ns, Vars)
+ || Ns <- Gs])
+ end
+ end.
+
+rewrite_list([N | Ns], Vars) ->
+ [rewrite(N, Vars) | rewrite_list(Ns, Vars)];
+rewrite_list([], _) ->
+ [].
+
+is_escaping(T) ->
+ lists:member(escapes, cerl:get_ann(T)).
+
+wrap(Es, Node, Vars) ->
+ L = cerl_trees:get_label(Node),
+ Xs = dict:fetch(L, Vars),
+ wrap(Es, Xs).
+
+wrap([E | Es], [{S, _} | Xs]) ->
+ case ordsets:is_element(unsafe, S) of
+%% case cerl:type(E) =/= literal of
+ true ->
+ [cerl:c_call(cerl:abstract(hybrid),
+ cerl:abstract(copy),
+ [E])
+ | wrap(Es, Xs)];
+ false ->
+ [E | wrap(Es, Xs)]
+ end;
+wrap([], _) ->
+ [].
diff --git a/lib/hipe/cerl/cerl_lib.erl b/lib/hipe/cerl/cerl_lib.erl
new file mode 100644
index 0000000000..83bb20e047
--- /dev/null
+++ b/lib/hipe/cerl/cerl_lib.erl
@@ -0,0 +1,462 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% @doc Utility functions for Core Erlang abstract syntax trees.
+%%
+%% <p>Syntax trees are defined in the module <a
+%% href=""><code>cerl</code></a>.</p>
+%%
+%% @type cerl() = cerl:cerl()
+
+-module(cerl_lib).
+
+-define(NO_UNUSED, true).
+
+-export([is_safe_expr/2, reduce_expr/1, is_simple_clause/1,
+ is_bool_switch/1, bool_switch_cases/1]).
+-ifndef(NO_UNUSED).
+-export([is_safe_expr/1, is_pure_expr/1, is_pure_expr/2,
+ make_bool_switch/3]).
+-endif.
+
+
+%% Test if a clause has a single pattern and an always-true guard.
+
+-spec is_simple_clause(cerl:c_clause()) -> boolean().
+
+is_simple_clause(C) ->
+ case cerl:clause_pats(C) of
+ [_P] ->
+ G = cerl:clause_guard(C),
+ case cerl_clauses:eval_guard(G) of
+ {value, true} -> true;
+ _ -> false
+ end;
+ _ -> false
+ end.
+
+%% Creating an if-then-else construct that can be recognized as such.
+%% `Test' *must* be guaranteed to return a boolean.
+
+-ifndef(NO_UNUSED).
+make_bool_switch(Test, True, False) ->
+ Cs = [cerl:c_clause([cerl:c_atom(true)], True),
+ cerl:c_clause([cerl:c_atom(false)], False)],
+ cerl:c_case(Test, Cs).
+-endif.
+
+%% A boolean switch cannot have a catch-all; only true/false branches.
+
+-spec is_bool_switch([cerl:c_clause()]) -> boolean().
+
+is_bool_switch([C1, C2]) ->
+ case is_simple_clause(C1) andalso is_simple_clause(C2) of
+ true ->
+ [P1] = cerl:clause_pats(C1),
+ [P2] = cerl:clause_pats(C2),
+ case cerl:is_c_atom(P1) andalso cerl:is_c_atom(P2) of
+ true ->
+ A1 = cerl:concrete(P1),
+ A2 = cerl:concrete(P2),
+ is_boolean(A1) andalso is_boolean(A2)
+ andalso A1 =/= A2;
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+is_bool_switch(_) ->
+ false.
+
+%% Returns the true-body and the false-body for boolean switch clauses.
+
+-spec bool_switch_cases([cerl:c_clause()]) -> {cerl:cerl(), cerl:cerl()}.
+
+bool_switch_cases([C1, C2]) ->
+ B1 = cerl:clause_body(C1),
+ B2 = cerl:clause_body(C2),
+ [P1] = cerl:clause_pats(C1),
+ case cerl:concrete(P1) of
+ true ->
+ {B1, B2};
+ false ->
+ {B2, B1}
+ end.
+
+%%
+%% The type of the check functions like the default check below - XXX: refine
+%%
+-type check_fun() :: fun((_, _) -> boolean()).
+
+%% The default function property check always returns `false':
+
+default_check(_Property, _Function) -> false.
+
+
+%% @spec is_safe_expr(Expr::cerl()) -> boolean()
+%%
+%% @doc Returns `true' if `Expr' represents a "safe" Core Erlang
+%% expression, otherwise `false'. An expression is safe if it always
+%% completes normally and does not modify the state (although the return
+%% value may depend on the state).
+%%
+%% Expressions of type `apply', `case', `receive' and `binary' are
+%% always considered unsafe by this function.
+
+%% TODO: update cerl_inline to use these functions instead.
+
+-ifndef(NO_UNUSED).
+is_safe_expr(E) ->
+ Check = fun default_check/2,
+ is_safe_expr(E, Check).
+-endif.
+%% @clear
+
+-spec is_safe_expr(cerl:cerl(), check_fun()) -> boolean().
+
+is_safe_expr(E, Check) ->
+ case cerl:type(E) of
+ literal ->
+ true;
+ var ->
+ true;
+ 'fun' ->
+ true;
+ values ->
+ is_safe_expr_list(cerl:values_es(E), Check);
+ tuple ->
+ is_safe_expr_list(cerl:tuple_es(E), Check);
+ cons ->
+ case is_safe_expr(cerl:cons_hd(E), Check) of
+ true ->
+ is_safe_expr(cerl:cons_tl(E), Check);
+ false ->
+ false
+ end;
+ 'let' ->
+ case is_safe_expr(cerl:let_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:let_body(E), Check);
+ false ->
+ false
+ end;
+ letrec ->
+ is_safe_expr(cerl:letrec_body(E), Check);
+ seq ->
+ case is_safe_expr(cerl:seq_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:seq_body(E), Check);
+ false ->
+ false
+ end;
+ 'catch' ->
+ is_safe_expr(cerl:catch_body(E), Check);
+ 'try' ->
+ %% If the guarded expression is safe, the try-handler will
+ %% never be evaluated, so we need only check the body. If
+ %% the guarded expression is pure, but could fail, we also
+ %% have to check the handler.
+ case is_safe_expr(cerl:try_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:try_body(E), Check);
+ false ->
+ case is_pure_expr(cerl:try_arg(E), Check) of
+ true ->
+ case is_safe_expr(cerl:try_body(E), Check) of
+ true ->
+ is_safe_expr(cerl:try_handler(E), Check);
+ false ->
+ false
+ end;
+ false ->
+ false
+ end
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ case Check(safe, {Name, length(As)}) of
+ true ->
+ is_safe_expr_list(As, Check);
+ false ->
+ false
+ end;
+ call ->
+ Module = cerl:call_module(E),
+ Name = cerl:call_name(E),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ As = cerl:call_args(E),
+ case Check(safe, {M, F, length(As)}) of
+ true ->
+ is_safe_expr_list(As, Check);
+ false ->
+ false
+ end;
+ false ->
+ false % Call to unknown function
+ end;
+ _ ->
+ false
+ end.
+
+is_safe_expr_list([E | Es], Check) ->
+ case is_safe_expr(E, Check) of
+ true ->
+ is_safe_expr_list(Es, Check);
+ false ->
+ false
+ end;
+is_safe_expr_list([], _Check) ->
+ true.
+
+
+%% @spec (Expr::cerl()) -> bool()
+%%
+%% @doc Returns `true' if `Expr' represents a "pure" Core Erlang
+%% expression, otherwise `false'. An expression is pure if it does not
+%% affect the state, nor depend on the state, although its evaluation is
+%% not guaranteed to complete normally for all input.
+%%
+%% Expressions of type `apply', `case', `receive' and `binary' are
+%% always considered impure by this function.
+
+-ifndef(NO_UNUSED).
+is_pure_expr(E) ->
+ Check = fun default_check/2,
+ is_pure_expr(E, Check).
+-endif.
+%% @clear
+
+is_pure_expr(E, Check) ->
+ case cerl:type(E) of
+ literal ->
+ true;
+ var ->
+ true;
+ 'fun' ->
+ true;
+ values ->
+ is_pure_expr_list(cerl:values_es(E), Check);
+ tuple ->
+ is_pure_expr_list(cerl:tuple_es(E), Check);
+ cons ->
+ case is_pure_expr(cerl:cons_hd(E), Check) of
+ true ->
+ is_pure_expr(cerl:cons_tl(E), Check);
+ false ->
+ false
+ end;
+ 'let' ->
+ case is_pure_expr(cerl:let_arg(E), Check) of
+ true ->
+ is_pure_expr(cerl:let_body(E), Check);
+ false ->
+ false
+ end;
+ letrec ->
+ is_pure_expr(cerl:letrec_body(E), Check);
+ seq ->
+ case is_pure_expr(cerl:seq_arg(E), Check) of
+ true ->
+ is_pure_expr(cerl:seq_body(E), Check);
+ false ->
+ false
+ end;
+ 'catch' ->
+ is_pure_expr(cerl:catch_body(E), Check);
+ 'try' ->
+ case is_pure_expr(cerl:try_arg(E), Check) of
+ true ->
+ case is_pure_expr(cerl:try_body(E), Check) of
+ true ->
+ is_pure_expr(cerl:try_handler(E), Check);
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ case Check(pure, {Name, length(As)}) of
+ true ->
+ is_pure_expr_list(As, Check);
+ false ->
+ false
+ end;
+ call ->
+ Module = cerl:call_module(E),
+ Name = cerl:call_name(E),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ As = cerl:call_args(E),
+ case Check(pure, {M, F, length(As)}) of
+ true ->
+ is_pure_expr_list(As, Check);
+ false ->
+ false
+ end;
+ false ->
+ false % Call to unknown function
+ end;
+ _ ->
+ false
+ end.
+
+is_pure_expr_list([E | Es], Check) ->
+ case is_pure_expr(E, Check) of
+ true ->
+ is_pure_expr_list(Es, Check);
+ false ->
+ false
+ end;
+is_pure_expr_list([], _Check) ->
+ true.
+
+
+%% Peephole optimizations
+%%
+%% This is only intended to be a light-weight cleanup optimizer,
+%% removing small things that may e.g. have been generated by other
+%% optimization passes or in the translation from higher-level code.
+%% It is not recursive in general - it only descends until it can do no
+%% more work in the current context.
+%%
+%% To expose hidden cases of final expressions (enabling last call
+%% optimization), we try to remove all trivial let-bindings (`let X = Y
+%% in X', `let X = Y in Y', `let X = Y in let ... in ...', `let X = let
+%% ... in ... in ...', etc.). We do not, however, try to recognize any
+%% other similar cases, even for simple `case'-expressions like `case E
+%% of X -> X end', or simultaneous multiple-value bindings.
+
+-spec reduce_expr(cerl:cerl()) -> cerl:cerl().
+
+reduce_expr(E) ->
+ Check = fun default_check/2,
+ reduce_expr(E, Check).
+
+-spec reduce_expr(cerl:cerl(), check_fun()) -> cerl:cerl().
+
+reduce_expr(E, Check) ->
+ case cerl:type(E) of
+ values ->
+ case cerl:values_es(E) of
+ [E1] ->
+ %% Not really an "optimization" in itself, but
+ %% enables other rewritings by removing the wrapper.
+ reduce_expr(E1, Check);
+ _ ->
+ E
+ end;
+ 'seq' ->
+ A = reduce_expr(cerl:seq_arg(E), Check),
+ B = reduce_expr(cerl:seq_body(E), Check),
+ %% `do <E1> <E2>' is equivalent to `<E2>' if `<E1>' is
+ %% "safe" (cannot effect the behaviour in any way).
+ case is_safe_expr(A, Check) of
+ true ->
+ B;
+ false ->
+ case cerl:is_c_seq(B) of
+ true ->
+ %% Rewrite `do <E1> do <E2> <E3>' to `do do
+ %% <E1> <E2> <E3>' so that the "body" of the
+ %% outermost seq-operator is the expression
+ %% which produces the final result (i.e.,
+ %% E3). This can make other optimizations
+ %% easier; see `let'.
+ B1 = cerl:seq_arg(B),
+ B2 = cerl:seq_body(B),
+ cerl:c_seq(cerl:c_seq(A, B1), B2);
+ false ->
+ cerl:c_seq(A, B)
+ end
+ end;
+ 'let' ->
+ A = reduce_expr(cerl:let_arg(E), Check),
+ case cerl:is_c_seq(A) of
+ true ->
+ %% `let X = do <E1> <E2> in Y' is equivalent to `do
+ %% <E1> let X = <E2> in Y'. Note that `<E2>' cannot
+ %% be a seq-operator, due to the `seq' optimization.
+ A1 = cerl:seq_arg(A),
+ A2 = cerl:seq_body(A),
+ E1 = cerl:update_c_let(E, cerl:let_vars(E),
+ A2, cerl:let_body(E)),
+ cerl:c_seq(A1, reduce_expr(E1, Check));
+ false ->
+ B = reduce_expr(cerl:let_body(E), Check),
+ Vs = cerl:let_vars(E),
+ %% We give up if the body does not reduce to a
+ %% single variable. This is not a generic copy
+ %% propagation.
+ case cerl:type(B) of
+ var when length(Vs) =:= 1 ->
+ %% We have `let <V1> = <E> in <V2>':
+ [V] = Vs,
+ N1 = cerl:var_name(V),
+ N2 = cerl:var_name(B),
+ if N1 =:= N2 ->
+ %% `let X = <E> in X' equals `<E>'
+ A;
+ true ->
+ %% `let X = <E> in Y' when X and Y
+ %% are different variables is
+ %% equivalent to `do <E> Y'.
+ reduce_expr(cerl:c_seq(A, B), Check)
+ end;
+ literal ->
+ %% `let X = <E> in T' when T is a literal
+ %% term is equivalent to `do <E> T'.
+ reduce_expr(cerl:c_seq(A, B), Check);
+ _ ->
+ cerl:update_c_let(E, Vs, A, B)
+ end
+ end;
+ 'try' ->
+ %% Get rid of unnecessary try-expressions.
+ A = reduce_expr(cerl:try_arg(E), Check),
+ B = reduce_expr(cerl:try_body(E), Check),
+ case is_safe_expr(A, Check) of
+ true ->
+ B;
+ false ->
+ cerl:update_c_try(E, A, cerl:try_vars(E), B,
+ cerl:try_evars(E),
+ cerl:try_handler(E))
+ end;
+ 'catch' ->
+ %% Just a simpler form of try-expressions.
+ B = reduce_expr(cerl:catch_body(E), Check),
+ case is_safe_expr(B, Check) of
+ true ->
+ B;
+ false ->
+ cerl:update_c_catch(E, B)
+ end;
+ _ ->
+ E
+ end.
diff --git a/lib/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl
new file mode 100644
index 0000000000..0753376e7d
--- /dev/null
+++ b/lib/hipe/cerl/cerl_messagean.erl
@@ -0,0 +1,1105 @@
+%% =====================================================================
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Message analysis of Core Erlang programs.
+%%
+%% Copyright (C) 2002 Richard Carlsson
+%%
+%% Author contact: richardc@it.uu.se
+%% =====================================================================
+
+%% TODO: might need a "top" (`any') element for any-length value lists.
+
+-module(cerl_messagean).
+
+-export([annotate/1]).
+
+-import(cerl, [alias_pat/1, alias_var/1, ann_c_var/2, ann_c_fun/3,
+ apply_args/1, apply_op/1, atom_val/1, bitstr_size/1,
+ bitstr_val/1, binary_segments/1, c_letrec/2,
+ ann_c_tuple/2, c_nil/0, call_args/1, call_module/1,
+ call_name/1, case_arg/1, case_clauses/1, catch_body/1,
+ clause_body/1, clause_guard/1, clause_pats/1, cons_hd/1,
+ cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
+ is_c_atom/1, is_c_int/1, let_arg/1, let_body/1,
+ let_vars/1, letrec_body/1, letrec_defs/1, module_defs/1,
+ module_defs/1, module_exports/1, pat_vars/1,
+ primop_args/1, primop_name/1, receive_action/1,
+ receive_clauses/1, receive_timeout/1, seq_arg/1,
+ seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1,
+ try_evars/1, try_handler/1, tuple_es/1, type/1,
+ values_es/1]).
+
+-import(cerl_trees, [get_label/1]).
+
+-define(DEF_LIMIT, 4).
+
+%% -export([test/1, test1/1, ttest/1]).
+
+%% ttest(F) ->
+%% {T, _} = cerl_trees:label(user_default:read(F)),
+%% {Time0, _} = erlang:statistics(runtime),
+%% analyze(T),
+%% {Time1, _} = erlang:statistics(runtime),
+%% Time1 - Time0.
+
+%% test(F) ->
+%% {T, _} = cerl_trees:label(user_default:read(F)),
+%% {Time0, _} = erlang:statistics(runtime),
+%% {Esc, _Vars} = analyze(T),
+%% {Time1, _} = erlang:statistics(runtime),
+%% io:fwrite("messages: ~p.\n", [Esc]),
+%% Set = sets:from_list(Esc),
+%% H = fun (Node, Ctxt, Cont) ->
+%% Doc = case get_ann(Node) of
+%% [{label, L} | _] ->
+%% B = sets:is_element(L, Set),
+%% bf(Node, Ctxt, Cont, B);
+%% _ ->
+%% bf(Node, Ctxt, Cont, false)
+%% end,
+%% case type(Node) of
+%% cons -> color(Doc);
+%% tuple -> color(Doc);
+%% _ -> Doc
+%% end
+%% end,
+%% {ok, FD} = file:open("out.html",[write]),
+%% Txt = cerl_prettypr:format(T, [{hook, H},{user,false}]),
+%% io:put_chars(FD, "<pre>\n"),
+%% io:put_chars(FD, html(Txt)),
+%% io:put_chars(FD, "</pre>\n"),
+%% file:close(FD),
+%% {ok, Time1 - Time0}.
+
+%% test1(F) ->
+%% {T, _} = cerl_trees:label(user_default:read(F)),
+%% {Time0, _} = erlang:statistics(runtime),
+%% {T1, Esc, Vars} = annotate(T),
+%% {Time1, _} = erlang:statistics(runtime),
+%% io:fwrite("messages: ~p.\n", [Esc]),
+%% %%% io:fwrite("vars: ~p.\n", [[X || X <- dict:to_list(Vars)]]),
+%% T2 = hhl_transform:transform(T1, Vars),
+%% Set = sets:from_list(Esc),
+%% H = fun (Node, Ctxt, Cont) ->
+%% case get_ann(Node) of
+%% [{label, L} | _] ->
+%% B = sets:is_element(L, Set),
+%% bf(Node, Ctxt, Cont, B);
+%% _ ->
+%% bf(Node, Ctxt, Cont, false)
+%% end
+%% end,
+%% {ok, FD} = file:open("out.html",[write]),
+%% Txt = cerl_prettypr:format(T2, [{hook, H},{user,false}]),
+%% io:put_chars(FD, "<pre>\n"),
+%% io:put_chars(FD, html(Txt)),
+%% io:put_chars(FD, "</pre>\n"),
+%% file:close(FD),
+%% {ok, Time1 - Time0}.
+
+%% html(Cs) ->
+%% html(Cs, []).
+
+%% html([$#, $< | Cs], As) ->
+%% html_1(Cs, [$< | As]);
+%% html([$< | Cs], As) ->
+%% html(Cs, ";tl&" ++ As);
+%% html([$> | Cs], As) ->
+%% html(Cs, ";tg&" ++ As);
+%% html([$& | Cs], As) ->
+%% html(Cs, ";pma&" ++ As);
+%% html([C | Cs], As) ->
+%% html(Cs, [C | As]);
+%% html([], As) ->
+%% lists:reverse(As).
+
+%% html_1([$> | Cs], As) ->
+%% html(Cs, [$> | As]);
+%% html_1([C | Cs], As) ->
+%% html_1(Cs, [C | As]).
+
+%% bf(Node, Ctxt, Cont, B) ->
+%% B0 = cerl_prettypr:get_ctxt_user(Ctxt),
+%% if B /= B0 ->
+%% Ctxt1 = cerl_prettypr:set_ctxt_user(Ctxt, B),
+%% Doc = Cont(Node, Ctxt1),
+%% case B of
+%% true ->
+%% Start = "<b>",
+%% End = "</b>";
+%% false ->
+%% Start = "</b>",
+%% End = "<b>"
+%% end,
+%% markup(Doc, Start, End);
+%% true ->
+%% Cont(Node, Ctxt)
+%% end.
+
+%% color(Doc) ->
+%% % Doc.
+%% markup(Doc, "<font color=blue>", "</font>").
+
+%% markup(Doc, Start, End) ->
+%% prettypr:beside(
+%% prettypr:null_text([$# | Start]),
+%% prettypr:beside(Doc,
+%% prettypr:null_text([$# | End]))).
+
+
+%% =====================================================================
+%% annotate(Tree) -> {Tree1, Escapes, Vars}
+%%
+%% Tree = cerl:cerl()
+%%
+%% Analyzes `Tree' (see `analyze') and appends a term 'escapes', to
+%% the annotation list of each constructor expression node and of
+%% `Tree', corresponding to the escape information derived by the
+%% analysis. Any previous such annotations are removed from `Tree'.
+%% `Tree1' is the modified tree; for details on `OutList',
+%% `Outputs' , `Dependencies', `Escapes' and `Parents', see
+%% `analyze'.
+%%
+%% Note: `Tree' must be annotated with labels in order to use this
+%% function; see `analyze' for details.
+
+-type label() :: integer() | 'external' | 'top'.
+-type ordset(X) :: [X]. % XXX: TAKE ME OUT
+
+-spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict()}.
+
+annotate(Tree) ->
+ {Esc0, Vars} = analyze(Tree),
+ Esc = sets:from_list(Esc0),
+ F = fun (T) ->
+ case type(T) of
+ literal -> T;
+%%% var ->
+%%% L = get_label(T),
+%%% T1 = ann_escape(T, L, Esc),
+%%% X = dict:fetch(L, Vars),
+%%% set_ann(T1, append_ann({s,X}, get_ann(T1)));
+ _ ->
+ L = get_label(T),
+ ann_escape(T, L, Esc)
+ end
+ end,
+ {cerl_trees:map(F, Tree), Esc0, Vars}.
+
+ann_escape(T, L, Esc) ->
+ case sets:is_element(L, Esc) of
+ true ->
+ set_ann(T, append_ann(escapes, get_ann(T)));
+ false ->
+ T
+ end.
+
+append_ann(Tag, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ append_ann(Tag, Xs);
+ true ->
+ [X | append_ann(Tag, Xs)]
+ end;
+append_ann(Tag, []) ->
+ [Tag].
+
+
+%% =====================================================================
+%% analyze(Tree) -> Escapes
+%%
+%% Tree = cerl:cerl()
+%% Escapes = ordset(Label)
+%% Label = integer() | external | top
+%%
+%% Analyzes a module or an expression represented by `Tree'.
+%%
+%% `Escapes' is the set of labels of constructor expressions in
+%% `Tree' such that the created values may be accessed from outside
+%% `Tree'.
+%%
+%% Note: `Tree' must be annotated with labels (as done by the
+%% function `cerl_trees:label/1') in order to use this function.
+%% The label annotation `{label, L}' (where L should be an integer)
+%% must be the first element of the annotation list of each node in
+%% the tree. Instances of variables bound in `Tree' which denote
+%% the same variable must have the same label; apart from this,
+%% labels should be unique. Constant literals do not need to be
+%% labeled.
+
+-record(state, {vars, out, dep, work, funs, k}).
+
+%% Note: We assume that all remote calls and primops return a single
+%% value.
+
+%% The analysis determines which objects (identified by the
+%% corresponding "cons-point" labels in the code) are likely to be
+%% passed in a message. (If so, we say that they "escape".) It is always
+%% safe to assume either case, because the send operation will assure
+%% that things are copied if necessary. This analysis tries to
+%% anticipate that copying will be done.
+%%
+%% Rules:
+%% 1) An object passed as message argument (or part of such an
+%% argument) to a known send-operation, will probably be a message.
+%% 2) A received value is always a message (safe).
+%% 3) The external function can return any object (unsafe).
+%% 4) A function called from the external function can receive any
+%% object (unsafe) as argument.
+%% 5) Unknown functions/operations can return any object (unsafe).
+
+%% We wrap the given syntax tree T in a fun-expression labeled `top',
+%% which is initially in the set of escaped labels. `top' will be
+%% visited at least once.
+%%
+%% We create a separate function labeled `external', defined as:
+%% "'external'/1 = fun () -> Any", which will represent any and all
+%% functions outside T, and which returns the 'unsafe' value.
+
+analyze(Tree) ->
+ analyze(Tree, ?DEF_LIMIT).
+
+analyze(Tree, Limit) ->
+ {_, _, Esc, Dep, _Par} = cerl_closurean:analyze(Tree),
+%%% io:fwrite("dependencies: ~w.\n", [dict:to_list(Dep)]),
+ analyze(Tree, Limit, Dep, Esc).
+
+analyze(Tree, Limit, Dep0, Esc0) ->
+ %% Note that we use different name spaces for variable labels and
+ %% function/call site labels, so we can reuse some names here. We
+ %% assume that the labeling of Tree only uses integers, not atoms.
+ Any = ann_c_var([{label, any}], 'Any'),
+ External = ann_c_var([{label, external}], {external, 1}),
+ ExtFun = ann_c_fun([{label, external}], [], Any),
+%%% io:fwrite("external fun:\n~s.\n",
+%%% [cerl_prettypr:format(ExtFun, [noann, {paper, 80}])]),
+ Top = ann_c_var([{label, top}], {top, 0}),
+ TopFun = ann_c_fun([{label, top}], [], Tree),
+
+ %% The "start fun" just makes the initialisation easier. It is not
+ %% itself in the call graph.
+ StartFun = ann_c_fun([{label, start}], [],
+ c_letrec([{External, ExtFun}, {Top, TopFun}],
+ c_nil())),
+%%% io:fwrite("start fun:\n~s.\n",
+%%% [cerl_prettypr:format(StartFun, [{paper, 80}])]),
+
+ %% Initialise the Any and Escape variables. Gather a database of all
+ %% fun-expressions in Tree and initialise their outputs and parameter
+ %% variables. All escaping functions can receive any values as
+ %% inputs. Bind all module- and letrec-defined variables to their
+ %% corresponding labels.
+ Esc = sets:from_list(Esc0),
+ Unsafe = unsafe(),
+ Empty = empty(),
+ Funs0 = dict:new(),
+ Vars0 = dict:store(escape, empty(),
+ dict:store(any, Unsafe, dict:new())),
+ Out0 = dict:new(),
+ F = fun (T, S = {Fs, Vs, Os}) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ As = fun_vars(T),
+ X = case sets:is_element(L, Esc) of
+ true -> Unsafe;
+ false -> Empty
+ end,
+ {dict:store(L, T, Fs),
+ bind_vars_single(As, X, Vs),
+ dict:store(L, none, Os)};
+ letrec ->
+ {Fs, bind_defs(letrec_defs(T), Vs), Os};
+ module ->
+ {Fs, bind_defs(module_defs(T), Vs), Os};
+ _ ->
+ S
+ end
+ end,
+ {Funs, Vars, Out} = cerl_trees:fold(F, {Funs0, Vars0, Out0}, StartFun),
+
+ %% Add the dependency for the loop in 'external':
+ Dep = add_dep(loop, external, Dep0),
+
+ %% Enter the fixpoint iteration at the StartFun.
+ St = loop(StartFun, start, #state{vars = Vars,
+ out = Out,
+ dep = Dep,
+ work = init_work(),
+ funs = Funs,
+ k = Limit}),
+ Ms = labels(dict:fetch(escape, St#state.vars)),
+ {Ms, St#state.vars}.
+
+loop(T, L, St0) ->
+%%% io:fwrite("analyzing: ~w.\n",[L]),
+%%% io:fwrite("work: ~w.\n", [St0#state.work]),
+ Xs0 = dict:fetch(L, St0#state.out),
+ {Xs1, St1} = visit(fun_body(T), L, St0),
+ Xs = limit(Xs1, St1#state.k),
+ {W, M} = case equal(Xs0, Xs) of
+ true ->
+ {St1#state.work, St1#state.out};
+ false ->
+%%% io:fwrite("out (~w) changed: ~w <- ~w.\n",
+%%% [L, Xs, Xs0]),
+ M1 = dict:store(L, Xs, St1#state.out),
+ case dict:find(L, St1#state.dep) of
+ {ok, S} ->
+ {add_work(set__to_list(S), St1#state.work),
+ M1};
+ error ->
+ {St1#state.work, M1}
+ end
+ end,
+ St2 = St1#state{out = M},
+ case take_work(W) of
+ {ok, L1, W1} ->
+ T1 = dict:fetch(L1, St2#state.funs),
+ loop(T1, L1, St2#state{work = W1});
+ none ->
+ St2
+ end.
+
+visit(T, L, St) ->
+%%% io:fwrite("visiting: ~w.\n",[type(T)]),
+ case type(T) of
+ literal ->
+ %% This is (or should be) a constant, even if it's compound,
+ %% so it's bugger all whether it is sent or not.
+ case cerl:concrete(T) of
+ [] -> {[empty()], St};
+ X when is_atom(X) -> {[empty()], St};
+ X when is_integer(X) -> {[empty()], St};
+ X when is_float(X) -> {[empty()], St};
+ _ ->
+ exit({not_literal, T})
+ end;
+ var ->
+ %% If a variable is not already in the store here, it must
+ %% be free in the program.
+ L1 = get_label(T),
+ Vars = St#state.vars,
+ case dict:find(L1, Vars) of
+ {ok, X} ->
+ {[X], St};
+ error ->
+%%% io:fwrite("free var: ~w.\n",[L1]),
+ X = unsafe(),
+ St1 = St#state{vars = dict:store(L1, X, Vars)},
+ {[X], St1}
+ end;
+ 'fun' ->
+ %% Must revisit the fun also, because its environment might
+ %% have changed. (We don't keep track of such dependencies.)
+ L1 = get_label(T),
+ St1 = St#state{work = add_work([L1], St#state.work)},
+ %% Currently, lambda expressions can only be locally
+ %% allocated, and therefore we have to force copying by
+ %% treating them as "unsafe" for now.
+ {[unsafe()], St1};
+ %% {[singleton(L1)], St1};
+ values ->
+ visit_list(values_es(T), L, St);
+ cons ->
+ {[X1, X2], St1} = visit_list([cons_hd(T), cons_tl(T)], L, St),
+ L1 = get_label(T),
+ X = make_cons(L1, X1, X2),
+ %% Also store the values of the elements.
+ Hd = get_hd(X),
+ Tl = get_tl(X),
+ St2 = St1#state{vars = dict:store(L1, [Hd, Tl], St1#state.vars)},
+ {[X], St2};
+ tuple ->
+ {Xs, St1} = visit_list(tuple_es(T), L, St),
+ L1 = get_label(T),
+ %% Also store the values of the elements.
+ St2 = St1#state{vars = dict:store(L1, Xs, St1#state.vars)},
+ {[struct(L1, Xs)], St2};
+ 'let' ->
+ {Xs, St1} = visit(let_arg(T), L, St),
+ Vars = bind_vars(let_vars(T), Xs, St1#state.vars),
+ visit(let_body(T), L, St1#state{vars = Vars});
+ seq ->
+ {_, St1} = visit(seq_arg(T), L, St),
+ visit(seq_body(T), L, St1);
+ apply ->
+ {_F, St1} = visit(apply_op(T), L, St),
+ {As, St2} = visit_list(apply_args(T), L, St1),
+ L1 = get_label(T),
+ Ls = get_deps(L1, St#state.dep),
+ Out = St2#state.out,
+ Xs1 = join_list([dict:fetch(X, Out) || X <- Ls]),
+ {Xs1, call_site(Ls, As, St2)};
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ As = call_args(T),
+ {_, St1} = visit(M, L, St),
+ {_, St2} = visit(F, L, St1),
+ {Xs, St3} = visit_list(As, L, St2),
+ L1 = get_label(T),
+ remote_call(M, F, Xs, As, L1, St3);
+ primop ->
+ As = primop_args(T),
+ {Xs, St1} = visit_list(As, L, St),
+ F = atom_val(primop_name(T)),
+ primop_call(F, length(Xs), Xs, As, St1);
+ 'case' ->
+ {Xs, St1} = visit(case_arg(T), L, St),
+ visit_clauses(Xs, case_clauses(T), L, St1);
+ 'receive' ->
+ %% The received value is of course a message, so it
+ %% is 'empty()', not 'unsafe()'.
+ X = empty(),
+ {Xs1, St1} = visit_clauses([X], receive_clauses(T), L, St),
+ {_, St2} = visit(receive_timeout(T), L, St1),
+ {Xs2, St3} = visit(receive_action(T), L, St2),
+ {join(Xs1, Xs2), St3};
+ 'try' ->
+ {Xs1, St1} = visit(try_arg(T), L, St),
+ X = unsafe(),
+ Vars = bind_vars(try_vars(T), Xs1, St1#state.vars),
+ {Xs2, St2} = visit(try_body(T), L, St1#state{vars = Vars}),
+ EVars = bind_vars(try_evars(T), [X, X, X], St2#state.vars),
+ {Xs3, St3} = visit(try_handler(T), L, St2#state{vars = EVars}),
+ {join(Xs2, Xs3), St3};
+ 'catch' ->
+ %% If we catch an exception, we can get unsafe data.
+ {Xs, St1} = visit(catch_body(T), L, St),
+ {join([unsafe()], Xs), St1};
+ binary ->
+ %% Binaries are heap objects, but we don't have special
+ %% shared-heap allocation operators for them at the moment.
+ %% They must therefore be treated as unsafe.
+ {_, St1} = visit_list(binary_segments(T), L, St),
+ {[unsafe()], St1};
+ bitstr ->
+ %% The other fields are constant literals.
+ {_, St1} = visit(bitstr_val(T), L, St),
+ {_, St2} = visit(bitstr_size(T), L, St1),
+ {none, St2};
+ letrec ->
+ %% All the bound funs should be revisited, because the
+ %% environment might have changed.
+ Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
+ St1 = St#state{work = add_work(Ls, St#state.work)},
+ visit(letrec_body(T), L, St1);
+ module ->
+ %% We regard a module as a tuple of function variables in
+ %% the body of a `letrec'.
+ visit(c_letrec(module_defs(T),
+ ann_c_tuple([{label, get_label(T)}],
+ module_exports(T))),
+ L, St)
+ end.
+
+visit_clause(T, Xs, L, St) ->
+ Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
+ {_, St1} = visit(clause_guard(T), L, St#state{vars = Vars}),
+ visit(clause_body(T), L, St1).
+
+%% We assume correct value-list typing.
+
+visit_list([T | Ts], L, St) ->
+ {Xs, St1} = visit(T, L, St),
+ {Xs1, St2} = visit_list(Ts, L, St1),
+ X = case Xs of
+ [X1] -> X1;
+ _ -> empty()
+ end,
+ {[X | Xs1], St2};
+visit_list([], _L, St) ->
+ {[], St}.
+
+visit_clauses(Xs, [T | Ts], L, St) ->
+ {Xs1, St1} = visit_clause(T, Xs, L, St),
+ {Xs2, St2} = visit_clauses(Xs, Ts, L, St1),
+ {join(Xs1, Xs2), St2};
+visit_clauses(_, [], _L, St) ->
+ {none, St}.
+
+bind_defs([{V, F} | Ds], Vars) ->
+ bind_defs(Ds, dict:store(get_label(V), singleton(get_label(F)), Vars));
+bind_defs([], Vars) ->
+ Vars.
+
+bind_pats(Ps, none, Vars) ->
+ bind_pats_single(Ps, empty(), Vars);
+bind_pats(Ps, Xs, Vars) ->
+ if length(Xs) =:= length(Ps) ->
+ bind_pats_list(Ps, Xs, Vars);
+ true ->
+ bind_pats_single(Ps, empty(), Vars)
+ end.
+
+%% The lists might not be of the same length.
+
+bind_pats_list([P | Ps], [X | Xs], Vars) ->
+ bind_pats_list(Ps, Xs, bind_pat_vars(P, X, Vars));
+bind_pats_list(Ps, [], Vars) ->
+ bind_pats_single(Ps, empty(), Vars);
+bind_pats_list([], _, Vars) ->
+ Vars.
+
+bind_pats_single([P | Ps], X, Vars) ->
+ bind_pats_single(Ps, X, bind_pat_vars(P, X, Vars));
+bind_pats_single([], _X, Vars) ->
+ Vars.
+
+bind_pat_vars(P, X, Vars) ->
+ case type(P) of
+ var ->
+ dict:store(get_label(P), X, Vars);
+ literal ->
+ Vars;
+ cons ->
+ bind_pats_list([cons_hd(P), cons_tl(P)],
+ [get_hd(X), get_tl(X)], Vars);
+ tuple ->
+ case elements(X) of
+ none ->
+ bind_vars_single(pat_vars(P), X, Vars);
+ Xs ->
+ bind_pats_list(tuple_es(P), Xs, Vars)
+ end;
+ binary ->
+ %% See the handling of binary-expressions.
+ bind_pats_single(binary_segments(P), unsafe(), Vars);
+ bitstr ->
+ %% See the handling of binary-expressions.
+ bind_pats_single([bitstr_val(P), bitstr_size(P)],
+ unsafe(), Vars);
+ alias ->
+ P1 = alias_pat(P),
+ Vars1 = bind_pat_vars(P1, X, Vars),
+ dict:store(get_label(alias_var(P)), X, Vars1)
+ end.
+
+%%% %% This is the "exact" version of list representation, which simply
+%%% %% mimics the actual cons, head and tail operations.
+%%% make_cons(L, X1, X2) ->
+%%% struct(L1, [X1, X2]).
+%%% get_hd(X) ->
+%%% case elements(X) of
+%%% none -> X;
+%%% [X1 | _] -> X1;
+%%% _ -> empty()
+%%% end.
+%%% get_tl(X) ->
+%%% case elements(X) of
+%%% none -> X;
+%%% [_, X2 | _] -> X2;
+%%% _ -> empty()
+%%% end.
+
+%% This version does not unnecessarily confuse spine labels with element
+%% labels, and is safe. However, it loses precision if cons cells are
+%% used for other things than proper lists.
+
+make_cons(L, X1, X2) ->
+ %% join subtypes and cons locations
+ join_single(struct(L, [X1]), X2).
+
+get_hd(X) ->
+ case elements(X) of
+ none -> X;
+ [X1 | _] -> X1; % First element represents list subtype.
+ _ -> empty()
+ end.
+
+get_tl(X) -> X. % Tail of X has same type as X.
+
+bind_vars(Vs, none, Vars) ->
+ bind_vars_single(Vs, empty(), Vars);
+bind_vars(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_vars_list(Vs, Xs, Vars);
+ true ->
+ bind_vars_single(Vs, empty(), Vars)
+ end.
+
+bind_vars_list([V | Vs], [X | Xs], Vars) ->
+ bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
+bind_vars_list([], [], Vars) ->
+ Vars.
+
+bind_vars_single([V | Vs], X, Vars) ->
+ bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
+bind_vars_single([], _X, Vars) ->
+ Vars.
+
+%% This handles a call site, updating parameter variables with respect
+%% to the actual parameters. The 'external' function is handled
+%% specially, since it can get an arbitrary number of arguments. For our
+%% purposes here, calls to the external function can be ignored.
+
+call_site(Ls, Xs, St) ->
+%%% io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, Xs]),
+ {W, V} = call_site(Ls, Xs, St#state.work, St#state.vars,
+ St#state.funs, St#state.k),
+ St#state{work = W, vars = V}.
+
+call_site([external | Ls], Xs, W, V, Fs, Limit) ->
+ call_site(Ls, Xs, W, V, Fs, Limit);
+call_site([L | Ls], Xs, W, V, Fs, Limit) ->
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args(Vs, Xs, V, Limit) of
+ {V1, true} ->
+ call_site(Ls, Xs, add_work([L], W), V1, Fs, Limit);
+ {V1, false} ->
+ call_site(Ls, Xs, W, V1, Fs, Limit)
+ end;
+call_site([], _, W, V, _, _) ->
+ {W, V}.
+
+add_dep(Source, Target, Deps) ->
+ case dict:find(Source, Deps) of
+ {ok, X} ->
+ case set__is_member(Target, X) of
+ true ->
+ Deps;
+ false ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__add(Target, X), Deps)
+ end;
+ error ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__singleton(Target), Deps)
+ end.
+
+%% If the arity does not match the call, nothing is done here.
+
+bind_args(Vs, Xs, Vars, Limit) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_args(Vs, Xs, Vars, Limit, false);
+ true ->
+ {Vars, false}
+ end.
+
+bind_args([V | Vs], [X | Xs], Vars, Limit, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Limit, Ch),
+ bind_args(Vs, Xs, Vars1, Limit, Ch1);
+bind_args([], [], Vars, _Limit, Ch) ->
+ {Vars, Ch}.
+
+%% bind_arg(L, X, Vars, Limit) ->
+%% bind_arg(L, X, Vars, Limit, false).
+
+bind_arg(L, X, Vars, Limit, Ch) ->
+ X0 = dict:fetch(L, Vars),
+ X1 = limit_single(join_single(X, X0), Limit),
+ case equal_single(X0, X1) of
+ true ->
+ {Vars, Ch};
+ false ->
+%%% io:fwrite("arg (~w) changed: ~w <- ~w + ~w.\n",
+%%% [L, X1, X0, X]),
+ {dict:store(L, X1, Vars), true}
+ end.
+
+%% This handles escapes from things like primops and remote calls.
+
+escape(Xs, Ns, St) ->
+ escape(Xs, Ns, 1, St).
+
+escape([_ | Xs], Ns=[N1 | _], N, St) when is_integer(N1), N1 > N ->
+ escape(Xs, Ns, N + 1, St);
+escape([X | Xs], [N | Ns], N, St) ->
+ Vars = St#state.vars,
+ X0 = dict:fetch(escape, Vars),
+ X1 = join_single(X, X0),
+ case equal_single(X0, X1) of
+ true ->
+ escape(Xs, Ns, N + 1, St);
+ false ->
+%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]),
+ Vars1 = dict:store(escape, X1, Vars),
+ escape(Xs, Ns, N + 1, St#state{vars = Vars1})
+ end;
+escape(Xs, [_ | Ns], N, St) ->
+ escape(Xs, Ns, N + 1, St);
+escape(_, _, _, St) ->
+ St.
+
+%% Handle primop calls: (At present, we assume that all unknown calls
+%% yield exactly one value. This might have to be changed.)
+
+primop_call(F, A, Xs, _As, St0) ->
+ %% St1 = case is_escape_op(F, A) of
+ %% [] -> St0;
+ %% Ns -> escape(Xs, Ns, St0)
+ %% end,
+ St1 = St0,
+ case is_imm_op(F, A) of
+ true ->
+ {[empty()], St1};
+ false ->
+ call_unknown(Xs, St1)
+ end.
+
+%% Handle remote-calls: (At present, we assume that all unknown calls
+%% yield exactly one value. This might have to be changed.)
+
+remote_call(M, F, Xs, As, L, St) ->
+ case is_c_atom(M) andalso is_c_atom(F) of
+ true ->
+ remote_call_1(atom_val(M), atom_val(F), length(Xs),
+ Xs, As, L, St);
+ false ->
+ %% Unknown function
+ call_unknown(Xs, St)
+ end.
+
+%% When calling an unknown function, we assume that the result does
+%% *not* contain any of the constructors in its arguments (but it could
+%% return locally allocated data that we don't know about). Note that
+%% even a "pure" function can still cons up new data.
+
+call_unknown(_Xs, St) ->
+ {[unsafe()], St}.
+
+%% We need to handle some important standard functions in order to get
+%% decent precision.
+%% TODO: foldl, map, mapfoldl
+
+remote_call_1(erlang, hd, 1, [X], _As, _L, St) ->
+ {[get_hd(X)], St};
+remote_call_1(erlang, tl, 1, [X], _As, _L, St) ->
+ {[get_tl(X)], St};
+remote_call_1(erlang, element, 2, [_,X], [N|_], _L, St) ->
+ case elements(X) of
+ none -> {[X], St};
+ Xs ->
+ case is_c_int(N) of
+ true ->
+ N1 = int_val(N),
+ if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
+ {[nth(N1, Xs)], St};
+ true ->
+ {none, St}
+ end;
+ false ->
+ %% Even if we don't know which element is selected,
+ %% we know that the top level is never part of the
+ %% returned value.
+ {[join_single_list(Xs)], St}
+ end
+ end;
+remote_call_1(erlang, setelement, 3, [_,X, Y], [N|_], L, St) ->
+ %% The constructor gets the label of the call operation.
+ case elements(X) of
+ none -> {[join_single(singleton(L), join_single(X, Y))], St};
+ Xs ->
+ case is_c_int(N) of
+ true ->
+ N1 = int_val(N),
+ if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
+ Xs1 = set_nth(N1, Y, Xs),
+ {[struct(L, Xs1)], St};
+ true ->
+ {none, St}
+ end;
+ false ->
+ %% Even if we don't know which element is selected,
+ %% we know that the top level is never part of the
+ %% returned value (a new tuple is always created).
+ Xs1 = [join_single(Y, X1) || X1 <- Xs],
+ {[struct(L, Xs1)], St}
+ end
+ end;
+remote_call_1(erlang, '++', 2, [X1,X2], _As, _L, St) ->
+ %% Note: this is unsafe for non-proper lists! (See make_cons/3).
+ %% No safe version is implemented.
+ {[join_single(X1, X2)], St};
+remote_call_1(erlang, '--', 2, [X1,_X2], _As, _L, St) ->
+ {[X1], St};
+remote_call_1(lists, append, 2, Xs, As, L, St) ->
+ remote_call_1(erlang, '++', 2, Xs, As, L, St);
+remote_call_1(lists, subtract, 2, Xs, As, L, St) ->
+ remote_call_1(erlang, '--', 2, Xs, As, L, St);
+remote_call_1(M, F, A, Xs, _As, _L, St0) ->
+ St1 = case is_escape_op(M, F, A) of
+ [] -> St0;
+ Ns -> escape(Xs, Ns, St0)
+ end,
+ case is_imm_op(M, F, A) of
+ true ->
+ {[empty()], St1};
+ false ->
+ call_unknown(Xs, St1)
+ end.
+
+%% 1-based n:th-element list selector and update function.
+
+nth(1, [X | _Xs]) -> X;
+nth(N, [_X | Xs]) when N > 1 -> nth(N - 1, Xs).
+
+set_nth(1, Y, [_X | Xs]) -> [Y | Xs];
+set_nth(N, Y, [X | Xs]) when N > 1 -> [X | set_nth(N - 1, Y, Xs)].
+
+%% Domain: none | [V], where V = {S, none} | {S, [V]}, S = set(integer()).
+
+join(none, Xs2) -> Xs2;
+join(Xs1, none) -> Xs1;
+join(Xs1, Xs2) ->
+ if length(Xs1) =:= length(Xs2) ->
+ join_1(Xs1, Xs2);
+ true ->
+ none
+ end.
+
+join_1([X1 | Xs1], [X2 | Xs2]) ->
+ [join_single(X1, X2) | join_1(Xs1, Xs2)];
+join_1([], []) ->
+ [].
+
+join_list([Xs | Xss]) ->
+ join(Xs, join_list(Xss));
+join_list([]) ->
+ none.
+
+empty() -> {set__new(), []}.
+
+singleton(X) -> {set__singleton(X), []}.
+
+struct(X, Xs) -> {set__singleton(X), Xs}.
+
+elements({_, Xs}) -> Xs.
+
+unsafe() -> {set__singleton(unsafe), none}.
+
+equal(none, none) -> true;
+equal(none, _) -> false;
+equal(_, none) -> false;
+equal(X1, X2) -> equal_1(X1, X2).
+
+equal_1([X1 | Xs1], [X2 | Xs2]) ->
+ equal_single(X1, X2) andalso equal_1(Xs1, Xs2);
+equal_1([], []) -> true;
+equal_1(_, _) -> false.
+
+equal_single({S1, none}, {S2, none}) ->
+ set__equal(S1, S2);
+equal_single({_, none}, _) ->
+ false;
+equal_single(_, {_, none}) ->
+ false;
+equal_single({S1, Vs1}, {S2, Vs2}) ->
+ set__equal(S1, S2) andalso equal_single_lists(Vs1, Vs2).
+
+equal_single_lists([X1 | Xs1], [X2 | Xs2]) ->
+ equal_single(X1, X2) andalso equal_single_lists(Xs1, Xs2);
+equal_single_lists([], []) ->
+ true;
+equal_single_lists(_, _) ->
+ false.
+
+join_single({S, none}, V) ->
+ {set__union(S, labels(V)), none};
+join_single(V, {S, none}) ->
+ {set__union(S, labels(V)), none};
+join_single({S1, Vs1}, {S2, Vs2}) ->
+ {set__union(S1, S2), join_single_lists(Vs1, Vs2)}.
+
+join_single_list([V | Vs]) ->
+ join_single(V, join_single_list(Vs));
+join_single_list([]) ->
+ empty().
+
+%% If one list has more elements that the other, and N is the length of
+%% the longer list, then the result has N elements.
+
+join_single_lists([V1], [V2]) ->
+ [join_single(V1, V2)];
+join_single_lists([V1 | Vs1], [V2 | Vs2]) ->
+ [join_single(V1, V2) | join_single_lists(Vs1, Vs2)];
+join_single_lists([], Vs) -> Vs;
+join_single_lists(Vs, []) -> Vs.
+
+collapse(V) ->
+ {labels(V), none}.
+
+%% collapse_list([]) ->
+%% empty();
+%% collapse_list(Vs) ->
+%% {labels_list(Vs), none}.
+
+labels({S, none}) -> S;
+labels({S, []}) -> S;
+labels({S, Vs}) -> set__union(S, labels_list(Vs)).
+
+labels_list([V]) ->
+ labels(V);
+labels_list([V | Vs]) ->
+ set__union(labels(V), labels_list(Vs)).
+
+limit(none, _K) -> none;
+limit(X, K) -> limit_list(X, K).
+
+limit_list([X | Xs], K) ->
+ [limit_single(X, K) | limit_list(Xs, K)];
+limit_list([], _) ->
+ [].
+
+limit_single({_, none} = V, _K) ->
+ V;
+limit_single({_, []} = V, _K) ->
+ V;
+limit_single({S, Vs}, K) when K > 0 ->
+ {S, limit_list(Vs, K - 1)};
+limit_single(V, _K) ->
+ collapse(V).
+
+%% Set abstraction for label sets in the domain.
+
+%% set__is_empty([]) -> true;
+%% set__is_empty(_) -> false.
+
+set__new() -> [].
+
+set__singleton(X) -> [X].
+
+set__to_list(S) -> S.
+
+%% set__from_list(S) -> ordsets:from_list(S).
+
+set__union(X, Y) -> ordsets:union(X, Y).
+
+set__add(X, S) -> ordsets:add_element(X, S).
+
+set__is_member(X, S) -> ordsets:is_element(X, S).
+
+%% set__subtract(X, Y) -> ordsets:subtract(X, Y).
+
+set__equal(X, Y) -> X =:= Y.
+
+%% A simple but efficient functional queue.
+
+queue__new() -> {[], []}.
+
+queue__put(X, {In, Out}) -> {[X | In], Out}.
+
+queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
+queue__get({[], _}) -> empty;
+queue__get({In, _}) ->
+ [X | In1] = lists:reverse(In),
+ {ok, X, {[], In1}}.
+
+%% The work list - a queue without repeated elements.
+
+init_work() ->
+ {queue__new(), sets:new()}.
+
+add_work(Ls, {Q, Set}) ->
+ add_work(Ls, Q, Set).
+
+%% Note that the elements are enqueued in order.
+
+add_work([L | Ls], Q, Set) ->
+ case sets:is_element(L, Set) of
+ true ->
+ add_work(Ls, Q, Set);
+ false ->
+ add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
+ end;
+add_work([], Q, Set) ->
+ {Q, Set}.
+
+take_work({Queue0, Set0}) ->
+ case queue__get(Queue0) of
+ {ok, L, Queue1} ->
+ Set1 = sets:del_element(L, Set0),
+ {ok, L, {Queue1, Set1}};
+ empty ->
+ none
+ end.
+
+get_deps(L, Dep) ->
+ case dict:find(L, Dep) of
+ {ok, Ls} -> Ls;
+ error -> []
+ end.
+
+%% Escape operators may let their arguments escape. For this analysis,
+%% only send-operations are considered as causing escapement, and only
+%% in specific arguments.
+
+%% is_escape_op(_F, _A) -> [].
+
+-spec is_escape_op(module(), atom(), arity()) -> [arity()].
+
+is_escape_op(erlang, '!', 2) -> [2];
+is_escape_op(erlang, send, 2) -> [2];
+is_escape_op(erlang, spawn, 1) -> [1];
+is_escape_op(erlang, spawn, 3) -> [3];
+is_escape_op(erlang, spawn, 4) -> [4];
+is_escape_op(erlang, spawn_link, 3) -> [3];
+is_escape_op(erlang, spawn_link, 4) -> [4];
+is_escape_op(_M, _F, _A) -> [].
+
+%% "Immediate" operators will never return heap allocated data. This is
+%% of course true for operators that never return, like 'exit/1'. (Note
+%% that floats are always heap allocated objects, and that most integer
+%% arithmetic can return a bignum on the heap.)
+
+-spec is_imm_op(atom(), arity()) -> boolean().
+
+is_imm_op(match_fail, 1) -> true;
+is_imm_op(_, _) -> false.
+
+-spec is_imm_op(module(), atom(), arity()) -> boolean().
+
+is_imm_op(erlang, self, 0) -> true;
+is_imm_op(erlang, '=:=', 2) -> true;
+is_imm_op(erlang, '==', 2) -> true;
+is_imm_op(erlang, '=/=', 2) -> true;
+is_imm_op(erlang, '/=', 2) -> true;
+is_imm_op(erlang, '<', 2) -> true;
+is_imm_op(erlang, '=<', 2) -> true;
+is_imm_op(erlang, '>', 2) -> true;
+is_imm_op(erlang, '>=', 2) -> true;
+is_imm_op(erlang, 'and', 2) -> true;
+is_imm_op(erlang, 'or', 2) -> true;
+is_imm_op(erlang, 'xor', 2) -> true;
+is_imm_op(erlang, 'not', 1) -> true;
+is_imm_op(erlang, is_alive, 0) -> true;
+is_imm_op(erlang, is_atom, 1) -> true;
+is_imm_op(erlang, is_binary, 1) -> true;
+is_imm_op(erlang, is_builtin, 3) -> true;
+is_imm_op(erlang, is_constant, 1) -> true;
+is_imm_op(erlang, is_float, 1) -> true;
+is_imm_op(erlang, is_function, 1) -> true;
+is_imm_op(erlang, is_integer, 1) -> true;
+is_imm_op(erlang, is_list, 1) -> true;
+is_imm_op(erlang, is_number, 1) -> true;
+is_imm_op(erlang, is_pid, 1) -> true;
+is_imm_op(erlang, is_port, 1) -> true;
+is_imm_op(erlang, is_process_alive, 1) -> true;
+is_imm_op(erlang, is_reference, 1) -> true;
+is_imm_op(erlang, is_tuple, 1) -> true;
+is_imm_op(erlang, length, 1) -> true; % never a bignum
+is_imm_op(erlang, list_to_atom, 1) -> true;
+is_imm_op(erlang, node, 0) -> true;
+is_imm_op(erlang, node, 1) -> true;
+is_imm_op(erlang, throw, 1) -> true;
+is_imm_op(erlang, exit, 1) -> true;
+is_imm_op(erlang, error, 1) -> true;
+is_imm_op(erlang, error, 2) -> true;
+is_imm_op(_, _, _) -> false.
diff --git a/lib/hipe/cerl/cerl_pmatch.erl b/lib/hipe/cerl/cerl_pmatch.erl
new file mode 100644
index 0000000000..3bc93e80dd
--- /dev/null
+++ b/lib/hipe/cerl/cerl_pmatch.erl
@@ -0,0 +1,624 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <richardc@it.uu.se>
+%% @copyright 2000-2006 Richard Carlsson
+%%
+%% @doc Core Erlang pattern matching compiler.
+%%
+%% <p>For reference, see Simon L. Peyton Jones "The Implementation of
+%% Functional Programming Languages", chapter 5 (by Phil Wadler).</p>
+%%
+%% @type cerl() = cerl:cerl().
+%% Abstract Core Erlang syntax trees.
+%% @type cerl_records() = cerl:cerl_records().
+%% An explicit record representation of Core Erlang syntax trees.
+
+-module(cerl_pmatch).
+
+-define(NO_UNUSED, true).
+
+-export([clauses/2]).
+-ifndef(NO_UNUSED).
+-export([transform/2, core_transform/2, expr/2]).
+-endif.
+
+-import(lists, [all/2, splitwith/2, foldr/3, keysort/2, foldl/3,
+ mapfoldl/3]).
+
+-define(binary_id, {binary}).
+-define(cons_id, {cons}).
+-define(tuple_id, {tuple}).
+-define(literal_id(V), V).
+
+
+%% @spec core_transform(Module::cerl_records(), Options::[term()]) ->
+%% cerl_records()
+%%
+%% @doc Transforms a module represented by records. See
+%% <code>transform/2</code> for details.
+%%
+%% <p>Use the compiler option <code>{core_transform, cerl_pmatch}</code>
+%% to insert this function as a compilation pass.</p>
+%%
+%% @see transform/2
+
+-ifndef(NO_UNUSED).
+core_transform(M, Opts) ->
+ cerl:to_records(transform(cerl:from_records(M), Opts)).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%% @doc Rewrites all <code>case</code>-clauses in <code>Module</code>.
+%% <code>receive</code>-clauses are not affected. Currently, no options
+%% are available.
+%%
+%% @see clauses/2
+%% @see expr/2
+%% @see core_transform/2
+
+-ifndef(NO_UNUSED).
+transform(M, _Opts) ->
+ expr(M, env__empty()).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% @spec clauses(Clauses::[Clause], Env) -> {Expr, Vars}
+%% Clause = cerl()
+%% Expr = cerl()
+%% Vars = [cerl()]
+%% Env = rec_env:environment()
+%%
+%% @doc Rewrites a sequence of clauses to an equivalent expression,
+%% removing as much repeated testing as possible. Returns a pair
+%% <code>{Expr, Vars}</code>, where <code>Expr</code> is the resulting
+%% expression, and <code>Vars</code> is a list of new variables (i.e.,
+%% not already in the given environment) to be bound to the arguments to
+%% the switch. The following is a typical example (assuming
+%% <code>E</code> is a Core Erlang case expression):
+%% <pre>
+%% handle_case(E, Env) ->
+%% Cs = case_clauses(E),
+%% {E1, Vs} = cerl_pmatch(Cs, Env),
+%% c_let(Vs, case_arg(E), E1).
+%% </pre>
+%%
+%% <p>The environment is used for generating new variables which do not
+%% shadow existing bindings.</p>
+%%
+%% @see rec_env
+%% @see expr/2
+%% @see transform/2
+
+-spec clauses([cerl:cerl()], rec_env:environment()) ->
+ {cerl:cerl(), [cerl:cerl()]}.
+
+clauses(Cs, Env) ->
+ clauses(Cs, none, Env).
+
+clauses([C | _] = Cs, Else, Env) ->
+ Vs = new_vars(cerl:clause_arity(C), Env),
+ E = match(Vs, Cs, Else, add_vars(Vs, Env)),
+ {E, Vs}.
+
+%% The implementation very closely follows that described in the book.
+
+match([], Cs, Else, _Env) ->
+ %% If the "default action" is the atom 'none', it is simply not
+ %% added; otherwise it is put in the body of a final catch-all
+ %% clause (which is often removed by the below optimization).
+ Cs1 = if Else =:= none -> Cs;
+ true -> Cs ++ [cerl:c_clause([], Else)]
+ end,
+ %% This clause reduction is an important optimization. It selects a
+ %% clause body if possible, and otherwise just removes dead clauses.
+ case cerl_clauses:reduce(Cs1) of
+ {true, {C, []}} -> % if we get bindings, something is wrong!
+ cerl:clause_body(C);
+ {false, Cs2} ->
+ %% This happens when guards are nontrivial.
+ cerl:c_case(cerl:c_values([]), Cs2)
+ end;
+match([V | _] = Vs, Cs, Else, Env) ->
+ foldr(fun (CsF, ElseF) ->
+ match_var_con(Vs, CsF, ElseF, Env)
+ end,
+ Else,
+ group([unalias(C, V) || C <- Cs], fun is_var_clause/1)).
+
+group([], _F) ->
+ [];
+group([X | _] = Xs, F) ->
+ group(Xs, F, F(X)).
+
+group(Xs, F, P) ->
+ {First, Rest} = splitwith(fun (X) -> F(X) =:= P end, Xs),
+ [First | group(Rest, F)].
+
+is_var_clause(C) ->
+ cerl:is_c_var(hd(cerl:clause_pats(C))).
+
+%% To avoid code duplication, if the 'Else' expression is too big, we
+%% put it in a local function definition instead, and replace it with a
+%% call. (Note that it is important that 'is_lightweight' does not yield
+%% 'true' for a simple function application, or we will create a lot of
+%% unnecessary extra functions.)
+
+match_var_con(Vs, Cs, none = Else, Env) ->
+ match_var_con_1(Vs, Cs, Else, Env);
+match_var_con(Vs, Cs, Else, Env) ->
+ case is_lightweight(Else) of
+ true ->
+ match_var_con_1(Vs, Cs, Else, Env);
+ false ->
+ F = new_fvar("match_", 0, Env),
+ Else1 = cerl:c_apply(F, []),
+ Env1 = add_vars([F], Env),
+ cerl:c_letrec([{F, cerl:c_fun([], Else)}],
+ match_var_con_1(Vs, Cs, Else1, Env1))
+ end.
+
+match_var_con_1(Vs, Cs, Else, Env) ->
+ case is_var_clause(hd(Cs)) of
+ true ->
+ match_var(Vs, Cs, Else, Env);
+ false ->
+ match_con(Vs, Cs, Else, Env)
+ end.
+
+match_var([V | Vs], Cs, Else, Env) ->
+ Cs1 = [begin
+ [P | Ps] = cerl:clause_pats(C),
+ G = make_let([P], V, cerl:clause_guard(C)),
+ B = make_let([P], V, cerl:clause_body(C)),
+ cerl:update_c_clause(C, Ps, G, B)
+ end
+ || C <- Cs],
+ match(Vs, Cs1, Else, Env).
+
+%% Since Erlang is dynamically typed, we must include the possibility
+%% that none of the constructors in the group will match, and in that
+%% case the "Else" code will be executed (unless it is 'none'), in the
+%% body of a final catch-all clause.
+
+match_con([V | Vs], Cs, Else, Env) ->
+ case group_con(Cs) of
+ [{_, _, Gs}] ->
+ %% Don't create a group type switch if there is only one
+ %% such group
+ make_switch(V, [match_congroup(DG, Vs, CsG, Else, Env)
+ || {DG, _, CsG} <- Gs],
+ Else, Env);
+ Ts ->
+ Cs1 = [match_typegroup(T, V, Vs, Gs, Else, Env)
+ || {T, _, Gs} <- Ts],
+ make_switch(V, Cs1, Else, Env)
+ end.
+
+
+match_typegroup(_T, _V, Vs, [{D, _, Cs}], Else, Env) when element(1, D) /= ?binary_id ->
+ %% Don't create a group type switch if there is only one constructor
+ %% in the group. (Note that this always happens for '[]'.)
+ %% Special case for binaries which always get a group switch
+ match_congroup(D, Vs, Cs, Else, Env);
+match_typegroup(T, V, Vs, Gs, Else, Env) ->
+ Body = make_switch(V, [match_congroup(D, Vs, Cs, Else, Env)
+ || {D, _, Cs} <- Gs],
+ Else, Env),
+ typetest_clause(T, V, Body, Env).
+
+match_congroup({?binary_id, Segs}, Vs, Cs, _Else, Env) ->
+ Ref = get_unique(),
+ Guard = cerl:c_primop(cerl:c_atom(set_label), [cerl:c_int(Ref)]),
+ NewElse = cerl:c_primop(cerl:c_atom(goto_label), [cerl:c_int(Ref)]),
+ Body = match(Vs, Cs, NewElse, Env),
+ cerl:c_clause([make_pat(?binary_id, Segs)], Guard, Body);
+
+match_congroup({D, A}, Vs, Cs, Else, Env) ->
+ Vs1 = new_vars(A, Env),
+ Body = match(Vs1 ++ Vs, Cs, Else, add_vars(Vs1, Env)),
+ cerl:c_clause([make_pat(D, Vs1)], Body).
+
+make_switch(V, Cs, Else, Env) ->
+ cerl:c_case(V, if Else =:= none -> Cs;
+ true -> Cs ++ [cerl:c_clause([new_var(Env)],
+ Else)]
+ end).
+
+%% We preserve the relative order of different-type constructors as they
+%% were originally listed. This is done by tracking the clause numbers.
+
+group_con(Cs) ->
+ {Cs1, _} = mapfoldl(fun (C, N) ->
+ [P | Ps] = cerl:clause_pats(C),
+ Ps1 = sub_pats(P) ++ Ps,
+ G = cerl:clause_guard(C),
+ B = cerl:clause_body(C),
+ C1 = cerl:update_c_clause(C, Ps1, G, B),
+ D = con_desc(P),
+ {{D, N, C1}, N + 1}
+ end,
+ 0, Cs),
+ %% Sort and group constructors.
+ Css = group(keysort(1, Cs1), fun ({D,_,_}) -> D end),
+ %% Sort each group "back" by line number, and move the descriptor
+ %% and line number to the wrapper for the group.
+ Gs = [finalize_congroup(C) || C <- Css],
+ %% Group by type only (put e.g. different-arity tuples together).
+ Gss = group(Gs, fun ({D,_,_}) -> con_desc_type(D) end),
+ %% Sort and wrap the type groups.
+ Ts = [finalize_typegroup(G) || G <- Gss],
+ %% Sort type-groups by first clause order
+ keysort(2, Ts).
+
+finalize_congroup(Cs) ->
+ [{D,N,_}|_] = Cs1 = keysort(2, Cs),
+ {D, N, [C || {_,_,C} <- Cs1]}.
+
+finalize_typegroup(Gs) ->
+ [{D,N,_}|_] = Gs1 = keysort(2, Gs),
+ {con_desc_type(D), N, Gs1}.
+
+%% Since Erlang clause patterns can contain "alias patterns", we must
+%% eliminate these, by turning them into let-definitions in the guards
+%% and bodies of the clauses.
+
+unalias(C, V) ->
+ [P | Ps] = cerl:clause_pats(C),
+ B = cerl:clause_body(C),
+ G = cerl:clause_guard(C),
+ unalias(P, V, Ps, B, G, C).
+
+unalias(P, V, Ps, B, G, C) ->
+ case cerl:type(P) of
+ alias ->
+ V1 = cerl:alias_var(P),
+ B1 = make_let([V1], V, B),
+ G1 = make_let([V1], V, G),
+ unalias(cerl:alias_pat(P), V, Ps, B1, G1, C);
+ _ ->
+ cerl:update_c_clause(C, [P | Ps], G, B)
+ end.
+
+%% Generating a type-switch clause
+
+typetest_clause([], _V, E, _Env) ->
+ cerl:c_clause([cerl:c_nil()], E);
+typetest_clause(atom, V, E, _Env) ->
+ typetest_clause_1(is_atom, V, E);
+typetest_clause(integer, V, E, _Env) ->
+ typetest_clause_1(is_integer, V, E);
+typetest_clause(float, V, E, _Env) ->
+ typetest_clause_1(is_float, V, E);
+typetest_clause(cons, _V, E, Env) ->
+ [V1, V2] = new_vars(2, Env),
+ cerl:c_clause([cerl:c_cons(V1, V2)], E); % there is no 'is cons'
+typetest_clause(tuple, V, E, _Env) ->
+ typetest_clause_1(is_tuple, V, E);
+typetest_clause(binary, V, E, _Env) ->
+ typetest_clause_1(is_binary, V, E).
+
+typetest_clause_1(T, V, E) ->
+ cerl:c_clause([V], cerl:c_call(cerl:c_atom('erlang'),
+ cerl:c_atom(T), [V]), E).
+
+%% This returns a constructor descriptor, to be used for grouping and
+%% pattern generation. It consists of an identifier term and the arity.
+
+con_desc(E) ->
+ case cerl:type(E) of
+ cons -> {?cons_id, 2};
+ tuple -> {?tuple_id, cerl:tuple_arity(E)};
+ binary -> {?binary_id, cerl:binary_segments(E)};
+ literal ->
+ case cerl:concrete(E) of
+ [_|_] -> {?cons_id, 2};
+ T when is_tuple(T) -> {?tuple_id, tuple_size(T)};
+ V -> {?literal_id(V), 0}
+ end;
+ _ ->
+ throw({bad_constructor, E})
+ end.
+
+%% This returns the type class for a constructor descriptor, for
+%% grouping of clauses. It does not distinguish between tuples of
+%% different arity, nor between different values of atoms, integers and
+%% floats.
+
+con_desc_type({?literal_id([]), _}) -> [];
+con_desc_type({?literal_id(V), _}) when is_atom(V) -> atom;
+con_desc_type({?literal_id(V), _}) when is_integer(V) -> integer;
+con_desc_type({?literal_id(V), _}) when is_float(V) -> float;
+con_desc_type({?cons_id, 2}) -> cons;
+con_desc_type({?tuple_id, _}) -> tuple;
+con_desc_type({?binary_id, _}) -> binary.
+
+%% This creates a new constructor pattern from a type descriptor and a
+%% list of variables.
+
+make_pat(?cons_id, [V1, V2]) -> cerl:c_cons(V1, V2);
+make_pat(?tuple_id, Vs) -> cerl:c_tuple(Vs);
+make_pat(?binary_id, Segs) -> cerl:c_binary(Segs);
+make_pat(?literal_id(Val), []) -> cerl:abstract(Val).
+
+%% This returns the list of subpatterns of a constructor pattern.
+
+sub_pats(E) ->
+ case cerl:type(E) of
+ cons ->
+ [cerl:cons_hd(E), cerl:cons_tl(E)];
+ tuple ->
+ cerl:tuple_es(E);
+ binary ->
+ [];
+ literal ->
+ case cerl:concrete(E) of
+ [H|T] -> [cerl:abstract(H), cerl:abstract(T)];
+ T when is_tuple(T) -> [cerl:abstract(X)
+ || X <- tuple_to_list(T)];
+ _ -> []
+ end;
+ _ ->
+ throw({bad_constructor_pattern, E})
+ end.
+
+%% This avoids generating stupid things like "let X = ... in 'true'",
+%% and "let X = Y in X", keeping the generated code cleaner. It also
+%% prevents expressions from being considered "non-lightweight" when
+%% code duplication is disallowed (see is_lightweight for details).
+
+make_let(Vs, A, B) ->
+ cerl_lib:reduce_expr(cerl:c_let(Vs, A, B)).
+
+%% ---------------------------------------------------------------------
+%% Rewriting a module or other expression:
+
+%% @spec expr(Expression::cerl(), Env) -> cerl()
+%% Env = rec_env:environment()
+%%
+%% @doc Rewrites all <code>case</code>-clauses in
+%% <code>Expression</code>. <code>receive</code>-clauses are not
+%% affected.
+%%
+%% <p>The environment is used for generating new variables which do not
+%% shadow existing bindings.</p>
+%%
+%% @see clauses/2
+%% @see rec_env
+
+-ifndef(NO_UNUSED).
+expr(E, Env) ->
+ case cerl:type(E) of
+ literal ->
+ E;
+ var ->
+ E;
+ values ->
+ Es = expr_list(cerl:values_es(E), Env),
+ cerl:update_c_values(E, Es);
+ cons ->
+ H = expr(cerl:cons_hd(E), Env),
+ T = expr(cerl:cons_tl(E), Env),
+ cerl:update_c_cons(E, H, T);
+ tuple ->
+ Es = expr_list(cerl:tuple_es(E), Env),
+ cerl:update_c_tuple(E, Es);
+ 'let' ->
+ A = expr(cerl:let_arg(E), Env),
+ Vs = cerl:let_vars(E),
+ Env1 = add_vars(Vs, Env),
+ B = expr(cerl:let_body(E), Env1),
+ cerl:update_c_let(E, Vs, A, B);
+ seq ->
+ A = expr(cerl:seq_arg(E), Env),
+ B = expr(cerl:seq_body(E), Env),
+ cerl:update_c_seq(E, A, B);
+ apply ->
+ Op = expr(cerl:apply_op(E), Env),
+ As = expr_list(cerl:apply_args(E), Env),
+ cerl:update_c_apply(E, Op, As);
+ call ->
+ M = expr(cerl:call_module(E), Env),
+ N = expr(cerl:call_name(E), Env),
+ As = expr_list(cerl:call_args(E), Env),
+ cerl:update_c_call(E, M, N, As);
+ primop ->
+ As = expr_list(cerl:primop_args(E), Env),
+ cerl:update_c_primop(E, cerl:primop_name(E), As);
+ 'case' ->
+ A = expr(cerl:case_arg(E), Env),
+ Cs = expr_list(cerl:case_clauses(E), Env),
+ {E1, Vs} = clauses(Cs, Env),
+ make_let(Vs, A, E1);
+ clause ->
+ Vs = cerl:clause_vars(E),
+ Env1 = add_vars(Vs, Env),
+ G = expr(cerl:clause_guard(E), Env1),
+ B = expr(cerl:clause_body(E), Env1),
+ cerl:update_c_clause(E, cerl:clause_pats(E), G, B);
+ 'fun' ->
+ Vs = cerl:fun_vars(E),
+ Env1 = add_vars(Vs, Env),
+ B = expr(cerl:fun_body(E), Env1),
+ cerl:update_c_fun(E, Vs, B);
+ 'receive' ->
+ %% NOTE: No pattern matching compilation is done here! The
+ %% receive-clauses and patterns cannot be staged as long as
+ %% we are working with "normal" Core Erlang.
+ Cs = expr_list(cerl:receive_clauses(E), Env),
+ T = expr(cerl:receive_timeout(E), Env),
+ A = expr(cerl:receive_action(E), Env),
+ cerl:update_c_receive(E, Cs, T, A);
+ 'try' ->
+ A = expr(cerl:try_arg(E), Env),
+ Vs = cerl:try_vars(E),
+ B = expr(cerl:try_body(E), add_vars(Vs, Env)),
+ Evs = cerl:try_evars(E),
+ H = expr(cerl:try_handler(E), add_vars(Evs, Env)),
+ cerl:update_c_try(E, A, Vs, B, Evs, H);
+ 'catch' ->
+ B = expr(cerl:catch_body(E), Env),
+ cerl:update_c_catch(E, B);
+ letrec ->
+ Ds = cerl:letrec_defs(E),
+ Env1 = add_defs(Ds, Env),
+ Ds1 = defs(Ds, Env1),
+ B = expr(cerl:letrec_body(E), Env1),
+ cerl:update_c_letrec(E, Ds1, B);
+ module ->
+ Ds = cerl:module_defs(E),
+ Env1 = add_defs(Ds, Env),
+ Ds1 = defs(Ds, Env1),
+ cerl:update_c_module(E, cerl:module_name(E),
+ cerl:module_exports(E),
+ cerl:module_attrs(E), Ds1)
+ end.
+
+expr_list(Es, Env) ->
+ [expr(E, Env) || E <- Es].
+
+defs(Ds, Env) ->
+ [{V, expr(F, Env)} || {V, F} <- Ds].
+-endif. % NO_UNUSED
+%% @clear
+
+%% ---------------------------------------------------------------------
+%% Support functions
+
+new_var(Env) ->
+ Name = env__new_vname(Env),
+ cerl:c_var(Name).
+
+new_vars(N, Env) ->
+ [cerl:c_var(V) || V <- env__new_vnames(N, Env)].
+
+new_fvar(A, N, Env) ->
+ Name = env__new_fname(A, N, Env),
+ cerl:c_var(Name).
+
+add_vars(Vs, Env) ->
+ foldl(fun (V, E) -> env__bind(cerl:var_name(V), [], E) end, Env, Vs).
+
+-ifndef(NO_UNUSED).
+add_defs(Ds, Env) ->
+ foldl(fun ({V, _F}, E) ->
+ env__bind(cerl:var_name(V), [], E)
+ end, Env, Ds).
+-endif. % NO_UNUSED
+
+%% This decides whether an expression is worth lifting out to a separate
+%% function instead of duplicating the code. In other words, whether its
+%% cost is about the same or smaller than that of a local function call.
+%% Note that variables must always be "lightweight"; otherwise, they may
+%% get lifted out of the case switch that introduces them.
+
+is_lightweight(E) ->
+ case get('cerl_pmatch_duplicate_code') of
+ never -> cerl:type(E) =:= var; % Avoids all code duplication
+ always -> true; % Does not lift code to new functions
+ _ -> is_lightweight_1(E)
+ end.
+
+is_lightweight_1(E) ->
+ case cerl:type(E) of
+ var -> true;
+ literal -> true;
+ 'fun' -> true;
+ values -> all(fun is_simple/1, cerl:values_es(E));
+ cons -> is_simple(cerl:cons_hd(E))
+ andalso is_simple(cerl:cons_tl(E));
+ tuple -> all(fun is_simple/1, cerl:tuple_es(E));
+ 'let' -> (is_simple(cerl:let_arg(E)) andalso
+ is_lightweight_1(cerl:let_body(E)));
+ seq -> (is_simple(cerl:seq_arg(E)) andalso
+ is_lightweight_1(cerl:seq_body(E)));
+ primop ->
+ all(fun is_simple/1, cerl:primop_args(E));
+ apply ->
+ is_simple(cerl:apply_op(E))
+ andalso all(fun is_simple/1, cerl:apply_args(E));
+ call ->
+ is_simple(cerl:call_module(E))
+ andalso is_simple(cerl:call_name(E))
+ andalso all(fun is_simple/1, cerl:call_args(E));
+ _ ->
+ %% The default is to lift the code to a new function.
+ false
+ end.
+
+%% "Simple" things have no (or negligible) runtime cost and are free
+%% from side effects.
+
+is_simple(E) ->
+ case cerl:type(E) of
+ var -> true;
+ literal -> true;
+ values -> all(fun is_simple/1, cerl:values_es(E));
+ _ -> false
+ end.
+
+
+get_unique() ->
+ case get(unique_label) of
+ undefined ->
+ put(unique_label, 1),
+ 0;
+ N ->
+ put(unique_label, N+1),
+ N
+ end.
+
+%% ---------------------------------------------------------------------
+%% Abstract datatype: environment()
+
+env__bind(Key, Val, Env) ->
+ rec_env:bind(Key, Val, Env).
+
+-ifndef(NO_UNUSED).
+%% env__bind_recursive(Ks, Vs, F, Env) ->
+%% rec_env:bind_recursive(Ks, Vs, F, Env).
+
+%% env__lookup(Key, Env) ->
+%% rec_env:lookup(Key, Env).
+
+%% env__get(Key, Env) ->
+%% rec_env:get(Key, Env).
+
+%% env__is_defined(Key, Env) ->
+%% rec_env:is_defined(Key, Env).
+
+env__empty() ->
+ rec_env:empty().
+-endif. % NO_UNUSED
+
+env__new_vname(Env) ->
+ rec_env:new_key(Env).
+
+env__new_vnames(N, Env) ->
+ rec_env:new_keys(N, Env).
+
+env__new_fname(F, A, Env) ->
+ rec_env:new_key(fun (X) ->
+ S = integer_to_list(X),
+ {list_to_atom(F ++ S), A}
+ end,
+ Env).
diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl
new file mode 100644
index 0000000000..fba9a48cda
--- /dev/null
+++ b/lib/hipe/cerl/cerl_prettypr.erl
@@ -0,0 +1,883 @@
+%% =====================================================================
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Core Erlang prettyprinter, using the 'prettypr' module.
+%%
+%% Copyright (C) 1999-2002 Richard Carlsson
+%%
+%% Author contact: richardc@it.uu.se
+%% =====================================================================
+%%
+%% @doc Core Erlang prettyprinter.
+%%
+%% <p>This module is a front end to the pretty-printing library module
+%% <code>prettypr</code>, for text formatting of Core Erlang abstract
+%% syntax trees defined by the module <code>cerl</code>.</p>
+
+%% TODO: add printing of comments for `comment'-annotations?
+
+-module(cerl_prettypr).
+
+-define(NO_UNUSED, true).
+
+-export([format/1, format/2, annotate/3]).
+-ifndef(NO_UNUSED).
+-export([best/1, best/2, layout/1, layout/2, get_ctxt_paperwidth/1,
+ set_ctxt_paperwidth/2, get_ctxt_linewidth/1,
+ set_ctxt_linewidth/2, get_ctxt_hook/1, set_ctxt_hook/2,
+ get_ctxt_user/1, set_ctxt_user/2]).
+-endif.
+
+-import(prettypr, [text/1, nest/2, above/2, beside/2, sep/1, par/1,
+ par/2, follow/3, follow/2, floating/1, empty/0]).
+
+-import(cerl, [abstract/1, alias_pat/1, alias_var/1, apply_args/1,
+ apply_op/1, atom_lit/1, binary_segments/1, bitstr_val/1,
+ bitstr_size/1, bitstr_unit/1, bitstr_type/1,
+ bitstr_flags/1, call_args/1, call_module/1, call_name/1,
+ case_arg/1, case_clauses/1, catch_body/1, c_atom/1,
+ c_binary/1, c_bitstr/5, c_int/1, clause_body/1,
+ clause_guard/1, clause_pats/1, concrete/1, cons_hd/1,
+ cons_tl/1, float_lit/1, fun_body/1, fun_vars/1,
+ get_ann/1, int_lit/1, is_c_cons/1, is_c_let/1,
+ is_c_nil/1, is_c_seq/1, is_print_string/1, let_arg/1,
+ let_body/1, let_vars/1, letrec_body/1, letrec_defs/1,
+ module_attrs/1, module_defs/1, module_exports/1,
+ module_name/1, primop_args/1, primop_name/1,
+ receive_action/1, receive_clauses/1, receive_timeout/1,
+ seq_arg/1, seq_body/1, string_lit/1, try_arg/1,
+ try_body/1, try_vars/1, try_evars/1, try_handler/1,
+ tuple_es/1, type/1, values_es/1, var_name/1]).
+
+-define(PAPER, 76).
+-define(RIBBON, 45).
+-define(NOUSER, undefined).
+-define(NOHOOK, none).
+
+-type hook() :: 'none' | fun((cerl:cerl(), _, _) -> prettypr:document()).
+
+-record(ctxt, {line = 0 :: integer(),
+ body_indent = 4 :: non_neg_integer(),
+ sub_indent = 2 :: non_neg_integer(),
+ hook = ?NOHOOK :: hook(),
+ noann = false :: boolean(),
+ paper = ?PAPER :: integer(),
+ ribbon = ?RIBBON :: integer(),
+ user = ?NOUSER :: term()}).
+-type context() :: #ctxt{}.
+
+%% =====================================================================
+%% The following functions examine and modify contexts:
+
+%% @spec (context()) -> integer()
+%% @doc Returns the paper widh field of the prettyprinter context.
+%% @see set_ctxt_paperwidth/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_paperwidth(Ctxt) ->
+ Ctxt#ctxt.paper.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), integer()) -> context()
+%%
+%% @doc Updates the paper widh field of the prettyprinter context.
+%%
+%% <p> Note: changing this value (and passing the resulting context to a
+%% continuation function) does not affect the normal formatting, but may
+%% affect user-defined behaviour in hook functions.</p>
+%%
+%% @see get_ctxt_paperwidth/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_paperwidth(Ctxt, W) ->
+ Ctxt#ctxt{paper = W}.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context()) -> integer()
+%% @doc Returns the line widh field of the prettyprinter context.
+%% @see set_ctxt_linewidth/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_linewidth(Ctxt) ->
+ Ctxt#ctxt.ribbon.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), integer()) -> context()
+%%
+%% @doc Updates the line widh field of the prettyprinter context.
+%%
+%% <p> Note: changing this value (and passing the resulting context to a
+%% continuation function) does not affect the normal formatting, but may
+%% affect user-defined behaviour in hook functions.</p>
+%%
+%% @see get_ctxt_linewidth/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_linewidth(Ctxt, W) ->
+ Ctxt#ctxt{ribbon = W}.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context()) -> hook()
+%% @doc Returns the hook function field of the prettyprinter context.
+%% @see set_ctxt_hook/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_hook(Ctxt) ->
+ Ctxt#ctxt.hook.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), hook()) -> context()
+%% @doc Updates the hook function field of the prettyprinter context.
+%% @see get_ctxt_hook/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_hook(Ctxt, Hook) ->
+ Ctxt#ctxt{hook = Hook}.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context()) -> term()
+%% @doc Returns the user data field of the prettyprinter context.
+%% @see set_ctxt_user/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_user(Ctxt) ->
+ Ctxt#ctxt.user.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), term()) -> context()
+%% @doc Updates the user data field of the prettyprinter context.
+%% @see get_ctxt_user/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_user(Ctxt, X) ->
+ Ctxt#ctxt{user = X}.
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec format(Tree::cerl()) -> string()
+%% @equiv format(Tree, [])
+
+-spec format(cerl:cerl()) -> string().
+
+format(Node) ->
+ format(Node, []).
+
+
+%% =====================================================================
+%% @spec format(Tree::cerl(), Options::[term()]) -> string()
+%% cerl() = cerl:cerl()
+%%
+%% @type hook() = (cerl(), context(), Continuation) -> document()
+%% Continuation = (cerl(), context()) -> document().
+%%
+%% A call-back function for user-controlled formatting. See <a
+%% href="#format-2"><code>format/2</code></a>.
+%%
+%% @type context(). A representation of the current context of the
+%% pretty-printer. Can be accessed in hook functions.
+%%
+%% @doc Prettyprint-formats a Core Erlang syntax tree as text.
+%%
+%% <p>Available options:
+%% <dl>
+%% <dt>{hook, none | <a href="#type-hook">hook()</a>}</dt>
+%% <dd>Unless the value is <code>none</code>, the given function
+%% is called for every node; see below for details. The default
+%% value is <code>none</code>.</dd>
+%%
+%% <dt>{noann, boolean()}</dt>
+%% <dd>If the value is <code>true</code>, annotations on the code
+%% are not printed. The default value is <code>false</code>.</dd>
+%%
+%% <dt>{paper, integer()}</dt>
+%% <dd>Specifies the preferred maximum number of characters on any
+%% line, including indentation. The default value is 76.</dd>
+%%
+%% <dt>{ribbon, integer()}</dt>
+%% <dd>Specifies the preferred maximum number of characters on any
+%% line, not counting indentation. The default value is 45.</dd>
+%%
+%% <dt>{user, term()}</dt>
+%% <dd>User-specific data for use in hook functions. The default
+%% value is <code>undefined</code>.</dd>
+%% </dl></p>
+%%
+%% <p>A hook function (cf. the <a
+%% href="#type-hook"><code>hook()</code></a> type) is passed the current
+%% syntax tree node, the context, and a continuation. The context can be
+%% examined and manipulated by functions such as
+%% <code>get_ctxt_user/1</code> and <code>set_ctxt_user/2</code>. The
+%% hook must return a "document" data structure (see
+%% <code>layout/2</code> and <code>best/2</code>); this may be
+%% constructed in part or in whole by applying the continuation
+%% function. For example, the following is a trivial hook:
+%% <pre>
+%% fun (Node, Ctxt, Cont) -> Cont(Node, Ctxt) end
+%% </pre>
+%% which yields the same result as if no hook was given.
+%% The following, however:
+%% <pre>
+%% fun (Node, Ctxt, Cont) ->
+%% Doc = Cont(Node, Ctxt),
+%% prettypr:beside(prettypr:text("<b>"),
+%% prettypr:beside(Doc,
+%% prettypr:text("</b>")))
+%% end
+%% </pre>
+%% will place the text of any annotated node (regardless of the
+%% annotation data) between HTML "boldface begin" and "boldface end"
+%% tags. The function <code>annotate/3</code> is exported for use in
+%% hook functions.</p>
+%%
+%% @see cerl
+%% @see format/1
+%% @see layout/2
+%% @see best/2
+%% @see annotate/3
+%% @see get_ctxt_user/1
+%% @see set_ctxt_user/2
+
+-spec format(cerl:cerl(), [term()]) -> string().
+
+format(Node, Options) ->
+ W = proplists:get_value(paper, Options, ?PAPER),
+ L = proplists:get_value(ribbon, Options, ?RIBBON),
+ prettypr:format(layout(Node, Options), W, L).
+
+
+%% =====================================================================
+%% @spec best(Tree::cerl()) -> empty | document()
+%% @equiv best(Node, [])
+
+-ifndef(NO_UNUSED).
+best(Node) ->
+ best(Node, []).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec best(Tree::cerl(), Options::[term()]) ->
+%% empty | document()
+%%
+%% @doc Creates a fixed "best" abstract layout for a Core Erlang syntax
+%% tree. This is similar to the <code>layout/2</code> function, except
+%% that here, the final layout has been selected with respect to the
+%% given options. The atom <code>empty</code> is returned if no such
+%% layout could be produced. For information on the options, see the
+%% <code>format/2</code> function.
+%%
+%% @see best/1
+%% @see layout/2
+%% @see format/2
+%% @see prettypr:best/2
+
+-ifndef(NO_UNUSED).
+best(Node, Options) ->
+ W = proplists:get_value(paper, Options, ?PAPER),
+ L = proplists:get_value(ribbon, Options, ?RIBBON),
+ prettypr:best(layout(Node, Options), W, L).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec layout(Tree::cerl()) -> document()
+%% @equiv layout(Tree, [])
+
+-ifndef(NO_UNUSED).
+layout(Node) ->
+ layout(Node, []).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec annotate(document(), Terms::[term()], context()) -> document()
+%%
+%% @doc Adds an annotation containing <code>Terms</code> around the
+%% given abstract document. This function is exported mainly for use in
+%% hook functions; see <code>format/2</code>.
+%%
+%% @see format/2
+
+-spec annotate(prettypr:document(), [term()], context()) -> prettypr:document().
+
+annotate(Doc, As0, Ctxt) ->
+ case strip_line(As0) of
+ [] ->
+ Doc;
+ As ->
+ case Ctxt#ctxt.noann of
+ false ->
+ Es = seq(As, floating(text(",")), Ctxt,
+ fun lay_concrete/2),
+ follow(beside(floating(text("(")), Doc),
+ beside(text("-| ["),
+ beside(par(Es), floating(text("])")))),
+ Ctxt#ctxt.sub_indent);
+ true ->
+ Doc
+ end
+ end.
+
+
+%% =====================================================================
+%% @spec layout(Tree::cerl(), Options::[term()]) -> document()
+%% document() = prettypr:document()
+%%
+%% @doc Creates an abstract document layout for a syntax tree. The
+%% result represents a set of possible layouts (cf. module
+%% <code>prettypr</code>). For information on the options, see
+%% <code>format/2</code>; note, however, that the <code>paper</code> and
+%% <code>ribbon</code> options are ignored by this function.
+%%
+%% <p>This function provides a low-level interface to the pretty
+%% printer, returning a flexible representation of possible layouts,
+%% independent of the paper width eventually to be used for formatting.
+%% This can be included as part of another document and/or further
+%% processed directly by the functions in the <code>prettypr</code>
+%% module, or used in a hook function (see <code>format/2</code> for
+%% details).</p>
+%%
+%% @see prettypr
+%% @see format/2
+%% @see layout/1
+
+-spec layout(cerl:cerl(), [term()]) -> prettypr:document().
+
+layout(Node, Options) ->
+ lay(Node,
+ #ctxt{hook = proplists:get_value(hook, Options, ?NOHOOK),
+ noann = proplists:get_bool(noann, Options),
+ paper = proplists:get_value(paper, Options, ?PAPER),
+ ribbon = proplists:get_value(ribbon, Options, ?RIBBON),
+ user = proplists:get_value(user, Options)}).
+
+lay(Node, Ctxt) ->
+ case get_line(get_ann(Node)) of
+ none ->
+ lay_0(Node, Ctxt);
+ Line ->
+ if Line > Ctxt#ctxt.line ->
+ Ctxt1 = Ctxt#ctxt{line = Line},
+ Txt = io_lib:format("% Line ~w",[Line]),
+% beside(lay_0(Node, Ctxt1), floating(text(Txt)));
+ above(floating(text(Txt)), lay_0(Node, Ctxt1));
+ true ->
+ lay_0(Node, Ctxt)
+ end
+ end.
+
+lay_0(Node, Ctxt) ->
+ case Ctxt#ctxt.hook of
+ ?NOHOOK ->
+ lay_ann(Node, Ctxt);
+ Hook ->
+ %% If there is a hook, we apply it.
+ Hook(Node, Ctxt, fun lay_ann/2)
+ end.
+
+%% This adds an annotation list (if nonempty) around a document, unless
+%% the `noann' option is enabled.
+
+lay_ann(Node, Ctxt) ->
+ Doc = lay_1(Node, Ctxt),
+ As = get_ann(Node),
+ annotate(Doc, As, Ctxt).
+
+%% This part ignores annotations:
+
+lay_1(Node, Ctxt) ->
+ case type(Node) of
+ literal ->
+ lay_literal(Node, Ctxt);
+ var ->
+ lay_var(Node, Ctxt);
+ values ->
+ lay_values(Node, Ctxt);
+ cons ->
+ lay_cons(Node, Ctxt);
+ tuple ->
+ lay_tuple(Node, Ctxt);
+ 'let' ->
+ lay_let(Node, Ctxt);
+ seq ->
+ lay_seq(Node, Ctxt);
+ apply ->
+ lay_apply(Node, Ctxt);
+ call ->
+ lay_call(Node, Ctxt);
+ primop ->
+ lay_primop(Node, Ctxt);
+ 'case' ->
+ lay_case(Node, Ctxt);
+ clause ->
+ lay_clause(Node, Ctxt);
+ alias ->
+ lay_alias(Node, Ctxt);
+ 'fun' ->
+ lay_fun(Node, Ctxt);
+ 'receive' ->
+ lay_receive(Node, Ctxt);
+ 'try' ->
+ lay_try(Node, Ctxt);
+ 'catch' ->
+ lay_catch(Node, Ctxt);
+ letrec ->
+ lay_letrec(Node, Ctxt);
+ module ->
+ lay_module(Node, Ctxt);
+ binary ->
+ lay_binary(Node, Ctxt);
+ bitstr ->
+ lay_bitstr(Node, Ctxt)
+ end.
+
+lay_literal(Node, Ctxt) ->
+ case concrete(Node) of
+ V when is_atom(V) ->
+ text(atom_lit(Node));
+ V when is_float(V) ->
+ text(tidy_float(float_lit(Node)));
+ V when is_integer(V) ->
+ %% Note that we do not even try to recognize values
+ %% that could represent printable characters - we
+ %% always print an integer.
+ text(int_lit(Node));
+ V when is_binary(V) ->
+ lay_binary(c_binary([c_bitstr(abstract(B),
+ abstract(8),
+ abstract(1),
+ abstract(integer),
+ abstract([unsigned, big]))
+ || B <- binary_to_list(V)]),
+ Ctxt);
+ [] ->
+ text("[]");
+ [_ | _] ->
+ %% `lay_cons' will check for strings.
+ lay_cons(Node, Ctxt);
+ V when is_tuple(V) ->
+ lay_tuple(Node, Ctxt)
+ end.
+
+lay_var(Node, Ctxt) ->
+ %% When formatting variable names, no two names should ever map to
+ %% the same string. We assume below that an atom representing a
+ %% variable name either has the character sequence of a proper
+ %% variable, or otherwise does not need single-quoting.
+ case var_name(Node) of
+ V when is_atom(V) ->
+ S = atom_to_list(V),
+ case S of
+ [C | _] when C >= $A, C =< $Z ->
+ %% Ordinary uppercase-prefixed names are printed
+ %% just as they are.
+ text(S);
+ [C | _] when C >= $\300, C =< $\336, C /= $\327 ->
+ %% These are also uppercase (ISO 8859-1).
+ text(S);
+ [$_| _] ->
+ %% If the name starts with '_' we keep the name as is.
+ text(S);
+ _ ->
+ %% Plain atom names are prefixed with a single "_".
+ %% E.g. 'foo' => "_foo".
+ text([$_ | S])
+ end;
+ V when is_integer(V) ->
+ %% Integers are always simply prefixed with "_";
+ %% e.g. 4711 => "_4711".
+ text([$_ | integer_to_list(V)]);
+ {N, A} when is_atom(N), is_integer(A) ->
+ %% Function names have no overlap problem.
+ beside(lay_noann(c_atom(atom_to_list(N)), Ctxt),
+ beside(text("/"), lay_noann(c_int(A), Ctxt)))
+ end.
+
+lay_values(Node, Ctxt) ->
+ lay_value_list(values_es(Node), Ctxt).
+
+lay_cons(Node, Ctxt) ->
+ case is_print_string(Node) of
+ true ->
+ lay_string(string_lit(Node), Ctxt);
+ false ->
+ beside(floating(text("[")),
+ beside(par(lay_list_elements(Node, Ctxt)),
+ floating(text("]"))))
+ end.
+
+lay_string(S, Ctxt) ->
+ %% S includes leading/trailing double-quote characters. The segment
+ %% width is 2/3 of the ribbon width - this seems to work well.
+ W = (Ctxt#ctxt.ribbon) * 2 div 3,
+ lay_string_1(S, length(S), W).
+
+lay_string_1(S, L, W) when L > W, W > 0 ->
+ %% Note that L is the minimum, not the exact, printed length.
+ case split_string(S, W - 1, L) of
+ {_, ""} ->
+ text(S);
+ {S1, S2} ->
+ above(text(S1 ++ "\""),
+ lay_string_1([$" | S2], L - W + 1, W))
+ end;
+lay_string_1(S, _L, _W) ->
+ text(S).
+
+split_string(Xs, N, L) ->
+ split_string_1(Xs, N, L, []).
+
+%% We only split strings at whitespace, if possible. We must make sure
+%% we do not split an escape sequence.
+
+split_string_1([$\s | Xs], N, L, As) when N =< 0, L >= 5 ->
+ {lists:reverse([$\s | As]), Xs};
+split_string_1([$\t | Xs], N, L, As) when N =< 0, L >= 5 ->
+ {lists:reverse([$t, $\\ | As]), Xs};
+split_string_1([$\n | Xs], N, L, As) when N =< 0, L >= 5 ->
+ {lists:reverse([$n, $\\ | As]), Xs};
+split_string_1([$\\ | Xs], N, L, As) ->
+ split_string_2(Xs, N - 1, L - 1, [$\\ | As]);
+split_string_1(Xs, N, L, As) when N =< -10, L >= 5 ->
+ {lists:reverse(As), Xs};
+split_string_1([X | Xs], N, L, As) ->
+ split_string_1(Xs, N - 1, L - 1, [X | As]);
+split_string_1([], _N, _L, As) ->
+ {lists:reverse(As), ""}.
+
+split_string_2([$^, X | Xs], N, L, As) ->
+ split_string_1(Xs, N - 2, L - 2, [X, $^ | As]);
+split_string_2([X1, X2, X3 | Xs], N, L, As) when
+ X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7, X3 >= $0, X3 =< $7 ->
+ split_string_1(Xs, N - 3, L - 3, [X3, X2, X1 | As]);
+split_string_2([X1, X2 | Xs], N, L, As) when
+ X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7 ->
+ split_string_1(Xs, N - 2, L - 2, [X2, X1 | As]);
+split_string_2([X | Xs], N, L, As) ->
+ split_string_1(Xs, N - 1, L - 1, [X | As]).
+
+lay_tuple(Node, Ctxt) ->
+ beside(floating(text("{")),
+ beside(par(seq(tuple_es(Node), floating(text(",")),
+ Ctxt, fun lay/2)),
+ floating(text("}")))).
+
+lay_let(Node, Ctxt) ->
+ V = lay_value_list(let_vars(Node), Ctxt),
+ D1 = par([follow(text("let"),
+ beside(V, floating(text(" ="))),
+ Ctxt#ctxt.sub_indent),
+ lay(let_arg(Node), Ctxt)],
+ Ctxt#ctxt.body_indent),
+ B = let_body(Node),
+ D2 = lay(B, Ctxt),
+ case is_c_let(B) of
+ true ->
+ sep([beside(D1, floating(text(" in"))), D2]);
+ false ->
+ sep([D1, beside(text("in "), D2)])
+ end.
+
+lay_seq(Node, Ctxt) ->
+ D1 = beside(text("do "), lay(seq_arg(Node), Ctxt)),
+ B = seq_body(Node),
+ D2 = lay(B, Ctxt),
+ case is_c_seq(B) of
+ true ->
+ sep([D1, D2]);
+ false ->
+ sep([D1, nest(3, D2)])
+ end.
+
+lay_apply(Node, Ctxt) ->
+ As = seq(apply_args(Node), floating(text(",")), Ctxt,
+ fun lay/2),
+ beside(follow(text("apply"), lay(apply_op(Node), Ctxt)),
+ beside(text("("),
+ beside(par(As), floating(text(")"))))).
+
+lay_call(Node, Ctxt) ->
+ As = seq(call_args(Node), floating(text(",")), Ctxt,
+ fun lay/2),
+ beside(follow(text("call"),
+ beside(beside(lay(call_module(Node), Ctxt),
+ floating(text(":"))),
+ lay(call_name(Node), Ctxt)),
+ Ctxt#ctxt.sub_indent),
+ beside(text("("), beside(par(As),
+ floating(text(")"))))).
+
+lay_primop(Node, Ctxt) ->
+ As = seq(primop_args(Node), floating(text(",")), Ctxt,
+ fun lay/2),
+ beside(follow(text("primop"),
+ lay(primop_name(Node), Ctxt),
+ Ctxt#ctxt.sub_indent),
+ beside(text("("), beside(par(As),
+ floating(text(")"))))).
+
+lay_case(Node, Ctxt) ->
+ Cs = seq(case_clauses(Node), none, Ctxt, fun lay/2),
+ sep([par([follow(text("case"),
+ lay(case_arg(Node), Ctxt),
+ Ctxt#ctxt.sub_indent),
+ text("of")],
+ Ctxt#ctxt.sub_indent),
+ nest(Ctxt#ctxt.sub_indent,
+ vertical(Cs)),
+ text("end")]).
+
+lay_clause(Node, Ctxt) ->
+ P = lay_value_list(clause_pats(Node), Ctxt),
+ G = lay(clause_guard(Node), Ctxt),
+ H = par([P, follow(follow(text("when"), G,
+ Ctxt#ctxt.sub_indent),
+ floating(text("->")))],
+ Ctxt#ctxt.sub_indent),
+ par([H, lay(clause_body(Node), Ctxt)],
+ Ctxt#ctxt.body_indent).
+
+lay_alias(Node, Ctxt) ->
+ follow(beside(lay(alias_var(Node), Ctxt),
+ text(" =")),
+ lay(alias_pat(Node), Ctxt),
+ Ctxt#ctxt.body_indent).
+
+lay_fun(Node, Ctxt) ->
+ Vs = seq(fun_vars(Node), floating(text(",")),
+ Ctxt, fun lay/2),
+ par([follow(text("fun"),
+ beside(text("("),
+ beside(par(Vs),
+ floating(text(") ->")))),
+ Ctxt#ctxt.sub_indent),
+ lay(fun_body(Node), Ctxt)],
+ Ctxt#ctxt.body_indent).
+
+lay_receive(Node, Ctxt) ->
+ Cs = seq(receive_clauses(Node), none, Ctxt, fun lay/2),
+ sep([text("receive"),
+ nest(Ctxt#ctxt.sub_indent, vertical(Cs)),
+ sep([follow(text("after"),
+ beside(lay(receive_timeout(Node), Ctxt),
+ floating(text(" ->"))),
+ Ctxt#ctxt.sub_indent),
+ nest(Ctxt#ctxt.sub_indent,
+ lay(receive_action(Node), Ctxt))])]).
+
+lay_try(Node, Ctxt) ->
+ Vs = lay_value_list(try_vars(Node), Ctxt),
+ Evs = lay_value_list(try_evars(Node), Ctxt),
+ sep([follow(text("try"),
+ lay(try_arg(Node), Ctxt),
+ Ctxt#ctxt.body_indent),
+ follow(beside(beside(text("of "), Vs),
+ floating(text(" ->"))),
+ lay(try_body(Node), Ctxt),
+ Ctxt#ctxt.body_indent),
+ follow(beside(beside(text("catch "), Evs),
+ floating(text(" ->"))),
+ lay(try_handler(Node), Ctxt),
+ Ctxt#ctxt.body_indent)]).
+
+lay_catch(Node, Ctxt) ->
+ follow(text("catch"),
+ lay(catch_body(Node), Ctxt),
+ Ctxt#ctxt.sub_indent).
+
+lay_letrec(Node, Ctxt) ->
+ Es = seq(letrec_defs(Node), none, Ctxt, fun lay_fdef/2),
+ sep([text("letrec"),
+ nest(Ctxt#ctxt.sub_indent, vertical(Es)),
+ beside(text("in "), lay(letrec_body(Node), Ctxt))]).
+
+lay_module(Node, Ctxt) ->
+ %% Note that the module name, exports and attributes may not
+ %% be annotated in the printed format.
+ Xs = seq(module_exports(Node), floating(text(",")), Ctxt,
+ fun lay_noann/2),
+ As = seq(module_attrs(Node), floating(text(",")), Ctxt,
+ fun lay_attrdef/2),
+ Es = seq(module_defs(Node), none, Ctxt, fun lay_fdef/2),
+ sep([follow(text("module"),
+ follow(lay_noann(module_name(Node), Ctxt),
+ beside(beside(text("["), par(Xs)),
+ floating(text("]")))),
+ Ctxt#ctxt.sub_indent),
+ nest(Ctxt#ctxt.sub_indent,
+ follow(text("attributes"),
+ beside(beside(text("["), par(As)),
+ floating(text("]"))),
+ Ctxt#ctxt.sub_indent)),
+ nest(Ctxt#ctxt.sub_indent, vertical(Es)),
+ text("end")]).
+
+lay_binary(Node, Ctxt) ->
+ beside(floating(text("#{")),
+ beside(sep(seq(binary_segments(Node), floating(text(",")),
+ Ctxt, fun lay_bitstr/2)),
+ floating(text("}#")))).
+
+lay_bitstr(Node, Ctxt) ->
+ Head = beside(floating(text("#<")),
+ beside(lay(bitstr_val(Node), Ctxt),
+ floating(text(">")))),
+ As = [bitstr_size(Node),
+ bitstr_unit(Node),
+ bitstr_type(Node),
+ bitstr_flags(Node)],
+ beside(Head, beside(floating(text("(")),
+ beside(sep(seq(As, floating(text(",")),
+ Ctxt, fun lay/2)),
+ floating(text(")"))))).
+
+%% In all places where "<...>"-sequences can occur, it is OK to
+%% write 1-element sequences without the "<" and ">".
+
+lay_value_list([E], Ctxt) ->
+ lay(E, Ctxt);
+lay_value_list(Es, Ctxt) ->
+ beside(floating(text("<")),
+ beside(par(seq(Es, floating(text(",")),
+ Ctxt, fun lay/2)),
+ floating(text(">")))).
+
+lay_noann(Node, Ctxt) ->
+ lay(Node, Ctxt#ctxt{noann = true}).
+
+lay_concrete(T, Ctxt) ->
+ lay(abstract(T), Ctxt).
+
+lay_attrdef({K, V}, Ctxt) ->
+ follow(beside(lay_noann(K, Ctxt), floating(text(" ="))),
+ lay_noann(V, Ctxt),
+ Ctxt#ctxt.body_indent).
+
+lay_fdef({N, F}, Ctxt) ->
+ par([beside(lay(N, Ctxt), floating(text(" ="))),
+ lay(F, Ctxt)],
+ Ctxt#ctxt.body_indent).
+
+lay_list_elements(Node, Ctxt) ->
+ T = cons_tl(Node),
+ A = case Ctxt#ctxt.noann of
+ false ->
+ get_ann(T);
+ true ->
+ []
+ end,
+ H = lay(cons_hd(Node), Ctxt),
+ case is_c_cons(T) of
+ true when A =:= [] ->
+ [beside(H, floating(text(",")))
+ | lay_list_elements(T, Ctxt)];
+ _ ->
+ case is_c_nil(T) of
+ true when A =:= [] ->
+ [H];
+ _ ->
+ [H, beside(floating(text("| ")),
+ lay(T, Ctxt))]
+ end
+ end.
+
+seq([H | T], Separator, Ctxt, Fun) ->
+ case T of
+ [] ->
+ [Fun(H, Ctxt)];
+ _ ->
+ [maybe_append(Separator, Fun(H, Ctxt))
+ | seq(T, Separator, Ctxt, Fun)]
+ end;
+seq([], _, _, _) ->
+ [empty()].
+
+maybe_append(none, D) ->
+ D;
+maybe_append(Suffix, D) ->
+ beside(D, Suffix).
+
+vertical([D]) ->
+ D;
+vertical([D | Ds]) ->
+ above(D, vertical(Ds));
+vertical([]) ->
+ [].
+
+% horizontal([D]) ->
+% D;
+% horizontal([D | Ds]) ->
+% beside(D, horizontal(Ds));
+% horizontal([]) ->
+% [].
+
+tidy_float([$., C | Cs]) ->
+ [$., C | tidy_float_1(Cs)]; % preserve first decimal digit
+tidy_float([$e | _] = Cs) ->
+ tidy_float_2(Cs);
+tidy_float([C | Cs]) ->
+ [C | tidy_float(Cs)];
+tidy_float([]) ->
+ [].
+
+tidy_float_1([$0, $0, $0 | Cs]) ->
+ tidy_float_2(Cs); % cut mantissa at three consecutive zeros.
+tidy_float_1([$e | _] = Cs) ->
+ tidy_float_2(Cs);
+tidy_float_1([C | Cs]) ->
+ [C | tidy_float_1(Cs)];
+tidy_float_1([]) ->
+ [].
+
+tidy_float_2([$e, $+, $0]) -> [];
+tidy_float_2([$e, $+, $0 | Cs]) -> tidy_float_2([$e, $+ | Cs]);
+tidy_float_2([$e, $+ | _] = Cs) -> Cs;
+tidy_float_2([$e, $-, $0]) -> [];
+tidy_float_2([$e, $-, $0 | Cs]) -> tidy_float_2([$e, $- | Cs]);
+tidy_float_2([$e, $- | _] = Cs) -> Cs;
+tidy_float_2([$e | Cs]) -> tidy_float_2([$e, $+ | Cs]);
+tidy_float_2([_ | Cs]) -> tidy_float_2(Cs);
+tidy_float_2([]) -> [].
+
+get_line([L | _As]) when is_integer(L) ->
+ L;
+get_line([_ | As]) ->
+ get_line(As);
+get_line([]) ->
+ none.
+
+strip_line([A | As]) when is_integer(A) ->
+ strip_line(As);
+strip_line([A | As]) ->
+ [A | strip_line(As)];
+strip_line([]) ->
+ [].
+
+%% =====================================================================
diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl
new file mode 100644
index 0000000000..362c427cbe
--- /dev/null
+++ b/lib/hipe/cerl/cerl_to_icode.erl
@@ -0,0 +1,2717 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <richardc@it.uu.se>
+%% @copyright 2000-2006 Richard Carlsson
+%% @doc Translation from Core Erlang to HiPE Icode.
+
+%% TODO: annotate Icode leaf functions as such.
+%% TODO: add a pass to remove unnecessary reduction tests
+%% TODO: generate branch prediction info?
+
+-module(cerl_to_icode).
+
+-define(NO_UNUSED, true).
+
+-export([module/2]).
+-ifndef(NO_UNUSED).
+-export([function/3, function/4, module/1]).
+-endif.
+
+%% Added in an attempt to suppress message by Dialyzer, but I run into
+%% an internal compiler error in the old inliner and commented it out.
+%% The inlining is performed manually instead :-( - Kostis
+%% -compile({inline, [{error_fun_value,1}]}).
+
+%% ---------------------------------------------------------------------
+%% Macros and records
+
+%% Icode primitive operation names
+
+-include("../icode/hipe_icode_primops.hrl").
+
+-define(OP_REDTEST, redtest).
+-define(OP_CONS, cons).
+-define(OP_TUPLE, mktuple).
+-define(OP_ELEMENT, {erlang,element,2}). %% This has an MFA name
+-define(OP_UNSAFE_HD, unsafe_hd).
+-define(OP_UNSAFE_TL, unsafe_tl).
+-define(OP_UNSAFE_ELEMENT(N), #unsafe_element{index=N}).
+-define(OP_UNSAFE_SETELEMENT(N), #unsafe_update_element{index=N}).
+-define(OP_CHECK_GET_MESSAGE, check_get_msg).
+-define(OP_NEXT_MESSAGE, next_msg).
+-define(OP_SELECT_MESSAGE, select_msg).
+-define(OP_SET_TIMEOUT, set_timeout).
+-define(OP_CLEAR_TIMEOUT, clear_timeout).
+-define(OP_WAIT_FOR_MESSAGE, suspend_msg).
+-define(OP_APPLY_FIXARITY(N), #apply_N{arity=N}).
+-define(OP_MAKE_FUN(M, F, A, U, I), #mkfun{mfa={M,F,A}, magic_num=U, index=I}).
+-define(OP_FUN_ELEMENT(N), #closure_element{n=N}).
+-define(OP_BS_CONTEXT_TO_BINARY, {hipe_bs_primop,bs_context_to_binary}).
+
+%% Icode conditional tests
+
+-define(TEST_EQ, '==').
+-define(TEST_NE, '/=').
+-define(TEST_EXACT_EQ, '=:=').
+-define(TEST_EXACT_NE, '=/=').
+-define(TEST_LT, '<').
+-define(TEST_GT, '>').
+-define(TEST_LE, '=<').
+-define(TEST_GE, '>=').
+-define(TEST_WAIT_FOR_MESSAGE_OR_TIMEOUT, suspend_msg_timeout).
+
+%% Icode type tests
+
+-define(TYPE_ATOM(X), {atom, X}).
+-define(TYPE_INTEGER(X), {integer, X}).
+-define(TYPE_FIXNUM(X), {integer, X}). % for now
+-define(TYPE_CONS, cons).
+-define(TYPE_NIL, nil).
+-define(TYPE_IS_N_TUPLE(N), {tuple, N}).
+-define(TYPE_IS_ATOM, atom).
+-define(TYPE_IS_BIGNUM, bignum).
+-define(TYPE_IS_BINARY, binary).
+-define(TYPE_IS_CONSTANT, constant).
+-define(TYPE_IS_FIXNUM, fixnum).
+-define(TYPE_IS_FLOAT, float).
+-define(TYPE_IS_FUNCTION, function).
+-define(TYPE_IS_INTEGER, integer).
+-define(TYPE_IS_LIST, list).
+-define(TYPE_IS_NUMBER, number).
+-define(TYPE_IS_PID, pid).
+-define(TYPE_IS_PORT, port).
+-define(TYPE_IS_RECORD(Atom_, Size_), {record, Atom_, Size_}).
+-define(TYPE_IS_REFERENCE, reference).
+-define(TYPE_IS_TUPLE, tuple).
+
+%% Record definitions
+
+-record(ctxt, {final = false :: boolean(),
+ effect = false,
+ fail = [], % [] or fail-to label
+ class = expr, % expr | guard
+ line = 0, % current line number
+ 'receive' % undefined | #receive{}
+ }).
+
+-record('receive', {loop}).
+-record(cerl_to_icode__var, {name}).
+-record('fun', {label, vars}).
+
+
+%% ---------------------------------------------------------------------
+%% Code
+
+
+%% @spec module(Module::cerl()) -> [icode()]
+%% @equiv module(Module, [])
+
+-ifndef(NO_UNUSED).
+module(E) ->
+ module(E, []).
+-endif.
+%% @clear
+
+
+%% @spec module(Module::cerl(), Options::[term()]) -> [icode()]
+%%
+%% cerl() = cerl:cerl()
+%% icode() = hipe_icode:icode()
+%%
+%% @doc Transforms a Core Erlang module to linear HiPE Icode. The result
+%% is a list of Icode function definitions. Currently, no options are
+%% available.
+%%
+%% <p>This function first calls the {@link cerl_hipeify:transform/2}
+%% function on the module.</p>
+%%
+%% <p>Note: Except for the module name, which is included in the header
+%% of each Icode function definition, the remaining information (exports
+%% and attributes) associated with the module definition is not included
+%% in the resulting Icode.</p>
+%%
+%% @see function/4
+%% @see cerl_hipeify:transform/1
+
+%% -spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}].
+
+module(E, Options) ->
+ module_1(cerl_hipeify:transform(E, Options), Options).
+
+module_1(E, Options) ->
+ M = cerl:atom_val(cerl:module_name(E)),
+ if is_atom(M) ->
+ ok;
+ true ->
+ error_msg("bad module name: ~P.", [M, 5]),
+ throw(error)
+ end,
+ S0 = init(M),
+ S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0),
+ S2 = s__set_bitlevel_binaries(proplists:get_value(
+ bitlevel_binaries, Options), S1),
+ {Icode, _} = lists:mapfoldl(fun function_definition/2,
+ S2, cerl:module_defs(E)),
+ Icode.
+
+%% For now, we simply assume that all function bodies should have degree
+%% one (i.e., return exactly one value). We clear the code ackumulator
+%% before we start compiling each function.
+
+function_definition({V, F}, S) ->
+ S1 = s__set_code([], S),
+ {Icode, S2} = function_1(cerl:var_name(V), F, 1, S1),
+ {{icode_icode_name(Icode), Icode}, S2}.
+
+init(Module) ->
+ reset_label_counter(),
+ s__new(Module).
+
+%% @spec function(Module::atom(), Name::atom(), Function::cerl()) ->
+%% icode()
+%% @equiv function(Module, Name, Fun, 1)
+
+-ifndef(NO_UNUSED).
+function(Module, Name, Fun) ->
+ function(Module, Name, Fun, 1).
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec function(Module::atom(), Name::{atom(), integer()},
+%% Fun::cerl(), Degree::integer()) -> icode()
+%%
+%% @doc Transforms a Core Erlang function to a HiPE Icode function
+%% definition. `Fun' must represent a fun-expression, which may not
+%% contain free variables. `Module' and `Name' specify the module and
+%% function name of the resulting Icode function. Note that the arity
+%% part of `Name' is not necessarily equivalent to the number of
+%% parameters of `Fun' (this can happen e.g., for lifted closure
+%% functions).
+%%
+%% <p>`Degree' specifies the number of values the function is expected
+%% to return; this is typically 1 (one); cf. {@link function/3}.</p>
+%%
+%% <p>Notes:
+%% <ul>
+%% <li>This function assumes that the code has been transformed into a
+%% very simple and explicit form, using the {@link cerl_hipeify}
+%% module.</li>
+%%
+%% <li>Several primops (see "`cerl_hipe_primops.hrl'") are
+%% detected by the translation and handled specially.</li>
+%%
+%% <li>Tail call optimization is handled, even when the call is
+%% "hidden" by let-definitions.</li>
+%%
+%% <li>It is assumed that all `primop' calls in the code represent
+%% Icode primops or macro instructions, and that all inter-module
+%% calls (both calls to statically named functions, and dynamic
+%% meta-calls) represent <em>actual</em> inter-module calls - not
+%% primitive or built-in operations.</li>
+%%
+%% <li>The following special form:
+%% ```case Test of
+%% 'true' when 'true' -> True
+%% 'false' when 'true' -> False
+%% end'''
+%% is recognized as an if-then-else switch where `Test' is known
+%% to always yield 'true' or 'false'. Efficient jumping code is
+%% generated for such expressions, in particular if nested. Note that
+%% there must be exactly two clauses; order is not important.</li>
+%%
+%% <li>Compilation of clauses is simplistic. No pattern matching
+%% compilation or similar optimizations is done at this stage. Guards
+%% that are `true' or `false' are recognized as trivially true/false;
+%% for all other guards, code will be generated. Catch-all clauses
+%% (with `true' guard and variable-only patterns) are detected, and
+%% any following clauses are discarded.</li>
+%% </ul></p>
+%%
+%% <p><b>Important</b>: This function does not handle occurrences of
+%% fun-expressions in the body of `Fun', nor `apply'-expressions whose
+%% operators are not locally bound function variables. These must be
+%% transformed away before this function is called, by closure
+%% conversion ({@link cerl_cconv}) using the `make_fun' and `call_fun'
+%% primitive operations to create and apply functional values.</p>
+%%
+%% <p>`receive'-expressions are expected to have a particular
+%% form:
+%% <ul>
+%% <li>There must be exactly one clause, with the atom
+%% `true' as guard, and only a single variable as pattern.
+%% The variable will be bound to a message in the mailbox, and can be
+%% referred to in the clause body.</li>
+%%
+%% <li>In the body of that clause, all paths must execute one of the
+%% primitive operations `receive_select/0' or
+%% `receive_next/0' before another
+%% `receive'-statement might be executed.
+%% `receive_select/0' always returns, but without a value,
+%% while `receive_next/0' never returns, either causing
+%% the nearest surrounding receive-expression to be re-tried with the
+%% next message in the input queue, or timing out.</li>
+%% </ul></p>
+%%
+%% @see function/3
+
+-include("cerl_hipe_primops.hrl").
+
+%% Main translation function:
+
+-ifndef(NO_UNUSED).
+function(Module, Name, Fun, Degree) ->
+ S = init(Module),
+ {Icode, _} = function_1(Name, Fun, Degree, S),
+ Icode.
+-endif. % NO_UNUSED
+%% @clear
+
+function_1(Name, Fun, Degree, S) ->
+ reset_var_counter(),
+ LowV = max_var(),
+ LowL = max_label(),
+ %% Create input variables for the function parameters, and a list of
+ %% target variables for the result of the function.
+ Args = cerl:fun_vars(Fun),
+ IcodeArity = length(Args),
+ Vs = make_vars(IcodeArity),
+ Vs1 = make_vars(IcodeArity), % input variable temporaries
+ Ts = make_vars(Degree),
+
+ %% Initialise environment and context.
+ Env = bind_vars(Args, Vs, env__new()),
+ %% TODO: if the function returns no values, we can use effect mode
+ Ctxt = #ctxt{final = true, effect = false},
+ %% Each basic block must begin with a label. Note that we
+ %% immediately transfer the input parameters to local variables, for
+ %% our self-recursive calling convention.
+ Start = new_label(),
+ Local = new_label(),
+ S1 = add_code([icode_label(Start)]
+ ++ make_moves(Vs, Vs1)
+ ++ [icode_label(Local)],
+ s__set_function(Name, S)),
+ S2 = expr(cerl:fun_body(Fun), Ts, Ctxt, Env,
+ s__set_local_entry({Local, Vs}, S1)),
+
+ %% This creates an Icode function definition. The ranges of used
+ %% variables and labels below should be nonempty. Note that the
+ %% input variables for the Icode function are `Vs1', which will be
+ %% transferred to `Vs' (see above).
+ HighV = new_var(), % assure nonempty range
+ HighL = max_label(),
+ Closure = lists:member(closure, cerl:get_ann(Fun)),
+ Module = s__get_module(S2),
+ Code = s__get_code(S2),
+ Function = icode_icode(Module, Name, Vs1, Closure, Code,
+ {LowV, HighV}, {LowL, HighL}),
+ if Closure ->
+ {_, OrigArity} =
+ lists:keyfind(closure_orig_arity, 1, cerl:get_ann(Fun)),
+ {hipe_icode:icode_closure_arity_update(Function,
+ OrigArity),
+ S2};
+ true -> {Function, S2}
+ end.
+
+%% ---------------------------------------------------------------------
+%% Main expression handler
+
+expr(E, Ts, Ctxt, Env, S0) ->
+ %% Insert source code position information
+ case get_line(cerl:get_ann(E)) of
+ none ->
+ expr_1(E, Ts, Ctxt, Env, S0);
+ Line when Line > Ctxt#ctxt.line ->
+ Txt = "Line: " ++ integer_to_list(Line),
+ S1 = add_code([icode_comment(Txt)], S0),
+ expr_1(E, Ts, Ctxt#ctxt{line = Line}, Env, S1);
+ _ ->
+ expr_1(E, Ts, Ctxt, Env, S0)
+ end.
+
+expr_1(E, Ts, Ctxt, Env, S) ->
+ case cerl:type(E) of
+ var ->
+ expr_var(E, Ts, Ctxt, Env, S);
+ literal ->
+ expr_literal(E, Ts, Ctxt, S);
+ values ->
+ expr_values(E, Ts, Ctxt, Env, S);
+ tuple ->
+ %% (The unit tuple `{}' is a literal, handled above.)
+ expr_tuple(E, Ts, Ctxt, Env, S);
+ cons ->
+ expr_cons(E, Ts, Ctxt, Env, S);
+ 'let' ->
+ expr_let(E, Ts, Ctxt, Env, S);
+ seq ->
+ expr_seq(E, Ts, Ctxt, Env, S);
+ apply ->
+ expr_apply(E, Ts, Ctxt, Env, S);
+ call ->
+ expr_call(E, Ts, Ctxt, Env, S);
+ primop ->
+ expr_primop(E, Ts, Ctxt, Env, S);
+ 'case' ->
+ expr_case(E, Ts, Ctxt, Env, S);
+ 'receive' ->
+ expr_receive(E, Ts, Ctxt, Env, S);
+ 'try' ->
+ expr_try(E, Ts, Ctxt, Env, S);
+ binary ->
+ expr_binary(E, Ts, Ctxt, Env, S);
+ letrec ->
+ expr_letrec(E, Ts, Ctxt, Env, S);
+ 'fun' ->
+ error_msg("cannot handle fun-valued expressions; "
+ "must be closure converted."),
+ throw(error)
+ end.
+
+%% This is for when we need new target variables for all of the
+%% expressions in the list, and evaluate them for value in a
+%% non-tail-call context.
+
+expr_list(Es, Ctxt, Env, S) ->
+ Ctxt1 = Ctxt#ctxt{effect = false, final = false},
+ lists:mapfoldl(fun (E0, S0) ->
+ V = make_var(),
+ {V, expr(E0, [V], Ctxt1, Env, S0)}
+ end,
+ S, Es).
+
+%% This is for when we already have the target variables. It is expected
+%% that each expression in the list has degree one, so the result can be
+%% assigned to the corresponding variable.
+
+exprs([E | Es], [V | Vs], Ctxt, Env, S) ->
+ S1 = expr(E, [V], Ctxt, Env, S),
+ exprs(Es, Vs, Ctxt, Env, S1);
+exprs([], [], _Ctxt, _Env, S) ->
+ S;
+exprs([], _, _Ctxt, _Env, S) ->
+ warning_low_degree(),
+ S;
+exprs(_, [], _Ctxt, _Env, _S) ->
+ error_high_degree(),
+ throw(error).
+
+get_line([L | _As]) when is_integer(L) ->
+ L;
+get_line([_ | As]) ->
+ get_line(As);
+get_line([]) ->
+ none.
+
+
+%% ---------------------------------------------------------------------
+%% Variables
+
+expr_var(_E, _Ts, #ctxt{effect = true}, _Env, S) ->
+ S;
+expr_var(E, Ts, Ctxt, Env, S) ->
+ Name = cerl:var_name(E),
+ case env__lookup(Name, Env) of
+ error ->
+ %% Either an undefined variable or an attempt to use a local
+ %% function name as a value.
+ case Name of
+ {N,A} when is_atom(N), is_integer(A) ->
+ %% error_fun_value(Name);
+ error_msg("cannot handle fun-values outside call context; "
+ "must be closure converted: ~P.",
+ [Name, 5]),
+ throw(error);
+ _ ->
+ error_msg("undefined variable: ~P.", [Name, 5]),
+ throw(error)
+ end;
+ {ok, #cerl_to_icode__var{name = V}} ->
+ case Ctxt#ctxt.final of
+ false ->
+ glue([V], Ts, S);
+ true ->
+ add_return([V], S)
+ end;
+ {ok, #'fun'{}} ->
+ %% A letrec-defined function name, used as a value.
+ %% error_fun_value(Name)
+ error_msg("cannot handle fun-values outside call context; "
+ "must be closure converted: ~P.",
+ [Name, 5]),
+ throw(error)
+ end.
+
+%% The function has been inlined manually above to suppress message by Dialyzer
+%% error_fun_value(Name) ->
+%% error_msg("cannot handle fun-values outside call context; "
+%% "must be closure converted: ~P.",
+%% [Name, 5]),
+%% throw(error).
+
+%% ---------------------------------------------------------------------
+%% This handles all constants, both atomic and compound:
+
+expr_literal(_E, _Ts, #ctxt{effect = true}, S) ->
+ S;
+expr_literal(E, [V] = Ts, Ctxt, S) ->
+ Code = [icode_move(V, icode_const(cerl:concrete(E)))],
+ maybe_return(Ts, Ctxt, add_code(Code, S));
+expr_literal(E, Ts, _Ctxt, _S) ->
+ error_degree_mismatch(length(Ts), E),
+ throw(error).
+
+%% ---------------------------------------------------------------------
+%% Multiple value aggregate <X1,...,Xn>
+
+expr_values(E, Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
+ {_, S1} = exprs(cerl:values_es(E), Ts, Ctxt#ctxt{final = false},
+ Env, S),
+ S1;
+expr_values(E, Ts, Ctxt, Env, S) ->
+ S1 = exprs(cerl:values_es(E), Ts, Ctxt#ctxt{final = false}, Env, S),
+ maybe_return(Ts, Ctxt, S1).
+
+%% ---------------------------------------------------------------------
+%% Nonconstant tuples
+
+expr_tuple(E, _Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
+ {_Vs, S1} = expr_list(cerl:tuple_es(E), Ctxt, Env, S),
+ S1;
+expr_tuple(E, [_V] = Ts, Ctxt, Env, S) ->
+ {Vs, S1} = expr_list(cerl:tuple_es(E), Ctxt, Env, S),
+ add_code(make_op(?OP_TUPLE, Ts, Vs, Ctxt), S1);
+expr_tuple(E, Ts, _Ctxt, _Env, _S) ->
+ error_degree_mismatch(length(Ts), E),
+ throw(error).
+
+%% ---------------------------------------------------------------------
+%% Nonconstant cons cells
+
+expr_cons(E, _Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
+ {_Vs, S1} = expr_list([cerl:cons_hd(E), cerl:cons_tl(E)], Ctxt, Env, S),
+ S1;
+expr_cons(E, [_V] = Ts, Ctxt, Env, S) ->
+ {Vs, S1} = expr_list([cerl:cons_hd(E), cerl:cons_tl(E)], Ctxt, Env, S),
+ add_code(make_op(?OP_CONS, Ts, Vs, Ctxt), S1);
+expr_cons(E, Ts, _Ctxt, _Env, _S) ->
+ error_degree_mismatch(length(Ts), E),
+ throw(error).
+
+%% ---------------------------------------------------------------------
+%% Let-expressions
+
+%% We want to make sure we are not easily tricked by expressions hidden
+%% in contexts like "let X = Expr in X"; this should not destroy tail
+%% call properties.
+
+expr_let(E, Ts, Ctxt, Env, S) ->
+ F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+ expr_let_1(E, F, Ctxt, Env, S).
+
+expr_let_1(E, F, Ctxt, Env, S) ->
+ E1 = cerl_lib:reduce_expr(E),
+ case cerl:is_c_let(E1) of
+ true ->
+ expr_let_2(E1, F, Ctxt, Env, S);
+ false ->
+ %% Redispatch the new expression.
+ F(E1, Ctxt, Env, S)
+ end.
+
+expr_let_2(E, F, Ctxt, Env, S) ->
+ Vars = cerl:let_vars(E),
+ Vs = make_vars(length(Vars)),
+ S1 = expr(cerl:let_arg(E), Vs,
+ Ctxt#ctxt{effect = false, final = false}, Env, S),
+ Env1 = bind_vars(Vars, Vs, Env),
+ F(cerl:let_body(E), Ctxt, Env1, S1).
+
+%% ---------------------------------------------------------------------
+%% Sequencing
+
+%% To compile a sequencing operator, we generate code for effect only
+%% for the first expression (the "argument") and then use the
+%% surrounding context for the second expression (the "body"). Note that
+%% we always create a new dummy target variable; this is necessary for
+%% many ICode operations, even if the result is not used.
+
+expr_seq(E, Ts, Ctxt, Env, S) ->
+ F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+ expr_seq_1(E, F, Ctxt, Env, S).
+
+expr_seq_1(E, F, Ctxt, Env, S) ->
+ Ctxt1 = Ctxt#ctxt{effect = true, final = false},
+ S1 = expr(cerl:seq_arg(E), [make_var()], Ctxt1, Env, S),
+ F(cerl:seq_body(E), Ctxt, Env, S1).
+
+%% ---------------------------------------------------------------------
+%% Binaries
+
+-record(sz_var, {code, sz}).
+-record(sz_const, {code, sz}).
+
+expr_binary(E, [V]=Ts, Ctxt, Env, S) ->
+ Offset = make_reg(),
+ Base = make_reg(),
+ Segs = cerl:binary_segments(E),
+ S1 = case do_size_code(Segs, S, Env, Ctxt) of
+ #sz_const{code = S0, sz = Size} ->
+ Primop = {hipe_bs_primop, {bs_init, Size, 0}},
+ add_code([icode_call_primop([V, Base, Offset], Primop, [])],
+ S0);
+ #sz_var{code = S0, sz = SizeVar} ->
+ Primop = {hipe_bs_primop, {bs_init, 0}},
+ add_code([icode_call_primop([V, Base, Offset],
+ Primop, [SizeVar])],
+ S0)
+ end,
+ Vars = make_vars(length(Segs)),
+ S2 = binary_segments(Segs, Vars, Ctxt, Env, S1, false, Base, Offset),
+ S3 = case s__get_bitlevel_binaries(S2) of
+ true ->
+ POp = {hipe_bs_primop, bs_final},
+ add_code([icode_call_primop([V], POp, [V, Offset])], S2);
+ false ->
+ S2
+ end,
+ maybe_return(Ts, Ctxt, S3).
+
+do_size_code(Segs, S, Env, Ctxt) ->
+ case do_size_code(Segs, S, Env, cerl:c_int(0), [], []) of
+ {[], [], Const, S1} ->
+ #sz_const{code = S1, sz = ((cerl:concrete(Const) + 7) div 8)};
+ {Pairs, Bins, Const, S1} ->
+ V1 = make_var(),
+ S2 = add_code([icode_move(V1, icode_const(cerl:int_val(Const)))], S1),
+ {S3, SizeVar} = create_size_code(Pairs, Bins, Ctxt, V1, S2),
+ #sz_var{code = S3, sz = SizeVar}
+ end.
+
+do_size_code([Seg|Rest], S, Env, Const, Pairs, Bins) ->
+ Size = cerl:bitstr_size(Seg),
+ Unit = cerl:bitstr_unit(Seg),
+ Val = cerl:bitstr_val(Seg),
+ case calculate_size(Unit, Size, false, Env, S) of
+ {all,_, _, S} ->
+ Binary = make_var(),
+ S1 = expr(Val, [Binary], #ctxt{final=false}, Env, S),
+ do_size_code(Rest, S1, Env, Const, Pairs, [{all,Binary}|Bins]);
+ {NewVal, [], S, _} ->
+ do_size_code(Rest, S, Env, add_val(NewVal, Const), Pairs, Bins);
+ {UnitVal, [Var], S1, _} ->
+ do_size_code(Rest, S1, Env, Const, [{UnitVal,Var}|Pairs], Bins)
+ end;
+do_size_code([], S, _Env, Const, Pairs, Bins) ->
+ {Pairs, Bins, Const, S}.
+
+add_val(NewVal, Const) ->
+ cerl:c_int(NewVal + cerl:concrete(Const)).
+
+create_size_code([{UnitVal, Var}|Rest], Bins, Ctxt, Old, S0) ->
+ Dst = make_var(),
+ S = make_bs_add(UnitVal, Old, Var, Dst, Ctxt, S0),
+ create_size_code(Rest, Bins, Ctxt, Dst, S);
+create_size_code([], Bins, Ctxt, Old, S0) ->
+ Dst = make_var(),
+ S = make_bs_bits_to_bytes(Old, Dst, Ctxt, S0),
+ create_size_code(Bins, Ctxt, Dst, S).
+
+create_size_code([{all,Bin}|Rest], Ctxt, Old, S0) ->
+ Dst = make_var(),
+ S = make_binary_size(Old, Bin, Dst, Ctxt, S0),
+ create_size_code(Rest, Ctxt, Dst, S);
+create_size_code([], _Ctxt, Dst, S) ->
+ {S, Dst}.
+
+make_bs_add(Unit, Old, Var, Dst, #ctxt{fail=FL, class=guard}, S0) ->
+ SL1 = new_label(),
+ SL2 = new_label(),
+ SL3 = new_label(),
+ Temp = make_var(),
+ add_code([icode_if('>=', [Var, icode_const(0)], SL1, FL),
+ icode_label(SL1),
+ icode_guardop([Temp], '*', [Var, icode_const(Unit)], SL2, FL),
+ icode_label(SL2),
+ icode_guardop([Dst], '+', [Temp, Old], SL3, FL),
+ icode_label(SL3)], S0);
+make_bs_add(Unit, Old, Var, Dst, _Ctxt, S0) ->
+ SL = new_label(),
+ FL = new_label(),
+ Temp = make_var(),
+ add_code([icode_if('>=', [Var, icode_const(0)], SL, FL),
+ icode_label(FL),
+ icode_fail([icode_const(badarg)], error),
+ icode_label(SL),
+ icode_call_primop([Temp], '*', [Var, icode_const(Unit)]),
+ icode_call_primop([Dst], '+', [Temp, Old])], S0).
+
+make_bs_bits_to_bytes(Old, Dst, #ctxt{fail=FL, class=guard}, S0) ->
+ SL = new_label(),
+ add_code([icode_guardop([Dst], 'bsl', [Old, icode_const(3)], SL, FL),
+ icode_label(SL)], S0);
+make_bs_bits_to_bytes(Old, Dst, _Ctxt, S0) ->
+ add_code([icode_call_primop([Dst], 'bsl', [Old, icode_const(3)])], S0).
+
+make_binary_size(Old, Bin, Dst, #ctxt{fail=FL, class=guard}, S0) ->
+ SL1 = new_label(),
+ SL2 = new_label(),
+ add_code([icode_guardop([Dst], {erlang, byte_size, 1}, [Bin], SL1, FL),
+ icode_label(SL1),
+ icode_guardop([Dst], '+', [Old, Dst], SL2, FL),
+ icode_label(SL2)], S0);
+make_binary_size(Old, Bin, Dst, _Ctxt, S0) ->
+ add_code([icode_call_primop([Dst], {erlang, byte_size, 1}, [Bin]),
+ icode_call_primop([Dst], '+', [Old, Dst])], S0).
+
+binary_segments(SegList, TList, Ctxt=#ctxt{}, Env, S, Align, Base,
+ Offset) ->
+ case do_const_segs(SegList, TList, S, Align, Base, Offset) of
+ {[Seg|Rest], [T|Ts], S1} ->
+ {S2, NewAlign} = bitstr(Seg, [T], Ctxt, Env, S1, Align,
+ Base, Offset),
+ binary_segments(Rest, Ts, Ctxt, Env, S2, NewAlign, Base, Offset);
+ {[], [], S1} ->
+ S1
+ end.
+
+do_const_segs(SegList, TList, S, _Align, Base, Offset) ->
+ case get_segs(SegList, TList, [], 0, {[], SegList, TList}) of
+ {[], SegList, TList} ->
+ {SegList, TList, S};
+ {ConstSegs, RestSegs, RestT} ->
+ String = create_string(ConstSegs, <<>>, 0),
+ Name = {bs_put_string, String, length(String)},
+ Primop = {hipe_bs_primop, Name},
+ {RestSegs, RestT,
+ add_code([icode_call_primop([Offset], Primop, [Base, Offset])],
+ S)}
+ end.
+
+get_segs([Seg|Rest], [_|RestT], Acc, AccSize, BestPresent) ->
+ Size = cerl:bitstr_size(Seg),
+ Unit = cerl:bitstr_unit(Seg),
+ Val = cerl:bitstr_val(Seg),
+ case allowed(Size, Unit, Val, AccSize) of
+ {true, NewAccSize} ->
+ case Acc of
+ [] ->
+ get_segs(Rest, RestT, [Seg|Acc], NewAccSize, BestPresent);
+ _ ->
+ get_segs(Rest, RestT, [Seg|Acc], NewAccSize,
+ {lists:reverse([Seg|Acc]), Rest, RestT})
+ end;
+ {possible, NewAccSize} ->
+ get_segs(Rest, RestT, [Seg|Acc], NewAccSize, BestPresent);
+ false ->
+ BestPresent
+ end;
+get_segs([], [], _Acc, _AccSize, Best) ->
+ Best.
+
+
+create_string([Seg|Rest], Bin, TotalSize) ->
+ Size = cerl:bitstr_size(Seg),
+ Unit = cerl:bitstr_unit(Seg),
+ NewSize = cerl:int_val(Size) * cerl:int_val(Unit),
+ LitVal = cerl:concrete(cerl:bitstr_val(Seg)),
+ LiteralFlags = cerl:bitstr_flags(Seg),
+ FlagVal = translate_flags(LiteralFlags, []),
+ NewTotalSize = NewSize + TotalSize,
+ Pad = (8 - NewTotalSize rem 8) rem 8,
+ NewBin = case cerl:concrete(cerl:bitstr_type(Seg)) of
+ integer ->
+ case {FlagVal band 2, FlagVal band 4} of
+ {2, 4} ->
+ <<Bin:TotalSize/binary-unit:1,
+ LitVal:NewSize/integer-little-signed, 0:Pad>>;
+ {0, 4} ->
+ <<Bin:TotalSize/binary-unit:1,
+ LitVal:NewSize/integer-signed, 0:Pad>>;
+ {2, 0} ->
+ <<Bin:TotalSize/binary-unit:1,
+ LitVal:NewSize/integer-little, 0:Pad>>;
+ {0, 0} ->
+ <<Bin:TotalSize/binary-unit:1,
+ LitVal:NewSize/integer, 0:Pad>>
+ end;
+ float ->
+ case FlagVal band 2 of
+ 2 ->
+ <<Bin:TotalSize/binary-unit:1,
+ LitVal:NewSize/float-little, 0:Pad>>;
+ 0 ->
+ <<Bin:TotalSize/binary-unit:1,
+ LitVal:NewSize/float, 0:Pad>>
+ end
+ end,
+ create_string(Rest, NewBin, NewTotalSize);
+
+create_string([], Bin, _Size) ->
+ binary_to_list(Bin).
+
+allowed(Size, Unit, Val, AccSize) ->
+ case {cerl:is_c_int(Size), cerl:is_literal(Val)} of
+ {true, true} ->
+ NewAccSize = cerl:int_val(Size) * cerl:int_val(Unit) + AccSize,
+ case NewAccSize rem 8 of
+ 0 ->
+ {true, NewAccSize};
+ _ ->
+ {possible, NewAccSize}
+ end;
+ _ ->
+ false
+ end.
+
+bitstr(E, Ts, Ctxt, Env, S, Align, Base, Offset) ->
+ Size = cerl:bitstr_size(E),
+ Unit = cerl:bitstr_unit(E),
+ LiteralFlags = cerl:bitstr_flags(E),
+ Val = cerl:bitstr_val(E),
+ Type = cerl:concrete(cerl:bitstr_type(E)),
+ S0 = expr(Val, Ts, Ctxt#ctxt{final = false, effect = false}, Env, S),
+ ConstInfo = get_const_info(Val, Type),
+ Flags = translate_flags(LiteralFlags, Align),
+ SizeInfo = calculate_size(Unit, Size, false, Env, S0),
+ bitstr_gen_op(Ts, Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset).
+
+bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo,
+ Type, Flags, Base, Offset) ->
+ SL = new_label(),
+ case SizeInfo of
+ {all,_NewUnit, NewAlign, S1} ->
+ Type = binary,
+ Name = {bs_put_binary_all, Flags},
+ Primop = {hipe_bs_primop, Name},
+ {add_code([icode_guardop([Offset], Primop,
+ [V, Base, Offset], SL, FL),
+ icode_label(SL)], S1), NewAlign};
+ {NewUnit, NewArgs, S1, NewAlign} ->
+ Args = [V|NewArgs] ++ [Base, Offset],
+ Name =
+ case Type of
+ integer ->
+ {bs_put_integer, NewUnit, Flags, ConstInfo};
+ float ->
+ {bs_put_float, NewUnit, Flags, ConstInfo};
+ binary ->
+ {bs_put_binary, NewUnit, Flags}
+ end,
+ Primop = {hipe_bs_primop, Name},
+ {add_code([icode_guardop([Offset], Primop, Args, SL, FL),
+ icode_label(SL)], S1), NewAlign}
+ end;
+bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base,
+ Offset) ->
+ case SizeInfo of
+ {all, _NewUnit, NewAlign, S} ->
+ Type = binary,
+ Name = {bs_put_binary_all, Flags},
+ Primop = {hipe_bs_primop, Name},
+ {add_code([icode_call_primop([Offset], Primop,
+ [V, Base, Offset])], S),
+ NewAlign};
+ {NewUnit, NewArgs, S, NewAlign} ->
+ Args = [V|NewArgs] ++ [Base, Offset],
+ Name =
+ case Type of
+ integer ->
+ {bs_put_integer, NewUnit, Flags, ConstInfo};
+ float ->
+ {bs_put_float, NewUnit, Flags, ConstInfo};
+ binary ->
+ {bs_put_binary, NewUnit, Flags}
+ end,
+ Primop = {hipe_bs_primop, Name},
+ {add_code([icode_call_primop([Offset], Primop, Args)], S),
+ NewAlign}
+ end.
+
+%% ---------------------------------------------------------------------
+%% Apply-expressions
+
+%% Note that the arity of the called function only depends on the length
+%% of the argument list; the arity stated by the function name is
+%% ignored.
+
+expr_apply(E, Ts, Ctxt, Env, S) ->
+ Op = cerl_lib:reduce_expr(cerl:apply_op(E)),
+ {Vs, S1} = expr_list(cerl:apply_args(E), Ctxt, Env, S),
+ case cerl:is_c_var(Op) of
+ true ->
+ case cerl:var_name(Op) of
+ {N, A} = V when is_atom(N), is_integer(A) ->
+ case env__lookup(V, Env) of
+ error ->
+ %% Assumed to be a function in the
+ %% current module; we don't check.
+ add_local_call(V, Vs, Ts, Ctxt, S1);
+ {ok, #'fun'{label = L, vars = Vs1}} ->
+ %% Call to a local letrec-bound function.
+ add_letrec_call(L, Vs1, Vs, Ctxt, S1);
+ {ok, #cerl_to_icode__var{}} ->
+ error_msg("cannot call via variable; must "
+ "be closure converted: ~P.",
+ [V, 5]),
+ throw(error)
+ end;
+ _ ->
+ error_nonlocal_application(Op),
+ throw(error)
+ end;
+ false ->
+ error_nonlocal_application(Op),
+ throw(error)
+ end.
+
+%% ---------------------------------------------------------------------
+%% Call-expressions
+
+%% Unless we know the module and function names statically, we have to
+%% go through the meta-call operator for a static number of arguments.
+
+expr_call(E, Ts, Ctxt, Env, S) ->
+ Module = cerl_lib:reduce_expr(cerl:call_module(E)),
+ Name = cerl_lib:reduce_expr(cerl:call_name(E)),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ {Vs, S1} = expr_list(cerl:call_args(E), Ctxt, Env, S),
+ add_code(make_call(M, F, Ts, Vs, Ctxt), S1);
+ false ->
+ Args = cerl:call_args(E),
+ N = length(Args),
+ {Vs, S1} = expr_list([Module, Name | Args], Ctxt, Env, S),
+ add_code(make_op(?OP_APPLY_FIXARITY(N), Ts, Vs, Ctxt), S1)
+ end.
+
+%% ---------------------------------------------------------------------
+%% Primop calls
+
+%% Core Erlang primop calls are generally mapped directly to Icode
+%% primop calls, with a few exceptions (listed above), which are
+%% expanded inline, sometimes depending on context. Note that primop
+%% calls do not have specialized tail-call forms.
+
+expr_primop(E, Ts, Ctxt, Env, S) ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ Arity = length(As),
+ expr_primop_0(Name, Arity, As, E, Ts, Ctxt, Env, S).
+
+expr_primop_0(Name, Arity, As, E, Ts, #ctxt{effect = true} = Ctxt, Env,
+ S) ->
+ case is_safe_op(Name, Arity) of
+ true ->
+ %% Just drop the operation; cf. 'expr_values(...)'.
+ {_, S1} = expr_list(As, Ctxt, Env, S),
+ S1;
+ false ->
+ expr_primop_1(Name, Arity, As, E, Ts,
+ Ctxt#ctxt{effect = false}, Env, S)
+ end;
+expr_primop_0(Name, Arity, As, E, Ts, Ctxt, Env, S) ->
+ expr_primop_1(Name, Arity, As, E, Ts, Ctxt, Env, S).
+
+%% Some primops must be caught before their arguments are visited.
+
+expr_primop_1(?PRIMOP_MAKE_FUN, 6, As, _E, Ts, Ctxt, Env, S) ->
+ primop_make_fun(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_APPLY_FUN, 2, As, _E, Ts, Ctxt, Env, S) ->
+ primop_apply_fun(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_FUN_ELEMENT, 2, As, _E, Ts, Ctxt, Env, S) ->
+ primop_fun_element(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_DSETELEMENT, 3, As, _E, Ts, Ctxt, Env, S) ->
+ primop_dsetelement(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_RECEIVE_SELECT, 0, _As, _E, Ts, Ctxt, _Env, S) ->
+ primop_receive_select(Ts, Ctxt, S);
+expr_primop_1(?PRIMOP_RECEIVE_NEXT, 0, _As, _E, _Ts, Ctxt, _Env, S) ->
+ primop_receive_next(Ctxt, S);
+%%expr_primop_1(?PRIMOP_IDENTITY, 1, [A], _E, Ts, Ctxt, Env, S) ->
+%% expr(A, Ts, Ctxt, Env, S); % used for unary plus
+expr_primop_1(?PRIMOP_NEG, 1, [A], _, Ts, Ctxt, Env, S) ->
+ E = cerl:c_primop(cerl:c_atom('-'), [cerl:c_int(0), A]),
+ expr_primop(E, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_GOTO_LABEL, 1, [A], _, _Ts, _Ctxt, _Env, S) ->
+ primop_goto_label(A, S);
+expr_primop_1(?PRIMOP_REDUCTION_TEST, 0, [], _, _Ts, Ctxt, _Env, S) ->
+ primop_reduction_test(Ctxt, S);
+expr_primop_1(Name, Arity, As, E, Ts, Ctxt, Env, S) ->
+ case is_pure_op_aux(Name, Arity) of
+ true ->
+ boolean_expr(E, Ts, Ctxt, Env, S);
+ false ->
+ {Vs, S1} = expr_list(As, Ctxt, Env, S),
+ expr_primop_2(Name, Arity, Vs, Ts, Ctxt, S1)
+ end.
+
+expr_primop_2(?PRIMOP_ELEMENT, 2, Vs, Ts, Ctxt, S) ->
+ add_code(make_op(?OP_ELEMENT, Ts, Vs, Ctxt), S);
+expr_primop_2(?PRIMOP_BS_CONTEXT_TO_BINARY, 1, Vs, Ts, Ctxt, S) ->
+ add_code(make_op(?OP_BS_CONTEXT_TO_BINARY, Ts, Vs, Ctxt), S);
+expr_primop_2(?PRIMOP_EXIT, 1, [V], _Ts, Ctxt, S) ->
+ add_exit(V, Ctxt, S);
+expr_primop_2(?PRIMOP_THROW, 1, [V], _Ts, Ctxt, S) ->
+ add_throw(V, Ctxt, S);
+expr_primop_2(?PRIMOP_ERROR, 1, [V], _Ts, Ctxt, S) ->
+ add_error(V, Ctxt, S);
+expr_primop_2(?PRIMOP_ERROR, 2, [V, F], _Ts, Ctxt, S) ->
+ add_error(V, F, Ctxt, S);
+expr_primop_2(?PRIMOP_RETHROW, 2, [E, V], _Ts, Ctxt, S) ->
+ add_rethrow(E, V, Ctxt, S);
+expr_primop_2(Name, _Arity, Vs, Ts, Ctxt, S) ->
+ %% Other ops are assumed to be recognized by the backend.
+ add_code(make_op(Name, Ts, Vs, Ctxt), S).
+
+%% All of M, F, and A must be literals with the right types.
+%% V must represent a proper list.
+
+primop_make_fun([M, F, A, H, I, V] = As, [_T] = Ts, Ctxt, Env, S) ->
+ case cerl:is_c_atom(M) and
+ cerl:is_c_atom(F) and
+ cerl:is_c_int(A) and
+ cerl:is_c_int(H) and
+ cerl:is_c_int(I) and
+ cerl:is_c_list(V) of
+ true ->
+ Module = cerl:atom_val(M),
+ Name = cerl:atom_val(F),
+ Arity = cerl:int_val(A),
+ Hash = cerl:int_val(H),
+ Index = cerl:int_val(I),
+ {Vs, S1} = expr_list(cerl:list_elements(V),
+ Ctxt, Env, S),
+ add_code(make_op(?OP_MAKE_FUN(Module, Name, Arity,
+ Hash, Index),
+ Ts, Vs, Ctxt),
+ S1);
+ false ->
+ error_primop_badargs(?PRIMOP_MAKE_FUN, As),
+ throw(error)
+ end.
+
+%% V must represent a proper list.
+
+primop_apply_fun([F, V] = As, [_T] = Ts, Ctxt, Env, S) ->
+ case cerl:is_c_list(V) of
+ true ->
+ %% Note that the closure itself is passed as the last value.
+ {Vs, S1} = expr_list(cerl:list_elements(V) ++ [F],
+ Ctxt, Env, S),
+ case Ctxt#ctxt.final of
+ false ->
+ add_code([icode_call_fun(Ts, Vs)], S1);
+ true ->
+ add_code([icode_enter_fun(Vs)], S1)
+ end;
+ false ->
+ error_primop_badargs(?PRIMOP_APPLY_FUN, As),
+ throw(error)
+ end.
+
+primop_fun_element([N, F] = As, Ts, Ctxt, Env, S) ->
+ case cerl:is_c_int(N) of
+ true ->
+ V = make_var(),
+ S1 = expr(F, [V], Ctxt#ctxt{final = false, effect = false},
+ Env, S),
+ add_code(make_op(?OP_FUN_ELEMENT(cerl:int_val(N)),
+ Ts, [V], Ctxt),
+ S1);
+ false ->
+ error_primop_badargs(?PRIMOP_FUN_ELEMENT, As),
+ throw(error)
+ end.
+
+primop_goto_label(A, S) ->
+ {Label,S1} = s__get_label(A, S),
+ add_code([icode_goto(Label)], S1).
+
+is_goto(E) ->
+ case cerl:type(E) of
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ Arity = length(As),
+ case {Name, Arity} of
+ {?PRIMOP_GOTO_LABEL, 1} ->
+ true;
+ _ ->
+ false
+ end;
+ _ ->
+ false
+ end.
+
+primop_reduction_test(Ctxt, S) ->
+ add_code(make_op(?OP_REDTEST, [], [], Ctxt), S).
+
+primop_dsetelement([N | As1] = As, Ts, Ctxt, Env, S) ->
+ case cerl:is_c_int(N) of
+ true ->
+ {Vs, S1} = expr_list(As1, Ctxt, Env, S),
+ add_code(make_op(?OP_UNSAFE_SETELEMENT(cerl:int_val(N)),
+ Ts, Vs, Ctxt),
+ S1);
+ false ->
+ error_primop_badargs(?PRIMOP_DSETELEMENT, As),
+ throw(error)
+ end.
+
+%% ---------------------------------------------------------------------
+%% Try-expressions:
+
+%% We want to rewrite trivial things like `try A of X -> B catch ...',
+%% where A is safe, into a simple let-binding `let X = A in B', avoiding
+%% unnecessary try-blocks. (The `let' might become further simplified.)
+
+expr_try(E, Ts, Ctxt, Env, S) ->
+ F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+ expr_try_1(E, F, Ctxt, Env, S).
+
+expr_try_1(E, F, Ctxt, Env, S) ->
+ A = cerl:try_arg(E),
+ case is_safe_expr(A) of
+ true ->
+ E1 = cerl:c_let(cerl:try_vars(E), A, cerl:try_body(E)),
+ expr_let_1(E1, F, Ctxt, Env, S);
+ false ->
+ expr_try_2(E, F, Ctxt, Env, S)
+ end.
+
+%% TODO: maybe skip begin_try/end_try and just use fail-labels...
+
+expr_try_2(E, F, Ctxt, Env, S) ->
+ Cont = new_continuation_label(Ctxt),
+ Catch = new_label(),
+ Next = new_label(),
+ S1 = add_code([icode_begin_try(Catch,Next),icode_label(Next)], S),
+ Vars = cerl:try_vars(E),
+ Vs = make_vars(length(Vars)),
+ Ctxt1 = Ctxt#ctxt{final = false},
+ S2 = expr(cerl:try_arg(E), Vs, Ctxt1, Env, S1),
+ Env1 = bind_vars(Vars, Vs, Env),
+ S3 = add_code([icode_end_try()], S2),
+ S4 = F(cerl:try_body(E), Ctxt, Env1, S3),
+ S5 = add_continuation_jump(Cont, Ctxt, S4),
+ EVars = cerl:try_evars(E),
+ EVs = make_vars(length(EVars)),
+ Env2 = bind_vars(EVars, EVs, Env),
+ S6 = add_code([icode_label(Catch), icode_begin_handler(EVs)], S5),
+ S7 = F(cerl:try_handler(E), Ctxt, Env2, S6),
+ add_continuation_label(Cont, Ctxt, S7).
+
+%% ---------------------------------------------------------------------
+%% Letrec-expressions (local goto-labels)
+
+%% We only handle letrec-functions as continuations. The fun-bodies are
+%% always compiled in the same context as the main letrec-body. Note
+%% that we cannot propagate "advanced" contexts like boolean-compilation
+%% into the letrec body like we do for ordinary lets or seqs, since the
+%% context for an individual local function would be depending on the
+%% contexts of its call sites.
+
+expr_letrec(E, Ts, Ctxt, Env, S) ->
+ Ds = cerl:letrec_defs(E),
+ Env1 = add_defs(Ds, Env),
+ S1 = expr(cerl:letrec_body(E), Ts, Ctxt, Env1, S),
+ Next = new_continuation_label(Ctxt),
+ S2 = add_continuation_jump(Next, Ctxt, S1),
+ S3 = defs(Ds, Ts, Ctxt, Env1, S2),
+ add_continuation_label(Next, Ctxt, S3).
+
+add_defs([{V, _F} | Ds], Env) ->
+ {_, A} = cerl:var_name(V),
+ Vs = make_vars(A),
+ L = new_label(),
+ Env1 = bind_fun(V, L, Vs, Env),
+ add_defs(Ds, Env1);
+add_defs([], Env) ->
+ Env.
+
+defs([{V, F} | Ds], Ts, Ctxt, Env, S) ->
+ Name = cerl:var_name(V),
+ #'fun'{label = L, vars = Vs} = env__get(Name, Env),
+ S1 = add_code([icode_label(L)], S),
+ Env1 = bind_vars(cerl:fun_vars(F), Vs, Env),
+ S2 = expr(cerl:fun_body(F), Ts, Ctxt, Env1, S1),
+ defs(Ds, Ts, Ctxt, Env, S2);
+defs([], _Ts, _Ctxt, _Env, S) ->
+ S.
+
+%% ---------------------------------------------------------------------
+%% Receive-expressions
+
+%% There may only be exactly one clause, which must be a trivial
+%% catch-all with exactly one (variable) pattern. Each message will be
+%% read from the mailbox and bound to the pattern variable; the body of
+%% the clause must do the switching and call either of the primops
+%% `receive_select/0' or `receive_next/0'.
+
+expr_receive(E, Ts, Ctxt, Env, S) ->
+ F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+ expr_receive_1(E, F, Ctxt, Env, S).
+
+expr_receive_1(E, F, Ctxt, Env, S) ->
+ case cerl:receive_clauses(E) of
+ [C] ->
+ case cerl:clause_pats(C) of
+ [_] ->
+ case cerl_clauses:is_catchall(C) of
+ true ->
+ expr_receive_2(C, E, F, Ctxt, Env, S);
+ false ->
+ error_msg("receive-expression clause "
+ "must be a catch-all."),
+ throw(error)
+ end;
+ _ ->
+ error_msg("receive-expression clause must "
+ "have exactly one pattern."),
+ throw(error)
+ end;
+ _ ->
+ error_msg("receive-expressions must have "
+ "exactly one clause."),
+ throw(error)
+ end.
+
+%% There are a number of primitives to do the work involved in receiving
+%% messages:
+%%
+%% if-tests: suspend_msg_timeout()
+%%
+%% primops: V = check_get_msg()
+%% select_msg()
+%% next_msg()
+%% set_timeout(T)
+%% clear_timeout()
+%% suspend_msg()
+%%
+%% `check_get_msg' tests if the mailbox is empty or not, and if not it
+%% reads the message currently pointed to by the implicit message pointer.
+%% `select_msg' removes the current message from the mailbox, resets the
+%% message pointer and clears any timeout. `next_msg' advances the
+%% message pointer but does nothing else. `set_timeout(T)' sets up the
+%% timeout mechanism *unless it is already set*. `suspend_msg' suspends
+%% until a message has arrived and does not check for timeout. The test
+%% `suspend_msg_timeout' suspends the process and upon resuming
+%% execution selects the `true' branch if a message has arrived and the
+%% `false' branch otherwise. `clear_timeout' resets the message pointer
+%% when a timeout has occurred (the name is somewhat misleading).
+%%
+%% Note: the receiving of a message must be performed so that the
+%% message pointer is always reset when the receive is done; thus, all
+%% paths must go through either `select_msg' or `clear_timeout'.
+
+%% Recall that the `final' and `effect' context flags distribute over
+%% the clauses *and* the timeout action (but not over the
+%% timeout-expression, which is always executed for its value).
+
+%% This is the code we generate for a full receive:
+%%
+%% Loop: check_get_msg(Match, Wait)
+%% Wait: set_timeout
+%% suspend_msg_timeout(Loop, Timeout)
+%% Timeout: clear_timeout
+%% TIMEOUT-ACTION
+%% goto Next
+%% Match: RECEIVE-CLAUSES(Loop, Next)
+%% Next: ...
+%%
+%% For a receive with infinity timout, we generate
+%%
+%% Wait: suspend_msg
+%% goto Loop
+%%
+%% For a receive with zero timout, we generate
+%%
+%% Wait: clear_timeout
+%% TIMEOUT-ACTION
+%% goto Next
+
+expr_receive_2(C, E, F, Ctxt, Env, S0) ->
+ Expiry = cerl_lib:reduce_expr(cerl:receive_timeout(E)),
+ After = case cerl:is_literal(Expiry) of
+ true ->
+ cerl:concrete(Expiry);
+ false ->
+ undefined
+ end,
+ T = make_var(), % T will hold the timeout value
+ %% It would be harmless to generate code for `infinity', but we
+ %% might as well avoid it if we can.
+ S1 = if After =:= 'infinity' -> S0;
+ true ->
+ expr(Expiry, [T],
+ Ctxt#ctxt{final = false, effect = false},
+ Env, S0)
+ end,
+
+ %% This is the top of the receive-loop, which checks if the
+ %% mailbox is empty, and otherwise reads the next message.
+ Loop = new_label(),
+ Wait = new_label(),
+ Match = new_label(),
+ V = make_var(),
+ S2 = add_code([icode_label(Loop),
+ icode_call_primop([V], ?OP_CHECK_GET_MESSAGE, [],
+ Match, Wait),
+ icode_label(Wait)], S1),
+
+ %% The wait-for-message section looks a bit different depending on
+ %% whether we actually need to set a timer or not.
+ Ctxt0 = #ctxt{},
+ S3 = case After of
+ 'infinity' ->
+ %% Only wake up when we get new messages, and never
+ %% execute the expiry body.
+ add_code(make_op(?OP_WAIT_FOR_MESSAGE, [], [], Ctxt0)
+ ++ [icode_goto(Loop)], S2);
+ 0 ->
+ %% Zero limit - reset the message pointer (this is what
+ %% "clear timeout" does) and execute the expiry body.
+ add_code(make_op(?OP_CLEAR_TIMEOUT, [], [], Ctxt0),
+ S2);
+ _ ->
+ %% Other value - set the timer (if it is already set,
+ %% nothing is changed) and wait for a message or
+ %% timeout. Reset the message pointer upon timeout.
+ Timeout = new_label(),
+ add_code(make_op(?OP_SET_TIMEOUT, [], [T], Ctxt0)
+ ++ [make_if(?TEST_WAIT_FOR_MESSAGE_OR_TIMEOUT,
+ [], Loop, Timeout),
+ icode_label(Timeout)]
+ ++ make_op(?OP_CLEAR_TIMEOUT, [], [], Ctxt0),
+ S2)
+ end,
+
+ %% We never generate code for the expiry body if the timeout value
+ %% is 'infinity' (and thus we know that it will not be used), mainly
+ %% because in this case it is possible (and legal) for the expiry
+ %% body to not have the expected degree. (Typically, it produces a
+ %% single constant value such as 'true', while the clauses may be
+ %% producing 2 or more values.)
+ Next = new_continuation_label(Ctxt),
+ S4 = if After =:= 'infinity' -> S3;
+ true ->
+ add_continuation_jump(Next, Ctxt,
+ F(cerl:receive_action(E), Ctxt,
+ Env, S3))
+ end,
+
+ %% When we compile the primitive operations that select the current
+ %% message or loop to try the next message (see the functions
+ %% 'primop_receive_next' and 'primop_receive_select'), we will use
+ %% the receive-loop label in the context (i.e., that of the nearest
+ %% enclosing receive expression).
+ Ctxt1 = Ctxt#ctxt{'receive' = #'receive'{loop = Loop}},
+
+ %% The pattern variable of the clause will be mapped to `V', which
+ %% holds the message, so it can be accessed in the clause body:
+ S5 = clauses([C], F, [V], Ctxt1, Env,
+ add_code([icode_label(Match)], S4)),
+ add_continuation_label(Next, Ctxt, S5).
+
+%% Primops supporting "expanded" receive-expressions on the Core level:
+
+primop_receive_next(#ctxt{'receive' = R} = Ctxt, S0) ->
+ case R of
+ #'receive'{loop = Loop} ->
+ %% Note that this has the same "problem" as the fail
+ %% instruction (see the 'add_fail' function), namely, that
+ %% it unexpectedly ends a basic block. The solution is the
+ %% same - add a dummy label if necessary.
+ S1 = add_code(make_op(?OP_NEXT_MESSAGE, [], [], #ctxt{})
+ ++ [icode_goto(Loop)], S0),
+ add_new_continuation_label(Ctxt, S1);
+ _ ->
+ error_not_in_receive(?PRIMOP_RECEIVE_NEXT),
+ throw(error)
+ end.
+
+primop_receive_select(Ts, #ctxt{'receive' = R} = Ctxt, S) ->
+ case R of
+ #'receive'{} ->
+ add_code(make_op(?OP_SELECT_MESSAGE, Ts, [], Ctxt), S);
+ _ ->
+ error_not_in_receive(?PRIMOP_RECEIVE_SELECT),
+ throw(error)
+ end.
+
+%% ---------------------------------------------------------------------
+%% Case expressions
+
+%% Typically, pattern matching compilation has split all switches into
+%% separate groups of tuples, integers, atoms, etc., where each such
+%% switch over a group of constructors is protected by a type test.
+%% Thus, it is straightforward to generate switch instructions. (If no
+%% pattern matching compilation has been done, we don't care about
+%% efficiency anyway, so we don't spend any extra effort here.)
+
+expr_case(E, Ts, Ctxt, Env, S) ->
+ F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+ expr_case_1(E, F, Ctxt, Env, S).
+
+expr_case_1(E, F, Ctxt, Env, S) ->
+ Cs = cerl:case_clauses(E),
+ A = cerl:case_arg(E),
+ case cerl_lib:is_bool_switch(Cs) of
+ true ->
+ %% An if-then-else with a known boolean argument
+ {True, False} = cerl_lib:bool_switch_cases(Cs),
+ bool_switch(A, True, False, F, Ctxt, Env, S);
+ false ->
+ Vs = make_vars(cerl:clause_arity(hd(Cs))),
+ Ctxt1 = Ctxt#ctxt{final = false, effect = false},
+ S1 = expr(A, Vs, Ctxt1, Env, S),
+ expr_case_2(Vs, Cs, F, Ctxt, Env, S1)
+ end.
+
+%% Switching on a value
+
+expr_case_2(Vs, Cs, F, Ctxt, Env, S1) ->
+ case is_constant_switch(Cs) of
+ true ->
+ switch_val_clauses(Cs, F, Vs, Ctxt, Env, S1);
+ false ->
+ case is_tuple_switch(Cs) of
+ true ->
+ switch_tuple_clauses(Cs, F, Vs, Ctxt, Env, S1);
+ false ->
+ case is_binary_switch(Cs, S1) of
+ true ->
+ switch_binary_clauses(Cs, F, Vs, Ctxt, Env, S1);
+ false ->
+ clauses(Cs, F, Vs, Ctxt, Env, S1)
+ end
+ end
+ end.
+
+%% Check if a list of clauses represents a switch over a number (more
+%% than 1) of constants (integers or atoms), or tuples (whose elements
+%% are all variables)
+
+is_constant_switch(Cs) ->
+ is_switch(Cs, fun (P) -> (cerl:type(P) =:= literal) andalso
+ (is_integer(cerl:concrete(P))
+ orelse is_atom(cerl:concrete(P))) end).
+
+is_tuple_switch(Cs) ->
+ is_switch(Cs, fun (P) -> cerl:is_c_tuple(P) andalso
+ all_vars(cerl:tuple_es(P)) end).
+
+is_binary_switch(Cs, S) ->
+ case s__get_pmatch(S) of
+ False when False =:= false; False =:= undefined ->
+ false;
+ Other when Other =:= duplicate_all; Other =:= no_duplicates; Other =:= true->
+ is_binary_switch1(Cs, 0)
+ end.
+
+is_binary_switch1([C|Cs], N) ->
+ case cerl:clause_pats(C) of
+ [P] ->
+ case cerl:is_c_binary(P) of
+ true ->
+ is_binary_switch1(Cs, N + 1);
+ false ->
+ %% The final clause may be a catch-all.
+ Cs =:= [] andalso N > 0 andalso cerl:type(P) =:= var
+ end;
+ _ ->
+ false
+ end;
+is_binary_switch1([], N) ->
+ N > 0.
+
+all_vars([E | Es]) ->
+ case cerl:is_c_var(E) of
+ true -> all_vars(Es);
+ false -> false
+ end;
+all_vars([]) -> true.
+
+is_switch(Cs, F) ->
+ is_switch(Cs, F, 0).
+
+is_switch([C | Cs], F, N) ->
+ case cerl_lib:is_simple_clause(C) of
+ true ->
+ [P] = cerl:clause_pats(C),
+ case F(P) of
+ true ->
+ is_switch(Cs, F, N + 1);
+ false ->
+ %% The final clause may be a catch-all.
+ Cs =:= [] andalso N > 1 andalso cerl:type(P) =:= var
+ end;
+ false -> false
+ end;
+is_switch([], _F, N) ->
+ N > 1.
+
+switch_val_clauses(Cs, F, Vs, Ctxt, Env, S) ->
+ switch_clauses(Cs, F, Vs, Ctxt, Env,
+ fun (P) -> cerl:concrete(P) end,
+ fun icode_switch_val/4,
+ fun val_clause_body/9,
+ S).
+
+val_clause_body(_N, _V, C, F, Next, _Fail, Ctxt, Env, S) ->
+ clause_body(C, F, Next, Ctxt, Env, S).
+
+switch_tuple_clauses(Cs, F, Vs, Ctxt, Env, S) ->
+ switch_clauses(Cs, F, Vs, Ctxt, Env,
+ fun (P) -> cerl:tuple_arity(P) end,
+ fun icode_switch_tuple_arity/4,
+ fun tuple_clause_body/9,
+ S).
+
+tuple_clause_body(N, V, C, F, Next, Fail, Ctxt, Env, S0) ->
+ Vs = make_vars(N),
+ S1 = tuple_elements(Vs, V, S0),
+ Es = cerl:tuple_es(hd(cerl:clause_pats(C))),
+ {Env1, S2} = patterns(Es, Vs, Fail, Env, S1),
+ clause_body(C, F, Next, Ctxt, Env1, S2).
+
+switch_clauses(Cs, F, [V], Ctxt, Env, GetVal, Switch, Body, S0) ->
+ Cs1 = [switch_clause(C, GetVal) || C <- Cs],
+ Cases = [{Val, L} || {Val, L, _} <- Cs1],
+ Default = [C || {default, C} <- Cs1],
+ Fail = new_label(),
+ S1 = add_code([Switch(V, Fail, length(Cases), Cases)], S0),
+ Next = new_continuation_label(Ctxt),
+ S3 = case Default of
+ [] -> add_default_case(Fail, Ctxt, S1);
+ [C] ->
+ %% Bind the catch-all variable (this always succeeds)
+ {Env1, S2} = patterns(cerl:clause_pats(C), [V], Fail,
+ Env, S1),
+ clause_body(C, F, Next, Ctxt, Env1,
+ add_code([icode_label(Fail)], S2))
+ end,
+ S4 = switch_cases(Cs1, V, F, Next, Fail, Ctxt, Env, Body, S3),
+ add_continuation_label(Next, Ctxt, S4).
+
+switch_clause(C, F) ->
+ [P] = cerl:clause_pats(C),
+ L = new_label(),
+ case cerl:type(P) of
+ var -> {default, C};
+ _ -> {icode_const(F(P)), L, C}
+ end.
+
+switch_binary_clauses(Cs, F, Vs, Ctxt, Env, S) ->
+ {Bins, Default} = get_binary_clauses(Cs),
+ Fail = new_label(),
+ Next = new_continuation_label(Ctxt),
+ S1 = binary_match(Bins, F, Vs, Next, Fail, Ctxt, Env, S),
+ S2 = case Default of
+ [] -> add_default_case(Fail, Ctxt, S1);
+ [C] ->
+ clause_body(C, F, Next, Ctxt, Env,
+ add_code([icode_label(Fail)], S1))
+ end,
+ add_continuation_label(Next, Ctxt, S2).
+
+get_binary_clauses(Cs) ->
+ get_binary_clauses(Cs, []).
+
+get_binary_clauses([C|Cs], Acc) ->
+ [P] = cerl:clause_pats(C),
+ case cerl:is_c_binary(P) of
+ true ->
+ get_binary_clauses(Cs, [C|Acc]);
+ false ->
+ {lists:reverse(Acc),[C]}
+ end;
+get_binary_clauses([], Acc) ->
+ {lists:reverse(Acc),[]}.
+
+switch_cases([{N, L, C} | Cs], V, F, Next, Fail, Ctxt, Env, Body, S0) ->
+ S1 = add_code([icode_label(L)], S0),
+ S2 = Body(icode_const_val(N), V, C, F, Next, Fail, Ctxt, Env, S1),
+ switch_cases(Cs, V, F, Next, Fail, Ctxt, Env, Body, S2);
+switch_cases([_ | Cs], V, F, Next, Fail, Ctxt, Env, Body, S) ->
+ switch_cases(Cs, V, F, Next, Fail, Ctxt, Env, Body, S);
+switch_cases([], _V, _F, _Next, _Fail, _Ctxt, _Env, _Body, S) ->
+ S.
+
+%% Recall that the `final' and `effect' context flags distribute over
+%% the clause bodies.
+
+clauses(Cs, F, Vs, Ctxt, Env, S) ->
+ Next = new_continuation_label(Ctxt),
+ S1 = clauses_1(Cs, F, Vs, undefined, Next, Ctxt, Env, S),
+ add_continuation_label(Next, Ctxt, S1).
+
+clauses_1([C | Cs], F, Vs, Fail, Next, Ctxt, Env, S) ->
+ case cerl_clauses:is_catchall(C) of
+ true ->
+ %% The fail label will not actually be used in this case.
+ clause(C, F, Vs, Fail, Next, Ctxt, Env, S);
+ false ->
+ %% The previous `Fail' is not used here.
+ Fail1 = new_label(),
+ S1 = clause(C, F, Vs, Fail1, Next, Ctxt, Env, S),
+ S2 = add_code([icode_label(Fail1)], S1),
+ clauses_1(Cs, F, Vs, Fail1, Next, Ctxt, Env, S2)
+ end;
+clauses_1([], _F, _Vs, Fail, _Next, Ctxt, _Env, S) ->
+ if Fail =:= undefined ->
+ L = new_label(),
+ add_default_case(L, Ctxt, S);
+ true ->
+ add_code([icode_goto(Fail)], S) % use existing label
+ end.
+
+%% The exact behaviour if all clauses fail is undefined; we generate an
+%% 'internal_error' exception if this happens, which is safe and will
+%% not get in the way of later analyses. (Continuing execution after the
+%% `case', as in a C `switch' statement, would add a new possible path
+%% to the program, which could destroy program properties.) Note that
+%% this code is only generated if some previous stage has created a
+%% switch over clauses without a final catch-all; this could be both
+%% legal and non-redundant, e.g. if the last clause does pattern
+%% matching to extract components of a (known) constructor. The
+%% generated default-case code *should* be unreachable, but we need it
+%% in order to have a safe fail-label.
+
+add_default_case(L, Ctxt, S) ->
+ S1 = add_code([icode_label(L)], S),
+ add_error(icode_const(internal_error), Ctxt, S1).
+
+clause(C, F, Vs, Fail, Next, Ctxt, Env, S) ->
+ G = cerl:clause_guard(C),
+ case cerl_clauses:eval_guard(G) of
+ {value, true} ->
+ {Env1, S1} = patterns(cerl:clause_pats(C), Vs, Fail, Env,
+ S),
+ clause_body(C, F, Next, Ctxt, Env1, S1);
+ {value, false} ->
+ add_code([icode_goto(Fail)], S);
+ _ ->
+ {Env1, S1} = patterns(cerl:clause_pats(C), Vs, Fail, Env,
+ S),
+ Succ = new_label(),
+ Ctxt1 = Ctxt#ctxt{final = false,
+ fail = Fail,
+ class = guard},
+ S2 = boolean(G, Succ, Fail, Ctxt1, Env1, S1),
+ S3 = add_code([icode_label(Succ)], S2),
+ clause_body(C, F, Next, Ctxt, Env1, S3)
+ end.
+
+clause_body(C, F, Next, Ctxt, Env, S) ->
+ %% This check is inserted as a goto is always final
+ case is_goto(cerl:clause_body(C)) of
+ true ->
+ F(cerl:clause_body(C), Ctxt, Env, S);
+ false ->
+ S1 = F(cerl:clause_body(C), Ctxt, Env, S),
+ add_continuation_jump(Next, Ctxt, S1)
+ end.
+
+patterns([P | Ps], [V | Vs], Fail, Env, S) ->
+ {Env1, S1} = pattern(P, V, Fail, Env, S),
+ patterns(Ps, Vs, Fail, Env1, S1);
+patterns([], [], _, Env, S) ->
+ {Env, S}.
+
+pattern(P, V, Fail, Env, S) ->
+ case cerl:type(P) of
+ var ->
+ {bind_var(P, V, Env), S};
+ alias ->
+ {Env1, S1} = pattern(cerl:alias_pat(P), V,
+ Fail, Env, S),
+ {bind_var(cerl:alias_var(P), V, Env1), S1};
+ literal ->
+ {Env, literal_pattern(P, V, Fail, S)};
+ cons ->
+ cons_pattern(P, V, Fail, Env, S);
+ tuple ->
+ tuple_pattern(P, V, Fail, Env, S);
+ binary ->
+ binary_pattern(P, V, Fail, Env, S)
+ end.
+
+literal_pattern(P, V, Fail, S) ->
+ L = new_label(),
+ S1 = literal_pattern_1(P, V, Fail, L, S),
+ add_code([icode_label(L)], S1).
+
+literal_pattern_1(P, V, Fail, Next, S) ->
+ case cerl:concrete(P) of
+ X when is_atom(X) ->
+ add_code([make_type([V], ?TYPE_ATOM(X), Next, Fail)],
+ S);
+ X when is_integer(X) ->
+ add_code([make_type([V], ?TYPE_INTEGER(X), Next, Fail)],
+ S);
+ X when is_float(X) ->
+ V1 = make_var(),
+ L = new_label(),
+ %% First doing an "is float" test here might allow later
+ %% stages to use a specialized equality test.
+ add_code([make_type([V], ?TYPE_IS_FLOAT, L, Fail),
+ icode_label(L),
+ icode_move(V1, icode_const(X)),
+ make_if(?TEST_EQ, [V, V1], Next, Fail)],
+ S);
+ [] ->
+ add_code([make_type([V], ?TYPE_NIL, Next, Fail)], S);
+ X ->
+ %% Compound constants are compared with the generic exact
+ %% equality test.
+ V1 = make_var(),
+ add_code([icode_move(V1, icode_const(X)),
+ make_if(?TEST_EXACT_EQ, [V, V1], Next, Fail)],
+ S)
+ end.
+
+cons_pattern(P, V, Fail, Env, S) ->
+ V1 = make_var(),
+ V2 = make_var(),
+ Next = new_label(),
+ Ctxt = #ctxt{},
+ S1 = add_code([make_type([V], ?TYPE_CONS, Next, Fail),
+ icode_label(Next)]
+ ++ make_op(?OP_UNSAFE_HD, [V1], [V], Ctxt)
+ ++ make_op(?OP_UNSAFE_TL, [V2], [V], Ctxt),
+ S),
+ patterns([cerl:cons_hd(P), cerl:cons_tl(P)], [V1, V2],
+ Fail, Env, S1).
+
+tuple_pattern(P, V, Fail, Env, S) ->
+ Es = cerl:tuple_es(P),
+ N = length(Es),
+ Vs = make_vars(N),
+ Next = new_label(),
+ S1 = add_code([make_type([V], ?TYPE_IS_N_TUPLE(N), Next, Fail),
+ icode_label(Next)],
+ S),
+ S2 = tuple_elements(Vs, V, S1),
+ patterns(Es, Vs, Fail, Env, S2).
+
+tuple_elements(Vs, V, S) ->
+ tuple_elements(Vs, V, #ctxt{}, 1, S).
+
+tuple_elements([V1 | Vs], V0, Ctxt, N, S) ->
+ Code = make_op(?OP_UNSAFE_ELEMENT(N), [V1], [V0], Ctxt),
+ tuple_elements(Vs, V0, Ctxt, N + 1, add_code(Code, S));
+tuple_elements([], _, _, _, S) ->
+ S.
+
+binary_pattern(P, V, Fail, Env, S) ->
+ L1 = new_label(),
+ Segs = cerl:binary_segments(P),
+ Arity = length(Segs),
+ Vars = make_vars(Arity),
+ MS = make_var(),
+ Primop1 = {hipe_bs_primop, {bs_start_match,0}},
+ S1 = add_code([icode_guardop([MS], Primop1, [V], L1, Fail),
+ icode_label(L1)],S),
+ {Env1,S2} = bin_seg_patterns(Segs, Vars, MS, Fail, Env, S1, false),
+ L2 = new_label(),
+ Primop2 = {hipe_bs_primop, {bs_test_tail, 0}},
+ {Env1, add_code([icode_guardop([], Primop2, [MS], L2, Fail),
+ icode_label(L2)], S2)}.
+
+bin_seg_patterns([Seg|Rest], [T|Ts], MS, Fail, Env, S, Align) ->
+ {{NewEnv, S1}, NewAlign} = bin_seg_pattern(Seg, T, MS, Fail, Env, S, Align),
+ bin_seg_patterns(Rest, Ts, MS, Fail, NewEnv, S1, NewAlign);
+
+bin_seg_patterns([], [], _MS, _Fail, Env, S, _Align) ->
+ {Env, S}.
+
+bin_seg_pattern(P, V, MS, Fail, Env, S, Align) ->
+ L = new_label(),
+ Size = cerl:bitstr_size(P),
+ Unit = cerl:bitstr_unit(P),
+ Type = cerl:concrete(cerl:bitstr_type(P)),
+ LiteralFlags = cerl:bitstr_flags(P),
+ T = cerl:bitstr_val(P),
+ Flags = translate_flags(LiteralFlags, Align),
+ case calculate_size(Unit, Size, false, Env, S) of
+ {all, NewUnit, NewAlign, S0} ->
+ Type = binary,
+ Name = {bs_get_binary_all_2, NewUnit, Flags},
+ Primop = {hipe_bs_primop, Name},
+ S1 = add_code([icode_guardop([V,MS], Primop, [MS], L, Fail),
+ icode_label(L)], S0),
+ {pattern(T, V, Fail, Env, S1), NewAlign};
+ {NewUnit, Args, S0, NewAlign} ->
+ Name =
+ case Type of
+ integer ->
+ {bs_get_integer, NewUnit, Flags};
+ float ->
+ {bs_get_float, NewUnit, Flags};
+ binary ->
+ {bs_get_binary, NewUnit, Flags}
+ end,
+ Primop = {hipe_bs_primop, Name},
+ S1 = add_code([icode_guardop([V,MS], Primop, [MS|Args], L, Fail),
+ icode_label(L)], S0),
+ {pattern(T, V, Fail, Env, S1), NewAlign}
+ end.
+
+%% ---------------------------------------------------------------------
+%% Boolean expressions
+
+%% This generates code for a boolean expression (such as "primop
+%% 'and'(X, Y)") in a normal expression context, when an actual `true'
+%% or `false' value is to be computed. We set up a default fail-label
+%% for generating a `badarg' error, unless we are in a guard.
+
+boolean_expr(E, [V], Ctxt=#ctxt{class = guard}, Env, S) ->
+ {Code, True, False} = make_bool_glue(V),
+ S1 = boolean(E, True, False, Ctxt, Env, S),
+ add_code(Code, S1);
+boolean_expr(E, [V] = Ts, Ctxt, Env, S) ->
+ {Code, True, False} = make_bool_glue(V),
+ Fail = new_label(),
+ Cont = new_continuation_label(Ctxt),
+ Ctxt1 = Ctxt#ctxt{final = false, effect = false, fail = Fail},
+ S1 = boolean(E, True, False, Ctxt1, Env, S),
+ S2 = maybe_return(Ts, Ctxt, add_code(Code, S1)),
+ S3 = add_continuation_jump(Cont, Ctxt, S2),
+ S4 = add_code([icode_label(Fail)], S3),
+ S5 = add_error(icode_const(badarg), Ctxt, S4), % can add dummy label
+ S6 = add_continuation_jump(Cont, Ctxt, S5), % avoid empty basic block
+ add_continuation_label(Cont, Ctxt, S6);
+boolean_expr(_, [], _Ctxt, _Env, _S) ->
+ error_high_degree(),
+ throw(error);
+boolean_expr(_, _, _Ctxt, _Env, _S) ->
+ error_low_degree(),
+ throw(error).
+
+%% This is for when we expect a boolean result in jumping code context,
+%% but are not sure what the expression will produce, or we know that
+%% the result is not a boolean and we just want error handling.
+
+expect_boolean_value(E, True, False, Ctxt, Env, S) ->
+ V = make_var(),
+ S1 = expr(E, [V], Ctxt#ctxt{final = false}, Env, S),
+ case Ctxt#ctxt.fail of
+ [] ->
+ %% No fail-label set - this means we are *sure* that the
+ %% result can only be 'true' or 'false'.
+ add_code([make_type([V], ?TYPE_ATOM(true), True, False)],
+ S1);
+ Fail ->
+ Next = new_label(),
+ add_code([make_type([V], ?TYPE_ATOM(true), True, Next),
+ icode_label(Next),
+ make_type([V], ?TYPE_ATOM(false), False, Fail)],
+ S1)
+ end.
+
+%% This generates code for a case-switch with exactly one 'true' branch
+%% and one 'false' branch, and no other branches (not even a catch-all).
+%% Note that E must be guaranteed to produce a boolean value for such a
+%% switch to have been generated.
+
+bool_switch(E, TrueExpr, FalseExpr, F, Ctxt, Env, S) ->
+ Cont = new_continuation_label(Ctxt),
+ True = new_label(),
+ False = new_label(),
+ Ctxt1 = Ctxt#ctxt{final = false, effect = false},
+ S1 = boolean(E, True, False, Ctxt1, Env, S),
+ S2 = add_code([icode_label(True)], S1),
+ S3 = F(TrueExpr, Ctxt, Env, S2),
+ S4 = add_continuation_jump(Cont, Ctxt, S3),
+ S5 = add_code([icode_label(False)], S4),
+ S6 = F(FalseExpr, Ctxt, Env, S5),
+ add_continuation_label(Cont, Ctxt, S6).
+
+%% This generates jumping code for booleans. If the fail-label is set,
+%% it tells where to go in case a value turns out not to be a boolean.
+
+%% In strict boolean expressions, we set a flag to be checked if
+%% necessary after both branches have been evaluated. An alternative
+%% would be to duplicate the code for the second argument, for each
+%% value ('true' or 'false') of the first argument.
+
+%% (Note that subexpressions are checked repeatedly to see if they are
+%% safe - this is quadratic, but I don't expect booleans to be very
+%% deeply nested.)
+
+%% Note that 'and', 'or' and 'xor' are strict (like all primops)!
+
+boolean(E0, True, False, Ctxt, Env, S) ->
+ E = cerl_lib:reduce_expr(E0),
+ case cerl:type(E) of
+ literal ->
+ case cerl:concrete(E) of
+ true ->
+ add_code([icode_goto(True)], S);
+ false ->
+ add_code([icode_goto(False)], S);
+ _ ->
+ expect_boolean_value(E, True, False, Ctxt, Env, S)
+ end;
+ values ->
+ case cerl:values_es(E) of
+ [E1] ->
+ boolean(E1, True, False, Ctxt, Env, S);
+ _ ->
+ error_msg("degree mismatch - expected boolean: ~P",
+ [E, 10]),
+ throw(error)
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ Arity = length(As),
+ case {Name, Arity} of
+ {?PRIMOP_NOT, 1} ->
+ %% `not' simply switches true and false labels.
+ [A] = As,
+ boolean(A, False, True, Ctxt, Env, S);
+ {?PRIMOP_AND, 2} ->
+ strict_and(As, True, False, Ctxt, Env, S);
+ {?PRIMOP_OR, 2} ->
+ strict_or(As, True, False, Ctxt, Env, S);
+ {?PRIMOP_XOR, 2} ->
+ %% `xor' always needs to evaluate both arguments
+ strict_xor(As, True, False, Ctxt, Env, S);
+ _ ->
+ case is_comp_op(Name, Arity) of
+ true ->
+ comparison(Name, As, True, False, Ctxt, Env,
+ S);
+ false ->
+ case is_type_test(Name, Arity) of
+ true ->
+ type_test(Name, As, True, False,
+ Ctxt, Env, S);
+ false ->
+ expect_boolean_value(E, True, False,
+ Ctxt, Env, S)
+ end
+ end
+ end;
+ 'case' ->
+ %% Propagate boolean handling into clause bodies.
+ %% (Note that case switches assume fallthrough code in the
+ %% clause bodies, so we must add a dummy label as needed.)
+ F = fun (BF, CtxtF, EnvF, SF) ->
+ SF1 = boolean(BF, True, False, CtxtF, EnvF, SF),
+ add_new_continuation_label(CtxtF, SF1)
+ end,
+ S1 = expr_case_1(E, F, Ctxt, Env, S),
+ %% Add a final goto if necessary, to compensate for the
+ %% final continuation label of the case-expression. This
+ %% should be unreachable, so the value does not matter.
+ add_continuation_jump(False, Ctxt, S1);
+ seq ->
+ %% Propagate boolean handling into body.
+ F = fun (BF, CtxtF, EnvF, SF) ->
+ boolean(BF, True, False, CtxtF, EnvF, SF)
+ end,
+ expr_seq_1(E, F, Ctxt, Env, S);
+ 'let' ->
+ %% Propagate boolean handling into body. Note that we have
+ %% called 'cerl_lib:reduce_expr/1' above.
+ F = fun (BF, CtxtF, EnvF, SF) ->
+ boolean(BF, True, False, CtxtF, EnvF, SF)
+ end,
+ expr_let_1(E, F, Ctxt, Env, S);
+ 'try' ->
+ case Ctxt#ctxt.class of
+ guard ->
+ %% This *must* be a "protected" guard expression on
+ %% the form "try E of X -> X catch <...> -> 'false'"
+ %% (we could of course test if the handler body is
+ %% the atom 'false', etc.).
+ Ctxt1 = Ctxt#ctxt{fail = False},
+ boolean(cerl:try_arg(E), True, False, Ctxt1, Env, S);
+ _ ->
+ %% Propagate boolean handling into the handler and body
+ %% (see propagation into case switches for comparison)
+ F = fun (BF, CtxtF, EnvF, SF) ->
+ boolean(BF, True, False, CtxtF, EnvF, SF)
+ end,
+ S1 = expr_try_1(E, F, Ctxt, Env, S),
+ add_continuation_jump(False, Ctxt, S1)
+ end;
+ _ ->
+ %% This handles everything else, including cases that are
+ %% known to not return a boolean.
+ expect_boolean_value(E, True, False, Ctxt, Env, S)
+ end.
+
+strict_and([A, B], True, False, Ctxt, Env, S) ->
+ V = make_var(),
+ {Glue, True1, False1} = make_bool_glue(V),
+ S1 = boolean(A, True1, False1, Ctxt, Env, S),
+ S2 = add_code(Glue, S1),
+ Test = new_label(),
+ S3 = boolean(B, Test, False, Ctxt, Env, S2),
+ add_code([icode_label(Test),
+ make_bool_test(V, True, False)],
+ S3).
+
+strict_or([A, B], True, False, Ctxt, Env, S) ->
+ V = make_var(),
+ {Glue, True1, False1} = make_bool_glue(V),
+ S1 = boolean(A, True1, False1, Ctxt, Env, S),
+ S2 = add_code(Glue, S1),
+ Test = new_label(),
+ S3 = boolean(B, True, Test, Ctxt, Env, S2),
+ add_code([icode_label(Test),
+ make_bool_test(V, True, False)],
+ S3).
+
+strict_xor([A, B], True, False, Ctxt, Env, S) ->
+ V = make_var(),
+ {Glue, True1, False1} = make_bool_glue(V),
+ S1 = boolean(A, True1, False1, Ctxt, Env, S),
+ S2 = add_code(Glue, S1),
+ Test1 = new_label(),
+ Test2 = new_label(),
+ S3 = boolean(B, Test1, Test2, Ctxt, Env, S2),
+ add_code([icode_label(Test1),
+ make_bool_test(V, False, True),
+ icode_label(Test2),
+ make_bool_test(V, True, False)],
+ S3).
+
+%% Primitive comparison operations are inline expanded as conditional
+%% branches when part of a boolean expression, rather than made into
+%% primop or guardop calls. Note that Without type information, we
+%% cannot reduce equality tests like `Expr == true' to simply `Expr'
+%% (and `Expr == false' to `not Expr'), because we are not sure that
+%% Expr will yield a boolean - if it does not, the result of the
+%% comparison should be `false'.
+
+comparison(Name, As, True, False, Ctxt, Env, S) ->
+ {Vs, S1} = expr_list(As, Ctxt, Env, S),
+ Test = comp_test(Name),
+ add_code([make_if(Test, Vs, True, False)], S1).
+
+comp_test(?PRIMOP_EQ) -> ?TEST_EQ;
+comp_test(?PRIMOP_NE) -> ?TEST_NE;
+comp_test(?PRIMOP_EXACT_EQ) -> ?TEST_EXACT_EQ;
+comp_test(?PRIMOP_EXACT_NE) -> ?TEST_EXACT_NE;
+comp_test(?PRIMOP_LT) -> ?TEST_LT;
+comp_test(?PRIMOP_GT) -> ?TEST_GT;
+comp_test(?PRIMOP_LE) -> ?TEST_LE;
+comp_test(?PRIMOP_GE) -> ?TEST_GE.
+
+type_test(?PRIMOP_IS_RECORD, [T, A, N], True, False, Ctxt, Env, S) ->
+ is_record_test(T, A, N, True, False, Ctxt, Env, S);
+type_test(Name, [A], True, False, Ctxt, Env, S) ->
+ V = make_var(),
+ S1 = expr(A, [V], Ctxt#ctxt{final = false, effect = false}, Env, S),
+ Test = type_test(Name),
+ add_code([make_type([V], Test, True, False)], S1).
+
+%% It turned out to be easiest to generate Icode directly for this.
+is_record_test(T, A, N, True, False, Ctxt, Env, S) ->
+ case cerl:is_c_atom(A) andalso cerl:is_c_int(N)
+ andalso (cerl:concrete(N) > 0) of
+ true ->
+ V = make_var(),
+ Ctxt1 = Ctxt#ctxt{final = false, effect = false},
+ S1 = expr(T, [V], Ctxt1, Env, S),
+ Atom = cerl:concrete(A),
+ Size = cerl:concrete(N),
+ add_code([make_type([V], ?TYPE_IS_RECORD(Atom, Size), True, False)],
+ S1);
+ false ->
+ error_primop_badargs(?PRIMOP_IS_RECORD, [T, A, N]),
+ throw(error)
+ end.
+
+type_test(?PRIMOP_IS_ATOM) -> ?TYPE_IS_ATOM;
+type_test(?PRIMOP_IS_BIGNUM) -> ?TYPE_IS_BIGNUM;
+type_test(?PRIMOP_IS_BINARY) -> ?TYPE_IS_BINARY;
+type_test(?PRIMOP_IS_CONSTANT) -> ?TYPE_IS_CONSTANT;
+type_test(?PRIMOP_IS_FIXNUM) -> ?TYPE_IS_FIXNUM;
+type_test(?PRIMOP_IS_FLOAT) -> ?TYPE_IS_FLOAT;
+type_test(?PRIMOP_IS_FUNCTION) -> ?TYPE_IS_FUNCTION;
+type_test(?PRIMOP_IS_INTEGER) -> ?TYPE_IS_INTEGER;
+type_test(?PRIMOP_IS_LIST) -> ?TYPE_IS_LIST;
+type_test(?PRIMOP_IS_NUMBER) -> ?TYPE_IS_NUMBER;
+type_test(?PRIMOP_IS_PID) -> ?TYPE_IS_PID;
+type_test(?PRIMOP_IS_PORT) -> ?TYPE_IS_PORT;
+type_test(?PRIMOP_IS_REFERENCE) -> ?TYPE_IS_REFERENCE;
+type_test(?PRIMOP_IS_TUPLE) -> ?TYPE_IS_TUPLE.
+
+is_comp_op(?PRIMOP_EQ, 2) -> true;
+is_comp_op(?PRIMOP_NE, 2) -> true;
+is_comp_op(?PRIMOP_EXACT_EQ, 2) -> true;
+is_comp_op(?PRIMOP_EXACT_NE, 2) -> true;
+is_comp_op(?PRIMOP_LT, 2) -> true;
+is_comp_op(?PRIMOP_GT, 2) -> true;
+is_comp_op(?PRIMOP_LE, 2) -> true;
+is_comp_op(?PRIMOP_GE, 2) -> true;
+is_comp_op(Op, A) when is_atom(Op), is_integer(A) -> false.
+
+is_bool_op(?PRIMOP_AND, 2) -> true;
+is_bool_op(?PRIMOP_OR, 2) -> true;
+is_bool_op(?PRIMOP_XOR, 2) -> true;
+is_bool_op(?PRIMOP_NOT, 1) -> true;
+is_bool_op(Op, A) when is_atom(Op), is_integer(A) -> false.
+
+is_type_test(?PRIMOP_IS_ATOM, 1) -> true;
+is_type_test(?PRIMOP_IS_BIGNUM, 1) -> true;
+is_type_test(?PRIMOP_IS_BINARY, 1) -> true;
+is_type_test(?PRIMOP_IS_CONSTANT, 1) -> true;
+is_type_test(?PRIMOP_IS_FIXNUM, 1) -> true;
+is_type_test(?PRIMOP_IS_FLOAT, 1) -> true;
+is_type_test(?PRIMOP_IS_FUNCTION, 1) -> true;
+is_type_test(?PRIMOP_IS_INTEGER, 1) -> true;
+is_type_test(?PRIMOP_IS_LIST, 1) -> true;
+is_type_test(?PRIMOP_IS_NUMBER, 1) -> true;
+is_type_test(?PRIMOP_IS_PID, 1) -> true;
+is_type_test(?PRIMOP_IS_PORT, 1) -> true;
+is_type_test(?PRIMOP_IS_REFERENCE, 1) -> true;
+is_type_test(?PRIMOP_IS_TUPLE, 1) -> true;
+is_type_test(?PRIMOP_IS_RECORD, 3) -> true;
+is_type_test(Op, A) when is_atom(Op), is_integer(A) -> false.
+
+
+%% ---------------------------------------------------------------------
+%% Utility functions
+
+bind_var(V, Name, Env) ->
+ env__bind(cerl:var_name(V), #cerl_to_icode__var{name = Name}, Env).
+
+bind_vars([V | Vs], [X | Xs], Env) ->
+ bind_vars(Vs, Xs, bind_var(V, X, Env));
+bind_vars([], [], Env) ->
+ Env.
+
+bind_fun(V, L, Vs, Env) ->
+ env__bind(cerl:var_name(V), #'fun'{label = L, vars = Vs}, Env).
+
+add_code(Code, S) ->
+ s__add_code(Code, S).
+
+%% This inserts code when necessary for assigning the targets in the
+%% first list to those in the second.
+
+glue([V1 | Vs1], [V2 | Vs2], S) ->
+ if V1 =:= V2 ->
+ S;
+ true ->
+ glue(Vs1, Vs2, add_code([icode_move(V2, V1)], S))
+ end;
+glue([], [], S) ->
+ S;
+glue([], _, S) ->
+ warning_low_degree(),
+ S;
+glue(_, [], _) ->
+ error_high_degree(),
+ throw(error).
+
+make_moves([V1 | Vs1], [V2 | Vs2]) ->
+ [icode_move(V1, V2) | make_moves(Vs1, Vs2)];
+make_moves([], []) ->
+ [].
+
+%% If the context signals `final', we generate a return instruction,
+%% otherwise nothing happens.
+
+maybe_return(Ts, Ctxt, S) ->
+ case Ctxt#ctxt.final of
+ false ->
+ S;
+ true ->
+ add_return(Ts, S)
+ end.
+
+add_return(Ts, S) ->
+ add_code([icode_return(Ts)], S).
+
+new_continuation_label(Ctxt) ->
+ case Ctxt#ctxt.final of
+ false ->
+ new_label();
+ true ->
+ undefined
+ end.
+
+add_continuation_label(Label, Ctxt, S) ->
+ case Ctxt#ctxt.final of
+ false ->
+ add_code([icode_label(Label)], S);
+ true ->
+ S
+ end.
+
+add_continuation_jump(Label, Ctxt, S) ->
+ case Ctxt#ctxt.final of
+ false ->
+ add_code([icode_goto(Label)], S);
+ true ->
+ S
+ end.
+
+%% This is used to insert a new dummy label (if necessary) when
+%% a block is ended suddenly; cf. add_fail.
+add_new_continuation_label(Ctxt, S) ->
+ add_continuation_label(new_continuation_label(Ctxt), Ctxt, S).
+
+add_local_call({Name, _Arity} = V, Vs, Ts, Ctxt, S) ->
+ Module = s__get_module(S),
+ case Ctxt#ctxt.final of
+ false ->
+ add_code([icode_call_local(Ts, Module, Name, Vs)], S);
+ true ->
+ Self = s__get_function(S),
+ if V =:= Self ->
+ %% Self-recursive tail call:
+ {Label, Vs1} = s__get_local_entry(S),
+ add_code(make_moves(Vs1, Vs) ++ [icode_goto(Label)],
+ S);
+ true ->
+ add_code([icode_enter_local(Module, Name, Vs)], S)
+ end
+ end.
+
+%% Note that this has the same "problem" as the fail instruction (see
+%% the 'add_fail' function), namely, that it unexpectedly ends a basic
+%% block. The solution is the same - add a dummy label if necessary.
+
+add_letrec_call(Label, Vs1, Vs, Ctxt, S) ->
+ S1 = add_code(make_moves(Vs1, Vs) ++ [icode_goto(Label)], S),
+ add_new_continuation_label(Ctxt, S1).
+
+add_exit(V, Ctxt, S) ->
+ add_fail([V], exit, Ctxt, S).
+
+add_throw(V, Ctxt, S) ->
+ add_fail([V], throw, Ctxt, S).
+
+add_error(V, Ctxt, S) ->
+ add_fail([V], error, Ctxt, S).
+
+add_error(V, F, Ctxt, S) ->
+ add_fail([V, F], error, Ctxt, S).
+
+add_rethrow(E, V, Ctxt, S) ->
+ add_fail([E, V], rethrow, Ctxt, S).
+
+%% Failing is special, because it can "suddenly" end the basic block,
+%% even though the context was expecting the code to fall through, for
+%% instance when you have a call to 'exit(X)' that is not in a tail call
+%% context. In those cases a dummy label must therefore be added after
+%% the fail instruction, to start a new (but unreachable) basic block.
+
+add_fail(Vs, Class, Ctxt, S0) ->
+ S1 = add_code([icode_fail(Vs, Class)], S0),
+ add_new_continuation_label(Ctxt, S1).
+
+%% We must add continuation- and fail-labels if we are in a guard context.
+
+make_op(Name, Ts, As, Ctxt) ->
+ case Ctxt#ctxt.final of
+ false ->
+ case Ctxt#ctxt.class of
+ guard ->
+ Next = new_label(),
+ [icode_guardop(Ts, Name, As, Next, Ctxt#ctxt.fail),
+ icode_label(Next)];
+ _ ->
+ [icode_call_primop(Ts, Name, As)]
+ end;
+ true ->
+ [icode_enter_primop(Name, As)]
+ end.
+
+make_call(M, F, Ts, As, Ctxt) ->
+ case Ctxt#ctxt.final of
+ false ->
+ case Ctxt#ctxt.class of
+ guard ->
+ Next = new_label(),
+ [icode_call_remote(Ts, M, F, As, Next,
+ Ctxt#ctxt.fail, true),
+ icode_label(Next)];
+ _ ->
+ [icode_call_remote(Ts, M, F, As)]
+ end;
+ true ->
+ %% A final call can't be in a guard anyway
+ [icode_enter_remote(M, F, As)]
+ end.
+
+%% Recognize useless tests that always go to the same label. This often
+%% happens as an artefact of the translation.
+
+make_if(_, _, Label, Label) ->
+ icode_goto(Label);
+make_if(Test, As, True, False) ->
+ icode_if(Test, As, True, False).
+
+make_type(_, _, Label, Label) ->
+ icode_goto(Label);
+make_type(Vs, Test, True, False) ->
+ icode_type(Vs, Test, True, False).
+
+%% Creating glue code with true/false target labels for assigning a
+%% corresponding 'true'/'false' value to a specific variable. Used as
+%% glue between boolean jumping code and boolean values.
+
+make_bool_glue(V) ->
+ make_bool_glue(V, true, false).
+
+make_bool_glue(V, T, F) ->
+ False = new_label(),
+ True = new_label(),
+ Next = new_label(),
+ Code = [icode_label(False),
+ icode_move(V, icode_const(F)),
+ icode_goto(Next),
+ icode_label(True),
+ icode_move(V, icode_const(T)),
+ icode_label(Next)],
+ {Code, True, False}.
+
+make_bool_test(V, True, False) ->
+ make_type([V], ?TYPE_ATOM(true), True, False).
+
+%% Checking if an expression is safe
+
+is_safe_expr(E) ->
+ cerl_lib:is_safe_expr(E, fun function_check/2).
+
+function_check(safe, {Name, Arity}) ->
+ is_safe_op(Name, Arity);
+function_check(safe, {Module, Name, Arity}) ->
+ erl_bifs:is_safe(Module, Name, Arity);
+function_check(pure, {Name, Arity}) ->
+ is_pure_op(Name, Arity);
+function_check(pure, {Module, Name, Arity}) ->
+ erl_bifs:is_pure(Module, Name, Arity);
+function_check(_, _) ->
+ false.
+
+%% There are very few really safe operations (sigh!). If we have type
+%% information, several operations could be rewritten into specialized
+%% safe versions, such as '+'/2 -> add_integer/2.
+
+is_safe_op(N, A) ->
+ is_comp_op(N, A) orelse is_type_test(N, A).
+
+is_pure_op(?PRIMOP_ELEMENT, 2) -> true;
+is_pure_op(?PRIMOP_MAKE_FUN, 6) -> true;
+is_pure_op(?PRIMOP_FUN_ELEMENT, 2) -> true;
+is_pure_op(?PRIMOP_ADD, 2) -> true;
+is_pure_op(?PRIMOP_SUB, 2) -> true;
+is_pure_op(?PRIMOP_NEG, 1) -> true;
+is_pure_op(?PRIMOP_MUL, 2) -> true;
+is_pure_op(?PRIMOP_DIV, 2) -> true;
+is_pure_op(?PRIMOP_INTDIV, 2) -> true;
+is_pure_op(?PRIMOP_REM, 2) -> true;
+is_pure_op(?PRIMOP_BAND, 2) -> true;
+is_pure_op(?PRIMOP_BOR, 2) -> true;
+is_pure_op(?PRIMOP_BXOR, 2) -> true;
+is_pure_op(?PRIMOP_BNOT, 1) -> true;
+is_pure_op(?PRIMOP_BSL, 2) -> true;
+is_pure_op(?PRIMOP_BSR, 2) -> true;
+is_pure_op(?PRIMOP_EXIT, 1) -> true;
+is_pure_op(?PRIMOP_THROW, 1) -> true;
+is_pure_op(?PRIMOP_ERROR, 1) -> true;
+is_pure_op(?PRIMOP_ERROR, 2) -> true;
+is_pure_op(?PRIMOP_RETHROW, 2) -> true;
+is_pure_op(N, A) -> is_pure_op_aux(N, A).
+
+is_pure_op_aux(N, A) ->
+ is_bool_op(N, A) orelse is_comp_op(N, A) orelse is_type_test(N, A).
+
+translate_flags(Flags, Align) ->
+ translate_flags1(cerl:concrete(Flags), Align).
+
+translate_flags1([A|Rest], Align) ->
+ case A of
+ signed ->
+ 4 + translate_flags1(Rest, Align);
+ little ->
+ 2 + translate_flags1(Rest, Align);
+ native ->
+ case hipe_rtl_arch:endianess() of
+ little ->
+ 2 + translate_flags1(Rest, Align);
+ big ->
+ translate_flags1(Rest, Align)
+ end;
+ _ ->
+ translate_flags1(Rest, Align)
+ end;
+translate_flags1([], Align) ->
+ case Align of
+ 0 ->
+ 1;
+ _ ->
+ 0
+ end.
+
+get_const_info(Val, integer) ->
+ case {cerl:is_c_var(Val), cerl:is_c_int(Val)} of
+ {true, _} ->
+ var;
+ {_, true} ->
+ pass;
+ _ ->
+ fail
+ end;
+get_const_info(Val, float) ->
+ case {cerl:is_c_var(Val), cerl:is_c_float(Val)} of
+ {true, _} ->
+ var;
+ {_, true} ->
+ pass;
+ _ ->
+ fail
+ end;
+get_const_info(_Val, _Type) ->
+ [].
+
+calculate_size(Unit, Var, Align, Env, S) ->
+ case cerl:is_c_atom(Var) of
+ true ->
+ {cerl:atom_val(Var), cerl:concrete(Unit), Align, S};
+ false ->
+ case cerl:is_c_int(Var) of
+ true ->
+ NewVal = cerl:concrete(Var) * cerl:concrete(Unit),
+ NewAlign =
+ case Align of
+ false ->
+ false
+ %% Currently, all uses of the function are
+ %% with "Aligned == false", and this case
+ %% is commented out to shut up Dialyzer.
+ %% _ ->
+ %% (NewVal+Align) band 7
+ end,
+ {NewVal, [], S, NewAlign};
+ false ->
+ NewSize = make_var(),
+ S1 = expr(Var, [NewSize], #ctxt{final=false}, Env, S),
+ NewAlign =
+ case cerl:concrete(Unit) band 7 of
+ 0 ->
+ Align;
+ _ ->
+ false
+ end,
+ {cerl:concrete(Unit), [NewSize], S1, NewAlign}
+ end
+ end.
+
+
+%% ---------------------------------------------------------------------
+%% Environment (abstract datatype)
+
+env__new() ->
+ rec_env:empty().
+
+env__bind(Key, Val, Env) ->
+ rec_env:bind(Key, Val, Env).
+
+env__lookup(Key, Env) ->
+ rec_env:lookup(Key, Env).
+
+env__get(Key, Env) ->
+ rec_env:get(Key, Env).
+
+%% env__new_integer_keys(N, Env) ->
+%% rec_env:new_keys(N, Env).
+
+
+%% ---------------------------------------------------------------------
+%% State (abstract datatype)
+
+-record(state, {module, function, local, labels=gb_trees:empty(),
+ code = [], pmatch=true, bitlevel_binaries=false}).
+
+s__new(Module) ->
+ #state{module = Module}.
+
+s__get_module(S) ->
+ S#state.module.
+
+s__set_function(Name, S) ->
+ S#state{function = Name}.
+
+s__get_function(S) ->
+ S#state.function.
+
+s__set_local_entry(Info, S) ->
+ S#state{local = Info}.
+
+s__get_local_entry(S) ->
+ S#state.local.
+
+%% Generated code is kept in reverse order, to make adding fast.
+
+s__set_code(Code, S) ->
+ S#state{code = lists:reverse(Code)}.
+
+s__get_code(S) ->
+ lists:reverse(S#state.code).
+
+s__add_code(Code, S) ->
+ S#state{code = lists:reverse(Code, S#state.code)}.
+
+s__get_label(Ref, S) ->
+ Labels = S#state.labels,
+ case gb_trees:lookup(Ref, Labels) of
+ none ->
+ Label = new_label(),
+ S1 = S#state{labels=gb_trees:enter(Ref, Label, Labels)},
+ {Label, S1};
+ {value, Label} ->
+ {Label,S}
+ end.
+
+s__set_pmatch(V, S) ->
+ S#state{pmatch = V}.
+
+s__get_pmatch(S) ->
+ S#state.pmatch.
+
+s__set_bitlevel_binaries(true, S) ->
+ S#state{bitlevel_binaries = true};
+s__set_bitlevel_binaries(_, S) ->
+ S#state{bitlevel_binaries = false}.
+
+s__get_bitlevel_binaries(S) ->
+ S#state.bitlevel_binaries.
+%% ---------------------------------------------------------------------
+%%% Match label State
+
+%-record(mstate,{labels=gb_trees:empty()}).
+
+%get_correct_label(Alias, MState=#mstate{labels=Labels}) ->
+% case gb_trees:lookup(Alias, Labels) of
+% none ->
+% LabelName=new_label(),
+% {LabelName, MState#mstate{labels=gb_trees:insert(Alias, LabelName, Labels)}};
+% {value, LabelName} ->
+% {LabelName, MState}
+% end.
+
+
+%% ---------------------------------------------------------------------
+%% General utilities
+
+reset_var_counter() ->
+ hipe_gensym:set_var(0).
+
+reset_label_counter() ->
+ hipe_gensym:set_label(0).
+
+new_var() ->
+ hipe_gensym:get_next_var().
+
+new_label() ->
+ hipe_gensym:get_next_label().
+
+max_var() ->
+ hipe_gensym:get_var().
+
+max_label() ->
+ hipe_gensym:get_label().
+
+make_var() ->
+ icode_var(new_var()).
+
+make_vars(N) when N > 0 ->
+ [make_var() | make_vars(N - 1)];
+make_vars(0) ->
+ [].
+
+make_reg() ->
+ icode_reg(new_var()).
+
+
+%% ---------------------------------------------------------------------
+%% ICode interface
+
+icode_icode(M, {F, A}, Vs, Closure, C, V, L) ->
+ MFA = {M, F, A},
+ hipe_icode:mk_icode(MFA, Vs, Closure, false, C, V, L).
+
+icode_icode_name(Icode) ->
+ hipe_icode:icode_fun(Icode).
+
+icode_comment(S) -> hipe_icode:mk_comment(S).
+
+icode_var(V) -> hipe_icode:mk_var(V).
+
+icode_reg(V) -> hipe_icode:mk_reg(V).
+
+icode_label(L) -> hipe_icode:mk_label(L).
+
+icode_move(V, D) -> hipe_icode:mk_move(V, D).
+
+icode_const(X) -> hipe_icode:mk_const(X).
+
+icode_const_val(X) -> hipe_icode:const_value(X).
+
+icode_call_local(Ts, M, N, Vs) ->
+ hipe_icode:mk_call(Ts, M, N, Vs, local).
+
+icode_call_remote(Ts, M, N, Vs) ->
+ hipe_icode:mk_call(Ts, M, N, Vs, remote).
+
+icode_call_remote(Ts, M, N, Vs, Cont, Fail, Guard) ->
+ hipe_icode:mk_call(Ts, M, N, Vs, remote, Cont, Fail, Guard).
+
+icode_enter_local(M, N, Vs) ->
+ hipe_icode:mk_enter(M, N, Vs, local).
+
+icode_enter_remote(M, N, Vs) ->
+ hipe_icode:mk_enter(M, N, Vs, remote).
+
+icode_call_fun(Ts, Vs) ->
+ icode_call_primop(Ts, call_fun, Vs).
+
+icode_enter_fun(Vs) ->
+ icode_enter_primop(enter_fun, Vs).
+
+icode_begin_try(L,Cont) -> hipe_icode:mk_begin_try(L,Cont).
+
+icode_end_try() -> hipe_icode:mk_end_try().
+
+icode_begin_handler(Ts) -> hipe_icode:mk_begin_handler(Ts).
+
+icode_goto(L) -> hipe_icode:mk_goto(L).
+
+icode_return(Ts) -> hipe_icode:mk_return(Ts).
+
+icode_fail(Vs, C) -> hipe_icode:mk_fail(Vs, C).
+
+icode_guardop(Ts, Name, As, Succ, Fail) ->
+ hipe_icode:mk_guardop(Ts, Name, As, Succ, Fail).
+
+icode_call_primop(Ts, Name, As) -> hipe_icode:mk_primop(Ts, Name, As).
+
+icode_call_primop(Ts, Name, As, Succ, Fail) ->
+ hipe_icode:mk_primop(Ts, Name, As, Succ, Fail).
+
+icode_enter_primop(Name, As) -> hipe_icode:mk_enter_primop(Name, As).
+
+icode_if(Test, As, True, False) ->
+ hipe_icode:mk_if(Test, As, True, False).
+
+icode_type(Test, As, True, False) ->
+ hipe_icode:mk_type(Test, As, True, False).
+
+icode_switch_val(Arg, Fail, Length, Cases) ->
+ hipe_icode:mk_switch_val(Arg, Fail, Length, Cases).
+
+icode_switch_tuple_arity(Arg, Fail, Length, Cases) ->
+ SortedCases = lists:keysort(1, Cases), %% immitate BEAM compiler - Kostis
+ hipe_icode:mk_switch_tuple_arity(Arg, Fail, Length, SortedCases).
+
+
+%% ---------------------------------------------------------------------
+%% Error reporting
+
+error_not_in_receive(Name) ->
+ error_msg("primitive operation `~w' missing receive-context.",
+ [Name]).
+
+low_degree() ->
+ "degree of expression less than expected.".
+
+warning_low_degree() ->
+ warning_msg(low_degree()).
+
+error_low_degree() ->
+ error_msg(low_degree()).
+
+error_high_degree() ->
+ error_msg("degree of expression greater than expected.").
+
+error_degree_mismatch(N, E) ->
+ error_msg("expression does not have expected degree (~w): ~P.",
+ [N, E, 10]).
+
+error_nonlocal_application(Op) ->
+ error_msg("application operator not a local function: ~P.",
+ [Op, 10]).
+
+error_primop_badargs(Op, As) ->
+ error_msg("bad arguments to `~w' operation: ~P.",
+ [Op, As, 15]).
+
+%% internal_error_msg(S) ->
+%% internal_error_msg(S, []).
+
+%% internal_error_msg(S, Vs) ->
+%% error_msg(lists:concat(["Internal error: ", S]), Vs).
+
+error_msg(S) ->
+ error_msg(S, []).
+
+error_msg(S, Vs) ->
+ error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
+
+warning_msg(S) ->
+ warning_msg(S, []).
+
+warning_msg(S, Vs) ->
+ info_msg(lists:concat(["warning: ", S]), Vs).
+
+%% info_msg(S) ->
+%% info_msg(S, []).
+
+info_msg(S, Vs) ->
+ error_logger:info_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
+
+
+%% --------------------------------------------------------------------------
+%% Binary stuff
+
+binary_match([Clause|Clauses], F, [V], Next, Fail, Ctxt, Env, S) ->
+ Guard = cerl:clause_guard(Clause),
+ Body = cerl:clause_body(Clause),
+ [Pat] = cerl:clause_pats(Clause),
+ {FL,S1} = s__get_label(translate_label_primop(Guard),S),
+ {Env1,S2} = binary_pattern(Pat,V,FL,Env,S1),
+ S3 = F(Body, Ctxt, Env1, S2),
+ S4 = add_continuation_jump(Next, Ctxt, S3),
+ S5 = add_code([icode_label(FL)], S4),
+ binary_match(Clauses, F, [V], Next, Fail, Ctxt, Env, S5);
+binary_match([], _F, _, _Next, Fail, _Ctxt, _Env, S) ->
+ add_code([icode_goto(Fail)], S).
+
+translate_label_primop(LabelPrimop) ->
+ ?PRIMOP_SET_LABEL = cerl:atom_val(cerl:primop_name(LabelPrimop)),
+ [Ref] = cerl:primop_args(LabelPrimop),
+ Ref.
+
+
diff --git a/lib/hipe/cerl/cerl_typean.erl b/lib/hipe/cerl/cerl_typean.erl
new file mode 100644
index 0000000000..ccd8903658
--- /dev/null
+++ b/lib/hipe/cerl/cerl_typean.erl
@@ -0,0 +1,1003 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Type analysis of Core Erlang programs.
+%%
+%% Copyright (C) 2001-2002 Richard Carlsson
+%%
+%% Author contact: richardc@it.uu.se
+%%
+%% @doc Type analysis of Core Erlang programs.
+
+%% TODO: filters must handle conjunctions for better precision!
+%% TODO: should get filters from patterns as well as guards.
+%% TODO: unused functions are being included in the analysis.
+
+-module(cerl_typean).
+
+-export([core_transform/2, analyze/1, pp_hook/0]).
+%%-export([analyze/2, analyze/5, annotate/1, annotate/2, annotate/5]).
+
+-import(erl_types, [t_any/0, t_atom/0, t_atom_vals/1, t_binary/0,
+ t_cons/2, t_cons_hd/1, t_cons_tl/1, t_float/0,
+ t_fun/0, t_fun/2, t_from_range/2, t_from_term/1,
+ t_inf/2, t_integer/0,
+ t_is_any/1, t_is_atom/1, t_is_cons/1, t_is_list/1,
+ t_is_maybe_improper_list/1, t_is_none/1, t_is_tuple/1,
+ t_limit/2, t_list_elements/1, t_maybe_improper_list/0,
+ t_none/0, t_number/0, t_pid/0, t_port/0, t_product/1,
+ t_reference/0, t_sup/2, t_to_tlist/1, t_tuple/0, t_tuple/1,
+ t_tuple_args/1, t_tuple_size/1, t_tuple_subtypes/1]).
+
+-import(cerl, [ann_c_fun/3, ann_c_var/2, alias_pat/1, alias_var/1,
+ apply_args/1, apply_op/1, atom_val/1, bitstr_size/1,
+ bitstr_val/1, bitstr_type/1, bitstr_flags/1, binary_segments/1,
+ c_letrec/2, c_nil/0,
+ c_values/1, call_args/1, call_module/1, call_name/1,
+ case_arg/1, case_clauses/1, catch_body/1, clause_body/1,
+ clause_guard/1, clause_pats/1, concrete/1, cons_hd/1,
+ cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
+ is_c_atom/1, is_c_int/1, let_arg/1, let_body/1, let_vars/1,
+ letrec_body/1, letrec_defs/1, module_defs/1,
+ module_defs/1, module_exports/1, pat_vars/1,
+ primop_args/1, primop_name/1, receive_action/1,
+ receive_clauses/1, receive_timeout/1, seq_arg/1,
+ seq_body/1, set_ann/2, try_arg/1, try_body/1,
+ try_evars/1, try_handler/1, try_vars/1, tuple_arity/1,
+ tuple_es/1, type/1, values_es/1, var_name/1]).
+
+-import(cerl_trees, [get_label/1]).
+
+-ifdef(DEBUG).
+-define(ANNOTATE(X), case erl_types:t_to_string(X) of Q when length(Q) < 255 -> list_to_atom(Q); Q -> Q end).
+-else.
+-define(ANNOTATE(X), X).
+-endif.
+
+%% Limit for type representation depth.
+-define(DEF_LIMIT, 3).
+
+
+%% @spec core_transform(Module::cerl_records(), Options::[term()]) ->
+%% cerl_records()
+%%
+%% @doc Annotates a module represented by records with type
+%% information. See <code>annotate/1</code> for details.
+%%
+%% <p>Use the compiler option <code>{core_transform, cerl_typean}</code>
+%% to insert this function as a compilation pass.</p>
+%%
+%% @see module/2
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(Code, _Opts) ->
+ {Code1, _} = cerl_trees:label(cerl:from_records(Code)),
+ %% io:fwrite("Running type analysis..."),
+ %% {T1,_} = statistics(runtime),
+ {Code2, _, _} = annotate(Code1),
+ %% {T2,_} = statistics(runtime),
+ %% io:fwrite("(~w ms).\n", [T2 - T1]),
+ cerl:to_records(Code2).
+
+
+%% =====================================================================
+%% annotate(Tree) -> {Tree1, Type, Vars}
+%%
+%% Tree = cerl:cerl()
+%%
+%% Analyzes `Tree' (see `analyze') and appends terms `{type, Type}'
+%% to the annotation list of each fun-expression node and
+%% apply-expression node of `Tree', respectively, where `Labels' is
+%% an ordered-set list of labels of fun-expressions in `Tree',
+%% possibly also containing the atom `external', corresponding to
+%% the dependency information derived by the analysis. Any previous
+%% such annotations are removed from `Tree'. `Tree1' is the
+%% modified tree; for details on `OutList', `Outputs' ,
+%% `Dependencies' and `Escapes', see `analyze'.
+%%
+%% Note: `Tree' must be annotated with labels in order to use this
+%% function; see `analyze' for details.
+
+annotate(Tree) ->
+ annotate(Tree, ?DEF_LIMIT).
+
+annotate(Tree, Limit) ->
+ {_, _, Esc, Dep, Par} = cerl_closurean:analyze(Tree),
+ annotate(Tree, Limit, Esc, Dep, Par).
+
+annotate(Tree, Limit, Esc, Dep, Par) ->
+ {Type, Out, Vars} = analyze(Tree, Limit, Esc, Dep, Par),
+ DelAnn = fun (T) -> set_ann(T, delete_ann(type, get_ann(T))) end,
+ SetType = fun (T, Dict) ->
+ case dict:find(get_label(T), Dict) of
+ {ok, X} ->
+ case t_is_any(X) of
+ true ->
+ DelAnn(T);
+ false ->
+ set_ann(T, append_ann(type,
+ ?ANNOTATE(X),
+ get_ann(T)))
+ end;
+ error ->
+ DelAnn(T)
+ end
+ end,
+ F = fun (T) ->
+ case type(T) of
+ var ->
+ SetType(T, Vars);
+ apply ->
+ SetType(T, Out);
+ call ->
+ SetType(T, Out);
+ primop ->
+ SetType(T, Out);
+ 'fun' ->
+ SetType(T, Out);
+ _ ->
+ DelAnn(T)
+ end
+ end,
+ {cerl_trees:map(F, Tree), Type, Vars}.
+
+append_ann(Tag, Val, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ append_ann(Tag, Val, Xs);
+ true ->
+ [X | append_ann(Tag, Val, Xs)]
+ end;
+append_ann(Tag, Val, []) ->
+ [{Tag, Val}].
+
+delete_ann(Tag, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ delete_ann(Tag, Xs);
+ true ->
+ [X | delete_ann(Tag, Xs)]
+ end;
+delete_ann(_, []) ->
+ [].
+
+
+%% =====================================================================
+%% analyze(Tree) -> {OutList, Outputs, Dependencies}
+%%
+%% Tree = cerl:cerl()
+%% OutList = [LabelSet] | none
+%% Outputs = dict(integer(), OutList)
+%% Dependencies = dict(integer(), LabelSet)
+%% LabelSet = ordset(Label)
+%% Label = integer() | external
+%%
+%% Analyzes a module or an expression represented by `Tree'.
+%%
+%% The returned `OutList' is a list of sets of labels of
+%% fun-expressions which correspond to the possible closures in the
+%% value list produced by `Tree' (viewed as an expression; the
+%% "value" of a module contains its exported functions). The atom
+%% `none' denotes missing or conflicting information.
+%%
+%% The atom `external' in any label set denotes any possible
+%% function outside `Tree', including those in `Escapes'.
+%%
+%% `Outputs' is a mapping from the labels of fun-expressions in
+%% `Tree' to corresponding lists of sets of labels of
+%% fun-expressions (or the atom `none'), representing the possible
+%% closures in the value lists returned by the respective
+%% functions.
+%%
+%% `Dependencies' is a similar mapping from the labels of
+%% fun-expressions and apply-expressions in `Tree' to sets of
+%% labels of corresponding fun-expressions which may contain call
+%% sites of the functions or be called from the call sites,
+%% respectively. Any such label not defined in `Dependencies'
+%% represents an unreachable function or a dead or faulty
+%% application.
+%%
+%% `Escapes' is the set of labels of fun-expressions in `Tree' such
+%% that corresponding closures may be accessed from outside `Tree'.
+%%
+%% Note: `Tree' must be annotated with labels (as done by the
+%% function `cerl_trees:label/1') in order to use this function.
+%% The label annotation `{label, L}' (where L should be an integer)
+%% must be the first element of the annotation list of each node in
+%% the tree. Instances of variables bound in `Tree' which denote
+%% the same variable must have the same label; apart from this,
+%% labels should be unique. Constant literals do not need to be
+%% labeled.
+
+-record(state, {k, vars, out, dep, work, funs, envs}).
+
+%% Note: In order to keep our domain simple, we assume that all remote
+%% calls and primops return a single value, if any.
+
+%% We wrap the given syntax tree T in a fun-expression labeled `top',
+%% which is initially in the set of escaped labels. `top' will be
+%% visited at least once.
+%%
+%% We create a separate function labeled `external', defined as:
+%% "External = fun () -> Any", which will represent any and all
+%% functions outside T, and whose return value has unknown type.
+
+-type label() :: integer() | 'external' | 'top'.
+-type ordset(X) :: [X]. % XXX: TAKE ME OUT
+-type labelset() :: ordset(label()).
+-type outlist() :: [labelset()] | 'none'.
+
+-spec analyze(cerl:cerl()) -> {outlist(), dict(), dict()}.
+
+analyze(Tree) ->
+ analyze(Tree, ?DEF_LIMIT).
+
+analyze(Tree, Limit) ->
+ {_, _, Esc, Dep, Par} = cerl_closurean:analyze(Tree),
+ analyze(Tree, Limit, Esc, Dep, Par).
+
+analyze(Tree, Limit, Esc0, Dep0, Par) ->
+ %% Note that we use different name spaces for variable labels and
+ %% function/call site labels. We assume that the labeling of Tree
+ %% only uses integers, not atoms.
+ LabelExtL = [{label, external}],
+ External = ann_c_var(LabelExtL, {external, 1}),
+ ExtFun = ann_c_fun(LabelExtL, [], ann_c_var([{label, any}], 'Any')),
+%%% io:fwrite("external fun:\n~s.\n",
+%%% [cerl_prettypr:format(ExtFun, [noann, {paper, 80}])]),
+ LabelTopL = [{label, top}],
+ Top = ann_c_var(LabelTopL, {top, 0}),
+ TopFun = ann_c_fun(LabelTopL, [], Tree),
+
+ %% The "start fun" just makes the initialisation easier. It is not
+ %% itself in the call graph.
+ StartFun = ann_c_fun([{label, start}], [],
+ c_letrec([{External, ExtFun}, {Top, TopFun}],
+ c_nil())),
+%%% io:fwrite("start fun:\n~s.\n",
+%%% [cerl_prettypr:format(StartFun, [{paper, 80}])]),
+
+ %% Gather a database of all fun-expressions in Tree and initialise
+ %% their outputs and parameter variables. All escaping functions can
+ %% receive any values as inputs. Also add an extra dependency edge
+ %% from each fun-expression label to its parent fun-expression.
+%%% io:fwrite("Escape: ~p.\n",[Esc0]),
+ Esc = sets:from_list(Esc0),
+ Any = t_any(),
+ None = t_none(),
+ Funs0 = dict:new(),
+ Vars0 = dict:store(any, Any, dict:new()),
+ Out0 = dict:store(top, None,
+ dict:store(external, None, dict:new())),
+ Envs0 = dict:store(top, dict:new(),
+ dict:store(external, dict:new(), dict:new())),
+ F = fun (T, S = {Fs, Vs, Os, Es}) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ As = fun_vars(T),
+ X = case sets:is_element(L, Esc) of
+ true -> Any;
+ false -> None
+ end,
+ {dict:store(L, T, Fs),
+ bind_vars_single(As, X, Vs),
+ dict:store(L, None, Os),
+ dict:store(L, dict:new(), Es)};
+ _ ->
+ S
+ end
+ end,
+ {Funs, Vars, Out, Envs} = cerl_trees:fold(F, {Funs0, Vars0, Out0,
+ Envs0}, StartFun),
+
+ %% Add dependencies from funs to their parent funs.
+ Dep = lists:foldl(fun ({L, L1}, D) -> add_dep(L, L1, D) end,
+ Dep0, dict:to_list(Par)),
+
+ %% Enter the fixpoint iteration at the StartFun.
+ St = loop(TopFun, top, #state{vars = Vars,
+ out = Out,
+ dep = Dep,
+ work = init_work(),
+ funs = Funs,
+ envs = Envs,
+ k = Limit}),
+ {dict:fetch(top, St#state.out),
+ tidy_dict([top, external], St#state.out),
+ tidy_dict([any], St#state.vars)}.
+
+tidy_dict([X | Xs], D) ->
+ tidy_dict(Xs, dict:erase(X, D));
+tidy_dict([], D) ->
+ D.
+
+loop(T, L, St0) ->
+%%% io:fwrite("analyzing: ~w.\n",[L]),
+%%% io:fwrite("work: ~w.\n", [Queue0]),
+ Env = dict:fetch(L, St0#state.envs),
+ X0 = dict:fetch(L, St0#state.out),
+ {X1, St1} = visit(fun_body(T), Env, St0),
+ X = limit(X1, St1#state.k),
+ {W, M} = case equal(X0, X) of
+ true ->
+ {St1#state.work, St1#state.out};
+ false ->
+%%% io:fwrite("out (~w) changed: ~s <- ~s.\n",
+%%% [L, erl_types:t_to_string(X),
+%%% erl_types:t_to_string(X0)]),
+ M1 = dict:store(L, X, St1#state.out),
+ case dict:find(L, St1#state.dep) of
+ {ok, S} ->
+%%% io:fwrite("adding work: ~w.\n", [S]),
+ {add_work(S, St1#state.work), M1};
+ error ->
+ {St1#state.work, M1}
+ end
+ end,
+ St2 = St1#state{out = M},
+ case take_work(W) of
+ {ok, L1, W1} ->
+ T1 = dict:fetch(L1, St2#state.funs),
+ loop(T1, L1, St2#state{work = W1});
+ none ->
+ St2
+ end.
+
+visit(T, Env, St) ->
+ case type(T) of
+ literal ->
+ {t_from_term(concrete(T)), St};
+ var ->
+ %% If a variable is not already in the store at this point,
+ %% we initialize it to 'none()'.
+ L = get_label(T),
+ Vars = St#state.vars,
+ case dict:find(L, Vars) of
+ {ok, X} ->
+ case dict:find(var_name(T), Env) of
+ {ok, X1} ->
+%%% io:fwrite("filtered variable reference: ~w:~s.\n",
+%%% [var_name(T), erl_types:t_to_string(X1)]),
+ {meet(X, X1), St};
+ error ->
+ {X, St}
+ end;
+ error ->
+ X = t_none(),
+ Vars1 = dict:store(L, X, Vars),
+ St1 = St#state{vars = Vars1},
+ {X, St1}
+ end;
+ 'fun' ->
+ %% Must revisit the fun also, because its environment might
+ %% have changed. (We don't keep track of such dependencies.)
+ L = get_label(T),
+ Xs = [dict:fetch(get_label(V), St#state.vars)
+ || V <- fun_vars(T)],
+ X = dict:fetch(L, St#state.out),
+ St1 = St#state{work = add_work([L], St#state.work),
+ envs = dict:store(L, Env, St#state.envs)},
+ {t_fun(Xs, X), St1};
+ values ->
+ {Xs, St1} = visit_list(values_es(T), Env, St),
+ {t_product(Xs), St1};
+ cons ->
+ {[X1, X2], St1} = visit_list([cons_hd(T), cons_tl(T)], Env, St),
+ {t_cons(X1, X2), St1};
+ tuple ->
+ {Xs, St1} = visit_list(tuple_es(T), Env, St),
+ {t_tuple(Xs), St1};
+ 'let' ->
+ {X, St1} = visit(let_arg(T), Env, St),
+ LetVars = let_vars(T),
+ St1Vars = St1#state.vars,
+ Vars = case t_is_any(X) orelse t_is_none(X) of
+ true ->
+ bind_vars_single(LetVars, X, St1Vars);
+ false ->
+ bind_vars(LetVars, t_to_tlist(X), St1Vars)
+ end,
+ visit(let_body(T), Env, St1#state{vars = Vars});
+ seq ->
+ {_, St1} = visit(seq_arg(T), Env, St),
+ visit(seq_body(T), Env, St1);
+ apply ->
+ {_F, St1} = visit(apply_op(T), Env, St),
+ {As, St2} = visit_list(apply_args(T), Env, St1),
+ L = get_label(T),
+ Ls = get_deps(L, St#state.dep),
+ Out = St2#state.out,
+ X = join_list([dict:fetch(L1, Out) || L1 <- Ls]),
+ Out1 = dict:store(L, X, Out),
+ {X, call_site(Ls, As, St2#state{out = Out1})};
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ As = call_args(T),
+ {[X1, X2], St1} = visit_list([M, F], Env, St),
+ {Xs, St2} = visit_list(As, Env, St1),
+%%% io:fwrite("call: ~w:~w(~w).\n",[X1,X2,Xs]),
+ X = case {t_atom_vals(X1), t_atom_vals(X2)} of
+ {[M1], [F1]} ->
+ A = length(As),
+%%% io:fwrite("known call: ~w:~w/~w.\n",
+%%% [M1, F1, A]),
+ call_type(M1, F1, A, Xs);
+ _ ->
+ t_any()
+ end,
+ L = get_label(T),
+ {X, St2#state{out = dict:store(L, X, St2#state.out)}};
+ primop ->
+ As = primop_args(T),
+ {Xs, St1} = visit_list(As, Env, St),
+ F = atom_val(primop_name(T)),
+ A = length(As),
+ L = get_label(T),
+ X = primop_type(F, A, Xs),
+ {X, St1#state{out = dict:store(L, X, St1#state.out)}};
+ 'case' ->
+ {X, St1} = visit(case_arg(T), Env, St),
+ Xs = case t_is_any(X) orelse t_is_none(X) of
+ true ->
+ [X || _ <- cerl:case_clauses(T)];
+ false ->
+ t_to_tlist(X)
+ end,
+ join_visit_clauses(Xs, case_clauses(T), Env, St1);
+ 'receive' ->
+ Any = t_any(),
+ {X1, St1} = join_visit_clauses([Any], receive_clauses(T),
+ Env, St),
+ {X2, St2} = visit(receive_timeout(T), Env, St1),
+ case t_is_atom(X2) andalso (t_atom_vals(X2) =:= [infinity]) of
+ true ->
+ {X1, St2};
+ false ->
+ {X3, St3} = visit(receive_action(T), Env, St2),
+ {join(X1, X3), St3}
+ end;
+ 'try' ->
+ {X, St1} = visit(try_arg(T), Env, St),
+ Any = t_any(),
+ Atom = t_atom(),
+ TryVars = try_vars(T),
+ St1Vars = St1#state.vars,
+ Vars = case t_is_any(X) orelse t_is_none(X) of
+ true ->
+ bind_vars_single(TryVars, X, St1Vars);
+ false ->
+ bind_vars(TryVars, t_to_tlist(X), St1Vars)
+ end,
+ {X1, St2} = visit(try_body(T), Env, St1#state{vars = Vars}),
+ EVars = bind_vars(try_evars(T), [Atom, Any, Any], St2#state.vars),
+ {X2, St3} = visit(try_handler(T), Env, St2#state{vars = EVars}),
+ {join(X1, X2), St3};
+ 'catch' ->
+ {_, St1} = visit(catch_body(T), Env, St),
+ {t_any(), St1};
+ binary ->
+ {_, St1} = visit_list(binary_segments(T), Env, St),
+ {t_binary(), St1};
+ bitstr ->
+ %% The other fields are constant literals.
+ {_, St1} = visit(bitstr_val(T), Env, St),
+ {_, St2} = visit(bitstr_size(T), Env, St1),
+ {t_none(), St2};
+ letrec ->
+ %% All the bound funs should be revisited, because the
+ %% environment might have changed.
+ Vars = bind_defs(letrec_defs(T), St#state.vars,
+ St#state.out),
+ Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
+ St1 = St#state{work = add_work(Ls, St#state.work),
+ vars = Vars},
+ visit(letrec_body(T), Env, St1);
+ module ->
+ %% We handle a module as a sequence of function variables in
+ %% the body of a `letrec'.
+ {_, St1} = visit(c_letrec(module_defs(T),
+ c_values(module_exports(T))),
+ Env, St),
+ {t_none(), St1}
+ end.
+
+visit_clause(T, Xs, Env, St) ->
+ Env1 = Env,
+ Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
+ G = clause_guard(T),
+ {_, St1} = visit(G, Env1, St#state{vars = Vars}),
+ Env2 = guard_filters(G, Env1),
+ visit(clause_body(T), Env2, St1).
+
+%% We assume correct value-list typing.
+
+visit_list([T | Ts], Env, St) ->
+ {X, St1} = visit(T, Env, St),
+ {Xs, St2} = visit_list(Ts, Env, St1),
+ {[X | Xs], St2};
+visit_list([], _Env, St) ->
+ {[], St}.
+
+join_visit_clauses(Xs, [T | Ts], Env, St) ->
+ {X1, St1} = visit_clause(T, Xs, Env, St),
+ {X2, St2} = join_visit_clauses(Xs, Ts, Env, St1),
+ {join(X1, X2), St2};
+join_visit_clauses(_, [], _Env, St) ->
+ {t_none(), St}.
+
+bind_defs([{V, F} | Ds], Vars, Out) ->
+ Xs = [dict:fetch(get_label(V1), Vars) || V1 <- fun_vars(F)],
+ X = dict:fetch(get_label(F), Out),
+ bind_defs(Ds, dict:store(get_label(V), t_fun(Xs, X), Vars), Out);
+bind_defs([], Vars, _Out) ->
+ Vars.
+
+bind_pats(Ps, Xs, Vars) ->
+ if length(Xs) =:= length(Ps) ->
+ bind_pats_list(Ps, Xs, Vars);
+ true ->
+ bind_pats_single(Ps, t_none(), Vars)
+ end.
+
+bind_pats_list([P | Ps], [X | Xs], Vars) ->
+ Vars1 = bind_pat_vars(P, X, Vars),
+ bind_pats_list(Ps, Xs, Vars1);
+bind_pats_list([], [], Vars) ->
+ Vars.
+
+bind_pats_single([P | Ps], X, Vars) ->
+ bind_pats_single(Ps, X, bind_pat_vars(P, X, Vars));
+bind_pats_single([], _X, Vars) ->
+ Vars.
+
+bind_pat_vars(P, X, Vars) ->
+ case type(P) of
+ var ->
+ dict:store(get_label(P), X, Vars);
+ literal ->
+ Vars;
+ cons ->
+ case t_is_cons(X) of
+ true ->
+ %% If X is "nonempty proper list of X1", then the
+ %% head has type X1 and the tail has type "proper
+ %% list of X1". (If X is just "cons cell of X1",
+ %% then both head and tail have type X1.)
+ Vars1 = bind_pat_vars(cons_hd(P), t_cons_hd(X),
+ Vars),
+ bind_pat_vars(cons_tl(P), t_cons_tl(X), Vars1);
+ false ->
+ case t_is_list(X) of
+ true ->
+ %% If X is "proper list of X1", then the
+ %% head has type X1 and the tail has type
+ %% "proper list of X1", i.e., type X.
+ Vars1 = bind_pat_vars(cons_hd(P),
+ t_list_elements(X),
+ Vars),
+ bind_pat_vars(cons_tl(P), X, Vars1);
+ false ->
+ case t_is_maybe_improper_list(X) of
+ true ->
+ %% If X is "cons cell of X1", both
+ %% the head and tail have type X1.
+ X1 = t_list_elements(X),
+ Vars1 = bind_pat_vars(cons_hd(P),
+ X1, Vars),
+ bind_pat_vars(cons_tl(P), X1,
+ Vars1);
+ false ->
+ bind_vars_single(pat_vars(P),
+ top_or_bottom(X),
+ Vars)
+ end
+ end
+ end;
+ tuple ->
+ case t_is_tuple(X) of
+ true ->
+ case t_tuple_subtypes(X) of
+ unknown ->
+ bind_vars_single(pat_vars(P), top_or_bottom(X),
+ Vars);
+ [Tuple] ->
+ case t_tuple_size(Tuple) =:= tuple_arity(P) of
+ true ->
+ bind_pats_list(tuple_es(P),
+ t_tuple_args(Tuple), Vars);
+
+ false ->
+ bind_vars_single(pat_vars(P),
+ top_or_bottom(X), Vars)
+ end;
+ List when is_list(List) ->
+ bind_vars_single(pat_vars(P), top_or_bottom(X),
+ Vars)
+ end;
+ false ->
+ bind_vars_single(pat_vars(P), top_or_bottom(X), Vars)
+ end;
+ binary ->
+ bind_pats_single(binary_segments(P), t_none(), Vars);
+ bitstr ->
+ %% Only the Value field is a new binding. Size is already
+ %% bound, and the other fields are constant literals.
+ %% We could create a filter for Size being an integer().
+ Size = bitstr_size(P),
+ ValType =
+ case concrete(bitstr_type(P)) of
+ float -> t_float();
+ binary -> t_binary();
+ integer ->
+ case is_c_int(Size) of
+ false -> t_integer();
+ true ->
+ SizeVal = int_val(Size),
+ Flags = concrete(bitstr_flags(P)),
+ case lists:member(signed, Flags) of
+ true ->
+ t_from_range(-(1 bsl (SizeVal - 1)),
+ 1 bsl (SizeVal - 1) - 1);
+ false ->
+ t_from_range(0,1 bsl SizeVal - 1)
+ end
+ end
+ end,
+ bind_pat_vars(bitstr_val(P), ValType, Vars);
+ alias ->
+ P1 = alias_pat(P),
+ Vars1 = bind_pat_vars(P1, X, Vars),
+ dict:store(get_label(alias_var(P)), pat_type(P1, Vars1),
+ Vars1)
+ end.
+
+pat_type(P, Vars) ->
+ case type(P) of
+ var ->
+ dict:fetch(get_label(P), Vars);
+ literal ->
+ t_from_term(concrete(P));
+ cons ->
+ t_cons(pat_type(cons_hd(P), Vars),
+ pat_type(cons_tl(P), Vars));
+ tuple ->
+ t_tuple([pat_type(E, Vars) || E <- tuple_es(P)]);
+ binary ->
+ t_binary();
+ alias ->
+ pat_type(alias_pat(P), Vars)
+ end.
+
+bind_vars(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_vars_list(Vs, Xs, Vars);
+ true ->
+ bind_vars_single(Vs, t_none(), Vars)
+ end.
+
+bind_vars_list([V | Vs], [X | Xs], Vars) ->
+ bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
+bind_vars_list([], [], Vars) ->
+ Vars.
+
+bind_vars_single([V | Vs], X, Vars) ->
+ bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
+bind_vars_single([], _X, Vars) ->
+ Vars.
+
+add_dep(Source, Target, Deps) ->
+ case dict:find(Source, Deps) of
+ {ok, X} ->
+ case set__is_member(Target, X) of
+ true ->
+ Deps;
+ false ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__add(Target, X), Deps)
+ end;
+ error ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__singleton(Target), Deps)
+ end.
+
+%% This handles a call site, updating parameter variables with respect
+%% to the actual parameters.
+
+call_site(Ls, Xs, St) ->
+%% io:fwrite("call site: ~w ~s.\n",
+%% [Ls, erl_types:t_to_string(erl_types:t_product(Xs))]),
+ {W, V} = call_site(Ls, Xs, St#state.work, St#state.vars,
+ St#state.funs, St#state.k),
+ St#state{work = W, vars = V}.
+
+call_site([L | Ls], Xs, W, V, Fs, Limit) ->
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args(Vs, Xs, V, Limit) of
+ {V1, true} ->
+ call_site(Ls, Xs, add_work([L], W), V1, Fs, Limit);
+ {V1, false} ->
+ call_site(Ls, Xs, W, V1, Fs, Limit)
+ end;
+call_site([], _, W, V, _, _) ->
+ {W, V}.
+
+%% If the arity does not match the call, nothing is done here.
+
+bind_args(Vs, Xs, Vars, Limit) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_args(Vs, Xs, Vars, Limit, false);
+ true ->
+ {Vars, false}
+ end.
+
+bind_args([V | Vs], [X | Xs], Vars, Limit, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Limit, Ch),
+ bind_args(Vs, Xs, Vars1, Limit, Ch1);
+bind_args([], [], Vars, _Limit, Ch) ->
+ {Vars, Ch}.
+
+%% bind_arg(L, X, Vars, Limit) ->
+%% bind_arg(L, X, Vars, Limit, false).
+
+bind_arg(L, X, Vars, Limit, Ch) ->
+ X0 = dict:fetch(L, Vars),
+ X1 = limit(join(X, X0), Limit),
+ case equal(X0, X1) of
+ true ->
+ {Vars, Ch};
+ false ->
+%%% io:fwrite("arg (~w) changed: ~s <- ~s + ~s.\n",
+%%% [L, erl_types:t_to_string(X1),
+%%% erl_types:t_to_string(X0),
+%%% erl_types:t_to_string(X)]),
+ {dict:store(L, X1, Vars), true}
+ end.
+
+%% Domain: type(), defined in module `erl_types'.
+
+meet(X, Y) -> t_inf(X, Y).
+
+join(X, Y) -> t_sup(X, Y).
+
+join_list([Xs | Xss]) ->
+ join(Xs, join_list(Xss));
+join_list([]) ->
+ t_none().
+
+equal(X, Y) -> X =:= Y.
+
+limit(X, K) -> t_limit(X, K).
+
+top_or_bottom(T) ->
+ case t_is_none(T) of
+ true ->
+ T;
+ false ->
+ t_any()
+ end.
+
+strict(Xs, T) ->
+ case erl_types:any_none(Xs) of
+ true ->
+ t_none();
+ false ->
+ T
+ end.
+
+%% Set abstraction for label sets.
+
+%% set__new() -> [].
+
+set__singleton(X) -> [X].
+
+%% set__to_list(S) -> S.
+
+%% set__from_list(S) -> ordsets:from_list(S).
+
+%% set__union(X, Y) -> ordsets:union(X, Y).
+
+set__add(X, S) -> ordsets:add_element(X, S).
+
+set__is_member(X, S) -> ordsets:is_element(X, S).
+
+%% set__subtract(X, Y) -> ordsets:subtract(X, Y).
+
+%% set__equal(X, Y) -> X =:= Y.
+
+%% A simple but efficient functional queue.
+
+queue__new() -> {[], []}.
+
+queue__put(X, {In, Out}) -> {[X | In], Out}.
+
+queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
+queue__get({[], _}) -> empty;
+queue__get({In, _}) ->
+ [X | In1] = lists:reverse(In),
+ {ok, X, {[], In1}}.
+
+%% The work list - a queue without repeated elements.
+
+init_work() ->
+ {queue__put(external, queue__new()), sets:new()}.
+
+add_work(Ls, {Q, Set}) ->
+ add_work(Ls, Q, Set).
+
+%% Note that the elements are enqueued in order.
+
+add_work([L | Ls], Q, Set) ->
+ case sets:is_element(L, Set) of
+ true ->
+ add_work(Ls, Q, Set);
+ false ->
+ add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
+ end;
+add_work([], Q, Set) ->
+ {Q, Set}.
+
+take_work({Queue0, Set0}) ->
+ case queue__get(Queue0) of
+ {ok, L, Queue1} ->
+ Set1 = sets:del_element(L, Set0),
+ {ok, L, {Queue1, Set1}};
+ empty ->
+ none
+ end.
+
+get_deps(L, Dep) ->
+ case dict:find(L, Dep) of
+ {ok, Ls} -> Ls;
+ error -> []
+ end.
+
+%% Type information for built-in functions. We do not check that the
+%% arguments have the correct type; if the call would actually fail,
+%% rather than return a value, this is a safe overapproximation.
+
+primop_type(match_fail, 1, _) -> t_none();
+primop_type(_, _, Xs) -> strict(Xs, t_any()).
+
+call_type(M, F, A, Xs) ->
+ erl_bif_types:type(M, F, A, Xs).
+
+guard_filters(T, Env) ->
+ guard_filters(T, Env, dict:new()).
+
+guard_filters(T, Env, Vars) ->
+ case type(T) of
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ case is_c_atom(M) andalso is_c_atom(F) of
+ true ->
+ As = call_args(T),
+ case {atom_val(M), atom_val(F), length(As)} of
+ {erlang, 'and', 2} ->
+ [A1, A2] = As,
+ guard_filters(A1, guard_filters(A2, Env));
+ {erlang, is_atom, 1} ->
+ filter(As, t_atom(), Env);
+ {erlang, is_binary, 1} ->
+ filter(As, t_binary(), Env);
+ {erlang, is_float, 1} ->
+ filter(As, t_float(), Env);
+ {erlang, is_function, 1} ->
+ filter(As, t_fun(), Env);
+ {erlang, is_integer, 1} ->
+ filter(As, t_integer(), Env);
+ {erlang, is_list, 1} ->
+ filter(As, t_maybe_improper_list(), Env);
+ {erlang, is_number, 1} ->
+ filter(As, t_number(), Env);
+ {erlang, is_pid, 1} ->
+ filter(As, t_pid(), Env);
+ {erlang, is_port, 1} ->
+ filter(As, t_port(), Env);
+ {erlang, is_reference, 1} ->
+ filter(As, t_reference(), Env);
+ {erlang, is_tuple, 1} ->
+ filter(As, t_tuple(), Env);
+ _ ->
+ Env
+ end;
+ false ->
+ Env
+ end;
+ var ->
+ case dict:find(var_name(T), Vars) of
+ {ok, T1} ->
+ guard_filters(T1, Env, Vars);
+ error ->
+ Env
+ end;
+ 'let' ->
+ case let_vars(T) of
+ [V] ->
+ guard_filters(let_body(T), Env,
+ dict:store(var_name(V), let_arg(T),
+ Vars));
+ _ ->
+ Env
+ end;
+ values ->
+ case values_es(T) of
+ [T1] ->
+ guard_filters(T1, Env, Vars);
+ _ ->
+ Env
+ end;
+ _ ->
+ Env
+ end.
+
+filter(As, X, Env) ->
+ [A] = As,
+ case type(A) of
+ var ->
+ V = var_name(A),
+ case dict:find(V, Env) of
+ {ok, X1} ->
+ dict:store(V, meet(X, X1), Env);
+ error ->
+ dict:store(V, X, Env)
+ end;
+ _ ->
+ Env
+ end.
+
+%% Callback hook for cerl_prettypr:
+
+-spec pp_hook() -> fun((cerl:cerl(), _, fun((_,_) -> any())) -> any()).
+
+pp_hook() ->
+ fun pp_hook/3.
+
+pp_hook(Node, Ctxt, Cont) ->
+ As = cerl:get_ann(Node),
+ As1 = proplists:delete(type, proplists:delete(label, As)),
+ As2 = proplists:delete(typesig, proplists:delete(file, As1)),
+ D = Cont(cerl:set_ann(Node, []), Ctxt),
+ T = case proplists:lookup(type, As) of
+ {type, T0} -> T0;
+ none ->
+ case proplists:lookup(typesig, As) of
+ {typesig, T0} -> T0;
+ none -> t_any()
+ end
+ end,
+ D1 = case erl_types:t_is_any(T) of
+ true ->
+ D;
+ false ->
+ case cerl:is_literal(Node) of
+ true ->
+ D;
+ false ->
+ S = erl_types:t_to_string(T),
+ Q = prettypr:beside(prettypr:text("::"),
+ prettypr:text(S)),
+ prettypr:beside(D, Q)
+ end
+ end,
+ cerl_prettypr:annotate(D1, As2, Ctxt).
+
+%% =====================================================================
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
new file mode 100644
index 0000000000..0f57a93a7c
--- /dev/null
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -0,0 +1,5021 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% =====================================================================
+%% Type information for Erlang Built-in functions (implemented in C)
+%%
+%% Copyright (C) 2002 Richard Carlsson
+%% Copyright (C) 2006 Richard Carlsson, Tobias Lindahl and Kostis Sagonas
+%%
+%% Author contact: richardc@it.uu.se, tobiasl@it.uu.se, kostis@it.uu.se
+%% =====================================================================
+
+-module(erl_bif_types).
+
+%-define(BITS, (hipe_rtl_arch:word_size() * 8) - ?TAG_IMMED1_SIZE).
+-define(BITS, 128). %This is only in bsl to convert answer to pos_inf/neg_inf.
+-define(TAG_IMMED1_SIZE, 4).
+
+-export([type/3, type/4, arg_types/3,
+ is_known/3, structure_inspecting_args/3, infinity_add/2]).
+
+-import(erl_types, [number_max/1,
+ number_min/1,
+ t_any/0,
+ t_arity/0,
+ t_atom/0,
+ t_atom/1,
+ t_atoms/1,
+ t_atom_vals/1,
+ t_binary/0,
+ t_bitstr/0,
+ t_boolean/0,
+ t_byte/0,
+ t_char/0,
+ t_cons/0,
+ t_cons/2,
+ t_cons_hd/1,
+ t_cons_tl/1,
+ t_constant/0,
+ t_fixnum/0,
+ t_non_neg_fixnum/0,
+ t_pos_fixnum/0,
+ t_float/0,
+ t_from_range/2,
+ t_from_term/1,
+ t_fun/0,
+ t_fun/2,
+ t_fun_args/1,
+ t_fun_range/1,
+ t_identifier/0,
+ t_inf/2,
+ t_integer/0,
+ t_integer/1,
+ t_non_neg_fixnum/0,
+ t_non_neg_integer/0,
+ t_pos_integer/0,
+ t_integers/1,
+ t_iodata/0,
+ t_iolist/0,
+ t_is_any/1,
+ t_is_atom/1,
+ t_is_binary/1,
+ t_is_bitstr/1,
+ t_is_boolean/1,
+ t_is_cons/1,
+ t_is_constant/1,
+ t_is_float/1,
+ t_is_float/1,
+ t_is_fun/1,
+ t_is_integer/1,
+ t_is_integer/1,
+ t_is_list/1,
+ t_is_nil/1,
+ t_is_none/1,
+ t_is_none_or_unit/1,
+ t_is_number/1,
+ t_is_pid/1,
+ t_is_port/1,
+ t_is_maybe_improper_list/1,
+ t_is_reference/1,
+ t_is_string/1,
+ t_is_subtype/2,
+ t_is_tuple/1,
+ t_list/0,
+ t_list/1,
+ t_list_elements/1,
+ t_list_termination/1,
+ t_mfa/0,
+ t_nil/0,
+ t_node/0,
+ t_none/0,
+ t_nonempty_list/0,
+ t_nonempty_list/1,
+ t_number/0,
+ t_number_vals/1,
+ t_pid/0,
+ t_port/0,
+ t_maybe_improper_list/0,
+ t_reference/0,
+ t_string/0,
+ t_subtract/2,
+ t_sup/1,
+ t_sup/2,
+ t_tid/0,
+ t_timeout/0,
+ t_tuple/0,
+ t_tuple/1,
+ t_tuple_args/1,
+ t_tuple_size/1,
+ t_tuple_subtypes/1
+ ]).
+
+-ifdef(DO_ERL_BIF_TYPES_TEST).
+-export([test/0]).
+-endif.
+
+%%=============================================================================
+
+-spec type(atom(), atom(), arity()) -> erl_types:erl_type().
+
+type(M, F, A) ->
+ type(M, F, A, any_list(A)).
+
+%% Arguments should be checked for undefinedness, so we do not make
+%% unnecessary overapproximations.
+
+-spec type(atom(), atom(), arity(), [erl_types:erl_type()]) -> erl_types:erl_type().
+
+%%-- code ---------------------------------------------------------------------
+type(code, add_path, 1, Xs) ->
+ strict(arg_types(code, add_path, 1), Xs,
+ fun (_) ->
+ t_sup(t_boolean(),
+ t_tuple([t_atom('error'), t_atom('bad_directory')]))
+ end);
+type(code, add_patha, 1, Xs) ->
+ type(code, add_path, 1, Xs);
+type(code, add_paths, 1, Xs) ->
+ strict(arg_types(code, add_paths, 1), Xs, fun(_) -> t_atom('ok') end);
+type(code, add_pathsa, 1, Xs) ->
+ type(code, add_paths, 1, Xs);
+type(code, add_pathsz, 1, Xs) ->
+ type(code, add_paths, 1, Xs);
+type(code, add_pathz, 1, Xs) ->
+ type(code, add_path, 1, Xs);
+type(code, all_loaded, 0, _) ->
+ t_list(t_tuple([t_atom(), t_code_loaded_fname_or_status()]));
+type(code, compiler_dir, 0, _) ->
+ t_string();
+type(code, del_path, 1, Xs) ->
+ strict(arg_types(code, del_path, 1), Xs,
+ fun (_) ->
+ t_sup(t_boolean(),
+ t_tuple([t_atom('error'), t_atom('bad_name')]))
+ end);
+type(code, delete, 1, Xs) ->
+ strict(arg_types(code, delete, 1), Xs, fun (_) -> t_boolean() end);
+type(code, ensure_loaded, 1, Xs) ->
+ type(code, load_file, 1, Xs);
+type(code, get_chunk, 2, Xs) ->
+ strict(arg_types(code, get_chunk, 2), Xs,
+ fun (_) -> t_sup(t_binary(), t_atom('undefined')) end);
+type(code, get_object_code, 1, Xs) ->
+ strict(arg_types(code, get_object_code, 1), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom(), t_binary(), t_string()]),
+ t_atom('error'))
+ end);
+type(code, get_path, 0, _) ->
+ t_list(t_string());
+type(code, is_loaded, 1, Xs) ->
+ strict(arg_types(code, is_loaded, 1), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('file'), t_code_loaded_fname_or_status()]),
+ t_atom('false')])
+ end);
+type(code, is_sticky, 1, Xs) ->
+ strict(arg_types(code, is_sticky, 1), Xs, fun (_) -> t_boolean() end);
+type(code, is_module_native, 1, Xs) ->
+ strict(arg_types(code, is_module_native, 1), Xs,
+ fun (_) -> t_sup(t_boolean(), t_atom('undefined')) end);
+type(code, lib_dir, 0, _) ->
+ t_string();
+type(code, lib_dir, 1, Xs) ->
+ strict(arg_types(code, lib_dir, 1), Xs,
+ fun (_) ->
+ t_sup(t_string(),
+ t_tuple([t_atom('error'), t_atom('bad_name')]))
+ end);
+type(code, load_abs, 1, Xs) ->
+ strict(arg_types(code, load_abs, 1), Xs,
+ fun ([_File]) -> t_code_load_return(t_atom()) end); % XXX: cheating
+type(code, load_abs, 2, Xs) ->
+ strict(arg_types(code, load_abs, 2), Xs,
+ fun ([_File,Mod]) -> t_code_load_return(Mod) end);
+type(code, load_binary, 3, Xs) ->
+ strict(arg_types(code, load_binary, 3), Xs,
+ fun ([Mod,_File,_Bin]) -> t_code_load_return(Mod) end);
+type(code, load_file, 1, Xs) ->
+ strict(arg_types(code, load_file, 1), Xs,
+ fun ([Mod]) -> t_code_load_return(Mod) end);
+type(code, load_native_partial, 2, Xs) ->
+ strict(arg_types(code, load_native_partial, 2), Xs,
+ fun ([Mod,_Bin]) -> t_code_load_return(Mod) end);
+type(code, load_native_sticky, 3, Xs) ->
+ strict(arg_types(code, load_native_sticky, 3), Xs,
+ fun ([Mod,_Bin,_]) -> t_code_load_return(Mod) end);
+type(code, module_md5, 1, Xs) ->
+ strict(arg_types(code, module_md5, 1), Xs,
+ fun (_) -> t_sup(t_binary(), t_atom('undefined')) end);
+type(code, make_stub_module, 3, Xs) ->
+ strict(arg_types(code, make_stub_module, 3), Xs, fun ([Mod,_,_]) -> Mod end);
+type(code, priv_dir, 1, Xs) ->
+ strict(arg_types(code, priv_dir, 1), Xs,
+ fun (_) ->
+ t_sup(t_string(), t_tuple([t_atom('error'), t_atom('bad_name')]))
+ end);
+type(code, purge, 1, Xs) ->
+ type(code, delete, 1, Xs);
+type(code, rehash, 0, _) -> t_atom('ok');
+type(code, replace_path, 2, Xs) ->
+ strict(arg_types(code, replace_path, 2), Xs,
+ fun (_) ->
+ t_sup([t_atom('true'),
+ t_tuple([t_atom('error'), t_atom('bad_name')]),
+ t_tuple([t_atom('error'), t_atom('bad_directory')]),
+ t_tuple([t_atom('error'),
+ t_tuple([t_atom('badarg'), t_any()])])])
+ end);
+type(code, root_dir, 0, _) ->
+ t_string();
+type(code, set_path, 1, Xs) ->
+ strict(arg_types(code, set_path, 1), Xs,
+ fun (_) ->
+ t_sup([t_atom('true'),
+ t_tuple([t_atom('error'), t_atom('bad_path')]),
+ t_tuple([t_atom('error'), t_atom('bad_directory')])])
+ end);
+type(code, soft_purge, 1, Xs) ->
+ type(code, delete, 1, Xs);
+type(code, stick_mod, 1, Xs) ->
+ strict(arg_types(code, stick_mod, 1), Xs, fun (_) -> t_atom('true') end);
+type(code, unstick_mod, 1, Xs) ->
+ type(code, stick_mod, 1, Xs);
+type(code, which, 1, Xs) ->
+ strict(arg_types(code, which, 1), Xs,
+ fun (_) ->
+ t_sup([t_code_loaded_fname_or_status(),
+ t_atom('non_existing')])
+ end);
+%%-- erl_ddll -----------------------------------------------------------------
+type(erl_ddll, demonitor, 1, Xs) ->
+ type(erlang, demonitor, 1, Xs);
+type(erl_ddll, format_error_int, 1, Xs) ->
+ strict(arg_types(erl_ddll, format_error_int, 1), Xs,
+ fun (_) -> t_string() end);
+type(erl_ddll, info, 2, Xs) ->
+ strict(arg_types(erl_ddll, info, 2), Xs, fun (_) -> t_atom() end);
+type(erl_ddll, loaded_drivers, 0, _) ->
+ t_tuple([t_atom('ok'), t_list(t_string())]);
+type(erl_ddll, monitor, 2, Xs) -> % return type is the same, though args are not
+ type(erlang, monitor, 2, Xs);
+type(erl_ddll, try_load, 3, Xs) ->
+ strict(arg_types(erl_ddll, try_load, 3), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('ok'), t_atom('already_loaded')]),
+ t_tuple([t_atom('ok'), t_atom('loaded')]),
+ t_tuple([t_atom('ok'),
+ t_atom('pending_driver'), t_reference()]),
+ t_tuple([t_atom('error'), t_atom('inconsistent')]),
+ t_tuple([t_atom('error'), t_atom('permanent')])])
+ end);
+type(erl_ddll, try_unload, 2, Xs) ->
+ strict(arg_types(erl_ddll, try_unload, 2), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('ok'), t_atom('pending_process')]),
+ t_tuple([t_atom('ok'), t_atom('unloaded')]),
+ t_tuple([t_atom('ok'), t_atom('pending_driver')]),
+ t_tuple([t_atom('ok'),
+ t_atom('pending_driver'), t_reference()]),
+ t_tuple([t_atom('error'), t_atom('permanent')]),
+ t_tuple([t_atom('error'), t_atom('not_loaded')]),
+ t_tuple([t_atom('error'),
+ t_atom('not_loaded_by_this_process')])])
+ end);
+%%-- erlang -------------------------------------------------------------------
+type(erlang, halt, 0, _) -> t_none();
+type(erlang, halt, 1, _) -> t_none();
+type(erlang, exit, 1, _) -> t_none();
+%% Note that exit/2 sends an exit signal to another process.
+type(erlang, exit, 2, _) -> t_atom('true');
+type(erlang, error, 1, _) -> t_none();
+type(erlang, error, 2, _) -> t_none();
+type(erlang, throw, 1, _) -> t_none();
+type(erlang, hibernate, 3, _) -> t_none();
+type(erlang, '==', 2, Xs = [X1, X2]) ->
+ case t_is_atom(X1) andalso t_is_atom(X2) of
+ true -> type(erlang, '=:=', 2, Xs);
+ false ->
+ case t_is_integer(X1) andalso t_is_integer(X2) of
+ true -> type(erlang, '=:=', 2, Xs);
+ false -> strict(Xs, t_boolean())
+ end
+ end;
+type(erlang, '/=', 2, Xs = [X1, X2]) ->
+ case t_is_atom(X1) andalso t_is_atom(X2) of
+ true -> type(erlang, '=/=', 2, Xs);
+ false ->
+ case t_is_integer(X1) andalso t_is_integer(X2) of
+ true -> type(erlang, '=/=', 2, Xs);
+ false -> strict(Xs, t_boolean())
+ end
+ end;
+type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) ->
+ Ans =
+ case t_is_none(t_inf(Lhs, Rhs)) of
+ true -> t_atom('false');
+ false ->
+ case t_is_atom(Lhs) andalso t_is_atom(Rhs) of
+ true ->
+ case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of
+ {unknown, _} -> t_boolean();
+ {_, unknown} -> t_boolean();
+ {[X], [X]} -> t_atom('true');
+ {LhsVals, RhsVals} ->
+ case lists:all(fun({X, Y}) -> X =/= Y end,
+ [{X, Y} || X <- LhsVals, Y <- RhsVals]) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end;
+ false ->
+ case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+ false -> t_boolean();
+ true ->
+ case {t_number_vals(Lhs), t_number_vals(Rhs)} of
+ {[X], [X]} when is_integer(X) -> t_atom('true');
+ _ ->
+ LhsMax = number_max(Lhs),
+ LhsMin = number_min(Lhs),
+ RhsMax = number_max(Rhs),
+ RhsMin = number_min(Rhs),
+ Ans1 = (is_integer(LhsMin)
+ andalso is_integer(RhsMax)
+ andalso (LhsMin > RhsMax)),
+ Ans2 = (is_integer(LhsMax)
+ andalso is_integer(RhsMin)
+ andalso (RhsMin > LhsMax)),
+ case Ans1 orelse Ans2 of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end
+ end
+ end
+ end,
+ strict(Xs, Ans);
+type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) ->
+ Ans =
+ case t_is_none(t_inf(Lhs, Rhs)) of
+ true -> t_atom('true');
+ false ->
+ case t_is_atom(Lhs) andalso t_is_atom(Rhs) of
+ true ->
+ case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of
+ {unknown, _} -> t_boolean();
+ {_, unknown} -> t_boolean();
+ {[Val], [Val]} -> t_atom('false');
+ {LhsVals, RhsVals} ->
+ t_sup([t_from_term(X =/= Y) || X <- LhsVals, Y <- RhsVals])
+ end;
+ false ->
+ case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+ false -> t_boolean();
+ true ->
+ LhsMax = number_max(Lhs),
+ LhsMin = number_min(Lhs),
+ RhsMax = number_max(Rhs),
+ RhsMin = number_min(Rhs),
+ Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax)
+ andalso (LhsMin > RhsMax)),
+ Ans2 = (is_integer(LhsMax) andalso is_integer(RhsMin)
+ andalso (RhsMin > LhsMax)),
+ case Ans1 orelse Ans2 of
+ true -> t_atom('true');
+ false ->
+ if LhsMax =:= LhsMin,
+ RhsMin =:= RhsMax,
+ RhsMax =:= LhsMax -> t_atom('false');
+ true -> t_boolean()
+ end
+ end
+ end
+ end
+ end,
+ strict(Xs, Ans);
+type(erlang, '>', 2, Xs = [Lhs, Rhs]) ->
+ Ans =
+ case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+ true ->
+ LhsMax = number_max(Lhs),
+ LhsMin = number_min(Lhs),
+ RhsMax = number_max(Rhs),
+ RhsMin = number_min(Rhs),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMin), is_integer(RhsMax), LhsMin > RhsMax -> T;
+ is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F;
+ true -> t_boolean()
+ end;
+ false -> t_boolean()
+ end,
+ strict(Xs, Ans);
+type(erlang, '>=', 2, Xs = [Lhs, Rhs]) ->
+ Ans =
+ case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+ true ->
+ LhsMax = number_max(Lhs),
+ LhsMin = number_min(Lhs),
+ RhsMax = number_max(Rhs),
+ RhsMin = number_min(Rhs),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMin), is_integer(RhsMax), LhsMin >= RhsMax -> T;
+ is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F;
+ true -> t_boolean()
+ end;
+ false -> t_boolean()
+ end,
+ strict(Xs, Ans);
+type(erlang, '<', 2, Xs = [Lhs, Rhs]) ->
+ Ans =
+ case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+ true ->
+ LhsMax = number_max(Lhs),
+ LhsMin = number_min(Lhs),
+ RhsMax = number_max(Rhs),
+ RhsMin = number_min(Rhs),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMax), is_integer(RhsMin), LhsMax < RhsMin -> T;
+ is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F;
+ true -> t_boolean()
+ end;
+ false -> t_boolean()
+ end,
+ strict(Xs, Ans);
+type(erlang, '=<', 2, Xs = [Lhs, Rhs]) ->
+ Ans =
+ case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+ true ->
+ LhsMax = number_max(Lhs),
+ LhsMin = number_min(Lhs),
+ RhsMax = number_max(Rhs),
+ RhsMin = number_min(Rhs),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMax), is_integer(RhsMin), LhsMax =< RhsMin -> T;
+ is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F;
+ true -> t_boolean()
+ end;
+ false -> t_boolean()
+ end,
+ strict(Xs, Ans);
+type(erlang, '+', 1, Xs) ->
+ strict(arg_types(erlang, '+', 1), Xs,
+ fun ([X]) -> X end);
+type(erlang, '-', 1, Xs) ->
+ strict(arg_types(erlang, '-', 1), Xs,
+ fun ([X]) ->
+ case t_is_integer(X) of
+ true -> type(erlang, '-', 2, [t_integer(0), X]);
+ false -> X
+ end
+ end);
+type(erlang, '!', 2, Xs) ->
+ strict(arg_types(erlang, '!', 2), Xs, fun ([_, X2]) -> X2 end);
+type(erlang, '+', 2, Xs) ->
+ strict(arg_types(erlang, '+', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('+', X1, X2) of
+ {ok, T} -> T;
+ error ->
+ case t_is_float(X1) orelse t_is_float(X2) of
+ true -> t_float();
+ false -> t_number()
+ end
+ end
+ end);
+type(erlang, '-', 2, Xs) ->
+ strict(arg_types(erlang, '-', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('-', X1, X2) of
+ {ok, T} -> T;
+ error ->
+ case t_is_float(X1) orelse t_is_float(X2) of
+ true -> t_float();
+ false -> t_number()
+ end
+ end
+ end);
+type(erlang, '*', 2, Xs) ->
+ strict(arg_types(erlang, '*', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('*', X1, X2) of
+ {ok, T} -> T;
+ error ->
+ case t_is_float(X1) orelse t_is_float(X2) of
+ true -> t_float();
+ false -> t_number()
+ end
+ end
+ end);
+type(erlang, '/', 2, Xs) ->
+ strict(arg_types(erlang, '/', 2), Xs,
+ fun (_) -> t_float() end);
+type(erlang, 'div', 2, Xs) ->
+ strict(arg_types(erlang, 'div', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('div', X1, X2) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+type(erlang, 'rem', 2, Xs) ->
+ strict(arg_types(erlang, 'rem', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('rem', X1, X2) of
+ error -> t_non_neg_integer();
+ {ok, T} -> T
+ end
+ end);
+type(erlang, '++', 2, Xs) ->
+ strict(arg_types(erlang, '++', 2), Xs,
+ fun ([X1, X2]) ->
+ case t_is_nil(X1) of
+ true -> X2; % even if X2 is not a list
+ false ->
+ case t_is_nil(X2) of
+ true -> X1;
+ false ->
+ E1 = t_list_elements(X1),
+ case t_is_cons(X1) of
+ true -> t_cons(E1, X2);
+ false ->
+ t_sup(X2, t_cons(E1, X2))
+ end
+ end
+ end
+ end);
+type(erlang, '--', 2, Xs) ->
+ %% We don't know which elements (if any) in X2 will be found and
+ %% removed from X1, even if they would have the same type. Thus, we
+ %% must assume that X1 can remain unchanged. However, if we succeed,
+ %% we know that X1 must be a proper list, but the result could
+ %% possibly be empty even if X1 is nonempty.
+ strict(arg_types(erlang, '--', 2), Xs,
+ fun ([X1, X2]) ->
+ case t_is_nil(X1) of
+ true -> t_nil();
+ false ->
+ case t_is_nil(X2) of
+ true -> X1;
+ false -> t_list(t_list_elements(X1))
+ end
+ end
+ end);
+type(erlang, 'and', 2, Xs) ->
+ strict(arg_types(erlang, 'and', 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'or', 2, Xs) ->
+ strict(arg_types(erlang, 'or', 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'xor', 2, Xs) ->
+ strict(arg_types(erlang, 'xor', 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'not', 1, Xs) ->
+ strict(arg_types(erlang, 'not', 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'band', 2, Xs) ->
+ strict(arg_types(erlang, 'band', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('band', X1, X2) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+%% The result is not wider than the smallest argument. We need to
+%% kill any value-sets in the result.
+%% strict(arg_types(erlang, 'band', 2), Xs,
+%% fun ([X1, X2]) -> t_sup(t_inf(X1, X2), t_byte()) end);
+type(erlang, 'bor', 2, Xs) ->
+ strict(arg_types(erlang, 'bor', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('bor', X1, X2) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+%% The result is not wider than the largest argument. We need to
+%% kill any value-sets in the result.
+%% strict(arg_types(erlang, 'bor', 2), Xs,
+%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end);
+type(erlang, 'bxor', 2, Xs) ->
+ strict(arg_types(erlang, 'bxor', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('bxor', X1, X2) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+%% The result is not wider than the largest argument. We need to
+%% kill any value-sets in the result.
+%% strict(arg_types(erlang, 'bxor', 2), Xs,
+%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end);
+type(erlang, 'bsr', 2, Xs) ->
+ strict(arg_types(erlang, 'bsr', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('bsr', X1, X2) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+%% If the first argument is unsigned (which is the case for
+%% characters and bytes), the result is never wider. We need to kill
+%% any value-sets in the result.
+%% strict(arg_types(erlang, 'bsr', 2), Xs,
+%% fun ([X, _]) -> t_sup(X, t_byte()) end);
+type(erlang, 'bsl', 2, Xs) ->
+ strict(arg_types(erlang, 'bsl', 2), Xs,
+ fun ([X1, X2]) ->
+ case arith('bsl', X1, X2) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+%% Not worth doing anything special here.
+%% strict(arg_types(erlang, 'bsl', 2), Xs, fun (_) -> t_integer() end);
+type(erlang, 'bnot', 1, Xs) ->
+ strict(arg_types(erlang, 'bnot', 1), Xs,
+ fun ([X1]) ->
+ case arith('bnot', X1) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end);
+%% This returns (-X)-1, so it often gives a negative result.
+%% strict(arg_types(erlang, 'bnot', 1), Xs, fun (_) -> t_integer() end);
+type(erlang, abs, 1, Xs) ->
+ strict(arg_types(erlang, abs, 1), Xs, fun ([X]) -> X end);
+type(erlang, append_element, 2, Xs) ->
+ strict(arg_types(erlang, append_element, 2), Xs, fun (_) -> t_tuple() end);
+type(erlang, apply, 2, Xs) ->
+ Fun = fun ([X, _Y]) ->
+ case t_is_fun(X) of
+ true ->
+ t_fun_range(X);
+ false ->
+ t_any()
+ end
+ end,
+ strict(arg_types(erlang, apply, 2), Xs, Fun);
+type(erlang, apply, 3, Xs) ->
+ strict(arg_types(erlang, apply, 3), Xs, fun (_) -> t_any() end);
+type(erlang, atom_to_binary, 2, Xs) ->
+ strict(arg_types(erlang, atom_to_binary, 2), Xs, fun (_) -> t_binary() end);
+type(erlang, atom_to_list, 1, Xs) ->
+ strict(arg_types(erlang, atom_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, binary_to_atom, 2, Xs) ->
+ strict(arg_types(erlang, binary_to_atom, 2), Xs, fun (_) -> t_atom() end);
+type(erlang, binary_to_existing_atom, 2, Xs) ->
+ type(erlang, binary_to_atom, 2, Xs);
+type(erlang, binary_to_list, 1, Xs) ->
+ strict(arg_types(erlang, binary_to_list, 1), Xs,
+ fun (_) -> t_list(t_byte()) end);
+type(erlang, binary_to_list, 3, Xs) ->
+ strict(arg_types(erlang, binary_to_list, 3), Xs,
+ fun (_) -> t_list(t_byte()) end);
+type(erlang, binary_to_term, 1, Xs) ->
+ strict(arg_types(erlang, binary_to_term, 1), Xs, fun (_) -> t_any() end);
+type(erlang, bitsize, 1, Xs) -> % XXX: TAKE OUT
+ type(erlang, bit_size, 1, Xs);
+type(erlang, bit_size, 1, Xs) ->
+ strict(arg_types(erlang, bit_size, 1), Xs,
+ fun (_) -> t_non_neg_integer() end);
+type(erlang, bitstr_to_list, 1, Xs) -> % XXX: TAKE OUT
+ type(erlang, bitstring_to_list, 1, Xs);
+type(erlang, bitstring_to_list, 1, Xs) ->
+ strict(arg_types(erlang, bitstring_to_list, 1), Xs,
+ fun (_) -> t_list(t_sup(t_byte(), t_bitstr())) end);
+type(erlang, bump_reductions, 1, Xs) ->
+ strict(arg_types(erlang, bump_reductions, 1), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, byte_size, 1, Xs) ->
+ strict(arg_types(erlang, byte_size, 1), Xs,
+ fun (_) -> t_non_neg_integer() end);
+type(erlang, cancel_timer, 1, Xs) ->
+ strict(arg_types(erlang, cancel_timer, 1), Xs,
+ fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(erlang, check_process_code, 2, Xs) ->
+ strict(arg_types(erlang, check_process_code, 2), Xs,
+ fun (_) -> t_boolean() end);
+type(erlang, concat_binary, 1, Xs) ->
+ strict(arg_types(erlang, concat_binary, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, crc32, 1, Xs) ->
+ strict(arg_types(erlang, crc32, 1), Xs, fun (_) -> t_integer() end);
+type(erlang, crc32, 2, Xs) ->
+ strict(arg_types(erlang, crc32, 2), Xs, fun (_) -> t_integer() end);
+type(erlang, crc32_combine, 3, Xs) ->
+ strict(arg_types(erlang, crc32_combine, 3), Xs, fun (_) -> t_integer() end);
+type(erlang, date, 0, _) ->
+ t_date();
+type(erlang, decode_packet, 3, Xs) ->
+ strict(arg_types(erlang, decode_packet, 3), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('ok'), t_packet(), t_binary()]),
+ t_tuple([t_atom('more'), t_sup([t_non_neg_integer(),
+ t_atom('undefined')])]),
+ t_tuple([t_atom('error'), t_any()])])
+ end);
+type(erlang, delete_module, 1, Xs) ->
+ strict(arg_types(erlang, delete_module, 1), Xs,
+ fun (_) -> t_sup(t_atom('true'), t_atom('undefined')) end);
+type(erlang, demonitor, 1, Xs) ->
+ strict(arg_types(erlang, demonitor, 1), Xs, fun (_) -> t_atom('true') end);
+%% TODO: overapproximation -- boolean only if 'info' is part of arg2 otherwise 'true'
+type(erlang, demonitor, 2, Xs) ->
+ strict(arg_types(erlang, demonitor, 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, disconnect_node, 1, Xs) ->
+ strict(arg_types(erlang, disconnect_node, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, display, 1, _) -> t_atom('true');
+type(erlang, dist_exit, 3, Xs) ->
+ strict(arg_types(erlang, dist_exit, 3), Xs, fun (_) -> t_atom('true') end);
+type(erlang, element, 2, Xs) ->
+ strict(arg_types(erlang, element, 2), Xs,
+ fun ([X1, X2]) ->
+ case t_tuple_subtypes(X2) of
+ unknown -> t_any();
+ [_] ->
+ Sz = t_tuple_size(X2),
+ As = t_tuple_args(X2),
+ case t_number_vals(X1) of
+ unknown -> t_sup(As);
+ Ns when is_list(Ns) ->
+ Fun = fun
+ (N, X) when is_integer(N), 1 =< N, N =< Sz ->
+ t_sup(X, lists:nth(N, As));
+ (_, X) ->
+ X
+ end,
+ lists:foldl(Fun, t_none(), Ns)
+ end;
+ Ts when is_list(Ts) ->
+ t_sup([type(erlang, element, 2, [X1, Y]) || Y <- Ts])
+ end
+ end);
+type(erlang, erase, 0, _) -> t_any();
+type(erlang, erase, 1, _) -> t_any();
+type(erlang, external_size, 1, _) -> t_integer();
+type(erlang, float, 1, Xs) ->
+ strict(arg_types(erlang, float, 1), Xs, fun (_) -> t_float() end);
+type(erlang, float_to_list, 1, Xs) ->
+ strict(arg_types(erlang, float_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, function_exported, 3, Xs) ->
+ strict(arg_types(erlang, function_exported, 3), Xs,
+ fun (_) -> t_boolean() end);
+type(erlang, fun_info, 1, Xs) ->
+ strict(arg_types(erlang, fun_info, 1), Xs,
+ fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end);
+type(erlang, fun_info, 2, Xs) ->
+ strict(arg_types(erlang, fun_info, 2), Xs,
+ fun (_) -> t_tuple([t_atom(), t_any()]) end);
+type(erlang, fun_to_list, 1, Xs) ->
+ strict(arg_types(erlang, fun_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, garbage_collect, 0, _) -> t_atom('true');
+type(erlang, garbage_collect, 1, Xs) ->
+ strict(arg_types(erlang, garbage_collect, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, get, 0, _) -> t_list(t_tuple(2));
+type(erlang, get, 1, _) -> t_any(); % | t_atom('undefined')
+type(erlang, get_cookie, 0, _) -> t_atom(); % | t_atom('nocookie')
+type(erlang, get_keys, 1, _) -> t_list();
+type(erlang, get_module_info, 1, Xs) ->
+ strict(arg_types(erlang, get_module_info, 1), Xs,
+ fun (_) ->
+ t_list(t_tuple([t_atom(), t_list(t_tuple([t_atom(), t_any()]))]))
+ end);
+type(erlang, get_module_info, 2, Xs) ->
+ T_module_info_2_returns =
+ t_sup([t_atom(),
+ t_list(t_tuple([t_atom(), t_any()])),
+ t_list(t_tuple([t_atom(), t_arity(), t_integer()]))]),
+ strict(arg_types(erlang, get_module_info, 2), Xs,
+ fun ([Module, Item]) ->
+ case t_is_atom(Item) of
+ true ->
+ case t_atom_vals(Item) of
+ ['module'] -> t_inf(t_atom(), Module);
+ ['imports'] -> t_nil();
+ ['exports'] -> t_list(t_tuple([t_atom(), t_arity()]));
+ ['functions'] -> t_list(t_tuple([t_atom(), t_arity()]));
+ ['attributes'] -> t_list(t_tuple([t_atom(), t_any()]));
+ ['compile'] -> t_list(t_tuple([t_atom(), t_any()]));
+ ['native_addresses'] -> % [{FunName, Arity, Address}]
+ t_list(t_tuple([t_atom(), t_arity(), t_integer()]));
+ List when is_list(List) ->
+ T_module_info_2_returns;
+ unknown ->
+ T_module_info_2_returns
+ end;
+ false ->
+ T_module_info_2_returns
+ end
+ end);
+type(erlang, get_stacktrace, 0, _) ->
+ t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()])]));
+type(erlang, group_leader, 0, _) -> t_pid();
+type(erlang, group_leader, 2, Xs) ->
+ strict(arg_types(erlang, group_leader, 2), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, hash, 2, Xs) ->
+ strict(arg_types(erlang, hash, 2), Xs, fun (_) -> t_integer() end);
+type(erlang, hd, 1, Xs) ->
+ strict(arg_types(erlang, hd, 1), Xs, fun ([X]) -> t_cons_hd(X) end);
+type(erlang, integer_to_list, 1, Xs) ->
+ strict(arg_types(erlang, integer_to_list, 1), Xs,
+ fun (_) -> t_string() end);
+type(erlang, info, 1, Xs) -> type(erlang, system_info, 1, Xs); % alias
+type(erlang, iolist_size, 1, Xs) ->
+ strict(arg_types(erlang, iolist_size, 1), Xs,
+ fun (_) -> t_non_neg_integer() end);
+type(erlang, iolist_to_binary, 1, Xs) ->
+ strict(arg_types(erlang, iolist_to_binary, 1), Xs,
+ fun (_) -> t_binary() end);
+type(erlang, is_alive, 0, _) -> t_boolean();
+type(erlang, is_atom, 1, Xs) ->
+ Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_atom(Y) end, t_atom()) end,
+ strict(arg_types(erlang, is_atom, 1), Xs, Fun);
+type(erlang, is_binary, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_binary(Y) end, t_binary())
+ end,
+ strict(arg_types(erlang, is_binary, 1), Xs, Fun);
+type(erlang, is_bitstr, 1, Xs) -> % XXX: TAKE OUT
+ type(erlang, is_bitstring, 1, Xs);
+type(erlang, is_bitstring, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_bitstr(Y) end, t_bitstr())
+ end,
+ strict(arg_types(erlang, is_bitstring, 1), Xs, Fun);
+type(erlang, is_boolean, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_boolean(Y) end, t_boolean())
+ end,
+ strict(arg_types(erlang, is_boolean, 1), Xs, Fun);
+type(erlang, is_builtin, 3, Xs) ->
+ strict(arg_types(erlang, is_builtin, 3), Xs, fun (_) -> t_boolean() end);
+type(erlang, is_constant, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_constant(Y) end, t_constant())
+ end,
+ strict(arg_types(erlang, is_constant, 1), Xs, Fun);
+type(erlang, is_float, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_float(Y) end, t_float())
+ end,
+ strict(arg_types(erlang, is_float, 1), Xs, Fun);
+type(erlang, is_function, 1, Xs) ->
+ Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_fun(Y) end, t_fun()) end,
+ strict(arg_types(erlang, is_function, 1), Xs, Fun);
+type(erlang, is_function, 2, Xs) ->
+ Fun = fun ([FunType, ArityType]) ->
+ case t_number_vals(ArityType) of
+ unknown -> t_boolean();
+ [Val] ->
+ FunConstr = t_fun(any_list(Val), t_any()),
+ Fun2 = fun (X) ->
+ t_is_subtype(X, FunConstr) andalso (not t_is_none(X))
+ end,
+ check_guard_single(FunType, Fun2, FunConstr);
+ IntList when is_list(IntList) -> t_boolean() %% true?
+ end
+ end,
+ strict(arg_types(erlang, is_function, 2), Xs, Fun);
+type(erlang, is_integer, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_integer(Y) end, t_integer())
+ end,
+ strict(arg_types(erlang, is_integer, 1), Xs, Fun);
+type(erlang, is_list, 1, Xs) ->
+ Fun = fun (X) ->
+ Fun2 = fun (Y) -> t_is_maybe_improper_list(Y) end,
+ check_guard(X, Fun2, t_maybe_improper_list())
+ end,
+ strict(arg_types(erlang, is_list, 1), Xs, Fun);
+type(erlang, is_number, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_number(Y) end, t_number())
+ end,
+ strict(arg_types(erlang, is_number, 1), Xs, Fun);
+type(erlang, is_pid, 1, Xs) ->
+ Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_pid(Y) end, t_pid()) end,
+ strict(arg_types(erlang, is_pid, 1), Xs, Fun);
+type(erlang, is_port, 1, Xs) ->
+ Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_port(Y) end, t_port()) end,
+ strict(arg_types(erlang, is_port, 1), Xs, Fun);
+type(erlang, is_process_alive, 1, Xs) ->
+ strict(arg_types(erlang, is_process_alive, 1), Xs,
+ fun (_) -> t_boolean() end);
+type(erlang, is_record, 2, Xs) ->
+ Fun = fun ([X, Y]) ->
+ case t_is_tuple(X) of
+ false ->
+ case t_is_none(t_inf(t_tuple(), X)) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end;
+ true ->
+ case t_tuple_subtypes(X) of
+ unknown -> t_boolean();
+ [Tuple] ->
+ case t_tuple_args(Tuple) of
+ %% any -> t_boolean();
+ [Tag|_] ->
+ case t_is_atom(Tag) of
+ false ->
+ TagAtom = t_inf(Tag, t_atom()),
+ case t_is_none(TagAtom) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end;
+ true ->
+ case t_atom_vals(Tag) of
+ [RealTag] ->
+ case t_atom_vals(Y) of
+ [RealTag] -> t_atom('true');
+ _ -> t_boolean()
+ end;
+ _ -> t_boolean()
+ end
+ end
+ end;
+ List when length(List) >= 2 ->
+ t_sup([type(erlang, is_record, 2, [T, Y]) || T <- List])
+ end
+ end
+ end,
+ strict(arg_types(erlang, is_record, 2), Xs, Fun);
+type(erlang, is_record, 3, Xs) ->
+ Fun = fun ([X, Y, Z]) ->
+ Arity = t_number_vals(Z),
+ case t_is_tuple(X) of
+ false when length(Arity) =:= 1 ->
+ [RealArity] = Arity,
+ case t_is_none(t_inf(t_tuple(RealArity), X)) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end;
+ false ->
+ case t_is_none(t_inf(t_tuple(), X)) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end;
+ true when length(Arity) =:= 1 ->
+ [RealArity] = Arity,
+ case t_tuple_subtypes(X) of
+ unknown -> t_boolean();
+ [Tuple] ->
+ case t_tuple_args(Tuple) of
+ %% any -> t_boolean();
+ Args when length(Args) =:= RealArity ->
+ Tag = hd(Args),
+ case t_is_atom(Tag) of
+ false ->
+ TagAtom = t_inf(Tag, t_atom()),
+ case t_is_none(TagAtom) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end;
+ true ->
+ case t_atom_vals(Tag) of
+ [RealTag] ->
+ case t_atom_vals(Y) of
+ [RealTag] -> t_atom('true');
+ _ -> t_boolean()
+ end;
+ _ -> t_boolean()
+ end
+ end;
+ Args when length(Args) =/= RealArity ->
+ t_atom('false')
+ end;
+ [_, _|_] ->
+ t_boolean()
+ end;
+ true ->
+ t_boolean()
+ end
+ end,
+ strict(arg_types(erlang, is_record, 3), Xs, Fun);
+type(erlang, is_reference, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_reference(Y) end, t_reference())
+ end,
+ strict(arg_types(erlang, is_reference, 1), Xs, Fun);
+type(erlang, is_tuple, 1, Xs) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_tuple(Y) end, t_tuple())
+ end,
+ strict(arg_types(erlang, is_tuple, 1), Xs, Fun);
+type(erlang, length, 1, Xs) ->
+ strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end);
+type(erlang, link, 1, Xs) ->
+ strict(arg_types(erlang, link, 1), Xs, fun (_) -> t_atom('true') end);
+type(erlang, list_to_atom, 1, Xs) ->
+ strict(arg_types(erlang, list_to_atom, 1), Xs, fun (_) -> t_atom() end);
+type(erlang, list_to_binary, 1, Xs) ->
+ strict(arg_types(erlang, list_to_binary, 1), Xs,
+ fun (_) -> t_binary() end);
+type(erlang, list_to_bitstr, 1, Xs) ->
+ type(erlang, list_to_bitstring, 1, Xs);
+type(erlang, list_to_bitstring, 1, Xs) ->
+ strict(arg_types(erlang, list_to_bitstring, 1), Xs,
+ fun (_) -> t_bitstr() end);
+type(erlang, list_to_existing_atom, 1, Xs) ->
+ strict(arg_types(erlang, list_to_existing_atom, 1), Xs,
+ fun (_) -> t_atom() end);
+type(erlang, list_to_float, 1, Xs) ->
+ strict(arg_types(erlang, list_to_float, 1), Xs, fun (_) -> t_float() end);
+type(erlang, list_to_integer, 1, Xs) ->
+ strict(arg_types(erlang, list_to_integer, 1), Xs,
+ fun (_) -> t_integer() end);
+type(erlang, list_to_pid, 1, Xs) ->
+ strict(arg_types(erlang, list_to_pid, 1), Xs, fun (_) -> t_pid() end);
+type(erlang, list_to_tuple, 1, Xs) ->
+ strict(arg_types(erlang, list_to_tuple, 1), Xs, fun (_) -> t_tuple() end);
+type(erlang, loaded, 0, _) ->
+ t_list(t_atom());
+type(erlang, load_module, 2, Xs) ->
+ strict(arg_types(erlang, load_module, 2), Xs,
+ fun ([Mod,_Bin]) -> t_code_load_return(Mod) end);
+type(erlang, localtime, 0, Xs) ->
+ type(erlang, universaltime, 0, Xs); % same
+type(erlang, localtime_to_universaltime, 1, Xs) ->
+ type(erlang, universaltime_to_localtime, 1, Xs); % same
+type(erlang, localtime_to_universaltime, 2, Xs) ->
+ strict(arg_types(erlang, localtime_to_universaltime, 2), Xs, % typecheck
+ fun ([X,_]) -> type(erlang, localtime_to_universaltime, 1, [X]) end);
+type(erlang, make_fun, 3, Xs) ->
+ strict(arg_types(erlang, make_fun, 3), Xs,
+ fun ([_, _, Arity]) ->
+ case t_number_vals(Arity) of
+ [N] ->
+ case is_integer(N) andalso 0 =< N andalso N =< 255 of
+ true -> t_fun(N, t_any());
+ false -> t_none()
+ end;
+ _Other -> t_fun()
+ end
+ end);
+type(erlang, make_ref, 0, _) -> t_reference();
+type(erlang, make_tuple, 2, Xs) ->
+ strict(arg_types(erlang, make_tuple, 2), Xs,
+ fun ([Int, _]) ->
+ case t_number_vals(Int) of
+ [N] when is_integer(N), N >= 0 -> t_tuple(N);
+ _Other -> t_tuple()
+ end
+ end);
+type(erlang, make_tuple, 3, Xs) ->
+ strict(arg_types(erlang, make_tuple, 3), Xs,
+ fun ([Int, _, _]) ->
+ case t_number_vals(Int) of
+ [N] when is_integer(N), N >= 0 -> t_tuple(N);
+ _Other -> t_tuple()
+ end
+ end);
+type(erlang, match_spec_test, 3, Xs) ->
+ strict(arg_types(erlang, match_spec_test, 3), Xs,
+ fun (_) -> t_sup(t_tuple([t_atom('ok'),
+ t_any(), % it can be any term
+ t_list(t_atom('return_trace')),
+ t_match_spec_test_errors()]),
+ t_tuple([t_atom('error'),
+ t_match_spec_test_errors()])) end);
+type(erlang, md5, 1, Xs) ->
+ strict(arg_types(erlang, md5, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, md5_final, 1, Xs) ->
+ strict(arg_types(erlang, md5_final, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, md5_init, 0, _) -> t_binary();
+type(erlang, md5_update, 2, Xs) ->
+ strict(arg_types(erlang, md5_update, 2), Xs, fun (_) -> t_binary() end);
+type(erlang, memory, 0, _) -> t_list(t_tuple([t_atom(), t_non_neg_fixnum()]));
+type(erlang, memory, 1, Xs) ->
+ strict(arg_types(erlang, memory, 1), Xs,
+ fun ([Type]) ->
+ case t_is_atom(Type) of
+ true -> t_non_neg_fixnum();
+ false ->
+ case t_is_list(Type) of
+ true -> t_list(t_tuple([t_atom(), t_non_neg_fixnum()]));
+ false ->
+ t_sup(t_non_neg_fixnum(),
+ t_list(t_tuple([t_atom(), t_non_neg_fixnum()])))
+ end
+ end
+ end);
+type(erlang, module_loaded, 1, Xs) ->
+ strict(arg_types(erlang, module_loaded, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, monitor, 2, Xs) ->
+ strict(arg_types(erlang, monitor, 2), Xs, fun (_) -> t_reference() end);
+type(erlang, monitor_node, 2, Xs) ->
+ strict(arg_types(erlang, monitor_node, 2), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, monitor_node, 3, Xs) ->
+ strict(arg_types(erlang, monitor_node, 3), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, node, 0, _) -> t_node();
+type(erlang, node, 1, Xs) ->
+ strict(arg_types(erlang, node, 1), Xs, fun (_) -> t_node() end);
+type(erlang, nodes, 0, _) -> t_list(t_node());
+type(erlang, nodes, 1, Xs) ->
+ strict(arg_types(erlang, nodes, 1), Xs, fun (_) -> t_list(t_node()) end);
+type(erlang, now, 0, _) ->
+ t_time();
+type(erlang, open_port, 2, Xs) ->
+ strict(arg_types(erlang, open_port, 2), Xs, fun (_) -> t_port() end);
+type(erlang, phash, 2, Xs) ->
+ strict(arg_types(erlang, phash, 2), Xs, fun (_) -> t_pos_integer() end);
+type(erlang, phash2, 1, Xs) ->
+ strict(arg_types(erlang, phash2, 1), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, phash2, 2, Xs) ->
+ strict(arg_types(erlang, phash2, 2), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, pid_to_list, 1, Xs) ->
+ strict(arg_types(erlang, pid_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, port_call, 3, Xs) ->
+ strict(arg_types(erlang, port_call, 3), Xs, fun (_) -> t_any() end);
+type(erlang, port_close, 1, Xs) ->
+ strict(arg_types(erlang, port_close, 1), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, port_command, 2, Xs) ->
+ strict(arg_types(erlang, port_command, 2), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, port_command, 3, Xs) ->
+ strict(arg_types(erlang, port_command, 3), Xs,
+ fun (_) -> t_boolean() end);
+type(erlang, port_connect, 2, Xs) ->
+ strict(arg_types(erlang, port_connect, 2), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, port_control, 3, Xs) ->
+ strict(arg_types(erlang, port_control, 3), Xs,
+ fun (_) -> t_sup(t_string(), t_binary()) end);
+type(erlang, port_get_data, 1, Xs) ->
+ strict(arg_types(erlang, port_get_data, 1), Xs, fun (_) -> t_any() end);
+type(erlang, port_info, 1, Xs) ->
+ strict(arg_types(erlang, port_info, 1), Xs,
+ fun (_) -> t_sup(t_atom('undefined'), t_list()) end);
+type(erlang, port_info, 2, Xs) ->
+ strict(arg_types(erlang, port_info, 2), Xs,
+ fun ([_Port, Item]) ->
+ t_sup(t_atom('undefined'),
+ case t_atom_vals(Item) of
+ ['connected'] -> t_tuple([Item, t_pid()]);
+ ['id'] -> t_tuple([Item, t_integer()]);
+ ['input'] -> t_tuple([Item, t_integer()]);
+ ['links'] -> t_tuple([Item, t_list(t_pid())]);
+ ['name'] -> t_tuple([Item, t_string()]);
+ ['output'] -> t_tuple([Item, t_integer()]);
+ ['registered_name'] -> t_tuple([Item, t_atom()]);
+ List when is_list(List) ->
+ t_tuple([t_sup([t_atom(A) || A <- List]),
+ t_sup([t_atom(), t_integer(),
+ t_pid(), t_list(t_pid()),
+ t_string()])]);
+ unknown ->
+ [_, PosItem] = arg_types(erlang, port_info, 2),
+ t_tuple([PosItem,
+ t_sup([t_atom(), t_integer(),
+ t_pid(), t_list(t_pid()),
+ t_string()])])
+ end)
+ end);
+type(erlang, port_to_list, 1, Xs) ->
+ strict(arg_types(erlang, port_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, ports, 0, _) -> t_list(t_port());
+type(erlang, port_set_data, 2, Xs) ->
+ strict(arg_types(erlang, port_set_data, 2), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, pre_loaded, 0, _) -> t_list(t_atom());
+type(erlang, process_display, 2, _) -> t_atom('true');
+type(erlang, process_flag, 2, Xs) ->
+ T_process_flag_returns = t_sup([t_boolean(), t_atom(), t_non_neg_integer()]),
+ strict(arg_types(erlang, process_flag, 2), Xs,
+ fun ([Flag, _Option]) ->
+ case t_is_atom(Flag) of
+ true ->
+ case t_atom_vals(Flag) of
+ ['error_handler'] -> t_atom();
+ ['min_heap_size'] -> t_non_neg_integer();
+ ['monitor_nodes'] -> t_boolean();
+ ['priority'] -> t_process_priority_level();
+ ['save_calls'] -> t_non_neg_integer();
+ ['trap_exit'] -> t_boolean();
+ List when is_list(List) ->
+ T_process_flag_returns;
+ unknown ->
+ T_process_flag_returns
+ end;
+ false -> % XXX: over-approximation if Flag is tuple
+ T_process_flag_returns
+ end
+ end);
+type(erlang, process_flag, 3, Xs) ->
+ strict(arg_types(erlang, process_flag, 3), Xs,
+ fun (_) -> t_non_neg_integer() end);
+type(erlang, process_info, 1, Xs) ->
+ strict(arg_types(erlang, process_info, 1), Xs,
+ fun (_) ->
+ t_sup(t_list(t_tuple([t_pinfo(), t_any()])),
+ t_atom('undefined'))
+ end);
+type(erlang, process_info, 2, Xs) ->
+ %% we define all normal return values: the return when the process exists
+ %% t_nil() is the return for 'registered_name'; perhaps for more
+ T_process_info_2_normal_returns =
+ t_sup([t_tuple([t_pinfo_item(), t_any()]), t_nil()]),
+ strict(arg_types(erlang, process_info, 2), Xs,
+ fun ([_Pid, InfoItem]) ->
+ Ret = case t_is_atom(InfoItem) of
+ true ->
+ case t_atom_vals(InfoItem) of
+ ['backtrace'] -> t_tuple([InfoItem, t_binary()]);
+ ['current_function'] -> t_tuple([InfoItem, t_mfa()]);
+ ['dictionary'] -> t_tuple([InfoItem, t_list()]);
+ ['error_handler'] -> t_tuple([InfoItem, t_atom()]);
+ ['garbage_collection'] ->
+ t_tuple([InfoItem, t_list()]);
+ ['group_leader'] -> t_tuple([InfoItem, t_pid()]);
+ ['heap_size'] ->
+ t_tuple([InfoItem, t_non_neg_integer()]);
+ ['initial_call'] -> t_tuple([InfoItem, t_mfa()]);
+ ['last_calls'] ->
+ t_tuple([InfoItem,
+ t_sup(t_atom('false'), t_list())]);
+ ['links'] -> t_tuple([InfoItem, t_list(t_pid())]);
+ ['memory'] ->
+ t_tuple([InfoItem, t_non_neg_integer()]);
+ ['message_binary'] -> t_tuple([InfoItem, t_list()]);
+ ['message_queue_len'] ->
+ t_tuple([InfoItem, t_non_neg_integer()]);
+ ['messages'] -> t_tuple([InfoItem, t_list()]);
+ ['monitored_by'] ->
+ t_tuple([InfoItem, t_list(t_pid())]);
+ ['monitors'] ->
+ t_tuple([InfoItem,
+ t_list(t_sup(t_tuple([t_atom('process'),
+ t_pid()]),
+ t_tuple([t_atom('process'),
+ t_tuple([t_atom(),
+ t_atom()])])))]);
+ ['priority'] ->
+ t_tuple([InfoItem, t_process_priority_level()]);
+ ['reductions'] ->
+ t_tuple([InfoItem, t_non_neg_integer()]);
+ ['registered_name'] ->
+ t_sup(t_tuple([InfoItem, t_atom()]), t_nil());
+ ['sequential_trace_token'] ->
+ t_tuple([InfoItem, t_any()]); %% Underspecified
+ ['stack_size'] ->
+ t_tuple([InfoItem, t_non_neg_integer()]);
+ ['status'] ->
+ t_tuple([InfoItem, t_process_status()]);
+ ['suspending'] ->
+ t_tuple([InfoItem,
+ t_list(t_tuple([t_pid(),
+ t_non_neg_integer(),
+ t_non_neg_integer()]))]);
+ ['total_heap_size'] ->
+ t_tuple([InfoItem, t_non_neg_integer()]);
+ ['trap_exit'] ->
+ t_tuple([InfoItem, t_boolean()]);
+ List when is_list(List) ->
+ T_process_info_2_normal_returns;
+ unknown ->
+ T_process_info_2_normal_returns
+ end;
+ false ->
+ case t_is_list(InfoItem) of
+ true ->
+ t_list(t_tuple([t_pinfo_item(), t_any()]));
+ false ->
+ t_sup(T_process_info_2_normal_returns,
+ t_list(t_tuple([t_pinfo_item(), t_any()])))
+ end
+ end,
+ t_sup([Ret, t_atom('undefined')])
+ end);
+type(erlang, processes, 0, _) -> t_list(t_pid());
+type(erlang, purge_module, 1, Xs) ->
+ strict(arg_types(erlang, purge_module, 1), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, put, 2, Xs) ->
+ strict(arg_types(erlang, put, 2), Xs, fun (_) -> t_any() end);
+type(erlang, raise, 3, _) -> t_none();
+type(erlang, read_timer, 1, Xs) ->
+ strict(arg_types(erlang, read_timer, 1), Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(erlang, ref_to_list, 1, Xs) ->
+ strict(arg_types(erlang, ref_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, register, 2, Xs) ->
+ strict(arg_types(erlang, register, 2), Xs, fun (_) -> t_atom('true') end);
+type(erlang, registered, 0, _) -> t_list(t_atom());
+type(erlang, resume_process, 1, Xs) ->
+ strict(arg_types(erlang, resume_process, 1), Xs,
+ fun (_) -> t_any() end); %% TODO: overapproximation -- fix this
+type(erlang, round, 1, Xs) ->
+ strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end);
+type(erlang, self, 0, _) -> t_pid();
+type(erlang, send, 2, Xs) -> type(erlang, '!', 2, Xs); % alias
+type(erlang, send, 3, Xs) ->
+ strict(arg_types(erlang, send, 3), Xs,
+ fun (_) -> t_sup(t_atom('ok'), t_sendoptions()) end);
+type(erlang, send_after, 3, Xs) ->
+ strict(arg_types(erlang, send_after, 3), Xs, fun (_) -> t_reference() end);
+type(erlang, seq_trace, 2, Xs) ->
+ strict(arg_types(erlang, seq_trace, 2), Xs,
+ fun (_) -> t_sup(t_seq_trace_info_returns(), t_tuple(5)) end);
+type(erlang, seq_trace_info, 1, Xs) ->
+ strict(arg_types(erlang, seq_trace_info, 1), Xs,
+ fun ([Item]) ->
+ case t_atom_vals(Item) of
+ ['label'] ->
+ t_sup(t_tuple([Item, t_non_neg_integer()]), t_nil());
+ ['serial'] ->
+ t_sup(t_tuple([Item, t_tuple([t_non_neg_integer(),
+ t_non_neg_integer()])]),
+ t_nil());
+ ['send'] -> t_tuple([Item, t_boolean()]);
+ ['receive'] -> t_tuple([Item, t_boolean()]);
+ ['print'] -> t_tuple([Item, t_boolean()]);
+ ['timestamp'] -> t_tuple([Item, t_boolean()]);
+ List when is_list(List) ->
+ t_seq_trace_info_returns();
+ unknown ->
+ t_seq_trace_info_returns()
+ end
+ end);
+type(erlang, seq_trace_print, 1, Xs) ->
+ strict(arg_types(erlang, seq_trace_print, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, seq_trace_print, 2, Xs) ->
+ strict(arg_types(erlang, seq_trace_print, 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, set_cookie, 2, Xs) ->
+ strict(arg_types(erlang, set_cookie, 2), Xs, fun (_) -> t_atom('true') end);
+type(erlang, setelement, 3, Xs) ->
+ strict(arg_types(erlang, setelement, 3), Xs,
+ fun ([X1, X2, X3]) ->
+ case t_tuple_subtypes(X2) of
+ unknown -> t_tuple();
+ [_] ->
+ Sz = t_tuple_size(X2),
+ As = t_tuple_args(X2),
+ case t_number_vals(X1) of
+ unknown ->
+ t_tuple([t_sup(X, X3) || X <- As]);
+ [N] when is_integer(N), 1 =< N, N =< Sz ->
+ t_tuple(list_replace(N, X3, As));
+ [N] when is_integer(N), N < 1 ->
+ t_none();
+ [N] when is_integer(N), N > Sz ->
+ t_none();
+ Ns ->
+ Fun = fun (N, XL) when is_integer(N), 1 =< N, N =< Sz ->
+ X = lists:nth(N, XL),
+ Y = t_sup(X, X3),
+ list_replace(N, Y, XL);
+ (_, XL) ->
+ XL
+ end,
+ t_tuple(lists:foldl(Fun, As, Ns))
+ end;
+ Ts when is_list(Ts) ->
+ t_sup([type(erlang, setelement, 3, [X1, Y, X3]) || Y <- Ts])
+ end
+ end);
+type(erlang, setnode, 2, Xs) ->
+ strict(arg_types(erlang, setnode, 2), Xs, fun (_) -> t_atom('true') end);
+type(erlang, setnode, 3, Xs) ->
+ strict(arg_types(erlang, setnode, 3), Xs, fun (_) -> t_atom('true') end);
+type(erlang, size, 1, Xs) ->
+ strict(arg_types(erlang, size, 1), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, spawn, 1, Xs) ->
+ strict(arg_types(erlang, spawn, 1), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn, 2, Xs) ->
+ strict(arg_types(erlang, spawn, 2), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn, 3, Xs) ->
+ strict(arg_types(erlang, spawn, 3), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn, 4, Xs) ->
+ strict(arg_types(erlang, spawn, 4), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn_link, 1, Xs) -> type(erlang, spawn, 1, Xs); % same
+type(erlang, spawn_link, 2, Xs) -> type(erlang, spawn, 2, Xs); % same
+type(erlang, spawn_link, 3, Xs) -> type(erlang, spawn, 3, Xs); % same
+type(erlang, spawn_link, 4, Xs) -> type(erlang, spawn, 4, Xs); % same
+type(erlang, spawn_opt, 1, Xs) ->
+ strict(arg_types(erlang, spawn_opt, 1), Xs,
+ fun ([Tuple]) ->
+ Fun = fun (TS) ->
+ [_, _, _, List] = t_tuple_args(TS),
+ t_spawn_opt_return(List)
+ end,
+ t_sup([Fun(TS) || TS <- t_tuple_subtypes(Tuple)])
+ end);
+type(erlang, spawn_opt, 2, Xs) ->
+ strict(arg_types(erlang, spawn_opt, 2), Xs,
+ fun ([_, List]) -> t_spawn_opt_return(List) end);
+type(erlang, spawn_opt, 3, Xs) ->
+ strict(arg_types(erlang, spawn_opt, 3), Xs,
+ fun ([_, _, List]) -> t_spawn_opt_return(List) end);
+type(erlang, spawn_opt, 4, Xs) ->
+ strict(arg_types(erlang, spawn_opt, 4), Xs,
+ fun ([_, _, _, List]) -> t_spawn_opt_return(List) end);
+type(erlang, split_binary, 2, Xs) ->
+ strict(arg_types(erlang, split_binary, 2), Xs,
+ fun (_) -> t_tuple([t_binary(), t_binary()]) end);
+type(erlang, start_timer, 3, Xs) ->
+ strict(arg_types(erlang, start_timer, 3), Xs, fun (_) -> t_reference() end);
+type(erlang, statistics, 1, Xs) ->
+ strict(arg_types(erlang, statistics, 1), Xs,
+ fun ([Type]) ->
+ T_statistics_1 = t_sup([t_non_neg_integer(),
+ t_tuple([t_non_neg_integer(),
+ t_non_neg_integer()]),
+ %% When called with the argument 'io'.
+ t_tuple([t_tuple([t_atom('input'),
+ t_non_neg_integer()]),
+ t_tuple([t_atom('output'),
+ t_non_neg_integer()])]),
+ t_tuple([t_non_neg_integer(),
+ t_non_neg_integer(),
+ t_non_neg_integer()])]),
+ case t_atom_vals(Type) of
+ ['context_switches'] ->
+ t_tuple([t_non_neg_integer(), t_integer(0)]);
+ ['exact_reductions'] ->
+ t_tuple([t_non_neg_integer(), t_non_neg_integer()]);
+ ['garbage_collection'] ->
+ t_tuple([t_non_neg_integer(),
+ t_non_neg_integer(),
+ t_integer(0)]);
+ ['io'] ->
+ t_tuple([t_tuple([t_atom('input'), t_non_neg_integer()]),
+ t_tuple([t_atom('output'), t_non_neg_integer()])]);
+ ['reductions'] ->
+ t_tuple([t_non_neg_integer(), t_non_neg_integer()]);
+ ['run_queue'] ->
+ t_non_neg_integer();
+ ['runtime'] ->
+ t_tuple([t_non_neg_integer(), t_integer(0)]);
+ ['wall_clock'] ->
+ t_tuple([t_non_neg_integer(), t_integer(0)]);
+ List when is_list(List) ->
+ T_statistics_1;
+ unknown ->
+ T_statistics_1
+ end
+ end);
+type(erlang, suspend_process, 1, Xs) ->
+ strict(arg_types(erlang, suspend_process, 1), Xs,
+ fun (_) -> t_atom('true') end);
+type(erlang, suspend_process, 2, Xs) ->
+ strict(arg_types(erlang, suspend_process, 2), Xs,
+ fun (_) -> t_boolean() end);
+type(erlang, system_flag, 2, Xs) ->
+ strict(arg_types(erlang, system_flag, 2), Xs,
+ fun ([Flag,_Value]) ->
+ %% this provides an overapproximation of all return values
+ T_system_flag_2 = t_sup([t_boolean(),
+ t_integer(),
+ t_sequential_tracer(),
+ t_system_cpu_topology(),
+ t_system_multi_scheduling()]),
+ case t_is_atom(Flag) of
+ true ->
+ case t_atom_vals(Flag) of
+ ['backtrace_depth'] ->
+ t_non_neg_fixnum();
+ ['cpu_topology'] ->
+ t_system_cpu_topology();
+ ['debug_flags'] ->
+ t_atom('true');
+ ['display_items'] ->
+ t_non_neg_fixnum();
+ ['fullsweep_after'] ->
+ t_non_neg_fixnum();
+ ['min_heap_size'] ->
+ t_non_neg_fixnum();
+ ['multi_scheduling'] ->
+ t_system_multi_scheduling();
+ ['schedulers_online'] ->
+ t_pos_fixnum();
+ ['scheduler_bind_type'] ->
+ t_scheduler_bind_type_results();
+ ['sequential_tracer'] ->
+ t_sequential_tracer();
+ ['trace_control_word'] ->
+ t_integer();
+ List when is_list(List) ->
+ T_system_flag_2;
+ unknown ->
+ T_system_flag_2
+ end;
+ false ->
+ case t_is_integer(Flag) of % SHOULD BE: t_is_fixnum
+ true ->
+ t_atom('true');
+ false ->
+ T_system_flag_2
+ end
+ end
+ end);
+type(erlang, system_info, 1, Xs) ->
+ strict(arg_types(erlang, system_info, 1), Xs,
+ fun ([Type]) ->
+ case t_is_atom(Type) of
+ true ->
+ case t_atom_vals(Type) of
+ ['allocated_areas'] ->
+ t_list(t_sup([t_tuple([t_atom(),t_non_neg_integer()]),
+ t_tuple([t_atom(),
+ t_non_neg_integer(),
+ t_non_neg_integer()])]));
+ ['allocator'] ->
+ t_tuple([t_sup([t_atom('undefined'),
+ t_atom('elib_malloc'),
+ t_atom('glibc')]),
+ t_list(t_integer()),
+ t_list(t_atom()),
+ t_list(t_tuple([t_atom(),
+ t_list(t_tuple([t_atom(),
+ t_any()]))]))]);
+ ['break_ignored'] ->
+ t_boolean();
+ ['cpu_topology'] ->
+ t_system_cpu_topology();
+ ['compat_rel'] ->
+ t_non_neg_fixnum();
+ ['creation'] ->
+ t_fixnum();
+ ['debug_compiled'] ->
+ t_boolean();
+ ['dist'] ->
+ t_binary();
+ ['dist_ctrl'] ->
+ t_list(t_tuple([t_atom(), t_sup([t_pid(), t_port])]));
+ ['elib_malloc'] ->
+ t_sup([t_atom('false'),
+ t_list(t_tuple([t_atom(), t_any()]))]);
+ ['endian'] ->
+ t_sup([t_atom('big'), t_atom('little')]);
+ ['fullsweep_after'] ->
+ t_tuple([t_atom('fullsweep_after'), t_non_neg_integer()]);
+ ['garbage_collection'] ->
+ t_list();
+ ['global_heaps_size'] ->
+ t_non_neg_integer();
+ ['heap_sizes'] ->
+ t_list(t_integer());
+ ['heap_type'] ->
+ t_sup([t_atom('private'), t_atom('hybrid')]);
+ ['hipe_architecture'] ->
+ t_sup([t_atom('amd64'), t_atom('arm'),
+ t_atom('powerpc'), t_atom('undefined'),
+ t_atom('ultrasparc'), t_atom('x86')]);
+ ['info'] ->
+ t_binary();
+ ['internal_cpu_topology'] -> %% Undocumented internal feature
+ t_internal_cpu_topology();
+ ['loaded'] ->
+ t_binary();
+ ['logical_processors'] ->
+ t_non_neg_fixnum();
+ ['machine'] ->
+ t_string();
+ ['multi_scheduling'] ->
+ t_system_multi_scheduling();
+ ['multi_scheduling_blockers'] ->
+ t_list(t_pid());
+ ['os_type'] ->
+ t_tuple([t_sup([t_atom('ose'), % XXX: undocumented
+ t_atom('unix'),
+ t_atom('vxworks'),
+ t_atom('win32')]),
+ t_atom()]);
+ ['os_version'] ->
+ t_sup(t_tuple([t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum()]),
+ t_string());
+ ['process_count'] ->
+ t_non_neg_fixnum();
+ ['process_limit'] ->
+ t_non_neg_fixnum();
+ ['procs'] ->
+ t_binary();
+ ['scheduler_bindings'] ->
+ t_tuple();
+ ['scheduler_bind_type'] ->
+ t_scheduler_bind_type_results();
+ ['schedulers'] ->
+ t_pos_fixnum();
+ ['schedulers_online'] ->
+ t_pos_fixnum();
+ ['sequential_tracer'] ->
+ t_tuple([t_atom('sequential_tracer'),
+ t_sequential_tracer()]);
+ ['smp_support'] ->
+ t_boolean();
+ ['system_architecture'] ->
+ t_string();
+ ['system_version'] ->
+ t_string();
+ ['threads'] ->
+ t_boolean();
+ ['thread_pool_size'] ->
+ t_non_neg_fixnum();
+ ['trace_control_word'] ->
+ t_integer();
+ ['version'] ->
+ t_string();
+ ['wordsize'] ->
+ t_integers([4,8]);
+ List when is_list(List) ->
+ t_any(); %% gross overapproximation
+ unknown ->
+ t_any()
+ end;
+ false -> %% This currently handles only {allocator, Alloc}
+ t_any() %% overapproximation as the return value might change
+ end
+ end);
+type(erlang, system_monitor, 0, Xs) ->
+ strict(arg_types(erlang, system_monitor, 0), Xs,
+ fun (_) -> t_system_monitor_settings() end);
+type(erlang, system_monitor, 1, Xs) ->
+ strict(arg_types(erlang, system_monitor, 1), Xs,
+ fun (_) -> t_system_monitor_settings() end);
+type(erlang, system_monitor, 2, Xs) ->
+ strict(arg_types(erlang, system_monitor, 2), Xs,
+ fun (_) -> t_system_monitor_settings() end);
+type(erlang, system_profile, 0, _) ->
+ t_system_profile_return();
+type(erlang, system_profile, 2, Xs) ->
+ strict(arg_types(erlang, system_profile, 2), Xs,
+ fun (_) -> t_system_profile_return() end);
+type(erlang, term_to_binary, 1, Xs) ->
+ strict(arg_types(erlang, term_to_binary, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, term_to_binary, 2, Xs) ->
+ strict(arg_types(erlang, term_to_binary, 2), Xs, fun (_) -> t_binary() end);
+type(erlang, time, 0, _) ->
+ t_tuple([t_non_neg_integer(), t_non_neg_integer(), t_non_neg_integer()]);
+type(erlang, tl, 1, Xs) ->
+ strict(arg_types(erlang, tl, 1), Xs, fun ([X]) -> t_cons_tl(X) end);
+type(erlang, trace, 3, Xs) ->
+ strict(arg_types(erlang, trace, 3), Xs, fun (_) -> t_integer() end);
+type(erlang, trace_delivered, 1, Xs) ->
+ strict(arg_types(erlang, trace_delivered, 1), Xs,
+ fun (_) -> t_reference() end);
+type(erlang, trace_info, 2, Xs) ->
+ strict(arg_types(erlang, trace_info, 2), Xs,
+ fun (_) ->
+ t_tuple([t_atom(),
+ t_sup([%% the following is info about a PID
+ t_list(t_atom()), t_pid(), t_port(),
+ %% the following is info about a func
+ t_atom('global'), t_atom('local'),
+ t_atom('false'), t_atom('true'),
+ t_list(), t_pid(), t_port(),
+ t_integer(),
+ t_list(t_tuple([t_atom(), t_any()])),
+ %% and this is the 'not found' value
+ t_atom('undefined')])])
+ end);
+type(erlang, trace_pattern, 2, Xs) ->
+ strict(arg_types(erlang, trace_pattern, 2), Xs,
+ fun (_) -> t_non_neg_fixnum() end); %% num of MFAs that match pattern
+type(erlang, trace_pattern, 3, Xs) ->
+ strict(arg_types(erlang, trace_pattern, 3), Xs,
+ fun (_) -> t_non_neg_fixnum() end); %% num of MFAs that match pattern
+type(erlang, trunc, 1, Xs) ->
+ strict(arg_types(erlang, trunc, 1), Xs, fun (_) -> t_integer() end);
+type(erlang, tuple_size, 1, Xs) ->
+ strict(arg_types(erlang, tuple_size, 1), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, tuple_to_list, 1, Xs) ->
+ strict(arg_types(erlang, tuple_to_list, 1), Xs,
+ fun ([X]) ->
+ case t_tuple_subtypes(X) of
+ unknown -> t_list();
+ SubTypes ->
+ Args = lists:flatten([t_tuple_args(ST) || ST <- SubTypes]),
+ %% Can be nil if the tuple can be {}
+ case lists:any(fun (T) ->
+ t_tuple_size(T) =:= 0
+ end, SubTypes) of
+ true ->
+ %% Be careful here. If we had only {} we need to
+ %% keep the nil.
+ t_sup(t_nonempty_list(t_sup(Args)), t_nil());
+ false ->
+ t_nonempty_list(t_sup(Args))
+ end
+ end
+ end);
+type(erlang, universaltime, 0, _) ->
+ t_tuple([t_date(), t_time()]);
+type(erlang, universaltime_to_localtime, 1, Xs) ->
+ strict(arg_types(erlang, universaltime_to_localtime, 1), Xs,
+ fun ([T]) -> T end);
+type(erlang, unlink, 1, Xs) ->
+ strict(arg_types(erlang, unlink, 1), Xs, fun (_) -> t_atom('true') end);
+type(erlang, unregister, 1, Xs) ->
+ strict(arg_types(erlang, unregister, 1), Xs, fun (_) -> t_atom('true') end);
+type(erlang, whereis, 1, Xs) ->
+ strict(arg_types(erlang, whereis, 1), Xs,
+ fun (_) -> t_sup([t_pid(), t_port(), t_atom('undefined')]) end);
+type(erlang, yield, 0, _) -> t_atom('true');
+%%-- erl_prim_loader ----------------------------------------------------------
+type(erl_prim_loader, get_file, 1, Xs) ->
+ strict(arg_types(erl_prim_loader, get_file, 1), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_binary(), t_string()]),
+ t_atom('error'))
+ end);
+type(erl_prim_loader, get_path, 0, _) ->
+ t_tuple([t_atom('ok'), t_list(t_string())]);
+type(erl_prim_loader, set_path, 1, Xs) ->
+ strict(arg_types(erl_prim_loader, set_path, 1), Xs,
+ fun (_) -> t_atom('ok') end);
+%%-- error_logger -------------------------------------------------------------
+type(error_logger, warning_map, 0, _) ->
+ t_sup([t_atom('info'), t_atom('warning'), t_atom('error')]);
+%%-- erts_debug ---------------------------------------------------------------
+type(erts_debug, breakpoint, 2, Xs) ->
+ strict(arg_types(erts_debug, breakpoint, 2), Xs, fun (_) -> t_fixnum() end);
+type(erts_debug, disassemble, 1, Xs) ->
+ strict(arg_types(erts_debug, disassemble, 1), Xs,
+ fun (_) -> t_sup([t_atom('false'),
+ t_atom('undef'),
+ t_tuple([t_integer(), t_binary(), t_mfa()])]) end);
+type(erts_debug, flat_size, 1, Xs) ->
+ strict(arg_types(erts_debug, flat_size, 1), Xs, fun (_) -> t_integer() end);
+type(erts_debug, same, 2, Xs) ->
+ strict(arg_types(erts_debug, same, 2), Xs, fun (_) -> t_boolean() end);
+%%-- ets ----------------------------------------------------------------------
+type(ets, all, 0, _) ->
+ t_list(t_tab());
+type(ets, delete, 1, Xs) ->
+ strict(arg_types(ets, delete, 1), Xs, fun (_) -> t_atom('true') end);
+type(ets, delete, 2, Xs) ->
+ strict(arg_types(ets, delete, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, delete_all_objects, 1, Xs) ->
+ strict(arg_types(ets, delete_all_objects, 1), Xs,
+ fun (_) -> t_atom('true') end);
+type(ets, delete_object, 2, Xs) ->
+ strict(arg_types(ets, delete_object, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, first, 1, Xs) ->
+ strict(arg_types(ets, first, 1), Xs, fun (_) -> t_any() end);
+type(ets, give_away, 3, Xs) ->
+ strict(arg_types(ets, give_away, 3), Xs, fun (_) -> t_atom('true') end);
+type(ets, info, 1, Xs) ->
+ strict(arg_types(ets, info, 1), Xs,
+ fun (_) ->
+ t_sup(t_list(t_tuple([t_ets_info_items(), t_any()])),
+ t_atom('undefined'))
+ end);
+type(ets, info, 2, Xs) ->
+ strict(arg_types(ets, info, 2), Xs, fun (_) -> t_any() end);
+type(ets, insert, 2, Xs) ->
+ strict(arg_types(ets, insert, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, insert_new, 2, Xs) ->
+ strict(arg_types(ets, insert_new, 2), Xs, fun (_) -> t_boolean() end);
+type(ets, is_compiled_ms, 1, Xs) ->
+ strict(arg_types(ets, is_compiled_ms, 1), Xs, fun (_) -> t_boolean() end);
+type(ets, last, 1, Xs) ->
+ type(ets, first, 1, Xs);
+type(ets, lookup, 2, Xs) ->
+ strict(arg_types(ets, lookup, 2), Xs, fun (_) -> t_list(t_tuple()) end);
+type(ets, lookup_element, 3, Xs) ->
+ strict(arg_types(ets, lookup_element, 3), Xs, fun (_) -> t_any() end);
+type(ets, match, 1, Xs) ->
+ strict(arg_types(ets, match, 1), Xs, fun (_) -> t_matchres() end);
+type(ets, match, 2, Xs) ->
+ strict(arg_types(ets, match, 2), Xs, fun (_) -> t_list() end);
+type(ets, match, 3, Xs) ->
+ strict(arg_types(ets, match, 3), Xs, fun (_) -> t_matchres() end);
+type(ets, match_object, 1, Xs) -> type(ets, match, 1, Xs);
+type(ets, match_object, 2, Xs) -> type(ets, match, 2, Xs);
+type(ets, match_object, 3, Xs) -> type(ets, match, 3, Xs);
+type(ets, match_spec_compile, 1, Xs) ->
+ strict(arg_types(ets, match_spec_compile, 1), Xs, fun (_) -> t_any() end);
+type(ets, match_spec_run_r, 3, Xs) ->
+ strict(arg_types(ets, match_spec_run_r, 3), Xs, fun (_) -> t_list() end);
+type(ets, member, 2, Xs) ->
+ strict(arg_types(ets, member, 2), Xs, fun (_) -> t_boolean() end);
+type(ets, new, 2, Xs) ->
+ strict(arg_types(ets, new, 2), Xs, fun (_) -> t_tab() end);
+type(ets, next, 2, Xs) ->
+ strict(arg_types(ets, next, 2), Xs,
+ %% t_any below stands for: term() | '$end_of_table'
+ fun (_) -> t_any() end);
+type(ets, prev, 2, Xs) -> type(ets, next, 2, Xs);
+type(ets, rename, 2, Xs) ->
+ strict(arg_types(ets, rename, 2), Xs, fun ([_, Name]) -> Name end);
+type(ets, safe_fixtable, 2, Xs) ->
+ strict(arg_types(ets, safe_fixtable, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, select, 1, Xs) ->
+ strict(arg_types(ets, select, 1), Xs, fun (_) -> t_matchres() end);
+type(ets, select, 2, Xs) ->
+ strict(arg_types(ets, select, 2), Xs, fun (_) -> t_list() end);
+type(ets, select, 3, Xs) ->
+ strict(arg_types(ets, select, 3), Xs, fun (_) -> t_matchres() end);
+type(ets, select_count, 2, Xs) ->
+ strict(arg_types(ets, select_count, 2), Xs,
+ fun (_) -> t_non_neg_fixnum() end);
+type(ets, select_delete, 2, Xs) ->
+ strict(arg_types(ets, select_delete, 2), Xs,
+ fun (_) -> t_non_neg_fixnum() end);
+type(ets, select_reverse, 1, Xs) -> type(ets, select, 1, Xs);
+type(ets, select_reverse, 2, Xs) -> type(ets, select, 2, Xs);
+type(ets, select_reverse, 3, Xs) -> type(ets, select, 3, Xs);
+type(ets, setopts, 2, Xs) ->
+ strict(arg_types(ets, setopts, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, slot, 2, Xs) ->
+ strict(arg_types(ets, slot, 2), Xs,
+ fun (_) -> t_sup(t_list(t_tuple()), t_atom('$end_of_table')) end);
+type(ets, update_counter, 3, Xs) ->
+ strict(arg_types(ets, update_counter, 3), Xs, fun (_) -> t_integer() end);
+type(ets, update_element, 3, Xs) ->
+ strict(arg_types(ets, update_element, 3), Xs, fun (_) -> t_boolean() end);
+%%-- file ---------------------------------------------------------------------
+type(file, close, 1, Xs) ->
+ strict(arg_types(file, close, 1), Xs, fun (_) -> t_file_return() end);
+type(file, delete, 1, Xs) ->
+ strict(arg_types(file, delete, 1), Xs, fun (_) -> t_file_return() end);
+type(file, get_cwd, 0, _) ->
+ t_sup(t_tuple([t_atom('ok'), t_string()]),
+ t_tuple([t_atom('error'), t_file_posix_error()]));
+type(file, make_dir, 1, Xs) ->
+ strict(arg_types(file, make_dir, 1), Xs, fun (_) -> t_file_return() end);
+type(file, open, 2, Xs) ->
+ strict(arg_types(file, open, 2), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('ok'), t_file_io_device()]),
+ t_tuple([t_atom('error'), t_file_posix_error()])])
+ end);
+type(file, read_file, 1, Xs) ->
+ strict(arg_types(file, read_file, 1), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('ok'), t_binary()]),
+ t_tuple([t_atom('error'), t_file_posix_error()])])
+ end);
+type(file, set_cwd, 1, Xs) ->
+ strict(arg_types(file, set_cwd, 1), Xs,
+ fun (_) -> t_sup(t_atom('ok'),
+ t_tuple([t_atom('error'), t_file_posix_error()]))
+ end);
+type(file, write_file, 2, Xs) ->
+ strict(arg_types(file, write_file, 2), Xs, fun (_) -> t_file_return() end);
+%%-- gen_tcp ------------------------------------------------------------------
+%% NOTE: All type information for this module added to avoid loss of precision
+type(gen_tcp, accept, 1, Xs) ->
+ strict(arg_types(gen_tcp, accept, 1), Xs, fun (_) -> t_gen_tcp_accept() end);
+type(gen_tcp, accept, 2, Xs) ->
+ strict(arg_types(gen_tcp, accept, 2), Xs, fun (_) -> t_gen_tcp_accept() end);
+type(gen_tcp, connect, 3, Xs) ->
+ strict(arg_types(gen_tcp, connect, 3), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_socket()]),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+type(gen_tcp, connect, 4, Xs) ->
+ strict(arg_types(gen_tcp, connect, 4), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_socket()]),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+type(gen_tcp, listen, 2, Xs) ->
+ strict(arg_types(gen_tcp, listen, 2), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_socket()]),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+type(gen_tcp, recv, 2, Xs) ->
+ strict(arg_types(gen_tcp, recv, 2), Xs, fun (_) -> t_gen_tcp_recv() end);
+type(gen_tcp, recv, 3, Xs) ->
+ strict(arg_types(gen_tcp, recv, 3), Xs, fun (_) -> t_gen_tcp_recv() end);
+type(gen_tcp, send, 2, Xs) ->
+ strict(arg_types(gen_tcp, send, 2), Xs,
+ fun (_) ->
+ t_sup(t_atom('ok'),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+type(gen_tcp, shutdown, 2, Xs) ->
+ strict(arg_types(gen_tcp, shutdown, 2), Xs,
+ fun (_) ->
+ t_sup(t_atom('ok'),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+%%-- gen_udp ------------------------------------------------------------------
+%% NOTE: All type information for this module added to avoid loss of precision
+type(gen_udp, open, 1, Xs) ->
+ strict(arg_types(gen_udp, open, 1), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_socket()]),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+type(gen_udp, open, 2, Xs) ->
+ strict(arg_types(gen_udp, open, 2), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_socket()]),
+ t_tuple([t_atom('error'), t_inet_posix_error()]))
+ end);
+type(gen_udp, recv, 2, Xs) ->
+ strict(arg_types(gen_udp, recv, 2), Xs, fun (_) -> t_gen_udp_recv() end);
+type(gen_udp, recv, 3, Xs) ->
+ strict(arg_types(gen_udp, recv, 3), Xs, fun (_) -> t_gen_udp_recv() end);
+type(gen_udp, send, 4, Xs) ->
+ strict(arg_types(gen_udp, send, 4), Xs,
+ fun (_) ->
+ t_sup(t_atom('ok'),
+ t_tuple([t_atom('error'), t_sup(t_atom('not_owner'),
+ t_inet_posix_error())]))
+ end);
+%%-- hipe_bifs ----------------------------------------------------------------
+type(hipe_bifs, add_ref, 2, Xs) ->
+ strict(arg_types(hipe_bifs, add_ref, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, alloc_data, 2, Xs) ->
+ strict(arg_types(hipe_bifs, alloc_data, 2), Xs,
+ fun (_) -> t_integer() end); % address
+type(hipe_bifs, array, 2, Xs) ->
+ strict(arg_types(hipe_bifs, array, 2), Xs, fun (_) -> t_immarray() end);
+type(hipe_bifs, array_length, 1, Xs) ->
+ strict(arg_types(hipe_bifs, array_length, 1), Xs,
+ fun (_) -> t_non_neg_fixnum() end);
+type(hipe_bifs, array_sub, 2, Xs) ->
+ strict(arg_types(hipe_bifs, array_sub, 2), Xs, fun (_) -> t_immediate() end);
+type(hipe_bifs, array_update, 3, Xs) ->
+ strict(arg_types(hipe_bifs, array_update, 3), Xs,
+ fun (_) -> t_immarray() end);
+type(hipe_bifs, atom_to_word, 1, Xs) ->
+ strict(arg_types(hipe_bifs, atom_to_word, 1), Xs,
+ fun (_) -> t_integer() end);
+type(hipe_bifs, bif_address, 3, Xs) ->
+ strict(arg_types(hipe_bifs, bif_address, 3), Xs,
+ fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(hipe_bifs, bitarray, 2, Xs) ->
+ strict(arg_types(hipe_bifs, bitarray, 2), Xs, fun (_) -> t_bitarray() end);
+type(hipe_bifs, bitarray_sub, 2, Xs) ->
+ strict(arg_types(hipe_bifs, bitarray_sub, 2), Xs, fun (_) -> t_boolean() end);
+type(hipe_bifs, bitarray_update, 3, Xs) ->
+ strict(arg_types(hipe_bifs, bitarray_update, 3), Xs,
+ fun (_) -> t_bitarray() end);
+type(hipe_bifs, bytearray, 2, Xs) ->
+ strict(arg_types(hipe_bifs, bytearray, 2), Xs, fun (_) -> t_bytearray() end);
+type(hipe_bifs, bytearray_sub, 2, Xs) ->
+ strict(arg_types(hipe_bifs, bytearray_sub, 2), Xs, fun (_) -> t_byte() end);
+type(hipe_bifs, bytearray_update, 3, Xs) ->
+ strict(arg_types(hipe_bifs, bytearray_update, 3), Xs,
+ fun (_) -> t_bytearray() end);
+type(hipe_bifs, call_count_clear, 1, Xs) ->
+ strict(arg_types(hipe_bifs, call_count_clear, 1), Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(hipe_bifs, call_count_get, 1, Xs) ->
+ strict(arg_types(hipe_bifs, call_count_get, 1), Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(hipe_bifs, call_count_off, 1, Xs) ->
+ strict(arg_types(hipe_bifs, call_count_off, 1), Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(hipe_bifs, call_count_on, 1, Xs) ->
+ strict(arg_types(hipe_bifs, call_count_on, 1), Xs,
+ fun (_) -> t_sup(t_atom('true'), t_nil()) end);
+type(hipe_bifs, check_crc, 1, Xs) ->
+ strict(arg_types(hipe_bifs, check_crc, 1), Xs, fun (_) -> t_boolean() end);
+type(hipe_bifs, enter_code, 2, Xs) ->
+ strict(arg_types(hipe_bifs, enter_code, 2), Xs,
+ fun (_) -> t_tuple([t_integer(),
+ %% XXX: The tuple below contains integers and
+ %% is of size same as the length of the MFA list
+ t_sup(t_nil(), t_binary())]) end);
+type(hipe_bifs, enter_sdesc, 1, Xs) ->
+ strict(arg_types(hipe_bifs, enter_sdesc, 1), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, find_na_or_make_stub, 2, Xs) ->
+ strict(arg_types(hipe_bifs, find_na_or_make_stub, 2), Xs,
+ fun (_) -> t_integer() end); % address
+type(hipe_bifs, fun_to_address, 1, Xs) ->
+ strict(arg_types(hipe_bifs, fun_to_address, 1), Xs,
+ fun (_) -> t_integer() end);
+%% type(hipe_bifs, get_emu_address, 1, Xs) ->
+%% strict(arg_types(hipe_bifs, get_emu_address, 1), Xs,
+%% fun (_) -> t_integer() end); % address
+type(hipe_bifs, get_rts_param, 1, Xs) ->
+ strict(arg_types(hipe_bifs, get_rts_param, 1), Xs,
+ fun (_) -> t_sup(t_integer(), t_nil()) end);
+type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs) ->
+ strict(arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, make_fe, 3, Xs) ->
+ strict(arg_types(hipe_bifs, make_fe, 3), Xs, fun (_) -> t_integer() end);
+%% type(hipe_bifs, make_native_stub, 2, Xs) ->
+%% strict(arg_types(hipe_bifs, make_native_stub, 2), Xs,
+%% fun (_) -> t_integer() end); % address
+type(hipe_bifs, mark_referred_from, 1, Xs) ->
+ strict(arg_types(hipe_bifs, mark_referred_from, 1), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, merge_term, 1, Xs) ->
+ strict(arg_types(hipe_bifs, merge_term, 1), Xs, fun ([X]) -> X end);
+type(hipe_bifs, patch_call, 3, Xs) ->
+ strict(arg_types(hipe_bifs, patch_call, 3), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, patch_insn, 3, Xs) ->
+ strict(arg_types(hipe_bifs, patch_insn, 3), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, primop_address, 1, Xs) ->
+ strict(arg_types(hipe_bifs, primop_address, 1), Xs,
+ fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(hipe_bifs, redirect_referred_from, 1, Xs) ->
+ strict(arg_types(hipe_bifs, redirect_referred_from, 1), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, ref, 1, Xs) ->
+ strict(arg_types(hipe_bifs, ref, 1), Xs, fun (_) -> t_immarray() end);
+type(hipe_bifs, ref_get, 1, Xs) ->
+ strict(arg_types(hipe_bifs, ref_get, 1), Xs, fun (_) -> t_immediate() end);
+type(hipe_bifs, ref_set, 2, Xs) ->
+ strict(arg_types(hipe_bifs, ref_set, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, remove_refs_from, 1, Xs) ->
+ strict(arg_types(hipe_bifs, remove_refs_from, 1), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, set_funinfo_native_address, 3, Xs) ->
+ strict(arg_types(hipe_bifs, set_funinfo_native_address, 3), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, set_native_address, 3, Xs) ->
+ strict(arg_types(hipe_bifs, set_native_address, 3), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, system_crc, 1, Xs) ->
+ strict(arg_types(hipe_bifs, system_crc, 1), Xs, fun (_) -> t_integer() end);
+type(hipe_bifs, term_to_word, 1, Xs) ->
+ strict(arg_types(hipe_bifs, term_to_word, 1), Xs,
+ fun (_) -> t_integer() end);
+type(hipe_bifs, update_code_size, 3, Xs) ->
+ strict(arg_types(hipe_bifs, update_code_size, 3), Xs,
+ fun (_) -> t_nil() end);
+type(hipe_bifs, write_u8, 2, Xs) ->
+ strict(arg_types(hipe_bifs, write_u8, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, write_u32, 2, Xs) ->
+ strict(arg_types(hipe_bifs, write_u32, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, write_u64, 2, Xs) ->
+ strict(arg_types(hipe_bifs, write_u64, 2), Xs, fun (_) -> t_nil() end);
+%%-- io -----------------------------------------------------------------------
+type(io, format, 1, Xs) ->
+ strict(arg_types(io, format, 1), Xs, fun (_) -> t_atom('ok') end);
+type(io, format, 2, Xs) ->
+ strict(arg_types(io, format, 2), Xs, fun (_) -> t_atom('ok') end);
+type(io, format, 3, Xs) ->
+ strict(arg_types(io, format, 3), Xs, fun (_) -> t_atom('ok') end);
+type(io, fwrite, 1, Xs) -> type(io, format, 1, Xs); % same
+type(io, fwrite, 2, Xs) -> type(io, format, 2, Xs); % same
+type(io, fwrite, 3, Xs) -> type(io, format, 3, Xs); % same
+type(io, put_chars, 1, Xs) ->
+ strict(arg_types(io, put_chars, 1), Xs, fun (_) -> t_atom('ok') end);
+type(io, put_chars, 2, Xs) ->
+ strict(arg_types(io, put_chars, 2), Xs, fun (_) -> t_atom('ok') end);
+%%-- io_lib -------------------------------------------------------------------
+type(io_lib, format, 2, Xs) ->
+ strict(arg_types(io_lib, format, 2), Xs,
+ %% t_list() because the character list might be arbitrarily nested
+ fun (_) -> t_list(t_sup(t_char(), t_list())) end);
+type(io_lib, fwrite, 2, Xs) -> type(io_lib, format, 2, Xs); % same
+%%-- lists --------------------------------------------------------------------
+type(lists, all, 2, Xs) ->
+ strict(arg_types(lists, all, 2), Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L) of
+ true -> t_atom('true');
+ false ->
+ El = t_list_elements(L),
+ case check_fun_application(F, [El]) of
+ ok ->
+ case t_is_cons(L) of
+ true -> t_fun_range(F);
+ false ->
+ %% The list can be empty.
+ t_sup(t_atom('true'), t_fun_range(F))
+ end;
+ error ->
+ case t_is_cons(L) of
+ true -> t_none();
+ false -> t_fun_range(F)
+ end
+ end
+ end
+ end);
+type(lists, any, 2, Xs) ->
+ strict(arg_types(lists, any, 2), Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L) of
+ true -> t_atom('false');
+ false ->
+ El = t_list_elements(L),
+ case check_fun_application(F, [El]) of
+ ok ->
+ case t_is_cons(L) of
+ true -> t_fun_range(F);
+ false ->
+ %% The list can be empty
+ t_sup(t_atom('false'), t_fun_range(F))
+ end;
+ error ->
+ case t_is_cons(L) of
+ true -> t_none();
+ false -> t_fun_range(F)
+ end
+ end
+ end
+ end);
+type(lists, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias
+type(lists, delete, 2, Xs) ->
+ strict(arg_types(lists, delete, 2), Xs,
+ fun ([_, List]) ->
+ case t_is_cons(List) of
+ true -> t_cons_tl(List);
+ false -> List
+ end
+ end);
+type(lists, dropwhile, 2, Xs) ->
+ strict(arg_types(lists, dropwhile, 2), Xs,
+ fun ([F, X]) ->
+ case t_is_nil(X) of
+ true -> t_nil();
+ false ->
+ X1 = t_list_elements(X),
+ case check_fun_application(F, [X1]) of
+ ok ->
+ case t_atom_vals(t_fun_range(F)) of
+ ['true'] ->
+ case t_is_none(t_inf(t_list(), X)) of
+ true -> t_none();
+ false -> t_nil()
+ end;
+ ['false'] ->
+ case t_is_none(t_inf(t_list(), X)) of
+ true -> t_none();
+ false -> X
+ end;
+ _ ->
+ t_inf(t_cons_tl(t_inf(X, t_cons())),
+ t_maybe_improper_list())
+ end;
+ error ->
+ case t_is_cons(X) of
+ true -> t_none();
+ false -> t_nil()
+ end
+ end
+ end
+ end);
+type(lists, filter, 2, Xs) ->
+ strict(arg_types(lists, filter, 2), Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L) of
+ true -> t_nil();
+ false ->
+ T = t_list_elements(L),
+ case check_fun_application(F, [T]) of
+ ok ->
+ case t_atom_vals(t_fun_range(F)) =:= ['false'] of
+ true -> t_nil();
+ false ->
+ case t_atom_vals(t_fun_range(F)) =:= ['true'] of
+ true -> L;
+ false -> t_list(T)
+ end
+ end;
+ error ->
+ case t_is_cons(L) of
+ true -> t_none();
+ false -> t_nil()
+ end
+ end
+ end
+ end);
+type(lists, flatten, 1, Xs) ->
+ strict(arg_types(lists, flatten, 1), Xs,
+ fun ([L]) ->
+ case t_is_nil(L) of
+ true -> L; % (nil has undefined elements)
+ false ->
+ %% Avoiding infinite recursion is tricky
+ X1 = t_list_elements(L),
+ case t_is_any(X1) of
+ true ->
+ t_list();
+ false ->
+ X2 = type(lists, flatten, 1, [t_inf(X1, t_list())]),
+ t_sup(t_list(t_subtract(X1, t_list())),
+ X2)
+ end
+ end
+ end);
+type(lists, flatmap, 2, Xs) ->
+ strict(arg_types(lists, flatmap, 2), Xs,
+ fun ([F, List]) ->
+ case t_is_nil(List) of
+ true -> t_nil();
+ false ->
+ case check_fun_application(F, [t_list_elements(List)]) of
+ ok ->
+ case t_is_cons(List) of
+ true -> t_nonempty_list(t_list_elements(t_fun_range(F)));
+ false -> t_list(t_list_elements(t_fun_range(F)))
+ end;
+ error ->
+ case t_is_cons(List) of
+ true -> t_none();
+ false -> t_nil()
+ end
+ end
+ end
+ end);
+type(lists, foreach, 2, Xs) ->
+ strict(arg_types(lists, foreach, 2), Xs,
+ fun ([F, List]) ->
+ case t_is_cons(List) of
+ true ->
+ case check_fun_application(F, [t_list_elements(List)]) of
+ ok -> t_atom('ok');
+ error -> t_none()
+ end;
+ false ->
+ t_atom('ok')
+ end
+ end);
+type(lists, foldl, 3, Xs) ->
+ strict(arg_types(lists, foldl, 3), Xs,
+ fun ([F, Acc, List]) ->
+ case t_is_nil(List) of
+ true -> Acc;
+ false ->
+ case check_fun_application(F, [t_list_elements(List), Acc]) of
+ ok ->
+ case t_is_cons(List) of
+ true -> t_fun_range(F);
+ false -> t_sup(t_fun_range(F), Acc)
+ end;
+ error ->
+ case t_is_cons(List) of
+ true -> t_none();
+ false -> Acc
+ end
+ end
+ end
+ end);
+type(lists, foldr, 3, Xs) -> type(lists, foldl, 3, Xs); % same
+type(lists, keydelete, 3, Xs) ->
+ strict(arg_types(lists, keydelete, 3), Xs,
+ fun ([_, _, L]) ->
+ Term = t_list_termination(L),
+ t_sup(Term, erl_types:lift_list_to_pos_empty(L))
+ end);
+type(lists, keyfind, 3, Xs) ->
+ strict(arg_types(lists, keyfind, 3), Xs,
+ fun ([X, Y, Z]) ->
+ ListEs = t_list_elements(Z),
+ Tuple = t_inf(t_tuple(), ListEs),
+ case t_is_none(Tuple) of
+ true -> t_atom('false');
+ false ->
+ %% this BIF, contrary to lists:keysearch/3 does not
+ %% wrap its result in a 'value'-tagged tuple
+ Ret = t_sup(Tuple, t_atom('false')),
+ case t_is_any(X) of
+ true -> Ret;
+ false ->
+ case t_tuple_subtypes(Tuple) of
+ unknown -> Ret;
+ List ->
+ Keys = [type(erlang, element, 2, [Y, S])
+ || S <- List],
+ Infs = [t_inf(Key, X) || Key <- Keys],
+ case all_is_none(Infs) of
+ true -> t_atom('false');
+ false -> Ret
+ end
+ end
+ end
+ end
+ end);
+type(lists, keymap, 3, Xs) ->
+ strict(arg_types(lists, keymap, 3), Xs,
+ fun ([F, _I, L]) ->
+ case t_is_nil(L) of
+ true -> L;
+ false -> t_list(t_sup(t_fun_range(F), t_list_elements(L)))
+ end
+ end);
+type(lists, keymember, 3, Xs) ->
+ strict(arg_types(lists, keymember, 3), Xs,
+ fun ([X, Y, Z]) ->
+ ListEs = t_list_elements(Z),
+ Tuple = t_inf(t_tuple(), ListEs),
+ case t_is_none(Tuple) of
+ true -> t_atom('false');
+ false ->
+ case t_is_any(X) of
+ true -> t_boolean();
+ false ->
+ case t_tuple_subtypes(Tuple) of
+ unknown -> t_boolean();
+ List ->
+ Keys = [type(erlang, element, 2, [Y,S]) || S <- List],
+ Infs = [t_inf(Key, X) || Key <- Keys],
+ case all_is_none(Infs) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end
+ end
+ end
+ end);
+type(lists, keymerge, 3, Xs) ->
+ strict(arg_types(lists, keymerge, 3), Xs,
+ fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end);
+type(lists, keyreplace, 4, Xs) ->
+ strict(arg_types(lists, keyreplace, 4), Xs,
+ fun ([_K, _I, L, T]) -> t_list(t_sup(t_list_elements(L), T)) end);
+type(lists, keysearch, 3, Xs) ->
+ strict(arg_types(lists, keysearch, 3), Xs,
+ fun ([X, Y, Z]) ->
+ ListEs = t_list_elements(Z),
+ Tuple = t_inf(t_tuple(), ListEs),
+ case t_is_none(Tuple) of
+ true -> t_atom('false');
+ false ->
+ Ret = t_sup(t_tuple([t_atom('value'), Tuple]),
+ t_atom('false')),
+ case t_is_any(X) of
+ true -> Ret;
+ false ->
+ case t_tuple_subtypes(Tuple) of
+ unknown -> Ret;
+ List ->
+ Keys = [type(erlang, element, 2, [Y, S])
+ || S <- List],
+ Infs = [t_inf(Key, X) || Key <- Keys],
+ case all_is_none(Infs) of
+ true -> t_atom('false');
+ false -> Ret
+ end
+ end
+ end
+ end
+ end);
+type(lists, keysort, 2, Xs) ->
+ strict(arg_types(lists, keysort, 2), Xs, fun ([_, L]) -> L end);
+type(lists, last, 1, Xs) ->
+ strict(arg_types(lists, last, 1), Xs, fun ([L]) -> t_list_elements(L) end);
+type(lists, map, 2, Xs) ->
+ strict(arg_types(lists, map, 2), Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L) of
+ true -> L;
+ false ->
+ El = t_list_elements(L),
+ case t_is_cons(L) of
+ true ->
+ case check_fun_application(F, [El]) of
+ ok -> t_nonempty_list(t_fun_range(F));
+ error -> t_none()
+ end;
+ false ->
+ case check_fun_application(F, [El]) of
+ ok -> t_list(t_fun_range(F));
+ error -> t_nil()
+ end
+ end
+ end
+ end);
+type(lists, mapfoldl, 3, Xs) ->
+ strict(arg_types(lists, mapfoldl, 3), Xs,
+ fun ([F, Acc, List]) ->
+ case t_is_nil(List) of
+ true -> t_tuple([List, Acc]);
+ false ->
+ El = t_list_elements(List),
+ R = t_fun_range(F),
+ case t_is_cons(List) of
+ true ->
+ case check_fun_application(F, [El, Acc]) of
+ ok ->
+ Fun = fun (RangeTuple) ->
+ [T1, T2] = t_tuple_args(RangeTuple),
+ t_tuple([t_nonempty_list(T1), T2])
+ end,
+ t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]);
+ error ->
+ t_none()
+ end;
+ false ->
+ case check_fun_application(F, [El, Acc]) of
+ ok ->
+ Fun = fun (RangeTuple) ->
+ [T1, T2] = t_tuple_args(RangeTuple),
+ t_tuple([t_list(T1), t_sup(Acc, T2)])
+ end,
+ t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]);
+ error ->
+ t_tuple([t_nil(), Acc])
+ end
+ end
+ end
+ end);
+type(lists, mapfoldr, 3, Xs) -> type(lists, mapfoldl, 3, Xs); % same
+type(lists, max, 1, Xs) ->
+ strict(arg_types(lists, max, 1), Xs, fun ([L]) -> t_list_elements(L) end);
+type(lists, member, 2, Xs) ->
+ strict(arg_types(lists, member, 2), Xs,
+ fun ([X, Y]) ->
+ Y1 = t_list_elements(Y),
+ case t_is_none(t_inf(Y1, X)) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end);
+%% type(lists, merge, 1, Xs) ->
+type(lists, merge, 2, Xs) ->
+ strict(arg_types(lists, merge, 2), Xs,
+ fun ([L1, L2]) ->
+ case t_is_none(L1) of
+ true -> L2;
+ false ->
+ case t_is_none(L2) of
+ true -> L1;
+ false -> t_sup(L1, L2)
+ end
+ end
+ end);
+%% type(lists, merge, 3, Xs) ->
+%% type(lists, merge3, 3, Xs) ->
+type(lists, min, 1, Xs) ->
+ strict(arg_types(lists, min, 1), Xs, fun ([L]) -> t_list_elements(L) end);
+type(lists, nth, 2, Xs) ->
+ strict(arg_types(lists, nth, 2), Xs,
+ fun ([_, Y]) -> t_list_elements(Y) end);
+type(lists, nthtail, 2, Xs) ->
+ strict(arg_types(lists, nthtail, 2), Xs,
+ fun ([_, Y]) -> t_sup(Y, t_list()) end);
+type(lists, partition, 2, Xs) ->
+ strict(arg_types(lists, partition, 2), Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L) of
+ true -> t_tuple([L,L]);
+ false ->
+ El = t_list_elements(L),
+ case check_fun_application(F, [El]) of
+ error ->
+ case t_is_cons(L) of
+ true -> t_none();
+ false -> t_tuple([t_nil(), t_nil()])
+ end;
+ ok ->
+ case t_atom_vals(t_fun_range(F)) of
+ ['true'] -> t_tuple([L, t_nil()]);
+ ['false'] -> t_tuple([t_nil(), L]);
+ [_, _] ->
+ L2 = t_list(El),
+ t_tuple([L2, L2])
+ end
+ end
+ end
+ end);
+type(lists, reverse, 1, Xs) ->
+ strict(arg_types(lists, reverse, 1), Xs, fun ([X]) -> X end);
+type(lists, reverse, 2, Xs) ->
+ type(erlang, '++', 2, Xs); % reverse-onto is just like append
+type(lists, seq, 2, Xs) ->
+ strict(arg_types(lists, seq, 2), Xs, fun (_) -> t_list(t_integer()) end);
+type(lists, seq, 3, Xs) ->
+ strict(arg_types(lists, seq, 3), Xs, fun (_) -> t_list(t_integer()) end);
+type(lists, sort, 1, Xs) ->
+ strict(arg_types(lists, sort, 1), Xs, fun ([X]) -> X end);
+type(lists, sort, 2, Xs) ->
+ strict(arg_types(lists, sort, 2), Xs,
+ fun ([F, L]) ->
+ R = t_fun_range(F),
+ case t_is_boolean(R) of
+ true -> L;
+ false ->
+ case t_is_nil(L) of
+ true -> t_nil();
+ false -> t_none()
+ end
+ end
+ end);
+type(lists, split, 2, Xs) ->
+ strict(arg_types(lists, split, 2), Xs,
+ fun ([_, L]) ->
+ case t_is_nil(L) of
+ true -> t_tuple([L, L]);
+ false ->
+ T = t_list_elements(L),
+ t_tuple([t_list(T), t_list(T)])
+ end
+ end);
+type(lists, splitwith, 2, Xs) ->
+ T1 = type(lists, takewhile, 2, Xs),
+ T2 = type(lists, dropwhile, 2, Xs),
+ case t_is_none(T1) orelse t_is_none(T2) of
+ true -> t_none();
+ false -> t_tuple([T1, T2])
+ end;
+type(lists, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias
+type(lists, takewhile, 2, Xs) ->
+ strict(arg_types(lists, takewhile, 2), Xs,
+ fun([F, L]) ->
+ case t_is_none(t_inf(t_list(), L)) of
+ false -> type(lists, filter, 2, Xs);
+ true ->
+ %% This works for non-proper lists as well.
+ El = t_list_elements(L),
+ type(lists, filter, 2, [F, t_list(El)])
+ end
+ end);
+type(lists, usort, 1, Xs) -> type(lists, sort, 1, Xs); % same
+type(lists, usort, 2, Xs) -> type(lists, sort, 2, Xs); % same
+type(lists, unzip, 1, Xs) ->
+ strict(arg_types(lists, unzip, 1), Xs,
+ fun ([Ps]) ->
+ case t_is_nil(Ps) of
+ true ->
+ t_tuple([t_nil(), t_nil()]);
+ false -> % Ps is a proper list of pairs
+ TupleTypes = t_tuple_subtypes(t_list_elements(Ps)),
+ lists:foldl(fun(Tuple, Acc) ->
+ [A, B] = t_tuple_args(Tuple),
+ t_sup(t_tuple([t_list(A), t_list(B)]), Acc)
+ end, t_none(), TupleTypes)
+ end
+ end);
+type(lists, unzip3, 1, Xs) ->
+ strict(arg_types(lists, unzip3, 1), Xs,
+ fun ([Ts]) ->
+ case t_is_nil(Ts) of
+ true ->
+ t_tuple([t_nil(), t_nil(), t_nil()]);
+ false -> % Ps is a proper list of triples
+ TupleTypes = t_tuple_subtypes(t_list_elements(Ts)),
+ lists:foldl(fun(T, Acc) ->
+ [A, B, C] = t_tuple_args(T),
+ t_sup(t_tuple([t_list(A),
+ t_list(B),
+ t_list(C)]),
+ Acc)
+ end, t_none(), TupleTypes)
+ end
+ end);
+type(lists, zip, 2, Xs) ->
+ strict(arg_types(lists, zip, 2), Xs,
+ fun ([As, Bs]) ->
+ case (t_is_nil(As) orelse t_is_nil(Bs)) of
+ true -> t_nil();
+ false ->
+ A = t_list_elements(As),
+ B = t_list_elements(Bs),
+ t_list(t_tuple([A, B]))
+ end
+ end);
+type(lists, zip3, 3, Xs) ->
+ strict(arg_types(lists, zip3, 3), Xs,
+ fun ([As, Bs, Cs]) ->
+ case (t_is_nil(As) orelse t_is_nil(Bs) orelse t_is_nil(Cs)) of
+ true -> t_nil();
+ false ->
+ A = t_list_elements(As),
+ B = t_list_elements(Bs),
+ C = t_list_elements(Cs),
+ t_list(t_tuple([A, B, C]))
+ end
+ end);
+type(lists, zipwith, 3, Xs) ->
+ strict(arg_types(lists, zipwith, 3), Xs,
+ fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end);
+type(lists, zipwith3, 4, Xs) ->
+ strict(arg_types(lists, zipwith3, 4), Xs,
+ fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end);
+%%-- math ---------------------------------------------------------------------
+type(math, acos, 1, Xs) ->
+ strict(arg_types(math, acos, 1), Xs, fun (_) -> t_float() end);
+type(math, acosh, 1, Xs) ->
+ strict(arg_types(math, acosh, 1), Xs, fun (_) -> t_float() end);
+type(math, asin, 1, Xs) ->
+ strict(arg_types(math, asin, 1), Xs, fun (_) -> t_float() end);
+type(math, asinh, 1, Xs) ->
+ strict(arg_types(math, asinh, 1), Xs, fun (_) -> t_float() end);
+type(math, atan, 1, Xs) ->
+ strict(arg_types(math, atan, 1), Xs, fun (_) -> t_float() end);
+type(math, atan2, 2, Xs) ->
+ strict(arg_types(math, atan2, 2), Xs, fun (_) -> t_float() end);
+type(math, atanh, 1, Xs) ->
+ strict(arg_types(math, atanh, 1), Xs, fun (_) -> t_float() end);
+type(math, cos, 1, Xs) ->
+ strict(arg_types(math, cos, 1), Xs, fun (_) -> t_float() end);
+type(math, cosh, 1, Xs) ->
+ strict(arg_types(math, cosh, 1), Xs, fun (_) -> t_float() end);
+type(math, erf, 1, Xs) ->
+ strict(arg_types(math, erf, 1), Xs, fun (_) -> t_float() end);
+type(math, erfc, 1, Xs) ->
+ strict(arg_types(math, erfc, 1), Xs, fun (_) -> t_float() end);
+type(math, exp, 1, Xs) ->
+ strict(arg_types(math, exp, 1), Xs, fun (_) -> t_float() end);
+type(math, log, 1, Xs) ->
+ strict(arg_types(math, log, 1), Xs, fun (_) -> t_float() end);
+type(math, log10, 1, Xs) ->
+ strict(arg_types(math, log10, 1), Xs, fun (_) -> t_float() end);
+type(math, pi, 0, _) -> t_float();
+type(math, pow, 2, Xs) ->
+ strict(arg_types(math, pow, 2), Xs, fun (_) -> t_float() end);
+type(math, sin, 1, Xs) ->
+ strict(arg_types(math, sin, 1), Xs, fun (_) -> t_float() end);
+type(math, sinh, 1, Xs) ->
+ strict(arg_types(math, sinh, 1), Xs, fun (_) -> t_float() end);
+type(math, sqrt, 1, Xs) ->
+ strict(arg_types(math, sqrt, 1), Xs, fun (_) -> t_float() end);
+type(math, tan, 1, Xs) ->
+ strict(arg_types(math, tan, 1), Xs, fun (_) -> t_float() end);
+type(math, tanh, 1, Xs) ->
+ strict(arg_types(math, tanh, 1), Xs, fun (_) -> t_float() end);
+%%-- net_kernel ---------------------------------------------------------------
+type(net_kernel, dflag_unicode_io, 1, Xs) ->
+ strict(arg_types(net_kernel, dflag_unicode_io, 1), Xs,
+ fun (_) -> t_boolean() end);
+%%-- ordsets ------------------------------------------------------------------
+type(ordsets, filter, 2, Xs) ->
+ type(lists, filter, 2, Xs);
+type(ordsets, fold, 3, Xs) ->
+ type(lists, foldl, 3, Xs);
+%%-- os -----------------------------------------------------------------------
+type(os, getenv, 0, _) -> t_list(t_string());
+type(os, getenv, 1, Xs) ->
+ strict(arg_types(os, getenv, 1), Xs,
+ fun (_) -> t_sup(t_string(), t_atom('false')) end);
+type(os, getpid, 0, _) -> t_string();
+type(os, putenv, 2, Xs) ->
+ strict(arg_types(os, putenv, 2), Xs, fun (_) -> t_atom('true') end);
+%%-- re -----------------------------------------------------------------------
+type(re, compile, 1, Xs) ->
+ strict(arg_types(re, compile, 1), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_re_MP()]),
+ t_tuple([t_atom('error'), t_re_ErrorSpec()]))
+ end);
+type(re, compile, 2, Xs) ->
+ strict(arg_types(re, compile, 2), Xs,
+ fun (_) ->
+ t_sup(t_tuple([t_atom('ok'), t_re_MP()]),
+ t_tuple([t_atom('error'), t_re_ErrorSpec()]))
+ end);
+type(re, run, 2, Xs) ->
+ strict(arg_types(re, run, 2), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('match'), t_re_Captured()]),
+ t_atom('nomatch'),
+ t_tuple([t_atom('error'), t_re_ErrorSpec()])])
+ end);
+type(re, run, 3, Xs) ->
+ strict(arg_types(re, run, 3), Xs,
+ fun (_) ->
+ t_sup([t_tuple([t_atom('match'), t_re_Captured()]),
+ t_atom('match'),
+ t_atom('nomatch'),
+ t_tuple([t_atom('error'), t_re_ErrorSpec()])])
+ end);
+%%-- string -------------------------------------------------------------------
+type(string, chars, 2, Xs) -> % NOTE: added to avoid loss of information
+ strict(arg_types(string, chars, 2), Xs, fun (_) -> t_string() end);
+type(string, chars, 3, Xs) -> % NOTE: added to avoid loss of information
+ strict(arg_types(string, chars, 3), Xs,
+ fun ([Char, N, Tail]) ->
+ case t_is_nil(Tail) of
+ true ->
+ type(string, chars, 2, [Char, N]);
+ false ->
+ case t_is_string(Tail) of
+ true ->
+ t_string();
+ false ->
+ t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail))
+ end
+ end
+ end);
+type(string, concat, 2, Xs) -> % NOTE: added to avoid loss of information
+ strict(arg_types(string, concat, 2), Xs, fun (_) -> t_string() end);
+type(string, equal, 2, Xs) -> % NOTE: added to avoid loss of information
+ strict(arg_types(string, equal, 2), Xs, fun (_) -> t_boolean() end);
+type(string, to_float, 1, Xs) ->
+ strict(arg_types(string, to_float, 1), Xs,
+ fun (_) -> t_sup(t_tuple([t_float(), t_string()]),
+ t_tuple([t_atom('error'),
+ t_sup(t_atom('no_float'),
+ t_atom('not_a_list'))]))
+ end);
+type(string, to_integer, 1, Xs) ->
+ strict(arg_types(string, to_integer, 1), Xs,
+ fun (_) -> t_sup(t_tuple([t_integer(), t_string()]),
+ t_tuple([t_atom('error'),
+ t_sup(t_atom('no_integer'),
+ t_atom('not_a_list'))]))
+ end);
+%%-- unicode ------------------------------------------------------------------
+type(unicode, characters_to_binary, 2, Xs) ->
+ strict(arg_types(unicode, characters_to_binary, 2), Xs,
+ fun (_) ->
+ t_sup([t_binary(),
+ t_tuple([t_atom('error'), t_binary(), t_ML()]),
+ t_tuple([t_atom('incomplete'), t_binary(), t_ML()])])
+ end);
+type(unicode, characters_to_list, 2, Xs) ->
+ strict(arg_types(unicode, characters_to_list, 2), Xs,
+ fun (_) ->
+ t_sup([t_string(),
+ t_tuple([t_atom('error'), t_string(), t_ML()]),
+ t_tuple([t_atom('incomplete'), t_string(), t_ML()])])
+ end);
+type(unicode, bin_is_7bit, 1, Xs) ->
+ strict(arg_types(unicode, bin_is_7bit, 1), Xs, fun (_) -> t_boolean() end);
+
+%%-----------------------------------------------------------------------------
+type(M, F, A, Xs) when is_atom(M), is_atom(F),
+ is_integer(A), 0 =< A, A =< 255 ->
+ strict(Xs, t_any()). % safe approximation for all functions.
+
+
+%%-----------------------------------------------------------------------------
+%% Auxiliary functions
+%%-----------------------------------------------------------------------------
+
+strict(Xs, Ts, F) ->
+ %% io:format("inf lists arg~n1:~p~n2:~p ~n", [Xs, Ts]),
+ Xs1 = inf_lists(Xs, Ts),
+ %% io:format("inf lists return ~p ~n", [Xs1]),
+ case any_is_none_or_unit(Xs1) of
+ true -> t_none();
+ false -> F(Xs1)
+ end.
+
+strict(Xs, X) ->
+ case any_is_none_or_unit(Xs) of
+ true -> t_none();
+ false -> X
+ end.
+
+inf_lists([X | Xs], [T | Ts]) ->
+ [t_inf(X, T) | inf_lists(Xs, Ts)];
+inf_lists([], []) ->
+ [].
+
+any_list(N) -> any_list(N, t_any()).
+
+any_list(N, A) when N > 0 ->
+ [A | any_list(N - 1, A)];
+any_list(0, _) ->
+ [].
+
+list_replace(N, E, [X | Xs]) when N > 1 ->
+ [X | list_replace(N - 1, E, Xs)];
+list_replace(1, E, [_X | Xs]) ->
+ [E | Xs].
+
+any_is_none_or_unit(Ts) ->
+ lists:any(fun erl_types:t_is_none_or_unit/1, Ts).
+
+all_is_none(Ts) ->
+ lists:all(fun erl_types:t_is_none/1, Ts).
+
+check_guard([X], Test, Type) ->
+ check_guard_single(X, Test, Type).
+
+check_guard_single(X, Test, Type) ->
+ case Test(X) of
+ true -> t_atom('true');
+ false ->
+ case erl_types:t_is_opaque(X) of
+ true -> t_none();
+ false ->
+ case t_is_none(t_inf(Type, X)) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Functions for range analysis
+%%-----------------------------------------------------------------------------
+
+infinity_max([]) -> empty;
+infinity_max([H|T]) ->
+ if H =:= empty ->
+ infinity_max(T);
+ true ->
+ lists:foldl(
+ fun (Elem, Max) ->
+ Geq = infinity_geq(Elem, Max),
+ if not Geq orelse (Elem =:= empty) ->
+ Max;
+ true ->
+ Elem
+ end
+ end,
+ H,
+ T)
+ end.
+
+infinity_min([]) -> empty;
+infinity_min([H|T]) ->
+ if H =:= empty ->
+ infinity_min(T);
+ true ->
+ lists:foldl(fun (Elem, Min) ->
+ Geq = infinity_geq(Elem, Min),
+ if Geq orelse (Elem =:= empty) ->
+ Min;
+ true ->
+ Elem
+ end
+ end,
+ H,
+ T)
+ end.
+
+-type inf_integer() :: 'neg_inf' | 'pos_inf' | integer().
+
+-spec infinity_abs('pos_inf' | 'neg_inf') -> 'pos_inf'
+ ; (integer()) -> non_neg_integer().
+
+infinity_abs(pos_inf) -> pos_inf;
+infinity_abs(neg_inf) -> pos_inf;
+infinity_abs(Number) when is_integer(Number) -> abs(Number).
+
+%% span_zero(Range) ->
+%% infinity_geq(0, number_min(Range)) and infinity_geq(number_max(Range), 0).
+
+infinity_inv(pos_inf) -> neg_inf;
+infinity_inv(neg_inf) -> pos_inf;
+infinity_inv(Number) when is_integer(Number) -> -Number.
+
+infinity_band(neg_inf, Type2) -> Type2;
+%% infinity_band(Type1, neg_inf) -> Type1;
+infinity_band(pos_inf, Type2) -> Type2;
+%% infinity_band(Type1, pos_inf) -> Type1;
+infinity_band(Type1, Type2) when is_integer(Type1), is_integer(Type2) ->
+ Type1 band Type2.
+
+infinity_bor(neg_inf, _Type2) -> neg_inf;
+%% infinity_bor(_Type1, neg_inf) -> neg_inf;
+infinity_bor(pos_inf, _Type2) -> pos_inf;
+%% infinity_bor(_Type1, pos_inf) -> pos_inf;
+infinity_bor(Type1, Type2) when is_integer(Type1), is_integer(Type2) ->
+ Type1 bor Type2.
+
+infinity_div(pos_inf, pos_inf) -> [0, pos_inf];
+infinity_div(pos_inf, neg_inf) -> [neg_inf, 0];
+infinity_div(neg_inf, neg_inf) -> [0, pos_inf];
+infinity_div(neg_inf, pos_inf) -> [neg_inf, 0];
+infinity_div(pos_inf, Number) when is_integer(Number), Number > 0 -> pos_inf;
+infinity_div(pos_inf, Number) when is_integer(Number), Number < 0 -> neg_inf;
+infinity_div(neg_inf, Number) when is_integer(Number), Number > 0 -> neg_inf;
+infinity_div(neg_inf, Number) when is_integer(Number), Number < 0 -> pos_inf;
+infinity_div(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf;
+infinity_div(Number, pos_inf) when is_integer(Number), Number < 0 -> neg_inf;
+infinity_div(Number, neg_inf) when is_integer(Number), Number >= 0 -> neg_inf;
+infinity_div(Number, neg_inf) when is_integer(Number), Number < 0 -> pos_inf;
+infinity_div(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ Number1 div Number2.
+
+infinity_bsl(pos_inf, _) -> pos_inf;
+infinity_bsl(neg_inf, _) -> neg_inf;
+infinity_bsl(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf;
+infinity_bsl(Number, pos_inf) when is_integer(Number) -> neg_inf;
+infinity_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0;
+infinity_bsl(Number, neg_inf) when is_integer(Number) -> -1;
+infinity_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ Bits = ?BITS,
+ if Number2 > (Bits * 2) -> infinity_bsl(Number1, pos_inf);
+ Number2 < (-Bits * 2) -> infinity_bsl(Number1, neg_inf);
+ true -> Number1 bsl Number2
+ end.
+
+infinity_geq(pos_inf, _) -> true;
+infinity_geq(_, pos_inf) -> false;
+infinity_geq(_, neg_inf) -> true;
+infinity_geq(neg_inf, _) -> false;
+infinity_geq(A, B) when is_integer(A), is_integer(B) -> A >= B.
+
+-spec infinity_add(inf_integer(), inf_integer()) -> inf_integer().
+
+infinity_add(pos_inf, _Number) -> pos_inf;
+infinity_add(neg_inf, _Number) -> neg_inf;
+infinity_add(_Number, pos_inf) -> pos_inf;
+infinity_add(_Number, neg_inf) -> neg_inf;
+infinity_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ Number1 + Number2.
+
+infinity_mult(neg_inf, Number) ->
+ Greater = infinity_geq(Number, 0),
+ if Greater -> neg_inf;
+ true -> pos_inf
+ end;
+infinity_mult(pos_inf, Number) -> infinity_inv(infinity_mult(neg_inf, Number));
+infinity_mult(Number, pos_inf) -> infinity_inv(infinity_mult(neg_inf, Number));
+infinity_mult(Number, neg_inf) -> infinity_mult(neg_inf, Number);
+infinity_mult(Number1, Number2) when is_integer(Number1), is_integer(Number2)->
+ Number1 * Number2.
+
+width({Min, Max}) -> infinity_max([width(Min), width(Max)]);
+width(pos_inf) -> pos_inf;
+width(neg_inf) -> pos_inf;
+width(X) when is_integer(X), X >= 0 -> poswidth(X, 0);
+width(X) when is_integer(X), X < 0 -> negwidth(X, 0).
+
+poswidth(X, N) ->
+ case X < (1 bsl N) of
+ true -> N;
+ false -> poswidth(X, N+1)
+ end.
+
+negwidth(X, N) ->
+ case X >= (-1 bsl N) of
+ true -> N;
+ false -> negwidth(X, N+1)
+ end.
+
+arith('bnot', X1) ->
+ case t_is_integer(X1) of
+ false -> error;
+ true ->
+ Min1 = number_min(X1),
+ Max1 = number_max(X1),
+ {ok, t_from_range(infinity_add(infinity_inv(Max1), -1),
+ infinity_add(infinity_inv(Min1), -1))}
+ end.
+
+arith_mult(Min1, Max1, Min2, Max2) ->
+ Tmp_list = [infinity_mult(Min1, Min2), infinity_mult(Min1, Max2),
+ infinity_mult(Max1, Min2), infinity_mult(Max1, Max2)],
+ {infinity_min(Tmp_list), infinity_max(Tmp_list)}.
+
+arith_div(_Min1, _Max1, 0, 0) ->
+ %% Signal failure.
+ {pos_inf, neg_inf};
+arith_div(Min1, Max1, Min2, Max2) ->
+ %% 0 is not an accepted divisor.
+ NewMin2 = if Min2 =:= 0 -> 1;
+ true -> Min2
+ end,
+ NewMax2 = if Max2 =:= 0 -> -1;
+ true -> Max2
+ end,
+ Tmp_list = lists:flatten([infinity_div(Min1, NewMin2),
+ infinity_div(Min1, NewMax2),
+ infinity_div(Max1, NewMin2),
+ infinity_div(Max1, NewMax2)]),
+ {infinity_min(Tmp_list), infinity_max(Tmp_list)}.
+
+arith_rem(Min1, Max1, Min2, Max2) ->
+ Min1_geq_zero = infinity_geq(Min1, 0),
+ Max1_leq_zero = infinity_geq(0, Max1),
+ Max_range2 = infinity_max([infinity_abs(Min2), infinity_abs(Max2)]),
+ Max_range2_leq_zero = infinity_geq(0, Max_range2),
+ New_min =
+ if Min1_geq_zero -> 0;
+ Max_range2 =:= 0 -> 0;
+ Max_range2_leq_zero -> infinity_add(Max_range2, 1);
+ true -> infinity_add(infinity_inv(Max_range2), 1)
+ end,
+ New_max =
+ if Max1_leq_zero -> 0;
+ Max_range2 =:= 0 -> 0;
+ Max_range2_leq_zero -> infinity_add(infinity_inv(Max_range2), -1);
+ true -> infinity_add(Max_range2, -1)
+ end,
+ {New_min, New_max}.
+
+arith_bsl(Min1, Max1, Min2, Max2) ->
+ case infinity_geq(Min1, 0) of
+ true -> {infinity_bsl(Min1, Min2), infinity_bsl(Max1, Max2)};
+ false ->
+ case infinity_geq(Max1, 0) of
+ true -> {infinity_bsl(Min1, Max2), infinity_bsl(Max1, Max2)};
+ false -> {infinity_bsl(Min1, Max2), infinity_bsl(Max2, Min2)}
+ end
+ end.
+
+arith_band_range_set({Min, Max}, [Int|IntList]) ->
+ SafeAnd = lists:foldl(
+ fun (IntFromSet, SafeAndAcc) ->
+ IntFromSet bor SafeAndAcc
+ end,
+ Int,
+ IntList),
+ {infinity_band(Min, SafeAnd), infinity_band(Max, SafeAnd)}.
+
+arith_bor_range_set({Min, Max}, [Int|IntList]) ->
+ SafeAnd = lists:foldl(
+ fun (IntFromSet, SafeAndAcc) ->
+ IntFromSet band SafeAndAcc
+ end,
+ Int,
+ IntList),
+ {infinity_bor(Min, SafeAnd), infinity_bor(Max, SafeAnd)}.
+
+arith_band(X1, X2) ->
+ L1 = t_number_vals(X1),
+ L2 = t_number_vals(X2),
+ Min1 = number_min(X1),
+ Max1 = number_max(X1),
+ Min2 = number_min(X2),
+ Max2 = number_max(X2),
+ case {L1 =:= unknown, L2 =:= unknown} of
+ {true, false} ->
+ arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L2);
+ {false, true} ->
+ arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L1);
+ {true, true} ->
+ arith_band_ranges(Min1, Max1, Min2, Max2)
+ end.
+
+arith_bor(X1, X2) ->
+ L1 = t_number_vals(X1),
+ L2 = t_number_vals(X2),
+ Min1 = number_min(X1),
+ Max1 = number_max(X1),
+ Min2 = number_min(X2),
+ Max2 = number_max(X2),
+ case {L1 =:= unknown, L2 =:= unknown} of
+ {true, false} ->
+ arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L2);
+ {false, true} ->
+ arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L1);
+ {true, true} ->
+ arith_bor_ranges(Min1, Max1, Min2, Max2)
+ end.
+
+arith_band_ranges(Min1, Max1, Min2, Max2) ->
+ Width = infinity_min([width({Min1, Max1}), width({Min2, Max2})]),
+ Min =
+ case infinity_geq(Min1, 0) orelse infinity_geq(Min2, 0) of
+ true -> 0;
+ false -> infinity_bsl(-1, Width)
+ end,
+ Max =
+ case infinity_geq(Max1, 0) orelse infinity_geq(Max2, 0) of
+ true -> infinity_add(infinity_bsl(1, Width), -1);
+ false -> 0
+ end,
+ {Min, Max}.
+
+arith_bor_ranges(Min1, Max1, Min2, Max2) ->
+ Width = infinity_max([width({Min1, Max1}), width({Min2, Max2})]),
+ Min =
+ case infinity_geq(Min1, 0) andalso infinity_geq(Min2, 0) of
+ true -> 0;
+ false -> infinity_bsl(-1, Width)
+ end,
+ Max =
+ case infinity_geq(Max1, 0) andalso infinity_geq(Max2, 0) of
+ true -> infinity_add(infinity_bsl(1, Width), -1);
+ false -> -1
+ end,
+ {Min, Max}.
+
+arith(Op, X1, X2) ->
+ %% io:format("arith ~p ~p ~p~n", [Op, X1, X2]),
+ case t_is_integer(X1) andalso t_is_integer(X2) of
+ false -> error;
+ true ->
+ L1 = t_number_vals(X1),
+ L2 = t_number_vals(X2),
+ case (L1 =:= unknown) orelse (L2 =:= unknown) of
+ true ->
+ Min1 = number_min(X1),
+ Max1 = number_max(X1),
+ Min2 = number_min(X2),
+ Max2 = number_max(X2),
+ {NewMin, NewMax} =
+ case Op of
+ '+' -> {infinity_add(Min1, Min2), infinity_add(Max1, Max2)};
+ '-' -> {infinity_add(Min1, infinity_inv(Max2)),
+ infinity_add(Max1, infinity_inv(Min2))};
+ '*' -> arith_mult(Min1, Max1, Min2, Max2);
+ 'div' -> arith_div(Min1, Max1, Min2, Max2);
+ 'rem' -> arith_rem(Min1, Max1, Min2, Max2);
+ 'bsl' -> arith_bsl(Min1, Max1, Min2, Max2);
+ 'bsr' -> NewMin2 = infinity_inv(Max2),
+ NewMax2 = infinity_inv(Min2),
+ arith_bsl(Min1, Max1, NewMin2, NewMax2);
+ 'band' -> arith_band(X1, X2);
+ 'bor' -> arith_bor(X1, X2);
+ 'bxor' -> arith_bor_ranges(Min1, Max1, Min2, Max2) %% overaprox.
+ end,
+ %% io:format("done arith ~p = ~p~n", [Op, {NewMin, NewMax}]),
+ {ok, t_from_range(NewMin, NewMax)};
+ false ->
+ AllVals =
+ case Op of
+ '+' -> [X + Y || X <- L1, Y <- L2];
+ '-' -> [X - Y || X <- L1, Y <- L2];
+ '*' -> [X * Y || X <- L1, Y <- L2];
+ 'div' -> [X div Y || X <- L1, Y <- L2,Y =/= 0];
+ 'rem' -> [X rem Y || X <- L1, Y <- L2,Y =/= 0];
+ 'bsl' -> [X bsl Y || X <- L1, Y <- L2];
+ 'bsr' -> [X bsr Y || X <- L1, Y <- L2];
+ 'band' -> [X band Y || X <- L1, Y <- L2];
+ 'bor' -> [X bor Y || X <- L1, Y <- L2];
+ 'bxor' -> [X bxor Y || X <- L1, Y <- L2]
+ end,
+ {ok, t_integers(ordsets:from_list(AllVals))}
+ end
+ end.
+
+%%=============================================================================
+
+-spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'.
+
+%%------- code ----------------------------------------------------------------
+arg_types(code, add_path, 1) ->
+ [t_string()];
+arg_types(code, add_patha, 1) ->
+ arg_types(code, add_path, 1);
+arg_types(code, add_paths, 1) ->
+ [t_list(t_string())];
+arg_types(code, add_pathsa, 1) ->
+ arg_types(code, add_paths, 1);
+arg_types(code, add_pathsz, 1) ->
+ arg_types(code, add_paths, 1);
+arg_types(code, add_pathz, 1) ->
+ arg_types(code, add_path, 1);
+arg_types(code, all_loaded, 0) ->
+ [];
+arg_types(code, compiler_dir, 0) ->
+ [];
+arg_types(code, del_path, 1) ->
+ [t_sup(t_string(), t_atom())]; % OBS: doc differs from add_path/1 - why?
+arg_types(code, delete, 1) ->
+ [t_atom()];
+arg_types(code, ensure_loaded, 1) ->
+ arg_types(code, load_file, 1);
+arg_types(code, get_chunk, 2) ->
+ [t_binary(), t_string()];
+arg_types(code, get_object_code, 1) ->
+ [t_atom()];
+arg_types(code, get_path, 0) ->
+ [];
+arg_types(code, is_loaded, 1) ->
+ [t_atom()];
+arg_types(code, is_sticky, 1) ->
+ [t_atom()];
+arg_types(code, is_module_native, 1) ->
+ [t_atom()];
+arg_types(code, lib_dir, 0) ->
+ [];
+arg_types(code, lib_dir, 1) ->
+ [t_atom()];
+arg_types(code, load_abs, 1) ->
+ [t_string()];
+arg_types(code, load_abs, 2) ->
+ [t_code_loaded_fname_or_status(), t_atom()];
+arg_types(code, load_binary, 3) ->
+ [t_atom(), t_code_loaded_fname_or_status(), t_binary()];
+arg_types(code, load_file, 1) ->
+ [t_atom()];
+arg_types(code, load_native_partial, 2) ->
+ [t_atom(), t_binary()];
+arg_types(code, load_native_sticky, 3) ->
+ [t_atom(), t_binary(), t_sup(t_binary(), t_atom('false'))];
+arg_types(code, module_md5, 1) ->
+ [t_binary()];
+arg_types(code, make_stub_module, 3) ->
+ [t_atom(), t_binary(), t_tuple([t_list(), t_list()])];
+arg_types(code, priv_dir, 1) ->
+ [t_atom()];
+arg_types(code, purge, 1) ->
+ arg_types(code, delete, 1);
+arg_types(code, rehash, 0) ->
+ [];
+arg_types(code, replace_path, 2) ->
+ [t_atom(), t_string()];
+arg_types(code, root_dir, 0) ->
+ [];
+arg_types(code, set_path, 1) ->
+ [t_string()];
+arg_types(code, soft_purge, 1) ->
+ arg_types(code, delete, 1);
+arg_types(code, stick_mod, 1) ->
+ [t_atom()];
+arg_types(code, unstick_mod, 1) ->
+ arg_types(code, stick_mod, 1);
+arg_types(code, which, 1) ->
+ [t_atom()];
+%%------- erl_ddll ------------------------------------------------------------
+arg_types(erl_ddll, demonitor, 1) ->
+ arg_types(erlang, demonitor, 1);
+arg_types(erl_ddll, format_error_int, 1) ->
+ [t_sup([t_atom('inconsistent'),
+ t_atom('linked_in_driver'),
+ t_atom('permanent'),
+ t_atom('not_loaded'),
+ t_atom('not_loaded_by_this_process'),
+ t_atom('not_pending'),
+ t_atom('already_loaded'),
+ t_atom('unloading')])];
+arg_types(erl_ddll, info, 2) ->
+ [t_sup([t_atom(), t_string()]),
+ t_sup([t_atom('awaiting_load'),
+ t_atom('awaiting_unload'),
+ t_atom('driver_options'),
+ t_atom('linked_in_driver'),
+ t_atom('permanent'),
+ t_atom('port_count'),
+ t_atom('processes')])];
+arg_types(erl_ddll, loaded_drivers, 0) ->
+ [];
+arg_types(erl_ddll, monitor, 2) ->
+ [t_atom('driver'),
+ t_tuple([t_atom(), t_sup([t_atom('loaded'), t_atom('unloaded')])])];
+arg_types(erl_ddll, try_load, 3) ->
+ [t_sup([t_atom(), t_string(), t_nonempty_list(t_sup([t_atom(), t_string()]))]),
+ t_sup([t_atom(), t_string()]),
+ t_list(t_sup([t_tuple([t_atom('driver_options'),
+ t_list(t_atom('kill_ports'))]),
+ t_tuple([t_atom('monitor'),
+ t_sup([t_atom('pending_driver'),
+ t_atom('pending')])]),
+ t_tuple([t_atom('reload'),
+ t_sup([t_atom('pending_driver'),
+ t_atom('pending')])])]))];
+arg_types(erl_ddll, try_unload, 2) ->
+ [t_sup([t_atom(), t_string(), t_nonempty_list(t_sup([t_atom(), t_string()]))]),
+ t_list(t_sup([t_atom('kill_ports'),
+ t_tuple([t_atom('monitor'),
+ t_sup([t_atom('pending_driver'),
+ t_atom('pending')])])]))];
+%%------- erlang --------------------------------------------------------------
+arg_types(erlang, '!', 2) ->
+ Pid = t_sup([t_pid(), t_port(), t_atom(),
+ t_tuple([t_atom(), t_node()])]),
+ [Pid, t_any()];
+arg_types(erlang, '==', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '/=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '=:=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '=/=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '>', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '>=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '<', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '=<', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '+', 1) ->
+ [t_number()];
+arg_types(erlang, '+', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, '++', 2) ->
+ [t_list(), t_any()];
+arg_types(erlang, '-', 1) ->
+ [t_number()];
+arg_types(erlang, '-', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, '--', 2) ->
+ [t_list(), t_list()];
+arg_types(erlang, '*', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, '/', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, 'div', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'rem', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'and', 2) ->
+ [t_boolean(), t_boolean()];
+arg_types(erlang, 'or', 2) ->
+ [t_boolean(), t_boolean()];
+arg_types(erlang, 'xor', 2) ->
+ [t_boolean(), t_boolean()];
+arg_types(erlang, 'not', 1) ->
+ [t_boolean()];
+arg_types(erlang, 'band', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bor', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bxor', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bsr', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bsl', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bnot', 1) ->
+ [t_integer()];
+arg_types(erlang, abs, 1) ->
+ [t_number()];
+arg_types(erlang, append_element, 2) ->
+ [t_tuple(), t_any()];
+arg_types(erlang, apply, 2) ->
+ [t_sup(t_tuple([t_sup(t_atom(), % module name
+ t_tuple()), % parameterized module
+ t_atom()]),
+ t_fun()),
+ t_list()];
+arg_types(erlang, apply, 3) ->
+ [t_sup(t_atom(), t_tuple()), t_atom(), t_list()];
+arg_types(erlang, atom_to_binary, 2) ->
+ [t_atom(), t_encoding_a2b()];
+arg_types(erlang, atom_to_list, 1) ->
+ [t_atom()];
+arg_types(erlang, binary_to_atom, 2) ->
+ [t_binary(), t_encoding_a2b()];
+arg_types(erlang, binary_to_existing_atom, 2) ->
+ arg_types(erlang, binary_to_atom, 2);
+arg_types(erlang, binary_to_list, 1) ->
+ [t_binary()];
+arg_types(erlang, binary_to_list, 3) ->
+ [t_binary(), t_pos_integer(), t_pos_integer()]; % I want fixnum, but cannot
+arg_types(erlang, binary_to_term, 1) ->
+ [t_binary()];
+arg_types(erlang, bitsize, 1) -> % XXX: TAKE OUT
+ arg_types(erlang, bit_size, 1);
+arg_types(erlang, bit_size, 1) ->
+ [t_bitstr()];
+arg_types(erlang, bitstr_to_list, 1) -> % XXX: TAKE OUT
+ arg_types(erlang, bitstring_to_list, 1);
+arg_types(erlang, bitstring_to_list, 1) ->
+ [t_bitstr()];
+arg_types(erlang, bump_reductions, 1) ->
+ [t_pos_fixnum()];
+arg_types(erlang, byte_size, 1) ->
+ [t_binary()];
+arg_types(erlang, cancel_timer, 1) ->
+ [t_reference()];
+arg_types(erlang, check_process_code, 2) ->
+ [t_pid(), t_atom()];
+arg_types(erlang, concat_binary, 1) ->
+ [t_list(t_binary())];
+arg_types(erlang, crc32, 1) ->
+ [t_iodata()];
+arg_types(erlang, crc32, 2) ->
+ [t_integer(), t_iodata()];
+arg_types(erlang, crc32_combine, 3) ->
+ [t_integer(), t_integer(), t_integer()];
+arg_types(erlang, date, 0) ->
+ [];
+arg_types(erlang, decode_packet, 3) ->
+ [t_decode_packet_type(), t_binary(), t_list(t_decode_packet_option())];
+arg_types(erlang, delete_module, 1) ->
+ [t_atom()];
+arg_types(erlang, demonitor, 1) ->
+ [t_reference()];
+arg_types(erlang, demonitor, 2) ->
+ [t_reference(), t_list(t_atoms(['flush', 'info']))];
+arg_types(erlang, disconnect_node, 1) ->
+ [t_node()];
+arg_types(erlang, display, 1) ->
+ [t_any()];
+arg_types(erlang, dist_exit, 3) ->
+ [t_pid(), t_dist_exit(), t_sup(t_pid(), t_port())];
+arg_types(erlang, element, 2) ->
+ [t_pos_fixnum(), t_tuple()];
+arg_types(erlang, erase, 0) ->
+ [];
+arg_types(erlang, erase, 1) ->
+ [t_any()];
+arg_types(erlang, error, 1) ->
+ [t_any()];
+arg_types(erlang, error, 2) ->
+ [t_any(), t_list()];
+arg_types(erlang, exit, 1) ->
+ [t_any()];
+arg_types(erlang, exit, 2) ->
+ [t_sup(t_pid(), t_port()), t_any()];
+arg_types(erlang, external_size, 1) ->
+ [t_any()]; % takes any term as input
+arg_types(erlang, float, 1) ->
+ [t_number()];
+arg_types(erlang, float_to_list, 1) ->
+ [t_float()];
+arg_types(erlang, function_exported, 3) ->
+ [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, fun_info, 1) ->
+ [t_fun()];
+arg_types(erlang, fun_info, 2) ->
+ [t_fun(), t_atom()];
+arg_types(erlang, fun_to_list, 1) ->
+ [t_fun()];
+arg_types(erlang, garbage_collect, 0) ->
+ [];
+arg_types(erlang, garbage_collect, 1) ->
+ [t_pid()];
+arg_types(erlang, get, 0) ->
+ [];
+arg_types(erlang, get, 1) ->
+ [t_any()];
+arg_types(erlang, get_cookie, 0) ->
+ [];
+arg_types(erlang, get_keys, 1) ->
+ [t_any()];
+arg_types(erlang, get_stacktrace, 0) ->
+ [];
+arg_types(erlang, get_module_info, 1) ->
+ [t_atom()];
+arg_types(erlang, get_module_info, 2) ->
+ [t_atom(), t_module_info_2()];
+arg_types(erlang, group_leader, 0) ->
+ [];
+arg_types(erlang, group_leader, 2) ->
+ [t_pid(), t_pid()];
+arg_types(erlang, halt, 0) ->
+ [];
+arg_types(erlang, halt, 1) ->
+ [t_sup(t_non_neg_fixnum(), t_string())];
+arg_types(erlang, hash, 2) ->
+ [t_any(), t_integer()];
+arg_types(erlang, hd, 1) ->
+ [t_cons()];
+arg_types(erlang, hibernate, 3) ->
+ [t_atom(), t_atom(), t_list()];
+arg_types(erlang, info, 1) ->
+ arg_types(erlang, system_info, 1); % alias
+arg_types(erlang, iolist_to_binary, 1) ->
+ [t_sup(t_iolist(), t_binary())];
+arg_types(erlang, iolist_size, 1) ->
+ [t_sup(t_iolist(), t_binary())];
+arg_types(erlang, integer_to_list, 1) ->
+ [t_integer()];
+arg_types(erlang, is_alive, 0) ->
+ [];
+arg_types(erlang, is_atom, 1) ->
+ [t_any()];
+arg_types(erlang, is_binary, 1) ->
+ [t_any()];
+arg_types(erlang, is_bitstr, 1) -> % XXX: TAKE OUT
+ arg_types(erlang, is_bitstring, 1);
+arg_types(erlang, is_bitstring, 1) ->
+ [t_any()];
+arg_types(erlang, is_boolean, 1) ->
+ [t_any()];
+arg_types(erlang, is_builtin, 3) ->
+ [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, is_constant, 1) ->
+ [t_any()];
+arg_types(erlang, is_float, 1) ->
+ [t_any()];
+arg_types(erlang, is_function, 1) ->
+ [t_any()];
+arg_types(erlang, is_function, 2) ->
+ [t_any(), t_arity()];
+arg_types(erlang, is_integer, 1) ->
+ [t_any()];
+arg_types(erlang, is_list, 1) ->
+ [t_any()];
+arg_types(erlang, is_number, 1) ->
+ [t_any()];
+arg_types(erlang, is_pid, 1) ->
+ [t_any()];
+arg_types(erlang, is_port, 1) ->
+ [t_any()];
+arg_types(erlang, is_process_alive, 1) ->
+ [t_pid()];
+arg_types(erlang, is_record, 2) ->
+ [t_any(), t_atom()];
+arg_types(erlang, is_record, 3) ->
+ [t_any(), t_atom(), t_pos_fixnum()];
+arg_types(erlang, is_reference, 1) ->
+ [t_any()];
+arg_types(erlang, is_tuple, 1) ->
+ [t_any()];
+arg_types(erlang, length, 1) ->
+ [t_list()];
+arg_types(erlang, link, 1) ->
+ [t_sup(t_pid(), t_port())];
+arg_types(erlang, list_to_atom, 1) ->
+ [t_string()];
+arg_types(erlang, list_to_binary, 1) ->
+ [t_iolist()];
+arg_types(erlang, list_to_bitstr, 1) -> % XXX: TAKE OUT
+ arg_types(erlang, list_to_bitstring, 1);
+arg_types(erlang, list_to_bitstring, 1) ->
+ [t_iolist()];
+arg_types(erlang, list_to_existing_atom, 1) ->
+ [t_string()];
+arg_types(erlang, list_to_float, 1) ->
+ [t_list(t_byte())];
+arg_types(erlang, list_to_integer, 1) ->
+ [t_list(t_byte())];
+arg_types(erlang, list_to_pid, 1) ->
+ [t_string()];
+arg_types(erlang, list_to_tuple, 1) ->
+ [t_list()];
+arg_types(erlang, loaded, 0) ->
+ [];
+arg_types(erlang, load_module, 2) ->
+ [t_atom(), t_binary()];
+arg_types(erlang, localtime, 0) ->
+ [];
+arg_types(erlang, localtime_to_universaltime, 1) ->
+ [t_tuple([t_date(), t_time()])];
+arg_types(erlang, localtime_to_universaltime, 2) ->
+ arg_types(erlang, localtime_to_universaltime, 1) ++
+ [t_sup(t_boolean(), t_atom('undefined'))];
+arg_types(erlang, make_fun, 3) ->
+ [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, make_ref, 0) ->
+ [];
+arg_types(erlang, make_tuple, 2) ->
+ [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument
+arg_types(erlang, make_tuple, 3) ->
+ [t_non_neg_fixnum(), t_any(), t_list(t_tuple([t_pos_integer(), t_any()]))];
+arg_types(erlang, match_spec_test, 3) ->
+ [t_sup(t_list(), t_tuple()),
+ t_any(),
+ t_sup(t_atom('table'), t_atom('trace'))];
+arg_types(erlang, md5, 1) ->
+ [t_sup(t_iolist(), t_binary())];
+arg_types(erlang, md5_final, 1) ->
+ [t_binary()];
+arg_types(erlang, md5_init, 0) ->
+ [];
+arg_types(erlang, md5_update, 2) ->
+ [t_binary(), t_sup(t_iolist(), t_binary())];
+arg_types(erlang, memory, 0) ->
+ [];
+arg_types(erlang, memory, 1) ->
+ Arg = t_atoms(['total', 'processes', 'processes_used', 'system',
+ 'atom', 'atom_used', 'binary', 'code', 'ets',
+ 'maximum']),
+ [t_sup(Arg, t_list(Arg))];
+arg_types(erlang, module_loaded, 1) ->
+ [t_atom()];
+arg_types(erlang, monitor, 2) ->
+ [t_atom(), t_sup([t_pid(), t_atom(), t_tuple([t_atom(), t_node()])])];
+arg_types(erlang, monitor_node, 2) ->
+ [t_node(), t_boolean()];
+arg_types(erlang, monitor_node, 3) ->
+ [t_node(), t_boolean(), t_list(t_atom('allow_passive_connect'))];
+arg_types(erlang, node, 0) ->
+ [];
+arg_types(erlang, node, 1) ->
+ [t_identifier()];
+arg_types(erlang, nodes, 0) ->
+ [];
+arg_types(erlang, nodes, 1) ->
+ NodesArg = t_atoms(['visible', 'hidden', 'connected', 'this', 'known']),
+ [t_sup(NodesArg, t_list(NodesArg))];
+arg_types(erlang, now, 0) ->
+ [];
+arg_types(erlang, open_port, 2) ->
+ [t_sup(t_atom(), t_sup([t_tuple([t_atom('spawn'), t_string()]),
+ t_tuple([t_atom('spawn_driver'), t_string()]),
+ t_tuple([t_atom('spawn_executable'), t_string()]),
+ t_tuple([t_atom('fd'), t_integer(), t_integer()])])),
+ t_list(t_sup(t_sup([t_atom('stream'),
+ t_atom('exit_status'),
+ t_atom('use_stdio'),
+ t_atom('nouse_stdio'),
+ t_atom('stderr_to_stdout'),
+ t_atom('in'),
+ t_atom('out'),
+ t_atom('binary'),
+ t_atom('eof'),
+ t_atom('hide')]),
+ t_sup([t_tuple([t_atom('packet'), t_integer()]),
+ t_tuple([t_atom('line'), t_integer()]),
+ t_tuple([t_atom('cd'), t_string()]),
+ t_tuple([t_atom('env'), t_list(t_tuple(2))]), % XXX: More
+ t_tuple([t_atom('args'), t_list(t_string())]),
+ t_tuple([t_atom('arg0'), t_string()])])))];
+arg_types(erlang, phash, 2) ->
+ [t_any(), t_pos_integer()];
+arg_types(erlang, phash2, 1) ->
+ [t_any()];
+arg_types(erlang, phash2, 2) ->
+ [t_any(), t_pos_integer()];
+arg_types(erlang, pid_to_list, 1) ->
+ [t_pid()];
+arg_types(erlang, port_call, 3) ->
+ [t_sup(t_port(), t_atom()), t_integer(), t_any()];
+arg_types(erlang, port_close, 1) ->
+ [t_sup(t_port(), t_atom())];
+arg_types(erlang, port_command, 2) ->
+ [t_sup(t_port(), t_atom()), t_sup(t_iolist(), t_binary())];
+arg_types(erlang, port_command, 3) ->
+ [t_sup(t_port(), t_atom()),
+ t_sup(t_iolist(), t_binary()),
+ t_list(t_atoms(['force', 'nosuspend']))];
+arg_types(erlang, port_connect, 2) ->
+ [t_sup(t_port(), t_atom()), t_pid()];
+arg_types(erlang, port_control, 3) ->
+ [t_sup(t_port(), t_atom()), t_integer(), t_sup(t_iolist(), t_binary())];
+arg_types(erlang, port_get_data, 1) ->
+ [t_sup(t_port(), t_atom())];
+arg_types(erlang, port_info, 1) ->
+ [t_sup(t_port(), t_atom())];
+arg_types(erlang, port_info, 2) ->
+ [t_sup(t_port(), t_atom()),
+ t_atoms(['registered_name', 'id', 'connected',
+ 'links', 'name', 'input', 'output'])];
+arg_types(erlang, port_to_list, 1) ->
+ [t_port()];
+arg_types(erlang, ports, 0) ->
+ [];
+arg_types(erlang, port_set_data, 2) ->
+ [t_sup(t_port(), t_atom()), t_any()];
+arg_types(erlang, pre_loaded, 0) ->
+ [];
+arg_types(erlang, process_display, 2) ->
+ [t_pid(), t_atom('backtrace')];
+arg_types(erlang, process_flag, 2) ->
+ [t_sup([t_atom('trap_exit'), t_atom('error_handler'),
+ t_atom('min_heap_size'), t_atom('priority'), t_atom('save_calls'),
+ t_atom('monitor_nodes'), % undocumented
+ t_tuple([t_atom('monitor_nodes'), t_list()])]), % undocumented
+ t_sup([t_boolean(), t_atom(), t_non_neg_integer()])];
+arg_types(erlang, process_flag, 3) ->
+ [t_pid(), t_atom('save_calls'), t_non_neg_integer()];
+arg_types(erlang, process_info, 1) ->
+ [t_pid()];
+arg_types(erlang, process_info, 2) ->
+ [t_pid(), t_pinfo()];
+arg_types(erlang, processes, 0) ->
+ [];
+arg_types(erlang, purge_module, 1) ->
+ [t_atom()];
+arg_types(erlang, put, 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, raise, 3) ->
+ [t_raise_errorclass(), t_any(), type(erlang, get_stacktrace, 0, [])];
+arg_types(erlang, read_timer, 1) ->
+ [t_reference()];
+arg_types(erlang, ref_to_list, 1) ->
+ [t_reference()];
+arg_types(erlang, register, 2) ->
+ [t_atom(), t_sup(t_port(), t_pid())];
+arg_types(erlang, registered, 0) ->
+ [];
+arg_types(erlang, resume_process, 1) ->
+ [t_pid()]; % intended for debugging only
+arg_types(erlang, round, 1) ->
+ [t_number()];
+arg_types(erlang, self, 0) ->
+ [];
+arg_types(erlang, send, 2) ->
+ arg_types(erlang, '!', 2); % alias
+arg_types(erlang, send, 3) ->
+ arg_types(erlang, send, 2) ++ [t_list(t_sendoptions())];
+arg_types(erlang, send_after, 3) ->
+ [t_non_neg_integer(), t_sup(t_pid(), t_atom()), t_any()];
+arg_types(erlang, seq_trace, 2) ->
+ [t_atom(), t_sup([t_boolean(), t_tuple([t_fixnum(), t_fixnum()]), t_nil()])];
+arg_types(erlang, seq_trace_info, 1) ->
+ [t_seq_trace_info()];
+arg_types(erlang, seq_trace_print, 1) ->
+ [t_any()];
+arg_types(erlang, seq_trace_print, 2) ->
+ [t_sup(t_atom(), t_fixnum()), t_any()];
+arg_types(erlang, set_cookie, 2) ->
+ [t_node(), t_atom()];
+arg_types(erlang, setelement, 3) ->
+ [t_pos_integer(), t_tuple(), t_any()];
+arg_types(erlang, setnode, 2) ->
+ [t_atom(), t_integer()];
+arg_types(erlang, setnode, 3) ->
+ [t_atom(), t_port(), t_tuple(4)];
+arg_types(erlang, size, 1) ->
+ [t_sup(t_tuple(), t_binary())];
+arg_types(erlang, spawn, 1) -> %% TODO: Tuple?
+ [t_fun()];
+arg_types(erlang, spawn, 2) -> %% TODO: Tuple?
+ [t_node(), t_fun()];
+arg_types(erlang, spawn, 3) -> %% TODO: Tuple?
+ [t_atom(), t_atom(), t_list()];
+arg_types(erlang, spawn, 4) -> %% TODO: Tuple?
+ [t_node(), t_atom(), t_atom(), t_list()];
+arg_types(erlang, spawn_link, 1) ->
+ arg_types(erlang, spawn, 1); % same
+arg_types(erlang, spawn_link, 2) ->
+ arg_types(erlang, spawn, 2); % same
+arg_types(erlang, spawn_link, 3) ->
+ arg_types(erlang, spawn, 3); % same
+arg_types(erlang, spawn_link, 4) ->
+ arg_types(erlang, spawn, 4); % same
+arg_types(erlang, spawn_opt, 1) ->
+ [t_tuple([t_atom(), t_atom(), t_list(), t_list(t_spawn_options())])];
+arg_types(erlang, spawn_opt, 2) ->
+ [t_fun(), t_list(t_spawn_options())];
+arg_types(erlang, spawn_opt, 3) ->
+ [t_atom(), t_fun(), t_list(t_spawn_options())];
+arg_types(erlang, spawn_opt, 4) ->
+ [t_node(), t_atom(), t_list(), t_list(t_spawn_options())];
+arg_types(erlang, split_binary, 2) ->
+ [t_binary(), t_non_neg_integer()];
+arg_types(erlang, start_timer, 3) ->
+ [t_non_neg_integer(), t_sup(t_pid(), t_atom()), t_any()];
+arg_types(erlang, statistics, 1) ->
+ [t_sup([t_atom('context_switches'),
+ t_atom('exact_reductions'),
+ t_atom('garbage_collection'),
+ t_atom('io'),
+ t_atom('reductions'),
+ t_atom('run_queue'),
+ t_atom('runtime'),
+ t_atom('wall_clock')])];
+arg_types(erlang, suspend_process, 1) ->
+ [t_pid()];
+arg_types(erlang, suspend_process, 2) ->
+ [t_pid(), t_list(t_sup([t_atom('unless_suspending'),
+ t_atom('asynchronous')]))];
+arg_types(erlang, system_flag, 2) ->
+ [t_sup([t_atom('backtrace_depth'),
+ t_atom('cpu_topology'),
+ t_atom('debug_flags'), % undocumented
+ t_atom('display_items'), % undocumented
+ t_atom('fullsweep_after'),
+ t_atom('min_heap_size'),
+ t_atom('multi_scheduling'),
+ t_atom('schedulers_online'),
+ t_atom('scheduler_bind_type'),
+ %% Undocumented; used to implement (the documented) seq_trace module.
+ t_atom('sequential_tracer'),
+ t_atom('trace_control_word'),
+ %% 'internal_cpu_topology' is an undocumented internal feature.
+ t_atom('internal_cpu_topology'),
+ t_integer()]),
+ t_sup([t_integer(),
+ %% 'cpu_topology'
+ t_system_cpu_topology(),
+ %% 'scheduler_bind_type'
+ t_scheduler_bind_type_args(),
+ %% Undocumented: the following is for 'debug_flags' that
+ %% takes any erlang term as flags and currently ignores it.
+ %% t_any(), % commented out since it destroys the type signature
+ %%
+ %% Again undocumented; the following are for 'sequential_tracer'
+ t_sequential_tracer(),
+ %% The following two are for 'multi_scheduling'
+ t_atom('block'),
+ t_atom('unblock'),
+ %% The following is for 'internal_cpu_topology'
+ t_internal_cpu_topology()])];
+arg_types(erlang, system_info, 1) ->
+ [t_sup([t_atom(), % documented
+ t_tuple([t_atom(), t_any()]), % documented
+ t_tuple([t_atom(), t_atom(), t_any()])])];
+arg_types(erlang, system_monitor, 0) ->
+ [];
+arg_types(erlang, system_monitor, 1) ->
+ [t_system_monitor_settings()];
+arg_types(erlang, system_monitor, 2) ->
+ [t_pid(), t_system_monitor_options()];
+arg_types(erlang, system_profile, 0) ->
+ [];
+arg_types(erlang, system_profile, 2) ->
+ [t_sup([t_pid(), t_port(), t_atom('undefined')]),
+ t_system_profile_options()];
+arg_types(erlang, term_to_binary, 1) ->
+ [t_any()];
+arg_types(erlang, term_to_binary, 2) ->
+ [t_any(), t_list(t_sup([t_atom('compressed'),
+ t_tuple([t_atom('compressed'), t_from_range(0, 9)]),
+ t_tuple([t_atom('minor_version'), t_integers([0, 1])])]))];
+arg_types(erlang, throw, 1) ->
+ [t_any()];
+arg_types(erlang, time, 0) ->
+ [];
+arg_types(erlang, tl, 1) ->
+ [t_cons()];
+arg_types(erlang, trace, 3) ->
+ [t_sup(t_pid(), t_sup([t_atom('existing'), t_atom('new'), t_atom('all')])),
+ t_boolean(),
+ t_list(t_sup(t_atom(), t_tuple(2)))];
+arg_types(erlang, trace_delivered, 1) ->
+ [t_sup(t_pid(), t_atom('all'))];
+arg_types(erlang, trace_info, 2) ->
+ [t_sup([%% the following two get info about a PID
+ t_pid(), t_atom('new'),
+ %% while the following two get info about a func
+ t_mfa(), t_atom('on_load')]),
+ t_sup([%% the following are items about a PID
+ t_atom('flags'), t_atom('tracer'),
+ %% while the following are items about a func
+ t_atom('traced'), t_atom('match_spec'), t_atom('meta'),
+ t_atom('meta_match_spec'), t_atom('call_count'), t_atom('all')])];
+arg_types(erlang, trace_pattern, 2) ->
+ [t_sup(t_tuple([t_atom(), t_atom(), t_sup(t_arity(), t_atom('_'))]),
+ t_atom('on_load')),
+ t_sup([t_boolean(), t_list(), t_atom('restart'), t_atom('pause')])];
+arg_types(erlang, trace_pattern, 3) ->
+ arg_types(erlang, trace_pattern, 2) ++
+ [t_list(t_sup([t_atom('global'), t_atom('local'),
+ t_atom('meta'), t_tuple([t_atom('meta'), t_pid()]),
+ t_atom('call_count')]))];
+arg_types(erlang, trunc, 1) ->
+ [t_number()];
+arg_types(erlang, tuple_size, 1) ->
+ [t_tuple()];
+arg_types(erlang, tuple_to_list, 1) ->
+ [t_tuple()];
+arg_types(erlang, universaltime, 0) ->
+ [];
+arg_types(erlang, universaltime_to_localtime, 1) ->
+ [t_tuple([t_date(), t_time()])];
+arg_types(erlang, unlink, 1) ->
+ [t_sup(t_pid(), t_port())];
+arg_types(erlang, unregister, 1) ->
+ [t_atom()];
+arg_types(erlang, whereis, 1) ->
+ [t_atom()];
+arg_types(erlang, yield, 0) ->
+ [];
+%%------- erl_prim_loader -----------------------------------------------------
+arg_types(erl_prim_loader, get_file, 1) ->
+ [t_sup(t_atom(), t_string())];
+arg_types(erl_prim_loader, get_path, 0) ->
+ [];
+arg_types(erl_prim_loader, set_path, 1) ->
+ [t_list(t_string())];
+%%------- error_logger --------------------------------------------------------
+arg_types(error_logger, warning_map, 0) ->
+ [];
+%%------- erts_debug ----------------------------------------------------------
+arg_types(erts_debug, breakpoint, 2) ->
+ [t_tuple([t_atom(), t_atom(), t_sup(t_integer(), t_atom('_'))]), t_boolean()];
+arg_types(erts_debug, disassemble, 1) ->
+ [t_sup(t_mfa(), t_integer())];
+arg_types(erts_debug, flat_size, 1) ->
+ [t_any()];
+arg_types(erts_debug, same, 2) ->
+ [t_any(), t_any()];
+%%------- ets -----------------------------------------------------------------
+arg_types(ets, all, 0) ->
+ [];
+arg_types(ets, delete, 1) ->
+ [t_tab()];
+arg_types(ets, delete, 2) ->
+ [t_tab(), t_any()];
+arg_types(ets, delete_all_objects, 1) ->
+ [t_tab()];
+arg_types(ets, delete_object, 2) ->
+ [t_tab(), t_tuple()];
+arg_types(ets, first, 1) ->
+ [t_tab()];
+arg_types(ets, give_away, 3) ->
+ [t_tab(), t_pid(), t_any()];
+arg_types(ets, info, 1) ->
+ [t_tab()];
+arg_types(ets, info, 2) ->
+ [t_tab(), t_ets_info_items()];
+arg_types(ets, insert, 2) ->
+ [t_tab(), t_sup(t_tuple(), t_list(t_tuple()))];
+arg_types(ets, insert_new, 2) ->
+ [t_tab(), t_sup(t_tuple(), t_list(t_tuple()))];
+arg_types(ets, is_compiled_ms, 1) ->
+ [t_any()];
+arg_types(ets, last, 1) ->
+ arg_types(ets, first, 1);
+arg_types(ets, lookup, 2) ->
+ [t_tab(), t_any()];
+arg_types(ets, lookup_element, 3) ->
+ [t_tab(), t_any(), t_pos_fixnum()];
+arg_types(ets, match, 1) ->
+ [t_any()];
+arg_types(ets, match, 2) ->
+ [t_tab(), t_match_pattern()];
+arg_types(ets, match, 3) ->
+ [t_tab(), t_match_pattern(), t_pos_fixnum()];
+arg_types(ets, match_object, 1) ->
+ arg_types(ets, match, 1);
+arg_types(ets, match_object, 2) ->
+ arg_types(ets, match, 2);
+arg_types(ets, match_object, 3) ->
+ arg_types(ets, match, 3);
+arg_types(ets, match_spec_compile, 1) ->
+ [t_matchspecs()];
+arg_types(ets, match_spec_run_r, 3) ->
+ [t_matchspecs(), t_any(), t_list()];
+arg_types(ets, member, 2) ->
+ [t_tab(), t_any()];
+arg_types(ets, new, 2) ->
+ [t_atom(), t_ets_new_options()];
+arg_types(ets, next, 2) ->
+ [t_tab(), t_any()];
+arg_types(ets, prev, 2) ->
+ [t_tab(), t_any()];
+arg_types(ets, rename, 2) ->
+ [t_atom(), t_atom()];
+arg_types(ets, safe_fixtable, 2) ->
+ [t_tab(), t_boolean()];
+arg_types(ets, select, 1) ->
+ [t_any()];
+arg_types(ets, select, 2) ->
+ [t_tab(), t_matchspecs()];
+arg_types(ets, select, 3) ->
+ [t_tab(), t_matchspecs(), t_pos_fixnum()];
+arg_types(ets, select_count, 2) ->
+ [t_tab(), t_matchspecs()];
+arg_types(ets, select_delete, 2) ->
+ [t_tab(), t_matchspecs()];
+arg_types(ets, select_reverse, 1) ->
+ arg_types(ets, select, 1);
+arg_types(ets, select_reverse, 2) ->
+ arg_types(ets, select, 2);
+arg_types(ets, select_reverse, 3) ->
+ arg_types(ets, select, 3);
+arg_types(ets, slot, 2) ->
+ [t_tab(), t_non_neg_fixnum()]; % 2nd arg can be 0
+arg_types(ets, setopts, 2) ->
+ Opt = t_sup(t_tuple([t_atom('heir'), t_pid(), t_any()]),
+ t_tuple([t_atom('heir'), t_atom('none')])),
+ [t_tab(), t_sup(Opt, t_list(Opt))];
+arg_types(ets, update_counter, 3) ->
+ [t_tab(), t_any(), t_sup(t_integer(),
+ t_sup(t_tuple([t_integer(), t_integer()]),
+ t_tuple([t_integer(), t_integer(),
+ t_integer(), t_integer()])))];
+arg_types(ets, update_element, 3) ->
+ PosValue = t_tuple([t_integer(), t_any()]),
+ [t_tab(), t_any(), t_sup(PosValue, t_list(PosValue))];
+%%------- file ----------------------------------------------------------------
+arg_types(file, close, 1) ->
+ [t_file_io_device()];
+arg_types(file, delete, 1) ->
+ [t_file_name()];
+arg_types(file, get_cwd, 0) ->
+ [];
+arg_types(file, make_dir, 1) ->
+ [t_file_name()];
+arg_types(file, open, 2) ->
+ [t_file_name(), t_list(t_file_open_option())];
+arg_types(file, read_file, 1) ->
+ [t_file_name()];
+arg_types(file, set_cwd, 1) ->
+ [t_file_name()];
+arg_types(file, write, 2) ->
+ [t_file_io_device(), t_iodata()];
+arg_types(file, write_file, 2) ->
+ [t_file_name(), t_sup(t_binary(), t_list())];
+%%------- gen_tcp -------------------------------------------------------------
+arg_types(gen_tcp, accept, 1) ->
+ [t_socket()];
+arg_types(gen_tcp, accept, 2) ->
+ [t_socket(), t_timeout()];
+arg_types(gen_tcp, connect, 3) ->
+ [t_gen_tcp_address(), t_gen_tcp_port(), t_list(t_gen_tcp_connect_option())];
+arg_types(gen_tcp, connect, 4) ->
+ arg_types(gen_tcp, connect, 3) ++ [t_timeout()];
+arg_types(gen_tcp, listen, 2) ->
+ [t_gen_tcp_port(), t_list(t_gen_tcp_listen_option())];
+arg_types(gen_tcp, recv, 2) ->
+ [t_socket(), t_non_neg_integer()];
+arg_types(gen_tcp, recv, 3) ->
+ arg_types(gen_tcp, recv, 2) ++ [t_timeout()];
+arg_types(gen_tcp, send, 2) ->
+ [t_socket(), t_packet()];
+arg_types(gen_tcp, shutdown, 2) ->
+ [t_socket(), t_sup([t_atom('read'), t_atom('write'), t_atom('read_write')])];
+%%------- gen_udp -------------------------------------------------------------
+arg_types(gen_udp, open, 1) ->
+ [t_gen_tcp_port()];
+arg_types(gen_udp, open, 2) ->
+ [t_gen_tcp_port(), t_list(t_gen_udp_connect_option())];
+arg_types(gen_udp, recv, 2) ->
+ arg_types(gen_tcp, recv, 2);
+arg_types(gen_udp, recv, 3) ->
+ arg_types(gen_tcp, recv, 3);
+arg_types(gen_udp, send, 4) ->
+ [t_socket(), t_gen_tcp_address(), t_gen_tcp_port(), t_packet()];
+%%------- hipe_bifs -----------------------------------------------------------
+arg_types(hipe_bifs, add_ref, 2) ->
+ [t_mfa(), t_tuple([t_mfa(),
+ t_integer(),
+ t_sup(t_atom('call'), t_atom('load_mfa')),
+ t_trampoline(),
+ t_sup(t_atom('remote'), t_atom('local'))])];
+arg_types(hipe_bifs, alloc_data, 2) ->
+ [t_integer(), t_integer()];
+arg_types(hipe_bifs, array, 2) ->
+ [t_non_neg_fixnum(), t_immediate()];
+arg_types(hipe_bifs, array_length, 1) ->
+ [t_immarray()];
+arg_types(hipe_bifs, array_sub, 2) ->
+ [t_immarray(), t_non_neg_fixnum()];
+arg_types(hipe_bifs, array_update, 3) ->
+ [t_immarray(), t_non_neg_fixnum(), t_immediate()];
+arg_types(hipe_bifs, atom_to_word, 1) ->
+ [t_atom()];
+arg_types(hipe_bifs, bif_address, 3) ->
+ [t_atom(), t_atom(), t_arity()];
+arg_types(hipe_bifs, bitarray, 2) ->
+ [t_non_neg_fixnum(), t_boolean()];
+arg_types(hipe_bifs, bitarray_sub, 2) ->
+ [t_bitarray(), t_non_neg_fixnum()];
+arg_types(hipe_bifs, bitarray_update, 3) ->
+ [t_bytearray(), t_non_neg_fixnum(), t_boolean()];
+arg_types(hipe_bifs, bytearray, 2) ->
+ [t_non_neg_fixnum(), t_byte()];
+arg_types(hipe_bifs, bytearray_sub, 2) ->
+ [t_bytearray(), t_non_neg_fixnum()];
+arg_types(hipe_bifs, bytearray_update, 3) ->
+ [t_bytearray(), t_non_neg_fixnum(), t_byte()];
+arg_types(hipe_bifs, call_count_clear, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, call_count_get, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, call_count_off, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, call_count_on, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, check_crc, 1) ->
+ [t_integer()];
+arg_types(hipe_bifs, enter_code, 2) ->
+ [t_binary(), t_sup(t_nil(), t_tuple())];
+arg_types(hipe_bifs, enter_sdesc, 1) ->
+ [t_tuple([t_integer(), t_integer(), t_integer(), t_integer(), t_integer()])];
+arg_types(hipe_bifs, find_na_or_make_stub, 2) ->
+ [t_mfa(), t_boolean()];
+arg_types(hipe_bifs, fun_to_address, 1) ->
+ [t_mfa()];
+%% arg_types(hipe_bifs, get_emu_address, 1) ->
+%% [t_mfa()];
+arg_types(hipe_bifs, get_rts_param, 1) ->
+ [t_fixnum()];
+arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1) ->
+ [t_list(t_mfa())];
+arg_types(hipe_bifs, make_fe, 3) ->
+ [t_integer(), t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])];
+%% arg_types(hipe_bifs, make_native_stub, 2) ->
+%% [t_integer(), t_arity()];
+arg_types(hipe_bifs, mark_referred_from, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, merge_term, 1) ->
+ [t_any()];
+arg_types(hipe_bifs, patch_call, 3) ->
+ [t_integer(), t_integer(), t_trampoline()];
+arg_types(hipe_bifs, patch_insn, 3) ->
+ [t_integer(), t_integer(), t_insn_type()];
+arg_types(hipe_bifs, primop_address, 1) ->
+ [t_atom()];
+arg_types(hipe_bifs, redirect_referred_from, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, ref, 1) ->
+ [t_immediate()];
+arg_types(hipe_bifs, ref_get, 1) ->
+ [t_hiperef()];
+arg_types(hipe_bifs, ref_set, 2) ->
+ [t_hiperef(), t_immediate()];
+arg_types(hipe_bifs, remove_refs_from, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, set_funinfo_native_address, 3) ->
+ arg_types(hipe_bifs, set_native_address, 3);
+arg_types(hipe_bifs, set_native_address, 3) ->
+ [t_mfa(), t_integer(), t_boolean()];
+arg_types(hipe_bifs, system_crc, 1) ->
+ [t_integer()];
+arg_types(hipe_bifs, term_to_word, 1) ->
+ [t_any()];
+arg_types(hipe_bifs, update_code_size, 3) ->
+ [t_atom(), t_sup(t_nil(), t_binary()), t_integer()];
+arg_types(hipe_bifs, write_u8, 2) ->
+ [t_integer(), t_byte()];
+arg_types(hipe_bifs, write_u32, 2) ->
+ [t_integer(), t_integer()];
+arg_types(hipe_bifs, write_u64, 2) ->
+ [t_integer(), t_integer()];
+%%------- io ------------------------------------------------------------------
+arg_types(io, format, 1) ->
+ [t_io_format_string()];
+arg_types(io, format, 2) ->
+ [t_io_format_string(), t_list()];
+arg_types(io, format, 3) ->
+ [t_io_device(), t_io_format_string(), t_list()];
+arg_types(io, fwrite, 1) ->
+ arg_types(io, format, 1);
+arg_types(io, fwrite, 2) ->
+ arg_types(io, format, 2);
+arg_types(io, fwrite, 3) ->
+ arg_types(io, format, 3);
+arg_types(io, put_chars, 1) ->
+ [t_iodata()];
+arg_types(io, put_chars, 2) ->
+ [t_io_device(), t_iodata()];
+%%------- io_lib --------------------------------------------------------------
+arg_types(io_lib, format, 2) ->
+ arg_types(io, format, 2);
+arg_types(io_lib, fwrite, 2) ->
+ arg_types(io_lib, format, 2);
+%%------- lists ---------------------------------------------------------------
+arg_types(lists, all, 2) ->
+ [t_fun([t_any()], t_boolean()), t_list()];
+arg_types(lists, any, 2) ->
+ [t_fun([t_any()], t_boolean()), t_list()];
+arg_types(lists, append, 2) ->
+ arg_types(erlang, '++', 2); % alias
+arg_types(lists, delete, 2) ->
+ [t_any(), t_maybe_improper_list()];
+arg_types(lists, dropwhile, 2) ->
+ [t_fun([t_any()], t_boolean()), t_maybe_improper_list()];
+arg_types(lists, filter, 2) ->
+ [t_fun([t_any()], t_boolean()), t_list()];
+arg_types(lists, flatten, 1) ->
+ [t_list()];
+arg_types(lists, flatmap, 2) ->
+ [t_fun([t_any()], t_list()), t_list()];
+arg_types(lists, foreach, 2) ->
+ [t_fun([t_any()], t_any()), t_list()];
+arg_types(lists, foldl, 3) ->
+ [t_fun([t_any(), t_any()], t_any()), t_any(), t_list()];
+arg_types(lists, foldr, 3) ->
+ arg_types(lists, foldl, 3); % same
+arg_types(lists, keydelete, 3) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list()]; % t_list(t_tuple())];
+arg_types(lists, keyfind, 3) ->
+ arg_types(lists, keysearch, 3);
+arg_types(lists, keymap, 3) ->
+ [t_fun([t_any()], t_any()), t_pos_fixnum(), t_list(t_tuple())];
+arg_types(lists, keymember, 3) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list()]; % t_list(t_tuple());
+arg_types(lists, keymerge, 3) ->
+ [t_pos_fixnum(), t_list(t_tuple()), t_list(t_tuple())];
+arg_types(lists, keyreplace, 4) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list(), t_tuple()]; % t_list(t_tuple())];
+arg_types(lists, keysearch, 3) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list()]; % t_list(t_tuple())];
+arg_types(lists, keysort, 2) ->
+ [t_pos_fixnum(), t_list(t_tuple())];
+arg_types(lists, last, 1) ->
+ [t_nonempty_list()];
+arg_types(lists, map, 2) ->
+ [t_fun([t_any()], t_any()), t_list()];
+arg_types(lists, mapfoldl, 3) ->
+ [t_fun([t_any(), t_any()], t_tuple([t_any(), t_any()])), t_any(), t_list()];
+arg_types(lists, mapfoldr, 3) ->
+ arg_types(lists, mapfoldl, 3); % same
+arg_types(lists, max, 1) ->
+ [t_nonempty_list()];
+arg_types(lists, member, 2) ->
+ [t_any(), t_list()];
+%% arg_types(lists, merge, 1) ->
+%% [t_list(t_list())];
+arg_types(lists, merge, 2) ->
+ [t_list(), t_list()];
+%% arg_types(lists, merge, 3) ->
+%% [t_fun([t_any(), t_any()], t_boolean()), t_list(), t_list()];
+%% arg_types(lists, merge3, 3) ->
+%% [t_list(), t_list(), t_list()];
+arg_types(lists, min, 1) ->
+ [t_nonempty_list()];
+arg_types(lists, nth, 2) ->
+ [t_pos_fixnum(), t_nonempty_list()];
+arg_types(lists, nthtail, 2) ->
+ [t_non_neg_fixnum(), t_nonempty_list()];
+arg_types(lists, partition, 2) ->
+ arg_types(lists, filter, 2); % same
+arg_types(lists, reverse, 1) ->
+ [t_list()];
+arg_types(lists, reverse, 2) ->
+ [t_list(), t_any()];
+arg_types(lists, seq, 2) ->
+ [t_integer(), t_integer()];
+arg_types(lists, seq, 3) ->
+ [t_integer(), t_integer(), t_integer()];
+arg_types(lists, sort, 1) ->
+ [t_list()];
+arg_types(lists, sort, 2) ->
+ [t_fun([t_any(), t_any()], t_boolean()), t_list()];
+arg_types(lists, split, 2) ->
+ [t_non_neg_fixnum(), t_maybe_improper_list()]; % do not lie in 2nd arg
+arg_types(lists, splitwith, 2) ->
+ [t_fun([t_any()], t_boolean()), t_maybe_improper_list()];
+arg_types(lists, subtract, 2) ->
+ arg_types(erlang, '--', 2); % alias
+arg_types(lists, takewhile, 2) ->
+ [t_fun([t_any()], t_boolean()), t_maybe_improper_list()];
+arg_types(lists, usort, 1) ->
+ arg_types(lists, sort, 1); % same
+arg_types(lists, usort, 2) ->
+ arg_types(lists, sort, 2);
+arg_types(lists, unzip, 1) ->
+ [t_list(t_tuple(2))];
+arg_types(lists, unzip3, 1) ->
+ [t_list(t_tuple(3))];
+arg_types(lists, zip, 2) ->
+ [t_list(), t_list()];
+arg_types(lists, zip3, 3) ->
+ [t_list(), t_list(), t_list()];
+arg_types(lists, zipwith, 3) ->
+ [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()];
+arg_types(lists, zipwith3, 4) ->
+ [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()];
+%%------- math ----------------------------------------------------------------
+arg_types(math, acos, 1) ->
+ [t_number()];
+arg_types(math, acosh, 1) ->
+ [t_number()];
+arg_types(math, asin, 1) ->
+ [t_number()];
+arg_types(math, asinh, 1) ->
+ [t_number()];
+arg_types(math, atan, 1) ->
+ [t_number()];
+arg_types(math, atan2, 2) ->
+ [t_number(), t_number()];
+arg_types(math, atanh, 1) ->
+ [t_number()];
+arg_types(math, cos, 1) ->
+ [t_number()];
+arg_types(math, cosh, 1) ->
+ [t_number()];
+arg_types(math, erf, 1) ->
+ [t_number()];
+arg_types(math, erfc, 1) ->
+ [t_number()];
+arg_types(math, exp, 1) ->
+ [t_number()];
+arg_types(math, log, 1) ->
+ [t_number()];
+arg_types(math, log10, 1) ->
+ [t_number()];
+arg_types(math, pi, 0) ->
+ [];
+arg_types(math, pow, 2) ->
+ [t_number(), t_number()];
+arg_types(math, sin, 1) ->
+ [t_number()];
+arg_types(math, sinh, 1) ->
+ [t_number()];
+arg_types(math, sqrt, 1) ->
+ [t_number()];
+arg_types(math, tan, 1) ->
+ [t_number()];
+arg_types(math, tanh, 1) ->
+ [t_number()];
+%%-- net_kernel ---------------------------------------------------------------
+arg_types(net_kernel, dflag_unicode_io, 1) ->
+ [t_pid()];
+%%------- ordsets -------------------------------------------------------------
+arg_types(ordsets, filter, 2) ->
+ arg_types(lists, filter, 2);
+arg_types(ordsets, fold, 3) ->
+ arg_types(lists, foldl, 3);
+%%------- os ------------------------------------------------------------------
+arg_types(os, getenv, 0) ->
+ [];
+arg_types(os, getenv, 1) ->
+ [t_string()];
+arg_types(os, getpid, 0) ->
+ [];
+arg_types(os, putenv, 2) ->
+ [t_string(), t_string()];
+%%-- re -----------------------------------------------------------------------
+arg_types(re, compile, 1) ->
+ [t_iodata()];
+arg_types(re, compile, 2) ->
+ [t_iodata(), t_list(t_re_compile_option())];
+arg_types(re, run, 2) ->
+ [t_iodata(), t_re_RE()];
+arg_types(re, run, 3) ->
+ [t_iodata(), t_re_RE(), t_list(t_re_run_option())];
+%%------- string --------------------------------------------------------------
+arg_types(string, chars, 2) ->
+ [t_char(), t_non_neg_integer()];
+arg_types(string, chars, 3) ->
+ [t_char(), t_non_neg_integer(), t_any()];
+arg_types(string, concat, 2) ->
+ [t_string(), t_string()];
+arg_types(string, equal, 2) ->
+ [t_string(), t_string()];
+arg_types(string, to_float, 1) ->
+ [t_string()];
+arg_types(string, to_integer, 1) ->
+ [t_string()];
+%%------- unicode -------------------------------------------------------------
+arg_types(unicode, characters_to_binary, 2) ->
+ [t_ML(), t_encoding()];
+arg_types(unicode, characters_to_list, 2) ->
+ [t_ML(), t_encoding()];
+arg_types(unicode, bin_is_7bit, 1) ->
+ [t_binary()];
+%%-----------------------------------------------------------------------------
+arg_types(M, F, A) when is_atom(M), is_atom(F),
+ is_integer(A), 0 =< A, A =< 255 ->
+ unknown. % safe approximation for all functions.
+
+
+-spec is_known(atom(), atom(), arity()) -> boolean().
+
+is_known(M, F, A) ->
+ arg_types(M, F, A) =/= unknown.
+
+
+-spec structure_inspecting_args(atom(), atom(), arity()) -> [1..255].
+
+structure_inspecting_args(erlang, element, 2) -> [2];
+structure_inspecting_args(erlang, is_atom, 1) -> [1];
+structure_inspecting_args(erlang, is_boolean, 1) -> [1];
+structure_inspecting_args(erlang, is_binary, 1) -> [1];
+structure_inspecting_args(erlang, is_bitstring, 1) -> [1];
+structure_inspecting_args(erlang, is_float, 1) -> [1];
+structure_inspecting_args(erlang, is_function, 1) -> [1];
+structure_inspecting_args(erlang, is_integer, 1) -> [1];
+structure_inspecting_args(erlang, is_list, 1) -> [1];
+structure_inspecting_args(erlang, is_number, 1) -> [1];
+structure_inspecting_args(erlang, is_pid, 1) -> [1];
+structure_inspecting_args(erlang, is_port, 1) -> [1];
+structure_inspecting_args(erlang, is_reference, 1) -> [1];
+structure_inspecting_args(erlang, is_tuple, 1) -> [1];
+%%structure_inspecting_args(erlang, setelement, 3) -> [2].
+structure_inspecting_args(_, _, _) -> []. % XXX: assume no arg needs inspection
+
+
+check_fun_application(Fun, Args) ->
+ case t_is_fun(Fun) of
+ true ->
+ case t_fun_args(Fun) of
+ unknown ->
+ case t_is_none_or_unit(t_fun_range(Fun)) of
+ true -> error;
+ false -> ok
+ end;
+ FunDom when length(FunDom) =:= length(Args) ->
+ case any_is_none_or_unit(inf_lists(FunDom, Args)) of
+ true -> error;
+ false ->
+ case t_is_none_or_unit(t_fun_range(Fun)) of
+ true -> error;
+ false -> ok
+ end
+ end;
+ _ -> error
+ end;
+ false ->
+ error
+ end.
+
+
+%% =====================================================================
+%% These are basic types that should probably be moved to erl_types
+%% =====================================================================
+
+t_socket() -> t_port(). % alias
+
+t_ip_address() ->
+ T_int16 = t_from_range(0, 16#FFFF),
+ t_sup(t_tuple([t_byte(), t_byte(), t_byte(), t_byte()]),
+ t_tuple([T_int16, T_int16, T_int16, T_int16,
+ T_int16, T_int16, T_int16, T_int16])).
+
+%% =====================================================================
+%% Some basic types used in various parts of the system
+%% =====================================================================
+
+t_date() ->
+ t_tuple([t_pos_fixnum(), t_pos_fixnum(), t_pos_fixnum()]).
+
+t_time() ->
+ t_tuple([t_non_neg_fixnum(), t_non_neg_fixnum(), t_non_neg_fixnum()]).
+
+t_packet() ->
+ t_sup([t_binary(), t_iolist(), t_httppacket()]).
+
+t_httppacket() ->
+ t_sup([t_HttpRequest(), t_HttpResponse(),
+ t_HttpHeader(), t_atom('http_eoh'), t_HttpError()]).
+
+%% =====================================================================
+%% HTTP types documented in R12B-4
+%% =====================================================================
+
+t_HttpRequest() ->
+ t_tuple([t_atom('http_request'), t_HttpMethod(), t_HttpUri(), t_HttpVersion()]).
+
+t_HttpResponse() ->
+ t_tuple([t_atom('http_response'), t_HttpVersion(), t_integer(), t_string()]).
+
+t_HttpHeader() ->
+ t_tuple([t_atom('http_header'), t_integer(), t_HttpField(), t_any(), t_string()]).
+
+t_HttpError() ->
+ t_tuple([t_atom('http_error'), t_string()]).
+
+t_HttpMethod() ->
+ t_sup(t_HttpMethodAtom(), t_string()).
+
+t_HttpMethodAtom() ->
+ t_atoms(['OPTIONS', 'GET', 'HEAD', 'POST', 'PUT', 'DELETE', 'TRACE']).
+
+t_HttpUri() ->
+ t_sup([t_atom('*'),
+ t_tuple([t_atom('absoluteURI'),
+ t_sup(t_atom('http'), t_atom('https')),
+ t_string(),
+ t_sup(t_non_neg_integer(), t_atom('undefined')),
+ t_string()]),
+ t_tuple([t_atom('scheme'), t_string(), t_string()]),
+ t_tuple([t_atom('abs_path'), t_string()]),
+ t_string()]).
+
+t_HttpVersion() ->
+ t_tuple([t_non_neg_integer(), t_non_neg_integer()]).
+
+t_HttpField() ->
+ t_sup(t_HttpFieldAtom(), t_string()).
+
+t_HttpFieldAtom() ->
+ t_atoms(['Cache-Control', 'Connection', 'Date', 'Pragma', 'Transfer-Encoding',
+ 'Upgrade', 'Via', 'Accept', 'Accept-Charset', 'Accept-Encoding',
+ 'Accept-Language', 'Authorization', 'From', 'Host',
+ 'If-Modified-Since', 'If-Match', 'If-None-Match', 'If-Range',
+ 'If-Unmodified-Since', 'Max-Forwards', 'Proxy-Authorization',
+ 'Range', 'Referer', 'User-Agent', 'Age', 'Location',
+ 'Proxy-Authenticate', 'Public', 'Retry-After', 'Server', 'Vary',
+ 'Warning', 'Www-Authenticate', 'Allow', 'Content-Base',
+ 'Content-Encoding', 'Content-Language', 'Content-Length',
+ 'Content-Location', 'Content-Md5', 'Content-Range', 'Content-Type',
+ 'Etag', 'Expires', 'Last-Modified', 'Accept-Ranges',
+ 'Set-Cookie', 'Set-Cookie2', 'X-Forwarded-For', 'Cookie',
+ 'Keep-Alive', 'Proxy-Connection']).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'code'
+%% =====================================================================
+
+t_code_load_return(Mod) ->
+ t_sup(t_tuple([t_atom('module'), case t_is_atom(Mod) of
+ true -> Mod;
+ false -> t_atom()
+ end]),
+ t_tuple([t_atom('error'), t_code_load_error_rsn()])).
+
+t_code_load_error_rsn() -> % also used in erlang:load_module/2
+ t_sup([t_atom('badfile'),
+ t_atom('nofile'),
+ t_atom('not_purged'),
+ t_atom('native_code'),
+ t_atom('sticky_directory')]). % only for the 'code' functions
+
+t_code_loaded_fname_or_status() ->
+ t_sup([t_string(), % filename
+ t_atom('preloaded'),
+ t_atom('cover_compiled')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'erlang'
+%% =====================================================================
+
+t_decode_packet_option() ->
+ t_sup([t_tuple([t_atom('packet_size'), t_non_neg_integer()]),
+ t_tuple([t_atom('line_length'), t_non_neg_integer()])]).
+
+t_decode_packet_type() ->
+ t_sup(t_inet_setoption_packettype(), t_atom('httph')).
+
+t_dist_exit() ->
+ t_sup([t_atom('kill'), t_atom('noconnection'), t_atom('normal')]).
+
+t_match_spec_test_errors() ->
+ t_list(t_sup(t_tuple([t_atom('error'), t_string()]),
+ t_tuple([t_atom('warning'), t_string()]))).
+
+t_module_info_2() ->
+ t_sup([t_atom('module'),
+ t_atom('imports'),
+ t_atom('exports'),
+ t_atom('functions'),
+ t_atom('attributes'),
+ t_atom('compile'),
+ t_atom('native_addresses')]).
+
+t_pinfo() ->
+ t_sup([t_pinfo_item(), t_list(t_pinfo_item())]).
+
+t_pinfo_item() ->
+ t_sup([t_atom('backtrace'),
+ t_atom('current_function'),
+ t_atom('dictionary'),
+ t_atom('error_handler'),
+ t_atom('garbage_collection'),
+ t_atom('group_leader'),
+ t_atom('heap_size'),
+ t_atom('initial_call'),
+ t_atom('last_calls'),
+ t_atom('links'),
+ t_atom('memory'),
+ t_atom('message_binary'), % for hybrid heap only
+ t_atom('message_queue_len'),
+ t_atom('messages'),
+ t_atom('monitored_by'),
+ t_atom('monitors'),
+ t_atom('priority'),
+ t_atom('reductions'),
+ t_atom('registered_name'),
+ t_atom('sequential_trace_token'),
+ t_atom('stack_size'),
+ t_atom('status'),
+ t_atom('suspending'),
+ t_atom('total_heap_size'),
+ t_atom('trap_exit')]).
+
+t_process_priority_level() ->
+ t_sup([t_atom('max'), t_atom('high'), t_atom('normal'), t_atom('low')]).
+
+t_process_status() ->
+ t_sup([t_atom('runnable'), t_atom('running'),
+ t_atom('suspended'), t_atom('waiting')]).
+
+t_raise_errorclass() ->
+ t_sup([t_atom('error'), t_atom('exit'), t_atom('throw')]).
+
+t_sendoptions() ->
+ t_sup(t_atom('noconnect'), t_atom('nosuspend')).
+
+t_seq_trace_info() ->
+ t_sup([t_atom('send'),
+ t_atom('receive'),
+ t_atom('print'),
+ t_atom('timestamp'),
+ t_atom('label'),
+ t_atom('serial')]).
+
+%% XXX: Better if we also maintain correspondencies between infos and values
+t_seq_trace_info_returns() ->
+ Values = t_sup([t_non_neg_integer(), t_boolean(),
+ t_tuple([t_non_neg_integer(), t_non_neg_integer()])]),
+ t_sup(t_tuple([t_seq_trace_info(), Values]), t_nil()).
+
+t_sequential_tracer() ->
+ t_sup([t_atom('false'), t_pid(), t_port()]).
+
+t_spawn_options() ->
+ t_sup([t_atom('link'),
+ t_atom('monitor'),
+ t_tuple([t_atom('priority'), t_process_priority_level()]),
+ t_tuple([t_atom('min_heap_size'), t_fixnum()]),
+ t_tuple([t_atom('fullsweep_after'), t_fixnum()])]).
+
+t_spawn_opt_return(List) ->
+ case t_is_none(t_inf(t_list(t_atom('monitor')), List)) of
+ true -> t_pid();
+ false -> t_sup(t_pid(), t_tuple([t_pid(), t_reference()]))
+ end.
+
+t_system_cpu_topology() ->
+ t_sup(t_atom('undefined'), t_system_cpu_topology_level_entry_list()).
+
+t_system_cpu_topology_level_entry_list() ->
+ t_list(t_system_cpu_topology_level_entry()).
+
+t_system_cpu_topology_level_entry() ->
+ t_sup(t_tuple([t_system_cpu_topology_level_tag(),
+ t_system_cpu_topology_sublevel_entry()]),
+ t_tuple([t_system_cpu_topology_level_tag(),
+ t_system_cpu_topology_info_list(),
+ t_system_cpu_topology_sublevel_entry()])).
+
+t_system_cpu_topology_sublevel_entry() ->
+ t_sup(t_system_cpu_topology_logical_cpu_id(),
+ t_list(t_tuple())). % approximation
+
+t_system_cpu_topology_level_tag() ->
+ t_atoms(['core', 'node', 'processor', 'thread']).
+
+t_system_cpu_topology_logical_cpu_id() ->
+ t_tuple([t_atom('logical'), t_non_neg_fixnum()]).
+
+t_system_cpu_topology_info_list() ->
+ t_nil(). % it may be extended in the future
+
+t_internal_cpu_topology() -> %% Internal undocumented type
+ t_sup(t_list(t_tuple([t_atom('cpu'),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum()])),
+ t_atom('undefined')).
+
+t_scheduler_bind_type_args() ->
+ t_sup([t_atom('default_bind'),
+ t_atom('no_node_processor_spread'),
+ t_atom('no_node_thread_spread'),
+ t_atom('no_spread'),
+ t_atom('processor_spread'),
+ t_atom('spread'),
+ t_atom('thread_spread'),
+ t_atom('thread_no_node_processor_spread'),
+ t_atom('unbound')]).
+
+t_scheduler_bind_type_results() ->
+ t_sup([t_atom('no_node_processor_spread'),
+ t_atom('no_node_thread_spread'),
+ t_atom('no_spread'),
+ t_atom('processor_spread'),
+ t_atom('spread'),
+ t_atom('thread_spread'),
+ t_atom('thread_no_node_processor_spread'),
+ t_atom('unbound')]).
+
+
+t_system_monitor_settings() ->
+ t_sup([t_atom('undefined'),
+ t_tuple([t_pid(), t_system_monitor_options()])]).
+
+t_system_monitor_options() ->
+ t_list(t_sup([t_atom('busy_port'),
+ t_atom('busy_dist_port'),
+ t_tuple([t_atom('long_gc'), t_integer()]),
+ t_tuple([t_atom('large_heap'), t_integer()])])).
+
+t_system_multi_scheduling() ->
+ t_sup([t_atom('blocked'), t_atom('disabled'), t_atom('enabled')]).
+
+t_system_profile_options() ->
+ t_list(t_sup([t_atom('exclusive'),
+ t_atom('runnable_ports'),
+ t_atom('runnable_procs'),
+ t_atom('scheduler')])).
+
+t_system_profile_return() ->
+ t_sup(t_atom('undefined'),
+ t_tuple([t_sup(t_pid(), t_port()), t_system_profile_options()])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'ets'
+%% =====================================================================
+
+t_tab() ->
+ t_sup(t_tid(), t_atom()).
+
+t_match_pattern() ->
+ t_sup(t_atom(), t_tuple()).
+
+t_matchspecs() ->
+ t_list(t_tuple([t_match_pattern(), t_list(), t_list()])).
+
+t_matchres() ->
+ t_sup(t_tuple([t_list(), t_any()]), t_atom('$end_of_table')).
+
+%% From the 'ets' documentation
+%%-----------------------------
+%% Option = Type | Access | named_table | {keypos,Pos}
+%% | {heir,pid(),HeirData} | {heir,none}
+%% | {write_concurrency,boolean()}
+%% Type = set | ordered_set | bag | duplicate_bag
+%% Access = public | protected | private
+%% Pos = integer()
+%% HeirData = term()
+t_ets_new_options() ->
+ t_list(t_sup([t_atom('set'),
+ t_atom('ordered_set'),
+ t_atom('bag'),
+ t_atom('duplicate_bag'),
+ t_atom('public'),
+ t_atom('protected'),
+ t_atom('private'),
+ t_atom('named_table'),
+ t_tuple([t_atom('heir'), t_pid(), t_any()]),
+ t_tuple([t_atom('heir'), t_atom('none')]),
+ t_tuple([t_atom('keypos'), t_integer()]),
+ t_tuple([t_atom('write_concurrency'), t_boolean()])])).
+
+t_ets_info_items() ->
+ t_sup([t_atom('fixed'),
+ t_atom('safe_fixed'),
+ t_atom('keypos'),
+ t_atom('memory'),
+ t_atom('name'),
+ t_atom('named_table'),
+ t_atom('node'),
+ t_atom('owner'),
+ t_atom('protection'),
+ t_atom('size'),
+ t_atom('type')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'file'
+%% =====================================================================
+
+t_file_io_device() ->
+ t_sup(t_pid(), t_tuple([t_atom('file_descriptor'), t_atom(), t_any()])).
+
+t_file_name() ->
+ t_sup([t_atom(),
+ t_string(),
+ %% DeepList = [char() | atom() | DeepList] -- approximation below
+ t_list(t_sup([t_atom(), t_string(), t_list()]))]).
+
+t_file_open_option() ->
+ t_sup([t_atom('read'),
+ t_atom('write'),
+ t_atom('append'),
+ t_atom('raw'),
+ t_atom('binary'),
+ t_atom('delayed_write'),
+ t_atom('read_ahead'),
+ t_atom('compressed'),
+ t_tuple([t_atom('delayed_write'),
+ t_pos_integer(), t_non_neg_integer()]),
+ t_tuple([t_atom('read_ahead'), t_pos_integer()])]).
+
+%% This lists all Posix errors that can occur in file:*/* functions
+t_file_posix_error() ->
+ t_sup([t_atom('eacces'),
+ t_atom('eagain'),
+ t_atom('ebadf'),
+ t_atom('ebusy'),
+ t_atom('edquot'),
+ t_atom('eexist'),
+ t_atom('efault'),
+ t_atom('efbig'),
+ t_atom('eintr'),
+ t_atom('einval'),
+ t_atom('eio'),
+ t_atom('eisdir'),
+ t_atom('eloop'),
+ t_atom('emfile'),
+ t_atom('emlink'),
+ t_atom('enametoolong'),
+ t_atom('enfile'),
+ t_atom('enodev'),
+ t_atom('enoent'),
+ t_atom('enomem'),
+ t_atom('enospc'),
+ t_atom('enotblk'),
+ t_atom('enotdir'),
+ t_atom('enotsup'),
+ t_atom('enxio'),
+ t_atom('eperm'),
+ t_atom('epipe'),
+ t_atom('erofs'),
+ t_atom('espipe'),
+ t_atom('esrch'),
+ t_atom('estale'),
+ t_atom('exdev')]).
+
+t_file_return() ->
+ t_sup(t_atom('ok'), t_tuple([t_atom('error'), t_file_posix_error()])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'gen_tcp'
+%% =====================================================================
+
+t_gen_tcp_accept() ->
+ t_sup(t_tuple([t_atom('ok'), t_socket()]),
+ t_tuple([t_atom('error'), t_sup([t_atom('closed'),
+ t_atom('timeout'),
+ t_inet_posix_error()])])).
+
+t_gen_tcp_address() ->
+ t_sup([t_string(), t_atom(), t_ip_address()]).
+
+t_gen_tcp_port() ->
+ t_from_range(0, 16#FFFF).
+
+t_gen_tcp_connect_option() ->
+ t_sup([t_atom('list'),
+ t_atom('binary'),
+ t_tuple([t_atom('ip'), t_ip_address()]),
+ t_tuple([t_atom('port'), t_gen_tcp_port()]),
+ t_tuple([t_atom('fd'), t_integer()]),
+ t_atom('inet6'),
+ t_atom('inet'),
+ t_inet_setoption()]).
+
+t_gen_tcp_listen_option() ->
+ t_sup([t_atom('list'),
+ t_atom('binary'),
+ t_tuple([t_atom('backlog'), t_non_neg_integer()]),
+ t_tuple([t_atom('ip'), t_ip_address()]),
+ t_tuple([t_atom('fd'), t_integer()]),
+ t_atom('inet6'),
+ t_atom('inet'),
+ t_inet_setoption()]).
+
+t_gen_tcp_recv() ->
+ t_sup(t_tuple([t_atom('ok'), t_packet()]),
+ t_tuple([t_atom('error'), t_sup([t_atom('closed'),
+ t_inet_posix_error()])])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'gen_udp'
+%% =====================================================================
+
+t_gen_udp_connect_option() ->
+ t_sup([t_atom('list'),
+ t_atom('binary'),
+ t_tuple([t_atom('ip'), t_ip_address()]),
+ t_tuple([t_atom('fd'), t_integer()]),
+ t_atom('inet6'),
+ t_atom('inet'),
+ t_inet_setoption()]).
+
+t_gen_udp_recv() ->
+ t_sup(t_tuple([t_atom('ok'),
+ t_tuple([t_ip_address(),
+ t_gen_tcp_port(),
+ t_packet()])]),
+ t_tuple([t_atom('error'),
+ t_sup(t_atom('not_owner'), t_inet_posix_error())])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'hipe_bifs'
+%% =====================================================================
+
+t_trampoline() ->
+ t_sup(t_nil(), t_integer()).
+
+t_immediate() ->
+ t_sup([t_nil(), t_atom(), t_fixnum()]).
+
+t_immarray() ->
+ t_integer(). %% abstract data type
+
+t_hiperef() ->
+ t_immarray().
+
+t_bitarray() ->
+ t_bitstr().
+
+t_bytearray() ->
+ t_binary().
+
+t_insn_type() ->
+ t_sup([% t_atom('call'),
+ t_atom('load_mfa'),
+ t_atom('x86_abs_pcrel'),
+ t_atom('atom'),
+ t_atom('constant'),
+ t_atom('c_const'),
+ t_atom('closure')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'inet'
+%% =====================================================================
+
+t_inet_setoption() ->
+ t_sup([%% first the 2-tuple options
+ t_tuple([t_atom('active'), t_sup(t_boolean(), t_atom('once'))]),
+ t_tuple([t_atom('broadcast'), t_boolean()]),
+ t_tuple([t_atom('delay_send'), t_boolean()]),
+ t_tuple([t_atom('dontroute'), t_boolean()]),
+ t_tuple([t_atom('exit_on_close'), t_boolean()]),
+ t_tuple([t_atom('header'), t_non_neg_integer()]),
+ t_tuple([t_atom('keepalive'), t_boolean()]),
+ t_tuple([t_atom('nodelay'), t_boolean()]),
+ t_tuple([t_atom('packet'), t_inet_setoption_packettype()]),
+ t_tuple([t_atom('packet_size'), t_non_neg_integer()]),
+ t_tuple([t_atom('read_packets'), t_non_neg_integer()]),
+ t_tuple([t_atom('recbuf'), t_non_neg_integer()]),
+ t_tuple([t_atom('reuseaddr'), t_boolean()]),
+ t_tuple([t_atom('send_timeout'), t_non_neg_integer()]),
+ t_tuple([t_atom('sndbuf'), t_non_neg_integer()]),
+ t_tuple([t_atom('priority'), t_non_neg_integer()]),
+ t_tuple([t_atom('tos'), t_non_neg_integer()]),
+ %% and a 4-tuple option
+ t_tuple([t_atom('raw'),
+ t_non_neg_integer(), % protocol level
+ t_non_neg_integer(), % option number
+ t_binary()])]). % actual option value
+
+t_inet_setoption_packettype() ->
+ t_sup([t_atom('raw'),
+ t_integers([0,1,2,4]),
+ t_atom('asn1'), t_atom('cdr'), t_atom('sunrm'),
+ t_atom('fcgi'), t_atom('tpkt'), t_atom('line'),
+ t_atom('http')]). %% but t_atom('httph') is not needed
+
+t_inet_posix_error() ->
+ t_atom(). %% XXX: Very underspecified
+
+%% =====================================================================
+%% These are used for the built-in functions of 'io'
+%% =====================================================================
+
+t_io_device() ->
+ t_sup(t_atom(), t_pid()).
+
+%% The documentation in R11B-4 reads
+%% Format ::= atom() | string() | binary()
+%% but the Format can also be a (deep) list, hence the type below
+t_io_format_string() ->
+ t_sup([t_atom(), t_list(), t_binary()]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 're'; the functions
+%% whose last name component starts with a capital letter are types
+%% =====================================================================
+
+t_re_MP() -> %% it's supposed to be an opaque data type
+ t_tuple([t_atom('re_pattern'), t_integer(), t_integer(), t_binary()]).
+
+t_re_RE() ->
+ t_sup(t_re_MP(), t_iodata()).
+
+t_re_compile_option() ->
+ t_sup([t_atoms(['anchored', 'caseless', 'dollar_endonly', 'dotall',
+ 'extended', 'firstline', 'multiline', 'no_auto_capture',
+ 'dupnames', 'ungreedy']),
+ t_tuple([t_atom('newline'), t_re_NLSpec()])]).
+
+t_re_run_option() ->
+ t_sup([t_atoms(['anchored', 'global', 'notbol', 'noteol', 'notempty']),
+ t_tuple([t_atom('offset'), t_integer()]),
+ t_tuple([t_atom('newline'), t_re_NLSpec()]),
+ t_tuple([t_atom('capture'), t_re_ValueSpec()]),
+ t_tuple([t_atom('capture'), t_re_ValueSpec(), t_re_Type()]),
+ t_re_compile_option()]).
+
+t_re_ErrorSpec() ->
+ t_tuple([t_string(), t_non_neg_integer()]).
+
+t_re_Type() ->
+ t_atoms(['index', 'list', 'binary']).
+
+t_re_NLSpec() ->
+ t_atoms(['cr', 'crlf', 'lf', 'anycrlf']).
+
+t_re_ValueSpec() ->
+ t_sup(t_atoms(['all', 'all_but_first', 'first', 'none']), t_re_ValueList()).
+
+t_re_ValueList() ->
+ t_list(t_sup([t_integer(), t_string(), t_atom()])).
+
+t_re_Captured() ->
+ t_list(t_sup(t_re_CapturedData(), t_list(t_re_CapturedData()))).
+
+t_re_CapturedData() ->
+ t_sup([t_tuple([t_integer(), t_integer()]), t_string(), t_binary()]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'unicode'
+%% =====================================================================
+
+t_ML() -> % a binary or a possibly deep list of integers or binaries
+ t_sup(t_list(t_sup([t_integer(), t_binary(), t_list()])), t_binary()).
+
+t_encoding() ->
+ t_atoms(['latin1', 'unicode', 'utf8', 'utf16', 'utf32']).
+
+t_encoding_a2b() -> % for the 2nd arg of atom_to_binary/2 and binary_to_atom/2
+ t_atoms(['latin1', 'unicode', 'utf8']).
+
+%% =====================================================================
+%% Some testing code for ranges below
+%% =====================================================================
+
+-ifdef(DO_ERL_BIF_TYPES_TEST).
+
+test() ->
+ put(hipe_target_arch, amd64),
+
+ Bsl1 = type(erlang, 'bsl', 2, [t_from_range(1, 299), t_from_range(-4, 22)]),
+ Bsl2 = type(erlang, 'bsl', 2),
+ Bsl3 = type(erlang, 'bsl', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("Bsl ~p ~p ~p~n", [Bsl1, Bsl2, Bsl3]),
+
+ Add1 = type(erlang, '+', 2, [t_from_range(1, 299), t_from_range(-4, 22)]),
+ Add2 = type(erlang, '+', 2),
+ Add3 = type(erlang, '+', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("Add ~p ~p ~p~n", [Add1, Add2, Add3]),
+
+ Band1 = type(erlang, 'band', 2, [t_from_range(1, 29), t_from_range(34, 36)]),
+ Band2 = type(erlang, 'band', 2),
+ Band3 = type(erlang, 'band', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("band ~p ~p ~p~n", [Band1, Band2, Band3]),
+
+ Bor1 = type(erlang, 'bor', 2, [t_from_range(1, 29), t_from_range(8, 11)]),
+ Bor2 = type(erlang, 'bor', 2),
+ Bor3 = type(erlang, 'bor', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("bor ~p ~p ~p~n", [Bor1, Bor2, Bor3]),
+
+ io:format("inf_?"),
+ pos_inf = infinity_max([1, 4, 51, pos_inf]),
+ -12 = infinity_min([1, 142, -4, -12]),
+ neg_inf = infinity_max([neg_inf]),
+
+ io:format("width"),
+ 4 = width({7, 9}),
+ pos_inf = width({neg_inf, 100}),
+ pos_inf = width({1, pos_inf}),
+ 3 = width({-8, 7}),
+ 0 = width({-1, 0}),
+
+ io:format("arith * "),
+ Mult1 = t_from_range(0, 12),
+ Mult2 = t_from_range(-21, 7),
+ Mult1 = type(erlang, '*', 2, [t_from_range(2,3), t_from_range(0,4)]),
+ Mult2 = type(erlang, '*', 2, [t_from_range(-7,-1), t_from_range(-1,3)]),
+ ok.
+
+-endif.
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
new file mode 100644
index 0000000000..fac308d0c6
--- /dev/null
+++ b/lib/hipe/cerl/erl_types.erl
@@ -0,0 +1,3847 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ======================================================================
+%% Copyright (C) 2000-2003 Richard Carlsson
+%%
+%% ======================================================================
+%% Provides a representation of Erlang types.
+%%
+%% The initial author of this file is Richard Carlsson (2000-2004).
+%% In July 2006, the type representation was totally re-designed by
+%% Tobias Lindahl. This is the representation which is used currently.
+%% In late 2008, Manouk Manoukian and Kostis Sagonas added support for
+%% opaque types to the structure-based representation of types.
+%% During February and March 2009, Kostis Sagonas significantly
+%% cleaned up the type representation added spec declarations.
+%%
+%% Author contact: richardc@it.uu.se, tobiasl@it.uu.se, kostis@cs.ntua.gr
+%% ======================================================================
+
+-module(erl_types).
+
+-export([any_none/1,
+ any_none_or_unit/1,
+ lookup_record/3,
+ max/2,
+ module_builtin_opaques/1,
+ min/2,
+ number_max/1,
+ number_min/1,
+ t_abstract_records/2,
+ t_any/0,
+ t_arity/0,
+ t_atom/0,
+ t_atom/1,
+ t_atoms/1,
+ t_atom_vals/1,
+ t_binary/0,
+ t_bitstr/0,
+ t_bitstr/2,
+ t_bitstr_base/1,
+ t_bitstr_concat/1,
+ t_bitstr_concat/2,
+ t_bitstr_match/2,
+ t_bitstr_unit/1,
+ t_boolean/0,
+ t_byte/0,
+ t_char/0,
+ t_collect_vars/1,
+ t_cons/0,
+ t_cons/2,
+ t_cons_hd/1,
+ t_cons_tl/1,
+ t_constant/0,
+ t_contains_opaque/1,
+ t_elements/1,
+ t_find_opaque_mismatch/2,
+ t_fixnum/0,
+ t_map/2,
+ t_non_neg_fixnum/0,
+ t_pos_fixnum/0,
+ t_float/0,
+ t_form_to_string/1,
+ t_from_form/1,
+ t_from_form/2,
+ t_from_form/3,
+ t_from_range/2,
+ t_from_range_unsafe/2,
+ t_from_term/1,
+ t_fun/0,
+ t_fun/1,
+ t_fun/2,
+ t_fun_args/1,
+ t_fun_arity/1,
+ t_fun_range/1,
+ t_has_opaque_subtype/1,
+ t_has_var/1,
+ t_identifier/0,
+ %% t_improper_list/2,
+ t_inf/2,
+ t_inf/3,
+ t_inf_lists/2,
+ t_inf_lists/3,
+ t_integer/0,
+ t_integer/1,
+ t_non_neg_integer/0,
+ t_pos_integer/0,
+ t_integers/1,
+ t_iodata/0,
+ t_iolist/0,
+ t_is_any/1,
+ t_is_atom/1,
+ t_is_atom/2,
+ t_is_binary/1,
+ t_is_bitstr/1,
+ t_is_bitwidth/1,
+ t_is_boolean/1,
+ %% t_is_byte/1,
+ %% t_is_char/1,
+ t_is_cons/1,
+ t_is_constant/1,
+ t_is_equal/2,
+ t_is_fixnum/1,
+ t_is_float/1,
+ t_is_fun/1,
+ t_is_instance/2,
+ t_is_integer/1,
+ t_is_list/1,
+ t_is_matchstate/1,
+ t_is_nil/1,
+ t_is_non_neg_integer/1,
+ t_is_none/1,
+ t_is_none_or_unit/1,
+ t_is_number/1,
+ t_is_opaque/1,
+ t_is_pid/1,
+ t_is_port/1,
+ t_is_maybe_improper_list/1,
+ t_is_reference/1,
+ t_is_remote/1,
+ t_is_string/1,
+ t_is_subtype/2,
+ t_is_tuple/1,
+ t_is_unit/1,
+ t_is_var/1,
+ t_limit/2,
+ t_list/0,
+ t_list/1,
+ t_list_elements/1,
+ t_list_termination/1,
+ t_matchstate/0,
+ t_matchstate/2,
+ t_matchstate_present/1,
+ t_matchstate_slot/2,
+ t_matchstate_slots/1,
+ t_matchstate_update_present/2,
+ t_matchstate_update_slot/3,
+ t_mfa/0,
+ t_module/0,
+ t_nil/0,
+ t_node/0,
+ t_none/0,
+ t_nonempty_list/0,
+ t_nonempty_list/1,
+ t_nonempty_string/0,
+ t_number/0,
+ t_number/1,
+ t_number_vals/1,
+ t_opaque_from_records/1,
+ t_opaque_match_atom/2,
+ t_opaque_match_record/2,
+ t_opaque_matching_structure/2,
+ t_opaque_structure/1,
+ t_pid/0,
+ t_port/0,
+ t_maybe_improper_list/0,
+ %% t_maybe_improper_list/2,
+ t_product/1,
+ t_reference/0,
+ t_remote/3,
+ t_string/0,
+ t_struct_from_opaque/2,
+ t_solve_remote/2,
+ t_subst/2,
+ t_subtract/2,
+ t_subtract_list/2,
+ t_sup/1,
+ t_sup/2,
+ t_tid/0,
+ t_timeout/0,
+ t_to_string/1,
+ t_to_string/2,
+ t_to_tlist/1,
+ t_tuple/0,
+ t_tuple/1,
+ t_tuple_args/1,
+ t_tuple_size/1,
+ t_tuple_sizes/1,
+ t_tuple_subtypes/1,
+ t_unify/2,
+ t_unit/0,
+ t_unopaque/1,
+ t_unopaque/2,
+ t_var/1,
+ t_var_name/1,
+ %% t_assign_variables_to_subtype/2,
+ type_is_defined/3,
+ subst_all_vars_to_any/1,
+ lift_list_to_pos_empty/1
+ ]).
+
+%%-define(DO_ERL_TYPES_TEST, true).
+
+-ifdef(DO_ERL_TYPES_TEST).
+-export([test/0]).
+-else.
+-define(NO_UNUSED, true).
+-endif.
+
+-ifndef(NO_UNUSED).
+-export([t_is_identifier/1]).
+-endif.
+
+%%=============================================================================
+%%
+%% Definition of the type structure
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Limits
+%%
+
+-define(TUPLE_TAG_LIMIT, 5).
+-define(TUPLE_ARITY_LIMIT, 10).
+-define(SET_LIMIT, 13).
+-define(MAX_BYTE, 255).
+-define(MAX_CHAR, 16#10ffff).
+
+-define(WIDENING_LIMIT, 7).
+-define(UNIT_MULTIPLIER, 8).
+
+-define(TAG_IMMED1_SIZE, 4).
+-define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE).
+
+%%-----------------------------------------------------------------------------
+%% Type tags and qualifiers
+%%
+
+-define(atom_tag, atom).
+-define(binary_tag, binary).
+-define(function_tag, function).
+-define(identifier_tag, identifier).
+-define(list_tag, list).
+-define(matchstate_tag, matchstate).
+-define(nil_tag, nil).
+-define(number_tag, number).
+-define(opaque_tag, opaque).
+-define(product_tag, product).
+-define(remote_tag, remote).
+-define(tuple_set_tag, tuple_set).
+-define(tuple_tag, tuple).
+-define(union_tag, union).
+-define(var_tag, var).
+
+-type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag
+ | ?list_tag | ?matchstate_tag | ?nil_tag | ?number_tag
+ | ?opaque_tag | ?product_tag | ?tuple_tag | ?tuple_set_tag
+ | ?union_tag | ?var_tag.
+
+-define(float_qual, float).
+-define(integer_qual, integer).
+-define(nonempty_qual, nonempty).
+-define(pid_qual, pid).
+-define(port_qual, port).
+-define(reference_qual, reference).
+-define(unknown_qual, unknown).
+
+-type qual() :: ?float_qual | ?integer_qual | ?nonempty_qual | ?pid_qual
+ | ?port_qual | ?reference_qual | ?unknown_qual | {_, _}.
+
+%%-----------------------------------------------------------------------------
+%% The type representation
+%%
+
+-define(any, any).
+-define(none, none).
+-define(unit, unit).
+%% Generic constructor - elements can be many things depending on the tag.
+-record(c, {tag :: tag(),
+ elements = [] :: term(),
+ qualifier = ?unknown_qual :: qual()}).
+
+-opaque erl_type() :: ?any | ?none | ?unit | #c{}.
+
+%%-----------------------------------------------------------------------------
+%% Auxiliary types and convenient macros
+%%
+
+-type parse_form() :: {atom(), _, _} | {atom(), _, _, _}. %% XXX: Temporarily
+-type rng_elem() :: 'pos_inf' | 'neg_inf' | integer().
+
+-record(int_set, {set :: [integer()]}).
+-record(int_rng, {from :: rng_elem(), to :: rng_elem()}).
+-record(opaque, {mod :: module(), name :: atom(),
+ args = [] :: [erl_type()], struct :: erl_type()}).
+-record(remote, {mod:: module(), name :: atom(), args = [] :: [erl_type()]}).
+
+-define(atom(Set), #c{tag=?atom_tag, elements=Set}).
+-define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}).
+-define(float, ?number(?any, ?float_qual)).
+-define(function(Domain, Range), #c{tag=?function_tag,
+ elements=[Domain, Range]}).
+-define(identifier(Types), #c{tag=?identifier_tag, elements=Types}).
+-define(integer(Types), ?number(Types, ?integer_qual)).
+-define(int_range(From, To), ?integer(#int_rng{from=From, to=To})).
+-define(int_set(Set), ?integer(#int_set{set=Set})).
+-define(list(Types, Term, Size), #c{tag=?list_tag, elements=[Types,Term],
+ qualifier=Size}).
+-define(nil, #c{tag=?nil_tag}).
+-define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)).
+-define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set,
+ qualifier=Qualifier}.
+-define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}).
+-define(product(Types), #c{tag=?product_tag, elements=Types}).
+-define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}).
+-define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types,
+ qualifier={Arity, Qual}}).
+-define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}).
+-define(var(Id), #c{tag=?var_tag, elements=Id}).
+
+-define(matchstate(P, Slots), #c{tag=?matchstate_tag, elements=[P,Slots]}).
+-define(any_matchstate, ?matchstate(t_bitstr(), ?any)).
+
+-define(byte, ?int_range(0, ?MAX_BYTE)).
+-define(char, ?int_range(0, ?MAX_CHAR)).
+-define(integer_pos, ?int_range(1, pos_inf)).
+-define(integer_non_neg, ?int_range(0, pos_inf)).
+-define(integer_neg, ?int_range(neg_inf, -1)).
+
+%%-----------------------------------------------------------------------------
+%% Unions
+%%
+
+-define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}).
+
+-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])).
+-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])).
+-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])).
+-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])).
+-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])).
+-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])).
+-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])).
+-define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])).
+-define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])).
+-define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])).
+-define(integer_union(T), ?number_union(T)).
+-define(float_union(T), ?number_union(T)).
+-define(nil_union(T), ?list_union(T)).
+
+
+%%=============================================================================
+%%
+%% Primitive operations such as type construction and type tests
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Top and bottom
+%%
+
+-spec t_any() -> erl_type().
+
+t_any() ->
+ ?any.
+
+-spec t_is_any(erl_type()) -> boolean().
+
+t_is_any(?any) -> true;
+t_is_any(_) -> false.
+
+-spec t_none() -> erl_type().
+
+t_none() ->
+ ?none.
+
+-spec t_is_none(erl_type()) -> boolean().
+
+t_is_none(?none) -> true;
+t_is_none(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Opaque types
+%%
+
+-spec t_opaque(module(), atom(), [_], erl_type()) -> erl_type().
+
+t_opaque(Mod, Name, Args, Struct) ->
+ ?opaque(set_singleton(#opaque{mod=Mod, name=Name, args=Args, struct=Struct})).
+
+-spec t_is_opaque(erl_type()) -> boolean().
+
+t_is_opaque(?opaque(_)) -> true;
+t_is_opaque(_) -> false.
+
+-spec t_has_opaque_subtype(erl_type()) -> boolean().
+
+t_has_opaque_subtype(?union(Ts)) ->
+ lists:any(fun t_is_opaque/1, Ts);
+t_has_opaque_subtype(T) ->
+ t_is_opaque(T).
+
+-spec t_opaque_structure(erl_type()) -> erl_type().
+
+t_opaque_structure(?opaque(Elements)) ->
+ case ordsets:size(Elements) of
+ 1 ->
+ [#opaque{struct = Struct}] = ordsets:to_list(Elements),
+ Struct;
+ _ -> throw({error, "Unexpected multiple opaque types"})
+ end.
+
+-spec t_opaque_module(erl_type()) -> module().
+
+t_opaque_module(?opaque(Elements)) ->
+ case ordsets:size(Elements) of
+ 1 ->
+ [#opaque{mod=Module}] = ordsets:to_list(Elements),
+ Module;
+ _ -> throw({error, "Unexpected multiple opaque types"})
+ end.
+
+%% This only makes sense if we know that Type matches Opaque
+-spec t_opaque_matching_structure(erl_type(), erl_type()) -> erl_type().
+
+t_opaque_matching_structure(Type, Opaque) ->
+ OpaqueStruct = t_opaque_structure(Opaque),
+ case OpaqueStruct of
+ ?union(L1) ->
+ case Type of
+ ?union(_L2) -> OpaqueStruct;
+ _OtherType -> t_opaque_matching_structure_list(Type, L1)
+ end;
+ ?tuple_set(_Set1) = TupleSet ->
+ case Type of
+ ?tuple_set(_Set2) -> OpaqueStruct;
+ _ -> t_opaque_matching_structure_list(Type, t_tuple_subtypes(TupleSet))
+ end;
+ _Other -> OpaqueStruct
+ end.
+
+t_opaque_matching_structure_list(Type, List) ->
+ NewList = [t_inf(Element, Type) || Element <- List],
+ Results = [NotNone || NotNone <- NewList, NotNone =/= ?none],
+ case Results of
+ [] -> ?none;
+ [First|_] -> First
+ end.
+
+-spec t_contains_opaque(erl_type()) -> boolean().
+
+t_contains_opaque(?any) -> false;
+t_contains_opaque(?none) -> false;
+t_contains_opaque(?unit) -> false;
+t_contains_opaque(?atom(_Set)) -> false;
+t_contains_opaque(?bitstr(_Unit, _Base)) -> false;
+t_contains_opaque(?float) -> false;
+t_contains_opaque(?function(Domain, Range)) ->
+ t_contains_opaque(Domain) orelse t_contains_opaque(Range);
+t_contains_opaque(?identifier(_Types)) -> false;
+t_contains_opaque(?integer(_Types)) -> false;
+t_contains_opaque(?int_range(_From, _To)) -> false;
+t_contains_opaque(?int_set(_Set)) -> false;
+t_contains_opaque(?list(Type, _, _)) -> t_contains_opaque(Type);
+t_contains_opaque(?matchstate(_P, _Slots)) -> false;
+t_contains_opaque(?nil) -> false;
+t_contains_opaque(?number(_Set, _Tag)) -> false;
+t_contains_opaque(?opaque(_)) -> true;
+t_contains_opaque(?product(Types)) -> list_contains_opaque(Types);
+t_contains_opaque(?tuple(?any, _, _)) -> false;
+t_contains_opaque(?tuple(Types, _, _)) -> list_contains_opaque(Types);
+t_contains_opaque(?tuple_set(_Set) = T) ->
+ list_contains_opaque(t_tuple_subtypes(T));
+t_contains_opaque(?union(List)) -> list_contains_opaque(List);
+t_contains_opaque(?var(_Id)) -> false.
+
+-spec list_contains_opaque([erl_type()]) -> boolean().
+
+list_contains_opaque(List) ->
+ lists:any(fun t_contains_opaque/1, List).
+
+%% t_find_opaque_mismatch/2 of two types should only be used if their
+%% t_inf is t_none() due to some opaque type violation.
+%%
+%% The first argument of the function is the pattern and its second
+%% argument the type we are matching against the pattern.
+
+-spec t_find_opaque_mismatch(erl_type(), erl_type()) -> 'error' | {'ok', erl_type(), erl_type()}.
+
+t_find_opaque_mismatch(T1, T2) ->
+ t_find_opaque_mismatch(T1, T2, T2).
+
+t_find_opaque_mismatch(?any, _Type, _TopType) -> error;
+t_find_opaque_mismatch(?none, _Type, _TopType) -> error;
+t_find_opaque_mismatch(?list(T1, _, _), ?list(T2, _, _), TopType) ->
+ t_find_opaque_mismatch(T1, T2, TopType);
+t_find_opaque_mismatch(_T1, ?opaque(_) = T2, TopType) -> {ok, TopType, T2};
+t_find_opaque_mismatch(?product(T1), ?product(T2), TopType) ->
+ t_find_opaque_mismatch_ordlists(T1, T2, TopType);
+t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), TopType) ->
+ t_find_opaque_mismatch_ordlists(T1, T2, TopType);
+t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, TopType) ->
+ Tuples1 = t_tuple_subtypes(T1),
+ Tuples2 = t_tuple_subtypes(T2),
+ t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType);
+t_find_opaque_mismatch(T1, ?union(U2), TopType) ->
+ t_find_opaque_mismatch_lists([T1], U2, TopType);
+t_find_opaque_mismatch(_T1, _T2, _TopType) -> error.
+
+t_find_opaque_mismatch_ordlists(L1, L2, TopType) ->
+ List = lists:zipwith(fun(T1, T2) ->
+ t_find_opaque_mismatch(T1, T2, TopType)
+ end, L1, L2),
+ t_find_opaque_mismatch_list(List).
+
+t_find_opaque_mismatch_lists(L1, L2, _TopType) ->
+ List = [t_find_opaque_mismatch(T1, T2, T2) || T1 <- L1, T2 <- L2],
+ t_find_opaque_mismatch_list(List).
+
+t_find_opaque_mismatch_list([]) -> error;
+t_find_opaque_mismatch_list([H|T]) ->
+ case H of
+ {ok, _T1, _T2} -> H;
+ error -> t_find_opaque_mismatch_list(T)
+ end.
+
+-spec t_opaque_from_records(dict()) -> [erl_type()].
+
+t_opaque_from_records(RecDict) ->
+ OpaqueRecDict =
+ dict:filter(fun(Key, _Value) ->
+ case Key of
+ {opaque, _Name} -> true;
+ _ -> false
+ end
+ end, RecDict),
+ OpaqueTypeDict =
+ dict:map(fun({opaque, Name}, {Module, Type, ArgNames}) ->
+ case ArgNames of
+ [] ->
+ t_opaque(Module, Name, [], t_from_form(Type, RecDict));
+ _ ->
+ throw({error,"Polymorphic opaque types not supported yet"})
+ end
+ end, OpaqueRecDict),
+ [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)].
+
+-spec t_opaque_match_atom(erl_type(), [erl_type()]) -> [erl_type()].
+
+t_opaque_match_atom(?atom(_) = Atom, Opaques) ->
+ case t_atom_vals(Atom) of
+ unknown -> [];
+ _ -> [O || O <- Opaques, t_inf(Atom, O, opaque) =/= ?none,
+ t_opaque_atom_vals(t_opaque_structure(O)) =/= unknown]
+ end;
+t_opaque_match_atom(_, _) -> [].
+
+-spec t_opaque_atom_vals(erl_type()) -> 'unknown' | [atom(),...].
+
+t_opaque_atom_vals(OpaqueStruct) ->
+ case OpaqueStruct of
+ ?atom(_) -> t_atom_vals(OpaqueStruct);
+ ?union([Atom,_,_,_,_,_,_,_,_,_]) -> t_atom_vals(Atom);
+ _ -> unknown
+ end.
+
+-spec t_opaque_match_record(erl_type(), [erl_type()]) -> [erl_type()].
+
+t_opaque_match_record(?tuple([?atom(_) = Tag|_Fields], _, _) = Rec, Opaques) ->
+ [O || O <- Opaques, t_inf(Rec, O, opaque) =/= ?none,
+ lists:member(Tag, t_opaque_tuple_tags(t_opaque_structure(O)))];
+t_opaque_match_record(_, _) -> [].
+
+-spec t_opaque_tuple_tags(erl_type()) -> [erl_type()].
+
+t_opaque_tuple_tags(OpaqueStruct) ->
+ case OpaqueStruct of
+ ?tuple([?atom(_) = Tag|_Fields], _, _) -> [Tag];
+ ?tuple_set(_) = TupleSet ->
+ Tuples = t_tuple_subtypes(TupleSet),
+ lists:flatten([t_opaque_tuple_tags(T) || T <- Tuples]);
+ ?union([_,_,_,_,_,_,Tuples,_,_,_]) -> t_opaque_tuple_tags(Tuples);
+ _ -> []
+ end.
+
+%% Decompose opaque instances of type arg2 to structured types, in arg1
+-spec t_struct_from_opaque(erl_type(), erl_type()) -> erl_type().
+
+t_struct_from_opaque(?function(Domain, Range), Opaque) ->
+ ?function(t_struct_from_opaque(Domain, Opaque),
+ t_struct_from_opaque(Range, Opaque));
+t_struct_from_opaque(?list(Types, Term, Size), Opaque) ->
+ ?list(t_struct_from_opaque(Types, Opaque), Term, Size);
+t_struct_from_opaque(?opaque(_) = T, Opaque) ->
+ case T =:= Opaque of
+ true -> t_opaque_structure(T);
+ false -> T
+ end;
+t_struct_from_opaque(?product(Types), Opaque) ->
+ ?product(list_struct_from_opaque(Types, Opaque));
+t_struct_from_opaque(?tuple(?any, _, _) = T, _Opaque) -> T;
+t_struct_from_opaque(?tuple(Types, Arity, Tag), Opaque) ->
+ ?tuple(list_struct_from_opaque(Types, Opaque), Arity, Tag);
+t_struct_from_opaque(?tuple_set(Set), Opaque) ->
+ NewSet = [{Sz, [t_struct_from_opaque(T, Opaque) || T <- Tuples]}
+ || {Sz, Tuples} <- Set],
+ ?tuple_set(NewSet);
+t_struct_from_opaque(?union(List), Opaque) ->
+ t_sup(list_struct_from_opaque(List, Opaque));
+t_struct_from_opaque(Type, _Opaque) -> Type.
+
+list_struct_from_opaque(Types, Opaque) ->
+ [t_struct_from_opaque(Type, Opaque) || Type <- Types].
+
+-spec module_builtin_opaques(module()) -> [erl_type()].
+
+module_builtin_opaques(Module) ->
+ [O || O <- all_opaque_builtins(), t_opaque_module(O) =:= Module].
+
+%%-----------------------------------------------------------------------------
+%% Remote types
+%% These types are used for preprocessing they should never reach the analysis stage
+
+-spec t_remote(module(), atom(), [_]) -> erl_type().
+
+t_remote(Mod, Name, Args) ->
+ ?remote(set_singleton(#remote{mod=Mod, name=Name, args=Args})).
+
+-spec t_is_remote(erl_type()) -> boolean().
+
+t_is_remote(?remote(_)) -> true;
+t_is_remote(_) -> false.
+
+-spec t_solve_remote(erl_type(), dict()) -> erl_type().
+
+t_solve_remote(Type , Records) ->
+ t_solve_remote(Type, Records, ordsets:new()).
+
+t_solve_remote(?function(Domain, Range), R, C) ->
+ ?function(t_solve_remote(Domain, R, C), t_solve_remote(Range, R, C));
+t_solve_remote(?list(Types, Term, Size), R, C) ->
+ ?list(t_solve_remote(Types, R, C), Term, Size);
+t_solve_remote(?product(Types), R, C) ->
+ ?product(list_solve_remote(Types, R, C));
+t_solve_remote(?opaque(Set), R, C) ->
+ List = ordsets:to_list(Set),
+ NewList = [Remote#opaque{struct = t_solve_remote(Struct, R, C)}
+ || Remote = #opaque{struct = Struct} <- List],
+ ?opaque(ordsets:from_list(NewList));
+t_solve_remote(?tuple(?any, _, _) = T, _R, _C) -> T;
+t_solve_remote(?tuple(Types, Arity, Tag), R, C) ->
+ ?tuple(list_solve_remote(Types, R, C), Arity, Tag);
+t_solve_remote(?tuple_set(Set), R, C) ->
+ NewSet = [{Sz, [t_solve_remote(T, R, C) || T <- Tuples]} || {Sz, Tuples} <- Set],
+ ?tuple_set(NewSet);
+t_solve_remote(?remote(Set), R, C) ->
+ Cycle = ordsets:intersection(Set, C),
+ case ordsets:size(Cycle) of
+ 0 -> ok;
+ _ ->
+ CycleMsg = "Cycle detected while processing remote types: " ++
+ t_to_string(?remote(C), dict:new()),
+ throw({error, CycleMsg})
+ end,
+ NewCycle = ordsets:union(C, Set),
+ TypeFun =
+ fun(#remote{mod = RemoteModule, name = Name, args = Args}) ->
+ case dict:find(RemoteModule, R) of
+ error ->
+ Msg = io_lib:format("Cannot locate module ~w to "
+ "resolve the remote type: ~w:~w()~n",
+ [RemoteModule, RemoteModule, Name]),
+ throw({error, Msg});
+ {ok, RemoteDict} ->
+ case lookup_type(Name, RemoteDict) of
+ {type, {_TypeMod, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+ List = lists:zip(ArgNames, Args),
+ TmpVardict = dict:from_list(List),
+ NewType = t_from_form(Type, RemoteDict, TmpVardict),
+ t_solve_remote(NewType, R, NewCycle);
+ {opaque, {OpModule, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+ List = lists:zip(ArgNames, Args),
+ TmpVardict = dict:from_list(List),
+ Rep = t_from_form(Type, RemoteDict, TmpVardict),
+ NewRep = t_solve_remote(Rep, R, NewCycle),
+ t_from_form({opaque, -1, Name, {OpModule, Args, NewRep}},
+ RemoteDict, TmpVardict);
+ {type, _} ->
+ Msg = io_lib:format("Unknown remote type ~w\n", [Name]),
+ throw({error, Msg});
+ {opaque, _} ->
+ Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]),
+ throw({error, Msg});
+ error ->
+ Msg = io_lib:format("Unable to find remote type ~w:~w()\n",
+ [RemoteModule, Name]),
+ throw({error, Msg})
+ end
+ end
+ end,
+ RemoteList = ordsets:to_list(Set),
+ t_sup([TypeFun(RemoteType) || RemoteType <- RemoteList]);
+t_solve_remote(?union(List), R, C) ->
+ t_sup(list_solve_remote(List, R, C));
+t_solve_remote(T, _R, _C) -> T.
+
+list_solve_remote(Types, R, C) ->
+ [t_solve_remote(Type, R, C) || Type <- Types].
+
+%%-----------------------------------------------------------------------------
+%% Unit type. Signals non termination.
+%%
+
+-spec t_unit() -> erl_type().
+
+t_unit() ->
+ ?unit.
+
+-spec t_is_unit(erl_type()) -> boolean().
+
+t_is_unit(?unit) -> true;
+t_is_unit(_) -> false.
+
+-spec t_is_none_or_unit(erl_type()) -> boolean().
+
+t_is_none_or_unit(?none) -> true;
+t_is_none_or_unit(?unit) -> true;
+t_is_none_or_unit(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Atoms and the derived type bool
+%%
+
+-spec t_atom() -> erl_type().
+
+t_atom() ->
+ ?atom(?any).
+
+-spec t_atom(atom()) -> erl_type().
+
+t_atom(A) when is_atom(A) ->
+ ?atom(set_singleton(A)).
+
+-spec t_atoms([atom()]) -> erl_type().
+
+t_atoms(List) when is_list(List) ->
+ t_sup([t_atom(A) || A <- List]).
+
+-spec t_atom_vals(erl_type()) -> 'unknown' | [atom(),...].
+
+t_atom_vals(?atom(?any)) -> unknown;
+t_atom_vals(?atom(Set)) -> set_to_list(Set);
+t_atom_vals(Other) ->
+ ?atom(_) = Atm = t_inf(t_atom(), Other),
+ t_atom_vals(Atm).
+
+-spec t_is_atom(erl_type()) -> boolean().
+
+t_is_atom(?atom(_)) -> true;
+t_is_atom(_) -> false.
+
+-spec t_is_atom(atom(), erl_type()) -> boolean().
+
+t_is_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false;
+t_is_atom(Atom, ?atom(Set)) when is_atom(Atom) -> set_is_singleton(Atom, Set);
+t_is_atom(Atom, _) when is_atom(Atom) -> false.
+
+%%------------------------------------
+
+-spec t_boolean() -> erl_type().
+
+t_boolean() ->
+ ?atom(set_from_list([false, true])).
+
+-spec t_is_boolean(erl_type()) -> boolean().
+
+t_is_boolean(?atom(?any)) -> false;
+t_is_boolean(?atom(Set)) ->
+ case set_size(Set) of
+ 1 -> set_is_element(true, Set) orelse set_is_element(false, Set);
+ 2 -> set_is_element(true, Set) andalso set_is_element(false, Set);
+ N when is_integer(N), N > 2 -> false
+ end;
+t_is_boolean(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Binaries
+%%
+
+-spec t_binary() -> erl_type().
+
+t_binary() ->
+ ?bitstr(8, 0).
+
+-spec t_is_binary(erl_type()) -> boolean().
+
+t_is_binary(?bitstr(U, B)) ->
+ ((U rem 8) =:= 0) andalso ((B rem 8) =:= 0);
+t_is_binary(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Bitstrings
+%%
+
+-spec t_bitstr() -> erl_type().
+
+t_bitstr() ->
+ ?bitstr(1, 0).
+
+-spec t_bitstr(non_neg_integer(), non_neg_integer()) -> erl_type().
+
+t_bitstr(U, B) ->
+ NewB =
+ if
+ U =:= 0 -> B;
+ B >= (U * (?UNIT_MULTIPLIER + 1)) ->
+ (B rem U) + U * ?UNIT_MULTIPLIER;
+ true ->
+ B
+ end,
+ ?bitstr(U, NewB).
+
+-spec t_bitstr_unit(erl_type()) -> non_neg_integer().
+
+t_bitstr_unit(?bitstr(U, _)) -> U.
+
+-spec t_bitstr_base(erl_type()) -> non_neg_integer().
+
+t_bitstr_base(?bitstr(_, B)) -> B.
+
+-spec t_bitstr_concat([erl_type()]) -> erl_type().
+
+t_bitstr_concat(List) ->
+ t_bitstr_concat_1(List, t_bitstr(0, 0)).
+
+t_bitstr_concat_1([T|Left], Acc) ->
+ t_bitstr_concat_1(Left, t_bitstr_concat(Acc, T));
+t_bitstr_concat_1([], Acc) ->
+ Acc.
+
+-spec t_bitstr_concat(erl_type(), erl_type()) -> erl_type().
+
+t_bitstr_concat(T1, T2) ->
+ T1p = t_inf(t_bitstr(), T1),
+ T2p = t_inf(t_bitstr(), T2),
+ bitstr_concat(T1p, T2p).
+
+-spec t_bitstr_match(erl_type(), erl_type()) -> erl_type().
+
+t_bitstr_match(T1, T2) ->
+ T1p = t_inf(t_bitstr(), T1),
+ T2p = t_inf(t_bitstr(), T2),
+ bitstr_match(T1p, T2p).
+
+-spec t_is_bitstr(erl_type()) -> boolean().
+
+t_is_bitstr(?bitstr(_, _)) -> true;
+t_is_bitstr(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Matchstates
+%%
+
+-spec t_matchstate() -> erl_type().
+
+t_matchstate() ->
+ ?any_matchstate.
+
+-spec t_matchstate(erl_type(), non_neg_integer()) -> erl_type().
+
+t_matchstate(Init, 0) ->
+ ?matchstate(Init, Init);
+t_matchstate(Init, Max) when is_integer(Max) ->
+ Slots = [Init|[?none || _ <- lists:seq(1, Max)]],
+ ?matchstate(Init, t_product(Slots)).
+
+-spec t_is_matchstate(erl_type()) -> boolean().
+
+t_is_matchstate(?matchstate(_, _)) -> true;
+t_is_matchstate(_) -> false.
+
+-spec t_matchstate_present(erl_type()) -> erl_type().
+
+t_matchstate_present(Type) ->
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(P, _) -> P;
+ _ -> ?none
+ end.
+
+-spec t_matchstate_slot(erl_type(), non_neg_integer()) -> erl_type().
+
+t_matchstate_slot(Type, Slot) ->
+ RealSlot = Slot + 1,
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(_, ?any) -> ?any;
+ ?matchstate(_, ?product(Vals)) when length(Vals) >= RealSlot ->
+ lists:nth(RealSlot, Vals);
+ ?matchstate(_, ?product(_)) ->
+ ?none;
+ ?matchstate(_, SlotType) when RealSlot =:= 1 ->
+ SlotType;
+ _ ->
+ ?none
+ end.
+
+-spec t_matchstate_slots(erl_type()) -> erl_type().
+
+t_matchstate_slots(?matchstate(_, Slots)) ->
+ Slots.
+
+-spec t_matchstate_update_present(erl_type(), erl_type()) -> erl_type().
+
+t_matchstate_update_present(New, Type) ->
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(_, Slots) ->
+ ?matchstate(New, Slots);
+ _ -> ?none
+ end.
+
+-spec t_matchstate_update_slot(erl_type(), erl_type(), non_neg_integer()) -> erl_type().
+
+t_matchstate_update_slot(New, Type, Slot) ->
+ RealSlot = Slot + 1,
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(Pres, Slots) ->
+ NewSlots =
+ case Slots of
+ ?any ->
+ ?any;
+ ?product(Vals) when length(Vals) >= RealSlot ->
+ NewTuple = setelement(RealSlot, list_to_tuple(Vals), New),
+ NewVals = tuple_to_list(NewTuple),
+ ?product(NewVals);
+ ?product(_) ->
+ ?none;
+ _ when RealSlot =:= 1 ->
+ New;
+ _ ->
+ ?none
+ end,
+ ?matchstate(Pres, NewSlots);
+ _ ->
+ ?none
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Functions
+%%
+
+-spec t_fun() -> erl_type().
+
+t_fun() ->
+ ?function(?any, ?any).
+
+-spec t_fun(erl_type()) -> erl_type().
+
+t_fun(Range) ->
+ ?function(?any, Range).
+
+-spec t_fun([erl_type()] | arity(), erl_type()) -> erl_type().
+
+t_fun(Domain, Range) when is_list(Domain) ->
+ ?function(?product(Domain), Range);
+t_fun(Arity, Range) when is_integer(Arity), 0 =< Arity, Arity =< 255 ->
+ ?function(?product(lists:duplicate(Arity, ?any)), Range).
+
+-spec t_fun_args(erl_type()) -> 'unknown' | [erl_type()].
+
+t_fun_args(?function(?any, _)) ->
+ unknown;
+t_fun_args(?function(?product(Domain), _)) when is_list(Domain) ->
+ Domain.
+
+-spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer().
+
+t_fun_arity(?function(?any, _)) ->
+ unknown;
+t_fun_arity(?function(?product(Domain), _)) ->
+ length(Domain).
+
+-spec t_fun_range(erl_type()) -> erl_type().
+
+t_fun_range(?function(_, Range)) ->
+ Range.
+
+-spec t_is_fun(erl_type()) -> boolean().
+
+t_is_fun(?function(_, _)) -> true;
+t_is_fun(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Identifiers. Includes ports, pids and refs.
+%%
+
+-spec t_identifier() -> erl_type().
+
+t_identifier() ->
+ ?identifier(?any).
+
+-ifdef(DO_ERL_TYPES_TEST).
+-spec t_is_identifier(erl_type()) -> erl_type().
+
+t_is_identifier(?identifier(_)) -> true;
+t_is_identifier(_) -> false.
+-endif.
+
+%%------------------------------------
+
+-spec t_port() -> erl_type().
+
+t_port() ->
+ ?identifier(set_singleton(?port_qual)).
+
+-spec t_is_port(erl_type()) -> boolean().
+
+t_is_port(?identifier(?any)) -> false;
+t_is_port(?identifier(Set)) -> set_is_singleton(?port_qual, Set);
+t_is_port(_) -> false.
+
+%%------------------------------------
+
+-spec t_pid() -> erl_type().
+
+t_pid() ->
+ ?identifier(set_singleton(?pid_qual)).
+
+-spec t_is_pid(erl_type()) -> boolean().
+
+t_is_pid(?identifier(?any)) -> false;
+t_is_pid(?identifier(Set)) -> set_is_singleton(?pid_qual, Set);
+t_is_pid(_) -> false.
+
+%%------------------------------------
+
+-spec t_reference() -> erl_type().
+
+t_reference() ->
+ ?identifier(set_singleton(?reference_qual)).
+
+-spec t_is_reference(erl_type()) -> boolean().
+
+t_is_reference(?identifier(?any)) -> false;
+t_is_reference(?identifier(Set)) -> set_is_singleton(?reference_qual, Set);
+t_is_reference(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Numbers are divided into floats, integers, chars and bytes.
+%%
+
+-spec t_number() -> erl_type().
+
+t_number() ->
+ ?number(?any, ?unknown_qual).
+
+-spec t_number(integer()) -> erl_type().
+
+t_number(X) when is_integer(X) ->
+ t_integer(X).
+
+-spec t_is_number(erl_type()) -> boolean().
+
+t_is_number(?number(_, _)) -> true;
+t_is_number(_) -> false.
+
+%% Currently, the type system collapses all floats to ?float and does
+%% not keep any information about their values. As a result, the list
+%% that this function returns contains only integers.
+-spec t_number_vals(erl_type()) -> 'unknown' | [integer(),...].
+
+t_number_vals(?int_set(?any)) -> unknown;
+t_number_vals(?int_set(Set)) -> set_to_list(Set);
+t_number_vals(?number(_, _)) -> unknown;
+t_number_vals(Other) ->
+ Inf = t_inf(Other, t_number()),
+ false = t_is_none(Inf), % sanity check
+ t_number_vals(Inf).
+
+%%------------------------------------
+
+-spec t_float() -> erl_type().
+
+t_float() ->
+ ?float.
+
+-spec t_is_float(erl_type()) -> boolean().
+
+t_is_float(?float) -> true;
+t_is_float(_) -> false.
+
+%%------------------------------------
+
+-spec t_integer() -> erl_type().
+
+t_integer() ->
+ ?integer(?any).
+
+-spec t_integer(integer()) -> erl_type().
+
+t_integer(I) when is_integer(I) ->
+ ?int_set(set_singleton(I)).
+
+-spec t_integers([integer()]) -> erl_type().
+
+t_integers(List) when is_list(List) ->
+ t_sup([t_integer(I) || I <- List]).
+
+-spec t_is_integer(erl_type()) -> boolean().
+
+t_is_integer(?integer(_)) -> true;
+t_is_integer(_) -> false.
+
+%%------------------------------------
+
+-spec t_byte() -> erl_type().
+
+t_byte() ->
+ ?byte.
+
+-ifdef(DO_ERL_TYPES_TEST).
+-spec t_is_byte(erl_type()) -> boolean().
+
+t_is_byte(?int_range(neg_inf, _)) -> false;
+t_is_byte(?int_range(_, pos_inf)) -> false;
+t_is_byte(?int_range(From, To))
+ when is_integer(From), From >= 0, is_integer(To), To =< ?MAX_BYTE -> true;
+t_is_byte(?int_set(Set)) ->
+ (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE);
+t_is_byte(_) -> false.
+-endif.
+
+%%------------------------------------
+
+-spec t_char() -> erl_type().
+
+t_char() ->
+ ?char.
+
+-spec t_is_char(erl_type()) -> boolean().
+
+t_is_char(?int_range(neg_inf, _)) -> false;
+t_is_char(?int_range(_, pos_inf)) -> false;
+t_is_char(?int_range(From, To))
+ when is_integer(From), From >= 0, is_integer(To), To =< ?MAX_CHAR -> true;
+t_is_char(?int_set(Set)) ->
+ (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_CHAR);
+t_is_char(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Lists
+%%
+
+-spec t_cons() -> erl_type().
+
+t_cons() ->
+ ?nonempty_list(?any, ?any).
+
+%% Note that if the tail argument can be a list, we must collapse the
+%% content of the list to include both the content of the tail list
+%% and the head of the cons. If for example the tail argument is any()
+%% then there can be any list in the tail and the content of the
+%% returned list must be any().
+
+-spec t_cons(erl_type(), erl_type()) -> erl_type().
+
+t_cons(?none, _) -> ?none;
+t_cons(_, ?none) -> ?none;
+t_cons(?unit, _) -> ?none;
+t_cons(_, ?unit) -> ?none;
+t_cons(Hd, ?nil) ->
+ ?nonempty_list(Hd, ?nil);
+t_cons(Hd, ?list(Contents, Termination, _)) ->
+ ?nonempty_list(t_sup(Contents, Hd), Termination);
+t_cons(Hd, Tail) ->
+ case t_inf(Tail, t_maybe_improper_list()) of
+ ?list(Contents, Termination, _Size) ->
+ %% Collapse the list part of the termination but keep the
+ %% non-list part intact.
+ NewTermination = t_sup(t_subtract(Tail, t_maybe_improper_list()),
+ Termination),
+ ?nonempty_list(t_sup(Hd, Contents), NewTermination);
+ ?nil -> ?nonempty_list(Hd, Tail);
+ ?none -> ?nonempty_list(Hd, Tail);
+ ?unit -> ?none
+ end.
+
+-spec t_is_cons(erl_type()) -> boolean().
+
+t_is_cons(?nonempty_list(_, _)) -> true;
+t_is_cons(_) -> false.
+
+-spec t_cons_hd(erl_type()) -> erl_type().
+
+t_cons_hd(?nonempty_list(Contents, _Termination)) -> Contents.
+
+-spec t_cons_tl(erl_type()) -> erl_type().
+
+t_cons_tl(?nonempty_list(_Contents, Termination) = T) ->
+ t_sup(Termination, T).
+
+-spec t_nil() -> erl_type().
+
+t_nil() ->
+ ?nil.
+
+-spec t_is_nil(erl_type()) -> boolean().
+
+t_is_nil(?nil) -> true;
+t_is_nil(_) -> false.
+
+-spec t_list() -> erl_type().
+
+t_list() ->
+ ?list(?any, ?nil, ?unknown_qual).
+
+-spec t_list(erl_type()) -> erl_type().
+
+t_list(?none) -> ?none;
+t_list(?unit) -> ?none;
+t_list(Contents) ->
+ ?list(Contents, ?nil, ?unknown_qual).
+
+-spec t_list_elements(erl_type()) -> erl_type().
+
+t_list_elements(?list(Contents, _, _)) -> Contents;
+t_list_elements(?nil) -> ?none.
+
+-spec t_list_termination(erl_type()) -> erl_type().
+
+t_list_termination(?nil) -> ?nil;
+t_list_termination(?list(_, Term, _)) -> Term.
+
+-spec t_is_list(erl_type()) -> boolean().
+
+t_is_list(?list(_Contents, ?nil, _)) -> true;
+t_is_list(?nil) -> true;
+t_is_list(_) -> false.
+
+-spec t_nonempty_list() -> erl_type().
+
+t_nonempty_list() ->
+ t_cons(?any, ?nil).
+
+-spec t_nonempty_list(erl_type()) -> erl_type().
+
+t_nonempty_list(Type) ->
+ t_cons(Type, ?nil).
+
+-spec t_nonempty_string() -> erl_type().
+
+t_nonempty_string() ->
+ t_nonempty_list(t_char()).
+
+-spec t_string() -> erl_type().
+
+t_string() ->
+ t_list(t_char()).
+
+-spec t_is_string(erl_type()) -> boolean().
+
+t_is_string(X) ->
+ t_is_list(X) andalso t_is_char(t_list_elements(X)).
+
+-spec t_maybe_improper_list() -> erl_type().
+
+t_maybe_improper_list() ->
+ ?list(?any, ?any, ?unknown_qual).
+
+%% Should only be used if you know what you are doing. See t_cons/2
+-spec t_maybe_improper_list(erl_type(), erl_type()) -> erl_type().
+
+t_maybe_improper_list(_Content, ?unit) -> ?none;
+t_maybe_improper_list(?unit, _Termination) -> ?none;
+t_maybe_improper_list(Content, Termination) ->
+ %% Safety check
+ true = t_is_subtype(t_nil(), Termination),
+ ?list(Content, Termination, ?unknown_qual).
+
+-spec t_is_maybe_improper_list(erl_type()) -> boolean().
+
+t_is_maybe_improper_list(?list(_, _, _)) -> true;
+t_is_maybe_improper_list(?nil) -> true;
+t_is_maybe_improper_list(_) -> false.
+
+%% %% Should only be used if you know what you are doing. See t_cons/2
+%% -spec t_improper_list(erl_type(), erl_type()) -> erl_type().
+%%
+%% t_improper_list(?unit, _Termination) -> ?none;
+%% t_improper_list(_Content, ?unit) -> ?none;
+%% t_improper_list(Content, Termination) ->
+%% %% Safety check
+%% false = t_is_subtype(t_nil(), Termination),
+%% ?list(Content, Termination, ?any).
+
+-spec lift_list_to_pos_empty(erl_type()) -> erl_type().
+
+lift_list_to_pos_empty(?nil) -> ?nil;
+lift_list_to_pos_empty(?list(Content, Termination, _)) ->
+ ?list(Content, Termination, ?unknown_qual).
+
+%%-----------------------------------------------------------------------------
+%% Tuples
+%%
+
+-spec t_tuple() -> erl_type().
+
+t_tuple() ->
+ ?tuple(?any, ?any, ?any).
+
+-spec t_tuple(non_neg_integer() | [erl_type()]) -> erl_type().
+
+t_tuple(N) when is_integer(N) ->
+ ?tuple(lists:duplicate(N, ?any), N, ?any);
+t_tuple(List) ->
+ case any_none_or_unit(List) of
+ true -> t_none();
+ false ->
+ Arity = length(List),
+ case get_tuple_tags(List) of
+ [Tag] -> ?tuple(List, Arity, Tag); %% Tag can also be ?any here
+ TagList ->
+ SortedTagList = lists:sort(TagList),
+ Tuples = [?tuple([T|tl(List)], Arity, T) || T <- SortedTagList],
+ ?tuple_set([{Arity, Tuples}])
+ end
+ end.
+
+-spec get_tuple_tags([erl_type()]) -> [erl_type(),...].
+
+get_tuple_tags([?atom(?any)|_]) -> [?any];
+get_tuple_tags([?atom(Set)|_]) ->
+ case set_size(Set) > ?TUPLE_TAG_LIMIT of
+ true -> [?any];
+ false -> [t_atom(A) || A <- set_to_list(Set)]
+ end;
+get_tuple_tags(_) -> [?any].
+
+%% to be used for a tuple with known types for its arguments (not ?any)
+-spec t_tuple_args(erl_type()) -> [erl_type()].
+
+t_tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args.
+
+%% to be used for a tuple with a known size (not ?any)
+-spec t_tuple_size(erl_type()) -> non_neg_integer().
+
+t_tuple_size(?tuple(_, Size, _)) when is_integer(Size) -> Size.
+
+-spec t_tuple_sizes(erl_type()) -> 'unknown' | [non_neg_integer(),...].
+
+t_tuple_sizes(?tuple(?any, ?any, ?any)) -> unknown;
+t_tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size];
+t_tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List].
+
+-spec t_tuple_subtypes(erl_type()) -> 'unknown' | [erl_type(),...].
+
+t_tuple_subtypes(?tuple(?any, ?any, ?any)) -> unknown;
+t_tuple_subtypes(?tuple(_, _, _) = T) -> [T];
+t_tuple_subtypes(?tuple_set(List)) ->
+ lists:append([Tuples || {_Size, Tuples} <- List]).
+
+-spec t_is_tuple(erl_type()) -> boolean().
+
+t_is_tuple(?tuple(_, _, _)) -> true;
+t_is_tuple(?tuple_set(_)) -> true;
+t_is_tuple(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Non-primitive types, including some handy syntactic sugar types
+%%
+
+-spec t_constant() -> erl_type().
+
+t_constant() ->
+ t_sup([t_number(), t_identifier(), t_atom(), t_fun(), t_binary()]).
+
+-spec t_is_constant(erl_type()) -> boolean().
+
+t_is_constant(X) ->
+ t_is_subtype(X, t_constant()).
+
+-spec t_arity() -> erl_type().
+
+t_arity() ->
+ t_from_range(0, 255). % was t_byte().
+
+-spec t_pos_integer() -> erl_type().
+
+t_pos_integer() ->
+ t_from_range(1, pos_inf).
+
+-spec t_non_neg_integer() -> erl_type().
+
+t_non_neg_integer() ->
+ t_from_range(0, pos_inf).
+
+-spec t_is_non_neg_integer(erl_type()) -> boolean().
+
+t_is_non_neg_integer(?integer(_) = T) ->
+ t_is_subtype(T, t_non_neg_integer());
+t_is_non_neg_integer(_) -> false.
+
+-spec t_neg_integer() -> erl_type().
+
+t_neg_integer() ->
+ t_from_range(neg_inf, -1).
+
+-spec t_fixnum() -> erl_type().
+
+t_fixnum() ->
+ t_integer(). % Gross over-approximation
+
+-spec t_pos_fixnum() -> erl_type().
+
+t_pos_fixnum() ->
+ t_pos_integer(). % Gross over-approximation
+
+-spec t_non_neg_fixnum() -> erl_type().
+
+t_non_neg_fixnum() ->
+ t_non_neg_integer(). % Gross over-approximation
+
+-spec t_mfa() -> erl_type().
+
+t_mfa() ->
+ t_tuple([t_atom(), t_atom(), t_arity()]).
+
+-spec t_module() -> erl_type().
+
+t_module() ->
+ t_atom().
+
+-spec t_node() -> erl_type().
+
+t_node() ->
+ t_atom().
+
+-spec t_iodata() -> erl_type().
+
+t_iodata() ->
+ t_sup(t_iolist(), t_binary()).
+
+-spec t_iolist() -> erl_type().
+
+t_iolist() ->
+ t_iolist(1).
+
+-spec t_iolist(non_neg_integer()) -> erl_type().
+
+t_iolist(N) when N > 0 ->
+ t_maybe_improper_list(t_sup([t_iolist(N-1), t_binary(), t_byte()]),
+ t_sup(t_binary(), t_nil()));
+t_iolist(0) ->
+ t_maybe_improper_list(t_any(), t_sup(t_binary(), t_nil())).
+
+-spec t_timeout() -> erl_type().
+
+t_timeout() ->
+ t_sup(t_non_neg_integer(), t_atom('infinity')).
+
+%%-----------------------------------------------------------------------------
+%% Some built-in opaque types
+%%
+
+-spec t_array() -> erl_type().
+
+t_array() ->
+ t_opaque(array, array, [],
+ t_tuple([t_atom('array'),
+ t_non_neg_integer(), t_non_neg_integer(),
+ t_any(), t_any()])).
+
+-spec t_dict() -> erl_type().
+
+t_dict() ->
+ t_opaque(dict, dict, [],
+ t_tuple([t_atom('dict'),
+ t_non_neg_integer(), t_non_neg_integer(),
+ t_non_neg_integer(), t_non_neg_integer(),
+ t_non_neg_integer(), t_non_neg_integer(),
+ t_tuple(), t_tuple()])).
+
+-spec t_digraph() -> erl_type().
+
+t_digraph() ->
+ t_opaque(digraph, digraph, [],
+ t_tuple([t_atom('digraph'),
+ t_sup(t_atom(), t_tid()),
+ t_sup(t_atom(), t_tid()),
+ t_sup(t_atom(), t_tid()),
+ t_boolean()])).
+
+-spec t_gb_set() -> erl_type().
+
+t_gb_set() ->
+ t_opaque(gb_sets, gb_set, [],
+ t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])).
+
+-spec t_gb_tree() -> erl_type().
+
+t_gb_tree() ->
+ t_opaque(gb_trees, gb_tree, [],
+ t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])).
+
+-spec t_queue() -> erl_type().
+
+t_queue() ->
+ t_opaque(queue, queue, [], t_tuple([t_list(), t_list()])).
+
+-spec t_set() -> erl_type().
+
+t_set() ->
+ t_opaque(sets, set, [],
+ t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(),
+ t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(),
+ t_non_neg_integer(), t_tuple(), t_tuple()])).
+
+-spec t_tid() -> erl_type().
+
+t_tid() ->
+ t_opaque(ets, tid, [], t_integer()).
+
+-spec all_opaque_builtins() -> [erl_type()].
+
+all_opaque_builtins() ->
+ [t_array(), t_dict(), t_digraph(), t_gb_set(),
+ t_gb_tree(), t_queue(), t_set(), t_tid()].
+
+-spec is_opaque_builtin(atom(), atom()) -> boolean().
+
+is_opaque_builtin(array, array) -> true;
+is_opaque_builtin(dict, dict) -> true;
+is_opaque_builtin(digraph, digraph) -> true;
+is_opaque_builtin(gb_sets, gb_set) -> true;
+is_opaque_builtin(gb_trees, gb_tree) -> true;
+is_opaque_builtin(queue, queue) -> true;
+is_opaque_builtin(sets, set) -> true;
+is_opaque_builtin(ets, tid) -> true;
+is_opaque_builtin(_, _) -> false.
+
+%%------------------------------------
+
+%% ?none is allowed in products. A product of size 1 is not a product.
+
+-spec t_product([erl_type()]) -> erl_type().
+
+t_product([T]) -> T;
+t_product(Types) when is_list(Types) ->
+ ?product(Types).
+
+%% This function is intended to be the inverse of the one above.
+%% It should NOT be used with ?any, ?none or ?unit as input argument.
+
+-spec t_to_tlist(erl_type()) -> [erl_type()].
+
+t_to_tlist(?product(Types)) -> Types;
+t_to_tlist(T) when T =/= ?any orelse T =/= ?none orelse T =/= ?unit -> [T].
+
+%%------------------------------------
+
+-spec t_var(atom() | integer()) -> erl_type().
+
+t_var(Atom) when is_atom(Atom) -> ?var(Atom);
+t_var(Int) when is_integer(Int) -> ?var(Int).
+
+-spec t_is_var(erl_type()) -> boolean().
+
+t_is_var(?var(_)) -> true;
+t_is_var(_) -> false.
+
+-spec t_var_name(erl_type()) -> atom() | integer().
+
+t_var_name(?var(Id)) -> Id.
+
+-spec t_has_var(erl_type()) -> boolean().
+
+t_has_var(?var(_)) -> true;
+t_has_var(?function(Domain, Range)) ->
+ t_has_var(Domain) orelse t_has_var(Range);
+t_has_var(?list(Contents, Termination, _)) ->
+ t_has_var(Contents) orelse t_has_var(Termination);
+t_has_var(?product(Types)) -> t_has_var_list(Types);
+t_has_var(?tuple(?any, ?any, ?any)) -> false;
+t_has_var(?tuple(Elements, _, _)) ->
+ t_has_var_list(Elements);
+t_has_var(?tuple_set(_) = T) ->
+ t_has_var_list(t_tuple_subtypes(T));
+%% t_has_var(?union(_) = U) ->
+%% exit(lists:flatten(io_lib:format("Union happens in t_has_var/1 ~p\n",[U])));
+t_has_var(_) -> false.
+
+-spec t_has_var_list([erl_type()]) -> boolean().
+
+t_has_var_list([T|Ts]) ->
+ t_has_var(T) orelse t_has_var_list(Ts);
+t_has_var_list([]) -> false.
+
+-spec t_collect_vars(erl_type()) -> [erl_type()].
+
+t_collect_vars(T) ->
+ t_collect_vars(T, []).
+
+-spec t_collect_vars(erl_type(), [erl_type()]) -> [erl_type()].
+
+t_collect_vars(?var(_) = Var, Acc) ->
+ ordsets:add_element(Var, Acc);
+t_collect_vars(?function(Domain, Range), Acc) ->
+ ordsets:union(t_collect_vars(Domain, Acc), t_collect_vars(Range, []));
+t_collect_vars(?list(Contents, Termination, _), Acc) ->
+ ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, []));
+t_collect_vars(?product(Types), Acc) ->
+ lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types);
+t_collect_vars(?tuple(?any, ?any, ?any), Acc) ->
+ Acc;
+t_collect_vars(?tuple(Types, _, _), Acc) ->
+ lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types);
+t_collect_vars(?tuple_set(_) = TS, Acc) ->
+ lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc,
+ t_tuple_subtypes(TS));
+t_collect_vars(_, Acc) ->
+ Acc.
+
+
+%%=============================================================================
+%%
+%% Type construction from Erlang terms.
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Make a type from a term. No type depth is enforced.
+%%
+
+-spec t_from_term(term()) -> erl_type().
+
+t_from_term([H|T]) -> t_cons(t_from_term(H), t_from_term(T));
+t_from_term([]) -> t_nil();
+t_from_term(T) when is_atom(T) -> t_atom(T);
+t_from_term(T) when is_bitstring(T) -> t_bitstr(0, erlang:bit_size(T));
+t_from_term(T) when is_float(T) -> t_float();
+t_from_term(T) when is_function(T) ->
+ {arity, Arity} = erlang:fun_info(T, arity),
+ t_fun(Arity, t_any());
+t_from_term(T) when is_integer(T) -> t_integer(T);
+t_from_term(T) when is_pid(T) -> t_pid();
+t_from_term(T) when is_port(T) -> t_port();
+t_from_term(T) when is_reference(T) -> t_reference();
+t_from_term(T) when is_tuple(T) ->
+ t_tuple([t_from_term(E) || E <- tuple_to_list(T)]).
+
+%%-----------------------------------------------------------------------------
+%% Integer types from a range.
+%%-----------------------------------------------------------------------------
+
+%%-define(USE_UNSAFE_RANGES, true).
+
+-spec t_from_range(rng_elem(), rng_elem()) -> erl_type().
+
+-ifdef(USE_UNSAFE_RANGES).
+
+t_from_range(X, Y) ->
+ t_from_range_unsafe(X, Y).
+
+-else.
+
+t_from_range(neg_inf, pos_inf) -> t_integer();
+t_from_range(neg_inf, Y) when is_integer(Y), Y < 0 -> ?integer_neg;
+t_from_range(neg_inf, Y) when is_integer(Y), Y >= 0 -> t_integer();
+t_from_range(X, pos_inf) when is_integer(X), X >= 1 -> ?integer_pos;
+t_from_range(X, pos_inf) when is_integer(X), X >= 0 -> ?integer_non_neg;
+t_from_range(X, pos_inf) when is_integer(X), X < 0 -> t_integer();
+t_from_range(X, Y) when is_integer(X), is_integer(Y), X > Y -> t_none();
+t_from_range(X, Y) when is_integer(X), is_integer(Y) ->
+ case ((Y - X) < ?SET_LIMIT) of
+ true -> t_integers(lists:seq(X, Y));
+ false ->
+ case X >= 0 of
+ false ->
+ if Y < 0 -> ?integer_neg;
+ true -> t_integer()
+ end;
+ true ->
+ if Y =< ?MAX_BYTE, X >= 1 -> ?int_range(1, ?MAX_BYTE);
+ Y =< ?MAX_BYTE -> t_byte();
+ Y =< ?MAX_CHAR, X >= 1 -> ?int_range(1, ?MAX_CHAR);
+ Y =< ?MAX_CHAR -> t_char();
+ X >= 1 -> ?integer_pos;
+ X >= 0 -> ?integer_non_neg
+ end
+ end
+ end;
+t_from_range(pos_inf, neg_inf) -> t_none().
+
+-endif.
+
+-spec t_from_range_unsafe(rng_elem(), rng_elem()) -> erl_type().
+
+t_from_range_unsafe(neg_inf, pos_inf) -> t_integer();
+t_from_range_unsafe(neg_inf, Y) -> ?int_range(neg_inf, Y);
+t_from_range_unsafe(X, pos_inf) -> ?int_range(X, pos_inf);
+t_from_range_unsafe(X, Y) when is_integer(X), is_integer(Y), X =< Y ->
+ if (Y - X) < ?SET_LIMIT -> t_integers(lists:seq(X, Y));
+ true -> ?int_range(X, Y)
+ end;
+t_from_range_unsafe(X, Y) when is_integer(X), is_integer(Y) -> t_none();
+t_from_range_unsafe(pos_inf, neg_inf) -> t_none().
+
+-spec t_is_fixnum(erl_type()) -> boolean().
+
+t_is_fixnum(?int_range(neg_inf, _)) -> false;
+t_is_fixnum(?int_range(_, pos_inf)) -> false;
+t_is_fixnum(?int_range(From, To)) ->
+ is_fixnum(From) andalso is_fixnum(To);
+t_is_fixnum(?int_set(Set)) ->
+ is_fixnum(set_min(Set)) andalso is_fixnum(set_max(Set));
+t_is_fixnum(_) -> false.
+
+-spec is_fixnum(integer()) -> boolean().
+
+is_fixnum(N) when is_integer(N) ->
+ Bits = ?BITS,
+ (N =< ((1 bsl (Bits - 1)) - 1)) andalso (N >= -(1 bsl (Bits - 1))).
+
+infinity_geq(pos_inf, _) -> true;
+infinity_geq(_, pos_inf) -> false;
+infinity_geq(_, neg_inf) -> true;
+infinity_geq(neg_inf, _) -> false;
+infinity_geq(A, B) -> A >= B.
+
+-spec t_is_bitwidth(erl_type()) -> boolean().
+
+t_is_bitwidth(?int_range(neg_inf, _)) -> false;
+t_is_bitwidth(?int_range(_, pos_inf)) -> false;
+t_is_bitwidth(?int_range(From, To)) ->
+ infinity_geq(From, 0) andalso infinity_geq(?BITS, To);
+t_is_bitwidth(?int_set(Set)) ->
+ infinity_geq(set_min(Set), 0) andalso infinity_geq(?BITS, set_max(Set));
+t_is_bitwidth(_) -> false.
+
+-spec number_min(erl_type()) -> rng_elem().
+
+number_min(?int_range(From, _)) -> From;
+number_min(?int_set(Set)) -> set_min(Set);
+number_min(?number(?any, _Tag)) -> neg_inf.
+
+-spec number_max(erl_type()) -> rng_elem().
+
+number_max(?int_range(_, To)) -> To;
+number_max(?int_set(Set)) -> set_max(Set);
+number_max(?number(?any, _Tag)) -> pos_inf.
+
+%% -spec int_range(rgn_elem(), rng_elem()) -> erl_type().
+%%
+%% int_range(neg_inf, pos_inf) -> t_integer();
+%% int_range(neg_inf, To) -> ?int_range(neg_inf, To);
+%% int_range(From, pos_inf) -> ?int_range(From, pos_inf);
+%% int_range(From, To) when From =< To -> t_from_range(From, To);
+%% int_range(From, To) when To < From -> ?none.
+
+in_range(_, ?int_range(neg_inf, pos_inf)) -> true;
+in_range(X, ?int_range(From, pos_inf)) -> X >= From;
+in_range(X, ?int_range(neg_inf, To)) -> X =< To;
+in_range(X, ?int_range(From, To)) -> (X >= From) andalso (X =< To).
+
+-spec min(rng_elem(), rng_elem()) -> rng_elem().
+
+min(neg_inf, _) -> neg_inf;
+min(_, neg_inf) -> neg_inf;
+min(pos_inf, Y) -> Y;
+min(X, pos_inf) -> X;
+min(X, Y) when X =< Y -> X;
+min(_, Y) -> Y.
+
+-spec max(rng_elem(), rng_elem()) -> rng_elem().
+
+max(neg_inf, Y) -> Y;
+max(X, neg_inf) -> X;
+max(pos_inf, _) -> pos_inf;
+max(_, pos_inf) -> pos_inf;
+max(X, Y) when X =< Y -> Y;
+max(X, _) -> X.
+
+expand_range_from_set(Range = ?int_range(From, To), Set) ->
+ Min = min(set_min(Set), From),
+ Max = max(set_max(Set), To),
+ if From =:= Min, To =:= Max -> Range;
+ true -> t_from_range(Min, Max)
+ end.
+
+%%=============================================================================
+%%
+%% Lattice operations
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Supremum
+%%
+
+-spec t_sup([erl_type()]) -> erl_type().
+
+t_sup([?any|_]) ->
+ ?any;
+t_sup([H1, H2|T]) ->
+ t_sup([t_sup(H1, H2)|T]);
+t_sup([H]) ->
+ subst_all_vars_to_any(H);
+t_sup([]) ->
+ ?none.
+
+-spec t_sup(erl_type(), erl_type()) -> erl_type().
+
+t_sup(?any, _) -> ?any;
+t_sup(_, ?any) -> ?any;
+t_sup(?none, T) -> T;
+t_sup(T, ?none) -> T;
+t_sup(?unit, T) -> T;
+t_sup(T, ?unit) -> T;
+t_sup(T, T) -> subst_all_vars_to_any(T);
+t_sup(?var(_), _) -> ?any;
+t_sup(_, ?var(_)) -> ?any;
+t_sup(?atom(Set1), ?atom(Set2)) ->
+ ?atom(set_union(Set1, Set2));
+t_sup(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ t_bitstr(gcd(gcd(U1, U2), abs(B1-B2)), lists:min([B1, B2]));
+t_sup(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
+ %% The domain is either a product or any.
+ ?function(t_sup(Domain1, Domain2), t_sup(Range1, Range2));
+t_sup(?identifier(Set1), ?identifier(Set2)) ->
+ ?identifier(set_union(Set1, Set2));
+t_sup(?opaque(Set1), ?opaque(Set2)) ->
+ ?opaque(set_union_no_limit(Set1, Set2));
+%%Disallow unions with opaque types
+%%t_sup(T1=?opaque(_,_,_), T2) ->
+%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none;
+%%t_sup(T1, T2=?opaque(_,_,_)) ->
+%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none;
+t_sup(?remote(Set1), ?remote(Set2)) ->
+ ?remote(set_union_no_limit(Set1, Set2));
+t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) ->
+ ?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2));
+t_sup(?nil, ?nil) -> ?nil;
+t_sup(?nil, ?list(Contents, Termination, _)) ->
+ ?list(Contents, t_sup(?nil, Termination), ?unknown_qual);
+t_sup(?list(Contents, Termination, _), ?nil) ->
+ ?list(Contents, t_sup(?nil, Termination), ?unknown_qual);
+t_sup(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2)) ->
+ NewSize =
+ case {Size1, Size2} of
+ {?unknown_qual, ?unknown_qual} -> ?unknown_qual;
+ {?unknown_qual, ?nonempty_qual} -> ?unknown_qual;
+ {?nonempty_qual, ?unknown_qual} -> ?unknown_qual;
+ {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual
+ end,
+ NewContents = t_sup(Contents1, Contents2),
+ NewTermination = t_sup(Termination1, Termination2),
+ TmpList = t_cons(NewContents, NewTermination),
+ case NewSize of
+ ?nonempty_qual -> TmpList;
+ ?unknown_qual ->
+ ?list(FinalContents, FinalTermination, _) = TmpList,
+ ?list(FinalContents, FinalTermination, ?unknown_qual)
+ end;
+t_sup(?number(_, _), ?number(?any, ?unknown_qual) = T) -> T;
+t_sup(?number(?any, ?unknown_qual) = T, ?number(_, _)) -> T;
+t_sup(?float, ?float) -> ?float;
+t_sup(?float, ?integer(_)) -> t_number();
+t_sup(?integer(_), ?float) -> t_number();
+t_sup(?integer(?any) = T, ?integer(_)) -> T;
+t_sup(?integer(_), ?integer(?any) = T) -> T;
+t_sup(?int_set(Set1), ?int_set(Set2)) ->
+ case set_union(Set1, Set2) of
+ ?any ->
+ t_from_range(min(set_min(Set1), set_min(Set2)),
+ max(set_max(Set1), set_max(Set2)));
+ Set -> ?int_set(Set)
+ end;
+t_sup(?int_range(From1, To1), ?int_range(From2, To2)) ->
+ t_from_range(min(From1, From2), max(To1, To2));
+t_sup(Range = ?int_range(_, _), ?int_set(Set)) ->
+ expand_range_from_set(Range, Set);
+t_sup(?int_set(Set), Range = ?int_range(_, _)) ->
+ expand_range_from_set(Range, Set);
+t_sup(?product(Types1), ?product(Types2)) ->
+ L1 = length(Types1),
+ L2 = length(Types2),
+ if L1 =:= L2 -> ?product(t_sup_lists(Types1, Types2));
+ true -> ?any
+ end;
+t_sup(?product(_), _) ->
+ ?any;
+t_sup(_, ?product(_)) ->
+ ?any;
+t_sup(?tuple(?any, ?any, ?any) = T, ?tuple(_, _, _)) -> T;
+t_sup(?tuple(_, _, _), ?tuple(?any, ?any, ?any) = T) -> T;
+t_sup(?tuple(?any, ?any, ?any) = T, ?tuple_set(_)) -> T;
+t_sup(?tuple_set(_), ?tuple(?any, ?any, ?any) = T) -> T;
+t_sup(?tuple(Elements1, Arity, Tag1) = T1,
+ ?tuple(Elements2, Arity, Tag2) = T2) ->
+ if Tag1 =:= Tag2 -> t_tuple(t_sup_lists(Elements1, Elements2));
+ Tag1 =:= ?any -> t_tuple(t_sup_lists(Elements1, Elements2));
+ Tag2 =:= ?any -> t_tuple(t_sup_lists(Elements1, Elements2));
+ Tag1 < Tag2 -> ?tuple_set([{Arity, [T1, T2]}]);
+ Tag1 > Tag2 -> ?tuple_set([{Arity, [T2, T1]}])
+ end;
+t_sup(?tuple(_, Arity1, _) = T1, ?tuple(_, Arity2, _) = T2) ->
+ sup_tuple_sets([{Arity1, [T1]}], [{Arity2, [T2]}]);
+t_sup(?tuple_set(List1), ?tuple_set(List2)) ->
+ sup_tuple_sets(List1, List2);
+t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) ->
+ sup_tuple_sets(List1, [{Arity, [T2]}]);
+t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) ->
+ sup_tuple_sets([{Arity, [T1]}], List2);
+t_sup(T1, T2) ->
+ ?union(U1) = force_union(T1),
+ ?union(U2) = force_union(T2),
+ sup_union(U1, U2).
+
+-spec t_sup_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_sup_lists([T1|Left1], [T2|Left2]) ->
+ [t_sup(T1, T2)|t_sup_lists(Left1, Left2)];
+t_sup_lists([], []) ->
+ [].
+
+sup_tuple_sets(L1, L2) ->
+ TotalArities = ordsets:union([Arity || {Arity, _} <- L1],
+ [Arity || {Arity, _} <- L2]),
+ if length(TotalArities) > ?TUPLE_ARITY_LIMIT -> t_tuple();
+ true ->
+ case sup_tuple_sets(L1, L2, []) of
+ [{_Arity, [OneTuple = ?tuple(_, _, _)]}] -> OneTuple;
+ List -> ?tuple_set(List)
+ end
+ end.
+
+sup_tuple_sets([{Arity, Tuples1}|Left1], [{Arity, Tuples2}|Left2], Acc) ->
+ NewAcc = [{Arity, sup_tuples_in_set(Tuples1, Tuples2)}|Acc],
+ sup_tuple_sets(Left1, Left2, NewAcc);
+sup_tuple_sets([{Arity1, _} = T1|Left1] = L1,
+ [{Arity2, _} = T2|Left2] = L2, Acc) ->
+ if Arity1 < Arity2 -> sup_tuple_sets(Left1, L2, [T1|Acc]);
+ Arity1 > Arity2 -> sup_tuple_sets(L1, Left2, [T2|Acc])
+ end;
+sup_tuple_sets([], L2, Acc) -> lists:reverse(Acc, L2);
+sup_tuple_sets(L1, [], Acc) -> lists:reverse(Acc, L1).
+
+sup_tuples_in_set([?tuple(_, _, ?any) = T], L) ->
+ [t_tuple(sup_tuple_elements([T|L]))];
+sup_tuples_in_set(L, [?tuple(_, _, ?any) = T]) ->
+ [t_tuple(sup_tuple_elements([T|L]))];
+sup_tuples_in_set(L1, L2) ->
+ FoldFun = fun(?tuple(_, _, Tag), AccTag) -> t_sup(Tag, AccTag) end,
+ TotalTag0 = lists:foldl(FoldFun, ?none, L1),
+ TotalTag = lists:foldl(FoldFun, TotalTag0, L2),
+ case TotalTag of
+ ?atom(?any) ->
+ %% We will reach the set limit. Widen now.
+ [t_tuple(sup_tuple_elements(L1 ++ L2))];
+ ?atom(Set) ->
+ case set_size(Set) > ?TUPLE_TAG_LIMIT of
+ true ->
+ %% We will reach the set limit. Widen now.
+ [t_tuple(sup_tuple_elements(L1 ++ L2))];
+ false ->
+ %% We can go on and build the tuple set.
+ sup_tuples_in_set(L1, L2, [])
+ end
+ end.
+
+sup_tuple_elements([?tuple(Elements, _, _)|L]) ->
+ lists:foldl(fun (?tuple(Es, _, _), Acc) -> t_sup_lists(Es, Acc) end,
+ Elements, L).
+
+sup_tuples_in_set([?tuple(Elements1, Arity, Tag1) = T1|Left1] = L1,
+ [?tuple(Elements2, Arity, Tag2) = T2|Left2] = L2, Acc) ->
+ if
+ Tag1 < Tag2 -> sup_tuples_in_set(Left1, L2, [T1|Acc]);
+ Tag1 > Tag2 -> sup_tuples_in_set(L1, Left2, [T2|Acc]);
+ Tag2 =:= Tag2 -> NewElements = t_sup_lists(Elements1, Elements2),
+ NewAcc = [?tuple(NewElements, Arity, Tag1)|Acc],
+ sup_tuples_in_set(Left1, Left2, NewAcc)
+ end;
+sup_tuples_in_set([], L2, Acc) -> lists:reverse(Acc, L2);
+sup_tuples_in_set(L1, [], Acc) -> lists:reverse(Acc, L1).
+
+sup_union(U1, U2) ->
+ sup_union(U1, U2, 0, []).
+
+sup_union([?none|Left1], [?none|Left2], N, Acc) ->
+ sup_union(Left1, Left2, N, [?none|Acc]);
+sup_union([T1|Left1], [T2|Left2], N, Acc) ->
+ sup_union(Left1, Left2, N+1, [t_sup(T1, T2)|Acc]);
+sup_union([], [], N, Acc) ->
+ if N =:= 0 -> ?none;
+ N =:= 1 ->
+ [Type] = [T || T <- Acc, T =/= ?none],
+ Type;
+ N =:= length(Acc) -> ?any;
+ true -> ?union(lists:reverse(Acc))
+ end.
+
+force_union(T = ?atom(_)) -> ?atom_union(T);
+force_union(T = ?bitstr(_, _)) -> ?bitstr_union(T);
+force_union(T = ?function(_, _)) -> ?function_union(T);
+force_union(T = ?identifier(_)) -> ?identifier_union(T);
+force_union(T = ?list(_, _, _)) -> ?list_union(T);
+force_union(T = ?nil) -> ?list_union(T);
+force_union(T = ?number(_,_)) -> ?number_union(T);
+force_union(T = ?opaque(_)) -> ?opaque_union(T);
+force_union(T = ?remote(_)) -> ?remote_union(T);
+force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T);
+force_union(T = ?tuple_set(_)) -> ?tuple_union(T);
+force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T);
+force_union(T = ?union(_)) -> T.
+
+%%-----------------------------------------------------------------------------
+%% An attempt to write the inverse operation of t_sup/1 -- XXX: INCOMPLETE !!
+%%
+
+-spec t_elements(erl_type()) -> [erl_type()].
+
+t_elements(?none) -> [];
+t_elements(?unit) -> [];
+t_elements(?any = T) -> [T];
+t_elements(?nil = T) -> [T];
+t_elements(?atom(?any) = T) -> [T];
+t_elements(?atom(Atoms)) ->
+ [t_atom(A) || A <- Atoms];
+t_elements(?bitstr(_, _) = T) -> [T];
+t_elements(?function(_, _) = T) -> [T];
+t_elements(?identifier(?any) = T) -> [T];
+t_elements(?identifier(IDs)) ->
+ [?identifier([T]) || T <- IDs];
+t_elements(?list(_, _, _) = T) -> [T];
+t_elements(?number(_, _) = T) ->
+ case T of
+ ?number(?any, ?unknown_qual) -> [T];
+ ?float -> [T];
+ ?integer(?any) -> [T];
+ ?int_range(_, _) -> [T];
+ ?int_set(Set) ->
+ [t_integer(I) || I <- Set]
+ end;
+t_elements(?opaque(_) = T) -> [T];
+t_elements(?tuple(_, _, _) = T) -> [T];
+t_elements(?tuple_set(_) = TS) ->
+ case t_tuple_subtypes(TS) of
+ unknown -> [];
+ Elems -> Elems
+ end;
+t_elements(?union(List)) ->
+ lists:append([t_elements(T) || T <- List]);
+t_elements(?var(_)) -> [?any]. %% yes, vars exist -- what else to do here?
+%% t_elements(T) ->
+%% io:format("T_ELEMENTS => ~p\n", [T]).
+
+%%-----------------------------------------------------------------------------
+%% Infimum
+%%
+
+-spec t_inf([erl_type()]) -> erl_type().
+
+t_inf([H1, H2|T]) ->
+ case t_inf(H1, H2) of
+ ?none -> ?none;
+ NewH -> t_inf([NewH|T])
+ end;
+t_inf([H]) -> H;
+t_inf([]) -> ?none.
+
+-spec t_inf(erl_type(), erl_type()) -> erl_type().
+
+t_inf(T1, T2) ->
+ t_inf(T1, T2, structured).
+
+-type t_inf_mode() :: 'opaque' | 'structured'.
+-spec t_inf(erl_type(), erl_type(), t_inf_mode()) -> erl_type().
+
+t_inf(?var(_), ?var(_), _Mode) -> ?any;
+t_inf(?var(_), T, _Mode) -> subst_all_vars_to_any(T);
+t_inf(T, ?var(_), _Mode) -> subst_all_vars_to_any(T);
+t_inf(?any, T, _Mode) -> subst_all_vars_to_any(T);
+t_inf(T, ?any, _Mode) -> subst_all_vars_to_any(T);
+t_inf(?unit, _, _Mode) -> ?unit;
+t_inf(_, ?unit, _Mode) -> ?unit;
+t_inf(?none, _, _Mode) -> ?none;
+t_inf(_, ?none, _Mode) -> ?none;
+t_inf(T, T, _Mode) -> subst_all_vars_to_any(T);
+t_inf(?atom(Set1), ?atom(Set2), _) ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ NewSet -> ?atom(NewSet)
+ end;
+t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Mode) ->
+ if B2 >= B1 andalso (B2-B1) rem U1 =:= 0 -> t_bitstr(0, B2);
+ true -> ?none
+ end;
+t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Mode) ->
+ if B1 >= B2 andalso (B1-B2) rem U2 =:= 0 -> t_bitstr(0, B1);
+ true -> ?none
+ end;
+t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Mode) ->
+ t_bitstr(U1, B1);
+t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) when U2 > U1 ->
+ inf_bitstr(U2, B2, U1, B1);
+t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) ->
+ inf_bitstr(U1, B1, U2, B2);
+t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Mode) ->
+ case t_inf(Domain1, Domain2, Mode) of
+ ?none -> ?none;
+ Domain -> ?function(Domain, t_inf(Range1, Range2, Mode))
+ end;
+t_inf(?identifier(Set1), ?identifier(Set2), _Mode) ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?identifier(Set)
+ end;
+t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Mode) ->
+ ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2));
+t_inf(?nil, ?nil, _Mode) -> ?nil;
+t_inf(?nil, ?nonempty_list(_, _), _Mode) ->
+ ?none;
+t_inf(?nonempty_list(_, _), ?nil, _Mode) ->
+ ?none;
+t_inf(?nil, ?list(_Contents, Termination, _), Mode) ->
+ t_inf(?nil, Termination, Mode);
+t_inf(?list(_Contents, Termination, _), ?nil, Mode) ->
+ t_inf(?nil, Termination, Mode);
+t_inf(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2), Mode) ->
+ case t_inf(Termination1, Termination2, Mode) of
+ ?none -> ?none;
+ Termination ->
+ case t_inf(Contents1, Contents2, Mode) of
+ ?none ->
+ %% If none of the lists are nonempty, then the infimum is nil.
+ case (Size1 =:= ?unknown_qual) andalso (Size2 =:= ?unknown_qual) of
+ true -> t_nil();
+ false -> ?none
+ end;
+ Contents ->
+ Size =
+ case {Size1, Size2} of
+ {?unknown_qual, ?unknown_qual} -> ?unknown_qual;
+ {?unknown_qual, ?nonempty_qual} -> ?nonempty_qual;
+ {?nonempty_qual, ?unknown_qual} -> ?nonempty_qual;
+ {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual
+ end,
+ ?list(Contents, Termination, Size)
+ end
+ end;
+t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) ->
+ case {T1, T2} of
+ {T, T} -> T;
+ {_, ?number(?any, ?unknown_qual)} -> T1;
+ {?number(?any, ?unknown_qual), _} -> T2;
+ {?float, ?integer(_)} -> ?none;
+ {?integer(_), ?float} -> ?none;
+ {?integer(?any), ?integer(_)} -> T2;
+ {?integer(_), ?integer(?any)} -> T1;
+ {?int_set(Set1), ?int_set(Set2)} ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?int_set(Set)
+ end;
+ {?int_range(From1, To1), ?int_range(From2, To2)} ->
+ t_from_range(max(From1, From2), min(To1, To2));
+ {Range = ?int_range(_, _), ?int_set(Set)} ->
+ %% io:format("t_inf range, set args ~p ~p ~n", [T1, T2]),
+ Ans2 =
+ case set_filter(fun(X) -> in_range(X, Range) end, Set) of
+ ?none -> ?none;
+ NewSet -> ?int_set(NewSet)
+ end,
+ %% io:format("Ans2 ~p ~n", [Ans2]),
+ Ans2;
+ {?int_set(Set), ?int_range(_, _) = Range} ->
+ case set_filter(fun(X) -> in_range(X, Range) end, Set) of
+ ?none -> ?none;
+ NewSet -> ?int_set(NewSet)
+ end
+ end;
+t_inf(?product(Types1), ?product(Types2), Mode) ->
+ L1 = length(Types1),
+ L2 = length(Types2),
+ if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Mode));
+ true -> ?none
+ end;
+t_inf(?product(_), _, _Mode) ->
+ ?none;
+t_inf(_, ?product(_), _Mode) ->
+ ?none;
+t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Mode) -> T;
+t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Mode) -> T;
+t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Mode) -> T;
+t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Mode) -> T;
+t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Mode) ->
+ case t_inf_lists_strict(Elements1, Elements2, Mode) of
+ bottom -> ?none;
+ NewElements -> t_tuple(NewElements)
+ end;
+t_inf(?tuple_set(List1), ?tuple_set(List2), Mode) ->
+ inf_tuple_sets(List1, List2, Mode);
+t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Mode) ->
+ inf_tuple_sets(List, [{Arity, [T]}], Mode);
+t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Mode) ->
+ inf_tuple_sets(List, [{Arity, [T]}], Mode);
+%% be careful: here and in the next clause T can be ?opaque
+t_inf(?union(U1), T, Mode) ->
+ ?union(U2) = force_union(T),
+ inf_union(U1, U2, Mode);
+t_inf(T, ?union(U2), Mode) ->
+ ?union(U1) = force_union(T),
+ inf_union(U1, U2, Mode);
+%% and as a result, the cases for ?opaque should appear *after* ?union
+t_inf(?opaque(Set1), ?opaque(Set2), _Mode) ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ NewSet -> ?opaque(NewSet)
+ end;
+t_inf(?opaque(_) = T1, T2, opaque) ->
+ case t_inf(t_opaque_structure(T1), T2, structured) of
+ ?none -> ?none;
+ _Type -> T1
+ end;
+t_inf(T1, ?opaque(_) = T2, opaque) ->
+ case t_inf(T1, t_opaque_structure(T2), structured) of
+ ?none -> ?none;
+ _Type -> T2
+ end;
+t_inf(#c{}, #c{}, _) ->
+ ?none.
+
+-spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_inf_lists(L1, L2) ->
+ t_inf_lists(L1, L2, structured).
+
+-spec t_inf_lists([erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()].
+
+t_inf_lists(L1, L2, Mode) ->
+ t_inf_lists(L1, L2, [], Mode).
+
+-spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()].
+
+t_inf_lists([T1|Left1], [T2|Left2], Acc, Mode) ->
+ t_inf_lists(Left1, Left2, [t_inf(T1, T2, Mode)|Acc], Mode);
+t_inf_lists([], [], Acc, _Mode) ->
+ lists:reverse(Acc).
+
+%% Infimum of lists with strictness.
+%% If any element is the ?none type, the value 'bottom' is returned.
+
+-spec t_inf_lists_strict([erl_type()], [erl_type()], t_inf_mode()) -> 'bottom' | [erl_type()].
+
+t_inf_lists_strict(L1, L2, Mode) ->
+ t_inf_lists_strict(L1, L2, [], Mode).
+
+-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> 'bottom' | [erl_type()].
+
+t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Mode) ->
+ case t_inf(T1, T2, Mode) of
+ ?none -> bottom;
+ T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Mode)
+ end;
+t_inf_lists_strict([], [], Acc, _Mode) ->
+ lists:reverse(Acc).
+
+inf_tuple_sets(L1, L2, Mode) ->
+ case inf_tuple_sets(L1, L2, [], Mode) of
+ [] -> ?none;
+ [{_Arity, [?tuple(_, _, _) = OneTuple]}] -> OneTuple;
+ List -> ?tuple_set(List)
+ end.
+
+inf_tuple_sets([{Arity, Tuples1}|Left1], [{Arity, Tuples2}|Left2], Acc, Mode) ->
+ case inf_tuples_in_sets(Tuples1, Tuples2, Mode) of
+ [] -> inf_tuple_sets(Left1, Left2, Acc, Mode);
+ NewTuples -> inf_tuple_sets(Left1, Left2, [{Arity, NewTuples}|Acc], Mode)
+ end;
+inf_tuple_sets(L1 = [{Arity1, _}|Left1], L2 = [{Arity2, _}|Left2], Acc, Mode) ->
+ if Arity1 < Arity2 -> inf_tuple_sets(Left1, L2, Acc, Mode);
+ Arity1 > Arity2 -> inf_tuple_sets(L1, Left2, Acc, Mode)
+ end;
+inf_tuple_sets([], _, Acc, _Mode) -> lists:reverse(Acc);
+inf_tuple_sets(_, [], Acc, _Mode) -> lists:reverse(Acc).
+
+inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Mode) ->
+ NewList = [t_inf_lists_strict(Elements1, Elements2, Mode)
+ || ?tuple(Elements2, _, _) <- L2],
+ [t_tuple(Es) || Es <- NewList, Es =/= bottom];
+inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Mode) ->
+ NewList = [t_inf_lists_strict(Elements1, Elements2, Mode)
+ || ?tuple(Elements1, _, _) <- L1],
+ [t_tuple(Es) || Es <- NewList, Es =/= bottom];
+inf_tuples_in_sets(L1, L2, Mode) ->
+ inf_tuples_in_sets(L1, L2, [], Mode).
+
+inf_tuples_in_sets([?tuple(Elements1, Arity, Tag)|Left1],
+ [?tuple(Elements2, Arity, Tag)|Left2], Acc, Mode) ->
+ case t_inf_lists_strict(Elements1, Elements2, Mode) of
+ bottom -> inf_tuples_in_sets(Left1, Left2, Acc, Mode);
+ NewElements ->
+ inf_tuples_in_sets(Left1, Left2, [?tuple(NewElements, Arity, Tag)|Acc], Mode)
+ end;
+inf_tuples_in_sets([?tuple(_, _, Tag1)|Left1] = L1,
+ [?tuple(_, _, Tag2)|Left2] = L2, Acc, Mode) ->
+ if Tag1 < Tag2 -> inf_tuples_in_sets(Left1, L2, Acc, Mode);
+ Tag1 > Tag2 -> inf_tuples_in_sets(L1, Left2, Acc, Mode)
+ end;
+inf_tuples_in_sets([], _, Acc, _Mode) -> lists:reverse(Acc);
+inf_tuples_in_sets(_, [], Acc, _Mode) -> lists:reverse(Acc).
+
+inf_union(U1, U2, opaque) ->
+%%---------------------------------------------------------------------
+%% Under Testing
+%%----------------------------------------------------------------------
+%% OpaqueFun =
+%% fun(Union1, Union2) ->
+%% [_,_,_,_,_,_,_,_,Opaque,_] = Union1,
+%% [A,B,F,I,L,N,T,M,_,_R] = Union2,
+%% List = [A,B,F,I,L,N,T,M],
+%% case [T || T <- List, t_inf(T, Opaque, opaque) =/= ?none] of
+%% [] -> ?none;
+%% _ -> Opaque
+%% end
+%% end,
+%% O1 = OpaqueFun(U1, U2),
+%% O2 = OpaqueFun(U2, U1),
+%% Union = inf_union(U1, U2, 0, [], opaque),
+%% t_sup([O1, O2, Union]);
+ inf_union(U1, U2, 0, [], opaque);
+inf_union(U1, U2, OtherMode) ->
+ inf_union(U1, U2, 0, [], OtherMode).
+
+inf_union([?none|Left1], [?none|Left2], N, Acc, Mode) ->
+ inf_union(Left1, Left2, N, [?none|Acc], Mode);
+inf_union([T1|Left1], [T2|Left2], N, Acc, Mode) ->
+ case t_inf(T1, T2, Mode) of
+ ?none -> inf_union(Left1, Left2, N, [?none|Acc], Mode);
+ T -> inf_union(Left1, Left2, N+1, [T|Acc], Mode)
+ end;
+inf_union([], [], N, Acc, _Mode) ->
+ if N =:= 0 -> ?none;
+ N =:= 1 ->
+ [Type] = [T || T <- Acc, T =/= ?none],
+ Type;
+ N >= 2 -> ?union(lists:reverse(Acc))
+ end.
+
+inf_bitstr(U1, B1, U2, B2) ->
+ GCD = gcd(U1, U2),
+ case (B2-B1) rem GCD of
+ 0 ->
+ U = (U1*U2) div GCD,
+ B = findfirst(0, 0, U1, B1, U2, B2),
+ t_bitstr(U, B);
+ _ ->
+ ?none
+ end.
+
+findfirst(N1, N2, U1, B1, U2, B2) ->
+ Val1 = U1*N1+B1,
+ Val2 = U2*N2+B2,
+ if Val1 =:= Val2 ->
+ Val1;
+ Val1 > Val2 ->
+ findfirst(N1, N2+1, U1, B1, U2, B2);
+ Val1 < Val2 ->
+ findfirst(N1+1, N2, U1, B1, U2, B2)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Substitution of variables
+%%
+
+-spec t_subst(erl_type(), dict()) -> erl_type().
+
+t_subst(T, Dict) ->
+ case t_has_var(T) of
+ true -> t_subst(T, Dict, fun(X) -> X end);
+ false -> T
+ end.
+
+-spec subst_all_vars_to_any(erl_type()) -> erl_type().
+
+subst_all_vars_to_any(T) ->
+ case t_has_var(T) of
+ true -> t_subst(T, dict:new(), fun(_) -> ?any end);
+ false -> T
+ end.
+
+t_subst(?var(Id) = V, Dict, Fun) ->
+ case dict:find(Id, Dict) of
+ error -> Fun(V);
+ {ok, Type} -> Type
+ end;
+t_subst(?list(Contents, Termination, Size), Dict, Fun) ->
+ case t_subst(Contents, Dict, Fun) of
+ ?none -> ?none;
+ NewContents ->
+ %% Be careful here to make the termination collapse if necessary.
+ case t_subst(Termination, Dict, Fun) of
+ ?nil -> ?list(NewContents, ?nil, Size);
+ ?any -> ?list(NewContents, ?any, Size);
+ Other ->
+ ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other),
+ ?list(NewContents, NewTermination, Size)
+ end
+ end;
+t_subst(?function(Domain, Range), Dict, Fun) ->
+ ?function(t_subst(Domain, Dict, Fun), t_subst(Range, Dict, Fun));
+t_subst(?product(Types), Dict, Fun) ->
+ ?product([t_subst(T, Dict, Fun) || T <- Types]);
+t_subst(?tuple(?any, ?any, ?any) = T, _Dict, _Fun) ->
+ T;
+t_subst(?tuple(Elements, _Arity, _Tag), Dict, Fun) ->
+ t_tuple([t_subst(E, Dict, Fun) || E <- Elements]);
+t_subst(?tuple_set(_) = TS, Dict, Fun) ->
+ t_sup([t_subst(T, Dict, Fun) || T <- t_tuple_subtypes(TS)]);
+t_subst(T, _Dict, _Fun) ->
+ T.
+
+%%-----------------------------------------------------------------------------
+%% Unification
+%%
+
+-spec t_unify(erl_type(), erl_type()) -> {erl_type(), [{_, erl_type()}]}.
+
+t_unify(T1, T2) ->
+ {T, Dict} = t_unify(T1, T2, dict:new()),
+ {t_subst(T, Dict), lists:keysort(1, dict:to_list(Dict))}.
+
+t_unify(?var(Id) = T, ?var(Id), Dict) ->
+ {T, Dict};
+t_unify(?var(Id1) = T, ?var(Id2), Dict) ->
+ case dict:find(Id1, Dict) of
+ error ->
+ case dict:find(Id2, Dict) of
+ error -> {T, dict:store(Id2, T, Dict)};
+ {ok, Type} -> {Type, t_unify(T, Type, Dict)}
+ end;
+ {ok, Type1} ->
+ case dict:find(Id2, Dict) of
+ error -> {Type1, dict:store(Id2, T, Dict)};
+ {ok, Type2} -> t_unify(Type1, Type2, Dict)
+ end
+ end;
+t_unify(?var(Id), Type, Dict) ->
+ case dict:find(Id, Dict) of
+ error -> {Type, dict:store(Id, Type, Dict)};
+ {ok, VarType} -> t_unify(VarType, Type, Dict)
+ end;
+t_unify(Type, ?var(Id), Dict) ->
+ case dict:find(Id, Dict) of
+ error -> {Type, dict:store(Id, Type, Dict)};
+ {ok, VarType} -> t_unify(VarType, Type, Dict)
+ end;
+t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), Dict) ->
+ {Domain, Dict1} = t_unify(Domain1, Domain2, Dict),
+ {Range, Dict2} = t_unify(Range1, Range2, Dict1),
+ {?function(Domain, Range), Dict2};
+t_unify(?list(Contents1, Termination1, Size),
+ ?list(Contents2, Termination2, Size), Dict) ->
+ {Contents, Dict1} = t_unify(Contents1, Contents2, Dict),
+ {Termination, Dict2} = t_unify(Termination1, Termination2, Dict1),
+ {?list(Contents, Termination, Size), Dict2};
+t_unify(?product(Types1), ?product(Types2), Dict) ->
+ {Types, Dict1} = unify_lists(Types1, Types2, Dict),
+ {?product(Types), Dict1};
+t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), Dict) ->
+ {T, Dict};
+t_unify(?tuple(Elements1, Arity, _),
+ ?tuple(Elements2, Arity, _), Dict) when Arity =/= ?any ->
+ {NewElements, Dict1} = unify_lists(Elements1, Elements2, Dict),
+ {t_tuple(NewElements), Dict1};
+t_unify(?tuple_set([{Arity, _}]) = T1,
+ ?tuple(_, Arity, _) = T2, Dict) when Arity =/= ?any ->
+ unify_tuple_set_and_tuple(T1, T2, Dict);
+t_unify(?tuple(_, Arity, _) = T1,
+ ?tuple_set([{Arity, _}]) = T2, Dict) when Arity =/= ?any ->
+ unify_tuple_set_and_tuple(T2, T1, Dict);
+t_unify(?tuple_set(List1), ?tuple_set(List2), Dict) ->
+ {Tuples, NewDict} =
+ unify_lists(lists:append([T || {_Arity, T} <- List1]),
+ lists:append([T || {_Arity, T} <- List2]), Dict),
+ {t_sup(Tuples), NewDict};
+t_unify(T, T, Dict) ->
+ {T, Dict};
+t_unify(T1, T2, _) ->
+ throw({mismatch, T1, T2}).
+
+unify_tuple_set_and_tuple(?tuple_set([{Arity, List}]),
+ ?tuple(Elements2, Arity, _), Dict) ->
+ %% Can only work if the single tuple has variables at correct places.
+ %% Collapse the tuple set.
+ {NewElements, Dict1} = unify_lists(sup_tuple_elements(List), Elements2, Dict),
+ {t_tuple(NewElements), Dict1}.
+
+unify_lists(L1, L2, Dict) ->
+ unify_lists(L1, L2, Dict, []).
+
+unify_lists([T1|Left1], [T2|Left2], Dict, Acc) ->
+ {NewT, NewDict} = t_unify(T1, T2, Dict),
+ unify_lists(Left1, Left2, NewDict, [NewT|Acc]);
+unify_lists([], [], Dict, Acc) ->
+ {lists:reverse(Acc), Dict}.
+
+%%t_assign_variables_to_subtype(T1, T2) ->
+%% try
+%% Dict = assign_vars(T1, T2, dict:new()),
+%% {ok, dict:map(fun(_Param, List) -> t_sup(List) end, Dict)}
+%% catch
+%% throw:error -> error
+%% end.
+
+%%assign_vars(_, ?var(_), _Dict) ->
+%% erlang:error("Variable in right hand side of assignment");
+%%assign_vars(?any, _, Dict) ->
+%% Dict;
+%%assign_vars(?var(_) = Var, Type, Dict) ->
+%% store_var(Var, Type, Dict);
+%%assign_vars(?function(Domain1, Range1), ?function(Domain2, Range2), Dict) ->
+%% DomainList =
+%% case Domain2 of
+%% ?any -> [];
+%% ?product(List) -> List
+%% end,
+%% case any_none([Range2|DomainList]) of
+%% true -> throw(error);
+%% false ->
+%% Dict1 = assign_vars(Domain1, Domain2, Dict),
+%% assign_vars(Range1, Range2, Dict1)
+%% end;
+%%assign_vars(?list(_Contents, _Termination, ?any), ?nil, Dict) ->
+%% Dict;
+%%assign_vars(?list(Contents1, Termination1, Size1),
+%% ?list(Contents2, Termination2, Size2), Dict) ->
+%% Dict1 = assign_vars(Contents1, Contents2, Dict),
+%% Dict2 = assign_vars(Termination1, Termination2, Dict1),
+%% case {Size1, Size2} of
+%% {S, S} -> Dict2;
+%% {?any, ?nonempty_qual} -> Dict2;
+%% {_, _} -> throw(error)
+%% end;
+%%assign_vars(?product(Types1), ?product(Types2), Dict) ->
+%% case length(Types1) =:= length(Types2) of
+%% true -> assign_vars_lists(Types1, Types2, Dict);
+%% false -> throw(error)
+%% end;
+%%assign_vars(?tuple(?any, ?any, ?any), ?tuple(?any, ?any, ?any), Dict) ->
+%% Dict;
+%%assign_vars(?tuple(?any, ?any, ?any), ?tuple(_, _, _), Dict) ->
+%% Dict;
+%%assign_vars(?tuple(Elements1, Arity, _),
+%% ?tuple(Elements2, Arity, _), Dict) when Arity =/= ?any ->
+%% assign_vars_lists(Elements1, Elements2, Dict);
+%%assign_vars(?tuple_set(_) = T, ?tuple_set(List2), Dict) ->
+%% %% All Rhs tuples must already be subtypes of Lhs, so we can take
+%% %% each one separatly.
+%% assign_vars_lists([T || _ <- List2], List2, Dict);
+%%assign_vars(?tuple(?any, ?any, ?any), ?tuple_set(_), Dict) ->
+%% Dict;
+%%assign_vars(?tuple(_, Arity, _) = T1, ?tuple_set(List), Dict) ->
+%% case reduce_tuple_tags(List) of
+%% [Tuple = ?tuple(_, Arity, _)] -> assign_vars(T1, Tuple, Dict);
+%% _ -> throw(error)
+%% end;
+%%assign_vars(?tuple_set(List), ?tuple(_, Arity, Tag) = T2, Dict) ->
+%% case [T || ?tuple(_, Arity1, Tag1) = T <- List,
+%% Arity1 =:= Arity, Tag1 =:= Tag] of
+%% [] -> throw(error);
+%% [T1] -> assign_vars(T1, T2, Dict)
+%% end;
+%%assign_vars(?union(U1), T2, Dict) ->
+%% ?union(U2) = force_union(T2),
+%% assign_vars_lists(U1, U2, Dict);
+%%assign_vars(T, T, Dict) ->
+%% Dict;
+%%assign_vars(T1, T2, Dict) ->
+%% case t_is_subtype(T2, T1) of
+%% false -> throw(error);
+%% true -> Dict
+%% end.
+
+%%assign_vars_lists([T1|Left1], [T2|Left2], Dict) ->
+%% assign_vars_lists(Left1, Left2, assign_vars(T1, T2, Dict));
+%%assign_vars_lists([], [], Dict) ->
+%% Dict.
+
+%%store_var(?var(Id), Type, Dict) ->
+%% case dict:find(Id, Dict) of
+%% error -> dict:store(Id, [Type], Dict);
+%% {ok, _VarType0} -> dict:update(Id, fun(X) -> [Type|X] end, Dict)
+%% end.
+
+%%-----------------------------------------------------------------------------
+%% Subtraction.
+%%
+%% Note that the subtraction is an approximation since we do not have
+%% negative types. Also, tuples and products should be handled using
+%% the cartesian product of the elements, but this is not feasible to
+%% do.
+%%
+%% Example: {a|b,c|d}\{a,d} = {a,c}|{a,d}|{b,c}|{b,d} \ {a,d} =
+%% = {a,c}|{b,c}|{b,d} = {a|b,c|d}
+%%
+%% Instead, we can subtract if all elements but one becomes none after
+%% subtracting element-wise.
+%%
+%% Example: {a|b,c|d}\{a|b,d} = {a,c}|{a,d}|{b,c}|{b,d} \ {a,d}|{b,d} =
+%% = {a,c}|{b,c} = {a|b,c}
+
+-spec t_subtract_list(erl_type(), [erl_type()]) -> erl_type().
+
+t_subtract_list(T1, [T2|Left]) ->
+ t_subtract_list(t_subtract(T1, T2), Left);
+t_subtract_list(T, []) ->
+ T.
+
+-spec t_subtract(erl_type(), erl_type()) -> erl_type().
+
+t_subtract(_, ?any) -> ?none;
+t_subtract(?any, _) -> ?any;
+t_subtract(T, ?unit) -> T;
+t_subtract(?unit, _) -> ?unit;
+t_subtract(?none, _) -> ?none;
+t_subtract(T, ?none) -> T;
+t_subtract(?atom(Set1), ?atom(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?atom(Set)
+ end;
+t_subtract(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ subtract_bin(t_bitstr(U1, B1), t_inf(t_bitstr(U1, B1), t_bitstr(U2, B2)));
+t_subtract(?function(_, _) = T1, ?function(_, _) = T2) ->
+ case t_is_subtype(T1, T2) of
+ true -> ?none;
+ false -> T1
+ end;
+t_subtract(?identifier(Set1), ?identifier(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?identifier(Set)
+ end;
+t_subtract(?opaque(Set1), ?opaque(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?opaque(Set)
+ end;
+t_subtract(?matchstate(Pres1, Slots1), ?matchstate(Pres2, _Slots2)) ->
+ Pres = t_subtract(Pres1,Pres2),
+ case t_is_none(Pres) of
+ true -> ?none;
+ false -> ?matchstate(Pres,Slots1)
+ end;
+t_subtract(?matchstate(Present,Slots),_) ->
+ ?matchstate(Present,Slots);
+t_subtract(?nil, ?nil) ->
+ ?none;
+t_subtract(?nil, ?nonempty_list(_, _)) ->
+ ?nil;
+t_subtract(?nil, ?list(_, _, _)) ->
+ ?none;
+t_subtract(?list(Contents, Termination, _Size) = T, ?nil) ->
+ case Termination =:= ?nil of
+ true -> ?nonempty_list(Contents, Termination);
+ false -> T
+ end;
+t_subtract(?list(Contents1, Termination1, Size1) = T,
+ ?list(Contents2, Termination2, Size2)) ->
+ case t_is_subtype(Contents1, Contents2) of
+ true ->
+ case t_is_subtype(Termination1, Termination2) of
+ true ->
+ case {Size1, Size2} of
+ {?nonempty_qual, ?unknown_qual} -> ?none;
+ {?unknown_qual, ?nonempty_qual} -> Termination1;
+ {S, S} -> ?none
+ end;
+ false ->
+ %% If the termination is not covered by the subtracted type
+ %% we cannot really say anything about the result.
+ T
+ end;
+ false ->
+ %% All contents must be covered if there is going to be any
+ %% change to the list.
+ T
+ end;
+t_subtract(?float, ?float) -> ?none;
+t_subtract(?number(_, _) = T1, ?float) -> t_inf(T1, t_integer());
+t_subtract(?float, ?number(_Set, Tag)) ->
+ case Tag of
+ ?unknown_qual -> ?none;
+ _ -> ?float
+ end;
+t_subtract(?number(_, _), ?number(?any, ?unknown_qual)) -> ?none;
+t_subtract(?number(_, _) = T1, ?integer(?any)) -> t_inf(?float, T1);
+t_subtract(?int_set(Set1), ?int_set(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?int_set(Set)
+ end;
+t_subtract(?int_range(From1, To1) = T1, ?int_range(_, _) = T2) ->
+ case t_inf(T1, T2) of
+ ?none -> T1;
+ ?int_range(From1, To1) -> ?none;
+ ?int_range(neg_inf, To) -> t_from_range(To + 1, To1);
+ ?int_range(From, pos_inf) -> t_from_range(From1, From - 1);
+ ?int_range(From, To) -> t_sup(t_from_range(From1, From - 1),
+ t_from_range(To + 1, To))
+ end;
+t_subtract(?int_range(From, To) = T1, ?int_set(Set)) ->
+ NewFrom = case set_is_element(From, Set) of
+ true -> From + 1;
+ false -> From
+ end,
+ NewTo = case set_is_element(To, Set) of
+ true -> To - 1;
+ false -> To
+ end,
+ if (NewFrom =:= From) and (NewTo =:= To) -> T1;
+ true -> t_from_range(NewFrom, NewTo)
+ end;
+t_subtract(?int_set(Set), ?int_range(From, To)) ->
+ case set_filter(fun(X) -> not ((X =< From) orelse (X >= To)) end, Set) of
+ ?none -> ?none;
+ NewSet -> ?int_set(NewSet)
+ end;
+t_subtract(?integer(?any) = T1, ?integer(_)) -> T1;
+t_subtract(?number(_, _) = T1, ?number(_, _)) -> T1;
+t_subtract(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> ?none;
+t_subtract(?tuple_set(_), ?tuple(?any, ?any, ?any)) -> ?none;
+t_subtract(?tuple(?any, ?any, ?any) = T1, ?tuple_set(_)) -> T1;
+t_subtract(?tuple(Elements1, Arity1, _Tag1) = T1,
+ ?tuple(Elements2, Arity2, _Tag2)) ->
+ if Arity1 =/= Arity2 -> T1;
+ Arity1 =:= Arity2 ->
+ NewElements = t_subtract_lists(Elements1, Elements2),
+ case [E || E <- NewElements, E =/= ?none] of
+ [] -> ?none;
+ [_] -> t_tuple(replace_nontrivial_element(Elements1, NewElements));
+ _ -> T1
+ end
+ end;
+t_subtract(?tuple_set(List1) = T1, ?tuple(_, Arity, _) = T2) ->
+ case orddict:find(Arity, List1) of
+ error -> T1;
+ {ok, List2} ->
+ TuplesLeft0 = [Tuple || {_Arity, Tuple} <- orddict:erase(Arity, List1)],
+ TuplesLeft1 = lists:append(TuplesLeft0),
+ t_sup([t_subtract(L, T2) || L <- List2] ++ TuplesLeft1)
+ end;
+t_subtract(?tuple(_, Arity, _) = T1, ?tuple_set(List1)) ->
+ case orddict:find(Arity, List1) of
+ error -> T1;
+ {ok, List2} -> t_inf([t_subtract(T1, L) || L <- List2])
+ end;
+t_subtract(?tuple_set(_) = T1, ?tuple_set(_) = T2) ->
+ t_sup([t_subtract(T, T2) || T <- t_tuple_subtypes(T1)]);
+t_subtract(?product(Elements1) = T1, ?product(Elements2)) ->
+ Arity1 = length(Elements1),
+ Arity2 = length(Elements2),
+ if Arity1 =/= Arity2 -> T1;
+ Arity1 =:= Arity2 ->
+ NewElements = t_subtract_lists(Elements1, Elements2),
+ case [E || E <- NewElements, E =/= ?none] of
+ [] -> ?none;
+ [_] -> t_product(replace_nontrivial_element(Elements1, NewElements));
+ _ -> T1
+ end
+ end;
+t_subtract(?product(P1), _) ->
+ ?product(P1);
+t_subtract(T, ?product(_)) ->
+ T;
+t_subtract(?union(U1), ?union(U2)) ->
+ subtract_union(U1, U2);
+t_subtract(T1, T2) ->
+ ?union(U1) = force_union(T1),
+ ?union(U2) = force_union(T2),
+ subtract_union(U1, U2).
+
+-spec t_subtract_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_subtract_lists(L1, L2) ->
+ t_subtract_lists(L1, L2, []).
+
+-spec t_subtract_lists([erl_type()], [erl_type()], [erl_type()]) -> [erl_type()].
+
+t_subtract_lists([T1|Left1], [T2|Left2], Acc) ->
+ t_subtract_lists(Left1, Left2, [t_subtract(T1, T2)|Acc]);
+t_subtract_lists([], [], Acc) ->
+ lists:reverse(Acc).
+
+-spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type().
+
+subtract_union(U1, U2) ->
+ subtract_union(U1, U2, 0, []).
+
+-spec subtract_union([erl_type()], [erl_type()], non_neg_integer(), [erl_type()]) -> erl_type().
+
+subtract_union([T1|Left1], [T2|Left2], N, Acc) ->
+ case t_subtract(T1, T2) of
+ ?none -> subtract_union(Left1, Left2, N, [?none|Acc]);
+ T -> subtract_union(Left1, Left2, N+1, [T|Acc])
+ end;
+subtract_union([], [], 0, _Acc) ->
+ ?none;
+subtract_union([], [], 1, Acc) ->
+ [T] = [X || X <- Acc, X =/= ?none],
+ T;
+subtract_union([], [], N, Acc) when is_integer(N), N > 1 ->
+ ?union(lists:reverse(Acc)).
+
+replace_nontrivial_element(El1, El2) ->
+ replace_nontrivial_element(El1, El2, []).
+
+replace_nontrivial_element([T1|Left1], [?none|Left2], Acc) ->
+ replace_nontrivial_element(Left1, Left2, [T1|Acc]);
+replace_nontrivial_element([_|Left1], [T2|_], Acc) ->
+ lists:reverse(Acc) ++ [T2|Left1].
+
+subtract_bin(?bitstr(U1, B1), ?bitstr(U1, B1)) ->
+ ?none;
+subtract_bin(?bitstr(U1, B1), ?none) ->
+ t_bitstr(U1, B1);
+subtract_bin(?bitstr(U1, B1), ?bitstr(0, B1)) ->
+ t_bitstr(U1, B1+U1);
+subtract_bin(?bitstr(U1, B1), ?bitstr(U1, B2)) ->
+ if (B1+U1) =/= B2 -> t_bitstr(0, B1);
+ true -> t_bitstr(U1, B1)
+ end;
+subtract_bin(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ if (2 * U1) =:= U2 ->
+ if B1 =:= B2 ->
+ t_bitstr(U2, B1+U1);
+ (B1 + U1) =:= B2 ->
+ t_bitstr(U2, B1);
+ true ->
+ t_bitstr(U1, B1)
+ end;
+ true ->
+ t_bitstr(U1, B1)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Relations
+%%
+
+-spec t_is_equal(erl_type(), erl_type()) -> boolean().
+
+t_is_equal(T, T) -> true;
+t_is_equal(_, _) -> false.
+
+-spec t_is_subtype(erl_type(), erl_type()) -> boolean().
+
+t_is_subtype(T1, T2) ->
+ Inf = t_inf(T1, T2),
+ t_is_equal(T1, Inf).
+
+-spec t_is_instance(erl_type(), erl_type()) -> boolean().
+
+t_is_instance(ConcreteType, Type) ->
+ t_is_subtype(ConcreteType, t_unopaque(Type)).
+
+-spec t_unopaque(erl_type()) -> erl_type().
+
+t_unopaque(T) ->
+ t_unopaque(T, 'universe').
+
+-spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type().
+
+t_unopaque(?opaque(_) = T, Opaques) ->
+ case Opaques =:= universe orelse lists:member(T, Opaques) of
+ true -> t_unopaque(t_opaque_structure(T), Opaques);
+ false -> T % XXX: needs revision for parametric opaque data types
+ end;
+t_unopaque(?list(ElemT, Termination, Sz), Opaques) ->
+ ?list(t_unopaque(ElemT, Opaques), Termination, Sz);
+t_unopaque(?tuple(?any, _, _) = T, _) -> T;
+t_unopaque(?tuple(ArgTs, Sz, Tag), Opaques) when is_list(ArgTs) ->
+ NewArgTs = [t_unopaque(A, Opaques) || A <- ArgTs],
+ ?tuple(NewArgTs, Sz, Tag);
+t_unopaque(?tuple_set(Set), Opaques) ->
+ NewSet = [{Sz, [t_unopaque(T, Opaques) || T <- Tuples]}
+ || {Sz, Tuples} <- Set],
+ ?tuple_set(NewSet);
+t_unopaque(?union([A,B,F,I,L,N,T,M,O,R]), Opaques) ->
+ UL = t_unopaque(L, Opaques),
+ UT = t_unopaque(T, Opaques),
+ UO = case O of
+ ?none -> [];
+ ?opaque(Os) -> [t_unopaque(S, Opaques) || #opaque{struct = S} <- Os]
+ end,
+ t_sup([?union([A,B,F,I,UL,N,UT,M,?none,R])|UO]);
+t_unopaque(T, _) ->
+ T.
+
+%%-----------------------------------------------------------------------------
+%% K-depth abstraction.
+%%
+%% t_limit/2 is the exported function, which checks the type of the
+%% second argument and calls the module local t_limit_k/2 function.
+%%
+
+-spec t_limit(erl_type(), integer()) -> erl_type().
+
+t_limit(Term, K) when is_integer(K) ->
+ t_limit_k(Term, K).
+
+t_limit_k(_, K) when K =< 0 -> ?any;
+t_limit_k(?tuple(?any, ?any, ?any) = T, _K) -> T;
+t_limit_k(?tuple(Elements, Arity, _), K) ->
+ if K =:= 1 -> t_tuple(Arity);
+ true -> t_tuple([t_limit_k(E, K-1) || E <- Elements])
+ end;
+t_limit_k(?tuple_set(_) = T, K) ->
+ t_sup([t_limit_k(Tuple, K) || Tuple <- t_tuple_subtypes(T)]);
+t_limit_k(?list(Elements, Termination, Size), K) ->
+ NewTermination =
+ if K =:= 1 ->
+ %% We do not want to lose the termination information.
+ t_limit_k(Termination, K);
+ true -> t_limit_k(Termination, K - 1)
+ end,
+ NewElements = t_limit_k(Elements, K - 1),
+ TmpList = t_cons(NewElements, NewTermination),
+ case Size of
+ ?nonempty_qual -> TmpList;
+ ?unknown_qual ->
+ ?list(NewElements1, NewTermination1, _) = TmpList,
+ ?list(NewElements1, NewTermination1, ?unknown_qual)
+ end;
+t_limit_k(?function(Domain, Range), K) ->
+ %% The domain is either a product or any() so we do not decrease the K.
+ ?function(t_limit_k(Domain, K), t_limit_k(Range, K-1));
+t_limit_k(?product(Elements), K) ->
+ ?product([t_limit_k(X, K - 1) || X <- Elements]);
+t_limit_k(?union(Elements), K) ->
+ ?union([t_limit_k(X, K) || X <- Elements]);
+t_limit_k(T, _K) -> T.
+
+%%============================================================================
+%%
+%% Abstract records. Used for comparing contracts.
+%%
+%%============================================================================
+
+-spec t_abstract_records(erl_type(), dict()) -> erl_type().
+
+t_abstract_records(?list(Contents, Termination, Size), RecDict) ->
+ case t_abstract_records(Contents, RecDict) of
+ ?none -> ?none;
+ NewContents ->
+ %% Be careful here to make the termination collapse if necessary.
+ case t_abstract_records(Termination, RecDict) of
+ ?nil -> ?list(NewContents, ?nil, Size);
+ ?any -> ?list(NewContents, ?any, Size);
+ Other ->
+ ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other),
+ ?list(NewContents, NewTermination, Size)
+ end
+ end;
+t_abstract_records(?function(Domain, Range), RecDict) ->
+ ?function(t_abstract_records(Domain, RecDict),
+ t_abstract_records(Range, RecDict));
+t_abstract_records(?product(Types), RecDict) ->
+ ?product([t_abstract_records(T, RecDict) || T <- Types]);
+t_abstract_records(?union(Types), RecDict) ->
+ t_sup([t_abstract_records(T, RecDict) || T <- Types]);
+t_abstract_records(?tuple(?any, ?any, ?any) = T, _RecDict) ->
+ T;
+t_abstract_records(?tuple(Elements, Arity, ?atom(_) = Tag), RecDict) ->
+ [TagAtom] = t_atom_vals(Tag),
+ case lookup_record(TagAtom, Arity - 1, RecDict) of
+ error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
+ {ok, Fields} -> t_tuple([Tag|[T || {_Name, T} <- Fields]])
+ end;
+t_abstract_records(?tuple(Elements, _Arity, _Tag), RecDict) ->
+ t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
+t_abstract_records(?tuple_set(_) = Tuples, RecDict) ->
+ t_sup([t_abstract_records(T, RecDict) || T <- t_tuple_subtypes(Tuples)]);
+t_abstract_records(T, _RecDict) ->
+ T.
+
+%% Map over types. Depth first. Used by the contract checker. ?list is
+%% not fully implemented so take care when changing the type in Termination.
+
+-spec t_map(fun((erl_type()) -> erl_type()), erl_type()) -> erl_type().
+
+t_map(Fun, ?list(Contents, Termination, Size)) ->
+ Fun(?list(t_map(Fun, Contents), t_map(Fun, Termination), Size));
+t_map(Fun, ?function(Domain, Range)) ->
+ Fun(?function(t_map(Fun, Domain), t_map(Fun, Range)));
+t_map(Fun, ?product(Types)) ->
+ Fun(?product([t_map(Fun, T) || T <- Types]));
+t_map(Fun, ?union(Types)) ->
+ Fun(t_sup([t_map(Fun, T) || T <- Types]));
+t_map(Fun, ?tuple(?any, ?any, ?any) = T) ->
+ Fun(T);
+t_map(Fun, ?tuple(Elements, _Arity, _Tag)) ->
+ Fun(t_tuple([t_map(Fun, E) || E <- Elements]));
+t_map(Fun, ?tuple_set(_) = Tuples) ->
+ Fun(t_sup([t_map(Fun, T) || T <- t_tuple_subtypes(Tuples)]));
+t_map(Fun, T) ->
+ Fun(T).
+
+%%=============================================================================
+%%
+%% Prettyprinter
+%%
+%%=============================================================================
+
+-spec t_to_string(erl_type()) -> string().
+
+t_to_string(T) ->
+ t_to_string(T, dict:new()).
+
+-spec t_to_string(erl_type(), dict()) -> string().
+
+t_to_string(?any, _RecDict) ->
+ "any()";
+t_to_string(?none, _RecDict) ->
+ "none()";
+t_to_string(?unit, _RecDict) ->
+ "no_return()";
+t_to_string(?atom(?any), _RecDict) ->
+ "atom()";
+t_to_string(?atom(Set), _RecDict) ->
+ case set_size(Set) of
+ 2 ->
+ case set_is_element(true, Set) andalso set_is_element(false, Set) of
+ true -> "boolean()";
+ false -> set_to_string(Set)
+ end;
+ _ ->
+ set_to_string(Set)
+ end;
+t_to_string(?bitstr(8, 0), _RecDict) ->
+ "binary()";
+t_to_string(?bitstr(0, 0), _RecDict) ->
+ "<<>>";
+t_to_string(?bitstr(0, B), _RecDict) ->
+ io_lib:format("<<_:~w>>", [B]);
+t_to_string(?bitstr(U, 0), _RecDict) ->
+ io_lib:format("<<_:_*~w>>", [U]);
+t_to_string(?bitstr(U, B), _RecDict) ->
+ io_lib:format("<<_:~w,_:_*~w>>", [B, U]);
+t_to_string(?function(?any, ?any), _RecDict) ->
+ "fun()";
+t_to_string(?function(?any, Range), RecDict) ->
+ "fun((...) -> " ++ t_to_string(Range, RecDict) ++ ")";
+t_to_string(?function(?product(ArgList), Range), RecDict) ->
+ "fun((" ++ comma_sequence(ArgList, RecDict) ++ ") -> "
+ ++ t_to_string(Range, RecDict) ++ ")";
+t_to_string(?identifier(Set), _RecDict) ->
+ if Set =:= ?any -> "identifier()";
+ true -> sequence([io_lib:format("~w()", [T])
+ || T <- set_to_list(Set)], [], " | ")
+ end;
+t_to_string(?opaque(Set), _RecDict) ->
+ sequence([case is_opaque_builtin(Mod, Name) of
+ true -> io_lib:format("~w()", [Name]);
+ false -> io_lib:format("~w:~w()", [Mod, Name])
+ end
+ || #opaque{mod = Mod, name = Name} <- set_to_list(Set)], [], " | ");
+t_to_string(?matchstate(Pres, Slots), RecDict) ->
+ io_lib:format("ms(~s,~s)", [t_to_string(Pres, RecDict),
+ t_to_string(Slots,RecDict)]);
+t_to_string(?nil, _RecDict) ->
+ "[]";
+t_to_string(?nonempty_list(Contents, Termination), RecDict) ->
+ ContentString = t_to_string(Contents, RecDict),
+ case Termination of
+ ?nil ->
+ case Contents of
+ ?char -> "nonempty_string()";
+ _ -> "["++ContentString++",...]"
+ end;
+ ?any ->
+ %% Just a safety check.
+ case Contents =:= ?any of
+ true -> ok;
+ false ->
+ erlang:error({illegal_list, ?nonempty_list(Contents, Termination)})
+ end,
+ "nonempty_maybe_improper_list()";
+ _ ->
+ case t_is_subtype(t_nil(), Termination) of
+ true ->
+ "nonempty_maybe_improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")";
+ false ->
+ "nonempty_improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")"
+ end
+ end;
+t_to_string(?list(Contents, Termination, ?unknown_qual), RecDict) ->
+ ContentString = t_to_string(Contents, RecDict),
+ case Termination of
+ ?nil ->
+ case Contents of
+ ?char -> "string()";
+ _ -> "["++ContentString++"]"
+ end;
+ ?any ->
+ %% Just a safety check.
+ case Contents =:= ?any of
+ true -> ok;
+ false ->
+ L = ?list(Contents, Termination, ?unknown_qual),
+ erlang:error({illegal_list, L})
+ end,
+ "maybe_improper_list()";
+ _ ->
+ case t_is_subtype(t_nil(), Termination) of
+ true ->
+ "maybe_improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")";
+ false ->
+ "improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")"
+ end
+ end;
+t_to_string(?int_set(Set), _RecDict) ->
+ set_to_string(Set);
+t_to_string(?byte, _RecDict) -> "byte()";
+t_to_string(?char, _RecDict) -> "char()";
+t_to_string(?integer_pos, _RecDict) -> "pos_integer()";
+t_to_string(?integer_non_neg, _RecDict) -> "non_neg_integer()";
+t_to_string(?integer_neg, _RecDict) -> "neg_integer()";
+t_to_string(?int_range(From, To), _RecDict) ->
+ lists:flatten(io_lib:format("~w..~w", [From, To]));
+t_to_string(?integer(?any), _RecDict) -> "integer()";
+t_to_string(?float, _RecDict) -> "float()";
+t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()";
+t_to_string(?product(List), RecDict) ->
+ "<" ++ comma_sequence(List, RecDict) ++ ">";
+t_to_string(?remote(Set), RecDict) ->
+ sequence([case Args =:= [] of
+ true -> io_lib:format("~w:~w()", [Mod, Name]);
+ false ->
+ ArgString = comma_sequence(Args, RecDict),
+ io_lib:format("~w:~w(~s)", [Mod, Name, ArgString])
+ end
+ || #remote{mod = Mod, name = Name, args = Args} <- set_to_list(Set)],
+ [], " | ");
+t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()";
+t_to_string(?tuple(Elements, _Arity, ?any), RecDict) ->
+ "{" ++ comma_sequence(Elements, RecDict) ++ "}";
+t_to_string(?tuple(Elements, Arity, Tag), RecDict) ->
+ [TagAtom] = t_atom_vals(Tag),
+ case lookup_record(TagAtom, Arity-1, RecDict) of
+ error -> "{" ++ comma_sequence(Elements, RecDict) ++ "}";
+ {ok, FieldNames} ->
+ record_to_string(TagAtom, Elements, FieldNames, RecDict)
+ end;
+t_to_string(?tuple_set(_) = T, RecDict) ->
+ union_sequence(t_tuple_subtypes(T), RecDict);
+t_to_string(?union(Types), RecDict) ->
+ union_sequence([T || T <- Types, T =/= ?none], RecDict);
+t_to_string(?var(Id), _RecDict) when is_atom(Id) ->
+ io_lib:format("~s", [atom_to_list(Id)]);
+t_to_string(?var(Id), _RecDict) when is_integer(Id) ->
+ io_lib:format("var(~w)", [Id]).
+
+record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
+ FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
+ "#" ++ atom_to_list(Tag) ++ "{" ++ sequence(FieldStrings, [], ",") ++ "}".
+
+record_fields_to_string([Field|Left1], [{FieldName, DeclaredType}|Left2],
+ RecDict, Acc) ->
+ PrintType =
+ case t_is_equal(Field, DeclaredType) of
+ true -> false;
+ false ->
+ case t_is_any(DeclaredType) andalso t_is_atom(undefined, Field) of
+ true -> false;
+ false ->
+ TmpType = t_subtract(DeclaredType, t_atom(undefined)),
+ not t_is_equal(Field, TmpType)
+ end
+ end,
+ case PrintType of
+ false -> record_fields_to_string(Left1, Left2, RecDict, Acc);
+ true ->
+ String = atom_to_list(FieldName) ++ "::" ++ t_to_string(Field, RecDict),
+ record_fields_to_string(Left1, Left2, RecDict, [String|Acc])
+ end;
+record_fields_to_string([], [], _RecDict, Acc) ->
+ lists:reverse(Acc).
+
+comma_sequence(Types, RecDict) ->
+ List = [case T =:= ?any of
+ true -> "_";
+ false -> t_to_string(T, RecDict)
+ end || T <- Types],
+ sequence(List, ",").
+
+union_sequence(Types, RecDict) ->
+ List = [t_to_string(T, RecDict) || T <- Types],
+ sequence(List, " | ").
+
+sequence(List, Delimiter) ->
+ sequence(List, [], Delimiter).
+
+sequence([], [], _Delimiter) ->
+ [];
+sequence([T], Acc, _Delimiter) ->
+ lists:flatten(lists:reverse([T|Acc]));
+sequence([T|Left], Acc, Delimiter) ->
+ sequence(Left, [T ++ Delimiter|Acc], Delimiter).
+
+%%=============================================================================
+%%
+%% Build a type from parse forms.
+%%
+%%=============================================================================
+
+-spec t_from_form(parse_form()) -> erl_type().
+
+t_from_form(Form) ->
+ t_from_form(Form, dict:new()).
+
+-spec t_from_form(parse_form(), dict()) -> erl_type().
+
+t_from_form(Form, RecDict) ->
+ t_from_form(Form, RecDict, dict:new()).
+
+-spec t_from_form(parse_form(), dict(), dict()) -> erl_type().
+
+t_from_form({var, _L, '_'}, _RecDict, _VarDict) -> t_any();
+t_from_form({var, _L, Name}, _RecDict, VarDict) ->
+ case dict:find(Name, VarDict) of
+ error -> t_var(Name);
+ {ok, Val} -> Val
+ end;
+t_from_form({ann_type, _L, [_Var, Type]}, RecDict, VarDict) ->
+ t_from_form(Type, RecDict, VarDict);
+t_from_form({paren_type, _L, [Type]}, RecDict, VarDict) ->
+ t_from_form(Type, RecDict, VarDict);
+t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]},
+ RecDict, VarDict) ->
+ t_remote(Module, Type, [t_from_form(A, RecDict, VarDict) || A <- Args]);
+t_from_form({atom, _L, Atom}, _RecDict, _VarDict) -> t_atom(Atom);
+t_from_form({integer, _L, Int}, _RecDict, _VarDict) -> t_integer(Int);
+t_from_form({type, _L, any, []}, _RecDict, _VarDict) -> t_any();
+t_from_form({type, _L, arity, []}, _RecDict, _VarDict) -> t_arity();
+t_from_form({type, _L, array, []}, _RecDict, _VarDict) -> t_array();
+t_from_form({type, _L, atom, []}, _RecDict, _VarDict) -> t_atom();
+t_from_form({type, _L, binary, []}, _RecDict, _VarDict) -> t_binary();
+t_from_form({type, _L, binary, [{integer, _, Base}, {integer, _, Unit}]},
+ _RecDict, _VarDict) ->
+ t_bitstr(Unit, Base);
+t_from_form({type, _L, bitstring, []}, _RecDict, _VarDict) -> t_bitstr();
+t_from_form({type, _L, bool, []}, _RecDict, _VarDict) -> t_boolean(); % XXX: Temporarily
+t_from_form({type, _L, boolean, []}, _RecDict, _VarDict) -> t_boolean();
+t_from_form({type, _L, byte, []}, _RecDict, _VarDict) -> t_byte();
+t_from_form({type, _L, char, []}, _RecDict, _VarDict) -> t_char();
+t_from_form({type, _L, dict, []}, _RecDict, _VarDict) -> t_dict();
+t_from_form({type, _L, digraph, []}, _RecDict, _VarDict) -> t_digraph();
+t_from_form({type, _L, float, []}, _RecDict, _VarDict) -> t_float();
+t_from_form({type, _L, function, []}, _RecDict, _VarDict) -> t_fun();
+t_from_form({type, _L, 'fun', []}, _RecDict, _VarDict) -> t_fun();
+t_from_form({type, _L, 'fun', [{type, _, any, []}, Range]}, RecDict, VarDict) ->
+ t_fun(t_from_form(Range, RecDict, VarDict));
+t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
+ RecDict, VarDict) ->
+ t_fun([t_from_form(D, RecDict, VarDict) || D <- Domain],
+ t_from_form(Range, RecDict, VarDict));
+t_from_form({type, _L, gb_set, []}, _RecDict, _VarDict) -> t_gb_set();
+t_from_form({type, _L, gb_tree, []}, _RecDict, _VarDict) -> t_gb_tree();
+t_from_form({type, _L, identifier, []}, _RecDict, _VarDict) -> t_identifier();
+t_from_form({type, _L, integer, []}, _RecDict, _VarDict) -> t_integer();
+t_from_form({type, _L, iodata, []}, _RecDict, _VarDict) -> t_iodata();
+t_from_form({type, _L, iolist, []}, _RecDict, _VarDict) -> t_iolist();
+t_from_form({type, _L, list, []}, _RecDict, _VarDict) -> t_list();
+t_from_form({type, _L, list, [Type]}, RecDict, VarDict) ->
+ t_list(t_from_form(Type, RecDict, VarDict));
+t_from_form({type, _L, mfa, []}, _RecDict, _VarDict) -> t_mfa();
+t_from_form({type, _L, module, []}, _RecDict, _VarDict) -> t_module();
+t_from_form({type, _L, nil, []}, _RecDict, _VarDict) -> t_nil();
+t_from_form({type, _L, neg_integer, []}, _RecDict, _VarDict) -> t_neg_integer();
+t_from_form({type, _L, non_neg_integer, []}, _RecDict, _VarDict) ->
+ t_non_neg_integer();
+t_from_form({type, _L, no_return, []}, _RecDict, _VarDict) -> t_unit();
+t_from_form({type, _L, node, []}, _RecDict, _VarDict) -> t_node();
+t_from_form({type, _L, none, []}, _RecDict, _VarDict) -> t_none();
+t_from_form({type, _L, nonempty_list, []}, _RecDict, _VarDict) ->
+ t_nonempty_list();
+t_from_form({type, _L, nonempty_list, [Type]}, RecDict, VarDict) ->
+ t_nonempty_list(t_from_form(Type, RecDict, VarDict));
+t_from_form({type, _L, nonempty_improper_list, [Cont, Term]},
+ RecDict, VarDict) ->
+ t_cons(t_from_form(Cont, RecDict, VarDict),
+ t_from_form(Term, RecDict, VarDict));
+t_from_form({type, _L, nonempty_maybe_improper_list, []}, _RecDict, _VarDict) ->
+ t_cons(?any, ?any);
+t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]},
+ RecDict, VarDict) ->
+ t_cons(t_from_form(Cont, RecDict, VarDict),
+ t_from_form(Term, RecDict, VarDict));
+t_from_form({type, _L, nonempty_string, []}, _RecDict, _VarDict) ->
+ t_nonempty_string();
+t_from_form({type, _L, number, []}, _RecDict, _VarDict) -> t_number();
+t_from_form({type, _L, pid, []}, _RecDict, _VarDict) -> t_pid();
+t_from_form({type, _L, port, []}, _RecDict, _VarDict) -> t_port();
+t_from_form({type, _L, pos_integer, []}, _RecDict, _VarDict) -> t_pos_integer();
+t_from_form({type, _L, maybe_improper_list, []}, _RecDict, _VarDict) ->
+ t_maybe_improper_list();
+t_from_form({type, _L, maybe_improper_list, [Content, Termination]},
+ RecDict, VarDict) ->
+ t_maybe_improper_list(t_from_form(Content, RecDict, VarDict),
+ t_from_form(Termination, RecDict, VarDict));
+t_from_form({type, _L, product, Elements}, RecDict, VarDict) ->
+ t_product([t_from_form(E, RecDict, VarDict) || E <- Elements]);
+t_from_form({type, _L, queue, []}, _RecDict, _VarDict) -> t_queue();
+t_from_form({type, _L, range, [{integer, _, From}, {integer, _, To}]},
+ _RecDict, _VarDict) ->
+ t_from_range(From, To);
+t_from_form({type, _L, record, [Name|Fields]}, RecDict, VarDict) ->
+ record_from_form(Name, Fields, RecDict, VarDict);
+t_from_form({type, _L, reference, []}, _RecDict, _VarDict) -> t_reference();
+t_from_form({type, _L, set, []}, _RecDict, _VarDict) -> t_set();
+t_from_form({type, _L, string, []}, _RecDict, _VarDict) -> t_string();
+t_from_form({type, _L, term, []}, _RecDict, _VarDict) -> t_any();
+t_from_form({type, _L, tid, []}, _RecDict, _VarDict) -> t_tid();
+t_from_form({type, _L, timeout, []}, _RecDict, _VarDict) -> t_timeout();
+t_from_form({type, _L, tuple, any}, _RecDict, _VarDict) -> t_tuple();
+t_from_form({type, _L, tuple, Args}, RecDict, VarDict) ->
+ t_tuple([t_from_form(A, RecDict, VarDict) || A <- Args]);
+t_from_form({type, _L, union, Args}, RecDict, VarDict) ->
+ t_sup([t_from_form(A, RecDict, VarDict) || A <- Args]);
+t_from_form({type, _L, Name, Args}, RecDict, VarDict) ->
+ case lookup_type(Name, RecDict) of
+ {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+ List = lists:zipwith(fun(ArgName, ArgType) ->
+ {ArgName, t_from_form(ArgType, RecDict, VarDict)}
+ end, ArgNames, Args),
+ TmpVardict = dict:from_list(List),
+ t_from_form(Type, RecDict, TmpVardict);
+ {opaque, {Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+ List = lists:zipwith(fun(ArgName, ArgType) ->
+ {ArgName, t_from_form(ArgType, RecDict, VarDict)}
+ end, ArgNames, Args),
+ TmpVardict = dict:from_list(List),
+ Rep = t_from_form(Type, RecDict, TmpVardict),
+ t_from_form({opaque, -1, Name, {Module, Args, Rep}}, RecDict, VarDict);
+ {type, _} ->
+ throw({error, io_lib:format("Unknown type ~w\n", [Name])});
+ {opaque, _} ->
+ throw({error, io_lib:format("Unknown opaque type ~w\n", [Name])});
+ error ->
+ throw({error, io_lib:format("Unable to find type ~w\n", [Name])})
+ end;
+t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _RecDict, _VarDict) ->
+ case Args of
+ [] -> t_opaque(Mod, Name, Args, Rep);
+ _ -> throw({error, "Polymorphic opaque types not supported yet"})
+ end.
+
+record_from_form({atom, _, Name}, ModFields, RecDict, VarDict) ->
+ case lookup_record(Name, RecDict) of
+ {ok, DeclFields} ->
+ case get_mod_record(ModFields, DeclFields, RecDict, VarDict) of
+ {error, FieldName} ->
+ throw({error, io_lib:format("Illegal declaration of ~w#{~w}\n",
+ [Name, FieldName])});
+ {ok, NewFields} ->
+ t_tuple([t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]])
+ end;
+ error ->
+ throw({error,
+ erlang:error(io_lib:format("Unknown record #~w{}\n", [Name]))})
+ end.
+
+get_mod_record([], DeclFields, _RecDict, _VarDict) ->
+ {ok, DeclFields};
+get_mod_record(ModFields, DeclFields, RecDict, VarDict) ->
+ DeclFieldsDict = orddict:from_list(DeclFields),
+ ModFieldsDict = build_field_dict(ModFields, RecDict, VarDict),
+ case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of
+ {error, _FieldName} = Error -> Error;
+ {ok, FinalOrdDict} ->
+ {ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)}
+ || {FieldName, _} <- DeclFields]}
+ end.
+
+build_field_dict(FieldTypes, RecDict, VarDict) ->
+ build_field_dict(FieldTypes, RecDict, VarDict, []).
+
+build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left],
+ RecDict, VarDict, Acc) ->
+ NewAcc = [{Name, t_from_form(Type, RecDict, VarDict)}|Acc],
+ build_field_dict(Left, RecDict, VarDict, NewAcc);
+build_field_dict([], _RecDict, _VarDict, Acc) ->
+ orddict:from_list(Acc).
+
+get_mod_record([{FieldName, DeclType}|Left1],
+ [{FieldName, ModType}|Left2], Acc) ->
+ case t_is_var(ModType) orelse t_is_subtype(ModType, DeclType) of
+ false -> {error, FieldName};
+ true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc])
+ end;
+get_mod_record([{FieldName1, _DeclType} = DT|Left1],
+ [{FieldName2, _ModType}|_] = List2,
+ Acc) when FieldName1 < FieldName2 ->
+ get_mod_record(Left1, List2, [DT|Acc]);
+get_mod_record(DeclFields, [], Acc) ->
+ {ok, orddict:from_list(Acc ++ DeclFields)};
+get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) ->
+ {error, FieldName2}.
+
+-spec t_form_to_string(parse_form()) -> string().
+
+t_form_to_string({var, _L, '_'}) -> "_";
+t_form_to_string({var, _L, Name}) -> atom_to_list(Name);
+t_form_to_string({atom, _L, Atom}) ->
+ io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... '
+t_form_to_string({integer, _L, Int}) -> integer_to_list(Int);
+t_form_to_string({ann_type, _L, [Var, Type]}) ->
+ t_form_to_string(Var) ++ "::" ++ t_form_to_string(Type);
+t_form_to_string({paren_type, _L, [Type]}) ->
+ io_lib:format("(~s)", [t_form_to_string(Type)]);
+t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) ->
+ ArgString = "(" ++ sequence(t_form_to_string_list(Args), ",") ++ ")",
+ io_lib:format("~w:~w", [Mod, Name]) ++ ArgString;
+t_form_to_string({type, _L, arity, []}) -> "arity()";
+t_form_to_string({type, _L, 'fun', []}) -> "fun()";
+t_form_to_string({type, _L, 'fun', [{type, _, any, []}, Range]}) ->
+ "fun(...) -> " ++ t_form_to_string(Range);
+t_form_to_string({type, _L, 'fun', [{type, _, product, Domain}, Range]}) ->
+ "fun((" ++ sequence(t_form_to_string_list(Domain), ",") ++ ") -> "
+ ++ t_form_to_string(Range) ++ ")";
+t_form_to_string({type, _L, iodata, []}) -> "iodata()";
+t_form_to_string({type, _L, iolist, []}) -> "iolist()";
+t_form_to_string({type, _L, list, [Type]}) ->
+ "[" ++ t_form_to_string(Type) ++ "]";
+t_form_to_string({type, _L, mfa, []}) -> "mfa()";
+t_form_to_string({type, _L, module, []}) -> "module()";
+t_form_to_string({type, _L, node, []}) -> "node()";
+t_form_to_string({type, _L, nonempty_list, [Type]}) ->
+ "[" ++ t_form_to_string(Type) ++ ",...]";
+t_form_to_string({type, _L, nonempty_string, []}) -> "nonempty_string()";
+t_form_to_string({type, _L, product, Elements}) ->
+ "<" ++ sequence(t_form_to_string_list(Elements), ",") ++ ">";
+t_form_to_string({type, _L, range, [{integer, _, From}, {integer, _, To}]}) ->
+ io_lib:format("~w..~w", [From, To]);
+t_form_to_string({type, _L, record, [{atom, _, Name}]}) ->
+ io_lib:format("#~w{}", [Name]);
+t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) ->
+ FieldString = sequence(t_form_to_string_list(Fields), ","),
+ io_lib:format("#~w{~s}", [Name, FieldString]);
+t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) ->
+ io_lib:format("~w::~s", [Name, t_form_to_string(Type)]);
+t_form_to_string({type, _L, term, []}) -> "term()";
+t_form_to_string({type, _L, timeout, []}) -> "timeout()";
+t_form_to_string({type, _L, tuple, any}) -> "tuple()";
+t_form_to_string({type, _L, tuple, Args}) ->
+ "{" ++ sequence(t_form_to_string_list(Args), ",") ++ "}";
+t_form_to_string({type, _L, union, Args}) ->
+ sequence(t_form_to_string_list(Args), " | ");
+t_form_to_string({type, _L, Name, []} = T) ->
+ try t_to_string(t_from_form(T))
+ catch throw:{error, _} -> atom_to_list(Name) ++ "()"
+ end;
+t_form_to_string({type, _L, binary, [{integer, _, X}, {integer, _, Y}]}) ->
+ case Y of
+ 0 ->
+ case X of
+ 0 -> "<<>>";
+ _ -> io_lib:format("<<_:~w>>", [X])
+ end
+ end;
+t_form_to_string({type, _L, Name, List}) ->
+ io_lib:format("~w(~s)", [Name, sequence(t_form_to_string_list(List), ",")]).
+
+t_form_to_string_list(List) ->
+ t_form_to_string_list(List, []).
+
+t_form_to_string_list([H|T], Acc) ->
+ t_form_to_string_list(T, [t_form_to_string(H)|Acc]);
+t_form_to_string_list([], Acc) ->
+ lists:reverse(Acc).
+
+%%=============================================================================
+%%
+%% Utilities
+%%
+%%=============================================================================
+
+-spec any_none([erl_type()]) -> boolean().
+
+any_none([?none|_Left]) -> true;
+any_none([_|Left]) -> any_none(Left);
+any_none([]) -> false.
+
+-spec any_none_or_unit([erl_type()]) -> boolean().
+
+any_none_or_unit([?none|_]) -> true;
+any_none_or_unit([?unit|_]) -> true;
+any_none_or_unit([_|Left]) -> any_none_or_unit(Left);
+any_none_or_unit([]) -> false.
+
+-spec lookup_record(atom(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}.
+
+lookup_record(Tag, RecDict) when is_atom(Tag) ->
+ case dict:find({record, Tag}, RecDict) of
+ {ok, [{_Arity, Fields}]} -> {ok, Fields};
+ {ok, List} when is_list(List) ->
+ %% This will have to do, since we do not know which record we
+ %% are looking for.
+ error;
+ error ->
+ error
+ end.
+
+-spec lookup_record(atom(), arity(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}.
+
+lookup_record(Tag, Arity, RecDict) when is_atom(Tag) ->
+ case dict:find({record, Tag}, RecDict) of
+ {ok, [{Arity, Fields}]} -> {ok, Fields};
+ {ok, OrdDict} -> orddict:find(Arity, OrdDict);
+ error -> error
+ end.
+
+lookup_type(Name, RecDict) ->
+ case dict:find({type, Name}, RecDict) of
+ error ->
+ case dict:find({opaque, Name}, RecDict) of
+ error -> error;
+ {ok, Found} -> {opaque, Found}
+ end;
+ {ok, Found} -> {type, Found}
+ end.
+
+-spec type_is_defined('type' | 'opaque', atom(), dict()) -> boolean().
+
+type_is_defined(TypeOrOpaque, Name, RecDict) ->
+ dict:is_key({TypeOrOpaque, Name}, RecDict).
+
+%% -----------------------------------
+%% Set
+%%
+
+set_singleton(Element) ->
+ ordsets:from_list([Element]).
+
+set_is_singleton(Element, Set) ->
+ set_singleton(Element) =:= Set.
+
+set_is_element(Element, Set) ->
+ ordsets:is_element(Element, Set).
+
+set_union(?any, _) -> ?any;
+set_union(_, ?any) -> ?any;
+set_union(S1, S2) ->
+ case ordsets:union(S1, S2) of
+ S when length(S) =< ?SET_LIMIT -> S;
+ _ -> ?any
+ end.
+
+set_union_no_limit(?any, _) -> ?any;
+set_union_no_limit(_, ?any) -> ?any;
+set_union_no_limit(S1, S2) -> ordsets:union(S1, S2).
+
+%% The intersection and subtraction can return ?none.
+%% This should always be handled right away since ?none is not a valid set.
+%% However, ?any is considered a valid set.
+
+set_intersection(?any, S) -> S;
+set_intersection(S, ?any) -> S;
+set_intersection(S1, S2) ->
+ case ordsets:intersection(S1, S2) of
+ [] -> ?none;
+ S -> S
+ end.
+
+set_subtract(_, ?any) -> ?none;
+set_subtract(?any, _) -> ?any;
+set_subtract(S1, S2) ->
+ case ordsets:subtract(S1, S2) of
+ [] -> ?none;
+ S -> S
+ end.
+
+set_from_list(List) ->
+ case length(List) of
+ L when L =< ?SET_LIMIT -> ordsets:from_list(List);
+ L when L > ?SET_LIMIT -> ?any
+ end.
+
+set_to_list(Set) ->
+ ordsets:to_list(Set).
+
+set_filter(Fun, Set) ->
+ case ordsets:filter(Fun, Set) of
+ [] -> ?none;
+ NewSet -> NewSet
+ end.
+
+set_size(Set) ->
+ ordsets:size(Set).
+
+set_to_string(Set) ->
+ L = [case is_atom(X) of
+ true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs '
+ false -> io_lib:format("~w", [X])
+ end || X <- set_to_list(Set)],
+ sequence(L, [], " | ").
+
+set_min([H|_]) -> H.
+
+set_max(Set) ->
+ hd(lists:reverse(Set)).
+
+%%=============================================================================
+%%
+%% Utilities for the binary type
+%%
+%%=============================================================================
+
+-spec gcd(integer(), integer()) -> integer().
+
+gcd(A, B) when B > A ->
+ gcd1(B, A);
+gcd(A, B) ->
+ gcd1(A, B).
+
+-spec gcd1(integer(), integer()) -> integer().
+
+gcd1(A, 0) -> A;
+gcd1(A, B) ->
+ case A rem B of
+ 0 -> B;
+ X -> gcd1(B, X)
+ end.
+
+-spec bitstr_concat(erl_type(), erl_type()) -> erl_type().
+
+bitstr_concat(?none, _) -> ?none;
+bitstr_concat(_, ?none) -> ?none;
+bitstr_concat(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ t_bitstr(gcd(U1, U2), B1+B2).
+
+-spec bitstr_match(erl_type(), erl_type()) -> erl_type().
+
+bitstr_match(?none, _) -> ?none;
+bitstr_match(_, ?none) -> ?none;
+bitstr_match(?bitstr(0, B1), ?bitstr(0, B2)) when B1 =< B2 ->
+ t_bitstr(0, B2-B1);
+bitstr_match(?bitstr(0, _B1), ?bitstr(0, _B2)) ->
+ ?none;
+bitstr_match(?bitstr(0, B1), ?bitstr(U2, B2)) when B1 =< B2 ->
+ t_bitstr(U2, B2-B1);
+bitstr_match(?bitstr(0, B1), ?bitstr(U2, B2)) ->
+ t_bitstr(U2, handle_base(U2, B2-B1));
+bitstr_match(?bitstr(_, B1), ?bitstr(0, B2)) when B1 > B2 ->
+ ?none;
+bitstr_match(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ GCD = gcd(U1, U2),
+ t_bitstr(GCD, handle_base(GCD, B2-B1)).
+
+-spec handle_base(integer(), integer()) -> integer().
+
+handle_base(Unit, Pos) when Pos >= 0 ->
+ Pos rem Unit;
+handle_base(Unit, Neg) ->
+ (Unit+(Neg rem Unit)) rem Unit.
+
+%%=============================================================================
+%% Consistency-testing function(s) below
+%%=============================================================================
+
+-ifdef(DO_ERL_TYPES_TEST).
+
+test() ->
+ Atom1 = t_atom(),
+ Atom2 = t_atom(foo),
+ Atom3 = t_atom(bar),
+ true = t_is_atom(Atom2),
+
+ True = t_atom(true),
+ False = t_atom(false),
+ Bool = t_boolean(),
+ true = t_is_boolean(True),
+ true = t_is_boolean(Bool),
+ false = t_is_boolean(Atom1),
+
+ Binary = t_binary(),
+ true = t_is_binary(Binary),
+
+ Bitstr = t_bitstr(),
+ true = t_is_bitstr(Bitstr),
+
+ Bitstr1 = t_bitstr(7, 3),
+ true = t_is_bitstr(Bitstr1),
+ false = t_is_binary(Bitstr1),
+
+ Bitstr2 = t_bitstr(16, 8),
+ true = t_is_bitstr(Bitstr2),
+ true = t_is_binary(Bitstr2),
+
+ ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
+ ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
+
+ Int1 = t_integer(),
+ Int2 = t_integer(1),
+ Int3 = t_integer(16#ffffffff),
+ true = t_is_integer(Int2),
+ true = t_is_byte(Int2),
+ false = t_is_byte(Int3),
+ false = t_is_byte(t_from_range(-1, 1)),
+ true = t_is_byte(t_from_range(1, ?MAX_BYTE)),
+
+ Tuple1 = t_tuple(),
+ Tuple2 = t_tuple(3),
+ Tuple3 = t_tuple([Atom1, Int1]),
+ Tuple4 = t_tuple([Tuple1, Tuple2]),
+ Tuple5 = t_tuple([Tuple3, Tuple4]),
+ Tuple6 = t_limit(Tuple5, 2),
+ Tuple7 = t_limit(Tuple5, 3),
+ true = t_is_tuple(Tuple1),
+
+ Port = t_port(),
+ Pid = t_pid(),
+ Ref = t_reference(),
+ Identifier = t_identifier(),
+ false = t_is_reference(Port),
+ true = t_is_identifier(Port),
+
+ Function1 = t_fun(),
+ Function2 = t_fun(Pid),
+ Function3 = t_fun([], Pid),
+ Function4 = t_fun([Port, Pid], Pid),
+ Function5 = t_fun([Pid, Atom1], Int2),
+ true = t_is_fun(Function3),
+
+ List1 = t_list(),
+ List2 = t_list(t_boolean()),
+ List3 = t_cons(t_boolean(), List2),
+ List4 = t_cons(t_boolean(), t_atom()),
+ List5 = t_cons(t_boolean(), t_nil()),
+ List6 = t_cons_tl(List5),
+ List7 = t_sup(List4, List5),
+ List8 = t_inf(List7, t_list()),
+ List9 = t_cons(),
+ List10 = t_cons_tl(List9),
+ true = t_is_boolean(t_cons_hd(List5)),
+ true = t_is_list(List5),
+ false = t_is_list(List4),
+
+ Product1 = t_product([Atom1, Atom2]),
+ Product2 = t_product([Atom3, Atom1]),
+ Product3 = t_product([Atom3, Atom2]),
+
+ Union1 = t_sup(Atom2, Atom3),
+ Union2 = t_sup(Tuple2, Tuple3),
+ Union3 = t_sup(Int2, Atom3),
+ Union4 = t_sup(Port, Pid),
+ Union5 = t_sup(Union4, Int1),
+ Union6 = t_sup(Function1, Function2),
+ Union7 = t_sup(Function4, Function5),
+ Union8 = t_sup(True, False),
+ true = t_is_boolean(Union8),
+ Union9 = t_sup(Int2, t_integer(2)),
+ true = t_is_byte(Union9),
+ Union10 = t_sup(t_tuple([t_atom(true), ?any]),
+ t_tuple([t_atom(false), ?any])),
+
+ ?any = t_sup(Product3, Function5),
+
+ Atom3 = t_inf(Union3, Atom1),
+ Union2 = t_inf(Union2, Tuple1),
+ Int2 = t_inf(Int1, Union3),
+ Union4 = t_inf(Union4, Identifier),
+ Port = t_inf(Union5, Port),
+ Function4 = t_inf(Union7, Function4),
+ ?none = t_inf(Product2, Atom1),
+ Product3 = t_inf(Product1, Product2),
+ Function5 = t_inf(Union7, Function5),
+ true = t_is_byte(t_inf(Union9, t_number())),
+ true = t_is_char(t_inf(Union9, t_number())),
+
+ io:format("3? ~p ~n", [?int_set([3])]),
+
+ RecDict = dict:store({foo, 2}, [bar, baz], dict:new()),
+ Record1 = t_from_term({foo, [1,2], {1,2,3}}),
+
+ Types = [
+ Atom1,
+ Atom2,
+ Atom3,
+ Binary,
+ Int1,
+ Int2,
+ Tuple1,
+ Tuple2,
+ Tuple3,
+ Tuple4,
+ Tuple5,
+ Tuple6,
+ Tuple7,
+ Ref,
+ Port,
+ Pid,
+ Identifier,
+ List1,
+ List2,
+ List3,
+ List4,
+ List5,
+ List6,
+ List7,
+ List8,
+ List9,
+ List10,
+ Function1,
+ Function2,
+ Function3,
+ Function4,
+ Function5,
+ Product1,
+ Product2,
+ Record1,
+ Union1,
+ Union2,
+ Union3,
+ Union4,
+ Union5,
+ Union6,
+ Union7,
+ Union8,
+ Union10,
+ t_inf(Union10, t_tuple([t_atom(true), t_integer()]))
+ ],
+ io:format("~p\n", [[t_to_string(X, RecDict) || X <- Types]]).
+
+-endif.
diff --git a/lib/hipe/doc/Makefile b/lib/hipe/doc/Makefile
new file mode 100644
index 0000000000..340f909aa6
--- /dev/null
+++ b/lib/hipe/doc/Makefile
@@ -0,0 +1,29 @@
+# ``The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved via the world wide web at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+SHELL=/bin/sh
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+clean:
+ -rm -f *.html edoc-info stylesheet.css
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
diff --git a/lib/hipe/doc/html/.gitignore b/lib/hipe/doc/html/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/lib/hipe/doc/overview.edoc b/lib/hipe/doc/overview.edoc
new file mode 100644
index 0000000000..0016478a8a
--- /dev/null
+++ b/lib/hipe/doc/overview.edoc
@@ -0,0 +1,9 @@
+
+ HiPE overview page
+
+@title The HiPE Compiler
+
+@author The HiPE group <hipe@it.uu.se> [http://www.it.uu.se/research/group/hipe/]
+
+@doc This is the online documentation for the HiPE native code compiler.
+The user interface is provided by the module {@link hipe}.
diff --git a/lib/hipe/doc/pdf/.gitignore b/lib/hipe/doc/pdf/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/lib/hipe/doc/src/Makefile b/lib/hipe/doc/src/Makefile
new file mode 100644
index 0000000000..3b63e57549
--- /dev/null
+++ b/lib/hipe/doc/src/Makefile
@@ -0,0 +1,113 @@
+# ``The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved via the world wide web at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+# AB. All Rights Reserved.''
+#
+# $Id$
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../../vsn.mk
+VSN=$(HIPE_VSN)
+APPLICATION=hipe
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+XML_APPLICATION_FILES =
+XML_REF3_FILES =
+
+XML_PART_FILES = part_notes.xml
+XML_CHAPTER_FILES = notes.xml
+
+BOOK_FILES = book.xml
+
+XML_FILES = \
+ $(BOOK_FILES) $(XML_CHAPTER_FILES) \
+ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES)
+
+GIF_FILES =
+
+# ----------------------------------------------------
+
+HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
+
+INFO_FILE = ../../info
+EXTRA_FILES = \
+ $(DEFAULT_GIF_FILES) \
+ $(DEFAULT_HTML_FILES) \
+ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
+
+MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
+
+HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
+
+TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+XML_FLAGS +=
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+$(HTMLDIR)/%.gif: %.gif
+ $(INSTALL_DATA) $< $@
+
+docs: pdf html man
+
+$(TOP_PDF_FILE): $(XML_FILES)
+
+pdf: $(TOP_PDF_FILE)
+
+html: gifs $(HTML_REF_MAN_FILE)
+
+man: $(MAN3_FILES)
+
+gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
+
+debug opt:
+
+clean clean_docs:
+ rm -rf $(HTMLDIR)/*
+ rm -f $(MAN3DIR)/*
+ rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f errs core *~
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_docs_spec: docs
+ $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf
+ $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf
+ $(INSTALL_DIR) $(RELSYSDIR)/doc/html
+ $(INSTALL_DATA) $(HTMLDIR)/* \
+ $(RELSYSDIR)/doc/html
+ $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR)
+
+
+release_spec:
diff --git a/lib/hipe/doc/src/book.xml b/lib/hipe/doc/src/book.xml
new file mode 100644
index 0000000000..236dfc69a1
--- /dev/null
+++ b/lib/hipe/doc/src/book.xml
@@ -0,0 +1,38 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE book SYSTEM "book.dtd">
+
+<book xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header titlestyle="normal">
+ <copyright>
+ <year>2006</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>HiPE</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <pagetext></pagetext>
+ <preamble>
+ </preamble>
+ <pagetext>HiPE</pagetext>
+ <releasenotes>
+ <xi:include href="notes.xml"/>
+ </releasenotes>
+</book>
+
diff --git a/lib/hipe/doc/src/fascicules.xml b/lib/hipe/doc/src/fascicules.xml
new file mode 100644
index 0000000000..28acc14624
--- /dev/null
+++ b/lib/hipe/doc/src/fascicules.xml
@@ -0,0 +1,12 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
+
+<fascicules>
+ <fascicule file="part_notes" href="part_notes_frame.html" entry="yes">
+ Release Notes
+ </fascicule>
+ <fascicule file="" href="../../../../doc/print.html" entry="no">
+ Off-Print
+ </fascicule>
+</fascicules>
+
diff --git a/lib/hipe/doc/src/make.dep b/lib/hipe/doc/src/make.dep
new file mode 100644
index 0000000000..d5f5844c21
--- /dev/null
+++ b/lib/hipe/doc/src/make.dep
@@ -0,0 +1,13 @@
+# ----------------------------------------------------
+# >>>> Do not edit this file <<<<
+# This file was automaticly generated by
+# /home/otp/bin/docdepend
+# ----------------------------------------------------
+
+
+# ----------------------------------------------------
+# TeX files that the DVI file depend on
+# ----------------------------------------------------
+
+book.dvi: book.tex
+
diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml
new file mode 100644
index 0000000000..8bb9320756
--- /dev/null
+++ b/lib/hipe/doc/src/notes.xml
@@ -0,0 +1,350 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2006</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>HiPE Release Notes</title>
+ <prepared>otp_appnotes</prepared>
+ <docno>nil</docno>
+ <date>nil</date>
+ <rev>nil</rev>
+ <file>notes.xml</file>
+ </header>
+ <p>This document describes the changes made to HiPE.</p>
+
+<section><title>Hipe 3.7.4</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The documentation is now built with open source tools
+ (xsltproc and fop) that exists on most platforms. One
+ visible change is that the frames are removed.</p>
+ <p>
+ Own Id: OTP-8201</p>
+ </item>
+ <item>
+ <p>
+ Misc updates.</p>
+ <p>
+ Own Id: OTP-8301</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.7.3</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Various small bugs (one involving the handling of large
+ binaries) were corrected and some additions to its
+ functionality and/or code cleanups were done.</p>
+ <p>
+ Own Id: OTP-8189</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.7.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Miscellanous updates.</p>
+ <p>
+ Own Id: OTP-8038</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.7.1</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Minor updates and bug fixes.</p>
+ <p>
+ Own Id: OTP-7958</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+
+<section><title>Hipe 3.7</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Miscellaneous updates.</p>
+ <p>
+ Own Id: OTP-7877</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.6.9</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The <c>--disable-hipe</c> option for the
+ <c>configure</c> will now completely disable the hipe
+ run-time in the emulator, as is the expected
+ behaviour.</p>
+ <p>
+ Own Id: OTP-7631</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.6.8</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Minor updates.</p>
+ <p>
+ Own Id: OTP-7522</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+
+<section><title>Hipe 3.6.7</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Minor changes.</p>
+ <p>
+ Own Id: OTP-7388</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.6.6</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>A fix for an #include problem which caused the FP
+ exception test to fail unnecessarily on
+ debian/glibc-2.7/x86 systems.</p>
+ <p>Added SIGFPE loop detection to the FP exception test.
+ This prevents the test from looping indefinitely, which
+ could happen when the CPU is supported (so we can enable
+ FP exceptions on it) but the OS isn't (so we can't write
+ a proper SIGFPE handler). x86 on an unsupported OS is
+ known to have had this problem.</p>
+ <p>
+ Own Id: OTP-7254</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ HiPE now also supports little-endian ARM processors.</p>
+ <p>
+ Own Id: OTP-7255</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Hipe 3.6.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ HIPE: Corrected the choice of interface to the send/3 and
+ setnode/3 BIFs for native-compiled code. Using the
+ incorrect interface could, in unusual circumstances, lead
+ to random runtime errors.</p>
+ <p>
+ Own Id: OTP-7067</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The HiPE compiler's SPARC backend has been rewritten,
+ improving its correctness and long-term maintainability.</p>
+ <p>
+ Own Id: OTP-7133</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+ <section>
+ <title>Hipe 3.6.3</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Minor Makefile changes.</p>
+ <p>Own Id: OTP-6689</p>
+ </item>
+ <item>
+ <p>Miscellanous updates.</p>
+ <p>Own Id: OTP-6738</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Hipe 3.6.2</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Miscellanous improvements.</p>
+ <p>Own Id: OTP-6577</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Hipe 3.6.1.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Dialyzer could fail to analyze certain beam files that
+ used try/catch.</p>
+ <p>Own Id: OTP-6449 Aux Id: seq10563 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Hipe 3.6.1</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>HiPE runtime system:</p>
+ <p>* added notes about supported systems to README</p>
+ <p>* support 32-bit x86 on FreeBSD</p>
+ <p>* autoenable HiPE on FreeBSD (32-bit x86) and Solaris
+ (64-bit x86)</p>
+ <p>* updated x86 runtime system to support glibc-2.5</p>
+ <p>* work around probable gcc-4.1.1 bug affecting the x86
+ runtime system</p>
+ <p>HiPE compiler:</p>
+ <p>* improved performance of integer multiplications on
+ all platforms</p>
+ <p>* corrected a code optimisation error in R11B-2 that
+ broke some bsl/bsr operations on all platforms</p>
+ <p>* corrected a type error in the ARM backend which
+ could cause the compiler to crash</p>
+ <p>* corrected an error in the SPARC backend's naive
+ register allocator which could throw the compiler into an
+ infinite loop</p>
+ <p>Own Id: OTP-6423</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Hipe 3.6.0</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Support for native code on Solaris 10/AMD64.</p>
+ <p>Support for native code on FreeBSD/AMD64.</p>
+ <p>Native code now handles external funs (<c><![CDATA[fun M:F/A]]></c>). Native code can now also apply so-called
+ tuple-funs (<c><![CDATA[{M,F}]]></c>). (Tuple funs are NOT
+ recommended for new code; they are deprecated and will be
+ removed in some future release.)</p>
+ <p>Own Id: OTP-6305</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Hipe 3.5.6</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Improved compilation of receives for the SMP runtime
+ system.</p>
+ <p>Improved code quality in HiPE compiler on ARM.</p>
+ <p>Fix bug in handling of re-raised exceptions in
+ try-catch.</p>
+ <p>(HiPE loader) When native code is incompatible with
+ the current runtime system, fall back to loading the BEAM
+ code.</p>
+ <p>Own Id: OTP-6127</p>
+ </item>
+ </list>
+ </section>
+ </section>
+</chapter>
+
diff --git a/lib/hipe/doc/src/part_notes.xml b/lib/hipe/doc/src/part_notes.xml
new file mode 100644
index 0000000000..8a3e82027b
--- /dev/null
+++ b/lib/hipe/doc/src/part_notes.xml
@@ -0,0 +1,35 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE part SYSTEM "part.dtd">
+
+<part xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>2006</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>HiPE Release Notes</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <description>
+ <p><em>HiPE</em> - High Performance Erlang.</p>
+ </description>
+ <xi:include href="notes.xml"/>
+</part>
+
diff --git a/lib/hipe/ebin/.gitignore b/lib/hipe/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/lib/hipe/flow/Makefile b/lib/hipe/flow/Makefile
new file mode 100644
index 0000000000..5b9d0b7582
--- /dev/null
+++ b/lib/hipe/flow/Makefile
@@ -0,0 +1,105 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = hipe_bb hipe_dominators hipe_gen_cfg
+
+
+HRL_FILES=
+INC_FILES= cfg.inc ebb.inc liveness.inc
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/flow
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(INC_FILES) $(RELSYSDIR)/flow
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+$(EBIN)/hipe_bb.beam: hipe_bb.hrl
+$(EBIN)/hipe_gen_cfg.beam: cfg.hrl cfg.inc ../main/hipe.hrl
diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl
new file mode 100644
index 0000000000..62f47a707a
--- /dev/null
+++ b/lib/hipe/flow/cfg.hrl
@@ -0,0 +1,53 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%============================================================================
+%% File : cfg.hrl
+%% Author : Kostis Sagonas <kostis@it.uu.se>
+%% Purpose : Contains typed record declarations for the CFG data structures
+%%
+%% $Id$
+%%============================================================================
+
+-type cfg_lbl() :: non_neg_integer().
+
+%%
+%% This is supposed to be local but appears here for the time being
+%% just so that it is used below
+%%
+-record(cfg_info, {'fun' :: mfa(),
+ start_label :: cfg_lbl(),
+ is_closure :: boolean(),
+ closure_arity :: arity(),
+ is_leaf :: boolean(),
+ params, % :: list()
+ info = []}). %% this field seems not needed; take out??
+
+%%
+%% Data is a triple with a dict of constants, a list of labels and an integer
+%%
+-type cfg_data() :: {dict(), [cfg_lbl()], non_neg_integer()}.
+
+%%
+%% The following is to be used by other modules
+%%
+-record(cfg, {table = gb_trees:empty() :: gb_tree(),
+ info :: #cfg_info{},
+ data :: cfg_data()}).
+-type cfg() :: #cfg{}.
diff --git a/lib/hipe/flow/cfg.inc b/lib/hipe/flow/cfg.inc
new file mode 100644
index 0000000000..62f399a81c
--- /dev/null
+++ b/lib/hipe/flow/cfg.inc
@@ -0,0 +1,949 @@
+%% -*- Erlang -*-
+%% -*- erlang-indent-level: 2 -*-
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% CONTROL FLOW GRAPHS
+%%
+%% Construct and manipulate the control flow graph of a function (program?).
+%%
+%% Exports:
+%% ~~~~~~~~
+%% init(Code) - makes a CFG out of code.
+%% bb(CFG, Label) - returns the basic block named 'Label' from the CFG.
+%% bb_add(CFG, Label, NewBB) - makes NewBB the basic block associated
+%% with Label.
+%% succ(Map, Label) - returns a list of successors of basic block 'Label'.
+%% pred(Map, Label) - returns the predecessors of basic block 'Label'.
+%% fallthrough(CFG, Label) - returns fall-through successor of basic
+%% block 'Label' (or 'none').
+%% conditional(CFG, Label) - returns conditional successor (or 'none')
+%% start_label(CFG) - returns the label of the entry basic block.
+%% params(CFG) - returns the list of parameters to the CFG.
+%% labels(CFG) - returns a list of labels of all basic blocks in the CFG.
+%% postorder(CFG) - returns a list of labels in postorder.
+%% reverse_postorder(CFG) - returns a list of labels in reverse postorder.
+%% cfg_to_linear(CFG) - converts CFG to linearized code.
+%% remove_trivial_bbs(CFG) - removes empty BBs or BBs with only a goto.
+%% remove_unreachable_code(CFG) - removes unreachable BBs.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% TODO:
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=====================================================================
+%% The following are ugly as hell, but what else can I do???
+%%=====================================================================
+
+-ifdef(GEN_CFG).
+-define(PRED_NEEDED,true).
+-endif.
+
+-ifdef(ICODE_CFG).
+-define(CLOSURE_ARITY_NEEDED,true).
+-define(INFO_NEEDED,true).
+-define(PARAMS_NEEDED,true).
+-define(PARAMS_UPDATE_NEEDED,true).
+-define(PRED_NEEDED,true).
+-define(REMOVE_TRIVIAL_BBS_NEEDED,true).
+-define(REMOVE_UNREACHABLE_CODE,true).
+-define(START_LABEL_UPDATE_NEEDED,true).
+-define(CFG_CAN_HAVE_PHI_NODES,true).
+-endif.
+
+-ifdef(RTL_CFG).
+-define(PREORDER,true).
+-define(FIND_NEW_LABEL_NEEDED,true).
+-define(INFO_NEEDED,true).
+-define(PARAMS_NEEDED,true).
+-define(PARAMS_UPDATE_NEEDED,true).
+-define(PRED_NEEDED,true).
+-define(REMOVE_TRIVIAL_BBS_NEEDED,true).
+-define(REMOVE_UNREACHABLE_CODE,true).
+-define(START_LABEL_UPDATE_NEEDED,true).
+-define(CFG_CAN_HAVE_PHI_NODES,true).
+-endif.
+
+-ifdef(SPARC_CFG).
+-define(BREADTH_ORDER,true). % for linear scan
+-define(PARAMS_NEEDED,true).
+-define(START_LABEL_UPDATE_NEEDED,true).
+-endif.
+
+%%=====================================================================
+
+-ifdef(START_LABEL_UPDATE_NEEDED).
+-export([start_label_update/2]).
+-endif.
+
+-ifdef(BREADTH_ORDER).
+-export([breadthorder/1]).
+-endif.
+
+-compile(inline).
+
+%%=====================================================================
+%%
+%% Interface functions that MUST be implemented in the including file:
+%%
+%% linear_to_cfg(LinearCode) -> CFG, constructs the cfg.
+%% is_label(Instr) -> boolean(), true if instruction is a label.
+%% label_name(Instr) -> term(), the name of a label.
+%% branch_successors(Instr) -> [term()], the successors of a branch.
+%% fails_to(Instr) -> [term()], the fail-successors of an instruction.
+%% is_branch(Instr) -> boolean(), true if instruction is a branch.
+%% is_comment(Instr) -> boolean(),
+%% true if instruction is a comment, used by remove dead code.
+%% is_goto(Instr) -> boolean(),
+%% true if instruction is a pure goto, used by remove dead code.
+%% redirect_jmp(Jmp, ToOld, ToNew) -> NewJmp,
+%% redirect_ops(Labels, CFG, Map) -> CFG.
+%% Rewrite instructions with labels in operands to use
+%% the new label as given by map.
+%% Use find_new_label(OldLab,Map) to get the new label.
+%% (See hipe_sparc_cfg for example)
+%% pp(CFG) -> ok, do some nifty output.
+%% cfg_to_linear(CFG) -> LinearCode, linearizes the code of CFG
+%% mk_goto(Label) -> instruction
+%% is_phi(Instr) -> boolean(), true if the instruction is a phi-instruction.
+%% phi_remove_pred(PhiInstr, Pred) -> NewPhi,
+%% Removes the predecessor Pred from the phi instruction.
+%% highest_var(Code) -> term(),
+%% Returns the highest variable used or defined in the code.
+%%
+%%=====================================================================
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Primitives (not all of these are exported)
+%%
+
+-spec start_label(cfg()) -> cfg_lbl().
+start_label(CFG) -> (CFG#cfg.info)#cfg_info.start_label.
+
+-ifndef(GEN_CFG).
+-spec start_label_update(cfg(), cfg_lbl()) -> cfg().
+start_label_update(CFG, NewStartLabel) ->
+ Info = CFG#cfg.info,
+ CFG#cfg{info = Info#cfg_info{start_label = NewStartLabel}}.
+
+-spec function(cfg()) -> mfa().
+function(CFG) -> (CFG#cfg.info)#cfg_info.'fun'.
+
+-spec is_closure(cfg()) -> boolean().
+is_closure(CFG) -> (CFG#cfg.info)#cfg_info.is_closure.
+
+-spec is_leaf(cfg()) -> boolean().
+is_leaf(CFG) -> (CFG#cfg.info)#cfg_info.is_leaf.
+
+mk_empty_cfg(Fun, StartLbl, Data, Closure, Leaf, Params) ->
+ Info = #cfg_info{'fun' = Fun,
+ start_label = StartLbl,
+ is_closure = Closure,
+ is_leaf = Leaf,
+ params = Params},
+ #cfg{table = gb_trees:empty(), data = Data, info = Info}.
+
+data(CFG) -> CFG#cfg.data.
+-endif. % GEN_CFG
+
+-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
+-spec update_data(cfg(), cfg_data()) -> cfg().
+update_data(CFG, D) ->
+ CFG#cfg{data = D}.
+-endif.
+
+-ifdef(PARAMS_NEEDED).
+params(CFG) -> (CFG#cfg.info)#cfg_info.params.
+-endif.
+
+-ifdef(PARAMS_UPDATE_NEEDED).
+params_update(CFG, NewParams) ->
+ Info = CFG#cfg.info,
+ CFG#cfg{info = Info#cfg_info{params = NewParams}}.
+-endif.
+
+-ifdef(CLOSURE_ARITY_NEEDED).
+-spec closure_arity(cfg()) -> arity().
+closure_arity(CFG) ->
+ Info = CFG#cfg.info,
+ Info#cfg_info.closure_arity.
+
+-spec closure_arity_update(cfg(), arity()) -> cfg().
+closure_arity_update(CFG, Arity) ->
+ Info = CFG#cfg.info,
+ CFG#cfg{info = Info#cfg_info{closure_arity = Arity}}.
+-endif.
+
+%% %% Don't forget to do a start_label_update if necessary.
+%% update_code(CFG, NewCode) ->
+%% take_bbs(NewCode, CFG).
+
+-ifdef(INFO_NEEDED).
+info(CFG) -> (CFG#cfg.info)#cfg_info.info.
+%% info_add(CFG, A) ->
+%% As = info(CFG),
+%% Info = CFG#cfg.info,
+%% CFG#cfg{info = Info#cfg_info{info = [A|As]}}.
+info_update(CFG, I) ->
+ Info = CFG#cfg.info,
+ CFG#cfg{info = Info#cfg_info{info = I}}.
+-endif.
+
+%%=====================================================================
+-ifndef(GEN_CFG).
+
+-spec other_entrypoints(cfg()) -> [cfg_lbl()].
+%% @doc Returns a list of labels that are refered to from the data section.
+
+other_entrypoints(CFG) ->
+ hipe_consttab:referred_labels(data(CFG)).
+
+%% is_entry(Lbl, CFG) ->
+%% Lbl =:= start_label(CFG) orelse
+%% lists:member(Lbl, other_entrypoints(CFG)).
+
+%% @spec bb(CFG::cfg(), Label::cfg_lbl()) -> basic_block()
+%% @doc Returns the basic block of the CFG which begins at the Label.
+bb(CFG, Label) ->
+ HT = CFG#cfg.table,
+ case gb_trees:lookup(Label, HT) of
+ {value, {Block,_Succ,_Pred}} ->
+ Block;
+ none ->
+ not_found
+ end.
+
+%% Remove duplicates from a list. The first instance (in left-to-right
+%% order) of an element is kept, remaining instances are removed.
+-spec remove_duplicates([cfg_lbl()]) -> [cfg_lbl()].
+remove_duplicates(List) ->
+ remove_duplicates(List, []).
+
+-spec remove_duplicates([cfg_lbl()], [cfg_lbl()]) -> [cfg_lbl()].
+remove_duplicates([H|T], Acc) ->
+ NewAcc =
+ case lists:member(H, Acc) of
+ false -> [H|Acc];
+ true -> Acc
+ end,
+ remove_duplicates(T, NewAcc);
+remove_duplicates([], Acc) ->
+ lists:reverse(Acc).
+
+
+-ifdef(RTL_CFG). %% this could be CFG_CAN_HAVE_PHI_NODES
+ %% if Icode also starts using this function
+
+%% @spec bb_insert_between(CFG::cfg(),
+%% Label::cfg_lbl(), NewBB::basic_block(),
+%% Pred::cfg_lbl(), Succ::cfg_lbl()) -> cfg()
+%%
+%% @doc Insert the new basic block with label Label in the edge from
+%% Pred to Succ
+
+bb_insert_between(CFG, Label, NewBB, Pred, Succ) ->
+ Last = hipe_bb:last(NewBB),
+ %% Asserts that NewBB ends in a label
+ true = is_branch(Last),
+ %% Asserts that the only Successor of NewBB is Succ
+ [Succ] = remove_duplicates(branch_successors(Last)),
+ HT = CFG#cfg.table,
+ %% Asserts that Label does not exist in the CFG
+ none = gb_trees:lookup(Label, HT),
+ %% Updates the predecessor of NewBB
+ {value, {PBB, PSucc, PPred}} = gb_trees:lookup(Pred, HT),
+ NewPSucc = [Label|lists:delete(Succ, PSucc)],
+ PLast = hipe_bb:last(PBB),
+ PButLast = hipe_bb:butlast(PBB),
+ NewPBB = hipe_bb:code_update(PBB, PButLast++[redirect_jmp(PLast, Succ, Label)]),
+ HT1 = gb_trees:update(Pred, {NewPBB,NewPSucc,PPred}, HT),
+ %% Updates the successor of NewBB
+ {value, {SBB, SSucc, SPred}} = gb_trees:lookup(Succ, HT1),
+ NewSPred = [Label|lists:delete(Pred, SPred)],
+ SCode = hipe_bb:code(SBB),
+ NewSCode = redirect_phis(SCode, Pred, Label, []),
+ NewSBB = hipe_bb:code_update(SBB, NewSCode),
+ HT2 = gb_trees:update(Succ, {NewSBB,SSucc,NewSPred}, HT1),
+ %% Enters NewBB into the CFG
+ HT3 = gb_trees:insert(Label, {NewBB,[Succ],[Pred]}, HT2),
+ CFG#cfg{table = HT3}.
+
+redirect_phis([], _OldPred, _NewPred, Acc) ->
+ lists:reverse(Acc);
+redirect_phis([I|Rest], OldPred, NewPred, Acc) ->
+ case is_phi(I) of
+ true ->
+ Phi = phi_redirect_pred(I, OldPred, NewPred),
+ redirect_phis(Rest, OldPred, NewPred, [Phi|Acc]);
+ false ->
+ redirect_phis(Rest, OldPred, NewPred, [I|Acc])
+ end.
+
+-endif.
+
+%% @spec bb_add(CFG::cfg(), Label::cfg_lbl(), NewBB::basic_block()) -> cfg()
+%% @doc Adds a new basic block to a CFG (or updates an existing block).
+bb_add(CFG, Label, NewBB) ->
+ %% Asserting that the NewBB is a legal basic block
+ Last = hipe_bb:last(NewBB),
+ case is_branch(Last) of
+ true -> ok;
+ false -> throw({?MODULE, {"Basic block ends without branch", Last}})
+ end,
+ %% The order of the elements from branch_successors/1 is
+ %% significant. It determines the basic block order when the CFG is
+ %% converted to linear form. That order may have been tuned for
+ %% branch prediction purposes.
+ Succ = remove_duplicates(branch_successors(Last)),
+ HT = CFG#cfg.table,
+ {OldSucc, OldPred} = case gb_trees:lookup(Label, HT) of
+ {value, {_Block, OSucc, OPred}} ->
+ {OSucc, OPred};
+ none ->
+ {[], []}
+ end,
+ %% Change this block to contain new BB and new successors, but keep
+ %% the old predecessors which will be updated in the following steps
+ HT1 = gb_trees:enter(Label, {NewBB, Succ, OldPred}, HT),
+ %% Add this block as predecessor to its new successors
+ HT2 = lists:foldl(fun (P, HTAcc) ->
+ add_pred(HTAcc, P, Label)
+ end,
+ HT1, Succ -- OldSucc),
+ %% Remove this block as predecessor of its former successors
+ HT3 = lists:foldl(fun (S, HTAcc) ->
+ remove_pred(HTAcc, S, Label)
+ end,
+ HT2, OldSucc -- Succ),
+ CFG#cfg{table = HT3}.
+
+remove_pred(HT, FromL, PredL) ->
+ case gb_trees:lookup(FromL, HT) of
+ {value, {Block, Succ, Preds}} ->
+ Code = hipe_bb:code(Block),
+ NewCode = remove_pred_from_phis(Code, PredL, []),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ gb_trees:update(FromL, {NewBlock,Succ,lists:delete(PredL,Preds)}, HT);
+ none ->
+ HT
+ end.
+
+add_pred(HT, ToL, PredL) ->
+ case gb_trees:lookup(ToL, HT) of
+ {value,{Block,Succ,Preds}} ->
+ gb_trees:update(ToL, {Block,Succ,[PredL|lists:delete(PredL,Preds)]}, HT);
+ none ->
+ gb_trees:insert(ToL, {[],[],[PredL]}, HT)
+ end.
+
+%% find_highest_label(CFG) ->
+%% Labels = labels(CFG),
+%% lists:foldl(fun(X, Acc) -> erlang:max(X, Acc) end, 0, Labels).
+%%
+%% find_highest_var(CFG) ->
+%% Labels = labels(CFG),
+%% Fun = fun(X, Max) ->
+%% Code = hipe_bb:code(bb(CFG, X)),
+%% NewMax = highest_var(Code),
+%% erlang:max(Max, NewMax)
+%% end,
+%% lists:foldl(Fun, 0, Labels).
+
+-ifdef(CFG_CAN_HAVE_PHI_NODES).
+%% phi-instructions in a removed block's successors must be aware of
+%% the change.
+remove_pred_from_phis(List = [I|Left], Label, Acc) ->
+ case is_phi(I) of
+ true ->
+ NewAcc = [phi_remove_pred(I, Label)|Acc],
+ remove_pred_from_phis(Left, Label, NewAcc);
+ false ->
+ lists:reverse(Acc) ++ List
+ end;
+remove_pred_from_phis([], _Label, Acc) ->
+ lists:reverse(Acc).
+-else.
+%% this is used for code representations like those of back-ends which
+%% do not have phi-nodes.
+remove_pred_from_phis(Code, _Label, _Acc) ->
+ Code.
+-endif.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Constructs a CFG from a list of instructions.
+%%
+
+take_bbs([], CFG) ->
+ CFG;
+take_bbs(Xs, CFG) ->
+ Lbl = hd(Xs),
+ case is_label(Lbl) of
+ true ->
+ case take_bb(tl(Xs), []) of
+ {Code, Rest} ->
+ NewCFG = bb_add(CFG, label_name(Lbl), hipe_bb:mk_bb(Code)),
+ take_bbs(Rest, NewCFG)
+ end;
+ false ->
+ erlang:error({?MODULE,"basic block doesn't start with a label",Xs})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Take_bb returns:
+%% - {Code, Rest}.
+%% * Code is a list of all the instructions.
+%% * Rest is the remainder of the instructions
+
+take_bb([], Code) ->
+ {lists:reverse(Code), []};
+take_bb([X, Y|Xs], Code) ->
+ case is_label(X) of
+ true -> %% Empty block fallthrough
+ {[mk_goto(label_name(X))], [X,Y|Xs]};
+ false ->
+ case is_branch(X) of
+ true ->
+ case is_label(Y) of
+ true ->
+ {lists:reverse([X|Code]), [Y|Xs]};
+ false ->
+ %% This should not happen...
+ %% move the problem to the next BB.
+ {lists:reverse([X|Code]), [Y|Xs]}
+ end;
+ false -> %% X not branch
+ case is_label(Y) of
+ true ->
+ {lists:reverse([mk_goto(label_name(Y)),X|Code]), [Y|Xs]};
+ false ->
+ take_bb([Y|Xs], [X|Code])
+ end
+ end
+ end;
+take_bb([X], []) ->
+ case is_label(X) of
+ true ->
+ %% We don't want the CFG to just end with a label...
+ %% We loop forever instead...
+ {[X,mk_goto(label_name(X))],[]};
+ false ->
+ {[X],[]}
+ end;
+take_bb([X], Code) ->
+ case is_label(X) of
+ true ->
+ %% We don't want the CFG to just end with a label...
+ %% We loop for ever instead...
+ {lists:reverse(Code),[X,mk_goto(label_name(X))]};
+ false ->
+ {lists:reverse([X|Code]),[]}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Functions for extracting the names of the basic blocks in various
+%% orders.
+%%
+
+labels(CFG) ->
+ HT = CFG#cfg.table,
+ gb_trees:keys(HT).
+
+postorder(CFG) ->
+ lists:reverse(reverse_postorder(CFG)).
+
+reverse_postorder(CFG) ->
+ Start = start_label(CFG),
+ {Ordering, _Visited} =
+ depth_search([Start|other_entrypoints(CFG)], none_visited(), CFG, []),
+ Ordering.
+
+depth_search([N|Ns], Visited, CFG, Acc) ->
+ case is_visited(N, Visited) of
+ true ->
+ depth_search(Ns, Visited, CFG, Acc);
+ false ->
+ {Order, Vis} = depth_search(succ(CFG, N), visit(N, Visited), CFG, Acc),
+ depth_search(Ns, Vis, CFG, [N|Order])
+ end;
+depth_search([], Visited, _, Ordering) ->
+ {Ordering, Visited}.
+
+-ifdef(PREORDER).
+preorder(CFG) ->
+ Start = start_label(CFG),
+ {Ordering, _Visited} =
+ preorder_search([Start|other_entrypoints(CFG)], none_visited(), CFG, []),
+ lists:reverse(Ordering).
+
+preorder_search([N|Ns], Visited, CFG, Acc) ->
+ case is_visited(N, Visited) of
+ true ->
+ preorder_search(Ns, Visited, CFG, Acc);
+ false ->
+ {Order, Vis} =
+ preorder_search(succ(CFG, N), visit(N, Visited), CFG, [N|Acc]),
+ preorder_search(Ns, Vis, CFG, Order)
+ end;
+preorder_search([], Visited, _, Ordering) ->
+ {Ordering,Visited}.
+-endif. % PREORDER
+
+-ifdef(BREADTH_ORDER).
+breadthorder(CFG) ->
+ lists:reverse(reverse_breadthorder(CFG)).
+
+reverse_breadthorder(CFG) ->
+ Start = start_label(CFG),
+ {Vis, RBO1} = breadth_list([Start], none_visited(), CFG, []),
+ {_Vis1, RBO2} = breadth_list(other_entrypoints(CFG), Vis, CFG, RBO1),
+ RBO2.
+
+breadth_list([X|Xs], Vis, CFG, BO) ->
+ case is_visited(X, Vis) of
+ true ->
+ breadth_list(Xs, Vis, CFG, BO);
+ false ->
+ breadth_list(Xs ++ succ(CFG, X), visit(X, Vis), CFG, [X|BO])
+ end;
+breadth_list([], Vis, _CFG, BO) ->
+ {Vis, BO}.
+-endif.
+
+-spec none_visited() -> gb_set().
+none_visited() ->
+ gb_sets:empty().
+
+visit(X, Vis) ->
+ gb_sets:add(X, Vis).
+
+is_visited(X, Vis) ->
+ gb_sets:is_member(X, Vis).
+
+-endif. % GEN_CFG
+
+%%---------------------------------------------------------------------
+
+succ(SuccMap, Label) ->
+ HT = SuccMap#cfg.table,
+ case gb_trees:lookup(Label, HT) of
+ {value, {_Block,Succ,_Pred}} ->
+ Succ;
+ none ->
+ erlang:error({"successor not found", Label, SuccMap})
+ end.
+
+-ifdef(PRED_NEEDED).
+pred(Map, Label) ->
+ HT = Map#cfg.table,
+ case gb_trees:lookup(Label, HT) of
+ {value, {_Block,_Succ,Pred}} ->
+ Pred;
+ none ->
+ erlang:error({"predecessor not found", Label, Map})
+ end.
+-endif. % PRED_NEEDED
+
+-ifndef(GEN_CFG).
+fallthrough(CFG, Label) ->
+ HT = CFG#cfg.table,
+ case gb_trees:lookup(Label, HT) of
+ {value, {_Block, Succ, _}} ->
+ case Succ of
+ [X|_] -> X;
+ _ -> none
+ end;
+ none ->
+ erlang:error({"fallthrough label not found", Label})
+ end.
+
+conditional(CFG, Label) ->
+ HT = CFG#cfg.table,
+ {value,{_Block,Succ,_}} = gb_trees:lookup(Label, HT),
+ case Succ of
+ [] -> none;
+ [_] -> none;
+ [_|Labels] -> Labels
+ end.
+-endif. % GEN_CFG
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Linearize the code in a CFG. Returns a list of instructions.
+%%
+
+-ifdef(GEN_CFG).
+-else.
+linearize_cfg(CFG) ->
+ Start = start_label(CFG),
+ Vis = none_visited(),
+ {Vis0, NestedCode} = lin_succ(Start, CFG, Vis),
+ BlocksInData = hipe_consttab:referred_labels(data(CFG)),
+ AllCode = lin_other_entries(NestedCode, CFG, BlocksInData, Vis0),
+ lists:flatten(AllCode).
+
+lin_succ(none, _CFG, Vis) ->
+ {Vis, []};
+lin_succ([Label|Labels], CFG, Vis) ->
+ {Vis1, Code1} = lin_succ(Label, CFG, Vis),
+ {Vis2, Code2} = lin_succ(Labels, CFG, Vis1),
+ {Vis2, [Code1,Code2]};
+lin_succ([], _CFG, Vis) ->
+ {Vis, []};
+lin_succ(Label, CFG, Vis) ->
+ case is_visited(Label, Vis) of
+ true ->
+ {Vis, []}; % already visited
+ false ->
+ Vis0 = visit(Label, Vis),
+ case bb(CFG, Label) of
+ not_found ->
+ erlang:error({?MODULE, "No basic block with label", Label});
+ BB ->
+ Fallthrough = fallthrough(CFG, Label),
+ Cond = conditional(CFG, Label),
+ LblInstr = mk_label(Label),
+ {Vis1, Code1} = lin_succ(Fallthrough, CFG, Vis0),
+ {Vis2, Code2} = lin_succ(Cond, CFG, Vis1),
+ {Vis2, [[LblInstr|hipe_bb:code(BB)], Code1, Code2]}
+ end
+ end.
+
+lin_other_entries(Code, _CFG, [], _Vis) ->
+ Code;
+lin_other_entries(Code, CFG, [E|Es], Vis) ->
+ {Vis0, MoreCode} = lin_succ(E, CFG, Vis),
+ lin_other_entries([Code, MoreCode], CFG, Es, Vis0).
+-endif.
+
+-ifdef(FIND_NEW_LABEL_NEEDED).
+find_new_label(Old, Map) ->
+ forward(Old, Map).
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Remove empty BBs.
+%%
+%% Removes basic blocks containing only a goto to another BB.
+%% Branches to removed blocks are updated to the successor of the
+%% removed block.
+%% Loads (or other operations) on the label of the BB are also
+%% updated. So are any references from the data section.
+%%
+
+-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
+
+-spec remove_trivial_bbs(cfg()) -> cfg().
+remove_trivial_bbs(CFG) ->
+ ?opt_start_timer("Merge BBs"),
+ CFG0 = merge_bbs(rewrite_trivial_branches(CFG)),
+ ?opt_stop_timer("Merge BBs"),
+ %% pp(CFG0),
+ ?opt_start_timer("FindDead"),
+ {NewMap, CFG1} = remap(labels(CFG0), rd_map_new(), CFG0),
+ ?opt_stop_timer("FindDead"),
+ ?opt_start_timer("Labels"),
+ Labels = labels(CFG1),
+ ?opt_stop_timer("Labels"),
+ ?opt_start_timer("RedirectBranches"),
+ CFG2 = redirect_branches(NewMap, CFG1),
+ ?opt_stop_timer("RedirectBranches"),
+ ?opt_start_timer("RedirectOps"),
+ CFG3 = redirect_ops(Labels, CFG2, NewMap),
+ ?opt_stop_timer("RedirectOps"),
+ ?opt_start_timer("RedirectData"),
+ CFG4 = redirect_data(CFG3, NewMap),
+ ?opt_stop_timer("RedirectData"),
+ ?opt_start_timer("RedirectStart"),
+ CFG5 = redirect_start(CFG4, NewMap),
+ ?opt_stop_timer("RedirectStart"),
+ %% pp(CFG5),
+ CFG5.
+
+redirect_start(CFG, Map) ->
+ Start = start_label(CFG),
+ case forward(Start, Map) of
+ Start -> CFG;
+ NewStart ->
+ start_label_update(CFG, NewStart)
+ end.
+
+redirect_data(CFG, Map) ->
+ Data = data(CFG),
+ NewData = hipe_consttab:update_referred_labels(Data, rd_succs(Map)),
+ update_data(CFG, NewData).
+
+redirect_branches(Map, CFG) ->
+ lists:foldl(fun ({From,{newsuccs,Redirects}}, CFGAcc) ->
+ lists:foldl(
+ fun({ToOld,ToNew}, CFG1) ->
+ case bb(CFG1, From) of
+ not_found ->
+ CFG1;
+ _ ->
+ To = forward(ToNew, Map),
+ redirect(CFG1, From, ToOld, To)
+ end
+ end,
+ CFGAcc,
+ Redirects);
+ (_, CFGAcc) -> CFGAcc
+ end,
+ CFG,
+ gb_trees:to_list(Map)).
+
+redirect(CFG, From, ToOld, ToNew) ->
+ BB = bb(CFG, From),
+ LastInstr = hipe_bb:last(BB),
+ NewLastInstr = redirect_jmp(LastInstr, ToOld, ToNew),
+ NewBB = hipe_bb:mk_bb(hipe_bb:butlast(BB) ++ [NewLastInstr]),
+ bb_add(CFG, From, NewBB).
+
+bb_remove(CFG, Label) ->
+ HT = CFG#cfg.table,
+ case gb_trees:lookup(Label, HT) of
+ {value, {_Block, Succ, _Preds}} ->
+ %% Remove this block as a pred from all successors.
+ HT1 = lists:foldl(fun (S,HTAcc) ->
+ remove_pred(HTAcc, S, Label)
+ end,
+ HT, Succ),
+ CFG#cfg{table = gb_trees:delete(Label, HT1)};
+ none ->
+ CFG
+ end.
+
+remap([L|Rest], Map, CFG) ->
+ case is_empty(bb(CFG, L)) of
+ true ->
+ case succ(CFG, L) of
+ [L] -> %% This is an empty (infinite) self loop. Leave it.
+ remap(Rest, Map, CFG);
+ [SuccL] ->
+ CFG1 = bb_remove(CFG, L),
+ NewMap = remap_to_succ(L, SuccL, Map, CFG),
+ remap(Rest, NewMap, CFG1)
+ end;
+ false ->
+ remap(Rest, Map, CFG)
+ end;
+remap([], Map, CFG) ->
+ {Map, CFG}.
+
+remap_to_succ(L, SuccL, Map, PredMap) ->
+ insert_remap(L, forward(SuccL,Map), pred(PredMap,L), Map).
+
+%% Find the proxy for a BB
+forward(L, Map) ->
+ case gb_trees:lookup(L, Map) of
+ {value, {dead, To}} ->
+ forward(To, Map); %% Hope this terminates.
+ _ -> L
+ end.
+
+%% A redirection map contains mappings from labels to
+%% none -> this BB is not affected by the remapping.
+%% {dead,To} -> this BB is dead, To is the new proxy.
+%% {newsuccs,[{X,Y}|...]} -> The successor X is redirected to Y.
+
+rd_map_new() -> gb_trees:empty().
+
+rd_succs(M) ->
+ lists:foldl(fun ({From,{dead,To}}, Acc) -> [{From,forward(To,M)}|Acc];
+ (_, Acc) -> Acc
+ end,
+ [],
+ gb_trees:to_list(M)).
+
+add_redirectedto(L, From, To, Map) ->
+ case gb_trees:lookup(L, Map) of
+ {value, {newsuccs, NS}} ->
+ gb_trees:update(L,{newsuccs,[{From,To}|lists:keydelete(From,1,NS)]},Map);
+ {value, {dead, _}} -> Map;
+ none ->
+ gb_trees:insert(L, {newsuccs, [{From, To}]}, Map)
+ end.
+
+insert_remap(L, ToL, Preds, Map) ->
+ Map2 = gb_trees:enter(L, {dead, ToL}, Map),
+ lists:foldl(fun (Pred, AccMap) ->
+ add_redirectedto(Pred, L, ToL, AccMap)
+ end,
+ Map2,
+ Preds).
+
+is_empty(BB) ->
+ is_empty_bb(hipe_bb:code(BB)).
+
+is_empty_bb([I]) ->
+ is_goto(I); %% A BB with just a 'goto' is empty.
+is_empty_bb([I|Is]) ->
+ case is_comment(I) of
+ true ->
+ is_empty_bb(Is);
+ false ->
+ false
+ end;
+is_empty_bb([]) ->
+ true.
+
+
+%% Rewrite all pure branches with one successor to goto:s
+
+-spec rewrite_trivial_branches(cfg()) -> cfg().
+rewrite_trivial_branches(CFG) ->
+ rewrite_trivial_branches(postorder(CFG), CFG).
+
+rewrite_trivial_branches([L|Left], CFG) ->
+ BB = bb(CFG, L),
+ Last = hipe_bb:last(BB),
+ case is_goto(Last) of
+ true ->
+ rewrite_trivial_branches(Left, CFG);
+ false ->
+ case is_pure_branch(Last) of
+ false ->
+ rewrite_trivial_branches(Left, CFG);
+ true ->
+ case succ(CFG, L) of
+ [Successor] ->
+ Head = hipe_bb:butlast(BB),
+ NewBB = hipe_bb:mk_bb(Head ++ [mk_goto(Successor)]),
+ NewCFG = bb_add(CFG, L, NewBB),
+ rewrite_trivial_branches(Left, NewCFG);
+ _ ->
+ rewrite_trivial_branches(Left, CFG)
+ end
+ end
+ end;
+rewrite_trivial_branches([], CFG) ->
+ CFG.
+
+
+%% Go through the CFG and find pairs of BBs that can be merged to one BB.
+%% They are of the form:
+%%
+%% L
+%% |
+%% Successor
+%%
+%% That is, the block L has only one successor (Successor) and that
+%% successor has no other predecessors than L.
+%%
+%% Note: calls might end a basic block
+
+merge_bbs(CFG) ->
+ lists:foldl(fun merge_successor/2, CFG, postorder(CFG)).
+
+%% If L fulfills the requirements, merge it with its successor.
+merge_successor(L, CFG) ->
+ %% Get the BB L (If it still exists).
+ case bb(CFG, L) of
+ not_found -> CFG;
+ BB ->
+ StartLabel = start_label(CFG),
+ Last = hipe_bb:last(BB),
+ %% Note: Cannot use succ/2 since the instruction can have more than
+ %% one successor that are the same label.
+ case {branch_successors(Last), fails_to(Last)} of
+ {[Successor],[Successor]} ->
+ %% The single successor is the fail-label; don't merge.
+ CFG;
+ {[Successor],_} when Successor =/= StartLabel ->
+ %% Make sure the succesor only have this block as predecessor.
+ case [L] =:= pred(CFG, Successor) of
+ true ->
+ %% Remove the goto or remap fall-through in BB and merge the BBs
+ NewCode = merge(BB, bb(CFG, Successor), Successor),
+ NewBB = hipe_bb:mk_bb(NewCode),
+ bb_add(bb_remove(CFG, Successor), L, NewBB);
+ false ->
+ CFG
+ end;
+ _ ->
+ %% Not exactly one successor or tried to merge with the
+ %% entry point
+ CFG
+ end
+ end.
+
+%% Merge BB and BB2
+merge(BB, BB2, BB2_Label) ->
+ Head = hipe_bb:butlast(BB),
+ Last = hipe_bb:last(BB),
+ Tail = hipe_bb:code(BB2),
+ case is_goto(Last) of
+ true ->
+ %% Just ignore the goto.
+ Head ++ Tail;
+ false ->
+ %% The last instr is not a goto,
+ %% e.g. a call with only fall-through
+ %% Remove the fall-through with the []-label.
+ Head ++ [redirect_jmp(Last, BB2_Label, [])|Tail]
+ end.
+
+-endif. % REMOVE_TRIVIAL_BBS_NEEDED
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Remove unreachable BBs.
+%%
+%% A BB is unreachable if it cannot be reached by any path from the
+%% start label of the function.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-ifdef(REMOVE_UNREACHABLE_CODE).
+
+-spec remove_unreachable_code(cfg()) -> cfg().
+
+remove_unreachable_code(CFG) ->
+ Start = start_label(CFG),
+ Reachable = find_reachable([Start], CFG, gb_sets:from_list([Start])),
+ %% Reachable is an ordset: it comes from gb_sets:to_list/1.
+ %% So use ordset:subtract instead of '--' below.
+ Labels = ordsets:from_list(labels(CFG)),
+ case ordsets:subtract(Labels, Reachable) of
+ [] ->
+ CFG;
+ Remove ->
+ NewCFG = lists:foldl(fun(X, Acc) -> bb_remove(Acc, X) end, CFG, Remove),
+ remove_unreachable_code(NewCFG)
+ end.
+
+find_reachable([Label|Left], CFG, Acc) ->
+ NewAcc = gb_sets:add(Label, Acc),
+ Succ = succ(CFG, Label),
+ find_reachable([X || X <- Succ, not gb_sets:is_member(X, Acc)] ++ Left,
+ CFG, NewAcc);
+find_reachable([], _CFG, Acc) ->
+ gb_sets:to_list(Acc).
+
+-endif.
diff --git a/lib/hipe/flow/ebb.inc b/lib/hipe/flow/ebb.inc
new file mode 100644
index 0000000000..42d7ff3793
--- /dev/null
+++ b/lib/hipe/flow/ebb.inc
@@ -0,0 +1,247 @@
+%% -*- Erlang -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% IDENTIFIES THE EXTENDED BASIC BLOCKS OF A CFG
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-export([cfg/1,
+ %% dag/2,
+ type/1,
+ node_label/1,
+ node_successors/1
+ ]).
+-ifdef(DEBUG_EBB).
+-export([pp/1]).
+-endif.
+
+-define(cfg, ?CFG).
+
+%%--------------------------------------------------------------------
+%% The extended basic block datatype
+%%
+%% An EBB is identified with the label of the root node.
+%% It's a tree
+%%
+%% EBB := {ebb_node, Label, [EBB]}
+%% | {ebb_leaf, SuccesorLabel}
+%%--------------------------------------------------------------------
+
+%% XXX: Cheating big time! no recursive types
+-type ebb() :: {ebb_node, icode_lbl(), _}
+ | {ebb_leaf, icode_lbl()}.
+
+-record(ebb_node, {label :: icode_lbl(), successors :: [ebb()]}).
+-record(ebb_leaf, {successor :: icode_lbl()}).
+
+%%--------------------------------------------------------------------
+%% Returns a list of extended basic blocks.
+%%--------------------------------------------------------------------
+
+-spec cfg(cfg()) -> [ebb()].
+
+cfg(CFG) ->
+ Start = ?cfg:start_label(CFG),
+ Labels = ?cfg:reverse_postorder(CFG),
+ Roots = [Start],
+ Blocks = Labels -- Roots,
+ Visited = new_visited(),
+ build_all_ebb(Roots, Blocks, Visited, CFG).
+
+new_visited() ->
+ gb_sets:empty().
+visited(L, Visited) ->
+ gb_sets:is_member(L, Visited).
+visit(L, Visited) ->
+ gb_sets:add(L, Visited).
+
+build_all_ebb(Roots, Blocks, Visited, CFG) ->
+ build_all_ebb(Roots, Blocks, Visited, CFG, []).
+
+build_all_ebb([], [], _, _CFG, Ebbs) ->
+ lists:reverse(Ebbs);
+build_all_ebb([], [BlockLeft|BlocksLeft], Visited, CFG, Ebbs) ->
+ case visited(BlockLeft, Visited) of
+ true ->
+ build_all_ebb([], BlocksLeft, Visited, CFG, Ebbs);
+ false ->
+ build_all_ebb([BlockLeft], BlocksLeft, Visited, CFG, Ebbs)
+ end;
+build_all_ebb([Root|Roots], Blocks, Visited, CFG, Ebbs) ->
+ {Ebb, NewVisited} = build_ebb(Root, Visited, CFG),
+ build_all_ebb(Roots, Blocks, NewVisited, CFG, [Ebb|Ebbs]).
+
+%%
+%% Build the extended basic block with Lbl as its root.
+%%
+
+build_ebb(Lbl, Visited, CFG) ->
+ build_ebb(Lbl, Visited,
+ fun (NodeL, NewVisited) -> {NodeL, NewVisited} end,
+ [], CFG).
+
+build_ebb(Lbl, Visited, MkFun, EBBs, CFG) ->
+ Succ = ?cfg:succ(CFG, Lbl),
+ add_succ(Succ, visit(Lbl, Visited), Lbl, MkFun, EBBs, CFG).
+
+add_succ([], Visited, Node, MkFun, EBBs, _CFG) ->
+ MkFun(mk_node(Node, lists:reverse(EBBs)), Visited);
+add_succ([Lbl|Lbls], Visited, Node, MkFun, EBBs, CFG) ->
+ case [visited(Lbl, Visited)|?cfg:pred(CFG, Lbl)] of
+ [false,_] ->
+ build_ebb(Lbl, Visited,
+ fun (NewEbb, Visited0) ->
+ add_succ(Lbls, Visited0, Node, MkFun, [NewEbb|EBBs], CFG)
+ end, [], CFG);
+ _ ->
+ add_succ(Lbls, Visited, Node, MkFun, [mk_leaf(Lbl)|EBBs], CFG)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Generate a list of dags.
+%%
+
+%% dag(EBBs, CFG) ->
+%% Start = ?cfg:start_label(CFG),
+%% Roots = [Start],
+%% Edges = all_adges(EBBs, Roots),
+%% start_dag(Roots, Edges, []).
+%%
+%% start_dag([], _Edges, _Visit) ->
+%% [];
+%% start_dag([Root|Roots], Edges, Visit) ->
+%% case lists:member(Root, Visit) of
+%% true ->
+%% start_dag(Roots, Edges, Visit);
+%% false ->
+%% {Dag, Roots0, Visit0} =
+%% fill_dag(Root, [Root], Edges, Roots, [Root|Visit]),
+%% [lists:reverse(Dag) | start_dag(Roots0, Edges, Visit0)]
+%% end.
+%%
+%% fill_dag(Lbl, Dag, Edges, Roots, Visit) ->
+%% Succ = find_succ(Lbl, Edges),
+%% add_dag_succ(Succ, Dag, Edges, Roots, Visit).
+%%
+%% add_dag_succ([], Dag, _Edges, Roots, Visit) ->
+%% {Dag, Roots, Visit};
+%% add_dag_succ([S|Ss], Dag, Edges, Roots, Visit) ->
+%% {Dag0, Roots0, Visit0} = add_dag_succ(Ss, Dag, Edges, Roots, Visit),
+%% Pred = find_pred(S, Edges),
+%% case all_in(Pred, Dag0) of
+%% true ->
+%% fill_dag(S, [S|Dag0], Edges, Roots0, [S|Visit0]);
+%% false ->
+%% {Dag0, [S|Roots], Visit0}
+%% end.
+%%
+%% find_succ(_Lbl, []) ->
+%% [];
+%% find_succ(Lbl, [{Lbl, Succ}|Edges]) ->
+%% [Succ | find_succ(Lbl, Edges)];
+%% find_succ(Lbl, [_|Edges]) ->
+%% find_succ(Lbl, Edges).
+%%
+%% find_pred(_Lbl, []) ->
+%% [];
+%% find_pred(Lbl, [{Pred, Lbl}|Edges]) ->
+%% [Pred | find_pred(Lbl, Edges)];
+%% find_pred(Lbl, [_|Edges]) ->
+%% find_pred(Lbl, Edges).
+%%
+%% all_edges([], _Roots) ->
+%% [];
+%% all_edges([EBB|EBBs], Roots) ->
+%% succ_edges(node_label(EBB), ebb_successors(EBB), EBBs, Roots).
+%%
+%% succ_edges(Lbl, [], EBBs, Roots) ->
+%% case lists:member(Lbl, Roots) of
+%% true ->
+%% [{start, Lbl} | all_edges(EBBs, Roots)];
+%% false ->
+%% all_edges(EBBs, Roots)
+%% end;
+%% succ_edges(Lbl, [S|Ss], EBBs, Roots) ->
+%% [{Lbl, S} | succ_edges(Lbl, Ss, EBBs, Roots)].
+%%
+%% all_in([], _List) ->
+%% true;
+%% all_in([X|Xs], List) ->
+%% lists:member(X, List) andalso all_in(Xs, List).
+%%
+%% find_ebb(Lbl, [EBB|EBBs]) ->
+%% case node_label(EBB) of
+%% Lbl ->
+%% EBB;
+%% _ ->
+%% find_ebb(Lbl, EBBs)
+%% end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec mk_node(icode_lbl(), [ebb()]) -> #ebb_node{}.
+mk_node(Label, Successors) -> #ebb_node{label=Label, successors=Successors}.
+
+-spec node_label(#ebb_node{}) -> icode_lbl().
+node_label(#ebb_node{label=Label}) -> Label.
+
+-spec node_successors(#ebb_node{}) -> [ebb()].
+node_successors(#ebb_node{successors=Successors}) -> Successors.
+
+-spec mk_leaf(icode_lbl()) -> #ebb_leaf{}.
+mk_leaf(NextEbb) -> #ebb_leaf{successor=NextEbb}.
+%% leaf_next(Leaf) -> Leaf#ebb_leaf.successor.
+
+-spec type(#ebb_node{}) -> 'node' ; (#ebb_leaf{}) -> 'leaf'.
+type(#ebb_node{}) -> node;
+type(#ebb_leaf{}) -> leaf.
+
+%% ebb_successors(EBB) ->
+%% ordsets:from_list(ebb_successors0(EBB)).
+%%
+%% ebb_successors0(#ebb_leaf{successor=NextEBB}) ->
+%% [NextEBB];
+%% ebb_successors0(#ebb_node{successors=SuccessorNodes}) ->
+%% lists:append(lists:map(fun ebb_successors0/1, SuccessorNodes)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Prettyprint a list of extended basic blocks
+%%
+
+-ifdef(DEBUG_EBB).
+
+pp(EBBs) ->
+ lists:map(fun(E) -> pp(E, 0) end, EBBs).
+
+pp(EBB, Indent) ->
+ io:format([$~]++integer_to_list(Indent)++[$c],[$ ]),
+ case type(EBB) of
+ node ->
+ io:format("~w~n", [node_label(EBB)]),
+ lists:map(fun(E) -> pp(E, Indent+3) end, node_successors(EBB));
+ leaf ->
+ io:format("* -> ~w~n", [leaf_next(EBB)])
+ end.
+
+-endif.
diff --git a/lib/hipe/flow/hipe_bb.erl b/lib/hipe/flow/hipe_bb.erl
new file mode 100644
index 0000000000..16730f1dce
--- /dev/null
+++ b/lib/hipe/flow/hipe_bb.erl
@@ -0,0 +1,81 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Basic Block Module
+%%
+%% Exports:
+%% ~~~~~~~~
+%% mk_bb(Code) - construct a basic block.
+%% code(BB) - returns the code.
+%% code_update(BB, NewCode) - replace the code in a basic block.
+%% last(BB) - returns the last instruction.
+%% butlast(BB) - returns the code with the last instruction removed.
+%%
+
+-module(hipe_bb).
+
+-export([mk_bb/1,
+ code/1,
+ code_update/2,
+ is_bb/1,
+ last/1,
+ butlast/1]).
+
+-include("hipe_bb.hrl").
+
+%%
+%% Constructs a basic block.
+%% Returns a basic block: {bb, Code}
+%% * Code is a list of instructions
+
+-spec mk_bb([_]) -> bb().
+
+mk_bb(Code) ->
+ #bb{code=Code}.
+
+-spec is_bb(_) -> boolean().
+
+is_bb(#bb{}) -> true;
+is_bb(_) -> false.
+
+-spec code_update(bb(), [_]) -> bb().
+
+code_update(BB, Code) ->
+ BB#bb{code = Code}.
+
+-spec code(bb()) -> [_].
+
+code(#bb{code = Code}) ->
+ Code.
+
+-spec last(bb()) -> _.
+
+last(#bb{code = Code}) ->
+ lists:last(Code).
+
+-spec butlast(bb()) -> [_].
+
+butlast(#bb{code = Code}) ->
+ butlast_1(Code).
+
+butlast_1([X|Xs]) -> butlast_1(Xs,X).
+
+butlast_1([X|Xs],Y) -> [Y|butlast_1(Xs,X)];
+butlast_1([],_) -> [].
diff --git a/lib/hipe/flow/hipe_bb.hrl b/lib/hipe/flow/hipe_bb.hrl
new file mode 100644
index 0000000000..f4d426dad1
--- /dev/null
+++ b/lib/hipe/flow/hipe_bb.hrl
@@ -0,0 +1,30 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%-------------------------------------------------------------------
+%%% File : bb.hrl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description : Typed record declaration for basic blocks
+%%%
+%%% Created : 20 Dec 2007 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+
+-record(bb, {code=[] :: [_]}).
+
+-type bb() :: #bb{}.
diff --git a/lib/hipe/flow/hipe_dominators.erl b/lib/hipe/flow/hipe_dominators.erl
new file mode 100644
index 0000000000..3bfa6d43c4
--- /dev/null
+++ b/lib/hipe/flow/hipe_dominators.erl
@@ -0,0 +1,715 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%------------------------------------------------------------------------
+%% File : hipe_dominators.erl
+%% Author : Christoffer Vikstr�m <chvi3471@student.uu.se>
+%% Daniel Deogun <dade4543@student.uu.se>
+%% Jesper Bengtsson <jebe8371@student.uu.se>
+%% Created : 18 Mar 2002
+%%
+%% @doc
+%% Contains utilities for creating and manipulating dominator trees
+%% and dominance frontiers from a CFG.
+%% @end
+%%------------------------------------------------------------------------
+-module(hipe_dominators).
+
+-export([domTree_create/1,
+ domTree_getChildren/2,
+ domTree_dominates/3,
+ domFrontier_create/2,
+ domFrontier_get/2]).
+
+-include("cfg.hrl").
+
+%%========================================================================
+%%
+%% CODE FOR CREATING AND MANIPULATING DOMINATOR TREES.
+%%
+%%========================================================================
+
+-record(workDataCell, {dfnum = 0 :: non_neg_integer(),
+ dfparent = none :: 'none' | cfg_lbl(),
+ semi = none :: 'none' | cfg_lbl(),
+ ancestor = none :: 'none' | cfg_lbl(),
+ best = none :: 'none' | cfg_lbl(),
+ samedom = none :: 'none' | cfg_lbl(),
+ bucket = [] :: [cfg_lbl()]}).
+
+-record(domTree, {root :: cfg_lbl(),
+ size = 0 :: non_neg_integer(),
+ nodes = gb_trees:empty() :: gb_tree()}).
+-type domTree() :: #domTree{}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_create/1
+%% Purpose : Creates a complete dominator tree given a CFG.
+%% Arguments : CFG - a Control Flow Graph representation
+%% Returns : A dominator tree
+%%>----------------------------------------------------------------------<
+
+-spec domTree_create(cfg()) -> domTree().
+
+domTree_create(CFG) ->
+ {WorkData, DFS, N} = dfs(CFG),
+ DomTree = domTree_empty(hipe_gen_cfg:start_label(CFG)),
+ {DomData, WorkData2} = getIdoms(CFG, DomTree, WorkData, N, DFS),
+ finalize(WorkData2, DomData, 1, N, DFS).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_empty/0
+%% Purpose : Creates an empty dominator tree.
+%% Arguments : The root node
+%% Returns : A dominator tree
+%%>----------------------------------------------------------------------<
+
+domTree_empty(Node) ->
+ #domTree{root = Node}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_createNode/2
+%% Purpose : Creates a new node and inserts it into the dominator tree.
+%% Arguments : Node - The new node
+%% DomTree - The target dominator tree
+%% Returns : A dominator tree
+%%>----------------------------------------------------------------------<
+
+domTree_createNode(Node, DomTree) ->
+ DomTree2 = domTree_setNodes(DomTree,
+ gb_trees:enter(Node, {none,[]},
+ domTree_getNodes(DomTree))),
+ domTree_incSize(DomTree2).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_getNode/2
+%% Purpose : Returns a specific node in the dominator tree.
+%% Arguments : Node - The new node
+%% DomTree - The target dominator tree
+%% Returns : Node
+%%>----------------------------------------------------------------------<
+
+domTree_getNode(Node, DomTree) ->
+ gb_trees:lookup(Node, domTree_getNodes(DomTree)).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_getNodes/1
+%% Purpose : Retrieves the nodes from a dominator tree.
+%% Arguments : DomTree - The target dominator tree
+%% Returns : A map containing the nodes of the dominator tree.
+%%>----------------------------------------------------------------------<
+
+domTree_getNodes(#domTree{nodes=Nodes}) -> Nodes.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_setNodes/2
+%% Purpose : Replaces the set of nodes in a dominator tree with a
+%% new set of nodes.
+%% Arguments : Nodes - The new set of nodes
+%% DomTree - The target dominator tree
+%% Returns : DomTree
+%%>----------------------------------------------------------------------<
+
+domTree_setNodes(DomTree, Nodes) -> DomTree#domTree{nodes = Nodes}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_setSize/2
+%% Purpose : Sets the size of the dominator tree, i.e. the number of
+%% nodes in it.
+%% Arguments : Size - The new size of the target dominator tree
+%% DomTree - The target dominator tree
+%% Returns : A dominator tree
+%%>----------------------------------------------------------------------<
+
+domTree_setSize(DomTree, Size) -> DomTree#domTree{size = Size}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_incSize/1
+%% Purpose : Increases the size of the dominator tree with one.
+%% Arguments : DomTree - The target dominator tree
+%% Returns : DomTree
+%%>----------------------------------------------------------------------<
+
+domTree_incSize(DomTree) ->
+ Size = domTree_getSize(DomTree),
+ domTree_setSize(DomTree, Size + 1).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : get IDom/2
+%% Purpose : Retrieves the immediate dominators of a node in the
+%% dominator tree.
+%% Arguments : Node - The new node
+%% DomTree - The target dominator tree
+%% Returns : The immediate dominator
+%%>----------------------------------------------------------------------<
+
+domTree_getIDom(Node, DomTree) ->
+ case domTree_getNode(Node, DomTree) of
+ {value, {IDom, _}} ->
+ IDom;
+ none ->
+ []
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : getChildren/2
+%% Purpose : Retrieves the children of a node in the dominator tree.
+%% Arguments : Node - The new node
+%% DomTree - The target dominator tree
+%% Returns : [children]
+%%>----------------------------------------------------------------------<
+
+-spec domTree_getChildren(cfg_lbl(), domTree()) -> [cfg_lbl()].
+
+domTree_getChildren(Node, DomTree) ->
+ case domTree_getNode(Node, DomTree) of
+ {value, {_, Children}} ->
+ Children;
+ none ->
+ []
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_getSize/1
+%% Purpose : Retrieves the size of a dominator tree.
+%% Arguments : DomTree - The target dominator tree
+%% Returns : A number denoting the size of the dominator tree
+%%>----------------------------------------------------------------------<
+
+domTree_getSize(#domTree{size=Size}) -> Size.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_getRoot/2
+%% Purpose : Retrieves the number of the root node in the dominator tree.
+%% Arguments : DomTree - The target dominator tree
+%% Returns : Number
+%%>----------------------------------------------------------------------<
+
+domTree_getRoot(#domTree{root=Root}) -> Root.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_addChild/3
+%% Purpose : Inserts a new node as a child to another node in the
+%% dominator tree.
+%% Arguments : Node - The old node that should get a new child
+%% Child - The new child node
+%% DomTree - The target dominator tree
+%% Returns : DomTree
+%%>----------------------------------------------------------------------<
+
+domTree_addChild(Node, Child, DomTree) ->
+ {IDom, Children} = case domTree_getNode(Node, DomTree) of
+ {value, Tuple} ->
+ Tuple;
+ none ->
+ {none, []}
+ end,
+ Nodes = case lists:member(Child, Children) of
+ true ->
+ domTree_getNodes(DomTree);
+ false ->
+ gb_trees:enter(Node, {IDom, [Child|Children]},
+ domTree_getNodes(DomTree))
+ end,
+ domTree_setNodes(DomTree, Nodes).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : setIDom/3
+%% Purpose : Sets the immediate domminator of a node in the domminator tree.
+%% Arguments : Node - The node whose immediate domminator we are seting
+%% IDom - The immediate domminator
+%% DomTree - The target dominator tree
+%% Returns : DomTree
+%% Notes : Is used to build the dominator tree.
+%%>----------------------------------------------------------------------<
+
+setIDom(Node, IDom, DomTree) ->
+ DomTree1 = case domTree_getNode(Node, DomTree) of
+ none ->
+ domTree_createNode(Node, DomTree);
+ _ ->
+ DomTree
+ end,
+ DomTree2 = domTree_addChild(IDom, Node, DomTree1),
+ {value, {_, Children}} = domTree_getNode(Node, DomTree2),
+ domTree_setNodes(DomTree2,
+ gb_trees:enter(Node, {IDom, Children},
+ domTree_getNodes(DomTree2))).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : lookup
+%% Purpose : This function is used as a wrapper for the lookup function.
+%% The function retrieves a particular element (defined by
+%% Field) stored in a workDataCell in the table (defined by
+%% Table).
+%% Arguments : Field - Value defined in the workDataCell record
+%% Key - Value used as a key in the table
+%% Table - Table storing workDataCells
+%% Returns : A value defined in the workDataCell record
+%%>----------------------------------------------------------------------<
+
+lookup({Field, Key}, Table) when is_integer(Key) ->
+ WD = lookup_table(Key, Table),
+ case Field of
+ ancestor -> WD#workDataCell.ancestor;
+ best -> WD#workDataCell.best;
+ bucket -> WD#workDataCell.bucket;
+ dfnum -> WD#workDataCell.dfnum;
+ dfparent -> WD#workDataCell.dfparent;
+ samedom -> WD#workDataCell.samedom;
+ semi -> WD#workDataCell.semi
+ end.
+
+lookup_table(Key, Table) when is_integer(Key) ->
+ case gb_trees:lookup(Key, Table) of
+ {value, Data} ->
+ Data;
+ none ->
+ #workDataCell{}
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : update
+%% Purpose : This function is used as a wrapper for the update function
+%% The main purpose of the update function is therefore
+%% change a particular cell in the table (Table) to the
+%% value given as an argument (Value).
+%% Arguments : Key - Value used as a key in the table
+%% Field - Value defined in the workDataCell record.
+%% Value - The new value that should replace the old in the table
+%% Table - Table storing workDataCells
+%% Returns : NewTable
+%%>----------------------------------------------------------------------<
+
+update(Key, {Field, Value}, Table) ->
+ gb_trees:enter(Key, updateCell(Value, Field, lookup_table(Key, Table)), Table);
+update(Key, List, Table) ->
+ gb_trees:enter(Key, update(List, lookup_table(Key, Table)), Table).
+
+update([{Field, Value} | T], WD) ->
+ update(T, updateCell(Value, Field, WD));
+update([], WD) -> WD.
+
+updateCell(Value, Field, WD) ->
+ case Field of
+ dfnum -> WD#workDataCell{dfnum = Value};
+ dfparent -> WD#workDataCell{dfparent= Value};
+ semi -> WD#workDataCell{semi = Value};
+ ancestor -> WD#workDataCell{ancestor= Value};
+ best -> WD#workDataCell{best = Value};
+ samedom -> WD#workDataCell{samedom = Value};
+ bucket -> WD#workDataCell{bucket = Value}
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : dfs/1
+%% Purpose : The main purpose of this function is to traverse the CFG in
+%% a depth first order. It is aslo used to initialize certain
+%% elements defined in a workDataCell.
+%% Arguments : CFG - a Control Flow Graph representation
+%% Returns : A table (WorkData) and the total number of elements in
+%% the CFG.
+%%>----------------------------------------------------------------------<
+
+dfs(CFG) ->
+ {WorkData, DFS, N} = dfs(CFG, hipe_gen_cfg:start_label(CFG),
+ none, 1, gb_trees:empty(), gb_trees:empty()),
+ {WorkData, DFS, N-1}.
+
+dfs(CFG, Node, Parent, N, WorkData, DFS) ->
+ case lookup({dfnum, Node}, WorkData) of
+ 0 ->
+ WorkData2 = update(Node, [{dfnum, N}, {dfparent, Parent},
+ {semi, Node}, {best, Node}], WorkData),
+ DFS2 = gb_trees:enter(N, Node, DFS),
+ dfsTraverse(hipe_gen_cfg:succ(CFG, Node), CFG, Node,
+ N + 1, WorkData2, DFS2);
+ _ -> {WorkData, DFS, N}
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : dfsTraverse/6
+%% Purpose : This function acts as a help function for the dfs algorithm
+%% in the sence that it traverses a list of nodes given by the
+%% CFG.
+%% Arguments : Node - The first element in the node list
+%% SuccLst - The remainder of the node list
+%% CFG - Control Flow Graph representation
+%% Parent - Node representing the parent of the Node defined
+%% above.
+%% N - The total number of processed nodes.
+%% WorkData - Table consisting of workDataCells
+%% Returns : An updated version of the table (WorkData) and the
+%% total number of nodes processed.
+%%>----------------------------------------------------------------------<
+
+dfsTraverse([Node|T], CFG, Parent, N, WorkData, DFS) ->
+ {WorkData2, DFS2, N2} = dfs(CFG, Node, Parent, N, WorkData, DFS),
+ dfsTraverse(T, CFG, Parent, N2, WorkData2, DFS2);
+dfsTraverse([], _, _, N, WorkData, DFS) -> {WorkData, DFS, N}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : getIdoms/6
+%% Purpose : The purpose of this function is to compute the immediate
+%% dominators. This is accomplished by traversing the CFG nodes
+%% by their depth first number in a bottom up manner. That is,
+%% the nodes are processed in a backward order (highest to
+%% lowest number).
+%% Arguments : CFG - Control Flow Graph representation
+%% DomData - Table consisting of domTree cells
+%% WorkData - Table consisting of workDataCells
+%% Index - The index used for retrieving the node to be
+%% processed
+%% Returns : An updated version of the tables DomData and WorkData
+%%>----------------------------------------------------------------------<
+
+getIdoms(CFG, DomData, WorkData, Index, DFS)
+ when is_integer(Index), Index > 1 ->
+ Node = lookup_table(Index, DFS),
+ PredLst = hipe_gen_cfg:pred(CFG, Node),
+ Par = lookup({dfparent, Node}, WorkData),
+ DfNumN = lookup({dfnum, Node}, WorkData),
+ {S, WorkData2} = getSemiDominator(PredLst, DfNumN, Par, WorkData),
+ WorkData3 = update(Node, {semi, S}, WorkData2),
+ OldBucket = lookup({bucket, S}, WorkData3),
+ WorkData4 = update(S, {bucket, [Node | OldBucket]}, WorkData3),
+ WorkData5 = linkTrees(Par, Node, WorkData4),
+ {WorkData6, DomData2} = filterBucket(lookup({bucket, Par}, WorkData5),
+ Par, WorkData5, DomData),
+ WorkData7 = update(Par, {bucket, []}, WorkData6),
+ getIdoms(CFG, DomData2, WorkData7, Index - 1, DFS);
+getIdoms(_, DomData, WorkData, 1, _) ->
+ {DomData, WorkData}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : getSemiDominator/4
+%% Purpose : The main purpose of this algorithm is to compute the semi
+%% dominator of the node Node based on the Semidominator Theorem
+%% Arguments : Preds - The list of predecessors of the node Node
+%% Node - Node in the CFG
+%% S - Parent of node Node (depth first parent)
+%% WorkData - Table consisting of workDataCells
+%% Returns : A tuple containing the semidominator and an updated version
+%% of the table WorkData.
+%%>----------------------------------------------------------------------<
+
+getSemiDominator([Pred|Preds], DfNumChild, S, WorkData) ->
+ {Sp, WorkData3} =
+ case lookup({dfnum, Pred}, WorkData) =< DfNumChild of
+ true ->
+ {Pred, WorkData};
+ false ->
+ {AncLowSemi, WorkData2} = getAncestorWithLowestSemi(Pred, WorkData),
+ {lookup({semi, AncLowSemi}, WorkData2), WorkData2}
+ end,
+ S2 = case lookup({dfnum, Sp}, WorkData3) < lookup({dfnum, S}, WorkData3) of
+ true -> Sp;
+ false -> S
+ end,
+ getSemiDominator(Preds, DfNumChild, S2, WorkData3);
+getSemiDominator([], _, S, WorkData) ->
+ {S, WorkData}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : getAncestorWithLowestSemi/2
+%% Purpose : The main purpose of this function is to retrieve the ancestor
+%% of a node with the lowest depth first number (semi). The
+%% function is also using path compression, i.e. it remembers the
+%% best node (the one with the lowest semi number) and hence the
+%% algorithm is only processing the minimal number of nodes.
+%% Arguments : Node - Node in the tree
+%% WorkData - Table consisting of workDataCells
+%% Returns : A node (the one with the lowest semi) and an updated version
+%% of the table WorkData.
+%%>----------------------------------------------------------------------<
+
+getAncestorWithLowestSemi(Node, WorkData) ->
+ Best = lookup({best, Node}, WorkData),
+ case lookup({ancestor, Node}, WorkData) of
+ none -> {Best, WorkData};
+ A ->
+ case lookup({ancestor, A}, WorkData) of
+ none ->
+ {Best, WorkData};
+ _ ->
+ {B, WorkData2} = getAncestorWithLowestSemi(A, WorkData),
+ AncA = lookup({ancestor, A}, WorkData2),
+ WorkData3 = update(Node, {ancestor, AncA}, WorkData2),
+ DfSemiB = lookup({dfnum, lookup({semi, B}, WorkData3)}, WorkData3),
+ BestN = lookup({best, Node}, WorkData3),
+ SemiB = lookup({semi, BestN}, WorkData3),
+ DfSemiBestN = lookup({dfnum, SemiB}, WorkData3),
+ case DfSemiB < DfSemiBestN of
+ true ->
+ {B, update(Node, {best, B}, WorkData3)};
+ false ->
+ {BestN, WorkData3}
+ end
+ end
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : linkTrees/3
+%% Purpose : The main purpose of this function is to combine two trees
+%% into one (accomplished by setting the ancestor for node
+%% Node to Parent). The algorithm is also updating the best field
+%% in the workDataCell for node Node to the value of itself.
+%% Arguments : Parent - The parent of the node Node.
+%% Node - The node to process
+%% WorkData - Table consisting of workDataCells
+%% Returns : An updated version of table WorkData
+%%>----------------------------------------------------------------------<
+
+linkTrees(Parent, Node, WorkData) ->
+ update(Node, [{ancestor, Parent}, {best, Node}], WorkData).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : filterBucket/4
+%% Purpose : The purpose of this algorith is to compute the dominator of
+%% the node Node by utilizing the first clause of the Dominator
+%% Theorem. If the first clause of the theorem doesn't apply
+%% then the computation of that particular node is deferred to
+%% a later stage (see finalize).
+%% Arguments : Nodes - The list of CFG nodes that need to be computed.
+%% Parent - The parent of the nodes in the list Nodes
+%% WorkData - Table consisting of workDataCells
+%% DomData - Table consisting of domTree cells.
+%% Returns : An updated version of the tables WorkData and DomData
+%%>----------------------------------------------------------------------<
+
+filterBucket([Node|Nodes], Parent, WorkData, DomData) ->
+ {Y, WorkData2} = getAncestorWithLowestSemi(Node, WorkData),
+ {WorkData3, DomData2} =
+ case lookup({semi, Y}, WorkData2) =:= lookup({semi, Node}, WorkData2) of
+ true -> {WorkData2, setIDom(Node, Parent, DomData)};
+ false -> {update(Node, {samedom, Y}, WorkData2), DomData}
+ end,
+ filterBucket(Nodes, Parent, WorkData3, DomData2);
+filterBucket([], _, WorkData, DomData) ->
+ {WorkData, DomData}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : finalize/5
+%% Purpose : This algorithm finishes up the second clause of the Dominator
+%% Theorem. Hence, the main purpose of this function is therefore
+%% to update the dominator tree with the nodes that were deferred
+%% in the filterBucket algorithm.
+%% Arguments : WorkData - Table consisting of workDataCells
+%% DomData - Table consisting of domTree cells
+%% N - The index used for retrieving the node to be
+%% processed
+%% Max - Maximum node index
+%% Returns : An updated version of the table DomData
+%%>----------------------------------------------------------------------<
+
+finalize(WorkData, DomData, N, Max, DFS) when N =< Max ->
+ Node = lookup_table(N, DFS),
+ case lookup({samedom, Node}, WorkData) of
+ none ->
+ finalize(WorkData, DomData, N + 1, Max, DFS);
+ SameDomN ->
+ case domTree_getIDom(SameDomN, DomData) of
+ IdomSameDomN when is_integer(IdomSameDomN) ->
+ DomData2 = setIDom(Node, IdomSameDomN, DomData),
+ finalize(WorkData, DomData2, N + 1, Max, DFS)
+ end
+ end;
+finalize(_, DomData, _, _, _) ->
+ DomData.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domTree_dominates/3
+%% Purpose : checks wheter Node1 dominates Node2 with respect to the
+%% dominator tree DomTree
+%% Arguments : Node1 the possible dominator, Node2 which might be dominated
+%% and DomTree - the target dominator tree.
+%% Notes : Relies on lists:any to return false when the a list is empty
+%%>----------------------------------------------------------------------<
+
+-spec domTree_dominates(cfg_lbl(), cfg_lbl(), domTree()) -> boolean().
+
+domTree_dominates(Node1, Node1, _DomTree) ->
+ true;
+domTree_dominates(Node1, Node2, DomTree) ->
+ Children = domTree_getChildren(Node1, DomTree),
+ lists:any(fun(X) -> domTree_dominates(X, Node2, DomTree) end, Children).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : pp/1
+%% Purpose : Pretty Printing a dominator tree.
+%% Arguments : DomTree - the target dominator tree.
+%% Notes : Uses pp/2 and pp_children to perform its task.
+%%>----------------------------------------------------------------------<
+
+-ifdef(DEBUG).
+
+domTree_pp(DomTree) ->
+ io:format("Domtree:\nRoot: ~w\nSize: ~w\n", [domTree_getRoot(DomTree),
+ domTree_getSize(DomTree)]),
+ domTree_pp(domTree_getRoot(DomTree), DomTree).
+
+domTree_pp(N, DomTree) ->
+ case domTree_getNode(N, DomTree) of
+ {value, {IDom, Children}} ->
+ io:format("Node: ~w\n\tIDom: ~w\n\tChildren: ~w\n\n",
+ [N, IDom, Children]),
+ domTree_pp_children(Children, DomTree);
+ none ->
+ failed
+ end.
+
+domTree_pp_children([Child|T], DomTree) ->
+ domTree_pp(Child, DomTree),
+ domTree_pp_children(T, DomTree);
+domTree_pp_children([], _) ->
+ ok.
+
+-endif. %% DEBUG
+
+%%========================================================================
+%%
+%% CODE FOR CREATING AND MANIPULATING DOMINANCE FRONTIERS.
+%%
+%%========================================================================
+
+-type domFrontier() :: gb_tree().
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domFrontier_create
+%% Purpose : This function calculates the Dominance Frontiers given
+%% a CFG and a Dominator Tree.
+%% Arguments : SuccMap - The successor map of the CFG we are working with.
+%% DomTree - The dominance tree of the CFG.
+%% Notes : DomTree must actually be the dominance tree of the CFG.
+%%>----------------------------------------------------------------------<
+
+-spec domFrontier_create(cfg(), domTree()) -> domFrontier().
+
+domFrontier_create(SuccMap, DomTree) ->
+ df_create(domTree_getRoot(DomTree), SuccMap, DomTree, df__empty()).
+
+df_create(Node, SuccMap, DomTree, DF) ->
+ Children = domTree_getChildren(Node, DomTree),
+ Succ = hipe_gen_cfg:succ(SuccMap, Node),
+ DF1 = checkIDomList(Succ, Node, DomTree, DF),
+ makeDFChildren(Children, Node, SuccMap, DomTree, DF1).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : domFrontier_get
+%% Purpose : This function returns the Dominance Frontier for Node.
+%% Arguments : Node - The node whose Dominance Frontier we request
+%% DF - The Dominance Frontier structure
+%% Returns :
+%%>----------------------------------------------------------------------<
+
+-spec domFrontier_get(cfg_lbl(), domFrontier()) -> [cfg_lbl()].
+
+domFrontier_get(Node, DF) ->
+ case gb_trees:lookup(Node, DF) of
+ {value, List} -> List;
+ none -> []
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : df__empty
+%% Purpose : This function creates an empty instance of the Dominance
+%% Frontiers (DF) structure.
+%%>----------------------------------------------------------------------<
+
+df__empty() ->
+ gb_trees:empty().
+
+%%>----------------------------------------------------------------------<
+%% Procedure : df__add
+%% Purpose : This function adds Node to N in DF.
+%% Arguments : N - The value being inserted
+%% Node - The node getting the value
+%% DF - The Dominance Frontiers
+%% Returns : DF
+%% Notes : If Node already exists at position N, it is not added again.
+%%>----------------------------------------------------------------------<
+
+df__add_to_node(N, Node, DF) ->
+ case gb_trees:lookup(N, DF) of
+ {value, DFList} ->
+ case lists:member(Node, DFList) of
+ true ->
+ DF;
+ false ->
+ gb_trees:update(N, [Node|DFList], DF)
+ end;
+ none ->
+ gb_trees:insert(N, [Node], DF)
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : makeDFChildren
+%% Purpose : This function calculates the dominance frontiers of the
+%% children of the parent and adds the nodes in these
+%% dominance frontiers who are not immediate dominantors of
+%% the parent to parents dominance frontier.
+%% Arguments : ChildList - The list of children that the function traverses
+%% Parent - The parent of the children
+%% SuccMap - The successor map of the CFG
+%% DomTree - The dominantor tree of the CFG
+%% DF - The dominance frontiers so far
+%%>----------------------------------------------------------------------<
+
+makeDFChildren([Child|T], Parent, SuccMap, DomTree, DF) ->
+ DF1 = df_create(Child, SuccMap, DomTree, DF),
+ DF2 = checkIDomList(domFrontier_get(Child, DF1), Parent, DomTree, DF1),
+ makeDFChildren(T, Parent, SuccMap, DomTree, DF2);
+makeDFChildren([], _, _, _, DF) ->
+ DF.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : checIDomList
+%% Purpose : Adds all the nodes in the list to the parents dominance
+%% frontier who do not have parent as immediate dominator.
+%% Arguments : NodeList - The list of nodes that the function traverses
+%% Parent - The parent of the nodes
+%% DomTree - Our dominator tree
+%% DF - The dominance frontiers so far
+%%>----------------------------------------------------------------------<
+
+checkIDomList([Node|T], Parent, DomTree, DF) ->
+ DF1 = checkIDom(Node, Parent, DomTree, DF),
+ checkIDomList(T, Parent, DomTree, DF1);
+checkIDomList([], _, _, DF) ->
+ DF.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : checkIdom
+%% Purpose : Adds Node1 to Node2's dominance frontier if Node2 is not
+%% Node1's immediate dominator.
+%% Arguments : Node1 - a node
+%% Node2 - another node
+%% DomTree - the dominator tree
+%% DF - the dominance frontier so far
+%%>----------------------------------------------------------------------<
+
+checkIDom(Node1, Node2, DomTree, DF) ->
+ case domTree_getIDom(Node1, DomTree) of
+ Node2 ->
+ DF;
+ none ->
+ DF;
+ _ ->
+ df__add_to_node(Node2, Node1, DF)
+ end.
diff --git a/lib/hipe/flow/hipe_gen_cfg.erl b/lib/hipe/flow/hipe_gen_cfg.erl
new file mode 100644
index 0000000000..f9fb1f70c8
--- /dev/null
+++ b/lib/hipe/flow/hipe_gen_cfg.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_gen_cfg).
+
+-export([start_label/1,
+ succ/2,
+ pred/2
+ ]).
+
+%%-define(DO_ASSERT, true).
+-define(GEN_CFG, true). % needed for cfg.inc
+
+-include("../main/hipe.hrl").
+-include("cfg.hrl").
+
+-spec succ(cfg(), cfg_lbl()) -> [cfg_lbl()].
+-spec pred(cfg(), cfg_lbl()) -> [cfg_lbl()].
+
+-include("cfg.inc").
+
diff --git a/lib/hipe/flow/liveness.inc b/lib/hipe/flow/liveness.inc
new file mode 100644
index 0000000000..9c5eaf3e68
--- /dev/null
+++ b/lib/hipe/flow/liveness.inc
@@ -0,0 +1,332 @@
+%% -*- Erlang -*-
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% LIVENESS ANALYSIS
+%%
+%% Exports:
+%% ~~~~~~~
+%% analyze(CFG) - returns a liveness analysis of CFG.
+%% liveout(Liveness, Label) - returns a set of variables that are live at
+%% exit from basic block named Label.
+%% livein(Liveness, Label) - returns a set of variables that are live at
+%% entry to the basic block named Label.
+%% livein_from_liveout(Instructions, LiveOut) - Given a list of instructions
+%% and a liveout-set, returns a set of variables live at the
+%% first instruction.
+%%
+
+-export([analyze/1,
+ livein/2]).
+-ifdef(LIVEOUT_NEEDED).
+-export([liveout/2]).
+-endif.
+-ifdef(PRETTY_PRINT).
+-export([pp/1]).
+-endif.
+%%-export([livein_from_liveout/2]).
+-ifdef(DEBUG_LIVENESS).
+-export([annotate_liveness/2]).
+-endif.
+
+-include("../flow/cfg.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface functions that MUST be implemented in the including file
+%%
+%% cfg_bb(CFG, L) -> BasicBlock, extract a basic block from a cfg.
+%% cfg_postorder(CFG) -> [Labels], the labels of the cfg in postorder
+%% cfg_succ(CFG, L) -> [Labels],
+%% uses(Instr) ->
+%% defines(Instr) ->
+%%
+%% Plus the following, if basic block annotations are needed
+%%
+%% cfg_labels(CFG) ->
+%% cfg_bb_add(CFG, L, NewBB) ->
+%% mk_comment(Text) ->
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The generic liveness analysis
+%%
+
+-spec analyze(cfg()) -> gb_tree().
+
+-ifdef(HIPE_LIVENESS_CALC_LARGEST_LIVESET).
+analyze(CFG) ->
+ PO = cfg_postorder(CFG),
+ InitLiveness = liveness_init(init(cfg_labels(CFG), CFG)),
+ _Max = case get(hipe_largest_liveset) of
+ undefined ->
+ put(hipe_largest_liveset, 0),
+ 0;
+ LL -> LL
+ end,
+ Res = merry_go_around(PO, InitLiveness,0),
+ case get(hipe_largest_liveset) > _Max of
+ true ->
+ io:format("Largest liveset: ~w \n", [get(hipe_largest_liveset)]);
+ _ -> ok
+ end,
+ Res.
+
+-else.
+
+analyze(CFG) ->
+ PO = cfg_postorder(CFG),
+ InitLiveness = liveness_init(init(PO, CFG)),
+ Res = merry_go_around(PO, InitLiveness, 0),
+ Res.
+-endif.
+
+%%
+%% The fixpoint iteration
+%%
+
+merry_go_around(Labels, Liveness, Count) ->
+ case doit_once(Labels, Liveness, 0) of
+ {NewLiveness, 0} ->
+ %% io:format("Iterations ~w~n", [Count]),
+ NewLiveness;
+ {NewLiveness, _Changed} ->
+ merry_go_around(Labels, NewLiveness, Count+1)
+ end.
+
+%%
+%% One iteration
+%%
+
+-ifdef(HIPE_LIVENESS_CALC_LARGEST_LIVESET).
+doit_once([], Liveness, Changed) ->
+ {Liveness, Changed};
+doit_once([L|Ls], Liveness, Changed) ->
+ LiveOut = liveout(Liveness, L),
+ Kill = ordsets:subtract(LiveOut, kill(L, Liveness)),
+ LiveIn = ordsets:union(Kill, gen(L,Liveness)),
+ {NewLiveness, ChangedP} = update_livein(L, LiveIn, Liveness),
+ Le = length(LiveIn),
+ Max = get(hipe_largest_liveset),
+ if Le > Max -> put(hipe_largest_liveset, Le);
+ true -> true
+ end,
+ doit_once(Ls, NewLiveness, Changed+ChangedP).
+
+-else.
+
+doit_once([], Liveness, Changed) ->
+ {Liveness, Changed};
+doit_once([L|Ls], Liveness, Changed) ->
+ LiveOut = liveout(Liveness, L),
+ Kill = ordsets:subtract(LiveOut, kill(L, Liveness)),
+ LiveIn = ordsets:union(Kill, gen(L,Liveness)),
+ {NewLiveness, ChangedP} = update_livein(L, LiveIn, Liveness),
+ doit_once(Ls, NewLiveness, Changed+ChangedP).
+-endif.
+
+%% %%
+%% %% Given a list of instructions and liveout, calculates livein
+%% %%
+%% livein_from_liveout(List, LiveOut) when is_list(List) ->
+%% livein_from_liveout_1(lists:reverse(List), gb_sets:from_list(LiveOut));
+%% livein_from_liveout(Instr, LiveOut) ->
+%% livein_from_liveout_1([Instr], gb_sets:from_list(LiveOut)).
+%%
+%% livein_from_liveout_1([], LiveOut) ->
+%% gb_sets:to_list(LiveOut);
+%% livein_from_liveout_1([I|Is], LiveOut) ->
+%% Def = defines(I),
+%% Use = uses(I),
+%% DefSet = gb_sets:from_list(Def),
+%% UseSet = gb_sets:from_list(Use),
+%% LiveIn = gb_sets:union(gb_sets:difference(LiveOut, DefSet), UseSet),
+%% Le = gb_sets:size(LiveIn),
+%% Max = get(hipe_largest_liveset),
+%% if Le > Max -> put(hipe_largest_liveset, Le);
+%% true -> true
+%% end,
+%% livein_from_liveout_1(Is, LiveIn).
+
+%%
+%% updates liveness for a basic block
+%% - returns: {NewLiveness, ChangedP}
+%% - ChangedP is 0 if the new LiveIn is equal to the old one
+%% otherwise it's 1.
+%%
+
+update_livein(Label, NewLiveIn, Liveness) ->
+ {GK, LiveIn, Successors} = liveness_lookup(Label, Liveness),
+ NewLiveness = liveness_update(Label, {GK, NewLiveIn, Successors}, Liveness),
+ if LiveIn =:= NewLiveIn ->
+ {NewLiveness, 0};
+ true ->
+ {NewLiveness, 1}
+ end.
+
+
+%%
+%% LiveOut for a block is the union of the successors LiveIn
+%%
+
+liveout(Liveness, L) ->
+ Succ = successors(L, Liveness),
+ case Succ of
+ [] -> % special case if no successors
+ liveout_no_succ();
+ _ ->
+ liveout1(Succ, Liveness)
+ end.
+
+liveout1(Labels, Liveness) ->
+ liveout1(Labels, Liveness, ordsets:new()).
+
+liveout1([], _Liveness, Live) ->
+ Live;
+liveout1([L|Ls], Liveness,Live) ->
+ liveout1(Ls, Liveness, ordsets:union(livein(Liveness, L), Live)).
+
+successors(L, Liveness) ->
+ {_GK, _LiveIn, Successors} = liveness_lookup(L, Liveness),
+ Successors.
+
+-spec livein(gb_tree(), _) -> [_].
+
+livein(Liveness, L) ->
+ {_GK, LiveIn, _Successors} = liveness_lookup(L, Liveness),
+ LiveIn.
+
+kill(L, Liveness) ->
+ {{_Gen, Kill}, _LiveIn, _Successors} = liveness_lookup(L, Liveness),
+ Kill.
+
+gen(L, Liveness) ->
+ {{Gen, _Kill}, _LiveIn, _Successors} = liveness_lookup(L, Liveness),
+ Gen.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% init returns a list of: {Label, {{Gen, Kill}, LiveIn, Successors}}
+%% - Label is the name of the basic block.
+%% - Gen is the set of varables that are used by this block.
+%% - Kill is the set of varables that are defined by this block.
+%% - LiveIn is the set of variables that are alive at entry to the
+%% block (initially empty).
+%% - Successors is a list of the successors to the block.
+
+init([], _) ->
+ [];
+init([L|Ls], CFG) ->
+ BB = cfg_bb(CFG, L),
+ Code = hipe_bb:code(BB),
+ Succ = cfg_succ(CFG, L),
+ Transfer = make_bb_transfer(Code, Succ),
+ [{L, {Transfer, ordsets:new(), Succ}} | init(Ls, CFG)].
+
+
+make_bb_transfer([], _Succ) ->
+ {ordsets:new(), ordsets:new()}; % {Gen, Kill}
+make_bb_transfer([I|Is], Succ) ->
+ {Gen, Kill} = make_bb_transfer(Is, Succ),
+ InstrGen = ordsets:from_list(uses(I)),
+ InstrKill = ordsets:from_list(defines(I)),
+ Gen1 = ordsets:subtract(Gen, InstrKill),
+ Gen2 = ordsets:union(Gen1, InstrGen),
+ Kill1 = ordsets:union(Kill, InstrKill),
+ Kill2 = ordsets:subtract(Kill1, InstrGen),
+ {Gen2, Kill2}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Annotate each basic block with liveness info
+%%
+
+-ifdef(DEBUG_LIVENESS).
+
+annotate_liveness(CFG, Liveness) ->
+ Labels = cfg_labels(CFG),
+ annotate_liveness_bb(Labels, CFG, Liveness).
+
+annotate_liveness_bb([], CFG, _Liveness) ->
+ CFG;
+annotate_liveness_bb([L|Ls], CFG, Liveness) ->
+ BB = cfg_bb(CFG, L),
+ Code0 = hipe_bb:code(BB),
+ LiveIn = strip(livein(Liveness, L)),
+ LiveOut = strip(liveout(Liveness, L)),
+ Code = [mk_comment({live_in, LiveIn}),
+ mk_comment({live_out, LiveOut})
+ | Code0],
+ NewBB = hipe_bb:code_update(BB, Code),
+ NewCFG = cfg_bb_add(CFG, L, NewBB),
+ annotate_liveness_bb(Ls, NewCFG, Liveness).
+
+strip([]) ->
+ [];
+strip([{_,Y}|Xs]) ->
+ [Y|strip(Xs)].
+
+-endif. % DEBUG_LIVENESS
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+liveness_init(List) ->
+ liveness_init(List, gb_trees:empty()).
+
+liveness_init([{Lbl, Data}|Left], Acc) ->
+ liveness_init(Left, gb_trees:insert(Lbl, Data, Acc));
+liveness_init([], Acc) ->
+ Acc.
+
+liveness_lookup(Label, Liveness) ->
+ gb_trees:get(Label, Liveness).
+liveness_update(Label, Val, Liveness) ->
+ gb_trees:update(Label, Val, Liveness).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% pp/1 pretty prints liveness information for a CFG
+%%
+
+-ifdef(PRETTY_PRINT).
+
+-spec pp(cfg()) -> 'ok'.
+pp(Cfg) ->
+ Liveness = analyze(Cfg),
+ Labels = cfg_labels(Cfg),
+ ok = print_blocks(Labels, Liveness, Cfg).
+
+print_blocks([Lbl|Rest], Liveness, Cfg) ->
+ io:format("~nLivein:", []),
+ pp_liveness_info(livein(Liveness, Lbl)),
+ io:format("Label ~w:~n" , [Lbl]),
+ pp_block(Lbl, Cfg),
+ io:format("Liveout:", []),
+ pp_liveness_info(liveout(Liveness, Lbl)),
+ print_blocks(Rest, Liveness, Cfg);
+print_blocks([], _Liveness, _Cfg) ->
+ ok.
+
+-endif. % PRETTY_PRINT
diff --git a/lib/hipe/icode/Makefile b/lib/hipe/icode/Makefile
new file mode 100644
index 0000000000..de37c4e4c4
--- /dev/null
+++ b/lib/hipe/icode/Makefile
@@ -0,0 +1,144 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+ifdef HIPE_ENABLED
+HIPE_MODULES = hipe_icode_heap_test
+else
+HIPE_MODULES =
+endif
+
+DOC_MODULES = hipe_beam_to_icode \
+ hipe_icode hipe_icode_bincomp \
+ hipe_icode_callgraph hipe_icode_cfg hipe_icode_coordinator \
+ hipe_icode_fp \
+ hipe_icode_exceptions \
+ hipe_icode_inline_bifs hipe_icode_instruction_counter \
+ hipe_icode_liveness \
+ hipe_icode_pp hipe_icode_primops \
+ hipe_icode_range \
+ hipe_icode_split_arith \
+ hipe_icode_ssa hipe_icode_ssa_const_prop \
+ hipe_icode_ssa_copy_prop hipe_icode_ssa_struct_reuse \
+ hipe_icode_type $(HIPE_MODULES)
+
+MODULES = $(DOC_MODULES) hipe_icode_ebb hipe_icode_mulret
+
+HRL_FILES=hipe_icode.hrl hipe_icode_primops.hrl hipe_icode_type.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(DOC_MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_unused_import +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/icode
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/icode
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+$(EBIN)/hipe_beam_to_icode.beam: hipe_icode_primops.hrl ../main/hipe.hrl ../../compiler/src/beam_disasm.hrl
+$(EBIN)/hipe_icode.beam: ../main/hipe.hrl
+$(EBIN)/hipe_icode_bincomp.beam: ../flow/cfg.hrl
+$(EBIN)/hipe_icode_callgraph.beam: hipe_icode_primops.hrl
+$(EBIN)/hipe_icode_cfg.beam: ../flow/hipe_bb.hrl ../flow/cfg.hrl ../flow/cfg.inc ../main/hipe.hrl
+$(EBIN)/hipe_icode_ebb.beam: ../flow/cfg.hrl ../flow/ebb.inc
+$(EBIN)/hipe_icode_exceptions.beam: ../flow/cfg.hrl
+$(EBIN)/hipe_icode_fp.beam: ../flow/cfg.hrl
+$(EBIN)/hipe_icode_heap_test.beam: ../main/hipe.hrl hipe_icode_primops.hrl ../flow/cfg.hrl ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_icode_inline_bifs.beam: ../flow/cfg.hrl
+$(EBIN)/hipe_icode_instruction_counter.beam: ../main/hipe.hrl ../flow/cfg.hrl
+$(EBIN)/hipe_icode_liveness.beam: ../flow/cfg.hrl ../flow/liveness.inc
+$(EBIN)/hipe_icode_mulret.beam: ../main/hipe.hrl hipe_icode_primops.hrl
+$(EBIN)/hipe_icode_primops.beam: hipe_icode_primops.hrl
+$(EBIN)/hipe_icode_range.beam: ../main/hipe.hrl ../flow/cfg.hrl hipe_icode_primops.hrl
+$(EBIN)/hipe_icode_split_arith.beam: ../main/hipe.hrl hipe_icode.hrl ../flow/cfg.hrl
+$(EBIN)/hipe_icode_ssa.beam: ../main/hipe.hrl ../ssa/hipe_ssa.inc ../ssa/hipe_ssa_liveness.inc
+$(EBIN)/hipe_icode_ssa_const_prop.beam: ../main/hipe.hrl hipe_icode_primops.hrl ../flow/cfg.hrl ../ssa/hipe_ssa_const_prop.inc
+$(EBIN)/hipe_icode_ssa_copy_prop.beam: ../flow/cfg.hrl ../ssa/hipe_ssa_copy_prop.inc
+$(EBIN)/hipe_icode_type.beam: hipe_icode_primops.hrl ../flow/cfg.hrl hipe_icode_type.hrl
+$(EBIN)/hipe_icode_ssa_struct_reuse.beam: ../main/hipe.hrl hipe_icode_primops.hrl ../flow/cfg.hrl
+
+$(TARGET_FILES): hipe_icode.hrl ../misc/hipe_consttab.hrl
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
new file mode 100644
index 0000000000..3923e98673
--- /dev/null
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -0,0 +1,2326 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%=======================================================================
+%% File : hipe_beam_to_icode.erl
+%% Author : Kostis Sagonas
+%% Description : Translates symbolic BEAM code to Icode
+%%=======================================================================
+%% $Id$
+%%=======================================================================
+%% @doc
+%% This file translates symbolic BEAM code to Icode which is HiPE's
+%% intermediate code representation. Either the code of an entire
+%% module, or the code of a specified function can be translated.
+%% @end
+%%=======================================================================
+
+-module(hipe_beam_to_icode).
+
+-export([module/2, mfa/3]).
+
+%%-----------------------------------------------------------------------
+
+%% Uncomment the following lines to turn on debugging for this module
+%% or comment them to it turn off. Debug-level 6 inserts a print in
+%% each compiled function.
+%%
+%%-ifndef(DEBUG).
+%%-define(DEBUG,6).
+%%-endif.
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+-include("../../compiler/src/beam_disasm.hrl").
+
+-define(no_debug_msg(Str,Xs),ok).
+%%-define(no_debug_msg(Str,Xs),msg(Str,Xs)).
+
+-define(mk_debugcode(MFA, Env, Code),
+ case MFA of
+ {io,_,_} ->
+ %% We do not want to loop infinitely if we are compiling
+ %% the module io.
+ {Code,Env};
+ {M,F,A} ->
+ MFAVar = mk_var(new),
+ StringVar = mk_var(new),
+ Ignore = mk_var(new),
+ MkMfa = hipe_icode:mk_move(MFAVar,hipe_icode:mk_const([MFA])),
+ MkString = hipe_icode:mk_move(StringVar,
+ hipe_icode:mk_const(
+ atom_to_list(M) ++ ":" ++ atom_to_list(F) ++"/"++ integer_to_list(A) ++
+ " Native enter fun ~w\n")),
+ Call =
+ hipe_icode:mk_call([Ignore],io,format,[StringVar,MFAVar],remote),
+ {[MkMfa,MkString,Call | Code], Env}
+ end).
+
+%%-----------------------------------------------------------------------
+%% Exported types
+%%-----------------------------------------------------------------------
+
+-type hipe_beam_to_icode_ret() :: [{mfa(),#icode{}}].
+
+
+%%-----------------------------------------------------------------------
+%% Internal data structures
+%%-----------------------------------------------------------------------
+
+-record(beam_const, {value :: simple_const()}). % defined in hipe_icode.hrl
+
+-record(closure_info, {mfa :: mfa(), arity :: arity(), fv_arity :: arity()}).
+
+-record(environment, {mfa :: mfa(), entry :: non_neg_integer()}).
+
+
+%%-----------------------------------------------------------------------
+%% @doc
+%% Translates the code of a whole module into Icode.
+%% Returns a tuple whose first argument is a list of {{M,F,A}, ICode}
+%% pairs, and its second argument is the list of HiPE compiler options.
+%% @end
+%%-----------------------------------------------------------------------
+
+-spec module([#function{}], comp_options()) -> hipe_beam_to_icode_ret().
+
+module(BeamFuns, Options) ->
+ BeamCode0 = [beam_disasm:function__code(F) || F <- BeamFuns],
+ {ModCode, ClosureInfo} = preprocess_code(BeamCode0),
+ pp_beam(ModCode, Options),
+ [trans_beam_function_chunk(FunCode, ClosureInfo) || FunCode <- ModCode].
+
+trans_beam_function_chunk(FunBeamCode, ClosureInfo) ->
+ {M,F,A} = MFA = find_mfa(FunBeamCode),
+ Icode = trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo),
+ {MFA,Icode}.
+
+%%-----------------------------------------------------------------------
+%% @doc
+%% Translates the BEAM code of a single function into Icode.
+%% Returns a tuple whose first argument is list of {{M,F,A}, ICode}
+%% pairs, where the first entry is that of the given MFA, and the
+%% following (in undefined order) are those of the funs that are
+%% defined in the function, and recursively, in the funs. The
+%% second argument of the tuple is the HiPE compiler options
+%% contained in the file.
+%% @end
+%%-----------------------------------------------------------------------
+
+-spec mfa(list(), mfa(), comp_options()) -> hipe_beam_to_icode_ret().
+
+mfa(BeamFuns, {M,F,A} = MFA, Options)
+ when is_atom(M), is_atom(F), is_integer(A) ->
+ BeamCode0 = [beam_disasm:function__code(Fn) || Fn <- BeamFuns],
+ {ModCode, ClosureInfo} = preprocess_code(BeamCode0),
+ mfa_loop([MFA], [], sets:new(), ModCode, ClosureInfo, Options).
+
+mfa_loop([{M,F,A} = MFA | MFAs], Acc, Seen, ModCode, ClosureInfo,
+ Options) when is_atom(M), is_atom(F), is_integer(A) ->
+ case sets:is_element(MFA, Seen) of
+ true ->
+ mfa_loop(MFAs, Acc, Seen, ModCode, ClosureInfo, Options);
+ false ->
+ {Icode, FunMFAs} = mfa_get(M, F, A, ModCode, ClosureInfo, Options),
+ mfa_loop(FunMFAs ++ MFAs, [{MFA, Icode} | Acc],
+ sets:add_element(MFA, Seen),
+ ModCode, ClosureInfo, Options)
+ end;
+mfa_loop([], Acc, _, _, _, _) ->
+ lists:reverse(Acc).
+
+mfa_get(M, F, A, ModCode, ClosureInfo, Options) ->
+ BeamCode = get_fun(ModCode, M,F,A),
+ pp_beam([BeamCode], Options), % cheat by using a list
+ Icode = trans_mfa_code(M,F,A, BeamCode, ClosureInfo),
+ FunMFAs = get_fun_mfas(BeamCode),
+ {Icode, FunMFAs}.
+
+get_fun_mfas([{patched_make_fun,{M,F,A} = MFA,_,_,_}|BeamCode])
+ when is_atom(M), is_atom(F), is_integer(A) ->
+ [MFA|get_fun_mfas(BeamCode)];
+get_fun_mfas([_|BeamCode]) ->
+ get_fun_mfas(BeamCode);
+get_fun_mfas([]) ->
+ [].
+
+%%-----------------------------------------------------------------------
+%% The main translation function.
+%%-----------------------------------------------------------------------
+
+trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo) ->
+ ?no_debug_msg("disassembling: {~p,~p,~p} ...", [M,F,A]),
+ hipe_gensym:init(icode),
+ %% Extract the function arguments
+ FunArgs = extract_fun_args(A),
+ %% Record the function arguments
+ FunLbl = mk_label(new),
+ Env1 = env__mk_env(M, F, A, hipe_icode:label_name(FunLbl)),
+ Code1 = lists:flatten(trans_fun(FunBeamCode,Env1)),
+ Code2 = fix_fallthroughs(fix_catches(Code1)),
+ MFA = {M,F,A},
+ %% Debug code
+ ?IF_DEBUG_LEVEL(5,
+ {Code3,_Env3} = ?mk_debugcode(MFA, Env2, Code2),
+ {Code3,_Env3} = {Code2,Env1}),
+ %% For stack optimization
+ Leafness = leafness(Code3),
+ IsLeaf = is_leaf_code(Leafness),
+ Code4 =
+ [FunLbl |
+ case needs_redtest(Leafness) of
+ false -> Code3;
+ true -> [mk_redtest()|Code3]
+ end],
+ IsClosure = get_closure_info(MFA, ClosureInfo) =/= not_a_closure,
+ Code5 = hipe_icode:mk_icode(MFA, FunArgs, IsClosure, IsLeaf,
+ remove_dead_code(Code4),
+ hipe_gensym:var_range(icode),
+ hipe_gensym:label_range(icode)),
+ Icode = %% If this function is the code for a closure ...
+ case get_closure_info(MFA, ClosureInfo) of
+ not_a_closure -> Code5;
+ CI -> %% ... then patch the code to
+ %% get the free_vars from the closure
+ patch_closure_entry(Code5, CI)
+ end,
+ ?no_debug_msg("ok~n", []),
+ Icode.
+
+mk_redtest() -> hipe_icode:mk_primop([], redtest, []).
+
+leafness(Is) -> % -> true, selfrec, or false
+ leafness(Is, true).
+
+leafness([], Leafness) ->
+ Leafness;
+leafness([I|Is], Leafness) ->
+ case I of
+ #icode_comment{} ->
+ %% BEAM self-tailcalls become gotos, but they leave
+ %% a trace behind in comments. Check those to ensure
+ %% that the computed leafness is correct. Needed to
+ %% prevent redtest elimination in those cases.
+ NewLeafness =
+ case hipe_icode:comment_text(I) of
+ 'tail_recursive' -> selfrec; % call_last to selfrec
+ 'self_tail_recursive' -> selfrec; % call_only to selfrec
+ _ -> Leafness
+ end,
+ leafness(Is, NewLeafness);
+ #icode_call{} ->
+ case hipe_icode:call_type(I) of
+ 'primop' ->
+ case hipe_icode:call_fun(I) of
+ call_fun -> false; % Calls closure
+ enter_fun -> false; % Calls closure
+ #apply_N{} -> false;
+ _ -> leafness(Is, Leafness) % Other primop calls are ok
+ end;
+ T when T =:= 'local' orelse T =:= 'remote' ->
+ {M,F,A} = hipe_icode:call_fun(I),
+ case erlang:is_builtin(M, F, A) of
+ true -> leafness(Is, Leafness);
+ false -> false
+ end
+ end;
+ #icode_enter{} ->
+ case hipe_icode:enter_type(I) of
+ 'primop' ->
+ case hipe_icode:enter_fun(I) of
+ enter_fun -> false;
+ #apply_N{} -> false;
+ _ ->
+ %% All primops should be ok except those excluded above,
+ %% except we don't actually tailcall them...
+ io:format("leafness: unexpected enter to primop ~w\n", [I]),
+ true
+ end;
+ T when T =:= 'local' orelse T =:= 'remote' ->
+ {M,F,A} = hipe_icode:enter_fun(I),
+ case erlang:is_builtin(M, F, A) of
+ true -> leafness(Is, Leafness);
+ _ -> false
+ end
+ end;
+ _ -> leafness(Is, Leafness)
+ end.
+
+%% XXX: this old stuff is passed around but essentially unused
+is_leaf_code(Leafness) ->
+ case Leafness of
+ true -> true;
+ selfrec -> true;
+ false -> false
+ end.
+
+needs_redtest(Leafness) ->
+ case Leafness of
+ true -> false;
+ selfrec -> true;
+ false -> true
+ end.
+
+%%-----------------------------------------------------------------------
+%% The main translation switch.
+%%-----------------------------------------------------------------------
+
+%%--- label & func_info combo ---
+trans_fun([{label,B},{label,_},
+ {func_info,M,F,A},{label,L}|Instructions], Env) ->
+ trans_fun([{label,B},{func_info,M,F,A},{label,L}|Instructions], Env);
+trans_fun([{label,B},
+ {func_info,{atom,_M},{atom,_F},_A},
+ {label,L}|Instructions], Env) ->
+ %% Emit code to handle function_clause errors. The BEAM test instructions
+ %% branch to this label if they fail during function clause selection.
+ %% Obviously, we must goto past this error point on normal entry.
+ Begin = mk_label(B),
+ V = mk_var(new),
+ EntryPt = mk_label(L),
+ Goto = hipe_icode:mk_goto(hipe_icode:label_name(EntryPt)),
+ Mov = hipe_icode:mk_move(V, hipe_icode:mk_const(function_clause)),
+ Fail = hipe_icode:mk_fail([V],error),
+ [Goto, Begin, Mov, Fail, EntryPt | trans_fun(Instructions, Env)];
+%%--- label ---
+trans_fun([{label,L1},{label,L2}|Instructions], Env) ->
+ %% Old BEAM code can have two consecutive labels.
+ Lab1 = mk_label(L1),
+ Lab2 = mk_label(L2),
+ Goto = hipe_icode:mk_goto(map_label(L2)),
+ [Lab1, Goto, Lab2 | trans_fun(Instructions, Env)];
+trans_fun([{label,L}|Instructions], Env) ->
+ [mk_label(L) | trans_fun(Instructions, Env)];
+%%--- int_code_end --- SHOULD NEVER OCCUR HERE
+%%--- call ---
+trans_fun([{call,_N,{_M,_F,A}=MFA}|Instructions], Env) ->
+ Args = extract_fun_args(A),
+ Dst = [mk_var({r,0})],
+ I = trans_call(MFA, Dst, Args, local),
+ [I | trans_fun(Instructions, Env)];
+%%--- call_last ---
+%% Differs from call_only in that it deallocates the environment
+trans_fun([{call_last,_N,{_M,_F,A}=MFA,_}|Instructions], Env) ->
+ %% IS IT OK TO IGNORE LAST ARG ??
+ ?no_debug_msg(" translating call_last: ~p ...~n", [Env]),
+ case env__get_mfa(Env) of
+ MFA ->
+ %% Does this case really happen, or is it covered by call_only?
+ Entry = env__get_entry(Env),
+ [hipe_icode:mk_comment('tail_recursive'), % needed by leafness/2
+ hipe_icode:mk_goto(Entry) | trans_fun(Instructions,Env)];
+ _ ->
+ Args = extract_fun_args(A),
+ I = trans_enter(MFA, Args, local),
+ [I | trans_fun(Instructions, Env)]
+ end;
+%%--- call_only ---
+%% Used when the body contains only one call in which case
+%% an environment is not needed/created.
+trans_fun([{call_only,_N,{_M,_F,A}=MFA}|Instructions], Env) ->
+ ?no_debug_msg(" translating call_only: ~p ...~n", [Env]),
+ case env__get_mfa(Env) of
+ MFA ->
+ Entry = env__get_entry(Env),
+ [hipe_icode:mk_comment('self_tail_recursive'), % needed by leafness/2
+ hipe_icode:mk_goto(Entry) | trans_fun(Instructions,Env)];
+ _ ->
+ Args = extract_fun_args(A),
+ I = trans_enter(MFA,Args,local),
+ [I | trans_fun(Instructions,Env)]
+ end;
+%%--- call_ext ---
+trans_fun([{call_ext,_N,{extfunc,M,F,A}}|Instructions], Env) ->
+ Args = extract_fun_args(A),
+ Dst = [mk_var({r,0})],
+ I = trans_call({M,F,A},Dst,Args,remote),
+ [hipe_icode:mk_comment('call_ext'),I | trans_fun(Instructions,Env)];
+%%--- call_ext_last ---
+trans_fun([{call_ext_last,_N,{extfunc,M,F,A},_}|Instructions], Env) ->
+ %% IS IT OK TO IGNORE LAST ARG ??
+ Args = extract_fun_args(A),
+ %% Dst = [mk_var({r,0})],
+ I = trans_enter({M,F,A},Args,remote),
+ [hipe_icode:mk_comment('call_ext_last'), I | trans_fun(Instructions,Env)];
+%%--- bif0 ---
+trans_fun([{bif,BifName,nofail,[],Reg}|Instructions], Env) ->
+ BifInst = trans_bif0(BifName,Reg),
+ [hipe_icode:mk_comment({bif0,BifName}),BifInst|trans_fun(Instructions,Env)];
+%%--- bif1 ---
+trans_fun([{bif,BifName,{f,Lbl},[_] = Args,Reg}|Instructions], Env) ->
+ {BifInsts,Env1} = trans_bif(1,BifName,Lbl,Args,Reg,Env),
+ [hipe_icode:mk_comment({bif1,BifName})|BifInsts] ++ trans_fun(Instructions,Env1);
+%%--- bif2 ---
+trans_fun([{bif,BifName,{f,Lbl},[_,_] = Args,Reg}|Instructions], Env) ->
+ {BifInsts,Env1} = trans_bif(2,BifName,Lbl,Args,Reg,Env),
+ [hipe_icode:mk_comment({bif2,BifName})|BifInsts] ++ trans_fun(Instructions,Env1);
+%%--- allocate
+trans_fun([{allocate,StackSlots,_}|Instructions], Env) ->
+ trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
+%%--- allocate_heap
+trans_fun([{allocate_heap,StackSlots,_,_}|Instructions], Env) ->
+ trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
+%%--- allocate_zero
+trans_fun([{allocate_zero,StackSlots,_}|Instructions], Env) ->
+ trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
+%%--- allocate_heap_zero
+trans_fun([{allocate_heap_zero,StackSlots,_,_}|Instructions], Env) ->
+ trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
+%%--- test_heap --- IGNORED ON PURPOSE
+trans_fun([{test_heap,_,_}|Instructions], Env) ->
+ trans_fun(Instructions,Env);
+%%--- init --- IGNORED - CORRECT??
+trans_fun([{init,_}|Instructions], Env) ->
+ trans_fun(Instructions,Env);
+%%--- deallocate --- IGNORED ON PURPOSE
+trans_fun([{deallocate,_}|Instructions], Env) ->
+ trans_fun(Instructions,Env);
+%%--- return ---
+trans_fun([return|Instructions], Env) ->
+ [hipe_icode:mk_return([mk_var({r,0})]) | trans_fun(Instructions,Env)];
+%%--- send ---
+trans_fun([send|Instructions], Env) ->
+ I = hipe_icode:mk_call([mk_var({r,0})], erlang, send,
+ [mk_var({x,0}),mk_var({x,1})], remote),
+ [I | trans_fun(Instructions,Env)];
+%%--- remove_message ---
+trans_fun([remove_message|Instructions], Env) ->
+ [hipe_icode:mk_primop([],select_msg,[]) | trans_fun(Instructions,Env)];
+%%--- timeout ---
+trans_fun([timeout|Instructions], Env) ->
+ [hipe_icode:mk_primop([],clear_timeout,[]) | trans_fun(Instructions,Env)];
+%%--- loop_rec ---
+trans_fun([{loop_rec,{_,Lbl},Reg}|Instructions], Env) ->
+ {Movs,[Temp],Env1} = get_constants_in_temps([Reg],Env),
+ GotitLbl = mk_label(new),
+ ChkGetMsg = hipe_icode:mk_primop([Temp],check_get_msg,[],
+ hipe_icode:label_name(GotitLbl),
+ map_label(Lbl)),
+ Movs ++ [ChkGetMsg, GotitLbl | trans_fun(Instructions,Env1)];
+%%--- loop_rec_end ---
+trans_fun([{loop_rec_end,{_,Lbl}}|Instructions], Env) ->
+ Loop = hipe_icode:mk_goto(map_label(Lbl)),
+ [hipe_icode:mk_primop([],next_msg,[]), Loop | trans_fun(Instructions,Env)];
+%%--- wait ---
+trans_fun([{wait,{_,Lbl}}|Instructions], Env) ->
+ Susp = hipe_icode:mk_primop([],suspend_msg,[]),
+ Loop = hipe_icode:mk_goto(map_label(Lbl)),
+ [Susp, Loop | trans_fun(Instructions,Env)];
+%%--- wait_timeout ---
+trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) ->
+ {Movs,[_]=Temps,Env1} = get_constants_in_temps([Reg],Env),
+ SetTmout = hipe_icode:mk_primop([],set_timeout,Temps),
+ DoneLbl = mk_label(new),
+ SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[],
+ map_label(Lbl),hipe_icode:label_name(DoneLbl)),
+ Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)];
+%%--------------------------------------------------------------------
+%%--- Translation of arithmetics {bif,ArithOp, ...} ---
+%%--------------------------------------------------------------------
+trans_fun([{arithbif,ArithOp,{f,L},SrcRs,DstR}|Instructions], Env) ->
+ {ICode,NewEnv} = trans_arith(ArithOp,SrcRs,DstR,L,Env),
+ ICode ++ trans_fun(Instructions,NewEnv);
+%%--------------------------------------------------------------------
+%%--- Translation of arithmetic tests {test,is_ARITHTEST, ...} ---
+%%--------------------------------------------------------------------
+%%--- is_lt ---
+trans_fun([{test,is_lt,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
+ {ICode,Env1} = trans_test_guard('<',Lbl,Arg1,Arg2,Env),
+ ICode ++ trans_fun(Instructions,Env1);
+%%--- is_ge ---
+trans_fun([{test,is_ge,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
+ {ICode,Env1} = trans_test_guard('>=',Lbl,Arg1,Arg2,Env),
+ ICode ++ trans_fun(Instructions,Env1);
+%%--- is_eq ---
+trans_fun([{test,is_eq,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
+ {ICode,Env1} = trans_is_eq(Lbl,Arg1,Arg2,Env),
+ ICode ++ trans_fun(Instructions,Env1);
+%%--- is_ne ---
+trans_fun([{test,is_ne,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
+ {ICode,Env1} = trans_is_ne(Lbl,Arg1,Arg2,Env),
+ ICode ++ trans_fun(Instructions,Env1);
+%%--- is_eq_exact ---
+trans_fun([{test,is_eq_exact,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
+ {ICode,Env1} = trans_is_eq_exact(Lbl,Arg1,Arg2,Env),
+ ICode ++ trans_fun(Instructions,Env1);
+%%--- is_ne_exact ---
+trans_fun([{test,is_ne_exact,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
+ {ICode,Env1} = trans_is_ne_exact(Lbl,Arg1,Arg2,Env),
+ ICode ++ trans_fun(Instructions,Env1);
+%%--------------------------------------------------------------------
+%%--- Translation of type tests {test,is_TYPE, ...} ---
+%%--------------------------------------------------------------------
+%%--- is_integer ---
+trans_fun([{test,is_integer,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(integer,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_float ---
+trans_fun([{test,is_float,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(float,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_number ---
+trans_fun([{test,is_number,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(number,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_atom ---
+trans_fun([{test,is_atom,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(atom,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_pid ---
+trans_fun([{test,is_pid,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(pid,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_ref ---
+trans_fun([{test,is_reference,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(reference,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_port ---
+trans_fun([{test,is_port,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(port,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_nil ---
+trans_fun([{test,is_nil,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(nil,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_binary ---
+trans_fun([{test,is_binary,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(binary,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_constant ---
+trans_fun([{test,is_constant,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(constant,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_list ---
+trans_fun([{test,is_list,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(list,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_nonempty_list ---
+trans_fun([{test,is_nonempty_list,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(cons,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- is_tuple ---
+trans_fun([{test,is_tuple,{f,_Lbl}=FLbl,[Xreg]},
+ {test,test_arity,FLbl,[Xreg,_]=Args}|Instructions], Env) ->
+ trans_fun([{test,test_arity,FLbl,Args}|Instructions],Env);
+trans_fun([{test,is_tuple,{_,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(tuple,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- test_arity ---
+trans_fun([{test,test_arity,{f,Lbl},[Reg,N]}|Instructions], Env) ->
+ True = mk_label(new),
+ I = hipe_icode:mk_type([trans_arg(Reg)],{tuple,N},
+ hipe_icode:label_name(True),map_label(Lbl)),
+ [I,True | trans_fun(Instructions,Env)];
+%%--------------------------------------------------------------------
+%%--- select_val ---
+trans_fun([{select_val,Reg,{f,Lbl},{list,Cases}}|Instructions], Env) ->
+ {SwVar,CasePairs} = trans_select_stuff(Reg,Cases),
+ Len = length(CasePairs),
+ I = hipe_icode:mk_switch_val(SwVar,map_label(Lbl),Len,CasePairs),
+ ?no_debug_msg("switch_val instr is ~p~n",[I]),
+ [I | trans_fun(Instructions,Env)];
+%%--- select_tuple_arity ---
+trans_fun([{select_tuple_arity,Reg,{f,Lbl},{list,Cases}}|Instructions],Env) ->
+ {SwVar,CasePairs} = trans_select_stuff(Reg,Cases),
+ Len = length(CasePairs),
+ I = hipe_icode:mk_switch_tuple_arity(SwVar,map_label(Lbl),Len,CasePairs),
+ ?no_debug_msg("switch_tuple_arity instr is ~p~n",[I]),
+ [I | trans_fun(Instructions,Env)];
+%%--- jump ---
+trans_fun([{jump,{_,L}}|Instructions], Env) ->
+ Label = mk_label(L),
+ I = hipe_icode:mk_goto(hipe_icode:label_name(Label)),
+ [I | trans_fun(Instructions,Env)];
+%%--- move ---
+trans_fun([{move,Src,Dst}|Instructions], Env) ->
+ Dst1 = mk_var(Dst),
+ Src1 = trans_arg(Src),
+ [hipe_icode:mk_move(Dst1,Src1) | trans_fun(Instructions,Env)];
+%%--- catch --- ITS PROCESSING IS POSTPONED
+trans_fun([{'catch',N,{_,EndLabel}}|Instructions], Env) ->
+ NewContLbl = mk_label(new),
+ [{'catch',N,EndLabel},NewContLbl | trans_fun(Instructions,Env)];
+%%--- catch_end --- ITS PROCESSING IS POSTPONED
+trans_fun([{catch_end,_N}=I|Instructions], Env) ->
+ [I | trans_fun(Instructions,Env)];
+%%--- try --- ITS PROCESSING IS POSTPONED
+trans_fun([{'try',N,{_,EndLabel}}|Instructions], Env) ->
+ NewContLbl = mk_label(new),
+ [{'try',N,EndLabel},NewContLbl | trans_fun(Instructions,Env)];
+%%--- try_end ---
+trans_fun([{try_end,_N}|Instructions], Env) ->
+ [hipe_icode:mk_end_try() | trans_fun(Instructions,Env)];
+%%--- try_case --- ITS PROCESSING IS POSTPONED
+trans_fun([{try_case,_N}=I|Instructions], Env) ->
+ [I | trans_fun(Instructions,Env)];
+%%--- try_case_end ---
+trans_fun([{try_case_end,Arg}|Instructions], Env) ->
+ BadArg = trans_arg(Arg),
+ ErrVar = mk_var(new),
+ Vs = [mk_var(new)],
+ Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(try_clause)),
+ Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadArg]),
+ Fail = hipe_icode:mk_fail(Vs,error),
+ [Atom,Tuple,Fail | trans_fun(Instructions,Env)];
+%%--- raise ---
+trans_fun([{raise,{f,0},[Reg1,Reg2],{x,0}}|Instructions], Env) ->
+ V1 = trans_arg(Reg1),
+ V2 = trans_arg(Reg2),
+ Fail = hipe_icode:mk_fail([V1,V2],rethrow),
+ [Fail | trans_fun(Instructions,Env)];
+%%--- get_list ---
+trans_fun([{get_list,List,Head,Tail}|Instructions], Env) ->
+ TransList = [trans_arg(List)],
+ I1 = hipe_icode:mk_primop([mk_var(Head)],unsafe_hd,TransList),
+ I2 = hipe_icode:mk_primop([mk_var(Tail)],unsafe_tl,TransList),
+ %% Handle the cases where the dest overwrites the src!!
+ if
+ Head =/= List ->
+ [I1, I2 | trans_fun(Instructions,Env)];
+ Tail =/= List ->
+ [I2, I1 | trans_fun(Instructions,Env)];
+ true ->
+ %% XXX: We should take care of this case!!!!!
+ ?error_msg("hd and tl regs identical in get_list~n",[]),
+ erlang:error(not_handled)
+ end;
+%%--- get_tuple_element ---
+trans_fun([{get_tuple_element,Xreg,Index,Dst}|Instructions], Env) ->
+ I = hipe_icode:mk_primop([mk_var(Dst)],
+ #unsafe_element{index=Index+1},
+ [trans_arg(Xreg)]),
+ [I | trans_fun(Instructions,Env)];
+%%--- set_tuple_element ---
+trans_fun([{set_tuple_element,Elem,Tuple,Index}|Instructions], Env) ->
+ Elem1 = trans_arg(Elem),
+ I = hipe_icode:mk_primop([mk_var(Tuple)],
+ #unsafe_update_element{index=Index+1},
+ [mk_var(Tuple),Elem1]),
+ [I | trans_fun(Instructions,Env)];
+%%--- put_string ---
+trans_fun([{put_string,_Len,String,Dst}|Instructions], Env) ->
+ Mov = hipe_icode:mk_move(mk_var(Dst),trans_const(String)),
+ [Mov | trans_fun(Instructions,Env)];
+%%--- put_list ---
+trans_fun([{put_list,Car,Cdr,Dest}|Instructions], Env) ->
+ {M1,V1,Env2} = mk_move_and_var(Car,Env),
+ {M2,V2,Env3} = mk_move_and_var(Cdr,Env2),
+ D = mk_var(Dest),
+ M1 ++ M2 ++ [hipe_icode:mk_primop([D],cons,[V1,V2])
+ | trans_fun(Instructions,Env3)];
+%%--- put_tuple ---
+trans_fun([{put_tuple,_Size,Reg}|Instructions], Env) ->
+ {Moves,Instructions2,Vars,Env2} = trans_puts(Instructions,Env),
+ Dest = [mk_var(Reg)],
+ Src = lists:reverse(Vars),
+ Primop = hipe_icode:mk_primop(Dest,mktuple,Src),
+ Moves ++ [Primop | trans_fun(Instructions2,Env2)];
+%%--- put --- SHOULD NOT REALLY EXIST HERE; put INSTRUCTIONS ARE HANDLED ABOVE.
+%%--- badmatch ---
+trans_fun([{badmatch,Arg}|Instructions], Env) ->
+ BadVar = trans_arg(Arg),
+ ErrVar = mk_var(new),
+ Vs = [mk_var(new)],
+ Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(badmatch)),
+ Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadVar]),
+ Fail = hipe_icode:mk_fail(Vs,error),
+ [Atom,Tuple,Fail | trans_fun(Instructions,Env)];
+%%--- if_end ---
+trans_fun([if_end|Instructions], Env) ->
+ V = mk_var(new),
+ Mov = hipe_icode:mk_move(V,hipe_icode:mk_const(if_clause)),
+ Fail = hipe_icode:mk_fail([V],error),
+ [Mov,Fail | trans_fun(Instructions, Env)];
+%%--- case_end ---
+trans_fun([{case_end,Arg}|Instructions], Env) ->
+ BadArg = trans_arg(Arg),
+ ErrVar = mk_var(new),
+ Vs = [mk_var(new)],
+ Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(case_clause)),
+ Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadArg]),
+ Fail = hipe_icode:mk_fail(Vs,error),
+ [Atom,Tuple,Fail | trans_fun(Instructions,Env)];
+%%--- enter_fun ---
+trans_fun([{call_fun,N},{deallocate,_},return|Instructions], Env) ->
+ Args = extract_fun_args(N+1), %% +1 is for the fun itself
+ [hipe_icode:mk_comment('enter_fun'),
+ hipe_icode:mk_enter_primop(enter_fun,Args) | trans_fun(Instructions,Env)];
+%%--- call_fun ---
+trans_fun([{call_fun,N}|Instructions], Env) ->
+ Args = extract_fun_args(N+1), %% +1 is for the fun itself
+ Dst = [mk_var({r,0})],
+ [hipe_icode:mk_comment('call_fun'),
+ hipe_icode:mk_primop(Dst,call_fun,Args) | trans_fun(Instructions,Env)];
+%%--- patched_make_fun --- make_fun/make_fun2 after fixes
+trans_fun([{patched_make_fun,MFA,Magic,FreeVarNum,Index}|Instructions], Env) ->
+ Args = extract_fun_args(FreeVarNum),
+ Dst = [mk_var({r,0})],
+ Fun = hipe_icode:mk_primop(Dst,
+ #mkfun{mfa=MFA,magic_num=Magic,index=Index},
+ Args),
+ ?no_debug_msg("mkfun translates to: ~p~n",[Fun]),
+ [Fun | trans_fun(Instructions,Env)];
+%%--- is_function ---
+trans_fun([{test,is_function,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(function,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--- call_ext_only ---
+trans_fun([{call_ext_only,_N,{extfunc,M,F,A}}|Instructions], Env) ->
+ Args = extract_fun_args(A),
+ I = trans_enter({M,F,A}, Args, remote),
+ [hipe_icode:mk_comment('call_ext_only'), I | trans_fun(Instructions,Env)];
+%%--------------------------------------------------------------------
+%%--- Translation of binary instructions ---
+%%--------------------------------------------------------------------
+%% This code uses a somewhat unorthodox translation:
+%% Since we do not want non-erlang values as arguments to Icode
+%% instructions some compile time constants are coded into the
+%% name of the function (or rather the primop).
+%% TODO: Make sure all cases of argument types are covered.
+%%--------------------------------------------------------------------
+trans_fun([{test,bs_start_match2,{f,Lbl},[X,_Live,Max,Ms]}|Instructions], Env) ->
+ Bin = trans_arg(X),
+ MsVar = mk_var(Ms),
+ trans_op_call({hipe_bs_primop, {bs_start_match, Max}}, Lbl, [Bin],
+ [MsVar], Env, Instructions);
+trans_fun([{test,bs_get_float2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags0},X]}|
+ Instructions], Env) ->
+ Dst = mk_var(X),
+ MsVar = mk_var(Ms),
+ Flags = resolve_native_endianess(Flags0),
+ {Name, Args} =
+ case Size of
+ {integer, NoBits} when is_integer(NoBits), NoBits >= 0 ->
+ {{bs_get_float,NoBits*Unit,Flags}, [MsVar]};
+ {integer, NoBits} when is_integer(NoBits), NoBits < 0 ->
+ ?EXIT({bad_bs_size_constant,Size});
+ BitReg ->
+ Bits = mk_var(BitReg),
+ {{bs_get_float,Unit,Flags}, [Bits,MsVar]}
+ end,
+ trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [Dst,MsVar], Env, Instructions);
+trans_fun([{test,bs_get_integer2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags0},X]}|
+ Instructions], Env) ->
+ Dst = mk_var(X),
+ MsVar = mk_var(Ms),
+ Flags = resolve_native_endianess(Flags0),
+ {Name, Args} =
+ case Size of
+ {integer,NoBits} when is_integer(NoBits), NoBits >= 0 ->
+ {{bs_get_integer,NoBits*Unit,Flags}, [MsVar]};
+ {integer,NoBits} when is_integer(NoBits), NoBits < 0 ->
+ ?EXIT({bad_bs_size_constant,Size});
+ BitReg ->
+ Bits = mk_var(BitReg),
+ {{bs_get_integer,Unit,Flags}, [MsVar,Bits]}
+ end,
+ trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [Dst,MsVar], Env, Instructions);
+trans_fun([{test,bs_get_binary2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags},X]}|
+ Instructions], Env) ->
+ MsVar = mk_var(Ms),
+ {Name, Args, Dsts} =
+ case Size of
+ {atom, all} -> %% put all bits
+ if Ms =:= X ->
+ {{bs_get_binary_all,Unit,Flags},[MsVar],[mk_var(X)]};
+ true ->
+ {{bs_get_binary_all_2,Unit,Flags},[MsVar],[mk_var(X),MsVar]}
+ end;
+ {integer, NoBits} when is_integer(NoBits), NoBits >= 0 ->
+ {{bs_get_binary,NoBits*Unit,Flags}, [MsVar], [mk_var(X),MsVar]};%% Create a N*Unit bits subbinary
+ {integer, NoBits} when is_integer(NoBits), NoBits < 0 ->
+ ?EXIT({bad_bs_size_constant,Size});
+ BitReg -> % Use a number of bits only known at runtime.
+ Bits = mk_var(BitReg),
+ {{bs_get_binary,Unit,Flags}, [MsVar,Bits], [mk_var(X),MsVar]}
+ end,
+ trans_op_call({hipe_bs_primop,Name}, Lbl, Args, Dsts, Env, Instructions);
+trans_fun([{test,bs_skip_bits2,{f,Lbl},[Ms,Size,NumBits,{field_flags,Flags}]}|
+ Instructions], Env) ->
+ %% the current match buffer
+ MsVar = mk_var(Ms),
+ {Name, Args} =
+ case Size of
+ {atom, all} -> %% Skip all bits
+ {{bs_skip_bits_all,NumBits,Flags},[MsVar]};
+ {integer, BitSize} when is_integer(BitSize), BitSize >= 0-> %% Skip N bits
+ {{bs_skip_bits,BitSize*NumBits}, [MsVar]};
+ {integer, BitSize} when is_integer(BitSize), BitSize < 0 ->
+ ?EXIT({bad_bs_size_constant,Size});
+ X -> % Skip a number of bits only known at runtime.
+ Src = mk_var(X),
+ {{bs_skip_bits,NumBits},[MsVar,Src]}
+ end,
+ trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [MsVar], Env, Instructions);
+trans_fun([{test,bs_test_unit,{f,Lbl},[Ms,Unit]}|
+ Instructions], Env) ->
+ %% the current match buffer
+ MsVar = mk_var(Ms),
+ trans_op_call({hipe_bs_primop,{bs_test_unit,Unit}}, Lbl,
+ [MsVar], [], Env, Instructions);
+trans_fun([{test,bs_match_string,{f,Lbl},[Ms,BitSize,Bin]}|
+ Instructions], Env) ->
+ True = mk_label(new),
+ FalseLabName = map_label(Lbl),
+ TrueLabName = hipe_icode:label_name(True),
+ MsVar = mk_var(Ms),
+ TmpVar = mk_var(new),
+ ByteSize = BitSize div 8,
+ ExtraBits = BitSize rem 8,
+ WordSize = hipe_rtl_arch:word_size(),
+ if ExtraBits =:= 0 ->
+ trans_op_call({hipe_bs_primop,{bs_match_string,Bin,ByteSize}}, Lbl,
+ [MsVar], [MsVar], Env, Instructions);
+ BitSize =< ((WordSize * 8) - 5) ->
+ <<Int:BitSize, _/bits>> = Bin,
+ {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,BitSize,0}}, Lbl,
+ [MsVar], [TmpVar, MsVar], Env),
+ I2 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName),
+ I1 ++ [I2,True] ++ trans_fun(Instructions, Env1);
+ true ->
+ <<RealBin:ByteSize/binary, Int:ExtraBits, _/bits>> = Bin,
+ {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_match_string,RealBin,ByteSize}}, Lbl,
+ [MsVar], [MsVar], Env),
+ {I2,Env2} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,ExtraBits,0}}, Lbl,
+ [MsVar], [TmpVar, MsVar], Env1),
+ I3 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName),
+ I1 ++ I2 ++ [I3,True] ++ trans_fun(Instructions, Env2)
+ end;
+trans_fun([{bs_context_to_binary,Var}|Instructions], Env) ->
+ %% the current match buffer
+ IVars = [trans_arg(Var)],
+ [hipe_icode:mk_primop(IVars,{hipe_bs_primop,bs_context_to_binary},IVars)|
+ trans_fun(Instructions, Env)];
+trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}|
+ Instructions], Env) ->
+ %% the current match buffer
+ SizeArg = trans_arg(Size),
+ BinArg = trans_arg(Binary),
+ IcodeDst = mk_var(Dst),
+ Offset = mk_var(reg),
+ Base = mk_var(reg),
+ trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg],
+ [IcodeDst,Base,Offset],
+ Base, Offset, Env, Instructions);
+trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}|
+ Instructions], Env) ->
+ %% the current match buffer
+ SizeArg = trans_arg(Size),
+ BinArg = trans_arg(Binary),
+ IcodeDst = mk_var(Dst),
+ Offset = mk_var(reg),
+ Base = mk_var(reg),
+ trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}},
+ Lbl,[SizeArg,BinArg],
+ [IcodeDst,Base,Offset],
+ Base, Offset, Env, Instructions);
+trans_fun([bs_init_writable|Instructions], Env) ->
+ Vars = [mk_var({x,0})], %{x,0} is implict arg and dst
+ [hipe_icode:mk_primop(Vars,{hipe_bs_primop,bs_init_writable},Vars),
+ trans_fun(Instructions, Env)];
+trans_fun([{bs_save2,Ms,IndexName}|Instructions], Env) ->
+ Index =
+ case IndexName of
+ {atom, start} -> 0;
+ _ -> IndexName+1
+ end,
+ MsVars = [mk_var(Ms)],
+ [hipe_icode:mk_primop(MsVars,{hipe_bs_primop,{bs_save,Index}},MsVars) |
+ trans_fun(Instructions, Env)];
+trans_fun([{bs_restore2,Ms,IndexName}|Instructions], Env) ->
+ Index =
+ case IndexName of
+ {atom, start} -> 0;
+ _ -> IndexName+1
+ end,
+ MsVars = [mk_var(Ms)],
+ [hipe_icode:mk_primop(MsVars,{hipe_bs_primop,{bs_restore,Index}},MsVars) |
+ trans_fun(Instructions, Env)];
+trans_fun([{test,bs_test_tail2,{f,Lbl},[Ms,Numbits]}| Instructions], Env) ->
+ MsVar = mk_var(Ms),
+ trans_op_call({hipe_bs_primop,{bs_test_tail,Numbits}},
+ Lbl, [MsVar], [], Env, Instructions);
+%%--------------------------------------------------------------------
+%% New bit syntax instructions added in February 2004 (R10B).
+%%--------------------------------------------------------------------
+trans_fun([{bs_init2,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
+ Instructions], Env) ->
+ Dst = mk_var(X),
+ Flags = resolve_native_endianess(Flags0),
+ Offset = mk_var(reg),
+ Base = mk_var(reg),
+ {Name, Args} =
+ case Size of
+ NoBytes when is_integer(NoBytes) ->
+ {{bs_init, Size, Flags}, []};
+ BitReg ->
+ Bits = mk_var(BitReg),
+ {{bs_init, Flags}, [Bits]}
+ end,
+ trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset],
+ Base, Offset, Env, Instructions);
+trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
+ Instructions], Env) ->
+ Dst = mk_var(X),
+ Flags = resolve_native_endianess(Flags0),
+ Offset = mk_var(reg),
+ Base = mk_var(reg),
+ {Name, Args} =
+ case Size of
+ NoBits when is_integer(NoBits) ->
+ {{bs_init_bits, NoBits, Flags}, []};
+ BitReg ->
+ Bits = mk_var(BitReg),
+ {{bs_init_bits, Flags}, [Bits]}
+ end,
+ trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset],
+ Base, Offset, Env, Instructions);
+trans_fun([{bs_bits_to_bytes2, Bits, Bytes}|Instructions], Env) ->
+ Src = trans_arg(Bits),
+ Dst = mk_var(Bytes),
+ [hipe_icode:mk_primop([Dst], 'bsl', [Src, hipe_icode:mk_const(3)])|
+ trans_fun(Instructions,Env)];
+trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) ->
+ Dst = mk_var(Res),
+ Temp = mk_var(new),
+ MultIs =
+ case {New,Unit} of
+ {{integer, NewInt}, _} ->
+ [hipe_icode:mk_move(Temp, hipe_icode:mk_const(NewInt*Unit))];
+ {_, 1} ->
+ NewVar = mk_var(New),
+ [hipe_icode:mk_move(Temp, NewVar)];
+ _ ->
+ NewVar = mk_var(New),
+ if Lbl =:= 0 ->
+ [hipe_icode:mk_primop([Temp], '*',
+ [NewVar, hipe_icode:mk_const(Unit)])];
+ true ->
+ Succ = mk_label(new),
+ [hipe_icode:mk_primop([Temp], '*',
+ [NewVar, hipe_icode:mk_const(Unit)],
+ hipe_icode:label_name(Succ), Lbl),
+ Succ]
+ end
+ end,
+ Succ2 = mk_label(new),
+ {FailLblName, FailCode} =
+ if Lbl =:= 0 ->
+ FailLbl = mk_label(new),
+ {hipe_icode:label_name(FailLbl),
+ [FailLbl,
+ hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]};
+ true ->
+ {Lbl, []}
+ end,
+ IsPos =
+ [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)],
+ hipe_icode:label_name(Succ2), FailLblName)] ++
+ FailCode ++ [Succ2],
+ AddI =
+ case Old of
+ {integer,OldInt} ->
+ hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]);
+ _ ->
+ OldVar = mk_var(Old),
+ hipe_icode:mk_primop([Dst], '+', [Temp, OldVar])
+ end,
+ MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)];
+%%--------------------------------------------------------------------
+%% Bit syntax instructions added in R12B-5 (Fall 2008)
+%%--------------------------------------------------------------------
+trans_fun([{bs_utf8_size,{f,Lbl},A2,A3}|Instructions], Env) ->
+ Bin = trans_arg(A2),
+ Dst = mk_var(A3),
+ trans_op_call({hipe_bs_primop, bs_utf8_size}, Lbl, [Bin], [Dst], Env, Instructions);
+trans_fun([{test,bs_get_utf8,{f,Lbl},[Ms,_Live,{field_flags,_Flags},X]} |
+ Instructions], Env) ->
+ trans_bs_get_or_skip_utf8(Lbl, Ms, X, Instructions, Env);
+trans_fun([{test,bs_skip_utf8,{f,Lbl},[Ms,_Live,{field_flags,_Flags}]} |
+ Instructions], Env) ->
+ trans_bs_get_or_skip_utf8(Lbl, Ms, 'new', Instructions, Env);
+trans_fun([{bs_utf16_size,{f,Lbl},A2,A3}|Instructions], Env) ->
+ Bin = trans_arg(A2),
+ Dst = mk_var(A3),
+ trans_op_call({hipe_bs_primop, bs_utf16_size}, Lbl, [Bin], [Dst], Env, Instructions);
+trans_fun([{test,bs_get_utf16,{f,Lbl},[Ms,_Live,{field_flags,Flags0},X]} |
+ Instructions], Env) ->
+ trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, X, Instructions, Env);
+trans_fun([{test,bs_skip_utf16,{f,Lbl},[Ms,_Live,{field_flags,Flags0}]} |
+ Instructions], Env) ->
+ trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, 'new', Instructions, Env);
+trans_fun([{test,bs_get_utf32,{f,Lbl},[Ms,_Live,{field_flags,Flags0},X]} | Instructions], Env) ->
+ trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, X, Instructions, Env);
+trans_fun([{test,bs_skip_utf32,{f,Lbl},[Ms,_Live,{field_flags,Flags0}]} | Instructions], Env) ->
+ trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, 'new', Instructions, Env);
+%%--------------------------------------------------------------------
+%%--- Translation of floating point instructions ---
+%%--------------------------------------------------------------------
+%%--- fclearerror ---
+trans_fun([fclearerror|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ [hipe_icode:mk_primop([], fclearerror, []) |
+ trans_fun(Instructions,Env)];
+ _ ->
+ trans_fun(Instructions,Env)
+ end;
+%%--- fcheckerror ---
+trans_fun([{fcheckerror,{_,Fail}}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ ContLbl = mk_label(new),
+ case Fail of
+ 0 ->
+ [hipe_icode:mk_primop([], fcheckerror, [],
+ hipe_icode:label_name(ContLbl), []),
+ ContLbl | trans_fun(Instructions,Env)];
+ _ -> %% Can this happen?
+ {Guard,Env1} =
+ make_guard([], fcheckerror, [],
+ hipe_icode:label_name(ContLbl), map_label(Fail), Env),
+ [Guard, ContLbl | trans_fun(Instructions,Env1)]
+ end;
+ _ ->
+ trans_fun(Instructions, Env)
+ end;
+%%--- fmove ---
+trans_fun([{fmove,Src,Dst}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ Dst1 = mk_var(Dst),
+ Src1 = trans_arg(Src),
+ case{hipe_icode:is_fvar(Dst1),
+ hipe_icode:is_fvar(Src1)} of
+ {true, true} -> %% fvar := fvar
+ [hipe_icode:mk_move(Dst1,Src1) | trans_fun(Instructions,Env)];
+ {false, true} -> %% var := fvar
+ [hipe_icode:mk_primop([Dst1], unsafe_tag_float, [Src1]) |
+ trans_fun(Instructions,Env)];
+ {true, false} -> %% fvar := var or fvar := constant
+ [hipe_icode:mk_primop([Dst1], unsafe_untag_float, [Src1]) |
+ trans_fun(Instructions,Env)]
+ end;
+ _ ->
+ trans_fun([{move,Src,Dst}|Instructions], Env)
+ end;
+%%--- fconv ---
+trans_fun([{fconv,Eterm,FReg}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ Src = trans_arg(Eterm),
+ ContLbl = mk_label(new),
+ Dst = mk_var(FReg),
+ [hipe_icode:mk_primop([Dst], conv_to_float, [Src],
+ hipe_icode:label_name(ContLbl), []),
+ ContLbl| trans_fun(Instructions, Env)];
+ _ ->
+ trans_fun([{fmove,Eterm,FReg}|Instructions], Env)
+ end;
+%%--- fadd ---
+trans_fun([{arithfbif,fadd,Lab,SrcRs,DstR}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ trans_fun([{arithbif,fp_add,Lab,SrcRs,DstR}|Instructions], Env);
+ _ ->
+ trans_fun([{arithbif,'+',Lab,SrcRs,DstR}|Instructions], Env)
+ end;
+%%--- fsub ---
+trans_fun([{arithfbif,fsub,Lab,SrcRs,DstR}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ trans_fun([{arithbif,fp_sub,Lab,SrcRs,DstR}|Instructions], Env);
+ _ ->
+ trans_fun([{arithbif,'-',Lab,SrcRs,DstR}|Instructions], Env)
+ end;
+%%--- fmult ---
+trans_fun([{arithfbif,fmul,Lab,SrcRs,DstR}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ trans_fun([{arithbif,fp_mul,Lab,SrcRs,DstR}|Instructions], Env);
+ _ ->
+ trans_fun([{arithbif,'*',Lab,SrcRs,DstR}|Instructions], Env)
+ end;
+%%--- fdiv ---
+trans_fun([{arithfbif,fdiv,Lab,SrcRs,DstR}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ trans_fun([{arithbif,fp_div,Lab,SrcRs,DstR}|Instructions], Env);
+ _ ->
+ trans_fun([{arithbif,'/',Lab,SrcRs,DstR}|Instructions], Env)
+ end;
+%%--- fnegate ---
+trans_fun([{arithfbif,fnegate,Lab,[SrcR],DestR}|Instructions], Env) ->
+ case get(hipe_inline_fp) of
+ true ->
+ Src = trans_arg(SrcR),
+ Dst = mk_var(DestR),
+ [hipe_icode:mk_primop([Dst], fnegate, [Src])|
+ trans_fun(Instructions,Env)];
+ _ ->
+ trans_fun([{arithbif,'-',Lab,[{float,0.0},SrcR],DestR}|Instructions], Env)
+ end;
+%%--------------------------------------------------------------------
+%% New apply instructions added in April 2004 (R10B).
+%%--------------------------------------------------------------------
+trans_fun([{apply,Arity}|Instructions], Env) ->
+ BeamArgs = extract_fun_args(Arity+2), %% +2 is for M and F
+ {Args,[M,F]} = lists:split(Arity,BeamArgs),
+ Dst = [mk_var({r,0})],
+ [hipe_icode:mk_comment('apply'),
+ hipe_icode:mk_primop(Dst, #apply_N{arity=Arity}, [M,F|Args])
+ | trans_fun(Instructions,Env)];
+trans_fun([{apply_last,Arity,_N}|Instructions], Env) -> % N is StackAdjustment?
+ BeamArgs = extract_fun_args(Arity+2), %% +2 is for M and F
+ {Args,[M,F]} = lists:split(Arity,BeamArgs),
+ [hipe_icode:mk_comment('apply_last'),
+ hipe_icode:mk_enter_primop(#apply_N{arity=Arity}, [M,F|Args])
+ | trans_fun(Instructions,Env)];
+%%--------------------------------------------------------------------
+%% New test instruction added in April 2004 (R10B).
+%%--------------------------------------------------------------------
+%%--- is_boolean ---
+trans_fun([{test,is_boolean,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(boolean,Lbl,Arg,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--------------------------------------------------------------------
+%% New test instruction added in June 2005 for R11
+%%--------------------------------------------------------------------
+%%--- is_function2 ---
+trans_fun([{test,is_function2,{f,Lbl},[Arg,Arity]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test2(function2,Lbl,Arg,Arity,Env),
+ [Code | trans_fun(Instructions,Env1)];
+%%--------------------------------------------------------------------
+%% New garbage-collecting BIFs added in January 2006 for R11B.
+%%--------------------------------------------------------------------
+trans_fun([{gc_bif,'-',Fail,_Live,[SrcR],DstR}|Instructions], Env) ->
+ %% Unary minus. Change this to binary minus.
+ trans_fun([{arithbif,'-',Fail,[{integer,0},SrcR],DstR}|Instructions], Env);
+trans_fun([{gc_bif,'+',Fail,_Live,[SrcR],DstR}|Instructions], Env) ->
+ %% Unary plus. Change this to a bif call.
+ trans_fun([{bif,'+',Fail,[SrcR],DstR}|Instructions], Env);
+trans_fun([{gc_bif,Name,Fail,_Live,SrcRs,DstR}|Instructions], Env) ->
+ case erl_internal:guard_bif(Name, length(SrcRs)) of
+ false ->
+ %% Arithmetic instruction.
+ trans_fun([{arithbif,Name,Fail,SrcRs,DstR}|Instructions], Env);
+ true ->
+ %% A guard BIF.
+ trans_fun([{bif,Name,Fail,SrcRs,DstR}|Instructions], Env)
+ end;
+%%--------------------------------------------------------------------
+%% Instruction for constant pool added in February 2007 for R11B-4.
+%%--------------------------------------------------------------------
+trans_fun([{put_literal,{literal,Literal},DstR}|Instructions], Env) ->
+ DstV = mk_var(DstR),
+ Move = hipe_icode:mk_move(DstV, hipe_icode:mk_const(Literal)),
+ [Move | trans_fun(Instructions, Env)];
+%%--------------------------------------------------------------------
+%% New test instruction added in July 2007 for R12.
+%%--------------------------------------------------------------------
+%%--- is_bitstr ---
+trans_fun([{test,is_bitstr,{f,Lbl},[Arg]}|Instructions], Env) ->
+ {Code,Env1} = trans_type_test(bitstr, Lbl, Arg, Env),
+ [Code | trans_fun(Instructions, Env1)];
+%%--------------------------------------------------------------------
+%% New stack triming instruction added in October 2007 for R12.
+%%--------------------------------------------------------------------
+trans_fun([{trim,N,NY}|Instructions], Env) ->
+ %% trim away N registers leaving NY registers
+ Moves = trans_trim(N, NY),
+ Moves ++ trans_fun(Instructions, Env);
+%%--------------------------------------------------------------------
+%%--- ERROR HANDLING ---
+%%--------------------------------------------------------------------
+trans_fun([X|_], _) ->
+ ?EXIT({'trans_fun/2',X});
+trans_fun([], _) ->
+ [].
+
+%%--------------------------------------------------------------------
+%% trans_call and trans_enter generate correct Icode calls/tail-calls,
+%% recognizing explicit fails.
+%%--------------------------------------------------------------------
+
+trans_call(MFA={M,F,_A}, Dst, Args, Type) ->
+ handle_fail(MFA, Args, fun () -> hipe_icode:mk_call(Dst,M,F,Args,Type) end).
+
+trans_enter(MFA={M,F,_A}, Args, Type) ->
+ handle_fail(MFA, Args, fun () -> hipe_icode:mk_enter(M,F,Args,Type) end).
+
+handle_fail(MFA, Args, F) ->
+ case MFA of
+ {erlang,exit,1} ->
+ hipe_icode:mk_fail(Args,exit);
+ {erlang,throw,1} ->
+ hipe_icode:mk_fail(Args,throw);
+ {erlang,fault,1} ->
+ hipe_icode:mk_fail(Args,error);
+ {erlang,fault,2} ->
+ hipe_icode:mk_fail(Args,error);
+ {erlang,error,1} ->
+ hipe_icode:mk_fail(Args,error);
+ {erlang,error,2} ->
+ hipe_icode:mk_fail(Args,error);
+ _ ->
+ F()
+ end.
+
+%%-----------------------------------------------------------------------
+%% trans_bif0(BifName, DestReg)
+%% trans_bif(Arity, BifName, FailLab, Args, DestReg, Environment)
+%%-----------------------------------------------------------------------
+
+trans_bif0(BifName, DestReg) ->
+ ?no_debug_msg(" found BIF0: ~p() ...~n", [BifName]),
+ BifRes = mk_var(DestReg),
+ hipe_icode:mk_call([BifRes],erlang,BifName,[],remote).
+
+trans_bif(Arity, BifName, Lbl, Args, DestReg, Env) ->
+ ?no_debug_msg(" found BIF: ~p(~p) ...~n", [BifName,Args]),
+ BifRes = mk_var(DestReg),
+ {Movs, SrcVars, Env1} = get_constants_in_temps(Args,Env),
+ case Lbl of
+ 0 -> % Bif is not in a guard
+ I = hipe_icode:mk_call([BifRes],erlang,BifName,SrcVars,remote),
+ {Movs ++ [I], Env1};
+ _ -> % Bif occurs in a guard - fail silently to Lbl
+ {GuardI,Env2} =
+ make_fallthrough_guard([BifRes],{erlang,BifName,Arity},SrcVars,
+ map_label(Lbl),Env1),
+ {[Movs,GuardI], Env2}
+ end.
+
+trans_op_call(Name, Lbl, Args, Dests, Env, Instructions) ->
+ {Code, Env1} = trans_one_op_call(Name, Lbl, Args, Dests, Env),
+ [Code|trans_fun(Instructions, Env1)].
+
+trans_one_op_call(Name, Lbl, Args, Dests, Env) ->
+ case Lbl of
+ 0 -> % Op is not in a guard
+ I = hipe_icode:mk_primop(Dests, Name, Args),
+ {[I], Env};
+ _ -> % op occurs in a guard - fail silently to Lbl
+ make_fallthrough_guard(Dests, Name, Args, map_label(Lbl), Env)
+ end.
+
+%%-----------------------------------------------------------------------
+%% trans_bin_call
+%%-----------------------------------------------------------------------
+
+trans_bin_call(Name, Lbl, Args, Dests, Base, Offset, Env, Instructions) ->
+ {Code, Env1} =
+ case Lbl of
+ 0 -> % Op is not in a guard
+ I = hipe_icode:mk_primop(Dests, Name, Args),
+ {[I], Env};
+ _ -> % op occurs in a guard - fail silently to Lbl
+ make_fallthrough_guard(Dests, Name, Args, map_label(Lbl), Env)
+ end,
+ [Code|trans_bin(Instructions, Base, Offset, Env1)].
+
+%% Translate instructions for building binaries separately to give
+%% them an appropriate state
+
+trans_bin([{bs_put_float,{f,Lbl},Size,Unit,{field_flags,Flags0},Source}|
+ Instructions], Base, Offset, Env) ->
+ Flags = resolve_native_endianess(Flags0),
+ %% Get source
+ {Src,SourceInstrs,ConstInfo} =
+ case is_var(Source) of
+ true ->
+ {mk_var(Source),[], var};
+ false ->
+ case Source of
+ {float, X} when is_float(X) ->
+ C = trans_const(Source),
+ SrcVar = mk_var(new),
+ I = hipe_icode:mk_move(SrcVar, C),
+ {SrcVar,[I],pass};
+ _ ->
+ C = trans_const(Source),
+ SrcVar = mk_var(new),
+ I = hipe_icode:mk_move(SrcVar, C),
+ {SrcVar,[I],fail}
+ end
+ end,
+ %% Get type of put_float
+ {Name,Args,Env2} =
+ case Size of
+ {integer,NoBits} when is_integer(NoBits), NoBits >= 0 ->
+ %% Create a N*Unit bits float
+ {{bs_put_float, NoBits*Unit, Flags, ConstInfo}, [Src, Base, Offset], Env};
+ {integer,NoBits} when is_integer(NoBits), NoBits < 0 ->
+ ?EXIT({bad_bs_size_constant,Size});
+ BitReg -> % Use a number of bits only known at runtime.
+ Bits = mk_var(BitReg),
+ {{bs_put_float, Unit, Flags, ConstInfo}, [Src,Bits,Base,Offset], Env}
+ end,
+ %% Generate code for calling the bs-op.
+ SourceInstrs ++
+ trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Offset], Base, Offset, Env2, Instructions);
+trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}|
+ Instructions], Base, Offset, Env) ->
+ %% Get the source of the binary.
+ Src = trans_arg(Source),
+ %% Get type of put_binary
+ {Name, Args, Env2} =
+ case Size of
+ {atom,all} -> %% put all bits
+ {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env};
+ {integer,NoBits} when is_integer(NoBits), NoBits >= 0 ->
+ %% Create a N*Unit bits subbinary
+ {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env};
+ {integer,NoBits} when is_integer(NoBits), NoBits < 0 ->
+ ?EXIT({bad_bs_size_constant,Size});
+ BitReg -> % Use a number of bits only known at runtime.
+ Bits = mk_var(BitReg),
+ {{bs_put_binary, Unit, Flags}, [Src, Bits,Base,Offset], Env}
+ end,
+ %% Generate code for calling the bs-op.
+ trans_bin_call({hipe_bs_primop, Name},
+ Lbl, Args, [Offset],
+ Base, Offset, Env2, Instructions);
+%%--- bs_put_string ---
+trans_bin([{bs_put_string,SizeInBytes,{string,String}}|Instructions], Base,
+ Offset, Env) ->
+ [hipe_icode:mk_primop([Offset],
+ {hipe_bs_primop,{bs_put_string, String, SizeInBytes}},
+ [Base, Offset]) |
+ trans_bin(Instructions, Base, Offset, Env)];
+trans_bin([{bs_put_integer,{f,Lbl},Size,Unit,{field_flags,Flags0},Source}|
+ Instructions], Base, Offset, Env) ->
+ Flags = resolve_native_endianess(Flags0),
+ %% Get size-type
+
+ %% Get the source of the binary.
+ {Src, SrcInstrs, ConstInfo} =
+ case is_var(Source) of
+ true ->
+ {mk_var(Source), [], var};
+ false ->
+ case Source of
+ {integer, X} when is_integer(X) ->
+ C = trans_const(Source),
+ SrcVar = mk_var(new),
+ I = hipe_icode:mk_move(SrcVar, C),
+ {SrcVar,[I], pass};
+ _ ->
+ C = trans_const(Source),
+ SrcVar = mk_var(new),
+ I = hipe_icode:mk_move(SrcVar, C),
+ {SrcVar,[I], fail}
+
+ end
+ end,
+ {Name, Args, Env2} =
+ case is_var(Size) of
+ true ->
+ SVar = mk_var(Size),
+ {{bs_put_integer,Unit,Flags,ConstInfo}, [SVar, Base, Offset], Env};
+ false ->
+ case Size of
+ {integer, NoBits} when NoBits >= 0 ->
+ {{bs_put_integer,NoBits*Unit,Flags,ConstInfo}, [Base, Offset], Env};
+ _ ->
+ ?EXIT({bad_bs_size_constant,Size})
+ end
+ end,
+ SrcInstrs ++ trans_bin_call({hipe_bs_primop, Name},
+ Lbl, [Src|Args], [Offset], Base, Offset, Env2, Instructions);
+%%----------------------------------------------------------------
+%% New binary construction instructions added in R12B-5 (Fall 2008).
+%%----------------------------------------------------------------
+trans_bin([{bs_put_utf8,{f,Lbl},_FF,A3}|Instructions], Base, Offset, Env) ->
+ Src = trans_arg(A3),
+ Args = [Src, Base, Offset],
+ trans_bin_call({hipe_bs_primop, bs_put_utf8}, Lbl, Args, [Offset], Base, Offset, Env, Instructions);
+trans_bin([{bs_put_utf16,{f,Lbl},{field_flags,Flags0},A3}|Instructions], Base, Offset, Env) ->
+ Src = trans_arg(A3),
+ Args = [Src, Base, Offset],
+ Flags = resolve_native_endianess(Flags0),
+ Name = {bs_put_utf16, Flags},
+ trans_bin_call({hipe_bs_primop, Name}, Lbl, Args, [Offset], Base, Offset, Env, Instructions);
+trans_bin([{bs_put_utf32,F={f,Lbl},FF={field_flags,_Flags0},A3}|Instructions], Base, Offset, Env) ->
+ Src = trans_arg(A3),
+ trans_bin_call({hipe_bs_primop,bs_validate_unicode}, Lbl, [Src], [], Base, Offset, Env,
+ [{bs_put_integer,F,{integer,32},1,FF,A3} | Instructions]);
+%%----------------------------------------------------------------
+%% Base cases for the end of a binary construction sequence.
+%%----------------------------------------------------------------
+trans_bin([{bs_final2,Src,Dst}|Instructions], _Base, Offset, Env) ->
+ [hipe_icode:mk_primop([mk_var(Dst)], {hipe_bs_primop, bs_final},
+ [trans_arg(Src),Offset])
+ |trans_fun(Instructions, Env)];
+trans_bin(Instructions, _Base, _Offset, Env) ->
+ trans_fun(Instructions, Env).
+
+%% this translates bs_get_utf8 and bs_skip_utf8 (get with new unused dst)
+trans_bs_get_or_skip_utf8(Lbl, Ms, X, Instructions, Env) ->
+ Dst = mk_var(X),
+ MsVar = mk_var(Ms),
+ trans_op_call({hipe_bs_primop,bs_get_utf8}, Lbl, [MsVar], [Dst,MsVar], Env, Instructions).
+
+%% this translates bs_get_utf16 and bs_skip_utf16 (get with new unused dst)
+trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, X, Instructions, Env) ->
+ Dst = mk_var(X),
+ MsVar = mk_var(Ms),
+ Flags = resolve_native_endianess(Flags0),
+ Name = {bs_get_utf16,Flags},
+ trans_op_call({hipe_bs_primop,Name}, Lbl, [MsVar], [Dst,MsVar], Env, Instructions).
+
+%% this translates bs_get_utf32 and bs_skip_utf32 (get with new unused dst)
+trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, X, Instructions, Env) ->
+ Dst = mk_var(X),
+ MsVar = mk_var(Ms),
+ Flags = resolve_native_endianess(Flags0),
+ {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,32,Flags}},
+ Lbl, [MsVar], [Dst,MsVar], Env),
+ I1 ++ trans_op_call({hipe_bs_primop,bs_validate_unicode_retract},
+ Lbl, [Dst,MsVar], [MsVar], Env1, Instructions).
+
+%%-----------------------------------------------------------------------
+%% trans_arith(Op, SrcVars, Des, Lab, Env) -> { Icode, NewEnv }
+%% A failure label of type {f,0} means in a body.
+%% A failure label of type {f,L} where L>0 means in a guard.
+%% Within a guard a failure should branch to the next guard and
+%% not trigger an exception!!
+%% Handles body arithmetic with Icode primops!
+%% Handles guard arithmetic with Icode guardops!
+%%-----------------------------------------------------------------------
+
+trans_arith(Op, SrcRs, DstR, Lbl, Env) ->
+ {Movs,SrcVars,Env1} = get_constants_in_temps(SrcRs,Env),
+ DstVar = mk_var(DstR),
+ %%io:format("~w:trans_arith()\n ~w := ~w ~w\n",
+ %% [?MODULE,DstVar,SrcVars,Op]),
+ case Lbl of
+ 0 -> % Body arithmetic
+ Primop = hipe_icode:mk_primop([DstVar], arith_op_name(Op), SrcVars),
+ {Movs++[Primop], Env1};
+ _ -> % Guard arithmetic
+ {Guard,Env2} =
+ make_fallthrough_guard([DstVar], arith_op_name(Op), SrcVars,
+ map_label(Lbl), Env1),
+ {[Movs,Guard], Env2}
+ end.
+
+%% Prevent arbitrary names from leaking into Icode from BEAM.
+arith_op_name('+') -> '+';
+arith_op_name('-') -> '-';
+arith_op_name('*') -> '*';
+arith_op_name('/') -> '/';
+arith_op_name('div') -> 'div';
+arith_op_name('fp_add') -> 'fp_add';
+arith_op_name('fp_sub') -> 'fp_sub';
+arith_op_name('fp_mul') -> 'fp_mul';
+arith_op_name('fp_div') -> 'fp_div';
+arith_op_name('rem') -> 'rem';
+arith_op_name('bsl') -> 'bsl';
+arith_op_name('bsr') -> 'bsr';
+arith_op_name('band') -> 'band';
+arith_op_name('bor') -> 'bor';
+arith_op_name('bxor') -> 'bxor';
+arith_op_name('bnot') -> 'bnot'.
+
+%%-----------------------------------------------------------------------
+%%-----------------------------------------------------------------------
+
+trans_test_guard(TestOp,F,Arg1,Arg2,Env) ->
+ {Movs,Vars,Env1} = get_constants_in_temps([Arg1,Arg2],Env),
+ True = mk_label(new),
+ I = hipe_icode:mk_if(TestOp,Vars,hipe_icode:label_name(True),map_label(F)),
+ {[Movs,I,True], Env1}.
+
+%%-----------------------------------------------------------------------
+%%-----------------------------------------------------------------------
+
+make_fallthrough_guard(DstVar,GuardOp,Args,FailLName,Env) ->
+ ContL = mk_label(new),
+ ContLName = hipe_icode:label_name(ContL),
+ {Instrs, NewDsts} = clone_dsts(DstVar),
+ {Guard,Env1} = make_guard(NewDsts,GuardOp,Args,ContLName,FailLName,Env),
+ {[Guard,ContL]++Instrs,Env1}.
+
+%% Make sure DstVar gets initialised to a dummy value after a fail:
+%make_guard(Dests,{hipe_bs_primop,Primop},Args,ContLName,FailLName,Env) ->
+% {[hipe_icode:mk_guardop(Dests,{hipe_bs_primop,Primop},Args,ContLName,FailLName)],
+% Env};
+make_guard(Dests=[_|_],GuardOp,Args,ContLName,FailLName,Env) ->
+ TmpFailL = mk_label(new),
+ TmpFailLName = hipe_icode:label_name(TmpFailL),
+ GuardOpIns = hipe_icode:mk_guardop(Dests,GuardOp,Args,
+ ContLName,TmpFailLName),
+ FailCode = [TmpFailL,
+ nillify_all(Dests),
+ hipe_icode:mk_goto(FailLName)],
+ {[GuardOpIns|FailCode], Env};
+%% A guard that does not return anything:
+make_guard([],GuardOp,Args,ContLName,FailLName,Env) ->
+ {[hipe_icode:mk_guardop([],GuardOp,Args,ContLName,FailLName)],
+ Env}.
+
+nillify_all([Var|Vars]) ->
+ [hipe_icode:mk_move(Var,hipe_icode:mk_const([]))|nillify_all(Vars)];
+nillify_all([]) -> [].
+
+clone_dsts(Dests) ->
+ clone_dsts(Dests, [],[]).
+
+clone_dsts([Dest|Dests], Instrs, NewDests) ->
+ {I,ND} = clone_dst(Dest),
+ clone_dsts(Dests, [I|Instrs], [ND|NewDests]);
+clone_dsts([], Instrs, NewDests) ->
+ {lists:reverse(Instrs), lists:reverse(NewDests)}.
+
+clone_dst(Dest) ->
+ New =
+ case hipe_icode:is_reg(Dest) of
+ true ->
+ mk_var(reg);
+ false ->
+ true = hipe_icode:is_var(Dest),
+ mk_var(new)
+ end,
+ {hipe_icode:mk_move(Dest, New), New}.
+
+
+%%-----------------------------------------------------------------------
+%% trans_type_test(Test, Lbl, Arg, Env) -> { Icode, NewEnv }
+%% Handles all unary type tests like is_integer etc.
+%%-----------------------------------------------------------------------
+
+trans_type_test(Test, Lbl, Arg, Env) ->
+ True = mk_label(new),
+ {Move,Var,Env1} = mk_move_and_var(Arg,Env),
+ I = hipe_icode:mk_type([Var], Test,
+ hipe_icode:label_name(True), map_label(Lbl)),
+ {[Move,I,True],Env1}.
+
+%%
+%% This handles binary type tests. Currently, the only such is the new
+%% is_function/2 BIF.
+%%
+trans_type_test2(function2, Lbl, Arg, Arity, Env) ->
+ True = mk_label(new),
+ {Move1,Var1,Env1} = mk_move_and_var(Arg, Env),
+ {Move2,Var2,Env2} = mk_move_and_var(Arity, Env1),
+ I = hipe_icode:mk_type([Var1,Var2], function2,
+ hipe_icode:label_name(True), map_label(Lbl)),
+ {[Move1,Move2,I,True],Env2}.
+
+%%-----------------------------------------------------------------------
+%% trans_puts(Code, Environment) ->
+%% { Movs, Code, Vars, NewEnv }
+%%-----------------------------------------------------------------------
+
+trans_puts(Code, Env) ->
+ trans_puts(Code, [], [], Env).
+
+trans_puts([{put,X}|Code], Vars, Moves, Env) ->
+ case type(X) of
+ var ->
+ Var = mk_var(X),
+ trans_puts(Code, [Var|Vars], Moves, Env);
+ #beam_const{value=C} ->
+ Var = mk_var(new),
+ Move = hipe_icode:mk_move(Var, hipe_icode:mk_const(C)),
+ trans_puts(Code, [Var|Vars], [Move|Moves], Env)
+ end;
+trans_puts(Code, Vars, Moves, Env) -> %% No more put operations
+ {Moves, Code, Vars, Env}.
+
+%%-----------------------------------------------------------------------
+%% The code for this instruction is a bit large because we are treating
+%% different cases differently. We want to use the icode `type'
+%% instruction when it is applicable to take care of match expressions.
+%%-----------------------------------------------------------------------
+
+trans_is_eq_exact(Lbl, Arg1, Arg2, Env) ->
+ case {is_var(Arg1),is_var(Arg2)} of
+ {true,true} ->
+ True = mk_label(new),
+ I = hipe_icode:mk_if('=:=',
+ [mk_var(Arg1),mk_var(Arg2)],
+ hipe_icode:label_name(True), map_label(Lbl)),
+ {[I,True], Env};
+ {true,false} -> %% right argument is a constant -- use type()!
+ trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env);
+ {false,true} -> %% mirror of the case above; swap args
+ trans_is_eq_exact_var_const(Lbl, Arg2, Arg1, Env);
+ {false,false} -> %% both arguments are constants !!!
+ case Arg1 =:= Arg2 of
+ true ->
+ {[], Env};
+ false ->
+ Never = mk_label(new),
+ I = hipe_icode:mk_goto(map_label(Lbl)),
+ {[I,Never], Env}
+ end
+ end.
+
+trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env) -> % var =:= const
+ True = mk_label(new),
+ NewArg1 = mk_var(Arg1),
+ TrueLabName = hipe_icode:label_name(True),
+ FalseLabName = map_label(Lbl),
+ I = case Arg2 of
+ {float,Float} ->
+ hipe_icode:mk_if('=:=',
+ [NewArg1, hipe_icode:mk_const(Float)],
+ TrueLabName, FalseLabName);
+ {literal,Literal} ->
+ hipe_icode:mk_if('=:=',
+ [NewArg1, hipe_icode:mk_const(Literal)],
+ TrueLabName, FalseLabName);
+ _ ->
+ hipe_icode:mk_type([NewArg1], Arg2, TrueLabName, FalseLabName)
+ end,
+ {[I,True], Env}.
+
+%%-----------------------------------------------------------------------
+%% ... and this is analogous to the above
+%%-----------------------------------------------------------------------
+
+trans_is_ne_exact(Lbl, Arg1, Arg2, Env) ->
+ case {is_var(Arg1),is_var(Arg2)} of
+ {true,true} ->
+ True = mk_label(new),
+ I = hipe_icode:mk_if('=/=',
+ [mk_var(Arg1),mk_var(Arg2)],
+ hipe_icode:label_name(True), map_label(Lbl)),
+ {[I,True], Env};
+ {true,false} -> %% right argument is a constant -- use type()!
+ trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env);
+ {false,true} -> %% mirror of the case above; swap args
+ trans_is_ne_exact_var_const(Lbl, Arg2, Arg1, Env);
+ {false,false} -> %% both arguments are constants !!!
+ case Arg1 =/= Arg2 of
+ true ->
+ {[], Env};
+ false ->
+ Never = mk_label(new),
+ I = hipe_icode:mk_goto(map_label(Lbl)),
+ {[I,Never], Env}
+ end
+ end.
+
+trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env) -> % var =/= const
+ True = mk_label(new),
+ NewArg1 = mk_var(Arg1),
+ TrueLabName = hipe_icode:label_name(True),
+ FalseLabName = map_label(Lbl),
+ I = case Arg2 of
+ {float,Float} ->
+ hipe_icode:mk_if('=/=',
+ [NewArg1, hipe_icode:mk_const(Float)],
+ TrueLabName, FalseLabName);
+ {literal,Literal} ->
+ hipe_icode:mk_if('=/=',
+ [NewArg1, hipe_icode:mk_const(Literal)],
+ TrueLabName, FalseLabName);
+ _ ->
+ hipe_icode:mk_type([NewArg1], Arg2, FalseLabName, TrueLabName)
+ end,
+ {[I,True], Env}.
+
+%%-----------------------------------------------------------------------
+%% Try to do a relatively straightforward optimization: if equality with
+%% an atom is used, then convert this test to use of exact equality test
+%% with the same atom (which in turn will be translated to a `type' test
+%% instruction by the code of trans_is_eq_exact_var_const/4 above).
+%%-----------------------------------------------------------------------
+
+trans_is_eq(Lbl, Arg1, Arg2, Env) ->
+ case {is_var(Arg1),is_var(Arg2)} of
+ {true,true} -> %% not much can be done in this case
+ trans_test_guard('==', Lbl, Arg1, Arg2, Env);
+ {true,false} -> %% optimize this case, if possible
+ case Arg2 of
+ {atom,_SomeAtom} ->
+ trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env);
+ _ ->
+ trans_test_guard('==', Lbl, Arg1, Arg2, Env)
+ end;
+ {false,true} -> %% probably happens rarely; hence the recursive call
+ trans_is_eq(Lbl, Arg2, Arg1, Env);
+ {false,false} -> %% both arguments are constants !!!
+ case Arg1 == Arg2 of
+ true ->
+ {[], Env};
+ false ->
+ Never = mk_label(new),
+ I = hipe_icode:mk_goto(map_label(Lbl)),
+ {[I,Never], Env}
+ end
+ end.
+
+%%-----------------------------------------------------------------------
+%% ... and this is analogous to the above
+%%-----------------------------------------------------------------------
+
+trans_is_ne(Lbl, Arg1, Arg2, Env) ->
+ case {is_var(Arg1),is_var(Arg2)} of
+ {true,true} -> %% not much can be done in this case
+ trans_test_guard('/=', Lbl, Arg1, Arg2, Env);
+ {true,false} -> %% optimize this case, if possible
+ case Arg2 of
+ {atom,_SomeAtom} ->
+ trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env);
+ _ ->
+ trans_test_guard('/=', Lbl, Arg1, Arg2, Env)
+ end;
+ {false,true} -> %% probably happens rarely; hence the recursive call
+ trans_is_ne(Lbl, Arg2, Arg1, Env);
+ {false,false} -> %% both arguments are constants !!!
+ case Arg1 /= Arg2 of
+ true ->
+ {[], Env};
+ false ->
+ Never = mk_label(new),
+ I = hipe_icode:mk_goto(map_label(Lbl)),
+ {[I,Never], Env}
+ end
+ end.
+
+
+%%-----------------------------------------------------------------------
+%% Translates an allocate instruction into a sequence of initializations
+%%-----------------------------------------------------------------------
+
+trans_allocate(N) ->
+ trans_allocate(N, []).
+
+trans_allocate(0, Acc) ->
+ Acc;
+trans_allocate(N, Acc) ->
+ Move = hipe_icode:mk_move(mk_var({y,N-1}),
+ hipe_icode:mk_const('dummy_value')),
+ trans_allocate(N-1, [Move|Acc]).
+
+%%-----------------------------------------------------------------------
+%% Translates a trim instruction into a sequence of moves
+%%-----------------------------------------------------------------------
+
+trans_trim(N, NY) ->
+ lists:reverse(trans_trim(N, NY, 0, [])).
+
+trans_trim(_, 0, _, Acc) ->
+ Acc;
+trans_trim(N, NY, Y, Acc) ->
+ Move = hipe_icode:mk_move(mk_var({y,Y}), mk_var({y,N})),
+ trans_trim(N+1, NY-1, Y+1, [Move|Acc]).
+
+%%-----------------------------------------------------------------------
+%%-----------------------------------------------------------------------
+
+mk_move_and_var(Var, Env) ->
+ case type(Var) of
+ var ->
+ V = mk_var(Var),
+ {[], V, Env};
+ #beam_const{value=C} ->
+ V = mk_var(new),
+ {[hipe_icode:mk_move(V,hipe_icode:mk_const(C))], V, Env}
+ end.
+
+%%-----------------------------------------------------------------------
+%% Find names of closures and number of free vars.
+%%-----------------------------------------------------------------------
+
+closure_info_mfa(#closure_info{mfa=MFA}) -> MFA.
+closure_info_arity(#closure_info{arity=Arity}) -> Arity.
+%% closure_info_fv_arity(#closure_info{fv_arity=Arity}) -> Arity.
+
+find_closure_info(Code) -> mod_find_closure_info(Code, []).
+
+mod_find_closure_info([FunCode|Fs], CI) ->
+ mod_find_closure_info(Fs, find_closure_info(FunCode, CI));
+mod_find_closure_info([], CI) ->
+ CI.
+
+find_closure_info([{patched_make_fun,MFA={_M,_F,A},_Magic,FreeVarNum,_Index}|BeamCode],
+ ClosureInfo) ->
+ NewClosure = %% A-FreeVarNum+1 (The real arity + 1 for the closure)
+ #closure_info{mfa=MFA, arity=A-FreeVarNum+1, fv_arity=FreeVarNum},
+ find_closure_info(BeamCode, [NewClosure|ClosureInfo]);
+find_closure_info([_Inst|BeamCode], ClosureInfo) ->
+ find_closure_info(BeamCode, ClosureInfo);
+find_closure_info([], ClosureInfo) ->
+ ClosureInfo.
+
+%%-----------------------------------------------------------------------
+%% Is closure
+%%-----------------------------------------------------------------------
+
+get_closure_info(MFA, [CI|Rest]) ->
+ case closure_info_mfa(CI) of
+ MFA -> CI;
+ _ -> get_closure_info(MFA, Rest)
+ end;
+get_closure_info(_, []) ->
+ not_a_closure.
+
+%%-----------------------------------------------------------------------
+%% Patch closure entry.
+%%-----------------------------------------------------------------------
+
+%% NOTE: this changes the number of parameters in the ICode function,
+%% but does *not* change the arity in the function name. Thus, all
+%% closure-functions have the exact same names in Beam and in native
+%% code, although they have different calling conventions.
+
+patch_closure_entry(Icode, ClosureInfo)->
+ Arity = closure_info_arity(ClosureInfo),
+ %% ?msg("Arity ~w\n",[Arity]),
+ {Args, Closure, FreeVars} =
+ split_params(Arity, hipe_icode:icode_params(Icode), []),
+ [Start|_] = hipe_icode:icode_code(Icode),
+ {_LMin, LMax} = hipe_icode:icode_label_range(Icode),
+ hipe_gensym:set_label(icode,LMax+1),
+ {_VMin, VMax} = hipe_icode:icode_var_range(Icode),
+ hipe_gensym:set_var(icode,VMax+1),
+ MoveCode = gen_get_free_vars(FreeVars, Closure,
+ hipe_icode:label_name(Start)),
+ Icode1 = hipe_icode:icode_code_update(Icode, MoveCode ++
+ hipe_icode:icode_code(Icode)),
+ Icode2 = hipe_icode:icode_params_update(Icode1, Args),
+ %% Arity - 1 since the original arity did not have the closure argument.
+ Icode3 = hipe_icode:icode_closure_arity_update(Icode2, Arity-1),
+ Icode3.
+
+%%-----------------------------------------------------------------------
+
+gen_get_free_vars(Vars, Closure, StartName) ->
+ [hipe_icode:mk_new_label()] ++
+ get_free_vars(Vars, Closure, 1, []) ++ [hipe_icode:mk_goto(StartName)].
+
+get_free_vars([V|Vs], Closure, No, MoveCode) ->
+ %% TempV = hipe_icode:mk_new_var(),
+ get_free_vars(Vs, Closure, No+1,
+ [%% hipe_icode:mk_move(TempV,hipe_icode:mk_const(No)),
+ hipe_icode:mk_primop([V], #closure_element{n=No}, [Closure])
+ |MoveCode]);
+get_free_vars([],_,_,MoveCode) ->
+ MoveCode.
+
+%%-----------------------------------------------------------------------
+
+split_params(1, [Closure|_OrgArgs] = Params, Args) ->
+ {lists:reverse([Closure|Args]), Closure, Params};
+split_params(1, [], Args) ->
+ Closure = hipe_icode:mk_new_var(),
+ {lists:reverse([Closure|Args]), Closure, []};
+split_params(N, [ArgN|OrgArgs], Args) ->
+ split_params(N-1, OrgArgs, [ArgN|Args]).
+
+%%-----------------------------------------------------------------------
+
+preprocess_code(ModuleCode) ->
+ PatchedCode = patch_R7_funs(ModuleCode),
+ ClosureInfo = find_closure_info(PatchedCode),
+ {PatchedCode, ClosureInfo}.
+
+%%-----------------------------------------------------------------------
+%% Patches the "make_fun" BEAM instructions of R7 so that they also
+%% contain the index that the BEAM loader generates for funs.
+%%
+%% The index starts from 0 and is incremented by 1 for each make_fun
+%% instruction encountered.
+%%
+%% Retained only for compatibility with BEAM code prior to R8.
+%%
+%% Temporarily, it also rewrites R8-PRE-RELEASE "make_fun2"
+%% instructions, since their embedded indices don't work.
+%%-----------------------------------------------------------------------
+
+patch_R7_funs(ModuleCode) ->
+ patch_make_funs(ModuleCode, 0).
+
+patch_make_funs([FunCode0|Fs], FunIndex0) ->
+ {PatchedFunCode,FunIndex} = patch_make_funs(FunCode0, FunIndex0, []),
+ [PatchedFunCode|patch_make_funs(Fs, FunIndex)];
+patch_make_funs([], _) -> [].
+
+patch_make_funs([{make_fun,MFA,Magic,FreeVarNum}|Is], FunIndex, Acc) ->
+ Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex},
+ patch_make_funs(Is, FunIndex+1, [Patched|Acc]);
+patch_make_funs([{make_fun2,MFA,_BogusIndex,Magic,FreeVarNum}|Is], FunIndex, Acc) ->
+ Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex},
+ patch_make_funs(Is, FunIndex+1, [Patched|Acc]);
+patch_make_funs([I|Is], FunIndex, Acc) ->
+ patch_make_funs(Is, FunIndex, [I|Acc]);
+patch_make_funs([], FunIndex, Acc) ->
+ {lists:reverse(Acc),FunIndex}.
+
+%%-----------------------------------------------------------------------
+
+find_mfa([{label,_}|Code]) ->
+ find_mfa(Code);
+find_mfa([{func_info,{atom,M},{atom,F},A}|_])
+ when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 ->
+ {M, F, A}.
+
+%%-----------------------------------------------------------------------
+
+%% Localize a particular function in a module
+get_fun([[L, {func_info,{atom,M},{atom,F},A} | Is] | _], M,F,A) ->
+ [L, {func_info,{atom,M},{atom,F},A} | Is];
+get_fun([[_L1,_L2, {func_info,{atom,M},{atom,F},A} = MFA| _Is] | _], M,F,A) ->
+ ?WARNING_MSG("Consecutive labels found; please re-create the .beam file~n", []),
+ [_L1,_L2, MFA | _Is];
+get_fun([_|Rest], M,F,A) ->
+ get_fun(Rest, M,F,A).
+
+%%-----------------------------------------------------------------------
+%% Takes a list of arguments and returns the constants of them into
+%% fresh temporaries. Return a triple consisting of a list of move
+%% instructions, a list of proper icode arguments and the new environment.
+%%-----------------------------------------------------------------------
+
+get_constants_in_temps(Args, Env) ->
+ get_constants_in_temps(Args, [], [], Env).
+
+get_constants_in_temps([Arg|Args], Instrs, Temps, Env) ->
+ case get_constant_in_temp(Arg, Env) of
+ {none,ArgVar,Env1} ->
+ get_constants_in_temps(Args, Instrs, [ArgVar|Temps], Env1);
+ {Instr,Temp,Env1} ->
+ get_constants_in_temps(Args, [Instr|Instrs], [Temp|Temps], Env1)
+ end;
+get_constants_in_temps([], Instrs, Temps, Env) ->
+ {lists:reverse(Instrs), lists:reverse(Temps), Env}.
+
+%% If Arg is a constant then put Arg in a fresh temp!
+get_constant_in_temp(Arg, Env) ->
+ case is_var(Arg) of
+ true -> % Convert into Icode variable format before return
+ {none, mk_var(Arg), Env};
+ false -> % Create a new temp and move the constant into it
+ Temp = mk_var(new),
+ Const = trans_const(Arg),
+ {hipe_icode:mk_move(Temp, Const), Temp, Env}
+ end.
+
+%%-----------------------------------------------------------------------
+%% Makes a list of function arguments.
+%%-----------------------------------------------------------------------
+
+extract_fun_args(A) ->
+ lists:reverse(extract_fun_args1(A)).
+
+extract_fun_args1(0) ->
+ [];
+extract_fun_args1(1) ->
+ [mk_var({r,0})];
+extract_fun_args1(N) ->
+ [mk_var({x,N-1}) | extract_fun_args1(N-1)].
+
+%%-----------------------------------------------------------------------
+%% Auxiliary translation for arguments of select_val & select_tuple_arity
+%%-----------------------------------------------------------------------
+
+trans_select_stuff(Reg, CaseList) ->
+ SwVar = case is_var(Reg) of
+ true ->
+ mk_var(Reg);
+ false ->
+ trans_const(Reg)
+ end,
+ CasePairs = trans_case_list(CaseList),
+ {SwVar,CasePairs}.
+
+trans_case_list([Symbol,{f,Lbl}|L]) ->
+ [{trans_const(Symbol),map_label(Lbl)} | trans_case_list(L)];
+trans_case_list([]) ->
+ [].
+
+%%-----------------------------------------------------------------------
+%% Makes an Icode argument from a BEAM argument.
+%%-----------------------------------------------------------------------
+
+trans_arg(Arg) ->
+ case is_var(Arg) of
+ true ->
+ mk_var(Arg);
+ false ->
+ trans_const(Arg)
+ end.
+
+%%-----------------------------------------------------------------------
+%% Makes an Icode constant from a BEAM constant.
+%%-----------------------------------------------------------------------
+
+trans_const(Const) ->
+ case Const of
+ {atom,Atom} when is_atom(Atom) ->
+ hipe_icode:mk_const(Atom);
+ {integer,N} when is_integer(N) ->
+ hipe_icode:mk_const(N);
+ {float,Float} when is_float(Float) ->
+ hipe_icode:mk_const(Float);
+ {string,String} ->
+ hipe_icode:mk_const(String);
+ {literal,Literal} ->
+ hipe_icode:mk_const(Literal);
+ nil ->
+ hipe_icode:mk_const([]);
+ Int when is_integer(Int) ->
+ hipe_icode:mk_const(Int)
+ end.
+
+%%-----------------------------------------------------------------------
+%% Make an icode variable of proper type
+%% (Variables mod 5) =:= 0 are X regs
+%% (Variables mod 5) =:= 1 are Y regs
+%% (Variables mod 5) =:= 2 are FR regs
+%% (Variables mod 5) =:= 3 are new temporaries
+%% (Variables mod 5) =:= 4 are new register temporaries
+%% Tell hipe_gensym to update its state for each new thing created!!
+%%-----------------------------------------------------------------------
+
+mk_var({r,0}) ->
+ hipe_icode:mk_var(0);
+mk_var({x,R}) when is_integer(R) ->
+ V = 5*R,
+ hipe_gensym:update_vrange(icode,V),
+ hipe_icode:mk_var(V);
+mk_var({y,R}) when is_integer(R) ->
+ V = (5*R)+1,
+ hipe_gensym:update_vrange(icode,V),
+ hipe_icode:mk_var(V);
+mk_var({fr,R}) when is_integer(R) ->
+ V = (5*R)+2,
+ hipe_gensym:update_vrange(icode,V),
+ case get(hipe_inline_fp) of
+ true ->
+ hipe_icode:mk_fvar(V);
+ _ ->
+ hipe_icode:mk_var(V)
+ end;
+mk_var(new) ->
+ T = hipe_gensym:new_var(icode),
+ V = (5*T)+3,
+ hipe_gensym:update_vrange(icode,V),
+ hipe_icode:mk_var(V);
+mk_var(reg) ->
+ T = hipe_gensym:new_var(icode),
+ V = (5*T)+4,
+ hipe_gensym:update_vrange(icode,V),
+ hipe_icode:mk_reg(V).
+
+%%-----------------------------------------------------------------------
+%% Make an icode label of proper type
+%% (Labels mod 2) =:= 0 are actually occuring in the BEAM code
+%% (Labels mod 2) =:= 1 are new labels generated by the translation
+%%-----------------------------------------------------------------------
+
+mk_label(L) when is_integer(L) ->
+ LL = 2 * L,
+ hipe_gensym:update_lblrange(icode, LL),
+ hipe_icode:mk_label(LL);
+mk_label(new) ->
+ L = hipe_gensym:new_label(icode),
+ LL = (2 * L) + 1,
+ hipe_gensym:update_lblrange(icode, LL),
+ hipe_icode:mk_label(LL).
+
+%% Maps from the BEAM's labelling scheme to our labelling scheme.
+%% See mk_label to understand how it works.
+
+map_label(L) ->
+ L bsl 1. % faster and more type-friendly version of 2 * L
+
+%%-----------------------------------------------------------------------
+%% Returns the type of the given variables.
+%%-----------------------------------------------------------------------
+
+type({x,_}) ->
+ var;
+type({y,_}) ->
+ var;
+type({fr,_}) ->
+ var;
+type({atom,A}) when is_atom(A) ->
+ #beam_const{value=A};
+type(nil) ->
+ #beam_const{value=[]};
+type({integer,X}) when is_integer(X) ->
+ #beam_const{value=X};
+type({float,X}) when is_float(X) ->
+ #beam_const{value=X};
+type({literal,X}) ->
+ #beam_const{value=X}.
+
+%%-----------------------------------------------------------------------
+%% Returns true iff the argument is a variable.
+%%-----------------------------------------------------------------------
+
+is_var({x,_}) ->
+ true;
+is_var({y,_}) ->
+ true;
+is_var({fr,_}) ->
+ true;
+is_var({atom,A}) when is_atom(A) ->
+ false;
+is_var(nil) ->
+ false;
+is_var({integer,N}) when is_integer(N) ->
+ false;
+is_var({float,F}) when is_float(F) ->
+ false;
+is_var({literal,_Literal}) ->
+ false.
+
+%%-----------------------------------------------------------------------
+%% Fixes the code for catches by adding some code.
+%%-----------------------------------------------------------------------
+
+fix_catches(Code) ->
+ fix_catches(Code, gb_trees:empty()).
+
+%% We need to handle merged catch blocks, that is multiple 'catch' with
+%% only one 'catch_end', or multiple 'try' with one 'try_case'. (Catch
+%% and try can never be merged.) All occurrences of 'catch' or 'try'
+%% with a particular fail-to label are assumed to only occur before the
+%% corresponding 'catch_end'/'try_end' in the Beam code.
+
+fix_catches([{'catch',N,Lbl},ContLbl|Code], HandledCatchLbls) ->
+ fix_catch('catch',Lbl,ContLbl,Code,HandledCatchLbls,{catch_end,N});
+fix_catches([{'try',N,Lbl},ContLbl|Code], HandledCatchLbls) ->
+ fix_catch('try',Lbl,ContLbl,Code,HandledCatchLbls,{try_case,N});
+fix_catches([Instr|Code], HandledCatchLbls) ->
+ [Instr|fix_catches(Code, HandledCatchLbls)];
+fix_catches([], _HandledCatchLbls) ->
+ [].
+
+fix_catch(Type, Lbl, ContLbl, Code, HandledCatchLbls, Instr) ->
+ TLbl = {Type, Lbl},
+ case gb_trees:lookup(TLbl, HandledCatchLbls) of
+ {value, Catch} when is_integer(Catch) ->
+ NewCode = fix_catches(Code, HandledCatchLbls),
+ Cont = hipe_icode:label_name(ContLbl),
+ [hipe_icode:mk_begin_try(Catch,Cont),ContLbl | NewCode];
+ none ->
+ OldCatch = map_label(Lbl),
+ OldCatchLbl = hipe_icode:mk_label(OldCatch),
+ {CodeToCatch,RestOfCode} = split_code(Code,OldCatchLbl,Instr),
+ NewCatchLbl = mk_label(new),
+ NewCatch = hipe_icode:label_name(NewCatchLbl),
+ %% The rest of the code cannot contain catches with the same label.
+ RestOfCode1 = fix_catches(RestOfCode, HandledCatchLbls),
+ %% The catched code *can* contain more catches with the same label.
+ NewHandledCatchLbls = gb_trees:insert(TLbl, NewCatch, HandledCatchLbls),
+ CatchedCode = fix_catches(CodeToCatch, NewHandledCatchLbls),
+ %% The variables which will get the tag, value, and trace.
+ Vars = [mk_var({r,0}), mk_var({x,1}), mk_var({x,2})],
+ Cont = hipe_icode:label_name(ContLbl),
+ [hipe_icode:mk_begin_try(NewCatch,Cont), ContLbl]
+ ++ CatchedCode
+ ++ [mk_label(new), % dummy label before the goto
+ hipe_icode:mk_goto(OldCatch), % normal execution path
+ NewCatchLbl, % exception handing enters here
+ hipe_icode:mk_begin_handler(Vars)]
+ ++ catch_handler(Type, Vars, OldCatchLbl)
+ ++ RestOfCode1 % back to normal execution
+ end.
+
+catch_handler('try', _Vars, OldCatchLbl) ->
+ %% A try just falls through to the old fail-to label which marked the
+ %% start of the try_case block. All variables are set up as expected.
+ [OldCatchLbl];
+catch_handler('catch', [TagVar,ValueVar,TraceVar], OldCatchLbl) ->
+ %% This basically implements a catch as a try-expression. We must jump
+ %% to the given end label afterwards so we don't pass through both the
+ %% begin_handler and the end_try.
+ ContLbl = mk_label(new),
+ Cont = hipe_icode:label_name(ContLbl),
+ ThrowLbl = mk_label(new),
+ NoThrowLbl = mk_label(new),
+ ExitLbl = mk_label(new),
+ ErrorLbl = mk_label(new),
+ Dst = mk_var({r,0}),
+ [hipe_icode:mk_if('=:=', [TagVar, hipe_icode:mk_const('throw')],
+ hipe_icode:label_name(ThrowLbl),
+ hipe_icode:label_name(NoThrowLbl)),
+ ThrowLbl,
+ hipe_icode:mk_move(Dst, ValueVar),
+ hipe_icode:mk_goto(Cont),
+ NoThrowLbl,
+ hipe_icode:mk_if('=:=', [TagVar, hipe_icode:mk_const('exit')],
+ hipe_icode:label_name(ExitLbl),
+ hipe_icode:label_name(ErrorLbl)),
+ ExitLbl,
+ hipe_icode:mk_primop([Dst],mktuple,[hipe_icode:mk_const('EXIT'),
+ ValueVar]),
+ hipe_icode:mk_goto(Cont),
+ ErrorLbl,
+ %% We use the trace variable to hold the symbolic trace. Its previous
+ %% value is just that in p->ftrace, so get_stacktrace() works fine.
+ hipe_icode:mk_call([TraceVar],erlang,get_stacktrace,[],remote),
+ hipe_icode:mk_primop([ValueVar],mktuple, [ValueVar, TraceVar]),
+ hipe_icode:mk_goto(hipe_icode:label_name(ExitLbl)),
+ OldCatchLbl, % normal execution paths must go through end_try
+ hipe_icode:mk_end_try(),
+ hipe_icode:mk_goto(Cont),
+ ContLbl].
+
+%% Note that it is the fail-to label that is the important thing, but
+%% for 'catch' we want to make sure that the label is followed by the
+%% 'catch_end' instruction - if it is not, we might have a real problem.
+%% Checking that a 'try' label is followed by 'try_case' is not as
+%% important, but we get that as a bonus.
+
+split_code([First|Code], Label, Instr) ->
+ split_code(Code, Label, Instr, First, []).
+
+split_code([Instr|Code], Label, Instr, Prev, As) when Prev =:= Label ->
+ split_code_final(Code, As); % drop both label and instruction
+split_code([Other|_Code], Label, Instr, Prev, _As) when Prev =:= Label ->
+ ?EXIT({missing_instr_after_label, Label, Instr, [Other, Prev | _As]});
+split_code([Other|Code], Label, Instr, Prev, As) ->
+ split_code(Code, Label, Instr, Other, [Prev|As]);
+split_code([], _Label, _Instr, Prev, As) ->
+ split_code_final([], [Prev|As]).
+
+split_code_final(Code, As) ->
+ {lists:reverse(As), Code}.
+
+%%-----------------------------------------------------------------------
+%% Fixes fallthroughs
+%%-----------------------------------------------------------------------
+
+fix_fallthroughs([]) ->
+ [];
+fix_fallthroughs([I|Is]) ->
+ fix_fallthroughs(Is, I, []).
+
+fix_fallthroughs([I1|Is], I0, Acc) ->
+ case hipe_icode:is_label(I1) of
+ false ->
+ fix_fallthroughs(Is, I1, [I0 | Acc]);
+ true ->
+ case hipe_icode:is_branch(I0) of
+ true ->
+ fix_fallthroughs(Is, I1, [I0 | Acc]);
+ false ->
+ %% non-branch before label - insert a goto
+ Goto = hipe_icode:mk_goto(hipe_icode:label_name(I1)),
+ fix_fallthroughs(Is, I1, [Goto, I0 | Acc])
+ end
+ end;
+fix_fallthroughs([], I, Acc) ->
+ lists:reverse([I | Acc]).
+
+%%-----------------------------------------------------------------------
+%% Removes the code between a fail instruction and the closest following
+%% label.
+%%-----------------------------------------------------------------------
+
+-spec remove_dead_code(icode_instrs()) -> icode_instrs().
+remove_dead_code([I|Is]) ->
+ case I of
+ #icode_fail{} ->
+ [I|remove_dead_code(skip_to_label(Is))];
+ _ ->
+ [I|remove_dead_code(Is)]
+ end;
+remove_dead_code([]) ->
+ [].
+
+%% returns the instructions from the closest label
+-spec skip_to_label(icode_instrs()) -> icode_instrs().
+skip_to_label([I|Is] = Instrs) ->
+ case I of
+ #icode_label{} -> Instrs;
+ _ -> skip_to_label(Is)
+ end;
+skip_to_label([]) ->
+ [].
+
+%%-----------------------------------------------------------------------
+%% This needs to be extended in case new architectures are added.
+%%-----------------------------------------------------------------------
+
+resolve_native_endianess(Flags) ->
+ case {Flags band 16#10, hipe_rtl_arch:endianess()} of
+ {16#10, big} ->
+ Flags band 5;
+ {16#10, little} ->
+ (Flags bor 2) band 7;
+ _ ->
+ Flags band 7
+ end.
+
+%%-----------------------------------------------------------------------
+%% Potentially useful for debugging.
+%%-----------------------------------------------------------------------
+
+pp_beam(BeamCode, Options) ->
+ case proplists:get_value(pp_beam, Options) of
+ true ->
+ pp(BeamCode);
+ {file,FileName} ->
+ {ok,File} = file:open(FileName, [write]),
+ pp(File, BeamCode);
+ _ -> %% includes "false" case
+ ok
+ end.
+
+pp(Code) ->
+ pp(standard_io, Code).
+
+pp(Stream, []) ->
+ case Stream of %% I am not sure whether this is necessary
+ standard_io -> ok;
+ _ -> ok = file:close(Stream)
+ end;
+pp(Stream, [FunCode|FunCodes]) ->
+ pp_mfa(Stream, FunCode),
+ put_nl(Stream),
+ pp(Stream, FunCodes).
+
+pp_mfa(Stream, FunCode) ->
+ lists:foreach(fun(Instr) -> print_instr(Stream, Instr) end, FunCode).
+
+print_instr(Stream, {label,Lbl}) ->
+ io:format(Stream, " label ~p:\n", [Lbl]);
+print_instr(Stream, Op) ->
+ io:format(Stream, " ~p\n", [Op]).
+
+put_nl(Stream) ->
+ io:format(Stream, "\n", []).
+
+%%-----------------------------------------------------------------------
+%% Handling of environments -- used to process local tail calls.
+%%-----------------------------------------------------------------------
+
+%% Construct an environment
+env__mk_env(M, F, A, Entry) ->
+ #environment{mfa={M,F,A}, entry=Entry}.
+
+%% Get current MFA
+env__get_mfa(#environment{mfa=MFA}) -> MFA.
+
+%% Get entry point of the current function
+env__get_entry(#environment{entry=EP}) -> EP.
+
+%%-----------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl
new file mode 100644
index 0000000000..a4614d7237
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode.erl
@@ -0,0 +1,1820 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% HiPE Intermediate Code
+%% ====================================================================
+%% Filename : hipe_icode.erl
+%% Module : hipe_icode
+%% Purpose : Provide primops for the Icode data structure.
+%% History : 1997-? Erik Johansson (happi@it.uu.se): Created.
+%% 2001-01-30 EJ (happi@it.uu.se):
+%% Apply, primop, guardop removed
+%% 2003-03-15 ES (happi@acm.org):
+%% Started commenting in Edoc.
+%% Moved pretty printer to separate file.
+%%
+%% $Id$
+%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%@doc
+%% This module implements "Linear Icode" and Icode instructions.
+%%
+%% <p> Icode is a simple (in that it has few instructions) imperative
+%% language, used as the first Intermediate Code in the HiPE compiler.
+%% Icode is closely related to Erlang, and Icode instructions operate
+%% on Erlang terms. </p>
+%%
+%% <h2><a href="#type-icode">Icode</a></h2>
+%%
+%% <p> Linear Icode for a function consists of:
+%% <ul>
+%% <li> the function's name (`{M,F,A}'), </li>
+%% <li> a list of parameters, </li>
+%% <li> a list of instructions, </li>
+%% <li> data, </li>
+%% <li> information about whether the function is a leaf function, </li>
+%% <li> information about whether the function is a closure, and </li>
+%% <li> the range for labels and variables in the code. </li>
+%% </ul>
+%% </p>
+%%
+%% <h2><a href="#type-icode_instruction">Icode Instructions</a> (and
+%% their components)</h2>
+%%
+%% Control flow:
+%% <dl>
+%% <dt><code><a href="#type-if">'if'</a>
+%% {Cond::<a href="#type-cond">cond()</a>,
+%% Args::[<a href="#type-arg">arg()</a>],
+%% TrueLabel::<a href="#type-label_name">label_name()</a>,
+%% FalseLabel::<a href="#type-label_name">label_name()</a>
+%% } ::
+%% <a href="#type-icode_instruction">icode_instr()</a></code></dt>
+%% <dd>
+%% The if instruction compares the arguments (Args) with
+%% condition (Cond) and jumps to either TrueLabel or
+%% FalseLabel. (At the moment...) There are only binary
+%% conditions so the number of arguments should be two.
+%% <p>
+%% An if instructions ends a basic block and should be followed
+%% by a label (or be the last instruction of the code).
+%% </p></dd>
+%%
+%% <dt><code><a href="#type-switch_val">switch_val</a>
+%% {Term::<a href="#type-arg">var()</a>,
+%% FailLabel::<a href="#type-label_name">label_name()</a>,
+%% Length::integer(),
+%% Cases::[{<a href="#type-symbol">symbol()</a>,<a
+%% href="#type-label_name">label_name()</a>}]
+%% }::
+%% <a href="#type-icode_instruction">icode_instr()</a></code></dt>
+%% <dd>
+%% The switch_val instruction compares the argument Term to the
+%% symbols in the lists Cases, control is transfered to the label
+%% that corresponds to the first symbol that matches. If no
+%% symbol matches control is transfered to FailLabel. (NOTE: The
+%% length argument is not currently in use.)
+%% <p>
+%% The switch_val instruction can be assumed to be implemented as
+%% efficiently as possible given the symbols in the case
+%% list. (Jump-table, bianry-serach, or nested ifs)
+%% </p><p>
+%% A switch_val instructions ends a basic block and should be
+%% followed by a label (or be the last instruction of the code).
+%% </p></dd>
+%%
+%% <dt><code><a href="#type-switch_tuple_arity">switch_tuple_arity</a>
+%% {Term::<a href="#type-arg">var()</a>,
+%% FailLabel::<a href="#type-label_name">label_name()</a>,
+%% Length::integer(),
+%% Cases::[{integer(),<a href="#type-label_name">label_name()</a>}]
+%% }::
+%% <a href="#type-icode_instruction">icode_instr()</a></code></dt>
+%% <dd>
+%% The switch_tuple_arity instruction compares the size of the
+%% tuple in the argument Term to the integers in the lists Cases,
+%% control is transfered to the label that corresponds to the
+%% first integer that matches. If no integer matches control is
+%% transfered to FailLabel. (NOTE: The length argument is not
+%% currently in use.)
+%% <p>
+%% The switch_tuple_arity instruction can be assumed to be
+%% implemented as efficently as possible given the symbols in the
+%% case list. (Jump-table, bianry-serach, or nested ifs)
+%% </p><p>
+%% A switch_tuple_arity instructions ends a basic block and
+%% should be followed by a label (or be the last instruction of
+%% the code).
+%% </p></dd>
+%%
+%% <dt>`type {typ_expr, arg, true_label, false_label}}'</dt>
+%% <dt>`goto {label}'</dt>
+%% <dt>`label {name}'</dt>
+%% </dl>
+%%
+%% Moves:
+%% <dl>
+%% <dt>`move {dst, src}'</dt>
+%% <dt>`phi {dst, arglist}'</dt>
+%% </dl>
+%%
+%% Function application:
+%% <dl>
+%% <dt>`call {[dst], fun, [arg], type, continuation, fail,
+%% in_guard}'</dt>
+%% <dd>
+%% Where `type' is one of {`local', `remote', `primop'}
+%% and `in_guard' is either `true' or `false'.</dd>
+%% <dt>`enter {fun, [arg], type}'</dt>
+%% <dd>
+%% Where `type' is one of {`local', `remote', `primop'}
+%% and `in_guard' is either `true' or `false'.</dd>
+%% <dt>`return {[var]}'</dt>
+%% <dd>
+%% <strong>WARNING:</strong> Multiple return values are yet not
+%% fully implemented and tested.
+%% </dd>
+%% </dl>
+%%
+%% Error handling:
+%% <dl>
+%% <dt>`begin_try {label, successor}'</dt>
+%% <dt>`end_try'</dt>
+%% <dt>`begin_handler {dstlist}'</dt>
+%% <dt>`fail {Args, Class}'</dt>
+%% <dd>Where `Class' is one of
+%% {`exit', `throw', `error', `rethrow'}. For `error/2', `[args]'
+%% is `[Reason,Trace]'. For `rethrow', `Args' is
+%% `[Exception,Reason]' - this only occurs in autogenerated code.
+%% </dd>
+%% </dl>
+%%
+%% Comments:
+%% <dl>
+%% <dt>`comment{Text::string()}'</dt>
+%% </dl>
+%%
+%% <h4>Notes</h4>
+%%
+%% <p> A constant can only show up on the RHS of a `move' instruction
+%% and in `if' and `switch_*'</p>
+%% <p>
+%% Classification of primops should be like this:
+%% <ul>
+%% <li> `erlang:exit/1, erlang:throw/1, erlang:error/1,
+%% erlang:error/2, erlang:fault/1',
+%% and `erlang:fault/2' should use the
+%% {@link fail(). fail-instruction} in Icode.</li>
+%% <li> Calls or tail-recursive calls to BIFs, operators, or internal
+%% functions should be implemented with `call' or `enter'
+%% respectively, with the primop flag set.</li>
+%% <li> All other Erlang functions should be implemented with `call'
+%% or `enter' respectively, without the primop flag set.</li>
+%% </ul>
+%% </p>
+%%
+%% <h4>Primops</h4>
+%%
+%% <pre>
+%% Constructors:
+%% cons - [Car, Cdr]
+%% mktuple - [Element1, Element2, ..., ElementN]
+%% call_fun - [BoundArg1, ..., BoundArgN, Fun]
+%% enter_fun - [BoundArg1, ..., BoundArgN, Fun]
+%% #mkfun{} - [FreeVar1, FreeVar2, ..., FreeVarN]
+%%
+%% Binaries:
+%% bs_init
+%% {bs_put_string, Bytes, Size}
+%% bs_final
+%%
+%% Selectors:
+%% element - [Index, Tuple]
+%% unsafe_hd - [List]
+%% unsafe_tl - [List]
+%% #unsafe_element{} - [Tuple]
+%% #unsafe_update_element{} - [Tuple, Val]
+%% #closure_element{} - [Fun]
+%%
+%% Arithmetic: [Arg1, Arg2]
+%% '+', '-', '*', '/', 'div', 'rem',
+%% 'band', 'bor', 'bxor', 'bnot', 'bsl', 'bsr'
+%%
+%% Receive:
+%% check_get_msg - []
+%% next_msg - []
+%% select_msg - []
+%% set_timeout - [Timeout]
+%% clear_timeout - []
+%% suspend_msg - []
+%%
+%% </pre>
+%%
+%% <h4>Guardops: (primops that can be used in guards and can fail)</h4>
+%% <pre>
+%% Selectors:
+%% unsafe_hd - [List]
+%% unsafe_tl - [List]
+%% #element{} - [Index, Tuple]
+%% #unsafe_element{} - [Tuple]
+%%
+%% Arithmetic: [Arg1, Arg2]
+%% '+', '-', '*', '/', 'div', 'rem',
+%% 'band', 'bor', 'bxor', 'bnot', 'bsl', 'bsr',
+%% fix_add, fix_sub %% Do these exist?
+%%
+%% Concurrency:
+%% {erlang,self,0} - []
+%% </pre>
+%%
+%%
+%% <h4>Relational Operations (Cond in if instruction)</h4>
+%% <pre>
+%% gt, lt, geq, leq,
+%% eqeq, neq, exact_eqeq, exact_neq
+%% </pre>
+%%
+%% <h4>Type tests</h4>
+%% <pre>
+%% list
+%% nil
+%% cons
+%% tuple
+%% {tuple, N}
+%% atom
+%% {atom, Atom}
+%% constant
+%% number
+%% integer
+%% {integer, N}
+%% fixnum
+%% bignum
+%% float
+%% pid
+%% port
+%% {record, Atom, Size}
+%% reference
+%% binary
+%% function
+%% </pre>
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%=====================================================================
+
+-module(hipe_icode).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+
+%% @type icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange,LabelRange)
+%% Fun = mfa()
+%% Params = [var()]
+%% IsClosure = boolean()
+%% IsLeaf = boolean()
+%% Code = [icode_instr()]
+%% Data = data()
+%% VarRange = {integer(),integer()}
+%% LabelRange = {integer(),integer()}
+%%
+%% @type icode_instr(I)
+%% I = if() | switch_val() | switch_tuple_arity() | type() | goto()
+%% | label() | move() | phi() | call() | enter() | return()
+%% | begin_try() | end_try() | begin_handler() | fail() | comment()
+%%
+%% @type if(Cond, Args, TrueLabel, FalseLabel)
+%% Cond = cond()
+%% Args = [arg()]
+%% TrueLabel = label_name()
+%% FalseLabel = label_name()
+%%
+%% @type switch_val(Term, FailLabel, Length, Cases)
+%% Term = var()
+%% FailLabel = label_name()
+%% Length = integer()
+%% Cases = [{symbol(),label_name()}]
+%%
+%% @type switch_tuple_arity(Arg, FailLabel, Length, Cases)
+%% Term = var()
+%% FailLabel = label_name()
+%% Length = integer()
+%% Cases = [{symbol(),label_name()}]
+%%
+%% @type type(TypeTest, Arg, True_label, False_label)
+%% TypeTest = type_test()
+%% Args = [arg()]
+%% TrueLabel = label_name()
+%% FalseLabel = label_name()
+%%
+%% @type goto(Label) Label = label_name()
+%%
+%% @type label(Name) Name = label_name()
+%%
+%% @type move(Dst, Src) Dst = var() Src = arg()
+%%
+%% @type phi(Dst, Id, Arglist)
+%% Dst = var() | fvar()
+%% Id = var() | fvar()
+%% Arglist = [{Pred, Src}]
+%% Pred = label_name()
+%% Src = var() | fvar()
+%%
+%% @type call(Dst, Fun, Arg, Type, Continuation, FailLabel, InGuard)
+%% Dst = [var()]
+%% Fun = mfa() | primop() | closure()
+%% Arg = [var()]
+%% Type = call_type()
+%% Continuation = [] | label_name()
+%% FailLabel = [] | label_name()
+%% InGuard = boolean()
+%%
+%% @type enter(Fun, Arg, Type)
+%% Fun = mfa() | primop() | closure()
+%% Arg = [var()]
+%% Type = call_type()
+%%
+%% @type return (Vars) Vars = [var()]
+%%
+%% @type begin_try(FailLabel, Successor)
+%% FailLabel = label_name()
+%% Successor = label_name()
+%%
+%% @type end_try()
+%%
+%% @type begin_handler(Dst)
+%% Dst = [var()]
+%%
+%% @type fail(Class, Args, Label)
+%% Class = exit_class()
+%% Args = [var()]
+%% Label = label_name()
+%%
+%% @type comment(Text) Text = string()
+
+%% @type call_type() = 'local' | 'remote' | 'primop'
+%% @type exit_class() = 'exit' | 'throw' | 'error' | 'rethrow'
+%% @type cond() = gt | lt | geq | leq | eqeq | neq | exact_eqeq | exact_neq
+%% @type type_test() =
+%% list
+%% | nil
+%% | cons
+%% | tuple
+%% | {tuple, integer()}
+%% | atom
+%% | {atom, atom()}
+%% | constant
+%% | number
+%% | integer
+%% | {integer, integer()}
+%% | fixnum
+%% | bignum
+%% | float
+%% | pid
+%% | port
+%% | {record, atom(), integer()}
+%% | reference
+%% | binary
+%% | function
+%%
+%% @type mfa(Mod,Fun,Arity) = {atom(),atom(),arity()}
+
+%% @type arg() = var() | const()
+%% @type farg() = fvar() | float()
+%% @type var(Name) Name = integer()
+%% @type fvar(Name) Name = integer()
+%% @type label_name(Name) Name = integer()
+%% @type symbol(S) = atom() | number()
+%% @type const(C) C = immediate()
+%% @type immediate(I) = I
+%% I = term()
+%% @end
+
+
+%% ____________________________________________________________________
+%%
+%% Exports
+%%
+-export([mk_icode/7, %% mk_icode(Fun, Params, IsClosure, IsLeaf,
+ %% Code, VarRange, LabelRange)
+ mk_icode/8, %% mk_icode(Fun, Params, IsClosure, IsLeaf,
+ %% Code, Data, VarRange, LabelRange)
+ icode_fun/1,
+ icode_params/1,
+ icode_params_update/2,
+ icode_is_closure/1,
+ icode_closure_arity/1,
+ icode_closure_arity_update/2,
+ icode_is_leaf/1,
+ icode_code/1,
+ icode_code_update/2,
+ icode_data/1,
+ %% icode_data_update/2,
+ icode_var_range/1,
+ icode_label_range/1,
+ icode_info/1,
+ icode_info_update/2]).
+
+-export([mk_if/4, %% mk_if(Op, Args, TrueLbl, FalseLbl)
+ %% mk_if/5, %% mk_if(Op, Args, TrueLbl, FalseLbl, Prob)
+ if_op/1,
+ if_op_update/2,
+ if_true_label/1,
+ if_false_label/1,
+ if_args/1,
+ if_pred/1,
+ %% is_if/1,
+
+ mk_switch_val/4,
+ %% mk_switch_val/5,
+ switch_val_term/1,
+ switch_val_fail_label/1,
+ %% switch_val_length/1,
+ switch_val_cases/1,
+ switch_val_cases_update/2,
+ %% is_switch_val/1,
+
+ mk_switch_tuple_arity/4,
+ %% mk_switch_tuple_arityl/5,
+ switch_tuple_arity_term/1,
+ switch_tuple_arity_fail_label/1,
+ switch_tuple_arity_fail_label_update/2,
+ %% switch_tuple_arity_length/1,
+ switch_tuple_arity_cases/1,
+ switch_tuple_arity_cases_update/2,
+ %% is_switch_tuple_arity/1,
+
+ mk_type/4, %% mk_type(Args, Type, TrueLbl, FalseLbl)
+ mk_type/5, %% mk_type(Args, Type, TrueLbl, FalseLbl, P)
+ type_args/1,
+ %% type_args_update/2,
+ type_test/1,
+ type_true_label/1,
+ type_false_label/1,
+ type_pred/1,
+ is_type/1,
+
+ mk_guardop/5, %% mk_guardop(Dst, Fun, Args, Continuation, Fail)
+ mk_primop/3, %% mk_primop(Dst, Fun, Args)
+ mk_primop/5, %% mk_primop(Dst, Fun, Args, Cont, Fail)
+ mk_call/5, %% mk_call(Dst, Mod, Fun, Args, Type)
+ %% mk_call/7, %% mk_call(Dst, Mod, Fun, Args, Type,
+ %% Continuation, Fail)
+ mk_call/8, %% mk_call(Dst, Mod, Fun, Args, Type,
+ %% Continuation, Fail, Guard)
+ call_dstlist/1,
+ call_dstlist_update/2,
+ %% call_dst_type/1,
+ call_args/1,
+ call_args_update/2,
+ call_fun/1,
+ call_fun_update/2,
+ call_type/1,
+ call_continuation/1,
+ call_fail_label/1,
+ call_set_fail_label/2,
+ call_set_continuation/2,
+ is_call/1,
+ call_in_guard/1,
+
+ mk_goto/1, %% mk_goto(Lbl)
+ goto_label/1,
+
+ mk_enter/4, %% mk_enter(Mod, Fun, Args, Type)
+ mk_enter_primop/2, %% mk_enter_primop(Op, Type)
+ enter_fun/1,
+ enter_fun_update/2,
+ enter_args/1,
+ enter_args_update/2,
+ enter_type/1,
+ is_enter/1,
+
+
+ mk_return/1, %% mk_return(Vars)
+ %% mk_fail/1, %% mk_fail(Args) class = exit
+ mk_fail/2, %% mk_fail(Args, Class)
+ %% mk_fail/3, %% mk_fail(Args, Class, Label)
+ mk_move/2, %% mk_move(Dst, Src)
+ %% mk_moves/2, %% mk_moves(DstList, SrcList)
+ mk_begin_try/2, %% mk_begin_try(Label, Successor)
+ mk_begin_handler/1, %% mk_begin_handler(ReasonDst)
+ mk_end_try/0, %% mk_end_try()
+ %% mk_elements/2, %% mk_elements(Tuple, Vars)
+ mk_label/1, %% mk_label(Name)
+ mk_new_label/0, %% mk_new_label()
+ mk_comment/1, %% mk_comment(Text)
+ mk_const/1, %% mk_const(Const)
+ mk_var/1, %% mk_var(Id)
+ annotate_variable/2, %% annotate_var_or_reg(VarOrReg, Type)
+ unannotate_variable/1,%% unannotate_var_or_reg(VarOrReg)
+ mk_reg/1, %% mk_reg(Id)
+ mk_fvar/1, %% mk_fvar(Id)
+ mk_new_var/0, %% mk_new_var()
+ mk_new_fvar/0, %% mk_new_fvar()
+ mk_new_reg/0, %% mk_new_reg()
+ mk_phi/1, %% mk_phi(Id)
+ mk_phi/2 %% mk_phi(Id, ArgList)
+ ]).
+
+%%
+%% Identifiers
+%%
+
+-export([%% is_fail/1,
+ is_return/1,
+ is_move/1,
+ %% is_begin_try/1,
+ %% is_begin_handler/1,
+ %% is_end_try/1,
+ is_goto/1,
+ is_label/1,
+ is_comment/1,
+ is_const/1,
+ is_var/1,
+ is_fvar/1,
+ is_reg/1,
+ is_variable/1,
+ is_annotated_variable/1,
+ %% is_uncond/1,
+ is_phi/1]).
+
+%%
+%% Selectors
+%%
+
+-export([phi_dst/1,
+ phi_id/1,
+ %% phi_args/1,
+ phi_arg/2,
+ phi_arglist/1,
+ phi_enter_pred/3,
+ phi_remove_pred/2,
+ phi_redirect_pred/3,
+ move_dst/1,
+ move_src/1,
+ move_src_update/2,
+ begin_try_label/1,
+ begin_try_successor/1,
+ begin_handler_dstlist/1,
+ label_name/1,
+ comment_text/1,
+ return_vars/1,
+ fail_args/1,
+ fail_class/1,
+ fail_label/1,
+ fail_set_label/2,
+ var_name/1,
+ variable_annotation/1,
+ fvar_name/1,
+ reg_name/1,
+ reg_is_gcsafe/1,
+ const_value/1
+ ]).
+
+%%
+%% Misc
+%%
+
+-export([args/1,
+ uses/1,
+ defines/1,
+ is_safe/1,
+ strip_comments/1,
+ subst/2,
+ subst_uses/2,
+ subst_defines/2,
+ redirect_jmp/3,
+ successors/1,
+ fails_to/1,
+ is_branch/1
+ ]).
+
+-export([highest_var/1, highest_label/1]).
+
+%%---------------------------------------------------------------------
+%%
+%% Icode
+%%
+%%---------------------------------------------------------------------
+
+-spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()],
+ {non_neg_integer(),non_neg_integer()},
+ {icode_lbl(),icode_lbl()}) -> #icode{}.
+mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) ->
+ #icode{'fun'=Fun, params=Params, code=Code,
+ is_closure=IsClosure,
+ is_leaf=IsLeaf,
+ data=hipe_consttab:new(),
+ var_range=VarRange,
+ label_range=LabelRange}.
+
+-spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()],
+ hipe_consttab(), {non_neg_integer(),non_neg_integer()},
+ {icode_lbl(),icode_lbl()}) -> #icode{}.
+mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
+ #icode{'fun'=Fun, params=Params, code=Code,
+ data=Data, is_closure=IsClosure, is_leaf=IsLeaf,
+ var_range=VarRange, label_range=LabelRange}.
+
+-spec icode_fun(#icode{}) -> mfa().
+icode_fun(#icode{'fun' = MFA}) -> MFA.
+
+-spec icode_params(#icode{}) -> [icode_var()].
+icode_params(#icode{params = Params}) -> Params.
+
+-spec icode_params_update(#icode{}, [icode_var()]) -> #icode{}.
+icode_params_update(Icode, Params) ->
+ Icode#icode{params = Params}.
+
+-spec icode_is_closure(#icode{}) -> boolean().
+icode_is_closure(#icode{is_closure = Closure}) -> Closure.
+
+-spec icode_is_leaf(#icode{}) -> boolean().
+icode_is_leaf(#icode{is_leaf = Leaf}) -> Leaf.
+
+-spec icode_code(#icode{}) -> icode_instrs().
+icode_code(#icode{code = Code}) -> Code.
+
+-spec icode_code_update(#icode{}, icode_instrs()) -> #icode{}.
+icode_code_update(Icode, NewCode) ->
+ Vmax = highest_var(NewCode),
+ Lmax = highest_label(NewCode),
+ Icode#icode{code = NewCode, var_range = {0,Vmax}, label_range = {0,Lmax}}.
+
+-spec icode_data(#icode{}) -> hipe_consttab().
+icode_data(#icode{data=Data}) -> Data.
+
+%% %% -spec icode_data_update(#icode{}, hipe_consttab()) -> #icode{}.
+%% icode_data_update(Icode, NewData) -> Icode#icode{data=NewData}.
+
+-spec icode_var_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}.
+icode_var_range(#icode{var_range = VarRange}) -> VarRange.
+
+-spec icode_label_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}.
+icode_label_range(#icode{label_range = LabelRange}) -> LabelRange.
+
+-spec icode_info(#icode{}) -> icode_info().
+icode_info(#icode{info = Info}) -> Info.
+
+-spec icode_info_update(#icode{}, icode_info()) -> #icode{}.
+icode_info_update(Icode, Info) -> Icode#icode{info = Info}.
+
+-spec icode_closure_arity(#icode{}) -> arity().
+icode_closure_arity(#icode{closure_arity = Arity}) -> Arity.
+
+-spec icode_closure_arity_update(#icode{}, arity()) -> #icode{}.
+icode_closure_arity_update(Icode, Arity) -> Icode#icode{closure_arity = Arity}.
+
+
+%%----------------------------------------------------------------------------
+%% Instructions
+%%----------------------------------------------------------------------------
+
+%%----
+%% if
+%%----
+
+-spec mk_if(icode_if_op(), [icode_term_arg()],
+ icode_lbl(), icode_lbl()) -> #icode_if{}.
+mk_if(Op, Args, TrueLbl, FalseLbl) ->
+ #icode_if{op=Op, args=Args, true_label=TrueLbl, false_label=FalseLbl, p=0.5}.
+%% mk_if(Op, Args, TrueLbl, FalseLbl, P) ->
+%% #icode_if{op=Op, args=Args, true_label=TrueLbl, false_label=FalseLbl, p=P}.
+
+-spec if_op(#icode_if{}) -> icode_if_op().
+if_op(#icode_if{op=Op}) -> Op.
+
+-spec if_op_update(#icode_if{}, icode_if_op()) -> #icode_if{}.
+if_op_update(IF, NewOp) -> IF#icode_if{op=NewOp}.
+
+-spec if_args(#icode_if{}) -> [icode_term_arg()].
+if_args(#icode_if{args=Args}) -> Args.
+
+-spec if_true_label(#icode_if{}) -> icode_lbl().
+if_true_label(#icode_if{true_label=TrueLbl}) -> TrueLbl.
+
+-spec if_true_label_update(#icode_if{}, icode_lbl()) -> #icode_if{}.
+if_true_label_update(IF, TrueLbl) -> IF#icode_if{true_label=TrueLbl}.
+
+-spec if_false_label(#icode_if{}) -> icode_lbl().
+if_false_label(#icode_if{false_label=FalseLbl}) -> FalseLbl.
+
+-spec if_false_label_update(#icode_if{}, icode_lbl()) -> #icode_if{}.
+if_false_label_update(IF, FalseLbl) -> IF#icode_if{false_label=FalseLbl}.
+
+-spec if_pred(#icode_if{}) -> float().
+if_pred(#icode_if{p=P}) -> P.
+
+%%------------
+%% switch_val
+%%------------
+
+-spec mk_switch_val(icode_var(), icode_lbl(),
+ non_neg_integer(), [icode_switch_case()]) ->
+ #icode_switch_val{}.
+mk_switch_val(Term = #icode_variable{kind='var'}, FailLbl, Length, Cases) ->
+ #icode_switch_val{term=Term, fail_label=FailLbl, length=Length, cases=Cases}.
+
+-spec switch_val_term(#icode_switch_val{}) -> icode_var().
+switch_val_term(#icode_switch_val{term=Term}) -> Term.
+
+-spec switch_val_fail_label(#icode_switch_val{}) -> icode_lbl().
+switch_val_fail_label(#icode_switch_val{fail_label=FailLbl}) -> FailLbl.
+
+-spec switch_val_fail_label_update(#icode_switch_val{}, icode_lbl()) ->
+ #icode_switch_val{}.
+switch_val_fail_label_update(SV, FailLbl) ->
+ SV#icode_switch_val{fail_label=FailLbl}.
+
+%% switch_val_length(#icode_switch_val{length=Length}) -> Length.
+
+-spec switch_val_cases(#icode_switch_val{}) -> [icode_switch_case()].
+switch_val_cases(#icode_switch_val{cases=Cases}) -> Cases.
+
+-spec switch_val_cases_update(#icode_switch_val{}, [icode_switch_case()]) ->
+ #icode_switch_val{}.
+switch_val_cases_update(SV, NewCases) ->
+ SV#icode_switch_val{cases = NewCases}.
+
+%%--------------------
+%% switch_tuple_arity
+%%--------------------
+
+-spec mk_switch_tuple_arity(icode_var(), icode_lbl(),
+ non_neg_integer(), [icode_switch_case()]) ->
+ #icode_switch_tuple_arity{}.
+mk_switch_tuple_arity(Term = #icode_variable{kind='var'}, FailLbl, Length, Cases) ->
+ #icode_switch_tuple_arity{term=Term, fail_label=FailLbl,
+ length=Length, cases=Cases}.
+
+-spec switch_tuple_arity_term(#icode_switch_tuple_arity{}) -> icode_var().
+switch_tuple_arity_term(#icode_switch_tuple_arity{term=Term}) -> Term.
+
+-spec switch_tuple_arity_fail_label(#icode_switch_tuple_arity{}) -> icode_lbl().
+switch_tuple_arity_fail_label(#icode_switch_tuple_arity{fail_label=FailLbl}) ->
+ FailLbl.
+
+-spec switch_tuple_arity_fail_label_update(#icode_switch_tuple_arity{}, icode_lbl()) ->
+ #icode_switch_tuple_arity{}.
+switch_tuple_arity_fail_label_update(S, FailLbl) ->
+ S#icode_switch_tuple_arity{fail_label=FailLbl}.
+
+%% switch_tuple_arity_length(#icode_switch_tuple_arity{length=Length}) -> Length.
+
+-spec switch_tuple_arity_cases(#icode_switch_tuple_arity{}) -> [icode_switch_case()].
+switch_tuple_arity_cases(#icode_switch_tuple_arity{cases=Cases}) -> Cases.
+
+-spec switch_tuple_arity_cases_update(#icode_switch_tuple_arity{},
+ [icode_switch_case()]) ->
+ #icode_switch_tuple_arity{}.
+switch_tuple_arity_cases_update(Cond, NewCases) ->
+ Cond#icode_switch_tuple_arity{cases = NewCases}.
+
+%%------
+%% type
+%%------
+
+-spec mk_type([icode_term_arg()], icode_type_test(), icode_lbl(), icode_lbl()) ->
+ #icode_type{}.
+mk_type(Args, Test, TrueLbl, FalseLbl) ->
+ mk_type(Args, Test, TrueLbl, FalseLbl, 0.5).
+
+-spec mk_type([icode_term_arg()], icode_type_test(),
+ icode_lbl(), icode_lbl(), float()) -> #icode_type{}.
+mk_type(Args, Test, TrueLbl, FalseLbl, P) ->
+ #icode_type{test=Test, args=Args,
+ true_label=TrueLbl, false_label=FalseLbl, p=P}.
+
+-spec type_test(#icode_type{}) -> icode_type_test().
+type_test(#icode_type{test=Test}) -> Test.
+
+-spec type_args(#icode_type{}) -> [icode_term_arg()].
+type_args(#icode_type{args=Args}) -> Args.
+
+%% type_args_update(T, Args) -> T#icode_type{args=Args}.
+
+-spec type_true_label(#icode_type{}) -> icode_lbl().
+type_true_label(#icode_type{true_label=TrueLbl}) -> TrueLbl.
+
+-spec type_false_label(#icode_type{}) -> icode_lbl().
+type_false_label(#icode_type{false_label=FalseLbl}) -> FalseLbl.
+
+-spec type_pred(#icode_type{}) -> float().
+type_pred(#icode_type{p=P}) -> P.
+
+-spec is_type(icode_instr()) -> boolean().
+is_type(#icode_type{}) -> true;
+is_type(_) -> false.
+
+%%------
+%% goto
+%%------
+
+-spec mk_goto(icode_lbl()) -> #icode_goto{}.
+mk_goto(Lbl) -> #icode_goto{label=Lbl}.
+
+-spec goto_label(#icode_goto{}) -> icode_lbl().
+goto_label(#icode_goto{label=Lbl}) -> Lbl.
+
+-spec is_goto(icode_instr()) -> boolean().
+is_goto(#icode_goto{}) -> true;
+is_goto(_) -> false.
+
+%%--------
+%% return
+%%--------
+
+-spec mk_return([icode_var()]) -> #icode_return{}.
+mk_return(Vars) -> #icode_return{vars=Vars}.
+
+-spec return_vars(#icode_return{}) -> [icode_var()].
+return_vars(#icode_return{vars=Vars}) -> Vars.
+
+-spec is_return(icode_instr()) -> boolean().
+is_return(#icode_return{}) -> true;
+is_return(_) -> false.
+
+%%------
+%% fail
+%%------
+
+%% mk_fail(Args) when is_list(Args) -> mk_fail(Args, error).
+
+-spec mk_fail([icode_term_arg()], icode_exit_class()) -> #icode_fail{}.
+mk_fail(Args, Class) when is_list(Args) ->
+ case Class of
+ error -> ok;
+ exit -> ok;
+ rethrow -> ok;
+ throw -> ok
+ end,
+ #icode_fail{class=Class, args=Args}.
+
+%% mk_fail(Args, Class, Label) when is_list(Args) ->
+%% #icode_fail{class=Class, args=Args, fail_label=Label}.
+
+-spec fail_class(#icode_fail{}) -> icode_exit_class().
+fail_class(#icode_fail{class=Class}) -> Class.
+
+-spec fail_args(#icode_fail{}) -> [icode_term_arg()].
+fail_args(#icode_fail{args=Args}) -> Args.
+
+-spec fail_label(#icode_fail{}) -> [] | icode_lbl().
+fail_label(#icode_fail{fail_label=Label}) -> Label.
+
+-spec fail_set_label(#icode_fail{}, [] | icode_lbl()) -> #icode_fail{}.
+fail_set_label(I=#icode_fail{}, Label) ->
+ I#icode_fail{fail_label = Label}.
+
+%%------
+%% move
+%%------
+
+-spec mk_move(#icode_variable{}, #icode_variable{} | #icode_const{}) ->
+ #icode_move{}.
+mk_move(Dst, Src) ->
+ case Src of
+ #icode_variable{} -> ok;
+ #icode_const{} -> ok
+ end,
+ #icode_move{dst=Dst, src=Src}.
+
+-spec move_dst(#icode_move{}) -> #icode_variable{}.
+move_dst(#icode_move{dst=Dst}) -> Dst.
+
+-spec move_src(#icode_move{}) -> #icode_variable{} | #icode_const{}.
+move_src(#icode_move{src=Src}) -> Src.
+
+-spec move_src_update(#icode_move{}, #icode_variable{} | #icode_const{}) ->
+ #icode_move{}.
+move_src_update(M, NewSrc) -> M#icode_move{src=NewSrc}.
+
+-spec is_move(icode_instr()) -> boolean().
+is_move(#icode_move{}) -> true;
+is_move(_) -> false.
+
+%%-----
+%% phi
+%%-----
+
+%% The id field is not entirely redundant. It is used in mappings
+%% in the SSA pass since the dst field can change.
+-spec mk_phi(#icode_variable{}) -> #icode_phi{}.
+mk_phi(Var) -> #icode_phi{dst=Var, id=Var, arglist=[]}.
+
+-spec mk_phi(#icode_variable{}, [{icode_lbl(), #icode_variable{}}]) ->
+ #icode_phi{}.
+mk_phi(Var, ArgList) -> #icode_phi{dst=Var, id=Var, arglist=ArgList}.
+
+-spec phi_dst(#icode_phi{}) -> #icode_variable{}.
+phi_dst(#icode_phi{dst=Dst}) -> Dst.
+
+-spec phi_id(#icode_phi{}) -> #icode_variable{}.
+phi_id(#icode_phi{id=Id}) -> Id.
+
+-spec phi_arglist(#icode_phi{}) -> [{icode_lbl(), #icode_variable{}}].
+phi_arglist(#icode_phi{arglist=ArgList}) -> ArgList.
+
+-spec phi_args(#icode_phi{}) -> [#icode_variable{}].
+phi_args(P) -> [Var || {_, Var} <- phi_arglist(P)].
+
+-spec phi_arg(#icode_phi{}, icode_lbl()) -> #icode_variable{}.
+phi_arg(P, Pred) ->
+ case lists:keyfind(Pred, 1, phi_arglist(P)) of
+ {_, Var} -> Var;
+ false -> exit({'No such predecessor to phi', {Pred, P}})
+ end.
+
+-spec is_phi(icode_instr()) -> boolean().
+is_phi(#icode_phi{}) -> true;
+is_phi(_) -> false.
+
+-spec phi_enter_pred(#icode_phi{}, icode_lbl(), #icode_variable{}) ->
+ #icode_phi{}.
+phi_enter_pred(Phi, Pred, Var) ->
+ NewArg = {Pred, Var},
+ Phi#icode_phi{arglist=[NewArg|lists:keydelete(Pred, 1, phi_arglist(Phi))]}.
+
+-spec phi_remove_pred(#icode_phi{}, icode_lbl()) -> #icode_move{} | #icode_phi{}.
+phi_remove_pred(Phi, Pred) ->
+ NewArgList = lists:keydelete(Pred, 1, phi_arglist(Phi)),
+ case NewArgList of
+ [Arg] -> %% the Phi should be turned into an appropriate move instruction
+ {_Label, Var = #icode_variable{}} = Arg,
+ mk_move(phi_dst(Phi), Var);
+ [_|_] ->
+ Phi#icode_phi{arglist=NewArgList}
+ end.
+
+phi_argvar_subst(P, Subst) ->
+ NewArgList = [{Pred, subst1(Subst, Var)} || {Pred,Var} <- phi_arglist(P)],
+ P#icode_phi{arglist=NewArgList}.
+
+-spec phi_redirect_pred(#icode_phi{}, icode_lbl(), icode_lbl()) -> #icode_phi{}.
+phi_redirect_pred(P, OldPred, NewPred) ->
+ Subst = [{OldPred, NewPred}],
+ NewArgList = [{subst1(Subst, Pred), Var} || {Pred,Var} <- phi_arglist(P)],
+ P#icode_phi{arglist=NewArgList}.
+
+%%
+%% primop and guardop
+%%
+%% Whether a function is a "primop" - i.e., an internal thing - or not,
+%% is really only shown by its name. An {M,F,A} always represents a
+%% function in some Erlang module (although it might be a BIF, and
+%% could possibly be inline expanded). It is convenient to let the
+%% constructor functions check the name and set the type automatically,
+%% especially for guardops - some guardops are primitives and some are
+%% MFA:s, and this way we won't have to rewrite all calls to mk_guardop
+%% to flag whether they are primops or not.
+
+-spec mk_primop([#icode_variable{}], icode_funcall(),
+ [icode_argument()]) -> #icode_call{}.
+mk_primop(DstList, Fun, ArgList) ->
+ mk_primop(DstList, Fun, ArgList, [], []).
+
+-spec mk_primop([#icode_variable{}], icode_funcall(),
+ [icode_argument()], [] | icode_lbl(), [] | icode_lbl()) ->
+ #icode_call{}.
+mk_primop(DstList, Fun, ArgList, Continuation, Fail) ->
+ Type = op_type(Fun),
+ make_call(DstList, Fun, ArgList, Type, Continuation, Fail, false).
+
+%% Note that a 'guardop' is just a call that occurred in a guard. In
+%% this case, we should always have continuation labels True and False.
+
+-spec mk_guardop([#icode_variable{}], icode_funcall(),
+ [icode_argument()], icode_lbl(), icode_lbl()) -> #icode_call{}.
+mk_guardop(DstList, Fun, ArgList, True, False) ->
+ Type = op_type(Fun),
+ make_call(DstList, Fun, ArgList, Type, True, False, true).
+
+op_type(Fun) ->
+ case is_mfa(Fun) of
+ true -> remote;
+ false -> primop
+ end.
+
+is_mfa({M,F,A}) when is_atom(M), is_atom(F),
+ is_integer(A), 0 =< A, A =< 255 -> true;
+is_mfa(_) -> false.
+
+%%------
+%% call
+%%------
+
+-spec mk_call([#icode_variable{}], atom(), atom(),
+ [icode_argument()], 'local' | 'remote') -> #icode_call{}.
+mk_call(DstList, M, F, ArgList, Type) ->
+ mk_call(DstList, M, F, ArgList, Type, [], [], false).
+
+%% mk_call(DstList, M, F, ArgList, Type, Continuation, Fail) ->
+%% mk_call(DstList, M, F, ArgList, Type, Continuation, Fail, false).
+
+-spec mk_call([#icode_variable{}], atom(), atom(), [icode_argument()],
+ 'local' | 'remote', [] | icode_lbl(), [] | icode_lbl(), boolean()) ->
+ #icode_call{}.
+mk_call(DstList, M, F, ArgList, Type, Continuation, Fail, InGuard)
+ when is_atom(M), is_atom(F) ->
+ case Type of
+ local -> ok;
+ remote -> ok
+ end,
+ Fun = {M,F,length(ArgList)},
+ make_call(DstList, Fun, ArgList, Type, Continuation, Fail, InGuard).
+
+%% The common constructor for all calls (for internal use only)
+%%
+%% Note: If the "guard" flag is `true', it means that if the call fails,
+%% we can simply jump to the Fail label (if it exists) without
+%% generating any additional exception information - it isn't needed.
+-spec make_call([#icode_variable{}], icode_funcall(), [icode_argument()],
+ icode_call_type(), [] | icode_lbl(), [] | icode_lbl(), boolean()) ->
+ #icode_call{}.
+make_call(DstList, Fun, ArgList, Type, Continuation, Fail, InGuard) ->
+ #icode_call{dstlist=DstList, 'fun'=Fun, args=ArgList, type=Type,
+ continuation=Continuation, fail_label=Fail, in_guard=InGuard}.
+
+-spec call_dstlist(#icode_call{}) -> [#icode_variable{}].
+call_dstlist(#icode_call{dstlist=DstList}) -> DstList.
+
+-spec call_dstlist_update(#icode_call{}, [#icode_variable{}]) -> #icode_call{}.
+call_dstlist_update(C, Dest) -> C#icode_call{dstlist=Dest}.
+
+-spec call_type(#icode_call{}) -> icode_call_type().
+call_type(#icode_call{type=Type}) -> Type.
+
+%% -spec call_dst_type(#icode_call{}) -> erl_type().
+%% call_dst_type(#icode_call{dst_type=DstType}) -> DstType.
+
+-spec call_args(#icode_call{}) -> [icode_argument()].
+call_args(#icode_call{args=Args}) -> Args.
+
+-spec call_args_update(#icode_call{}, [icode_argument()]) -> #icode_call{}.
+call_args_update(C, Args) -> C#icode_call{args=Args}.
+
+-spec call_fun(#icode_call{}) -> icode_funcall().
+call_fun(#icode_call{'fun'=Fun}) -> Fun.
+
+%% Note that updating the name field requires recomputing the call type,
+%% in case it changes from a remote/local call to a primop call.
+-spec call_fun_update(#icode_call{}, icode_funcall()) -> #icode_call{}.
+call_fun_update(C, Fun) ->
+ Type = case is_mfa(Fun) of
+ true -> call_type(C);
+ false -> primop
+ end,
+ C#icode_call{'fun'=Fun, type=Type}.
+
+-spec call_continuation(#icode_call{}) -> [] | icode_lbl().
+call_continuation(#icode_call{continuation=Continuation}) -> Continuation.
+
+-spec call_fail_label(#icode_call{}) -> [] | icode_lbl().
+call_fail_label(#icode_call{fail_label=Fail}) -> Fail.
+
+-spec call_set_continuation(#icode_call{}, [] | icode_lbl()) -> #icode_call{}.
+call_set_continuation(I, Continuation) ->
+ I#icode_call{continuation = Continuation}.
+
+-spec call_set_fail_label(#icode_call{}, [] | icode_lbl()) -> #icode_call{}.
+call_set_fail_label(I=#icode_call{}, Fail) ->
+ case Fail of
+ [] ->
+ I#icode_call{fail_label=Fail, in_guard=false};
+ _ ->
+ I#icode_call{fail_label=Fail}
+ end.
+
+-spec is_call(icode_instr()) -> boolean().
+is_call(#icode_call{}) -> true;
+is_call(_) -> false.
+
+-spec call_in_guard(#icode_call{}) -> boolean().
+call_in_guard(#icode_call{in_guard=InGuard}) -> InGuard.
+
+%%-------
+%% enter
+%%-------
+
+-spec mk_enter(atom(), atom(), [icode_term_arg()], 'local' | 'remote') ->
+ #icode_enter{}.
+mk_enter(M, F, Args, Type) when is_atom(M), is_atom(F) ->
+ case Type of
+ local -> ok;
+ remote -> ok
+ end,
+ #icode_enter{'fun'={M,F,length(Args)}, args=Args, type=Type}.
+
+-spec enter_fun(#icode_enter{}) -> icode_funcall().
+enter_fun(#icode_enter{'fun'=Fun}) -> Fun.
+
+-spec enter_fun_update(#icode_enter{}, icode_funcall()) ->
+ #icode_enter{}.
+enter_fun_update(E, Fun) ->
+ Type = case is_mfa(Fun) of
+ true -> enter_type(E);
+ false -> primop
+ end,
+ E#icode_enter{'fun'=Fun, type=Type}.
+
+-spec enter_args(#icode_enter{}) -> [icode_term_arg()].
+enter_args(#icode_enter{args=Args}) -> Args.
+
+-spec enter_args_update(#icode_enter{}, [icode_term_arg()]) -> #icode_enter{}.
+enter_args_update(E, Args) -> E#icode_enter{args=Args}.
+
+-spec enter_type(#icode_enter{}) -> icode_call_type().
+enter_type(#icode_enter{type=Type}) -> Type.
+
+-spec is_enter(icode_instr()) -> boolean().
+is_enter(#icode_enter{}) -> true;
+is_enter(_) -> false.
+
+-spec mk_enter_primop(icode_primop(), [icode_term_arg()]) ->
+ #icode_enter{type::'primop'}.
+mk_enter_primop(Op, Args) ->
+ #icode_enter{'fun'=Op, args=Args, type=primop}.
+
+%%-----------
+%% begin_try
+%%-----------
+
+%% The reason that begin_try is a branch instruction is just so that it
+%% keeps the fail-to block linked into the CFG, until the exception
+%% handling instructions are eliminated.
+
+-spec mk_begin_try(icode_lbl(), icode_lbl()) -> #icode_begin_try{}.
+mk_begin_try(Label, Successor) ->
+ #icode_begin_try{label=Label, successor=Successor}.
+
+-spec begin_try_label(#icode_begin_try{}) -> icode_lbl().
+begin_try_label(#icode_begin_try{label=Label}) -> Label.
+
+-spec begin_try_successor(#icode_begin_try{}) -> icode_lbl().
+begin_try_successor(#icode_begin_try{successor=Successor}) -> Successor.
+
+%%---------
+%% end_try
+%%---------
+
+-spec mk_end_try() -> #icode_end_try{}.
+mk_end_try() -> #icode_end_try{}.
+
+%%---------------
+%% begin_handler
+%%---------------
+
+-spec mk_begin_handler([icode_var()]) -> #icode_begin_handler{}.
+mk_begin_handler(Dstlist) ->
+ #icode_begin_handler{dstlist=Dstlist}.
+
+-spec begin_handler_dstlist(#icode_begin_handler{}) -> [icode_var()].
+begin_handler_dstlist(#icode_begin_handler{dstlist=Dstlist}) -> Dstlist.
+
+%% -spec is_begin_handler(icode_instr()) -> boolean().
+%% is_begin_handler(#icode_begin_handler{}) -> true;
+%% is_begin_handler(_) -> false.
+
+%%-------
+%% label
+%%-------
+
+-spec mk_label(icode_lbl()) -> #icode_label{}.
+mk_label(Name) when is_integer(Name), Name >= 0 -> #icode_label{name=Name}.
+
+-spec label_name(#icode_label{}) -> icode_lbl().
+label_name(#icode_label{name=Name}) -> Name.
+
+-spec is_label(icode_instr()) -> boolean().
+is_label(#icode_label{}) -> true;
+is_label(_) -> false.
+
+%%---------
+%% comment
+%%---------
+
+-spec mk_comment(icode_comment_text()) -> #icode_comment{}.
+%% @doc If `Txt' is a list of characters (possibly deep), it will be
+%% printed as a string; otherwise, `Txt' will be printed as a term.
+mk_comment(Txt) -> #icode_comment{text=Txt}.
+
+-spec comment_text(#icode_comment{}) -> icode_comment_text().
+comment_text(#icode_comment{text=Txt}) -> Txt.
+
+-spec is_comment(icode_instr()) -> boolean().
+is_comment(#icode_comment{}) -> true;
+is_comment(_) -> false.
+
+
+%%---------------------------------------------------------------------
+%% Arguments (variables and constants)
+%%---------------------------------------------------------------------
+
+%%-------
+%% const
+%%-------
+
+-spec mk_const(simple_const() | structured_const() | binary()) -> #icode_const{}.
+mk_const(C) -> #icode_const{value=#flat{value=C}}.
+
+-spec const_value(#icode_const{}) -> simple_const() | structured_const() | binary().
+const_value(#icode_const{value=#flat{value=X}}) -> X.
+
+-spec is_const(icode_argument()) -> boolean().
+is_const(#icode_const{}) -> true;
+is_const(_) -> false.
+
+%%-----
+%% var
+%%-----
+
+-spec mk_var(non_neg_integer()) -> #icode_variable{kind::'var'}.
+mk_var(V) -> #icode_variable{name=V, kind=var}.
+
+-spec var_name(#icode_variable{kind::'var'}) -> non_neg_integer().
+var_name(#icode_variable{name=Name, kind=var}) -> Name.
+
+-spec is_var(icode_argument()) -> boolean().
+is_var(#icode_variable{kind=var}) -> true;
+is_var(_) -> false.
+
+-spec mk_reg(non_neg_integer()) -> #icode_variable{kind::'reg'}.
+mk_reg(V) -> #icode_variable{name=V, kind=reg}.
+
+-spec reg_name(#icode_variable{kind::'reg'}) -> non_neg_integer().
+reg_name(#icode_variable{name=Name, kind=reg}) -> Name.
+
+-spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'.
+reg_is_gcsafe(#icode_variable{kind=reg}) -> false. % for now
+
+-spec is_reg(icode_argument()) -> boolean().
+is_reg(#icode_variable{kind=reg}) -> true;
+is_reg(_) -> false.
+
+-spec mk_fvar(non_neg_integer()) -> #icode_variable{kind::'fvar'}.
+mk_fvar(V) -> #icode_variable{name=V, kind=fvar}.
+
+-spec fvar_name(#icode_variable{kind::'fvar'}) -> non_neg_integer().
+fvar_name(#icode_variable{name=Name, kind=fvar}) -> Name.
+
+-spec is_fvar(icode_argument()) -> boolean().
+is_fvar(#icode_variable{kind=fvar}) -> true;
+is_fvar(_) -> false.
+
+-spec is_variable(icode_argument()) -> boolean().
+is_variable(#icode_variable{}) -> true;
+is_variable(_) -> false.
+
+-spec annotate_variable(#icode_variable{}, variable_annotation()) ->
+ #icode_variable{}.
+annotate_variable(X, Anno) ->
+ X#icode_variable{annotation = Anno}.
+
+-spec is_annotated_variable(icode_argument()) -> boolean().
+is_annotated_variable(#icode_variable{annotation=[]}) ->
+ false;
+is_annotated_variable(#icode_variable{}) ->
+ true;
+is_annotated_variable(_) ->
+ false.
+
+-spec unannotate_variable(#icode_variable{}) -> #icode_variable{}.
+unannotate_variable(X) ->
+ X#icode_variable{annotation=[]}.
+
+-spec variable_annotation(#icode_variable{}) -> variable_annotation().
+variable_annotation(#icode_variable{annotation=Anno}) ->
+ Anno.
+
+%%
+%% Floating point Icode instructions.
+%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Liveness info
+%%
+
+-spec uses(icode_instr()) -> [#icode_variable{}].
+uses(Instr) ->
+ remove_constants(args(Instr)).
+
+-spec args(icode_instr()) -> [icode_argument()].
+args(I) ->
+ case I of
+ #icode_if{} -> if_args(I);
+ #icode_switch_val{} -> [switch_val_term(I)];
+ #icode_switch_tuple_arity{} -> [switch_tuple_arity_term(I)];
+ #icode_type{} -> type_args(I);
+ #icode_move{} -> [move_src(I)];
+ #icode_fail{} -> fail_args(I);
+ #icode_call{} -> call_args(I);
+ #icode_enter{} -> enter_args(I);
+ #icode_return{} -> return_vars(I);
+ #icode_phi{} -> phi_args(I);
+ #icode_goto{} -> [];
+ #icode_begin_try{} -> [];
+ #icode_begin_handler{} -> [];
+ #icode_end_try{} -> [];
+ #icode_comment{} -> [];
+ #icode_label{} -> []
+ end.
+
+-spec defines(icode_instr()) -> [#icode_variable{}].
+defines(I) ->
+ case I of
+ #icode_move{} -> remove_constants([move_dst(I)]);
+ #icode_call{} -> remove_constants(call_dstlist(I));
+ #icode_begin_handler{} -> remove_constants(begin_handler_dstlist(I));
+ #icode_phi{} -> remove_constants([phi_dst(I)]);
+ #icode_if{} -> [];
+ #icode_switch_val{} -> [];
+ #icode_switch_tuple_arity{} -> [];
+ #icode_type{} -> [];
+ #icode_goto{} -> [];
+ #icode_fail{} -> [];
+ #icode_enter{} -> [];
+ #icode_return{} -> [];
+ #icode_begin_try{} -> [];
+ #icode_end_try{} -> [];
+ #icode_comment{} -> [];
+ #icode_label{} -> []
+ end.
+
+-spec remove_constants([icode_argument()]) -> [#icode_variable{}].
+remove_constants(L) ->
+ [V || V <- L, (not is_const(V))].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Utilities
+%%
+
+%%
+%% Substitution: replace occurrences of X by Y if {X,Y} is in the
+%% Subst_list.
+
+-spec subst([{_,_}], I) -> I when is_subtype(I, icode_instr()).
+
+subst(Subst, I) ->
+ subst_defines(Subst, subst_uses(Subst, I)).
+
+-spec subst_uses([{_,_}], I) -> I when is_subtype(I, icode_instr()).
+
+subst_uses(Subst, I) ->
+ case I of
+ #icode_if{} -> I#icode_if{args = subst_list(Subst, if_args(I))};
+ #icode_switch_val{} ->
+ I#icode_switch_val{term = subst1(Subst, switch_val_term(I))};
+ #icode_switch_tuple_arity{} ->
+ I#icode_switch_tuple_arity{term = subst1(Subst, switch_tuple_arity_term(I))};
+ #icode_type{} -> I#icode_type{args = subst_list(Subst, type_args(I))};
+ #icode_move{} -> I#icode_move{src = subst1(Subst, move_src(I))};
+ #icode_fail{} -> I#icode_fail{args = subst_list(Subst, fail_args(I))};
+ #icode_call{} -> I#icode_call{args = subst_list(Subst, call_args(I))};
+ #icode_enter{} -> I#icode_enter{args = subst_list(Subst, enter_args(I))};
+ #icode_return{} -> I#icode_return{vars = subst_list(Subst, return_vars(I))};
+ #icode_phi{} -> phi_argvar_subst(I, Subst);
+ #icode_goto{} -> I;
+ #icode_begin_try{} -> I;
+ #icode_begin_handler{} -> I;
+ #icode_end_try{} -> I;
+ #icode_comment{} -> I;
+ #icode_label{} -> I
+ end.
+
+-spec subst_defines([{_,_}], I) -> I when is_subtype(I, icode_instr()).
+
+subst_defines(Subst, I) ->
+ case I of
+ #icode_move{} -> I#icode_move{dst = subst1(Subst, move_dst(I))};
+ #icode_call{} ->
+ I#icode_call{dstlist = subst_list(Subst, call_dstlist(I))};
+ #icode_begin_handler{} ->
+ I#icode_begin_handler{dstlist = subst_list(Subst,
+ begin_handler_dstlist(I))};
+ #icode_phi{} -> I#icode_phi{dst = subst1(Subst, phi_dst(I))};
+ #icode_if{} -> I;
+ #icode_switch_val{} -> I;
+ #icode_switch_tuple_arity{} -> I;
+ #icode_type{} -> I;
+ #icode_goto{} -> I;
+ #icode_fail{} -> I;
+ #icode_enter{} -> I;
+ #icode_return{} -> I;
+ #icode_begin_try{} -> I;
+ #icode_end_try{} -> I;
+ #icode_comment{} -> I;
+ #icode_label{} -> I
+ end.
+
+subst_list(S, Is) ->
+ [subst1(S, I) || I <- Is].
+
+subst1([], I) -> I;
+subst1([{I,Y}|_], I) -> Y;
+subst1([_|Pairs], I) -> subst1(Pairs, I).
+
+%%
+%% @doc Returns the successors of an Icode instruction.
+%% In CFG form only branch instructions have successors,
+%% but in linear form other instructions like e.g. moves and
+%% others might be the last instruction of some basic block.
+%%
+
+-spec successors(icode_instr()) -> [icode_lbl()].
+
+successors(I) ->
+ case I of
+ #icode_if{} ->
+ [if_true_label(I), if_false_label(I)];
+ #icode_goto{} ->
+ [goto_label(I)];
+ #icode_switch_val{} ->
+ CaseLabels = [L || {_,L} <- switch_val_cases(I)],
+ [switch_val_fail_label(I) | CaseLabels];
+ #icode_switch_tuple_arity{} ->
+ CaseLabels = [L || {_,L} <- switch_tuple_arity_cases(I)],
+ [switch_tuple_arity_fail_label(I) | CaseLabels];
+ #icode_type{} ->
+ [type_true_label(I), type_false_label(I)];
+ #icode_call{} ->
+ case call_continuation(I) of [] -> []; L when is_integer(L) -> [L] end
+ ++
+ case call_fail_label(I) of [] -> []; L when is_integer(L) -> [L] end;
+ #icode_begin_try{} ->
+ [begin_try_successor(I), begin_try_label(I)];
+ #icode_fail{} ->
+ case fail_label(I) of [] -> []; L when is_integer(L) -> [L] end;
+ #icode_enter{} -> [];
+ #icode_return{} -> [];
+ %% the following are included here for handling linear code
+ #icode_move{} -> [];
+ #icode_begin_handler{} -> []
+ end.
+
+%%
+%% @doc Returns the fail labels of an Icode instruction.
+%%
+
+-spec fails_to(icode_instr()) -> [icode_lbl()].
+
+fails_to(I) ->
+ case I of
+ #icode_switch_val{} -> [switch_val_fail_label(I)];
+ #icode_switch_tuple_arity{} -> [switch_tuple_arity_fail_label(I)];
+ #icode_call{} ->
+ case call_fail_label(I) of [] -> []; L when is_integer(L) -> [L] end;
+ #icode_begin_try{} -> [begin_try_label(I)]; % just for safety
+ #icode_fail{} ->
+ case fail_label(I) of [] -> []; L when is_integer(L) -> [L] end;
+ #icode_if{} -> []; % XXX: Correct?
+ #icode_enter{} -> []; % XXX: Correct?
+ #icode_goto{} -> [];
+ #icode_type{} -> []; % XXX: Correct?
+ #icode_return{} -> []
+ end.
+
+%%
+%% @doc Redirects jumps from label Old to label New.
+%% If the instruction does not jump to Old, it remains unchanged.
+%% The New label can be the special [] label used for calls with
+%% fall-throughs.
+%%
+
+-spec redirect_jmp(icode_instr(), icode_lbl(), [] | icode_lbl()) -> icode_instr().
+
+redirect_jmp(Jmp, ToOld, ToOld) ->
+ Jmp; % no need to do anything
+redirect_jmp(Jmp, ToOld, ToNew) ->
+ NewI =
+ case Jmp of
+ #icode_if{} ->
+ NewJmp = case if_true_label(Jmp) of
+ ToOld -> if_true_label_update(Jmp, ToNew);
+ _ -> Jmp
+ end,
+ case if_false_label(NewJmp) of
+ ToOld -> if_false_label_update(NewJmp, ToNew);
+ _ -> NewJmp
+ end;
+ #icode_goto{} ->
+ case goto_label(Jmp) of
+ ToOld -> Jmp#icode_goto{label=ToNew};
+ _ -> Jmp
+ end;
+ #icode_switch_val{} ->
+ NewJmp = case switch_val_fail_label(Jmp) of
+ ToOld -> switch_val_fail_label_update(Jmp, ToNew);
+ _ -> Jmp
+ end,
+ Cases = [case Pair of
+ {Val,ToOld} -> {Val,ToNew};
+ Unchanged -> Unchanged
+ end || Pair <- switch_val_cases(NewJmp)],
+ NewJmp#icode_switch_val{cases = Cases};
+ #icode_switch_tuple_arity{} ->
+ NewJmp = case switch_tuple_arity_fail_label(Jmp) of
+ ToOld ->
+ Jmp#icode_switch_tuple_arity{fail_label=ToNew};
+ _ -> Jmp
+ end,
+ Cases = [case Pair of
+ {Val,ToOld} -> {Val,ToNew};
+ Unchanged -> Unchanged
+ end || Pair <- switch_tuple_arity_cases(NewJmp)],
+ NewJmp#icode_switch_tuple_arity{cases = Cases};
+ #icode_type{} ->
+ NewJmp = case type_true_label(Jmp) of
+ ToOld -> Jmp#icode_type{true_label=ToNew};
+ _ -> Jmp
+ end,
+ case type_false_label(NewJmp) of
+ ToOld -> NewJmp#icode_type{false_label=ToNew};
+ _ -> NewJmp
+ end;
+ #icode_call{} ->
+ NewCont = case call_continuation(Jmp) of
+ ToOld -> ToNew;
+ OldCont -> OldCont
+ end,
+ NewFail = case call_fail_label(Jmp) of
+ ToOld -> ToNew;
+ OldFail -> OldFail
+ end,
+ Jmp#icode_call{continuation = NewCont,
+ fail_label = NewFail};
+ #icode_begin_try{} ->
+ NewLabl = case begin_try_label(Jmp) of
+ ToOld -> ToNew;
+ OldLab -> OldLab
+ end,
+ NewSucc = case begin_try_successor(Jmp) of
+ ToOld -> ToNew;
+ OldSucc -> OldSucc
+ end,
+ Jmp#icode_begin_try{label=NewLabl, successor=NewSucc};
+ #icode_fail{} ->
+ case fail_label(Jmp) of
+ ToOld -> Jmp#icode_fail{fail_label=ToNew};
+ _ -> Jmp
+ end
+ end,
+ simplify_branch(NewI).
+
+%%
+%% @doc Turns a branch into a goto if it has only one successor and it
+%% is safe to do so.
+%%
+
+-spec simplify_branch(icode_instr()) -> icode_instr().
+
+simplify_branch(I) ->
+ case ordsets:from_list(successors(I)) of
+ [Label] ->
+ Goto = mk_goto(Label),
+ case I of
+ #icode_type{} -> Goto;
+ #icode_if{} -> Goto;
+ #icode_switch_tuple_arity{} -> Goto;
+ #icode_switch_val{} -> Goto;
+ _ -> I
+ end;
+ _ -> I
+ end.
+
+%%
+%% Is this an unconditional jump (causes a basic block not to have a
+%% fallthrough successor).
+%%
+
+%% is_uncond(I) ->
+%% case I of
+%% #icode_goto{} -> true;
+%% #icode_fail{} -> true;
+%% #icode_enter{} -> true;
+%% #icode_return{} -> true;
+%% #icode_call{} ->
+%% case call_fail_label(I) of
+%% [] ->
+%% case call_continuation(I) of
+%% [] -> false;
+%% _ -> true
+%% end;
+%% _ -> true
+%% end;
+%% _ -> false
+%% end.
+
+%% @spec is_branch(icode_instr()) -> boolean()
+%%
+%% @doc Succeeds if the Icode instruction is a branch. I.e. a
+%% (possibly conditional) discontinuation of linear control flow.
+%% @end
+
+-spec is_branch(icode_instr()) -> boolean().
+is_branch(Instr) ->
+ case Instr of
+ #icode_if{} -> true;
+ #icode_switch_val{} -> true;
+ #icode_switch_tuple_arity{} -> true;
+ #icode_type{} -> true;
+ #icode_goto{} -> true;
+ #icode_fail{} -> true;
+ #icode_call{} ->
+ case call_fail_label(Instr) of
+ [] -> call_continuation(Instr) =/= [];
+ _ -> true
+ end;
+ #icode_enter{} -> true;
+ #icode_return{} -> true;
+ #icode_begin_try{} -> true;
+ %% false cases below
+ #icode_move{} -> false;
+ #icode_begin_handler{} -> false;
+ #icode_end_try{} -> false;
+ #icode_comment{} -> false;
+ #icode_label{} -> false;
+ #icode_phi{} -> false
+ end.
+
+%%
+%% @doc Makes a new variable.
+%%
+
+-spec mk_new_var() -> icode_var().
+mk_new_var() ->
+ mk_var(hipe_gensym:get_next_var(icode)).
+
+%%
+%% @doc Makes a new fp variable.
+%%
+
+-spec mk_new_fvar() -> icode_fvar().
+mk_new_fvar() ->
+ mk_fvar(hipe_gensym:get_next_var(icode)).
+
+%%
+%% @doc Makes a new register.
+%%
+
+-spec mk_new_reg() -> icode_reg().
+mk_new_reg() ->
+ mk_reg(hipe_gensym:get_next_var(icode)).
+
+%%
+%% @doc Makes a new label.
+%%
+
+-spec mk_new_label() -> #icode_label{}.
+mk_new_label() ->
+ mk_label(hipe_gensym:get_next_label(icode)).
+
+%% %%
+%% %% @doc Makes a bunch of move operations.
+%% %%
+%%
+%% -spec mk_moves([_], [_]) -> [#icode_move{}].
+%% mk_moves([], []) ->
+%% [];
+%% mk_moves([X|Xs], [Y|Ys]) ->
+%% [mk_move(X, Y) | mk_moves(Xs, Ys)].
+
+%%
+%% Makes a series of element operations.
+%%
+
+%% mk_elements(_, []) ->
+%% [];
+%% mk_elements(Tuple, [X|Xs]) ->
+%% [mk_primop([X], #unsafe_element{index=length(Xs)+1}, [Tuple]) |
+%% mk_elements(Tuple, Xs)].
+
+%%
+%% @doc Removes comments from Icode.
+%%
+
+-spec strip_comments(#icode{}) -> #icode{}.
+strip_comments(ICode) ->
+ icode_code_update(ICode, no_comments(icode_code(ICode))).
+
+%% The following spec is underspecified: the resulting list does not
+%% contain any #comment{} instructions
+-spec no_comments(icode_instrs()) -> icode_instrs().
+no_comments([]) ->
+ [];
+no_comments([I|Xs]) ->
+ case is_comment(I) of
+ true -> no_comments(Xs);
+ false -> [I|no_comments(Xs)]
+ end.
+
+%%-----------------------------------------------------------------------
+
+%% @doc True if an Icode instruction is safe (can be removed if the
+%% result is not used). Note that pure control flow instructions
+%% cannot be regarded as safe, as they are not defining anything.
+
+-spec is_safe(icode_instr()) -> boolean().
+
+is_safe(Instr) ->
+ case Instr of
+ %% Instructions that are safe, or might be safe to remove.
+ #icode_move{} -> true;
+ #icode_phi{} -> true;
+ #icode_begin_handler{} -> true;
+ #icode_call{} ->
+ case call_fun(Instr) of
+ {M,F,A} ->
+ erl_bifs:is_safe(M,F,A);
+ Op ->
+ hipe_icode_primops:is_safe(Op)
+ end;
+ %% Control flow instructions.
+ #icode_if{} -> false;
+ #icode_switch_val{} -> false;
+ #icode_switch_tuple_arity{} -> false;
+ #icode_type{} -> false;
+ #icode_goto{} -> false;
+ #icode_label{} -> false;
+ %% Returning instructions without defines.
+ #icode_return{} -> false;
+ #icode_fail{} -> false;
+ #icode_enter{} -> false;
+ %% Internal auxiliary instructions that should not be removed
+ %% unless you really know what you are doing.
+ #icode_comment{} -> false;
+ #icode_begin_try{} -> false;
+ #icode_end_try{} -> false
+ end.
+
+%%-----------------------------------------------------------------------
+
+-spec highest_var(icode_instrs()) -> non_neg_integer().
+highest_var(Instrs) ->
+ highest_var(Instrs, 0).
+
+-spec highest_var(icode_instrs(), non_neg_integer()) -> non_neg_integer().
+highest_var([I|Is], Max) ->
+ Defs = defines(I),
+ Uses = uses(I),
+ highest_var(Is, new_max(Defs++Uses, Max));
+highest_var([], Max) ->
+ Max.
+
+-spec new_max([#icode_variable{}], non_neg_integer()) -> non_neg_integer().
+new_max([V|Vs], Max) ->
+ VName =
+ case is_var(V) of
+ true ->
+ var_name(V);
+ false ->
+ case is_fvar(V) of
+ true ->
+ fvar_name(V);
+ _ ->
+ reg_name(V)
+ end
+ end,
+ new_max(Vs, erlang:max(VName, Max));
+new_max([], Max) when is_integer(Max) ->
+ Max.
+
+%%-----------------------------------------------------------------------
+
+-spec highest_label(icode_instrs()) -> icode_lbl().
+highest_label(Instrs) ->
+ highest_label(Instrs, 0).
+
+-spec highest_label(icode_instrs(), icode_lbl()) -> icode_lbl().
+highest_label([I|Is], Max) ->
+ case is_label(I) of
+ true ->
+ L = label_name(I),
+ NewMax = erlang:max(L, Max),
+ highest_label(Is, NewMax);
+ false ->
+ highest_label(Is, Max)
+ end;
+highest_label([], Max) when is_integer(Max) ->
+ Max.
+
+%%-----------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl
new file mode 100644
index 0000000000..65deaf6d7c
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode.hrl
@@ -0,0 +1,188 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%=====================================================================
+%%
+%% Contains type and record definitions for all Icode data structures.
+%%
+%%=====================================================================
+
+%%---------------------------------------------------------------------
+%% THIS DOES NOT REALLY BELONG HERE -- PLEASE REMOVE ASAP!
+%%---------------------------------------------------------------------
+
+-type ordset(T) :: [T].
+
+%%---------------------------------------------------------------------
+%% Include files needed for the compilation of this header file
+%%---------------------------------------------------------------------
+
+-include("../misc/hipe_consttab.hrl").
+
+%%---------------------------------------------------------------------
+%% Icode argument types
+%%---------------------------------------------------------------------
+
+-type simple_const() :: atom() | [] | integer() | float().
+-type structured_const() :: list() | tuple().
+
+-type icode_lbl() :: non_neg_integer().
+
+%%---------------------------------------------------------------------
+%% Icode records
+%%---------------------------------------------------------------------
+
+-record(flat, {value :: simple_const() | structured_const() | binary()}).
+
+-record(icode_const, {value :: #flat{}}).
+
+-type variable_annotation() :: {atom(), any(), fun((any()) -> string())}.
+
+-record(icode_variable, {name :: non_neg_integer(),
+ kind :: 'var' | 'reg' | 'fvar',
+ annotation = [] :: [] | variable_annotation()}).
+
+%%---------------------------------------------------------------------
+%% Type declarations for Icode instructions
+%%---------------------------------------------------------------------
+
+-type icode_if_op() :: '>' | '<' | '>=' | '=<' | '=:=' | '=/=' | '==' | '/='
+ | 'fixnum_eq' | 'fixnum_neq' | 'fixnum_lt'
+ | 'fixnum_le' | 'fixnum_ge' | 'fixnum_gt'
+ | 'suspend_msg_timeout'.
+
+-type icode_type_test() :: 'atom' | 'bignum' | 'binary' | 'bitrst' | 'boolean'
+ | 'cons' | 'constant' | 'fixnum' | 'float'
+ | 'function' | 'function2' | 'integer' | 'list' | 'nil'
+ | 'number' | 'pid' | 'port' | 'reference' | 'tuple'
+ | {'atom', atom()} | {'integer', integer()}
+ | {'record', atom(), non_neg_integer()}
+ | {'tuple', non_neg_integer()}.
+
+-type icode_primop() :: atom() | tuple(). % XXX: temporarily, I hope
+-type icode_funcall() :: mfa() | icode_primop().
+
+-type icode_var() :: #icode_variable{kind::'var'}.
+-type icode_reg() :: #icode_variable{kind::'reg'}.
+-type icode_fvar() :: #icode_variable{kind::'fvar'}.
+-type icode_argument() :: #icode_const{} | #icode_variable{}.
+-type icode_term_arg() :: icode_var() | #icode_const{}.
+
+-type icode_switch_case() :: {#icode_const{}, icode_lbl()}.
+
+-type icode_call_type() :: 'local' | 'primop' | 'remote'.
+-type icode_exit_class() :: 'error' | 'exit' | 'rethrow' | 'throw'.
+
+-type icode_comment_text() :: atom() | string() | {atom(), term()}.
+
+-type icode_info() :: [{'arg_types', [erl_types:erl_type()]}].
+
+%%---------------------------------------------------------------------
+%% Icode instructions
+%%---------------------------------------------------------------------
+
+-record(icode_label, {name :: icode_lbl()}).
+
+-record(icode_if, {op :: icode_if_op(),
+ args :: [icode_term_arg()],
+ true_label :: icode_lbl(),
+ false_label :: icode_lbl(),
+ p :: float()}).
+
+-record(icode_switch_val, {term :: icode_var(),
+ fail_label :: icode_lbl(),
+ length :: non_neg_integer(),
+ cases :: [icode_switch_case()]}).
+
+-record(icode_switch_tuple_arity, {term :: icode_var(),
+ fail_label :: icode_lbl(),
+ length :: non_neg_integer(),
+ cases :: [icode_switch_case()]}).
+
+
+-record(icode_type, {test :: icode_type_test(),
+ args :: [icode_term_arg()],
+ true_label :: icode_lbl(),
+ false_label :: icode_lbl(),
+ p :: float()}).
+
+-record(icode_goto, {label :: icode_lbl()}).
+
+-record(icode_move, {dst :: #icode_variable{},
+ src :: #icode_variable{} | #icode_const{}}).
+
+-record(icode_phi, {dst :: #icode_variable{},
+ id :: #icode_variable{},
+ arglist :: [{icode_lbl(), #icode_variable{}}]}).
+
+-record(icode_call, {dstlist :: [#icode_variable{}],
+ 'fun' :: icode_funcall(),
+ args :: [icode_argument()],
+ type :: icode_call_type(),
+ continuation :: [] | icode_lbl(),
+ fail_label = [] :: [] | icode_lbl(),
+ in_guard = false :: boolean()}).
+
+-record(icode_enter, {'fun' :: icode_funcall(),
+ args :: [icode_term_arg()],
+ type :: icode_call_type()}).
+
+-record(icode_return, {vars :: [icode_var()]}).
+
+-record(icode_begin_try, {label :: icode_lbl(), successor :: icode_lbl()}).
+
+-record(icode_end_try, {}).
+
+-record(icode_begin_handler, {dstlist :: [icode_var()]}).
+
+%% TODO: Remove [] from fail_label
+-record(icode_fail, {class :: icode_exit_class(),
+ args :: [icode_term_arg()],
+ fail_label = [] :: [] | icode_lbl()}).
+
+-record(icode_comment, {text :: icode_comment_text()}).
+
+%%---------------------------------------------------------------------
+%% Icode instructions
+%%---------------------------------------------------------------------
+
+-type icode_instr() :: #icode_begin_handler{} | #icode_begin_try{}
+ | #icode_call{} | #icode_comment{} | #icode_end_try{}
+ | #icode_enter{} | #icode_fail{}
+ | #icode_goto{} | #icode_if{} | #icode_label{}
+ | #icode_move{} | #icode_phi{} | #icode_return{}
+ | #icode_switch_tuple_arity{} | #icode_switch_val{}
+ | #icode_type{}.
+-type icode_instrs() :: [icode_instr()].
+
+%%---------------------------------------------------------------------
+%% The Icode data structure
+%%---------------------------------------------------------------------
+
+-record(icode, {'fun' :: mfa(),
+ params :: [icode_var()],
+ is_closure :: boolean(),
+ closure_arity :: arity(),
+ is_leaf :: boolean(),
+ code = [] :: icode_instrs(),
+ data :: hipe_consttab(),
+ var_range :: {non_neg_integer(), non_neg_integer()},
+ label_range :: {icode_lbl(), icode_lbl()},
+ info = [] :: icode_info()}).
+
+%%---------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode_bincomp.erl b/lib/hipe/icode/hipe_icode_bincomp.erl
new file mode 100644
index 0000000000..6f694f2bce
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_bincomp.erl
@@ -0,0 +1,178 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_icode_bincomp.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 12 Sep 2005 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+
+-module(hipe_icode_bincomp).
+
+-export([cfg/1]).
+
+%%--------------------------------------------------------------------
+
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+
+%%--------------------------------------------------------------------
+
+-spec cfg(cfg()) -> cfg().
+
+cfg(Cfg1) ->
+ StartLbls = ordsets:from_list([hipe_icode_cfg:start_label(Cfg1)]),
+ find_bs_get_integer(StartLbls, Cfg1, StartLbls).
+
+find_bs_get_integer([Lbl|Rest], Cfg, Visited) ->
+ BB = hipe_icode_cfg:bb(Cfg, Lbl),
+ Last = hipe_bb:last(BB),
+ NewCfg =
+ case ok(Last, Cfg) of
+ {ok,{Type, FakeFail, RealFail, SuccLbl, MsIn, MsOut}} ->
+ {Cont, Info, OldLbl, LastMsOut} =
+ collect_info(SuccLbl, Cfg, [Type], Lbl, RealFail, MsOut),
+ update_code(Lbl, OldLbl, Cfg, Info, Cont, FakeFail, MsIn, LastMsOut);
+ not_ok ->
+ Cfg
+ end,
+ Succs = ordsets:from_list(hipe_icode_cfg:succ(NewCfg, Lbl)),
+ NewSuccs = ordsets:subtract(Succs, Visited),
+ NewLbls = ordsets:union(NewSuccs, Rest),
+ NewVisited = ordsets:union(NewSuccs, Visited),
+ find_bs_get_integer(NewLbls, NewCfg, NewVisited);
+find_bs_get_integer([], Cfg, _) ->
+ Cfg.
+
+ok(I, Cfg) ->
+ case hipe_icode:is_call(I) of
+ true ->
+ case hipe_icode:call_fun(I) of
+ {hipe_bs_primop, {bs_get_integer, Size, Flags}} when (Flags band 6) =:= 0 ->
+ case {hipe_icode:call_dstlist(I), hipe_icode:call_args(I)} of
+ {[Dst, MsOut] = DstList, [MsIn]} ->
+ Cont = hipe_icode:call_continuation(I),
+ FirstFail = hipe_icode:call_fail_label(I),
+ FirstFailBB = hipe_icode_cfg:bb(Cfg, FirstFail),
+ case check_for_restore_block(FirstFailBB, DstList) of
+ {restore_block, RealFail} ->
+ {ok, {{Dst, Size}, FirstFail, RealFail, Cont, MsIn, MsOut}};
+ not_restore_block ->
+ not_ok
+ end;
+ _ ->
+ not_ok
+ end;
+ _ ->
+ not_ok
+ end;
+ false ->
+ not_ok
+ end.
+
+check_for_restore_block(FirstFailBB, DefVars) ->
+ Moves = hipe_bb:butlast(FirstFailBB),
+ case [Instr || Instr <- Moves, is_badinstr(Instr, DefVars)] of
+ [] ->
+ Last = hipe_bb:last(FirstFailBB),
+ case hipe_icode:is_goto(Last) of
+ true ->
+ {restore_block, hipe_icode:goto_label(Last)};
+ false ->
+ not_restore_block
+ end;
+ [_|_] ->
+ not_restore_block
+ end.
+
+is_badinstr(Instr, DefVars) ->
+ not(hipe_icode:is_move(Instr) andalso
+ lists:member(hipe_icode:move_dst(Instr), DefVars)).
+
+collect_info(Lbl, Cfg, Acc, OldLbl, FailLbl, MsOut) ->
+ case do_collect_info(Lbl, Cfg, Acc, FailLbl, MsOut) of
+ done ->
+ {Lbl, Acc, OldLbl, MsOut};
+ {cont, NewAcc, NewLbl, NewMsOut} ->
+ collect_info(NewLbl, Cfg, NewAcc, Lbl, FailLbl, NewMsOut)
+ end.
+
+do_collect_info(Lbl, Cfg, Acc, FailLbl, MsOut) ->
+ BB = hipe_icode_cfg:bb(Cfg,Lbl),
+ case hipe_bb:code(BB) of
+ [I] ->
+ case hipe_icode_cfg:pred(Cfg,Lbl) of
+ [_] ->
+ case ok(I, Cfg) of
+ {ok, {Type,_FakeFail,FailLbl,SuccLbl,MsOut,NewMsOut}} ->
+ NewAcc = [Type|Acc],
+ MaxSize = hipe_rtl_arch:word_size() * 8 - 5,
+ case calc_size(NewAcc) of
+ Size when Size =< MaxSize ->
+ {cont,NewAcc,SuccLbl,NewMsOut};
+ _ ->
+ done
+ end;
+ _ ->
+ done
+ end;
+ _ ->
+ done
+ end;
+ _ ->
+ done
+ end.
+
+calc_size([{_,Size}|Rest]) when is_integer(Size) ->
+ Size + calc_size(Rest);
+calc_size([]) -> 0.
+
+update_code(_Lbl, _, Cfg, [_Info], _Cont, _LastFail, _MsIn, _MsOut) ->
+ Cfg;
+update_code(Lbl, OldLbl, Cfg, Info, Cont, LastFail, MsIn, MsOut) ->
+ BB = hipe_icode_cfg:bb(Cfg, Lbl),
+ ButLast = hipe_bb:butlast(BB),
+ NewVar = hipe_icode:mk_new_var(),
+ Size = calc_size(Info),
+ NewLast =
+ hipe_icode:mk_primop([NewVar,MsOut],
+ {hipe_bs_primop, {bs_get_integer,Size,0}},
+ [MsIn],
+ OldLbl,
+ LastFail),
+ NewBB = hipe_bb:mk_bb(ButLast++[NewLast]),
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Lbl, NewBB),
+ fix_rest(Info, NewVar, OldLbl, Cont, NewCfg).
+
+fix_rest(Info, Var, Lbl, Cont, Cfg) ->
+ ButLast = make_butlast(Info, Var),
+ Last = hipe_icode:mk_goto(Cont),
+ NewBB = hipe_bb:mk_bb(ButLast++[Last]),
+ hipe_icode_cfg:bb_add(Cfg, Lbl, NewBB).
+
+make_butlast([{Res,_Size}], Var) ->
+ [hipe_icode:mk_move(Res, Var)];
+make_butlast([{Res, Size}|Rest], Var) ->
+ NewVar = hipe_icode:mk_new_var(),
+ [hipe_icode:mk_primop([Res], 'band',
+ [Var, hipe_icode:mk_const((1 bsl Size)-1)]),
+ hipe_icode:mk_primop([NewVar], 'bsr', [Var, hipe_icode:mk_const(Size)])
+ |make_butlast(Rest, NewVar)].
diff --git a/lib/hipe/icode/hipe_icode_callgraph.erl b/lib/hipe/icode/hipe_icode_callgraph.erl
new file mode 100644
index 0000000000..95182fc002
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_callgraph.erl
@@ -0,0 +1,217 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------
+%% File : hipe_icode_callgraph.erl
+%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%% Purpose : Creates a call graph to find out in what order functions
+%% in a module have to be compiled to gain best information
+%% in hipe_icode_type.erl.
+%%
+%% Created : 7 Jun 2004 by Tobias Lindahl <tobiasl@it.uu.se>
+%%
+%% $Id$
+%%-----------------------------------------------------------------------
+-module(hipe_icode_callgraph).
+
+-export([construct/1,
+ get_called_modules/1,
+ to_list/1,
+ construct_callgraph/1]).
+
+-define(NO_UNUSED, true).
+
+-ifndef(NO_UNUSED).
+-export([is_empty/1, take_first/1, pp/1]).
+-endif.
+
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+
+%%------------------------------------------------------------------------
+
+-type mfa_icode() :: {mfa(), #icode{}}.
+
+-record(icode_callgraph, {codedict :: dict(), ordered_sccs :: [[atom()]]}).
+
+%%------------------------------------------------------------------------
+%% Exported functions
+%%------------------------------------------------------------------------
+
+-spec construct([mfa_icode()]) -> #icode_callgraph{}.
+
+construct(List) ->
+ Calls = get_local_calls(List),
+ %% io:format("Calls: ~p\n", [lists:keysort(1, Calls)]),
+ Edges = get_edges(Calls),
+ %% io:format("Edges: ~p\n", [Edges]),
+ DiGraph = hipe_digraph:from_list(Edges),
+ Nodes = ordsets:from_list([MFA || {MFA, _} <- List]),
+ DiGraph1 = hipe_digraph:add_node_list(Nodes, DiGraph),
+ SCCs = hipe_digraph:reverse_preorder_sccs(DiGraph1),
+ #icode_callgraph{codedict = dict:from_list(List), ordered_sccs = SCCs}.
+
+-spec construct_callgraph([mfa_icode()]) -> hipe_digraph:hdg().
+
+construct_callgraph(List) ->
+ Calls = get_local_calls2(List),
+ Edges = get_edges(Calls),
+ hipe_digraph:from_list(Edges).
+
+-spec to_list(#icode_callgraph{}) -> [mfa_icode()].
+
+to_list(#icode_callgraph{codedict = Dict, ordered_sccs = SCCs}) ->
+ FlatList = lists:flatten(SCCs),
+ [{Mod, dict:fetch(Mod, Dict)} || Mod <- FlatList].
+
+%%------------------------------------------------------------------------
+
+-ifndef(NO_UNUSED).
+
+-spec is_empty(#icode_callgraph{}) -> boolean().
+
+is_empty(#icode_callgraph{ordered_sccs = SCCs}) ->
+ SCCs =:= [].
+
+-spec take_first(#icode_callgraph{}) -> {[mfa_icode()], #icode_callgraph{}}.
+
+take_first(#icode_callgraph{codedict = Dict, ordered_sccs = [H|T]} = CG) ->
+ SCCCode = [{Mod, dict:fetch(Mod, Dict)} || Mod <- H],
+ {SCCCode, CG#icode_callgraph{ordered_sccs = T}}.
+
+-spec pp(#icode_callgraph{}) -> 'ok'.
+
+pp(#icode_callgraph{ordered_sccs = SCCs}) ->
+ io:format("Callgraph ~p\n", [SCCs]).
+-endif.
+
+%%------------------------------------------------------------------------
+%% Get the modules called from this module
+
+-spec get_called_modules([mfa_icode()]) -> ordset(atom()).
+
+get_called_modules(List) ->
+ get_remote_calls(List, []).
+
+get_remote_calls([{_MFA, Icode}|Left], Acc) ->
+ CallSet = get_remote_calls_1(hipe_icode:icode_code(Icode), Acc),
+ get_remote_calls(Left, ordsets:union(Acc, CallSet));
+get_remote_calls([], Acc) ->
+ Acc.
+
+get_remote_calls_1([I|Left], Set) ->
+ NewSet =
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_type(I) of
+ remote ->
+ {M, _F, _A} = hipe_icode:call_fun(I),
+ ordsets:add_element(M, Set);
+ _ ->
+ Set
+ end;
+ #icode_enter{} ->
+ case hipe_icode:enter_type(I) of
+ remote ->
+ {M, _F, _A} = hipe_icode:enter_fun(I),
+ ordsets:add_element(M, Set);
+ _ ->
+ Set
+ end;
+ _ ->
+ Set
+ end,
+ get_remote_calls_1(Left, NewSet);
+get_remote_calls_1([], Set) ->
+ Set.
+
+%%------------------------------------------------------------------------
+%% Find functions called (or entered) by each function.
+
+get_local_calls(List) ->
+ RemoveFun = fun ordsets:del_element/2,
+ get_local_calls(List, RemoveFun, []).
+
+get_local_calls2(List) ->
+ RemoveFun = fun(_,Set) -> Set end,
+ get_local_calls(List, RemoveFun, []).
+
+get_local_calls([{{_M, _F, _A} = MFA, Icode}|Left], RemoveFun, Acc) ->
+ CallSet = get_local_calls_1(hipe_icode:icode_code(Icode)),
+ %% Exclude recursive calls.
+ CallSet1 = RemoveFun(MFA, CallSet),
+ get_local_calls(Left, RemoveFun, [{MFA, CallSet1}|Acc]);
+get_local_calls([], _RemoveFun, Acc) ->
+ Acc.
+
+get_local_calls_1(Icode) ->
+ get_local_calls_1(Icode, []).
+
+get_local_calls_1([I|Left], Set) ->
+ NewSet =
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_type(I) of
+ local ->
+ Fun = hipe_icode:call_fun(I),
+ ordsets:add_element(Fun, Set);
+ primop ->
+ case hipe_icode:call_fun(I) of
+ #mkfun{mfa = Fun} ->
+ ordsets:add_element(Fun, Set);
+ _ ->
+ Set
+ end;
+ remote ->
+ Set
+ end;
+ #icode_enter{} ->
+ case hipe_icode:enter_type(I) of
+ local ->
+ Fun = hipe_icode:enter_fun(I),
+ ordsets:add_element(Fun, Set);
+ primop ->
+ case hipe_icode:enter_fun(I) of
+ #mkfun{mfa = Fun} ->
+ ordsets:add_element(Fun, Set);
+ _ ->
+ Set
+ end;
+ remote ->
+ Set
+ end;
+ _ ->
+ Set
+ end,
+ get_local_calls_1(Left, NewSet);
+get_local_calls_1([], Set) ->
+ Set.
+
+%%------------------------------------------------------------------------
+%% Find the edges in the callgraph.
+
+get_edges(Calls) ->
+ get_edges(Calls, []).
+
+get_edges([{MFA, Set}|Left], Edges) ->
+ EdgeList = [{MFA, X} || X <- Set],
+ EdgeSet = ordsets:from_list(EdgeList),
+ get_edges(Left, ordsets:union(EdgeSet, Edges));
+get_edges([], Edges) ->
+ Edges.
diff --git a/lib/hipe/icode/hipe_icode_cfg.erl b/lib/hipe/icode/hipe_icode_cfg.erl
new file mode 100644
index 0000000000..9b4a10e273
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_cfg.erl
@@ -0,0 +1,203 @@
+%% -*- erlang-indent-level: 2 -*-
+%%======================================================================
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_icode_cfg).
+
+-export([bb/2, bb_add/3,
+ cfg_to_linear/1,
+ is_closure/1,
+ closure_arity/1,
+ linear_to_cfg/1,
+ labels/1, start_label/1,
+ pp/1, pp/2,
+ params/1, params_update/2,
+ pred/2,
+ redirect/4,
+ remove_trivial_bbs/1, remove_unreachable_code/1,
+ succ/2,
+ visit/2, is_visited/2, none_visited/0
+ ]).
+-export([postorder/1, reverse_postorder/1]).
+
+-define(ICODE_CFG, true). % needed by cfg.inc
+%%-define(DO_ASSERT, true).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("../flow/hipe_bb.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/cfg.inc").
+
+%%----------------------------------------------------------------------
+%% Prototypes for exported functions which are Icode specific
+%%----------------------------------------------------------------------
+
+-spec labels(cfg()) -> [icode_lbl()].
+-spec postorder(cfg()) -> [icode_lbl()].
+-spec reverse_postorder(cfg()) -> [icode_lbl()].
+
+-spec is_visited(icode_lbl(), gb_set()) -> boolean().
+-spec visit(icode_lbl(), gb_set()) -> gb_set().
+
+-spec bb(cfg(), icode_lbl()) -> 'not_found' | bb().
+-spec bb_add(cfg(), icode_lbl(), bb()) -> cfg().
+-spec pred(cfg(), icode_lbl()) -> [icode_lbl()].
+-spec succ(cfg(), icode_lbl()) -> [icode_lbl()].
+-spec redirect(cfg(), icode_lbl(), icode_lbl(), icode_lbl()) -> cfg().
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface to Icode
+%%
+
+-spec linear_to_cfg(#icode{}) -> cfg().
+
+linear_to_cfg(LinearIcode) ->
+ %% hipe_icode_pp:pp(Icode),
+ Code = hipe_icode:icode_code(LinearIcode),
+ IsClosure = hipe_icode:icode_is_closure(LinearIcode),
+ StartLabel = hipe_icode:label_name(hd(Code)),
+ CFG0 = mk_empty_cfg(hipe_icode:icode_fun(LinearIcode),
+ StartLabel,
+ hipe_icode:icode_data(LinearIcode),
+ IsClosure,
+ hipe_icode:icode_is_leaf(LinearIcode),
+ hipe_icode:icode_params(LinearIcode)),
+ CFG1 = info_update(CFG0, hipe_icode:icode_info(LinearIcode)),
+ CFG2 = case IsClosure of
+ true ->
+ closure_arity_update(CFG1,
+ hipe_icode:icode_closure_arity(LinearIcode));
+ false ->
+ CFG1
+ end,
+ ?opt_start_timer("Get BBs icode"),
+ FullCFG = take_bbs(Code, CFG2),
+ ?opt_stop_timer("Get BBs icode"),
+ FullCFG.
+
+%% remove_blocks(CFG, []) ->
+%% CFG;
+%% remove_blocks(CFG, [Lbl|Lbls]) ->
+%% remove_blocks(bb_remove(CFG, Lbl), Lbls).
+
+-spec is_label(icode_instr()) -> boolean().
+is_label(Instr) ->
+ hipe_icode:is_label(Instr).
+
+label_name(Instr) ->
+ hipe_icode:label_name(Instr).
+
+mk_label(Name) ->
+ hipe_icode:mk_label(Name).
+
+mk_goto(Name) ->
+ hipe_icode:mk_goto(Name).
+
+branch_successors(Instr) ->
+ hipe_icode:successors(Instr).
+
+fails_to(Instr) ->
+ hipe_icode:fails_to(Instr).
+
+%% True if instr has no effect.
+-spec is_comment(icode_instr()) -> boolean().
+is_comment(Instr) ->
+ hipe_icode:is_comment(Instr).
+
+%% True if instr is just a jump (no side-effects).
+-spec is_goto(icode_instr()) -> boolean().
+is_goto(Instr) ->
+ hipe_icode:is_goto(Instr).
+
+-spec is_branch(icode_instr()) -> boolean().
+is_branch(Instr) ->
+ hipe_icode:is_branch(Instr).
+
+-spec is_pure_branch(icode_instr()) -> boolean().
+is_pure_branch(Instr) ->
+ case Instr of
+ #icode_if{} -> true;
+ #icode_goto{} -> true;
+ #icode_switch_val{} -> true;
+ #icode_switch_tuple_arity{} -> true;
+ #icode_type{} -> true;
+ %% false cases below -- XXX: are they correct?
+ #icode_label{} -> false;
+ #icode_move{} -> false;
+ #icode_phi{} -> false;
+ #icode_call{} -> false;
+ #icode_enter{} -> false;
+ #icode_return{} -> false;
+ #icode_begin_try{} -> false;
+ #icode_end_try{} -> false;
+ #icode_begin_handler{} -> false;
+ #icode_fail{} -> false;
+ #icode_comment{} -> false
+ end.
+
+-spec is_phi(icode_instr()) -> boolean().
+is_phi(I) ->
+ hipe_icode:is_phi(I).
+
+phi_remove_pred(I, Pred) ->
+ hipe_icode:phi_remove_pred(I, Pred).
+
+%% phi_redirect_pred(I, OldPred, NewPred) ->
+%% hipe_icode:phi_redirect_pred(I, OldPred, NewPred).
+
+redirect_jmp(Jmp, ToOld, ToNew) ->
+ hipe_icode:redirect_jmp(Jmp, ToOld, ToNew).
+
+redirect_ops(_, CFG, _) -> %% We do not refer to labels in Icode ops.
+ CFG.
+
+%%----------------------------------------------------------------------------
+
+-spec pp(cfg()) -> 'ok'.
+
+pp(CFG) ->
+ hipe_icode_pp:pp(cfg_to_linear(CFG)).
+
+-spec pp(io:device(), cfg()) -> 'ok'.
+
+pp(Dev, CFG) ->
+ hipe_icode_pp:pp(Dev, cfg_to_linear(CFG)).
+
+%%----------------------------------------------------------------------------
+
+-spec cfg_to_linear(cfg()) -> #icode{}.
+cfg_to_linear(CFG) ->
+ Code = linearize_cfg(CFG),
+ IsClosure = is_closure(CFG),
+ Icode = hipe_icode:mk_icode(function(CFG),
+ params(CFG),
+ IsClosure,
+ is_leaf(CFG),
+ Code,
+ data(CFG),
+ hipe_gensym:var_range(icode),
+ hipe_gensym:label_range(icode)),
+ Icode1 = hipe_icode:icode_info_update(Icode, info(CFG)),
+ case IsClosure of
+ true -> hipe_icode:icode_closure_arity_update(Icode1, closure_arity(CFG));
+ false -> Icode1
+ end.
diff --git a/lib/hipe/icode/hipe_icode_coordinator.erl b/lib/hipe/icode/hipe_icode_coordinator.erl
new file mode 100644
index 0000000000..a71e143192
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_coordinator.erl
@@ -0,0 +1,274 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%--------------------------------------------------------------------
+%% File : hipe_icode_coordinator.erl
+%% Author : Per Gustafsson <pergu@it.uu.se>
+%% Description : This module coordinates an Icode pass.
+%% Created : 20 Feb 2007 by Per Gustafsson <pergu@it.uu.se>
+%%---------------------------------------------------------------------
+
+-module(hipe_icode_coordinator).
+
+-export([coordinate/4]).
+
+-include("hipe_icode.hrl").
+
+%%---------------------------------------------------------------------
+
+-define(MAX_CONCURRENT, erlang:system_info(schedulers)).
+
+%%---------------------------------------------------------------------
+
+-spec coordinate(hipe_digraph:hdg(), [{mfa(),boolean()}], [mfa()], module()) ->
+ no_return().
+
+coordinate(CG, Escaping, NonEscaping, Mod) ->
+ ServerPid = initialize_server(Escaping, Mod),
+ Clean = [MFA || {MFA, _} <- Escaping],
+ All = NonEscaping ++ Clean,
+ Restart =
+ fun (MFALists, PM) -> restart_funs(MFALists, PM, All, ServerPid) end,
+ LastAction =
+ fun (PM) -> last_action(PM, ServerPid, Mod, All) end,
+ coordinate({Clean,All}, CG, gb_trees:empty(), Restart, LastAction, ServerPid).
+
+coordinate(MFALists, CG, PM, Restart, LastAction, ServerPid) ->
+ case MFALists of
+ {[], []} ->
+ LastAction(PM),
+ ServerPid ! stop,
+ receive
+ {stop, Ans2Pid} ->
+ Ans2Pid ! {done, self()},
+ exit(normal)
+ end;
+ _ -> ok
+ end,
+ receive
+ {stop, AnsPid} ->
+ ServerPid ! stop,
+ AnsPid ! {done, self()},
+ exit(normal);
+ Message ->
+ {NewPM, NewMFALists} =
+ case Message of
+ {restart_call, MFA} ->
+ {PM, handle_restart_call(MFA, MFALists)};
+ {ready, {MFA, Pid}} ->
+ handle_ready(MFA, Pid, MFALists, PM);
+ {restart_done, MFA} ->
+ {PM, handle_restart_done(MFA, MFALists, CG)};
+ {no_change_done, MFA} ->
+ {PM, handle_no_change_done(MFA, MFALists)}
+ end,
+ coordinate(Restart(NewMFALists, NewPM), CG, NewPM, Restart,
+ LastAction, ServerPid)
+ end.
+
+handle_restart_call(MFA, {Queue, Busy} = QB) ->
+ case lists:member(MFA, Queue) of
+ true ->
+ QB;
+ false ->
+ {[MFA|Queue], Busy}
+ end.
+
+handle_ready(MFA, Pid, {Queue, Busy}, PM) ->
+ {gb_trees:insert(MFA, Pid, PM), {Queue, Busy -- [MFA]}}.
+
+handle_restart_done(MFA, {Queue, Busy}, CG) ->
+ Restarts = hipe_digraph:get_parents(MFA, CG),
+ {ordsets:from_list(Restarts ++ Queue), Busy -- [MFA]}.
+
+handle_no_change_done(MFA, {Queue, Busy}) ->
+ {Queue, Busy -- [MFA]}.
+
+last_action(PM, ServerPid, Mod, All) ->
+ lists:foreach(fun (MFA) ->
+ gb_trees:get(MFA, PM) ! {done, final_funs(ServerPid, Mod)},
+ receive
+ {done_rewrite, MFA} -> ok
+ end
+ end, All),
+ ok.
+
+restart_funs({Queue, Busy} = QB, PM, All, ServerPid) ->
+ case ?MAX_CONCURRENT - length(Busy) of
+ X when is_integer(X), X > 0 ->
+ Possible = [Pos || Pos <- Queue, (not lists:member(Pos, Busy))],
+ Restarts = lists:sublist(Possible, X),
+ lists:foreach(fun (MFA) ->
+ restart_fun(MFA, PM, All, ServerPid)
+ end, Restarts),
+ {Queue -- Restarts, Busy ++ Restarts};
+ X when is_integer(X) ->
+ QB
+ end.
+
+initialize_server(Escaping, Mod) ->
+ Pid = spawn_link(fun () -> info_server(Mod) end),
+ lists:foreach(fun ({MFA, _}) -> Pid ! {set_escaping, MFA} end, Escaping),
+ Pid.
+
+safe_get_args(MFA, Cfg, Pid, Mod) ->
+ Mod:replace_nones(get_args(MFA, Cfg, Pid)).
+
+get_args(MFA, Cfg, Pid) ->
+ Ref = make_ref(),
+ Pid ! {get_call, MFA, Cfg, self(), Ref},
+ receive
+ {Ref, Types} ->
+ Types
+ end.
+
+safe_get_res(MFA, Pid, Mod) ->
+ Mod:replace_nones(get_res(MFA, Pid)).
+
+get_res(MFA, Pid) ->
+ Ref = make_ref(),
+ Pid ! {get_return, MFA, self(), Ref},
+ receive
+ {Ref, Types} ->
+ Types
+ end.
+
+update_return_type(MFA, NewType, Pid) ->
+ Ref = make_ref(),
+ Pid ! {update_return, MFA, NewType, self(), Ref},
+ receive
+ {Ref, Ans} ->
+ Ans
+ end.
+
+update_call_type(MFA, NewTypes, Pid) ->
+ Ref = make_ref(),
+ Pid ! {update_call, MFA, NewTypes, self(), Ref},
+ receive
+ {Ref, Ans} ->
+ Ans
+ end.
+
+restart_fun(MFA, PM, All, ServerPid) ->
+ gb_trees:get(MFA, PM) ! {analyse, analysis_funs(All, ServerPid)},
+ ok.
+
+analysis_funs(All, Pid) ->
+ Self = self(),
+ ArgsFun = fun (MFA, Cfg) -> get_args(MFA, Cfg, Pid) end,
+ GetResFun = fun (MFA, Args) ->
+ case lists:member(MFA, All) of
+ true ->
+ case update_call_type(MFA, Args, Pid) of
+ do_restart ->
+ Self ! {restart_call, MFA},
+ ok;
+ no_change ->
+ ok
+ end;
+ false ->
+ ok
+ end,
+ [Ans] = get_res(MFA, Pid),
+ Ans
+ end,
+ FinalFun = fun (MFA, RetTypes) ->
+ case update_return_type(MFA, RetTypes, Pid) of
+ do_restart ->
+ Self ! {restart_done, MFA},
+ ok;
+ no_change ->
+ Self ! {no_change_done, MFA},
+ ok
+ end
+ end,
+ {ArgsFun, GetResFun, FinalFun}.
+
+final_funs(Pid,Mod) ->
+ ArgsFun = fun (MFA, Cfg) -> safe_get_args(MFA, Cfg, Pid, Mod) end,
+ GetResFun = fun (MFA, _) ->
+ [Ans] = safe_get_res(MFA, Pid, Mod),
+ Ans
+ end,
+ FinalFun = fun (_, _) -> ok end,
+ {ArgsFun, GetResFun, FinalFun}.
+
+info_server(Mod) ->
+ info_server_loop(gb_trees:empty(), gb_trees:empty(), Mod).
+
+info_server_loop(CallInfo, ReturnInfo, Mod) ->
+ receive
+ {update_return, MFA, NewInfo, Pid, Ref} ->
+ NewReturnInfo = handle_update(MFA, ReturnInfo, NewInfo, Pid, Ref, Mod),
+ info_server_loop(CallInfo, NewReturnInfo, Mod);
+ {update_call, MFA, NewInfo, Pid, Ref} ->
+ NewCallInfo = handle_update(MFA, CallInfo, NewInfo, Pid, Ref, Mod),
+ info_server_loop(NewCallInfo, ReturnInfo, Mod);
+ {get_return, MFA, Pid, Ref} ->
+ Ans =
+ case gb_trees:lookup(MFA, ReturnInfo) of
+ none ->
+ Mod:return_none();
+ {value, TypesComp} ->
+ Mod:return__info((TypesComp))
+ end,
+ Pid ! {Ref, Ans},
+ info_server_loop(CallInfo, ReturnInfo, Mod);
+ {get_call, MFA, Cfg, Pid, Ref} ->
+ Ans =
+ case gb_trees:lookup(MFA, CallInfo) of
+ none ->
+ Mod:return_none_args(Cfg, MFA);
+ {value, escaping} ->
+ Mod:return_any_args(Cfg, MFA);
+ {value, TypesComp} ->
+ Mod:return__info(TypesComp)
+ end,
+ Pid ! {Ref, Ans},
+ info_server_loop(CallInfo, ReturnInfo, Mod);
+ {set_escaping, MFA} ->
+ NewCallInfo = gb_trees:enter(MFA, escaping, CallInfo),
+ info_server_loop(NewCallInfo, ReturnInfo, Mod);
+ stop ->
+ ok
+ end.
+
+handle_update(MFA, Tree, NewInfo, Pid, Ref, Mod) ->
+ ResType =
+ case gb_trees:lookup(MFA, Tree) of
+ none ->
+ %% io:format("First Type: ~w ~w~n", [NewType, MFA]),
+ Pid ! {Ref, do_restart},
+ Mod:new__info(NewInfo);
+ {value, escaping} ->
+ Pid ! {Ref, no_change},
+ escaping;
+ {value, OldInfo} ->
+ %% io:format("New Type: ~w ~w~n", [NewType, MFA]),
+ %% io:format("Old Type: ~w ~w~n", [OldType, MFA]),
+ case Mod:update__info(NewInfo, OldInfo) of
+ {true, Type} ->
+ Pid ! {Ref, no_change},
+ Type;
+ {false, Type} ->
+ Pid ! {Ref, do_restart},
+ Type
+ end
+ end,
+ gb_trees:enter(MFA, ResType, Tree).
diff --git a/lib/hipe/icode/hipe_icode_ebb.erl b/lib/hipe/icode/hipe_icode_ebb.erl
new file mode 100644
index 0000000000..966c4d7564
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_ebb.erl
@@ -0,0 +1,30 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Icode version of extended basic blocks.
+%%
+
+-module(hipe_icode_ebb).
+
+-define(CFG, hipe_icode_cfg).
+
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/ebb.inc").
diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl
new file mode 100644
index 0000000000..787fb05415
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_exceptions.erl
@@ -0,0 +1,474 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ====================================================================
+%% Filename : hipe_icode_exceptions.erl
+%% Module : hipe_icode_exceptions
+%% Purpose : Rewrite calls in intermediate code to use Continuation
+%% and Fail-To labels.
+%%
+%% Catch-instructions work as follows:
+%% - A begin_try(FailLabel) starts a catch-region which
+%% is ended by a corresponding end_try(FailLabel).
+%% - The handler begins with a begin_handler(FailLabel).
+%%
+%% However, the begin/end instructions do not always appear
+%% as parentheses around the section that they protect (in
+%% linear Beam/Icode). Also, different begin_catch
+%% instructions can reach the same basic blocks (which may
+%% raise exceptions), due to code compation optimizations
+%% in the Beam compiler, even though they have different
+%% handlers. Because of this, a data flow analysis is
+%% necessary to find out which catches may reach which
+%% basic blocks. After that, we clone basic blocks as
+%% needed to ensure that each block belongs to at most one
+%% unique begin_catch. The Beam does not have this problem,
+%% since it will find the correct catch-handler frame
+%% pushed on the stack. (Note that since there can be no
+%% tail-calls within a catch region, our dataflow analysis
+%% for finding all catch-stacks is sure to terminate.)
+%%
+%% Finally, we can remove all special catch instructions
+%% and rewrite calls within catch regions to use explicit
+%% fail-to labels, which is the main point of all this.
+%% Fail labels that were set before this pass are kept.
+%% (Note that calls that have only a continuation label do
+%% not always end their basic blocks. Adding a fail label
+%% to such a call can thus force us to split the block.)
+%%
+%% Notes : As of November 2003, primops that do not fail in the
+%% normal sense are allowed to have a fail-label even
+%% before this pass. (Used for the mbox-empty + get_msg
+%% primitive in receives.)
+%%
+%% Native floating point operations cannot fail in the
+%% normal sense. Instead they throw a hardware exception
+%% which will be caught by a special fp check error
+%% instruction. These primops do not need a fail label even
+%% in a catch. This pass checks for this with
+%% hipe_icode_primops:fails/1. If a call cannot fail, no
+%% fail label is added.
+%%
+%% Explicit fails (exit, error and throw) inside
+%% a catch have to be handled. They have to build their
+%% exit value and jump directly to the catch handler. An
+%% alternative solution would be to have a new type of
+%% fail instruction that takes a fail-to label...
+%%
+%% CVS:
+%% $Id$
+%% ====================================================================
+
+-module(hipe_icode_exceptions).
+
+-export([fix_catches/1]).
+
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+
+%%----------------------------------------------------------------------------
+
+-spec fix_catches(#cfg{}) -> #cfg{}.
+
+fix_catches(CFG) ->
+ {Map, State} = build_mapping(find_catches(init_state(CFG))),
+ hipe_icode_cfg:remove_unreachable_code(get_cfg(rewrite(State, Map))).
+
+%% This finds the set of possible catch-stacks for each basic block
+
+find_catches(State) ->
+ find_catches(get_start_labels(State),
+ clear_visited(clear_changed(State))).
+
+find_catches([L|Ls], State0) ->
+ case is_visited(L, State0) of
+ true ->
+ find_catches(Ls, State0);
+ false ->
+ State1 = set_visited(L, State0),
+ Code = get_bb_code(L, State1),
+ Cs = get_new_catches_in(L, State1),
+ State2 = set_catches_in(L, Cs, State1), % memorize
+ Cs1 = catches_out(Code, Cs),
+ Ls1 = get_succ(L, State2) ++ Ls,
+ Cs0 = get_catches_out(L, State2),
+ if Cs1 =:= Cs0 ->
+ find_catches(Ls1, State2);
+ true ->
+ State3 = set_catches_out(L, Cs1, State2),
+ find_catches(Ls1, set_changed(State3))
+ end
+ end;
+find_catches([], State) ->
+ case is_changed(State) of
+ true ->
+ find_catches(State);
+ false ->
+ State
+ end.
+
+catches_out([I|Is], Cs) ->
+ catches_out(Is, catches_out_instr(I, Cs));
+catches_out([], Cs) ->
+ Cs.
+
+catches_out_instr(I, Cs) ->
+ case I of
+ #icode_begin_try{} ->
+ Id = hipe_icode:begin_try_label(I),
+ push_catch(Id, Cs);
+ #icode_end_try{} ->
+ pop_catch(Cs);
+ #icode_begin_handler{} ->
+ pop_catch(Cs);
+ _ ->
+ Cs
+ end.
+
+
+%% This builds the mapping used for cloning
+
+build_mapping(State) ->
+ build_mapping(get_start_labels(State), clear_visited(State),
+ new_mapping()).
+
+build_mapping([L|Ls], State0, Map) ->
+ case is_visited(L, State0) of
+ true ->
+ build_mapping(Ls, State0, Map);
+ false ->
+ State1 = set_visited(L, State0),
+ Cs = list_of_catches(get_catches_in(L, State1)), % get memorized
+ {Map1, State2} = map_bb(L, Cs, State1, Map),
+ Ls1 = get_succ(L, State2) ++ Ls,
+ build_mapping(Ls1, State2, Map1)
+ end;
+build_mapping([], State, Map) ->
+ {Map, State}.
+
+map_bb(_L, [_C], State, Map) ->
+ {Map, State};
+map_bb(L, [C | Cs], State, Map) ->
+ %% This block will be cloned - we need to create N-1 new labels.
+ %% The identity mapping will be used for the first element.
+ Map1 = new_catch_labels(Cs, L, Map),
+ State1 = set_catches_in(L, single_catch(C), State), % update catches in
+ Code = get_bb_code(L, State1),
+ State2 = clone(Cs, L, Code, State1, Map1),
+ {Map1, State2}.
+
+clone([C | Cs], L, Code, State, Map) ->
+ Ren = get_renaming(C, Map),
+ L1 = Ren(L),
+ State1 = set_bb_code(L1, Code, State),
+ State2 = set_catches_in(L1, single_catch(C), State1), % set catches in
+ clone(Cs, L, Code, State2, Map);
+clone([], _L, _Code, State, _Map) ->
+ State.
+
+new_catch_labels([C | Cs], L, Map) ->
+ L1 = hipe_icode:label_name(hipe_icode:mk_new_label()),
+ Map1 = set_mapping(C, L, L1, Map),
+ new_catch_labels(Cs, L, Map1);
+new_catch_labels([], _L, Map) ->
+ Map.
+
+
+%% This does all the actual rewriting and cloning.
+
+rewrite(State, Map) ->
+ rewrite(get_start_labels(State), clear_visited(State), Map).
+
+rewrite([L|Ls], State0, Map) ->
+ case is_visited(L, State0) of
+ true ->
+ rewrite(Ls, State0, Map);
+ false ->
+ State1 = set_visited(L, State0),
+ Code = get_bb_code(L, State1),
+ Cs = list_of_catches(get_catches_in(L, State1)), % get memorized
+ State2 = rewrite_bb(L, Cs, Code, State1, Map),
+ Ls1 = get_succ(L, State2) ++ Ls,
+ rewrite(Ls1, State2, Map)
+ end;
+rewrite([], State, _Map) ->
+ State.
+
+rewrite_bb(L, [C], Code, State, Map) ->
+ {Code1, State1} = rewrite_code(Code, C, State, Map),
+ set_bb_code(L, Code1, State1).
+
+rewrite_code(Is, C, State, Map) ->
+ rewrite_code(Is, C, State, Map, []).
+
+rewrite_code([I|Is], C, State, Map, As) ->
+ [C1] = list_of_catches(catches_out_instr(I, single_catch(C))),
+ case I of
+ #icode_begin_try{} ->
+ {I1, Is1, State1} = update_begin_try(I, Is, C, State, Map),
+ I2 = redirect_instr(I1, C, Map),
+ rewrite_code(Is1, C1, State1, Map, [I2 | As]);
+ #icode_end_try{} ->
+ rewrite_code(Is, C1, State, Map, As);
+ #icode_call{} ->
+ {I1, Is1, State1} = update_call(I, Is, C, State, Map),
+ I2 = redirect_instr(I1, C, Map),
+ rewrite_code(Is1, C1, State1, Map, [I2 | As]);
+ #icode_fail{} ->
+ {I1, Is1, State1} = update_fail(I, Is, C, State, Map),
+ I2 = redirect_instr(I1, C, Map),
+ rewrite_code(Is1, C1, State1, Map, [I2 | As]);
+ _ ->
+ I1 = redirect_instr(I, C, Map),
+ rewrite_code(Is, C1, State, Map, [I1 | As])
+ end;
+rewrite_code([], _C, State, _Map, As) ->
+ {lists:reverse(As), State}.
+
+redirect_instr(I, C, Map) ->
+ redirect_instr_1(I, hipe_icode:successors(I), get_renaming(C, Map)).
+
+redirect_instr_1(I, [L0 | Ls], Ren) ->
+ I1 = hipe_icode:redirect_jmp(I, L0, Ren(L0)),
+ redirect_instr_1(I1, Ls, Ren);
+redirect_instr_1(I, [], _Ren) ->
+ I.
+
+update_begin_try(I, Is, _C, State0, _Map) ->
+ L = hipe_icode:begin_try_successor(I),
+ I1 = hipe_icode:mk_goto(L),
+ {I1, Is, State0}.
+
+update_call(I, Is, C, State0, Map) ->
+ case top_of_stack(C) of
+ [] ->
+ %% No active catch. Assume cont./fail labels are correct as is.
+ {I, Is, State0};
+ L ->
+ %% Only update the fail label if the call *can* fail.
+ case hipe_icode_primops:fails(hipe_icode:call_fun(I)) of
+ true ->
+ %% We only update the fail label if it is not already set.
+ case hipe_icode:call_fail_label(I) of
+ [] ->
+ I1 = hipe_icode:call_set_fail_label(I, L),
+ %% Now the call will end the block, so we must put the rest of
+ %% the code (if nonempty) in a new block!
+ if Is =:= [] ->
+ {I1, Is, State0};
+ true ->
+ L1 = hipe_icode:label_name(hipe_icode:mk_new_label()),
+ I2 = hipe_icode:call_set_continuation(I1, L1),
+ State1 = set_bb_code(L1, Is, State0),
+ State2 = set_catches_in(L1, single_catch(C), State1),
+ State3 = rewrite_bb(L1, [C], Is, State2, Map),
+ {I2, [], State3}
+ end;
+ _ when Is =:= [] ->
+ %% Something is very wrong if Is is not empty here. A call
+ %% with a fail label should have ended its basic block.
+ {I, Is, State0}
+ end;
+ false ->
+ %% Make sure that the fail label is not set.
+ I1 = hipe_icode:call_set_fail_label(I, []),
+ {I1, Is, State0}
+ end
+ end.
+
+update_fail(I, Is, C, State, _Map) ->
+ case hipe_icode:fail_label(I) of
+ [] ->
+ {hipe_icode:fail_set_label(I, top_of_stack(C)), Is, State};
+ _ ->
+ {I, Is, State}
+ end.
+
+
+%%---------------------------------------------------------------------
+%% Abstraction for sets of catch stacks.
+
+%% This is the bottom element
+no_catches() -> [].
+
+%% A singleton set
+single_catch(C) -> [C].
+
+%% A single, empty stack
+empty_stack() -> [].
+
+%% Getting the label to fail to
+top_of_stack([C|_]) -> C;
+top_of_stack([]) -> []. % nil is used in Icode for "no label"
+
+join_catches(Cs1, Cs2) ->
+ ordsets:union(Cs1, Cs2).
+
+list_of_catches(Cs) -> Cs.
+
+%% Note that prepending an element to all elements in the list will
+%% preserve the ordering of the list, and will never make two existing
+%% elements become identical, so the list is still an ordset.
+
+push_catch(L, []) ->
+ [[L]];
+push_catch(L, Cs) ->
+ push_catch_1(L, Cs).
+
+push_catch_1(L, [C|Cs]) ->
+ [[L|C] | push_catch_1(L, Cs)];
+push_catch_1(_L, []) ->
+ [].
+
+%% However, after discarding the head of all elements, the list
+%% is no longer an ordset, and must be processed.
+
+pop_catch(Cs) ->
+ ordsets:from_list(pop_catch_1(Cs)).
+
+pop_catch_1([[_|C] | Cs]) ->
+ [C | pop_catch_1(Cs)];
+pop_catch_1([]) ->
+ [].
+
+
+%%---------------------------------------------------------------------
+%% Mapping from catch-stacks to renamings on labels.
+
+new_mapping() ->
+ gb_trees:empty().
+
+set_mapping(C, L0, L1, Map) ->
+ Dict = case gb_trees:lookup(C, Map) of
+ {value, Dict0} ->
+ gb_trees:enter(L0, L1, Dict0);
+ none ->
+ gb_trees:insert(L0, L1, gb_trees:empty())
+ end,
+ gb_trees:enter(C, Dict, Map).
+
+%% Return a label renaming function for a particular catch-stack
+
+get_renaming(C, Map) ->
+ case gb_trees:lookup(C, Map) of
+ {value, Dict} ->
+ fun (L0) ->
+ case gb_trees:lookup(L0, Dict) of
+ {value, L1} -> L1;
+ none -> L0
+ end
+ end;
+ none ->
+ fun (L0) -> L0 end
+ end.
+
+
+%%---------------------------------------------------------------------
+%% State abstraction
+
+-record(state, {cfg :: #cfg{},
+ changed = false :: boolean(),
+ succ :: #cfg{},
+ pred :: #cfg{},
+ start_labels :: [icode_lbl(),...],
+ visited = hipe_icode_cfg:none_visited() :: gb_set(),
+ out = gb_trees:empty() :: gb_tree(),
+ in = gb_trees:empty() :: gb_tree()
+ }).
+
+init_state(CFG) ->
+ State = #state{cfg = CFG},
+ refresh_state_cache(State).
+
+refresh_state_cache(State) ->
+ CFG = State#state.cfg,
+ SLs = [hipe_icode_cfg:start_label(CFG)],
+ State#state{succ = CFG, pred = CFG, start_labels = SLs}.
+
+get_cfg(State) ->
+ State#state.cfg.
+
+get_start_labels(State) ->
+ State#state.start_labels.
+
+get_pred(L, State) ->
+ hipe_icode_cfg:pred(State#state.pred, L).
+
+get_succ(L, State) ->
+ hipe_icode_cfg:succ(State#state.succ, L).
+
+set_changed(State) ->
+ State#state{changed = true}.
+
+is_changed(State) ->
+ State#state.changed.
+
+clear_changed(State) ->
+ State#state{changed = false}.
+
+set_catches_out(L, Cs, State) ->
+ State#state{out = gb_trees:enter(L, Cs, State#state.out)}.
+
+get_catches_out(L, State) ->
+ case gb_trees:lookup(L, State#state.out) of
+ {value, Cs} -> Cs;
+ none -> no_catches()
+ end.
+
+set_catches_in(L, Cs, State) ->
+ State#state{in = gb_trees:enter(L, Cs, State#state.in)}.
+
+get_catches_in(L, State) ->
+ case gb_trees:lookup(L, State#state.in) of
+ {value, Cs} -> Cs;
+ none -> no_catches()
+ end.
+
+set_visited(L, State) ->
+ State#state{visited = hipe_icode_cfg:visit(L, State#state.visited)}.
+
+is_visited(L, State) ->
+ hipe_icode_cfg:is_visited(L, State#state.visited).
+
+clear_visited(State) ->
+ State#state{visited = hipe_icode_cfg:none_visited()}.
+
+get_bb_code(L, State) ->
+ hipe_bb:code(hipe_icode_cfg:bb(State#state.cfg, L)).
+
+set_bb_code(L, Code, State) ->
+ CFG = State#state.cfg,
+ CFG1 = hipe_icode_cfg:bb_add(CFG, L, hipe_bb:mk_bb(Code)),
+ refresh_state_cache(State#state{cfg = CFG1}).
+
+get_new_catches_in(L, State) ->
+ Ps = get_pred(L, State),
+ Cs = case lists:member(L, get_start_labels(State)) of
+ true -> single_catch(empty_stack());
+ false -> no_catches()
+ end,
+ get_new_catches_in(Ps, Cs, State).
+
+get_new_catches_in([P | Ps], Cs, State) ->
+ Cs1 = join_catches(Cs, get_catches_out(P, State)),
+ get_new_catches_in(Ps, Cs1, State);
+get_new_catches_in([], Cs, _) ->
+ Cs.
+
+%%---------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode_fp.erl b/lib/hipe/icode/hipe_icode_fp.erl
new file mode 100644
index 0000000000..a2ca6132d1
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_fp.erl
@@ -0,0 +1,1043 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%--------------------------------------------------------------------
+%% File : hipe_icode_fp.erl
+%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%% Description : One pass analysis to find floating point values.
+%% Mapping to FP variables and creation of FP EBBs.
+%%
+%% Created : 23 Apr 2003 by Tobias Lindahl <tobiasl@it.uu.se>
+%%--------------------------------------------------------------------
+
+-module(hipe_icode_fp).
+
+-export([cfg/1]).
+
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+
+-record(state, {edge_map = gb_trees:empty() :: gb_tree(),
+ fp_ebb_map = gb_trees:empty() :: gb_tree(),
+ cfg :: #cfg{}}).
+
+%%--------------------------------------------------------------------
+
+-spec cfg(#cfg{}) -> #cfg{}.
+
+cfg(Cfg) ->
+ %%hipe_icode_cfg:pp(Cfg),
+ NewCfg = annotate_fclearerror(Cfg),
+ State = new_state(NewCfg),
+ NewState = place_fp_blocks(State),
+ %% hipe_icode_cfg:pp(state__cfg(NewState)),
+ NewState2 = finalize(NewState),
+ NewCfg1 = state__cfg(NewState2),
+ %% hipe_icode_cfg:pp(NewCfg1),
+ NewCfg2 = unannotate_fclearerror(NewCfg1),
+ NewCfg2.
+
+%%--------------------------------------------------------------------
+%% Annotate fclearerror with information of the fail label of the
+%% corresponding fcheckerror.
+%%--------------------------------------------------------------------
+
+annotate_fclearerror(Cfg) ->
+ Labels = hipe_icode_cfg:reverse_postorder(Cfg),
+ annotate_fclearerror(Labels, Cfg).
+
+annotate_fclearerror([Label|Left], Cfg) ->
+ BB = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ NewCode = annotate_fclearerror1(Code, Label, Cfg, []),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB),
+ annotate_fclearerror(Left, NewCfg);
+annotate_fclearerror([], Cfg) ->
+ Cfg.
+
+annotate_fclearerror1([I|Left], Label, Cfg, Acc) ->
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_fun(I) of
+ fclearerror ->
+ Fail = lookahead_for_fcheckerror(Left, Label, Cfg),
+ NewI = hipe_icode:call_fun_update(I, {fclearerror, Fail}),
+ annotate_fclearerror1(Left, Label, Cfg, [NewI|Acc]);
+ _ ->
+ annotate_fclearerror1(Left, Label, Cfg, [I|Acc])
+ end;
+ _ ->
+ annotate_fclearerror1(Left, Label, Cfg, [I|Acc])
+ end;
+annotate_fclearerror1([], _Label, _Cfg, Acc) ->
+ lists:reverse(Acc).
+
+lookahead_for_fcheckerror([I|Left], Label, Cfg) ->
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_fun(I) of
+ fcheckerror ->
+ hipe_icode:call_fail_label(I);
+ _ ->
+ lookahead_for_fcheckerror(Left, Label, Cfg)
+ end;
+ _ ->
+ lookahead_for_fcheckerror(Left, Label, Cfg)
+ end;
+lookahead_for_fcheckerror([], Label, Cfg) ->
+ case hipe_icode_cfg:succ(Cfg, Label) of
+ [] -> exit("Unterminated fp ebb");
+ SuccList ->
+ Succ = hd(SuccList),
+ Code = hipe_bb:code(hipe_icode_cfg:bb(Cfg, Label)),
+ lookahead_for_fcheckerror(Code, Succ, Cfg)
+ end.
+
+unannotate_fclearerror(Cfg) ->
+ Labels = hipe_icode_cfg:reverse_postorder(Cfg),
+ unannotate_fclearerror(Labels, Cfg).
+
+unannotate_fclearerror([Label|Left], Cfg) ->
+ BB = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ NewCode = unannotate_fclearerror1(Code, []),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB),
+ unannotate_fclearerror(Left, NewCfg);
+unannotate_fclearerror([], Cfg) ->
+ Cfg.
+
+unannotate_fclearerror1([I|Left], Acc) ->
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_fun(I) of
+ {fclearerror, _Fail} ->
+ NewI = hipe_icode:call_fun_update(I, fclearerror),
+ unannotate_fclearerror1(Left, [NewI|Acc]);
+ _ ->
+ unannotate_fclearerror1(Left, [I|Acc])
+ end;
+ _ ->
+ unannotate_fclearerror1(Left, [I|Acc])
+ end;
+unannotate_fclearerror1([], Acc) ->
+ lists:reverse(Acc).
+
+%%--------------------------------------------------------------------
+%% Make float EBBs
+%%--------------------------------------------------------------------
+
+place_fp_blocks(State) ->
+ WorkList = new_worklist(State),
+ transform_block(WorkList, State).
+
+transform_block(WorkList, State) ->
+ case get_work(WorkList) of
+ none ->
+ State;
+ {Label, NewWorkList} ->
+ %%io:format("Handling ~w \n", [Label]),
+ BB = state__bb(State, Label),
+ Code1 = hipe_bb:butlast(BB),
+ Last = hipe_bb:last(BB),
+ NofPreds = length(state__pred(State, Label)),
+ Map = state__map(State, Label),
+ FilteredMap = filter_map(Map, NofPreds),
+ {Prelude, NewFilteredMap} = do_prelude(FilteredMap),
+
+ %% Take care to have a map without any new bindings from the
+ %% last instruction if it can fail.
+ {FailMap, NewCode1} = transform_instrs(Code1, Map, NewFilteredMap, []),
+ {NewMap, NewCode2} = transform_instrs([Last], Map, FailMap, []),
+ SuccSet0 = ordsets:from_list(hipe_icode:successors(Last)),
+ FailSet = ordsets:from_list(hipe_icode:fails_to(Last)),
+ SuccSet = ordsets:subtract(SuccSet0, FailSet),
+ NewCode = NewCode1 ++ NewCode2,
+ NewBB = hipe_bb:code_update(BB, Prelude++NewCode),
+ NewState = state__bb_add(State, Label, NewBB),
+ case update_maps(NewState, Label, SuccSet, NewMap, FailSet, FailMap) of
+ fixpoint ->
+ transform_block(NewWorkList, NewState);
+ {NewState1, AddBlocks} ->
+ NewWorkList1 = add_work(NewWorkList, AddBlocks),
+ transform_block(NewWorkList1, NewState1)
+ end
+ end.
+
+update_maps(State, Label, SuccSet, SuccMap, FailSet, FailMap) ->
+ {NewState, Add1} = update_maps(State, Label, SuccSet, SuccMap, []),
+ case update_maps(NewState, Label, FailSet, FailMap, Add1) of
+ {_NewState1, []} -> fixpoint;
+ {_NewState1, _Add} = Ret -> Ret
+ end.
+
+update_maps(State, From, [To|Left], Map, Acc) ->
+ case state__map_update(State, From, To, Map) of
+ fixpoint ->
+ update_maps(State, From, Left, Map, Acc);
+ NewState ->
+ update_maps(NewState, From, Left, Map, [To|Acc])
+ end;
+update_maps(State, _From, [], _Map, Acc) ->
+ {State, Acc}.
+
+transform_instrs([I|Left], PhiMap, Map, Acc) ->
+ Defines = hipe_icode:defines(I),
+ NewMap = delete_all(Defines, Map),
+ NewPhiMap = delete_all(Defines, PhiMap),
+ case I of
+ #icode_phi{} ->
+ Uses = hipe_icode:uses(I),
+ case [X || X <- Uses, lookup(X, PhiMap) =/= none] of
+ [] ->
+ %% No ordinary variables from the argument have been untagged.
+ transform_instrs(Left, NewPhiMap, NewMap, [I|Acc]);
+ Uses ->
+ %% All arguments are untagged. Let's untag the destination.
+ Dst = hipe_icode:phi_dst(I),
+ NewDst = hipe_icode:mk_new_fvar(),
+ NewMap1 = gb_trees:enter(Dst, NewDst, NewMap),
+ NewI = subst_phi_uncond(I, NewDst, PhiMap),
+ transform_instrs(Left, NewPhiMap, NewMap1, [NewI|Acc]);
+ _ ->
+ %% Some arguments are untagged. Keep the destination.
+ Dst = hipe_icode:phi_dst(I),
+ NewI = subst_phi(I, Dst, PhiMap),
+ transform_instrs(Left, NewPhiMap, NewMap, [NewI|Acc])
+ end;
+ #icode_call{} ->
+ case hipe_icode:call_fun(I) of
+ X when X =:= unsafe_untag_float orelse X =:= conv_to_float ->
+ [Dst] = hipe_icode:defines(I),
+ case hipe_icode:uses(I) of
+ [] -> %% Constant
+ transform_instrs(Left, NewPhiMap, NewMap, [I|Acc]);
+ [Src] ->
+ case lookup(Src, Map) of
+ none ->
+ NewMap1 = gb_trees:enter(Src, {assigned, Dst}, NewMap),
+ transform_instrs(Left, NewPhiMap, NewMap1, [I|Acc]);
+ Dst ->
+ %% This is the instruction that untagged the variable.
+ %% Use old maps.
+ transform_instrs(Left, NewPhiMap, Map, [I|Acc]);
+ FVar ->
+ %% The variable was already untagged.
+ %% This instruction can be changed to a move.
+ NewI = hipe_icode:mk_move(Dst, FVar),
+ case hipe_icode:call_continuation(I) of
+ [] ->
+ transform_instrs(Left,NewPhiMap,NewMap,[NewI|Acc]);
+ ContLbl ->
+ Goto = hipe_icode:mk_goto(ContLbl),
+ transform_instrs(Left, NewPhiMap, NewMap,
+ [Goto, NewI|Acc])
+ end
+ end
+ end;
+ unsafe_tag_float ->
+ [Dst] = hipe_icode:defines(I),
+ [Src] = hipe_icode:uses(I),
+ NewMap1 = gb_trees:enter(Dst, {assigned, Src}, NewMap),
+ transform_instrs(Left, NewPhiMap, NewMap1,[I|Acc]);
+ _ ->
+ {NewMap1, NewAcc} = check_for_fop_candidates(I, NewMap, Acc),
+ transform_instrs(Left, NewPhiMap, NewMap1, NewAcc)
+ end;
+ _ ->
+ NewIns = handle_untagged_arguments(I, NewMap),
+ transform_instrs(Left, NewPhiMap, NewMap, NewIns ++ Acc)
+ end;
+transform_instrs([], _PhiMap, Map, Acc) ->
+ {Map, lists:reverse(Acc)}.
+
+check_for_fop_candidates(I, Map, Acc) ->
+ case is_fop_cand(I) of
+ false ->
+ NewIs = handle_untagged_arguments(I, Map),
+ {Map, NewIs ++ Acc};
+ true ->
+ Fail = hipe_icode:call_fail_label(I),
+ Cont = hipe_icode:call_continuation(I),
+ Op = fun_to_fop(hipe_icode:call_fun(I)),
+ case Fail of
+ [] ->
+ Args = hipe_icode:args(I),
+ ConstArgs = [X || X <- Args, hipe_icode:is_const(X)],
+ try lists:foreach(fun(X) -> float(hipe_icode:const_value(X)) end,
+ ConstArgs) of
+ ok ->
+ %%io:format("Changing ~w to ~w\n", [hipe_icode:call_fun(I), Op]),
+ Uses = hipe_icode:uses(I),
+ Defines = hipe_icode:defines(I),
+ Convs = [X||X <- remove_duplicates(Uses), lookup(X,Map) =:= none],
+ NewMap0 = add_new_bindings_assigned(Convs, Map),
+ NewMap = add_new_bindings_unassigned(Defines, NewMap0),
+ ConvIns = get_conv_instrs(Convs, NewMap),
+ NewI = hipe_icode:mk_primop(lookup_list(Defines, NewMap), Op,
+ lookup_list_keep_consts(Args,NewMap),
+ Cont, Fail),
+ NewI2 = conv_consts(ConstArgs, NewI),
+ {NewMap, [NewI2|ConvIns]++Acc}
+ catch
+ error:badarg ->
+ %% This instruction will fail at runtime. The warning
+ %% should already have happened in hipe_icode_type.
+ NewIs = handle_untagged_arguments(I, Map),
+ {Map, NewIs ++ Acc}
+ end;
+ _ -> %% Bailing out! Can't handle instructions in catches (yet).
+ NewIs = handle_untagged_arguments(I, Map),
+ {Map, NewIs ++ Acc}
+ end
+ end.
+
+
+%% If this is an instruction that needs to operate on tagged values,
+%% which currently are untagged, we must tag the values and perhaps
+%% end the fp ebb.
+
+handle_untagged_arguments(I, Map) ->
+ case [X || X <- hipe_icode:uses(I), must_be_tagged(X, Map)] of
+ [] ->
+ [I];
+ Tag ->
+ TagIntrs =
+ [hipe_icode:mk_primop([Dst], unsafe_tag_float,
+ [gb_trees:get(Dst, Map)]) || Dst <- Tag],
+ [I|TagIntrs]
+ end.
+
+%% Add phi nodes for untagged fp values.
+
+do_prelude(Map) ->
+ case gb_trees:lookup(phi, Map) of
+ none ->
+ {[], Map};
+ {value, List} ->
+ %%io:format("Adding phi: ~w\n", [List]),
+ Fun = fun ({FVar, Bindings}, Acc) ->
+ [hipe_icode:mk_phi(FVar, Bindings)|Acc]
+ end,
+ {lists:foldl(Fun, [], List), gb_trees:delete(phi, Map)}
+ end.
+
+split_code(Code) ->
+ split_code(Code, []).
+
+split_code([I], Acc) ->
+ {lists:reverse(Acc), I};
+split_code([I|Left], Acc) ->
+ split_code(Left, [I|Acc]).
+
+
+%% When all code is mapped to fp instructions we must make sure that
+%% the fp ebb information going into each block is the same as the
+%% information coming out of each predecessor. Otherwise, we must add
+%% a block in between.
+
+finalize(State) ->
+ Worklist = new_worklist(State),
+ NewState = place_error_handling(Worklist, State),
+ Edges = needs_fcheckerror(NewState),
+ finalize(Edges, NewState).
+
+finalize([{From, To}|Left], State) ->
+ NewState = add_fp_ebb_fixup(From, To, State),
+ finalize(Left, NewState);
+finalize([], State) ->
+ State.
+
+needs_fcheckerror(State) ->
+ Cfg = state__cfg(State),
+ Labels = hipe_icode_cfg:labels(Cfg),
+ needs_fcheckerror(Labels, State, []).
+
+needs_fcheckerror([Label|Left], State, Acc) ->
+ case state__get_in_block_in(State, Label) of
+ {true, _} ->
+ needs_fcheckerror(Left, State, Acc);
+ false ->
+ Pred = state__pred(State, Label),
+ case [X || X <- Pred, state__get_in_block_out(State, X) =/= false] of
+ [] ->
+ needs_fcheckerror(Left, State, Acc);
+ NeedsFcheck ->
+ case length(Pred) =:= length(NeedsFcheck) of
+ true ->
+ %% All edges need fcheckerror. Add this to the
+ %% beginning of the block instead.
+ needs_fcheckerror(Left, State, [{none, Label}|Acc]);
+ false ->
+ Edges = [{X, Label} || X <- NeedsFcheck],
+ needs_fcheckerror(Left, State, Edges ++ Acc)
+ end
+ end
+ end;
+needs_fcheckerror([], _State, Acc) ->
+ Acc.
+
+add_fp_ebb_fixup('none', To, State) ->
+ %% Add the fcheckerror to the start of the block.
+ BB = state__bb(State, To),
+ Code = hipe_bb:code(BB),
+ Phis = lists:takewhile(fun(X) -> hipe_icode:is_phi(X) end, Code),
+ TailCode = lists:dropwhile(fun(X) -> hipe_icode:is_phi(X) end, Code),
+ FC = hipe_icode:mk_primop([], fcheckerror, []),
+ NewCode = Phis ++ [FC|TailCode],
+ state__bb_add(State, To, hipe_bb:code_update(BB, NewCode));
+add_fp_ebb_fixup(From, To, State) ->
+ FCCode = [hipe_icode:mk_primop([], fcheckerror, [], To, [])],
+ FCBB = hipe_bb:mk_bb(FCCode),
+ FCLabel = hipe_icode:label_name(hipe_icode:mk_new_label()),
+ NewState = state__bb_add(State, FCLabel, FCBB),
+ NewState1 = state__redirect(NewState, From, To, FCLabel),
+ ToBB = state__bb(NewState, To),
+ ToCode = hipe_bb:code(ToBB),
+ NewToCode = redirect_phis(ToCode, From, FCLabel),
+ NewToBB = hipe_bb:code_update(ToBB, NewToCode),
+ state__bb_add(NewState1, To, NewToBB).
+
+redirect_phis(Code, OldFrom, NewFrom) ->
+ redirect_phis(Code, OldFrom, NewFrom, []).
+
+redirect_phis([I|Is] = Code, OldFrom, NewFrom, Acc) ->
+ case I of
+ #icode_phi{} ->
+ NewI = hipe_icode:phi_redirect_pred(I, OldFrom, NewFrom),
+ redirect_phis(Is, OldFrom, NewFrom, [NewI|Acc]);
+ _ ->
+ lists:reverse(Acc) ++ Code
+ end;
+redirect_phis([], _OldFrom, _NewFrom, Acc) ->
+ lists:reverse(Acc).
+
+subst_phi(I, Dst, Map) ->
+ ArgList = subst_phi_uses0(hipe_icode:phi_arglist(I), Map, []),
+ hipe_icode:mk_phi(Dst, ArgList).
+
+subst_phi_uses0([{Pred, Var}|Left], Map, Acc) ->
+ case gb_trees:lookup(Var, Map) of
+ {value, List} ->
+ case lists:keyfind(Pred, 1, List) of
+ {Pred, {assigned, _NewVar}} ->
+ %% The variable is untagged, but it has been assigned. Keep it!
+ subst_phi_uses0(Left, Map, [{Pred, Var} | Acc]);
+ {Pred, _NewVar} = PredNV ->
+ %% The variable is untagged and it has never been assigned as tagged.
+ subst_phi_uses0(Left, Map, [PredNV | Acc]);
+ false ->
+ %% The variable is not untagged.
+ subst_phi_uses0(Left, Map, [{Pred, Var} | Acc])
+ end;
+ none ->
+ %% The variable is not untagged.
+ subst_phi_uses0(Left, Map, [{Pred, Var} | Acc])
+ end;
+subst_phi_uses0([], _Map, Acc) ->
+ Acc.
+
+subst_phi_uncond(I, Dst, Map) ->
+ ArgList = subst_phi_uses_uncond0(hipe_icode:phi_arglist(I), Map, []),
+ hipe_icode:mk_phi(Dst, ArgList).
+
+subst_phi_uses_uncond0([{Pred, Var}|Left], Map, Acc) ->
+ case gb_trees:lookup(Var, Map) of
+ {value, List} ->
+ case lists:keyfind(Pred, 1, List) of
+ {Pred, {assigned, NewVar}} ->
+ %% The variable is untagged!
+ subst_phi_uses_uncond0(Left, Map, [{Pred, NewVar} | Acc]);
+ {Pred, _NewVar} = PredNV ->
+ %% The variable is untagged!
+ subst_phi_uses_uncond0(Left, Map, [PredNV | Acc]);
+ false ->
+ %% The variable is not untagged.
+ subst_phi_uses_uncond0(Left, Map, [{Pred, Var} | Acc])
+ end;
+ none ->
+ %% The variable is not untagged.
+ subst_phi_uses_uncond0(Left, Map, [{Pred, Var} | Acc])
+ end;
+subst_phi_uses_uncond0([], _Map, Acc) ->
+ Acc.
+
+place_error_handling(WorkList, State) ->
+ case get_work(WorkList) of
+ none ->
+ State;
+ {Label, NewWorkList} ->
+ BB = state__bb(State, Label),
+ Code = hipe_bb:code(BB),
+ case state__join_in_block(State, Label) of
+ fixpoint ->
+ place_error_handling(NewWorkList, State);
+ {NewState, NewInBlock} ->
+ {NewCode1, InBlockOut} = place_error(Code, NewInBlock, []),
+ Succ = state__succ(NewState, Label),
+ NewCode2 = handle_unchecked_end(Succ, NewCode1, InBlockOut),
+ NewBB = hipe_bb:code_update(BB, NewCode2),
+ NewState1 = state__bb_add(NewState, Label, NewBB),
+ NewState2 = state__in_block_out_update(NewState1, Label, InBlockOut),
+ NewWorkList1 = add_work(NewWorkList, Succ),
+ place_error_handling(NewWorkList1, NewState2)
+ end
+ end.
+
+place_error([I|Left], InBlock, Acc) ->
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_fun(I) of
+ X when X =:= fp_add; X =:= fp_sub;
+ X =:= fp_mul; X =:= fp_div; X =:= fnegate ->
+ case InBlock of
+ false ->
+ Clear = hipe_icode:mk_primop([], {fclearerror, []}, []),
+ place_error(Left, {true, []}, [I, Clear|Acc]);
+ {true, _} ->
+ place_error(Left, InBlock, [I|Acc])
+ end;
+ unsafe_tag_float ->
+ case InBlock of
+ {true, Fail} ->
+ Check = hipe_icode:mk_primop([], fcheckerror, [], [], Fail),
+ place_error(Left, false, [I, Check|Acc]);
+ false ->
+ place_error(Left, InBlock, [I|Acc])
+ end;
+ {fclearerror, Fail} ->
+ case InBlock of
+ {true, Fail} ->
+ %% We can remove this fclearerror!
+ case hipe_icode:call_continuation(I) of
+ [] ->
+ place_error(Left, InBlock, Acc);
+ Cont ->
+ place_error(Left, InBlock, [hipe_icode:mk_goto(Cont)|Acc])
+ end;
+ {true, _OtherFail} ->
+ %% TODO: This can be handled but it requires breaking up
+ %% the BB in two. Currently this should not happen.
+ exit("Starting fp ebb with different fail label");
+ false ->
+ place_error(Left, {true, Fail}, [I|Acc])
+ end;
+ fcheckerror ->
+ case {true, hipe_icode:call_fail_label(I)} of
+ InBlock ->
+ %% No problem
+ place_error(Left, false, [I|Acc]);
+ NewInblock ->
+ exit({"Fcheckerror has the wrong fail label",
+ InBlock, NewInblock})
+ end;
+ X when X =:= conv_to_float; X =:= unsafe_untag_float ->
+ place_error(Left, InBlock, [I|Acc]);
+ _Other ->
+ case hipe_icode_primops:fails(hipe_icode:call_fun(I)) of
+ false ->
+ place_error(Left, InBlock, [I|Acc]);
+ true ->
+ case InBlock of
+ {true, Fail} ->
+ Check = hipe_icode:mk_primop([], fcheckerror, [], [], Fail),
+ place_error(Left, false, [I, Check|Acc]);
+ false ->
+ place_error(Left, InBlock, [I|Acc])
+ end
+ end
+ end;
+ #icode_fail{} ->
+ place_error_1(I, Left, InBlock, Acc);
+ #icode_return{} ->
+ place_error_1(I, Left, InBlock, Acc);
+ #icode_enter{} ->
+ place_error_1(I, Left, InBlock, Acc);
+ Other ->
+ case instr_allowed_in_fp_ebb(Other) of
+ true ->
+ place_error(Left, InBlock, [I|Acc]);
+ false ->
+ case InBlock of
+ {true, []} ->
+ Check = hipe_icode:mk_primop([], fcheckerror, []),
+ place_error(Left, false, [I, Check|Acc]);
+ {true, _} ->
+ exit({"Illegal instruction in caught fp ebb", I});
+ false ->
+ place_error(Left, InBlock, [I|Acc])
+ end
+ end
+ end;
+place_error([], InBlock, Acc) ->
+ {lists:reverse(Acc), InBlock}.
+
+place_error_1(I, Left, InBlock, Acc) ->
+ case InBlock of
+ {true, []} ->
+ Check = hipe_icode:mk_primop([], fcheckerror, []),
+ place_error(Left, false, [I, Check|Acc]);
+ {true, _} ->
+ exit({"End of control flow in caught fp ebb", I});
+ false ->
+ place_error(Left, InBlock, [I|Acc])
+ end.
+
+%% If the block has no successors and we still are in a fp ebb we must
+%% end it to make sure we don't have any unchecked fp exceptions.
+
+handle_unchecked_end(Succ, Code, InBlock) ->
+ case Succ of
+ [] ->
+ case InBlock of
+ {true, []} ->
+ {TopCode, Last} = split_code(Code),
+ NewI = hipe_icode:mk_primop([], fcheckerror, []),
+ TopCode ++ [NewI, Last];
+ false ->
+ Code
+ end;
+ _ ->
+ Code
+ end.
+
+instr_allowed_in_fp_ebb(Instr) ->
+ case Instr of
+ #icode_comment{} -> true;
+ #icode_goto{} -> true;
+ #icode_if{} -> true;
+ #icode_move{} -> true;
+ #icode_phi{} -> true;
+ #icode_begin_handler{} -> true;
+ #icode_switch_tuple_arity{} -> true;
+ #icode_switch_val{} -> true;
+ #icode_type{} -> true;
+ _ -> false
+ end.
+
+%%=============================================================
+%% Help functions
+%%=============================================================
+
+%% ------------------------------------------------------------
+%% Handling the gb_tree
+
+delete_all([Key|Left], Tree) ->
+ delete_all(Left, gb_trees:delete_any(Key, Tree));
+delete_all([], Tree) ->
+ Tree.
+
+lookup_list(List, Info) ->
+ lookup_list(List, fun lookup/2, Info, []).
+
+lookup_list([H|T], Fun, Info, Acc) ->
+ lookup_list(T, Fun, Info, [Fun(H, Info)|Acc]);
+lookup_list([], _, _, Acc) ->
+ lists:reverse(Acc).
+
+lookup(Key, Tree) ->
+ case hipe_icode:is_const(Key) of
+ %% This can be true if the same constant has been
+ %% untagged more than once
+ true -> none;
+ false ->
+ case gb_trees:lookup(Key, Tree) of
+ none -> none;
+ {value, {assigned, Val}} -> Val;
+ {value, Val} -> Val
+ end
+ end.
+
+lookup_list_keep_consts(List, Info) ->
+ lookup_list(List, fun lookup_keep_consts/2, Info, []).
+
+lookup_keep_consts(Key, Tree) ->
+ case hipe_icode:is_const(Key) of
+ true -> Key;
+ false ->
+ case gb_trees:lookup(Key, Tree) of
+ none -> none;
+ {value, {assigned, Val}} -> Val;
+ {value, Val} -> Val
+ end
+ end.
+
+get_type(Var) ->
+ case hipe_icode:is_const(Var) of
+ true -> erl_types:t_from_term(hipe_icode:const_value(Var));
+ false ->
+ case hipe_icode:is_annotated_variable(Var) of
+ true ->
+ {type_anno, Type, _} = hipe_icode:variable_annotation(Var),
+ Type
+%%% false -> erl_types:t_any()
+ end
+ end.
+
+%% ------------------------------------------------------------
+%% Handling the map from variables to fp-variables
+
+join_maps(Edges, EdgeMap) ->
+ join_maps(Edges, EdgeMap, gb_trees:empty()).
+
+join_maps([Edge = {Pred, _}|Left], EdgeMap, Map) ->
+ case gb_trees:lookup(Edge, EdgeMap) of
+ none ->
+ %% All predecessors have not been handled. Use empty map.
+ gb_trees:empty();
+ {value, OldMap} ->
+ NewMap = join_maps0(gb_trees:to_list(OldMap), Pred, Map),
+ join_maps(Left, EdgeMap, NewMap)
+ end;
+join_maps([], _, Map) ->
+ Map.
+
+join_maps0([{phi, _}|Tail], Pred, Map) ->
+ join_maps0(Tail, Pred, Map);
+join_maps0([{Var, FVar}|Tail], Pred, Map) ->
+ case gb_trees:lookup(Var, Map) of
+ none ->
+ join_maps0(Tail, Pred, gb_trees:enter(Var, [{Pred, FVar}], Map));
+ {value, List} ->
+ case lists:keyfind(Pred, 1, List) of
+ false ->
+ join_maps0(Tail, Pred, gb_trees:update(Var, [{Pred, FVar}|List], Map));
+ {Pred, FVar} ->
+ %% No problem.
+ join_maps0(Tail, Pred, Map);
+ _ ->
+ exit('New binding to same variable')
+ end
+ end;
+join_maps0([], _, Map) ->
+ Map.
+
+filter_map(Map, NofPreds) ->
+ filter_map(gb_trees:to_list(Map), NofPreds, Map).
+
+filter_map([{Var, Bindings}|Left], NofPreds, Map) ->
+ case length(Bindings) =:= NofPreds of
+ true ->
+ case all_args_equal(Bindings) of
+ true ->
+ {_, FVar} = hd(Bindings),
+ filter_map(Left, NofPreds, gb_trees:update(Var, FVar, Map));
+ false ->
+ PhiDst = hipe_icode:mk_new_fvar(),
+ PhiArgs = strip_of_assigned(Bindings),
+ NewMap =
+ case gb_trees:lookup(phi, Map) of
+ none ->
+ gb_trees:insert(phi, [{PhiDst, PhiArgs}], Map);
+ {value, Val} ->
+ gb_trees:update(phi, [{PhiDst, PhiArgs}|Val], Map)
+ end,
+ NewBinding =
+ case bindings_are_assigned(Bindings) of
+ true -> {assigned, PhiDst};
+ false -> PhiDst
+ end,
+ filter_map(Left, NofPreds, gb_trees:update(Var, NewBinding, NewMap))
+ end;
+ false ->
+ filter_map(Left, NofPreds, gb_trees:delete(Var, Map))
+ end;
+filter_map([], _NofPreds, Map) ->
+ Map.
+
+bindings_are_assigned([{_, {assigned, _}}|Left]) ->
+ assert_assigned(Left),
+ true;
+bindings_are_assigned(Bindings) ->
+ assert_not_assigned(Bindings),
+ false.
+
+assert_assigned([{_, {assigned, _}}|Left]) ->
+ assert_assigned(Left);
+assert_assigned([]) ->
+ ok.
+
+assert_not_assigned([{_, FVar}|Left]) ->
+ true = hipe_icode:is_fvar(FVar),
+ assert_not_assigned(Left);
+assert_not_assigned([]) ->
+ ok.
+
+%% all_args_equal returns true if the mapping for a variable is the
+%% same from all predecessors, i.e., we do not need a phi-node.
+
+all_args_equal([{_, FVar}|Left]) ->
+ all_args_equal(Left, FVar).
+
+all_args_equal([{_, FVar1}|Left], FVar1) ->
+ all_args_equal(Left, FVar1);
+all_args_equal([], _) ->
+ true;
+all_args_equal(_, _) ->
+ false.
+
+
+%% We differentiate between values that have been assigned as
+%% tagged variables and those that got a 'virtual' binding.
+
+add_new_bindings_unassigned([Var|Left], Map) ->
+ FVar = hipe_icode:mk_new_fvar(),
+ add_new_bindings_unassigned(Left, gb_trees:insert(Var, FVar, Map));
+add_new_bindings_unassigned([], Map) ->
+ Map.
+
+add_new_bindings_assigned([Var|Left], Map) ->
+ case lookup(Var, Map) of
+ none ->
+ FVar = hipe_icode:mk_new_fvar(),
+ NewMap = gb_trees:insert(Var, {assigned, FVar}, Map),
+ add_new_bindings_assigned(Left, NewMap);
+ _ ->
+ add_new_bindings_assigned(Left, Map)
+ end;
+add_new_bindings_assigned([], Map) ->
+ Map.
+
+strip_of_assigned(List) ->
+ strip_of_assigned(List, []).
+
+strip_of_assigned([{Pred, {assigned, Val}}|Left], Acc) ->
+ strip_of_assigned(Left, [{Pred, Val}|Acc]);
+strip_of_assigned([Tuple|Left], Acc) ->
+ strip_of_assigned(Left, [Tuple|Acc]);
+strip_of_assigned([], Acc) ->
+ Acc.
+
+%% ------------------------------------------------------------
+%% Help functions for the transformation from ordinary instruction to
+%% fp-instruction
+
+is_fop_cand(I) ->
+ case hipe_icode:call_fun(I) of
+ '/' -> true;
+ Fun ->
+ case fun_to_fop(Fun) of
+ false -> false;
+ _ -> any_is_float(hipe_icode:args(I))
+ end
+ end.
+
+any_is_float(Vars) ->
+ lists:any(fun (V) -> erl_types:t_is_float(get_type(V)) end, Vars).
+
+remove_duplicates(List) ->
+ remove_duplicates(List, []).
+
+remove_duplicates([X|Left], Acc) ->
+ case lists:member(X, Acc) of
+ true ->
+ remove_duplicates(Left, Acc);
+ false ->
+ remove_duplicates(Left, [X|Acc])
+ end;
+remove_duplicates([], Acc) ->
+ Acc.
+
+fun_to_fop(Fun) ->
+ case Fun of
+ '+' -> fp_add;
+ '-' -> fp_sub;
+ '*' -> fp_mul;
+ '/' -> fp_div;
+ _ -> false
+ end.
+
+
+%% If there is a tagged version of this variable available we don't
+%% have to tag the untagged version.
+
+must_be_tagged(Var, Map) ->
+ case gb_trees:lookup(Var, Map) of
+ none -> false;
+ {value, {assigned, _}} -> false;
+ {value, Val} -> hipe_icode:is_fvar(Val)
+ end.
+
+
+%% Converting to floating point variables
+
+get_conv_instrs(Vars, Map) ->
+ get_conv_instrs(Vars, Map, []).
+
+get_conv_instrs([Var|Left], Map, Acc) ->
+ {_, Dst} = gb_trees:get(Var, Map),
+ NewI =
+ case erl_types:t_is_float(get_type(Var)) of
+ true ->
+ [hipe_icode:mk_primop([Dst], unsafe_untag_float, [Var])];
+ false ->
+ [hipe_icode:mk_primop([Dst], conv_to_float, [Var])]
+ end,
+ get_conv_instrs(Left, Map, NewI++Acc);
+get_conv_instrs([], _, Acc) ->
+ Acc.
+
+
+conv_consts(ConstArgs, I) ->
+ conv_consts(ConstArgs, I, []).
+
+conv_consts([Const|Left], I, Subst) ->
+ NewConst = hipe_icode:mk_const(float(hipe_icode:const_value(Const))),
+ conv_consts(Left, I, [{Const, NewConst}|Subst]);
+conv_consts([], I, Subst) ->
+ hipe_icode:subst_uses(Subst, I).
+
+
+%% _________________________________________________________________
+%%
+%% Handling the state
+%%
+
+new_state(Cfg) ->
+ #state{cfg = Cfg}.
+
+state__cfg(#state{cfg = Cfg}) ->
+ Cfg.
+
+state__succ(#state{cfg = Cfg}, Label) ->
+ hipe_icode_cfg:succ(Cfg, Label).
+
+state__pred(#state{cfg = Cfg}, Label) ->
+ hipe_icode_cfg:pred(Cfg, Label).
+
+state__redirect(S = #state{cfg = Cfg}, From, ToOld, ToNew) ->
+ NewCfg = hipe_icode_cfg:redirect(Cfg, From, ToOld, ToNew),
+ S#state{cfg=NewCfg}.
+
+state__bb(#state{cfg = Cfg}, Label) ->
+ hipe_icode_cfg:bb(Cfg, Label).
+
+state__bb_add(S = #state{cfg = Cfg}, Label, BB) ->
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB),
+ S#state{cfg = NewCfg}.
+
+state__map(S = #state{edge_map = EM}, To) ->
+ join_maps([{From, To} || From <- state__pred(S, To)], EM).
+
+state__map_update(S = #state{edge_map = EM}, From, To, Map) ->
+ FromTo = {From, To},
+ MapChanged =
+ case gb_trees:lookup(FromTo, EM) of
+ {value, Map1} -> not match(Map1, Map);
+ none -> true
+ end,
+ case MapChanged of
+ true ->
+ NewEM = gb_trees:enter(FromTo, Map, EM),
+ S#state{edge_map = NewEM};
+ false ->
+ fixpoint
+ end.
+
+state__join_in_block(S = #state{fp_ebb_map = Map}, Label) ->
+ Pred = state__pred(S, Label),
+ Edges = [{X, Label} || X <- Pred],
+ NewInBlock = join_in_block([gb_trees:lookup(X, Map) || X <- Edges]),
+ InBlockLabel = {inblock_in, Label},
+ case gb_trees:lookup(InBlockLabel, Map) of
+ none ->
+ NewMap = gb_trees:insert(InBlockLabel, NewInBlock, Map),
+ {S#state{fp_ebb_map = NewMap}, NewInBlock};
+ {value, NewInBlock} ->
+ fixpoint;
+ _Other ->
+ NewMap = gb_trees:update(InBlockLabel, NewInBlock, Map),
+ {S#state{fp_ebb_map = NewMap}, NewInBlock}
+ end.
+
+state__in_block_out_update(S = #state{fp_ebb_map = Map}, Label, NewInBlock) ->
+ Succ = state__succ(S, Label),
+ Edges = [{Label, X} || X <- Succ],
+ NewMap = update_edges(Edges, NewInBlock, Map),
+ NewMap1 = gb_trees:enter({inblock_out, Label}, NewInBlock, NewMap),
+ S#state{fp_ebb_map = NewMap1}.
+
+update_edges([Edge|Left], NewInBlock, Map) ->
+ NewMap = gb_trees:enter(Edge, NewInBlock, Map),
+ update_edges(Left, NewInBlock, NewMap);
+update_edges([], _NewInBlock, NewMap) ->
+ NewMap.
+
+join_in_block([]) ->
+ false;
+join_in_block([none|_]) ->
+ false;
+join_in_block([{value, InBlock}|Left]) ->
+ join_in_block(Left, InBlock).
+
+join_in_block([none|_], _Current) ->
+ false;
+join_in_block([{value, InBlock}|Left], Current) ->
+ if Current =:= InBlock -> join_in_block(Left, Current);
+ Current =:= false -> false;
+ InBlock =:= false -> false;
+ true -> exit("Basic block is in two different fp ebb:s")
+ end;
+join_in_block([], Current) ->
+ Current.
+
+
+state__get_in_block_in(#state{fp_ebb_map = Map}, Label) ->
+ gb_trees:get({inblock_in, Label}, Map).
+
+state__get_in_block_out(#state{fp_ebb_map = Map}, Label) ->
+ gb_trees:get({inblock_out, Label}, Map).
+
+
+new_worklist(#state{cfg = Cfg}) ->
+ Start = hipe_icode_cfg:start_label(Cfg),
+ {[Start], [], gb_sets:insert(Start, gb_sets:empty())}.
+
+get_work({[Label|Left], List, Set}) ->
+ {Label, {Left, List, gb_sets:delete(Label, Set)}};
+get_work({[], [], _Set}) ->
+ none;
+get_work({[], List, Set}) ->
+ get_work({lists:reverse(List), [], Set}).
+
+add_work({List1, List2, Set} = Work, [Label|Left]) ->
+ case gb_sets:is_member(Label, Set) of
+ true ->
+ add_work(Work, Left);
+ false ->
+ %% io:format("Added work: ~w\n", [Label]),
+ NewSet = gb_sets:insert(Label, Set),
+ add_work({List1, [Label|List2], NewSet}, Left)
+ end;
+add_work(WorkList, []) ->
+ WorkList.
+
+match(Tree1, Tree2) ->
+ match_1(gb_trees:to_list(Tree1), Tree2) andalso
+ match_1(gb_trees:to_list(Tree2), Tree1).
+
+match_1([{Key, Val}|Left], Tree2) ->
+ case gb_trees:lookup(Key, Tree2) of
+ {value, Val} ->
+ match_1(Left, Tree2);
+ _ -> false
+ end;
+match_1([], _) ->
+ true.
diff --git a/lib/hipe/icode/hipe_icode_heap_test.erl b/lib/hipe/icode/hipe_icode_heap_test.erl
new file mode 100644
index 0000000000..92d5f023fa
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_heap_test.erl
@@ -0,0 +1,200 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2000 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Filename : hipe_icode_heap_test.erl
+%% Module : hipe_icode_heap_test
+%% Purpose :
+%% Notes :
+%% History : * 2000-11-07 Erik Johansson (happi@it.uu.se):
+%% Created.
+%%
+%% $Id$
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_icode_heap_test).
+
+-export([cfg/1]).
+
+-define(DO_ASSERT,true).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+-include("../flow/cfg.hrl").
+-include("../rtl/hipe_literals.hrl").
+
+%-------------------------------------------------------------------------
+
+-spec cfg(#cfg{}) -> #cfg{}.
+
+cfg(CFG) ->
+ Icode = hipe_icode_cfg:cfg_to_linear(CFG),
+ Code = hipe_icode:icode_code(Icode),
+ ActualVmax = hipe_icode:highest_var(Code),
+ ActualLmax = hipe_icode:highest_label(Code),
+ hipe_gensym:set_label(icode, ActualLmax+1),
+ hipe_gensym:set_var(icode, ActualVmax+1),
+ EBBs = hipe_icode_ebb:cfg(CFG),
+ {EBBcode,_Visited} = ebbs(EBBs, [], CFG),
+ NewCode = add_gc_tests(EBBcode),
+ NewIcode = hipe_icode:icode_code_update(Icode, NewCode),
+ NewCFG = hipe_icode_cfg:linear_to_cfg(NewIcode),
+ %% hipe_icode_cfg:pp(NewCFG),
+ NewCFG.
+
+ebbs([EBB|EBBs], Visited, CFG) ->
+ case hipe_icode_ebb:type(EBB) of
+ node ->
+ L = hipe_icode_ebb:node_label(EBB),
+ case visited(L, Visited) of
+ true ->
+ ebbs(EBBs, Visited, CFG);
+ false ->
+ EBBCode = hipe_bb:code(hipe_icode_cfg:bb(CFG, L)),
+ case hipe_icode_ebb:node_successors(EBB) of
+ [Succ|Succs] ->
+ {[SuccCode|More], Visited1} =
+ ebbs([Succ], [L|Visited], CFG),
+ {[OtherCode|MoreOther], Visited2} =
+ ebbs(Succs ++ EBBs, Visited1, CFG),
+ {[[hipe_icode:mk_label(L)|EBBCode] ++ SuccCode|
+ More] ++ [OtherCode|MoreOther],
+ Visited2};
+ [] ->
+ {OtherCode, Visited1} = ebbs(EBBs, [L|Visited], CFG),
+ {[[hipe_icode:mk_label(L)|EBBCode] | OtherCode], Visited1}
+ end
+ end;
+ leaf ->
+ ebbs(EBBs, Visited, CFG)
+ end;
+ebbs([], Visited,_) ->
+ {[[]], Visited}.
+
+visited(L, Visited) ->
+ lists:member(L, Visited).
+
+add_gc_tests([[]|EBBCodes]) -> add_gc_tests(EBBCodes);
+add_gc_tests([EBBCode|EBBCodes]) ->
+ case need(EBBCode, 0, []) of
+ {Need, RestCode, [Lbl|Code]} ->
+ if Need > 0 ->
+ [Lbl] ++ gc_test(Need) ++ Code ++ add_gc_tests([RestCode|EBBCodes]);
+ true ->
+ [Lbl|Code] ++ add_gc_tests([RestCode|EBBCodes])
+ end;
+ {0, RestCode, []} ->
+ add_gc_tests([RestCode|EBBCodes])
+ end;
+add_gc_tests([]) -> [].
+
+need([I|Is] , Need, Code) ->
+ case split(I) of
+ true ->
+ case I of
+ #icode_call{} ->
+ case hipe_icode:call_continuation(I) of
+ [] -> %% Was fallthrough.
+ NewLab = hipe_icode:mk_new_label(),
+ LabName = hipe_icode:label_name(NewLab),
+ NewCall = hipe_icode:call_set_continuation(I,LabName),
+ {Need + need(I), [NewLab|Is], lists:reverse([NewCall|Code])};
+ _ ->
+ {Need + need(I), Is, lists:reverse([I|Code])}
+ end;
+ _ ->
+ {Need + need(I), Is, lists:reverse([I|Code])}
+ end;
+ false ->
+ need(Is, Need + need(I), [I|Code])
+ end;
+need([], Need, Code) ->
+ {Need, [], lists:reverse(Code)}.
+
+need(I) ->
+ case I of
+ #icode_call{} ->
+ primop_need(hipe_icode:call_fun(I), hipe_icode:call_args(I));
+ #icode_enter{} ->
+ primop_need(hipe_icode:enter_fun(I), hipe_icode:enter_args(I));
+ _ ->
+ 0
+ end.
+
+primop_need(Op, As) ->
+ case Op of
+ cons ->
+ 2;
+ mktuple ->
+ length(As) + 1;
+ #mkfun{} ->
+ NumFree = length(As),
+ ?ERL_FUN_SIZE + NumFree;
+ unsafe_tag_float ->
+ 3;
+ _ ->
+ 0
+ end.
+
+gc_test(Need) ->
+ L = hipe_icode:mk_new_label(),
+ [hipe_icode:mk_primop([], #gc_test{need=Need}, [],
+ hipe_icode:label_name(L),
+ hipe_icode:label_name(L)),
+ L].
+
+split(I) ->
+ case I of
+ #icode_call{} -> not known_heap_need(hipe_icode:call_fun(I));
+ #icode_enter{} -> not known_heap_need(hipe_icode:enter_fun(I));
+ _ -> false
+ end.
+
+known_heap_need(Name) ->
+ case Name of
+ %% Primops
+ cons -> true;
+ fcheckerror -> true;
+ fclearerror -> true;
+ fnegate -> true;
+ fp_add -> true;
+ fp_div -> true;
+ fp_mul -> true;
+ fp_sub -> true;
+ mktuple -> true;
+ unsafe_hd -> true;
+ unsafe_tag_float -> true;
+ unsafe_tl -> true;
+ unsafe_untag_float -> true;
+ #element{} -> true;
+ #unsafe_element{} -> true;
+ #unsafe_update_element{} -> true;
+
+ %% MFAs
+ {erlang, element, 2} -> true;
+ {erlang, length, 1} -> true;
+ {erlang, self, 0} -> true;
+ {erlang, size, 1} -> true;
+
+ _ -> false
+ end.
diff --git a/lib/hipe/icode/hipe_icode_inline_bifs.erl b/lib/hipe/icode/hipe_icode_inline_bifs.erl
new file mode 100644
index 0000000000..27296dcad5
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_inline_bifs.erl
@@ -0,0 +1,240 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%--------------------------------------------------------------------
+%% File : hipe_icode_inline_bifs.erl
+%% Author : Per Gustafsson <pergu@it.uu.se>
+%% Purpose : Inlines BIFs which can be expressed easily in ICode.
+%% This allows for optimizations in later ICode passes
+%% and makes the code faster.
+%%
+%% Created : 14 May 2007 by Per Gustafsson <pergu@it.uu.se>
+%%--------------------------------------------------------------------
+
+%% Currently inlined BIFs:
+%% and, or, xor, not, <, >, >=, =<, ==, /=, =/=, =:=
+%% is_atom, is_boolean, is_binary, is_constant, is_float, is_function,
+%% is_integer, is_list, is_pid, is_port, is_reference, is_tuple
+
+-module(hipe_icode_inline_bifs).
+
+-export([cfg/1]).
+
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+
+%%--------------------------------------------------------------------
+
+-spec cfg(#cfg{}) -> #cfg{}.
+
+cfg(Cfg) ->
+ Linear = hipe_icode_cfg:cfg_to_linear(Cfg),
+ #icode{code = StraightCode} = Linear,
+ FinalCode = lists:flatten([inline_bif(I) || I <- StraightCode]),
+ Cfg1 = hipe_icode_cfg:linear_to_cfg(Linear#icode{code = FinalCode}),
+ hipe_icode_cfg:remove_unreachable_code(Cfg1).
+
+inline_bif(I = #icode_call{}) ->
+ try_conditional(I);
+inline_bif(I) ->
+ I.
+
+try_conditional(I = #icode_call{dstlist = [Dst], 'fun' = {erlang, Name, 2},
+ args = [Arg1, Arg2],
+ continuation = Cont}) ->
+ case is_conditional(Name) of
+ true ->
+ inline_conditional(Dst, Name, Arg1, Arg2, Cont);
+ false ->
+ try_bool(I)
+ end;
+try_conditional(I) ->
+ try_bool(I).
+
+is_conditional(Name) ->
+ case Name of
+ '=:=' -> true;
+ '=/=' -> true;
+ '==' -> true;
+ '/=' -> true;
+ '>' -> true;
+ '<' -> true;
+ '>=' -> true;
+ '=<' -> true;
+ _ -> false
+ end.
+
+try_bool(I = #icode_call{dstlist = [Dst], 'fun' = Name,
+ args = [Arg1, Arg2],
+ continuation = Cont, fail_label = Fail}) ->
+ case is_binary_bool(Name) of
+ {true, Results, ResLbls} ->
+ inline_binary_bool(Dst, Results, ResLbls, Arg1, Arg2, Cont, Fail, I);
+ false ->
+ try_type_tests(I)
+ end;
+try_bool(I = #icode_call{dstlist = [Dst], 'fun' = {erlang, 'not', 1},
+ args = [Arg1],
+ continuation = Cont,
+ fail_label = Fail}) ->
+ inline_unary_bool(Dst, {false, true}, Arg1, Cont, Fail, I);
+try_bool(I) -> try_type_tests(I).
+
+is_binary_bool({erlang, Name, 2}) ->
+ ResTLbl = hipe_icode:mk_new_label(),
+ ResFLbl = hipe_icode:mk_new_label(),
+ ResTL = hipe_icode:label_name(ResTLbl),
+ ResFL = hipe_icode:label_name(ResFLbl),
+ case Name of
+ 'and' -> {true, {ResTL, ResFL, ResFL}, {ResTLbl, ResFLbl}};
+ 'or' -> {true, {ResTL, ResTL, ResFL}, {ResTLbl, ResFLbl}};
+ 'xor' -> {true, {ResFL, ResTL, ResFL}, {ResTLbl, ResFLbl}};
+ _ -> false
+ end;
+is_binary_bool(_) -> false.
+
+try_type_tests(I = #icode_call{dstlist=[Dst], 'fun' = {erlang, Name, 1},
+ args = Args, continuation = Cont}) ->
+ case is_type_test(Name) of
+ {true, Type} ->
+ inline_type_test(Dst, Type, Args, Cont);
+ false ->
+ I
+ end;
+try_type_tests(I) -> I.
+
+is_type_test(Name) ->
+ case Name of
+ is_integer -> {true, integer};
+ is_float -> {true, float};
+ is_tuple -> {true, tuple};
+ is_binary -> {true, binary};
+ is_list -> {true, list};
+ is_pid -> {true, pid};
+ is_atom -> {true, atom};
+ is_boolean -> {true, boolean};
+ is_function -> {true, function};
+ is_reference -> {true, reference};
+ is_constant -> {true, constant};
+ is_port -> {true, port};
+ _ -> false
+ end.
+
+inline_type_test(BifRes, Type, Src, Cont) ->
+ {NewCont, NewEnd} = get_cont_lbl(Cont),
+ TLbl = hipe_icode:mk_new_label(),
+ FLbl = hipe_icode:mk_new_label(),
+ TL = hipe_icode:label_name(TLbl),
+ FL = hipe_icode:label_name(FLbl),
+ [hipe_icode:mk_type(Src, Type, TL, FL),
+ TLbl,
+ hipe_icode:mk_move(BifRes, hipe_icode:mk_const(true)),
+ hipe_icode:mk_goto(NewCont),
+ FLbl,
+ hipe_icode:mk_move(BifRes, hipe_icode:mk_const(false)),
+ hipe_icode:mk_goto(NewCont)|
+ NewEnd].
+
+inline_conditional(BifRes, Op, Src1, Src2, Cont) ->
+ {NewCont, NewEnd} = get_cont_lbl(Cont),
+ TLbl = hipe_icode:mk_new_label(),
+ FLbl = hipe_icode:mk_new_label(),
+ TL = hipe_icode:label_name(TLbl),
+ FL = hipe_icode:label_name(FLbl),
+ [hipe_icode:mk_if(Op, [Src1, Src2], TL, FL),
+ TLbl,
+ hipe_icode:mk_move(BifRes, hipe_icode:mk_const(true)),
+ hipe_icode:mk_goto(NewCont),
+ FLbl,
+ hipe_icode:mk_move(BifRes, hipe_icode:mk_const(false)),
+ hipe_icode:mk_goto(NewCont)|
+ NewEnd].
+
+%%
+%% The TTL TFL FFL labelnames points to either ResTLbl or ResFLbl
+%% Depending on what boolean expression we are inlining
+%%
+
+inline_binary_bool(Dst, {TTL, TFL, FFL}, {ResTLbl, ResFLbl},
+ Arg1, Arg2, Cont, Fail, I) ->
+ {NewCont, NewEnd} = get_cont_lbl(Cont),
+ {NewFail, FailCode} = get_fail_lbl(Fail, I),
+ EndCode = FailCode++NewEnd,
+ TLbl = hipe_icode:mk_new_label(),
+ FLbl = hipe_icode:mk_new_label(),
+ NotTLbl = hipe_icode:mk_new_label(),
+ NotTTLbl = hipe_icode:mk_new_label(),
+ NotTFLbl = hipe_icode:mk_new_label(),
+ TL = hipe_icode:label_name(TLbl),
+ FL = hipe_icode:label_name(FLbl),
+ NotTL = hipe_icode:label_name(NotTLbl),
+ NotTTL = hipe_icode:label_name(NotTTLbl),
+ NotTFL = hipe_icode:label_name(NotTFLbl),
+ [hipe_icode:mk_type([Arg1], {atom, true}, TL, NotTL, 0.5),
+ NotTLbl,
+ hipe_icode:mk_type([Arg1], {atom, false}, FL, NewFail, 0.99),
+ TLbl,
+ hipe_icode:mk_type([Arg2], {atom, true}, TTL, NotTTL, 0.5),
+ NotTTLbl,
+ hipe_icode:mk_type([Arg2], {atom, false}, TFL, NewFail, 0.99),
+ FLbl,
+ hipe_icode:mk_type([Arg2], {atom, true}, TFL, NotTFL, 0.5),
+ NotTFLbl,
+ hipe_icode:mk_type([Arg2], {atom, false}, FFL, NewFail, 0.99),
+ ResTLbl,
+ hipe_icode:mk_move(Dst, hipe_icode:mk_const(true)),
+ hipe_icode:mk_goto(NewCont),
+ ResFLbl,
+ hipe_icode:mk_move(Dst, hipe_icode:mk_const(false)),
+ hipe_icode:mk_goto(NewCont)|
+ EndCode].
+
+inline_unary_bool(Dst, {T,F}, Arg1, Cont, Fail, I) ->
+ TLbl = hipe_icode:mk_new_label(),
+ NotTLbl = hipe_icode:mk_new_label(),
+ FLbl = hipe_icode:mk_new_label(),
+ TL = hipe_icode:label_name(TLbl),
+ NotTL = hipe_icode:label_name(NotTLbl),
+ FL = hipe_icode:label_name(FLbl),
+ {NewCont, NewEnd} = get_cont_lbl(Cont),
+ {NewFail, FailCode} = get_fail_lbl(Fail, I),
+ EndCode = FailCode ++ NewEnd,
+ Arg1L = [Arg1],
+ [hipe_icode:mk_type(Arg1L, {atom, true}, TL, NotTL, 0.5),
+ NotTLbl,
+ hipe_icode:mk_type(Arg1L, {atom, false}, FL, NewFail, 0.99),
+ TLbl,
+ hipe_icode:mk_move(Dst, hipe_icode:mk_const(T)),
+ hipe_icode:mk_goto(NewCont),
+ FLbl,
+ hipe_icode:mk_move(Dst, hipe_icode:mk_const(F)),
+ hipe_icode:mk_goto(NewCont)|
+ EndCode].
+
+get_cont_lbl([]) ->
+ NL = hipe_icode:mk_new_label(),
+ {hipe_icode:label_name(NL), [NL]};
+get_cont_lbl(Cont) ->
+ {Cont, []}.
+
+get_fail_lbl([], I) ->
+ NL = hipe_icode:mk_new_label(),
+ {hipe_icode:label_name(NL), [NL, I]};
+get_fail_lbl(Fail, _) ->
+ {Fail, []}.
diff --git a/lib/hipe/icode/hipe_icode_instruction_counter.erl b/lib/hipe/icode/hipe_icode_instruction_counter.erl
new file mode 100644
index 0000000000..92658d294a
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_instruction_counter.erl
@@ -0,0 +1,135 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-------------------------------------------------------------------
+%% File : icode_instruction_counter.erl
+%% Author : Andreas Hasselberg <anha0825@student.uu.se>
+%% Purpose : This module counts the number of different instructions
+%% in a function. It is useful when you want to know if
+%% your Icode analysis or specialization is good, bad or
+%% simply unlucky :)
+%%
+%% Created : 2 Oct 2006 by Andreas Hasselberg <anha0825@student.uu.se>
+%%-------------------------------------------------------------------
+
+-module(hipe_icode_instruction_counter).
+
+-export([cfg/3, compare/3]).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+
+%%-------------------------------------------------------------------
+%% A general CFG instruction walktrough
+%%-------------------------------------------------------------------
+
+-spec cfg(#cfg{}, mfa(), comp_options()) -> [_].
+
+cfg(Cfg, _IcodeFun, _Options) ->
+ Labels = hipe_icode_cfg:labels(Cfg),
+ %% Your Info init function goes here
+ InitInfo = counter__init_info(),
+ Info = lists:foldl(fun (Label, InfoAcc) ->
+ BB = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ walktrough_bb(Code, InfoAcc)
+ end, InitInfo, Labels),
+ %% counter__output_info(IcodeFun, Info),
+ Info.
+
+walktrough_bb(BB, Info) ->
+ lists:foldl(fun (Insn, InfoAcc) ->
+ %% Your analysis function here
+ counter__analys_insn(Insn, InfoAcc)
+ end, Info, BB).
+
+%%-------------------------------------------------------------------
+%% The counter specific functions
+%%-------------------------------------------------------------------
+
+-spec compare(gb_tree(), gb_tree(), gb_tree()) -> gb_tree().
+
+compare(Name, Old, New) ->
+ NewList = gb_trees:to_list(New),
+ OldList = gb_trees:to_list(Old),
+ TempTree = compare_one_way(NewList, Old, added, gb_trees:empty()),
+ DiffTree = compare_one_way(OldList, New, removed, TempTree),
+ DiffList = gb_trees:to_list(DiffTree),
+ if DiffList =:= [] ->
+ ok;
+ true ->
+ io:format("~p: ~p ~n", [Name, DiffList])
+ end,
+ DiffTree.
+
+compare_one_way(List, Tree, Key, Fold_tree) ->
+ lists:foldl(fun({Insn, ListCount}, DiffAcc) when is_integer(ListCount) ->
+ DiffCount =
+ case gb_trees:lookup(Insn, Tree) of
+ {value, TreeCount} when is_integer(TreeCount) ->
+ ListCount - TreeCount;
+ none ->
+ ListCount
+ end,
+ if DiffCount > 0 ->
+ gb_trees:insert({Key, Insn}, DiffCount, DiffAcc);
+ true ->
+ DiffAcc
+ end
+ end,
+ Fold_tree,
+ List).
+
+counter__init_info() ->
+ gb_trees:empty().
+
+counter__analys_insn(Insn, Info) ->
+ Key = counter__insn_get_key(Insn),
+ counter__increase_key(Key, Info).
+
+counter__insn_get_key(If = #icode_if{}) -> {'if', hipe_icode:if_op(If)};
+counter__insn_get_key(Call = #icode_call{}) -> {call, hipe_icode:call_fun(Call)};
+counter__insn_get_key(#icode_enter{}) -> enter;
+counter__insn_get_key(#icode_return{}) -> return;
+counter__insn_get_key(#icode_type{}) -> type;
+counter__insn_get_key(#icode_switch_val{}) -> switch_val;
+counter__insn_get_key(#icode_switch_tuple_arity{}) -> switch_tuple_arity;
+counter__insn_get_key(#icode_goto{}) -> goto;
+counter__insn_get_key(#icode_move{}) -> move;
+counter__insn_get_key(#icode_phi{}) -> phi;
+counter__insn_get_key(#icode_begin_try{}) -> begin_try;
+counter__insn_get_key(#icode_end_try{}) -> end_try;
+counter__insn_get_key(#icode_begin_handler{}) -> begin_handler;
+counter__insn_get_key(#icode_fail{}) -> fail;
+counter__insn_get_key(#icode_comment{}) -> comment.
+
+counter__increase_key(Key, Info) ->
+ NewCounter =
+ case gb_trees:lookup(Key, Info) of
+ {value, Counter} when is_integer(Counter) ->
+ Counter + 1;
+ none ->
+ 1
+ end,
+ gb_trees:enter(Key, NewCounter, Info).
+
+%%counter__output_info(IcodeFun, Info) ->
+%% InfoList = gb_trees:to_list(Info),
+%% io:format("~p instructions : ~p ~n", [IcodeFun, InfoList]).
diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl
new file mode 100644
index 0000000000..5816e59032
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_liveness.erl
@@ -0,0 +1,101 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ICODE LIVENESS ANALYSIS
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_icode_liveness).
+
+-define(PRETTY_PRINT, true).
+
+-include("hipe_icode.hrl").
+-include("../flow/liveness.inc").
+
+%%--------------------------------------------------------------------
+%% Interface to CFG and icode.
+%%--------------------------------------------------------------------
+
+cfg_bb(CFG, L) ->
+ hipe_icode_cfg:bb(CFG, L).
+
+cfg_postorder(CFG) ->
+ hipe_icode_cfg:postorder(CFG).
+
+cfg_succ(CFG, L) ->
+ hipe_icode_cfg:succ(CFG, L).
+
+uses(Instr) ->
+ hipe_icode:uses(Instr).
+
+defines(Instr) ->
+ hipe_icode:defines(Instr).
+
+%%
+%% This is the list of registers that are live at exit from a function
+%%
+cfg_labels(CFG) ->
+ hipe_icode_cfg:labels(CFG).
+
+liveout_no_succ() ->
+ ordsets:new().
+
+pp_liveness_info(LiveList) ->
+ print_live_list(LiveList).
+
+print_live_list([]) ->
+ io:format(" none~n", []);
+print_live_list([Last]) ->
+ io:format(" ", []),
+ print_var(Last),
+ io:format("~n", []);
+print_live_list([Var|Rest]) ->
+ io:format(" ", []),
+ print_var(Var),
+ io:format(",", []),
+ print_live_list(Rest).
+
+pp_block(Label, CFG) ->
+ BB = hipe_icode_cfg:bb(CFG, Label),
+ Code = hipe_bb:code(BB),
+ hipe_icode_pp:pp_block(Code).
+
+print_var(#icode_variable{name=V, kind=Kind, annotation=T}) ->
+ case Kind of
+ var -> io:format("v~p", [V]);
+ reg -> io:format("r~p", [V]);
+ fvar -> io:format("fv~p", [V])
+ end,
+ case T of
+ [] -> ok;
+ {_,X,F} -> io:format(" (~s)", F(X))
+ end.
+
+%%
+%% The following are used only if annotation of the code is requested.
+%%
+-ifdef(DEBUG_LIVENESS).
+cfg_bb_add(CFG, L, NewBB) ->
+ hipe_icode_cfg:bb_add(CFG, L, NewBB).
+
+mk_comment(Text) ->
+ hipe_icode:mk_comment(Text).
+-endif.
diff --git a/lib/hipe/icode/hipe_icode_mulret.erl b/lib/hipe/icode/hipe_icode_mulret.erl
new file mode 100644
index 0000000000..a6529c8519
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_mulret.erl
@@ -0,0 +1,1323 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_icode_mulret.erl
+%% Author : Christoffer Vikstr�m <chvi3471@it.uu.se>
+%% Purpose :
+%% Created : 23 Jun 2004 by Christoffer Vikstr�m <chvi3471@it.uu.se>
+%%----------------------------------------------------------------------
+
+-module(hipe_icode_mulret).
+-export([mult_ret/4]).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+
+%%>----------------------------------------------------------------------<
+%% Procedure : mult_ret/4
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+
+-spec mult_ret([_], atom(), comp_options(), _) -> [_].
+
+mult_ret(List, Mod, Opts, Exports) ->
+ case length(List) > 1 of
+ true ->
+ Table = analyse(List, Mod, Exports),
+ %% printTable(Mod, Exports, Table),
+ optimize(List, Mod, Opts, Table);
+ false ->
+ List
+ end.
+
+%%>-----------------------< Analysis Steps >-----------------------------<
+
+%%>----------------------------------------------------------------------<
+%% Procedure : analyse/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+analyse(List, _Mod, Exports) ->
+ MaxRets = hipe_rtl_arch:nr_of_return_regs(),
+ Table = mkTable(List),
+ %% printTable(Mod, Exports, Table),
+ Table2 = filterTable(Table, MaxRets, Exports),
+ %% printTable(Mod, Exports, Table2),
+ Table2.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : mkTable/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+mkTable(List) ->
+ mkTable(List, {[], []}).
+
+mkTable([{MFA, Icode} | List], Table) ->
+ %% New Icode
+ {_LMin,LMax} = hipe_icode:icode_label_range(Icode),
+ hipe_gensym:set_label(icode, LMax+1),
+ {_VMin,VMax} = hipe_icode:icode_var_range(Icode),
+ hipe_gensym:set_var(icode, VMax+1),
+ case isFunDef(MFA) of
+ true ->
+ mkTable(List, Table);
+ false ->
+ CallList = mkCallList(MFA, Icode),
+ Optimizable = isOptimizable(Icode),
+ NewTable = addToTable(MFA, Optimizable, CallList, Table),
+ mkTable(List, NewTable)
+ end;
+mkTable([_|List], Table) -> mkTable(List, Table);
+mkTable([], Table) -> Table.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : isFunDef/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+isFunDef({_, F, _}) ->
+ hd(atom_to_list(F)) =:= 45. %% 45 is the character '-'
+
+%%>----------------------------------------------------------------------<
+%% Procedure : mkCallList/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+mkCallList(MFA, Icode) ->
+ Code = hipe_icode:icode_code(Icode),
+ mkCallList(Code, MFA, []).
+
+mkCallList([#icode_call{'fun'=F, dstlist=Vars, type=local}|Code], MFA, Res) ->
+ {Size, DstList} = lookForDef(Code, Vars),
+ mkCallList(Code, MFA, [{callPair,MFA,{F,{matchSize,Size,DstList}}}|Res]);
+mkCallList([_|Code], MFA, Res) -> mkCallList(Code, MFA, Res);
+mkCallList([], _, Res) -> Res.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : lookForDef/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+lookForDef([#icode_type{test={tuple,Size}, true_label=L}|Code], Vars) ->
+ Code2 = skipToLabel(Code, L),
+ DstLst = lookForUnElems(Code2, Vars),
+ case DstLst of
+ [] -> {1, Vars};
+ _ ->
+ DstLst2 = fixDstLst(DstLst, Size),
+ {Size, DstLst2}
+ end;
+lookForDef([#icode_move{src=Var, dst=NewVar}|Code], [Var]) ->
+ lookForDef(Code, [NewVar]);
+lookForDef([#icode_label{}|_], Vars) ->
+ {1, Vars};
+lookForDef([I|Code], [Var] = Vars) ->
+ Defs = hipe_icode:defines(I),
+ case lists:member(Var, Defs) of
+ true ->
+ {1, Vars};
+ false ->
+ lookForDef(Code, Vars)
+ end;
+lookForDef([], Vars) -> {1, Vars}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : skipToLabel/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+skipToLabel(Code, L) ->
+ case skipToLabel2(Code, L) of
+ noLabel ->
+ Code;
+ NewCode ->
+ NewCode
+ end.
+
+skipToLabel2([#icode_label{name = L}|Code],L) -> Code;
+skipToLabel2([_|Code], L) -> skipToLabel2(Code, L);
+skipToLabel2([], _) -> noLabel.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : lookForUnElems/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+lookForUnElems(Code, Var) ->
+ lookForUnElems(Code, Var, []).
+
+lookForUnElems([#icode_call{'fun'=#unsafe_element{index=Nr}, args=Var,
+ dstlist=[Ret]}|Code], Var, Res) ->
+ lookForUnElems(Code, Var, [{Nr, Ret}|Res]);
+lookForUnElems([#icode_move{dst=Var}|_], [Var], Res) ->
+ lists:flatten(Res);
+lookForUnElems([#icode_call{dstlist=VarList}|_], VarList, Res) ->
+ lists:flatten(Res);
+lookForUnElems([_|Code], Var, Res) ->
+ lookForUnElems(Code, Var, Res);
+lookForUnElems([], _, Res) -> lists:flatten(Res).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : fixDstLst/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+fixDstLst(DstLst, Size) when is_integer(Size) ->
+ fixDstLst(DstLst, Size, 1, []).
+
+fixDstLst(DstLst, Size, Cnt, Res) when Cnt =< Size ->
+ case isInLst(Cnt, DstLst) of
+ {true, Var} ->
+ fixDstLst(DstLst, Size, Cnt+1, [Var|Res]);
+ false ->
+ Var = hipe_icode:mk_var(hipe_gensym:new_var(icode)),
+ fixDstLst(DstLst, Size, Cnt+1, [Var|Res])
+ end;
+fixDstLst(_, Size, Cnt, Res) when Cnt > Size -> lists:reverse(Res).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : isInLst/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+isInLst(Nr, [{Nr,Var}|_]) -> {true, Var};
+isInLst(Cnt, [_|DstLst]) -> isInLst(Cnt, DstLst);
+isInLst(_, []) -> false.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : isOptimizable/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+isOptimizable(Icode) ->
+ %% Icode2 = hipe_icode:fixup_fallthroughs(Icode),
+ Icode2 = hipe_icode:strip_comments(Icode),
+ Cfg = hipe_icode_cfg:linear_to_cfg(Icode2),
+ %% hipe_icode_cfg:pp(Cfg),
+ case findReturnBlocks(Cfg) of
+ noReturn ->
+ {false, -1};
+ BlockList ->
+ processReturnBlocks(BlockList, Cfg)
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : findReturnBlocks/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+findReturnBlocks(IcodeCfg) ->
+ Labels = hipe_icode_cfg:labels(IcodeCfg),
+ case searchBlocks(Labels, IcodeCfg) of
+ [] ->
+ noReturn;
+ BlockList->
+ BlockList
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : searchBlocks/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+searchBlocks(Labels, IcodeCfg) ->
+ searchBlocks(Labels, IcodeCfg, []).
+
+searchBlocks([Label|Labels], IcodeCfg, Res) ->
+ Block = hipe_icode_cfg:bb(IcodeCfg, Label),
+ Code = hipe_bb:code(Block),
+ case searchBlockCode(Code) of
+ {hasReturn, RetVar} ->
+ searchBlocks(Labels, IcodeCfg, [{Label, RetVar}|Res]);
+ noReturn ->
+ searchBlocks(Labels, IcodeCfg, Res)
+ end;
+searchBlocks([], _, Res) -> Res.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : searchBlockCode/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+searchBlockCode([#icode_return{vars=Vars}|_]) ->
+ {hasReturn, Vars};
+searchBlockCode([_|Icode]) ->
+ searchBlockCode(Icode);
+searchBlockCode([]) -> noReturn.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : processReturnBlock/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+processReturnBlocks(Blocks, Cfg) ->
+ processReturnBlocks(Blocks, Cfg, {true, -1}, []).
+
+processReturnBlocks([{Label, Var}|BlockList], Cfg, {Opts, Size}, TypeLst) ->
+ {Opt, Type, Size2} = traverseCode(Label, Var, Cfg),
+ case (Size =:= -1) orelse (Size =:= Size2) of
+ true ->
+ processReturnBlocks(BlockList, Cfg,
+ {Opt andalso Opts, Size2}, [Type|TypeLst]);
+ false ->
+ {false, -1}
+ end;
+processReturnBlocks([], _, Res, TypeLst) ->
+ case lists:member(icode_var, TypeLst) of
+ true ->
+ {_, Size} = Res,
+ case Size > 1 of
+ true ->
+ Res;
+ false ->
+ {false, -1}
+ end;
+ false ->
+ {false, -1}
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : traverseCode/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+traverseCode(Label, Var, Cfg) ->
+ traverseCode(Label, Var, Cfg, []).
+
+traverseCode(Label, Var, Cfg, LabLst) ->
+ Preds = hipe_icode_cfg:pred(Cfg, Label),
+ Block = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(Block),
+ case findDefine(lists:reverse(Code), Var) of
+ {found, Type, NumRets} ->
+ {true, Type, NumRets};
+ {notFound, SrcVar} ->
+ case Preds of
+ [] ->
+ {false, none, -1};
+ [Pred] ->
+ case lists:member(Label, LabLst) of
+ false ->
+ traverseCode(Pred, SrcVar, Cfg, [Label|LabLst]);
+ true ->
+ {false, none, -1}
+ end;
+ _ ->
+ {false, none, -1}
+ end
+ end.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : findDefine/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+findDefine([#icode_call{dstlist=Vars,'fun'=mktuple,args=Vs}|_], Vars) ->
+ case length(Vs) of
+ 1 ->
+ [{Type, _}] = Vs,
+ {found, Type, 1};
+ Len ->
+ case lists:any(fun hipe_icode:is_var/1, Vs) of
+ true ->
+ {found, icode_var, Len};
+ false ->
+ {found, icode_const, Len}
+ end
+ end;
+findDefine([#icode_move{dst=Var, src=Src}|Code], [Var]) ->
+ case hipe_icode:is_var(Src) of
+ true ->
+ findDefine(Code, [Src]);
+ false ->
+ case Src of
+ #icode_const{value={flat, Value}} ->
+ case is_tuple(Value) of
+ true ->
+ {found, icode_const, tuple_size(Value)};
+ false ->
+ {found, icode_const, 1}
+ end;
+ _ ->
+ findDefine(Code, [Var])
+ end
+ end;
+findDefine([_|Code], Var) ->
+ findDefine(Code, Var);
+findDefine([], Var) ->
+ {notFound, Var}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : addToTable/4
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+addToTable(MFA, Optimizable, CallList, {FunLst, CallLst}) ->
+ NewFunLst = [{MFA, Optimizable}|FunLst],
+ {NewFunLst, CallList ++ CallLst}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : filterTable/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+filterTable({FunLst, CallLst}, MaxRets, Exports) ->
+ filterTable(FunLst, CallLst, MaxRets, Exports, {[],[]}).
+
+filterTable([Fun|FunLst], CallLst, MaxRets, Exports, {Funs, Calls} = FCs) ->
+ {MFA, {ReturnOpt, Rets}} = Fun,
+ {CallOpt, CallsToKeep} = checkCalls(CallLst, MFA, Rets),
+ CallsToKeep2 = removeDuplicateCalls(CallsToKeep),
+ NotExported = checkExported(MFA, Exports),
+ case CallOpt andalso ReturnOpt andalso (Rets =< MaxRets) andalso
+ NotExported andalso (not containRecursiveCalls(CallsToKeep2, MFA)) of
+ true ->
+ filterTable(FunLst, CallLst, MaxRets, Exports,
+ {[Fun|Funs], CallsToKeep2 ++ Calls});
+ false ->
+ filterTable(FunLst, CallLst, MaxRets, Exports, FCs)
+ end;
+filterTable([], _, _, _, Res) -> Res.
+
+removeDuplicateCalls(Calls) ->
+ removeDuplicateCalls(Calls, []).
+
+removeDuplicateCalls([Call|CallsToKeep], Res) ->
+ case lists:member(Call, CallsToKeep) of
+ true ->
+ removeDuplicateCalls(CallsToKeep, Res);
+ false ->
+ removeDuplicateCalls(CallsToKeep, [Call|Res])
+ end;
+removeDuplicateCalls([], Res) -> lists:reverse(Res).
+
+containRecursiveCalls([Call|Calls], Fun) ->
+ {callPair, Caller, {Callee, _}} = Call,
+ case (Callee =:= Fun) andalso (Caller =:= Fun) of
+ true ->
+ true;
+ false->
+ containRecursiveCalls(Calls, Fun)
+ end;
+containRecursiveCalls([], _) -> false.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : checkCalls/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+checkCalls(CallLst, MFA, Rets) ->
+ checkCalls(CallLst, MFA, Rets, [], []).
+
+checkCalls([C = {callPair, _, {MFA, {matchSize, Rets, _}}}|CallLst],
+ MFA, Rets, Res, Opt) ->
+ checkCalls(CallLst, MFA, Rets, [C|Res], [true|Opt]);
+checkCalls([{callPair, _, {MFA, {matchSize, _, _}}}|CallLst],
+ MFA, Rets, Res, Opt) ->
+ checkCalls(CallLst, MFA, Rets, Res, [false|Opt]);
+checkCalls([_|CallLst], MFA, Rets, Res, Opt) ->
+ checkCalls(CallLst, MFA, Rets, Res, Opt);
+checkCalls([], _, _, Res, Opt) -> {combineOpts(Opt), Res}.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : combineOpts/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+combineOpts([]) -> false;
+combineOpts([Opt]) -> Opt;
+combineOpts([Opt|Opts]) -> Opt andalso combineOpts(Opts).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : checkCalls/2
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+checkExported({_,F,A}, [{F,A}|_]) -> false;
+checkExported(MFA, [_|Exports]) -> checkExported(MFA, Exports);
+checkExported(_, []) -> true.
+
+%%>----------------------< Optimization Steps >--------------------------<
+
+%%>----------------------------------------------------------------------<
+%% Procedure : optimize/4
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+optimize(List, _Mod, Opts, Table) ->
+ {FunLst, CallLst} = Table,
+ List2 = optimizeFuns(FunLst, Opts, List),
+ optimizeCalls(CallLst, Opts, List2).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : optimizeFuns/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+optimizeFuns([{Fun, _}|FunList], Opts, List) ->
+ NewList = findFun(List, Fun),
+ optimizeFuns(FunList, Opts, NewList);
+optimizeFuns([],_,List) -> List.
+
+findFun(List, Fun) -> findFun(List, Fun, []).
+findFun([{Fun, Icode}|List], Fun, Res) ->
+ NewIcode = optimizeFun(Icode),
+ findFun(List, Fun, [{Fun, NewIcode}|Res]);
+findFun([I|List], Fun, Res) -> findFun(List, Fun, [I|Res]);
+findFun([], _, Res) -> lists:reverse(Res).
+
+
+optimizeFun(Icode) ->
+ {_LMin,LMax} = hipe_icode:icode_label_range(Icode),
+ hipe_gensym:set_label(icode, LMax+1),
+ {_VMin,VMax} = hipe_icode:icode_var_range(Icode),
+ hipe_gensym:set_var(icode, VMax+1),
+ %% Icode2 = hipe_icode:fixup_fallthroughs(Icode),
+ Icode2 = hipe_icode:strip_comments(Icode),
+ Cfg = hipe_icode_cfg:linear_to_cfg(Icode2),
+ case findReturnBlocks(Cfg) of
+ noReturn ->
+ false;
+ BlockList ->
+ NewCfg = optimizeReturnBlocks(BlockList, Cfg),
+ hipe_icode_cfg:cfg_to_linear(NewCfg)
+ end.
+
+optimizeReturnBlocks([Block|BlockList], Cfg) ->
+ {NewCfg, Vars} = optimizeReturnBlock(Block, Cfg),
+ NewCfg2 = case Vars of
+ [_] ->
+ Cfg;
+ _ ->
+ {Label, _} = Block,
+ updateReturnBlock(Label, Vars, NewCfg)
+ end,
+ optimizeReturnBlocks(BlockList, NewCfg2);
+optimizeReturnBlocks([], Cfg) -> Cfg.
+
+optimizeReturnBlock(Block, Cfg) ->
+ optimizeReturnBlock(Block, Cfg, []).
+
+optimizeReturnBlock({Label,Var}, Cfg, UpdateMap) ->
+ Preds = hipe_icode_cfg:pred(Cfg, Label),
+ Block = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(Block),
+ case optimizeDefine(Code, Var) of
+ {found, NewBlockCode, Vars} ->
+ NewBlock = hipe_bb:code_update(Block, NewBlockCode),
+ NewCfg = resolveUpdateMap(UpdateMap, Cfg),
+ {hipe_icode_cfg:bb_add(NewCfg, Label, NewBlock), Vars};
+ {none, NewBlockCode, NewVar} ->
+ case Preds of
+ [Pred] ->
+ NewBlock = hipe_bb:code_update(Block, NewBlockCode),
+ optimizeReturnBlock({Pred,NewVar}, Cfg,
+ [{Label, NewBlock}|UpdateMap]);
+ [_|_] ->
+ {Cfg, Var}
+ end;
+ {none, noOpt} ->
+ {Cfg, Var}
+ end.
+
+optimizeDefine(Code, Dst) ->
+ optimizeDefine(lists:reverse(Code), Dst, [], []).
+
+optimizeDefine([I|Code], Dsts, DstLst, Res) ->
+ [Ds] = Dsts,
+ case isCallPrimop(I, mktuple) andalso DstLst =:= [] of
+ true ->
+ case (hipe_icode:call_dstlist(I) =:= Dsts) of
+ true ->
+ case (hipe_icode:call_args(I) > 1) of
+ true ->
+ optimizeDefine(Code, Dsts, hipe_icode:call_args(I), Res);
+ false ->
+ {none, noOpt}
+ end;
+ false ->
+ optimizeDefine(Code, Dsts, DstLst, [I|Res])
+ end;
+ false ->
+ case hipe_icode:is_move(I) andalso DstLst =:= [] of
+ true ->
+ case hipe_icode:move_dst(I) =:= Ds of
+ true ->
+ Src = hipe_icode:move_src(I),
+ case hipe_icode:is_var(Src) of
+ true ->
+ NewDst = hipe_icode:move_src(I),
+ optimizeDefine(Code, [NewDst], DstLst, Res);
+ false ->
+ case Src of
+ #icode_const{value={flat, T}} when is_tuple(T) ->
+ NewLst = tuple_to_list(T),
+ optimizeDefine(Code, Dsts, NewLst, Res);
+ _ ->
+ {none, noOpt}
+ end
+ end;
+ false ->
+ optimizeDefine(Code, Dsts, DstLst, [I|Res])
+ end;
+ false ->
+ case lists:member(Ds, hipe_icode:defines(I)) andalso DstLst =:= [] of
+ true ->
+ {none, noOpt};
+ false ->
+ optimizeDefine(Code, Dsts, DstLst, [I|Res])
+ end
+ end
+ end;
+optimizeDefine([], Dsts, DstLst, Res) ->
+ case DstLst of
+ [] ->
+ {none, Res, Dsts};
+ _ ->
+ {found, Res, DstLst}
+ end.
+
+resolveUpdateMap([{Label, Block}|UpdateMap], Cfg) ->
+ resolveUpdateMap(UpdateMap, hipe_icode_cfg:bb_add(Cfg, Label, Block));
+resolveUpdateMap([], Cfg) -> Cfg.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : updateReturnBlock/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+updateReturnBlock(Label, Vars, IcodeCfg) ->
+ Block = hipe_icode_cfg:bb(IcodeCfg, Label),
+ Code = hipe_bb:code(Block),
+ NewCode = updateReturnCode(Code, Vars),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ hipe_icode_cfg:bb_add(IcodeCfg, Label, NewBlock).
+
+updateReturnCode(Code, DstLst) ->
+ updateReturnCode(Code, DstLst, []).
+
+updateReturnCode([I| Code], DstLst, Res) ->
+ case hipe_icode:is_return(I) of
+ true ->
+ updateReturnCode(Code, DstLst, [hipe_icode:mk_return(DstLst)|Res]);
+ false ->
+ updateReturnCode(Code, DstLst, [I|Res])
+ end;
+updateReturnCode([], _, Res) -> lists:reverse(Res).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : optimizeCalls/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+optimizeCalls([Call|CallLst], _Opts, List) ->
+ {callPair, Caller, {Callee, {matchSize, _, DstLst}}} = Call,
+ NewList = optimizeCall(List, Caller, Callee, DstLst),
+ optimizeCalls(CallLst, _Opts, NewList);
+optimizeCalls([], _Opts, List) -> List.
+
+%%>----------------------------------------------------------------------<
+%% Procedure : optimizeCall/4
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+optimizeCall(List, Caller, Callee, DstLst) ->
+ optimizeCall(List, Caller, Callee, DstLst, []).
+
+optimizeCall([{MFA, Icode}|List], MFA, Callee, DstLst, Res) ->
+ {_LMin,LMax} = hipe_icode:icode_label_range(Icode),
+ hipe_gensym:set_label(icode, LMax+1),
+ {_VMin,VMax} = hipe_icode:icode_var_range(Icode),
+ hipe_gensym:set_var(icode, VMax+1),
+ %% Icode2 = hipe_icode:fixup_fallthroughs(Icode),
+ Icode2 = hipe_icode:strip_comments(Icode),
+ Cfg = hipe_icode_cfg:linear_to_cfg(Icode2),
+ NewIcode = findAndUpdateCalls(Cfg, Callee, DstLst),
+ optimizeCall(List, MFA, Callee, DstLst, [{MFA, NewIcode}|Res]);
+optimizeCall([I|List], Caller, Callee, DstLst, Res) ->
+ optimizeCall(List, Caller, Callee, DstLst, [I|Res]);
+optimizeCall([], _, _, _, Res) -> lists:reverse(Res).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : findAndUpdateCall/3
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+findAndUpdateCalls(Cfg, Callee, DstLst) ->
+ Labels = hipe_icode_cfg:labels(Cfg),
+ Cfg2 = findAndUpdateCalls(Cfg, Labels, Callee, DstLst, []),
+ hipe_icode_cfg:cfg_to_linear(Cfg2).
+findAndUpdateCalls(Cfg, [L|Labels], Callee, DstLst, Visited) ->
+ %% Block = hipe_icode_cfg:bb(Cfg, L),
+ %% Code = hipe_bb:code(Block),
+ case containCorrectCall(Cfg, L, Callee, DstLst) of
+ true ->
+ Block = hipe_icode_cfg:bb(Cfg,L),
+ Code = hipe_bb:code(Block),
+ {NewCode, OldVar} = updateCode(Code, Callee, DstLst),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ Cfg2 = hipe_icode_cfg:bb_add(Cfg, L, NewBlock),
+ Cfg3 = cleanUpAffectedCode(Cfg2, OldVar, Callee, L, Visited),
+ findAndUpdateCalls(Cfg3, Labels, Callee, DstLst, [L|Visited]);
+ false ->
+ findAndUpdateCalls(Cfg, Labels, Callee, DstLst, [L|Visited])
+ end;
+findAndUpdateCalls(Cfg,[], _, _, _) -> Cfg.
+
+containCorrectCall(Cfg, Label, Callee, DstLst) ->
+ Block = hipe_icode_cfg:bb(Cfg,Label),
+ Code = hipe_bb:code(Block),
+ case containCallee(Code, Callee) of
+ {true, OldVar} ->
+ Succs = hipe_icode_cfg:succ(Cfg, Label),
+ checkForUnElems(Succs, OldVar, DstLst, Cfg);
+ false ->
+ false
+ end.
+
+checkForUnElems([], _, _, _) -> false;
+checkForUnElems([Succ|Succs], OldVar, DstLst, Cfg) ->
+ Block = hipe_icode_cfg:bb(Cfg,Succ),
+ Code = hipe_bb:code(Block),
+ case checkForUnElems2(Code, OldVar, DstLst, []) of
+ true ->
+ true;
+ false ->
+ checkForUnElems(Succs, OldVar, DstLst, Cfg)
+ end.
+
+checkForUnElems2([I|Code], OldVar, DstLst, DstRes) ->
+ case isCallPrimop(I, unsafe_element) of
+ true ->
+ case (hipe_icode:call_args(I) =:= OldVar) of
+ true ->
+ [Dst] = hipe_icode:call_dstlist(I),
+ case lists:member(Dst, DstLst) of
+ true ->
+ checkForUnElems2(Code, OldVar, DstLst, [Dst|DstRes]);
+ false ->
+ checkForUnElems2(Code, OldVar, DstLst, DstRes)
+ end;
+ false ->
+ checkForUnElems2(Code, OldVar, DstLst, DstRes)
+ end;
+ false ->
+ checkForUnElems2(Code, OldVar, DstLst, DstRes)
+ end;
+checkForUnElems2([], _, DstLst, DstRes) -> DstLst =:= lists:reverse(DstRes).
+
+
+containCallee([I|Code], Callee) ->
+ case isCallLocal(I, Callee) of
+ true ->
+ {true, hipe_icode:call_dstlist(I)};
+ false ->
+ containCallee(Code, Callee)
+ end;
+containCallee([], _) -> false.
+
+
+updateCode(Code, Callee, DstLst) ->
+ updateCode(Code, Callee, DstLst, [], []).
+
+updateCode([I|Code], Callee, DstLst, Res, OldVars) ->
+ case isCallLocal(I, Callee) of
+ true ->
+ Vars = hipe_icode:call_dstlist(I),
+ I2 = hipe_icode:call_dstlist_update(I, DstLst),
+ updateCode(Code, Callee, DstLst, [I2|Res], Vars);
+ false ->
+ updateCode(Code, Callee, DstLst, [I|Res], OldVars)
+ end;
+updateCode([], _, _, Res, OldVars) -> {lists:reverse(Res), OldVars}.
+
+
+cleanUpAffectedCode(Cfg, OldVar, Callee, Label, Visited) ->
+ Block = hipe_icode_cfg:bb(Cfg,Label),
+ Code = hipe_bb:code(Block),
+ {CodeBefore, CodeAfter, DstLst} = divideAtCall(Code, Callee),
+ {NewCodeAfter, ContLab, FailLab} = findType(CodeAfter, OldVar),
+ ContBlock = hipe_icode_cfg:bb(Cfg, ContLab),
+ Succs = hipe_icode_cfg:succ(Cfg, ContLab),
+ ContCode = hipe_bb:code(ContBlock),
+ {NewContCode, NewFailLab} = removeUnElems(ContCode, OldVar, DstLst),
+ NewBlock = hipe_bb:code_update(Block,
+ CodeBefore ++ NewCodeAfter ++ NewContCode),
+ Cfg2 = hipe_icode_cfg:bb_add(Cfg, Label, NewBlock),
+ Cfg3 = resolveSuccBlocks(Succs, OldVar, DstLst, [Label|Visited],
+ NewFailLab, Cfg2),
+ insertMiddleFailBlock(Cfg3, NewFailLab, FailLab, OldVar, DstLst).
+
+divideAtCall(Code, Caller) ->
+ divideAtCall(Code, Caller, []).
+
+divideAtCall([I|Code], Caller, Tail) ->
+ case isCallLocal(I, Caller) of
+ true ->
+ {lists:reverse([I|Tail]), Code, hipe_icode:call_dstlist(I)};
+ false ->
+ divideAtCall(Code, Caller, [I|Tail])
+ end;
+divideAtCall([], _, Tail) -> {Tail, []}.
+
+findType(CodeAfter, OldVar) ->
+ findType(CodeAfter, OldVar, [], {none, none}).
+
+findType([I|Code], OldVar, Rest, Succs) ->
+ case hipe_icode:is_type(I) of
+ true ->
+ case hipe_icode:type_args(I) =:= OldVar of
+ true ->
+ TrueLab = hipe_icode:type_true_label(I),
+ FalseLab = hipe_icode:type_false_label(I),
+ findType(Code, OldVar, Rest, {TrueLab, FalseLab});
+ false ->
+ findType(Code, OldVar, [I|Rest], Succs)
+ end;
+ false ->
+ case hipe_icode:is_move(I) of
+ true ->
+ case [hipe_icode:move_src(I)] =:= OldVar of
+ true ->
+ findType(Code, hipe_icode:move_dst(I), [I|Rest], Succs);
+ false ->
+ findType(Code, OldVar, [I|Rest], Succs)
+ end;
+ false ->
+ findType(Code, OldVar, [I|Rest], Succs)
+ end
+ end;
+findType([],_,Rest, {TrueLab, FalseLab}) ->
+ {lists:reverse(Rest), TrueLab, FalseLab}.
+
+%% Nesting hell... check for redundancies.
+%% ---------------------------------------
+removeUnElems(Code, OldVars, DstLst) ->
+ removeUnElems(Code, OldVars, DstLst, [], false, none).
+
+removeUnElems([I|Code], [OldVar] = OldVars, DstLst, Res, Def, Lab) ->
+ case isCallPrimop(I, unsafe_element) of
+ true ->
+ case (hipe_icode:call_args(I) =:= OldVars) of
+ true ->
+ removeUnElems(Code, OldVars, DstLst, Res, Def, Lab);
+ false ->
+ case lists:member(OldVar, hipe_icode:call_args(I)) of
+ true ->
+ %% XXX: the following test seems redundant,
+ %% hence commented out -- KOSTIS
+ %% case Def of
+ %% true ->
+ removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab);
+ %% false ->
+ %% removeUnElems(Code, OldVars, DstLst,
+ %% [I|Res], Def, Lab)
+ %% end;
+ false ->
+ io:format("Borde aldrig kunna hamna h�r!", []),
+ removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab)
+ end
+ end;
+ false ->
+ case hipe_icode:is_move(I) of
+ true ->
+ case hipe_icode:move_src(I) =:= OldVar of
+ true ->
+ NewVar = hipe_icode:move_dst(I),
+ removeUnElems(Code, [NewVar], DstLst, [I|Res], Def, Lab);
+ false ->
+ removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab)
+ end;
+ false ->
+ case hipe_icode:is_type(I) andalso not Def of
+ true ->
+ NewFalseLab = case Lab =:= none of
+ true ->
+ hipe_gensym:get_next_label(icode);
+ false ->
+ Lab
+ end,
+ _I2 = updateTypeFalseLabel(I, NewFalseLab),
+ removeUnElems(Code, OldVars, DstLst, [I|Res], Def, NewFalseLab);
+ false ->
+ case lists:member(OldVar, hipe_icode:uses(I)) andalso Def of
+ true ->
+ removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab);
+ false ->
+ case lists:member(OldVar, hipe_icode:defines(I)) of
+ true ->
+ removeUnElems(Code, OldVars, DstLst, [I|Res], true, Lab);
+ false ->
+ removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab)
+ end
+ end
+ end
+ end
+ end;
+removeUnElems([], _, _, Res,_, Lab) -> {lists:reverse(Res), Lab}.
+
+
+updateTypeFalseLabel(Instr, NewFalseLabel) ->
+ TrueLabel = hipe_icode:type_true_label(Instr),
+ Args = hipe_icode:type_args(Instr),
+ Type = hipe_icode:type_test(Instr),
+ hipe_icode:mk_type(Args, Type, TrueLabel, NewFalseLabel).
+
+
+resolveSuccBlocks(Succs, OldVar, DstLst, Visited, FailLab, Cfg) ->
+ NewSuccs = [X || X <- Succs, not lists:member(X, Visited)],
+ resolveSuccBlocks2(NewSuccs, OldVar, DstLst, Visited, FailLab, Cfg).
+
+resolveSuccBlocks2([Succ|Succs], OldVar, DstLst, Vis, FailLab, Cfg) ->
+ Block = hipe_icode_cfg:bb(Cfg,Succ),
+ Code = hipe_bb:code(Block),
+ {NewCode, ReDefined} = checkUsesDefs(Code, OldVar, DstLst, FailLab),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ Cfg2 = hipe_icode_cfg:bb_add(Cfg, Succ, NewBlock),
+ case ReDefined of
+ true ->
+ resolveSuccBlocks2(Succs, OldVar, DstLst, [Succ|Vis], FailLab, Cfg2);
+ false ->
+ NewSuccs = hipe_icode_cfg:succ(Cfg, Succ),
+ NewSuccs2 = [X || X <- NewSuccs, not lists:member(X, Vis++Succs)],
+ resolveSuccBlocks2(NewSuccs2++Succs, OldVar, DstLst,
+ [Succ|Vis], FailLab, Cfg2)
+ end;
+resolveSuccBlocks2([], _, _, _, _, Cfg) -> Cfg.
+
+
+checkUsesDefs(Code, OldVar, DstLst, FailLab) ->
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [], false).
+
+checkUsesDefs([I|Code], OldVar, DstLst, FailLab, Res, Defined) ->
+ [OVar] = OldVar,
+ case hipe_icode:is_move(I) of
+ true ->
+ case hipe_icode:move_src(I) =:= OVar of
+ true ->
+ NewVar = hipe_icode:move_dst(I),
+ checkUsesDefs(Code, NewVar, DstLst, FailLab, [I|Res], true);
+ false ->
+ case lists:member(OVar, hipe_icode:defines(I)) of
+ true ->
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], true);
+ false ->
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], Defined)
+ end
+ end;
+ false ->
+ case hipe_icode:is_type(I) andalso not Defined of
+ true ->
+ case FailLab =/= none of
+ true ->
+ _I2 = updateTypeFalseLabel(I, FailLab),
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], Defined);
+ false ->
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], Defined)
+ end;
+ false ->
+ case (lists:member(OVar, hipe_icode:uses(I))) andalso
+ (not Defined) andalso (FailLab =/= none) of
+ true ->
+ Tpl = hipe_icode:mk_primop(OldVar, mktuple, DstLst),
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I,Tpl|Res], true);
+ false ->
+ case lists:member(OVar, hipe_icode:defines(I)) of
+ true ->
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], true);
+ false ->
+ checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res],Defined)
+ end
+ end
+ end
+ end;
+checkUsesDefs([], _, _, _, Res, Defined) -> {lists:reverse(Res), Defined}.
+
+
+insertMiddleFailBlock(Cfg, NewFailLabel, OldFailLabel, OldVar, DstLst) ->
+ case NewFailLabel =:= none of
+ true ->
+ Cfg;
+ false ->
+ NewCode = [hipe_icode:mk_primop(OldVar, mktuple, DstLst),
+ hipe_icode:mk_goto(OldFailLabel)],
+ NewBlock = hipe_bb:mk_bb(NewCode),
+ hipe_icode_cfg:bb_add(Cfg, NewFailLabel, NewBlock)
+ end.
+
+
+isCallLocal(Instr, Fun) ->
+ hipe_icode:is_call(Instr) andalso (hipe_icode:call_type(Instr) =:= local)
+ andalso (hipe_icode:call_fun(Instr) =:= Fun).
+
+isCallPrimop(Instr, Fun) ->
+ case hipe_icode:is_call(Instr) of
+ true ->
+ case is_tuple(hipe_icode:call_fun(Instr)) of
+ true ->
+ ((hipe_icode:call_type(Instr) =:= primop) andalso
+ (element(1,hipe_icode:call_fun(Instr)) =:= Fun));
+ false ->
+ ((hipe_icode:call_type(Instr) =:= primop) andalso
+ (hipe_icode:call_fun(Instr) =:= Fun))
+ end;
+ false ->
+ false
+ end.
+
+
+%% >-------------------------< Debug code >------------------------------<
+
+-ifdef(DEBUG_MULRET).
+
+%%>----------------------------------------------------------------------<
+%% Procedure : printTable/1
+%% Purpose :
+%% Arguments :
+%% Return :
+%% Notes :
+%%>----------------------------------------------------------------------<
+printTable(Mod, Exports, {FunLst, CallLst}) ->
+ {Y,Mo,D} = date(),
+ {H,Mi,S} = time(),
+ io:format("Module: ~w - (~w/~w-~w, ~w:~w:~w)~n=======~n",
+ [Mod,D,Mo,Y,H,Mi,S]),
+ io:format("Exports: ~w~n", [Exports]),
+ io:format("FunList: ~n"),
+ printFunList(FunLst),
+ io:format("CallList: ~n"),
+ printCallList(CallLst).
+
+printFunList([Fun|FunLst]) ->
+ io:format(" ~w~n", [Fun]),
+ printFunList(FunLst);
+printFunList([]) -> io:format("~n").
+
+printCallList([Call|CallLst]) ->
+ io:format(" ~w~n", [Call]),
+ printCallList(CallLst);
+printCallList([]) -> io:format("~n").
+
+-endif.
+
+%% >----------------------------< Old code >--------------------------------<
+
+%% %%>----------------------------------------------------------------------<
+%% % Procedure : findCallCode/3
+%% % Purpose :
+%% % Arguments :
+%% % Return :
+%% % Notes :
+%% %%>----------------------------------------------------------------------<
+%% findCallCode(List, Callee, DstLst) -> findCallCode(List, Callee, DstLst, []).
+%% findCallCode([I=#icode_call{'fun'=Callee, dstlist=Var, type=local}, I2, I3|List],
+%% Callee, DstLst, Res) ->
+%% NewList = removeUnElems(List, Var),
+%% %% _Uses = checkForUses(NewList, Var, DstLst),
+%% Size = length(DstLst),
+%% case I2 of
+%% #icode_type{test={tuple, Size}, args=Var, true_label=Label} ->
+%% case I3 of
+%% #icode_label{name=Label} ->
+%% findCallCode(NewList, Callee, DstLst,
+%% [I#icode_call{dstlist=DstLst}|Res]);
+%% _ ->
+%% findCallCode(NewList, Callee, DstLst,
+%% [#goto{label=Label},
+%% I#icode_call{dstlist=DstLst}|Res])
+%% end;
+%% _ ->
+%% findCallCode(NewList, Callee, DstLst,
+%% [I2,I#icode_call{dstlist=DstLst}|Res])
+%% end;
+%% findCallCode([I|List], Callee, DstLst, Res) ->
+%% findCallCode(List, Callee, DstLst, [I|Res]);
+%% findCallCode([], _, _, Res) -> lists:reverse(Res).
+
+
+%% %%>----------------------------------------------------------------------<
+%% % Procedure : checkForUses
+%% % Purpose :
+%% % Arguments :
+%% % Return :
+%% % Notes :
+%% %%>----------------------------------------------------------------------<
+%% checkForUses(List, Var, Dsts) -> checkForUses(List, Var, Dsts, [], List).
+%% checkForUses([I|List], Var, Dsts, Rest, Code) ->
+%% Defs = hipe_icode:defines(I),
+%% Uses = hipe_icode:uses(I),
+%% case lists:member(Var, Uses) of
+%% true ->
+%% true;
+%% false ->
+%% case lists:member(Var, Defs) of
+%% true ->
+%% false;
+%% false ->
+%% case hipe_icode:is_branch(I) of
+%% true ->
+%% Succs = hipe_icode:successors(I),
+%% checkSuccsForUses(Succs, Var, Dsts, Rest, Code);
+%% false ->
+%% checkForUses(List, Var, Dsts, [I|Rest], Code)
+%% end
+%% end
+%% end;
+%% checkForUses([], _, _, _, _) -> false.
+
+%% checkSuccsForUses(Succs, Var, Dsts, Rest, Code) ->
+%% checkSuccsForUses(Succs, Var, Dsts, Rest, Code, false).
+%% checkSuccsForUses([S|Succs], Var, Dsts, Rest, Code, Res) ->
+%% List = gotoLabel(S, Code),
+%% Used = checkForUses(List, Var, Dsts, Rest, Code),
+%% checkSuccsForUses(Succs, Var, Code, Dsts, Used andalso Res);
+%% checkSuccsForUses([], _, _, _, _, Res) -> Res.
+
+%% gotoLabel(L, [L|List]) -> List;
+%% gotoLabel(L, [_|List]) -> gotoLabel(L, List);
+%% gotoLabel(_, []) -> [].
+
+
+%% %%>----------------------------------------------------------------------<
+%% % Procedure : removeUnElems/2
+%% % Purpose :
+%% % Arguments :
+%% % Return :
+%% % Notes : Fixa s� att funktionen anv�nder defines(I) ist�llet och
+%% % selektorer ist�llet f�r att matcha p� #call{}. L�tt gjort.
+%% %%>----------------------------------------------------------------------<
+%% removeUnElems(List, Var) -> removeUnElems(List, Var, []).
+%% removeUnElems([#icode_call{'fun'={unsafe_element,_}, args=Var}|List], Var, Res) ->
+%% removeUnElems(List, Var, Res);
+%% removeUnElems([I=#icode_move{dst=Var}|List], [Var], Res) ->
+%% lists:reverse(Res) ++ [I|List];
+%% removeUnElems([I=#icode_call{dstlist=Var}|List], Var, Res) ->
+%% lists:reverse(Res) ++ [I|List];
+%% removeUnElems([I|List], Var, Res) ->
+%% removeUnElems(List, Var, [I|Res]);
+%% removeUnElems([], _, Res) -> lists:reverse(Res).
+
+%% removeUnElems(List, Var) -> removeUnElems(List, Var, []).
+%% removeUnElems([I|List], Var, Res) ->
+%% Defs = hipe_icode:defines(I),
+%% case hipe_icode:is_call(I) of
+%% true ->
+%% Fn = hipe_icode:call_fun(I),
+%% case (hipe_icode:call_args(I) =:= Var) andalso is_tuple(Fn) of
+%% true ->
+%% case element(1,Fn) =:= unsafe_element of
+%% true ->
+%% removeUnElems(List, Var, Res);
+%% false ->
+%% case lists:member(Var, Defs) of
+%% true ->
+%% lists:reverse(Res) ++ [I|List];
+%% false ->
+%% removeUnElems(List, Var, [I|Res])
+%% end
+%% end;
+%% false ->
+%% case lists:member(Var, Defs) of
+%% true ->
+%% lists:reverse(Res) ++ [I|List];
+%% false ->
+%% removeUnElems(List, Var, [I|Res])
+%% end
+%% end;
+%% false ->
+%% case lists:member(Var, Defs) of
+%% true ->
+%% lists:reverse(Res) ++ [I|List];
+%% false ->
+%% removeUnElems(List, Var, [I|Res])
+%% end
+%% end;
+%% removeUnElems([], _, Res) -> lists:reverse(Res).
+
+
+%% Old findDefine that also could update it.
+%% -----------------------------------------
+%% findDefine(Code, Var) -> findDefine(Code, Var, [], []).
+%% findDefine([#icode_call{dstlist=Var,'fun'=mktuple,args=Vs}|Code],Var,NewCode,_)->
+%% findDefine(Code, Var, NewCode, Vs);
+%% findDefine([I=#icode_move{dst=Var, src=Src}|Code], [Var], NewCode, _) ->
+%% case Src of
+%% #icode_var{} ->
+%% findDefine(Code, [Src], [I|NewCode], [Src]);
+%% #icode_const{value={flat, Tuple}} ->
+%% findDefine(Code, [Var], [I|NewCode], []) %% Check this case! [Var]
+%% end;
+%% findDefine([I|Code], Var, NewCode, Vars) ->
+%% findDefine(Code, Var, [I|NewCode], Vars);
+%% findDefine([], _, NewCode, Vars) ->
+%% case Vars of
+%% [] ->
+%% notFound;
+%% [_] ->
+%% {notFound, Vars};
+%% _ ->
+%% {found, lists:reverse(NewCode), Vars}
+%% end.
+
+%% modifyCode(Code, Var) ->
+%% [#icode_return{vars=Var}|Code2] = lists:reverse(Code),
+%% case (length(Var) =< hipe_rtl_arch:nr_of_return_regs()) of
+%% true ->
+%% {Arity, Code3} = modifyCode(Code2, Var, []),
+%% {Arity, Code3};
+%% false ->
+%% {1, Code}
+%% end.
+
+%% modifyCode([I|Code], Var, Res) ->
+%% case scanInstr(I, Var) of
+%% {move, Arity, VarLst} ->
+%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res) ++ Code],
+%% {Arity, lists:reverse(Code2)};
+%% {mktuple, Arity, VarLst} ->
+%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res) ++ Code],
+%% {Arity, lists:reverse(Code2)};
+%% other ->
+%% modifyCode(Code, Var, [I|Res])
+%% end;
+%% modifyCode([], Var, Res) ->
+%% {1, lists:reverse(Res) ++ [#icode_return{vars=Var}]}.
+
+%% scanInstr(#icode_call{dstlist=Var, 'fun'=mktuple, args=Lst}, Var) ->
+%% {mktuple, length(Lst), Lst};
+%% scanInstr(_, _) -> other.
+
+%% printCode(Cfg) ->
+%% Labels = hipe_icode_cfg:labels(Cfg),
+%% {_,_,{_,F,_,_,_,_,_,_},_} = Cfg,
+%% io:format("~nFunction: ~w~n", [F]),
+%% Print = fun(Label) ->
+%% Block = hipe_icode_cfg:bb(Cfg, Label),
+%% Code = hipe_bb:code(Block),
+%% io:format("Label: ~w~n", [Label]),
+%% lists:foreach(fun(I) -> io:format("~w~n", [I]) end, Code),
+%% io:format("~n")
+%% end,
+%% lists:foreach(Print, Labels).
+
+%% printList(File, [{MFA, #icode{code=Code, params=Parms}}|List]) ->
+%% io:format(File, "MFA: ~w - Params: ~w~n", [MFA, Parms]),
+%% printList2(File, Code),
+%% printList(File, List);
+%% printList(_, []) -> ok.
+
+%% printList2(File, []) -> io:format(File, "~n~n", []);
+%% printList2(File, IList) when is_list(IList) ->
+%% [I|List] = IList,
+%% io:format(File, "~w~n", [I]),
+%% printList2(File, List);
+%% printList2(File, SomethingElse) ->
+%% io:format(File, "Got: ~w~n", [SomethingElse]).
+
+%% optimizeDefine([#icode_call{dstlist=Var,'fun'=mktuple,args=Vs}|Code],
+%% Var, _, Res) ->
+%% case Vs of
+%% [_] ->
+%% {none, noOpt};
+%% _ ->
+%% optimizeDefine(Code, Var, Vs, Res)
+%% end;
+%% optimizeDefine([I=#icode_move{dst=Var, src=Src}|Code], [Var], Rets, Res) ->
+%% case hipe_icode:is_var(Src) of
+%% true ->
+%% optimizeDefine(Code, [Src], Rets, Res);
+%% false ->
+%% case Src of
+%% #icode_const{value={flat, Tuple}} when is_tuple(Tuple) ->
+%% optimizeDefine(Code, [Var], tuple_to_list(Tuple), [I|Res]);
+%% #icode_const{value={flat, _}} ->
+%% {none, noOpt};
+%% _ ->
+%% optimizeDefine(Code, [Var], Rets, [I|Res])
+%% end
+%% end;
+%% optimizeDefine([I|Code], Var, Rets, Res) ->
+%% optimizeDefine(Code, Var, Rets, [I|Res]);
+%% optimizeDefine([], Var, Rets, Res) ->
+%% case Rets of
+%% [] ->
+%% {none, Res, Var};
+%% _ ->
+%% {found, Res, Rets}
+%% end.
diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl
new file mode 100755
index 0000000000..575bbfe43d
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_pp.erl
@@ -0,0 +1,303 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2003 by Erik Stenman.
+%% ====================================================================
+%% Filename : hipe_icode_pp.erl
+%% Module : hipe_icode_pp
+%% Purpose : Pretty-printer for Icode.
+%% Notes :
+%% History : * 2003-04-16 (stenman@epfl.ch): Created.
+%% CVS :
+%% $Author$
+%% $Date$
+%% $Revision$
+%% ====================================================================
+%%
+%% @doc
+%% Icode Pretty-Printer.
+%% @end
+%%
+%% ====================================================================
+
+-module(hipe_icode_pp).
+
+-export([pp/1, pp/2, pp_block/1]).
+
+-ifdef(DEBUG_ICODE).
+-export([pp_instrs/2]).
+-endif.
+
+-include("hipe_icode.hrl").
+
+%%---------------------------------------------------------------------
+
+-spec pp(#icode{}) -> 'ok'.
+%% @doc Prettyprints linear Icode on stdout.
+%% <p> Badly formed or unknown instructions are printed surrounded
+%% by three stars "***".</p>
+pp(Icode) ->
+ pp(standard_io, Icode).
+
+-spec pp(io:device(), #icode{}) -> 'ok'.
+%% @doc Prettyprints linear Icode on IoDevice.
+%% <p> Badly formed or unknown instructions are printed surrounded by
+%% three stars "***".</p>
+pp(Dev, Icode) ->
+ {Mod, Fun, Arity} = hipe_icode:icode_fun(Icode),
+ Args = hipe_icode:icode_params(Icode),
+ io:format(Dev, "~w:~w/~w(", [Mod, Fun, Arity]),
+ pp_args(Dev, Args),
+ io:format(Dev, ") ->~n", []),
+ io:format(Dev, "%% Info:~p\n",
+ [[case hipe_icode:icode_is_closure(Icode) of
+ true -> 'Closure';
+ false -> 'Not a closure'
+ end,
+ case hipe_icode:icode_is_leaf(Icode) of
+ true -> 'Leaf function';
+ false -> 'Not a leaf function'
+ end |
+ hipe_icode:icode_info(Icode)]]),
+ pp_instrs(Dev, hipe_icode:icode_code(Icode)),
+ io:format(Dev, "%% Data:\n", []),
+ hipe_data_pp:pp(Dev, hipe_icode:icode_data(Icode), icode, "").
+
+-spec pp_block(icode_instrs()) -> 'ok'.
+pp_block(Code) ->
+ pp_instrs(standard_io, Code).
+
+-spec pp_instrs(io:device(), icode_instrs()) -> 'ok'.
+%% @doc Prettyprints a list of Icode instructions.
+pp_instrs(Dev, Is) ->
+ lists:foreach(fun (I) -> pp_instr(Dev, I) end, Is).
+
+%%---------------------------------------------------------------------
+
+pp_instr(Dev, I) ->
+ case I of
+ #icode_label{} ->
+ io:format(Dev, "~p:~n", [hipe_icode:label_name(I)]);
+ #icode_comment{} ->
+ Txt = hipe_icode:comment_text(I),
+ Str = case io_lib:deep_char_list(Txt) of
+ true -> Txt;
+ false -> io_lib:format("~p", [Txt])
+ end,
+ io:format(Dev, " % ~s~n", [Str]);
+ #icode_phi{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, hipe_icode:phi_dst(I)),
+ io:format(Dev, " := phi(", []),
+ pp_phi_args(Dev, hipe_icode:phi_arglist(I)),
+ io:format(Dev, ")~n", []);
+ #icode_move{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, hipe_icode:move_dst(I)),
+ io:format(Dev, " := ", []),
+ pp_arg(Dev, hipe_icode:move_src(I)),
+ io:format(Dev, "~n", []);
+ #icode_call{} ->
+ io:format(Dev, " ", []),
+ case hipe_icode:call_dstlist(I) of
+ [] -> %% result is unused -- e.g. taken out by dead code elimination
+ io:format(Dev, "_ := ", []);
+ DstList ->
+ pp_args(Dev, DstList),
+ io:format(Dev, " := ", [])
+ end,
+ pp_fun(Dev, hipe_icode:call_fun(I),
+ hipe_icode:call_args(I),
+ hipe_icode:call_type(I),
+ hipe_icode:call_in_guard(I)),
+ case hipe_icode:call_continuation(I) of
+ [] ->
+ ok;
+ CC ->
+ io:format(Dev, " -> ~w", [CC])
+ end,
+ case hipe_icode:call_fail_label(I) of
+ [] -> io:format(Dev, "~n", []);
+ Fail -> io:format(Dev, ", #fail ~w~n", [Fail])
+ end;
+ #icode_enter{} ->
+ io:format(Dev, " ", []),
+ pp_fun(Dev, hipe_icode:enter_fun(I),
+ hipe_icode:enter_args(I),
+ hipe_icode:enter_type(I)),
+ io:format(Dev, "~n", []);
+ #icode_return{} ->
+ io:format(Dev, " return(", []),
+ pp_args(Dev, hipe_icode:return_vars(I)),
+ io:format(Dev, ")~n", []);
+ #icode_begin_try{} ->
+ io:format(Dev, " begin_try -> ~w cont ~w~n",
+ [hipe_icode:begin_try_label(I),
+ hipe_icode:begin_try_successor(I)]);
+ #icode_begin_handler{} ->
+ io:format(Dev, " ", []),
+ pp_args(Dev, hipe_icode:begin_handler_dstlist(I)),
+ io:format(Dev, " := begin_handler()~n",[]);
+ #icode_end_try{} ->
+ io:format(Dev, " end_try~n", []);
+ #icode_fail{} ->
+ Type = hipe_icode:fail_class(I),
+ io:format(Dev, " fail(~w, [", [Type]),
+ pp_args(Dev, hipe_icode:fail_args(I)),
+ case hipe_icode:fail_label(I) of
+ [] -> io:put_chars(Dev, "])\n");
+ Fail -> io:format(Dev, "]) -> ~w\n", [Fail])
+ end;
+ #icode_if{} ->
+ io:format(Dev, " if ~w(", [hipe_icode:if_op(I)]),
+ pp_args(Dev, hipe_icode:if_args(I)),
+ io:format(Dev, ") then ~p (~.2f) else ~p~n",
+ [hipe_icode:if_true_label(I), hipe_icode:if_pred(I),
+ hipe_icode:if_false_label(I)]);
+ #icode_switch_val{} ->
+ io:format(Dev, " switch_val ",[]),
+ pp_arg(Dev, hipe_icode:switch_val_term(I)),
+ pp_switch_cases(Dev, hipe_icode:switch_val_cases(I)),
+ io:format(Dev, " fail -> ~w\n",
+ [hipe_icode:switch_val_fail_label(I)]);
+ #icode_switch_tuple_arity{} ->
+ io:format(Dev, " switch_tuple_arity ",[]),
+ pp_arg(Dev, hipe_icode:switch_tuple_arity_term(I)),
+ pp_switch_cases(Dev,hipe_icode:switch_tuple_arity_cases(I)),
+ io:format(Dev, " fail -> ~w\n",
+ [hipe_icode:switch_tuple_arity_fail_label(I)]);
+ #icode_type{} ->
+ io:format(Dev, " if is_", []),
+ pp_type(Dev, hipe_icode:type_test(I)),
+ io:format(Dev, "(", []),
+ pp_args(Dev, hipe_icode:type_args(I)),
+ io:format(Dev, ") then ~p (~.2f) else ~p~n",
+ [hipe_icode:type_true_label(I), hipe_icode:type_pred(I),
+ hipe_icode:type_false_label(I)]);
+ #icode_goto{} ->
+ io:format(Dev, " goto ~p~n", [hipe_icode:goto_label(I)])
+ end.
+
+pp_fun(Dev, Fun, Args, Type) ->
+ pp_fun(Dev, Fun, Args, Type, false).
+
+pp_fun(Dev, Fun, Args, Type, Guard) ->
+ case Type of
+ primop ->
+ hipe_icode_primops:pp(Dev, Fun);
+ local ->
+ {_,F,A} = Fun,
+ io:format(Dev, "~w/~w", [F, A]);
+ remote ->
+ {M,F,A} = Fun,
+ io:format(Dev, "~w:~w/~w", [M, F, A])
+ end,
+ io:format(Dev, "(", []),
+ pp_args(Dev, Args),
+ case Guard of
+ true ->
+ case Type of
+ primop ->
+ io:format(Dev, ") (primop,guard)", []);
+ _ ->
+ io:format(Dev, ") (guard)", [])
+ end;
+ false ->
+ case Type of
+ primop ->
+ io:format(Dev, ") (primop)", []);
+ _ ->
+ io:format(Dev, ")", [])
+ end
+ end.
+
+pp_arg(Dev, Arg) ->
+ case hipe_icode:is_variable(Arg) of
+ true ->
+ case hipe_icode:is_var(Arg) of
+ true ->
+ N = hipe_icode:var_name(Arg),
+ io:format(Dev, "v~p", [N]);
+ false ->
+ case hipe_icode:is_reg(Arg) of
+ true ->
+ N = hipe_icode:reg_name(Arg),
+ io:format(Dev, "r~p", [N]);
+ false ->
+ N = hipe_icode:fvar_name(Arg),
+ io:format(Dev, "fv~p", [N])
+ end
+ end,
+ case hipe_icode:is_annotated_variable(Arg) of
+ true ->
+ {_,Val,Fun} = hipe_icode:variable_annotation(Arg),
+ io:format(Dev, " (~s)", [Fun(Val)]);
+ false ->
+ ok
+ end;
+ false ->
+ Const = hipe_icode:const_value(Arg),
+ io:format(Dev, "~p", [Const]) % ~p because it also prints ""
+ end.
+
+pp_args(_Dev, []) -> ok;
+pp_args(Dev, [A]) ->
+ pp_arg(Dev, A);
+pp_args(Dev, [A|Args]) ->
+ pp_arg(Dev, A),
+ io:format(Dev, ", ", []),
+ pp_args(Dev, Args).
+
+pp_phi_args(_Dev, []) -> ok;
+pp_phi_args(Dev, [{Pred,A}]) ->
+ io:format(Dev, "{~w, ", [Pred]),
+ pp_arg(Dev, A),
+ io:format(Dev, "}", []);
+pp_phi_args(Dev, [{Pred,A}|Args]) ->
+ io:format(Dev, "{~w, ", [Pred]),
+ pp_arg(Dev, A),
+ io:format(Dev, "}, ", []),
+ pp_phi_args(Dev, Args).
+
+pp_type(Dev, T) ->
+ io:format(Dev, "~w", [T]).
+
+pp_switch_cases(Dev, Cases) ->
+ io:format(Dev, " of\n",[]),
+ pp_switch_cases(Dev, Cases,1),
+ io:format(Dev, "",[]).
+
+pp_switch_cases(Dev, [{Val,L}], _Pos) ->
+ io:format(Dev, " ",[]),
+ pp_arg(Dev, Val),
+ io:format(Dev, " -> ~w\n", [L]);
+pp_switch_cases(Dev, [{Val, L}|Ls], Pos) ->
+ io:format(Dev, " ",[]),
+ pp_arg(Dev, Val),
+ io:format(Dev, " -> ~w;\n", [L]),
+ NewPos = Pos,
+ %% case Pos of
+ %% 5 -> io:format(Dev, "\n ",[]),
+ %% 0;
+ %% N -> N + 1
+ %% end,
+ pp_switch_cases(Dev, Ls, NewPos);
+pp_switch_cases(_Dev, [], _) -> ok.
+
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
new file mode 100644
index 0000000000..b0fe7eb708
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -0,0 +1,963 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Filename : hipe_icode_primops.erl
+%% Module : hipe_icode_primops
+%% Purpose :
+%% Notes :
+%% History : * 2001-06-13 Erik Johansson (happi@it.uu.se):
+%% Created.
+%%
+%% $Id$
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_icode_primops).
+
+-export([is_safe/1, fails/1, pp/2, type/1, type/2, arg_types/1]).
+
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+
+%%---------------------------------------------------------------------
+
+%% Note that 'unsafe_...' operations are generally "safe", i.e., it is
+%% typically unsafe to use them unless you have extra information about
+%% the call (e.g., if the types are known). However, if they have been
+%% correctly introduced in the code, most of them are also OK to remove
+%% if the result is not used.
+
+-spec is_safe(icode_primop()) -> boolean().
+
+is_safe('+') -> false;
+is_safe('/') -> false;
+is_safe('*') -> false;
+is_safe('-') -> false;
+is_safe('bsr') -> false;
+is_safe('bsl') -> false;
+is_safe('band') -> false;
+is_safe('bor') -> false;
+is_safe('bxor') -> false;
+is_safe('bnot') -> false;
+is_safe('div') -> false;
+is_safe('rem') -> false;
+is_safe(call_fun) -> false;
+is_safe(check_get_msg) -> false;
+is_safe(clear_timeout) -> false;
+is_safe(cons) -> true;
+%% is_safe(conv_to_float) -> false;
+is_safe(extra_unsafe_add) -> true;
+is_safe(extra_unsafe_sub) -> true;
+is_safe(fcheckerror) -> false;
+is_safe(fclearerror) -> false;
+is_safe(fp_add) -> false;
+is_safe(fp_div) -> false;
+is_safe(fp_mul) -> false;
+is_safe(fp_sub) -> false;
+is_safe(mktuple) -> true;
+is_safe(next_msg) -> false;
+is_safe(redtest) -> false;
+is_safe(select_msg) -> false;
+is_safe(self) -> true;
+is_safe(set_timeout) -> false;
+is_safe(suspend_msg) -> false;
+is_safe(unsafe_add) -> true;
+is_safe(unsafe_band) -> true;
+is_safe(unsafe_bnot) -> true;
+is_safe(unsafe_bor) -> true;
+is_safe(unsafe_bsl) -> true;
+is_safe(unsafe_bsr) -> true;
+is_safe(unsafe_bxor) -> true;
+is_safe(unsafe_hd) -> true;
+is_safe(unsafe_sub) -> true;
+is_safe(unsafe_tag_float) -> true;
+is_safe(unsafe_tl) -> true;
+is_safe(unsafe_untag_float) -> true;
+is_safe(#apply_N{}) -> false;
+is_safe(#closure_element{}) -> true;
+is_safe(#element{}) -> false;
+%% is_safe(#gc_test{}) -> ???
+is_safe({hipe_bs_primop, {bs_start_match, _}}) -> false;
+is_safe({hipe_bs_primop, {{bs_start_match, bitstr}, _}}) -> true;
+is_safe({hipe_bs_primop, {{bs_start_match, ok_matchstate}, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_get_binary, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_get_binary_all, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_get_binary_all_2, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_get_integer, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_get_float, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_skip_bits, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_skip_bits_all, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_test_tail, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_restore, _}}) -> true;
+is_safe({hipe_bs_primop, {bs_save, _}}) -> true;
+is_safe({hipe_bs_primop, {bs_add, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_add, _, _}}) -> false;
+is_safe({hipe_bs_primop, bs_bits_to_bytes}) -> false;
+is_safe({hipe_bs_primop, bs_bits_to_bytes2}) -> false;
+is_safe({hipe_bs_primop, {bs_init, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false;
+is_safe({hipe_bs_primop, bs_put_utf8}) -> false;
+is_safe({hipe_bs_primop, bs_utf8_size}) -> true;
+is_safe({hipe_bs_primop, bs_get_utf8}) -> false;
+is_safe({hipe_bs_primop, bs_utf16_size}) -> true;
+is_safe({hipe_bs_primop, {bs_put_utf16, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_get_utf16, _}}) -> false;
+is_safe({hipe_bs_primop, bs_validate_unicode}) -> false;
+is_safe({hipe_bs_primop, bs_validate_unicode_retract}) -> false;
+is_safe({hipe_bs_primop, {unsafe_bs_put_integer, _, _, _}}) -> false;
+is_safe({hipe_bs_primop, bs_final}) -> true;
+is_safe({hipe_bs_primop, bs_context_to_binary}) -> true;
+is_safe({hipe_bs_primop, {bs_test_unit, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_match_string, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_append, _, _, _, _}}) -> false;
+is_safe({hipe_bs_primop, {bs_private_append, _, _}}) -> false;
+is_safe({hipe_bs_primop, bs_init_writable}) -> true;
+is_safe(#mkfun{}) -> true;
+is_safe(#unsafe_element{}) -> true;
+is_safe(#unsafe_update_element{}) -> true.
+
+
+-spec fails(icode_funcall()) -> boolean().
+
+fails('+') -> true;
+fails('-') -> true;
+fails('*') -> true;
+fails('/') -> true;
+fails('bnot') -> true;
+fails('band') -> true;
+fails('bor') -> true;
+fails('bsl') -> true;
+fails('bsr') -> true;
+fails('bxor') -> true;
+fails('div') -> true;
+fails('rem') -> true;
+fails(call_fun) -> true;
+fails(check_get_msg) -> true;
+fails(clear_timeout) -> false;
+fails(cons) -> false;
+fails(conv_to_float) -> true;
+fails(extra_unsafe_add) -> false;
+fails(extra_unsafe_sub) -> false;
+fails(fcheckerror) -> true;
+fails(fclearerror) -> false;
+fails(fp_add) -> false;
+fails(fp_div) -> false;
+fails(fp_mul) -> false;
+fails(fp_sub) -> false;
+fails(mktuple) -> false;
+fails(next_msg) -> false;
+fails(redtest) -> false;
+fails(select_msg) -> false;
+fails(self) -> false;
+fails(set_timeout) -> true;
+fails(suspend_msg) -> false;
+fails(unsafe_untag_float) -> false;
+fails(unsafe_tag_float) -> false;
+fails(unsafe_add) -> false;
+fails(unsafe_band) -> false;
+fails(unsafe_bnot) -> false;
+fails(unsafe_bor) -> false;
+fails(unsafe_bsl) -> false;
+fails(unsafe_bsr) -> false;
+fails(unsafe_bxor) -> false;
+fails(unsafe_hd) -> false;
+fails(unsafe_sub) -> false;
+%% fails(unsafe_tag_float) -> false;
+fails(unsafe_tl) -> false;
+%% fails(unsafe_untag_float) -> false;
+fails(#apply_N{}) -> true;
+fails(#closure_element{}) -> false;
+fails(#element{}) -> true;
+%% fails(#gc_test{}) -> ???
+fails({hipe_bs_primop, {bs_start_match, _}}) -> true;
+fails({hipe_bs_primop, {{bs_start_match, bitstr}, _}}) -> true;
+fails({hipe_bs_primop, {{bs_start_match, ok_matchstate}, _}}) -> false;
+fails({hipe_bs_primop, {bs_get_binary, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_get_binary_all, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_get_binary_all_2, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_get_integer, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_get_float, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_skip_bits, _}}) -> true;
+fails({hipe_bs_primop, {bs_skip_bits_all, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_test_tail, _}}) -> true;
+fails({hipe_bs_primop, {bs_restore, _}}) -> false;
+fails({hipe_bs_primop, {bs_save, _}}) -> false;
+fails({hipe_bs_primop, bs_context_to_binary}) -> false;
+fails({hipe_bs_primop, {bs_test_unit, _}}) -> true;
+fails({hipe_bs_primop, {bs_match_string, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_add, _}}) -> true;
+fails({hipe_bs_primop, {bs_add, _, _}}) -> true;
+fails({hipe_bs_primop, bs_bits_to_bytes}) -> true;
+fails({hipe_bs_primop, bs_bits_to_bytes2}) -> true;
+fails({hipe_bs_primop, {bs_init, _}}) -> true;
+fails({hipe_bs_primop, {bs_init, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_init_bits, _}}) -> true;
+fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true;
+fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true;
+fails({hipe_bs_primop, bs_put_utf8}) -> true;
+fails({hipe_bs_primop, bs_utf8_size}) -> false;
+fails({hipe_bs_primop, bs_get_utf8}) -> true;
+fails({hipe_bs_primop, bs_utf16_size}) -> false;
+fails({hipe_bs_primop, {bs_put_utf16, _}}) -> true;
+fails({hipe_bs_primop, {bs_get_utf16, _}}) -> true;
+fails({hipe_bs_primop, bs_validate_unicode}) -> true;
+fails({hipe_bs_primop, bs_validate_unicode_retract}) -> true;
+fails({hipe_bs_primop, {unsafe_bs_put_integer, _, _, _}}) -> true;
+fails({hipe_bs_primop, bs_final}) -> false;
+fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true;
+fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true;
+fails({hipe_bs_primop, bs_init_writable}) -> true;
+fails(#mkfun{}) -> false;
+fails(#unsafe_element{}) -> false;
+fails(#unsafe_update_element{}) -> false;
+%% Apparently, we are calling fails/1 for all MFAs which are compiled.
+%% This is weird and we should restructure the compiler to avoid
+%% calling fails/1 for things that are not primops.
+fails({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 ->
+ %% Yes, we should move this.
+ not erl_bifs:is_safe(M, F, A).
+
+%%=====================================================================
+%% Pretty printing
+%%=====================================================================
+
+-spec pp(io:device(), icode_primop()) -> 'ok'.
+
+pp(Dev, Op) ->
+ case Op of
+ #apply_N{arity = N} ->
+ io:format(Dev, "apply_N<~w>/", [N]);
+ #closure_element{n = N} ->
+ io:format(Dev, "closure_element<~w>", [N]);
+ #element{} ->
+ io:format(Dev, "element", []);
+ #gc_test{need = N} ->
+ io:format(Dev, "gc_test<~w>", [N]);
+ {hipe_bs_primop, BsOp} ->
+ case BsOp of
+ {bs_put_binary_all, Flags} ->
+ io:format(Dev, "bs_put_binary_all<~w>", [Flags]);
+ {bs_put_binary, Size} ->
+ io:format(Dev, "bs_put_binary<~w>", [Size]);
+ {bs_put_binary, Flags, Size} ->
+ io:format(Dev, "bs_put_binary<~w, ~w>", [Flags, Size]);
+ {bs_put_float, Flags, Size, _ConstInfo} ->
+ io:format(Dev, "bs_put_float<~w, ~w>", [Flags, Size]);
+ {bs_put_string, String, SizeInBytes} ->
+ io:format(Dev, "bs_put_string<~w, ~w>", [String, SizeInBytes]);
+ {bs_put_integer, Bits, Flags, _ConstInfo} ->
+ io:format(Dev, "bs_put_integer<~w, ~w>", [Bits, Flags]);
+ {unsafe_bs_put_integer, Bits, Flags, _ConstInfo} ->
+ io:format(Dev, "unsafe_bs_put_integer<~w, ~w>", [Bits, Flags]);
+ {bs_skip_bits_all, Unit, Flags} ->
+ io:format(Dev, "bs_skip_bits_all<~w,~w>", [Unit, Flags]);
+ {bs_skip_bits, Unit} ->
+ io:format(Dev, "bs_skip_bits<~w>", [Unit]);
+ {bs_start_match, Max} ->
+ io:format(Dev, "bs_start_match<~w>", [Max]);
+ {{bs_start_match, Type}, Max} ->
+ io:format(Dev, "bs_start_match<~w,~w>", [Type,Max]);
+ {bs_match_string, String, SizeInBytes} ->
+ io:format(Dev, "bs_match_string<~w, ~w>", [String, SizeInBytes]);
+ {bs_get_integer, Size, Flags} ->
+ io:format(Dev, "bs_get_integer<~w, ~w>", [Size, Flags]);
+ {bs_get_float, Size, Flags} ->
+ io:format(Dev, "bs_get_float<~w, ~w>", [Size, Flags]);
+ {bs_get_binary, Size, Flags} ->
+ io:format(Dev, "bs_get_binary<~w, ~w>", [Size, Flags]);
+ {bs_get_binary_all, Unit, Flags} ->
+ io:format(Dev, "bs_get_binary_all<~w,~w>", [Unit, Flags]);
+ {bs_get_binary_all_2, Unit, Flags} ->
+ io:format(Dev, "bs_get_binary_all<~w,~w>", [Unit, Flags]);
+ {bs_test_tail, NumBits} ->
+ io:format(Dev, "bs_test_tail<~w>", [NumBits]);
+ {bs_test_unit, Unit} ->
+ io:format(Dev, "bs_test_unit<~w>", [Unit]);
+ bs_context_to_binary ->
+ io:format(Dev, "bs_context_to_binary", []);
+ {bs_restore, Index} ->
+ io:format(Dev, "bs_restore<~w>", [Index]);
+ {bs_save, Index} ->
+ io:format(Dev, "bs_save<~w>", [Index]);
+ {bs_init, Size, Flags} ->
+ io:format(Dev, "bs_init<~w, ~w>", [Size, Flags]);
+ {bs_init,Flags} ->
+ io:format(Dev, "bs_init<~w>", [Flags]);
+ {bs_init_bits, Size, Flags} ->
+ io:format(Dev, "bs_init_bits<~w, ~w>", [Size, Flags]);
+ {bs_init_bits, Flags} ->
+ io:format(Dev, "bs_init_bits<~w>", [Flags]);
+ {bs_add, Unit} ->
+ io:format(Dev, "bs_add<~w>", [Unit]);
+ {bs_add, Const, Unit} ->
+ io:format(Dev, "bs_add<~w, ~w>", [Const, Unit]);
+ {bs_append, X, Y, Z, W} ->
+ io:format(Dev, "bs_append<~w, ~w, ~w, ~w>", [X, Y, Z, W]);
+ {bs_private_append, U, Flags} ->
+ io:format(Dev, "bs_private_append<~w, ~w>", [U, Flags]);
+ bs_bits_to_bytes ->
+ io:format(Dev, "bs_bits_to_bytes", []);
+ bs_bits_to_bytes2 ->
+ io:format(Dev, "bs_bits_to_bytes2", []);
+ bs_utf8_size ->
+ io:format(Dev, "bs_utf8_size", []);
+ bs_put_utf8 ->
+ io:format(Dev, "bs_put_utf8", []);
+ bs_get_utf8 ->
+ io:format(Dev, "bs_get_utf8", []);
+ bs_utf16_size ->
+ io:format(Dev, "bs_utf16_size", []);
+ {bs_put_utf16, Flags} ->
+ io:format(Dev, "bs_put_utf16<~w>", [Flags]);
+ {bs_get_utf16, Flags} ->
+ io:format(Dev, "bs_get_utf16<~w>", [Flags]);
+ bs_validate_unicode ->
+ io:format(Dev, "bs_validate_unicode", []);
+ bs_validate_unicode_retract ->
+ io:format(Dev, "bs_validate_unicode_retract", []);
+ bs_final ->
+ io:format(Dev, "bs_final", []);
+ bs_final2 ->
+ io:format(Dev, "bs_final2", []);
+ bs_init_writable ->
+ io:format(Dev, "bs_init_writable", [])
+ end;
+ #mkfun{mfa = {Mod, Fun, Arity}, magic_num = Unique, index = I} ->
+ io:format(Dev, "mkfun<~w,~w,~w,~w,~w>", [Mod, Fun, Arity, Unique, I]);
+ #unsafe_element{index = N} ->
+ io:format(Dev, "unsafe_element<~w>", [N]);
+ #unsafe_update_element{index = N} ->
+ io:format(Dev, "unsafe_update_element<~w>", [N]);
+ Fun when is_atom(Fun) ->
+ io:format(Dev, "~w", [Fun])
+ end.
+
+%%=====================================================================
+%% Type handling
+%%=====================================================================
+
+-spec type(icode_funcall(), [erl_types:erl_type()]) -> erl_types:erl_type().
+
+type(Primop, Args) ->
+ case Primop of
+%%% -----------------------------------------------------
+%%% Arithops
+ '+' ->
+ erl_bif_types:type(erlang, '+', 2, Args);
+ '-' ->
+ erl_bif_types:type(erlang, '-', 2, Args);
+ '*' ->
+ erl_bif_types:type(erlang, '*', 2, Args);
+ '/' ->
+ erl_bif_types:type(erlang, '/', 2, Args);
+ 'band' ->
+ erl_bif_types:type(erlang, 'band', 2, Args);
+ 'bnot' ->
+ erl_bif_types:type(erlang, 'bnot', 1, Args);
+ 'bor' ->
+ erl_bif_types:type(erlang, 'bor', 2, Args);
+ 'bxor' ->
+ erl_bif_types:type(erlang, 'bxor', 2, Args);
+ 'bsl' ->
+ erl_bif_types:type(erlang, 'bsl', 2, Args);
+ 'bsr' ->
+ erl_bif_types:type(erlang, 'bsr', 2, Args);
+ 'div' ->
+ erl_bif_types:type(erlang, 'div', 2, Args);
+ 'rem' ->
+ erl_bif_types:type(erlang, 'rem', 2, Args);
+ extra_unsafe_add ->
+ erl_bif_types:type(erlang, '+', 2, Args);
+ unsafe_add ->
+ erl_bif_types:type(erlang, '+', 2, Args);
+ unsafe_bnot ->
+ erl_bif_types:type(erlang, 'bnot', 1, Args);
+ unsafe_bor ->
+ erl_bif_types:type(erlang, 'bor', 2, Args);
+ unsafe_band ->
+ erl_bif_types:type(erlang, 'band', 2, Args);
+ unsafe_bxor ->
+ erl_bif_types:type(erlang, 'bxor', 2, Args);
+ unsafe_sub ->
+ erl_bif_types:type(erlang, '-', 2, Args);
+%%% -----------------------------------------------------
+%%% Lists
+ cons ->
+ [HeadType, TailType] = Args,
+ erl_types:t_cons(HeadType, TailType);
+ unsafe_hd ->
+ [Type] = Args,
+ case erl_types:t_is_cons(Type) of
+ true -> erl_types:t_cons_hd(Type);
+ false -> erl_types:t_none()
+ end;
+ unsafe_tl ->
+ [Type] = Args,
+ case erl_types:t_is_cons(Type) of
+ true -> erl_types:t_cons_tl(Type);
+ false -> erl_types:t_none()
+ end;
+%%% -----------------------------------------------------
+%%% Tuples
+ mktuple ->
+ erl_types:t_tuple(Args);
+ #element{} ->
+ erl_bif_types:type(erlang, element, 2, Args);
+ #unsafe_element{index = N} ->
+ [Type] = Args,
+ case erl_types:t_is_tuple(Type) of
+ false ->
+ erl_types:t_none();
+ true ->
+ Index = erl_types:t_from_term(N),
+ erl_bif_types:type(erlang, element, 2, [Index|Args])
+ end;
+ #unsafe_update_element{index = N} ->
+ %% Same, same
+ erl_bif_types:type(erlang, setelement, 3, [erl_types:t_integer(N)|Args]);
+%%% -----------------------------------------------------
+%%% Floats
+ fclearerror ->
+ erl_types:t_any();
+ fcheckerror ->
+ erl_types:t_any();
+ unsafe_tag_float ->
+ erl_types:t_float();
+ %% These might look surprising, but the return is an untagged
+ %% float and we have no type for untagged values.
+ conv_to_float ->
+ erl_types:t_any();
+ unsafe_untag_float ->
+ erl_types:t_any();
+ fp_add ->
+ erl_types:t_any();
+ fp_sub ->
+ erl_types:t_any();
+ fp_mul ->
+ erl_types:t_any();
+ fp_div ->
+ erl_types:t_any();
+ fnegate ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%%
+ {hipe_bs_primop, {bs_start_match, Max}} ->
+ [Type] = Args,
+ Init =
+ erl_types:t_sup(
+ erl_types:t_matchstate_present(Type),
+ erl_types:t_inf(erl_types:t_bitstr(1, 0), Type)),
+ case erl_types:t_is_none(Init) of
+ true ->
+ erl_types:t_none();
+ false ->
+ erl_types:t_matchstate(Init, Max)
+ end;
+ {hipe_bs_primop, {{bs_start_match, _}, Max}} ->
+ [Type] = Args,
+ Init =
+ erl_types:t_sup(
+ erl_types:t_matchstate_present(Type),
+ erl_types:t_inf(erl_types:t_bitstr(1, 0), Type)),
+ case erl_types:t_is_none(Init) of
+ true ->
+ erl_types:t_none();
+ false ->
+ erl_types:t_matchstate(Init, Max)
+ end;
+ {hipe_bs_primop, {bs_get_integer, Size, Flags}} ->
+ Signed = Flags band 4,
+ [MatchState|RestArgs] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ case RestArgs of
+ [] ->
+ NewBinType = match_bin(erl_types:t_bitstr(0, Size), BinType),
+ NewMatchState =
+ erl_types:t_matchstate_update_present(NewBinType, MatchState),
+ if Signed =:= 0 ->
+ erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1),
+ NewMatchState]);
+ Signed =:= 4 ->
+ erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)),
+ (1 bsl (Size-1)) - 1),
+ NewMatchState])
+ end;
+ [_Arg] ->
+ NewBinType = match_bin(erl_types:t_bitstr(Size, 0), BinType),
+ NewMatchState =
+ erl_types:t_matchstate_update_present(NewBinType, MatchState),
+ erl_types:t_product([erl_types:t_integer(), NewMatchState])
+ end;
+ {hipe_bs_primop, {bs_get_float, Size, _Flags}} ->
+ [MatchState|RestArgs] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ NewBinType =
+ case RestArgs of
+ [] ->
+ match_bin(erl_types:t_bitstr(0,Size),BinType);
+ [_Arg] ->
+ erl_types:t_sup(match_bin(erl_types:t_bitstr(0, 32), BinType),
+ match_bin(erl_types:t_bitstr(0, 64), BinType))
+ end,
+ NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState),
+ erl_types:t_product([erl_types:t_float(), NewMatchState]);
+ {hipe_bs_primop, {bs_get_binary, Size, _Flags}} ->
+ [MatchState|RestArgs] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ case RestArgs of
+ [] ->
+ NewBinType = match_bin(erl_types:t_bitstr(0, Size), BinType),
+ NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState),
+ erl_types:t_product([erl_types:t_bitstr(0,Size), NewMatchState]);
+ [ArgType] ->
+ Posint = erl_types:t_inf(erl_types:t_non_neg_integer(), ArgType),
+ case erl_types:t_is_none(Posint) of
+ true ->
+ erl_types:t_product([erl_types:t_none(),
+ erl_types:t_matchstate_update_present(
+ erl_types:t_none(),
+ MatchState)]);
+ false ->
+ OutBinType =
+ erl_types:t_bitstr(Size,erl_types:number_min(Posint)*Size),
+ NewBinType = match_bin(OutBinType,BinType),
+ NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState),
+ erl_types:t_product([OutBinType, NewMatchState])
+ end
+ end;
+ {hipe_bs_primop, {bs_get_binary_all, Unit, _Flags}} ->
+ [MatchState] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ erl_types:t_inf(BinType, erl_types:t_bitstr(Unit, 0));
+ {hipe_bs_primop, {bs_get_binary_all_2, Unit, _Flags}} ->
+ [MatchState] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ erl_types:t_product(
+ [erl_types:t_inf(BinType,erl_types:t_bitstr(Unit, 0)),
+ erl_types:t_matchstate_update_present(
+ erl_types:t_bitstr(0, 0), MatchState)]);
+ {hipe_bs_primop, {bs_skip_bits_all, _Unit, _Flags}} ->
+ [MatchState] = Args,
+ erl_types:t_matchstate_update_present(erl_types:t_bitstr(0,0),MatchState);
+ {hipe_bs_primop, {bs_skip_bits, Size}} ->
+ [MatchState|RestArgs] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ NewBinType =
+ case RestArgs of
+ [] ->
+ match_bin(erl_types:t_bitstr(0, Size), BinType);
+ [_Arg] ->
+ match_bin(erl_types:t_bitstr(Size, 0), BinType)
+ end,
+ erl_types:t_matchstate_update_present(NewBinType, MatchState);
+ {hipe_bs_primop, {bs_save, Slot}} ->
+ [MatchState] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ erl_types:t_matchstate_update_slot(BinType, MatchState, Slot);
+ {hipe_bs_primop, {bs_restore, Slot}} ->
+ [MatchState] = Args,
+ BinType = erl_types:t_matchstate_slot(MatchState, Slot),
+ erl_types:t_matchstate_update_present(BinType, MatchState);
+ {hipe_bs_primop, bs_context_to_binary} ->
+ [Type] = Args,
+ erl_types:t_sup(
+ erl_types:t_subtract(Type, erl_types:t_matchstate()),
+ erl_types:t_matchstate_slot(
+ erl_types:t_inf(Type, erl_types:t_matchstate()), 0));
+ {hipe_bs_primop, {bs_match_string,_,Bytes}} ->
+ [MatchState] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ NewBinType = match_bin(erl_types:t_bitstr(0, Bytes*8), BinType),
+ erl_types:t_matchstate_update_present(NewBinType, MatchState);
+ {hipe_bs_primop, {bs_test_unit,Unit}} ->
+ [MatchState] = Args,
+ BinType = erl_types:t_matchstate_present(MatchState),
+ NewBinType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), BinType),
+ erl_types:t_matchstate_update_present(NewBinType, MatchState);
+ {hipe_bs_primop, {bs_add, _, _}} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, {bs_add, _}} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, bs_bits_to_bytes} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, bs_bits_to_bytes2} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, {Name, Size, _Flags, _ConstInfo}}
+ when Name =:= bs_put_integer;
+ Name =:= bs_put_float ->
+ case Args of
+ [_SrcType, _Base, Type] ->
+ erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(0, Size));
+ [_SrcType,_BitsType, _Base, Type] ->
+ erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0))
+ end;
+ {hipe_bs_primop, {bs_put_binary, Size, _Flags}} ->
+ case Args of
+ [_SrcType, _Base, Type] ->
+ erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(0, Size));
+ [_SrcType, _BitsType, _Base, Type] ->
+ erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0))
+ end;
+ {hipe_bs_primop, {bs_put_binary_all, _Flags}} ->
+ [SrcType, _Base, Type] = Args,
+ erl_types:t_bitstr_concat(SrcType,Type);
+ {hipe_bs_primop, {bs_put_string, _, Size}} ->
+ [_Base, Type] = Args,
+ erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(0, 8*Size));
+ {hipe_bs_primop, bs_utf8_size} ->
+ [_Arg] = Args,
+ erl_types:t_from_range(1, 4);
+ {hipe_bs_primop, bs_utf16_size} ->
+ [_Arg] = Args,
+ erl_types:t_from_range(2, 4); % XXX: really 2 | 4
+ {hipe_bs_primop, bs_final} ->
+ [_Base, Type] = Args,
+ Type;
+ {hipe_bs_primop, {bs_init, Size, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(0, Size*8),
+ erl_types:t_any(),
+ erl_types:t_bitstr(0, 0)]);
+ {hipe_bs_primop, {bs_init, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_binary(),
+ erl_types:t_any(),
+ erl_types:t_bitstr(0, 0)]);
+ {hipe_bs_primop, {bs_init_bits, Size, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(0, Size),
+ erl_types:t_any(),
+ erl_types:t_bitstr(0, 0)]);
+ {hipe_bs_primop, {bs_init_bits, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(),
+ erl_types:t_any(),
+ erl_types:t_bitstr(0, 0)]);
+ {hipe_bs_primop, {bs_private_append, _U, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(),
+ erl_types:t_any(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, {bs_append, _W, _R, _U, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(),
+ erl_types:t_any(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, bs_init_writable} ->
+ erl_types:t_bitstr(0, 0);
+ {hipe_bs_primop, _BsOp} ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%% Funs
+ #mkfun{mfa = {_M, _F, A}} ->
+ %% Note that the arity includes the bound variables in args
+ erl_types:t_fun(A - length(Args), erl_types:t_any());
+ #apply_N{} ->
+ erl_types:t_any();
+ Op when Op =:= call_fun orelse Op =:= enter_fun ->
+ [Fun0|TailArgs0] = lists:reverse(Args),
+ TailArgs = lists:reverse(TailArgs0),
+ Fun = erl_types:t_inf(erl_types:t_fun(), Fun0),
+ case erl_types:t_is_fun(Fun) of
+ true ->
+ case erl_types:t_fun_args(Fun) of
+ unknown ->
+ erl_types:t_any();
+ FunArgs ->
+ case check_fun_args(FunArgs, TailArgs) of
+ ok ->
+ erl_types:t_fun_range(Fun);
+ error ->
+ erl_types:t_none()
+ end
+ end;
+ false ->
+ erl_types:t_none()
+ end;
+%%% -----------------------------------------------------
+%%% Communication
+ check_get_msg ->
+ erl_types:t_any();
+ clear_timeout ->
+ erl_types:t_any();
+ next_msg ->
+ erl_types:t_any();
+ select_msg ->
+ erl_types:t_any();
+ set_timeout ->
+ erl_types:t_any();
+ suspend_msg ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%% Other
+ #closure_element{} ->
+ erl_types:t_any();
+ redtest ->
+ erl_types:t_any();
+ {M, F, A} ->
+ erl_bif_types:type(M, F, A, Args)
+ end.
+
+
+-spec type(icode_funcall()) -> erl_types:erl_type().
+
+type(Primop) ->
+ case Primop of
+%%% -----------------------------------------------------
+%%% Arithops
+ 'bnot' ->
+ erl_bif_types:type(erlang, 'bnot', 1);
+ '+' ->
+ erl_bif_types:type(erlang, '+', 2);
+ '-' ->
+ erl_bif_types:type(erlang, '-', 2);
+ '*' ->
+ erl_bif_types:type(erlang, '*', 2);
+ '/' ->
+ erl_bif_types:type(erlang, '/', 2);
+ 'div' ->
+ erl_bif_types:type(erlang, 'div', 2);
+ 'rem' ->
+ erl_bif_types:type(erlang, 'rem', 2);
+ 'band' ->
+ erl_bif_types:type(erlang, 'band', 2);
+ 'bor' ->
+ erl_bif_types:type(erlang, 'bor', 2);
+ 'bxor' ->
+ erl_bif_types:type(erlang, 'bxor', 2);
+ 'bsr' ->
+ erl_bif_types:type(erlang, 'bsr', 2);
+ 'bsl' ->
+ erl_bif_types:type(erlang, 'bsl', 2);
+ unsafe_add ->
+ erl_bif_types:type(erlang, '+', 2);
+ extra_unsafe_add ->
+ erl_bif_types:type(erlang, '+', 2);
+ unsafe_sub ->
+ erl_bif_types:type(erlang, '-', 2);
+ unsafe_bor ->
+ erl_bif_types:type(erlang, 'bor', 2);
+ unsafe_band ->
+ erl_bif_types:type(erlang, 'band', 2);
+ unsafe_bxor ->
+ erl_bif_types:type(erlang, 'bxor', 2);
+%%% -----------------------------------------------------
+%%% Lists
+ cons ->
+ erl_types:t_cons();
+ unsafe_hd ->
+ erl_bif_types:type(erlang, hd, 1);
+ unsafe_tl ->
+ erl_bif_types:type(erlang, tl, 1);
+%%% -----------------------------------------------------
+%%% Tuples
+ mktuple ->
+ erl_types:t_tuple();
+ #element{} ->
+ erl_bif_types:type(erlang, element, 2);
+ #unsafe_element{} ->
+ erl_bif_types:type(erlang, element, 2);
+ #unsafe_update_element{} ->
+ erl_bif_types:type(erlang, setelement, 3);
+%%% -----------------------------------------------------
+%%% Floats
+ fclearerror ->
+ erl_types:t_any();
+ fcheckerror ->
+ erl_types:t_any();
+ unsafe_tag_float ->
+ erl_types:t_float();
+ %% These might look surprising, but the return is an untagged
+ %% float and we have no type for untagged values.
+ conv_to_float ->
+ erl_types:t_any();
+ unsafe_untag_float ->
+ erl_types:t_any();
+ fp_add ->
+ erl_types:t_any();
+ fp_sub ->
+ erl_types:t_any();
+ fp_mul ->
+ erl_types:t_any();
+ fp_div ->
+ erl_types:t_any();
+ fnegate ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%% Binaries
+ {hipe_bs_primop, bs_get_utf8} ->
+ erl_types:t_product([erl_types:t_integer(), erl_types:t_matchstate()]);
+ {hipe_bs_primop, {bs_get_utf16, _Flags}} ->
+ erl_types:t_product([erl_types:t_integer(), erl_types:t_matchstate()]);
+ {hipe_bs_primop, {bs_get_integer, _Size, _Flags}} ->
+ erl_types:t_product([erl_types:t_integer(), erl_types:t_matchstate()]);
+ {hipe_bs_primop, {bs_get_float, _, _}} ->
+ erl_types:t_product([erl_types:t_float(), erl_types:t_matchstate()]);
+ {hipe_bs_primop, {bs_get_binary, _, _}} ->
+ erl_types:t_product([erl_types:t_bitstr(), erl_types:t_matchstate()]);
+ {hipe_bs_primop, {bs_get_binary_all, _, _}} ->
+ erl_types:t_bitstr();
+ {hipe_bs_primop, {bs_get_binary_all_2, _, _}} ->
+ erl_types:t_product([erl_types:t_bitstr(), erl_types:t_matchstate()]);
+ {hipe_bs_primop, bs_final} ->
+ erl_types:t_bitstr();
+ {hipe_bs_primop, {bs_init, _, _}} ->
+ erl_types:t_product([erl_types:t_binary(), erl_types:t_bitstr(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, {bs_init, _}} ->
+ erl_types:t_product([erl_types:t_binary(), erl_types:t_bitstr(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, {bs_init_bits, Size, _}} ->
+ erl_types:t_product([erl_types:t_bitstr(0, Size), erl_types:t_bitstr(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, {bs_init_bits, _}} ->
+ erl_types:t_product([erl_types:t_bitstr(), erl_types:t_bitstr(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, {bs_add, _, _}} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, {bs_add, _}} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, bs_bits_to_bytes} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, bs_bits_to_bytes2} ->
+ erl_types:t_integer();
+ {hipe_bs_primop, {bs_private_append, _U, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(),
+ erl_types:t_any(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, {bs_append, _W, _R, _U, _Flags}} ->
+ erl_types:t_product(
+ [erl_types:t_bitstr(),
+ erl_types:t_any(),
+ erl_types:t_bitstr()]);
+ {hipe_bs_primop, bs_init_writable} ->
+ erl_types:t_bitstr();
+ {hipe_bs_primop, _BsOp} ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%% Funs
+ #mkfun{} ->
+ %% Note that the arity includes the bound variables in args
+ erl_types:t_fun();
+ #apply_N{} ->
+ erl_types:t_any();
+ call_fun ->
+ erl_types:t_any();
+ enter_fun ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%% Communication
+ check_get_msg ->
+ erl_types:t_any();
+ clear_timeout ->
+ erl_types:t_any();
+ next_msg ->
+ erl_types:t_any();
+ select_msg ->
+ erl_types:t_any();
+ set_timeout ->
+ erl_types:t_any();
+ suspend_msg ->
+ erl_types:t_any();
+%%% -----------------------------------------------------
+%%% Other
+ #closure_element{} ->
+ erl_types:t_any();
+ redtest ->
+ erl_types:t_any();
+ {M, F, A} ->
+ erl_bif_types:type(M, F, A)
+ end.
+
+
+%% =====================================================================
+%% @doc
+%% function arg_types returns a list of the demanded argument types for
+%% a bif to succeed.
+
+-spec arg_types(icode_funcall()) -> [erl_types:erl_type()] | 'unknown'.
+
+arg_types(Primop) ->
+ case Primop of
+ {M, F, A} ->
+ erl_bif_types:arg_types(M, F, A);
+ #element{} ->
+ [erl_types:t_pos_fixnum(), erl_types:t_tuple()];
+ '+' ->
+ erl_bif_types:arg_types(erlang, '+', 2);
+ '-' ->
+ erl_bif_types:arg_types(erlang, '-', 2);
+ '*' ->
+ erl_bif_types:arg_types(erlang, '*', 2);
+ '/' ->
+ erl_bif_types:arg_types(erlang, '/', 2);
+ 'band' ->
+ erl_bif_types:arg_types(erlang, 'band', 2);
+ 'bnot' ->
+ erl_bif_types:arg_types(erlang, 'bnot', 1);
+ 'bor' ->
+ erl_bif_types:arg_types(erlang, 'bor', 2);
+ 'bxor' ->
+ erl_bif_types:arg_types(erlang, 'bxor', 2);
+ 'bsl' ->
+ erl_bif_types:arg_types(erlang, 'bsl', 2);
+ 'bsr' ->
+ erl_bif_types:arg_types(erlang, 'bsr', 2);
+ 'div' ->
+ erl_bif_types:arg_types(erlang, 'div', 2);
+ 'rem' ->
+ erl_bif_types:arg_types(erlang, 'rem', 2);
+ _ ->
+ unknown % safe approximation for all primops.
+ end.
+
+%%=====================================================================
+%% Auxiliary functions
+%%=====================================================================
+
+check_fun_args([T1|Left1], [T2|Left2]) ->
+ Inf = erl_types:t_inf(T1, T2),
+ case erl_types:t_inf(Inf, T2) of
+ Inf ->
+ check_fun_args(Left1, Left2);
+ _ ->
+ error
+ end;
+check_fun_args([], []) ->
+ ok;
+check_fun_args(_, _) ->
+ error.
+
+match_bin(Pattern, Match) ->
+ erl_types:t_bitstr_match(Pattern, Match).
diff --git a/lib/hipe/icode/hipe_icode_primops.hrl b/lib/hipe/icode/hipe_icode_primops.hrl
new file mode 100644
index 0000000000..8a65c5ece0
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_primops.hrl
@@ -0,0 +1,40 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%=======================================================================
+%% File : hipe_icode_primops.hrl
+%% Author : Kostis Sagonas
+%% Description : Contains definitions for HiPE's primitive operations.
+%%=======================================================================
+%% $Id$
+%%=======================================================================
+
+-record(apply_N, {arity :: arity()}).
+
+-record(closure_element, {n :: arity()}).
+
+-record(element, {typeinfo :: list()}). %% XXX: refine?
+
+-record(gc_test, {need :: non_neg_integer()}).
+
+-record(mkfun, {mfa :: mfa(), magic_num :: integer(), index :: integer()}).
+
+-record(unsafe_element, {index :: non_neg_integer()}).
+
+-record(unsafe_update_element, {index :: non_neg_integer()}).
diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl
new file mode 100644
index 0000000000..bcc857acf4
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_range.erl
@@ -0,0 +1,1966 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_icode_range.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 12 Mar 2007 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+-module(hipe_icode_range).
+
+-export([cfg/4]).
+
+%%=====================================================================
+%% Icode Coordinator Behaviour Callbacks
+%%=====================================================================
+
+-export([replace_nones/1,
+ update__info/2, new__info/1, return__info/1,
+ return_none/0, return_none_args/2, return_any_args/2]).
+
+%%=====================================================================
+
+-import(erl_types, [t_any/0,
+ t_from_range_unsafe/2,
+ t_inf/2, t_integer/0,
+ t_to_string/1, t_to_tlist/1,
+ t_limit/2, t_none/0,
+ number_min/1, number_max/1]).
+
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+-include("../main/hipe.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/hipe_bb.hrl").
+-include("hipe_icode_type.hrl").
+
+-type range_tuple() :: {'neg_inf' | integer(), 'pos_inf' | integer()}.
+-type range_rep() :: range_tuple() | 'empty'.
+-type fun_name() :: atom() | tuple().
+-type inf_integer() :: 'neg_inf' | 'pos_inf' | integer().
+
+-record(range, {range :: range_rep(),
+ other :: boolean()}).
+
+-record(ann, {range :: #range{},
+ type :: erl_types:erl_type(),
+ count :: integer()}).
+
+-type range_anno() :: {range_anno, #ann{}, fun((#ann{}) -> string())}.
+-type args_fun() :: fun((mfa(),cfg()) -> [#range{}]).
+-type call_fun() :: fun((mfa(),[#range{}]) -> #range{}).
+-type final_fun() :: fun((mfa(),[#range{}]) -> ok).
+-type data() :: {mfa(), args_fun(), call_fun(), final_fun()}.
+-type label() :: non_neg_integer().
+-type info() :: gb_tree().
+-type work_list() :: {[label()], [label()], set()}.
+-type variable() :: #icode_variable{}.
+-type annotated_variable() :: #icode_variable{}.
+-type argument() :: #icode_const{} | variable().
+-type three_range_fun() :: fun((#range{},#range{},#range{}) -> #range{}).
+-type instr_split_info() :: {icode_instr(), [{label(),info()}]}.
+-type last_instr_return() :: {instr_split_info(), #range{}}.
+
+-record(state, {info_map = gb_trees:empty() :: info(),
+ counter = dict:new() :: dict(),
+ cfg :: cfg(),
+ liveness = gb_trees:empty() :: gb_tree(),
+ ret_type :: #range{},
+ lookup_fun :: call_fun(),
+ result_action :: final_fun()}).
+
+-define(WIDEN, 1).
+
+-define(TAG_IMMED1_SIZE, 4).
+
+-define(BITS, 64).
+
+%%---------------------------------------------------------------------
+
+-spec cfg(cfg(), mfa(), comp_options(), #comp_servers{}) -> cfg().
+
+cfg(Cfg, MFA, Options, Servers) ->
+ case proplists:get_bool(concurrent_comp, Options) of
+ true ->
+ concurrent_cfg(Cfg, MFA, Servers#comp_servers.range);
+ false ->
+ ordinary_cfg(Cfg, MFA)
+ end.
+
+-spec concurrent_cfg(cfg(), mfa(), pid()) -> cfg().
+
+concurrent_cfg(Cfg, MFA, CompServer) ->
+ CompServer ! {ready, {MFA,self()}},
+ {ArgsFun,CallFun,FinalFun} = do_analysis(Cfg, MFA),
+ Ans = do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun),
+ CompServer ! {done_rewrite, MFA},
+ Ans.
+
+-spec do_analysis(cfg(), mfa()) -> {args_fun(), call_fun(), final_fun()}.
+
+do_analysis(Cfg, MFA) ->
+ receive
+ {analyse, {ArgsFun, CallFun, FinalFun}} ->
+ analyse(Cfg, {MFA, ArgsFun, CallFun, FinalFun}),
+ do_analysis(Cfg, MFA);
+ {done, {_NewArgsFun, _NewCallFun, _NewFinalFun} = T} ->
+ T
+ end.
+
+-spec do_rewrite(cfg(), mfa(), args_fun(), call_fun(), final_fun()) -> cfg().
+
+do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun) ->
+ common_rewrite(Cfg, {MFA, ArgsFun, CallFun, FinalFun}).
+
+-spec ordinary_cfg(cfg(), mfa()) -> cfg().
+
+ordinary_cfg(Cfg, MFA) ->
+ Data = make_data(Cfg,MFA),
+ common_rewrite(Cfg, Data).
+
+-spec common_rewrite(cfg(), data()) -> cfg().
+
+common_rewrite(Cfg, Data) ->
+ State = safe_analyse(Cfg, Data),
+ State2 = rewrite_blocks(State),
+ Cfg1 = state__cfg(State2),
+ Cfg2 = hipe_icode_cfg:remove_unreachable_code(Cfg1),
+ Cfg3 = convert_cfg_to_types(Cfg2),
+ hipe_icode_type:specialize(Cfg3).
+
+-spec make_data(cfg(), mfa()) -> data().
+
+make_data(Cfg, {_M,_F,A}=MFA) ->
+ NoArgs =
+ case hipe_icode_cfg:is_closure(Cfg) of
+ true -> hipe_icode_cfg:closure_arity(Cfg)+1;
+ false -> A
+ end,
+ Args = lists:duplicate(NoArgs, any_type()),
+ ArgsFun = fun(_,_) -> Args end,
+ CallFun = fun(_,_) -> any_type() end,
+ FinalFun = fun(_,_) -> ok end,
+ {MFA, ArgsFun, CallFun, FinalFun}.
+
+-spec analyse(cfg(), data()) -> 'ok'.
+
+analyse(Cfg, Data) ->
+ try
+ #state{} = safe_analyse(Cfg, Data),
+ ok
+ catch throw:no_input -> ok
+ end.
+
+-spec safe_analyse(cfg(), data()) -> #state{}.
+
+safe_analyse(CFG, Data={MFA,_,_,_}) ->
+ State = state__init(CFG, Data),
+ Work = init_work(State),
+ NewState = analyse_blocks(State, Work),
+ (state__result_action(NewState))(MFA, [state__ret_type(NewState)]),
+ NewState.
+
+-spec rewrite_blocks(#state{}) -> #state{}.
+
+rewrite_blocks(State) ->
+ CFG = state__cfg(State),
+ Start = hipe_icode_cfg:start_label(CFG),
+ rewrite_blocks([Start], State, [Start]).
+
+-spec rewrite_blocks([label()], #state{}, [label()]) -> #state{}.
+
+rewrite_blocks([Next|Rest], State, Visited) ->
+ Info = state__info_in(State, Next),
+ {NewState, NewLabels} = analyse_block(Next, Info, State, true),
+ NewLabelsSet = ordsets:from_list(NewLabels),
+ RealNew = ordsets:subtract(NewLabelsSet, Visited),
+ NewVisited = ordsets:union([RealNew, Visited, [Next]]),
+ NewWork = ordsets:union([RealNew, Rest]),
+ rewrite_blocks(NewWork, NewState, NewVisited);
+rewrite_blocks([], State, _) ->
+ State.
+
+-spec analyse_blocks(#state{}, work_list()) -> #state{}.
+
+analyse_blocks(State, Work) ->
+ case get_work(Work) of
+ fixpoint ->
+ State;
+ {Label, NewWork} ->
+ Info = state__info_in(State, Label),
+ {NewState, NewLabels} =
+ try analyse_block(Label, Info, State, false)
+ catch throw:none_range ->
+ {State, []}
+ end,
+ NewWork2 = add_work(NewWork, NewLabels),
+ analyse_blocks(NewState, NewWork2)
+ end.
+
+-spec analyse_block(label(), info(), #state{}, boolean()) -> {#state{}, [label()]}.
+
+analyse_block(Label, Info, State, Rewrite) ->
+ BB = state__bb(State, Label),
+ Code = hipe_bb:code(BB),
+ {NewCode, InfoList, RetType} =
+ analyse_BB(Code, Info, [], Rewrite, state__lookup_fun(State)),
+ State1 = state__bb_add(State, Label, hipe_bb:mk_bb(NewCode)),
+ State2 = state__ret_type_update(State1, RetType),
+ state__update_info(State2, InfoList, Rewrite).
+
+-spec analyse_BB([icode_instr()], info(), [icode_instr()], boolean(), call_fun()) ->
+ {[icode_instr()], [{label(),info()}], #range{}}.
+
+analyse_BB([Last], Info, Code, Rewrite, LookupFun) ->
+ {{NewI, LabelInfoList}, RetType} =
+ analyse_last_insn(Last, Info, Rewrite, LookupFun),
+ {lists:reverse([NewI|Code]), LabelInfoList, RetType};
+analyse_BB([Insn|InsnList], Info, Code, Rewrite, LookupFun) ->
+ {NewInfo, NewI} = analyse_insn(Insn, Info, LookupFun),
+ analyse_BB(InsnList, NewInfo, [NewI|Code], Rewrite, LookupFun).
+
+-spec analyse_insn(icode_instr(), info(), call_fun()) -> {info(), icode_instr()}.
+
+analyse_insn(I, Info, LookupFun) ->
+ %% io:format("~w Info: ~p~n", [I, Info]),
+ NewI = handle_args(I,Info),
+ FinalI =
+ case NewI of
+ #icode_call{} -> analyse_call(NewI, LookupFun);
+ #icode_move{} -> analyse_move(NewI);
+ #icode_phi{} -> analyse_phi(NewI);
+ #icode_begin_handler{} -> analyse_begin_handler(NewI);
+ #icode_comment{} -> NewI
+ end,
+ {enter_vals(FinalI, Info), FinalI}.
+
+-spec handle_args(icode_instr(), info()) -> icode_instr().
+
+handle_args(I, Info) ->
+ WidenFun = fun update_three/3,
+ handle_args(I, Info, WidenFun).
+
+-spec handle_args(icode_instr(), info(), three_range_fun()) -> icode_instr().
+
+handle_args(I, Info, WidenFun) ->
+ Uses = hipe_icode:uses(I),
+ PresentRanges = [lookup(V, Info) || V <- Uses],
+ %% io:format("Uses: ~p~nRanges: ~p~n", [Uses, PresentRanges]),
+ JoinFun = fun(Var, Range) -> update_info(Var, Range, WidenFun) end,
+ NewUses = lists:zipwith(JoinFun, Uses, PresentRanges),
+ hipe_icode:subst_uses(lists:zip(Uses, NewUses),I).
+
+-spec join_info(#ann{}, #range{}, three_range_fun()) -> #ann{}.
+
+join_info(Ann = #ann{range = R1, type = Type, count = ?WIDEN}, R2, Fun) ->
+ Ann#ann{range = Fun(R1, R2, range_from_simple_type(Type))};
+join_info(Ann = #ann{range = R1, type = Type, count = C}, R2, _Fun) when C < ?WIDEN ->
+ case join_three(R1, R2, range_from_simple_type(Type)) of
+ R1 -> Ann;
+ NewR -> Ann#ann{range = NewR, count = C+1}
+ end.
+
+-spec join_three(#range{}, #range{}, #range{}) -> #range{}.
+
+join_three(R1, R2, R3) ->
+ inf(sup(R1, R2), R3).
+
+-spec update_info(variable(), #range{}) -> annotated_variable().
+
+update_info(Var, Range) ->
+ update_info(Var, Range, fun update_three/3).
+
+-spec update_info(variable(), #range{}, three_range_fun()) -> annotated_variable().
+
+update_info(Arg, R, Fun) ->
+ case hipe_icode:is_annotated_variable(Arg) of
+ true ->
+ Ann = hipe_icode:variable_annotation(Arg),
+ hipe_icode:annotate_variable(Arg, update_info1(Ann, R, Fun));
+ false ->
+ Arg
+ end.
+
+-spec update_info1(any(), #range{}, three_range_fun()) -> range_anno().
+
+update_info1({range_anno, Ann, _}, R2, Fun) ->
+ make_range_anno(update_ann(Ann,R2,Fun));
+update_info1({type_anno, Type, _}, R2, Fun) ->
+ make_range_anno(update_ann(type_to_ann(Type), R2, Fun)).
+
+update_ann(Ann = #ann{range = R1, type = Type, count = ?WIDEN}, R2, Fun) ->
+ Ann#ann{range = Fun(R1,R2,range_from_simple_type(Type))};
+update_ann(Ann = #ann{range = R1, type = Type, count = C}, R2, _Fun) ->
+ case update_three(R1, R2, range_from_simple_type(Type)) of
+ R1 -> Ann;
+ NewR -> Ann#ann{range = NewR, count = C+1}
+ end.
+
+-spec type_to_ann(erl_types:erl_type()) -> #ann{}.
+
+type_to_ann(Type) ->
+ #ann{range = range_from_simple_type(Type), type = t_limit(Type,1), count=1}.
+
+-spec make_range_anno(#ann{}) -> range_anno().
+
+make_range_anno(Ann) ->
+ {range_anno, Ann, fun pp_ann/1}.
+
+-spec update_three(#range{}, #range{}, #range{}) -> #range{}.
+
+update_three(_R1, R2, R3) ->
+ inf(R2, R3).
+
+-spec safe_widen(#range{}, #range{}, #range{}) -> #range{}.
+
+safe_widen(#range{range=Old}, #range{range=New}, T = #range{range=Wide}) ->
+ ResRange =
+ case {Old,New,Wide} of
+ {{Min,Max1},{Min,Max2},{_,Max}} ->
+ case inf_geq(OMax = next_up_limit(inf_max([Max1,Max2])),Max) of
+ true -> {Min,Max};
+ false -> {Min,OMax}
+ end;
+ {{Min1,Max},{Min2,Max},{Min,_}} ->
+ case inf_geq(Min, OMin = next_down_limit(inf_min([Min1,Min2]))) of
+ true -> {Min,Max};
+ false -> {OMin,Max}
+ end;
+ {{Min1,Max1},{Min2,Max2},{Min,Max}} ->
+ RealMax =
+ case inf_geq(OMax = next_up_limit(inf_max([Max1,Max2])),Max) of
+ true -> Max;
+ false -> OMax
+ end,
+ RealMin =
+ case inf_geq(Min, OMin = next_down_limit(inf_min([Min1,Min2]))) of
+ true -> Min;
+ false -> OMin
+ end,
+ {RealMin,RealMax};
+ _ ->
+ Wide
+ end,
+ T#range{range=ResRange}.
+
+-spec widen(#range{}, #range{}, #range{}) -> #range{}.
+
+widen(#range{range=Old}, #range{range=New}, T = #range{range=Wide}) ->
+ ResRange =
+ case {Old,New,Wide} of
+ {{Min,_},{Min,Max2},{_,Max}} ->
+ case inf_geq(OMax = next_up_limit(Max2),Max) of
+ true -> {Min,Max};
+ false -> {Min,OMax}
+ end;
+ {{_,Max},{Min2,Max},{Min,_}} ->
+ case inf_geq(Min, OMin = next_down_limit(Min2)) of
+ true -> {Min,Max};
+ false -> {OMin,Max}
+ end;
+ {_,{Min2,Max2},{Min,Max}} ->
+ RealMax =
+ case inf_geq(OMax = next_up_limit(Max2),Max) of
+ true -> Max;
+ false -> OMax
+ end,
+ RealMin =
+ case inf_geq(Min, OMin = next_down_limit(Min2)) of
+ true -> Min;
+ false -> OMin
+ end,
+ {RealMin,RealMax};
+ _ ->
+ Wide
+ end,
+ T#range{range=ResRange}.
+
+-spec analyse_call(#icode_call{}, call_fun()) -> #icode_call{}.
+
+analyse_call(Call, LookupFun) ->
+ case hipe_icode:call_dstlist(Call) of
+ [] ->
+ Call;
+ Dsts ->
+ Args = hipe_icode:args(Call),
+ Fun = hipe_icode:call_fun(Call),
+ Type = hipe_icode:call_type(Call),
+ DstRanges = analyse_call_or_enter_fun(Fun, Args, Type, LookupFun),
+ NewDefs = [update_info(Var, R) || {Var,R} <- lists:zip(Dsts, DstRanges)],
+ hipe_icode:subst_defines(lists:zip(Dsts, NewDefs), Call)
+ end.
+
+-spec analyse_move(#icode_move{}) -> #icode_move{}.
+
+analyse_move(Move) ->
+ Src = hipe_icode:move_src(Move),
+ Dst = hipe_icode:move_dst(Move),
+ Range = get_range_from_arg(Src),
+ NewDst = update_info(Dst, Range),
+ hipe_icode:subst_defines([{Dst,NewDst}], Move).
+
+-spec analyse_begin_handler(#icode_begin_handler{}) -> #icode_begin_handler{}.
+
+analyse_begin_handler(Handler) ->
+ SubstList =
+ [{Dst,update_info(Dst,any_type())} ||
+ Dst <- hipe_icode:begin_handler_dstlist(Handler)],
+ hipe_icode:subst_defines(SubstList, Handler).
+
+-spec analyse_phi(#icode_phi{}) -> #icode_phi{}.
+
+analyse_phi(Phi) ->
+ {_, Args} = lists:unzip(hipe_icode:phi_arglist(Phi)),
+ Dst = hipe_icode:phi_dst(Phi),
+ ArgRanges = get_range_from_args(Args),
+ %% io:format("Phi-Arg_ranges: ~p ~n", [Arg_ranges]),
+ DstRange = sup(ArgRanges),
+ NewDst = update_info(Dst, DstRange, fun widen/3),
+ hipe_icode:subst_defines([{Dst, NewDst}], Phi).
+
+-spec analyse_last_insn(icode_instr(), info(), boolean(), call_fun()) ->
+ last_instr_return().
+
+analyse_last_insn(I, Info, Rewrite, LookupFun) ->
+ %% io:format("~w Info: ~p~n",[I,Info]),
+ NewI = handle_args(I, Info),
+ %% io:format("~w -> ~w~n",[NewI,I]),
+ case NewI of
+ #icode_return{} -> analyse_return(NewI, Info);
+ #icode_enter{} -> analyse_enter(NewI, Info, LookupFun);
+ #icode_switch_val{} ->
+ {analyse_switch_val(NewI, Info, Rewrite), none_type()};
+ #icode_if{} -> {analyse_if(NewI, Info, Rewrite), none_type()};
+ #icode_goto{} -> {analyse_goto(NewI, Info), none_type()};
+ #icode_type{} -> {analyse_type(NewI, Info, Rewrite), none_type()};
+ #icode_fail{} -> {analyse_fail(NewI, Info), none_type()};
+ #icode_call{} -> {analyse_last_call(NewI, Info, LookupFun), none_type()};
+ #icode_switch_tuple_arity{} ->
+ {analyse_switch_tuple_arity(NewI, Info), none_type()};
+ #icode_begin_try{} -> {analyse_begin_try(NewI, Info), none_type()}
+ end.
+
+-spec analyse_return(#icode_return{}, info()) -> last_instr_return().
+
+analyse_return(Insn, _Info) ->
+ [RetRange] = get_range_from_args(hipe_icode:return_vars(Insn)),
+ {{Insn,[]}, RetRange}.
+
+-spec analyse_enter(#icode_enter{}, info(), call_fun()) -> last_instr_return().
+
+analyse_enter(Insn, _Info, LookupFun) ->
+ Args = hipe_icode:args(Insn),
+ Fun = hipe_icode:enter_fun(Insn),
+ CallType = hipe_icode:enter_type(Insn),
+ [RetRange] = analyse_call_or_enter_fun(Fun, Args, CallType, LookupFun),
+ {{Insn,[]}, RetRange}.
+
+-spec analyse_switch_val(#icode_switch_val{}, info(), boolean()) -> instr_split_info().
+
+analyse_switch_val(Switch, Info, Rewrite) ->
+ Var = hipe_icode:switch_val_term(Switch),
+ SwitchRange = get_range_from_arg(Var),
+ Cases = hipe_icode:switch_val_cases(Switch),
+ {FailRange, LabelRangeList} = get_range_label_list(Cases, SwitchRange, []),
+ case range__is_none(FailRange) of
+ true ->
+ InfoList = update_infos(Var, Info, LabelRangeList),
+ if Rewrite -> {update_switch(Switch, LabelRangeList, false), InfoList};
+ true -> {Switch, InfoList}
+ end;
+ false ->
+ FailLabel = hipe_icode:switch_val_fail_label(Switch),
+ InfoList = update_infos(Var, Info, [{FailRange, FailLabel}|LabelRangeList]),
+ if Rewrite -> {update_switch(Switch, LabelRangeList, true), InfoList};
+ true -> {Switch, InfoList}
+ end
+ end.
+
+-spec update_infos(argument(), info(), [{#range{},label()}]) -> [{label(),info()}].
+
+update_infos(Arg, Info, [{Range, Label}|Rest]) ->
+ [{Label,enter_define({Arg,Range},Info)} | update_infos(Arg,Info,Rest)];
+update_infos(_, _, []) -> [].
+
+-spec get_range_label_list([{argument(),label()}], #range{}, [{#range{},label()}]) ->
+ {#range{},[{#range{},label()}]}.
+
+get_range_label_list([{Val,Label}|Cases], SRange, Acc) ->
+ VRange = get_range_from_arg(Val),
+ None = none_type(),
+ case inf(SRange, VRange) of
+ None ->
+ get_range_label_list(Cases, SRange, Acc);
+ ResRange ->
+ get_range_label_list(Cases, SRange, [{ResRange,Label}|Acc])
+ end;
+get_range_label_list([], SRange, Acc) ->
+ {PointTypes, _} = lists:unzip(Acc),
+ {remove_point_types(SRange, PointTypes), Acc}.
+
+-spec update_switch(#icode_switch_val{}, [{#range{},label()}], boolean()) ->
+ #icode_switch_val{}.
+
+update_switch(Switch, LabelRangeList, KeepFail) ->
+ S2 =
+ case label_range_list_to_cases(LabelRangeList, []) of
+ no_update ->
+ Switch;
+ Cases ->
+ hipe_icode:switch_val_cases_update(Switch, Cases)
+ end,
+ if KeepFail -> S2;
+ true -> S2
+ end.
+
+-spec label_range_list_to_cases([{#range{},label()}], [{#icode_const{},label()}]) ->
+ 'no_update' | [{#icode_const{},label()}].
+
+label_range_list_to_cases([{#range{range={C,C},other=false},Label}|Rest],
+ Acc) when is_integer(C) ->
+ label_range_list_to_cases(Rest, [{hipe_icode:mk_const(C),Label}|Acc]);
+label_range_list_to_cases([{_NotAConstantRange,_Label}|_Rest], _Acc) ->
+ no_update;
+label_range_list_to_cases([], Acc) ->
+ lists:reverse(Acc).
+
+-spec analyse_switch_tuple_arity(#icode_switch_tuple_arity{}, info()) ->
+ {#icode_switch_tuple_arity{}, [{label(),info()}]}.
+
+analyse_switch_tuple_arity(Switch, Info) ->
+ Var = hipe_icode:switch_tuple_arity_term(Switch),
+ NewInfo = enter_define({Var, get_range_from_arg(Var)}, Info),
+ Cases = hipe_icode:switch_tuple_arity_cases(Switch),
+ Fail = hipe_icode:switch_tuple_arity_fail_label(Switch),
+ {_, Case_labels} = lists:unzip(Cases),
+ Labels = [Fail|Case_labels],
+ {Switch, [{Label,NewInfo} || Label <- Labels]}.
+
+-spec analyse_goto(#icode_goto{}, info()) -> {#icode_goto{}, [{label(),info()},...]}.
+
+analyse_goto(Insn, Info) ->
+ GotoLabel = hipe_icode:goto_label(Insn),
+ {Insn, [{GotoLabel,Info}]}.
+
+-spec analyse_fail(#icode_fail{}, info()) -> {#icode_fail{}, [{label(),info()}]}.
+
+analyse_fail(Fail, Info) ->
+ case hipe_icode:fail_label(Fail) of
+ [] -> {Fail, []};
+ Label -> {Fail, [{Label,Info}]}
+ end.
+
+-spec analyse_begin_try(#icode_begin_try{}, info()) ->
+ {#icode_begin_try{}, [{label(),info()},...]}.
+
+analyse_begin_try(Insn, Info) ->
+ Label = hipe_icode:begin_try_label(Insn),
+ Successor = hipe_icode:begin_try_successor(Insn),
+ {Insn, [{Label,Info},{Successor,Info}]}.
+
+-spec analyse_last_call(#icode_call{}, info(), call_fun()) ->
+ {#icode_call{}, [{label(),info()},...]}.
+
+analyse_last_call(Call, Info, LookupFun) ->
+ %% hipe_icode_pp:pp_block([Insn]),
+ NewI = analyse_call(Call, LookupFun),
+ Continuation = hipe_icode:call_continuation(Call),
+ NewInfo = enter_vals(NewI, Info),
+ case hipe_icode:call_fail_label(Call) of
+ [] ->
+ {NewI, [{Continuation,NewInfo}]};
+ Fail ->
+ {NewI, [{Continuation,NewInfo}, {Fail,Info}]}
+ end.
+
+-spec analyse_if(#icode_if{}, info(), boolean()) ->
+ {#icode_goto{} | #icode_if{}, [{label(),info()}]}.
+
+analyse_if(If, Info, Rewrite) ->
+ case hipe_icode:if_args(If) of
+ Args = [_,_] ->
+ analyse_sane_if(If, Info, Args, get_range_from_args(Args), Rewrite);
+ _ ->
+ TrueLabel = hipe_icode:if_true_label(If),
+ FalseLabel = hipe_icode:if_false_label(If),
+ {If, [{TrueLabel,Info},{FalseLabel,Info}]}
+ end.
+
+-spec analyse_sane_if(#icode_if{}, info(), [argument(),...],
+ [#range{},...], boolean()) ->
+ {#icode_goto{} | #icode_if{}, [{label(), info()}]}.
+
+analyse_sane_if(If, Info, [Arg1, Arg2], [Range1, Range2], Rewrite) ->
+ case normalize_name(hipe_icode:if_op(If)) of
+ '>' ->
+ {TrueRange2, TrueRange1, FalseRange2, FalseRange1} =
+ range_inequality_propagation(Range2, Range1);
+ '==' ->
+ {TempTrueRange1, TempTrueRange2, FalseRange1, FalseRange2}=
+ range_equality_propagation(Range1, Range2),
+ TrueRange1 = set_other(TempTrueRange1,other(Range1)),
+ TrueRange2 = set_other(TempTrueRange2,other(Range2));
+ '<' ->
+ {TrueRange1, TrueRange2, FalseRange1, FalseRange2} =
+ range_inequality_propagation(Range1, Range2);
+ '>=' ->
+ {FalseRange1, FalseRange2, TrueRange1, TrueRange2} =
+ range_inequality_propagation(Range1, Range2);
+ '=<' ->
+ {FalseRange2, FalseRange1, TrueRange2, TrueRange1} =
+ range_inequality_propagation(Range2, Range1);
+ '=:=' ->
+ {TrueRange1, TrueRange2, FalseRange1, FalseRange2}=
+ range_equality_propagation(Range1, Range2);
+ '=/=' ->
+ {FalseRange1, FalseRange2, TrueRange1, TrueRange2} =
+ range_equality_propagation(Range1, Range2);
+ '/=' ->
+ {TempFalseRange1, TempFalseRange2, TrueRange1, TrueRange2}=
+ range_equality_propagation(Range1, Range2),
+ FalseRange1 = set_other(TempFalseRange1,other(Range1)),
+ FalseRange2 = set_other(TempFalseRange2,other(Range2))
+ end,
+ TrueLabel = hipe_icode:if_true_label(If),
+ FalseLabel = hipe_icode:if_false_label(If),
+ TrueInfo =
+ enter_defines([{Arg1,TrueRange1}, {Arg2,TrueRange2}],Info),
+ FalseInfo =
+ enter_defines([{Arg1,FalseRange1}, {Arg2,FalseRange2}],Info),
+ True =
+ case lists:any(fun range__is_none/1,[TrueRange1,TrueRange2]) of
+ true -> [];
+ false -> [{TrueLabel,TrueInfo}]
+ end,
+ False =
+ case lists:any(fun range__is_none/1, [FalseRange1,FalseRange2]) of
+ true -> [];
+ false -> [{FalseLabel,FalseInfo}]
+ end,
+ UpdateInfo = True++False,
+ NewIF =
+ if Rewrite ->
+ %%io:format("~w~n~w~n", [{Arg1,FalseRange1},{Arg2,FalseRange2}]),
+ %%io:format("Any none: ~w~n", [lists:any(fun range__is_none/1,[FalseRange1,FalseRange2])]),
+ case UpdateInfo of
+ [] -> %%This is weird
+ If;
+ [{Label,_Info}] ->
+ hipe_icode:mk_goto(Label);
+ [_,_] ->
+ If
+ end;
+ true ->
+ If
+ end,
+ {NewIF, UpdateInfo}.
+
+-spec normalize_name(atom()) -> atom().
+
+normalize_name(Name) ->
+ case Name of
+ 'fixnum_eq' -> '=:=';
+ 'fixnum_neq' -> '=/=';
+ 'fixnum_gt' -> '>';
+ 'fixnum_lt' -> '<';
+ 'fixnum_ge' -> '>=';
+ 'fixnum_le' -> '=<';
+ Name -> Name
+ end.
+
+-spec range_equality_propagation(#range{}, #range{}) ->
+ {#range{}, #range{}, #range{}, #range{}}.
+
+range_equality_propagation(Range_1, Range_2) ->
+ True_range = inf(Range_1, Range_2),
+ case {range(Range_1), range(Range_2)} of
+ {{N,N},{ N,N}} ->
+ False_range_1 = none_range(),
+ False_range_2 = none_range();
+ {{N1,N1}, {N2,N2}} ->
+ False_range_1 = Range_1,
+ False_range_2 = Range_2;
+ {{N,N}, _} ->
+ False_range_1 = Range_1,
+ {_,False_range_2} = compare_with_integer(N, Range_2);
+ {_, {N,N}} ->
+ False_range_2 = Range_2,
+ {_,False_range_1} = compare_with_integer(N, Range_1);
+ {_, _} ->
+ False_range_1 = Range_1,
+ False_range_2 = Range_2
+ end,
+ {True_range, True_range, False_range_1, False_range_2}.
+
+-spec range_inequality_propagation(#range{}, #range{}) ->
+ {#range{}, #range{}, #range{}, #range{}}.
+
+%% Range1 < Range2
+range_inequality_propagation(Range1, Range2) ->
+ R1_other = other(Range1),
+ R2_other = other(Range2),
+ {R1_true_range, R1_false_range, R2_true_range, R2_false_range} =
+ case {range(Range1), range(Range2)} of
+ {{N1,N1}, {N2,N2}} ->
+ case inf_geq(N2,inf_add(N1,1)) of
+ true ->
+ {{N1,N1},empty,{N2,N2},empty};
+ false ->
+ {empty,{N1,N1},empty,{N2,N2}}
+ end;
+ {{N1,N1}, {Min2,Max2}} ->
+ case inf_geq(Min2,inf_add(N1,1)) of
+ true ->
+ {{N1,N1},empty,{inf_add(N1,1),Max2},empty};
+ false ->
+ case inf_geq(N1,Max2) of
+ true ->
+ {empty,{N1,N1},empty,{Min2,N1}};
+ false ->
+ {{N1,N1},{N1,N1},{inf_add(N1,1),Max2},{Min2,N1}}
+ end
+ end;
+ {{Min1,Max1}, {N2,N2}} ->
+ case inf_geq(N2,inf_add(Max1,1)) of
+ true ->
+ {{Min1,inf_add(N2,-1)},empty,{N2,N2},empty};
+ false ->
+ case inf_geq(Min1,N2) of
+ true ->
+ {empty,{N2,Max1},empty,{N2,N2}};
+ false ->
+ {{Min1,inf_add(N2,-1)},{N2,Max1},{N2,N2},{N2,N2}}
+ end
+ end;
+ {empty, {Min2,Max2}} ->
+ {empty,empty,{Min2,Max2},{Min2,Max2}};
+ {{Min1,Max1}, empty} ->
+ {{Min1,Max1},{Min1,Max1},empty,empty};
+ {empty, empty} ->
+ {empty,empty,empty,empty};
+ {{Min1,Max1}, {Min2,Max2}} ->
+ {{Min1,inf_min([Max1,inf_add(Max2,-1)])},
+ {inf_max([Min1,Min2]),Max1},
+ {inf_max([inf_add(Min1,1),Min2]),Max2},
+ {Min2,inf_min([Max1,Max2])}}
+ end,
+ {range_init(R1_true_range, R1_other),
+ range_init(R2_true_range, R2_other),
+ range_init(R1_false_range, R1_other),
+ range_init(R2_false_range, R2_other)}.
+
+-spec analyse_type(#icode_type{}, info(), boolean()) ->
+ {#icode_goto{} | #icode_type{}, [{label(),info()}]}.
+
+analyse_type(Type, Info, Rewrite) ->
+ TypeTest = hipe_icode:type_test(Type),
+ [Arg|_] = hipe_icode:type_args(Type),
+ OldVarRange = get_range_from_arg(Arg),
+ case TypeTest of
+ {integer, N} ->
+ {TrueRange,FalseRange} = compare_with_integer(N,OldVarRange);
+ integer ->
+ TrueRange = inf(any_range(), OldVarRange),
+ FalseRange = inf(none_range(), OldVarRange);
+ _ ->
+ TrueRange = inf(none_range(),OldVarRange),
+ FalseRange = OldVarRange
+ end,
+ TrueLabel = hipe_icode:type_true_label(Type),
+ FalseLabel = hipe_icode:type_false_label(Type),
+ TrueInfo =
+ enter_define({Arg,TrueRange},Info),
+ FalseInfo =
+ enter_define({Arg,FalseRange},Info),
+ True =
+ case range__is_none(TrueRange) of
+ true -> [];
+ false -> [{TrueLabel,TrueInfo}]
+ end,
+ False =
+ case range__is_none(FalseRange) of
+ true -> [];
+ false -> [{FalseLabel,FalseInfo}]
+ end,
+ UpdateInfo = True++False,
+ NewType =
+ if Rewrite ->
+ case UpdateInfo of
+ [] -> %% This is weird
+ Type;
+ [{Label,_Info}] ->
+ hipe_icode:mk_goto(Label);
+ [_,_] ->
+ Type
+ end;
+ true ->
+ Type
+ end,
+ {NewType,True ++ False}.
+
+-spec compare_with_integer(integer(), #range{}) -> {#range{}, #range{}}.
+
+compare_with_integer(N, OldVarRange) ->
+ TestRange = range_init({N, N}, false),
+ TrueRange = inf(TestRange, OldVarRange),
+ %% False range
+ TempFalseRange = range__remove_constant(OldVarRange, TestRange),
+ BetterRange =
+ case range(TempFalseRange) of
+ {Min, Max} = MM ->
+ New_small = inf_geq(Min, N),
+ New_large = inf_geq(N, Max),
+ if New_small and not New_large ->
+ {N + 1, Max};
+ New_large and not New_small ->
+ {Min, N - 1};
+ true ->
+ MM
+ end;
+ Not_tuple ->
+ Not_tuple
+ end,
+ FalseRange = range_init(BetterRange, other(TempFalseRange)),
+ {TrueRange, FalseRange}.
+
+%%== Ranges ==================================================================
+
+-spec pp_ann(#ann{} | erl_types:erl_type()) -> [string()].
+
+pp_ann(#ann{range=#range{range=R, other=false}}) ->
+ pp_range(R);
+pp_ann(#ann{range=#range{range=empty, other=true}, type=Type}) ->
+ t_to_string(Type);
+pp_ann(#ann{range=#range{range=R, other=true}, type=Type}) ->
+ pp_range(R) ++ " | " ++ t_to_string(Type);
+pp_ann(Type) ->
+ t_to_string(Type).
+
+-spec pp_range(range_rep()) -> nonempty_string().
+
+pp_range(empty) ->
+ "none";
+pp_range({Min, Max}) ->
+ val_to_string(Min) ++ ".." ++ val_to_string(Max).
+
+-spec val_to_string('pos_inf' | 'neg_inf' | integer()) -> string().
+
+val_to_string(pos_inf) -> "inf";
+val_to_string(neg_inf) -> "-inf";
+val_to_string(X) when is_integer(X) -> integer_to_list(X).
+
+-spec range_from_type(erl_types:erl_type()) -> [#range{}].
+
+range_from_type(Type) ->
+ [range_from_simple_type(T) || T <- t_to_tlist(Type)].
+
+-spec range_from_simple_type(erl_types:erl_type()) -> #range{}.
+
+range_from_simple_type(Type) ->
+ None = t_none(),
+ case t_inf(t_integer(), Type) of
+ None ->
+ #range{range = empty, other = true};
+ Type ->
+ Range = {number_min(Type), number_max(Type)},
+ #range{range = Range, other = false};
+ NewType ->
+ Range = {number_min(NewType), number_max(NewType)},
+ #range{range = Range, other = true}
+ end.
+
+-spec range_init(range_rep(), boolean()) -> #range{}.
+
+range_init({Min, Max} = Range, Other) ->
+ case inf_geq(Max, Min) of
+ true ->
+ #range{range = Range, other = Other};
+ false ->
+ #range{range = empty, other = Other}
+ end;
+range_init(empty, Other) ->
+ #range{range = empty, other = Other}.
+
+-spec range(#range{}) -> range_rep().
+
+range(#range{range = R}) -> R.
+
+-spec other(#range{}) -> boolean().
+
+other(#range{other = O}) -> O.
+
+-spec set_other(#range{}, boolean()) -> #range{}.
+
+set_other(R, O) -> R#range{other = O}.
+
+-spec range__min(#range{}) -> 'empty' | 'neg_inf' | integer().
+
+range__min(#range{range=empty}) -> empty;
+range__min(#range{range={Min,_}}) -> Min.
+
+-spec range__max(#range{}) -> 'empty' | 'pos_inf' | integer().
+
+range__max(#range{range=empty}) -> empty;
+range__max(#range{range={_,Max}}) -> Max.
+
+-spec range__is_none(#range{}) -> boolean().
+
+range__is_none(#range{range=empty, other=false}) -> true;
+range__is_none(#range{}) -> false.
+
+-spec range__is_empty(#range{}) -> boolean().
+
+range__is_empty(#range{range=empty}) -> true;
+range__is_empty(#range{range={_,_}}) -> false.
+
+-spec remove_point_types(#range{}, [#range{}]) -> #range{}.
+
+remove_point_types(Range, Ranges) ->
+ Sorted = lists:sort(Ranges),
+ FoldFun = fun (R, Acc) -> range__remove_constant(Acc,R) end,
+ Range1 = lists:foldl(FoldFun, Range, Sorted),
+ lists:foldl(FoldFun, Range1, lists:reverse(Sorted)).
+
+-spec range__remove_constant(#range{}, #range{}) -> #range{}.
+
+range__remove_constant(R = #range{range={C,C}}, #range{range={C,C}}) ->
+ R#range{range=empty};
+range__remove_constant(R = #range{range={C,H}}, #range{range={C,C}}) ->
+ R#range{range={C+1,H}};
+range__remove_constant(R = #range{range={L,C}}, #range{range={C,C}}) ->
+ R#range{range={L,C-1}};
+range__remove_constant(R = #range{}, #range{range={C,C}}) ->
+ R;
+range__remove_constant(R = #range{}, _) ->
+ R.
+
+-spec any_type() -> #range{}.
+
+any_type() ->
+ #range{range=any_r(), other=true}.
+
+-spec any_range() -> #range{}.
+
+any_range() ->
+ #range{range=any_r(), other=false}.
+
+-spec none_range() -> #range{}.
+
+none_range() ->
+ #range{range=empty, other=true}.
+
+-spec none_type() -> #range{}.
+
+none_type() ->
+ #range{range = empty, other = false}.
+
+-spec any_r() -> {'neg_inf','pos_inf'}.
+
+any_r() -> {neg_inf, pos_inf}.
+
+-spec get_range_from_args([argument()]) -> [#range{}].
+
+get_range_from_args(Args) ->
+ [get_range_from_arg(Arg) || Arg <- Args].
+
+-spec get_range_from_arg(argument()) -> #range{}.
+
+get_range_from_arg(Arg) ->
+ case hipe_icode:is_const(Arg) of
+ true ->
+ Value = hipe_icode:const_value(Arg),
+ case is_integer(Value) of
+ true ->
+ #range{range={Value,Value}, other=false};
+ false ->
+ #range{range=empty, other=true}
+ end;
+ false ->
+ case hipe_icode:is_annotated_variable(Arg) of
+ true ->
+ case hipe_icode:variable_annotation(Arg) of
+ {range_anno, #ann{range=Range}, _} ->
+ Range;
+ {type_anno, Type, _} ->
+ range_from_simple_type(Type)
+ end;
+ false ->
+ any_type()
+ end
+ end.
+
+%% inf([R]) ->
+%% R;
+%% inf([R1,R2|Rest]) ->
+%% inf([inf(R1,R2)|Rest]).
+
+-spec inf(#range{}, #range{}) -> #range{}.
+
+inf(#range{range=R1, other=O1}, #range{range=R2, other=O2}) ->
+ #range{range=range_inf(R1,R2), other=other_inf(O1,O2)}.
+
+-spec range_inf(range_rep(), range_rep()) -> range_rep().
+
+range_inf(empty, _) -> empty;
+range_inf(_, empty) -> empty;
+range_inf({Min1,Max1}, {Min2,Max2}) ->
+ NewMin = inf_max([Min1,Min2]),
+ NewMax = inf_min([Max1,Max2]),
+ case inf_geq(NewMax, NewMin) of
+ true ->
+ {NewMin, NewMax};
+ false ->
+ empty
+ end.
+
+-spec other_inf(boolean(), boolean()) -> boolean().
+
+other_inf(O1, O2) -> O1 and O2.
+
+-spec sup([#range{},...]) -> #range{}.
+
+sup([R]) ->
+ R;
+sup([R1,R2|Rest]) ->
+ sup([sup(R1, R2)|Rest]).
+
+-spec sup(#range{}, #range{}) -> #range{}.
+
+sup(#range{range=R1,other=O1}, #range{range=R2,other=O2}) ->
+ #range{range=range_sup(R1,R2), other=other_sup(O1,O2)}.
+
+-spec range_sup(range_rep(), range_rep()) -> range_rep().
+
+range_sup(empty, R) -> R;
+range_sup(R, empty) -> R;
+range_sup({Min1,Max1}, {Min2,Max2}) ->
+ NewMin = inf_min([Min1,Min2]),
+ NewMax = inf_max([Max1,Max2]),
+ {NewMin,NewMax}.
+
+-spec other_sup(boolean(), boolean()) -> boolean().
+
+other_sup(O1, O2) -> O1 or O2.
+
+%%== Call Support =============================================================
+
+-spec analyse_call_or_enter_fun(fun_name(), [argument()],
+ icode_call_type(), call_fun()) -> [#range{}].
+
+analyse_call_or_enter_fun(Fun, Args, CallType, LookupFun) ->
+ %%io:format("Fun: ~p~n Args: ~p~n CT: ~p~n LF: ~p~n", [Fun, Args, CallType, LookupFun]),
+ case basic_type(Fun) of
+ {bin, Operation} ->
+ [Arg_range1,Arg_range2] = get_range_from_args(Args),
+ A1_is_empty = range__is_empty(Arg_range1),
+ A2_is_empty = range__is_empty(Arg_range2),
+ case A1_is_empty orelse A2_is_empty of
+ true ->
+ [none_type()];
+ false ->
+ [Operation(Arg_range1, Arg_range2)]
+ end;
+ {unary, Operation} ->
+ [Arg_range] = get_range_from_args(Args),
+ case range__is_empty(Arg_range) of
+ true ->
+ [none_type()];
+ false ->
+ [Operation(Arg_range)]
+ end;
+ {fcall, MFA} ->
+ case CallType of
+ local ->
+ Range = LookupFun(MFA, get_range_from_args(Args)),
+ case range__is_none(Range) of
+ true ->
+ throw(none_range);
+ false ->
+ [Range]
+ end;
+ remote ->
+ [any_type()]
+ end;
+ not_int ->
+ [any_type()];
+ not_analysed ->
+ [any_type()];
+ {hipe_bs_primop, {bs_get_integer, Size, Flags}} ->
+ {Min, Max} = analyse_bs_get_integer(Size, Flags, length(Args) =:= 1),
+ [#range{range={Min, Max}, other=false}, any_type()];
+ {hipe_bs_primop, _} = Primop ->
+ Type = hipe_icode_primops:type(Primop),
+ range_from_type(Type)
+ end.
+
+-type bin_operation() :: fun((#range{},#range{}) -> #range{}).
+-type unary_operation() :: fun((#range{}) -> #range{}).
+
+-spec basic_type(fun_name()) -> 'not_int' | 'not_analysed'
+ | {bin, bin_operation()}
+ | {unary, unary_operation()}
+ | {fcall, mfa()} | {hipe_bs_primop, _}.
+
+%% Arithmetic operations
+basic_type('+') -> {bin, fun(R1, R2) -> range_add(R1, R2) end};
+basic_type('-') -> {bin, fun(R1, R2) -> range_sub(R1, R2) end};
+basic_type('*') -> {bin, fun(R1, R2) -> range_mult(R1, R2) end};
+basic_type('/') -> not_int;
+basic_type('div') -> {bin, fun(R1, R2) -> range_div(R1, R2) end};
+basic_type('rem') -> {bin, fun(R1, R2) -> range_rem(R1, R2) end};
+basic_type('bor') -> {bin, fun(R1, R2) -> range_bor(R1, R2) end};
+basic_type('band') -> {bin, fun(R1, R2) -> range_band(R1, R2) end};
+basic_type('bxor') -> {bin, fun(R1, R2) -> range_bxor(R1, R2) end};
+basic_type('bnot') -> {unary, fun(R1) -> range_bnot(R1) end};
+basic_type('bsl') -> {bin, fun(R1, R2) -> range_bsl(R1, R2) end};
+basic_type('bsr') -> {bin, fun(R1, R2) -> range_bsr(R1, R2) end};
+%% unsafe_*
+basic_type('unsafe_bor') ->
+ {bin, fun(R1, R2) -> range_bor(R1, R2) end};
+basic_type('unsafe_band') ->
+ {bin, fun(R1, R2) -> range_band(R1, R2) end};
+basic_type('unsafe_bxor') ->
+ {bin, fun(R1, R2) -> range_bxor(R1, R2) end};
+basic_type('unsafe_bnot') ->
+ {unary, fun(R1) -> range_bnot(R1) end};
+basic_type('unsafe_bsl') ->
+ {bin, fun(R1, R2) -> range_bsl(R1, R2) end};
+basic_type('unsafe_bsr') ->
+ {bin, fun(R1, R2) -> range_bsr(R1, R2) end};
+basic_type('unsafe_add') ->
+ {bin, fun(R1, R2) -> range_add(R1, R2) end};
+basic_type('unsafe_sub') ->
+ {bin, fun(R1, R2) -> range_sub(R1, R2) end};
+basic_type('extra_unsafe_add') ->
+ {bin, fun(R1, R2) -> range_add(R1, R2) end};
+basic_type('extra_unsafe_sub') ->
+ {bin, fun(R1, R2) -> range_sub(R1, R2) end};
+%% Binaries
+basic_type({hipe_bs_primop, _} = Primop) -> Primop;
+%% Unknown, other
+basic_type(call_fun) -> not_analysed;
+basic_type(clear_timeout) -> not_analysed;
+basic_type(redtest) -> not_analysed;
+basic_type(set_timeout) -> not_analysed;
+basic_type(#apply_N{}) -> not_analysed;
+basic_type(#closure_element{}) -> not_analysed;
+basic_type(#gc_test{}) -> not_analysed;
+%% Message handling
+basic_type(check_get_msg) -> not_analysed;
+basic_type(next_msg) -> not_analysed;
+basic_type(select_msg) -> not_analysed;
+basic_type(suspend_msg) -> not_analysed;
+%% Functions
+basic_type(enter_fun) -> not_analysed;
+basic_type(#mkfun{}) -> not_int;
+basic_type({_M,_F,_A} = MFA) -> {fcall, MFA};
+%% Floats
+basic_type(conv_to_float) -> not_int;
+basic_type(fclearerror) -> not_analysed;
+basic_type(fcheckerror) -> not_analysed;
+basic_type(fnegate) -> not_int;
+basic_type(fp_add) -> not_int;
+basic_type(fp_div) -> not_int;
+basic_type(fp_mul) -> not_int;
+basic_type(fp_sub) -> not_int;
+basic_type(unsafe_tag_float) -> not_int;
+basic_type(unsafe_untag_float) -> not_int;
+%% Lists, tuples, records
+basic_type(cons) -> not_int;
+basic_type(mktuple) -> not_int;
+basic_type(unsafe_hd) -> not_analysed;
+basic_type(unsafe_tl) -> not_int;
+basic_type(#element{}) -> not_analysed;
+basic_type(#unsafe_element{}) -> not_analysed;
+basic_type(#unsafe_update_element{}) -> not_analysed.
+
+-spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple().
+
+analyse_bs_get_integer(Size, Flags, true) ->
+ Signed = Flags band 4,
+ if Signed =:= 0 ->
+ Max = 1 bsl Size - 1,
+ Min = 0;
+ true ->
+ Max = 1 bsl (Size-1) - 1,
+ Min = -(1 bsl (Size-1))
+ end,
+ {Min, Max};
+analyse_bs_get_integer(Size, Flags, false) when is_integer(Size),
+ is_integer(Flags) ->
+ any_r().
+
+%%---------------------------------------------------------------------------
+%% Range operations
+%%---------------------------------------------------------------------------
+
+%% Arithmetic
+
+-spec range_add(#range{}, #range{}) -> #range{}.
+
+range_add(Range1, Range2) ->
+ NewMin = inf_add(range__min(Range1), range__min(Range2)),
+ NewMax = inf_add(range__max(Range1), range__max(Range2)),
+ Other = other(Range1) orelse other(Range2),
+ range_init({NewMin, NewMax}, Other).
+
+-spec range_sub(#range{}, #range{}) -> #range{}.
+
+range_sub(Range1, Range2) ->
+ Min_sub = inf_min([inf_inv(range__max(Range2)),
+ inf_inv(range__min(Range2))]),
+ Max_sub = inf_max([inf_inv(range__max(Range2)),
+ inf_inv(range__min(Range2))]),
+ NewMin = inf_add(range__min(Range1), Min_sub),
+ NewMax = inf_add(range__max(Range1), Max_sub),
+ Other = other(Range1) orelse other(Range2),
+ range_init({NewMin, NewMax}, Other).
+
+-spec range_mult(#range{}, #range{}) -> #range{}.
+
+range_mult(#range{range=empty, other=true}, _Range2) ->
+ range_init(empty, true);
+range_mult(_Range1, #range{range=empty, other=true}) ->
+ range_init(empty, true);
+range_mult(Range1, Range2) ->
+ Min1 = range__min(Range1),
+ Min2 = range__min(Range2),
+ Max1 = range__max(Range1),
+ Max2 = range__max(Range2),
+ GreaterMin1 = inf_greater_zero(Min1),
+ GreaterMin2 = inf_greater_zero(Min2),
+ GreaterMax1 = inf_greater_zero(Max1),
+ GreaterMax2 = inf_greater_zero(Max2),
+ Range =
+ if GreaterMin1 ->
+ if GreaterMin2 -> {inf_mult(Min1, Min2), inf_mult(Max1, Max2)};
+ GreaterMax2 -> {inf_mult(Min2, Max1), inf_mult(Max2, Max1)};
+ true -> {inf_mult(Min2, Max1), inf_mult(Max2, Min1)}
+ end;
+ %% Column 1 or 2
+ GreaterMin2 -> % Column 1 or 2 row 3
+ range(range_mult(Range2, Range1));
+ GreaterMax1 -> % Column 2 Row 1 or 2
+ if GreaterMax2 -> % Column 2 Row 2
+ NewMin = inf_min([inf_mult(Min2, Max1), inf_mult(Max2, Min1)]),
+ NewMax = inf_max([inf_mult(Min2, Min1), inf_mult(Max2, Max1)]),
+ {NewMin, NewMax};
+ true -> % Column 2 Row 1
+ {inf_mult(Min2, Max1), inf_mult(Min2, Min1)}
+ end;
+ GreaterMax2 -> % Column 1 Row 2
+ range(range_mult(Range2, Range1));
+ true -> % Column 1 Row 1
+ {inf_mult(Max1, Max2), inf_mult(Min2, Min1)}
+ end,
+ Other = other(Range1) orelse other(Range2),
+ range_init(Range, Other).
+
+-spec extreme_divisors(#range{}) -> range_tuple().
+
+extreme_divisors(#range{range={0,0}}) -> {0,0};
+extreme_divisors(#range{range={0,Max}}) -> {1,Max};
+extreme_divisors(#range{range={Min,0}}) -> {Min,-1};
+extreme_divisors(#range{range={Min,Max}}) ->
+ case inf_geq(Min, 0) of
+ true -> {Min, Max};
+ false -> % Min < 0
+ case inf_geq(0, Max) of
+ true -> {Min,Max}; % Max < 0
+ false -> {-1,1} % Max > 0
+ end
+ end.
+
+-spec range_div(#range{}, #range{}) -> #range{}.
+
+%% this is div, not /.
+range_div(_, #range{range={0,0}}) ->
+ range_init(empty, false);
+range_div(#range{range=empty}, _) ->
+ range_init(empty, false);
+range_div(_, #range{range=empty}) ->
+ range_init(empty, false);
+range_div(Range1, Den) ->
+ Min1 = range__min(Range1),
+ Max1 = range__max(Range1),
+ {Min2, Max2} = extreme_divisors(Den),
+ Min_max_list = [inf_div(Min1, Min2), inf_div(Min1, Max2),
+ inf_div(Max1, Min2), inf_div(Max1, Max2)],
+ range_init({inf_min(Min_max_list), inf_max(Min_max_list)}, false).
+
+-spec range_rem(#range{}, #range{}) -> #range{}.
+
+range_rem(Range1, Range2) ->
+ %% Range1 desides the sign of the answer.
+ Min1 = range__min(Range1),
+ Max1 = range__max(Range1),
+ Min2 = range__min(Range2),
+ Max2 = range__max(Range2),
+ Min1_geq_zero = inf_geq(Min1, 0),
+ Max1_leq_zero = inf_geq(0, Max1),
+ Max_range2 = inf_max([inf_abs(Min2), inf_abs(Max2)]),
+ Max_range2_leq_zero = inf_geq(0, Max_range2),
+ New_min =
+ if Min1_geq_zero -> 0;
+ Max_range2_leq_zero -> Max_range2;
+ true -> inf_inv(Max_range2)
+ end,
+ New_max =
+ if Max1_leq_zero -> 0;
+ Max_range2_leq_zero -> inf_inv(Max_range2);
+ true -> Max_range2
+ end,
+ range_init({New_min, New_max}, false).
+
+%%--- Bit operations ----------------------------
+
+-spec range_bsr(#range{}, #range{}) -> #range{}.
+
+range_bsr(Range1, Range2=#range{range={Min, Max}}) ->
+ New_Range2 = range_init({inf_inv(Max), inf_inv(Min)}, other(Range2)),
+ Ans = range_bsl(Range1, New_Range2),
+ %% io:format("bsr res:~w~nInput:= ~w~n", [Ans, {Range1,Range2}]),
+ Ans.
+
+-spec range_bsl(#range{}, #range{}) -> #range{}.
+
+range_bsl(Range1, Range2) ->
+ Min1 = range__min(Range1),
+ Min2 = range__min(Range2),
+ Max1 = range__max(Range1),
+ Max2 = range__max(Range2),
+ Min1Geq0 = inf_geq(Min1, 0),
+ Max1Less0 = not inf_geq(Max1, 0),
+ MinMax =
+ if Min1Geq0 ->
+ {inf_bsl(Min1, Min2), inf_bsl(Max1, Max2)};
+ true ->
+ if Max1Less0 -> {inf_bsl(Min1, Max2), inf_bsl(Max1, Min2)};
+ true -> {inf_bsl(Min1, Max2), inf_bsl(Max1, Max2)}
+ end
+ end,
+ range_init(MinMax, false).
+
+-spec range_bnot(#range{}) -> #range{}.
+
+range_bnot(Range) ->
+ Minus_one = range_init({-1,-1}, false),
+ range_add(range_mult(Range, Minus_one), Minus_one).
+
+-spec width(range_rep() | integer()) -> 'pos_inf' | non_neg_integer().
+
+width({Min, Max}) -> inf_max([width(Min), width(Max)]);
+width(pos_inf) -> pos_inf;
+width(neg_inf) -> pos_inf;
+width(X) when is_integer(X), X >= 0 -> poswidth(X, 0);
+width(X) when is_integer(X), X < 0 -> negwidth(X, 0).
+
+-spec poswidth(non_neg_integer(), non_neg_integer()) -> non_neg_integer().
+
+poswidth(X, N) ->
+ case X < (1 bsl N) of
+ true -> N;
+ false -> poswidth(X, N+1)
+ end.
+
+-spec negwidth(neg_integer(), non_neg_integer()) -> non_neg_integer().
+
+negwidth(X, N) ->
+ case X > (-1 bsl N) of
+ true -> N;
+ false -> negwidth(X, N+1)
+ end.
+
+-spec range_band(#range{}, #range{}) -> #range{}.
+
+range_band(R1, R2) ->
+ {_Min1, Max1} = MM1 = range(R1),
+ {_Min2, Max2} = MM2 = range(R2),
+ Width1 = width(MM1),
+ Width2 = width(MM2),
+ Range =
+ case {classify_range(R1), classify_range(R2)} of
+ {minus_minus, minus_minus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), -1};
+ {minus_minus, minus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), Max2};
+ {minus_minus, plus_plus} ->
+ {0, Max2};
+ {minus_plus, minus_minus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), Max1};
+ {minus_plus, minus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), inf_max([Max1, Max2])};
+ {minus_plus, plus_plus} ->
+ {0, Max2};
+ {plus_plus, minus_minus} ->
+ {0, Max1};
+ {plus_plus, minus_plus} ->
+ {0, Max1};
+ {plus_plus, plus_plus} ->
+ {0, inf_min([Max1, Max2])}
+ end,
+ range_init(Range, false).
+
+-spec range_bor(#range{}, #range{}) -> #range{}.
+
+range_bor(R1, R2) ->
+ {Min1, _Max1} = MM1 = range(R1),
+ {Min2, _Max2} = MM2 = range(R2),
+ Width1 = width(MM1),
+ Width2 = width(MM2),
+ Range =
+ case {classify_range(R1), classify_range(R2)} of
+ {minus_minus, minus_minus} ->
+ {inf_max([Min1, Min2]), -1};
+ {minus_minus, minus_plus} ->
+ {Min1, -1};
+ {minus_minus, plus_plus} ->
+ {Min1, -1};
+ {minus_plus, minus_minus} ->
+ {Min2, -1};
+ {minus_plus, minus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_min([Min1, Min2]), inf_add(-1, inf_bsl(1, Width))};
+ {minus_plus, plus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {Min1, inf_add(-1, inf_bsl(1, Width))};
+ {plus_plus, minus_minus} ->
+ {Min2, -1};
+ {plus_plus, minus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {Min2, inf_add(-1, inf_bsl(1, Width))};
+ {plus_plus, plus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {0, inf_add(-1, inf_bsl(1, Width))}
+ end,
+ range_init(Range, false).
+
+-spec classify_range(#range{}) -> 'minus_minus' | 'minus_plus' | 'plus_plus'.
+
+classify_range(Range) ->
+ case range(Range) of
+ {neg_inf, Number} when is_integer(Number), Number < 0 -> minus_minus;
+ {neg_inf, Number} when is_integer(Number), Number >= 0 -> minus_plus;
+ {Number, pos_inf} when is_integer(Number), Number < 0 -> minus_plus;
+ {Number, pos_inf} when is_integer(Number), Number >= 0 -> plus_plus;
+ {neg_inf, pos_inf} -> minus_plus;
+ {Number1,Number2} when is_integer(Number1), is_integer(Number2) ->
+ classify_int_range(Number1, Number2)
+ end.
+
+-spec classify_int_range(integer(), integer()) ->
+ 'minus_minus' | 'minus_plus' | 'plus_plus'.
+
+classify_int_range(Number1, _Number2) when Number1 >= 0 ->
+ plus_plus;
+classify_int_range(_Number1, Number2) when Number2 < 0 ->
+ minus_minus;
+classify_int_range(_Number1, _Number2) ->
+ minus_plus.
+
+-spec range_bxor(#range{}, #range{}) -> #range{}.
+
+range_bxor(R1, R2) ->
+ {Min1, Max1} = MM1 = range(R1),
+ {Min2, Max2} = MM2 = range(R2),
+ Width1 = width(MM1),
+ Width2 = width(MM2),
+ Range =
+ case {classify_range(R1), classify_range(R2)} of
+ {minus_minus, minus_minus} ->
+ Width = inf_max([Width1, Width2]),
+ {0, inf_add(-1, inf_bsl(1, Width))};
+ {minus_minus, minus_plus} ->
+ MinWidth = inf_max([Width1, width({0,Max2})]),
+ MaxWidth = inf_max([Width1, width({Min2,-1})]),
+ {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))};
+ {minus_minus, plus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), -1};
+ {minus_plus, minus_minus} ->
+ MinWidth = inf_max([Width2,width({0,Max1})]),
+ MaxWidth = inf_max([Width2,width({Min1,-1})]),
+ {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))};
+ {minus_plus, minus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), inf_add(-1, inf_bsl(1, Width))};
+ {minus_plus, plus_plus} ->
+ MinWidth = inf_max([Width2,width({Min1,-1})]),
+ MaxWidth = inf_max([Width2,width({0,Max1})]),
+ {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))};
+ {plus_plus, minus_minus} ->
+ Width = inf_max([Width1, Width2]),
+ {inf_bsl(-1, Width), -1};
+ {plus_plus, minus_plus} ->
+ MinWidth = inf_max([Width1,width({Min2,-1})]),
+ MaxWidth = inf_max([Width1,width({0,Max2})]),
+ {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))};
+ {plus_plus, plus_plus} ->
+ Width = inf_max([Width1, Width2]),
+ {0, inf_add(-1, inf_bsl(1, Width))}
+ end,
+ range_init(Range, false).
+
+%%---------------------------------------------------------------------------
+%% Inf operations
+%%---------------------------------------------------------------------------
+
+-spec inf_max([inf_integer(),...]) -> inf_integer().
+
+inf_max([H|T]) ->
+ lists:foldl(fun (Elem, Max) ->
+ case inf_geq(Elem, Max) of
+ false -> Max;
+ true -> Elem
+ end
+ end, H, T).
+
+-spec inf_min([inf_integer(),...]) -> inf_integer().
+
+inf_min([H|T]) ->
+ lists:foldl(fun (Elem, Min) ->
+ case inf_geq(Elem, Min) of
+ true -> Min;
+ false -> Elem
+ end
+ end, H, T).
+
+-spec inf_abs(inf_integer()) -> 'pos_inf' | integer().
+
+inf_abs(pos_inf) -> pos_inf;
+inf_abs(neg_inf) -> pos_inf;
+inf_abs(Number) when is_integer(Number), (Number < 0) -> - Number;
+inf_abs(Number) when is_integer(Number) -> Number.
+
+-spec inf_add(inf_integer(), inf_integer()) -> inf_integer().
+
+inf_add(pos_inf, _Number) -> pos_inf;
+inf_add(neg_inf, _Number) -> neg_inf;
+inf_add(_Number, pos_inf) -> pos_inf;
+inf_add(_Number, neg_inf) -> neg_inf;
+inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ Number1 + Number2.
+
+-spec inf_inv(inf_integer()) -> inf_integer().
+
+inf_inv(pos_inf) -> neg_inf;
+inf_inv(neg_inf) -> pos_inf;
+inf_inv(Number) -> -Number.
+
+-spec inf_geq(inf_integer(), inf_integer()) -> boolean().
+
+inf_geq(pos_inf, _) -> true;
+inf_geq(_, pos_inf) -> false;
+inf_geq(_, neg_inf) -> true;
+inf_geq(neg_inf, _) -> false;
+inf_geq(A, B) -> A >= B.
+
+-spec inf_greater_zero(inf_integer()) -> boolean().
+
+inf_greater_zero(pos_inf) -> true;
+inf_greater_zero(neg_inf) -> false;
+inf_greater_zero(Number) when is_integer(Number), Number >= 0 -> true;
+inf_greater_zero(Number) when is_integer(Number), Number < 0 -> false.
+
+-spec inf_div(inf_integer(), inf_integer()) -> inf_integer().
+
+inf_div(Number, 0) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> pos_inf;
+ true -> neg_inf
+ end;
+inf_div(pos_inf, Number) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> pos_inf;
+ true -> neg_inf
+ end;
+inf_div(neg_inf, Number) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> neg_inf;
+ true -> pos_inf
+ end;
+inf_div(Number, pos_inf) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> pos_inf;
+ true -> neg_inf
+ end;
+inf_div(Number, neg_inf) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> neg_inf;
+ true -> pos_inf
+ end;
+inf_div(Number1, Number2) -> Number1 div Number2.
+
+-spec inf_mult(inf_integer(), inf_integer()) -> inf_integer().
+
+inf_mult(neg_inf, Number) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> neg_inf;
+ true -> pos_inf
+ end;
+inf_mult(pos_inf, Number) ->
+ Greater = inf_greater_zero(Number),
+ if Greater -> pos_inf;
+ true -> neg_inf
+ end;
+inf_mult(Number, pos_inf) -> inf_mult(pos_inf, Number);
+inf_mult(Number, neg_inf) -> inf_mult(neg_inf, Number);
+inf_mult(Number1, Number2) -> Number1 * Number2.
+
+-spec inf_bsl(inf_integer(), inf_integer()) -> inf_integer().
+
+inf_bsl(pos_inf, _) -> pos_inf;
+inf_bsl(neg_inf, _) -> neg_inf;
+inf_bsl(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf;
+inf_bsl(_, pos_inf) -> neg_inf;
+inf_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0;
+inf_bsl(_Number, neg_inf) -> -1;
+inf_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ %% We can not shift left with a number which is not a fixnum. We
+ %% don't have enough memory.
+ Bits = ?BITS,
+ if Number2 > (Bits bsl 1) -> inf_bsl(Number1, pos_inf);
+ Number2 < (-Bits bsl 1) -> inf_bsl(Number1, neg_inf);
+ true -> Number1 bsl Number2
+ end.
+
+%% State
+
+-spec state__init(cfg(), data()) -> #state{}.
+
+state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) ->
+ Start = hipe_icode_cfg:start_label(Cfg),
+ Params = hipe_icode_cfg:params(Cfg),
+ Ranges = ArgsFun(MFA, Cfg),
+ %% io:format("MFA: ~w~nRanges: ~w~n", [MFA, Ranges]),
+ Liveness =
+ hipe_icode_ssa:ssa_liveness__analyze(hipe_icode_type:unannotate_cfg(Cfg)),
+ case lists:any(fun range__is_none/1, Ranges) of
+ true ->
+ FinalFun(MFA, [none_type()]),
+ throw(no_input);
+ false ->
+ NewParams = lists:zipwith(fun update_info/2, Params, Ranges),
+ NewCfg = hipe_icode_cfg:params_update(Cfg, NewParams),
+ Info = enter_defines(NewParams, gb_trees:empty()),
+ InfoMap = gb_trees:insert({Start, in}, Info, gb_trees:empty()),
+ #state{info_map=InfoMap, cfg=NewCfg, liveness=Liveness,
+ ret_type=none_type(),
+ lookup_fun=CallFun, result_action=FinalFun}
+ end.
+
+-spec state__cfg(#state{}) -> cfg().
+
+state__cfg(#state{cfg=Cfg}) ->
+ Cfg.
+
+-spec state__bb(#state{}, label()) -> bb().
+
+state__bb(#state{cfg=Cfg}, Label) ->
+ BB = hipe_icode_cfg:bb(Cfg, Label),
+ true = hipe_bb:is_bb(BB), % Just an assert
+ BB.
+
+-spec state__bb_add(#state{}, label(), bb()) -> #state{}.
+
+state__bb_add(S=#state{cfg=Cfg}, Label, BB) ->
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB),
+ S#state{cfg=NewCfg}.
+
+state__lookup_fun(#state{lookup_fun=LF}) -> LF.
+
+state__result_action(#state{result_action=RA}) -> RA.
+
+state__ret_type(#state{ret_type=RT}) -> RT.
+
+state__ret_type_update(#state{ret_type=RT} = State, NewType) ->
+ TotType = sup(RT, NewType),
+ State#state{ret_type=TotType}.
+
+state__info_in(S, Label) ->
+ state__info(S, {Label, in}).
+
+state__info(#state{info_map=IM}, Key) ->
+ gb_trees:get(Key, IM).
+
+state__update_info(State, LabelInfo, Rewrite) ->
+ update_info(LabelInfo, State, [], Rewrite).
+
+update_info([{Label,InfoIn}|Rest], State, LabelAcc, Rewrite) ->
+ case state__info_in_update(State, Label, InfoIn) of
+ fixpoint ->
+ if Rewrite ->
+ update_info(Rest, State, [Label|LabelAcc], Rewrite);
+ true ->
+ update_info(Rest, State, LabelAcc, Rewrite)
+ end;
+ NewState ->
+ update_info(Rest, NewState, [Label|LabelAcc], Rewrite)
+ end;
+update_info([], State, LabelAcc, _Rewrite) ->
+ {State, LabelAcc}.
+
+state__info_in_update(S=#state{info_map=IM,liveness=Liveness}, Label, Info) ->
+ LabelIn = {Label, in},
+ case gb_trees:lookup(LabelIn, IM) of
+ none ->
+ LiveIn = hipe_icode_ssa:ssa_liveness__livein(Liveness, Label),
+ NamesLiveIn = [hipe_icode:var_name(Var) || Var <- LiveIn,
+ hipe_icode:is_var(Var)],
+ OldInfo = gb_trees:empty(),
+ case join_info_in(NamesLiveIn, OldInfo, Info) of
+ fixpoint ->
+ S#state{info_map=gb_trees:insert(LabelIn, OldInfo, IM)};
+ NewInfo ->
+ S#state{info_map=gb_trees:enter(LabelIn, NewInfo, IM)}
+ end;
+ {value, OldInfo} ->
+ OldVars = gb_trees:keys(OldInfo),
+ case join_info_in(OldVars, OldInfo, Info) of
+ fixpoint ->
+ fixpoint;
+ NewInfo ->
+ S#state{info_map=gb_trees:update(LabelIn, NewInfo, IM)}
+ end
+ end.
+
+join_info_in(Vars, OldInfo, NewInfo) ->
+ case join_info_in(Vars, OldInfo, NewInfo, gb_trees:empty(), false) of
+ {Res, true} -> Res;
+ {_, false} -> fixpoint
+ end.
+
+join_info_in([Var|Left], Info1, Info2, Acc, Changed) ->
+ Type1 = gb_trees:lookup(Var, Info1),
+ Type2 = gb_trees:lookup(Var, Info2),
+ case {Type1, Type2} of
+ {none, none} ->
+ NewTree = gb_trees:insert(Var, none_type(), Acc),
+ join_info_in(Left, Info1, Info2, NewTree, true);
+ {none, {value, Val}} ->
+ NewTree = gb_trees:insert(Var, Val, Acc),
+ join_info_in(Left, Info1, Info2, NewTree, true);
+ {{value, Val}, none} ->
+ NewTree = gb_trees:insert(Var, Val, Acc),
+ join_info_in(Left, Info1, Info2, NewTree, Changed);
+ {{value, Val}, {value, Val}} ->
+ NewTree = gb_trees:insert(Var, Val, Acc),
+ join_info_in(Left, Info1, Info2, NewTree, Changed);
+ {{value, Val1}, {value, Val2}} ->
+ NewVal =
+ case sup(Val1, Val2) of
+ Val1 ->
+ NewChanged = Changed,
+ Val1;
+ Val ->
+ NewChanged = true,
+ Val
+ end,
+ NewTree = gb_trees:insert(Var, NewVal, Acc),
+ join_info_in(Left, Info1, Info2, NewTree, NewChanged)
+ end;
+join_info_in([], _Info1, _Info2, Acc, NewChanged) ->
+ {Acc, NewChanged}.
+
+enter_defines([Def|Rest], Info) ->
+ enter_defines(Rest, enter_define(Def, Info));
+enter_defines([], Info) -> Info.
+
+enter_define({PossibleVar, Range = #range{}}, Info) ->
+ case hipe_icode:is_var(PossibleVar) of
+ true ->
+ gb_trees:enter(hipe_icode:var_name(PossibleVar), Range, Info);
+ false ->
+ Info
+ end;
+enter_define(PossibleVar, Info) ->
+ case hipe_icode:is_var(PossibleVar) of
+ true ->
+ case hipe_icode:variable_annotation(PossibleVar) of
+ {range_anno, #ann{range=Range}, _} ->
+ gb_trees:enter(hipe_icode:var_name(PossibleVar), Range, Info);
+ _ ->
+ Info
+ end;
+ false ->
+ Info
+ end.
+
+enter_vals(Ins, Info) ->
+ NewInfo = enter_defines(hipe_icode:args(Ins), Info),
+ enter_defines(hipe_icode:defines(Ins), NewInfo).
+
+lookup(PossibleVar, Info) ->
+ case hipe_icode:is_var(PossibleVar) of
+ true ->
+ case gb_trees:lookup(hipe_icode:var_name(PossibleVar), Info) of
+ none ->
+ none_type();
+ {value, Val} ->
+ Val
+ end;
+ false ->
+ none_type()
+ end.
+
+%% _________________________________________________________________
+%%
+%% The worklist.
+%%
+
+init_work(State) ->
+ %% Labels = hipe_icode_cfg:reverse_postorder(state__cfg(State)),
+ Labels = [hipe_icode_cfg:start_label(state__cfg(State))],
+ {Labels, [], sets:from_list(Labels)}.
+
+get_work({[Label|Left], List, Set}) ->
+ NewWork = {Left, List, sets:del_element(Label, Set)},
+ {Label, NewWork};
+get_work({[], [], _Set}) ->
+ fixpoint;
+get_work({[], List, Set}) ->
+ get_work({lists:reverse(List), [], Set}).
+
+add_work(Work = {List1, List2, Set}, [Label|Left]) ->
+ case sets:is_element(Label, Set) of
+ true ->
+ add_work(Work, Left);
+ false ->
+ %% io:format("Adding work: ~w\n", [Label]),
+ add_work({List1, [Label|List2], sets:add_element(Label, Set)}, Left)
+ end;
+add_work(Work, []) ->
+ Work.
+
+convert_cfg_to_types(Cfg) ->
+ Lbls = hipe_icode_cfg:reverse_postorder(Cfg),
+ lists:foldl(fun convert_lbl_to_type/2, Cfg, Lbls).
+
+convert_lbl_to_type(Lbl, Cfg) ->
+ BB = hipe_icode_cfg:bb(Cfg, Lbl),
+ Code = hipe_bb:code(BB),
+ NewCode = [convert_instr_to_type(I) || I <- Code],
+ hipe_icode_cfg:bb_add(Cfg, Lbl, hipe_bb:mk_bb(NewCode)).
+
+convert_instr_to_type(I) ->
+ Uses = hipe_icode:uses(I),
+ UseSubstList = [{Use, convert_to_types(Use)} ||
+ Use <- Uses, hipe_icode:is_annotated_variable(Use)],
+ NewI = hipe_icode:subst_uses(UseSubstList, I),
+ Defs = hipe_icode:defines(NewI),
+ DefSubstList = [{Def, convert_to_types(Def)} ||
+ Def <- Defs, hipe_icode:is_annotated_variable(Def)],
+ hipe_icode:subst_defines(DefSubstList, NewI).
+
+convert_to_types(VarOrReg) ->
+ Annotation =
+ case hipe_icode:variable_annotation(VarOrReg) of
+ {range_anno, Ann, _} ->
+ {type_anno, convert_ann_to_types(Ann), fun erl_types:t_to_string/1};
+ {type_anno, _, _} = TypeAnn ->
+ TypeAnn
+ end,
+ hipe_icode:annotate_variable(VarOrReg, Annotation).
+
+convert_ann_to_types(#ann{range=#range{range={Min,Max}, other=false}}) ->
+ t_from_range_unsafe(Min, Max);
+convert_ann_to_types(#ann{range=#range{range=empty, other=false}}) ->
+ t_none();
+convert_ann_to_types(#ann{range=#range{other=true}, type=Type}) ->
+ Type.
+
+%%=====================================================================
+%% Icode Coordinator Callbacks
+%%=====================================================================
+
+-spec replace_nones([#range{}]) -> [#range{}].
+replace_nones(Args) ->
+ [replace_none(Arg) || Arg <- Args].
+
+replace_none(Arg) ->
+ case range__is_none(Arg) of
+ true -> any_type();
+ false -> Arg
+ end.
+
+-spec update__info([#range{}], [#range{}]) -> {boolean(), [#ann{}]}.
+update__info(NewRanges, OldRanges) ->
+ SupFun = fun (Ann, Range) ->
+ join_info(Ann, Range, fun safe_widen/3)
+ end,
+ EqFun = fun (X, Y) -> X =:= Y end,
+ ResRanges = lists:zipwith(SupFun, OldRanges, NewRanges),
+ Change = lists:zipwith(EqFun, ResRanges, OldRanges),
+ {lists:all(fun (X) -> X end, Change), ResRanges}.
+
+-spec new__info/1 :: ([#range{}]) -> [#ann{}].
+new__info(NewRanges) ->
+ [#ann{range=Range,count=1,type=t_any()} || Range <- NewRanges].
+
+-spec return__info/1 :: ([#ann{}]) -> [#range{}].
+return__info(Ranges) ->
+ [Range || #ann{range=Range} <- Ranges].
+
+-spec return_none/0 :: () -> [#range{},...].
+return_none() ->
+ [none_type()].
+
+-spec return_none_args/2 :: (#cfg{}, mfa()) -> [#range{}].
+return_none_args(Cfg, {_M,_F,A}) ->
+ NoArgs =
+ case hipe_icode_cfg:is_closure(Cfg) of
+ true -> hipe_icode_cfg:closure_arity(Cfg) + 1;
+ false -> A
+ end,
+ lists:duplicate(NoArgs, none_type()).
+
+-spec return_any_args/2 :: (#cfg{}, mfa()) -> [#range{}].
+return_any_args(Cfg, {_M,_F,A}) ->
+ NoArgs =
+ case hipe_icode_cfg:is_closure(Cfg) of
+ true -> hipe_icode_cfg:closure_arity(Cfg) + 1;
+ false -> A
+ end,
+ lists:duplicate(NoArgs, any_type()).
+
+%%=====================================================================
+
+next_up_limit(X) when is_integer(X), X < 0 -> 0;
+next_up_limit(X) when is_integer(X), X < 255 -> 255;
+next_up_limit(X) when is_integer(X), X < 16#10ffff -> 16#10ffff;
+next_up_limit(X) when is_integer(X), X < 16#7ffffff -> 16#7ffffff;
+next_up_limit(X) when is_integer(X), X < 16#7fffffff -> 16#7fffffff;
+next_up_limit(X) when is_integer(X), X < 16#ffffffff -> 16#ffffffff;
+next_up_limit(X) when is_integer(X), X < 16#fffffffffff -> 16#fffffffffff;
+next_up_limit(X) when is_integer(X), X < 16#7fffffffffffffff -> 16#7fffffffffffffff;
+next_up_limit(_X) -> pos_inf.
+
+next_down_limit(X) when is_integer(X), X > 0 -> 0;
+next_down_limit(X) when is_integer(X), X > -256 -> -256;
+next_down_limit(X) when is_integer(X), X > -16#10ffff -> -16#10ffff;
+next_down_limit(X) when is_integer(X), X > -16#8000000 -> -16#8000000;
+next_down_limit(X) when is_integer(X), X > -16#80000000 -> -16#80000000;
+next_down_limit(X) when is_integer(X), X > -16#800000000000000 -> -16#800000000000000;
+next_down_limit(_X) -> neg_inf.
diff --git a/lib/hipe/icode/hipe_icode_split_arith.erl b/lib/hipe/icode/hipe_icode_split_arith.erl
new file mode 100644
index 0000000000..d59f9247fa
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_split_arith.erl
@@ -0,0 +1,553 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-------------------------------------------------------------------
+%% File : hipe_icode_split_arith.erl
+%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%% Description :
+%%
+%% Created : 12 Nov 2003 by Tobias Lindahl <tobiasl@it.uu.se>
+%%-------------------------------------------------------------------
+-module(hipe_icode_split_arith).
+
+-export([cfg/3]).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+
+-define(MIN_RATIO, 0.005).
+
+%%-------------------------------------------------------------------
+
+-spec cfg(#cfg{}, mfa(), comp_options()) -> #cfg{}.
+
+cfg(Cfg, _MFA, Options) ->
+ Icode = hipe_icode_cfg:cfg_to_linear(Cfg),
+ case proplists:get_bool(split_arith_unsafe, Options) of
+ true -> make_split_unsafe(Icode);
+ _ ->
+ case preprocess(Icode) of
+ {do_not_split, _Ratio} ->
+ Cfg;
+ {split, _Ratio, Icode1} ->
+ NewCfg = split(Icode1),
+ %% hipe_icode_cfg:pp(NewCfg),
+ NewCfg
+ end
+ end.
+
+check_nofix_const([Arg1|Arg2]) ->
+ case hipe_icode:is_const(Arg1) of
+ true ->
+ Val1 = hipe_tagscheme:fixnum_val(hipe_icode:const_value(Arg1)),
+ case hipe_tagscheme:is_fixnum(Val1) of
+ true ->
+ check_nofix_const(Arg2);
+ false -> {no}
+ end;
+ false ->
+ check_nofix_const(Arg2)
+ end;
+check_nofix_const([]) -> true.
+
+check_const([I|Left]) ->
+ case I of
+ #icode_call{} ->
+ case is_arith(I) of
+ true ->
+ Args = hipe_icode:call_args(I),
+ case check_nofix_const(Args) of
+ {no} -> {do_not_split};
+ _ -> check_const(Left)
+ end;
+ _ -> check_const(Left)
+ end;
+ _ -> check_const(Left)
+ end;
+check_const([]) -> {yes}.
+
+make_split_unsafe(Icode) ->
+ LinearCode = hipe_icode:icode_code(Icode),
+ NewLinearCode = change_unsafe(LinearCode),
+ NewIcode = hipe_icode:icode_code_update(Icode, NewLinearCode),
+ hipe_icode_cfg:linear_to_cfg(NewIcode).
+
+change_unsafe([I|Is]) ->
+ case I of
+ #icode_call{} ->
+ case is_arith_extra_unsafe(I) of
+ true ->
+ NewOp = arithop_to_extra_unsafe(hipe_icode:call_fun(I)),
+ NewI1 = hipe_icode:call_fun_update(I, NewOp),
+ [NewI1|change_unsafe(Is)];
+ false ->
+ [I|change_unsafe(Is)]
+ end;
+ _ ->
+ [I|change_unsafe(Is)]
+ end;
+change_unsafe([]) -> [].
+
+preprocess(Icode) ->
+ LinearCode = hipe_icode:icode_code(Icode),
+ case check_const(LinearCode) of
+ {do_not_split} -> %%io:format("NO FIXNUM....."),
+ {do_not_split, 1.9849}; % Ratio val is ignored
+ _ ->
+ {NofArith, NofIns, NewLinearCode} = preprocess_code(LinearCode),
+ case NofArith / NofIns of
+ X when X >= ?MIN_RATIO ->
+ NewIcode = hipe_icode:icode_code_update(Icode, NewLinearCode),
+ {split, X, NewIcode};
+ Y ->
+ {do_not_split, Y}
+ end
+ end.
+
+preprocess_code([H|Code]) ->
+ preprocess_code(Code, 0, 0, [H]).
+
+preprocess_code([I|Left], NofArith, NofIns, CodeAcc = [PrevI|_]) ->
+ case I of
+ #icode_call{} ->
+ case is_arith(I) of
+ true ->
+ %% Note that we need to put these instructions in a separate
+ %% basic block since we need the ability to fail to these
+ %% instructions, but also fail from them. The basic block
+ %% merger will take care of unnecessary splits.
+
+ %% If call is an arithmetic operation replace the operation
+ %% with the specified replacement operator.
+ NewOp = arithop_to_split(hipe_icode:call_fun(I)),
+ NewI = hipe_icode:call_fun_update(I, NewOp),
+ case hipe_icode:is_label(PrevI) of
+ true ->
+ case (Left =:= []) orelse hipe_icode:is_label(hd(Left)) of
+ true ->
+ preprocess_code(Left, NofArith+1, NofIns+1, [NewI|CodeAcc]);
+ false ->
+ NewLabel = hipe_icode:mk_new_label(),
+ NewLabelName = hipe_icode:label_name(NewLabel),
+ NewI1 = hipe_icode:call_set_continuation(NewI, NewLabelName),
+ preprocess_code(Left, NofArith+1, NofIns+1,
+ [NewLabel, NewI1|CodeAcc])
+ end;
+ false ->
+ RevPreCode =
+ case hipe_icode:is_branch(PrevI) of
+ true ->
+ [hipe_icode:mk_new_label()];
+ false ->
+ NewLabel1 = hipe_icode:mk_new_label(),
+ NewLabelName1 = hipe_icode:label_name(NewLabel1),
+ [NewLabel1, hipe_icode:mk_goto(NewLabelName1)]
+ end,
+ case (Left =:= []) orelse hipe_icode:is_label(hd(Left)) of
+ true ->
+ preprocess_code(Left, NofArith+1, NofIns+1,
+ [NewI|RevPreCode] ++ CodeAcc);
+ false ->
+ NewLabel2 = hipe_icode:mk_new_label(),
+ NewLabelName2 = hipe_icode:label_name(NewLabel2),
+ NewI1 = hipe_icode:call_set_continuation(NewI, NewLabelName2),
+ preprocess_code(Left, NofArith+1, NofIns+1,
+ [NewLabel2, NewI1|RevPreCode] ++ CodeAcc)
+ end
+ end;
+ false ->
+ preprocess_code(Left, NofArith, NofIns + 1, [I|CodeAcc])
+ end;
+ #icode_label{} ->
+ %% Don't count labels as instructions.
+ preprocess_code(Left, NofArith, NofIns, [I|CodeAcc]);
+ _ ->
+ preprocess_code(Left, NofArith, NofIns+1, [I|CodeAcc])
+ end;
+preprocess_code([], NofArith, NofIns, CodeAcc) ->
+ {NofArith, NofIns, lists:reverse(CodeAcc)}.
+
+split(Icode) ->
+ LinearCode = hipe_icode:icode_code(Icode),
+ %% create a new icode label for each existing icode label
+ %% create mappings, NewToOld and OldToNew.
+ AllLabels = lists:foldl(fun(I, Acc) ->
+ case hipe_icode:is_label(I) of
+ true -> [hipe_icode:label_name(I)|Acc];
+ false -> Acc
+ end
+ end, [], LinearCode),
+ {OldToNewMap, NewToOldMap} = new_label_maps(AllLabels),
+
+ %% the call below doubles the number of basic blocks with the new
+ %% labels instead of the old.
+
+ NewLinearCode = map_code(LinearCode, OldToNewMap),
+ NewIcode = hipe_icode:icode_code_update(Icode, NewLinearCode),
+ NewCfg = hipe_icode_cfg:linear_to_cfg(NewIcode),
+ NewCfg2 =
+ insert_tests(NewCfg, [gb_trees:get(X, OldToNewMap) || X<-AllLabels],
+ NewToOldMap, OldToNewMap),
+ %% io:format("split(Cfg): Inserting testsL Done\n", []),
+ NewCfg2.
+
+map_code(OldCode, LabelMap) ->
+ AddedCode = map_code(OldCode, none, LabelMap, []),
+ OldCode ++ AddedCode.
+
+map_code([I|Left], ArithFail, LabelMap, Acc) ->
+ case I of
+ #icode_call{} ->
+ case is_arith(I) of
+ true ->
+ case hipe_icode:defines(I) of
+ []->
+ map_code(Left, ArithFail, LabelMap, [redirect(I, LabelMap)|Acc]);
+ _ ->
+ NewOp = split_to_unsafe(I),
+ NewI1 = hipe_icode:call_fun_update(I, NewOp),
+ NewI2 = redirect(NewI1, LabelMap),
+ NewI3 = hipe_icode:call_set_fail_label(NewI2, ArithFail),
+ map_code(Left, ArithFail, LabelMap, [NewI3|Acc])
+ end;
+ false ->
+ map_code(Left, ArithFail, LabelMap, [redirect(I, LabelMap)|Acc])
+ end;
+ #icode_label{} ->
+ LabelName = hipe_icode:label_name(I),
+ NewLabel = hipe_icode:mk_label(gb_trees:get(LabelName, LabelMap)),
+ map_code(Left, LabelName, LabelMap, [NewLabel|Acc]);
+ _ ->
+ map_code(Left, ArithFail, LabelMap, [redirect(I, LabelMap)|Acc])
+ end;
+map_code([], _ArithFail, _LabelMap, Acc) ->
+ lists:reverse(Acc).
+
+insert_tests(Cfg, Labels,NewToOldMap, OldToNewMap) ->
+ InfoMap = infomap_init(Labels),
+ %%io:format("insert_tests/3: Finding testpoints ...\n", []),
+ NewInfoMap = find_testpoints(Cfg, Labels, InfoMap),
+ %%io:format("insert_tests/3: Finding testpoints: Done\n", []),
+ %%io:format("insert_tests/3: Infomap: ~w\n", [gb_trees:to_list(NewInfoMap)]),
+ make_tests(Cfg, NewInfoMap, NewToOldMap, OldToNewMap).
+
+find_testpoints(Cfg, Labels, InfoMap) ->
+ case find_testpoints(Labels, InfoMap, Cfg, false) of
+ {dirty, NewInfoMap} ->
+ %%io:format("find_testpoints/3: Looping\n", []),
+ find_testpoints(Cfg, Labels, NewInfoMap);
+ fixpoint ->
+ InfoMap
+ end.
+
+find_testpoints([Lbl|Left], InfoMap, Cfg, Dirty) ->
+ Code = hipe_bb:code(hipe_icode_cfg:bb(Cfg, Lbl)),
+ InfoOut = join_info(hipe_icode_cfg:succ(Cfg, Lbl), InfoMap),
+ OldInfoIn = infomap_get_all(Lbl, InfoMap),
+ NewInfoIn = traverse_code(lists:reverse(Code), InfoOut),
+ case (gb_sets:is_subset(OldInfoIn, NewInfoIn) andalso
+ gb_sets:is_subset(NewInfoIn, OldInfoIn)) of
+ true ->
+ find_testpoints(Left, InfoMap, Cfg, Dirty);
+ false ->
+ %%io:format("find_testpoints/4: Label: ~w: OldMap ~w\nNewMap: ~w\n",
+ %% [Lbl, gb_sets:to_list(OldInfoIn), gb_sets:to_list(NewInfoIn)]),
+ NewInfoMap = gb_trees:update(Lbl, NewInfoIn, InfoMap),
+ find_testpoints(Left, NewInfoMap, Cfg, true)
+ end;
+find_testpoints([], InfoMap, _Cfg, Dirty) ->
+ if Dirty -> {dirty, InfoMap};
+ true -> fixpoint
+ end.
+
+traverse_code([I|Left], Info) ->
+ NewInfo = kill_defines(I, Info),
+ case I of
+ #icode_call{} ->
+ case is_unsafe_arith(I) of
+ true ->
+ %% The dst is sure to be a fixnum. Remove the 'killed' mark.
+ Dst = hd(hipe_icode:call_dstlist(I)),
+ NewInfo1 = gb_sets:delete_any({killed, Dst}, NewInfo),
+ NewInfo2 =
+ gb_sets:union(NewInfo1, gb_sets:from_list(hipe_icode:uses(I))),
+ traverse_code(Left, NewInfo2);
+ false ->
+ traverse_code(Left, NewInfo)
+ end;
+ #icode_move{} ->
+ Dst = hipe_icode:move_dst(I),
+ case gb_sets:is_member(Dst, Info) of
+ true ->
+ %% The dst is an argument to an arith op. Transfer the test
+ %% to the src and remove the 'killed' mark from the dst.
+ NewInfo1 = gb_sets:delete({killed, Dst}, NewInfo),
+ Src = hipe_icode:move_src(I),
+ case hipe_icode:is_const(Src) of
+ true ->
+ traverse_code(Left, NewInfo1);
+ false ->
+ NewInfo2 = gb_sets:add(Src, NewInfo1),
+ traverse_code(Left, NewInfo2)
+ end;
+ false ->
+ traverse_code(Left, NewInfo)
+ end;
+ _ ->
+ traverse_code(Left, NewInfo)
+ end;
+traverse_code([], Info) ->
+ Info.
+
+kill_defines(I, Info) ->
+ Defines = hipe_icode:defines(I),
+ case [X || X<-Defines, gb_sets:is_member(X, Info)] of
+ [] ->
+ Info;
+ List ->
+ TmpInfo = gb_sets:difference(Info, gb_sets:from_list(List)),
+ gb_sets:union(gb_sets:from_list([{killed, X} || X <- List]), TmpInfo)
+ end.
+
+make_tests(Cfg, InfoMap, NewToOldMap, OldToNewMap) ->
+ %%io:format("make_tests 0:\n",[]),
+ WorkList = make_worklist(gb_trees:keys(NewToOldMap), InfoMap,
+ NewToOldMap, Cfg, []),
+ %%io:format("make_tests 1:Worklist: ~w\n",[WorkList]),
+ NewCfg = make_tests(WorkList, Cfg),
+ %%io:format("make_tests 2\n",[]),
+ %% If the arguments to this function are used in unsafe arith
+ %% they should be marked as killed by a new start block.
+ Args = hipe_icode_cfg:params(NewCfg),
+ Start = hipe_icode_cfg:start_label(NewCfg),
+ AltStart = gb_trees:get(Start, OldToNewMap),
+ UnsafeIn = gb_sets:to_list(infomap_get(AltStart, InfoMap)),
+ case [X || X <- UnsafeIn, Y <- Args, X =:= Y] of
+ [] ->
+ hipe_icode_cfg:start_label_update(NewCfg, AltStart);
+ KilledArgs ->
+ NewStart = hipe_icode:label_name(hipe_icode:mk_new_label()),
+ NewCfg1 = insert_test_block(NewStart, AltStart, Start,
+ KilledArgs, NewCfg),
+ hipe_icode_cfg:start_label_update(NewCfg1, NewStart)
+ end.
+
+make_worklist([Lbl|Left], InfoMap, LabelMap, Cfg, Acc) ->
+ Vars = infomap_get_killed(Lbl, InfoMap),
+ case gb_sets:is_empty(Vars) of
+ true -> make_worklist(Left, InfoMap, LabelMap, Cfg, Acc);
+ false ->
+ %% io:format("make_worklist 1 ~w\n", [Vars]),
+ NewAcc0 =
+ [{Lbl, Succ, gb_trees:get(Succ, LabelMap),
+ gb_sets:intersection(infomap_get(Succ, InfoMap), Vars)}
+ || Succ <- hipe_icode_cfg:succ(Cfg, Lbl)],
+ NewAcc = [{Label, Succ, FailLbl, gb_sets:to_list(PrunedVars)}
+ || {Label, Succ, FailLbl, PrunedVars} <- NewAcc0,
+ gb_sets:is_empty(PrunedVars) =:= false] ++ Acc,
+ %% io:format("make_worklist 2\n", []),
+ make_worklist(Left, InfoMap, LabelMap, Cfg, NewAcc)
+ end;
+make_worklist([], _InfoMap, _LabelMap, _Cfg, Acc) ->
+ Acc.
+
+make_tests([{FromLbl, ToLbl, FailLbl, Vars}|Left], Cfg) ->
+ NewLbl = hipe_icode:label_name(hipe_icode:mk_new_label()),
+ TmpCfg = insert_test_block(NewLbl, ToLbl, FailLbl, Vars, Cfg),
+ NewCfg = hipe_icode_cfg:redirect(TmpCfg, FromLbl, ToLbl, NewLbl),
+ make_tests(Left, NewCfg);
+make_tests([], Cfg) ->
+ Cfg.
+
+insert_test_block(NewLbl, Succ, FailLbl, Vars, Cfg) ->
+ Code = [hipe_icode:mk_type(Vars, fixnum, Succ, FailLbl, 0.99)],
+ BB = hipe_bb:mk_bb(Code),
+ hipe_icode_cfg:bb_add(Cfg, NewLbl, BB).
+
+infomap_init(Labels) ->
+ infomap_init(Labels, gb_trees:empty()).
+
+infomap_init([Lbl|Left], Map) ->
+ infomap_init(Left, gb_trees:insert(Lbl, gb_sets:empty(), Map));
+infomap_init([], Map) ->
+ Map.
+
+join_info(Labels, Map) ->
+ join_info(Labels, Map, gb_sets:empty()).
+
+join_info([Lbl|Left], Map, Set) ->
+ join_info(Left, Map, gb_sets:union(Set, infomap_get(Lbl, Map)));
+join_info([], _Map, Set) ->
+ Set.
+
+infomap_get(Lbl, Map) ->
+ case gb_trees:lookup(Lbl, Map) of
+ none -> gb_sets:empty();
+ {value, Val} ->
+ gb_sets:filter(fun(X) -> case X of
+ {killed, _} -> false;
+ _ -> true
+ end
+ end,
+ Val)
+ end.
+
+infomap_get_all(Lbl, Map) ->
+ case gb_trees:lookup(Lbl, Map) of
+ none -> gb_sets:empty();
+ {value, Val} -> Val
+ end.
+
+infomap_get_killed(Lbl, Map) ->
+ case gb_trees:lookup(Lbl, Map) of
+ none -> gb_sets:empty();
+ {value, Val} ->
+ Fun = fun(X, Acc) ->
+ case X of
+ {killed, Var} -> [Var|Acc];
+ _ -> Acc
+ end
+ end,
+ gb_sets:from_list(lists:foldl(Fun, [], gb_sets:to_list(Val)))
+ end.
+
+%%%-------------------------------------------------------------------
+%%% General replace of '+'/'-' to super safe version
+
+arithop_to_split(Op) ->
+ case Op of
+ '+' -> gen_add;
+ '-' -> gen_sub;
+ _ -> Op
+ end.
+
+%%%-------------------------------------------------------------------
+%%% Check if it's an arith op that needs to be split
+
+is_arith(I) ->
+ case hipe_icode:call_fun(I) of
+ '+' -> true;
+ '-' -> true;
+ gen_add -> true;
+ gen_sub -> true;
+ 'bor' -> true;
+ 'bxor' -> true;
+ 'bsr' ->
+ %% Need to check that the second argument is a non-negative
+ %% fixnum. We only allow for constants to simplify things.
+ [_, Arg2] = hipe_icode:args(I),
+ hipe_icode:is_const(Arg2) andalso (hipe_icode:const_value(Arg2) >= 0);
+ 'bsl' ->
+ %% There are major issues with bsl since it doesn't flag
+ %% overflow. We cannot allow for this in this optimization pass.
+ false;
+ 'bnot' -> true;
+ 'band' -> true;
+ _ -> false
+ end.
+
+%%%-------------------------------------------------------------------
+
+is_unsafe_arith(I) ->
+ case hipe_icode:call_fun(I) of
+ unsafe_add -> true;
+ unsafe_sub -> true;
+ unsafe_bor -> true;
+ unsafe_bxor -> true;
+ unsafe_bsr -> true;
+ unsafe_bsl -> true;
+ unsafe_bnot -> true;
+ unsafe_band -> true;
+ _ -> false
+ end.
+
+split_to_unsafe(I) ->
+ case hipe_icode:call_fun(I) of
+ gen_add -> unsafe_add;
+ gen_sub -> unsafe_sub;
+ 'bor' -> unsafe_bor;
+ 'bxor' -> unsafe_bxor;
+ 'bsr' ->
+ case is_arith(I) of
+ true -> unsafe_bsr;
+ false -> 'bsr'
+ end;
+ 'bsl' ->
+ %% There are major issues with bsl since it doesn't flag
+ %% overflow. We cannot allow for this in this optimization pass.
+ 'bsl';
+ 'bnot' -> unsafe_bnot;
+ 'band' -> unsafe_band;
+ Op -> Op
+ end.
+
+%%%-------------------------------------------------------------------
+%%% FLAG = split_arith_unsafe
+
+is_arith_extra_unsafe(I) ->
+ case hipe_icode:call_fun(I) of
+ '+' -> true;
+ '-' -> true;
+ 'bor' -> true;
+ 'bxor' -> true;
+ 'bsr' -> is_arith(I);
+ 'bsl' -> false; %% See comment in is_arith/1
+ 'bnot' -> true;
+ 'band' -> true;
+ _ -> false
+ end.
+
+arithop_to_extra_unsafe(Op) ->
+ case Op of
+ '+' -> extra_unsafe_add;
+ '-' -> extra_unsafe_sub;
+ 'bor' -> unsafe_bor;
+ 'bxor' -> unsafe_bxor;
+ 'bsr' -> unsafe_bsr;
+ 'bsl' -> 'bsl'; %% See comment in split_to_unsafe/1
+ 'bnot' -> unsafe_bnot;
+ 'band' -> unsafe_band
+ end.
+
+%%%-------------------------------------------------------------------
+
+redirect(I, LabelMap) ->
+ case hipe_icode:successors(I) of
+ [] -> I;
+ Successors ->
+ RedirectMap = [{X, gb_trees:get(X, LabelMap)} || X <- Successors],
+ redirect_1(RedirectMap, I)
+ end.
+
+redirect_1([{From, To}|Left], I) ->
+ redirect_1(Left, hipe_icode:redirect_jmp(I, From, To));
+redirect_1([], I) ->
+ I.
+
+new_label_maps(Labels) ->
+ new_label_maps(Labels, gb_trees:empty(), gb_trees:empty()).
+
+new_label_maps([Lbl|Left], Map1, Map2) ->
+ NewLabel = hipe_icode:label_name(hipe_icode:mk_new_label()),
+ NewMap1 = gb_trees:insert(Lbl, NewLabel, Map1),
+ NewMap2 = gb_trees:insert(NewLabel, Lbl, Map2),
+ new_label_maps(Left, NewMap1, NewMap2);
+new_label_maps([], Map1, Map2) ->
+ {Map1, Map2}.
diff --git a/lib/hipe/icode/hipe_icode_ssa.erl b/lib/hipe/icode/hipe_icode_ssa.erl
new file mode 100755
index 0000000000..719d5d8f45
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_ssa.erl
@@ -0,0 +1,98 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_icode_ssa.erl
+%% Author :
+%% Created :
+%% Purpose : Provides interface functions for converting Icode into
+%% SSA form and back using the generic SSA converter.
+%%----------------------------------------------------------------------
+
+-module(hipe_icode_ssa).
+
+%% The following defines are needed by the included file below
+-define(CODE, hipe_icode).
+-define(CFG, hipe_icode_cfg).
+-define(LIVENESS, hipe_icode_liveness).
+-define(LIVENESS_NEEDED, true).
+
+-include("hipe_icode.hrl").
+-include("../ssa/hipe_ssa.inc").
+
+%% Declarations for exported functions which are Icode-specific.
+-spec ssa_liveness__analyze(#cfg{}) -> gb_tree().
+-spec ssa_liveness__livein(_, icode_lbl()) -> [#icode_variable{}].
+%% -spec ssa_liveness__livein(_, icode_lbl(), _) -> [#icode_var{}].
+
+%%----------------------------------------------------------------------
+%% Auxiliary operations which seriously differ between Icode and RTL.
+%%----------------------------------------------------------------------
+
+defs_to_rename(Statement) ->
+ hipe_icode:defines(Statement).
+
+uses_to_rename(Statement) ->
+ hipe_icode:uses(Statement).
+
+liveout_no_succ() ->
+ [].
+
+%%----------------------------------------------------------------------
+
+reset_var_indx() ->
+ hipe_gensym:set_var(icode, 0).
+
+%%----------------------------------------------------------------------
+
+is_fp_temp(Temp) ->
+ hipe_icode:is_fvar(Temp).
+
+mk_new_fp_temp() ->
+ hipe_icode:mk_new_fvar().
+
+%%----------------------------------------------------------------------
+%% Procedure : makePhiMove
+%% Purpose : Create an ICode-specific version of a move instruction
+%% depending on the type of the arguments.
+%% Arguments : Dst, Src - the arguments of a Phi instruction that is
+%% to be moved up the predecessor block as part
+%% of the SSA unconvert phase.
+%% Returns : Code
+%%----------------------------------------------------------------------
+
+makePhiMove(Dst, Src) ->
+ case hipe_icode:is_fvar(Dst) of
+ false ->
+ case hipe_icode:is_fvar(Src) of
+ false ->
+ hipe_icode:mk_move(Dst, Src);
+ true ->
+ hipe_icode:mk_primop([Dst], unsafe_tag_float, [Src])
+ end;
+ true ->
+ case hipe_icode:is_fvar(Src) of
+ true ->
+ hipe_icode:mk_move(Dst, Src);
+ false ->
+ hipe_icode:mk_primop([Dst], conv_to_float, [Src])
+ end
+ end.
+
+%%----------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode_ssa_const_prop.erl b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl
new file mode 100644
index 0000000000..f1640b1cee
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl
@@ -0,0 +1,728 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ============================================================================
+%% Filename : hipe_icode_ssa_const_prop.erl
+%% Authors : Daniel Luna, Erik Andersson
+%% Purpose : Perform sparse conditional constant propagation on Icode.
+%% Notes : Works on the control-flow graph.
+%%
+%% History : * 2003-03-05: Created.
+%% * 2003-08-11: Passed simple testsuite.
+%% * 2003-10-01: Passed compiler testsuite.
+%% ============================================================================
+%%
+%% Exports: propagate/1.
+%%
+%% ============================================================================
+%%
+%% TODO:
+%%
+%% Take care of failures in call and replace operation with appropriate
+%% failure.
+%%
+%% Handle ifs with non-binary operators
+%%
+%% We want multisets for easier (and faster) creation of env->ssa_edges
+%%
+%% Maybe do things with begin_handler, begin_try if possible
+%%
+%% Propagation of constant arguments when some of the arguments are bottom
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_icode_ssa_const_prop).
+-export([propagate/1]).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+-include("hipe_icode_primops.hrl").
+
+-define(CONST_PROP_MSG(Str,L), ok).
+%%-define(CONST_PROP_MSG(Str,L), io:format(Str,L)).
+
+%%-define(DEBUG, 1).
+
+%%-----------------------------------------------------------------------------
+%% Include stuff shared between SCCP on Icode and RTL.
+%% NOTE: Needs to appear after DEBUG is possibly defined.
+%%-----------------------------------------------------------------------------
+
+-define(CODE, hipe_icode).
+-define(CFG, hipe_icode_cfg).
+
+-include("../ssa/hipe_ssa_const_prop.inc").
+
+%%-----------------------------------------------------------------------------
+
+visit_expression(Instruction, Environment) ->
+ EvaluatedArguments = [lookup_lattice_value(Argument, Environment)
+ || Argument <- hipe_icode:args(Instruction)],
+ case Instruction of
+ #icode_move{} ->
+ visit_move (Instruction, EvaluatedArguments, Environment);
+ #icode_if{} ->
+ visit_if (Instruction, EvaluatedArguments, Environment);
+ #icode_goto{} ->
+ visit_goto (Instruction, EvaluatedArguments, Environment);
+ #icode_type{} ->
+ visit_type (Instruction, EvaluatedArguments, Environment);
+ #icode_call{} ->
+ visit_call (Instruction, EvaluatedArguments, Environment);
+ #icode_switch_val{} ->
+ visit_switch_val (Instruction, EvaluatedArguments, Environment);
+ #icode_switch_tuple_arity{} ->
+ visit_switch_tuple_arity(Instruction, EvaluatedArguments, Environment);
+ #icode_begin_handler{} ->
+ visit_begin_handler (Instruction, EvaluatedArguments, Environment);
+ #icode_begin_try{} ->
+ visit_begin_try (Instruction, EvaluatedArguments, Environment);
+ #icode_fail{} ->
+ visit_fail (Instruction, EvaluatedArguments, Environment);
+ _ ->
+ %% label, end_try, comment, return,
+ {[], [], Environment}
+ end.
+
+%%-----------------------------------------------------------------------------
+
+visit_begin_try(Instruction, [], Environment) ->
+ Label = hipe_icode:begin_try_label(Instruction),
+ Successor = hipe_icode:begin_try_successor(Instruction),
+ {[Label, Successor], [], Environment}.
+
+%%-----------------------------------------------------------------------------
+
+visit_begin_handler(Instruction, _Arguments, Environment) ->
+ Destinations = hipe_icode:begin_handler_dstlist(Instruction),
+ {Environment1, SSAWork} =
+ lists:foldl(fun (Dst, {Env0,Work0}) ->
+ {Env, Work} = update_lattice_value({Dst, bottom}, Env0),
+ {Env, Work ++ Work0}
+ end,
+ {Environment, []},
+ Destinations),
+ {[], SSAWork, Environment1}.
+
+%%-----------------------------------------------------------------------------
+
+visit_switch_val(Instruction, [Argument], Environment) ->
+ Cases = hipe_icode:switch_val_cases(Instruction),
+ FailLabel = hipe_icode:switch_val_fail_label(Instruction),
+ case Argument of
+ bottom ->
+ FlowWork = [Label || {_Value, Label} <- Cases],
+ FlowWork1 = [FailLabel | FlowWork],
+ {FlowWork1, [], Environment};
+ _ ->
+ Target = get_switch_target(Cases, Argument, FailLabel),
+ {[Target], [], Environment}
+ end.
+
+%%-----------------------------------------------------------------------------
+
+visit_switch_tuple_arity(Instruction, [Argument], Environment) ->
+ Cases = hipe_icode:switch_tuple_arity_cases(Instruction),
+ FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction),
+ case Argument of
+ bottom ->
+ FlowWork = [Label || {_Value, Label} <- Cases],
+ FlowWork1 = [FailLabel | FlowWork],
+ {FlowWork1, [], Environment};
+ Constant ->
+ UnTagged = hipe_icode:const_value(Constant),
+ case is_tuple(UnTagged) of
+ true ->
+ Target = get_switch_target(Cases, tuple_size(UnTagged), FailLabel),
+ {[Target], [], Environment};
+ false ->
+ {[FailLabel], [], Environment}
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+
+get_switch_target([], _Argument, FailLabel) ->
+ FailLabel;
+get_switch_target([{CaseValue, Target} | CaseList], Argument, FailLabel) ->
+ case CaseValue =:= Argument of
+ true ->
+ Target;
+ false ->
+ get_switch_target(CaseList, Argument, FailLabel)
+ end.
+
+%%-----------------------------------------------------------------------------
+
+visit_move(Instruction, [SourceValue], Environment) ->
+ Destination = hipe_icode:move_dst(Instruction),
+ {Environment1, SSAWork} = update_lattice_value({Destination, SourceValue},
+ Environment),
+ {[], SSAWork, Environment1}.
+
+%%-----------------------------------------------------------------------------
+
+visit_if(Instruction, Arguments, Environment) ->
+ FlowWork =
+ case evaluate_if(hipe_icode:if_op(Instruction), Arguments) of
+ true ->
+ TrueLabel = hipe_icode:if_true_label(Instruction),
+ [TrueLabel];
+ false ->
+ FalseLabel = hipe_icode:if_false_label(Instruction),
+ [FalseLabel];
+ bottom ->
+ TrueLabel = hipe_icode:if_true_label(Instruction),
+ FalseLabel = hipe_icode:if_false_label(Instruction),
+ [TrueLabel, FalseLabel]
+ end,
+ {FlowWork, [], Environment}.
+
+%%-----------------------------------------------------------------------------
+
+visit_goto(Instruction, _Arguments, Environment) ->
+ GotoLabel = hipe_icode:goto_label(Instruction),
+ FlowWork = [GotoLabel],
+ {FlowWork, [], Environment}.
+
+%%-----------------------------------------------------------------------------
+
+visit_fail(Instruction, _Arguments, Environment) ->
+ FlowWork = hipe_icode:successors(Instruction),
+ {FlowWork, [], Environment}.
+
+%%-----------------------------------------------------------------------------
+
+visit_type(Instruction, Values, Environment) ->
+ FlowWork =
+ case evaluate_type(hipe_icode:type_test(Instruction), Values) of
+ true ->
+ TrueLabel = hipe_icode:type_true_label(Instruction),
+ [TrueLabel];
+ false ->
+ FalseLabel = hipe_icode:type_false_label(Instruction),
+ [FalseLabel];
+ bottom ->
+ TrueLabel = hipe_icode:type_true_label(Instruction),
+ FalseLabel = hipe_icode:type_false_label(Instruction),
+ [TrueLabel, FalseLabel]
+ end,
+ {FlowWork, [], Environment}.
+
+%%-----------------------------------------------------------------------------
+
+visit_call(Ins, Args, Environment) ->
+ Dsts = hipe_icode:call_dstlist(Ins),
+ Fun = hipe_icode:call_fun(Ins),
+ Fail = call_fail_labels(Ins),
+ Cont = call_continuation_labels(Ins),
+ visit_call(Dsts, Args, Fun, Cont, Fail, Environment).
+
+visit_call(Dst, Args, Fun, Cont, Fail, Environment) ->
+ {FlowWork, {Environment1, SSAWork}} =
+ case lists:any(fun(X) -> (X =:= bottom) end, Args) of
+ true ->
+ {Fail ++ Cont, update_lattice_value({Dst, bottom}, Environment)};
+ false ->
+ ConstArgs = [hipe_icode:const_value(Argument) || Argument <- Args],
+ try evaluate_call_or_enter(ConstArgs, Fun) of
+ bottom ->
+ {Fail ++ Cont, update_lattice_value({Dst, bottom}, Environment)};
+ Constant ->
+ {Cont, update_lattice_value({Dst, Constant}, Environment)}
+ catch
+ _:_ ->
+ {Fail, update_lattice_value({Dst, bottom}, Environment)}
+ end
+ end,
+ {FlowWork, SSAWork, Environment1}.
+
+%%-----------------------------------------------------------------------------
+
+call_fail_labels(I) ->
+ case hipe_icode:call_fail_label(I) of
+ [] -> [];
+ Label -> [Label]
+ end.
+
+call_continuation_labels(I) ->
+ case hipe_icode:call_continuation(I) of
+ [] -> [];
+ Label -> [Label]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+%% Unary calls
+evaluate_call_or_enter([Argument], Fun) ->
+ case Fun of
+ mktuple ->
+ hipe_icode:mk_const(list_to_tuple([Argument]));
+ unsafe_untag_float ->
+ hipe_icode:mk_const(float(Argument));
+ conv_to_float ->
+ hipe_icode:mk_const(float(Argument));
+ fnegate ->
+ hipe_icode:mk_const(0.0 - Argument);
+ 'bnot' ->
+ hipe_icode:mk_const(Argument);
+ #unsafe_element{index=N} ->
+ hipe_icode:mk_const(element(N, Argument));
+ {erlang, hd, 1} ->
+ hipe_icode:mk_const(hd(Argument));
+ {erlang, tl, 1} ->
+ hipe_icode:mk_const(tl(Argument));
+ {erlang, atom_to_list, 1} ->
+ hipe_icode:mk_const(atom_to_list(Argument));
+ {erlang, list_to_atom, 1} ->
+ hipe_icode:mk_const(list_to_atom(Argument));
+ {erlang, tuple_to_list, 1} ->
+ hipe_icode:mk_const(tuple_to_list(Argument));
+ {erlang, list_to_tuple, 1} ->
+ hipe_icode:mk_const(list_to_tuple(Argument));
+ {erlang, length, 1} ->
+ hipe_icode:mk_const(length(Argument));
+ {erlang, size, 1} ->
+ hipe_icode:mk_const(size(Argument));
+ {erlang, bit_size, 1} ->
+ hipe_icode:mk_const(bit_size(Argument));
+ {erlang, byte_size, 1} ->
+ hipe_icode:mk_const(byte_size(Argument));
+ {erlang, tuple_size, 1} ->
+ hipe_icode:mk_const(tuple_size(Argument));
+ {erlang, abs, 1} ->
+ hipe_icode:mk_const(abs(Argument));
+ {erlang, round, 1} ->
+ hipe_icode:mk_const(round(Argument));
+ {erlang, trunc, 1} ->
+ hipe_icode:mk_const(trunc(Argument));
+ _ ->
+ bottom
+ end;
+%% Binary calls
+evaluate_call_or_enter([Argument1,Argument2], Fun) ->
+ case Fun of
+ '+' ->
+ hipe_icode:mk_const(Argument1 + Argument2);
+ '-' ->
+ hipe_icode:mk_const(Argument1 - Argument2);
+ '*' ->
+ hipe_icode:mk_const(Argument1 * Argument2);
+ '/' ->
+ hipe_icode:mk_const(Argument1 / Argument2);
+ 'band' ->
+ hipe_icode:mk_const(Argument1 band Argument2);
+ 'bor' ->
+ hipe_icode:mk_const(Argument1 bor Argument2);
+ 'bsl' ->
+ hipe_icode:mk_const(Argument1 bsl Argument2);
+ 'bsr' ->
+ hipe_icode:mk_const(Argument1 bsr Argument2);
+ 'bxor' ->
+ hipe_icode:mk_const(Argument1 bxor Argument2);
+ fp_add ->
+ hipe_icode:mk_const(float(Argument1 + Argument2));
+ fp_sub ->
+ hipe_icode:mk_const(float(Argument1 - Argument2));
+ fp_mul ->
+ hipe_icode:mk_const(float(Argument1 * Argument2));
+ fp_div ->
+ hipe_icode:mk_const(Argument1 / Argument2);
+ cons ->
+ hipe_icode:mk_const([Argument1 | Argument2]);
+ mktuple ->
+ hipe_icode:mk_const(list_to_tuple([Argument1,Argument2]));
+ #unsafe_update_element{index=N} ->
+ hipe_icode:mk_const(setelement(N, Argument1, Argument2));
+ {erlang, '++', 2} ->
+ hipe_icode:mk_const(Argument1 ++ Argument2);
+ {erlang, '--', 2} ->
+ hipe_icode:mk_const(Argument1 -- Argument2);
+ {erlang, 'div', 2} ->
+ hipe_icode:mk_const(Argument1 div Argument2);
+ {erlang, 'rem', 2} ->
+ hipe_icode:mk_const(Argument1 rem Argument2);
+ {erlang, append_element, 2} ->
+ hipe_icode:mk_const(erlang:append_element(Argument1, Argument2));
+ {erlang, element, 2} ->
+ hipe_icode:mk_const(element(Argument1, Argument2));
+ _Other ->
+ %% io:format("In ~w(~w,~w)~n", [_Other,Argument1,Argument2]),
+ bottom
+ end;
+
+%% The rest of the calls
+evaluate_call_or_enter(Arguments, Fun) ->
+ case Fun of
+ mktuple ->
+ hipe_icode:mk_const(list_to_tuple(Arguments));
+ {erlang, setelement, 3} ->
+ [Argument1, Argument2, Argument3] = Arguments,
+ hipe_icode:mk_const(setelement(Argument1, Argument2, Argument3));
+ _ ->
+ bottom
+ end.
+
+%%-----------------------------------------------------------------------------
+
+evaluate_if(Conditional, [Argument1, Argument2]) ->
+ case ((Argument1 =:= bottom) or (Argument2 =:= bottom)) of
+ true -> bottom;
+ false -> evaluate_if_const(Conditional, Argument1, Argument2)
+ end;
+evaluate_if(_Conditional, _Arguments) ->
+ bottom.
+
+%%-----------------------------------------------------------------------------
+
+evaluate_if_const(Conditional, Argument1, Argument2) ->
+ case Conditional of
+ '=:=' -> Argument1 =:= Argument2;
+ '==' -> Argument1 == Argument2;
+ '=/=' -> Argument1 =/= Argument2;
+ '/=' -> Argument1 /= Argument2;
+ '<' -> Argument1 < Argument2;
+ '>=' -> Argument1 >= Argument2;
+ '=<' -> Argument1 =< Argument2;
+ '>' -> Argument1 > Argument2;
+ _ -> bottom
+ end.
+
+%%-----------------------------------------------------------------------------
+
+evaluate_type(Type, Vals) ->
+ case [X || X <- Vals, X =:= bottom] of
+ [] -> evaluate_type_const(Type, Vals);
+ _ -> bottom
+ end.
+
+%%-----------------------------------------------------------------------------
+
+evaluate_type_const(Type, [Arg|Left]) ->
+ Test =
+ case {Type, hipe_icode:const_value(Arg)} of
+ {nil, [] } -> true;
+ {nil, _ } -> false;
+ {cons, [_|_]} -> true;
+ {cons, _ } -> false;
+ {{tuple, N}, T} when tuple_size(T) =:= N -> true;
+ {atom, A} when is_atom(A) -> true;
+ {{atom, A}, A} when is_atom(A) -> true;
+ {{record, A, S}, R} when tuple_size(R) =:= S,
+ element(1, R) =:= A -> true;
+ {{record, _, _}, _} -> false;
+ _ -> bottom
+ end,
+ case Test of
+ bottom -> bottom;
+ false -> false;
+ true -> evaluate_type_const(Type, Left)
+ end;
+evaluate_type_const(_Type, []) ->
+ true.
+
+%%-----------------------------------------------------------------------------
+%% Icode-specific code below
+%%-----------------------------------------------------------------------------
+
+update_instruction(Instruction, Environment) ->
+ case Instruction of
+ #icode_call{} ->
+ update_call(Instruction, Environment);
+ #icode_enter{} ->
+ update_enter(Instruction, Environment);
+ #icode_if{} ->
+ update_if(Instruction, Environment);
+ #icode_move{} ->
+ update_move(Instruction, Environment);
+ #icode_phi{} ->
+ update_phi(Instruction, Environment);
+ #icode_switch_val{} ->
+ update_switch_val(Instruction, Environment);
+ #icode_type{} ->
+ update_type(Instruction, Environment);
+ #icode_switch_tuple_arity{} ->
+ update_switch_tuple_arity(Instruction, Environment);
+ _ ->
+ %% goto, comment, label, return, begin_handler, end_try,
+ %% begin_try, fail
+ %% We could but don't handle: catch?, fail?
+ [Instruction]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_call(Instruction, Environment) ->
+ DestList = hipe_icode:call_dstlist(Instruction),
+ case DestList of
+ [Destination] ->
+ case lookup_lattice_value(Destination, Environment) of
+ bottom ->
+ NewArguments = update_arguments(
+ hipe_icode:call_args(Instruction),
+ Environment),
+ [hipe_icode:call_args_update(Instruction, NewArguments)];
+ X ->
+ NewInstructions =
+ case is_call_to_fp_op(Instruction) of
+ true ->
+ TmpIns =
+ hipe_icode:call_fun_update(Instruction, unsafe_untag_float),
+ [hipe_icode:call_args_update(TmpIns, [X])];
+ false ->
+ case hipe_icode:call_continuation(Instruction) of
+ [] ->
+ [hipe_icode:mk_move(Destination, X)];
+ ContinuationLabel ->
+ [hipe_icode:mk_move(Destination, X),
+ hipe_icode:mk_goto(ContinuationLabel)]
+ end
+ end,
+ ?CONST_PROP_MSG("call: ~w ---> ~w\n",
+ [Instruction, NewInstructions]),
+ NewInstructions
+ end;
+%% %% [] -> %% No destination; we don't touch this
+%% [] ->
+%% NewArguments = update_arguments(hipe_icode:call_args(Instruction),
+%% Environment),
+%% [hipe_icode:call_args_update(Instruction, NewArguments)];
+ %% List-> %% Means register allocation; not implemented at this point
+ _ ->
+ [Instruction]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+is_call_to_fp_op(Instruction) ->
+ case hipe_icode:call_fun(Instruction) of
+ fp_add -> true;
+ fp_sub -> true;
+ fp_mul -> true;
+ fp_div -> true;
+ fnegate -> true;
+ conv_to_float -> true;
+ unsafe_untag_float -> true;
+ _ -> false
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_enter(Instruction, Environment) ->
+ Args = hipe_icode:enter_args(Instruction),
+ EvalArgs = [lookup_lattice_value(X, Environment) || X <- Args],
+ Fun = hipe_icode:enter_fun(Instruction),
+ case lists:any(fun(X) -> (X =:= bottom) end, EvalArgs) of
+ true ->
+ update_enter_arguments(Instruction, Environment);
+ false ->
+ ConstVals = [hipe_icode:const_value(X) || X <- EvalArgs],
+ try evaluate_call_or_enter(ConstVals, Fun) of
+ bottom ->
+ update_enter_arguments(Instruction, Environment);
+ Const ->
+ Dst = hipe_icode:mk_new_var(),
+ [hipe_icode:mk_move(Dst, Const),
+ hipe_icode:mk_return([Dst])]
+ catch
+ _:_ ->
+ update_enter_arguments(Instruction, Environment)
+ end
+ end.
+
+update_enter_arguments(Instruction, Env) ->
+ NewArguments = update_arguments(hipe_icode:enter_args(Instruction), Env),
+ [hipe_icode:enter_args_update(Instruction, NewArguments)].
+
+%%-----------------------------------------------------------------------------
+
+update_if(Instruction, Environment) ->
+ Args = hipe_icode:if_args(Instruction),
+ EvaluatedArguments = [lookup_lattice_value(Argument, Environment)
+ || Argument <- Args],
+ Op = hipe_icode:if_op(Instruction),
+ case evaluate_if(Op, EvaluatedArguments) of
+ true ->
+ TrueLabel = hipe_icode:if_true_label(Instruction),
+ ?CONST_PROP_MSG("ifT: ~w ---> goto ~w\n", [Instruction, TrueLabel]),
+ [hipe_icode:mk_goto(TrueLabel)];
+ false ->
+ FalseLabel = hipe_icode:if_false_label(Instruction),
+ ?CONST_PROP_MSG("ifF: ~w ---> goto ~w\n", [Instruction, FalseLabel]),
+ [hipe_icode:mk_goto(FalseLabel)];
+ bottom ->
+ %% Convert the if-test to a type test if possible.
+ Op = hipe_icode:if_op(Instruction),
+ case Op =:= '=:=' orelse Op =:= '=/=' of
+ false -> [Instruction];
+ true ->
+ [Arg1, Arg2] = Args,
+ case EvaluatedArguments of
+ [bottom, bottom] ->
+ [Instruction];
+ [bottom, X] ->
+ conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg1);
+ [X, bottom] ->
+ conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg2)
+ end
+ end
+ end.
+
+conv_if_to_type(I, Const, Arg) when is_atom(Const);
+ is_integer(Const);
+ Const =:= [] ->
+ Test =
+ if is_atom(Const) -> {atom, Const};
+ is_integer(Const) -> {integer, Const};
+ true -> nil
+ end,
+ {T, F} =
+ case hipe_icode:if_op(I) of
+ '=:=' -> {hipe_icode:if_true_label(I),hipe_icode:if_false_label(I)};
+ '=/=' -> {hipe_icode:if_false_label(I),hipe_icode:if_true_label(I)}
+ end,
+ NewI = hipe_icode:mk_type([Arg], Test, T, F),
+ ?CONST_PROP_MSG("if: ~w ---> type ~w\n", [I, NewI]),
+ [NewI];
+conv_if_to_type(I, _, _) ->
+ [I].
+
+%%-----------------------------------------------------------------------------
+
+update_move(Instruction, Environment) ->
+ Destination = hipe_icode:move_dst(Instruction),
+ case lookup_lattice_value(Destination, Environment) of
+ bottom ->
+ [Instruction];
+ X ->
+ case hipe_icode:move_src(Instruction) of
+ X ->
+ [Instruction];
+ _ ->
+ ?CONST_PROP_MSG("move: ~w ---> ~w\n", [Instruction, X]),
+ [hipe_icode:move_src_update(Instruction, X)]
+ end
+ %% == [hipe_icode:mk_move(Destination, X)]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_phi(Instruction, Environment) ->
+ Destination = hipe_icode:phi_dst(Instruction),
+ case lookup_lattice_value(Destination, Environment) of
+ bottom ->
+ [Instruction];
+ X ->
+ ?CONST_PROP_MSG("phi: ~w ---> ~w\n", [Instruction, X]),
+ [hipe_icode:mk_move(Destination, X)]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_type(Instruction, Environment) ->
+ EvaluatedArguments = [lookup_lattice_value(Argument, Environment) ||
+ Argument <- hipe_icode:type_args(Instruction)],
+ case evaluate_type(hipe_icode:type_test(Instruction), EvaluatedArguments) of
+ true ->
+ TrueLabel = hipe_icode:type_true_label(Instruction),
+ ?CONST_PROP_MSG("typeT: ~w ---> goto ~w\n", [Instruction, TrueLabel]),
+ [hipe_icode:mk_goto(TrueLabel)];
+ false ->
+ FalseLabel = hipe_icode:type_false_label(Instruction),
+ ?CONST_PROP_MSG("typeF: ~w ---> goto ~w\n", [Instruction, FalseLabel]),
+ [hipe_icode:mk_goto(FalseLabel)];
+ bottom ->
+ [Instruction]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_switch_val(Instruction, Environment) ->
+ Argument = hipe_icode:switch_val_term(Instruction),
+ Value = lookup_lattice_value(Argument, Environment),
+ case Value of
+ bottom ->
+ [Instruction];
+ _ ->
+ Cases = hipe_icode:switch_val_cases(Instruction),
+ FailLabel = hipe_icode:switch_val_fail_label(Instruction),
+ Target = get_switch_target(Cases, Value, FailLabel),
+ ?CONST_PROP_MSG("sv: ~w ---> goto ~w\n", [Instruction, Target]),
+ [hipe_icode:mk_goto(Target)]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_switch_tuple_arity(Instruction, Environment) ->
+ Argument = hipe_icode:switch_tuple_arity_term(Instruction),
+ Value = lookup_lattice_value(Argument, Environment),
+ case Value of
+ bottom ->
+ [Instruction];
+ Constant ->
+ UnTagged = hipe_icode:const_value(Constant),
+ case is_tuple(UnTagged) of
+ true ->
+ Cases = hipe_icode:switch_tuple_arity_cases(Instruction),
+ FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction),
+ Target = get_switch_target(Cases, tuple_size(UnTagged), FailLabel),
+ ?CONST_PROP_MSG("sta: ~w ---> goto ~w\n", [Instruction, Target]),
+ [hipe_icode:mk_goto(Target)];
+ false ->
+ [Instruction]
+ %% TODO: Can the above be replaced with below??? Perhaps
+ %% together with some sort of "generate failure".
+ %% [hipe_icode:mk_goto(FailLabel)]
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+
+lookup_lattice_value(X, Environment) ->
+ LatticeValues = env__lattice_values(Environment),
+ case hipe_icode:is_const(X) of
+ true ->
+ X;
+ false ->
+ case gb_trees:lookup(X, LatticeValues) of
+ none ->
+ ?WARNING_MSG("Earlier compiler steps generated erroneous "
+ "code for X = ~w. We are ignoring this.\n",[X]),
+ bottom;
+ {value, top} ->
+ ?EXIT({"lookup_lattice_value, top", X});
+ {value, Y} ->
+ Y
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+
+update_arguments(ArgumentList, Environment) ->
+ [case lookup_lattice_value(X, Environment) of
+ bottom ->
+ X;
+ Constant ->
+ Constant
+ end || X <- ArgumentList].
+
+%%----------------------------- End of file -----------------------------------
diff --git a/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl b/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl
new file mode 100644
index 0000000000..1899c09715
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl
@@ -0,0 +1,41 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-------------------------------------------------------------------
+%% File : hipe_icode_ssa_copy_prop.erl
+%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%% Description : Performs copy propagation on SSA form.
+%%
+%% Created : 4 Apr 2003 by Tobias Lindahl <tobiasl@it.uu.se>
+%%-------------------------------------------------------------------
+
+-module(hipe_icode_ssa_copy_prop).
+
+%%
+%% modules given as parameters
+%%
+-define(code, hipe_icode).
+-define(cfg, hipe_icode_cfg).
+
+%%
+%% appropriate include files
+%%
+-include("hipe_icode.hrl").
+-include("../flow/cfg.hrl").
+-include("../ssa/hipe_ssa_copy_prop.inc").
diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
new file mode 100644
index 0000000000..675c8c1ad8
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
@@ -0,0 +1,1444 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%=======================================================================
+%% File : hipe_icode_ssa_struct_reuse.erl
+%% Author : Ragnar Osterlund <ragoster@gmail.com>
+%% student at the compiler techniques 2 course at UU 2007
+%% Description : HiPE module that removes redundant or partially redundant
+%% structure creations from Icode.
+%% It does so by inserting redundant expressions as late
+%% as possible in the CFG, with the exception of loops where
+%% expressions are moved to just before the loop head.
+%% Current Icode instructions that can be moved are mktuple()
+%% and cons() primop calls. It also handles cases like
+%% f({Z}) -> {Z}. It does so by looking at the structure of
+%% the match, and recognizes tuples and conses.
+%%=======================================================================
+
+-module(hipe_icode_ssa_struct_reuse).
+
+-export([struct_reuse/1]).
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+-include("../flow/cfg.hrl").
+
+-define(SET, ordset).
+-define(SETS, ordsets).
+%%-define(DEBUG, true).
+
+-define(MKTUPLE, mktuple).
+-define(CONS, cons).
+-define(SR_INSTR_TYPE, sr_instr_type).
+-define(SR_STRUCT_INSTR_TYPE, sr_struct_instr_type).
+
+-type struct_type() :: {?CONS | ?MKTUPLE, icode_term_arg(), any()}.
+-type struct_elems() :: {icode_var(), non_neg_integer(), icode_term_arg()}.
+
+%% DATATYPE AREA
+
+%%-----------------------------------------------------------------------------
+%% maps
+%% The maps are used to identify variables and expressions.
+%% The maps are:
+%%
+%% expr - a map that contains value numbered structure expressions, ie
+%% mktuple and cons expression. The key is the value number and the value
+%% is an expr record.
+%%
+%% instr - maps the semantic instruction to an expression value number,
+%% that is, a key in the expr map above.
+%%
+%% var - maps variables to expression value numbers. These variables are
+%% defined or used by the structure expressions.
+
+-record(maps, {var = gb_trees:empty() :: gb_tree(),
+ instr = gb_trees:empty() :: gb_tree(),
+ expr = gb_trees:empty() :: gb_tree()}).
+
+maps_var(#maps{var = Out}) -> Out.
+maps_instr(#maps{instr = Out}) -> Out.
+maps_expr(#maps{expr = Out}) -> Out.
+
+maps_expr_keys(Maps) -> gb_trees:keys(maps_expr(Maps)).
+maps_expr_values(Maps) -> gb_trees:values(maps_expr(Maps)).
+
+maps_instr_lookup(Instr, Maps) -> gb_trees:lookup(Instr, maps_instr(Maps)).
+maps_instr_enter(Instr, ExprId, Maps) ->
+ NewInstr = gb_trees:enter(Instr, ExprId, maps_instr(Maps)),
+ Maps#maps{instr = NewInstr}.
+
+maps_expr_get(Id, Maps) -> gb_trees:get(Id, maps_expr(Maps)).
+maps_expr_enter(Expr, Maps) ->
+ NewExprMap = gb_trees:enter(expr_id(Expr), Expr, maps_expr(Maps)),
+ Maps#maps{expr = NewExprMap}.
+
+maps_var_get(Var, Maps) -> gb_trees:get(Var, maps_var(Maps)).
+maps_var_lookup(Var, #maps{var = VarMap}) -> gb_trees:lookup(Var, VarMap).
+maps_var_enter(Var, Info, Maps = #maps{var = VarMap}) ->
+ NewMap = gb_trees:enter(Var, Info, VarMap),
+ Maps#maps{var = NewMap}.
+maps_var_insert(Var, Info, Maps = #maps{var = VarMap}) ->
+ NewMap = gb_trees:insert(Var, Info, VarMap),
+ Maps#maps{var = NewMap}.
+
+maps_balance(Maps) ->
+ Maps#maps{instr = gb_trees:balance(maps_instr(Maps)),
+ expr = gb_trees:balance(maps_expr(Maps)),
+ var = gb_trees:balance(maps_var(Maps))}.
+
+maps_expr_key_enter(Expr, Maps) ->
+ NewMaps = maps_instr_enter(expr_key(Expr), expr_id(Expr), Maps),
+ maps_expr_enter(Expr, NewMaps).
+
+%%-----------------------------------------------------------------------------
+%% expr
+%% An expression record. Contains information about a structure expression.
+%% The fields are:
+%%
+%% id - the value number of the expression
+%% key - the semantic instruction, as defined in icode, with destination
+%% removed and arguments rewritten.
+%% defs - destination variable to hold the value of the expression.
+%% direct_replace - indicates whether the expression shall be replaced wherever
+%% it occurs, although it might not have been inserted. This is used for
+%% the expressions that are detected by the icode type constructs.
+%% inserts - a list of node labels that will insert this expression
+%% use - a list of expression value numbers that use the value of this
+%% expression
+
+-record(expr, {id = none :: 'none' | non_neg_integer(),
+ key = none :: 'none' | tuple(), % illegal_icode_instr()
+ defs = none :: 'none' | [icode_var()],
+ direct_replace = false :: boolean(),
+ inserts = ?SETS:new() :: ?SET(_),
+ use = ?SETS:new() :: ?SET(_)}).
+
+expr_id(#expr{id = Out}) -> Out.
+expr_defs(#expr{defs = Out}) -> Out.
+expr_key(#expr{key = Out}) -> Out.
+expr_inserts(#expr{inserts = Out}) -> Out.
+expr_use(#expr{use = Out}) -> Out.
+expr_direct_replace(#expr{direct_replace = Out}) -> Out.
+
+expr_use_add(Expr = #expr{use = UseSet}, Use) ->
+ Expr#expr{use = ?SETS:add_element(Use, UseSet)}.
+
+%% expr_key_set(Expr, In) -> Expr#expr{key = In}.
+expr_direct_replace_set(Expr, In) -> Expr#expr{direct_replace = In}.
+expr_inserts_set(Expr, In) -> Expr#expr{inserts = In}.
+
+expr_create(Key, Defs) ->
+ NewExprId = new_expr_id(),
+ #expr{id = NewExprId, key = Key, defs = Defs}.
+
+%%-----------------------------------------------------------------------------
+%% varinfo
+%% A variable mapping info. Contains info about variable references.
+%% The fields are:
+%%
+%% use - a set of expression value numbers that use this variable
+%% ref - the variable which value this variable will be assigned
+%% when expression is replaced. This is encoded as {N, M} where
+%% N is the expression value number and M is the nth destination
+%% variable defined by the expression N.
+%% elem - indicates that this variable has been detected to be a part of
+%% a tuple. The field contains a {V, N} tuple where V is the variable
+%% that refers to the structure that this variable is an element in
+%% and N is the position that the element occurs on in the tuple. Eg.
+%% {{var, 3}, 2} means that the variable {var, 3} refers to a tuple
+%% in which this variable is on second place.
+%% exprid - a expression value number which is the expression that
+%% the variable is defined by.
+
+-record(varinfo, {use = ?SETS:new() :: ?SET(_),
+ ref = none :: 'none' | {non_neg_integer(), non_neg_integer()},
+ elem = none :: 'none' | {icode_var(), non_neg_integer()},
+ exprid = none :: 'none' | non_neg_integer()}).
+
+varinfo_exprid(#varinfo{exprid = Out}) -> Out.
+
+varinfo_use_add(#varinfo{use = UseSet} = I, Use) ->
+ I#varinfo{use = ?SETS:add_element(Use, UseSet)}.
+
+%%-----------------------------------------------------------------------------
+%% node - a node in the temp CFG.
+%%
+%% label - the label of the node in the original CFG
+%% pred - a list of predecessors to this node
+%% succ - a list of successors to this node
+%% code - code from CFG filtered to only contain structure instructions
+%% non_struct_defs - a list of variable definitions that are not defined
+%% by structures
+%% up_expr - upwards exposed expression value numbers
+%% killed_expr - killed expressions value numbers
+%% sub_inserts - a set of labels of nodes that defines one or more
+%% expressions and that are in a subtree of this node
+%% inserts - a set of expression value numbers to be inserted into the node
+%% antic_in - a set of expression value numbers that are anticipated into
+%% the node
+%% antic_out - a set of expression value numbers that are anticipated out of
+%% the node
+%% phi - a tree of node labels which is defined in phi functions in the node
+%% varmap - a list of variable tuples {V1, V2} that maps a variable that are
+%% the output of phi functions in sub blocks, V1, into a variable
+%% flowing from the block of this node, V2.
+%% struct_type - a list of {V, N} tuples that indicates that V is a tuple
+%% with N elements. These are added from the icode primop type().
+%% struct_elems - a list of {VD, N, VS} tuples where VD is a variable in the N'th position
+%% in VS. These are added from the icode primop unsafe_element()
+
+-record(node, {
+ label = none :: 'none' | icode_lbl(),
+ pred = none :: 'none' | [icode_lbl()],
+ succ = none :: 'none' | [icode_lbl()],
+ code = [] :: [tuple()], % [illegal_icode_instr()]
+ phi = gb_trees:empty() :: gb_tree(),
+ varmap = [] :: [{icode_var(), icode_var()}],
+ pre_loop = false :: boolean(),
+ non_struct_defs = gb_sets:new() :: gb_set(),
+ up_expr = none :: 'none' | ?SET(_),
+ killed_expr = none :: 'none' | ?SET(_),
+ sub_inserts = ?SETS:new() :: ?SET(_),
+ inserts = ?SETS:new() :: ?SET(_),
+ antic_in = none :: 'none' | ?SET(_),
+ antic_out = none :: 'none' | ?SET(_),
+ struct_type = [] :: [struct_type()],
+ struct_elems = [] :: [struct_elems()]}).
+
+node_sub_inserts(#node{sub_inserts = Out}) -> Out.
+node_inserts(#node{inserts = Out}) -> Out.
+node_antic_out(#node{antic_out = Out}) -> Out.
+node_antic_in(#node{antic_in = Out}) -> Out.
+node_killed_expr(#node{killed_expr = Out}) -> Out.
+node_pred(#node{pred = Out}) -> Out.
+node_succ(#node{succ = Out}) -> Out.
+node_label(#node{label = Out}) -> Out.
+node_code(#node{code = Out}) -> Out.
+node_non_struct_defs(#node{non_struct_defs = Out}) -> Out.
+node_up_expr(#node{up_expr = Out}) -> Out.
+node_pre_loop(#node{pre_loop = Out}) -> Out.
+node_struct_type(#node{struct_type = Out}) -> Out.
+%% node_atom_type(#node{atom_type = Out}) -> Out.
+node_struct_elems(#node{struct_elems = Out}) -> Out.
+
+node_pre_loop_set(Node) -> Node#node{pre_loop = true}.
+
+node_phi_add(Node = #node{phi = Phi}, Pred, Value) ->
+ NewList =
+ case gb_trees:lookup(Pred, Phi) of
+ {value, List} -> [Value | List];
+ none -> [Value]
+ end,
+ Node#node{phi = gb_trees:enter(Pred, NewList, Phi)}.
+
+node_phi_get(#node{phi = Phi}, Pred) ->
+ case gb_trees:lookup(Pred, Phi) of
+ {value, List} -> List;
+ none -> []
+ end.
+
+node_code_add(Node = #node{code = Code}, Instr) ->
+ Node#node{code = [Instr | Code]}.
+
+node_code_rev(Node = #node{code = Code}) ->
+ Node#node{code = lists:reverse(Code)}.
+
+node_struct_type_add(Node = #node{struct_type = T}, Value) ->
+ Node#node{struct_type = [Value | T]}.
+
+%% node_atom_type_add(Node = #node{atom_type = T}, Value) ->
+%% Node#node{atom_type = [Value | T]}.
+
+node_struct_elems_add(Node = #node{struct_elems = T}, Value) ->
+ Node#node{struct_elems = [Value | T]}.
+
+node_non_struct_defs_list(Node) ->
+ gb_sets:to_list(node_non_struct_defs(Node)).
+
+node_non_struct_instr_add(Node, Instr) ->
+ DefList = hipe_icode:defines(Instr),
+ Tmp = gb_sets:union(node_non_struct_defs(Node), gb_sets:from_list(DefList)),
+ Node#node{non_struct_defs = Tmp}.
+
+node_set_sub_inserts(Node, In) -> Node#node{sub_inserts = In}.
+
+node_add_insert(Node, In) ->
+ NewIns = ?SETS:add_element(In, node_inserts(Node)),
+ Node#node{inserts = NewIns}.
+
+node_union_sub_inserts(Node, SubIns) ->
+ NewSubIns = ?SETS:union(SubIns, node_sub_inserts(Node)),
+ node_set_sub_inserts(Node, NewSubIns).
+
+node_varmap_set(Node, Vars) ->
+ Node#node{varmap = Vars}.
+
+node_varmap_lookup(#node{varmap = Varmap}, Var) ->
+ case lists:keyfind(Var, 1, Varmap) of
+ {_, NewVar} -> NewVar;
+ false -> Var
+ end.
+
+node_create(Label, Pred, Succ) ->
+ #node{label = Label, pred = Pred, succ = Succ}.
+
+%%-----------------------------------------------------------------------------
+%% nodes - describes the new temporary CFG
+%%
+%% domtree - the dominator tree of the original CFG
+%% labels - the labels of the original CFG, filtered to only contain non fail trace paths
+%% postorder - the postorder walk of labels of the original CFG, filtered to only contain non fail trace paths
+%% rev_postorder - reverse of postorder.
+%% start_label - the start basic block label.
+%% all_expr - all expression value numbers that the CFG defines
+%% tree - the tree of nodes, with labels as keys and node records as values
+
+-record(nodes, {
+ domtree :: hipe_dominators:domTree(),
+ labels = none :: 'none' | [icode_lbl()],
+ postorder = none :: 'none' | [icode_lbl()],
+ start_label = none :: 'none' | icode_lbl(),
+ rev_postorder = none :: 'none' | [icode_lbl()],
+ all_expr = none :: 'none' | [non_neg_integer()],
+ tree = gb_trees:empty() :: gb_tree()}).
+
+nodes_postorder(#nodes{postorder = Out}) -> Out.
+nodes_rev_postorder(#nodes{rev_postorder = Out}) -> Out.
+nodes_tree(#nodes{tree = Out}) -> Out.
+nodes_domtree(#nodes{domtree = Out}) -> Out.
+nodes_start_label(#nodes{start_label = Out}) -> Out.
+
+nodes_tree_is_empty(#nodes{tree = Tree}) ->
+ gb_trees:is_empty(Tree).
+
+nodes_tree_set(Tree, Nodes) -> Nodes#nodes{tree = Tree}.
+nodes_all_expr_set(AllExpr, Nodes) -> Nodes#nodes{all_expr = AllExpr}.
+
+nodes_tree_values(Nodes) ->
+ gb_trees:values(nodes_tree(Nodes)).
+
+get_node(Label, Nodes) ->
+ gb_trees:get(Label, nodes_tree(Nodes)).
+
+enter_node(Node, Nodes) ->
+ nodes_tree_set(gb_trees:enter(node_label(Node), Node, nodes_tree(Nodes)), Nodes).
+
+remove_node(Node, Nodes) ->
+ nodes_tree_set(gb_trees:delete(node_label(Node), nodes_tree(Nodes)), Nodes).
+
+nodes_create() -> #nodes{}.
+
+%%-----------------------------------------------------------------------------
+%% update
+%% record used when updating the CFG, keeping track of which expressions
+%% have been inserted and their mappings to variable names.
+%%
+%% inserted - maps an expression to a list of variables
+%% del_red_test - flag that is set to true when the reduction test
+%% has been inserted is used to move the reduction test.
+
+-record(update, {inserted = gb_trees:empty() :: gb_tree(),
+ del_red_test = false :: boolean()}).
+
+update_inserted_lookup(#update{inserted = Inserted}, ExprId) ->
+ gb_trees:lookup(ExprId, Inserted).
+
+update_inserted_add_new(Update = #update{inserted = Inserted}, ExprId, Defs) ->
+ VarList = [case hipe_icode:is_var(Def) of
+ true -> hipe_icode:mk_new_var();
+ false ->
+ case hipe_icode:is_reg(Def) of
+ true -> hipe_icode:mk_new_reg();
+ false ->
+ true = hipe_icode:is_fvar(Def),
+ hipe_icode:mk_new_fvar()
+ end
+ end || Def <- Defs],
+ NewInserted = gb_trees:enter(ExprId, VarList, Inserted),
+ {Update#update{inserted = NewInserted}, VarList}.
+
+update_inserted_add(Update = #update{inserted = Inserted}, ExprId, Defs) ->
+ Update#update{inserted = gb_trees:enter(ExprId, Defs, Inserted)}.
+
+update_del_red_test(#update{del_red_test = DelRed}) -> DelRed.
+update_del_red_test_set(Update) ->
+ Update#update{del_red_test = true}.
+
+%%-----------------------------------------------------------------------------
+%% CODE AREA
+
+%%-----------------------------------------------------------------------------
+%% Main function called from the hipe_main module
+
+-spec struct_reuse(#cfg{}) -> #cfg{}.
+
+struct_reuse(CFG) ->
+ %% debug_init_case_count(?SR_INSTR_TYPE),
+ %% debug_init_case_count(?SR_STRUCT_INSTR_TYPE),
+
+ %% debug_function({wings_ask,ask_unzip,3}, CFG),
+ %% debug_function(nil, CFG),
+ %% set_debug_flag(true),
+ %% debug_struct("CFG In: ", CFG),
+ %% debug_cfg_pp(CFG),
+
+ init_expr_id(),
+
+ Nodes = construct_nodes(CFG),
+
+ case nodes_tree_is_empty(Nodes) of
+ false ->
+ Maps = create_maps(Nodes),
+
+ Nodes3 = init_nodes(Nodes, Maps),
+ Nodes4 = calc_anticipated(Nodes3),
+
+ {Nodes5, Maps3} = calc_inserts(Nodes4, Maps),
+
+ Nodes6 = update_nodes_inserts(Nodes5, Maps3),
+
+ %% debug_list("ExprMap: ", gb_trees:to_list(Maps3#maps.expr)),
+ %% debug_list("VarMap: ", gb_trees:to_list(maps_var(Maps3))),
+ %% debug_nodes(Nodes6),
+
+ %% update the cfg
+ CFG1 = rewrite_cfg(CFG, Nodes6, Maps3),
+ CFG2 = hipe_icode_ssa:remove_dead_code(CFG1),
+ CFGOut = hipe_icode_ssa_copy_prop:cfg(CFG2),
+ %% CFGOut = CFG1,
+
+ %% print_struct("CFG: ", CFG),
+ %% debug_cfg_pp(CFG),
+ %% debug_cfg_pp(CFGOut),
+
+ %% debug_print_case_count(?SR_STRUCT_INSTR_TYPE),
+ %% debug_print_case_count(?SR_INSTR_TYPE),
+ %% debug("Done~n"),
+ %% debug_struct("CFG Out: ", CFGOut),
+ CFGOut;
+ true ->
+ CFG
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Calculate simplified CFG with all fail paths removed
+
+construct_nodes(CFG) ->
+ %% all important dominator tree
+ DomTree = hipe_dominators:domTree_create(CFG),
+
+ %% construct initial nodes
+ {Nodes, NonFailSet} = nodes_from_cfg(CFG, DomTree),
+
+ %% remove nodes on fail paths
+ NewNodes = prune_nodes(Nodes, NonFailSet),
+
+ %% fill in misc node tree info
+ Postorder = [Label || Label <- hipe_icode_cfg:postorder(CFG),
+ gb_sets:is_member(Label, NonFailSet)],
+
+ %% check postorder is valid
+ PostOrderTmp = hipe_icode_cfg:postorder(CFG),
+ LabelsTmp = hipe_icode_cfg:labels(CFG),
+ case length(PostOrderTmp) =/= length(LabelsTmp) of
+ true ->
+ print("Warning, Postorder and Labels differ!~n"),
+ print_struct("Postorder: ", PostOrderTmp),
+ print_struct("Labels: ", LabelsTmp);
+ false ->
+ done
+ end,
+
+ RevPostorder = lists:reverse(Postorder),
+
+ StartLabel = hipe_icode_cfg:start_label(CFG),
+ NewTree = gb_trees:balance(nodes_tree(NewNodes)),
+
+ NewNodes#nodes{postorder = Postorder,
+ rev_postorder = RevPostorder,
+ start_label = StartLabel,
+ tree = NewTree,
+ domtree = DomTree}.
+
+%%-----------------------------------------------------------------------------
+%% Constructs a tree of nodes, one node for each basic block in CFG
+
+nodes_from_cfg(CFG, DomTree) ->
+ lists:foldl(fun(Label, {NodesAcc, NonFailAcc}) ->
+ Code = hipe_bb:code(hipe_icode_cfg:bb(CFG, Label)),
+ Pred = hipe_icode_cfg:pred(CFG, Label),
+ Succ = hipe_icode_cfg:succ(CFG, Label),
+ %% debug_struct("Label: ", Label),
+ %% debug_struct("Code: ", Code),
+
+ %% Find all structures and phi functions.
+ %% Find all defines in this bb that are not from structures
+ %% and add them to NonStructDefs, later to be used for calculating upwards
+ %% exposed expressions, and killed expressions.
+ %% Also find all non fail blocks, ie backtrace from return blocks,
+ %% and add them to NewNonFailAcc
+
+ Node = node_create(Label, Pred, Succ),
+
+ {NewNode, NewNonFailAcc, PreLoopPreds} =
+ lists:foldl(fun(Instr, {NodeAcc, NFAcc, PLPAcc}) ->
+ case instr_type(Instr) of
+ struct ->
+ {node_code_add(NodeAcc, Instr), NFAcc, PLPAcc};
+ return ->
+ {NodeAcc, get_back_trace_rec(CFG, Label, NFAcc), PLPAcc};
+ {struct_elems, NumElem, DstVar, SrcVar} ->
+ NewNodeAcc = node_struct_elems_add(NodeAcc, {DstVar, NumElem, SrcVar}),
+ {node_non_struct_instr_add(NewNodeAcc, Instr), NFAcc, PLPAcc};
+ {struct_type, NumElems, Var, Type} ->
+ {node_struct_type_add(NodeAcc, {Type, Var, NumElems}), NFAcc, PLPAcc};
+ {tuple_arity, Var, Cases} ->
+ NewNodeAcc =
+ lists:foldl(fun(Case, NAcc) ->
+ case Case of
+ {{const, {flat, Arity}}, _} ->
+ Tuple = {?MKTUPLE, Var, Arity},
+ node_struct_type_add(NAcc, Tuple);
+ _ -> NAcc
+ end
+ end, NodeAcc, Cases),
+ {NewNodeAcc, NFAcc, PLPAcc};
+ %% {atom_type, Atom, Var} ->
+ %% {node_atom_type_add(NodeAcc, {Var, Atom}), NFAcc, PLPAcc};
+ phi ->
+ Def = hipe_icode:phi_dst(Instr),
+ Part = lists:foldl(fun(P = {Pr, PredVar}, {IsDef, NotDom}) ->
+ case hipe_dominators:domTree_dominates(Label, Pr, DomTree) of
+ false ->
+ {IsDef, [P | NotDom]};
+ true ->
+ {IsDef andalso PredVar =:= Def, NotDom}
+ end
+ end, {true, []}, hipe_icode:phi_arglist(Instr)),
+
+ case Part of
+ {true, [{P, V}]} ->
+ %% This is the only case recognized so far. All phi
+ %% sub block references a static variable that is
+ %% assigned the same value again in the phi function.
+ {node_phi_add(NodeAcc, P, {Def, V}),
+ NFAcc, ?SETS:add_element(P, PLPAcc)};
+
+ {false, [{P, _}]} ->
+ {node_non_struct_instr_add(NodeAcc, Instr),
+ NFAcc, ?SETS:add_element(P, PLPAcc)};
+
+ _ ->
+ {node_non_struct_instr_add(NodeAcc, Instr), NFAcc, PLPAcc}
+ end;
+ _ ->
+ {node_non_struct_instr_add(NodeAcc, Instr), NFAcc, PLPAcc}
+ end
+ end, {Node, NonFailAcc, ?SETS:new()}, Code),
+
+ %% insert the new node
+ NewNodesAcc = enter_node(node_code_rev(NewNode), NodesAcc),
+
+ %% Set the pre loop flag of all nodes that are predecessor to this node
+ %% and that are the first nodes prior to a loop.
+ NewNodesAcc2 =
+ lists:foldl(fun(Lbl, NsAcc) ->
+ PredNode = get_node(Lbl, NsAcc),
+ NewPredNode = node_pre_loop_set(PredNode),
+ NewPredNode2 = node_varmap_set(NewPredNode, node_phi_get(NewNode, Lbl)),
+
+ enter_node(NewPredNode2, NsAcc)
+ end, NewNodesAcc, PreLoopPreds),
+
+ {NewNodesAcc2, NewNonFailAcc}
+ end, {nodes_create(), gb_sets:new()}, hipe_icode_cfg:reverse_postorder(CFG)).
+
+%%-----------------------------------------------------------------------------
+%% Get all labels from Label to root of CFG, ie backtraces from Label.
+
+get_back_trace_rec(CFG, Label, LabelSet) ->
+ %% debug_struct("Label :", Label),
+ %% debug_struct("Set :", gb_sets:to_list(LabelSet)),
+ case gb_sets:is_member(Label, LabelSet) of
+ false ->
+ Preds = hipe_icode_cfg:pred(CFG, Label),
+ lists:foldl(fun(Lbl, SetAcc) ->
+ get_back_trace_rec(CFG, Lbl, SetAcc)
+ end, gb_sets:add(Label, LabelSet), Preds);
+ true -> LabelSet
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Remove all fail block paths and successors and predecessors
+%% That are on fail paths
+
+prune_nodes(Nodes, NonFailSet) ->
+ lists:foldl(fun(Node, NodesAcc) ->
+ case gb_sets:is_member(node_label(Node), NonFailSet) of
+ true ->
+ NewSucc = [L || L <- node_succ(Node), gb_sets:is_member(L, NonFailSet)],
+ NewPred = [L || L <- node_pred(Node), gb_sets:is_member(L, NonFailSet)],
+ enter_node(Node#node{succ = NewSucc, pred = NewPred}, NodesAcc);
+ false ->
+ remove_node(Node, NodesAcc)
+ end
+ end, Nodes, nodes_tree_values(Nodes)).
+
+%%-----------------------------------------------------------------------------
+%% Map calculations.
+
+%%-----------------------------------------------------------------------------
+%% Create a maps structure from the Nodes record
+
+create_maps(Nodes) ->
+ Maps = lists:foldl(fun(Label, MapsAcc) ->
+ Node = get_node(Label, Nodes),
+ NewMapsAcc = maps_from_node_struct_type(MapsAcc, Node),
+ NewMapsAcc2 = maps_from_node_struct_elems(NewMapsAcc, Node),
+ %% NewMapsAcc3 = maps_from_node_atom_type(NewMapsAcc2, Node),
+ maps_from_node_code(NewMapsAcc2, Node)
+ end, #maps{}, nodes_rev_postorder(Nodes)),
+ maps_balance(Maps).
+
+%%-----------------------------------------------------------------------------
+%% Add all elements in the struct_type list of Node to Maps as expressions
+
+maps_from_node_struct_type(Maps, Node) ->
+ %% debug_struct("Node Label: ", node_label(Node)),
+ %% debug_struct("Node Tuple Type: ", node_struct_type(Node)),
+ lists:foldl(fun({Type, Var, Size}, MapsAcc) ->
+ Key = create_elem_expr_key(Size, Var, []),
+ InstrKey = hipe_icode:mk_primop([], Type, Key),
+ NewExpr2 = expr_create(InstrKey, [Var]),
+ NewExpr3 = expr_direct_replace_set(NewExpr2, true),
+ maps_expr_key_enter(NewExpr3, MapsAcc)
+ end, Maps, node_struct_type(Node)).
+
+create_elem_expr_key(0, _, Key) -> Key;
+create_elem_expr_key(N, Var, Key) ->
+ create_elem_expr_key(N - 1, Var, [{Var, N} | Key]).
+
+%%-----------------------------------------------------------------------------
+%%maps_from_node_atom_type(Maps, Node) ->
+%% lists:foldl(fun({Var, Atom}, MapsAcc) ->
+%% case maps_var_lookup(Var, MapsAcc) of
+%% none ->
+%% MapsAcc;
+%% {value, #varinfo{elem = none}} ->
+%% MapsAcc;
+%% {value, #varinfo{elem = {Src, Num, ExprId}}} ->
+%% Expr = maps_expr_get(ExprId, MapsAcc),
+%% Key = expr_key(Expr),
+%%
+%% Filter = fun(Arg) ->
+%% case Arg of
+%% {Src, Num, ExprId} ->
+%% hipe_icode:mk_const(Atom);
+%% _ ->
+%% Arg
+%% end end,
+%%
+%% NewKey = replace_call_variables(Filter, Key),
+%% NewExpr = expr_create(NewKey, expr_defs(Expr)),
+%% maps_expr_key_enter(NewExpr, MapsAcc)
+%% end
+%% end, Maps, node_atom_type(Node)).
+
+%%-----------------------------------------------------------------------------
+%% Add all struct_elemns in Node to Maps as variables
+
+maps_from_node_struct_elems(Maps, Node) ->
+ lists:foldl(fun({Dst, Num, Src}, MapsAcc) ->
+ VarInfo = #varinfo{elem = {Src, Num}},
+ maps_var_insert(Dst, VarInfo, MapsAcc)
+ end, Maps, node_struct_elems(Node)).
+
+%%-----------------------------------------------------------------------------
+%% Get all expressions defined by the Node and insert them into Maps.
+%% Also insert information about all affected variables into Maps.
+
+maps_from_node_code(Maps, Node) ->
+ %% debug_struct("Node Label: ", Label),
+ %% debug_struct("Node Code: ", Code),
+ %% Label = node_label(Node),
+ lists:foldl(fun(Instr, MapsAcc) ->
+ %% create two keys that are used to reference this structure creation
+ %% instruction, so that we can lookup its expression value number
+ %% later.
+ InstrKey = hipe_icode:call_dstlist_update(Instr, []),
+
+ %% Fetch the two keys from the instruction
+ {HasElems, RefKey, ElemKey} =
+ replace_call_vars_elems(MapsAcc, InstrKey),
+
+ %% create a new expr record or lookup an existing one.
+ case HasElems of
+ true ->
+ %% The instruction contains uses of variables that are
+ %% part of another structure.
+ case maps_instr_lookup(ElemKey, MapsAcc) of
+ {value, ExprId} ->
+ %% The instruction is equal to a structure that has
+ %% already been created. This is the f({Z}) -> {Z}
+ %% optimization. I.e. there is no need to create {Z} again.
+ %% Also lookup if ExprId is defining a variable that is
+ %% already an element in another structure. If so,
+ %% use that element. This takes care of nested structures
+ %% such as f({X, {Y, Z}}) -> {X, {Y, Z}}.
+
+ #expr{defs = [Var]} = maps_expr_get(ExprId, MapsAcc),
+ StructElem =
+ case maps_var_lookup(Var, MapsAcc) of
+ {value, #varinfo{elem = Elem, exprid = none}} when Elem =/= none ->
+ Elem;
+ _ -> none
+ end,
+ Defines = hipe_icode:defines(Instr),
+ maps_varinfos_create(Defines, ExprId, StructElem, MapsAcc);
+ none ->
+ %% create a new expression
+ maps_expr_varinfos_create(Instr, RefKey, MapsAcc)
+ end;
+ false ->
+ %% create a new expression
+ maps_expr_varinfos_create(Instr, RefKey, MapsAcc)
+ end
+ end, Maps, node_code(Node)).
+
+%%-----------------------------------------------------------------------------
+%% Creates varinfo structures with exprid set to ExprId for all
+%% variables contained in Defines. These are put into MapsIn.
+
+maps_varinfos_create(Defines, ExprId, Elem, MapsIn) ->
+ VarInfo = #varinfo{exprid = ExprId, elem = Elem},
+ {MapsOut, _} =
+ lists:foldl(fun (Def, {Maps, NumAcc}) ->
+ NewVarInfo = VarInfo#varinfo{ref = {ExprId, NumAcc}},
+ {maps_var_insert(Def, NewVarInfo, Maps), NumAcc + 1}
+ end, {MapsIn, 1}, Defines),
+ MapsOut.
+
+%%-----------------------------------------------------------------------------
+%% Creates a new expression from RefKey if RefKey is not already reffering
+%% to an expression. Also creates varinfo structures for all variables defined
+%% and used by Instr. Result is put in Maps.
+
+maps_expr_varinfos_create(Instr, RefKey, Maps) ->
+ Defines = hipe_icode:defines(Instr),
+ {ExprId, Maps2} =
+ case maps_instr_lookup(RefKey, Maps) of
+ {value, EId} ->
+ {EId, Maps};
+ none ->
+ NewExpr = expr_create(RefKey, Defines),
+ {expr_id(NewExpr), maps_expr_key_enter(NewExpr, Maps)}
+ end,
+ Maps3 = maps_varinfos_create(Defines, ExprId, none, Maps2),
+ update_maps_var_use(Instr, ExprId, Maps3).
+
+%%-----------------------------------------------------------------------------
+%% A variable replacement function that returns a tuple of three elements
+%% {T, K1, K2}, where T indicates if Instr contained variables that where
+%% elements of other structures, K1 is the Instr with all variables that
+%% references another structure replaced, and K2 is K1 but also with all
+%% variables that are elements of other structures replaced.
+
+replace_call_vars_elems(Maps, Instr) ->
+ VarMap = maps_var(Maps),
+ {HasElems, Vars, Elems} =
+ lists:foldr(fun(Arg, {HasElems, Vars, Elems}) ->
+ case hipe_icode:is_const(Arg) of
+ false ->
+ case gb_trees:lookup(Arg, VarMap) of
+ none ->
+ {HasElems, [Arg | Vars], [Arg | Elems]};
+ {value, #varinfo{ref = none, elem = none}} ->
+ {HasElems, [Arg | Vars], [Arg | Elems]};
+ {value, #varinfo{ref = Ref, elem = none}} ->
+ {HasElems, [Ref | Vars], [Ref | Elems]};
+ {value, #varinfo{ref = none, elem = Elem}} ->
+ {true, [Arg | Vars], [Elem | Elems]};
+ {value, #varinfo{ref = Ref, elem = Elem}} ->
+ {true, [Ref | Vars], [Elem | Elems]}
+ end;
+ true ->
+ {HasElems, [Arg | Vars], [Arg | Elems]}
+ end end, {false, [], []}, hipe_icode:args(Instr)),
+ {HasElems, hipe_icode:call_args_update(Instr, Vars),
+ hipe_icode:call_args_update(Instr, Elems)}.
+
+%%-----------------------------------------------------------------------------
+%% Updates the usage information of all variables used by Instr to also
+%% contain Id and updates Maps to contain the new variable information.
+%% Also updates the expressions where the updated variables are used to
+%% contain the use information.
+
+update_maps_var_use(Instr, Id, Maps) ->
+ lists:foldl(fun(Use, MapsAcc) ->
+ VarInfo = get_varinfo(Use, MapsAcc),
+ NewVarInfo = varinfo_use_add(VarInfo, Id),
+ MapsAcc2 = maps_var_enter(Use, NewVarInfo, MapsAcc),
+ case varinfo_exprid(VarInfo) of
+ none ->
+ MapsAcc2;
+ VarExprId ->
+ Expr = maps_expr_get(VarExprId, MapsAcc2),
+ NewExpr = expr_use_add(Expr, Id),
+ maps_expr_enter(NewExpr, MapsAcc2)
+ end
+ end, Maps, hipe_icode:uses(Instr)).
+
+%%-----------------------------------------------------------------------------
+%% Looks up an old variable info or creates a new one if none is found.
+
+get_varinfo(Var, Maps) ->
+ case maps_var_lookup(Var, Maps) of
+ {value, Info} ->
+ Info;
+ none ->
+ #varinfo{}
+ end.
+
+%%-----------------------------------------------------------------------------
+%% filters all arguments to a function call Instr that are not constants
+%% through the Filter function, and replaces the arguments in Instr with
+%% the result.
+
+replace_call_variables(Filter, Instr) ->
+ NewArgs = [case hipe_icode:is_const(Arg) of
+ false -> Filter(Arg);
+ true -> Arg
+ end || Arg <- hipe_icode:args(Instr)],
+ hipe_icode:call_args_update(Instr, NewArgs).
+
+%%-----------------------------------------------------------------------------
+%% Init nodes from node local expression information
+
+init_nodes(Nodes, Maps) ->
+ AllExpr = maps_expr_keys(Maps),
+ lists:foldl(fun(Node, NodesAcc) ->
+ UEExpr = calc_up_exposed_expr(maps_var(Maps), Node),
+ %% print_list("Up ExprSet: ", ?SETS:to_list(UEExpr)),
+
+ KilledExpr = calc_killed_expr(Node, Maps),
+ %% print_list("Killed: ", ?SETS:to_list(KilledExpr)),
+
+ %% End nodes have no anticipated out
+ AnticOut =
+ case node_succ(Node) of
+ [] ->
+ ?SETS:new();
+ _ ->
+ AllExpr
+ end,
+ enter_node(Node#node{up_expr = UEExpr,
+ killed_expr = KilledExpr,
+ antic_out = AnticOut}, NodesAcc)
+ end, nodes_all_expr_set(AllExpr, Nodes), nodes_tree_values(Nodes)).
+
+%%-----------------------------------------------------------------------------
+%% Calculate the upwards exposed expressions for a node.
+
+calc_up_exposed_expr(VarMap, Node) ->
+ %% debug_struct("UpExpr label: ", node_label(Node)),
+ NonStructDefs = node_non_struct_defs(Node),
+ {_, ExprIdSet} =
+ lists:foldl(fun(Instr, {NotToUseAcc, ExprIdAcc}) ->
+ Defs = hipe_icode:defines(Instr),
+ Uses = hipe_icode:uses(Instr),
+ IsNotToUse =
+ lists:any(fun(Use) -> gb_sets:is_member(Use, NotToUseAcc) end, Uses),
+ case IsNotToUse of
+ false ->
+ NewExprIdAcc =
+ lists:foldl(fun(Def, Acc) ->
+ #varinfo{exprid = Id} = gb_trees:get(Def, VarMap),
+ ?SETS:add_element(Id, Acc) end, ExprIdAcc, Defs),
+ {NotToUseAcc, NewExprIdAcc};
+ true ->
+ NewNotToUse =
+ gb_sets:union(gb_sets:from_list(Defs), NotToUseAcc),
+ {NewNotToUse, ExprIdAcc}
+ end
+ end, {NonStructDefs, ?SETS:new()}, node_code(Node)),
+ ExprIdSet.
+
+%%-----------------------------------------------------------------------------
+%% Calculate killed expression for node
+
+calc_killed_expr(Node, Maps) ->
+ calc_killed_expr_defs(node_non_struct_defs_list(Node), ?SETS:new(), Maps).
+
+calc_killed_expr_defs(Defs, UseSet, Maps) ->
+ lists:foldl(fun(Def, Acc) ->
+ case maps_var_lookup(Def, Maps) of
+ none ->
+ Acc;
+ {value, #varinfo{use = Use}} ->
+ ?SETS:union(Acc, calc_killed_expr_use(Use, Maps))
+ end
+ end, UseSet, Defs).
+
+calc_killed_expr_use(ExprIds, Maps) ->
+ ?SETS:fold(fun(Id, Acc) ->
+ Expr = maps_expr_get(Id, Maps),
+ ?SETS:union(Acc, calc_killed_expr_use(expr_use(Expr), Maps))
+ end, ExprIds, ExprIds).
+
+%%-----------------------------------------------------------------------------
+%% Calculate the anticipated in and anticipated out sets for each node
+
+calc_anticipated(NodesIn) ->
+ calc_anticipated_rec(NodesIn, nodes_postorder(NodesIn)).
+
+calc_anticipated_rec(NodesIn, []) -> NodesIn;
+calc_anticipated_rec(NodesIn, WorkIn) ->
+ {NodesOut, WorkOut} =
+ lists:foldl(fun(Label, {NodesAcc, WorkAcc}) ->
+ Node = get_node(Label, NodesAcc),
+
+ %debug_struct("~nNode Label: ", Label),
+
+ AnticIn = ?SETS:union(node_up_expr(Node),
+ ?SETS:subtract(node_antic_out(Node), node_killed_expr(Node))),
+
+ %debug_struct("AnticIn: ", AnticIn),
+ case (node_antic_in(Node) =:= AnticIn) of
+ false ->
+ NewNodes1 = enter_node(Node#node{antic_in = AnticIn}, NodesAcc),
+ Preds = node_pred(Node),
+ %debug_struct("Preds: ", Preds),
+
+ NewNodes2 =
+ lists:foldl(fun(Label2, NodesAcc2) ->
+ PredNode = get_node(Label2, NodesAcc2),
+ AnticOut = ?SETS:intersection(AnticIn, node_antic_out(PredNode)),
+ %debug_struct("Pred Node Label: ", Label2),
+ %debug_struct("Pred AnticOut: ", AnticOut),
+
+ enter_node(PredNode#node{antic_out = AnticOut}, NodesAcc2)
+ end, NewNodes1, Preds),
+
+ NewWork = add_work_list(Preds, WorkAcc),
+ %debug_struct("New Work: ", NewWork),
+
+ {NewNodes2, NewWork};
+ true ->
+ {NodesAcc, WorkAcc}
+ end
+ end, {NodesIn, new_work()}, WorkIn),
+
+ calc_anticipated_rec(NodesOut, get_work_list(WorkOut)).
+
+%%-----------------------------------------------------------------------------
+%% Function that adds inserts to expressions from nodes which either
+%% have an upwards exposed expression or dominate more than one node
+%% that inserts the same expression or the node is a prior to loop
+%% node. The inserted info is stored in the #expr records in the expr
+%% map of the #maps structure.
+
+calc_inserts(NodesIn, MapsIn) ->
+ DomTree = nodes_domtree(NodesIn),
+
+ lists:foldl(fun(Label, {NodesAcc, MapsAcc}) ->
+ Node = get_node(Label, NodesAcc),
+
+ %% get some basic properties.
+ UpExpr = node_up_expr(Node),
+ AnticOut = node_antic_out(Node),
+ SubIns = node_sub_inserts(Node),
+
+ %% debug_struct("Label: ", Label),
+
+ {HasIns, NewMapsAcc} =
+ ?SETS:fold(fun(ExprId, {HasInsAcc, MapsAcc2}) ->
+ Expr = maps_expr_get(ExprId, MapsAcc2),
+
+ ExprIns = expr_inserts(Expr),
+ ExprSubIns = ?SETS:intersection(ExprIns, SubIns),
+
+ %% There are three cases when to insert an expression
+ %% 1. The expression is defined at least twice in the subtree of this
+ %% node, that is length(ExprSubIns) > 1.
+ %% 2. It is defined in the node and is upwards exposed.
+ %% 3. The node is a block just above a loop, so we should move
+ %% all anticipated expressions to the node.
+
+ case length(ExprSubIns) > 1 orelse ?SETS:is_element(ExprId, UpExpr)
+ orelse node_pre_loop(Node) of
+ true ->
+ %% get labels of all sub blocks that inserts the expression and
+ %% that are dominated by the current node.
+ Dominates =
+ ?SETS:filter(fun(SubLabel) ->
+ hipe_dominators:domTree_dominates(Label, SubLabel, DomTree)
+ end, ExprSubIns),
+
+ %% remove inserts labels from insert labelset.
+ NewIns = ?SETS:subtract(ExprIns, Dominates),
+ NewIns2 = ?SETS:add_element(Label, NewIns),
+
+ %% update the node.
+ NewMaps =
+ maps_expr_enter(expr_inserts_set(Expr, NewIns2), MapsAcc2),
+ {true, NewMaps};
+ false ->
+ {HasInsAcc, MapsAcc2}
+ end
+ end, {false, MapsAcc}, ?SETS:union(AnticOut, UpExpr)),
+
+ %% Check if there was an insert into this node,
+ %% and if so add to the sub inserts set.
+ NewSubIns =
+ case HasIns of
+ true ->
+ ?SETS:add_element(Label, SubIns);
+ false ->
+ SubIns
+ end,
+
+ %% update sub inserts for all predecessors to the node.
+ NewNodes2 =
+ lists:foldl(fun(PredLabel, NodesAcc2) ->
+ PredNode = get_node(PredLabel, NodesAcc2),
+ enter_node(node_union_sub_inserts(PredNode, NewSubIns), NodesAcc2)
+ end, NodesAcc, node_pred(Node)),
+
+ {NewNodes2, NewMapsAcc}
+
+ end, {NodesIn, MapsIn}, nodes_postorder(NodesIn)).
+
+%%-----------------------------------------------------------------------------
+%% Update the insert sets of each node in the node tree.
+%% That is, move the insert information from the expressions to
+%% the actual nodes that perform the inserts.
+
+update_nodes_inserts(Nodes, Maps) ->
+ lists:foldl(fun(Expr, NodesAcc) ->
+ ExprId = expr_id(Expr),
+ ?SETS:fold(fun(Label, NsAcc) ->
+ Nd = get_node(Label, NsAcc),
+ enter_node(node_add_insert(Nd, ExprId), NsAcc)
+ end, NodesAcc, expr_inserts(Expr))
+ end, Nodes, maps_expr_values(Maps)).
+
+%%-----------------------------------------------------------------------------
+%% Rewrite CFG functions
+
+%%-----------------------------------------------------------------------------
+%% Do the code updating from the info in the nodes and maps structures. This
+%% is a proxy function for rewrite_cfg/6
+rewrite_cfg(CFG, Nodes, Maps) ->
+ {NewCFG, _Visited} =
+ rewrite_cfg(CFG, ?SETS:new(), #update{}, Nodes, Maps, [nodes_start_label(Nodes)]),
+ %% debug_struct("Visited: ", _Visited),
+ NewCFG.
+
+%%-----------------------------------------------------------------------------
+%% rewrite_cfg
+%% traverse the CFG in reverse postorder and rewrite each basic block before
+%% rewriteing its children. Pass along to each BB update the mappings of
+%% inserted expressions in the Update record.
+
+rewrite_cfg(CFG, Visited, Update, Nodes, Maps, Labels) ->
+ lists:foldl(fun(Label, {CFGAcc, VisitedAcc}) ->
+ case ?SETS:is_element(Label, VisitedAcc) of
+ false ->
+ %% debug_struct("Visit: ", Label),
+ Node = get_node(Label, Nodes),
+ NewVisitedAcc = ?SETS:add_element(Label, VisitedAcc),
+ {NewCFGAcc, NewUpdate} = rewrite_bb(CFGAcc, Update, Maps, Node),
+ %% debug_struct("Update inserted: ", update_inserted_list(NewUpdate)),
+ rewrite_cfg(NewCFGAcc, NewVisitedAcc, NewUpdate, Nodes, Maps, node_succ(Node));
+ true ->
+ {CFGAcc, VisitedAcc}
+ end
+ end, {CFG, Visited}, Labels).
+
+%%-----------------------------------------------------------------------------
+%% rewrite one single basic block in the CFG as described by the properties
+%% in the Node for that block. Uses the Maps and Update info to lookup
+%% the instructions and expressions to insert or delete.
+
+rewrite_bb(CFG, Update, Maps, Node) ->
+ #node{pre_loop = PreLoop, label = Label, up_expr = UpExpr, inserts = Inserts} = Node,
+
+ Code = hipe_bb:code(hipe_icode_cfg:bb(CFG, Label)),
+
+ %debug_struct("RW Label: ", Label),
+ %debug_struct("Inserts", Inserts),
+
+ DelRed = update_del_red_test(Update),
+ Delete = ?SETS:subtract(UpExpr, Inserts),
+
+ %% local function that gets the instruction and defines list of an
+ %% expression id in the current node and and returns them.
+ GetInstrFunc = fun(Expr) ->
+ Instr = expr_key(Expr),
+ Defs = expr_defs(Expr),
+ NewInstr =
+ if
+ PreLoop ->
+ replace_call_variables(fun(Var) ->
+ node_varmap_lookup(Node,
+ Var)
+ end,
+ Instr);
+ true ->
+ Instr
+ end,
+ {NewInstr, Defs}
+ end,
+
+ %% go through all expressions defined by the node and replace
+ %% or remove them as indicated by the delete set. Also perform
+ %% reduction test replacement if neccessary.
+ {[CodeLast | CodeRest], NewUpdate, LocalAcc} =
+ lists:foldl(fun(Instr, {CodeAcc, UpdateAcc, LocalAcc}) ->
+ case struct_instr_type(Instr) of
+ struct ->
+ Defs = hipe_icode:defines(Instr),
+
+ #varinfo{exprid = ExprId} = maps_var_get(hd(Defs), Maps),
+
+ Expr = maps_expr_get(ExprId, Maps),
+ DirectReplace = expr_direct_replace(Expr),
+
+ %% Creates move intstructions from Vars to Defs
+ RemoveFuncVars = fun(Vars) ->
+ CodeAcc2 = mk_defs_moves(CodeAcc, Defs, Vars),
+ {CodeAcc2, UpdateAcc, LocalAcc} end,
+
+ %% Looks up an already inserted ExprId and makes moves
+ %% of variables from that expression to this expression.
+ RemoveFunc = fun() ->
+ {value, Vars} = update_inserted_lookup(UpdateAcc, ExprId),
+ RemoveFuncVars(Vars) end,
+
+ %% Is ExprId already inserted?
+ IsLocal = ?SETS:is_element(ExprId, LocalAcc),
+
+ case DirectReplace of
+ true ->
+ %% The Instr is reffering to an expression that is
+ %% defined as an identical already present instruction,
+ %% and can be removed directly.
+ RemoveFuncVars(expr_defs(Expr));
+ false when IsLocal ->
+ %% The instruction has already been inserted.
+ RemoveFunc();
+ _ ->
+ case ?SETS:is_element(ExprId, Delete) of
+ true ->
+ %% should not be inserted
+ RemoveFunc();
+ _ ->
+ %% Should remain
+ UpdateAcc2 = update_inserted_add(UpdateAcc, ExprId, Defs),
+ LocalAcc2 = ?SETS:add_element(ExprId, LocalAcc),
+ {[Instr | CodeAcc], UpdateAcc2, LocalAcc2}
+ end
+ end;
+ redtest when DelRed ->
+ %% delete reduction test
+ {CodeAcc, UpdateAcc, LocalAcc};
+ _ ->
+ {[Instr | CodeAcc], UpdateAcc, LocalAcc}
+ end
+ end, {[], Update, ?SETS:new()}, Code),
+
+ %debug_struct("RW Label 2: ", Label),
+
+ %% calculate the inserts that are new to this node, that is
+ %% the expressions that are in Inserts but not in UpExpr,
+ %% and that have not been added already,
+ %% that is not present in LocalAcc
+ NewInserts = ?SETS:subtract(?SETS:subtract(Inserts, UpExpr), LocalAcc),
+
+ {NewCodeRest, NewUpdate2} =
+ ?SETS:fold(fun(ExprId, {CodeAcc, UpdateAcc}) ->
+ Expr = maps_expr_get(ExprId, Maps),
+ {ExprInstr, Defs} = GetInstrFunc(Expr),
+ {UpdateAcc2, NewDefs} = update_inserted_add_new(UpdateAcc, ExprId, Defs),
+
+ %% check if there exists an identical expression, so that
+ %% this expression can be replaced directly.
+ CodeAcc2 =
+ case expr_direct_replace(Expr) of
+ false ->
+ NewInstr = rewrite_expr(UpdateAcc2, ExprInstr, NewDefs),
+ [NewInstr | CodeAcc];
+ true ->
+ mk_defs_moves(CodeAcc, NewDefs, Defs)
+ end,
+ {CodeAcc2, UpdateAcc2}
+ end, {CodeRest, NewUpdate}, NewInserts),
+
+ NewCode = lists:reverse([CodeLast | NewCodeRest]),
+
+ %% Check if we are to insert new reduction test here...
+ {NewCode2, NewUpdate3} =
+ case PreLoop andalso ?SETS:size(Inserts) > 0 andalso not DelRed of
+ true ->
+ {[hipe_icode:mk_primop([], redtest, []) | NewCode], update_del_red_test_set(NewUpdate2)};
+ false ->
+ {NewCode, NewUpdate2}
+ end,
+
+ NewBB = hipe_bb:mk_bb(NewCode2),
+ NewCFG = hipe_icode_cfg:bb_add(CFG, Label, NewBB),
+
+ {NewCFG, NewUpdate3}.
+
+%%-----------------------------------------------------------------------------
+%% Create a new structure instruction from Instr with destination Defs
+%% from the insert mapping in Update.
+
+rewrite_expr(Update, Instr, Defs) ->
+ NewInstr =
+ replace_call_variables(fun(Ref) ->
+ case Ref of
+ {ExprId, Num} when is_integer(ExprId) ->
+ {value, DefList} = update_inserted_lookup(Update, ExprId),
+ lists:nth(Num, DefList);
+ _ -> Ref
+ end end, Instr),
+ hipe_icode:call_dstlist_update(NewInstr, Defs).
+
+%%-----------------------------------------------------------------------------
+%% Make move instructions from Defs list to all variables in
+%% the Refs list and insert into Code.
+
+mk_defs_moves(Code, [], []) -> Code;
+mk_defs_moves(Code, [Ref | Refs], [Def | Defs]) ->
+ mk_defs_moves([hipe_icode:mk_move(Ref, Def) | Code], Refs, Defs).
+
+%%-----------------------------------------------------------------------------
+%% Utilities
+
+new_work() ->
+ {[], gb_sets:new()}.
+
+add_work_list(List, Work) ->
+ lists:foldl(fun(Label, WorkAcc) ->
+ add_work_label(Label, WorkAcc) end, Work, List).
+
+add_work_label(Label, {List, Set}) ->
+ case gb_sets:is_member(Label, Set) of
+ false ->
+ {[Label | List], gb_sets:add(Label, Set)};
+ true ->
+ {List, Set}
+ end.
+
+get_work_list({List, _}) ->
+ lists:reverse(List).
+
+%%-----------------------------------------------------------------------------
+%% instr_type
+%% gets a tag for the type of instruction that is passed in I
+
+struct_instr_type(I) ->
+ case I of
+ #icode_call{type = primop, 'fun' = mktuple} ->
+ %%debug_count_case(?SR_STRUCT_INSTR_TYPE, #call{type = primop, 'fun' = mktuple}),
+ struct;
+ #icode_call{type = primop, 'fun' = cons} ->
+ %%debug_count_case(?SR_STRUCT_INSTR_TYPE, #call{type = primop, 'fun' = cons}),
+ struct;
+ #icode_call{type = primop, 'fun' = redtest} ->
+ %%debug_count_case(?SR_STRUCT_INSTR_TYPE, #call{type = primop, 'fun' = redtest}),
+ redtest;
+ _ ->
+ %%debug_count_case(?SR_STRUCT_INSTR_TYPE, other),
+ other
+ end.
+
+instr_type(I) ->
+ case I of
+ %#call{type = primop, dstlist = List} when length(List) >= 1 -> struct;
+ #icode_call{type = primop, 'fun' = {unsafe_element, Elem}, dstlist = [DstVar], args = [SrcVar]} ->
+ %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = {unsafe_element, num}}),
+ {struct_elems, Elem, DstVar, SrcVar};
+ #icode_phi{} ->
+ %%debug_count_case(?SR_INSTR_TYPE,#phi{}),
+ phi;
+ #icode_enter{} ->
+ %%debug_count_case(?SR_INSTR_TYPE,#enter{}),
+ return;
+ #icode_return{} ->
+ %%debug_count_case(?SR_INSTR_TYPE,#return{}),
+ return;
+ #icode_call{type = primop, 'fun' = mktuple} ->
+ %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = mktuple}),
+ struct;
+ #icode_call{type = primop, 'fun' = cons} ->
+ %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = cons}),
+ struct;
+ #icode_call{type = primop, 'fun' = redtest} ->
+ %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = redtest}),
+ redtest;
+ #icode_type{test = {tuple, Size}, args = [Var]} ->
+ %%debug_count_case(?SR_INSTR_TYPE, #type{type = {tuple, size}}),
+ {struct_type, Size, Var, ?MKTUPLE};
+ #icode_type{test = cons, args = [Var]} ->
+ %%debug_count_case(?SR_INSTR_TYPE,#type{type = cons}),
+ {struct_type, 2, Var, ?CONS};
+ %#type{type = {atom, Atom}, args = [Var]} -> {atom_type, Atom, Var};
+ #icode_call{type = primop, 'fun' = unsafe_hd,
+ dstlist = [DstVar], args = [SrcVar]} ->
+ %%debug_count_case(?SR_INSTR_TYPE,#call{type = primop, 'fun' = unsafe_hd}),
+ {struct_elems, 1, DstVar, SrcVar};
+ #icode_call{type = primop, 'fun' = unsafe_tl,
+ dstlist = [DstVar], args = [SrcVar]} ->
+ %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = unsafe_tl}),
+ {struct_elems, 2, DstVar, SrcVar};
+ #icode_switch_tuple_arity{term = Var, cases = Cases} ->
+ %%debug_count_case(?SR_INSTR_TYPE,#switch_tuple_arity{}),
+ {tuple_arity, Var, Cases};
+ _ -> other
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Expression ID counter
+
+init_expr_id() ->
+ put({struct_reuse, expr_id_count}, 0).
+
+-spec new_expr_id() -> non_neg_integer().
+new_expr_id() ->
+ V = get({struct_reuse, expr_id_count}),
+ put({struct_reuse, expr_id_count}, V+1),
+ V.
+
+%%-----------------------------------------------------------------------------
+%% Debug and print functions
+
+print_struct(String, Struct) ->
+ io:format(String),
+ erlang:display(Struct).
+
+print(String) ->
+ io:format(String).
+
+-ifdef(DEBUG).
+
+debug_count_case(Type, Case) ->
+ Cases = get(Type),
+ NewCases =
+ case gb_trees:lookup(Case, Cases) of
+ {value, Value} -> gb_trees:enter(Case, Value + 1, Cases);
+ none -> gb_trees:insert(Case, 1, Cases)
+ end,
+ put(Type, NewCases).
+
+debug_init_case_count(Type) ->
+ case get(Type) of
+ undefined -> put(Type, gb_trees:empty());
+ _ -> ok
+ end.
+
+debug_print_case_count(Type) ->
+ Cases = get(Type),
+ debug_struct("Case type: ", Type),
+ debug_list("Cases: ", gb_trees:to_list(Cases)).
+
+set_debug_flag(Value) ->
+ put({struct_reuse, debug}, Value).
+
+get_debug_flag() -> get({struct_reuse, debug}).
+
+debug_function(FuncName, CFG) ->
+ Linear = hipe_icode_cfg:cfg_to_linear(CFG),
+ Func = hipe_icode:icode_fun(Linear),
+ case Func =:= FuncName orelse FuncName =:= nil of
+ true ->
+ set_debug_flag(true),
+ %% debug_struct("Code: ", hipe_icode_cfg:bb(CFG, 15)),
+ debug_struct("~nFunction name :", Func);
+ false ->
+ set_debug_flag(undefined)
+ end.
+
+debug_cfg_pp(CFG) ->
+ case get_debug_flag() of
+ true -> hipe_icode_cfg:pp(CFG);
+ _ -> none
+ end.
+
+debug_struct(String, Struct) ->
+ case get_debug_flag() of
+ true ->
+ io:format(String),
+ erlang:display(Struct);
+ _ -> none
+ end.
+
+debug(String) ->
+ case get_debug_flag() of
+ true -> io:format(String);
+ _ -> none
+ end.
+
+debug_list(String, List) ->
+ case get_debug_flag() of
+ true -> print_list(String, List);
+ _ -> none
+ end.
+
+print_list(String, List) ->
+ io:format(String),
+ io:format("~n"),
+ print_list_rec(List),
+ io:format("~n").
+
+print_list_rec([]) -> ok;
+print_list_rec([Struct | List]) ->
+ erlang:display(Struct),
+ print_list_rec(List).
+
+debug_nodes(Nodes) ->
+ lists:foreach(fun(Node) -> debug_node(Node) end, nodes_tree_values(Nodes)).
+
+debug_node(Node) ->
+ case get_debug_flag() of
+ true ->
+ print_struct("Node Label: ", Node#node.label),
+ print_struct("Code: ", Node#node.code),
+ print_struct("Phi: ", Node#node.phi),
+ print_struct("PreLoop: ", Node#node.pre_loop),
+ print_struct("Preds: ", Node#node.pred),
+ print_struct("Succ: ", Node#node.succ),
+ print_struct("Up Expr: ", Node#node.up_expr),
+ print_struct("Kill : ", Node#node.killed_expr),
+ print_struct("AnticIn: ", Node#node.antic_in),
+ print_struct("AnticOut: ", Node#node.antic_out),
+ print_struct("SubInserts: ", Node#node.sub_inserts),
+ print_struct("Inserts: ", Node#node.inserts),
+ print_struct("NonStructDefs: ", Node#node.non_struct_defs),
+ print_struct("Params: ", Node#node.struct_type),
+ print_struct("Elems: ", Node#node.struct_elems),
+ io:format("~n");
+ _ -> none
+ end.
+
+-endif.
diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl
new file mode 100644
index 0000000000..28198467f7
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_type.erl
@@ -0,0 +1,2266 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%--------------------------------------------------------------------
+%%% File : hipe_icode_type.erl
+%%% Author : Tobias Lindahl <Tobias.Lindahl@it.uu.se>
+%%% Description : Propagate type information.
+%%%
+%%% Created : 25 Feb 2003 by Tobias Lindahl <Tobias.Lindahl@it.uu.se>
+%%%
+%%% $Id$
+%%%--------------------------------------------------------------------
+
+-module(hipe_icode_type).
+
+-export([cfg/4, unannotate_cfg/1, specialize/1]).
+
+%%=====================================================================
+%% Icode Coordinator Callbacks
+%%=====================================================================
+
+-export([replace_nones/1,
+ update__info/2, new__info/1, return__info/1,
+ return_none/0, return_none_args/2, return_any_args/2]).
+
+%%=====================================================================
+
+-include("../main/hipe.hrl").
+-include("hipe_icode.hrl").
+-include("hipe_icode_primops.hrl").
+-include("hipe_icode_type.hrl").
+-include("../flow/cfg.hrl").
+
+-type args_fun() :: fun((mfa(), cfg()) -> [erl_types:erl_type()]).
+-type call_fun() :: fun((mfa(), [_]) -> erl_types:erl_type()).
+-type final_fun() :: fun((mfa(), [_]) -> 'ok').
+-type data() :: {mfa(), args_fun(), call_fun(), final_fun()}.
+
+%-define(DO_HIPE_ICODE_TYPE_TEST, false).
+
+-ifdef(DO_HIPE_ICODE_TYPE_TEST).
+-export([test/0]).
+-endif.
+
+-define(MFA_debug, fun(_, _, _) -> ok end).
+
+%-define(debug, fun(X, Y) -> io:format("~s ~p~n", [X, Y]) end).
+-define(debug, fun(_, _) -> ok end).
+
+%-define(flow_debug, fun(X, Y) -> io:format("flow: ~s ~p~n", [X, Y]) end).
+-define(flow_debug, fun(_, _) -> ok end).
+
+%-define(widening_debug, fun(X, Y) -> io:format("wid: ~s ~p~n", [X, Y]) end).
+-define(widening_debug, fun(_, _) -> ok end).
+
+%-define(call_debug, fun(X, Y) -> io:format("call: ~s ~p~n", [X, Y]) end).
+-define(call_debug, fun(_, _) -> ok end).
+
+%-define(ineq_debug, fun(X, Y) -> io:format("ineq: ~s ~p~n", [X, Y]) end).
+-define(ineq_debug, fun(_, _) -> ok end).
+
+%-define(server_debug, fun(X, Y) -> io:format("~p server: ~s ~p~n", [self(), X, Y]) end).
+-define(server_debug, fun(_, _) -> ok end).
+
+-import(erl_types, [min/2, max/2, number_min/1, number_max/1,
+ t_any/0, t_atom/1, t_atom/0, t_atom_vals/1,
+ t_binary/0, t_bitstr/0, t_bitstr_base/1, t_bitstr_unit/1,
+ t_boolean/0, t_cons/0, t_constant/0,
+ t_float/0, t_from_term/1, t_from_range/2,
+ t_fun/0, t_fun/1, t_fun/2, t_fun_args/1, t_fun_arity/1,
+ t_inf/2, t_inf_lists/2, t_integer/0,
+ t_integer/1, t_is_atom/1, t_is_any/1,
+ t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, t_is_boolean/1,
+ t_is_fixnum/1, t_is_cons/1, t_is_constant/1,
+ t_is_maybe_improper_list/1, t_is_equal/2, t_is_float/1,
+ t_is_fun/1, t_is_integer/1, t_is_non_neg_integer/1,
+ t_is_number/1, t_is_matchstate/1,
+ t_is_nil/1, t_is_none/1, t_is_port/1, t_is_pid/1,
+ t_is_reference/1, t_is_subtype/2, t_is_tuple/1,
+ t_limit/2, t_matchstate_present/1, t_matchstate/0,
+ t_matchstate_slots/1, t_maybe_improper_list/0,
+ t_nil/0, t_none/0, t_number/0, t_number/1, t_number_vals/1,
+ t_pid/0, t_port/0, t_reference/0, t_subtract/2, t_sup/2,
+ t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_sizes/1]).
+
+-record(state, {info_map = gb_trees:empty() :: gb_tree(),
+ cfg :: cfg(),
+ liveness = gb_trees:empty() :: gb_tree(),
+ arg_types :: [erl_types:erl_type()],
+ ret_type = [t_none()] :: [erl_types:erl_type()],
+ lookupfun :: call_fun(),
+ resultaction :: final_fun()}).
+
+%%-----------------------------------------------------------------------
+%% The main exported function
+%%-----------------------------------------------------------------------
+
+-spec cfg(cfg(), mfa(), comp_options(), #comp_servers{}) -> cfg().
+
+cfg(Cfg, MFA, Options, Servers) ->
+ case proplists:get_bool(concurrent_comp, Options) of
+ true ->
+ concurrent_cfg(Cfg, MFA, Servers#comp_servers.type);
+ false ->
+ ordinary_cfg(Cfg, MFA)
+ end.
+
+concurrent_cfg(Cfg, MFA, CompServer) ->
+ CompServer ! {ready, {MFA, self()}},
+ {ArgsFun, CallFun, FinalFun} = do_analysis(Cfg, MFA),
+ Ans = do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun),
+ CompServer ! {done_rewrite, MFA},
+ Ans.
+
+do_analysis(Cfg, MFA) ->
+ receive
+ {analyse, {ArgsFun,CallFun,FinalFun}} ->
+ analyse(Cfg, {MFA,ArgsFun,CallFun,FinalFun}),
+ do_analysis(Cfg, MFA);
+ {done, {_NewArgsFun,_NewCallFun,_NewFinalFun} = Done} ->
+ Done
+ end.
+
+do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun) ->
+ common_rewrite(Cfg, {MFA,ArgsFun,CallFun,FinalFun}).
+
+ordinary_cfg(Cfg, MFA) ->
+ Data = make_data(Cfg,MFA),
+ common_rewrite(Cfg, Data).
+
+common_rewrite(Cfg, Data) ->
+ State = safe_analyse(Cfg, Data),
+ NewState = simplify_controlflow(State),
+ NewCfg = state__cfg(annotate_cfg(NewState)),
+ hipe_icode_cfg:remove_unreachable_code(specialize(NewCfg)).
+
+make_data(Cfg, {_M,_F,A}=MFA) ->
+ NoArgs =
+ case hipe_icode_cfg:is_closure(Cfg) of
+ true -> hipe_icode_cfg:closure_arity(Cfg);
+ false -> A
+ end,
+ Args = lists:duplicate(NoArgs, t_any()),
+ ArgsFun = fun(_,_) -> Args end,
+ CallFun = fun(_,_) -> t_any() end,
+ FinalFun = fun(_,_) -> ok end,
+ {MFA,ArgsFun,CallFun,FinalFun}.
+
+%%debug_make_data(Cfg, {_M,_F,A}=MFA) ->
+%% NoArgs =
+%% case hipe_icode_cfg:is_closure(Cfg) of
+%% true -> hipe_icode_cfg:closure_arity(Cfg);
+%% false -> A
+%% end,
+%% Args = lists:duplicate(NoArgs, t_any()),
+%% ArgsFun = fun(MFA,_Cfg) -> io:format("Start:~p~n",[MFA]),Args end,
+%% CallFun = fun(MFA,Types) -> io:format("Call With:~p~nTo:~p~n",[Types,MFA]), t_any() end,
+%% FinalFun = fun(MFA,Type) -> io:format("ResType:~p~nFor:~p~n",[Type,MFA]),ok end,
+%% {MFA,ArgsFun,CallFun,FinalFun}.
+
+
+%%-------------------------------------------------------------------
+%% Global type analysis on the whole function. Demands that the code
+%% is in SSA form. When we encounter a phi node, the types of the
+%% arguments are joined. At the end of a block the information out is
+%% joined with the current information in for all _valid_ successors,
+%% that is, of all successors that actually can be reached. If the
+%% join produces new information in for the successor, this
+%% information is added to the worklist.
+%%-------------------------------------------------------------------
+
+-spec analyse(cfg(), data()) -> 'ok'.
+
+analyse(Cfg, Data) ->
+ try
+ #state{} = safe_analyse(Cfg, Data),
+ ok
+ catch throw:no_input -> ok % No need to do anything since we have no input
+ end.
+
+-spec safe_analyse(cfg(), data()) -> #state{}.
+
+safe_analyse(Cfg, {MFA,_,_,_}=Data) ->
+ State = new_state(Cfg, Data),
+ NewState = analyse_blocks(State,MFA),
+ (state__resultaction(NewState))(MFA,state__ret_type(NewState)),
+ NewState.
+
+analyse_blocks(State, MFA) ->
+ Work = init_work(State),
+ analyse_blocks(Work, State, MFA).
+
+analyse_blocks(Work, State, MFA) ->
+ case get_work(Work) of
+ fixpoint ->
+ State;
+ {Label, NewWork} ->
+ Info = state__info_in(State, Label),
+ {NewState, NewLabels} =
+ try analyse_block(Label, Info, State)
+ catch throw:none_type ->
+ %% io:format("received none type at label: ~p~n",[Label]),
+ {State,[]}
+ end,
+ NewWork2 = add_work(NewWork, NewLabels),
+ analyse_blocks(NewWork2, NewState, MFA)
+ end.
+
+analyse_block(Label, InfoIn, State) ->
+ BB = state__bb(State, Label),
+ Code = hipe_bb:butlast(BB),
+ Last = hipe_bb:last(BB),
+ InfoOut = analyse_insns(Code, InfoIn, state__lookupfun(State)),
+ NewState = state__info_out_update(State, Label, InfoOut),
+ case Last of
+ #icode_if{} ->
+ UpdateInfo = do_if(Last, InfoOut),
+ do_updates(NewState, UpdateInfo);
+ #icode_type{} ->
+ UpdateInfo = do_type(Last, InfoOut),
+ do_updates(NewState, UpdateInfo);
+ #icode_switch_tuple_arity{} ->
+ UpdateInfo = do_switch_tuple_arity(Last, InfoOut),
+ do_updates(NewState, UpdateInfo);
+ #icode_switch_val{} ->
+ UpdateInfo = do_switch_val(Last, InfoOut),
+ do_updates(NewState, UpdateInfo);
+ #icode_enter{} ->
+ NewState1 = do_enter(Last, InfoOut, NewState, state__lookupfun(NewState)),
+ do_updates(NewState1,[]);
+ #icode_call{} ->
+ {NewState1,UpdateInfo} = do_last_call(Last, InfoOut, NewState, Label),
+ do_updates(NewState1, UpdateInfo);
+ #icode_return{} ->
+ NewState1 = do_return(Last, InfoOut, NewState),
+ do_updates(NewState1,[]);
+ _ ->
+ UpdateInfo = [{X, InfoOut} || X <- state__succ(NewState, Label)],
+ do_updates(NewState, UpdateInfo)
+ end.
+
+analyse_insns([I|Insns], Info, LookupFun) ->
+ NewInfo = analyse_insn(I, Info, LookupFun),
+ analyse_insns(Insns, NewInfo, LookupFun);
+analyse_insns([], Info, _) ->
+ Info.
+
+analyse_insn(I, Info, LookupFun) ->
+ case I of
+ #icode_move{} ->
+ do_move(I, Info);
+ #icode_call{} ->
+ NewInfo = do_call(I, Info, LookupFun),
+ %%io:format("Analysing Call: ~w~n~w~n", [I,NewInfo]),
+ update_call_arguments(I, NewInfo);
+ #icode_phi{} ->
+ Type = t_limit(join_list(hipe_icode:args(I), Info), ?TYPE_DEPTH),
+ enter_defines(I, Type, Info);
+ #icode_begin_handler{} ->
+ enter_defines(I, t_any(), Info);
+ _ ->
+ %% Just an assert
+ case defines(I) of
+ [] -> Info;
+ _ -> exit({"Instruction with destination not analysed", I})
+ end
+ end.
+
+do_move(I, Info) ->
+ %% Can't use uses/1 since we must keep constants.
+ [Src] = hipe_icode:args(I),
+ enter_defines(I, lookup(Src, Info), Info).
+
+do_basic_call(I, Info, LookupFun) ->
+ case hipe_icode:call_type(I) of
+ primop ->
+ Fun = hipe_icode:call_fun(I),
+ ArgTypes = lookup_list(hipe_icode:args(I), Info),
+ primop_type(Fun, ArgTypes);
+ remote ->
+ {M, F, A} = hipe_icode:call_fun(I),
+ ArgTypes = lookup_list(hipe_icode:args(I), Info),
+ None = t_none(),
+ case erl_bif_types:type(M, F, A, ArgTypes) of
+ None ->
+ NewArgTypes = add_funs_to_arg_types(ArgTypes),
+ erl_bif_types:type(M, F, A, NewArgTypes);
+ Other ->
+ Other
+ end;
+ local ->
+ MFA = hipe_icode:call_fun(I),
+ ArgTypes = lookup_list(hipe_icode:args(I), Info),
+ %% io:format("Call:~p~nTypes: ~p~n",[I,ArgTypes]),
+ LookupFun(MFA,ArgTypes)
+ end.
+
+do_call(I, Info, LookupFun) ->
+ RetType = do_basic_call(I, Info, LookupFun),
+ IsNone = t_is_none(RetType),
+ %% io:format("RetType ~p~nIsNone ~p~n~p~n",[RetType,IsNone,I]),
+ if IsNone -> throw(none_type);
+ true -> enter_defines(I, RetType, Info)
+ end.
+
+do_safe_call(I, Info, LookupFun) ->
+ RetType = do_basic_call(I, Info, LookupFun),
+ enter_defines(I, RetType, Info).
+
+do_last_call(Last, InfoOut, State, Label) ->
+ try
+ NewInfoOut = do_call(Last, InfoOut, state__lookupfun(State)),
+ NewState = state__info_out_update(State, Label, NewInfoOut),
+ ContInfo = update_call_arguments(Last, NewInfoOut),
+ Cont = hipe_icode:call_continuation(Last),
+ Fail = hipe_icode:call_fail_label(Last),
+ ?call_debug("Continfo, NewInfoOut", {ContInfo, NewInfoOut}),
+ UpdateInfo =
+ case Fail of
+ [] ->
+ [{Cont, ContInfo}];
+ _ ->
+ case call_always_fails(Last, InfoOut) of
+ true ->
+ [{Fail, NewInfoOut}];
+ false ->
+ Fun = hipe_icode:call_fun(Last),
+ case hipe_icode_primops:fails(Fun) of
+ true ->
+ [{Cont, ContInfo}, {Fail, NewInfoOut}];
+ false ->
+ [{Cont, ContInfo}]
+ end
+ end
+ end,
+ {NewState,UpdateInfo}
+ catch throw:none_type ->
+ State2 = state__info_out_update(State, Label, InfoOut),
+ case hipe_icode:call_fail_label(Last) of
+ [] -> throw(none_type);
+ FailLbl ->
+ {State2,[{FailLbl, InfoOut}]}
+ end
+ end.
+
+call_always_fails(#icode_call{} = I, Info) ->
+ case hipe_icode:call_fun(I) of
+ %% These can actually be calls too.
+ {erlang, halt, 0} -> false;
+ {erlang, halt, 1} -> false;
+ {erlang, exit, 1} -> false;
+ {erlang, error, 1} -> false;
+ {erlang, error, 2} -> false;
+ {erlang, throw, 1} -> false;
+ {erlang, hibernate, 3} -> false;
+ Fun ->
+ case hipe_icode:call_type(I) of
+ primop ->
+ Args = safe_lookup_list(hipe_icode:call_args(I), Info),
+ ReturnType = primop_type(Fun, Args),
+ t_is_none(ReturnType);
+ _ -> false
+ end
+ end.
+
+do_enter(I, Info, State, LookupFun) ->
+ %% io:format("Enter:~p~n",[I]),
+ ArgTypes = lookup_list(hipe_icode:args(I), Info),
+ RetTypes =
+ case hipe_icode:enter_type(I) of
+ local ->
+ MFA = hipe_icode:enter_fun(I),
+ LookupFun(MFA,ArgTypes);
+ remote ->
+ {M, F, A} = hipe_icode:enter_fun(I),
+ None = t_none(),
+ case erl_bif_types:type(M, F, A, ArgTypes) of
+ None ->
+ NewArgTypes = add_funs_to_arg_types(ArgTypes),
+ erl_bif_types:type(M, F, A, NewArgTypes);
+ Other ->
+ Other
+ end;
+ primop ->
+ Fun = hipe_icode:enter_fun(I),
+ primop_type(Fun, ArgTypes)
+ end,
+ state__ret_type_update(State, RetTypes).
+
+do_return(I, Info, State) ->
+ RetTypes = lookup_list(hipe_icode:args(I), Info),
+ state__ret_type_update(State, RetTypes).
+
+do_if(I, Info) ->
+ %% XXX: Could probably do better than this.
+ TrueLab = hipe_icode:if_true_label(I),
+ FalseLab = hipe_icode:if_false_label(I),
+ case hipe_icode:if_args(I) of
+ [Arg1, Arg2] = Args ->
+ [Type1, Type2] = lookup_list(Args, Info),
+ case t_is_none(Type1) orelse t_is_none(Type2) of
+ true ->
+ [{TrueLab, Info}, {FalseLab, Info}];
+ false ->
+ Inf = t_inf(Type1, Type2),
+ case hipe_icode:if_op(I) of
+ '=:='->
+ case t_is_none(Inf) of
+ true ->
+ [{FalseLab, Info}];
+ false ->
+ [{TrueLab, enter(Arg1, Inf, enter(Arg2, Inf, Info))},
+ {FalseLab, Info}]
+ end;
+ '=/=' ->
+ case t_is_none(Inf) of
+ true ->
+ [{TrueLab, Info}];
+ false ->
+ [{FalseLab, enter(Arg1, Inf, enter(Arg2, Inf, Info))},
+ {TrueLab, Info}]
+ end;
+ '==' ->
+ [{TrueLab, Info}, {FalseLab, Info}];
+ '/=' ->
+ [{TrueLab, Info}, {FalseLab, Info}];
+ Op ->
+ integer_range_inequality_propagation(Op, Arg1, Arg2,
+ TrueLab, FalseLab, Info)
+ %%_ ->
+ %% [{TrueLab, Info}, {FalseLab, Info}]
+ end
+ end;
+ _ ->
+ %% Only care for binary if:s
+ [{TrueLab, Info}, {FalseLab, Info}]
+ end.
+
+integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) ->
+ Arg1 = lookup(A1, Info),
+ Arg2 = lookup(A2, Info),
+ ?ineq_debug("args", [Arg1,Arg2]),
+ IntArg1 = t_inf(Arg1, t_integer()),
+ IntArg2 = t_inf(Arg2, t_integer()),
+ NonIntArg1 = t_subtract(Arg1, t_integer()),
+ NonIntArg2 = t_subtract(Arg2, t_integer()),
+ ?ineq_debug("nonintargs", [NonIntArg1,NonIntArg2]),
+ case t_is_none(IntArg1) or t_is_none(IntArg2) of
+ true ->
+ ?ineq_debug("one is none", [IntArg1,IntArg2]),
+ [{TrueLab, Info}, {FalseLab, Info}];
+ false ->
+ case Op of
+ '>=' ->
+ {FalseArg1, FalseArg2, TrueArg1, TrueArg2} =
+ integer_range_less_then_propagator(IntArg1, IntArg2);
+ '>' ->
+ {TrueArg2, TrueArg1, FalseArg2, FalseArg1} =
+ integer_range_less_then_propagator(IntArg2, IntArg1);
+ '<' ->
+ {TrueArg1, TrueArg2, FalseArg1, FalseArg2} =
+ integer_range_less_then_propagator(IntArg1, IntArg2);
+ '=<' ->
+ {FalseArg2, FalseArg1, TrueArg2, TrueArg1} =
+ integer_range_less_then_propagator(IntArg2, IntArg1)
+ end,
+ ?ineq_debug("int res", [TrueArg1, TrueArg2, FalseArg1, FalseArg2]),
+ False = {FalseLab, enter(A1, t_sup(FalseArg1, NonIntArg1),
+ enter(A2, t_sup(FalseArg2, NonIntArg2), Info))},
+ True = {TrueLab, enter(A1, t_sup(TrueArg1, NonIntArg1),
+ enter(A2, t_sup(TrueArg2, NonIntArg2), Info))},
+ [True, False]
+ end.
+
+integer_range_less_then_propagator(IntArg1, IntArg2) ->
+ Min1 = number_min(IntArg1),
+ Max1 = number_max(IntArg1),
+ Min2 = number_min(IntArg2),
+ Max2 = number_max(IntArg2),
+ %% is this the same as erl_types:t_subtract?? no ... ??
+ TrueMax1 = min(Max1, erl_bif_types:infinity_add(Max2, -1)),
+ TrueMin2 = max(erl_bif_types:infinity_add(Min1, 1), Min2),
+ FalseMin1 = max(Min1, Min2),
+ FalseMax2 = min(Max1, Max2),
+ {t_from_range(Min1, TrueMax1),
+ t_from_range(TrueMin2, Max2),
+ t_from_range(FalseMin1, Max1),
+ t_from_range(Min2, FalseMax2)}.
+
+do_type(I, Info) ->
+ case hipe_icode:args(I) of
+ [Var] -> do_type(I, Info, Var);
+ [Var1,Var2] -> do_type2(I, Info, Var1, Var2)
+ end.
+
+do_type2(I, Info, FunVar, ArityVar) -> % function2(Fun,Arity)
+ %% Just for sanity.
+ function2 = hipe_icode:type_test(I),
+ FunType = lookup(FunVar, Info),
+ ArityType = lookup(ArityVar, Info),
+ TrueLab = hipe_icode:type_true_label(I),
+ FalseLab = hipe_icode:type_false_label(I),
+ SuccType1 = t_inf(t_fun(), FunType),
+ case combine_test(test_type(function, FunType),
+ test_type(integer, ArityType)) of
+ true ->
+ case t_number_vals(ArityType) of
+ [Arity] ->
+ case t_fun_arity(SuccType1) of
+ unknown ->
+ SuccType = t_inf(t_fun(Arity,t_any()),FunType),
+ [{TrueLab, enter(FunVar, SuccType, Info)},
+ {FalseLab, Info}];
+ Arity when is_integer(Arity) ->
+ FalseType = t_subtract(FunType, t_fun(Arity, t_any())),
+ [{TrueLab, enter(FunVar, SuccType1, Info)},
+ {FalseLab, enter(FunVar, FalseType, Info)}]
+ end;
+ _ ->
+ case t_fun_arity(SuccType1) of
+ unknown ->
+ [{TrueLab, enter(FunVar,SuccType1,Info)},
+ {FalseLab, Info}];
+ Arity when is_integer(Arity) ->
+ T = t_from_term(Arity),
+ NewInfo = enter(ArityVar, T, Info),
+ [{TrueLab, enter(FunVar, SuccType1, NewInfo)},
+ {FalseLab, enter(ArityVar, t_subtract(T, ArityType), Info)}]
+ end
+ end;
+ false ->
+ [{FalseLab, Info}];
+ maybe ->
+ GenTrueArity = t_inf(t_integer(), ArityType),
+ GenTrueFun = t_inf(t_fun(), FunType),
+ case {t_number_vals(GenTrueArity), t_fun_arity(GenTrueFun)} of
+ {unknown, unknown} ->
+ TrueInfo = enter_list([FunVar, ArityVar],
+ [GenTrueFun, GenTrueArity], Info),
+ [{TrueLab, TrueInfo}, {FalseLab, Info}];
+ {unknown, Arity} when is_integer(Arity) ->
+ TrueInfo = enter_list([FunVar, ArityVar],
+ [GenTrueFun, t_integer(Arity)], Info),
+ [{TrueLab, TrueInfo}, {FalseLab, Info}];
+ {[Val], unknown} when is_integer(Val) ->
+ TrueInfo = enter_list([FunVar, ArityVar],
+ [t_inf(GenTrueFun, t_fun(Val, t_any())),
+ GenTrueArity], Info),
+ [{TrueLab, TrueInfo}, {FalseLab, Info}];
+ {Vals, unknown} when is_list(Vals) ->
+ %% The function type gets widened when we have more than one arity.
+ TrueInfo = enter_list([FunVar, ArityVar],
+ [GenTrueFun, GenTrueArity], Info),
+ [{TrueLab, TrueInfo}, {FalseLab, Info}];
+ {Vals, Arity} when is_list(Vals), is_integer(Arity) ->
+ case lists:member(Arity, Vals) of
+ false ->
+ [{FalseLab, Info}];
+ true ->
+ TrueInfo = enter_list([FunVar, ArityVar],
+ [GenTrueFun, t_integer(Arity)], Info),
+ [{TrueLab, TrueInfo}, {FalseLab, Info}]
+ end
+ end
+ end.
+
+combine_test(true, true) -> true;
+combine_test(false, _) -> false;
+combine_test(_, false) -> false;
+combine_test(_, _) -> maybe.
+
+do_type(I, Info, Var) ->
+ TrueLab = hipe_icode:type_true_label(I),
+ FalseLab = hipe_icode:type_false_label(I),
+ None = t_none(),
+
+ case lookup(Var, Info) of
+ None ->
+ [{TrueLab, Info}, {FalseLab, Info}];
+ VarInfo ->
+ case hipe_icode:type_test(I) of
+ cons ->
+ test_cons_or_nil(t_cons(), Var, VarInfo, TrueLab, FalseLab, Info);
+ nil ->
+ test_cons_or_nil(t_nil(), Var, VarInfo, TrueLab, FalseLab, Info);
+ {atom, A} = Test ->
+ test_number_or_atom(fun(X) -> t_atom(X) end,
+ A, Var, VarInfo, Test, TrueLab, FalseLab, Info);
+ {integer, N} = Test ->
+ test_number_or_atom(fun(X) -> t_number(X) end,
+ N, Var, VarInfo, Test, TrueLab, FalseLab, Info);
+ {record, Atom, Size} ->
+ test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info);
+ Other ->
+ case t_is_any(VarInfo) of
+ true ->
+ TrueType = t_inf(true_branch_info(Other), VarInfo),
+ TrueInfo = enter(Var, TrueType, Info),
+ [{TrueLab, TrueInfo}, {FalseLab, Info}];
+ false ->
+ case test_type(Other, VarInfo) of
+ true ->
+ [{TrueLab, Info}];
+ false ->
+ [{FalseLab, Info}];
+ maybe ->
+ TrueType = t_inf(true_branch_info(Other), VarInfo),
+ TrueInfo = enter(Var, TrueType, Info),
+ FalseType = t_subtract(VarInfo, TrueType),
+ FalseInfo = enter(Var, FalseType, Info),
+ [{TrueLab, TrueInfo}, {FalseLab, FalseInfo}]
+ end
+ end
+ end
+ end.
+
+do_switch_tuple_arity(I, Info) ->
+ Var = hipe_icode:switch_tuple_arity_term(I),
+ VarType = lookup(Var, Info),
+ Cases = hipe_icode:switch_tuple_arity_cases(I),
+ FailLabel = hipe_icode:switch_tuple_arity_fail_label(I),
+ case legal_switch_tuple_arity_cases(Cases, VarType) of
+ [] ->
+ [{FailLabel, Info}];
+ LegalCases ->
+ {Fail, UpdateInfo} =
+ switch_tuple_arity_update_info(LegalCases, Var, VarType,
+ FailLabel, VarType, Info, []),
+ case switch_tuple_arity_can_fail(LegalCases, VarType) of
+ true -> [Fail|UpdateInfo];
+ false -> UpdateInfo
+ end
+ end.
+
+legal_switch_tuple_arity_cases(Cases, Type) ->
+ case t_is_tuple(Type) of
+ false ->
+ Inf = t_inf(t_tuple(), Type),
+ case t_is_tuple(Inf) of
+ true -> legal_switch_tuple_arity_cases_1(Cases, Inf);
+ false -> []
+ end;
+ true ->
+ legal_switch_tuple_arity_cases_1(Cases, Type)
+ end.
+
+legal_switch_tuple_arity_cases_1(Cases, Type) ->
+ case t_tuple_sizes(Type) of
+ unknown ->
+ Cases;
+ TupleSizes ->
+ [Case || {Size, _Label} = Case <- Cases,
+ lists:member(hipe_icode:const_value(Size), TupleSizes)]
+ end.
+
+switch_tuple_arity_can_fail(LegalCases, ArgType) ->
+ case t_is_tuple(ArgType) of
+ false -> true;
+ true ->
+ case t_tuple_sizes(ArgType) of
+ unknown -> true;
+ Sizes1 ->
+ Sizes2 = [hipe_icode:const_value(X) || {X, _} <- LegalCases],
+ Set1 = sets:from_list(Sizes1),
+ Set2 = sets:from_list(Sizes2),
+ not sets:is_subset(Set1, Set2)
+ end
+ end.
+
+switch_tuple_arity_update_info([{Arity, Label}|Left], Var, TupleType,
+ FailLabel, FailType, Info, Acc) ->
+ Inf = t_inf(TupleType, t_tuple(hipe_icode:const_value(Arity))),
+ NewInfo = enter(Var, Inf, Info),
+ NewFailType = t_subtract(FailType, Inf),
+ switch_tuple_arity_update_info(Left, Var, TupleType, FailLabel, NewFailType,
+ Info, [{Label, NewInfo}|Acc]);
+switch_tuple_arity_update_info([], Var, _TupleType,
+ FailLabel, FailType, Info, Acc) ->
+ {{FailLabel, enter(Var, FailType, Info)}, Acc}.
+
+do_switch_val(I, Info) ->
+ Var = hipe_icode:switch_val_term(I),
+ VarType = lookup(Var, Info),
+ Cases = hipe_icode:switch_val_cases(I),
+ FailLabel = hipe_icode:switch_val_fail_label(I),
+ case legal_switch_val_cases(Cases, VarType) of
+ [] ->
+ [{FailLabel, Info}];
+ LegalCases ->
+ switch_val_update_info(LegalCases, Var, VarType,
+ FailLabel, VarType, Info, [])
+ end.
+
+legal_switch_val_cases(Cases, Type) ->
+ legal_switch_val_cases(Cases, Type, []).
+
+legal_switch_val_cases([{Val, _Label} = VL|Left], Type, Acc) ->
+ ConstType = t_from_term(hipe_icode:const_value(Val)),
+ case t_is_subtype(ConstType, Type) of
+ true ->
+ legal_switch_val_cases(Left, Type, [VL|Acc]);
+ false ->
+ legal_switch_val_cases(Left, Type, Acc)
+ end;
+legal_switch_val_cases([], _Type, Acc) ->
+ lists:reverse(Acc).
+
+switch_val_update_info([{Const, Label}|Left], Arg, ArgType,
+ FailLabel, FailType, Info, Acc) ->
+ TrueType = t_from_term(hipe_icode:const_value(Const)),
+ NewInfo = enter(Arg, TrueType, Info),
+ NewFailType = t_subtract(FailType, TrueType),
+ switch_val_update_info(Left, Arg, ArgType, FailLabel, NewFailType,
+ Info, [{Label, NewInfo}|Acc]);
+switch_val_update_info([], Arg, _ArgType, FailLabel, FailType,Info, Acc) ->
+ [{FailLabel, enter(Arg, FailType, Info)}|Acc].
+
+test_cons_or_nil(Type, Var, VarInfo, TrueLab, FalseLab, Info) ->
+ case t_is_any(VarInfo) of
+ true ->
+ [{TrueLab, enter(Var, Type, Info)},
+ {FalseLab, Info}];
+ false ->
+ TrueType = t_inf(VarInfo, Type),
+ FalseType = t_subtract(VarInfo, TrueType),
+ case t_is_none(FalseType) of
+ true ->
+ [{TrueLab, Info}];
+ false ->
+ case t_is_none(TrueType) of
+ true ->
+ [{FalseLab, Info}];
+ false ->
+ [{TrueLab, enter(Var, TrueType, Info)},
+ {FalseLab, enter(Var, FalseType, Info)}]
+ end
+ end
+ end.
+
+test_number_or_atom(Fun, X, Var, VarInfo, TypeTest,
+ TrueLab, FalseLab, Info) ->
+ case t_is_any(VarInfo) of
+ true ->
+ [{TrueLab, enter(Var, Fun(X), Info)},
+ {FalseLab, Info}];
+ false ->
+ case test_type(TypeTest, VarInfo) of
+ false ->
+ [{FalseLab, Info}];
+ true ->
+ [{TrueLab, Info}];
+ maybe ->
+ FalseType = t_subtract(VarInfo, Fun(X)),
+ [{TrueLab, enter(Var, Fun(X), Info)},
+ {FalseLab, enter(Var, FalseType, Info)}]
+ end
+ end.
+
+test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info) ->
+ AnyList = lists:duplicate(Size - 1, t_any()),
+ RecordType = t_tuple([t_atom(Atom)|AnyList]),
+ Inf = t_inf(RecordType, VarInfo),
+ case t_is_none(Inf) of
+ true ->
+ [{FalseLab, Info}];
+ false ->
+ Sub = t_subtract(VarInfo, Inf),
+ case t_is_none(Sub) of
+ true ->
+ [{TrueLab, enter(Var, Inf, Info)}];
+ false ->
+ [{TrueLab, enter(Var, Inf, Info)},
+ {FalseLab, enter(Var, Sub, Info)}]
+ end
+ end.
+
+test_type(Test, Type) ->
+ %%io:format("Test is: ~w\n", [Test]),
+ %%io:format("Type is: ~s\n", [format_type(Type)]),
+ Ans =
+ case t_is_any(Type) of
+ true -> maybe;
+ false ->
+ TrueTest = true_branch_info(Test),
+ Inf = t_inf(TrueTest, Type),
+ %%io:format("TrueTest is: ~s\n", [format_type(TrueTest)]),
+ %%io:format("Inf is: ~s\n", [format_type(Inf)]),
+ case t_is_equal(Type, Inf) of
+ true ->
+ not t_is_none(Type);
+ false ->
+ case t_is_equal(TrueTest, Inf) of
+ true ->
+ case test_type0(Test, Type) of
+ false ->
+ maybe;
+ true ->
+ true;
+ maybe ->
+ maybe
+ end;
+ false ->
+ case test_type0(Test, Inf) of
+ true ->
+ maybe;
+ false ->
+ false;
+ maybe ->
+ maybe
+ end
+ end
+ end
+ end,
+ %% io:format("Result is: ~s\n\n", [Ans]),
+ Ans.
+
+test_type0(integer, T) ->
+ t_is_integer(T);
+test_type0({integer, N}, T) ->
+ case t_is_integer(T) of
+ true ->
+ case t_number_vals(T) of
+ unknown -> maybe;
+ [N] -> true;
+ List when is_list(List) ->
+ case lists:member(N, List) of
+ true -> maybe;
+ false -> false
+ end
+ end;
+ false -> false
+ end;
+test_type0(float, T) ->
+ t_is_float(T);
+test_type0(number, T) ->
+ t_is_number(T);
+test_type0(atom, T) ->
+ t_is_atom(T);
+test_type0({atom, A}, T) ->
+ case t_is_atom(T) of
+ true ->
+ case t_atom_vals(T) of
+ unknown -> maybe;
+ [A] -> true;
+ List when is_list(List) ->
+ case lists:member(A, List) of
+ true -> maybe;
+ false -> false
+ end
+ end;
+ false -> false
+ end;
+test_type0(tuple, T) ->
+ t_is_tuple(T);
+test_type0({tuple, N}, T) ->
+ case t_is_tuple(T) of
+ true ->
+ case t_tuple_sizes(T) of
+ unknown -> maybe;
+ [X] when is_integer(X) -> X =:= N;
+ List when is_list(List) ->
+ case lists:member(N, List) of
+ true -> maybe;
+ false -> false
+ end
+ end;
+ false -> false
+ end;
+test_type0(pid, T) ->
+ t_is_pid(T);
+test_type0(port, T) ->
+ t_is_port(T);
+test_type0(binary, T) ->
+ t_is_binary(T);
+test_type0(bitstr, T) ->
+ t_is_bitstr(T);
+test_type0(reference, T) ->
+ t_is_reference(T);
+test_type0(function, T) ->
+ t_is_fun(T);
+test_type0(boolean, T) ->
+ t_is_boolean(T);
+test_type0(list, T) ->
+ t_is_maybe_improper_list(T);
+test_type0(cons, T) ->
+ t_is_cons(T);
+test_type0(nil, T) ->
+ t_is_nil(T);
+test_type0(constant, T) ->
+ t_is_constant(T).
+
+
+true_branch_info(integer) ->
+ t_integer();
+true_branch_info({integer, N}) ->
+ t_integer(N);
+true_branch_info(float) ->
+ t_float();
+true_branch_info(number) ->
+ t_number();
+true_branch_info(atom) ->
+ t_atom();
+true_branch_info({atom, A}) ->
+ t_atom(A);
+true_branch_info(list) ->
+ t_maybe_improper_list();
+true_branch_info(tuple) ->
+ t_tuple();
+true_branch_info({tuple, N}) ->
+ t_tuple(N);
+true_branch_info(pid) ->
+ t_pid();
+true_branch_info(port) ->
+ t_port();
+true_branch_info(binary) ->
+ t_binary();
+true_branch_info(bitstr) ->
+ t_bitstr();
+true_branch_info(reference) ->
+ t_reference();
+true_branch_info(function) ->
+ t_fun();
+true_branch_info(cons) ->
+ t_cons();
+true_branch_info(nil) ->
+ t_nil();
+true_branch_info(boolean) ->
+ t_boolean();
+true_branch_info(constant) ->
+ t_constant();
+true_branch_info(T) ->
+ exit({?MODULE,unknown_typetest,T}).
+
+
+%% _________________________________________________________________
+%%
+%% Remove the redundant type tests. If a test is removed, the trace
+%% that isn't taken is explicitly removed from the CFG to simpilify
+%% the handling of Phi nodes. If a Phi node is left and at least one
+%% branch into it has disappeared, the SSA propagation pass can't
+%% handle it.
+%%
+%% If the CFG has changed at the end of this pass, the analysis is
+%% done again since we might be able to find more information because
+%% of the simplification of the CFG.
+%%
+
+simplify_controlflow(State) ->
+ Cfg = state__cfg(State),
+ simplify_controlflow(hipe_icode_cfg:reverse_postorder(Cfg), State).
+
+simplify_controlflow([Label|Left], State) ->
+ Info = state__info_out(State, Label),
+ NewState =
+ case state__bb(State, Label) of
+ not_found -> State;
+ BB ->
+ I = hipe_bb:last(BB),
+ case I of
+ #icode_if{} ->
+ rewrite_if(State,I,BB,Info,Label);
+ #icode_type{} ->
+ rewrite_type(State,I,BB,Info,Label);
+ #icode_switch_tuple_arity{} ->
+ rewrite_switch_tuple_arity(State,I,BB,Info,Label);
+ #icode_switch_val{} ->
+ rewrite_switch_val(State,I,BB,Info,Label);
+ #icode_call{} ->
+ rewrite_call(State,I,BB,Info,Label);
+ _ ->
+ State
+ end
+ end,
+ simplify_controlflow(Left, NewState);
+simplify_controlflow([], State) ->
+ State.
+
+rewrite_if(State, I, BB, Info, Label) ->
+ case do_if(I, Info) of
+ [{Lab, _}] ->
+ mk_goto(State, BB, Label, Lab);
+ [_,_] ->
+ State
+ end.
+
+rewrite_type(State, I, BB, Info, Label) ->
+ FalseLab = hipe_icode:type_false_label(I),
+ case hipe_icode:type_true_label(I) of
+ FalseLab ->
+ %% true label = false label, this can occur!
+ mk_goto(State, BB, Label, FalseLab);
+ TrueLab ->
+ case do_type(I, Info) of
+ [{TrueLab, _}] ->
+ mk_goto(State, BB, Label, TrueLab);
+ [{FalseLab, _}] ->
+ mk_goto(State, BB, Label, FalseLab);
+ [_,_] -> %% Maybe
+ State
+ end
+ end.
+
+rewrite_switch_tuple_arity(State, I, BB, Info, Label) ->
+ Cases = hipe_icode:switch_tuple_arity_cases(I),
+ Var = hipe_icode:switch_tuple_arity_term(I),
+ Type = safe_lookup(Var, Info),
+ case legal_switch_tuple_arity_cases(Cases, Type) of
+ [] ->
+ Fail = hipe_icode:switch_tuple_arity_fail_label(I),
+ mk_goto(State, BB, Label, Fail);
+ Cases ->
+ %% Nothing changed.
+ case switch_tuple_arity_can_fail(Cases, Type) of
+ true -> State;
+ false ->
+ NewCases = butlast(Cases),
+ {_Arity, NewFail} = lists:last(Cases),
+ TmpI =
+ hipe_icode:switch_tuple_arity_fail_label_update(I, NewFail),
+ NewI =
+ hipe_icode:switch_tuple_arity_cases_update(TmpI, NewCases),
+ NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]),
+ state__bb_add(State, Label, NewBB)
+ end;
+ LegalCases ->
+ NewI =
+ case switch_tuple_arity_can_fail(LegalCases, Type) of
+ true ->
+ hipe_icode:switch_tuple_arity_cases_update(I, LegalCases);
+ false ->
+ NewCases = butlast(LegalCases),
+ {_Arity, NewFail} = lists:last(LegalCases),
+ TmpI =
+ hipe_icode:switch_tuple_arity_cases_update(I, NewCases),
+ hipe_icode:switch_tuple_arity_fail_label_update(TmpI, NewFail)
+ end,
+ NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]),
+ state__bb_add(State, Label, NewBB)
+ end.
+
+rewrite_switch_val(State, I, BB, Info, Label) ->
+ Cases = hipe_icode:switch_val_cases(I),
+ Var = hipe_icode:switch_val_term(I),
+ VarType = safe_lookup(Var, Info),
+ case legal_switch_val_cases(Cases, VarType) of
+ [] ->
+ Fail = hipe_icode:switch_val_fail_label(I),
+ mk_goto(State, BB, Label, Fail);
+ Cases ->
+ State;
+ %% TODO: Find out whether switch_val can fail
+ %% just as switch_tuple_arity
+ LegalCases ->
+ NewI = hipe_icode:switch_val_cases_update(I, LegalCases),
+ NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]),
+ state__bb_add(State, Label, NewBB)
+ end.
+
+rewrite_call(State,I,BB,Info,Label) ->
+ case call_always_fails(I, Info) of
+ false ->
+ Fun = hipe_icode:call_fun(I),
+ case hipe_icode_primops:fails(Fun) of
+ false ->
+ case hipe_icode:call_fail_label(I) of
+ [] -> State;
+ _ -> unset_fail(State, BB, Label, I)
+ end;
+ true -> State
+ end;
+ true ->
+ case hipe_icode:call_in_guard(I) of
+ false -> State;
+ true ->
+ FailLabel = hipe_icode:call_fail_label(I),
+ mk_goto(State, BB, Label, FailLabel)
+ end
+ end.
+
+mk_goto(State, BB, Label, Succ) ->
+ NewI = hipe_icode:mk_goto(Succ),
+ NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]),
+ state__bb_add(State, Label, NewBB).
+
+unset_fail(State, BB, Label, I) ->
+ %%io:format("Setting a guard that cannot fail\n", []),
+ NewI = hipe_icode:call_set_fail_label(I, []),
+ NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]),
+ state__bb_add(State, Label, NewBB).
+
+%% _________________________________________________________________
+%%
+%% Make transformations (specialisations) based on the type knowledge.
+%%
+%% Annotate the variables with the local information. Since we have
+%% the code in SSA form and the type information can only depend on
+%% assignments or branches (type tests), we can use the information
+%% out of the block to annotate all variables in it.
+%%
+
+-spec specialize(cfg()) -> cfg().
+
+specialize(Cfg) ->
+ Labels = hipe_icode_cfg:reverse_postorder(Cfg),
+ transform_bbs(Labels, Cfg).
+
+transform_bbs([Label|Left], Cfg) ->
+ BB = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ NewCode = make_transformations(Code),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB),
+ transform_bbs(Left, NewCfg);
+transform_bbs([], Cfg) ->
+ Cfg.
+
+make_transformations(Is) ->
+ lists:flatten([transform_insn(I) || I <- Is]).
+
+transform_insn(I) ->
+ case I of
+ #icode_call{} ->
+ handle_call_and_enter(I);
+ #icode_enter{} ->
+ handle_call_and_enter(I);
+ #icode_if{} ->
+ CurrentIfOp = hipe_icode:if_op(I),
+ UsesFixnums = all_fixnums([get_type(A) || A <- hipe_icode:args(I)]),
+ AnyImmediate = any_immediate([get_type(A) || A <- hipe_icode:args(I)]),
+ ExactComp = is_exact_comp(CurrentIfOp),
+ if UsesFixnums ->
+ hipe_icode:if_op_update(I, fixnum_ifop(CurrentIfOp));
+ AnyImmediate andalso ExactComp ->
+ hipe_icode:if_op_update(I, fixnum_ifop(CurrentIfOp));
+ true ->
+ I
+ end;
+ _ ->
+ I
+ end.
+
+handle_call_and_enter(I) ->
+ case call_or_enter_fun(I) of
+ #element{} ->
+ transform_insn(update_call_or_enter(I, {erlang, element, 2}));
+ {erlang, element, 2} ->
+ NewI1 = transform_element2(I),
+ case is_record(I, icode_call) andalso hipe_icode:call_in_guard(I) of
+ true ->
+ case hipe_icode:call_fun(NewI1) of
+ #unsafe_element{} -> NewI1;
+ _ -> I
+ end;
+ false ->
+ NewI1
+ end;
+ {erlang, hd, 1} -> transform_hd_or_tl(I, unsafe_hd);
+ {erlang, tl, 1} -> transform_hd_or_tl(I, unsafe_tl);
+ {hipe_bs_primop, BsOP} ->
+ NewBsOp =
+ bit_opts(BsOP, get_type_list(hipe_icode:args(I))),
+ update_call_or_enter(I, {hipe_bs_primop, NewBsOp});
+ conv_to_float ->
+ [Src] = hipe_icode:args(I),
+ case t_is_float(get_type(Src)) of
+ true ->
+ update_call_or_enter(I, unsafe_untag_float);
+ false ->
+ I
+ end;
+ FunName ->
+ case is_arith_function(FunName) of
+ true ->
+ case strength_reduce(I, FunName) of
+ NewIs when is_list(NewIs) ->
+ [pos_transform_arith(NewI) || NewI <- NewIs];
+ NewI ->
+ pos_transform_arith(NewI)
+ end;
+ false ->
+ I
+ end
+ end.
+
+pos_transform_arith(I) ->
+ case hipe_icode:is_enter(I) orelse hipe_icode:is_call(I) of
+ true ->
+ FunName = call_or_enter_fun(I),
+ transform_arith(I, FunName);
+ false ->
+ I
+ end.
+
+is_arith_function(Name) ->
+ case Name of
+ 'band' -> true;
+ 'bor' -> true;
+ 'bxor' -> true;
+ 'bnot' -> true;
+ 'bsl' -> true;
+ 'bsr' -> true;
+ '+' -> true;
+ '-' -> true;
+ '*' -> true;
+ 'div' -> true;
+ 'rem' -> true;
+ _ -> false
+ end.
+
+%%---------------------------------------------------------------------
+%% Perform a limited form of strength reduction for multiplication and
+%% division of an integer with constants which are multiples of 2.
+%%---------------------------------------------------------------------
+
+strength_reduce(I, Op) ->
+ case Op of
+ '*' ->
+ [Arg1, Arg2] = mult_args_const_second(I),
+ ArgT1 = get_type(Arg1),
+ case t_is_integer(ArgT1) of
+ true ->
+ case hipe_icode:is_const(Arg2) of
+ true ->
+ case hipe_icode:const_value(Arg2) of
+ 0 -> case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [Dst] -> create_strength_reduce_move(I, Dst, Arg2)
+ end;
+ 1 -> case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [Dst] -> create_strength_reduce_move(I, Dst, Arg1)
+ end;
+ 2 -> strength_reduce_imult(I, Arg1, 1);
+ 4 -> strength_reduce_imult(I, Arg1, 2);
+ 8 -> strength_reduce_imult(I, Arg1, 3);
+ 16 -> strength_reduce_imult(I, Arg1, 4);
+ 32 -> strength_reduce_imult(I, Arg1, 5);
+ 64 -> strength_reduce_imult(I, Arg1, 6);
+ 128 -> strength_reduce_imult(I, Arg1, 7);
+ 256 -> strength_reduce_imult(I, Arg1, 8);
+ ___ -> I
+ end;
+ false -> I
+ end;
+ false -> I
+ end;
+ 'div' ->
+ [Arg1, Arg2] = hipe_icode:args(I),
+ ArgT1 = get_type(Arg1),
+ case t_is_non_neg_integer(ArgT1) of
+ true -> %% the optimization is NOT valid for negative integers
+ case hipe_icode:is_const(Arg2) of
+ true ->
+ case hipe_icode:const_value(Arg2) of
+ 0 -> io:fwrite("Integer division by 0 detected!\n"), I;
+ 1 -> case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [Dst] -> create_strength_reduce_move(I, Dst, Arg1)
+ end;
+ 2 -> strength_reduce_div(I, Arg1, 1);
+ 4 -> strength_reduce_div(I, Arg1, 2);
+ 8 -> strength_reduce_div(I, Arg1, 3);
+ 16 -> strength_reduce_div(I, Arg1, 4);
+ 32 -> strength_reduce_div(I, Arg1, 5);
+ 64 -> strength_reduce_div(I, Arg1, 6);
+ 128 -> strength_reduce_div(I, Arg1, 7);
+ 256 -> strength_reduce_div(I, Arg1, 8);
+ ___ -> I
+ end;
+ false -> I
+ end;
+ false -> I
+ end;
+ 'rem' ->
+ [Arg1, Arg2] = hipe_icode:args(I),
+ ArgT1 = get_type(Arg1),
+ case t_is_non_neg_integer(ArgT1) of
+ true -> %% the optimization is NOT valid for negative integers
+ case hipe_icode:is_const(Arg2) of
+ true ->
+ case hipe_icode:const_value(Arg2) of
+ 0 -> io:fwrite("Remainder with 0 detected!\n"), I;
+ 1 -> case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [Dst] -> create_strength_reduce_move(
+ I, Dst, hipe_icode:mk_const(0))
+ end;
+ 2 -> strength_reduce_rem(I, Arg1, 1);
+ 4 -> strength_reduce_rem(I, Arg1, 3);
+ 8 -> strength_reduce_rem(I, Arg1, 7);
+ 16 -> strength_reduce_rem(I, Arg1, 15);
+ 32 -> strength_reduce_rem(I, Arg1, 31);
+ 64 -> strength_reduce_rem(I, Arg1, 63);
+ 128 -> strength_reduce_rem(I, Arg1, 127);
+ 256 -> strength_reduce_rem(I, Arg1, 255);
+ ___ -> I
+ end;
+ false -> I
+ end;
+ false -> I
+ end;
+ _ -> I
+ end.
+
+remove_useless_arithmetic_instruction(_) ->
+ [].
+
+create_strength_reduce_move(I, Dst, Val) ->
+ case hipe_icode:call_continuation(I) of
+ [] ->
+ hipe_icode:mk_move(Dst, Val);
+ Lbl ->
+ [hipe_icode:mk_move(Dst, Val),
+ hipe_icode:mk_goto(Lbl)]
+ end.
+
+%% Puts the args of a multiplication in a form where the constant
+%% (if present) is always the second argument.
+mult_args_const_second(I) ->
+ [Arg1, Arg2] = Args = hipe_icode:args(I),
+ case hipe_icode:is_const(Arg1) of
+ true -> [Arg2, Arg1];
+ false -> Args
+ end.
+
+%% In all three functions below:
+%% - Arg1 is a variable of integer type
+%% - N is a small positive integer that will be used in a bit shift operation
+strength_reduce_imult(I, Arg1, N) ->
+ case t_number_vals(get_type(Arg1)) of
+ [X] when is_integer(X) ->
+ %% io:format("Multiplication with constant arguments:\n ~w\n", [I]),
+ case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [D] -> create_strength_reduce_move(I, D, hipe_icode:mk_const(X bsl N))
+ end;
+ _ ->
+ update_call_or_enter(I, 'bsl', [Arg1, hipe_icode:mk_const(N)])
+ end.
+
+strength_reduce_div(I, Arg1, N) ->
+ case t_number_vals(get_type(Arg1)) of
+ [X] when is_integer(X) ->
+ %% io:format("Division with constant arguments:\n ~w\n", [I]),
+ case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [D] -> create_strength_reduce_move(I, D, hipe_icode:mk_const(X bsr N))
+ end;
+ _ ->
+ update_call_or_enter(I, 'bsr', [Arg1, hipe_icode:mk_const(N)])
+ end.
+
+strength_reduce_rem(I, Arg1, N) ->
+ case t_number_vals(get_type(Arg1)) of
+ [X] when is_integer(X) ->
+ %% io:format("Remainder with constant arguments:\n ~w\n", [I]),
+ case call_dstlist(I) of
+ [] -> remove_useless_arithmetic_instruction(I);
+ [D] -> create_strength_reduce_move(I, D, hipe_icode:mk_const(X band N))
+ end;
+ _ ->
+ update_call_or_enter(I, 'band', [Arg1, hipe_icode:mk_const(N)])
+ end.
+
+%%---------------------------------------------------------------------
+
+call_or_enter_fun(I) ->
+ case hipe_icode:is_call(I) of
+ true -> hipe_icode:call_fun(I);
+ false -> hipe_icode:enter_fun(I)
+ end.
+
+update_call_or_enter(I, NewFun) ->
+ case hipe_icode:is_call(I) of
+ true ->
+ case hipe_icode_primops:fails(NewFun) of
+ false ->
+ NewI = hipe_icode:call_fun_update(I, NewFun),
+ hipe_icode:call_set_fail_label(NewI, []);
+ true ->
+ hipe_icode:call_fun_update(I, NewFun)
+ end;
+ false -> hipe_icode:enter_fun_update(I, NewFun)
+ end.
+
+update_call_or_enter(I, NewFun, NewArgs) ->
+ case hipe_icode:is_call(I) of
+ true ->
+ I1 = hipe_icode:call_args_update(I, NewArgs),
+ hipe_icode:call_fun_update(I1, NewFun);
+ false ->
+ I1 = hipe_icode:enter_args_update(I, NewArgs),
+ hipe_icode:enter_fun_update(I1, NewFun)
+ end.
+
+transform_element2(I) ->
+ [Index, Tuple] = hipe_icode:args(I),
+ IndexType = get_type(Index),
+ TupleType = get_type(Tuple),
+ ?debug("Tuple", TupleType),
+ NewIndex =
+ case test_type(integer, IndexType) of
+ true ->
+ case t_number_vals(IndexType) of
+ unknown -> unknown;
+ [_|_] = Vals -> {number, Vals}
+ end;
+ _ -> unknown
+ end,
+ MinSize =
+ case test_type(tuple, TupleType) of
+ true ->
+ ?debug("is tuple", TupleType),
+ case t_tuple_sizes(TupleType) of
+ unknown -> unknown;
+ Sizes -> {tuple, lists:min(Sizes)}
+ end;
+ _ -> unknown
+ end,
+ case {NewIndex, MinSize} of
+ {{number, [_|_] = Ns}, {tuple, A}} when is_integer(A) ->
+ case lists:all(fun(X) -> 0 < X andalso X =< A end, Ns) of
+ true ->
+ case Ns of
+ [Idx] ->
+ [_, Tuple] = hipe_icode:args(I),
+ update_call_or_enter(I, #unsafe_element{index = Idx}, [Tuple]);
+ [_|_] ->
+ NewFun = {element, [MinSize, valid]},
+ update_call_or_enter(I, NewFun)
+ end;
+ false ->
+ case lists:all(fun(X) -> hipe_tagscheme:is_fixnum(X) end, Ns) of
+ true ->
+ NewFun = {element, [MinSize, fixnums]},
+ update_call_or_enter(I, NewFun);
+ false ->
+ NewFun = {element, [MinSize, unknown]},
+ update_call_or_enter(I, NewFun)
+ end
+ end;
+ _ when (NewIndex =:= unknown) orelse (MinSize =:= unknown) ->
+ case t_is_fixnum(IndexType) of
+ true ->
+ NewFun = {element, [MinSize, fixnums]},
+ update_call_or_enter(I, NewFun);
+ false ->
+ NewFun = {element, [MinSize, NewIndex]},
+ update_call_or_enter(I, NewFun)
+ end
+ end.
+
+transform_hd_or_tl(I, Primop) ->
+ [Arg] = hipe_icode:args(I),
+ case t_is_cons(get_type(Arg)) of
+ true -> update_call_or_enter(I, Primop);
+ false -> I
+ end.
+
+transform_arith(I, Op) ->
+ ArgTypes = get_type_list(hipe_icode:args(I)),
+ %% io:format("Op = ~w, Args = ~w\n", [Op, ArgTypes]),
+ DstTypes =
+ case hipe_icode:is_call(I) of
+ true -> get_type_list(call_dstlist(I));
+ false -> [erl_bif_types:type(erlang, Op, length(ArgTypes), ArgTypes)]
+ end,
+ case valid_unsafe_args(ArgTypes, Op) of
+ true ->
+ case all_is_fixnum(DstTypes) of
+ true ->
+ update_call_or_enter(I, arithop_to_extra_unsafe(Op));
+ false ->
+ update_call_or_enter(I, arithop_to_unsafe(Op))
+ end;
+ false ->
+ I
+ end.
+
+all_is_fixnum(Types) ->
+ lists:all(fun erl_types:t_is_fixnum/1, Types).
+
+valid_unsafe_args(Args, Op) ->
+ if Op =:= 'bnot' ->
+ [Arg] = Args,
+ t_is_fixnum(Arg);
+ true ->
+ [LeftArg, RightArg] = Args,
+ case Op of
+ 'bsl' -> t_is_fixnum(LeftArg) and t_is_bitwidth(RightArg);
+ 'bsr' -> t_is_fixnum(LeftArg) and t_is_bitwidth(RightArg);
+ _ -> t_is_fixnum(LeftArg) and t_is_fixnum(RightArg)
+ end
+ end.
+
+arithop_to_extra_unsafe(Op) ->
+ case Op of
+ '+' -> extra_unsafe_add;
+ '-' -> extra_unsafe_sub;
+ '*' -> '*'; %% XXX: Revise?
+ 'div' -> 'div'; %% XXX: Revise?
+ 'rem' -> 'rem'; %% XXX: Revise?
+ 'band' -> unsafe_band;
+ 'bor' -> unsafe_bor;
+ 'bxor' -> unsafe_bxor;
+ 'bnot' -> unsafe_bnot;
+ 'bsl' -> unsafe_bsl;
+ 'bsr' -> unsafe_bsr
+ end.
+
+arithop_to_unsafe(Op) ->
+ case Op of
+ '+' -> unsafe_add;
+ '-' -> unsafe_sub;
+ _ -> Op
+ end.
+
+fixnum_ifop(Op) ->
+ case Op of
+ '=:=' -> 'fixnum_eq';
+ '=/=' -> 'fixnum_neq';
+ '==' -> 'fixnum_eq';
+ '/=' -> 'fixnum_neq';
+ '>' -> 'fixnum_gt';
+ '<' -> 'fixnum_lt';
+ '>=' -> 'fixnum_ge';
+ '=<' -> 'fixnum_le';
+ Op -> Op
+ end.
+
+bit_opts({Name, Size, Flags} = I, [MSType]) when Name =:= bs_get_integer;
+ Name =:= bs_get_float;
+ Name =:= bs_get_binary ->
+ Bits = t_matchstate_present(MSType),
+ case t_is_bitstr(Bits) of
+ true ->
+ Base = t_bitstr_base(Bits),
+ if Base >= Size ->
+ {Name, Size, Flags bor 16};
+ true -> I
+ end;
+ false -> I
+ end;
+bit_opts({bs_get_binary_all, Size, Flags} = I, [MSType]) ->
+ Bits = t_matchstate_present(MSType),
+ case t_is_bitstr(Bits) of
+ true ->
+ Base = t_bitstr_base(Bits),
+ Unit = t_bitstr_unit(Bits),
+ if (Base rem Size) =:= 0 andalso (Unit rem Size) =:= 0 ->
+ {bs_get_binary_all, Size, Flags bor 16};
+ true -> I
+ end;
+ false -> I
+ end;
+bit_opts({bs_test_unit, Size} = I, [MSType]) ->
+ Bits = t_matchstate_present(MSType),
+ case t_is_bitstr(Bits) of
+ true ->
+ Base = t_bitstr_base(Bits),
+ Unit = t_bitstr_unit(Bits),
+ if (Base rem Size) =:= 0 andalso (Unit rem Size) =:= 0 ->
+ {bs_test_unit, 1};
+ true -> I
+ end;
+ false -> I
+ end;
+bit_opts({bs_put_integer, Size, Flags, ConstInfo} = I, [Src|_]) ->
+ case t_is_fixnum(Src) of
+ true ->
+ {unsafe_bs_put_integer, Size, Flags, ConstInfo};
+ false -> I
+ end;
+bit_opts({bs_start_match, Max} = I, [Src]) ->
+ case t_is_bitstr(Src) of
+ true -> {{bs_start_match, bitstr}, Max};
+ false ->
+ MSorNone = t_inf(t_matchstate(), Src),
+ case t_is_matchstate(MSorNone) of
+ true ->
+ Slots = t_matchstate_slots(MSorNone),
+ case t_is_any(Slots) orelse (length(t_to_tlist(Slots)) =< Max) of
+ true -> I;
+ false -> {{bs_start_match, ok_matchstate}, Max}
+ end;
+ false -> I
+ end
+ end;
+bit_opts(I, _) -> I.
+
+is_exact_comp(Op) ->
+ case Op of
+ '=:=' -> true;
+ '=/=' -> true;
+ _Op -> false
+ end.
+
+all_fixnums([Type|Types]) ->
+ t_is_fixnum(Type) andalso all_fixnums(Types);
+all_fixnums([]) ->
+ true.
+
+any_immediate([Type|Types]) ->
+ t_is_fixnum(Type) orelse t_is_atom(Type) orelse any_immediate(Types);
+any_immediate([]) -> false.
+
+get_standard_primop(unsafe_bsl) -> 'bsl';
+get_standard_primop(unsafe_bsr) -> 'bsr';
+get_standard_primop(unsafe_add) -> '+';
+get_standard_primop(extra_unsafe_add) -> '+';
+get_standard_primop(unsafe_bnot) -> 'bnot';
+get_standard_primop(unsafe_bxor) -> 'bxor';
+get_standard_primop(unsafe_band) -> 'band';
+get_standard_primop(unsafe_bor) -> 'bor';
+get_standard_primop(unsafe_sub) -> '-';
+get_standard_primop(extra_unsafe_sub) -> '-';
+get_standard_primop(Op) -> Op.
+
+primop_type(Op, Args) ->
+ case Op of
+ #mkfun{mfa = MFA} ->
+ t_inf(t_fun(), find_signature_mfa(MFA));
+ _ ->
+ None = t_none(),
+ Primop = get_standard_primop(Op),
+ RetType = hipe_icode_primops:type(Primop, Args),
+ case RetType of
+ None ->
+ hipe_icode_primops:type(Primop, add_funs_to_arg_types(Args));
+ Other ->
+ Other
+ end
+ end.
+
+%%------------------------------------------------------------------
+%% Various help functions.
+%%------------------------------------------------------------------
+
+add_arg_types(Args, Types) ->
+ add_arg_types(Args, Types, gb_trees:empty()).
+
+add_arg_types([Arg|Args], [Type|Types], Acc) ->
+ Type1 =
+ case t_is_none(Type) of
+ true -> t_any();
+ false -> Type
+ end,
+ add_arg_types(Args,Types, enter(Arg, Type1, Acc));
+add_arg_types(_, [], Acc) ->
+ Acc.
+
+get_type_list(ArgList) ->
+ [get_type(Arg) || Arg <- ArgList].
+
+get_type(Arg) ->
+ case hipe_icode:is_annotated_variable(Arg) of
+ true ->
+ None = t_none(),
+ case hipe_icode:variable_annotation(Arg) of
+ {type_anno, None, _} -> t_any();
+ {type_anno, Type, _} -> Type
+ end;
+ false ->
+ case hipe_icode:is_const(Arg) of
+ true -> const_type(Arg);
+ false -> t_any()
+ end
+ end.
+
+%% Lookup treats anything that is neither in the map or a constant as
+%% t_none(). Use this during type propagation!
+
+lookup(Var, Tree) ->
+ case gb_trees:lookup(Var, Tree) of
+ none ->
+ case hipe_icode:is_const(Var) of
+ true -> const_type(Var);
+ false -> t_none()
+ end;
+ {value, Type} ->
+ Type
+ end.
+
+lookup_list(List, Info) ->
+ lookup_list0(List, Info, []).
+
+lookup_list0([H|T], Info, Acc) ->
+ lookup_list0(T, Info, [lookup(H, Info)|Acc]);
+lookup_list0([], _, Acc) ->
+ lists:reverse(Acc).
+
+
+%% safe_lookup treats anything that is neither in the map nor a
+%% constant as t_any(). Use this during transformations.
+
+safe_lookup(Var, Tree) ->
+ case gb_trees:lookup(Var, Tree) of
+ none ->
+ case hipe_icode:is_const(Var) of
+ true -> const_type(Var);
+ false ->
+ %% io:format("Expression has undefined type\n",[]),
+ t_any()
+ end;
+ {value, Type} ->
+ Type
+ end.
+
+safe_lookup_list(List, Info) ->
+ safe_lookup_list0(List, Info, []).
+
+safe_lookup_list0([H|T], Info, Acc) ->
+ safe_lookup_list0(T, Info, [safe_lookup(H, Info)|Acc]);
+safe_lookup_list0([], _, Acc) ->
+ lists:reverse(Acc).
+
+enter_list([Var|VarLeft], [Type|TypeLeft], Info) ->
+ NewInfo = enter(Var, Type, Info),
+ enter_list(VarLeft, TypeLeft, NewInfo);
+enter_list([], [], Info) ->
+ Info.
+
+enter([Key], Value, Tree) ->
+ enter(Key, Value, Tree);
+enter(Key, Value, Tree) ->
+ case is_var_or_reg(Key) of
+ true ->
+ case t_is_none(Value) of
+ true ->
+ gb_trees:delete_any(Key, Tree);
+ false ->
+ gb_trees:enter(Key, Value, Tree)
+ end;
+ false ->
+ Tree
+ end.
+
+join_list(List, Info) ->
+ join_list(List, Info, t_none()).
+
+join_list([H|T], Info, Acc) ->
+ Type = t_sup(lookup(H, Info), Acc),
+ join_list(T, Info, Type);
+join_list([], _, Acc) ->
+ Acc.
+
+join_info_in([], _OldInfo, _NewInfo) ->
+ %% No variables are live in. The information must be at a fixpoint.
+ fixpoint;
+join_info_in(Vars, OldInfo, NewInfo) ->
+ NewInfo2 = join_info_in(Vars, Vars, OldInfo, NewInfo, gb_trees:empty()),
+ case info_is_equal(NewInfo2, OldInfo) of
+ true -> fixpoint;
+ false -> NewInfo2
+ end.
+
+%% NOTE: Variables can be bound to other variables. Joining these is
+%% only possible if the binding is the same from both traces and this
+%% variable is still live.
+
+join_info_in([Var|Left], LiveIn, Info1, Info2, Acc) ->
+ Type1 = gb_trees:lookup(Var, Info1),
+ Type2 = gb_trees:lookup(Var, Info2),
+ case {Type1, Type2} of
+ {none, none} ->
+ join_info_in(Left, LiveIn, Info1, Info2, Acc);
+ {none, {value, Val}} ->
+ NewTree = gb_trees:insert(Var, Val, Acc),
+ join_info_in(Left, LiveIn, Info1, Info2, NewTree);
+ {{value, Val}, none} ->
+ NewTree = gb_trees:insert(Var, Val, Acc),
+ join_info_in(Left, LiveIn, Info1, Info2, NewTree);
+ {{value, Val1}, {value, Val2}} ->
+ NewTree = gb_trees:insert(Var, t_sup(Val1, Val2), Acc),
+ join_info_in(Left, LiveIn, Info1, Info2, NewTree)
+ end;
+join_info_in([], _LiveIn, _Info1, _Info2, Acc) ->
+ Acc.
+
+info_is_equal(Info1, Info2) ->
+ compare(gb_trees:to_list(Info1), gb_trees:to_list(Info2)).
+
+compare([{Var, Type1}|Left1], [{Var, Type2}|Left2]) ->
+ t_is_equal(Type1, Type2) andalso compare(Left1, Left2);
+compare([], []) ->
+ true;
+compare(_, _) ->
+ false.
+
+const_type(Const) ->
+ t_from_term(hipe_icode:const_value(Const)).
+
+do_updates(State, List) ->
+ do_updates(State, List, []).
+
+do_updates(State, [{Label, Info}|Tail], Worklist) ->
+ case state__info_in_update(State, Label, Info) of
+ fixpoint ->
+ %% io:format("Info in for ~w is: fixpoint\n", [Label]),
+ do_updates(State, Tail, Worklist);
+ NewState ->
+ %% io:format("Info in for ~w is:\n", [Label]),
+ %% [io:format("~w: ~p\n", [X, format_type(Y)])
+ %% || {X, Y} <- gb_trees:to_list(state__info_in(NewState, Label))],
+ do_updates(NewState, Tail, [Label|Worklist])
+ end;
+do_updates(State, [], Worklist) ->
+ {State, Worklist}.
+
+enter_defines(I, Type, Info) ->
+ case defines(I) of
+ [] -> Info;
+ [Def] ->
+ enter(Def, Type, Info);
+ Defs ->
+ Pairs = case t_is_any(Type) of
+ true ->
+ [{Def, t_any()} || Def <- Defs];
+ false ->
+ case t_is_none(Type) of
+ true ->
+ [{Def, t_none()} || Def <- Defs];
+ false ->
+ lists:zip(Defs, t_to_tlist(Type))
+ end
+ end,
+ lists:foldl(fun({X, T}, Inf) -> enter(X, T, Inf) end, Info, Pairs)
+ end.
+
+defines(I) ->
+ keep_vars_and_regs(hipe_icode:defines(I)).
+
+call_dstlist(I) ->
+ hipe_icode:call_dstlist(I).
+
+uses(I) ->
+ keep_vars_and_regs(hipe_icode:uses(I)).
+
+keep_vars_and_regs(Vars) ->
+ [V || V <- Vars, is_var_or_reg(V)].
+
+butlast([_]) ->
+ [];
+butlast([H|T]) ->
+ [H|butlast(T)].
+
+-spec any_is_none([erl_types:erl_type()]) -> boolean().
+
+any_is_none(Types) ->
+ lists:any(fun (T) -> t_is_none(T) end, Types).
+
+is_var_or_reg(X) ->
+ hipe_icode:is_var(X) orelse hipe_icode:is_reg(X).
+
+%% _________________________________________________________________
+%%
+%% Handling the state
+%%
+
+new_state(Cfg, {MFA, GetCallFun, GetResFun, FinalAction}) ->
+ Start = hipe_icode_cfg:start_label(Cfg),
+ Params = hipe_icode_cfg:params(Cfg),
+ ParamTypes = GetCallFun(MFA, Cfg),
+ case any_is_none(ParamTypes) of
+ true ->
+ FinalAction(MFA, [t_none()]),
+ throw(no_input);
+ false ->
+ Info = add_arg_types(Params, ParamTypes),
+ InfoMap = gb_trees:insert({Start, in}, Info, gb_trees:empty()),
+ Liveness = hipe_icode_ssa:ssa_liveness__analyze(Cfg),
+ #state{info_map = InfoMap, cfg = Cfg, liveness = Liveness,
+ arg_types = ParamTypes, lookupfun = GetResFun,
+ resultaction = FinalAction}
+ end.
+
+state__cfg(#state{cfg = Cfg}) ->
+ Cfg.
+
+state__succ(#state{cfg = Cfg}, Label) ->
+ hipe_icode_cfg:succ(Cfg, Label).
+
+state__bb(#state{cfg = Cfg}, Label) ->
+ hipe_icode_cfg:bb(Cfg, Label).
+
+state__bb_add(S = #state{cfg = Cfg}, Label, BB) ->
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB),
+ S#state{cfg=NewCfg}.
+
+state__params_update(S = #state{cfg = Cfg}, NewParams) ->
+ NewCfg = hipe_icode_cfg:params_update(Cfg, NewParams),
+ S#state{cfg = NewCfg}.
+
+state__ret_type(#state{ret_type = RT}) -> RT.
+
+state__lookupfun(#state{lookupfun = LF}) -> LF.
+
+state__resultaction(#state{resultaction = RA}) -> RA.
+
+state__info_in(S, Label) ->
+ state__info(S, {Label, in}).
+
+state__info_out(S, Label) ->
+ state__info(S, {Label, out}).
+
+state__info(#state{info_map = IM}, Label) ->
+ case gb_trees:lookup(Label, IM) of
+ {value, Info} -> Info;
+ none -> gb_trees:empty()
+ end.
+
+state__ret_type_update(#state{ret_type = RT} = State, NewType) when
+ is_list(NewType) ->
+ TotType = lists:zipwith(fun erl_types:t_sup/2, RT, NewType),
+ State#state{ret_type = TotType};
+state__ret_type_update(#state{ret_type = RT} = State, NewType) ->
+ state__ret_type_update(State, [NewType || _ <- RT]).
+
+state__info_in_update(S=#state{info_map=IM, liveness=Liveness}, Label, Info) ->
+ LiveIn = hipe_icode_ssa:ssa_liveness__livein(Liveness, Label),
+ LabelIn = {Label, in},
+ case gb_trees:lookup(LabelIn, IM) of
+ none ->
+ OldInfo = gb_trees:empty(),
+ case join_info_in(LiveIn, OldInfo, Info) of
+ fixpoint ->
+ %% If the BB has not been handled we ignore the fixpoint.
+ S#state{info_map = gb_trees:enter(LabelIn, OldInfo, IM)};
+ NewInfo ->
+ S#state{info_map = gb_trees:enter(LabelIn, NewInfo, IM)}
+ end;
+ {value, OldInfo} ->
+ case join_info_in(LiveIn, OldInfo, Info) of
+ fixpoint ->
+ fixpoint;
+ NewInfo ->
+ S#state{info_map = gb_trees:enter(LabelIn, NewInfo, IM)}
+ end
+ end.
+
+state__info_out_update(#state{info_map = IM} = State, Label, Info) ->
+ State#state{info_map = gb_trees:enter({Label, out}, Info, IM)}.
+
+%% _________________________________________________________________
+%%
+%% The worklist.
+%%
+
+init_work(State) ->
+ %% Labels = hipe_icode_cfg:reverse_postorder(state__cfg(State)),
+ Labels = [hipe_icode_cfg:start_label(state__cfg(State))],
+ {Labels, [], gb_sets:from_list(Labels)}.
+
+get_work({[Label|Left], List, Set}) ->
+ NewWork = {Left, List, gb_sets:delete(Label, Set)},
+ {Label, NewWork};
+get_work({[], [], _Set}) ->
+ fixpoint;
+get_work({[], List, Set}) ->
+ get_work({lists:reverse(List), [], Set}).
+
+add_work(Work = {List1, List2, Set}, [Label|Left]) ->
+ case gb_sets:is_member(Label, Set) of
+ true ->
+ add_work(Work, Left);
+ false ->
+ %% io:format("Adding work: ~w\n", [Label]),
+ add_work({List1, [Label|List2], gb_sets:insert(Label, Set)}, Left)
+ end;
+add_work(Work, []) ->
+ Work.
+
+%% _________________________________________________________________
+%%
+%% Annotator
+%%
+
+annotate_cfg(State) ->
+ Cfg = state__cfg(State),
+ NewState = annotate_params(hipe_icode_cfg:params(Cfg), State,
+ hipe_icode_cfg:start_label(Cfg)),
+ Labels = hipe_icode_cfg:reverse_postorder(Cfg),
+ annotate_bbs(Labels, NewState).
+
+annotate_params(Params, State, Start) ->
+ Info = state__info_in(State, Start),
+ AnnoFun = fun hipe_icode:annotate_variable/2,
+ NewParams =
+ lists:zipwith(AnnoFun, Params, [make_annotation(P,Info) || P <- Params]),
+ state__params_update(State,NewParams).
+
+annotate_bbs([Label|Left], State) ->
+ BB = state__bb(State, Label),
+ Code = hipe_bb:code(BB),
+ Info = state__info_in(State, Label),
+ NewCode = annotate_instr_list(Code, Info, state__lookupfun(State), []),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ NewState = state__bb_add(State, Label, NewBB),
+ annotate_bbs(Left, NewState);
+annotate_bbs([], State) ->
+ State.
+
+annotate_instr_list([I], Info, LookupFun, Acc) ->
+ NewInfo =
+ case I of
+ #icode_call{} ->
+ do_safe_call(I, Info, LookupFun);
+ _ ->
+ analyse_insn(I, Info, LookupFun)
+ end,
+ NewI = annotate_instr(I, NewInfo, Info),
+ lists:reverse([NewI|Acc]);
+annotate_instr_list([I|Left], Info, LookupFun, Acc) ->
+ NewInfo =
+ case I of
+ #icode_call{} ->
+ do_safe_call(I, Info, LookupFun);
+ _ ->
+ analyse_insn(I, Info, LookupFun)
+ end,
+ NewI = annotate_instr(I, NewInfo, Info),
+ annotate_instr_list(Left, NewInfo, LookupFun, [NewI|Acc]).
+
+annotate_instr(I, DefInfo, UseInfo) ->
+ Def = defines(I),
+ Use = uses(I),
+ Fun = fun hipe_icode:annotate_variable/2,
+ DefSubst = [{X, Fun(X, make_annotation(X, DefInfo))} || X <- Def],
+ UseSubst = [{X, Fun(X, make_annotation(X, UseInfo))} || X <- Use],
+ case DefSubst ++ UseSubst of
+ [] ->
+ I;
+ Subst ->
+ hipe_icode:subst(Subst, I)
+ end.
+
+make_annotation(X, Info) ->
+ {type_anno, safe_lookup(X, Info), fun erl_types:t_to_string/1}.
+
+-spec unannotate_cfg(cfg()) -> cfg().
+
+unannotate_cfg(Cfg) ->
+ NewCfg = unannotate_params(Cfg),
+ Labels = hipe_icode_cfg:labels(NewCfg),
+ unannotate_bbs(Labels, NewCfg).
+
+unannotate_params(Cfg) ->
+ Params = hipe_icode_cfg:params(Cfg),
+ NewParams = [hipe_icode:unannotate_variable(X)
+ || X <- Params, hipe_icode:is_variable(X)],
+ hipe_icode_cfg:params_update(Cfg, NewParams).
+
+unannotate_bbs([Label|Left], Cfg) ->
+ BB = hipe_icode_cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ NewCode = unannotate_instr_list(Code, []),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB),
+ unannotate_bbs(Left, NewCfg);
+unannotate_bbs([], Cfg) ->
+ Cfg.
+
+unannotate_instr_list([I|Left], Acc) ->
+ NewI = unannotate_instr(I),
+ unannotate_instr_list(Left, [NewI|Acc]);
+unannotate_instr_list([], Acc) ->
+ lists:reverse(Acc).
+
+unannotate_instr(I) ->
+ DefUses = hipe_icode:defines(I) ++ hipe_icode:uses(I),
+ Subst = [{X, hipe_icode:unannotate_variable(X)} || X <- DefUses,
+ hipe_icode:is_variable(X)],
+ if Subst =:= [] -> I;
+ true -> hipe_icode:subst(Subst, I)
+ end.
+
+%% _________________________________________________________________
+%%
+%% Find the types of the arguments to a call
+%%
+
+update_call_arguments(I, Info) ->
+ Args = hipe_icode:call_args(I),
+ ArgTypes = lookup_list(Args, Info),
+ Signature = find_signature(hipe_icode:call_fun(I), length(Args)),
+ case t_fun_args(Signature) of
+ unknown ->
+ Info;
+ PltArgTypes ->
+ NewArgTypes = t_inf_lists(ArgTypes, PltArgTypes),
+ enter_list(Args, NewArgTypes, Info)
+ end.
+
+%% _________________________________________________________________
+%%
+%% PLT info
+%%
+
+find_signature(MFA = {_, _, _}, _) -> find_signature_mfa(MFA);
+find_signature(Primop, Arity) -> find_signature_primop(Primop, Arity).
+
+find_signature_mfa(MFA) ->
+ case get_mfa_arg_types(MFA) of
+ any ->
+ t_fun(get_mfa_type(MFA));
+ BifArgs ->
+ t_fun(BifArgs, get_mfa_type(MFA))
+ end.
+
+find_signature_primop(Primop, Arity) ->
+ case get_primop_arg_types(Primop) of
+ any ->
+ t_fun(Arity, get_primop_type(Primop));
+ ArgTypes ->
+ t_fun(ArgTypes, get_primop_type(Primop))
+ end.
+
+get_primop_arg_types(Primop) ->
+ case hipe_icode_primops:arg_types(Primop) of
+ unknown -> any;
+ ArgTypes -> add_tuple_to_args(ArgTypes)
+ end.
+
+get_mfa_arg_types({M, F, A}) ->
+ case erl_bif_types:arg_types(M, F, A) of
+ unknown ->
+ any;
+ BifArgs ->
+ add_tuple_to_args(BifArgs)
+ end.
+
+get_mfa_type({M, F, A}) ->
+ erl_bif_types:type(M, F, A).
+
+get_primop_type(Primop) ->
+ hipe_icode_primops:type(get_standard_primop(Primop)).
+
+add_tuple_to_args(Types) ->
+ [add_tuple_to_type(T) || T <- Types].
+
+add_tuple_to_type(T) ->
+ None = t_none(),
+ case t_inf(t_fun(), T) of
+ None -> T;
+ _Other -> t_sup(T, t_tuple([t_atom(),t_atom()]))
+ end.
+
+add_funs_to_arg_types(Types) ->
+ [add_fun_to_arg_type(T) || T <- Types].
+
+add_fun_to_arg_type(T) ->
+ None = t_none(),
+ case t_inf(t_tuple([t_atom(),t_atom()]), T) of
+ None -> T;
+ _Other -> t_sup(T, t_fun())
+ end.
+
+%%=====================================================================
+%% Icode Coordinator Callbacks
+%%=====================================================================
+
+-spec replace_nones([erl_types:erl_type()] | erl_types:erl_type()) ->
+ [erl_types:erl_type()].
+
+replace_nones(Types) when is_list(Types) ->
+ [replace_none(T) || T <- Types];
+replace_nones(Type) ->
+ [replace_none(Type)].
+
+-spec replace_none(erl_types:erl_type()) -> erl_types:erl_type().
+
+replace_none(Type) ->
+ case erl_types:t_is_none(Type) of
+ true ->
+ erl_types:t_any();
+ false ->
+ Type
+ end.
+
+-spec update__info([erl_types:erl_type()], [erl_types:erl_type()]) ->
+ {boolean(), [erl_types:erl_type()]}.
+
+update__info(NewTypes, OldTypes) ->
+ SupFun =
+ fun(T1, T2) -> erl_types:t_limit(erl_types:t_sup(T1,T2), ?TYPE_DEPTH) end,
+ EqFun = fun erl_types:t_is_equal/2,
+ ResTypes = lists:zipwith(SupFun, NewTypes, OldTypes),
+ Change = lists:zipwith(EqFun, ResTypes, OldTypes),
+ {lists:all(fun(X) -> X end, Change), ResTypes}.
+
+-spec new__info([erl_types:erl_type()]) -> [erl_types:erl_type()].
+
+new__info(NewTypes) ->
+ [erl_types:t_limit(T, ?TYPE_DEPTH) || T <- NewTypes].
+
+-spec return__info(erl_types:erl_type()) -> erl_types:erl_type().
+
+return__info(Types) ->
+ Types.
+
+-spec return_none() -> [erl_types:erl_type(),...].
+
+return_none() ->
+ [erl_types:t_none()].
+
+-spec return_none_args(cfg(), mfa()) -> [erl_types:erl_type()].
+
+return_none_args(Cfg, {_M,_F,A}) ->
+ NoArgs =
+ case hipe_icode_cfg:is_closure(Cfg) of
+ true -> hipe_icode_cfg:closure_arity(Cfg) - 1;
+ false -> A
+ end,
+ lists:duplicate(NoArgs, erl_types:t_none()).
+
+-spec return_any_args(cfg(), mfa()) -> [erl_types:erl_type()].
+
+return_any_args(Cfg, {_M,_F,A}) ->
+ NoArgs =
+ case hipe_icode_cfg:is_closure(Cfg) of
+ true -> hipe_icode_cfg:closure_arity(Cfg);
+ false -> A
+ end,
+ lists:duplicate(NoArgs, erl_types:t_any()).
+
+%%=====================================================================
+%% Testing function below
+%%=====================================================================
+
+-ifdef(DO_HIPE_ICODE_TYPE_TEST).
+
+test() ->
+ Range1 = t_from_range(1, pos_inf),
+ Range2 = t_from_range(0, 5),
+ Var1 = hipe_icode:mk_var(1),
+ Var2 = hipe_icode:mk_var(2),
+
+ Info = enter(Var1, Range1, enter(Var2, Range2, gb_trees:empty())),
+ io:format("A1 ~p~n", [Info]),
+ A = integer_range_inequality_propagation('<', Var1, Var2, 1, 2, Info),
+ B = integer_range_inequality_propagation('>=', Var1, Var2, 1, 2, Info),
+ C = integer_range_inequality_propagation('=<', Var1, Var2, 1, 2, Info),
+ D = integer_range_inequality_propagation('>', Var1, Var2, 1, 2, Info),
+
+ io:format("< ~p~n", [A]),
+ io:format(">= ~p~n", [B]),
+ io:format("<= ~p~n", [C]),
+ io:format("> ~p~n", [D]).
+
+-endif.
diff --git a/lib/hipe/icode/hipe_icode_type.hrl b/lib/hipe/icode/hipe_icode_type.hrl
new file mode 100644
index 0000000000..dd69c1e8b2
--- /dev/null
+++ b/lib/hipe/icode/hipe_icode_type.hrl
@@ -0,0 +1,25 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_icode_type.hrl
+%%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%%% Created : 2 Sep 2004 by Tobias Lindahl <tobiasl@it.uu.se>
+%%%-------------------------------------------------------------------
+
+-define(TYPE_DEPTH, 3).
diff --git a/lib/hipe/info b/lib/hipe/info
new file mode 100644
index 0000000000..51b5dfb979
--- /dev/null
+++ b/lib/hipe/info
@@ -0,0 +1,2 @@
+group: basic
+short: High Performance Erlang
\ No newline at end of file
diff --git a/lib/hipe/main/Makefile b/lib/hipe/main/Makefile
new file mode 100644
index 0000000000..0ac522b1b2
--- /dev/null
+++ b/lib/hipe/main/Makefile
@@ -0,0 +1,117 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+ifdef HIPE_ENABLED
+HIPE_MODULES = hipe
+else
+HIPE_MODULES =
+endif
+MODULES = hipe_main $(HIPE_MODULES)
+
+## hipe.hrl is automatically generated from hipe.hrl.src -- see below
+HRL_FILES= hipe.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+APP_FILE= hipe.app
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+
+APPUP_FILE= hipe.appup
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +nowarn_shadow_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+hipe.hrl: ../vsn.mk hipe.hrl.src
+ sed -e "s;%VSN%;$(HIPE_VSN);" ../../hipe/main/hipe.hrl.src > ../../hipe/main/hipe.hrl
+
+$(EBIN)/hipe.beam: hipe.hrl ../../compiler/src/beam_disasm.hrl
+$(EBIN)/hipe_main.beam: hipe.hrl ../icode/hipe_icode.hrl #../rtl/hipe_rtl.hrl
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES) $(DOC_FILES) $(HRL_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DATA) ../vsn.mk $(RELSYSDIR)
+ $(INSTALL_DIR) $(RELSYSDIR)/main
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/main
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
new file mode 100644
index 0000000000..e5d6d1e540
--- /dev/null
+++ b/lib/hipe/main/hipe.app.src
@@ -0,0 +1,222 @@
+%% This is an -*- erlang -*- file.
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+{application, hipe,
+ [{description, "HiPE Native Code Compiler, version %VSN%"},
+ {vsn, "%VSN%"},
+ {modules, [cerl_cconv,
+ cerl_closurean,
+ cerl_hipeify,
+ cerl_hybrid_transform,
+ cerl_lib,
+ cerl_messagean,
+ cerl_pmatch,
+ cerl_prettypr,
+ cerl_to_icode,
+ cerl_typean,
+ erl_bif_types,
+ erl_types,
+ hipe,
+ hipe_adj_list,
+ hipe_amd64_assemble,
+ hipe_amd64_defuse,
+ hipe_amd64_encode,
+ hipe_amd64_frame,
+ hipe_amd64_liveness,
+ hipe_amd64_main,
+ hipe_amd64_pp,
+ hipe_amd64_ra,
+ hipe_amd64_ra_finalise,
+ hipe_amd64_ra_ls,
+ hipe_amd64_ra_naive,
+ hipe_amd64_ra_postconditions,
+ hipe_amd64_ra_sse2_postconditions,
+ hipe_amd64_ra_x87_ls,
+ hipe_amd64_registers,
+ hipe_amd64_specific,
+ hipe_amd64_specific_sse2,
+ hipe_amd64_specific_x87,
+ hipe_amd64_spill_restore,
+ hipe_amd64_x87,
+ hipe_arm,
+ hipe_arm_assemble,
+ hipe_arm_cfg,
+ hipe_arm_defuse,
+ hipe_arm_encode,
+ hipe_arm_finalise,
+ hipe_arm_frame,
+ hipe_arm_liveness_gpr,
+ hipe_arm_main,
+ hipe_arm_pp,
+ hipe_arm_ra,
+ hipe_arm_ra_finalise,
+ hipe_arm_ra_ls,
+ hipe_arm_ra_naive,
+ hipe_arm_ra_postconditions,
+ hipe_arm_registers,
+ hipe_arm_specific,
+ hipe_bb,
+ hipe_beam_to_icode,
+ hipe_ceach,
+ hipe_coalescing_regalloc,
+ hipe_consttab,
+ hipe_data_pp,
+ hipe_digraph,
+ hipe_dominators,
+ hipe_dot,
+ hipe_gen_cfg,
+ hipe_gensym,
+ hipe_graph_coloring_regalloc,
+ hipe_icode,
+ hipe_icode2rtl,
+ hipe_icode_bincomp,
+ hipe_icode_callgraph,
+ hipe_icode_cfg,
+ hipe_icode_coordinator,
+ hipe_icode_ebb,
+ hipe_icode_exceptions,
+ hipe_icode_fp,
+ hipe_icode_heap_test,
+ hipe_icode_inline_bifs,
+ hipe_icode_instruction_counter,
+ hipe_icode_liveness,
+ hipe_icode_mulret,
+ hipe_icode_pp,
+ hipe_icode_primops,
+ hipe_icode_range,
+ hipe_icode_ssa,
+ hipe_icode_ssa_const_prop,
+ hipe_icode_ssa_copy_prop,
+ hipe_icode_ssa_struct_reuse,
+ hipe_icode_split_arith,
+ hipe_icode_type,
+ hipe_ig,
+ hipe_ig_moves,
+ hipe_jit,
+ hipe_ls_regalloc,
+ hipe_main,
+ hipe_moves,
+ hipe_node_sets,
+ hipe_optimistic_regalloc,
+ hipe_pack_constants,
+ hipe_ppc,
+ hipe_ppc_assemble,
+ hipe_ppc_cfg,
+ hipe_ppc_defuse,
+ hipe_ppc_encode,
+ hipe_ppc_finalise,
+ hipe_ppc_frame,
+ hipe_ppc_liveness_all,
+ hipe_ppc_liveness_fpr,
+ hipe_ppc_liveness_gpr,
+ hipe_ppc_main,
+ hipe_ppc_pp,
+ hipe_ppc_ra,
+ hipe_ppc_ra_finalise,
+ hipe_ppc_ra_ls,
+ hipe_ppc_ra_naive,
+ hipe_ppc_ra_postconditions,
+ hipe_ppc_ra_postconditions_fp,
+ hipe_ppc_registers,
+ hipe_ppc_specific,
+ hipe_ppc_specific_fp,
+ hipe_profile,
+ hipe_reg_worklists,
+ hipe_regalloc_loop,
+ hipe_rtl,
+ hipe_rtl_arch,
+ hipe_rtl_arith_32,
+ hipe_rtl_arith_64,
+ hipe_rtl_binary,
+ hipe_rtl_binary_match,
+ hipe_rtl_binary_construct,
+ hipe_rtl_cfg,
+ hipe_rtl_cleanup_const,
+ hipe_rtl_exceptions,
+ hipe_rtl_lcm,
+ hipe_rtl_liveness,
+ hipe_rtl_mk_switch,
+ hipe_rtl_primops,
+ hipe_rtl_ssa,
+ hipe_rtl_ssa_const_prop,
+ hipe_rtl_ssa_avail_expr,
+ hipe_rtl_ssapre,
+ hipe_rtl_symbolic,
+ hipe_rtl_to_amd64,
+ hipe_rtl_to_arm,
+ hipe_rtl_to_ppc,
+ hipe_rtl_to_sparc,
+ hipe_rtl_to_x86,
+ hipe_rtl_varmap,
+ hipe_sdi,
+ hipe_sparc,
+ hipe_sparc_assemble,
+ hipe_sparc_cfg,
+ hipe_sparc_defuse,
+ hipe_sparc_encode,
+ hipe_sparc_finalise,
+ hipe_sparc_frame,
+ hipe_sparc_liveness_all,
+ hipe_sparc_liveness_fpr,
+ hipe_sparc_liveness_gpr,
+ hipe_sparc_main,
+ hipe_sparc_pp,
+ hipe_sparc_ra,
+ hipe_sparc_ra_finalise,
+ hipe_sparc_ra_ls,
+ hipe_sparc_ra_naive,
+ hipe_sparc_ra_postconditions,
+ hipe_sparc_ra_postconditions_fp,
+ hipe_sparc_registers,
+ hipe_sparc_specific,
+ hipe_sparc_specific_fp,
+ hipe_spillcost,
+ hipe_spillmin,
+ hipe_spillmin_color,
+ hipe_spillmin_scan,
+ hipe_tagscheme,
+ hipe_temp_map,
+ hipe_timing,
+ hipe_tool,
+ hipe_vectors,
+ hipe_x86,
+ hipe_x86_assemble,
+ hipe_x86_cfg,
+ hipe_x86_defuse,
+ hipe_x86_encode,
+ hipe_x86_frame,
+ hipe_x86_liveness,
+ hipe_x86_main,
+ hipe_x86_postpass,
+ hipe_x86_pp,
+ hipe_x86_ra,
+ hipe_x86_ra_finalise,
+ hipe_x86_ra_ls,
+ hipe_x86_ra_naive,
+ hipe_x86_ra_postconditions,
+ hipe_x86_ra_x87_ls,
+ hipe_x86_registers,
+ hipe_x86_specific,
+ hipe_x86_specific_x87,
+ hipe_x86_spill_restore,
+ hipe_x86_x87]},
+ {registered,[]},
+ {applications, [kernel,stdlib]},
+ {env, []}]}.
diff --git a/lib/hipe/main/hipe.appup.src b/lib/hipe/main/hipe.appup.src
new file mode 100644
index 0000000000..1d5a0d93f5
--- /dev/null
+++ b/lib/hipe/main/hipe.appup.src
@@ -0,0 +1,19 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+{"%VSN%",[],[]}.
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
new file mode 100644
index 0000000000..ed722fecba
--- /dev/null
+++ b/lib/hipe/main/hipe.erl
@@ -0,0 +1,1555 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ====================================================================
+%% Copyright (c) 1998 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Filename : hipe.erl
+%% Module : hipe
+%% Purpose :
+%% Notes :
+%% History : * 1998-01-28 Erik Johansson (happi@it.uu.se): Created.
+%% CVS : $Id$
+%% ====================================================================
+%% @doc This is the direct interface to the HiPE compiler.
+%%
+%% <h3>Normal use</h3>
+%%
+%% <p>The normal way to native-compile an Erlang module using HiPE is to
+%% include the atom <code>native</code> in the Erlang compiler options,
+%% as in:
+%%
+%% <pre> 1> c(my_module, [native]).</pre></p>
+%%
+%% <p>Options to the HiPE compiler are then passed as follows:
+%%
+%% <pre> 1> c(my_module, [native,{hipe,Options}]).</pre></p>
+%%
+%% <p>For on-line help in the Erlang shell, call <a
+%% href="#help-0"><code>hipe:help()</code></a>. Details on HiPE compiler
+%% options are given by <a
+%% href="#help_options-0"><code>hipe:help_options()</code></a>.</p>
+%%
+%% <h3>Using the direct interface - for advanced users only</h3>
+%%
+%% To compile a module or a specific function to native code and
+%% automatically load the code into memory, call <a
+%% href="#c-1"><code>hipe:c(Module)</code></a> or <a
+%% href="#c-2"><code>hipe:c(Module, Options)</code></a>. Note that all
+%% options are specific to the HiPE compiler. See the <a
+%% href="#index">function index</a> for other compiler functions.
+%%
+%% <h3>Main Options</h3>
+%%
+%% Options are processed in the order they appear in the list; an
+%% early option will shadow a later one.
+%% <dl>
+%% <dt><code>o0, 'O0', o1, 'O1', o2, 'O2', o3, 'O3'</code></dt>
+%% <dd>Set optimization level (default 2).</dd>
+%%
+%% <dt><code>load</code></dt>
+%% <dd>Automatically load the code into memory after compiling.</dd>
+%%
+%% <dt><code>time</code></dt>
+%% <dd>Reports the compilation times for the different stages
+%% of the compiler. Call <a
+%% href="#help_option-1"><code>hipe:help_option(time)</code></a> for
+%% details.</dd>
+%%
+%% <dt><code>{timeout, Time}</code></dt>
+%% <dd>Sets the time the compiler is allowed to use for the
+%% compilation. <code>Time</code> is time in ms or the atom
+%% <code>infinity</code> (the default).</dd>
+%%
+%% <dt><code>verbose</code></dt>
+%% <dd>Make the HiPE compiler output information about what it is
+%% being done.</dd>
+%% </dl>
+%%
+%% <h3>Advanced Options</h3>
+%%
+%% Note: You can also specify <code>{Option, false}</code> to turn a
+%% particular option off, or <code>{Option, true}</code> to force it on.
+%% Boolean-valued (<code>true</code>/<code>false</code>) options also
+%% have negative-form aliases, e.g. <code>no_load</code> = <code>{load,
+%% false}</code>.
+%%
+%% <p><dl>
+%% <dt><code>debug</code></dt>
+%% <dd>Outputs internal debugging information during
+%% compilation.</dd>
+%%
+%% <dt><code>icode_ssa_copy_prop</code></dt>
+%% <dd>Performs copy propagation on the SSA form on the Icode
+%% level.</dd>
+%%
+%% <dt><code>icode_ssa_const_prop</code></dt>
+%% <dd>Performs sparse conditional constant propagation on the SSA
+%% form on the Icode level.</dd>
+%%
+%% <dt><code>icode_ssa_struct_reuse</code></dt>
+%% <dd>Tries to factor out identical tuple and list constructions
+%% on the Icode level.</dd>
+%%
+%% <dt><code>icode_type</code></dt>
+%% <dd>Simplifies the code by employing type analysis and propagation
+%% on the Icode level.</dd>
+%%
+%% <dt><code>icode_range</code></dt>
+%% <dd>Performs integer range analysis on the Icode level.</dd>
+%%
+%% <dt><code>pp_all</code></dt>
+%% <dd>Equivalent to <code>[pp_beam, pp_icode, pp_rtl,
+%% pp_native]</code>.</dd>
+%%
+%% <dt><code>pp_asm</code></dt>
+%% <dd>Prints the assembly listing with addresses and bytecode.
+%% Currently available for x86 only.</dd>
+%%
+%% <dt><code>pp_beam, {pp_beam, {file, File}}</code></dt>
+%% <dd>Display the input Beam code to stdout or file.</dd>
+%%
+%% <dt><code>pp_icode, {pp_icode, {file, File}},
+%% {pp_icode, {only, Functions}}</code></dt>
+%% <dd>Pretty-print Icode intermediate code to stdout or file.</dd>
+%%
+%% <dt><code>pp_native, {pp_native, {file, File}},
+%% {pp_native, {only, Functions}}</code></dt>
+%% <dd>Pretty-print native code to stdout or file.</dd>
+%%
+%% <dt><code>pp_opt_icode, {pp_opt_icode, {file, File}},
+%% {pp_opt_icode, {only, Functions}}</code></dt>
+%% <dd>Pretty-print optimized Icode to stdout or file.</dd>
+%%
+%% <dt><code>pp_rtl, {pp_rtl, {file, File}},
+%% {pp_rtl, {only, Functions}}</code></dt>
+%% <dd>Pretty-print RTL intermediate code to stdout or file.</dd>
+%%
+%% <dt><code>regalloc</code></dt>
+%% <dd>Select register allocation algorithm. Used as
+%% <code>{regalloc, Method}</code>.
+%%
+%% <p><code>Method</code> is one of the following:
+%% <ul>
+%% <li><code>naive</code>: spills everything (for debugging and
+%% testing only).</li>
+%% <li><code>linear_scan</code>: fast compilation; not so good if
+%% only few registers available.</li>
+%% <li><code>graph_color</code>: slower, but gives better
+%% performance.</li>
+%% <li><code>coalescing</code>: tries hard to use registers; can be
+%% very slow, but typically results in code with best performance.</li>
+%% </ul></p></dd>
+%%
+%% <dt><code>remove_comments</code></dt>
+%% <dd>Remove comments from intermediate code.</dd>
+%%
+%% <dt><code>rtl_ssa_const_prop</code></dt>
+%% <dd>Performs sparse conditional constant propagation on the SSA
+%% form on the RTL level. </dd>
+%%
+%% <dt><code>rtl_lcm</code></dt>
+%% <dd>Lazy Code Motion on RTL.</dd>
+%%
+%% <dt><code>rtl_ssapre</code></dt>
+%% <dd>Lazy Partial Redundancy Elimination on RTL (SSA level).</dd>
+%%
+%% <dt><code>use_indexing</code></dt>
+%% <dd>Use indexing for multiple-choice branch selection.</dd>
+%%
+%% <dt><code>use_callgraph</code></dt>
+%% <dd>Use a static call graph for determining the order in which
+%% the functions of a module should be compiled (in reversed
+%% topological sort order).</dd>
+%% </dl></p>
+%%
+%% <h3>Debugging Options</h3>
+%% (May require that some modules have been
+%% compiled with the <code>DEBUG</code> flag.)
+%% <dl>
+%% <dt><code>rtl_show_translation</code></dt>
+%% <dd>Prints each step in the translation from Icode to RTL</dd>
+%% </dl>
+%%
+%% @end
+%% ====================================================================
+
+-module(hipe).
+
+-export([c/1,
+ c/2,
+ f/1,
+ f/2,
+ compile/1,
+ compile/2,
+ compile/4,
+ compile_core/4,
+ file/1,
+ file/2,
+ load/1,
+ help/0,
+ help_hiper/0,
+ help_options/0,
+ help_option/1,
+ help_debug_options/0,
+ version/0]).
+
+-ifndef(DEBUG).
+-define(DEBUG,true).
+-endif.
+
+-include("hipe.hrl").
+-include("../../compiler/src/beam_disasm.hrl").
+
+%%-------------------------------------------------------------------
+%% Basic type declaration for exported functions of the 'hipe' module
+%%-------------------------------------------------------------------
+
+-type mod() :: atom().
+-type c_unit() :: mod() | mfa().
+-type f_unit() :: mod() | binary().
+-type ret_rtl() :: [_].
+-type c_ret() :: {'ok', c_unit()} | {'error', term()} |
+ {'ok', c_unit(), ret_rtl()}. %% The last for debugging only
+-type compile_file() :: atom() | string() | binary().
+-type compile_ret() :: {hipe_architecture(), binary()} | list().
+
+%%-------------------------------------------------------------------
+
+-define(COMPILE_DEFAULTS, [o2]).
+-define(DEFAULT_TIMEOUT, infinity).
+
+%%-------------------------------------------------------------------
+
+%% @spec load(Mod) -> {module, Mod} | {error, Reason}
+%% Mod = mod()
+%% Reason = term()
+%%
+%% @doc Like load/2, but tries to locate a BEAM file automatically.
+%%
+%% @see load/2
+
+-spec load(Mod) -> {'module', Mod} | {'error', term()}
+ when is_subtype(Mod, mod()).
+
+load(Mod) ->
+ load(Mod, beam_file(Mod)).
+
+%% @spec load(Mod, BeamFileName) -> {module, Mod} | {error, Reason}
+%% Mod = mod()
+%% Reason = term()
+%% BeamFileName = string()
+%% filename() = term()
+%%
+%% @type mod() = atom(). A module name.
+%%
+%% @doc User interface for loading code into memory. The code can be
+%% given as a native code binary or as the file name of a BEAM file
+%% which should contain a native-code chunk. If only the module name is
+%% given (see <code>load/1</code>), the BEAM file is located
+%% automatically.
+%%
+%% @see load/1
+
+-spec load(Mod, string()) -> {'module', Mod} | {'error', term()}
+ when is_subtype(Mod, mod()).
+
+load(Mod, BeamFileName) when is_list(BeamFileName) ->
+ Architecture = erlang:system_info(hipe_architecture),
+ ChunkName = hipe_unified_loader:chunk_name(Architecture),
+ case beam_lib:chunks(BeamFileName, [ChunkName]) of
+ {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> do_load(Mod, Bin, Bin);
+ Error -> {error, Error}
+ end.
+
+%% @spec c(Name) -> {ok, Name} | {error, Reason}
+%% Name = mod() | mfa()
+%% Reason = term()
+%%
+%% @equiv c(Name, [])
+
+-spec c(c_unit()) -> c_ret().
+
+c(Name) ->
+ c(Name, []).
+
+%% @spec c(Name, options()) -> {ok, Name} | {error, Reason}
+%% Name = mod() | mfa()
+%% options() = [option()]
+%% option() = term()
+%% Reason = term()
+%%
+%% @type mfa() = {M::mod(),F::fun(),A::arity()}.
+%% A fully qualified function name.
+%%
+%% @type fun() = atom(). A function identifier.
+%%
+%% @type arity() = integer(). A function arity; always nonnegative.
+%%
+%% @doc User-friendly native code compiler interface. Reads BEAM code
+%% from the corresponding "Module<code>.beam</code>" file in the system
+%% path, and compiles either a single function or the whole module to
+%% native code. By default, the compiled code is loaded directly. See
+%% above for documentation of options.
+%%
+%% @see c/1
+%% @see c/3
+%% @see f/2
+%% @see compile/2
+
+-spec c(c_unit(), comp_options()) -> c_ret().
+
+c(Name, Options) ->
+ c(Name, beam_file(Name), Options).
+
+%% @spec c(Name, File, options()) -> {ok, Name} | {error, Reason}
+%% Name = mod() | mfa()
+%% File = filename() | binary()
+%% Reason = term()
+%%
+%% @doc Like <code>c/2</code>, but reads BEAM code from the specified
+%% <code>File</code>.
+%%
+%% @see c/2
+%% @see f/2
+
+c(Name, File, Opts) ->
+ %% No server if only one function is compiled
+ Opts1 = user_compile_opts(Opts),
+ case compile(Name, File, Opts1) of
+ {ok, Res} ->
+ case proplists:get_bool(to_rtl, Opts1) of
+ true -> {ok, Name, Res};
+ false -> {ok, Name}
+ end;
+ Other ->
+ Other
+ end.
+
+%% @spec f(File) -> {ok, Name} | {error, Reason}
+%% File = filename() | binary()
+%% Name = mod()
+%% Reason = term()
+%%
+%% @equiv f(File, [])
+
+-spec f(f_unit()) -> {'ok', mod()} | {'error', term()}.
+
+f(File) ->
+ f(File, []).
+
+%% @spec f(File, options()) -> {ok, Name} | {error, Reason}
+%% File = filename() | binary()
+%% Name = mod()
+%% Reason = term()
+%%
+%% @doc Like <code>c/3</code>, but takes the module name from the
+%% specified <code>File</code>. This always compiles the whole module;
+%% there is no possibility to compile just a single function.
+%%
+%% @see c/3
+
+-spec f(f_unit(), comp_options()) -> {'ok', mod()} | {'error', term()}.
+
+f(File, Opts) ->
+ case file(File, user_compile_opts(Opts)) of
+ {ok, Name, _} ->
+ {ok, Name};
+ Other ->
+ Other
+ end.
+
+-define(USER_DEFAULTS, [load]).
+
+user_compile_opts(Opts) ->
+ Opts ++ ?USER_DEFAULTS.
+
+
+%% @spec compile(Name) -> {ok, {Target,Binary}} | {error, Reason}
+%% Name = mod() | mfa()
+%% Binary = binary()
+%% Reason = term()
+%%
+%% @equiv compile(Name, [])
+
+-spec compile(c_unit()) -> {'ok', compile_ret()} | {'error', term()}.
+
+compile(Name) ->
+ compile(Name, []).
+
+%% @spec compile(Name, options()) -> {ok, {Target,Binary}} | {error, Reason}
+%% Name = mod() | mfa()
+%% Binary = binary()
+%% Reason = term()
+%%
+%% @doc Direct compiler interface, for advanced use. This just compiles
+%% the named function or module, reading BEAM code from the
+%% corresponding "Module<code>.beam</code>" file in the system path.
+%% Returns <code>{ok, Binary}</code> if successful, or <code>{error,
+%% Reason}</code> otherwise. By default, it does <em>not</em> load the
+%% binary to memory (the <code>load</code> option can be used to
+%% activate automatic loading). <code>File</code> can be either a file
+%% name or a binary containing the BEAM code for the module.
+%%
+%% @see c/2
+%% @see compile/1
+%% @see compile/3
+%% @see file/2
+%% @see load/2
+
+-spec compile(c_unit(), comp_options()) -> {'ok', compile_ret()} | {'error', _}.
+
+compile(Name, Options) ->
+ compile(Name, beam_file(Name), Options).
+
+-spec beam_file(mod() | mfa()) -> string().
+
+beam_file({M,F,A}) when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
+ beam_file(M);
+beam_file(Module) when is_atom(Module) ->
+ case code:which(Module) of
+ non_existing ->
+ ?error_msg("Cannot find ~w.beam file.",[Module]),
+ ?EXIT({cant_find_beam_file,Module});
+ File -> % string()
+ File
+ end.
+
+%% @spec compile(Name, File, options()) ->
+%% {ok, {Target, Binary}} | {error, Reason}
+%% Name = mod() | mfa()
+%% File = filename() | binary()
+%% Binary = binary()
+%% Reason = term()
+%%
+%% @doc Like <code>compile/2</code>, but reads BEAM code from the
+%% specified <code>File</code>.
+%%
+%% @see compile/2
+
+-spec compile(c_unit(), compile_file(), comp_options()) ->
+ {'ok', compile_ret()} | {'error', term()}.
+
+compile(Name, File, Opts0) ->
+ Opts1 = expand_kt2(Opts0),
+ Opts =
+ case Name of
+ {_Mod, _Fun, _Arity} ->
+ [no_concurrent_comp|Opts1];
+ _ ->
+ Opts1
+ end,
+ case proplists:get_value(core, Opts) of
+ true when is_binary(File) ->
+ ?error_msg("Cannot get Core Erlang code from BEAM binary.",[]),
+ ?EXIT({cant_compile_core_from_binary});
+ true ->
+ case filename:find_src(filename:rootname(File, ".beam")) of
+ {error, _} ->
+ ?error_msg("Cannot find source code for ~p.",[File]),
+ ?EXIT({cant_find_source_code});
+ {Source, CompOpts} ->
+ CoreOpts = [X || X = {core_transform, _} <- Opts],
+ %%io:format("Using: ~w\n", [CoreOpts]),
+ case compile:file(Source, CoreOpts ++ [to_core, binary|CompOpts]) of
+ {ok, _, Core} ->
+ compile_core(Name, Core, File, Opts);
+ Error ->
+ ?error_msg("Error compiling ~p:\n~p.",[File, Error]),
+ ?EXIT({cant_compile_source_code})
+ end
+ end;
+ {src_file, Source} ->
+ CoreOpts1 = [X || X = {core_transform, _} <- Opts],
+ CoreOpts2 = [report_errors, to_core, binary, {i,"../include"}|CoreOpts1],
+ %% io:format("Using: ~w\n", [CoreOpts2]),
+ case compile:file(Source, CoreOpts2) of
+ {ok, _, Core} ->
+ compile_core(Name, Core, File, Opts);
+ Error ->
+ ?error_msg("Error compiling ~p:\n~p\n",[Source, Error]),
+ ?EXIT({cant_compile_source_code, Error})
+ end;
+ Other when Other =:= false; Other =:= undefined ->
+ NewOpts =
+ case proplists:get_value(use_callgraph, Opts) of
+ No when No =:= false; No =:= undefined -> Opts;
+ _ ->
+ case Name of
+ {_M,_F,_A} ->
+ %% There is no point in using the callgraph or concurrent_comp
+ %% when analyzing just one function.
+ [no_use_callgraph, no_concurrent_comp|Opts];
+ _ -> Opts
+ end
+ end,
+ DisasmFun = fun (_) -> disasm(File) end,
+ IcodeFun = fun (Code, Opts_) ->
+ get_beam_icode(Name, Code, File, Opts_)
+ end,
+ run_compiler(Name, DisasmFun, IcodeFun, NewOpts)
+ end.
+
+-spec compile_core(mod(), _, compile_file(), comp_options()) ->
+ {'ok', compile_ret()} | {'error', term()}.
+
+compile_core(Name, Core0, File, Opts) ->
+ Core = cerl:from_records(Core0),
+ Core1 = case (erlang:system_info(heap_type) =:= hybrid)
+ andalso proplists:get_bool(hybrid, Opts) of
+ true -> cerl_hybrid_transform:transform(Core, Opts);
+ false -> Core
+ end,
+ compile(Name, Core1, File, Opts).
+
+%% @spec compile(Name, Core, File, options()) ->
+%% {ok, {Target, Binary}} | {error, Reason}
+%% Name = mod()
+%% Core = coreErlang() | []
+%% File = filename() | binary()
+%% Binary = binary()
+%% Reason = term()
+%%
+%% @doc Like <code>compile/3</code>, but unless <code>Core</code> is
+%% <code>[]</code>, low-level code is generated from the given Core
+%% Erlang code instead of from the BEAM code.
+%%
+%% <p>Note that only whole modules can be compiled with this
+%% function.</p>
+%%
+%% @see compile/3
+
+-spec compile(mod(), _, compile_file(), comp_options()) ->
+ {'ok', compile_ret()} | {'error', term()}.
+
+compile(Name, [], File, Opts) ->
+ compile(Name, File, Opts);
+compile(Name, Core, File, Opts) when is_atom(Name) ->
+ DisasmFun = fun (_) -> {false, []} end,
+ IcodeFun = fun (_, Opts) ->
+ get_core_icode(Name, Core, File, Opts)
+ end,
+ run_compiler(Name, DisasmFun, IcodeFun, Opts).
+
+%% @spec file(File) -> {ok, Name, {Target, Binary}} | {error, Reason}
+%% File = filename() | binary()
+%% Name = mod() | mfa()
+%% Binary = binary()
+%% Reason = term()
+%%
+%% @equiv file(File, [])
+
+-spec file(Mod) -> {'ok', Mod, compile_ret()} | {'error', term()}
+ when is_subtype(Mod, mod()).
+
+file(File) ->
+ file(File, []).
+
+%% @spec file(File, options()) -> {ok, Name, {Target,Binary}} | {error, Reason}
+%% File = filename()
+%% Name = mod() | mfa()
+%% Binary = binary()
+%% Reason = term()
+%%
+%% @doc Like <code>compile/2</code>, but takes the module name from the
+%% specified <code>File</code>. Returns both the name and the final
+%% binary if successful.
+%%
+%% @see file/1
+%% @see compile/2
+
+-spec file(Mod, comp_options()) -> {'ok', Mod, compile_ret()}
+ | {'error', term()}
+ when is_subtype(Mod, mod()).
+file(File, Options) when is_atom(File) ->
+ case beam_lib:info(File) of
+ L when is_list(L) ->
+ {module, Mod} = lists:keyfind(module, 1, L),
+ case compile(Mod, File, Options) of
+ {ok, CompRet} ->
+ {ok, Mod, CompRet};
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
+ end.
+
+
+%%-----------------------------------------------------------------------
+%% The rest are internal functions:
+%%-----------------------------------------------------------------------
+
+%% @doc
+%% Get BEAM code from `.beam' files or directly from binaries.
+%% File is either a file name or a binary containing the BEAM code.
+
+disasm(File) ->
+ case beam_disasm:file(File) of
+ #beam_file{labeled_exports = LabeledExports,
+ compile_info = CompInfo,
+ code = BeamCode} ->
+ {options, CompOpts} = lists:keyfind(options, 1, CompInfo),
+ HCompOpts = case lists:keyfind(hipe, 1, CompOpts) of
+ {hipe, L} when is_list(L) -> L;
+ {hipe, X} -> [X];
+ _ -> []
+ end,
+ Exports = fix_beam_exports(LabeledExports),
+ {{BeamCode, Exports}, HCompOpts};
+ {error, _Mod, Error} ->
+ io:format("~s\n", [beam_lib:format_error(Error)]),
+ ?EXIT(no_beam_code)
+ end.
+
+fix_beam_exports(BeamExports) ->
+ fix_beam_exports(BeamExports, []).
+
+fix_beam_exports([{F,A,_}|BeamExports], Exports) ->
+ fix_beam_exports(BeamExports, [{F,A} | Exports]);
+fix_beam_exports([], Exports) ->
+ Exports.
+
+get_beam_icode({M,_F,_A} = MFA, {BeamCode, Exports}, _File, Options) ->
+ ?option_time({ok, Icode} =
+ (catch {ok, hipe_beam_to_icode:mfa(BeamCode, MFA, Options)}),
+ "BEAM-to-Icode", Options),
+ {{M, Exports, Icode}, false};
+get_beam_icode(Mod, {BeamCode, Exports}, File, Options) ->
+ ?option_time({ok, Icode} =
+ (catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}),
+ "BEAM-to-Icode", Options),
+ BeamBin = get_beam_code(File),
+ {{Mod, Exports, Icode}, BeamBin}.
+
+get_core_icode(Mod, Core, File, Options) ->
+ ?option_time({ok, Icode} =
+ (catch {ok, cerl_to_icode:module(Core, Options)}),
+ "BEAM-to-Icode", Options),
+ NeedBeamCode = not proplists:get_bool(load, Options),
+ BeamBin =
+ case NeedBeamCode of
+ true -> [];
+ false -> get_beam_code(File)
+ end,
+ Exports = [cerl:var_name(V) || V <- cerl:module_exports(Core)],
+ {{Mod, Exports, Icode}, BeamBin}.
+
+get_beam_code(Bin) when is_binary(Bin) -> Bin;
+get_beam_code(FileName) ->
+ case erl_prim_loader:get_file(FileName) of
+ {ok,Bin,_} ->
+ Bin;
+ error ->
+ ?EXIT(no_beam_file)
+ end.
+
+
+%% ---------------------------------------------------------------------
+%% All compilations go through this function. Note that it receives only
+%% "basic" options. Name is just used for verbosity. The DisasmFun and
+%% IcodeFun only collect the Icode; most of the real work is done in the
+%% 'finalize' function.
+
+run_compiler(Name, DisasmFun, IcodeFun, Opts0) ->
+ Opts = expand_basic_options(Opts0 ++ ?COMPILE_DEFAULTS),
+ ?when_option(verbose, Opts, ?debug_msg("Compiling: ~p\n",[Name])),
+ ?option_start_time("Compile", Opts),
+ Res = run_compiler_1(DisasmFun, IcodeFun, Opts),
+ ?option_stop_time("Compile", Opts),
+ Res.
+
+run_compiler_1(DisasmFun, IcodeFun, Options) ->
+ Parent = self(),
+ {trap_exit,TrapExit} = process_info(Parent, trap_exit),
+ %% Spawn a compilation process CompProc. In case this process gets
+ %% killed, the trap_exit flag is restored to that of the Parent process.
+ process_flag(trap_exit, true),
+ CompProc = spawn_link(fun () ->
+ %% Compiler process
+ set_architecture(Options),
+ pre_init(Options),
+ %% The full option expansion is not done
+ %% until the DisasmFun returns.
+ {Code, CompOpts} = DisasmFun(Options),
+ Opts = expand_options(Options ++ CompOpts),
+ check_options(Opts),
+ ?when_option(verbose, Options,
+ ?debug_msg("Options: ~p.\n",[Opts])),
+ init(Opts),
+ {Icode, WholeModule} = IcodeFun(Code, Opts),
+ CompRes = compile_finish(Icode, WholeModule, Opts),
+ compiler_return(CompRes, Parent)
+ end),
+ Timeout = case proplists:get_value(timeout, Options) of
+ N when is_integer(N), N >= 0 -> N;
+ undefined -> ?DEFAULT_TIMEOUT;
+ infinity -> infinity;
+ Other ->
+ ?WARNING_MSG("Bad timeout value: ~P\n"
+ "Using default timeout limit.\n",
+ [Other, 5]),
+ ?DEFAULT_TIMEOUT
+ end,
+ receive
+ {'EXIT', CompProc, normal} -> ok;
+ {'EXIT', CompProc, Reason} -> exit(Reason)
+ after Timeout ->
+ %% Kill the compilation process
+ exit(CompProc, kill),
+ receive {'EXIT', CompProc, _} -> ok end,
+ flush(),
+ ?error_msg("ERROR: Compilation timed out.\n",[]),
+ exit(timed_out)
+ end,
+ Result = receive {CompProc, Res} -> Res end,
+ process_flag(trap_exit, TrapExit),
+ Result.
+
+flush() ->
+ receive
+ _ -> flush()
+ after 0 ->
+ ok
+ end.
+
+compiler_return(Res, Client) ->
+ Client ! {self(), Res}.
+
+compile_finish({Mod, Exports, Icode}, WholeModule, Options) ->
+ Res = finalize(Icode, Mod, Exports, WholeModule, Options),
+ post(Res, Icode, Options).
+
+
+%% -------------------------------------------------------------------------
+%% finalize/5
+%% compiles, assembles, and optionally loads a list of `{MFA, Icode}' pairs,
+%% and returns `{ok, {TargetArch, Binary}}' or `{error, Reason, Stack}'.
+
+finalize(OrigList, Mod, Exports, WholeModule, Opts) ->
+ List = icode_multret(OrigList, Mod, Opts, Exports),
+ {T1Compile,_} = erlang:statistics(runtime),
+ CompiledCode =
+ case proplists:get_value(use_callgraph, Opts) of
+ true ->
+ %% Compiling the functions bottom-up by using a call graph
+ CallGraph = hipe_icode_callgraph:construct(List),
+ OrdList = hipe_icode_callgraph:to_list(CallGraph),
+ finalize_fun(OrdList, Exports, Opts);
+ _ ->
+ %% Compiling the functions bottom-up by reversing the list
+ OrdList = lists:reverse(List),
+ finalize_fun(OrdList, Exports, Opts)
+ end,
+ {T2Compile,_} = erlang:statistics(runtime),
+ ?when_option(verbose, Opts,
+ ?debug_msg("Compiled ~p in ~.2f s\n",
+ [Mod,(T2Compile-T1Compile)/1000])),
+ case proplists:get_bool(to_rtl, Opts) of
+ true ->
+ {ok, CompiledCode};
+ false ->
+ Closures =
+ [MFA || {MFA, Icode} <- List,
+ hipe_icode:icode_is_closure(Icode)],
+ {T1,_} = erlang:statistics(runtime),
+ ?when_option(verbose, Opts, ?debug_msg("Assembling ~w",[Mod])),
+ try assemble(CompiledCode, Closures, Exports, Opts) of
+ Bin ->
+ {T2,_} = erlang:statistics(runtime),
+ ?when_option(verbose, Opts,
+ ?debug_untagged_msg(" in ~.2f s\n",
+ [(T2-T1)/1000])),
+ {module,Mod} = maybe_load(Mod, Bin, WholeModule, Opts),
+ TargetArch = get(hipe_target_arch),
+ {ok, {TargetArch,Bin}}
+ catch
+ error:Error ->
+ {error,Error,erlang:get_stacktrace()}
+ end
+ end.
+
+finalize_fun(MfaIcodeList, Exports, Opts) ->
+ case proplists:get_value(concurrent_comp, Opts) of
+ FalseVal when (FalseVal =:= undefined) orelse (FalseVal =:= false) ->
+ [finalize_fun_sequential(MFAIcode, Opts, #comp_servers{})
+ || {_MFA, _Icode} = MFAIcode <- MfaIcodeList];
+ TrueVal when (TrueVal =:= true) or (TrueVal =:= debug) ->
+ finalize_fun_concurrent(MfaIcodeList, Exports, Opts)
+ end.
+
+finalize_fun_concurrent(MfaIcodeList, Exports, Opts) ->
+ Self = self(),
+ case MfaIcodeList of
+ [{{M,_,_},_}|_] ->
+ CallGraph = hipe_icode_callgraph:construct_callgraph(MfaIcodeList),
+ Closures = [{MFA, true} || {MFA, Icode} <- MfaIcodeList,
+ hipe_icode:icode_is_closure(Icode)],
+ Exported = [{{M, F, A}, false} || {F, A} <- Exports],
+ NonEscaping = [MFA || {{_M, F, A} = MFA, Icode} <- MfaIcodeList,
+ not lists:member({F, A}, Exports),
+ not hipe_icode:icode_is_closure(Icode)],
+ Escaping = Closures ++ Exported,
+ TypeServerFun =
+ fun() ->
+ hipe_icode_coordinator:coordinate(CallGraph, Escaping,
+ NonEscaping, hipe_icode_type)
+ end,
+ TypeServer = spawn_link(TypeServerFun),
+ PPServerFun =
+ fun() ->
+ pp_server_start(Opts)
+ end,
+ PPServer = spawn_link(PPServerFun),
+ RangeServerFun =
+ fun() ->
+ hipe_icode_coordinator:coordinate(CallGraph, Escaping,
+ NonEscaping, hipe_icode_range)
+ end,
+ RangeServer = spawn_link(RangeServerFun),
+ Servers = #comp_servers{pp_server = PPServer,
+ range = RangeServer,
+ type = TypeServer},
+ CompFuns =
+ [fun() ->
+ set_architecture(Opts),
+ pre_init(Opts),
+ init(Opts),
+ Self ! finalize_fun_sequential(IcodeFun, Opts, Servers)
+ end || IcodeFun <- MfaIcodeList],
+ lists:foreach(fun (F) -> spawn_link(F) end, CompFuns),
+ Final = [receive Res when element(1, Res) =:= MFA -> Res end
+ || {MFA, _} <- MfaIcodeList],
+ lists:foreach(fun (Pid) -> stop_and_wait(Pid) end,
+ [PPServer, TypeServer, RangeServer]),
+ Final;
+ [] ->
+ []
+ end.
+
+stop_and_wait(Pid) ->
+ Pid ! {stop, self()},
+ receive
+ _ -> ok
+ end.
+
+finalize_fun_sequential({MFA, Icode}, Opts, Servers) ->
+ {T1, _} = erlang:statistics(runtime),
+ ?when_option(verbose, Opts, ?debug_msg("Compiling ~w~n", [MFA])),
+ try hipe_main:compile_icode(MFA, Icode, Opts, Servers) of
+ {native, _Platform, {unprofiled, Code}} ->
+ {T2, _} = erlang:statistics(runtime),
+ ?when_option(verbose, Opts,
+ ?debug_msg("Compiled ~w in ~.2f s\n", [MFA,(T2-T1)/1000])),
+ {MFA, Code};
+ {rtl, LinearRtl} ->
+ {MFA, LinearRtl}
+ catch
+ error:Error ->
+ ?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])),
+ ErrorInfo = {Error, erlang:get_stacktrace()},
+ ?error_msg("ERROR: ~p~n", [ErrorInfo]),
+ ?EXIT(ErrorInfo)
+ end.
+
+pp_server_start(Opts) ->
+ set_architecture(Opts),
+ garbage_collect(),
+ pp_server().
+
+pp_server() ->
+ receive
+ {print, Fun} ->
+ Fun(), pp_server();
+ {stop, Pid} ->
+ Pid ! {done, self()};
+ _ ->
+ pp_server()
+ end.
+
+icode_multret(List, Mod, Opts, Exports) ->
+ case proplists:get_bool(icode_multret, Opts) of
+ true ->
+ hipe_icode_mulret:mult_ret(List, Mod, Opts, Exports);
+ false ->
+ List
+ end.
+
+maybe_load(Mod, Bin, WholeModule, Opts) ->
+ case proplists:get_bool(load, Opts) of
+ false ->
+ {module, Mod};
+ true ->
+ ?when_option(verbose, Opts, ?debug_msg("Loading/linking\n", [])),
+ do_load(Mod, Bin, WholeModule)
+ end.
+
+do_load(Mod, Bin, WholeModule) ->
+ HostArch = get(hipe_host_arch),
+ TargetArch = get(hipe_target_arch),
+ %% Make sure we can do the load.
+ if HostArch =/= TargetArch ->
+ ?EXIT({host_and_target_arch_differ, HostArch, TargetArch});
+ true -> ok
+ end,
+ case WholeModule of
+ false ->
+ %% In this case, the emulated code for the module must be loaded.
+ {module, Mod} = code:ensure_loaded(Mod),
+ code:load_native_partial(Mod, Bin);
+ BinCode when is_binary(BinCode) ->
+ case code:is_sticky(Mod) of
+ true ->
+ %% We unpack and repack the Beam binary as a workaround to
+ %% ensure that it is not compressed.
+ {ok, _, Chunks} = beam_lib:all_chunks(WholeModule),
+ {ok, Beam} = beam_lib:build_module(Chunks),
+ %% Don't purge or register sticky mods; just load native.
+ code:load_native_sticky(Mod, Bin, Beam);
+ false ->
+ %% Normal loading of a whole module
+ Architecture = erlang:system_info(hipe_architecture),
+ ChunkName = hipe_unified_loader:chunk_name(Architecture),
+ {ok, _, Chunks0} = beam_lib:all_chunks(WholeModule),
+ Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)],
+ {ok, BeamPlusNative} = beam_lib:build_module(Chunks),
+ code:load_binary(Mod, code:which(Mod), BeamPlusNative)
+ end
+ end.
+
+assemble(CompiledCode, Closures, Exports, Options) ->
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options);
+ powerpc ->
+ hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options);
+ arm ->
+ hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options);
+ x86 ->
+ hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options);
+ amd64 ->
+ hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options);
+ Arch ->
+ ?EXIT({executing_on_an_unsupported_architecture, Arch})
+ end.
+
+%% --------------------------------------------------------------------
+
+%% Initialise host and target architectures. Target defaults to host,
+%% but can be overridden by passing an option {target, Target}.
+
+set_architecture(Options) ->
+ put(hipe_host_arch, erlang:system_info(hipe_architecture)),
+ put(hipe_target_arch,
+ proplists:get_value(target, Options, get(hipe_host_arch))),
+ ok.
+
+%% This sets up some globally accessed stuff that are needed by the
+%% compiler process before it even gets the full list of options.
+%% Therefore, this expands the current set of options for local use.
+
+pre_init(Opts) ->
+ Options = expand_options(Opts),
+ %% Initialise some counters used for measurements and benchmarking. If
+ %% the option 'measure_regalloc' is given the compilation will return
+ %% a keylist with the counter values.
+ put(hipe_time,
+ case proplists:get_value(time, Options, false) of
+ true -> [hipe, hipe_main];
+ OptTime -> OptTime
+ end),
+ lists:foreach(fun (T) -> ?set_hipe_timer_val(T, 0) end, hipe_timers()),
+ lists:foreach(fun (Counter) ->
+ case Counter of
+ {CounterName, InitVal} -> put(CounterName, InitVal);
+ CounterName -> put(CounterName, 0)
+ end
+ end,
+ proplists:get_value(counters, Options, [])),
+ put(hipe_debug, proplists:get_bool(debug, Options)),
+ put(hipe_inline_fp, proplists:get_bool(inline_fp, Options)),
+ ok.
+
+%% Prepare the compiler process by setting up variables which are
+%% accessed globally. Options have been fully expanded at ths point.
+
+init(_Options) ->
+ put(callersavetime, 0),
+ put(totalspill, {0,0}),
+ put(spilledtemps, 0),
+ put(pre_ra_instrs, 0),
+ put(post_ra_instrs, 0),
+ put(pre_ra_temps, 0),
+ put(post_ra_temps, 0),
+ put(noregs, 0),
+ put(bbs, 0),
+ ok.
+
+%% --------------------------------------------------------------------
+
+post(Res, Icode, Options) ->
+ TimerVals =
+ case proplists:get_value(timers, Options) of
+ Timers when is_list(Timers) ->
+ [{Timer, ?get_hipe_timer_val(Timer)} || Timer <- Timers];
+ _ -> []
+ end,
+ CounterVals =
+ case proplists:get_value(counters, Options) of
+ Counters when is_list(Counters) ->
+ [case Counter of
+ {CounterName, _InitVal} -> {CounterName, get(CounterName)};
+ CounterName -> {CounterName, get(CounterName)}
+ end
+ || Counter <- Counters];
+ _ -> []
+ end,
+ Measures =
+ case proplists:get_bool(measure_regalloc, Options) of
+ true ->
+ get(); % return whole process dictionary list (simplest way...)
+ false -> []
+ end,
+ Info = TimerVals ++ CounterVals ++ Measures,
+ case proplists:get_bool(get_called_modules, Options) of
+ true ->
+ CalledMods = hipe_icode_callgraph:get_called_modules(Icode),
+ case Info of
+ [] ->
+ {Res, {called_modules, CalledMods}};
+ _ ->
+ {Res, {info, Info}, {called_modules, CalledMods}}
+ end;
+ false ->
+ case Info of
+ [] ->
+ Res;
+ _ ->
+ {Res, {info, Info}}
+ end
+ end.
+
+%% --------------------------------------------------------------------
+
+%% @doc Returns the current HiPE version as a string().
+-spec version() -> string().
+
+version() ->
+ ?VERSION_STRING().
+
+%% --------------------------------------------------------------------
+%% D O C U M E N T A T I O N - H E L P
+%% --------------------------------------------------------------------
+
+%% @doc Prints on-line documentation to the standard output.
+-spec help() -> 'ok'.
+
+help() ->
+ M =
+ "The HiPE Compiler (Version " ++ ?VERSION_STRING() ++ ")\n" ++
+ "\n" ++
+ " The normal way to native-compile Erlang code using HiPE is to\n" ++
+ " include `native' in the Erlang compiler options, as in:\n" ++
+ " 1> c(my_module, [native]).\n" ++
+ " Options to the HiPE compiler must then be passed as follows:\n" ++
+ " 1> c(my_module, [native,{hipe,Options}]).\n" ++
+ " Use `help_options()' for details.\n" ++
+ "\n" ++
+ " Utility functions:\n" ++
+ " help()\n" ++
+ " Prints this message.\n" ++
+ " help_options()\n" ++
+ " Prints a description of options recognized by the\n" ++
+ " HiPE compiler.\n" ++
+ " help_option(Option)\n" ++
+ " Prints a description of that option.\n" ++
+ " help_debug_options()\n" ++
+ " Prints a description of debug options.\n" ++
+ " version() ->\n" ++
+ " Returns the HiPE version as a string'.\n" ++
+ "\n" ++
+ " For HiPE developers only:\n" ++
+ " Use `help_hiper()' for information about HiPE's low-level interface\n",
+ io:put_chars(M),
+ ok.
+
+-spec help_hiper() -> 'ok'.
+
+help_hiper() ->
+ M =
+ " This interface is supposed to be used by HiPE-developers only!\n" ++
+ " Note that all options are specific to the HiPE compiler.\n" ++
+ " c(Name,Options)\n" ++
+ " Compiles the module or function Name and loads it\n" ++
+ " to memory. Name is an atom or a tuple {M,F,A}.\n" ++
+ " c(Name)\n" ++
+ " As above, but using only default options.\n" ++
+ " f(File,Options)\n" ++
+ " As c(Name,File,Options), but taking the module name\n" ++
+ " from File.\n" ++
+ " f(File)\n" ++
+ " As above, but using only default options.\n" ++
+ " compile(Name,Options)\n" ++
+ " Compiles the module or function Name to a binary.\n" ++
+ " By default, this does not load to memory.\n" ++
+ " compile(Name)\n" ++
+ " As above, but using only default options.\n" ++
+ " file(File,Options)\n" ++
+ " As compile(Name,File,Options), but taking the\n" ++
+ " module name from File.\n" ++
+ " file(File)\n" ++
+ " As above, but using only default options.\n" ++
+ " load(Module)\n" ++
+ " Loads the named module into memory.\n",
+ io:put_chars(M),
+ ok.
+
+%% TODO: it should be possible to specify the target somehow when asking
+%% for available options. Right now, you only see host machine options.
+
+%% @doc Prints documentation about options to the standard output.
+-spec help_options() -> 'ok'.
+
+help_options() ->
+ set_architecture([]), %% needed for target-specific option expansion
+ O1 = expand_options([o1]),
+ O2 = expand_options([o2]),
+ O3 = expand_options([o3]),
+ io:format("HiPE Compiler Options\n" ++
+ " Boolean-valued options generally have corresponding " ++
+ "aliases `no_...',\n" ++
+ " and can also be specified as `{Option, true}' " ++
+ "or `{Option, false}.\n\n" ++
+ " General boolean options:\n" ++
+ " ~p.\n\n" ++
+ " Non-boolean options:\n" ++
+ " o#, where 0 =< # =< 3:\n" ++
+ " Select optimization level (the default is 2).\n\n" ++
+ " Further options can be found below; " ++
+ "use `hipe:help_option(Name)' for details.\n\n" ++
+ " Aliases:\n" ++
+ " pp_all = ~p,\n" ++
+ " pp_sparc = pp_native,\n" ++
+ " pp_x86 = pp_native,\n" ++
+ " pp_amd64 = pp_native,\n" ++
+ " pp_ppc = pp_native,\n" ++
+ " o0,\n" ++
+ " o1 = ~p,\n" ++
+ " o2 = ~p ++ o1,\n" ++
+ " o3 = ~p ++ o2.\n",
+ [ordsets:from_list([verbose, debug, time, load, pp_beam,
+ pp_icode, pp_rtl, pp_native, pp_asm,
+ timeout]),
+ expand_options([pp_all]),
+ O1 -- [o1],
+ (O2 -- O1) -- [o2],
+ (O3 -- O2) -- [o3]]),
+ ok.
+
+%% Documentation of the individual options.
+%% If you add an option, please add help-text here.
+
+-spec option_text(atom()) -> string().
+
+option_text('O') ->
+ "Specify optimization level. Used as o1, o2, o3.\n" ++
+ " At the moment levels 0 - 3 are implemented.\n" ++
+ " Aliases: 'O1', 'O2', O3'.";
+option_text(caller_save_spill_restore) ->
+ "Activates caller save register spills and restores";
+option_text(debug) ->
+ "Outputs internal debugging information during compilation";
+option_text(icode_range) ->
+ "Performs integer range analysis on the Icode level";
+option_text(icode_ssa_check) ->
+ "Checks whether Icode is on SSA form or not\n";
+option_text(icode_ssa_copy_prop) ->
+ "Performs copy propagation on Icode SSA";
+option_text(icode_ssa_const_prop) ->
+ "Performs sparse conditional constant propagation on Icode SSA";
+option_text(icode_ssa_struct_reuse) ->
+ "Factors out common tuple and list constructions on Icode SSA";
+option_text(icode_type) ->
+ "Performs type analysis on the Icode level" ++
+ "and then simplifies the code based on the results of this analysis";
+option_text(load) ->
+ "Automatically load the produced native code into memory";
+option_text(peephole) ->
+ "Enables peephole optimizations";
+option_text(pmatch) ->
+ "Enables pattern matching compilation when compiling from Core; " ++
+ "has no effect when compiling from BEAM bytecode";
+option_text(pp_asm) ->
+ "Displays assembly listing with addresses and bytecode\n" ++
+ "Currently available for x86 only";
+option_text(pp_beam) ->
+ "Display the input BEAM code";
+option_text(pp_icode) ->
+ "Display the intermediate HiPE-ICode";
+option_text(pp_rtl) ->
+ "Display the intermediate HiPE-RTL code";
+option_text(pp_rtl_lcm) ->
+ "Display the intermediate HiPE-RTL lazy code motion sets";
+option_text(pp_rtl_ssapre) ->
+ "Display the intermediate HiPE-RTL A-SSAPRE sets";
+option_text(pp_native) ->
+ "Display the generated (back-end specific) native code";
+option_text(regalloc) ->
+ "Select register allocation algorithm. Used as {regalloc, METHOD}.\n" ++
+ " Currently available methods:\n" ++
+ " naive - spills everything (for debugging and testing)\n" ++
+ " linear_scan - fast; not so good if few registers available\n" ++
+ " graph_color - slow, but gives OK performance\n" ++
+ " coalescing - slower, tries hard to use registers\n" ++
+ " optimistic - another variant of a coalescing allocator";
+option_text(remove_comments) ->
+ "Strip comments from intermediate code";
+option_text(rtl_ssa) ->
+ "Perform SSA conversion on the RTL level -- default starting at O2";
+option_text(rtl_ssa_const_prop) ->
+ "Performs sparse conditional constant propagation on RTL SSA";
+option_text(rtl_lcm) ->
+ "Perform Lazy Code Motion on RTL";
+option_text(rtl_ssapre) ->
+ "Perform A-SSAPRE on RTL";
+option_text(time) ->
+ "Reports the compilation times for the different stages\n" ++
+ "of the compiler.\n" ++
+ " {time, Module} reports timings for the module Module.\n" ++
+ " {time, [M1, M2, M3]} reports timings for the specified modules.\n" ++
+ " {time, all} reports timings all modules.\n" ++
+ " time reports timings for the main module.\n";
+option_text(timeout) ->
+ "Specify compilation time limit in ms. Used as {timeout, LIMIT}.\n" ++
+ " The limit must be a non-negative integer or the atom 'infinity'.\n" ++
+ " The current default limit is 15 minutes (900000 ms).";
+option_text(use_indexing) ->
+ "Use indexing for multiple-choice branch selection.";
+option_text(use_callgraph) ->
+ "Compile the functions in a module according to a reversed topological " ++
+ "sorted order to gain more information when using a persistent lookup " ++
+ "table for storing intra-modular type information.";
+option_text(verbose) ->
+ "Output information about what is being done";
+option_text(Opt) when is_atom(Opt) ->
+ "".
+
+%% @doc Prints documentation about a specific option to the standard output.
+-spec help_option(comp_option()) -> 'ok'.
+
+help_option(Opt) ->
+ set_architecture([]), %% needed for target-specific option expansion
+ case expand_options([Opt]) of
+ [Opt] ->
+ Name = if is_atom(Opt) -> Opt;
+ tuple_size(Opt) =:= 2 -> element(1, Opt)
+ end,
+ case option_text(Name) of
+ "" ->
+ case lists:member(Name, opt_keys()) of
+ true ->
+ io:format("~w - Sorry, this option is not documented yet.\n",
+ [Name]);
+ _ ->
+ io:format("Unknown option ~p.\n", [Name])
+ end;
+ Txt ->
+ io:fwrite("~w - ~s\n", [Name, Txt])
+ end;
+ Opts ->
+ io:fwrite("This is an alias for: ~p.\n", [Opts])
+ end,
+ ok.
+
+%% @doc Prints documentation about debugging options to the standard
+%% output.
+-spec help_debug_options() -> 'ok'.
+
+help_debug_options() ->
+ io:format("HiPE compiler debug options:\n" ++
+ " Might require that some modules have been compiled " ++
+ "with the debug flag.\n" ++
+ " rtl_show_translation - Prints each step in the\n" ++
+ " translation from Icode to RTL\n",
+ []),
+ ok.
+
+hipe_timers() ->
+ [time_ra].
+
+%% ____________________________________________________________________
+%%
+%% Option expansion
+
+%% These are currently in use, but not documented:
+%%
+%% count_instrs:
+%% icode_type:
+%% icode_range:
+%% {ls_order, Order}:
+%% {regalloc, Algorithm}:
+%% remove_comments
+%% timeregalloc:
+%% timers
+%% use_indexing
+
+%% Valid option keys. (Don't list aliases or negations - the check is
+%% done after the options have been expanded to normal form.)
+
+opt_keys() ->
+ [
+ binary_opt,
+ bitlevel_binaries,
+ caller_save_spill_restore,
+ concurrent_comp,
+ core,
+ core_transform,
+ counters,
+ count_instrs,
+ count_spills,
+ count_temps,
+ debug,
+ get_called_modules,
+ split_arith,
+ split_arith_unsafe,
+ icode_inline_bifs,
+ icode_ssa_check,
+ icode_ssa_copy_prop,
+ icode_ssa_const_prop,
+ icode_ssa_struct_reuse,
+ icode_type,
+ icode_range,
+ icode_multret,
+ inline_fp,
+ ls_order,
+ load,
+ measure_regalloc,
+ peephole,
+ pmatch,
+ pp_asm,
+ pp_beam,
+ pp_icode,
+ pp_icode_ssa,
+ pp_icode_split_arith,
+ pp_opt_icode,
+ pp_range_icode,
+ pp_typed_icode,
+ pp_icode_liveness,
+ pp_native,
+ pp_rtl,
+ pp_rtl_liveness,
+ pp_rtl_ssa,
+ pp_rtl_lcm,
+ pp_rtl_ssapre,
+ pp_rtl_linear,
+ regalloc,
+ remove_comments,
+ rtl_ssa,
+ rtl_ssa_const_prop,
+ rtl_lcm,
+ rtl_ssapre,
+ rtl_show_translation,
+ spillmin_color,
+ target,
+ time,
+ timeout,
+ timeregalloc,
+ timers,
+ to_rtl,
+ use_indexing,
+ use_inline_atom_search,
+ use_callgraph,
+ use_clusters,
+ use_jumptable,
+ verbose,
+ %% verbose_spills,
+ x87].
+
+%% Definitions:
+
+o1_opts() ->
+ Common = [inline_fp, pmatch, peephole],
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ Common;
+ powerpc ->
+ Common;
+ arm ->
+ Common -- [inline_fp]; % Pointless optimising for absent hardware
+ x86 ->
+ [x87 | Common]; % XXX: Temporary until x86 has sse2
+ amd64 ->
+ Common;
+ Arch ->
+ ?EXIT({executing_on_an_unsupported_architecture,Arch})
+ end.
+
+o2_opts() ->
+ Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse,
+ icode_type, icode_inline_bifs, rtl_lcm,
+ rtl_ssa, rtl_ssa_const_prop,
+ spillmin_color, use_indexing, remove_comments,
+ concurrent_comp, binary_opt | o1_opts()],
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ Common;
+ powerpc ->
+ Common;
+ arm ->
+ Common;
+ x86 ->
+ Common;
+ % [rtl_ssapre | Common];
+ amd64 ->
+ [icode_range | Common]; % range analysis is effective on 64 bits
+ Arch ->
+ ?EXIT({executing_on_an_unsupported_architecture,Arch})
+ end.
+
+o3_opts() ->
+ Common = [icode_range, {regalloc,coalescing} | o2_opts()],
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ Common;
+ powerpc ->
+ Common;
+ arm ->
+ Common;
+ x86 ->
+ Common;
+ amd64 ->
+ Common;
+ Arch ->
+ ?EXIT({executing_on_an_unsupported_architecture,Arch})
+ end.
+
+%% Note that in general, the normal form for options should be positive.
+%% This is a good programming convention, so that tests in the code say
+%% "if 'x' ..." instead of "if not 'no_x' ...".
+
+opt_negations() ->
+ [{no_binary_opt, binary_opt},
+ {no_bitlevel_binaries, bitlevel_binaries},
+ {no_core, core},
+ {no_debug, debug},
+ {no_get_called_modules, get_called_modules},
+ {no_split_arith, split_arith},
+ {no_concurrent_comp, concurrent_comp},
+ {no_icode_inline_bifs, icode_inline_bifs},
+ {no_icode_range, icode_range},
+ {no_icode_split_arith, icode_split_arith},
+ {no_icode_ssa_check, icode_ssa_check},
+ {no_icode_ssa_copy_prop, icode_ssa_copy_prop},
+ {no_icode_ssa_const_prop, icode_ssa_const_prop},
+ {no_icode_ssa_struct_reuse, icode_ssa_struct_reuse},
+ {no_icode_type, icode_type},
+ {no_inline_fp, inline_fp},
+ {no_load, load},
+ {no_peephole, peephole},
+ {no_pmatch, pmatch},
+ {no_pp_beam, pp_beam},
+ {no_pp_icode, pp_icode},
+ {no_pp_icode_ssa, pp_icode_ssa},
+ {no_pp_opt_icode, pp_opt_icode},
+ {no_pp_typed_icode, pp_typed_icode},
+ {no_pp_rtl, pp_rtl},
+ {no_pp_native, pp_native},
+ {no_pp_rtl_lcm, pp_rtl_lcm},
+ {no_pp_rtl_ssapre, pp_rtl_ssapre},
+ {no_remove_comments, remove_comments},
+ {no_rtl_ssa, rtl_ssa},
+ {no_rtl_ssa_const_prop, rtl_ssa_const_prop},
+ {no_rtl_lcm, rtl_lcm},
+ {no_rtl_ssapre, rtl_ssapre},
+ {no_rtl_show_translation, rtl_show_translation},
+ {no_time, time},
+ {no_use_callgraph, use_callgraph},
+ {no_use_clusters, use_clusters},
+ {no_use_inline_atom_search, use_inline_atom_search},
+ {no_use_indexing, use_indexing}].
+
+%% Don't use negative forms in right-hand sides of aliases and expansions!
+%% We only expand negations once, before the other expansions are done.
+
+opt_aliases() ->
+ [{'O0', o0},
+ {'O1', o1},
+ {'O2', o2},
+ {'O3', o3},
+ {pp_sparc, pp_native},
+ {pp_x86, pp_native},
+ {pp_amd64, pp_native},
+ {pp_ppc, pp_native}].
+
+opt_basic_expansions() ->
+ [{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}].
+
+opt_expansions() ->
+ [{o1, o1_opts()},
+ {o2, o2_opts()},
+ {o3, o3_opts()},
+ {x87, [x87, inline_fp]},
+ {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86
+ x86 -> [x87, inline_fp]; %% has sse2
+ _ -> [inline_fp] end}].
+
+%% This expands "basic" options, which may be tested early and cannot be
+%% in conflict with options found in the source code.
+
+-spec expand_basic_options(comp_options()) -> comp_options().
+
+expand_basic_options(Opts) ->
+ proplists:normalize(Opts, [{negations, opt_negations()},
+ {aliases, opt_aliases()},
+ {expand, opt_basic_expansions()}]).
+
+-spec expand_kt2(comp_options()) -> comp_options().
+
+expand_kt2(Opts) ->
+ proplists:normalize(Opts, [{expand, [{kt2_type,
+ [{use_callgraph, fixpoint}, core,
+ {core_transform, cerl_typean}]}]}]).
+
+%% Note that set_architecture/1 must be called first, and that the given
+%% list should contain the total set of options, since things like 'o2'
+%% are expanded here. Basic expansions are processed here also, since
+%% this function is called from the help functions.
+
+-spec expand_options(comp_options()) -> comp_options().
+
+expand_options(Opts) ->
+ proplists:normalize(Opts, [{negations, opt_negations()},
+ {aliases, opt_aliases()},
+ {expand, opt_basic_expansions()},
+ {expand, opt_expansions()}]).
+
+-spec check_options(comp_options()) -> 'ok'.
+
+check_options(Opts) ->
+ Keys = ordsets:from_list(opt_keys()),
+ Used = ordsets:from_list(proplists:get_keys(Opts)),
+ case ordsets:subtract(Used, Keys) of
+ [] ->
+ ok;
+ L ->
+ ?WARNING_MSG("Unknown options: ~p.\n", [L]),
+ ok
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src
new file mode 100644
index 0000000000..a1fbeda9cf
--- /dev/null
+++ b/lib/hipe/main/hipe.hrl.src
@@ -0,0 +1,322 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Filename : hipe.hrl (automatically generated by hipe.hrl.src)
+%% Purpose : Defines some useful macros for debugging and error
+%% reporting.
+%%
+%% History : * 2000-11-03 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%%
+%% Defines:
+%% msg/2 - Works like io:format but prepends
+%% ?MSGTAG to the message.
+%% If LOGGING is defined then error_logger is used,
+%% or rather its substitute in code_server.
+%% untagged_msg/2 - Like msg/2 but without the tag.
+%% WARNING_MSG/2 - Prints a tagged warning.
+%% error_msg/2 - Logs a tagged error.
+%% debug_msg/2 - Prints a tagged msg if DEBUG is defined.
+%% IF_DEBUG(A,B) - Executes A if DEBUG is defined B otherwise.
+%% IF_DEBUG(Lvl,A,B) - Executes A if DEBUG is defined to a value >= Lvl
+%% otherwise B is executed.
+%% EXIT - Exits with added module and line info.
+%% ASSERT - Exits if the expresion does not evaluate to true.
+%% VERBOSE_ASSSERT - A message is printed even when an asertion is true.
+%% TIME_STMNT(Stmnt, String, FreeVar)
+%% - Times the statemnet Stmnt if TIMING is on.
+%% The execution time is bound to FreeVar.
+%% String is printed after the execution
+%% followed by the execution time in seconds and
+%% a newline.
+%%
+%% Flags:
+%% DEBUG - Turns on debugging. (Can be defined to a integer
+%% value to determine the level of debugging)
+%% VERBOSE - More info is printed...
+%% HIPE_LOGGING - Turn on logging of messages with erl_logger.
+%% DO_ASSERT - Turn on Assertions.
+%% TIMING - Turn on timing.
+%% HIPE_INSTRUMENT_COMPILER - Turn on instrumentation of the compiler.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(VERSION_STRING(),"%VSN%").
+-define(MSGTAG, "<HiPE (v " ++ ?VERSION_STRING() ++ ")> ").
+
+%%
+%% Define the message macros with or without logging,
+%% depending on the value of the HIPE_LOGGING flag.
+%%
+
+-ifdef(HIPE_LOGGING).
+-define(msg(Msg, Args),
+ code_server:info_msg(?MSGTAG ++ Msg, Args)).
+-define(untagged_msg(Msg, Args),
+ code_server:info_msg(Msg, Args)).
+-else.
+-define(msg(Msg, Args),
+ io:format(?MSGTAG ++ Msg, Args)).
+-define(untagged_msg(Msg, Args),
+ io:format(Msg, Args)).
+-endif.
+
+%%
+%% Define error and warning messages.
+%%
+-define(error_msg(Msg, Args),
+ code_server:error_msg(?MSGTAG ++
+ "Error: [~s:~w]: " ++ Msg,
+ [?MODULE,?LINE|Args])).
+-define(WARNING_MSG(Msg, Args),
+ ?msg("Warning: [~s:~w]: " ++ Msg, [?MODULE,?LINE|Args])).
+
+%%
+%% Define the macros that are dependent on the debug flag.
+%%
+
+-ifdef(DEBUG).
+-define(debug_msg(Msg,Data), ?msg(Msg,Data)).
+-define(debug_untagged_msg(Msg,Data), ?untagged_msg(Msg,Data)).
+-define(IF_DEBUG(DebugAction,NoDebugAction), DebugAction).
+-define(IF_DEBUG_LEVEL(Level,DebugAction,NoDebugAction),
+ if (Level =< ?DEBUG) -> DebugAction; true -> NoDebugAction end).
+-else.
+-define(debug_msg(Msg,Data), no_debug).
+-define(debug_untagged_msg(Msg,Data), no_debug).
+-define(IF_DEBUG(DebugAction,NoDebugAction), NoDebugAction).
+-define(IF_DEBUG_LEVEL(Level,DebugAction,NoDebugAction), NoDebugAction).
+-endif.
+
+%%
+%% Define the exit macro
+%%
+-ifdef(VERBOSE).
+-define(EXIT(Reason), erlang:error({?MODULE,?LINE,Reason})).
+-else.
+-define(EXIT(Reason),
+ ?msg("EXITED with reason ~w @~w:~w\n", [Reason,?MODULE,?LINE]),
+ erlang:error({?MODULE,?LINE,Reason})).
+-endif.
+
+%%
+%% Assertions.
+%%
+-ifdef(DO_ASSERT).
+-define(VERBOSE_ASSERT(X),
+ case X of
+ true ->
+ io:format("Assertion ok ~w ~w\n",[?MODULE,?LINE]),
+ true;
+ __ASSVAL_R ->
+ io:format("Assertion failed ~w ~w: ~p\n",
+ [?MODULE,?LINE, __ASSVAL_R]),
+ ?EXIT(assertion_failed)
+ end).
+-define(ASSERT(X),
+ case X of
+ true -> true;
+ _ -> ?EXIT(assertion_failed)
+ end).
+-else.
+-define(ASSERT(X),true).
+-define(VERBOSE_ASSERT(X),true).
+-endif.
+
+
+%% Use this to display info, save stuff and so on.
+%% Vars cannot be exported from __Action
+-define(when_option(__Opt,__Opts,__Action),
+ case proplists:get_bool(__Opt,__Opts) of
+ true -> __Action;
+ false -> ok
+ end).
+
+%% Timing macros
+
+-ifdef(TIMING).
+-define(TIME_STMNT(STMNT,Msg,Timer),
+ Timer = hipe_timing:start_timer(),
+ STMNT,
+ ?untagged_msg(Msg ++ "~.2f s\n",[hipe_timing:stop_timer(Timer)/1000])).
+-else.
+-define(TIME_STMNT(STMNT,Msg,Timer),STMNT).
+-endif.
+
+-define(start_timer(Text), hipe_timing:start(Text, ?MODULE)).
+-define(stop_timer(Text), hipe_timing:stop(Text, ?MODULE)).
+-define(start_hipe_timer(Timer), hipe_timing:start_hipe_timer(Timer)).
+-define(stop_hipe_timer(Timer), hipe_timing:stop_hipe_timer(Timer)).
+-define(get_hipe_timer_val(Timer), get(Timer)).
+-define(set_hipe_timer_val(Timer, Val), put(Timer, Val)).
+-define(option_time(Stmnt, Text, Options),
+ if true -> ?when_option(time, Options, ?start_timer(Text)),
+ fun(R) ->
+ ?when_option(time, Options, ?stop_timer(Text)),
+ R
+ end(Stmnt)end).
+
+-define(option_start_time(Text,Options),
+ ?when_option(time, Options, ?start_timer(Text))).
+
+-define(option_stop_time(Text,Options),
+ ?when_option(time, Options, ?stop_timer(Text))).
+
+-define(opt_start_timer(Text),
+ hipe_timing:start_optional_timer(Text,?MODULE)).
+-define(opt_stop_timer(Text),
+ hipe_timing:stop_optional_timer(Text,?MODULE)).
+
+%%
+%% Turn on instrumentation of the compiler.
+%%
+-ifdef(HIPE_INSTRUMENT_COMPILER).
+
+-define(count_pre_ra_instructions(Options, NoInstrs),
+ ?when_option(count_instrs, Options,
+ put(pre_ra_instrs,
+ get(pre_ra_instrs)+ NoInstrs))).
+-define(count_post_ra_instructions(Options, NoInstrs),
+ ?when_option(count_instrs, Options,
+ put(post_ra_instrs,
+ get(post_ra_instrs)+ NoInstrs))).
+
+-define(start_time_regalloc(Options),
+ ?when_option(timeregalloc, Options,
+ put(regalloctime1,erlang:statistics(runtime)))).
+-define(stop_time_regalloc(Options),
+ ?when_option(timeregalloc, Options,
+ put(regalloctime,
+ get(regalloctime) +
+ (element(1,erlang:statistics(runtime))
+ -element(1,get(regalloctime1)))))).
+-define(start_time_caller_saves(Options),
+ ?when_option(timeregalloc, Options,
+ put(callersavetime1,erlang:statistics(runtime)))).
+-define(stop_time_caller_saves(Options),
+ ?when_option(timeregalloc, Options,
+ put(callersavetime,
+ get(callersavetime) +
+ (element(1,erlang:statistics(runtime))
+ -element(1,get(callersavetime1)))))).
+
+-define(count_pre_ra_temps(Options, NoTemps),
+ ?when_option(count_temps, Options,
+ put(pre_ra_temps,
+ get(pre_ra_temps)+ NoTemps))).
+-define(count_post_ra_temps(Options, NoTemps),
+ ?when_option(count_temps, Options,
+ put(post_ra_temps,
+ get(post_ra_temps)+ NoTemps))).
+
+-define(inc_counter(Counter, Val),
+ case get(Counter) of
+ undefined -> true;
+ _ -> put(Counter, Val + get(Counter))
+ end).
+
+-define(cons_counter(Counter, Val),
+ case get(Counter) of
+ undefined -> true;
+ _ -> put(Counter, [Val|get(Counter)])
+ end).
+
+-define(update_counter(Counter, Val, Op),
+ case get(Counter) of
+ undefined -> true;
+ _ -> put(Counter, get(Counter) Op Val)
+ end).
+
+-define(start_ra_instrumentation(Options, NoInstrs, NoTemps),
+ begin
+ ?count_pre_ra_instructions(Options, NoInstrs),
+ ?count_pre_ra_temps(Options, NoTemps),
+ case get(counter_mem_temps) of
+ undefined -> true;
+ _ -> put(counter_mfa_mem_temps,[])
+ end,
+ ?start_time_regalloc(Options)
+ end).
+-define(stop_ra_instrumentation(Options, NoInstrs, NoTemps),
+ begin
+ ?stop_time_regalloc(Options),
+ ?count_post_ra_instructions(Options, NoInstrs),
+ ?cons_counter(counter_mem_temps, get(counter_mfa_mem_temps)),
+ ?cons_counter(ra_all_iterations_counter, get(ra_iteration_counter)),
+ put(ra_iteration_counter,0),
+ ?count_post_ra_temps(Options, NoTemps)
+ end).
+
+-define(add_spills(Options, NoSpills),
+ ?when_option(count_spills, Options,
+ put(spilledtemps, get(spilledtemps) + NoSpills))).
+
+-define(optional_start_timer(Timer, Options),
+ case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of
+ true -> ?start_hipe_timer(Timer);
+ false -> true
+ end).
+-define(optional_stop_timer(Timer, Options),
+ case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of
+ true -> ?stop_hipe_timer(Timer);
+ false -> true
+ end).
+
+-else. %% HIPE_INSTRUMENT_COMPILER
+
+-define(count_pre_ra_instructions(Options, NoInstrs), no_instrumentation).
+-define(count_post_ra_instructions(Options, NoInstrs),no_instrumentation).
+-define(start_time_regalloc(Options), no_instrumentation).
+-define(stop_time_regalloc(Options), no_instrumentation).
+-define(start_time_caller_saves(Options), no_instrumentation).
+-define(stop_time_caller_saves(Options), no_instrumentation).
+-define(count_pre_ra_temps(Options, NoTemps), no_instrumentation).
+-define(count_post_ra_temps(Options, NoTemps), no_instrumentation).
+-define(start_ra_instrumentation(Options, NoInstrs, NoTemps),no_instrumentation).
+-define(stop_ra_instrumentation(Options, NoInstrs, NoTemps),no_instrumentation).
+-define(add_spills(Options, NoSpills), no_instrumentation).
+-define(optional_start_timer(Options, Timer), no_instrumentation).
+-define(optional_stop_timer(Options, Timer), no_instrumentation).
+-define(inc_counter(Counter, Val), no_instrumentation).
+-define(update_counter(Counter, Val, Op), no_instrumentation).
+-define(cons_counter(Counter, Val), no_instrumentation).
+
+-endif. %% HIPE_INSTRUMENT_COMPILER
+
+%%----------------------------------------------------------------------------
+%% Records defined in the hipe module used in other parts of the compiler
+%%----------------------------------------------------------------------------
+
+-record(comp_servers, {pp_server :: pid(), range :: pid(), type :: pid()}).
+
+%%----------------------------------------------------------------------------
+%% Basic types of the 'hipe' application used in other parts of the system
+%%----------------------------------------------------------------------------
+
+-type comp_option() :: atom() | {atom(), atom()}.
+-type comp_options() :: [comp_option()].
+
+-type hipe_architecture() ::
+ 'amd64' | 'arm' | 'powerpc' | 'ppc64' | 'ultrasparc' | 'x86'.
+
+-type hipe_map() :: [{non_neg_integer(),
+ 'unknown' | {'reg' | 'fp_reg' | 'spill',
+ non_neg_integer()}}].
+-type hipe_temp_map() :: tuple().
+-type hipe_spill_map() :: [{non_neg_integer(), {'spill',non_neg_integer()}}].
diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl
new file mode 100644
index 0000000000..fe9bc83fd2
--- /dev/null
+++ b/lib/hipe/main/hipe_main.erl
@@ -0,0 +1,549 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% @doc This is the HiPE compiler's main "loop".
+%%
+%% <h3>Purpose</h3>
+%%
+%% <p> This module provides code which compiles a single Erlang
+%% function, represented as linear ICode all the way down to a linear
+%% native code representation (which depends on the 'hipe_target_arch'
+%% global variable). </p>
+%%
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=====================================================================
+
+-module(hipe_main).
+-export([compile_icode/4]).
+
+%%=====================================================================
+
+-ifndef(DEBUG).
+-define(DEBUG,1).
+-endif.
+
+-define(HIPE_INSTRUMENT_COMPILER, true). %% Turn on instrumentation.
+
+-include("hipe.hrl").
+-include("../icode/hipe_icode.hrl").
+%%-include("../rtl/hipe_rtl.hrl").
+
+%%=====================================================================
+
+-type comp_icode_ret() :: {'native',hipe_architecture(),{'unprofiled',_}}
+ | {'rtl',tuple()}.
+
+%%=====================================================================
+
+%% @spec compile_icode(MFA::mfa(),
+%% LinearIcode::#icode{},
+%% CompilerOptions::comp_options(),
+%% CompServers::#comp_servers()) ->
+%% {native,Platform,{unprofiled,NativeCode}} | {rtl,RTLCode}
+%%
+%% @doc Compiles the Icode (in linear form) of a single MFA down to
+%% native code for the platform of the target architecture.
+%% CompilerOptions influence the steps of this compilation process.
+%%
+%% <p> In particular, the compiler option '<code>to_rtl</code>' stops
+%% compilation after translation to RTL (in which case RTL code is
+%% generated). The compiler options must have already been expanded
+%% (cf. `<a href="hipe.html">hipe:expand_options</a>'). </p>
+
+-spec compile_icode(mfa(), #icode{}, comp_options(), #comp_servers{}) ->
+ comp_icode_ret().
+
+compile_icode(MFA, LinearIcode, Options, Servers) ->
+ compile_icode(MFA, LinearIcode, Options, Servers, get(hipe_debug)).
+
+%%--------------------------------------------------------------------
+%%
+%% The following constraints apply to the passes on Icode:
+%%
+%% 1. The no_comment pass must be done on linear form;
+%%
+%% 2. linear_to_cfg, which turns linear form into a CFG, must be
+%% performed before any of the passes on CFG form;
+%%
+%% 3. handle_exceptions must be performed before icode_ssa;
+%%
+%% 4. split_arith should be performed after icode_ssa for
+%% effectiveness reasons (and perhaps to work at all);
+%%
+%% 5. remove_trivial_bbs should be performed last to tidy up the CFG.
+%%
+%%---------------------------------------------------------------------
+
+compile_icode(MFA, LinearIcode0, Options, Servers, DebugState) ->
+ %% Set up gensym with the right ranges for this function.
+ {LMin,LMax} = hipe_icode:icode_label_range(LinearIcode0),
+ hipe_gensym:set_label_range(icode, LMin, LMax+1),
+ {VMin,VMax} = hipe_icode:icode_var_range(LinearIcode0),
+ hipe_gensym:set_var_range(icode, VMin, VMax+1),
+ %%hipe_icode_pp:pp(LinearIcode0),
+ ?opt_start_timer("Icode"),
+ LinearIcode1 = icode_no_comment(LinearIcode0, Options),
+ IcodeCfg0 = icode_linear_to_cfg(LinearIcode1, Options),
+ %%hipe_icode_cfg:pp(IcodeCfg1),
+ IcodeCfg1 = icode_handle_exceptions(IcodeCfg0, MFA, Options),
+ IcodeCfg3 = icode_inline_bifs(IcodeCfg1, Options),
+ pp(IcodeCfg3, MFA, icode, pp_icode, Options, Servers),
+ IcodeCfg4 = icode_ssa(IcodeCfg3, MFA, Options, Servers),
+ IcodeCfg5 = icode_split_arith(IcodeCfg4, MFA, Options),
+ pp(IcodeCfg5, MFA, icode, pp_icode_split_arith, Options, Servers),
+ IcodeCfg6 = icode_heap_test(IcodeCfg5, Options),
+ IcodeCfg7 = icode_remove_trivial_bbs(IcodeCfg6, Options),
+ pp(IcodeCfg7, MFA, icode, pp_opt_icode, Options, Servers),
+ pp(IcodeCfg7, MFA, icode_liveness, pp_icode_liveness, Options, Servers),
+ FinalIcode = hipe_icode_cfg:cfg_to_linear(IcodeCfg7),
+ ?opt_stop_timer("Icode"),
+ LinearRTL = ?option_time(icode_to_rtl(MFA,FinalIcode,Options, Servers),
+ "RTL", Options),
+ case proplists:get_bool(to_rtl, Options) of
+ false ->
+ rtl_to_native(MFA, LinearRTL, Options, DebugState);
+ true ->
+ put(hipe_debug, DebugState),
+ {rtl, LinearRTL}
+ end.
+
+%%----------------------------------------------------------------
+%%
+%% Icode passes
+%%
+%%----------------------------------------------------------------
+
+icode_no_comment(LinearIcode, Options) ->
+ case proplists:get_bool(remove_comments, Options) of
+ true ->
+ ?option_time(hipe_icode:strip_comments(LinearIcode),
+ "Icode remove comments", Options);
+ _ ->
+ LinearIcode
+ end.
+
+icode_linear_to_cfg(LinearIcode, Options) ->
+ ?option_time(hipe_icode_cfg:linear_to_cfg(LinearIcode),
+ "transform linear Icode to CFG", Options).
+
+icode_ssa_binary_pass(IcodeSSA, Options) ->
+ case proplists:get_bool(binary_opt, Options) of
+ true ->
+ ?option_time(hipe_icode_bincomp:cfg(IcodeSSA),
+ "Icode binary pass", Options);
+ false ->
+ IcodeSSA
+ end.
+
+icode_handle_exceptions(IcodeCfg, MFA, Options) ->
+ debug("Icode fix catches: ~w~n", [MFA], Options),
+ ?option_time(hipe_icode_exceptions:fix_catches(IcodeCfg),
+ "Icode fix catches", Options).
+
+icode_inline_bifs(IcodeCfg, Options) ->
+ case proplists:get_bool(icode_inline_bifs, Options) of
+ true ->
+ ?option_time(hipe_icode_inline_bifs:cfg(IcodeCfg),
+ "Icode inline bifs", Options);
+ false ->
+ IcodeCfg
+ end.
+
+%%---------------------------------------------------------------------
+
+icode_split_arith(IcodeCfg, MFA, Options) ->
+ case proplists:get_bool(split_arith, Options) orelse
+ proplists:get_bool(split_arith_unsafe, Options) of
+ true ->
+ ?option_time(hipe_icode_split_arith:cfg(IcodeCfg, MFA, Options),
+ "Icode split arith", Options);
+ false ->
+ IcodeCfg
+ end.
+
+icode_heap_test(IcodeCfg, Options) ->
+ ?option_time(hipe_icode_heap_test:cfg(IcodeCfg),
+ "Icode heap_test", Options).
+
+icode_remove_trivial_bbs(IcodeCfg, Options) ->
+ ?option_time(hipe_icode_cfg:remove_trivial_bbs(IcodeCfg),
+ "Icode trivial BB removal", Options).
+
+pp(Cfg, MFA, Level, PrintOption, Options, Servers) ->
+ perform_io(pp_fun(Cfg, MFA, get_pp_module(Level),
+ proplists:get_value(PrintOption, Options)),
+ Servers#comp_servers.pp_server).
+
+pp_fun(Cfg, MFA, PP, PrintOptionValue) ->
+ case PrintOptionValue of
+ true ->
+ fun() -> PP:pp(Cfg) end;
+ {only, Lst} when is_list(Lst) ->
+ case lists:member(MFA, Lst) of
+ true ->
+ fun() -> PP:pp(Cfg) end;
+ false ->
+ no_fun
+ end;
+ {only, MFA} ->
+ fun() -> PP:pp(Cfg) end;
+ {file, FileName} ->
+ fun() ->
+ {ok, File} = file:open(FileName, [write,append]),
+ PP:pp(File, Cfg),
+ file:close(File)
+ end;
+ _ ->
+ no_fun
+ end.
+
+get_pp_module(icode) -> hipe_icode_cfg;
+get_pp_module(rtl) -> hipe_rtl_cfg;
+get_pp_module(rtl_linear) -> hipe_rtl;
+get_pp_module(icode_liveness) -> hipe_icode_liveness;
+get_pp_module(rtl_liveness) -> hipe_rtl_liveness.
+
+perform_io(no_fun, _) -> ok;
+perform_io(Fun,PPServer) when is_pid(PPServer) ->
+ PPServer ! {print,Fun};
+perform_io(Fun, undefined) ->
+ Fun().
+
+
+%%--------------------------------------------------------------------
+%%
+%% Icode passes on SSA form. The following constraints are applicable:
+%%
+%% 1. ssa_convert must be first and ssa_unconvert last
+%%
+%% 2. ssa_dead_code must be run after the other passes
+%%
+%% 3. The present order was chosen to maximize effectiveness as
+%% ssa_const_prop might make ssa_type_info more effective
+%%
+%% 4. ssa_check could be put in between all passes to make sure that
+%% they preserve SSA-ness
+%%
+%%---------------------------------------------------------------------
+
+icode_ssa(IcodeCfg0, MFA, Options, Servers) ->
+ ?opt_start_timer("Icode SSA passes"),
+ IcodeSSA0 = icode_ssa_convert(IcodeCfg0, Options),
+ pp(IcodeSSA0, MFA, icode, pp_icode_ssa, Options, Servers),
+ IcodeSSA1 = icode_ssa_const_prop(IcodeSSA0, Options),
+ IcodeSSA2 = icode_ssa_dead_code_elimination(IcodeSSA1, Options),
+ IcodeSSA3 = icode_ssa_copy_prop(IcodeSSA2, Options),
+ IcodeSSA3a = icode_ssa_binary_pass(IcodeSSA3, Options),
+ IcodeSSA4 = icode_ssa_type(IcodeSSA3a, MFA, Options, Servers),
+ IcodeSSA5 = icode_ssa_dead_code_elimination(IcodeSSA4, Options),
+ IcodeSSA6 = icode_ssa_struct_reuse(IcodeSSA5, Options),
+ icode_ssa_check(IcodeSSA6, Options), %% just for sanity
+ pp(IcodeSSA6, MFA, icode, pp_icode_ssa, Options, Servers),
+ IcodeCfg = icode_ssa_unconvert(IcodeSSA6, Options),
+ ?opt_stop_timer("Icode SSA passes"),
+ IcodeCfg.
+
+icode_ssa_type(IcodeSSA, MFA, Options, Servers) ->
+ case proplists:get_value(icode_type, Options) of
+ false -> IcodeSSA;
+ undefined -> IcodeSSA;
+ true ->
+ AnnIcode1 = icode_ssa_type_info(IcodeSSA, MFA, Options, Servers),
+ pp(AnnIcode1, MFA, icode, pp_typed_icode, Options, Servers),
+ AnnIcode2 =
+ case proplists:get_bool(inline_fp, Options) of
+ true -> hipe_icode_fp:cfg(AnnIcode1);
+ false -> AnnIcode1
+ end,
+ AnnIcode3 = icode_range_analysis(AnnIcode2, MFA, Options, Servers),
+ pp(AnnIcode3, MFA, icode, pp_range_icode, Options, Servers),
+ hipe_icode_type:unannotate_cfg(AnnIcode3)
+ end.
+
+icode_ssa_convert(IcodeCfg, Options) ->
+ ?option_time(hipe_icode_ssa:convert(IcodeCfg),
+ "Icode SSA conversion", Options).
+
+icode_ssa_const_prop(IcodeSSA, Options) ->
+ case proplists:get_bool(icode_ssa_const_prop, Options) of
+ true ->
+ ?option_time(Tmp=hipe_icode_ssa_const_prop:propagate(IcodeSSA),
+ "Icode SSA sparse conditional constant propagation", Options),
+ ?option_time(hipe_icode_ssa:remove_dead_code(Tmp),
+ "Icode SSA dead code elimination pass 1", Options);
+ false ->
+ IcodeSSA
+ end.
+
+icode_ssa_copy_prop(IcodeSSA, Options) ->
+ case proplists:get_bool(icode_ssa_copy_prop, Options) of
+ true ->
+ ?option_time(hipe_icode_ssa_copy_prop:cfg(IcodeSSA),
+ "Icode SSA copy propagation", Options);
+ false ->
+ IcodeSSA
+ end.
+
+icode_ssa_struct_reuse(IcodeSSA, Options) ->
+ case proplists:get_value(icode_ssa_struct_reuse, Options) of
+ true ->
+ ?option_time(hipe_icode_ssa_struct_reuse:struct_reuse(IcodeSSA),
+ "Icode SSA structure reuse", Options);
+ _ ->
+ IcodeSSA
+ end.
+
+icode_ssa_type_info(IcodeSSA, MFA, Options, Servers) ->
+ ?option_time(hipe_icode_type:cfg(IcodeSSA, MFA, Options, Servers),
+ "Icode SSA type info", Options).
+
+icode_range_analysis(IcodeSSA, MFA, Options, Servers) ->
+ case proplists:get_bool(icode_range, Options) of
+ true ->
+ ?option_time(hipe_icode_range:cfg(IcodeSSA, MFA, Options, Servers),
+ "Icode SSA integer range analysis", Options);
+ false ->
+ IcodeSSA
+ end.
+
+icode_ssa_dead_code_elimination(IcodeSSA, Options) ->
+ IcodeSSA1 = ?option_time(hipe_icode_ssa:remove_dead_code(IcodeSSA),
+ "Icode SSA dead code elimination pass 2",
+ Options),
+ hipe_icode_cfg:remove_unreachable_code(IcodeSSA1).
+
+icode_ssa_check(IcodeSSA, Options) ->
+ ?when_option(icode_ssa_check, Options,
+ ?option_time(hipe_icode_ssa:check(IcodeSSA),
+ "Icode check for SSA-ness", Options)).
+
+icode_ssa_unconvert(IcodeSSA, Options) ->
+ ?option_time(hipe_icode_ssa:unconvert(IcodeSSA),
+ "Icode SSA unconversion", Options).
+
+
+%%=====================================================================
+%%
+%% @spec icode_to_rtl(MFA::mfa(), Icode, options()) -> Linear_RTL_code
+%% @end
+%%=====================================================================
+
+%%---------------------------------------------------------------------
+%%
+%% The passes on RTL are as follows:
+%%
+%% 1. The translation to RTL, in particular the way exceptions are
+%% currently handled in RTL, introduces some unreachable code.
+%% Therefore, unreachable code is removed early on followed by a
+%% pass that removes trivial basic blocks so as to have smaller
+%% code to play with.
+%%
+%% 2. Code is then converted to SSA so as to perform as many
+%% optimizations as possible in this pass.
+%% Currently, the following optimizations are performed on SSA:
+%% - sparse conditional constant propagation (controlled by an option)
+%% - dead code elimination
+%% - detection of available exceptions
+%% - partial redundancy elimination (controlled by an option)
+%% Finally, code is converted back to non-SSA form.
+%%
+%% 3. rtl_symbolic expands some symbolic instructions.
+%%
+%% 4. rtl_lcm performs a lazy code motion on RTL.
+%%
+%%----------------------------------------------------------------------
+
+icode_to_rtl(MFA, Icode, Options, Servers) ->
+ debug("ICODE -> RTL: ~w, ~w~n", [MFA, hash(Icode)], Options),
+ LinearRTL = translate_to_rtl(Icode, Options),
+ pp(LinearRTL, MFA, rtl_linear, pp_rtl_linear, Options, Servers),
+ RtlCfg = initialize_rtl_cfg(LinearRTL, Options),
+ %% hipe_rtl_cfg:pp(RtlCfg),
+ RtlCfg0 = hipe_rtl_cfg:remove_unreachable_code(RtlCfg),
+ RtlCfg1 = hipe_rtl_cfg:remove_trivial_bbs(RtlCfg0),
+ %% hipe_rtl_cfg:pp(RtlCfg1),
+ RtlCfg2 = rtl_ssa(RtlCfg1, Options),
+ RtlCfg3 = rtl_symbolic(RtlCfg2, Options),
+ %% hipe_rtl_cfg:pp(RtlCfg3),
+ pp(RtlCfg3, MFA, rtl_liveness, pp_rtl_liveness, Options, Servers),
+ RtlCfg4 = rtl_lcm(RtlCfg3, Options),
+ pp(RtlCfg4, MFA, rtl, pp_rtl, Options, Servers),
+ LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg4),
+ LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1),
+ %% hipe_rtl:pp(standard_io, LinearRTL2),
+ LinearRTL2.
+
+translate_to_rtl(Icode, Options) ->
+ %% GC tests should have been added in the conversion to Icode.
+ ?option_time(hipe_icode2rtl:translate(Icode, Options),
+ "translate", Options).
+
+initialize_rtl_cfg(LinearRTL, Options) ->
+ ?option_time(hipe_rtl_cfg:init(LinearRTL), "to cfg", Options).
+
+rtl_symbolic(RtlCfg, Options) ->
+ ?option_time(hipe_rtl_symbolic:expand(RtlCfg),
+ "Expansion of symbolic instructions", Options).
+
+%%----------------------------------------------------------------------
+%%
+%% RTL passes on SSA form. The following constraints are applicable:
+%%
+%% 1. ssa_convert must be first and ssa_unconvert last.
+%%
+%% 2. dead_code_elimination should be performed after conditional
+%% constant propagation in order to cleanup dead code that might
+%% be created by that pass.
+%%
+%% 3. avail_expr ... (PER ADD THIS)
+%%
+%% 4. rtl_ssapre performs A-SSAPRE and has to be done after all other
+%% optimizations.
+%%
+%% 5. ssa_check could be put in between all passes to make sure that
+%% they preserve SSA-ness.
+%%
+%%----------------------------------------------------------------------
+
+rtl_ssa(RtlCfg0, Options) ->
+ case proplists:get_bool(rtl_ssa, Options) of
+ true ->
+ ?opt_start_timer("RTL SSA passes"),
+ RtlSSA0 = rtl_ssa_convert(RtlCfg0, Options),
+ RtlSSA1 = rtl_ssa_const_prop(RtlSSA0, Options),
+ %% RtlSSA1a = rtl_ssa_copy_prop(RtlSSA1, Options),
+ RtlSSA2 = rtl_ssa_dead_code_elimination(RtlSSA1, Options),
+ RtlSSA3 = rtl_ssa_avail_expr(RtlSSA2, Options),
+ RtlSSA4 = rtl_ssapre(RtlSSA3, Options),
+ %% rtl_ssa_check(RtlSSA4, Options), %% just for sanity
+ RtlCfg = rtl_ssa_unconvert(RtlSSA4, Options),
+ case proplists:get_bool(pp_rtl_ssa, Options) of
+ true ->
+ io:format("%%------------- After SSA un-conversion -----------\n"),
+ hipe_rtl_cfg:pp(RtlCfg);
+ false ->
+ ok
+ end,
+ ?opt_stop_timer("RTL SSA passes"),
+ RtlCfg;
+ false ->
+ RtlCfg0
+ end.
+
+rtl_ssa_convert(RtlCfg, Options) ->
+ case proplists:get_bool(pp_rtl_ssa, Options) of
+ true ->
+ io:format("%%------------- Before SSA conversion --------------\n"),
+ hipe_rtl_cfg:pp(RtlCfg),
+ io:format("%%------------- After SSA conversion --------------\n"),
+ RtlCfgSSA = hipe_rtl_ssa:convert(RtlCfg),
+ hipe_rtl_cfg:pp(RtlCfgSSA),
+ io:format("%%------------- SSA check warnings below -----------\n"),
+ hipe_rtl_ssa:check(RtlCfgSSA),
+ RtlCfgSSA;
+ false ->
+ ?option_time(hipe_rtl_ssa:convert(RtlCfg),
+ "RTL SSA conversion", Options)
+ end.
+
+rtl_ssa_const_prop(RtlCfgSSA, Options) ->
+ case proplists:get_bool(rtl_ssa_const_prop, Options) of
+ true ->
+ ?option_time(hipe_rtl_ssa_const_prop:propagate(RtlCfgSSA),
+ "RTL SSA sparse conditional constant propagation", Options);
+ false ->
+ RtlCfgSSA
+ end.
+
+rtl_ssa_dead_code_elimination(RtlCfgSSA, Options) ->
+ ?option_time(hipe_rtl_ssa:remove_dead_code(RtlCfgSSA),
+ "RTL SSA dead code elimination", Options).
+
+rtl_ssa_avail_expr(RtlCfgSSA, Options) ->
+ ?option_time(hipe_rtl_ssa_avail_expr:cfg(RtlCfgSSA),
+ "RTL SSA heap optimizations", Options).
+
+%%---------------------------------------------------------------------
+
+rtl_ssapre(RtlCfg, Options) ->
+ case proplists:get_bool(rtl_ssapre, Options) of
+ true ->
+ ?opt_start_timer("Partial Redundancy Elimination (A-SSAPRE)"),
+ NewRtlCfg = hipe_rtl_ssapre:rtl_ssapre(RtlCfg, Options),
+ ?opt_stop_timer("Partial Redundancy Elimination (A-SSAPRE)"),
+ NewRtlCfg;
+ false ->
+ RtlCfg
+ end.
+
+%%---------------------------------------------------------------------
+
+rtl_ssa_unconvert(RtlCfgSSA, Options) ->
+ ?option_time(hipe_rtl_ssa:unconvert(RtlCfgSSA),
+ "RTL SSA un-convert", Options).
+
+%%---------------------------------------------------------------------
+
+rtl_lcm(RtlCfg, Options) ->
+ case proplists:get_bool(rtl_lcm, Options) of
+ true ->
+ ?opt_start_timer("RTL lazy code motion"),
+ %% ?option_time(hipe_rtl_lcm:rtl_lcm(RtlCfg, Options),
+ %% "RTL lazy code motion", Options);
+ RtlCfg1 = hipe_rtl_lcm:rtl_lcm(RtlCfg, Options),
+ ?opt_stop_timer("RTL lazy code motion"),
+ RtlCfg1;
+ false ->
+ RtlCfg
+ end.
+
+%%=====================================================================
+%% Translation to native code takes place in the corresponding back-end
+%%=====================================================================
+
+rtl_to_native(MFA, LinearRTL, Options, DebugState) ->
+ ?opt_start_timer("Native code"),
+ LinearNativeCode =
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ hipe_sparc_main:rtl_to_sparc(MFA, LinearRTL, Options);
+ powerpc ->
+ hipe_ppc_main:rtl_to_ppc(MFA, LinearRTL, Options);
+ arm ->
+ hipe_arm_main:rtl_to_arm(MFA, LinearRTL, Options);
+ x86 ->
+ hipe_x86_main:rtl_to_x86(MFA, LinearRTL, Options);
+ amd64 ->
+ hipe_amd64_main:rtl_to_amd64(MFA, LinearRTL, Options)
+ end,
+ ?opt_stop_timer("Native code"),
+ put(hipe_debug, DebugState),
+ LinearNativeCode.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Debugging stuff ...
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+debug(Text, Args, Options) ->
+ ?when_option(debug, Options, ?msg(Text,Args)).
+
+hash(X) ->
+ erlang:phash(X, 16#7f3f5f1).
diff --git a/lib/hipe/misc/Makefile b/lib/hipe/misc/Makefile
new file mode 100644
index 0000000000..d5c395855a
--- /dev/null
+++ b/lib/hipe/misc/Makefile
@@ -0,0 +1,113 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+ifdef HIPE_ENABLED
+HIPE_MODULES = hipe_data_pp hipe_pack_constants hipe_sdi
+else
+HIPE_MODULES =
+endif
+MODULES = hipe_consttab hipe_gensym $(HIPE_MODULES)
+
+HRL_FILES= hipe_sdi.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/misc
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/misc
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+distclean: clean
+realclean: clean
+
+$(EBIN)/hipe_consttab.beam: hipe_consttab.hrl
+$(EBIN)/hipe_data_pp.beam: hipe_consttab.hrl
+$(EBIN)/hipe_pack_constants.beam: hipe_consttab.hrl ../../kernel/src/hipe_ext_format.hrl
+$(EBIN)/hipe_sdi.beam: hipe_sdi.hrl
diff --git a/lib/hipe/misc/hipe_consttab.erl b/lib/hipe/misc/hipe_consttab.erl
new file mode 100644
index 0000000000..c381e6a057
--- /dev/null
+++ b/lib/hipe/misc/hipe_consttab.erl
@@ -0,0 +1,503 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% @doc
+%% CONSTTAB - maps labels to constants.
+%% <p>
+%% <strong> Note:</strong> 'constant' is a misnomer throughout this code.
+%% </p>
+%% <p>
+%% There are two different types of constants that can be stored:
+%% <ul>
+%% <li>Erlang terms</li>
+%% <li>Blocks of binary data</li>
+%% </ul>
+%% </p>
+%% <p>
+%% Erlang terms are just what you would expect, you can store any
+%% Erlang term in the constant table.
+%% The term is assumed to be loaded to the place in memory denoted by the
+%% label returned by the insertion function.
+%% </p>
+%% <p>
+%% Blocks of binary data comes in some different shapes, you can
+%% either insert a block of integers (of byte, word (4 bytes), or
+%% word (8 bytes) size) or a list of references to code.
+%% These references will then be threated as word sized addresses
+%% and can be used for jumptables.
+%% The list of references can have an optional ordering, so that
+%% you can create a jumptable that will be sorted on the load-time
+%% representation of e.g. atoms.
+%% </p>
+%% @type ctdata() = #ctdata{}. See {@link mk_ctdata/4}.
+%% @type ct_type() = term | block | sorted_block | ref
+%% @type data() = term() | [term()] | [byte()] | internal().
+%% This type is dependent on ct_type
+%% <ul>
+%% <li> If ct_type() = term -- data() = term() </li>
+%% <li> If ct_type() = block -- data() = [byte()] </li>
+%% <li> If ct_type() = sorted_block -- data() = [term()] </li>
+%% <li> If ct_type() = ref -- data() = internal() </li>
+%% </ul>
+%% @type ct_alignment().
+%% Alignment is always a power of two equal to the number of bytes
+%% in the machine word.
+%% @end
+%% @type byte(). <code>B</code> is an integer between 0 and 255.
+%% @type hipe_consttab().
+%% An abstract datatype for storing data.
+%% @end
+%% Internal note:
+%% A hipe_consttab is a tuple {Data, ReferedLabels, NextConstLabel}
+%% @type hipe_constlbl().
+%% An abstract datatype for referring to data.
+%% @type element_type() = byte | word | ctab_array()
+%% @type ctab_array() = {ctab_array, Type::element_type(),
+%% NoElements::pos_integer()}
+%% @type block() = [integer() | label_ref()]
+%% @type label_ref() = {label, Label::code_label()}
+%% @type code_label() = hipe_sparc:label_name() | hipe_x86:label_name()
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-module(hipe_consttab).
+
+-export([new/0, % new() -> ConstTab
+ insert_term/2, % insert_term(ConstTab, Term) -> {NewTab, Lbl}
+ %% insert_fun/2, % insert_term(ConstTab, Fun) -> {NewTab, Lbl}
+ %% insert_word/2, % insert_word(ConstTab, Value) -> {NewTab, Lbl}
+ insert_sorted_block/2, % insert_word(ConstTab, ValueList) ->
+ % {NewTab, Lbl}
+ insert_sorted_block/4,
+ insert_block/3,
+ %% insert_global_word/2,
+ %% insert_global_block/4,
+ %% update_word/3, % update_word(ConstTab, Value) -> {NewTab, Lbl}
+ %% update_block/5,
+ %% update_global_word/3,
+ %% update_global_block/5,
+ lookup/2, % lookup(Key, ConstTab) -> [Term|Block]
+ labels/1, % labels(ConstTab) -> LabelList
+ referred_labels/1, % referred_labels(ConstTab) -> LabelList
+ update_referred_labels/2,
+ decompose/1,
+ size_of/1,
+ const_type/1,
+ const_align/1,
+ const_exported/1,
+ const_data/1,
+ const_size/1
+ %% block_size/1 % size of a block in bytes
+ ]).
+
+%%-----------------------------------------------------------------------------
+
+-include("hipe_consttab.hrl").
+
+-type code_label() :: term(). % XXX: FIXME
+-type label_ref() :: {'label', code_label()}.
+-type block() :: [hipe_constlbl() | label_ref()].
+
+-type ctab_array() :: {'ctab_array', 'byte' | 'word', pos_integer()}.
+-type element_type() :: 'byte' | 'word' | ctab_array().
+
+-type sort_order() :: term(). % XXX: FIXME
+
+%%-----------------------------------------------------------------------------
+
+%% @doc Create a new constant table.
+-spec new() -> hipe_consttab().
+new() -> {tree_empty(), [], 0}.
+
+
+%% @spec insert_term(ConstTab::hipe_consttab(), Term::term()) -> {NewTab, Lbl}
+%% NewTab = hipe_consttab()
+%% Lbl = hipe_constlbl()
+%% @doc Inserts an erlang term into the const table if the term was not
+%% present before, otherwise do nothing.
+-spec insert_term(hipe_consttab(), term()) -> {hipe_consttab(),hipe_constlbl()}.
+insert_term(ConstTab, Term) ->
+ case lookup_const(ConstTab, term, word_size(), false, Term) of
+ {value, Label} ->
+ {ConstTab, Label};
+ none ->
+ insert_const(ConstTab, term, word_size(), false, Term)
+ end.
+
+
+%% %% @spec insert_fun(ConstTab::hipe_consttab(), Term::term()) -> {NewTab, Lbl}
+%% %% NewTab = hipe_consttab()
+%% %% Lbl = hipe_constlbl()
+%% %% @doc Inserts a Fun into the const table.
+%% %% Don't ask me what this is for...
+%% -spec insert_fun(hipe_consttab(), term()) -> {hipe_consttab(), hipe_constlbl()}.
+%% insert_fun(ConstTab, Fun) ->
+%% insert_const(ConstTab, term, word_size(), false, Fun).
+
+
+%% @spec (ConstTab::hipe_consttab(), TermList::[term()]) -> {NewTab, Lbl}
+%% NewTab = hipe_consttab()
+%% Lbl = hipe_constlbl()
+%% @doc Inserts a list of terms into the const table.
+-spec insert_sorted_block(hipe_consttab(), [term()]) -> {hipe_consttab(), hipe_constlbl()}.
+insert_sorted_block(CTab, TermList) ->
+ insert_const(CTab, sorted_block, word_size(), false, TermList).
+
+%% %% @spec (ConstTab::hipe_consttab(), InitVal::integer()) -> {NewTab, Lbl}
+%% %% NewTab = hipe_consttab()
+%% %% Lbl = hipe_constlbl()
+%% %% @doc Inserts a word into the const table.
+%% %% Shorthand for inserting a word.
+%% insert_word(ConstTab, InitVal) ->
+%% insert_block(ConstTab, word, [InitVal]).
+
+%% %% @spec (ConstTab::hipe_consttab(), InitVal::integer()) -> {NewTab, Lbl}
+%% %% NewTab = hipe_consttab()
+%% %% Lbl = hipe_constlbl()
+%% %% @doc Inserts a word into the const table.
+%% %% This constant should be exported from the function...
+%% %% <strong>Note</strong> Global constants are
+%% %% not supported in current version of HiPE.
+%% insert_global_word(ConstTab, InitVal) ->
+%% insert_global_block(ConstTab, word_size(), word, [InitVal]).
+
+
+%% @spec (ConstTab::hipe_consttab(),
+%% ElementType::element_type(),
+%% InitList::block()) -> {hipe_consttab(), hipe_constlbl()}
+%% @doc Inserts a block into the const table.
+%% The block can consist of references to labels in the code.
+%% This is used for jump tables. These references should be tracked
+%% and the corresponding BBs should not be considered dead.
+-spec insert_block(hipe_consttab(), element_type(), block()) ->
+ {hipe_consttab(), hipe_constlbl()}.
+insert_block({ConstTab, RefToLabels, NextLabel}, ElementType, InitList) ->
+ ReferredLabels = get_labels(InitList, []),
+ NewRefTo = ReferredLabels ++ RefToLabels,
+ {NewTa, Id} = insert_const({ConstTab, NewRefTo, NextLabel},
+ block, word_size(), false,
+ {ElementType,InitList}),
+ {insert_backrefs(NewTa, Id, ReferredLabels), Id}.
+
+
+%% @spec (ConstTab::hipe_consttab(), ElementType::element_type(),
+%% InitList::block(), SortOrder) -> {hipe_consttab(), hipe_constlbl()}
+%% @doc Inserts a block into the const table.
+%% The block can consist of references to labels in the code.
+%% This is used for jump tables. These references should be tracked
+%% and the corresponding BBs should not be considered dead.
+%% At load-time the block will be sorted according to SortOrder.
+%% This is used to make jump tables on atom indices.
+-spec insert_sorted_block(hipe_consttab(), element_type(), block(), sort_order()) ->
+ {hipe_consttab(), hipe_constlbl()}.
+insert_sorted_block({ConstTab, RefToLabels, NextLabel},
+ ElementType, InitList, SortOrder) ->
+ ReferredLabels = get_labels(InitList, []),
+ NewRefTo = ReferredLabels ++ RefToLabels,
+ {NewTa, Id} = insert_const({ConstTab, NewRefTo, NextLabel},
+ block, word_size(), false,
+ {ElementType, InitList, SortOrder}),
+ {insert_backrefs(NewTa, Id, ReferredLabels), Id}.
+
+insert_backrefs(Tbl, From, ToLabels) ->
+ lists:foldl(fun(To, Tab) ->
+ insert_ref(Tab, From, To)
+ end, Tbl, ToLabels).
+
+insert_ref({Table, RefToLabels, NextLblNr}, From, To) ->
+ Ref = {To, ref},
+ case tree_lookup(Ref, Table) of
+ none ->
+ {tree_insert(Ref, [From], Table), RefToLabels, NextLblNr};
+ {value, RefList} ->
+ {tree_update(Ref, [From|RefList], Table), RefToLabels, NextLblNr}
+ end.
+
+find_refs(To, {Table,_,_}) ->
+ %% returns 'none' or {value, V}
+ tree_lookup({To, ref}, Table).
+
+delete_ref(To, {ConstTab, RefToLabels, NextLabel}) ->
+ {tree_delete({To, ref}, ConstTab), RefToLabels, NextLabel}.
+
+%% TODO: handle refs to labels.
+%% insert_global_block(ConstTab, Align, ElementType, InitList) ->
+%% ByteList = decompose(size_of(ElementType), InitList),
+%% insert_const(ConstTab, block, Align, true, {byte,ByteList}).
+
+get_labels([{label, L}|Rest], Acc) ->
+ get_labels(Rest, [L|Acc]);
+get_labels([I|Rest], Acc) when is_integer(I) ->
+ get_labels(Rest, Acc);
+get_labels([], Acc) ->
+ Acc.
+
+%% @spec size_of(element_type()) -> pos_integer()
+%% @doc Returns the size in bytes of an element_type.
+%% The is_atom/1 guard in the clause handling arrays
+%% constraints the argument to 'byte' | 'word'
+-spec size_of(element_type()) -> pos_integer().
+size_of(byte) -> 1;
+size_of(word) -> word_size();
+size_of({ctab_array,S,N}) when is_atom(S), is_integer(N), N > 0 ->
+ N * size_of(S).
+
+%% @spec decompose({element_type(), block()}) -> [byte()]
+%% @doc Turns a block into a list of bytes.
+%% <strong>Note:</strong> Be careful with the byte order here.
+-spec decompose({element_type(), block()}) -> [byte()].
+decompose({ElementType, Data}) ->
+ decompose(size_of(ElementType), Data).
+
+decompose(_Bytes, []) ->
+ [];
+decompose(Bytes, [X|Xs]) ->
+ number_to_bytes(Bytes, X, decompose(Bytes, Xs)).
+
+number_to_bytes(0, X, Bytes) when is_integer(X) ->
+ Bytes;
+number_to_bytes(N, X, Bytes) ->
+ Byte = X band 255,
+ number_to_bytes(N-1, X bsr 8, [Byte|Bytes]).
+
+%% @spec block_size({element_type(), block()}) -> non_neg_integer()
+%% @doc Returns the size in bytes of a block.
+block_size({ElementType, Block}) ->
+ length(Block) * size_of(ElementType);
+block_size({ElementType, Block, _SortOrder}) ->
+ length(Block) * size_of(ElementType).
+
+
+%%--------------------
+%% ctdata and friends
+%%--------------------
+
+-type ct_type() :: 'block' | 'ref' | 'sorted_block' | 'term'.
+
+-record(ctdata, {type :: ct_type(),
+ alignment :: ct_alignment(),
+ exported :: boolean(),
+ data :: term()}).
+-type ctdata() :: #ctdata{}.
+
+-spec mk_ctdata(Type::ct_type(), Alignment::ct_alignment(),
+ Exported::boolean(), Data::term()) -> ctdata().
+mk_ctdata(Type, Alignment, Exported, Data) ->
+ #ctdata{type = Type, alignment = Alignment, exported = Exported, data = Data}.
+
+-spec const_type(ctdata()) -> ct_type().
+const_type(#ctdata{type = Type}) -> Type.
+
+-spec const_align(ctdata()) -> ct_alignment().
+const_align(#ctdata{alignment = Alignment}) -> Alignment.
+
+-spec const_exported(ctdata()) -> boolean().
+const_exported(#ctdata{exported = Exported}) -> Exported.
+
+-spec const_data(ctdata()) -> term().
+const_data(#ctdata{data = Data}) -> Data.
+
+-spec update_const_data(ctdata(), {_,[_]} | {_,[_],_}) -> ctdata().
+update_const_data(CTData, Data) ->
+ CTData#ctdata{data = Data}.
+
+%% @doc Returns the size in bytes.
+-spec const_size(ctdata()) -> non_neg_integer().
+const_size(Constant) ->
+ case const_type(Constant) of
+ %% term: you can't and shouldn't ask for its size
+ block -> block_size(const_data(Constant));
+ sorted_block -> length(const_data(Constant)) * word_size()
+ end.
+
+-spec word_size() -> ct_alignment().
+word_size() ->
+ hipe_rtl_arch:word_size().
+
+
+%%--------------------
+%% Update a label
+%%--------------------
+
+
+%% TODO: Remove RefsTOfrom overwitten labels...
+%% update_word(ConstTab, Label, InitVal) ->
+%% update_block(ConstTab, Label, word_size(), word, [InitVal]).
+%%
+%% update_global_word(ConstTab, Label, InitVal) ->
+%% update_global_block(ConstTab, Label, word_size(), word, [InitVal]).
+
+%%
+%% Update info for an existing label
+%%
+%% Returns NewTable
+%%
+%%
+%% update_block(ConstTab, Label, Align, ElementType, InitList) ->
+%% ByteList = decompose(size_of(ElementType), InitList),
+%% update_const(ConstTab, Label, block, Align, false, {ElementType,ByteList}).
+
+update_block_labels(ConstTab, DataLbl, OldLbl, NewLbl) ->
+ Const = lookup(DataLbl, ConstTab),
+ Old = {label, OldLbl},
+ case const_data(Const) of
+ {Type, Data} ->
+ NewData = update_data(Data, Old, NewLbl),
+ update(ConstTab, DataLbl, update_const_data(Const, {Type,NewData}));
+ {Type, Data, Order} ->
+ NewData = update_data(Data, Old, NewLbl),
+ update(ConstTab, DataLbl, update_const_data(Const, {Type,NewData,Order}))
+ end.
+
+update_data(Data, Old, New) ->
+ [if Lbl =:= Old -> {label, New}; true -> Lbl end || Lbl <- Data].
+
+%% update_global_block(ConstTab, Label, Align, ElementType, InitList) ->
+%% ByteList = decompose(size_of(ElementType), InitList),
+%% update_const(ConstTab, Label, block, Align, true, ByteList).
+
+%%
+%% Insert a constant in the table, returns {NewTable, Label}.
+%%
+
+insert_const({Table, RefToLabels, NextLblNr}, Type, Alignment, Exported, Data) ->
+ Const = mk_ctdata(Type, Alignment, Exported, Data),
+ {{tree_insert(NextLblNr, Const, Table), RefToLabels, NextLblNr+1},
+ NextLblNr}.
+
+%% %% Update information for a label, returns NewTable.
+%% %% (Removes old info.)
+%%
+%% update_const({Table, RefToLabels, NextLblNr}, Label, Type, Alignment, Exported, Data) ->
+%% Const = mk_ctdata(Type, Alignment, Exported, Data),
+%% {tree_update(Label, Const, Table), RefToLabels, NextLblNr}.
+
+update({Table, RefToLabels, NextLblNr}, Label, NewConst) ->
+ {tree_update(Label, NewConst, Table), RefToLabels, NextLblNr}.
+
+%% @spec lookup(hipe_constlbl(), hipe_consttab()) -> ctdata()
+%% @doc Lookup a label.
+-spec lookup(hipe_constlbl(), hipe_consttab()) -> ctdata().
+lookup(Lbl, {Table, _RefToLabels, _NextLblNr}) ->
+ tree_get(Lbl, Table).
+
+%% Find out if a constant term is present in the constant table.
+lookup_const({Table, _RefToLabels, _NextLblNr},
+ Type, Alignment, Exported, Data) ->
+ Const = mk_ctdata(Type, Alignment, Exported, Data),
+ tree_lookup_key_for_value(Const, Table).
+
+%% @doc Return the labels bound in a table.
+-spec labels(hipe_consttab()) -> [hipe_constlbl() | {hipe_constlbl(), 'ref'}].
+labels({Table, _RefToLabels, _NextLblNr}) ->
+ tree_keys(Table).
+
+%% @spec referred_labels(hipe_consttab()) -> [hipe_constlbl()]
+%% @doc Return the referred labels bound in a table.
+-spec referred_labels(hipe_consttab()) -> [hipe_constlbl()].
+referred_labels({_Table, RefToLabels, _NextLblNr}) ->
+ RefToLabels.
+
+
+%%
+%% Change label names in constant blocks (jump_tables).
+%%
+-spec update_referred_labels(hipe_consttab(),
+ [{hipe_constlbl(), hipe_constlbl()}]) ->
+ hipe_consttab().
+update_referred_labels(Table, LabelMap) ->
+ %% io:format("LabelMap: ~w\nTb:~w\n", [LabelMap, Table]),
+ {Tb, Refs, Next} =
+ lists:foldl(
+ fun({OldLbl, NewLbl}, Tbl) ->
+ case find_refs(OldLbl, Tbl) of
+ none ->
+ Tbl;
+ {value, DataLbls} ->
+ %% A label may be referred several times.
+ UniqueLbls = ordsets:from_list(DataLbls),
+ lists:foldl(fun(DataLbl, AccTbl) ->
+ insert_ref(
+ delete_ref(OldLbl,
+ update_block_labels(AccTbl, DataLbl, OldLbl, NewLbl)),
+ DataLbl, NewLbl)
+ end,
+ Tbl,
+ UniqueLbls)
+ end
+ end,
+ Table,
+ LabelMap),
+ NewRefs = [case lists:keyfind(Lbl, 1, LabelMap) of
+ {_, New} -> New;
+ false -> Lbl
+ end || Lbl <- Refs],
+ %% io:format("NewTb:~w\n", [{Tb, NewRefs, Next}]),
+ {Tb, NewRefs, Next}.
+
+
+%%-----------------------------------------------------------------------------
+%% primitives for constants
+%%-----------------------------------------------------------------------------
+
+%% Since using `gb_trees' is not safe because of term ordering, we use
+%% the `dict' module instead since it matches with =:= on the keys.
+
+tree_keys(T) ->
+ dict:fetch_keys(T).
+
+-spec tree_to_list(dict()) -> [{_, _}].
+tree_to_list(T) ->
+ dict:to_list(T).
+
+tree_get(Key, T) ->
+ dict:fetch(Key, T).
+
+tree_update(Key, Val, T) ->
+ dict:store(Key, Val, T).
+
+tree_insert(Key, Val, T) ->
+ dict:store(Key, Val, T).
+
+tree_delete(Key, T) ->
+ dict:erase(Key, T).
+
+tree_lookup(Key, T) ->
+ case dict:find(Key, T) of
+ {ok, Val} ->
+ {value, Val};
+ error ->
+ none
+ end.
+
+-spec tree_empty() -> dict().
+tree_empty() ->
+ dict:new().
+
+-spec tree_lookup_key_for_value(ctdata(), dict()) -> 'none' | {'value', _}.
+tree_lookup_key_for_value(Val, T) ->
+ tree_lookup_key_for_value_1(tree_to_list(T), Val).
+
+-spec tree_lookup_key_for_value_1([{_,_}], ctdata()) -> 'none' | {'value', _}.
+tree_lookup_key_for_value_1([{Key, Val}|_], Val) ->
+ {value, Key};
+tree_lookup_key_for_value_1([_|Left], Val) ->
+ tree_lookup_key_for_value_1(Left, Val);
+tree_lookup_key_for_value_1([], _Val) ->
+ none.
diff --git a/lib/hipe/misc/hipe_consttab.hrl b/lib/hipe/misc/hipe_consttab.hrl
new file mode 100644
index 0000000000..39018dac34
--- /dev/null
+++ b/lib/hipe/misc/hipe_consttab.hrl
@@ -0,0 +1,27 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------------
+
+-type ct_alignment() :: 4 | 8.
+
+-type hipe_constlbl() :: non_neg_integer().
+-type hipe_consttab() :: {dict(), [hipe_constlbl()], hipe_constlbl()}.
+
+%%-----------------------------------------------------------------------------
diff --git a/lib/hipe/misc/hipe_data_pp.erl b/lib/hipe/misc/hipe_data_pp.erl
new file mode 100644
index 0000000000..0f206e8ade
--- /dev/null
+++ b/lib/hipe/misc/hipe_data_pp.erl
@@ -0,0 +1,158 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% Time-stamp: <2008-04-20 14:57:08 richard>
+%% ====================================================================
+%% Module : hipe_data_pp
+%% Purpose :
+%% Notes :
+%% History : * 2001-02-25 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_data_pp).
+-export([pp/4]).
+
+%%-----------------------------------------------------------------------------
+
+-include("hipe_consttab.hrl").
+
+-type hipe_code_type() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86'.
+
+%%-----------------------------------------------------------------------------
+%%
+%% Pretty print
+
+-spec pp(io:device(), hipe_consttab(), hipe_code_type(), string()) -> 'ok'.
+
+pp(Dev, Table, CodeType, Pre) ->
+ Ls = hipe_consttab:labels(Table),
+ lists:foreach(fun ({{_, ref}, _}) -> ok;
+ ({L, E}) -> pp_element(Dev, L, E, CodeType, Pre)
+ end,
+ [{L, hipe_consttab:lookup(L, Table)} || L <- Ls]).
+
+pp_element(Dev, Name, Element, CodeType, Prefix) ->
+ %% Alignment
+ case hipe_consttab:const_align(Element) of
+ 4 -> ok; %% Wordalignment is assumed
+ Alignment ->
+ io:format(Dev, " .align~w\n", [Alignment])
+ end,
+ %% Local or exported?
+ Exported = hipe_consttab:const_exported(Element),
+ case CodeType of
+ rtl ->
+ case Exported of
+ true ->
+ io:format(Dev, "DL~w: ", [Name]);
+ false ->
+ io:format(Dev, ".DL~w: ", [Name])
+ end;
+ _ ->
+ io:format(Dev, "~w ", [Name])
+ end,
+ %% Type and data...
+ case hipe_consttab:const_type(Element) of
+ term ->
+ io:format(Dev, "~w\n", [hipe_consttab:const_data(Element)]);
+ sorted_block ->
+ Data = hipe_consttab:const_data(Element),
+ pp_block(Dev, {word, lists:sort(Data)}, CodeType, Prefix);
+ block ->
+ pp_block(Dev, hipe_consttab:const_data(Element), CodeType, Prefix)
+ end.
+
+pp_block(Dev, {word, Data, SortOrder}, CodeType, Prefix) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, "\n",[]);
+ _ ->
+ ok
+ end,
+ pp_wordlist(Dev, Data, CodeType, Prefix),
+ case CodeType of
+ rtl ->
+ io:format(Dev, ";; Sorted by ~w\n",[SortOrder]);
+ _ ->
+ ok
+ end;
+pp_block(Dev, {word, Data}, CodeType, Prefix) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, ".word\n",[]);
+ _ ->
+ ok
+ end,
+ pp_wordlist(Dev, Data, CodeType, Prefix);
+pp_block(Dev, {byte, Data}, CodeType, _Prefix) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, ".byte\n ",[]);
+ _ ->
+ ok
+ end,
+ pp_bytelist(Dev, Data, CodeType),
+ case CodeType of
+ rtl ->
+ io:format(Dev, " ;; ~s\n ", [Data]);
+ _ -> ok
+ end.
+
+pp_wordlist(Dev, [{label, L}|Rest], CodeType, Prefix) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, " &L~w\n", [L]);
+ _ ->
+ io:format(Dev, " <~w>\n", [L])
+ end,
+ pp_wordlist(Dev, Rest, CodeType, Prefix);
+pp_wordlist(Dev, [D|Rest], CodeType, Prefix) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, " ~w\n", [D]);
+ _ ->
+ io:format(Dev, " ~w\n", [D])
+ end,
+ pp_wordlist(Dev, Rest, CodeType, Prefix);
+pp_wordlist(_Dev, [], _CodeType, _Prefix) ->
+ ok.
+
+pp_bytelist(Dev, [D], CodeType) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, "~w\n", [D]);
+ _ ->
+ io:format(Dev, "~w\n", [D])
+ end,
+ ok;
+pp_bytelist(Dev, [D|Rest], CodeType) ->
+ case CodeType of
+ rtl ->
+ io:format(Dev, "~w,", [D]);
+ _ ->
+ io:format(Dev, "~w,", [D])
+ end,
+ pp_bytelist(Dev, Rest, CodeType);
+pp_bytelist(Dev, [], _CodeType) ->
+ io:format(Dev, "\n", []).
diff --git a/lib/hipe/misc/hipe_gensym.erl b/lib/hipe/misc/hipe_gensym.erl
new file mode 100644
index 0000000000..84fc8fa7e8
--- /dev/null
+++ b/lib/hipe/misc/hipe_gensym.erl
@@ -0,0 +1,244 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%=======================================================================
+%% File : hipe_gensym.erl
+%% Author : Eric Johansson and Kostis Sagonas
+%% Description : Generates unique symbols and fresh integer counts.
+%%=======================================================================
+%% $Id$
+%%=======================================================================
+%% Notes: Written while we were in Montreal, Canada for PPDP-2000 as an
+%% exercise in Principles and Practice of Declarative Programming!
+%%=======================================================================
+
+-module(hipe_gensym).
+
+-export([%% init/0, new_var/0, new_label/0,
+ %% update_lblrange/1, update_vrange/1, var_range/0, label_range/0,
+ set_var/1, get_var/0, get_next_var/0,
+ set_label/1, get_label/0, get_next_label/0]).
+-export([init/1, new_var/1, new_label/1,
+ update_vrange/2, update_lblrange/2, var_range/1, label_range/1,
+ set_var_range/3, set_label_range/3,
+ set_var/2, get_var/1, get_next_var/1,
+ set_label/2, get_label/1, get_next_label/1]).
+
+%%-----------------------------------------------------------------------
+%% Types of allowable entities to set global variables for
+%%-----------------------------------------------------------------------
+
+-type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86'.
+
+%%-----------------------------------------------------------------------
+
+%% init() ->
+%% put(var_count, 0),
+%% put(label_count, 0),
+%% put(var_min, 0),
+%% put(var_max, 0),
+%% put(lbl_min, 1),
+%% put(lbl_max, 1),
+%% ok.
+
+-spec init(gvarname()) -> 'ok'.
+
+init(What) ->
+ put({What,var_count}, 0),
+ put({What,label_count}, 0),
+ put({What,var_min}, 0),
+ put({What,var_max}, 0),
+ put({What,lbl_min}, 1),
+ put({What,lbl_max}, 1),
+ ok.
+
+%% new_var() ->
+%% V = get(var_count),
+%% put(var_count, V+1),
+%% V.
+
+-spec new_var(gvarname()) -> non_neg_integer().
+
+new_var(What) ->
+ T = {What, var_count},
+ V = get(T),
+ put(T, V+1),
+ V.
+
+%% new_label() ->
+%% L = get(label_count),
+%% put(label_count, L+1),
+%% L.
+
+-spec new_label(gvarname()) -> non_neg_integer().
+
+new_label(What) ->
+ T = {What, label_count},
+ L = get(T),
+ put(T, L+1),
+ L.
+
+%% update_vrange(V) ->
+%% Vmax = get(var_max),
+%% Vmin = get(var_min),
+%% put(var_min, erlang:min(V, Vmin)),
+%% put(var_max, erlang:max(V, Vmax)),
+%% ok.
+
+-spec update_vrange(gvarname(), non_neg_integer()) -> 'ok'.
+update_vrange(What, V) ->
+ Tmin = {What, var_min},
+ Tmax = {What, var_max},
+ Vmax = get(Tmax),
+ Vmin = get(Tmin),
+ put(Tmin, erlang:min(V, Vmin)),
+ put(Tmax, erlang:max(V, Vmax)),
+ ok.
+
+%% update_lblrange(L) ->
+%% Lmax = get(lbl_max),
+%% Lmin = get(lbl_min),
+%% put(lbl_min, erlang:min(L, Lmin)),
+%% put(lbl_max, erlang:max(L, Lmax)),
+%% ok.
+
+-spec update_lblrange(gvarname(), non_neg_integer()) -> 'ok'.
+
+update_lblrange(What, L) ->
+ Tmin = {What, lbl_min},
+ Tmax = {What, lbl_max},
+ Lmax = get(Tmax),
+ Lmin = get(Tmin),
+ put(Tmin, erlang:min(L, Lmin)),
+ put(Tmax, erlang:max(L, Lmax)),
+ ok.
+
+%% var_range() ->
+%% {get(var_min), get(var_max)}.
+
+-spec var_range(gvarname()) -> {non_neg_integer(), non_neg_integer()}.
+
+var_range(What) ->
+ {get({What,var_min}), get({What,var_max})}.
+
+-spec set_var_range(gvarname(), non_neg_integer(), non_neg_integer()) -> 'ok'.
+
+set_var_range(What, Min, Max) ->
+ put({What,var_min}, Min),
+ put({What,var_max}, Max),
+ ok.
+
+%% label_range() ->
+%% {get(lbl_min), get(lbl_max)}.
+
+-spec label_range(gvarname()) -> {non_neg_integer(), non_neg_integer()}.
+
+label_range(What) ->
+ {get({What,lbl_min}), get({What,lbl_max})}.
+
+-spec set_label_range(gvarname(), non_neg_integer(), non_neg_integer()) -> 'ok'.
+
+set_label_range(What, Min, Max) ->
+ put({What,lbl_min}, Min),
+ put({What,lbl_max}, Max),
+ ok.
+
+%%-----------------------------------------------------------------------
+%% Variable counter
+%%-----------------------------------------------------------------------
+
+-spec set_var(non_neg_integer()) -> 'ok'.
+
+set_var(X) ->
+ put(var_max, X),
+ ok.
+
+-spec set_var(gvarname(), non_neg_integer()) -> 'ok'.
+
+set_var(What, X) ->
+ put({What,var_max}, X),
+ ok.
+
+-spec get_var() -> non_neg_integer().
+
+get_var() ->
+ get(var_max).
+
+-spec get_var(gvarname()) -> non_neg_integer().
+
+get_var(What) ->
+ get({What,var_max}).
+
+-spec get_next_var() -> non_neg_integer().
+
+get_next_var() ->
+ C = get(var_max),
+ put(var_max, C+1),
+ C+1.
+
+-spec get_next_var(gvarname()) -> non_neg_integer().
+
+get_next_var(What) ->
+ T = {What, var_max},
+ C = get(T),
+ put(T, C+1),
+ C+1.
+
+%%-----------------------------------------------------------------------
+%% Label counter
+%%-----------------------------------------------------------------------
+
+-spec set_label(non_neg_integer()) -> 'ok'.
+
+set_label(X) ->
+ put(lbl_max, X),
+ ok.
+
+-spec set_label(gvarname(), non_neg_integer()) -> 'ok'.
+
+set_label(What, X) ->
+ put({What,lbl_max}, X),
+ ok.
+
+-spec get_label() -> non_neg_integer().
+
+get_label() ->
+ get(lbl_max).
+
+-spec get_label(gvarname()) -> non_neg_integer().
+
+get_label(What) ->
+ get({What,lbl_max}).
+
+-spec get_next_label() -> non_neg_integer().
+
+get_next_label() ->
+ C = get(lbl_max),
+ put(lbl_max, C+1),
+ C+1.
+
+-spec get_next_label(gvarname()) -> non_neg_integer().
+
+get_next_label(What) ->
+ T = {What, lbl_max},
+ C = get(T),
+ put(T, C+1),
+ C+1.
+
+%%-----------------------------------------------------------------------
diff --git a/lib/hipe/misc/hipe_pack_constants.erl b/lib/hipe/misc/hipe_pack_constants.erl
new file mode 100644
index 0000000000..e214d7ebbc
--- /dev/null
+++ b/lib/hipe/misc/hipe_pack_constants.erl
@@ -0,0 +1,211 @@
+%% -*- erlang-indent-level: 2 -*-
+%%=============================================================================
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_pack_constants).
+-export([pack_constants/2, slim_refs/1, slim_constmap/1]).
+
+-include("hipe_consttab.hrl").
+-include("../../kernel/src/hipe_ext_format.hrl").
+
+%%-----------------------------------------------------------------------------
+
+-type raw_data() :: binary() | number() | list() | tuple().
+-type tbl_ref() :: {hipe_constlbl(), non_neg_integer()}.
+
+-record(pcm_entry, {mfa :: mfa(),
+ label :: hipe_constlbl(),
+ const_num :: non_neg_integer(),
+ start :: non_neg_integer(),
+ type :: 0 | 1 | 2,
+ raw_data :: raw_data()}).
+
+%%-----------------------------------------------------------------------------
+
+-spec pack_constants([{mfa(),[_],hipe_consttab()}], ct_alignment()) ->
+ {ct_alignment(),
+ non_neg_integer(),
+ [#pcm_entry{}],
+ [{mfa(),[tbl_ref() | {'sorted',non_neg_integer(),[tbl_ref()]}]}]}.
+
+pack_constants(Data, Align) ->
+ pack_constants(Data, 0, Align, 0, [], []).
+
+pack_constants([{MFA,_,ConstTab}|Rest], Size, Align, ConstNo, Acc, Refs) ->
+ Labels = hipe_consttab:labels(ConstTab),
+ %% RefToLabels = hipe_consttab:referred_labels(ConstTab),
+ {NewSize, NewAlign, Map, NewConstNo, RefToLabels} =
+ pack_labels(Labels, MFA, ConstTab, Size, Align, ConstNo, Acc, []),
+ NewRefs =
+ case RefToLabels of
+ [] -> Refs;
+ _ -> [{MFA,RefToLabels}|Refs]
+ end,
+ pack_constants(Rest, NewSize, NewAlign, NewConstNo, Map, NewRefs);
+pack_constants([], Size, Align, _, Acc, Refs) ->
+ {Align, Size, Acc, Refs}.
+
+%%
+%% pack_labels converts a ConstTab to a packed ConstMap, which
+%% maps {MFA,Label} pairs to information about individual constants,
+%% including their ConstNo and start offset in the constants pool.
+%%
+pack_labels([{_Label,ref}|Labels],MFA,ConstTab,Size,Align,ConstNo,Acc, Refs) ->
+ pack_labels(Labels, MFA, ConstTab, Size, Align, ConstNo, Acc, Refs);
+pack_labels([Label|Labels],MFA,ConstTab,AccSize,OldAlign,ConstNo, Acc, Refs) ->
+ Const = hipe_consttab:lookup(Label, ConstTab),
+ Align = hipe_consttab:const_align(Const),
+ NewAlign = erlang:max(Align, OldAlign),
+ Start =
+ case AccSize rem Align of
+ 0 -> AccSize;
+ N -> AccSize + (Align - N)
+ end,
+ %% io:format("Const ~w\n", [Const]),
+ RawType = hipe_consttab:const_type(Const),
+ Type = ?CONST_TYPE2EXT(RawType),
+ RawData = hipe_consttab:const_data(Const),
+ case RawType of
+ term ->
+ %% If the constant term is already in the constant map we want
+ %% to use the same constant number so that, in the end, the
+ %% constant term is not duplicated.
+ case lists:keyfind(RawData, 7, Acc) of
+ false ->
+ NewInfo = #pcm_entry{mfa=MFA, label=Label, const_num=ConstNo,
+ start=0, type=Type, raw_data=RawData},
+ pack_labels(Labels, MFA, ConstTab, AccSize, OldAlign, ConstNo+1,
+ [NewInfo|Acc], Refs);
+ #pcm_entry{const_num=OtherConstNo, type=Type, raw_data=RawData} ->
+ NewInfo = #pcm_entry{mfa=MFA, label=Label, const_num=OtherConstNo,
+ start=0, type=Type, raw_data=RawData},
+ pack_labels(Labels, MFA, ConstTab, AccSize, OldAlign, ConstNo,
+ [NewInfo|Acc], Refs);
+ _ ->
+ NewInfo = #pcm_entry{mfa=MFA, label=Label, const_num=ConstNo,
+ start=0, type=Type, raw_data=RawData},
+ pack_labels(Labels, MFA, ConstTab, AccSize, OldAlign, ConstNo+1,
+ [NewInfo|Acc], Refs)
+ end;
+ sorted_block ->
+ Need = hipe_consttab:const_size(Const),
+ NewInfo = #pcm_entry{mfa=MFA, label=Label, const_num=ConstNo,
+ start=Start, type=Type, raw_data=RawData},
+ pack_labels(Labels, MFA, ConstTab, Start+Need, NewAlign, ConstNo+1,
+ [NewInfo|Acc], Refs);
+ block ->
+ Need = hipe_consttab:const_size(Const),
+ {Data, NewRefs} =
+ case RawData of
+ {ElementType, ElementData} ->
+ decompose_block(ElementType, ElementData, Start);
+ {ElementType, ElementData, SortOrder} ->
+ {TblData, TblRefs} = get_sorted_refs(ElementData, SortOrder),
+ {hipe_consttab:decompose({ElementType, TblData}),
+ [{sorted,Start,TblRefs}]}
+ end,
+ NewInfo = #pcm_entry{mfa=MFA, label=Label, const_num=ConstNo,
+ start=Start, type=Type, raw_data=Data},
+ pack_labels(Labels, MFA, ConstTab, Start+Need, NewAlign, ConstNo+1,
+ [NewInfo|Acc], NewRefs++Refs)
+ end;
+pack_labels([], _, _, Size, Align, ConstNo, Acc, Refs) ->
+ {Size, Align, Acc, ConstNo, Refs}.
+
+decompose_block(ElementType, Data, Addr) ->
+ ElementSize = hipe_consttab:size_of(ElementType),
+ {NewData, Refs} = get_refs(Data, Addr, ElementSize),
+ {hipe_consttab:decompose({ElementType, NewData}), Refs}.
+
+get_refs([{label,L}|Rest], Pos, ElementSize) ->
+ {NewData, Refs} = get_refs(Rest, Pos+ElementSize, ElementSize),
+ {[0|NewData], [{L,Pos}|Refs]};
+get_refs([D|Rest], Pos, ElementSize) ->
+ {NewData, Refs} = get_refs(Rest, Pos+ElementSize, ElementSize),
+ {[D|NewData], Refs};
+get_refs([], _, _) ->
+ {[],[]}.
+
+get_sorted_refs([{label,L}|Rest], [Ordering|Os]) ->
+ {NewData, Refs} = get_sorted_refs(Rest, Os),
+ {[0|NewData], [{L,Ordering}|Refs]};
+get_sorted_refs([D|Rest], [_Ordering|Os]) ->
+ {NewData, Refs} = get_sorted_refs(Rest, Os),
+ {[D|NewData], Refs};
+get_sorted_refs([], []) ->
+ {[], []}.
+
+-type ref_type() :: 0..4.
+
+-spec slim_refs([{ref_type(),non_neg_integer(),term()}]) ->
+ [{ref_type(), [{term(), [non_neg_integer()]}]}].
+slim_refs([]) -> [];
+slim_refs(Refs) ->
+ [Ref|Rest] = lists:keysort(1, Refs),
+ compact_ref_types(Rest, element(1, Ref), [Ref], []).
+
+compact_ref_types([Ref|Refs], Type, AccofType, Acc) ->
+ case element(1, Ref) of
+ Type ->
+ compact_ref_types(Refs, Type, [Ref|AccofType], Acc);
+ NewType ->
+ compact_ref_types(Refs, NewType, [Ref],
+ [{Type,lists:sort(compact_dests(AccofType))}|Acc])
+ end;
+compact_ref_types([], Type, AccofType ,Acc) ->
+ [{Type,lists:sort(compact_dests(AccofType))}|Acc].
+
+
+%% compact_dests([]) -> []; % clause is redundant
+compact_dests(Refs) ->
+ [Ref|Rest] = lists:keysort(3, Refs),
+ compact_dests(Rest, element(3,Ref), [element(2,Ref)], []).
+
+compact_dests([Ref|Refs], Dest, AccofDest, Acc) ->
+ case element(3, Ref) of
+ Dest ->
+ compact_dests(Refs, Dest, [element(2,Ref)|AccofDest], Acc);
+ NewDest ->
+ compact_dests(Refs, NewDest, [element(2,Ref)], [{Dest,AccofDest}|Acc])
+ end;
+compact_dests([], Dest, AccofDest, Acc) ->
+ [{Dest,AccofDest}|Acc].
+
+%%
+%% slim_constmap/1 takes a packed ConstMap, as produced by pack_labels
+%% called from hipe_pack_constants:pack_constants/2, and converts it
+%% to the slimmed and flattened format ConstMap which is put in object
+%% files.
+%%
+-spec slim_constmap([#pcm_entry{}]) -> [raw_data()].
+slim_constmap(Map) ->
+ slim_constmap(Map, gb_sets:new(), []).
+
+-spec slim_constmap([#pcm_entry{}], gb_set(), [raw_data()]) -> [raw_data()].
+slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset,
+ type=Type, raw_data=Term}|Rest], Inserted, Acc) ->
+ case gb_sets:is_member(ConstNo, Inserted) of
+ true ->
+ slim_constmap(Rest, Inserted, Acc);
+ false ->
+ NewInserted = gb_sets:insert(ConstNo, Inserted),
+ slim_constmap(Rest, NewInserted, [ConstNo, Offset, Type, Term|Acc])
+ end;
+slim_constmap([], _Inserted, Acc) -> Acc.
diff --git a/lib/hipe/misc/hipe_sdi.erl b/lib/hipe/misc/hipe_sdi.erl
new file mode 100644
index 0000000000..ef1b5b48c5
--- /dev/null
+++ b/lib/hipe/misc/hipe_sdi.erl
@@ -0,0 +1,378 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%======================================================================
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% An implementation of the algorithm described in:
+%%% "Assembling Code for Machines with Span-Dependent Instructions",
+%%% Thomas G. Szymanski, CACM 21(4), April 1978, pp. 300--308.
+%%%
+%%% Copyright (C) 2000, 2004, 2007 Mikael Pettersson
+
+-module(hipe_sdi).
+-export([pass1_init/0,
+ pass1_add_label/3,
+ pass1_add_sdi/4,
+ pass2/1]).
+
+-include("hipe_sdi.hrl").
+
+%%------------------------------------------------------------------------
+
+-type hipe_array() :: integer(). % declare this in hipe.hrl or builtin?
+
+-type label() :: non_neg_integer().
+-type address() :: non_neg_integer().
+
+%%------------------------------------------------------------------------
+
+-record(label_data, {address :: address(),
+ prevSdi :: integer()}).
+
+-record(pre_sdi_data, {address :: address(),
+ label :: label(),
+ si :: #sdi_info{}}).
+
+-record(pass1, {prevSdi :: integer(),
+ preS = [] :: [#pre_sdi_data{}],
+ labelMap = gb_trees:empty() :: gb_tree()}).
+
+-record(sdi_data, {address :: address(),
+ label_address :: address(),
+ prevSdi :: integer(), %% -1 is the first previous
+ si :: #sdi_info{}}).
+
+%%------------------------------------------------------------------------
+
+%%% "During the first pass we assign addresses to instructions
+%%% and build a symbol table of labels and their addresses
+%%% according to the minimum address assignment. We do this by
+%%% treating each sdi as having its shorter length. We also
+%%% number the sdi's [sic] from 1 to n in order of occurrence
+%%% and record in the symbol table entry for each label the
+%%% number of sdi's [sic] preceding it in the program.
+%%% Simultaneously with pass 1 we build a set
+%%% S = {(i,a,l,c) | 1 <= i <= n, a is the minimum address of
+%%% the ith sdi, l and c, are the label and constant
+%%% components of the operand of the ith sdi respectively}."
+%%%
+%%% Implementation notes:
+%%% - We number the SDIs from 0 to n-1, not from 1 to n.
+%%% - SDIs target only labels, so the constant offsets are omitted.
+%%% - The set S is represented by a vector S[0..n-1] such that if
+%%% (i,a,l) is in the set, then S[i] = (a,l).
+%%% - The symbol table maps a label to its minimum address and the
+%%% number of the last SDI preceding it (-1 if none).
+%%% - To allow this module to make architecture-specific decisions
+%%% without using callbacks or making it architecture-specific,
+%%% the elements in the set S include a fourth component, SdiInfo,
+%%% supplied by the caller of this module.
+%%% - At the end of the first pass we finalise the preliminary SDIs
+%%% by replacing their symbolic target labels with the corresponding
+%%% data from the symbol table. This avoids repeated O(logn) time
+%%% lookup costs for the labels.
+
+-spec pass1_init() -> #pass1{}.
+pass1_init() ->
+ #pass1{prevSdi = -1}.
+
+-spec pass1_add_label(#pass1{}, non_neg_integer(), label()) -> #pass1{}.
+pass1_add_label(Pass1, Address, Label) ->
+ #pass1{prevSdi=PrevSdi, labelMap=LabelMap} = Pass1,
+ LabelData = #label_data{address=Address, prevSdi=PrevSdi},
+ LabelMap2 = gb_trees:insert(Label, LabelData, LabelMap),
+ Pass1#pass1{labelMap=LabelMap2}.
+
+-spec pass1_add_sdi(#pass1{}, non_neg_integer(), label(), #sdi_info{}) ->
+ #pass1{}.
+pass1_add_sdi(Pass1, Address, Label, SdiInfo) ->
+ #pass1{prevSdi=PrevSdi, preS=PreS} = Pass1,
+ PreSdiData = #pre_sdi_data{address=Address, label=Label, si=SdiInfo},
+ Pass1#pass1{prevSdi=PrevSdi+1, preS=[PreSdiData|PreS]}.
+
+-spec pass1_finalise(#pass1{}) -> {non_neg_integer(),tuple(),gb_tree()}.
+pass1_finalise(#pass1{prevSdi=PrevSdi, preS=PreS, labelMap=LabelMap}) ->
+ {PrevSdi+1, pass1_finalise_preS(PreS, LabelMap, []), LabelMap}.
+
+-spec pass1_finalise_preS([#pre_sdi_data{}], gb_tree(), [#sdi_data{}]) ->
+ tuple().
+pass1_finalise_preS([], _LabelMap, S) -> vector_from_list(S);
+pass1_finalise_preS([PreSdiData|PreS], LabelMap, S) ->
+ #pre_sdi_data{address=Address, label=Label, si=SdiInfo} = PreSdiData,
+ LabelData = gb_trees:get(Label, LabelMap),
+ #label_data{address=LabelAddress, prevSdi=PrevSdi} = LabelData,
+ SdiData = #sdi_data{address=Address, label_address=LabelAddress,
+ prevSdi=PrevSdi, si=SdiInfo},
+ pass1_finalise_preS(PreS, LabelMap, [SdiData|S]).
+
+%%% Pass2.
+
+-spec pass2(#pass1{}) -> {gb_tree(), non_neg_integer()}.
+pass2(Pass1) ->
+ {N,SDIS,LabelMap} = pass1_finalise(Pass1),
+ LONG = mk_long(N),
+ SPAN = mk_span(N, SDIS),
+ PARENTS = mk_parents(N, SDIS),
+ update_long(N, SDIS, SPAN, PARENTS, LONG),
+ {INCREMENT,CodeSizeIncr} = mk_increment(N, LONG),
+ {adjust_label_map(LabelMap, INCREMENT), CodeSizeIncr}.
+
+%%% "Between passes 1 and 2 we will construct an integer table
+%%% LONG[1:n] such that LONG[i] is nonzero if and only if the
+%%% ith sdi must be given a long form translation. Initially
+%%% LONG[i] is zero for all i."
+%%%
+%%% Implementation notes:
+%%% - LONG is an integer array indexed from 0 to N-1.
+
+-spec mk_long(non_neg_integer()) -> hipe_array().
+mk_long(N) ->
+ mk_array_of_zeros(N).
+
+%%% "At the heart of our algorithm is a graphical representation
+%%% of the interdependencies of the sdi's [sic] of the program.
+%%% For each sdi we construct a node containing the empty span
+%%% of that instruction. Nodes of this graph will be referred to
+%%% by the number of the sdi to which they correspond. Directed
+%%% arcs are now added to the graph so that i->j is an arc if
+%%% and only if the span of the ith sdi depends on the size of
+%%% the jth sdi, that is, the jth sdi lies between the ith sdi
+%%% and the label occurring in its operand. It is easy to see
+%%% that the graph we have just described can be constructed from
+%%% the information present in the set S and the symbol table.
+%%%
+%%% The significance if this graph is that sizes can be assigned
+%%% to the sdi's [sic] of the program so that the span of the ith
+%%% sdi is equal to the number appearing in node i if and only if
+%%% all the children of i can be given short translations."
+%%%
+%%% Implementation notes:
+%%% - The nodes are represented by an integer array SPAN[0..n-1]
+%%% such that SPAN[i] contains the current span of sdi i.
+%%% - Since the graph is traversed from child to parent nodes in
+%%% Step 3, the edges are represented by a vector PARENTS[0..n-1]
+%%% such that PARENTS[j] = { i | i is a parent of j }.
+%%% - An explicit PARENTS graph would have size O(n^2). Instead we
+%%% compute PARENTS[j] from the SDI vector when needed. This
+%%% reduces memory overheads, and may reduce time overheads too.
+
+-spec mk_span(non_neg_integer(), tuple()) -> hipe_array().
+mk_span(N, SDIS) ->
+ initSPAN(0, N, SDIS, mk_array_of_zeros(N)).
+
+-spec initSPAN(non_neg_integer(), non_neg_integer(),
+ tuple(), hipe_array()) -> hipe_array().
+initSPAN(SdiNr, N, SDIS, SPAN) ->
+ if SdiNr >= N -> SPAN;
+ true ->
+ SdiData = vector_sub(SDIS, SdiNr),
+ #sdi_data{address=SdiAddress, label_address=LabelAddress} = SdiData,
+ SdiSpan = LabelAddress - SdiAddress,
+ array_update(SPAN, SdiNr, SdiSpan),
+ initSPAN(SdiNr+1, N, SDIS, SPAN)
+ end.
+
+mk_parents(N, SDIS) -> {N,SDIS}.
+
+%%% "After the structure is built we process it as follows.
+%%% For any node i whose listed span exceeds the architectural
+%%% limit for a short form instruction, the LONG[i] equal to
+%%% the difference between the long and short forms of the ith
+%%% sdi. Increment the span of each parent of i by LONG[i] if
+%%% the parent precedes the child in the program. Otherwise,
+%%% decrement the span of the parent by LONG[i]. Finally, remove
+%%% node i from the graph. Clearly this process must terminate.
+%%% Any nodes left in the final graph correspond to sdi's [sic]
+%%% which can be translated in the short form."
+%%%
+%%% Implementation notes:
+%%% - We use a simple worklist algorithm, operating on a set
+%%% of SDIs known to require long form.
+%%% - A node is removed from the graph by setting its span to zero.
+%%% - The result is the updated LONG array. Afterwards, S, SPAN,
+%%% and PARENTS are no longer useful.
+
+-spec update_long(non_neg_integer(), tuple(), hipe_array(),
+ {non_neg_integer(),tuple()},hipe_array()) -> 'ok'.
+update_long(N, SDIS, SPAN, PARENTS, LONG) ->
+ WKL = initWKL(N-1, SDIS, SPAN, []),
+ processWKL(WKL, SDIS, SPAN, PARENTS, LONG).
+
+-spec initWKL(integer(), tuple(),
+ hipe_array(), [non_neg_integer()]) -> [non_neg_integer()].
+initWKL(SdiNr, SDIS, SPAN, WKL) ->
+ if SdiNr < 0 -> WKL;
+ true ->
+ SdiSpan = array_sub(SPAN, SdiNr),
+ WKL2 = updateWKL(SdiNr, SDIS, SdiSpan, WKL),
+ initWKL(SdiNr-1, SDIS, SPAN, WKL2)
+ end.
+
+-spec processWKL([non_neg_integer()], tuple(), hipe_array(),
+ {non_neg_integer(), tuple()}, hipe_array()) -> 'ok'.
+processWKL([], _SDIS, _SPAN, _PARENTS, _LONG) -> ok;
+processWKL([Child|WKL], SDIS, SPAN, PARENTS, LONG) ->
+ WKL2 = updateChild(Child, WKL, SDIS, SPAN, PARENTS, LONG),
+ processWKL(WKL2, SDIS, SPAN, PARENTS, LONG).
+
+-spec updateChild(non_neg_integer(), [non_neg_integer()], tuple(), hipe_array(),
+ {non_neg_integer(),tuple()}, hipe_array()) -> [non_neg_integer()].
+updateChild(Child, WKL, SDIS, SPAN, PARENTS, LONG) ->
+ case array_sub(SPAN, Child) of
+ 0 -> WKL; % removed
+ _ ->
+ SdiData = vector_sub(SDIS, Child),
+ Incr = sdiLongIncr(SdiData),
+ array_update(LONG, Child, Incr),
+ array_update(SPAN, Child, 0), % remove child
+ PS = parentsOfChild(PARENTS, Child),
+ updateParents(PS, Child, Incr, SDIS, SPAN, WKL)
+ end.
+
+-spec parentsOfChild({non_neg_integer(),tuple()},
+ non_neg_integer()) -> [non_neg_integer()].
+parentsOfChild({N,SDIS}, Child) ->
+ parentsOfChild(N-1, SDIS, Child, []).
+
+-spec parentsOfChild(integer(), tuple(), non_neg_integer(),
+ [non_neg_integer()]) -> [non_neg_integer()].
+parentsOfChild(-1, _SDIS, _Child, PS) -> PS;
+parentsOfChild(SdiNr, SDIS, Child, PS) ->
+ SdiData = vector_sub(SDIS, SdiNr),
+ #sdi_data{prevSdi=PrevSdi} = SdiData,
+ {LO,HI} = % inclusive
+ if SdiNr =< PrevSdi -> {SdiNr+1, PrevSdi}; % forwards
+ true -> {PrevSdi+1, SdiNr-1} % backwards
+ end,
+ NewPS =
+ if LO =< Child, Child =< HI -> [SdiNr | PS];
+ true -> PS
+ end,
+ parentsOfChild(SdiNr-1, SDIS, Child, NewPS).
+
+-spec updateParents([non_neg_integer()], non_neg_integer(),
+ byte(), tuple(), hipe_array(),
+ [non_neg_integer()]) -> [non_neg_integer()].
+updateParents([], _Child, _Incr, _SDIS, _SPAN, WKL) -> WKL;
+updateParents([P|PS], Child, Incr, SDIS, SPAN, WKL) ->
+ WKL2 = updateParent(P, Child, Incr, SDIS, SPAN, WKL),
+ updateParents(PS, Child, Incr, SDIS, SPAN, WKL2).
+
+-spec updateParent(non_neg_integer(), non_neg_integer(),
+ byte(), tuple(), hipe_array(),
+ [non_neg_integer()]) -> [non_neg_integer()].
+updateParent(Parent, Child, Incr, SDIS, SPAN, WKL) ->
+ case array_sub(SPAN, Parent) of
+ 0 -> WKL; % removed
+ OldSpan ->
+ NewSpan =
+ if Parent < Child -> OldSpan + Incr;
+ true -> OldSpan - Incr
+ end,
+ array_update(SPAN, Parent, NewSpan),
+ updateWKL(Parent, SDIS, NewSpan, WKL)
+ end.
+
+-spec updateWKL(non_neg_integer(), tuple(),
+ integer(), [non_neg_integer()]) -> [non_neg_integer()].
+updateWKL(SdiNr, SDIS, SdiSpan, WKL) ->
+ case sdiSpanIsShort(vector_sub(SDIS, SdiNr), SdiSpan) of
+ true -> WKL;
+ false -> [SdiNr|WKL]
+ end.
+
+-spec sdiSpanIsShort(#sdi_data{}, integer()) -> boolean().
+sdiSpanIsShort(#sdi_data{si = #sdi_info{lb = LB, ub = UB}}, SdiSpan) ->
+ SdiSpan >= LB andalso SdiSpan =< UB.
+
+-spec sdiLongIncr(#sdi_data{}) -> byte().
+sdiLongIncr(#sdi_data{si = #sdi_info{incr = Incr}}) -> Incr.
+
+%%% "Now construct a table INCREMENT[0:n] by defining
+%%% INCREMENT[0] = 0 and INCREMENT[i] = INCREMENT[i-1]+LONG[i]
+%%% for 1 <= i <= n. INCREMENT[i] represents the total increase
+%%% in size of the first i sdi's [sic] in the program."
+%%%
+%%% Implementation notes:
+%%% - INCREMENT is an integer vector indexed from 0 to n-1.
+%%% INCREMENT[i] = SUM(0 <= j <= i)(LONG[j]), for 0 <= i < n.
+%%% - Due to the lack of an SML-like Array.extract operation,
+%%% INCREMENT is an array, not an immutable vector.
+
+-spec mk_increment(non_neg_integer(), hipe_array()) ->
+ {hipe_array(), non_neg_integer()}.
+mk_increment(N, LONG) ->
+ initINCR(0, 0, N, LONG, mk_array_of_zeros(N)).
+
+-spec initINCR(non_neg_integer(), non_neg_integer(), non_neg_integer(),
+ hipe_array(), hipe_array()) -> {hipe_array(), non_neg_integer()}.
+initINCR(SdiNr, PrevIncr, N, LONG, INCREMENT) ->
+ if SdiNr >= N -> {INCREMENT, PrevIncr};
+ true ->
+ SdiIncr = PrevIncr + array_sub(LONG, SdiNr),
+ array_update(INCREMENT, SdiNr, SdiIncr),
+ initINCR(SdiNr+1, SdiIncr, N, LONG, INCREMENT)
+ end.
+
+%%% "At this point we can adjust the addresses of each label L
+%%% in the symbol table. If L is preceded by i sdi's [sic] in
+%%% the program, then add INCREMENT[i] to the value of L in the
+%%% symbol table."
+%%%
+%%% Implementation notes:
+%%% - Due to the 0..n-1 SDI numbering, a label L with address
+%%% a and previous sdi i is remapped to a+incr(i), where
+%%% incr(i) = if i < 0 then 0 else INCREMENT[i].
+
+-spec adjust_label_map(gb_tree(), hipe_array()) -> gb_tree().
+adjust_label_map(LabelMap, INCREMENT) ->
+ applyIncr(gb_trees:to_list(LabelMap), INCREMENT, gb_trees:empty()).
+
+-type label_pair() :: {label(), #label_data{}}.
+
+-spec applyIncr([label_pair()], hipe_array(), gb_tree()) -> gb_tree().
+applyIncr([], _INCREMENT, LabelMap) -> LabelMap;
+applyIncr([{Label,LabelData}|List], INCREMENT, LabelMap) ->
+ #label_data{address=Address, prevSdi=PrevSdi} = LabelData,
+ Incr =
+ if PrevSdi < 0 -> 0;
+ true -> array_sub(INCREMENT, PrevSdi)
+ end,
+ applyIncr(List, INCREMENT, gb_trees:insert(Label, Address+Incr, LabelMap)).
+
+%%% ADT for immutable vectors, indexed from 0 to N-1.
+%%% Currently implemented as tuples.
+%%% Used for the 'SDIS' and 'PARENTS' vectors.
+
+-spec vector_from_list([#sdi_data{}]) -> tuple().
+vector_from_list(Values) -> list_to_tuple(Values).
+
+vector_sub(Vec, I) -> element(I+1, Vec).
+
+%%% ADT for mutable integer arrays, indexed from 0 to N-1.
+%%% Currently implemented as HiPE arrays.
+%%% Used for the 'LONG', 'SPAN', and 'INCREMENT' arrays.
+
+-spec mk_array_of_zeros(non_neg_integer()) -> hipe_array().
+mk_array_of_zeros(N) -> hipe_bifs:array(N, 0).
+
+-spec array_update(hipe_array(), non_neg_integer(), integer()) -> hipe_array().
+array_update(A, I, V) -> hipe_bifs:array_update(A, I, V).
+
+-spec array_sub(hipe_array(), non_neg_integer()) -> integer().
+array_sub(A, I) -> hipe_bifs:array_sub(A, I).
diff --git a/lib/hipe/misc/hipe_sdi.hrl b/lib/hipe/misc/hipe_sdi.hrl
new file mode 100644
index 0000000000..f89cae1529
--- /dev/null
+++ b/lib/hipe/misc/hipe_sdi.hrl
@@ -0,0 +1,25 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-record(sdi_info,
+ {lb :: integer(), % span lower bound for short form
+ ub :: integer(), % span upper bound for short form
+ incr :: byte()}). % instruction size increase for long form
diff --git a/lib/hipe/native.mk b/lib/hipe/native.mk
new file mode 100644
index 0000000000..6f4602477b
--- /dev/null
+++ b/lib/hipe/native.mk
@@ -0,0 +1,5 @@
+ifndef SECONDARY_BOOTSTRAP
+ifeq ($(NATIVE_LIBS_ENABLED),yes)
+ERL_COMPILE_FLAGS += +native
+endif
+endif
diff --git a/lib/hipe/opt/Makefile b/lib/hipe/opt/Makefile
new file mode 100644
index 0000000000..972cf63944
--- /dev/null
+++ b/lib/hipe/opt/Makefile
@@ -0,0 +1,101 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = hipe_spillmin hipe_spillmin_color hipe_spillmin_scan
+
+HRL_FILES=
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+$(EBIN)/hipe_spillmin.beam: ../main/hipe.hrl ../flow/cfg.hrl
+$(EBIN)/hipe_spillmin_color.beam: ../main/hipe.hrl ../flow/cfg.hrl
+$(EBIN)/hipe_spillmin_scan.beam: ../main/hipe.hrl ../flow/cfg.hrl
diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl
new file mode 100644
index 0000000000..4925b2927b
--- /dev/null
+++ b/lib/hipe/opt/hipe_schedule.erl
@@ -0,0 +1,1489 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% INSTRUCTION SCHEDULER
+%%
+%% This is a basic ILP cycle scheduler:
+%% * set cycle = 0
+%% * while ready[cycle] nonempty do
+%% - take x with greatest priority from ready[cycle]
+%% - try to schedule x;
+%% * if scheduling x was possible,
+%% - reserve resources
+%% - add x to schedule and delete x from dag
+%% - update earliest-time for all successor nodes
+%% as max[earliest[y],cycle+latency[x]]
+%% - if some node y now has no predecessors,
+%% add y to ready[earliest[y]]
+%% * if it was impossible, put x in ready[cycle+1]
+%% (= try again)
+%%
+%% We use the following data structures:
+%% 1. all nodes are numbered and indices used as array keys
+%% 2. priority per node can be computed statically or dynamically
+%% * statically: before scheduling, each node gets a priority value
+%% * dynamically: at each cycle, compute priorities for all ready nodes
+%% 3. earliest: earliest cycle of issue, starts at 0
+%% and is updated as predecessors issue
+%% 4. predecessors: number of predecessors (0 = ready to issue)
+%% 5. successors: list of {Latency,NodeID}
+%% 6. ready: an array indexed by cycle-time (integer), where
+%% ready nodes are kept.
+%% 7. resources: a resource representation (ADT) that answers
+%% certain queries, e.g., "can x be scheduled this cycle"
+%% and "reserve resources for x".
+%% 8. schedule: list of scheduled instructions {Instr,Cycle}
+%% in the order of issue
+%% 9. instructions: maps IDs back to instructions
+%%
+%% Inputs:
+%% - a list of {ID,Node} pairs (where ID is a unique key)
+%% - a dependence list {ID0,Latency,ID1}, which is used to
+%% build the DAG.
+%%
+%% Note that there is some leeway in how things are represented
+%% from here.
+%%
+%% MODIFICATIONS:
+%% - Some basic blocks are not worth scheduling (e.g., GC save/restore code)
+%% yet are pretty voluminous. How do we skip them?
+%% - Scheduling should be done at finalization time: when basic block is
+%% linearized and is definitely at Sparc assembly level, THEN reorder
+%% stuff.
+
+-module(hipe_schedule).
+-export([cfg/1, est_cfg/1, delete_node/5]).
+
+-include("../sparc/hipe_sparc.hrl").
+
+%%-define(debug1,true).
+
+-define(debug2(Str,Args),ok).
+%%-define(debug2(Str,Args),io:format(Str,Args)).
+
+-define(debug3(Str,Args),ok).
+%%-define(debug3(Str,Args),io:format(Str,Args)).
+
+-define(debug4(Str,Args),ok).
+%%-define(debug4(Str,Args),io:format(Str,Args)).
+
+-define(debug5(Str,Args),ok).
+%%-define(debug5(Str,Args),io:format(Str,Args)).
+
+-define(debug(Str,Args),ok).
+%%-define(debug(Str,Args),io:format(Str,Args)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cfg
+%% Argument : CFG - the control flow graph
+%% Returns : CFG - A new cfg with scheduled blocks
+%% Description : Takes each basic block and schedules them one by one.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cfg(CFG) ->
+ ?debug3("CFG: ~n~p", [CFG]),
+ update_all( [ {L,
+ hipe_bb:mk_bb(
+ block(L,hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))) )}
+ || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : update_all
+%% Argument : Blocks - [{Label, Block}] , a list with labels and new code
+%% used for updating the old CFG.
+%% CFG - The old controlflow graph
+%% Returns : An updated controlflow graph.
+%% Description : Just swappes the basic blocks in the CFG to the scheduled one.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+update_all([],CFG) -> CFG;
+update_all([{L,NewB}|Ls],CFG) ->
+ update_all(Ls,hipe_sparc_cfg:bb_add(CFG,L,NewB)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+est_cfg(CFG) ->
+ update_all([ {L, hipe_bb:mk_bb(est_block(hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))))}
+ || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Provides an estimation of how quickly a block will execute.
+%% This is done by chaining all instructions in sequential order
+%% by 0-cycle dependences (which means they will never be reordered),
+%% then scheduling the mess.
+
+est_block([]) -> [];
+est_block([I]) -> [I];
+est_block(Blk) ->
+ {IxBlk,DAG} = est_deps(Blk),
+ Sch = bb(IxBlk,DAG),
+ separate_block(Sch,IxBlk).
+
+est_deps(Blk) ->
+ IxBlk = indexed_bb(Blk),
+ DAG = deps(IxBlk),
+ {IxBlk, chain_instrs(IxBlk,DAG)}.
+
+chain_instrs([{N,_}|Xs],DAG) ->
+ chain_i(N,Xs,DAG).
+
+chain_i(_,[],DAG) -> DAG;
+chain_i(N,[{M,_}|Xs],DAG) ->
+ NewDAG = dep_arc(N,zero_latency(),M,DAG),
+ chain_i(M,Xs,NewDAG).
+
+zero_latency() -> 0.
+
+lookup_instr([{N,I}|_], N) -> I;
+lookup_instr([_|Xs], N) -> lookup_instr(Xs, N).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : block
+%% Argument : Instrs - [Instr], list of all the instructions in a basic
+%% block.
+%% Returns : A new scheduled block
+%% Description : Schedule a basic block
+%%
+%% Note: does not consider delay slots!
+%% (another argument for using only annulled delay slots?)
+%% * how do we add delay slots? somewhat tricky to
+%% reconcile with the sort of scheduling we consider.
+%% (as-early-as-possible)
+%% => rewrite scheduler into as-late-as-possible?
+%% (=> just reverse the dependence arcs??)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Don't fire up the scheduler if there's no work to do.
+block(_, []) ->
+ [];
+block(_L, [I]) ->
+ case hipe_sparc:is_any_branch(I) of
+ true -> [hipe_sparc:nop_create(), I];
+ false -> [I]
+ end;
+block(_L, Blk) ->
+ IxBlk = indexed_bb(Blk),
+ case IxBlk of
+ [{_N, I}] -> % comments and nops may have been removed.
+ case hipe_sparc:is_any_branch(I) of
+ true -> [hipe_sparc:nop_create(), I];
+ false -> [I]
+ end;
+ _ ->
+ Sch = bb(IxBlk, {DAG, _Preds} = deps(IxBlk)),
+ {NewSch, NewIxBlk} = fill_delays(Sch, IxBlk, DAG),
+ X = finalize_block(NewSch, NewIxBlk),
+ debug1_stuff(Blk, DAG, IxBlk, Sch, X),
+ X
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : fill_delays
+%% Argument : Sch - List of {{cycle, C}, {node, N}} : C = current cycle
+%% N = node index
+%% IxBlk - Indexed block [{N, Instr}]
+%% DAG - Dependence graph
+%% Returns : {NewSch, NewIxBlk} - vector with new schedule and vector
+%% with {N, Instr}
+%% Description : Goes through the schedule from back to front looking for
+%% branches/jumps. If one is found fill_del tries to find
+%% an instr to fill the delayslot.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+fill_delays(Sch, IxBlk, DAG) ->
+ NewIxBlk = hipe_vectors:list_to_vector(IxBlk),
+ %% NewSch = hipe_vectors:list_to_vector(Sch),
+ NewSch = fill_del(length(Sch), hipe_vectors:list_to_vector(Sch),
+ NewIxBlk, DAG),
+ {NewSch, NewIxBlk}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : fill_del
+%% Argument : N - current index in the schedule
+%% Sch - schedule
+%% IxBlk - indexed block
+%% DAG - dependence graph
+%% Returns : Sch - New schedule with possibly a delay instr in the last
+%% position.
+%% Description : If a call/jump is found fill_branch_delay/fill_call_delay
+%% is called to find a delay-filler.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+fill_del(N, Sch, _IxBlk, _DAG) when N < 1 -> Sch;
+fill_del(N, Sch, IxBlk, DAG) ->
+ Index = get_index(Sch, N),
+ ?debug2("Index for ~p: ~p~nInstr: ~p~n",
+ [N, Index, get_instr(IxBlk, Index)]),
+ NewSch =
+ case get_instr(IxBlk, Index) of
+ #call_link{} ->
+ fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
+ #jmp_link{} ->
+ fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
+ #jmp{} ->
+ fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
+ #b{} ->
+ fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
+ #br{} ->
+ fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
+ #goto{} ->
+ fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
+ _Other ->
+ Sch
+ end,
+ NewSch.
+ %% fill_del(N - 1, NewSch, IxBlk, DAG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : fill_call_delay
+%% Argument : Cand - index in schedule of delay-candidate
+%% Call - index in schedule of call
+%% Sch - schedule vector: < {{cycle,Ci},{node,Nj}}, ... >
+%% IxBlk - block vector: < {N, Instr1}, {N+1, Instr2} ... >
+%% DAG - dependence graph
+%% Returns : Sch - new updated schedule.
+%% Description : Searches backwards through the schedule trying to find an
+%% instr without conflicts with the Call-instr.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+fill_call_delay(Cand, _Call, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
+fill_call_delay(Cand, Call, Sch, IxBlk, DAG) ->
+ CandIndex = get_index(Sch, Cand),
+ CallIndex = get_index(Sch, Call),
+ CandI = get_instr(IxBlk, CandIndex),
+ case move_or_alu(CandI) of
+ true ->
+ case single_depend(CandIndex, CallIndex, DAG) of
+ false -> % Other instrs depends on Cand ...
+ fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG);
+
+ true ->
+ CallI = get_instr(IxBlk, CallIndex),
+
+ CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
+ %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
+ %% CallDefs = ordsets:from_list(hipe_sparc:defines(CallI)),
+ CallUses = ordsets:from_list(hipe_sparc:uses(CallI)),
+
+ Args = case CallI of
+ #jmp_link{} ->
+ ordsets:from_list(
+ hipe_sparc:jmp_link_args(CallI));
+ #jmp{} ->
+ ordsets:from_list(hipe_sparc:jmp_args(CallI));
+ #call_link{} ->
+ ordsets:from_list(
+ hipe_sparc:call_link_args(CallI))
+ end,
+ CallUses2 = ordsets:subtract(CallUses, Args),
+ Conflict = ordsets:intersection(CandDefs, CallUses2),
+ %% io:format("single_depend -> true:~n ~p~n, ~p~n,~p~n",[CandI,CallI,DAG]),
+ %% io:format("Cand = ~p~nCall = ~p~n",[CandI,CallI]),
+ %% io:format("CandDefs = ~p~nCallDefs = ~p~n",[CandDefs,CallDefs]),
+ %% io:format("CandUses = ~p~nCallUses = ~p~n",[CandUses,CallUses]),
+ %% io:format("Args = ~p~nCallUses2 = ~p~n",[Args,CallUses2]),
+ %% io:format("Conflict = ~p~n",[Conflict]),
+
+ case Conflict of
+ [] -> % No conflicts ==> Cand can fill delayslot after Call
+ update_schedule(Cand, Call, Sch);
+ _ -> % Conflict: try with preceeding instrs
+ fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
+ end
+ end;
+ false ->
+ fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : fill_branch_delay
+%% Argument : Cand - index in schedule of delay-candidate
+%% Branch - index in schedule of branch
+%% Sch - schedule
+%% IxBlk - indexed block
+%% DAG - dependence graph
+%% Returns : Sch - new updated schedule.
+%% Description : Searches backwards through the schedule trying to find an
+%% instr without conflicts with the Branch-instr.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+fill_branch_delay(Cand, _Br, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
+fill_branch_delay(Cand, Br, Sch, IxBlk, DAG) ->
+ CandIndex = get_index(Sch, Cand),
+ BrIndex = get_index(Sch, Br),
+ CandI = get_instr(IxBlk, CandIndex),
+ case move_or_alu(CandI) of
+ true ->
+ case single_depend(CandIndex, BrIndex, DAG) of
+ false -> % Other instrs depends on Cand ...
+ fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG);
+
+ true ->
+ BrI = get_instr(IxBlk, BrIndex),
+ CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
+ %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
+ %% BrDefs = ordsets:from_list(hipe_sparc:defines(BrI)),
+ BrUses = ordsets:from_list(hipe_sparc:uses(BrI)),
+
+ Conflict = ordsets:intersection(CandDefs, BrUses),
+ %% io:format("single_depend -> true: ~p~n, ~p~n,~p~n", [CandI, BrI, DAG]),
+ %% io:format("Cand = ~p~nBr = ~p~n",[CandI,BrI]),
+ %% io:format("CandDefs = ~p~nBrDefs = ~p~n",[CandDefs,BrDefs]),
+ %% io:format("CandUses = ~p~nBrUses = ~p~n",[CandUses,BrUses]),
+ %% io:format("Conflict = ~p~n",[Conflict]);
+
+ case Conflict of
+ [] -> % No conflicts ==>
+ % Cand can fill delayslot after Branch
+ update_schedule(Cand, Br, Sch);
+ _ -> % Conflict: try with preceeding instrs
+ fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
+ end
+ end;
+ false ->
+ fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : update_schedule
+%% Argument : From - the position from where to switch indexes in Sch
+%% To - the position to where to switch indexes in Sch
+%% Sch - schedule
+%% Returns : Sch - an updated schedule
+%% Description : If From is the delay-filler and To is the Call/jump, the
+%% schedule is updated so From gets index To, To gets index
+%% To - 1, and the nodes between From and To gets old_index - 1.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+update_schedule(To, To, Sch) ->
+ {{cycle, C}, {node, _N} = Node} = hipe_vectors:get(Sch, To-1),
+ hipe_vectors:set(Sch, To-1, {{cycle, C+1}, Node});
+update_schedule(From, To, Sch) ->
+ Temp = hipe_vectors:get(Sch, From-1),
+ Sch1 = hipe_vectors:set(Sch, From-1, hipe_vectors:get(Sch, From)),
+ update_schedule(From + 1, To, hipe_vectors:set(Sch1, From, Temp)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : single_depend
+%% Argument : N - Index of the delayslot candidate
+%% M - Index of the node that N possibly has a single
+%% depend to.
+%% DAG - The dependence graph
+%% Returns : true if no other nodes than N os depending on N
+%% Description : Checks that no other nodes than M depends on N and that the
+%% latency between them is zero or 1.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+single_depend(N, M, DAG) ->
+ Deps = hipe_vectors:get(DAG, N-1),
+ single_depend(M, Deps).
+
+single_depend(_N, []) -> true;
+single_depend(N, [{0, N}]) -> true;
+single_depend(N, [{1, N}]) -> true;
+single_depend(_N, [{_Lat, _}|_]) -> false.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : get_index
+%% Argument : Sch - schedule
+%% N - index in schedule
+%% Returns : Index - index of the node
+%% Description : Returns the index of the node on position N in the schedule.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_index(Sch, N) ->
+ {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch,N-1),
+ Index.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : get_instr
+%% Argument : IxBlk - indexed block
+%% N - index in block
+%% Returns : Instr
+%% Description : Returns the instr on position N in the indexed block.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_instr(IxBlk, N) ->
+ {_, Instr} = hipe_vectors:get(IxBlk, N-1),
+ Instr.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : get_instr
+%% Argument : Sch - schedule
+%% IxBlk - indexed block
+%% N - index in schedule
+%% Returns : Instr
+%% Description : Returns the instr on position N in the schedule.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_instr(Sch, IxBlk, N) ->
+ {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch, N-1),
+ {_, Instr} = hipe_vectors:get(IxBlk, Index-1),
+ Instr.
+
+separate_block(Sch,IxBlk) ->
+ sep_comments([{C,lookup_instr(IxBlk,N)} || {{cycle,C},{node,N}} <- Sch]).
+
+sep_comments([]) -> [];
+sep_comments([{C,I}|Xs]) ->
+ [hipe_sparc:comment_create({cycle,C}), I | sep_comments(Xs,C)].
+
+sep_comments([], _) -> [];
+sep_comments([{C1,I}|Xs], C0) ->
+ if
+ C1 > C0 ->
+ [hipe_sparc:comment_create({cycle,C1}),I|sep_comments(Xs,C1)];
+ true ->
+ [I|sep_comments(Xs, C0)]
+ end.
+
+finalize_block(Sch, IxBlk) ->
+ ?debug5("Sch: ~p~nIxBlk: ~p~n",[Sch,IxBlk]),
+ finalize_block(1, hipe_vectors:size(Sch), 1, Sch, IxBlk, []).
+
+finalize_block(N, End, _C, Sch, IxBlk, _Instrs) when N =:= End - 1 ->
+ NextLast = get_instr(Sch, IxBlk, N),
+ Last = get_instr(Sch, IxBlk, End),
+ ?debug5("NextLast: ~p~nLast: ~p~n",[NextLast,Last]),
+ case hipe_sparc:is_any_branch(Last) of
+ true -> % Couldn't fill delayslot ==> add NOP
+ [NextLast , hipe_sparc:nop_create(), Last];
+ false -> % Last is a delayslot-filler ==> change order...
+ [Last, NextLast]
+ end;
+finalize_block(N, End, C0, Sch, IxBlk, Instrs) ->
+ {{cycle, _C1}, {node, _M}} = hipe_vectors:get(Sch, N-1),
+ Instr = get_instr(Sch, IxBlk, N),
+ ?debug5("Instr: ~p~n~n",[Instr]),
+ [Instr | finalize_block(N + 1, End, C0, Sch, IxBlk, Instrs)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : bb
+%% Argument : IxBlk - indexed block
+%% DAG - {Dag, Preds} where Dag is dependence graph and
+%% Preds is number of predecessors for each node.
+%% Returns : Sch
+%% Description : Initializes earliest-list, ready-list, priorities, resources
+%% and so on, and calls the cycle_sched which does the scheduling
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+bb(IxBlk,DAG) ->
+ bb(length(IxBlk), IxBlk, DAG).
+
+bb(N,IxBlk,{DAG, Preds}) ->
+ Earliest = init_earliest(N),
+ BigArray = N*10, % "nothing" is this big :-)
+ Ready = hipe_schedule_prio:init_ready(BigArray,Preds),
+ I_res = init_instr_resources(N, IxBlk),
+
+ Prio = hipe_schedule_prio:init_instr_prio(N,DAG),
+ Rsrc = init_resources(BigArray),
+ ?debug4("I_res: ~n~p~nPrio: ~n~p~nRsrc: ~n~p~n", [I_res,Prio,Rsrc]),
+ ?debug('cycle 1~n',[]),
+ Sch = empty_schedule(),
+ cycle_sched(1,Ready,DAG,Preds,Earliest,Rsrc,I_res,Prio,Sch,N,IxBlk).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cycle_sched
+%% Argument : - C is current cycle, 1 or more.
+%% - Ready is an array (Cycle -> [Node])
+%% yielding the collection of nodes ready to be
+%% scheduled in a cycle.
+%% - DAG is an array (Instr -> [{Latency,Instr}])
+%% represents the dependence DAG.
+%% - Preds is an array (Instr -> NumPreds)
+%% counts the number of predecessors
+%% (0 preds = ready to be scheduled).
+%% - Earl is an array (Instr -> EarliestCycle)
+%% holds the earliest cycle an instruction can be scheduled.
+%% - Rsrc is a 'resource ADT' that handles scheduler resource
+%% management checks whether instruction can be scheduled
+%% this cycle without a stall.
+%% - I_res is an array (Instr -> Required_resources)
+%% holds the resources required to schedule an instruction.
+%% - Sch is the representation of the schedule current schedule.
+%% - N is the number of nodes remaining to be scheduled
+%% tells us when to stop the scheduler.
+%% - IxBlk is the indexed block with instrs
+%% Returns : present schedule
+%% Description : Scheduler main loop.
+%% Pick next ready node in priority order for cycle C until
+%% none remain.
+%% * check each node if it can be scheduled w/o stalling
+%% * if so, schedule it
+%% * otherwise, bump the node to the next cycle
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cycle_sched(C,Ready,DAG,Preds,Earl,Rsrc,I_res,Prio,Sch,N,IxBlk) ->
+ case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk,DAG,Preds,Earl) of
+% case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk) of
+ {next,I,Ready1} ->
+ ?debug('try ~p~n==> ready = ~p~n',[I, Ready1]),
+ case resources_available(C,I,Rsrc,I_res) of
+ {yes,NewRsrc} ->
+ ?debug(' scheduled~n==> Rscrs = ~p~n',[NewRsrc]),
+ NewSch = add_to_schedule(I,C,Sch),
+ {ReadyNs,NewDAG,NewPreds,NewEarl} =
+ delete_node(C,I,DAG,Preds,Earl),
+ ?debug("NewPreds : ~p~n",[Preds]),
+ ?debug(' ReadyNs: ~p~n',[ReadyNs]),
+ NewReady = hipe_schedule_prio:add_ready_nodes(ReadyNs,
+ Ready1),
+ ?debug(' New ready: ~p~n',[NewReady]),
+ cycle_sched(C,NewReady,NewDAG,NewPreds,NewEarl,
+ NewRsrc,I_res,Prio,NewSch,N-1, IxBlk);
+ no ->
+ ?debug(' resource conflict~n',[]),
+ NewReady = hipe_schedule_prio:insert_node(C+1,I,Ready1),
+ cycle_sched(C,NewReady,DAG,Preds,Earl,Rsrc,
+ I_res,Prio,Sch,N,IxBlk)
+ end;
+ none -> % schedule next cycle if some node remains
+ if
+ N > 0 ->
+ ?debug('cycle ~p~n',[C+1]),
+ cycle_sched(C+1,Ready,DAG,Preds,Earl,
+ advance_cycle(Rsrc),
+ I_res,Prio,Sch,N, IxBlk);
+ true ->
+ present_schedule(Sch)
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : init_earliest
+%% Argument : N - number of instrs
+%% Returns :
+%% Description :
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+init_earliest(N) ->
+ hipe_vectors:new(N,1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Schedule is kept reversed until the end.
+
+-define(present_node(I,Cycle),{{cycle,Cycle},{node,I}}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : empty_schedule
+%% Description : Returns an empty schedule.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+empty_schedule() -> [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_to_schedule
+%% Argument : I - instr
+%% Cycle - cycle when I was placed
+%% Sch - schedule
+%% Description : Adds instr to schedule
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_to_schedule(I,Cycle,Sch) ->
+ [?present_node(I,Cycle)|Sch].
+
+present_schedule(Sch) -> lists:reverse(Sch).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface to resource manager:
+%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : init_resources
+%% Description : Yields a 'big enough' array mapping (Cycle -> Resources);
+%% this array is called Rsrc below.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+init_resources(S) ->
+ hipe_target_machine:init_resources(S).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : init_instr_resources
+%% Argument : Nodes - a list of the instructions
+%% N - is the number of nodes
+%% Description : return a vector (NodeID -> Resource_requirements)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+init_instr_resources(N,Nodes) ->
+ hipe_target_machine:init_instr_resources(N,Nodes).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : resources_available
+%% Argument : Cycle - the current cycle
+%% I - the current instruction (index = NodeID)
+%% Rsrc - a map (Cycle -> Resources)
+%% I_res - maps (NodeID -> Resource_requirements)
+%% Description : returns {yes,NewResTab} | no
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+resources_available(Cycle,I,Rsrc,I_res) ->
+ hipe_target_machine:resources_available(Cycle,I,Rsrc,I_res).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : advance_cycle
+%% Argument : Rsrc - resources
+%% Description : Returns an empty resources-state
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+advance_cycle(Rsrc) ->
+ hipe_target_machine:advance_cycle(Rsrc).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : delete_node
+%% Argument : Cycle - current cycle
+%% I - index of instr
+%% DAG - dependence dag
+%% Preds - array with number of predecessors for nodes
+%% Earl - array with earliest-times for nodes
+%% Returns : {ReadyNs,NewDAG,NewPreds,NewEarl}
+%% Description : Deletes node I and updates earliest times for the rest.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+delete_node(Cycle,I,DAG,Preds,Earl) ->
+ Succ = hipe_vectors:get(DAG,I-1),
+ NewDAG = hipe_vectors:set(DAG,I-1,scheduled), % provides debug 'support'
+ {ReadyNs,NewPreds,NewEarl} = update_earliest(Succ,Cycle,Preds,Earl,[]),
+ ?debug('earliest after ~p: ~p~n',[I,[{Ix+1,V} || {Ix,V} <- hipe_vectors:list(NewEarl)]]),
+ {ReadyNs,NewDAG,NewPreds,NewEarl}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : update_earliest
+%% Argument : Succ - successor list
+%% Cycle - current cycle
+%% Preds - predecessors
+%% Earl - earliest times for nodes
+%% Ready - array with readynodes for cycles
+%% Returns : {Ready,Preds,Earl}
+%% Description : Updates the earliest times for nodes and updates number of
+%% predecessors for nodes
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+update_earliest([],_Cycle,Preds,Earl,Ready) ->
+ {Ready,Preds,Earl};
+update_earliest([{Lat,N}|Xs],Cycle,Preds,Earl,Ready) ->
+ Old_earl = hipe_vectors:get(Earl,N-1),
+ New_earl = erlang:max(Old_earl,Cycle+Lat),
+ NewEarl = hipe_vectors:set(Earl,N-1,New_earl),
+ Num_preds = hipe_vectors:get(Preds,N-1),
+ NewPreds = hipe_vectors:set(Preds,N-1,Num_preds-1),
+ if
+ Num_preds =:= 0 ->
+ ?debug('inconsistent DAG~n',[]),
+ exit({update_earliest,N});
+ Num_preds =:= 1 ->
+ NewReady = [{New_earl,N}|Ready],
+ NewPreds2 = hipe_vectors:set(NewPreds,N-1,0),
+ update_earliest(Xs,Cycle,NewPreds2,NewEarl,NewReady);
+ is_integer(Num_preds), Num_preds > 1 ->
+ update_earliest(Xs,Cycle,NewPreds,NewEarl,Ready)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Collect instruction dependences.
+%%
+%% Three forms:
+%% - data/register
+%% * insert RAW, WAR, WAW dependences
+%% - memory
+%% * stores serialize memory references
+%% * alias analysis may allow loads to bypass stores
+%% - control
+%% * unsafe operations are 'trapped' between branches
+%% * branches are ordered
+%%
+%% returns { [{Index,Instr}], DepDAG }
+%% DepDAG is defined below.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : deps
+%% Argument : BB - Basic block
+%% Returns : {IxBB,DAG} - indexed block and dependence graph. DAG consists
+%% of both Dag and Preds, where Preds is number
+%% of predecessors for nodes.
+%% Description : Collect instruction dependences.
+%%
+%% Three forms:
+%% - data/register
+%% * insert RAW, WAR, WAW dependences
+%% - memory
+%% * stores serialize memory references
+%% * alias analysis may allow loads to bypass stores
+%% - control
+%% * unsafe operations are 'trapped' between branches
+%% * branches are ordered
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+deps(IxBB) ->
+ N = length(IxBB),
+ DAG = empty_dag(N), % The DAG contains both dependence-arcs and
+ % number of predeccessors...
+ {_DepTab,DAG1} = dd(IxBB, DAG),
+ DAG2 = md(IxBB, DAG1),
+ cd(IxBB, DAG2).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : empty_dag
+%% Argument : N - number of nodes
+%% Returns : empty DAG
+%% Description : DAG consists of dependence graph and predeccessors
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+empty_dag(N) ->
+ {hipe_vectors:new(N, []), hipe_vectors:new(N, 0)}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : indexed_bb
+%% Argument : BB - basic block
+%% Returns : [{N, Instr}]
+%% Description : Puts indexes to all instrs of a block, removes comments.
+%% NOP's are also removed because if both sparc_schedule and
+%% sparc_post_schedule options are used, the first pass will
+%% add nop's before the branch if necessary, and these are
+%% removed before scheduling the second pass.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+indexed_bb(BB) ->
+ indexed_bb(BB,1).
+
+indexed_bb([],_N) -> [];
+indexed_bb([X|Xs],N) ->
+ case X of
+ #comment{} ->
+ indexed_bb(Xs,N);
+ #nop{} ->
+ indexed_bb(Xs,N);
+ _Other ->
+ [{N,X}|indexed_bb(Xs,N+1)]
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : dep_arc
+%% Argument : N - Current node
+%% Lat - Latency from current node to M
+%% M - The dependent node
+%% DAG - The dependence graph. Consists of both DAG and
+%% predeccessors
+%% Returns : A new DAG with the arc added and number of predeccessors for
+%% M increased.
+%% Description : Adds a new arc to the graph, if an older arc goes from N to M
+%% it will be replaced with a new arc {max(OldLat, NewLat), M}.
+%% Number of predeccessors for node M is increased.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+dep_arc(N, Lat, M, {Dag,Preds}) ->
+ OldDeps = hipe_vectors:get(Dag, N-1),
+ %% io:format("{OldDeps} = {~p}~n",[OldDeps]),
+ {NewDeps, Status} = add_arc(Lat, M, OldDeps),
+ %% io:format("{NewDeps, Status} = {~p, ~p}~n",[NewDeps, Status]),
+ NewDag = hipe_vectors:set(Dag, N-1, NewDeps),
+ NewPreds = case Status of
+ added -> % just increase preds if new arc was added
+ OldPreds = hipe_vectors:get(Preds, M-1),
+ hipe_vectors:set(Preds, M-1, OldPreds + 1);
+ non_added ->
+ Preds
+ end,
+ {NewDag, NewPreds}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_arc
+%% Argument : Lat - The latency from current node to To.
+%% To - The instr-id of the node which the dependence goes to
+%% Arcs - The dependecies that are already in the dep-graph
+%% Returns : A dependence graph sorted by To.
+%% Description : A new arc that is added is sorted in the right place, and if
+%% there is already an arc between nodes A and B, the one with
+%% the greatest latency is choosen.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_arc(Lat,To, []) -> {[{Lat, To}], added};
+add_arc(Lat1, To, [{Lat2, To} | Arcs]) ->
+ {[{erlang:max(Lat1, Lat2), To} | Arcs], non_added};
+add_arc(Lat1,To1, [{Lat2, To2} | Arcs]) when To1 < To2 ->
+ {[{Lat1, To1}, {Lat2, To2} | Arcs], added};
+add_arc(Lat1 ,To1, [{Lat2, To2} | Arcs]) ->
+ {Arcs1, Status} = add_arc(Lat1, To1, Arcs),
+ {[{Lat2, To2} | Arcs1], Status}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The register/data dependence DAG of a block is represented
+%% as a mapping (Variable -> {NextWriter,NextReaders})
+%% where NextWriter is a pair {Ix,Type}
+%% and NextReaders is a list of pairs {Ix,Type}.
+%%
+%% Type is used to determine latencies of operations; on the UltraSparc,
+%% latencies of arcs (n -> m) are determined by both n and m. (E.g., if
+%% n is an integer op and m is a store, then latency is 0; if m is an
+%% integer op, it's 1.)
+
+dd([],DAG) -> { empty_deptab(), DAG };
+dd([{N,I}|Is],DAG0) ->
+ {DepTab,DAG1} = dd(Is,DAG0),
+ add_deps(N,I,DepTab,DAG1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_deps
+%% Argument : N - current node
+%% Instr - current instr
+%% DepTab - hashtable with {next-writer, next-readers} for reg
+%% DAG - dependence graph
+%% Returns : {DepTab, BlockInfo, DAG} - with new values
+%% Description : Adds dependencies for node N to the graph. The registers that
+%% node N defines and uses are used for computing the
+%% dependencies to the following nodes.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_deps(N,Instr,DepTab,DAG) ->
+ {Ds,Us} = def_use(Instr),
+ Type = dd_type(Instr),
+ {DepTab1,DAG1} = add_write_deps(Ds,N,Type,DepTab,DAG),
+ add_read_deps(Us,N,Type,DepTab1,DAG1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Instructions are classified into symbolic categories,
+%% which are subsequently used to determine operation latencies
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+dd_type(Instr) ->
+ case Instr of
+ #b{} -> branch;
+ %% #br{} -> branch;
+ #call_link{} -> branch;
+ #jmp_link{} -> branch;
+ #jmp{} -> branch;
+ #goto{} -> branch;
+ #load{} -> load;
+ #store{} -> store;
+ #alu{} -> alu;
+ #move{} -> alu;
+ #multimove{} ->
+ Src = hipe_sparc:multimove_src(Instr),
+ Lat = round(length(Src)/2),
+ {mmove,Lat};
+ #sethi{} -> alu;
+ #alu_cc{} -> alu_cc;
+ %% #cmov_cc{} -> cmov_cc;
+ %% #cmov_r{} -> alu;
+ #load_atom{} -> alu;
+ #load_address{} -> alu;
+ #pseudo_enter{} -> pseudo;
+ #pseudo_pop{} -> pseudo;
+ #pseudo_return{} -> pseudo;
+ #pseudo_spill{} -> pseudo;
+ #pseudo_unspill{} -> pseudo
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_write_deps
+%% Argument : Defs - registers that node N defines.
+%% N - current node
+%% Ty - the type of current instr
+%% DepTab - Dependence-table
+%% DAG - The dependence graph.
+%% Returns : {DepTab,DAG} - with new values
+%% Description : Adds dependencies to the graph for nodes that depends on the
+%% registers that N defines.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_write_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
+add_write_deps([D|Ds],N,Ty,DepTab,DAG) ->
+ {NewDepTab,NewDAG} = add_write_dep(D,N,Ty,DepTab,DAG),
+ add_write_deps(Ds,N,Ty,NewDepTab,NewDAG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_write_dep
+%% Description : Updates the dependence table with N as next writer, and
+%% updates the DAG with the dependencies from N to subsequent
+%% nodes.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_write_dep(X,N,Ty,DepTab,DAG) ->
+ {NxtWriter,NxtReaders} = lookup(X,DepTab),
+ NewDepTab = writer(X,N,Ty,DepTab),
+ NewDAG = write_deps(N,Ty,NxtWriter,NxtReaders,DAG),
+ {NewDepTab, NewDAG}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : write_deps
+%% Argument : Instr - Current instr
+%% Ty - Type of current instr
+%% NxtWriter - The node that is the next writer of the ragister
+%% that Instr defines.
+%% NxtReaders - The nodes that are subsequent readers of the
+%% register that N defines.
+%% DAG - The dependence graph
+%% Returns : Calls raw_deps that finally returns a new DAG with the new
+%% dependence arcs added.
+%% Description : If a next writer exists a dependence arc for this node is
+%% added, and after this raw_deps is called to compute the
+%% arcs for read-after-write dependencies.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+write_deps(Instr,Ty,NxtWriter,NxtReaders,DAG) ->
+ DAG1 = case NxtWriter of
+ none ->
+ DAG;
+ {Instr,_} ->
+ DAG;
+ {Wr,WrTy} ->
+ dep_arc(Instr,
+ hipe_target_machine:waw_latency(Ty,WrTy),
+ Wr, DAG)
+ end,
+ raw_deps(Instr,Ty,NxtReaders,DAG1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : raw_deps
+%% Argument : Instr - current instr
+%% Type - type of instr
+%% Readers - subsequent readers
+%% DAG - dependence graph
+%% Returns : DAG - A new DAG with read-after-write dependencies added
+%% Description : Updates the DAG with the dependence-arcs from Instr to the
+%% subsequent readers, with the appropriate latencies.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+raw_deps(_Instr,_Type,[],DAG) -> DAG;
+raw_deps(Instr,Ty,[{Rd,RdTy}|Xs],DAG) ->
+ raw_deps(Instr,Ty,Xs,
+ dep_arc(Instr,hipe_target_machine:raw_latency(Ty,RdTy),
+ Rd,DAG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_read_deps
+%% Argument : Uses - The registers that node N uses.
+%% N - Index of the current node.
+%% Ty - Type of current node.
+%% DepTab - Dependence table
+%% DAG - Dependence graph
+%% Returns : {DepTab, DAG} - with updated values.
+%% Description : Adds the read dependencies from node N to subsequent ones,
+%% according to the registers that N uses.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_read_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
+add_read_deps([U|Us],N,Ty,DepTab,DAG) ->
+ {NewDepTab,NewDAG} = add_read_dep(U,N,Ty,DepTab,DAG),
+ add_read_deps(Us,N,Ty,NewDepTab,NewDAG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_read_dep
+%% Argument : X - Used register
+%% N - Index of checked instr
+%% Ty - Type of checked instr
+%% DepTab - Hashtable with {next-writer, next-readers}
+%% DAG - Dependence graph
+%% Returns : {DepTab, DAG} - with updated values
+%% Description : Looks up what the next-writer/next-readers are, and adjusts
+%% the table with current node as new reader. Finally
+%% read-dependencies are added to the DAG.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_read_dep(X,N,Ty,DepTab,DAG) ->
+ {NxtWriter,_NxtReaders} = lookup(X,DepTab),
+ NewDepTab = reader(X,N,Ty,DepTab),
+ NewDAG = read_deps(N,Ty,NxtWriter,DAG),
+ {NewDepTab, NewDAG}.
+
+% If NxtWriter is 'none', then this var is not written subsequently
+% Add WAR from Instr to NxtWriter (if it exists)
+% *** UNFINISHED ***
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : read_deps
+%% Argument : N - Index of current node
+%% Ty - Type of current node
+%% Writer - tuple {NextWriter, WrType} where NextWriter is the
+%% subsequent instr that writes this register next time,
+%% and WrType is the type of that instr.
+%% DAG - The dependence graph
+%% Returns : DAG
+%% Description : Returns a new DAG if a next-writer exists, otherwise the old
+%% DAG is returned.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+read_deps(_Instr,_Ty,none,DAG) ->
+ DAG;
+read_deps(_Instr,_Ty,{_Instr,_},DAG) ->
+ DAG;
+read_deps(Instr,Ty,{NxtWr,NxtWrTy},DAG) ->
+ dep_arc(Instr,hipe_target_machine:war_latency(Ty,NxtWrTy),NxtWr,
+ DAG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : empty_deptab
+%% Description : Creates an empty dependence table (hash-table)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+empty_deptab() ->
+ gb_trees:empty().
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : lookup
+%% Argument : X - key (register)
+%% DepTab - dependence table
+%% Returns : {NextWriter, NextReaders}
+%% Description : Returns next writer and a list of following readers on
+%% register X.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+lookup(X, DepTab) ->
+ case gb_trees:lookup(X, DepTab) of
+ none ->
+ {none, []};
+ {value, {W, Rs} = Val} ->
+ Val
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : writer
+%% Argument : X - key (register)
+%% N - index of writer
+%% Ty - type of writer
+%% DepTab - dependence table to be updated
+%% Returns : DepTab - new dependence table
+%% Description : Sets N tobe next writer on X
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+writer(X, N, Ty, DepTab) ->
+ gb_trees:enter(X, {{N, Ty}, []}, DepTab).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : reader
+%% Argument : X - key (register)
+%% N - index of reader
+%% Ty - type of reader
+%% DepTab - dependence table to be updated
+%% Returns : DepTab - new dependence table
+%% Description : Adds N to the dependence table as a reader.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+reader(X,N,Ty,DepTab) ->
+ {W,Rs} = lookup(X,DepTab),
+ gb_trees:enter(X,{W,[{N,Ty}|Rs]},DepTab).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The following version of md/2 separates heap- and stack operations,
+%% which allows for greater reordering.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : md
+%% Argument : IxBB - indexed block
+%% DAG - dependence graph
+%% Returns : DAG - new dependence graph
+%% Description : Adds arcs for load/store dependencies to the DAG.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+md(IxBB, DAG) ->
+ md(IxBB,empty_md_state(),DAG).
+
+md([],_,DAG) -> DAG;
+md([{N,I}|Is],St,DAG) ->
+ case md_type(I) of
+ other ->
+ md(Is,St,DAG);
+ {st,T} ->
+ { WAW_nodes, WAR_nodes, NewSt } = st_overlap(N,T,St),
+ md(Is,NewSt,
+ md_war_deps(WAR_nodes,N,md_waw_deps(WAW_nodes,N,DAG)));
+ {ld,T} ->
+ { RAW_nodes, NewSt } = ld_overlap(N,T,St),
+ md(Is,NewSt,
+ md_raw_deps(RAW_nodes,N,DAG))
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : md_war_deps
+%% Argument : WAR_nodes - write-after-read nodes depending on N
+%% N - index of current instr
+%% DAG - dependence graph
+%% Returns : DAG - updated DAG
+%% Description : Adds arcs for write-after-read dependencies for N
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+md_war_deps([],_,DAG) -> DAG;
+md_war_deps([M|Ms],N,DAG) ->
+ md_war_deps(Ms,N,dep_arc(M,hipe_target_machine:m_war_latency(),N,DAG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : md_waw_deps
+%% Argument : WAW_nodes - write-after-write nodes depending on N
+%% N - index of current instr
+%% DAG - dependence graph
+%% Returns : DAG - updated DAG
+%% Description : Adds arcs for write-after-write dependencies for N
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+md_waw_deps([],_,DAG) -> DAG;
+md_waw_deps([M|Ms],N,DAG) ->
+ md_waw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_waw_latency(),N,DAG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : md_raw_deps
+%% Argument : RAW_nodes - read-after-write nodes depending on N
+%% N - index of current instr
+%% DAG - dependence graph
+%% Returns : DAG - updated DAG
+%% Description : Adds arcs for read-after-write dependencies for N
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+md_raw_deps([],_,DAG) -> DAG;
+md_raw_deps([M|Ms],N,DAG) ->
+ md_raw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_raw_latency(),N,DAG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : empty_md_state
+%% Description : Returns an empty memorydependence state, eg. 4 lists
+%% representing {StackStores, HeapStores, StackLoads, HeapLoads}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+empty_md_state() -> {[], [], [], []}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : md_type
+%% Argument : I - instr
+%% Description : Maps the instr-type to a simplified type, telling if it's
+%% store/load resp. heap or stack.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+md_type(I) ->
+ case I of
+ #load{} ->
+ Sp = hipe_sparc_registers:stack_pointer(),
+ Src = hipe_sparc:load_src(I),
+ N = hipe_sparc:reg_nr(Src),
+ Off = hipe_sparc:load_off(I),
+ if
+ N =:= Sp -> % operation on stack
+ {ld,{sp,Off}};
+ true ->
+ {ld,{hp,Src,Off}}
+ end;
+ #store{} ->
+ Sp = hipe_sparc_registers:stack_pointer(),
+ Dst = hipe_sparc:store_dest(I),
+ N = hipe_sparc:reg_nr(Dst),
+ Off = hipe_sparc:store_off(I),
+ if
+ N =:= Sp ->
+ {st,{sp,Off}};
+ true ->
+ {st,{hp,Dst,Off}}
+ end;
+ _ ->
+ other
+ end.
+
+%% Given a memory operation and a 'memory op state',
+%% overlap(N,MemOp,State) returns { Preceding_Dependent_Ops, NewState }.
+%% which are either a tuple { WAW_deps, WAR_deps } or a list RAW_deps.
+%%
+%% NOTES:
+%% Note that Erlang's semantics ("heap stores never overwrite existing data")
+%% means we can be quite free in reordering stores to the heap.
+%% Ld/St to the stack are simply handled by their offsets; since we do not
+%% rename the stack pointer, this is sufficient.
+%% *** We assume all memory ops have uniform size = 4 ***
+%%
+%% NOTES:
+%% The method mentioned above has now been changed because the assumption that
+%% "heap stores never overwrite existing data" caused a bug when the
+%% process-pointer was treated the same way as the heap. We were also told
+%% that the semantics can possibly change in the future, so it would be more
+%% safe to treat the heap store/loads as the stack.
+%% A future improvement can be to do an alias analysis to give more freedom
+%% in reordering stuff...
+%%
+%% Alias state:
+%% { [StackOp], [HeapOp], [StackOp], [HeapOp] }
+%% where StackOp = {InstrID, Offset}
+%% HeapOp = {InstrID, Reg, Offset}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : st_overlap
+%% Argument : N - Index of current node
+%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
+%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
+%% where StackStrs/StackLds = {InstrID, Offset}
+%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
+%% Returns : { DepStrs, DepLds, State } -
+%% where DepStrs/DepLds = [NodeId]
+%% and State is the new state
+%% Description : Adds dependencies for overlapping stores.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+st_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
+ {DepSt, IndepSt_Sp} = st_sp_dep(St_Sp, Off),
+ {DepLd, IndepLd_Sp} = ld_sp_dep(Ld_Sp, Off),
+ {DepSt, DepLd, {[{N, Off}|IndepSt_Sp], St_Hp, IndepLd_Sp, Ld_Hp}};
+st_overlap(N, {hp, Dst, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
+ DstOff = {Dst, Off},
+ {DepSt,_IndepSt_Hp} = st_hp_dep(St_Hp, DstOff),
+ {DepLd, IndepLd_Hp} = ld_hp_dep(Ld_Hp, DstOff),
+ {DepSt, DepLd, {St_Sp, [{N, Dst, Off}|St_Hp], Ld_Sp, IndepLd_Hp}}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : ld_overlap
+%% Argument : N - Index of current node
+%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
+%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
+%% where StackStrs/StackLds = {InstrID, Offset}
+%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
+%% Returns : { DepStrs, State }
+%% Description : Adds dependencies for overlapping laods
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ld_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
+ DepSt = sp_dep_only(St_Sp, Off),
+ {DepSt, {St_Sp, St_Hp, [{N, Off}|Ld_Sp], Ld_Hp}};
+ld_overlap(N, {hp, Src, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
+ DepSt = hp_dep_only(St_Hp, Src, Off),
+ {DepSt, {St_Sp, St_Hp, Ld_Sp, [{N, Src, Off}|Ld_Hp]}}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : st_sp_dep
+%% Description : Adds dependencies that are depending on a stack store
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+st_sp_dep(Stores, Off) ->
+ sp_dep(Stores, Off, [], []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : ld_sp_dep
+%% Description : Adds dependencies that are depending on a stack load
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ld_sp_dep(Loads, Off) ->
+ sp_dep(Loads, Off, [], []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : st_hp_dep
+%% Description : Adds dependencies that are depending on a heap store
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+st_hp_dep(Stores, {_Reg, _Off} = RegOff) ->
+ hp_dep(Stores, RegOff, [], []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : ld_hp_dep
+%% Description : Adds dependencies that are depending on a heap load
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ld_hp_dep(Loads, {_Reg, _Off} = RegOff) ->
+ hp_dep(Loads, RegOff, [], []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : sp_dep
+%% Description : Returns {Dependent, Independent} which are lists of nodes
+%% that depends or not on a stack load/store
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+sp_dep([], _Off, Dep, Indep) -> {Dep, Indep};
+sp_dep([{N,Off}|Xs], Off, Dep, Indep) ->
+ sp_dep(Xs, Off, [N|Dep], Indep);
+sp_dep([X|Xs], Off, Dep, Indep) ->
+ sp_dep(Xs, Off, Dep, [X|Indep]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : hp_dep
+%% Description : Returns {Dependent, Independent} which are lists of nodes
+%% that depends or not on a heap load/store
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+hp_dep([], {_Reg,_Off}, Dep, Indep) -> {Dep,Indep};
+hp_dep([{N,Reg,Off1}|Xs], {Reg,Off}, Dep, Indep) when Off1 =/= Off ->
+ hp_dep(Xs, {Reg,Off}, Dep, [{N,Reg,Off1}|Indep]);
+hp_dep([{N,_,_}|Xs], {Reg,Off}, Dep, Indep) ->
+ hp_dep(Xs, {Reg,Off}, [N|Dep], Indep).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : sp_dep_only
+%% Description : Returns a list of nodes that are depending on a stack store
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+sp_dep_only(Stores, Off) ->
+ [N || {N,Off0} <- Stores, Off =:= Off0].
+
+%% Dependences from heap stores to heap loads.
+%% *** UNFINISHED ***
+%% - but works
+%% This is somewhat subtle:
+%% - a heap load can only bypass a heap store if we KNOW it won't
+%% load the stored value
+%% - unfortunately, we do not know the relationships between registers
+%% at this point, so we can't say that store(p+4) is independent of
+%% load(q+0).
+%% (OR CAN WE? A bit closer reasoning might show that it's possible?)
+%% - We can ONLY say that st(p+c) and ld(p+c') are independent when c /= c'
+%%
+%% (As said before, it might be possible to lighten this restriction?)
+
+hp_dep_only([], _Reg, _Off) -> [];
+hp_dep_only([{_N,Reg,Off_1}|Xs], Reg, Off) when Off_1 =/= Off ->
+ hp_dep_only(Xs, Reg, Off);
+hp_dep_only([{N,_,_}|Xs], Reg, Off) ->
+ [N|hp_dep_only(Xs, Reg, Off)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Control dependences:
+%% - add dependences so that
+%% * branches are performed in order
+%% * unsafe operations are 'fenced in' by surrounding branches
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cd
+%% Argument : IxBB - indexed block
+%% DAG - dependence graph
+%% Returns : DAG - new dependence graph
+%% Description : Adds conditional dependencies to the DAG
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cd(IxBB,DAG) ->
+ cd(IxBB, DAG, none, [], []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cd
+%% Argument : IxBB - indexed block
+%% DAG - dependence graph
+%% PrevBr - previous branch
+%% PrevUnsafe - previous unsafe instr (mem-op)
+%% PrevOthers - previous other instrs, used to "fix" preceeding
+%% instrs so they don't bypass a branch.
+%% Returns : DAG - new dependence graph
+%% Description : Adds conditional dependencies to the graph.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cd([], DAG, _PrevBr, _PrevUnsafe, _PrevOthers) ->
+ DAG;
+cd([{N,I}|Xs], DAG, PrevBr, PrevUnsafe, PrevOthers) ->
+ case cd_type(I) of
+ {branch,Ty} ->
+ DAG1 = cd_branch_to_other_deps(N, PrevOthers, DAG),
+ NewDAG = cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG1),
+ cd(Xs,NewDAG,{N,Ty},[],[]);
+ {unsafe,Ty} ->
+ NewDAG = cd_unsafe_deps(PrevBr,N,Ty,DAG),
+ cd(Xs, NewDAG, PrevBr, [{N,Ty}|PrevUnsafe], PrevOthers);
+ {other,_Ty} ->
+ cd(Xs, DAG, PrevBr, PrevUnsafe, [N|PrevOthers])
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cd_branch_to_other_deps
+%% Argument : N - index of branch
+%% Ms - list of indexes of "others" preceeding instrs
+%% DAG - dependence graph
+%% Returns : DAG - new graph
+%% Description : Makes preceeding instrs fixed so they don't bypass a branch
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cd_branch_to_other_deps(_, [], DAG) ->
+ DAG;
+cd_branch_to_other_deps(N, [M | Ms], DAG) ->
+ cd_branch_to_other_deps(N, Ms, dep_arc(M, zero_latency(), N, DAG)).
+
+%% Is the operation a branch, an unspeculable op or something else?
+
+%% Returns
+%% {branch,BranchType}
+%% {unsafe,OpType}
+%% {other,OpType}
+
+%% *** UNFINISHED ***
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cd_type
+%% Argument : I - instr
+%% Description : Maps instrs to a simpler type.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cd_type(I) ->
+ case I of
+ #goto{} ->
+ {branch,uncond};
+ #br{} ->
+ {branch,'cond'};
+ #b{} ->
+ {branch,'cond'};
+ #call_link{} ->
+ {branch,call};
+ #jmp_link{} ->
+ {branch,call};
+ #jmp{} ->
+ {branch,call};
+ #load{} ->
+ {unsafe,load};
+ #store{} ->
+ {unsafe,load};
+ T ->
+ {other,T}
+ end.
+
+%% add dependences to keep order of branches + unspeculable ops:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cd_branch_deps
+%% Argument : PrevBr - preceeding branch
+%% PrevUnsafe - preceeding unsafe ops, eg, mem-ops
+%% N - current id.
+%% Ty - type of current instr
+%% DAG - dependence graph
+%% Returns : DAG - new DAG
+%% Description : Adds arcs between branches and calls deps_to_unsafe that adds
+%% arcs between branches and unsafe ops.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG) ->
+ DAG1 = case PrevBr of
+ none ->
+ DAG;
+ {Br,BrTy} ->
+ dep_arc(Br,
+ hipe_target_machine:br_br_latency(BrTy,Ty),
+ N, DAG)
+ end,
+ deps_to_unsafe(PrevUnsafe, N, Ty, DAG1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : deps_to_unsafe
+%% Description : Adds dependencies between unsafe's and branches
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+deps_to_unsafe([], _, _, DAG) -> DAG;
+deps_to_unsafe([{M,UTy}|Us], N, Ty, DAG) ->
+ deps_to_unsafe(Us,N,Ty,
+ dep_arc(M, hipe_target_machine:unsafe_to_br_latency(UTy,Ty),
+ N, DAG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cd_unsafe_deps
+%% Description : Adds dependencies between branches and unsafe's
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+cd_unsafe_deps(none, _, _, DAG) ->
+ DAG;
+cd_unsafe_deps({Br,BrTy}, N, Ty, DAG) ->
+ dep_arc(Br, hipe_target_machine:br_to_unsafe_latency(BrTy, Ty), N, DAG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : def_use
+%% Argument : Instr
+%% Description : Returns the registers that Instr defines resp. uses as 2 lists
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def_use(Instr) ->
+ {hipe_sparc:defines(Instr), hipe_sparc:uses(Instr)}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : move_or_alu
+%% Description : True if the instruction is a move or an alu; false otherwise
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+move_or_alu(#move{}) -> true;
+move_or_alu(#alu{}) -> true;
+move_or_alu(_) -> false.
+
+%% Debugging stuff below %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-ifdef(debug1).
+debug1_stuff(Blk, DAG, IxBlk, Sch, X) ->
+ io:format("Blk: ~p~n",[Blk]),
+ io:format("DAG: ~n~p~n~p",[DAG,IxBlk]),
+ io:format("~n"),
+ print_instrs(IxBlk),
+ print_sch(Sch, IxBlk),
+ print_instrs2(X).
+
+print_instrs([]) ->
+ io:format("~n");
+print_instrs([{N,Instr} | Instrs]) ->
+ io:format("(~p): ",[N]),
+ hipe_sparc_pp:pp_instr(Instr),
+ io:format("~p~n",[element(1,Instr)]),
+ print_instrs(Instrs).
+
+print_instrs2([]) ->
+ io:format("~n");
+print_instrs2([Instr | Instrs]) ->
+ hipe_sparc_pp:pp_instr(Instr),
+ print_instrs2(Instrs).
+
+print_sch([],_) -> io:format("~n");
+print_sch([{{cycle,Cycle},{node,I}} | Rest], IxBlk) ->
+ io:format("{C~p, N~p} ",[Cycle,I]),
+ print_node(I, IxBlk),
+ print_sch(Rest, IxBlk).
+
+print_node(_, []) ->
+ io:format("~n");
+print_node(I, [{I, Instr} | _]) ->
+ hipe_sparc_pp:pp_instr(Instr);
+print_node(I, [_ | IxBlk]) ->
+ print_node(I, IxBlk).
+-else.
+debug1_stuff(_Blk, _DAG, _IxBlk, _Sch, _X) ->
+ ok.
+-endif.
diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl
new file mode 100644
index 0000000000..4d078b007d
--- /dev/null
+++ b/lib/hipe/opt/hipe_schedule_prio.erl
@@ -0,0 +1,58 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% PRIORITY HANDLING AND PRIORITY CALCULATION
+%%
+%% Handling of ready nodes and priorities.
+%% - at present, all nodes have the same priority and so on.
+%%
+%% *** UNFINISHED ***
+%% - should compute a static priority estimate
+%% - should dynamically modify priorities + possibly insert NOPs
+%% (e.g., to separate branches, etc.)
+%% - thus, ought to be passed the current schedule and/or resources as well
+
+-module(hipe_schedule_prio).
+-export([init_ready/2,
+ init_instr_prio/2,
+ %% initial_ready_set/4,
+ next_ready/7,
+ add_ready_nodes/2,
+ insert_node/3
+ ]).
+
+init_ready(Size,Preds) ->
+ hipe_ultra_prio:init_ready(Size,Preds).
+
+init_instr_prio(N,DAG) ->
+ hipe_ultra_prio:init_instr_prio(N,DAG).
+
+%% initial_ready_set(M,N,Preds,Ready) ->
+%% hipe_ultra_prio:initial_ready_set(M,N,Preds,Ready).
+
+next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl) ->
+ hipe_ultra_prio:next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl).
+
+add_ready_nodes(NodeLst,Ready) ->
+ hipe_ultra_prio:add_ready_nodes(NodeLst,Ready).
+
+insert_node(C,I,Ready) ->
+ hipe_ultra_prio:insert_node(C,I,Ready).
diff --git a/lib/hipe/opt/hipe_spillmin.erl b/lib/hipe/opt/hipe_spillmin.erl
new file mode 100644
index 0000000000..df885a7dff
--- /dev/null
+++ b/lib/hipe/opt/hipe_spillmin.erl
@@ -0,0 +1,111 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ==========================================================================
+%% Module : hipe_spillmin
+%% Purpose : Driver module for minimizing the number of stack slots used
+%% by a function. This is done using an algorithm for register
+%% allocation. The implementation is target-independent and
+%% requires a target-specific interface module as argument.
+%%
+%% $Id$
+%% ==========================================================================
+%% Exported functions (short description):
+%%
+%% stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap) ->
+%% {Coloring, NumberOfSpills}
+%% Takes a CFG and the TempMap from register allocation and returns
+%% a coloring of stack slots.
+%% StackSlots should be a list of used stack slots, usually empty at
+%% first call to function.
+%% SpillIndex is the the first position we will spill to, usually 0.
+%% TempMap is the TempMap from the register allocation
+%%
+%% The Coloring will be in the form of the "allocation datastructure"
+%% described below, that is, a list of tuples on the form
+%% {Name, {spill, SpillIndex}}
+%% The NumberOfSpills is either 0 indicating no spill or the
+%% SpillIndex of the last spilled register.
+%%
+%% mapmerge(Map, SpillMap) -> NewMap
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_spillmin).
+-export([stackalloc/6, mapmerge/2]).
+
+%%-define(DEBUG, 1).
+-define(HIPE_INSTRUMENT_COMPILER, true).
+
+%%---------------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+-include("../flow/cfg.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap)
+%% Calculates an allocation of stack slots using either a linear scan
+%% or a graph coloring allocation algorithm.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec stackalloc(#cfg{}, [_], non_neg_integer(),
+ comp_options(), module(), hipe_temp_map()) ->
+ {hipe_spill_map(), non_neg_integer()}.
+
+stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap) ->
+ case proplists:get_bool(spillmin_color, Options) of
+ false ->
+ ?option_time(hipe_spillmin_scan:stackalloc(CFG, StackSlots, SpillIndex,
+ Options, Target, TempMap),
+ "Spill minimize, linear scan", Options);
+ true ->
+ ?option_time(hipe_spillmin_color:stackalloc(CFG, StackSlots, SpillIndex,
+ Options, Target, TempMap),
+ "Spill minimize, graph coloring", Options)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% mapmerge(Map, SpillMap)
+%%
+%% stackalloc/6 will only return the subset of the tempmap that contains
+%% the spilled temporaries. This function is used to merge the old
+%% complete tempmap with the new spill information.
+%% Map is the old map (a list of [{R0, C1}, {R1, C2}, ...]).
+%% SpillMap is the new "spill" map.
+%% !! Warning, the function does not work with the maps in another order !!
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Combines the map with allocated spills with a map from the register
+%% allocator
+
+-spec mapmerge(hipe_map(), hipe_spill_map()) -> hipe_map().
+
+mapmerge(TempMap, SpillMap) ->
+ mapmerge(TempMap, SpillMap, []).
+
+mapmerge([], _, Ack) ->
+ lists:reverse(Ack);
+mapmerge([{T1, _}|T1s], [{T2, C}|T2s], Ack) when T1 =:= T2 ->
+ mapmerge(T1s, T2s, [{T1, C}|Ack]);
+mapmerge([{_, unknown}|T1s], T2s, Ack) ->
+ mapmerge(T1s, T2s, Ack);
+mapmerge([T1|T1s], T2s, Ack) ->
+ mapmerge(T1s, T2s, [T1|Ack]).
diff --git a/lib/hipe/opt/hipe_spillmin_color.erl b/lib/hipe/opt/hipe_spillmin_color.erl
new file mode 100644
index 0000000000..11a281100b
--- /dev/null
+++ b/lib/hipe/opt/hipe_spillmin_color.erl
@@ -0,0 +1,556 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ===========================================================================
+%%@doc
+%% GRAPH COLORING STACK SLOT SPILL MINIMIZER
+%%
+%% A simple pessimistic graph coloring stack slot spill minimizer
+%%
+%% - build interference graph
+%% - estimate number of stack slots needed
+%% - simplify graph (push on stack, abort and retry with more stack slots if spill)
+%% - select colors
+%%
+%% Emits a coloring: a list of {TempName,Location}
+%% where Location is {spill,M}.
+%% {spill,M} denotes the Mth spilled node
+%%
+%% This version uses ETS tables
+%%
+%% Deficiencies:
+%% - pessimistic coloring
+%%
+
+-module(hipe_spillmin_color).
+
+-export([stackalloc/6]).
+
+%%-ifndef(DO_ASSERT).
+%%-define(DO_ASSERT, true).
+%%-endif.
+
+%%-ifndef(DEBUG).
+%%-define(DEBUG,0).
+%%-endif.
+
+%%---------------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+-include("../flow/cfg.hrl").
+
+%% Define these as 'ok' or 'report(X,Y)' depending on how much output you want.
+-define(report0(X,Y), ?IF_DEBUG_LEVEL(0,?msg(X, Y),ok)).
+-define(report(X,Y), ?IF_DEBUG_LEVEL(1,?msg(X, Y),ok)).
+-define(report2(X,Y), ?IF_DEBUG_LEVEL(2,?msg(X, Y),ok)).
+-define(report3(X,Y), ?IF_DEBUG_LEVEL(3,?msg(X, Y),ok)).
+
+%% Emits a coloring: a list of {TempName,Location}
+%% where Location is {spill,M}.
+%% {spill,M} denotes the Mth spilled node
+
+-spec stackalloc(#cfg{}, [_], non_neg_integer(),
+ comp_options(), module(), hipe_temp_map()) ->
+ {hipe_spill_map(), non_neg_integer()}.
+
+stackalloc(CFG, _StackSlots, SpillIndex, _Options, Target, TempMap) ->
+ ?report2("building IG~n", []),
+ {IG, NumNodes} = build_ig(CFG, Target, TempMap),
+ {Cols, MaxColors} =
+ color_heuristic(IG, 0, NumNodes, NumNodes, NumNodes, Target, 1),
+ SortedCols = lists:sort(Cols),
+ {remap_temp_map(SortedCols, TempMap, SpillIndex), SpillIndex+MaxColors}.
+
+%% Rounds a floating point value upwards
+ceiling(X) ->
+ T = trunc(X),
+ case (X - T) of
+ Neg when Neg < 0.0 -> T;
+ Pos when Pos > 0.0 -> T + 1;
+ _ -> T
+ end.
+
+%% Emits a coloring: an unsorted list of {Temp,Location}
+%% where Location is {spill,M}.
+%% {spill,M} denotes the Mth spilled node
+%%
+%% Notes:
+%% - Arguments:
+%% IG: The interference graph
+%% Min: The lower bound, the minimal number of colors tried.
+%% Max: The upper bound, the maximal number of colors tried.
+%% Safe: The number of colors that are guaranteed to work. This is
+%% needed, because we reuse information from color() about how
+%% many colors it used at the last try, but this is not guaranteed to
+%% be a feasible solution because color might work differently using
+%% more colors although it has successfully colored the graph with
+%% fewer colors previously. Example: color(666) colors with 23 colors,
+%% but color(23) fails.
+%% We use Safe inefficently, because we run color 1 additional
+%% time with the same argument if Safe is needed.
+%% MaxNodes: The number of nodes in IG.
+%% Target: Target specific information.
+%% MaxDepth: The maximum recursion depth.
+color_heuristic(IG, Min, Max, Safe, MaxNodes, Target, MaxDepth) ->
+ case MaxDepth of
+ 0 ->
+ case color(IG, ordsets:from_list(init_stackslots(Max)),
+ MaxNodes, Target) of
+ not_easily_colorable ->
+ color(IG, ordsets:from_list(init_stackslots(Safe)),
+ MaxNodes, Target);
+ Else ->
+ Else
+ end;
+ _ ->
+ %% This can be increased from 2, and by this the heuristic can be
+ %% exited earlier, but the same can be achived by decreasing the
+ %% recursion depth. This should not be decreased below 2.
+ case (Max - Min) < 2 of
+ true ->
+ case color(IG, ordsets:from_list(init_stackslots(Max)),
+ MaxNodes, Target) of
+ not_easily_colorable ->
+ color(IG, ordsets:from_list(init_stackslots(Safe)),
+ MaxNodes, Target);
+ Else ->
+ Else
+ end;
+ false ->
+ NumSlots = ceiling((Max - Min)/2) + Min,
+ case color(IG, ordsets:from_list(init_stackslots(NumSlots)),
+ MaxNodes, Target) of
+ not_easily_colorable ->
+ color_heuristic(IG, NumSlots, Max,
+ Safe, MaxNodes, Target, MaxDepth - 1);
+ {_TmpCols, TmpMaxColors} ->
+ color_heuristic(IG, Min, TmpMaxColors,
+ NumSlots, MaxNodes, Target, MaxDepth - 1)
+ end
+ end
+ end.
+
+%% Returns a new temp map with the spilled temporaries mapped to stack slots,
+%% located after SpillIndex, according to Cols.
+remap_temp_map(Cols, TempMap, SpillIndex) ->
+ remap_temp_map0(Cols, hipe_temp_map:to_substlist(TempMap), SpillIndex).
+
+remap_temp_map0([], _TempMap, _SpillIndex) ->
+ [];
+remap_temp_map0([{_M, {spill, N}}|Xs], [{TempNr, {spill,_}}|Ys], SpillIndex) ->
+ [{TempNr, {spill, SpillIndex + N-1}}|remap_temp_map0(Xs, Ys, SpillIndex)];
+remap_temp_map0(Cols, [_Y|Ys], SpillIndex) ->
+ remap_temp_map0(Cols, Ys, SpillIndex).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** BUILD THE INTERFERENCE GRAPH ***
+%%
+%% Returns {Interference_graph, Number_Of_Nodes}
+%%
+
+build_ig(CFG, Target, TempMap) ->
+ try build_ig0(CFG, Target, TempMap)
+ catch error:Rsn -> exit({regalloc, build_ig, Rsn})
+ end.
+
+%% Creates an ETS table consisting of the keys given in List, with the values
+%% being an integer which is the position of the key in List.
+%% [1,5,7] -> {1,0} {5,1} {7,2}
+%% etc.
+setup_ets(List) ->
+ setup_ets0(List, ets:new(tempMappingTable, []), 0).
+
+setup_ets0([], Table, _N) ->
+ Table;
+setup_ets0([X|Xs], Table, N) ->
+ ets:insert(Table, {X, N}),
+ setup_ets0(Xs, Table, N+1).
+
+build_ig0(CFG, Target, TempMap) ->
+ Live = Target:analyze(CFG),
+ TempMapping = map_spilled_temporaries(TempMap),
+ TempMappingTable = setup_ets(TempMapping),
+ NumSpilled = length(TempMapping),
+ IG = build_ig_bbs(Target:labels(CFG), CFG, Live, empty_ig(NumSpilled),
+ Target, TempMap, TempMappingTable),
+ ets:delete(TempMappingTable),
+ {normalize_ig(IG), NumSpilled}.
+
+build_ig_bbs([], _CFG, _Live, IG, _Target, _TempMap, _TempMapping) ->
+ IG;
+build_ig_bbs([L|Ls], CFG, Live, IG, Target, TempMap, TempMapping) ->
+ Xs = bb(CFG, L, Target),
+ LiveOut = [X || X <- liveout(Live, L, Target),
+ hipe_temp_map:is_spilled(X, TempMap)],
+ LiveOutList = ordsets:to_list(LiveOut),
+ LiveOutListMapped = list_map(LiveOutList, TempMapping, []),
+ LiveOutSetMapped = ordsets:from_list(LiveOutListMapped),
+ {_, NewIG} =
+ build_ig_bb(Xs, LiveOutSetMapped, IG, Target, TempMap, TempMapping),
+ build_ig_bbs(Ls, CFG, Live, NewIG, Target, TempMap, TempMapping).
+
+build_ig_bb([], LiveOut, IG, _Target, _TempMap, _TempMapping) ->
+ {LiveOut, IG};
+build_ig_bb([X|Xs], LiveOut, IG, Target, TempMap, TempMapping) ->
+ {Live,NewIG} =
+ build_ig_bb(Xs, LiveOut, IG, Target, TempMap, TempMapping),
+ build_ig_instr(X, Live, NewIG, Target, TempMap, TempMapping).
+
+build_ig_instr(X, Live, IG, Target, TempMap, TempMapping) ->
+ {Def, Use} = def_use(X, Target, TempMap),
+ ?report3("Live ~w\n~w : Def: ~w Use ~w\n",[Live, X, Def,Use]),
+ DefListMapped = list_map(Def, TempMapping, []),
+ UseListMapped = list_map(Use, TempMapping, []),
+ DefSetMapped = ordsets:from_list(DefListMapped),
+ UseSetMapped = ordsets:from_list(UseListMapped),
+ NewIG = interference_arcs(DefListMapped, ordsets:to_list(Live), IG),
+ NewLive = ordsets:union(UseSetMapped, ordsets:subtract(Live, DefSetMapped)),
+ {NewLive, NewIG}.
+
+%% Given a list of Keys and an ets-table returns a list of the elements
+%% in Mapping corresponding to the Keys and appends Acc to this list.
+list_map([], _Mapping, Acc) ->
+ Acc;
+list_map([X|Xs], Mapping, Acc) ->
+ {_Key, Val} = hd(ets:lookup(Mapping, X)),
+ list_map(Xs, Mapping, [Val | Acc]).
+
+%% Returns an ordered list of spilled temporaries in TempMap
+map_spilled_temporaries(TempMap) ->
+ map_spilled_temporaries0(hipe_temp_map:to_substlist(TempMap)).
+
+map_spilled_temporaries0([]) ->
+ [];
+map_spilled_temporaries0([{N, {spill, _}}|Xs]) ->
+ [N | map_spilled_temporaries0(Xs)];
+map_spilled_temporaries0([_X|Xs]) ->
+ map_spilled_temporaries0(Xs).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+interference_arcs([], _Live, IG) ->
+ IG;
+interference_arcs([X|Xs], Live, IG) ->
+ interference_arcs(Xs, Live, i_arcs(X, Live, IG)).
+
+i_arcs(_X, [], IG) ->
+ IG;
+i_arcs(X, [Y|Ys], IG) ->
+ i_arcs(X, Ys, add_edge(X, Y, IG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** COLORING ***
+%%
+%% Coloring is done straightforwardly:
+%% - find the low-degree nodes, put them in low
+%% - while low non-empty:
+%% * remove x from low
+%% * push x on stack
+%% * decrement degree of neighbors of x
+%% * for each neighbor y of low degree, put y on low
+%% - when low empty:
+%% - if graph empty, return stack
+%% - otherwise
+%% throw an exception (the caller should retry with more stack slots)
+
+color(IG, StackSlots, NumNodes, Target) ->
+ try
+ color_0(IG, StackSlots, NumNodes, Target)
+ catch
+ error:Rsn ->
+ ?error_msg("Coloring failed with ~p~n", [Rsn]),
+ ?EXIT(Rsn)
+ end.
+
+color_0(IG, StackSlots, NumNodes, Target) ->
+ ?report("simplification of IG~n", []),
+ K = ordsets:size(StackSlots),
+ Nodes = list_ig(IG),
+ Low = low_degree_nodes(Nodes, K),
+ ?report(" starting with low degree nodes ~p~n", [Low]),
+ EmptyStk = [],
+ case simplify(Low, NumNodes, IG, K, EmptyStk, Target) of
+ non_simplifiable -> not_easily_colorable;
+ Stk ->
+ ?report(" selecting colors~n", []),
+ select(Stk, IG, StackSlots, NumNodes)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%
+%%
+%% Simplification: push all easily colored nodes on a stack;
+%% when the list of easy nodes becomes empty, see if graph is
+%% empty as well. If it is not, throw an exception and abort.
+%% If it is empty, return the stack.
+%%
+%% Notes:
+%% - Arguments:
+%% Low: low-degree nodes (ready to color)
+%% NumNodes: number of remaining nodes in graph
+%% IG: interference graph
+%% K: number of colors
+%% Stk: stack of already simplified nodes
+%% Target: Machine to compile for
+
+simplify(Low, NumNodes, IG, K, Stk, Target) ->
+ Vis = none_visited(NumNodes),
+ simplify_ig(Low, NumNodes, IG, K, Stk, Vis, Target).
+
+simplify_ig([], 0, _IG, _K, Stk, _Vis, _Target) ->
+ Stk;
+simplify_ig([], N, _IG, _K, _Stk, _Vis, _Target) when N > 0 ->
+ ?report3("N: ~w Stk: ~w N+Stk ~w\n", [N,length(Stk),N+length(Stk)]),
+ non_simplifiable;
+simplify_ig([X|Xs], N, IG, K, Stk, Vis, Target) ->
+ ?report3("N: ~w Stk: ~w N+Stk ~w\n", [N,length(Stk),N+length(Stk)]),
+ case is_visited(X, Vis) of
+ true ->
+ ?report(" node ~p already visited~n", [X]),
+ simplify_ig(Xs, N, IG, K, Stk, Vis, Target);
+ false ->
+ ?report("Stack ~w\n", [Stk]),
+ {NewLow, NewIG} = decrement_neighbors(X, Xs, IG, Vis, K),
+ ?report(" node ~w pushed\n(~w now ready)~n", [X, NewLow]),
+ NewStk = push_colored(X, Stk),
+ simplify_ig(NewLow, N-1, NewIG, K, NewStk, visit(X, Vis), Target)
+ end.
+
+decrement_neighbors(X, Xs, IG, Vis, K) ->
+ Ns = unvisited_neighbors(X, Vis, IG),
+ ?report(" node ~p has neighbors ~w\n(unvisited ~p)~n",
+ [X, neighbors(X, IG), Ns]),
+ decrement_each(Ns, Xs, IG, Vis, K).
+
+%% For each node, decrement its degree and check if it is now
+%% a low-degree node. In that case, add it to the 'low list'.
+decrement_each([], Low, IG, _Vis, _K) ->
+ {Low, IG};
+decrement_each([N|Ns], OldLow, IG, Vis, K) ->
+ {Low, CurrIG} = Res = decrement_each(Ns, OldLow, IG, Vis, K),
+ case is_visited(N, Vis) of
+ true ->
+ Res;
+ false ->
+ {D, NewIG} = decrement_degree(N, CurrIG),
+ if
+ D =:= K-1 ->
+ {[N|Low], NewIG};
+ true ->
+ {Low, NewIG}
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%
+%%
+%% Returns a list of {Name,Location}, where Location is {spill,M}
+%%
+%% Note: we use pessimistic coloring here.
+%% - we could use optimistic coloring: for spilled node, check if there is
+%% an unused color among the neighbors and choose that.
+
+select(Stk, IG, PhysRegs, NumNodes) ->
+ select_colors(Stk, IG, none_colored(NumNodes), PhysRegs).
+
+select_colors([], _IG, _Cols, _PhysRegs) ->
+ ?report("all nodes colored~n", []),
+ {[], 0};
+select_colors([{X,colorable}|Xs], IG, Cols, PhysRegs) ->
+ ?report("color of ~p\n", [X]),
+ {Slot,NewCols} = select_color(X, IG, Cols, PhysRegs),
+ ?report("~p~n", [Slot]),
+ {Tail, MaxColor} = select_colors(Xs, IG, NewCols, PhysRegs),
+ NewMaxColor = erlang:max(Slot, MaxColor),
+ %% Since we are dealing with spills we label all our temporaries accordingly.
+ {[{X,{spill,Slot}} | Tail], NewMaxColor}.
+
+select_color(X, IG, Cols, PhysRegs) ->
+ UsedColors = get_colors(neighbors(X, IG), Cols),
+ Reg = select_unused_color(UsedColors, PhysRegs),
+ {Reg, set_color(X, Reg, Cols)}.
+
+%%%%%%%%%%%%%%%%%%%%
+
+get_colors([], _Cols) -> [];
+get_colors([X|Xs], Cols) ->
+ case color_of(X, Cols) of
+ uncolored ->
+ get_colors(Xs, Cols);
+ {color, R} ->
+ [R|get_colors(Xs, Cols)]
+ end.
+
+select_unused_color(UsedColors, PhysRegs) ->
+ Summary = ordsets:from_list(UsedColors),
+ AvailRegs = ordsets:to_list(ordsets:subtract(PhysRegs, Summary)),
+ hd(AvailRegs).
+
+push_colored(X, Stk) ->
+ [{X, colorable} | Stk].
+
+low_degree_nodes([], _K) -> [];
+low_degree_nodes([{N,Info}|Xs], K) ->
+ ?report0("node ~p has degree ~p: ~w~n", [N, degree(Info), neighbors(Info)]),
+ Deg = degree(Info),
+ if
+ Deg < K ->
+ [N|low_degree_nodes(Xs, K)];
+ true ->
+ low_degree_nodes(Xs, K)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+unvisited_neighbors(X, Vis, IG) ->
+ ordsets:from_list(unvisited(neighbors(X, IG), Vis)).
+
+unvisited([], _Vis) -> [];
+unvisited([X|Xs], Vis) ->
+ case is_visited(X, Vis) of
+ true ->
+ unvisited(Xs, Vis);
+ false ->
+ [X|unvisited(Xs, Vis)]
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** ABSTRACT DATATYPES ***
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%
+%% The stack slot datatype
+%%
+
+init_stackslots(NumSlots) ->
+ init_stackslots(NumSlots, []).
+
+init_stackslots(0, Acc) ->
+ Acc;
+init_stackslots(NumSlots, Acc) ->
+ init_stackslots(NumSlots - 1, [NumSlots|Acc]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The ig datatype:
+%%
+%% Note: if we know the number of temps used, we can use a VECTOR
+%% instead, which will speed up things.
+%%
+%% Note: later on, we may wish to add 'move-related' support.
+
+-record(ig_info, {neighbors = [] :: [_], degree = 0 :: non_neg_integer()}).
+
+empty_ig(NumNodes) ->
+ hipe_vectors:new(NumNodes, #ig_info{}).
+
+degree(Info) ->
+ Info#ig_info.degree.
+
+neighbors(Info) ->
+ Info#ig_info.neighbors.
+
+add_edge(X, X, IG) -> IG;
+add_edge(X, Y, IG) ->
+ add_arc(X, Y, add_arc(Y, X, IG)).
+
+add_arc(X, Y, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Old = neighbors(Info),
+ New = Info#ig_info{neighbors = [Y|Old]},
+ hipe_vectors:set(IG,X,New).
+
+normalize_ig(IG) ->
+ Size = hipe_vectors:size(IG),
+ normalize_ig(Size-1, IG).
+
+normalize_ig(-1, IG) ->
+ IG;
+normalize_ig(I, IG) ->
+ Info = hipe_vectors:get(IG, I),
+ N = ordsets:from_list(neighbors(Info)),
+ NewInfo = Info#ig_info{neighbors = N, degree = length(N)},
+ NewIG = hipe_vectors:set(IG, I, NewInfo),
+ normalize_ig(I-1, NewIG).
+
+neighbors(X, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Info#ig_info.neighbors.
+
+decrement_degree(X, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Degree = degree(Info),
+ NewDegree = Degree-1,
+ NewInfo = Info#ig_info{degree = NewDegree},
+ {NewDegree, hipe_vectors:set(IG, X, NewInfo)}.
+
+list_ig(IG) ->
+ hipe_vectors:list(IG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The coloring datatype:
+
+none_colored(NumNodes) ->
+ hipe_vectors:new(NumNodes, uncolored).
+
+color_of(X, Cols) ->
+ hipe_vectors:get(Cols, X).
+
+set_color(X, R, Cols) ->
+ hipe_vectors:set(Cols, X, {color, R}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Note: there might be a slight gain in separating the two versions
+%% of visit/2 and visited/2. (So that {var,X} selects X and calls
+%% the integer version.
+
+none_visited(NumNodes) ->
+ hipe_vectors:new(NumNodes, false).
+
+visit(X, Vis) ->
+ hipe_vectors:set(Vis, X, true).
+
+is_visited(X, Vis) ->
+ hipe_vectors:get(Vis, X).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** INTERFACES TO OTHER MODULES ***
+%%
+
+liveout(CFG, L, Target) ->
+ ordsets:from_list(reg_names(Target:liveout(CFG, L), Target)).
+
+bb(CFG, L, Target) ->
+ hipe_bb:code(Target:bb(CFG, L)).
+
+def_use(X, Target, TempMap) ->
+ Defines = [Y || Y <- reg_names(Target:defines(X), Target),
+ hipe_temp_map:is_spilled(Y, TempMap)],
+ Uses = [Z || Z <- reg_names(Target:uses(X), Target),
+ hipe_temp_map:is_spilled(Z, TempMap)],
+ {Defines, Uses}.
+
+reg_names(Regs, Target) ->
+ [Target:reg_nr(X) || X <- Regs].
diff --git a/lib/hipe/opt/hipe_spillmin_scan.erl b/lib/hipe/opt/hipe_spillmin_scan.erl
new file mode 100644
index 0000000000..c58906c389
--- /dev/null
+++ b/lib/hipe/opt/hipe_spillmin_scan.erl
@@ -0,0 +1,559 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ===========================================================================
+%% Copyright (c) 2002 by Niklas Andersson, Andreas Lundin, and Erik Johansson.
+%% ===========================================================================
+%% Module : hipe_spillmin_scan
+%% Purpose : Optimizes the number of stack slots used by using a
+%% "linear-scan algorithm" to allocate stack slots.
+%% Notes : * This is a simplified implementation of
+%% "Linear Scan Register Allocation" by
+%% Massimiliano Poletto & Vivek Sarkar described in
+%% ACM TOPLAS Vol 21, No 5, September 1999.
+%%
+%% * This implementation is target-independent and
+%% requires a target specific interface module
+%% as argument.
+%%
+%% * Based on the hipe_ls_regalloc module by Erik Johansson
+%%
+%% History : * 2002-04-01, NA & AL: Created
+%% * 2002-10-08, Happi: Cleanup and speedup
+%% ============================================================================
+%% Exported functions (short description):
+%% stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap) ->
+%% {Coloring, NumberOfSpills}
+%% Takes a CFG and the TempMap from register allocation and returns
+%% a coloring of stack slots.
+%% StackSlots should be a list of used stack slots, usually empty at
+%% first call to function.
+%% SpillIndex is the the first position we will spill to, usually 0.
+%% TempMap is the TempMap from the register allocation
+%%
+%% The Coloring will be in the form of the "allocation datastructure"
+%% described below, that is, a list of tuples on the form
+%% {Name, {spill, SpillIndex}}
+%% The NumberOfSpills is either 0 indicating no spill or the
+%% SpillIndex of the last spilled register.
+%%
+%% mapmerge
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_spillmin_scan).
+
+-export([stackalloc/6]).
+
+%%-define(DEBUG, 1).
+-define(HIPE_INSTRUMENT_COMPILER, true).
+
+%%----------------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+-include("../flow/cfg.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap)
+%% Calculates an allocation of stack slots using a linear_scan algorithm.
+%% There are three steps in the algorithm:
+%% 1. Calculate live-ranges for all spilled temporaries.
+%% 2. Calculate live-intervals for each temporary.
+%% The live interval consists of a start position and a end position
+%% these are the first definition and last use of the temporary
+%% given as instruction numbers in a breadth-first traversal of the
+%% control-flow-graph.
+%% 3. Do a linear scan allocation over the live intervals.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec stackalloc(#cfg{}, [_], non_neg_integer(),
+ comp_options(), module(), hipe_temp_map()) ->
+ {hipe_spill_map(), non_neg_integer()}.
+
+stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap) ->
+ ?debug_msg("LinearScan: ~w\n", [erlang:statistics(runtime)]),
+ %% Step 1: Calculate liveness (Call external implementation.)
+ Liveness = liveness(CFG, Target),
+ ?debug_msg("liveness (done)~w\n", [erlang:statistics(runtime)]),
+ USIntervals = calculate_intervals(CFG, Liveness, Options,
+ Target, TempMap),
+ %% ?debug_msg("intervals (done) ~w\n", [erlang:statistics(runtime)]),
+ Intervals = sort_on_start(USIntervals),
+ ?debug_msg("sort intervals (done) ~w\n", [erlang:statistics(runtime)]),
+ ?debug_msg("Intervals ~w\n", [Intervals]),
+ ?debug_msg("No intervals: ~w\n", [length(Intervals)]),
+ ?debug_msg("count intervals (done) ~w\n", [erlang:statistics(runtime)]),
+ Allocation = allocate(Intervals, StackSlots, SpillIndex, Target),
+ ?debug_msg("allocation (done) ~w\n", [erlang:statistics(runtime)]),
+ Allocation.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Step 2: Calculate live-intervals for each temporary. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% calculate_intervals(CFG, Liveness, Options, Target, TempMap)
+%% CFG: The Control-Flow Graph.
+%% Liveness: A map of live-in and live-out sets for each Basic-Block.
+%% TempMap: The TempMap from the register allocation
+%%
+%% This function will only consider the intervals of the temporaries
+%% that have been spilled during register allocation, and will ignore
+%% all other.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+calculate_intervals(CFG, Liveness, _Options, Target, TempMap) ->
+ Interval = empty_interval(Target:number_of_temporaries(CFG)),
+ Worklist = Target:reverse_postorder(CFG),
+ intervals(Worklist, Interval, 1, CFG, Liveness, Target, TempMap).
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% intervals(WorkList, Intervals, InstructionNr,
+%% CFG, Liveness, Target, TempMap)
+%% WorkList: List of BB-names to handle.
+%% Intervals: Intervals seen so far (sorted on register names).
+%% InstructionNr: The number of examined instructions.
+%% CFG: The Control-Flow Graph.
+%% Liveness: A map of live-in and live-out sets for each Basic-Block.
+%% Target: The backend for which we generate native code.
+%% TempMap: The TempMap from the register allocation
+%%
+%% This function will only consider the intervals of the temporaries
+%% that have been spilled during register allocation, and will ignore
+%% all other.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+intervals([L|ToDO], Intervals, InstructionNr, CFG, Liveness, Target,
+ TempMap) ->
+ ?debug_msg("Block ~w\n", [L]),
+ %% Add all variables that are live at the entry of this block
+ %% to the interval data structure.
+
+ %% Only consider spilled temporaries in LiveIn
+ LiveIn = [X || X <- livein(Liveness, L, Target),
+ hipe_temp_map:is_spilled(X, TempMap)],
+ Intervals2 = add_def_point(LiveIn, InstructionNr, Intervals),
+
+ %% Only consider spilled temporaries in LiveOut
+ LiveOut = [X2 || X2 <- liveout(Liveness, L, Target),
+ hipe_temp_map:is_spilled(X2, TempMap)],
+ ?debug_msg("In ~w -> Out ~w\n", [LiveIn, LiveOut]),
+
+ %% Traverse this block instruction by instruction and add all
+ %% uses and defines to the intervals.
+ Code = hipe_bb:code(bb(CFG, L, Target)),
+ {Intervals3, NewINr} = traverse_block(Code, InstructionNr+1,
+ Intervals2, Target, TempMap),
+
+ %% Add end points for the temporaries that are in the live-out set.
+ Intervals4 = add_use_point(LiveOut, NewINr+1, Intervals3),
+
+ intervals(ToDO, Intervals4, NewINr+1, CFG, Liveness, Target, TempMap);
+intervals([], Intervals, _, _, _, _, _) ->
+ %% Return the calculated intervals
+ interval_to_list(Intervals).
+ %% Intervals.
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% traverse_block(Code, InstructionNo, Intervals, Unchanged)
+%% Examine each instruction in the Code:
+%% For each temporary T used or defined by instruction number N:
+%% extend the interval of T to include N.
+%% TempMap: The TempMap from the register allocation
+%%
+%% This function will only consider the the instruction that have temporaries
+%% that have been spilled during register allocation, and will ignore
+%% all other.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+
+traverse_block([Instruction|Is], InstrNo, Intervals, Target, TempMap) ->
+ %% Get used temps.
+ %% Only consider spilled temporaries in the Use set.
+ UsesSet = [X || X <- uses(Instruction, Target),
+ hipe_temp_map:is_spilled(X, TempMap)],
+ %% Get defined temps.
+ %% Only consider spilled temporaries in the Def set.
+ DefsSet = [X2 || X2 <- defines(Instruction, Target),
+ hipe_temp_map:is_spilled(X2, TempMap)],
+ %% Only consider those temps that starts or ends their lifetime
+ %% within the basic block (that is remove all Unchanged temps).
+ Intervals1 = add_def_point( DefsSet, InstrNo, Intervals),
+ %% Extend the intervals for these temporaries to include InstrNo.
+ Intervals2 = add_use_point(UsesSet, InstrNo, Intervals1),
+ %% Handle the next instruction.
+ traverse_block(Is, InstrNo+1, Intervals2, Target, TempMap);
+traverse_block([], InstrNo, Intervals, _, _) ->
+ %% Return the new intervals and the number of the next instruction.
+ {Intervals,InstrNo}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Step 3. Do a linear scan allocation over the live intervals. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% allocate(Intervals, PhysicalRegisters, Target)
+%%
+%% This function performs the linear scan algorithm.
+%% Intervals contains the start and stop position of each spilled temporary,
+%% sorted on increasing startpositions
+%% StackSlots is a list of available Stack slots to use. If they run out a
+%% new stack slot is allocated from an (in theory) infinite domain.
+%%
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+allocate(Intervals, StackSlots, SpillIndex, Target) ->
+ AllocatedSlots = empty_allocation(),
+ allocate(Intervals, StackSlots, [], AllocatedSlots, SpillIndex, Target).
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% allocate(Intervals, Free, Active, Allocated, SpillIndex, Target)
+%% Iterates on each temporary interval.
+%% Intervals: The list of temporary intervals.
+%% Free: Currently available stack slots.
+%% Active: Currently used stack slots (sorted on increasing
+%% interval enpoints)
+%% Allocated: The mapping of register names to spill positions.
+%% SpillIndex: The number of spilled registers.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+allocate([TempInt|TIS], Free, Active, Alloc, SpillIndex, Target) ->
+ %% Remove from the active list those temporaries whose interval
+ %% ends before the start of the current interval.
+ {NewActive, NewFree} =
+ expire_old_intervals(Active, startpoint(TempInt), Free, Target),
+ %% Get the name of the temp in the current interval.
+ Temp = reg(TempInt),
+ case NewFree of
+ [] ->
+ %% There are no free spill slots, so we allocate a new one
+ NewSpillIndex = SpillIndex+1,
+ NewAlloc = spillalloc(Temp, SpillIndex, Alloc),
+ NewActive2 = add_active(endpoint(TempInt), SpillIndex, NewActive),
+ allocate(TIS, NewFree, NewActive2, NewAlloc, NewSpillIndex, Target);
+ [FreeSpillslot | Spillslots] ->
+ %% The spill slot FreeSpillSlot is available, let's use it.
+ allocate(TIS, Spillslots,
+ add_active(endpoint(TempInt), FreeSpillslot, NewActive),
+ spillalloc(Temp, FreeSpillslot, Alloc),
+ SpillIndex, Target)
+ end;
+allocate([], _, _, Alloc, SpillIndex, _) ->
+ %% No more register intervals to handle;
+ %% return the result sorted on regnames.
+ {lists:sort(Alloc), SpillIndex}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% expire_old_intervals(ActiveTemps, CurrentPos, FreeRegisters)
+%% Remove all temporaries that have live-ranges that ends before the
+%% current position from the active list and put them into the free
+%% list instead.
+%%
+%% ---------------------------------------------------------------------
+expire_old_intervals([Act|Acts] = AllActives, CurrentPos, Free, Target) ->
+ %% Does the live-range of the first active register end before
+ %% the current position?
+
+ %% We expand multimove before regalloc, ignore the next 2 lines.
+ %% %% We don't free registers that end at the current position,
+ %% %% since a multimove can decide to do the moves in another order...
+ case active_endpoint(Act) =< CurrentPos of
+ true -> %% Yes -> Then we can free that register.
+ Spillslot = active_spillslot(Act),
+ %% Add the spillslot to the free pool.
+ NewFree = [Spillslot|Free],
+ %% Here we could try appending the register to get a more
+ %% widespread use of registers.
+ %% Free ++ [active_spillslot(Act)]);
+ expire_old_intervals(Acts, CurrentPos, NewFree, Target);
+ false ->
+ %% No -> Then we cannot free any more temporaries.
+ %% (Since they are sorted on endpoints...)
+ {AllActives, Free}
+ end;
+expire_old_intervals([], _, Free, _) ->
+ {[], Free}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% D A T A S T R U C T U R E S %%
+%% & %%
+%% A U X I L I A R Y F U N C T I O N S %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The "allocation datastructure"
+%%
+%% This is an order list of register names paired with their allocations.
+%% {Name, Allocation}
+%% Since we are only dealing with spills, the allocation will look like:
+%% {spill, SpillIndex}
+%%
+%% ---------------------------------------------------------------------
+
+empty_allocation() -> [].
+
+spillalloc(Name, N, Allocation) -> [{Name,{spill,N}}|Allocation].
+
+%% spillalloc(Name,N,[{Name,_}|A]) ->
+%% ?debug_msg("Spilled ~w\n",[Name]),
+%% [{Name,{spill,N}}|A];
+%% spillalloc(Name,N,[{Name2,Binding}|Bindings]) when Name > Name2 ->
+%% [{Name2,Binding}|spillalloc(Name,N,Bindings)];
+%% spillalloc(Name,N,Bindings) ->
+%% [{Name,{spill,N}}|Bindings].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The active datastructure.
+%% Keeps tracks of currently active (allocated) spill slots.
+%% It is sorted on end points in the intervals
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+add_active(Endpoint, SpillSlot, [A1={P1,_}|Active]) when P1 < Endpoint ->
+ [A1|add_active(Endpoint, SpillSlot, Active)];
+add_active(Endpoint, SpillSlot, Active) ->
+ [{Endpoint, SpillSlot}|Active].
+
+active_spillslot({_,SpillSlot}) ->
+ SpillSlot.
+
+active_endpoint({EndPoint,_}) ->
+ EndPoint.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Interval data structure.
+%%
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+
+%% mk_interval(Name, Start, End) ->
+%% {Name, Start, End}.
+
+endpoint({_R,_S,Endpoint}) ->
+ Endpoint.
+
+startpoint({_R,Startpoint,_E}) ->
+ Startpoint.
+
+reg({RegName,_S,_E}) ->
+ RegName.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Intervals data structure.
+
+sort_on_start(I) ->
+ lists:keysort(2, I).
+
+-ifdef(gb_intervals).
+empty_interval(_) ->
+ gb_trees:empty().
+
+interval_to_list(Intervals) ->
+ lists:flatten(
+ lists:map(
+ fun({T, I}) when is_list(I) ->
+ lists:map(
+ fun ({none, End}) ->
+ {T,End,End};
+ ({Beg, none}) ->
+ {T,Beg, Beg}
+ end,
+ I);
+ ({T,{B,E}}) -> {T, B, E}
+ end,
+ gb_trees:to_list(Intervals))).
+
+add_use_point([Temp|Temps], Pos, Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case gb_trees:lookup(Temp, Intervals) of
+ %% This temp has an old interval...
+ {value, Value} ->
+ %% ... extend it.
+ extend_interval(Pos, Value);
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos}
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = gb_trees:enter(Temp, NewInterval, Intervals),
+ %% Add the rest of the temporaries.
+ add_use_point(Temps, Pos, Intervals2);
+add_use_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+add_def_point([Temp|Temps], Pos, Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case gb_trees:lookup(Temp, Intervals) of
+ %% This temp has an old interval...
+ {value, Value} ->
+ %% ... extend it.
+ extend_interval(Pos, Value);
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos}
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = gb_trees:enter(Temp, NewInterval, Intervals),
+ %% Add the rest of the temporaries.
+ add_def_point(Temps, Pos, Intervals2);
+add_def_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+extend_interval(Pos, {Beginning, End}) ->
+ %% If this position occurs before the beginning of the interval,
+ %% then extend the beginning to this position.
+ NewBeginning = erlang:min(Pos, Beginning),
+ %% If this position occurs after the end of the interval, then
+ %% extend the end to this position.
+ NewEnd = erlang:max(Pos, End),
+ {NewBeginning, NewEnd}.
+
+extend_def_interval(Pos, {Beginning, End}) ->
+ %% If this position occurs before the beginning of the interval,
+ %% then extend the beginning to this position.
+ NewBeginning = erlang:min(Pos, Beginning),
+ %% If this position occurs after the end of the interval, then
+ %% extend the end to this position.
+ NewEnd = erlang:max(Pos, End),
+ {NewBeginning, NewEnd};
+extend_def_interval(Pos, [{Beginning, none}|More]) ->
+ [{Pos,none}, {Beginning, none}|More];
+extend_def_interval(Pos, Intervals) ->
+ {Pos, Pos}.
+
+-else. %% ifdef gb_intervals
+
+empty_interval(N) ->
+ hipe_vectors:new(N, none).
+
+interval_to_list(Intervals) ->
+ add_indices(hipe_vectors:vector_to_list(Intervals), 0).
+
+add_indices([{B, E}|Xs], N) ->
+ [{N, B, E}|add_indices(Xs, N+1)];
+add_indices([List|Xs], N) when is_list(List) ->
+ flatten(List, N, Xs);
+add_indices([none|Xs], N) ->
+ add_indices(Xs, N+1);
+add_indices([], _N) -> [].
+
+flatten([{none, End}|Rest], N, More) ->
+ [{N,End,End} | flatten(Rest, N, More)];
+flatten([{Beg, none}|Rest], N ,More) ->
+ [{N,Beg,Beg} | flatten(Rest, N, More)];
+flatten([], N, More) ->
+ add_indices(More, N+1).
+
+add_use_point([Temp|Temps], Pos, Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case hipe_vectors:get(Intervals, Temp) of
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos};
+ %% This temp has an old interval...
+ Value ->
+ %% ... extend it.
+ extend_interval(Pos, Value)
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = hipe_vectors:set(Intervals, Temp, NewInterval),
+ %% Add the rest of the temporaries.
+ add_use_point(Temps, Pos, Intervals2);
+add_use_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+add_def_point([Temp|Temps], Pos, Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case hipe_vectors:get(Intervals, Temp) of
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos};
+ %% This temp has an old interval...
+ Value ->
+ %% ... extend it.
+ extend_interval(Pos, Value)
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = hipe_vectors:set(Intervals, Temp, NewInterval),
+ %% Add the rest of the temporaries.
+ add_def_point(Temps, Pos, Intervals2);
+add_def_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+extend_interval(Pos, {Beginning, End})
+ when is_integer(Beginning), is_integer(End) ->
+ %% If this position occurs before the beginning of the interval,
+ %% then extend the beginning to this position.
+ NewBeginning = erlang:min(Pos, Beginning),
+ %% If this position occurs after the end of the interval, then
+ %% extend the end to this position.
+ NewEnd = erlang:max(Pos, End),
+ {NewBeginning, NewEnd}.
+
+-endif. %% gb_intervals
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface to external functions.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+liveness(CFG, Target) ->
+ Target:analyze(CFG).
+
+bb(CFG, L, Target) ->
+ Target:bb(CFG, L).
+
+livein(Liveness, L, Target) ->
+ regnames(Target:livein(Liveness, L), Target).
+
+liveout(Liveness, L, Target) ->
+ regnames(Target:liveout(Liveness, L), Target).
+
+uses(I, Target) ->
+ regnames(Target:uses(I), Target).
+
+defines(I, Target) ->
+ regnames(Target:defines(I), Target).
+
+regnames(Regs, Target) ->
+ [Target:reg_nr(X) || X <- Regs].
diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl
new file mode 100644
index 0000000000..be9f095429
--- /dev/null
+++ b/lib/hipe/opt/hipe_target_machine.erl
@@ -0,0 +1,93 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% INTERFACE TO TARGET MACHINE MODEL
+%%
+%% Interfaces the instruction scheduler to the (resource) machine model.
+
+-module(hipe_target_machine).
+-export([init_resources/1,
+ init_instr_resources/2,
+ resources_available/4,
+ advance_cycle/1
+ ]).
+-export([raw_latency/2,
+ war_latency/2,
+ waw_latency/2,
+ %% m_raw_latency/2,
+ %% m_war_latency/2,
+ %% m_waw_latency/2,
+ m_raw_latency/0,
+ m_war_latency/0,
+ m_waw_latency/0,
+ br_to_unsafe_latency/2,
+ unsafe_to_br_latency/2,
+ br_br_latency/2
+ ]).
+
+-define(target,hipe_ultra_mod2).
+
+init_resources(X) ->
+ ?target:init_resources(X).
+
+init_instr_resources(X,Y) ->
+ ?target:init_instr_resources(X,Y).
+
+resources_available(X,Y,Z,W) ->
+ ?target:resources_available(X,Y,Z,W).
+
+advance_cycle(X) ->
+ ?target:advance_cycle(X).
+
+raw_latency(From,To) ->
+ ?target:raw_latency(From,To).
+
+war_latency(From,To) ->
+ ?target:war_latency(From,To).
+
+waw_latency(From,To) ->
+ ?target:waw_latency(From,To).
+
+%% m_raw_latency(From,To) ->
+%% ?target:m_raw_latency(From,To).
+
+%% m_war_latency(From,To) ->
+%% ?target:m_war_latency(From,To).
+
+%% m_waw_latency(From,To) ->
+%% ?target:m_waw_latency(From,To).
+
+m_raw_latency() ->
+ ?target:m_raw_latency().
+
+m_war_latency() ->
+ ?target:m_war_latency().
+
+m_waw_latency() ->
+ ?target:m_waw_latency().
+
+br_to_unsafe_latency(Br,U) ->
+ ?target:br_to_unsafe_latency(Br,U).
+
+unsafe_to_br_latency(U,Br) ->
+ ?target:unsafe_to_br_latency(U,Br).
+
+br_br_latency(Br1,Br2) ->
+ ?target:br_br_latency(Br1,Br2).
diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl
new file mode 100644
index 0000000000..b039eaee80
--- /dev/null
+++ b/lib/hipe/opt/hipe_ultra_mod2.erl
@@ -0,0 +1,239 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ULTRASPARC MACHINE MODEL
+%%
+%% This module is used by the scheduler.
+%% The following interface is used:
+%% ...
+%%
+%% NOTES:
+%% - the machine model is simple (on the verge of simplistic)
+%% * all FUs are pipelined => model only one cycle at a time
+%% * instruction latencies are mostly 1
+%% * floating point is left for later (I _think_ it works, but ...)
+%% - conservative: instructions that require multiple resources are
+%% modelled as 'single'; instead, they could reserve IEU+BR or whatever
+%% - possibly inefficient: I think machine state model could be turned into
+%% a bitvector.
+
+-module(hipe_ultra_mod2).
+-export([init_resources/1,
+ init_instr_resources/2,
+ resources_available/4,
+ advance_cycle/1
+ ]).
+-export([raw_latency/2,
+ war_latency/2,
+ waw_latency/2,
+ %% m_raw_latency/2,
+ %% m_war_latency/2,
+ %% m_waw_latency/2,
+ m_raw_latency/0,
+ m_war_latency/0,
+ m_waw_latency/0,
+ br_to_unsafe_latency/2,
+ unsafe_to_br_latency/2,
+ br_br_latency/2
+ ]).
+
+-include("../sparc/hipe_sparc.hrl").
+
+-define(debug(Str,Args),ok).
+%-define(debug(Str,Args),io:format(Str,Args)).
+
+-define(debug_ultra(Str,Args),ok).
+%-define(debug_ultra(Str,Args),io:format(Str,Args)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Straightforward and somewhat simplistic model for UltraSparc:
+%% - only one cycle at a time is modelled
+%% - resources are simplified:
+%% * ieu0, ieu1, ieu, mem, br, single
+%% * per-cycle state = done | { I0, I1, NumI, X, Mem, Br }
+%% * unoptimized representation (could be bit vector)
+
+init_resources(_Size) ->
+ ?debug_ultra('init res ~p~n',[_Size]),
+ empty_state().
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init_instr_resources(N,Nodes) ->
+ ultra_instr_rsrcs(Nodes,hipe_vectors:new(N, '')).
+
+ultra_instr_rsrcs([],I_res) -> I_res;
+ultra_instr_rsrcs([N|Ns],I_res) ->
+ ultra_instr_rsrcs(Ns,ultra_instr_type(N,I_res)).
+
+ultra_instr_type({N,I},I_res) ->
+ hipe_vectors:set(I_res,N-1,instr_type(I)).
+
+instr_type(I) ->
+ case I of
+ #move{} ->
+ ieu;
+ #multimove{} -> %% TODO: expand multimoves before scheduling
+ ieu;
+ #alu{} ->
+ case hipe_sparc:alu_operator(I) of
+ '>>' -> ieu0;
+ '<<' -> ieu0;
+ _ -> ieu
+ end;
+ #alu_cc{} ->
+ ieu1;
+ #sethi{} ->
+ ieu;
+ #load{} ->
+ mem;
+ #store{} ->
+ mem;
+ #b{} ->
+ br;
+ #br{} ->
+ br;
+ #goto{} ->
+ br;
+ #jmp_link{} -> % imprecise; should be mem+br?
+ single;
+ #jmp{} -> % imprecise
+ br;
+ #call_link{} -> % imprecise; should be mem+br?
+ single;
+ #cmov_cc{} -> % imprecise
+ single;
+ #cmov_r{} -> % imprecise
+ single;
+ #load_atom{} -> % should be resolved to sethi/or
+ single;
+ #load_address{} -> % should be resolved to sethi/or
+ single;
+ #load_word_index{} -> % should be resolved to sethi/or
+ single;
+ %% uncommon types:
+ #label{} ->
+ none;
+ #nop{} ->
+ none;
+ #comment{} ->
+ none;
+ _ ->
+ exit({ultrasparc_instr_type,{cant_schedule,I}})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+resources_available(_Cycle, I, Rsrc, I_res) ->
+ res_avail(instruction_resource(I_res, I), Rsrc).
+
+instruction_resource(I_res, I) ->
+ hipe_vectors:get(I_res, I-1).
+
+%% The following function checks resource availability.
+%% * all function units are assumed to be fully pipelined, so only
+%% one cycle at a time is modelled.
+%% * for IEU0 and IEU1, these must precede all generic IEU instructions
+%% (handled by X bit)
+%% * at most 2 integer instructions can issue in a cycle
+%% * mem is straightforward
+%% * br closes the cycle (= returns done).
+%% * single requires an entirely empty state and closes the cycle
+
+res_avail(ieu0, { free, I1, NumI, free, Mem, Br })
+ when is_integer(NumI), NumI < 2 ->
+ { yes, { occ, I1, NumI+1, free, Mem, Br }};
+res_avail(ieu1, { _I0, free, NumI, free, Mem, Br })
+ when is_integer(NumI), NumI < 2 ->
+ { yes, { free, occ, NumI+1, free, Mem, Br }};
+res_avail(ieu, { I0, I1, NumI, _X, Mem, Br })
+ when is_integer(NumI), NumI < 2 ->
+ { yes, { I0, I1, NumI+1, occ, Mem, Br }};
+res_avail(mem, { I0, I1, NumI, X, free, Br }) ->
+ { yes, { I0, I1, NumI, X, occ, Br }};
+res_avail(br, { _I0, _I1, _NumI, _X, _Mem, free }) ->
+ { yes, done };
+res_avail(single, { free, free, 0, free, free, free }) ->
+ { yes, done };
+res_avail(_, _) ->
+ no.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+advance_cycle(_Rsrc) ->
+ empty_state().
+
+empty_state() -> { free, free, 0, free, free, free }.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Latencies are taken from UltraSparc hardware manual
+%%
+%% *** UNFINISHED ***
+%% more precisely, they are taken from my memory of the US-manual
+%% at the moment.
+%%
+%% Note: all ld/st are assumed to hit in the L1 cache (D-cache),
+%% which is sort of imprecise.
+
+raw_latency(alu, store) -> 0;
+raw_latency(load, _) -> 2; % only if load is L1 hit
+raw_latency(alu_cc, b) -> 0;
+raw_latency(_I0, _I1) ->
+ 1.
+
+war_latency(_I0, _I1) ->
+ 0.
+
+waw_latency(_I0, _I1) ->
+ 1.
+
+%% *** UNFINISHED ***
+%% At present, all load/stores are assumed to hit in the L1 cache,
+%% which isn't really satisfying.
+
+%% m_raw_latency(_St, _Ld) ->
+%% 1.
+%%
+%% m_war_latency(_Ld, _St) ->
+%% 1.
+%%
+%% m_waw_latency(_St1, _St2) ->
+%% 1.
+
+%% Use these for 'default latencies' = do not permit reordering.
+
+m_raw_latency() ->
+ 1.
+
+m_war_latency() ->
+ 1.
+
+m_waw_latency() ->
+ 1.
+
+br_to_unsafe_latency(_BrTy, _UTy) ->
+ 0.
+
+unsafe_to_br_latency(_UTy, _BrTy) ->
+ 0.
+
+br_br_latency(_BrTy1, _BrTy2) ->
+ 0.
diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl
new file mode 100644
index 0000000000..9e2c1a0489
--- /dev/null
+++ b/lib/hipe/opt/hipe_ultra_prio.erl
@@ -0,0 +1,304 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% PRIORITY HANDLING AND PRIORITY CALCULATION
+%%
+%% Handling of ready nodes and priorities.
+%% Priorities are mainly from the critical path. More priorities are added.
+%% * One version is adding priorities just depending on the instr, so
+%% for example loads get higher priority than stores, and ordered
+%% after reg's and offset for better cache performance.
+%% * The other version gives higher priority to a node that adds more new
+%% nodes to the ready list. This one is maybe not so effectively
+%% implemented, but was added too late for smarter solutions.
+%% One version is commented away
+
+-module(hipe_ultra_prio).
+-export([init_ready/2,
+ init_instr_prio/2,
+ %% initial_ready_set/4,
+ next_ready/7,
+ add_ready_nodes/2,
+ insert_node/3
+ ]).
+
+-include("../sparc/hipe_sparc.hrl").
+
+% At first, only nodes with no predecessors are selected.
+% - if R is empty, there is an error (unless BB itself is empty)
+
+%% Arguments : Size - size of ready-array
+%% Preds - array with number of predecessors for each node
+%% Returns : An array with list of ready-nodes for each cycle.
+
+init_ready(Size, Preds) ->
+ P = hipe_vectors:size(Preds),
+ Ready = hipe_vectors:new(Size, []),
+ R = initial_ready_set(1, P, Preds, []),
+ hipe_vectors:set(Ready, 0, R).
+
+init_instr_prio(N, DAG) ->
+ critical_path(N, DAG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : initial_ready_set
+%% Argument : M - current node-index
+%% N - where to stop
+%% Preds - array with number of predecessors for each node
+%% Ready - list with ready-nodes
+%% Returns : Ready - list with ready-nodes
+%% Description : Finds all nodes with no predecessors and adds them to ready.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+initial_ready_set(M, N, Preds, Ready) ->
+ if
+ M > N ->
+ Ready;
+ true ->
+ case hipe_vectors:get(Preds, M-1) of
+ 0 ->
+ initial_ready_set(M+1, N, Preds, [M|Ready]);
+ V when is_integer(V), V > 0 ->
+ initial_ready_set(M+1, N, Preds, Ready)
+ end
+ end.
+
+%% The following handles the nodes ready to schedule:
+%% 1. select the ready queue of given cycle
+%% 2. if queue empty, return none
+%% 3. otherwise, remove entry with highest priority
+%% and return {next,Highest_Prio,NewReady}
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : next_ready
+%% Argument : C - current cycle
+%% Ready - array with ready nodes
+%% Prio - array with cpath-priorities for all nodes
+%% Nodes - indexed list [{N, Instr}]
+%% Returns : none / {next,Highest_Prio,NewReady}
+%% Description : 1. select the ready queue of given cycle
+%% 2. if queue empty, return none
+%% 3. otherwise, remove entry with highest priority
+%% and return {next,Highest_Prio,NewReady} where Highest_Prio
+%% = Id of instr and NewReady = updated ready-array.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+next_ready(C, Ready, Prio, Nodes, DAG, Preds, Earl) ->
+ Curr = hipe_vectors:get(Ready, C-1),
+ case Curr of
+ [] ->
+ none;
+ Instrs ->
+ {BestI,RestIs} =
+ get_best_instr(Instrs, Prio, Nodes, DAG, Preds, Earl, C),
+ {next,BestI,hipe_vectors:set(Ready,C-1,RestIs)}
+ end.
+
+% next_ready(C,Ready,Prio,Nodes) ->
+% Curr = hipe_vectors:get(Ready,C-1),
+% case Curr of
+% [] ->
+% none;
+% Instrs ->
+% {BestInstr,RestInstrs} = get_best_instr(Instrs, Prio, Nodes),
+% {next,BestInstr,hipe_vectors:set(Ready,C-1,RestInstrs)}
+% end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : get_best_instr
+%% Argument : Instrs - list of node-id's
+%% Prio - array with cpath-priorities for the nodes
+%% Nodes - indexed list [{Id, Instr}]
+%% Returns : {BestSoFar, Rest} - Id of best instr and the rest of id's
+%% Description : Returns the id of the instr that is the best choice.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_best_instr([Instr|Instrs], Prio, Nodes, DAG, Preds, Earl, C) ->
+ get_best_instr(Instrs, [], Instr, Prio, Nodes, DAG, Preds, Earl, C).
+
+get_best_instr([], Rest, BestSoFar, _Prio, _Nodes, _DAG, _Preds, _Earl, _C) ->
+ {BestSoFar, Rest};
+get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes,
+ DAG, Preds, Earl, C) ->
+ case better(Instr, BestSoFar, Prio, Nodes, DAG, Preds, Earl, C) of
+ true ->
+ get_best_instr(Instrs, [BestSoFar|PassedInstrs],
+ Instr, Prio, Nodes, DAG, Preds, Earl, C);
+ false ->
+ get_best_instr(Instrs, [Instr|PassedInstrs], BestSoFar, Prio,
+ Nodes, DAG, Preds, Earl, C)
+ end.
+
+% get_best_instr([Instr|Instrs], Prio, Nodes) ->
+% get_best_instr(Instrs, [], Instr, Prio, Nodes).
+
+% get_best_instr([], Rest, BestSoFar, Prio, Nodes) -> {BestSoFar, Rest};
+% get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes) ->
+% case better(Instr, BestSoFar, Prio, Nodes) of
+% true ->
+% get_best_instr(Instrs, [BestSoFar|PassedInstrs],
+% Instr, Prio, Nodes);
+% false ->
+% get_best_instr(Instrs, [Instr|PassedInstrs],BestSoFar, Prio, Nodes)
+% end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : better
+%% Argument : Instr1 - Id of instr 1
+%% Instr2 - Id of instr 2
+%% Prio - array with cpath-priorities for the nodes
+%% Nodes - indexed list [{Id, Instr}]
+%% Returns : true if Instr1 has higher priority than Instr2
+%% Description : Checks if Instr1 is a better choice than Instr2 for scheduling
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+better(Instr1, Instr2, Prio, Nodes, DAG, Preds, Earl, C) ->
+ better_hlp(priority(Instr1, Prio, Nodes, DAG, Preds, Earl, C),
+ priority(Instr2, Prio, Nodes, DAG, Preds, Earl, C)).
+
+better_hlp([], []) -> false;
+better_hlp([], [_|_]) -> false;
+better_hlp([_|_], []) -> true;
+better_hlp([X|Xs], [Y|Ys]) -> (X > Y) or ((X =:= Y) and better_hlp(Xs,Ys)).
+
+%%
+%% Returns the instr corresponding to id
+%%
+get_instr(InstrId, [{InstrId,Instr}|_]) -> Instr;
+get_instr(InstrId, [_|Xs]) -> get_instr(InstrId, Xs).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : priority
+%% Argument : InstrId - Id
+%% Prio - array with cpath-priorities for the nodes
+%% Nodes - indexed list [{Id, Instr}]
+%% Returns : PrioList - list of priorities [MostSignificant, LessSign, ...]
+%% Description : Returns a list of priorities where the first element is the
+%% cpath-priority and the rest are added depending on what kind
+%% of instr it is. Used to order loads/stores sequentially and
+%% there is possibility to add whatever stuff...
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+priority(InstrId, Prio, Nodes, DAG, Preds, Earl, C) ->
+ {ReadyNodes,_,_,_} = hipe_schedule:delete_node(C,InstrId,DAG,Preds,Earl),
+ Instr = get_instr(InstrId, Nodes),
+ Prio1 = hipe_vectors:get(Prio, InstrId-1),
+ Prio2 = length(ReadyNodes),
+ PrioRest =
+ case Instr of
+ #load_atom{} ->
+ [3];
+ #move{} ->
+ [3];
+ #load{} ->
+ Src = hipe_sparc:load_src(Instr),
+ Off = hipe_sparc:load_off(Instr),
+ case hipe_sparc:is_reg(Off) of
+ false -> [3,
+ -(hipe_sparc:reg_nr(Src)),
+ -(hipe_sparc:imm_value(Off))];
+ true -> [1]
+ end;
+ #store{} ->
+ Src = hipe_sparc:store_dest(Instr),
+ Off = hipe_sparc:store_off(Instr),
+ case hipe_sparc:is_reg(Off) of
+ false -> [2,
+ -(hipe_sparc:reg_nr(Src)),
+ -(hipe_sparc:imm_value(Off))];
+ true -> [1]
+ end;
+ _ -> [0]
+ end,
+ [Prio1,Prio2|PrioRest].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : add_ready_nodes
+%% Argument : Nodes - list of [{Cycle,Id}]
+%% Ready - array of ready nodes for all cycles
+%% Returns : NewReady - updated ready-array
+%% Description : Gets a list of instrs and adds them to the ready-array
+%% to the corresponding cycle.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+add_ready_nodes([], Ready) -> Ready;
+add_ready_nodes([{C,I}|Xs], Ready) ->
+ add_ready_nodes(Xs, insert_node(C, I, Ready)).
+
+insert_node(C, I, Ready) ->
+ Old = hipe_vectors:get(Ready, C-1),
+ hipe_vectors:set(Ready, C-1, [I|Old]).
+
+%%
+%% Computes the latency for the "most expensive" way through the graph
+%% for all nodes. Returns an array of priorities for all nodes.
+%%
+critical_path(N, DAG) ->
+ critical_path(1, N, DAG, hipe_vectors:new(N, -1)).
+
+critical_path(M, N, DAG, Prio) ->
+ if
+ M > N ->
+ Prio;
+ true ->
+ critical_path(M+1, N, DAG, cpath(M, DAG, Prio))
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : cpath
+%% Argument : M - current node id
+%% DAG - the dependence graph
+%% Prio - array of priorities for all nodes
+%% Returns : Prio - updated prio array
+%% Description : If node has prio -1, it has not been visited
+%% - otherwise, compute priority as max of priorities of
+%% successors (+ latency)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+cpath(M, DAG, Prio) ->
+ InitPrio = hipe_vectors:get(Prio, M-1),
+ if
+ InitPrio =:= -1 ->
+ cpath_node(M, DAG, Prio);
+ true ->
+ Prio
+ end.
+
+cpath_node(N, DAG, Prio) ->
+ SuccL = dag_succ(DAG, N),
+ {Max, NewPrio} = cpath_succ(SuccL, DAG, Prio),
+ hipe_vectors:set(NewPrio, N-1, Max).
+
+cpath_succ(SuccL, DAG, Prio) ->
+ cpath_succ(SuccL, DAG, Prio, 0).
+
+%% performs an unnecessary lookup of priority of Succ, but that might
+%% not be such a big deal
+
+cpath_succ([], _DAG, Prio, NodePrio) -> {NodePrio,Prio};
+cpath_succ([{Lat,Succ}|Xs], DAG, Prio, NodePrio) ->
+ NewPrio = cpath(Succ, DAG, Prio),
+ NewNodePrio = erlang:max(hipe_vectors:get(NewPrio, Succ - 1) + Lat, NodePrio),
+ cpath_succ(Xs, DAG, NewPrio, NewNodePrio).
+
+dag_succ(DAG, N) when is_integer(N) ->
+ hipe_vectors:get(DAG, N-1).
+
diff --git a/lib/hipe/ppc/Makefile b/lib/hipe/ppc/Makefile
new file mode 100644
index 0000000000..0857043527
--- /dev/null
+++ b/lib/hipe/ppc/Makefile
@@ -0,0 +1,120 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+# Please keep this list sorted.
+MODULES=hipe_ppc \
+ hipe_ppc_assemble \
+ hipe_ppc_cfg \
+ hipe_ppc_defuse \
+ hipe_ppc_encode \
+ hipe_ppc_finalise \
+ hipe_ppc_frame \
+ hipe_ppc_liveness_all \
+ hipe_ppc_liveness_fpr \
+ hipe_ppc_liveness_gpr \
+ hipe_ppc_main \
+ hipe_ppc_pp \
+ hipe_ppc_ra \
+ hipe_ppc_ra_finalise \
+ hipe_ppc_ra_ls \
+ hipe_ppc_ra_naive \
+ hipe_ppc_ra_postconditions \
+ hipe_ppc_ra_postconditions_fp \
+ hipe_ppc_registers \
+ hipe_rtl_to_ppc
+
+HRL_FILES=hipe_ppc.hrl
+ERL_FILES=$(MODULES:%=%.erl)
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+# Please keep this list sorted.
+$(EBIN)/hipe_ppc_assemble.beam: ../main/hipe.hrl ../../kernel/src/hipe_ext_format.hrl ../rtl/hipe_literals.hrl ../misc/hipe_sdi.hrl
+$(EBIN)/hipe_ppc_cfg.beam: ../flow/cfg.hrl ../flow/cfg.inc
+$(EBIN)/hipe_ppc_frame.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_ppc_liveness_all.beam: ../flow/liveness.inc
+$(EBIN)/hipe_ppc_liveness_fpr.beam: ../flow/liveness.inc
+$(EBIN)/hipe_ppc_liveness_gpr.beam: ../flow/liveness.inc
+$(EBIN)/hipe_ppc_registers.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_rtl_to_ppc.beam: ../rtl/hipe_rtl.hrl
+
+$(TARGET_FILES): hipe_ppc.hrl ../misc/hipe_consttab.hrl
diff --git a/lib/hipe/ppc/hipe_ppc.erl b/lib/hipe/ppc/hipe_ppc.erl
new file mode 100644
index 0000000000..047e86c45b
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc.erl
@@ -0,0 +1,415 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(hipe_ppc).
+-export([
+ mk_temp/2,
+ mk_new_temp/1,
+ mk_new_nonallocatable_temp/1,
+ is_temp/1,
+ temp_reg/1,
+ temp_type/1,
+ temp_is_allocatable/1,
+ temp_is_precoloured/1,
+
+ mk_simm16/1,
+ mk_uimm16/1,
+
+ mk_mfa/3,
+
+ mk_prim/1,
+ is_prim/1,
+ prim_prim/1,
+
+ mk_sdesc/4,
+
+ mk_alu/4,
+
+ mk_b_fun/2,
+
+ mk_b_label/1,
+
+ mk_bc/3,
+
+ mk_bctr/1,
+
+ mk_bctrl/1,
+
+ mk_bl/3,
+
+ mk_blr/0,
+
+ mk_cmp/3,
+
+ mk_comment/1,
+
+ mk_label/1,
+ is_label/1,
+ label_label/1,
+
+ mk_li/2,
+ mk_li/3,
+ mk_addi/4,
+
+ mk_load/4,
+ mk_loadx/4,
+ mk_load/6,
+ ldop_to_ldxop/1,
+
+ mk_mfspr/2,
+
+ mk_mtcr/1,
+
+ mk_mtspr/2,
+
+ mk_pseudo_bc/4,
+ negate_bcond/1,
+
+ mk_pseudo_call/4,
+ pseudo_call_contlab/1,
+ pseudo_call_func/1,
+ pseudo_call_sdesc/1,
+ pseudo_call_linkage/1,
+
+ mk_pseudo_call_prepare/1,
+ pseudo_call_prepare_nrstkargs/1,
+
+ mk_pseudo_li/2,
+
+ mk_pseudo_move/2,
+ is_pseudo_move/1,
+ pseudo_move_dst/1,
+ pseudo_move_src/1,
+
+ mk_pseudo_tailcall/4,
+ pseudo_tailcall_func/1,
+ pseudo_tailcall_stkargs/1,
+ pseudo_tailcall_linkage/1,
+
+ mk_pseudo_tailcall_prepare/0,
+
+ mk_store/4,
+ mk_storex/4,
+ mk_store/6,
+ stop_to_stxop/1,
+
+ mk_unary/3,
+
+ mk_lfd/3,
+ mk_lfdx/3,
+ mk_fload/4,
+
+ %% mk_stfd/3,
+ mk_stfdx/3,
+ mk_fstore/4,
+
+ mk_fp_binary/4,
+
+ mk_fp_unary/3,
+
+ mk_pseudo_fmove/2,
+ is_pseudo_fmove/1,
+ pseudo_fmove_dst/1,
+ pseudo_fmove_src/1,
+
+ mk_defun/8,
+ defun_mfa/1,
+ defun_formals/1,
+ defun_is_closure/1,
+ defun_is_leaf/1,
+ defun_code/1,
+ defun_data/1,
+ defun_var_range/1]).
+
+-include("hipe_ppc.hrl").
+
+mk_temp(Reg, Type, Allocatable) ->
+ #ppc_temp{reg=Reg, type=Type, allocatable=Allocatable}.
+mk_temp(Reg, Type) -> mk_temp(Reg, Type, true).
+mk_new_temp(Type, Allocatable) ->
+ mk_temp(hipe_gensym:get_next_var(ppc), Type, Allocatable).
+mk_new_temp(Type) -> mk_new_temp(Type, true).
+mk_new_nonallocatable_temp(Type) -> mk_new_temp(Type, false).
+is_temp(X) -> case X of #ppc_temp{} -> true; _ -> false end.
+temp_reg(#ppc_temp{reg=Reg}) -> Reg.
+temp_type(#ppc_temp{type=Type}) -> Type.
+temp_is_allocatable(#ppc_temp{allocatable=A}) -> A.
+temp_is_precoloured(#ppc_temp{reg=Reg,type=Type}) ->
+ case Type of
+ 'double' -> hipe_ppc_registers:is_precoloured_fpr(Reg);
+ _ -> hipe_ppc_registers:is_precoloured_gpr(Reg)
+ end.
+
+mk_simm16(Value) -> #ppc_simm16{value=Value}.
+mk_uimm16(Value) -> #ppc_uimm16{value=Value}.
+
+mk_mfa(M, F, A) -> #ppc_mfa{m=M, f=F, a=A}.
+
+mk_prim(Prim) -> #ppc_prim{prim=Prim}.
+is_prim(X) -> case X of #ppc_prim{} -> true; _ -> false end.
+prim_prim(#ppc_prim{prim=Prim}) -> Prim.
+
+mk_sdesc(ExnLab, FSize, Arity, Live) ->
+ #ppc_sdesc{exnlab=ExnLab, fsize=FSize, arity=Arity, live=Live}.
+
+mk_alu(AluOp, Dst, Src1, Src2) ->
+ #alu{aluop=AluOp, dst=Dst, src1=Src1, src2=Src2}.
+
+mk_b_fun(Fun, Linkage) -> #b_fun{'fun'=Fun, linkage=Linkage}.
+
+mk_b_label(Label) -> #b_label{label=Label}.
+
+mk_bc(BCond, Label, Pred) -> #bc{bcond=BCond, label=Label, pred=Pred}.
+
+mk_bctr(Labels) -> #bctr{labels=Labels}.
+
+mk_bctrl(SDesc) -> #bctrl{sdesc=SDesc}.
+
+mk_bl(Fun, SDesc, Linkage) -> #bl{'fun'=Fun, sdesc=SDesc, linkage=Linkage}.
+
+mk_blr() -> #blr{}.
+
+mk_cmp(CmpOp, Src1, Src2) -> #cmp{cmpop=CmpOp, src1=Src1, src2=Src2}.
+
+mk_comment(Term) -> #comment{term=Term}.
+
+mk_label(Label) -> #label{label=Label}.
+is_label(I) -> case I of #label{} -> true; _ -> false end.
+label_label(#label{label=Label}) -> Label.
+
+%%% Load an integer constant into a register.
+mk_li(Dst, Value) -> mk_li(Dst, Value, []).
+
+mk_li(Dst, Value, Tail) ->
+ R0 = mk_temp(0, 'untagged'),
+ mk_addi(Dst, R0, Value, Tail).
+
+mk_addi(Dst, R0, Value, Tail) ->
+ Low = at_l(Value),
+ High = at_ha(Value),
+ case High of
+ 0 ->
+ [mk_alu('addi', Dst, R0, mk_simm16(Low)) |
+ Tail];
+ _ ->
+ case Low of
+ 0 ->
+ [mk_alu('addis', Dst, R0, mk_simm16(High)) |
+ Tail];
+ _ ->
+ [mk_alu('addi', Dst, R0, mk_simm16(Low)),
+ mk_alu('addis', Dst, Dst, mk_simm16(High)) |
+ Tail]
+ end
+ end.
+
+at_l(Value) ->
+ simm16sext(Value band 16#FFFF).
+
+at_ha(Value) ->
+ simm16sext(((Value + 16#8000) bsr 16) band 16#FFFF).
+
+simm16sext(Value) ->
+ if Value >= 32768 -> (-1 bsl 16) bor Value;
+ true -> Value
+ end.
+
+mk_li_new(Dst, Value, Tail) -> % Dst may be R0
+ R0 = mk_temp(0, 'untagged'),
+ case at_ha(Value) of
+ 0 ->
+ %% Value[31:16] are the sign-extension of Value[15].
+ %% Use a single addi to load and sign-extend 16 bits.
+ [mk_alu('addi', Dst, R0, mk_simm16(at_l(Value))) |
+ Tail];
+ _ ->
+ %% Use addis to load the high 16 bits, followed by an
+ %% optional ori to load non sign-extended low 16 bits.
+ High = simm16sext((Value bsr 16) band 16#FFFF),
+ [mk_alu('addis', Dst, R0, mk_simm16(High)) |
+ case (Value band 16#FFFF) of
+ 0 -> Tail;
+ Low ->
+ [mk_alu('ori', Dst, Dst, mk_uimm16(Low)) |
+ Tail]
+ end]
+ end.
+
+mk_load(LDop, Dst, Disp, Base) ->
+ #load{ldop=LDop, dst=Dst, disp=Disp, base=Base}.
+
+mk_loadx(LdxOp, Dst, Base1, Base2) ->
+ #loadx{ldxop=LdxOp, dst=Dst, base1=Base1, base2=Base2}.
+
+mk_load(LdOp, Dst, Offset, Base, Scratch, Rest) when is_integer(Offset) ->
+ if Offset >= -32768, Offset =< 32767 ->
+ [mk_load(LdOp, Dst, Offset, Base) | Rest];
+ true ->
+ LdxOp = ldop_to_ldxop(LdOp),
+ Index =
+ begin
+ DstReg = temp_reg(Dst),
+ BaseReg = temp_reg(Base),
+ if DstReg =/= BaseReg -> Dst;
+ true -> mk_scratch(Scratch)
+ end
+ end,
+ mk_li_new(Index, Offset,
+ [mk_loadx(LdxOp, Dst, Base, Index) | Rest])
+ end.
+
+ldop_to_ldxop(LdOp) ->
+ case LdOp of
+ 'lbz' -> 'lbzx';
+ 'lha' -> 'lhax';
+ 'lhz' -> 'lhzx';
+ 'lwz' -> 'lwzx'
+ end.
+
+mk_scratch(Scratch) ->
+ case Scratch of
+ 0 -> mk_temp(0, 'untagged');
+ 'new' -> mk_new_temp('untagged')
+ end.
+
+mk_mfspr(Dst, Spr) -> #mfspr{dst=Dst, spr=Spr}.
+
+mk_mtcr(Src) -> #mtcr{src=Src}.
+
+mk_mtspr(Spr, Src) -> #mtspr{spr=Spr, src=Src}.
+
+mk_pseudo_bc(BCond, TrueLab, FalseLab, Pred) ->
+ if Pred >= 0.5 ->
+ mk_pseudo_bc_simple(negate_bcond(BCond), FalseLab,
+ TrueLab, 1.0-Pred);
+ true ->
+ mk_pseudo_bc_simple(BCond, TrueLab, FalseLab, Pred)
+ end.
+
+mk_pseudo_bc_simple(BCond, TrueLab, FalseLab, Pred) when Pred =< 0.5 ->
+ #pseudo_bc{bcond=BCond, true_label=TrueLab,
+ false_label=FalseLab, pred=Pred}.
+
+negate_bcond(BCond) ->
+ case BCond of
+ 'lt' -> 'ge';
+ 'ge' -> 'lt';
+ 'gt' -> 'le';
+ 'le' -> 'gt';
+ 'eq' -> 'ne';
+ 'ne' -> 'eq';
+ 'so' -> 'ns';
+ 'ns' -> 'so'
+ end.
+
+mk_pseudo_call(FunC, SDesc, ContLab, Linkage) ->
+ #pseudo_call{func=FunC, sdesc=SDesc, contlab=ContLab, linkage=Linkage}.
+pseudo_call_func(#pseudo_call{func=FunC}) -> FunC.
+pseudo_call_sdesc(#pseudo_call{sdesc=SDesc}) -> SDesc.
+pseudo_call_contlab(#pseudo_call{contlab=ContLab}) -> ContLab.
+pseudo_call_linkage(#pseudo_call{linkage=Linkage}) -> Linkage.
+
+mk_pseudo_call_prepare(NrStkArgs) ->
+ #pseudo_call_prepare{nrstkargs=NrStkArgs}.
+pseudo_call_prepare_nrstkargs(#pseudo_call_prepare{nrstkargs=NrStkArgs}) ->
+ NrStkArgs.
+
+mk_pseudo_li(Dst, Imm) -> #pseudo_li{dst=Dst, imm=Imm}.
+
+mk_pseudo_move(Dst, Src) -> #pseudo_move{dst=Dst, src=Src}.
+is_pseudo_move(I) -> case I of #pseudo_move{} -> true; _ -> false end.
+pseudo_move_dst(#pseudo_move{dst=Dst}) -> Dst.
+pseudo_move_src(#pseudo_move{src=Src}) -> Src.
+
+mk_pseudo_tailcall(FunC, Arity, StkArgs, Linkage) ->
+ #pseudo_tailcall{func=FunC, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
+pseudo_tailcall_func(#pseudo_tailcall{func=FunC}) -> FunC.
+pseudo_tailcall_stkargs(#pseudo_tailcall{stkargs=StkArgs}) -> StkArgs.
+pseudo_tailcall_linkage(#pseudo_tailcall{linkage=Linkage}) -> Linkage.
+
+mk_pseudo_tailcall_prepare() -> #pseudo_tailcall_prepare{}.
+
+mk_store(STop, Src, Disp, Base) ->
+ #store{stop=STop, src=Src, disp=Disp, base=Base}.
+
+mk_storex(StxOp, Src, Base1, Base2) ->
+ #storex{stxop=StxOp, src=Src, base1=Base1, base2=Base2}.
+
+mk_store(StOp, Src, Offset, Base, Scratch, Rest)when is_integer(Offset) ->
+ if Offset >= -32768, Offset =< 32767 ->
+ [mk_store(StOp, Src, Offset, Base) | Rest];
+ true ->
+ StxOp = stop_to_stxop(StOp),
+ Index = mk_scratch(Scratch),
+ mk_li_new(Index, Offset,
+ [mk_storex(StxOp, Src, Base, Index) | Rest])
+ end.
+
+stop_to_stxop(StOp) ->
+ case StOp of
+ 'stb' -> 'stbx';
+ 'sth' -> 'sthx';
+ 'stw' -> 'stwx'
+ end.
+
+mk_unary(UnOp, Dst, Src) -> #unary{unop=UnOp, dst=Dst, src=Src}.
+
+mk_lfd(Dst, Disp, Base) -> #lfd{dst=Dst, disp=Disp, base=Base}.
+mk_lfdx(Dst, Base1, Base2) -> #lfdx{dst=Dst, base1=Base1, base2=Base2}.
+mk_fload(Dst, Offset, Base, Scratch) when is_integer(Offset) ->
+ if Offset >= -32768, Offset =< 32767 ->
+ [mk_lfd(Dst, Offset, Base)];
+ true ->
+ Index = mk_scratch(Scratch),
+ mk_li_new(Index, Offset, [mk_lfdx(Dst, Base, Index)])
+ end.
+
+mk_stfd(Src, Disp, Base) -> #stfd{src=Src, disp=Disp, base=Base}.
+mk_stfdx(Src, Base1, Base2) -> #stfdx{src=Src, base1=Base1, base2=Base2}.
+mk_fstore(Src, Offset, Base, Scratch) when is_integer(Offset) ->
+ if Offset >= -32768, Offset =< 32767 ->
+ [mk_stfd(Src, Offset, Base)];
+ true ->
+ Index = mk_scratch(Scratch),
+ mk_li_new(Index, Offset, [mk_stfdx(Src, Base, Index)])
+ end.
+
+mk_fp_binary(FpBinOp, Dst, Src1, Src2) ->
+ #fp_binary{fp_binop=FpBinOp, dst=Dst, src1=Src1, src2=Src2}.
+
+mk_fp_unary(FpUnOp, Dst, Src) -> #fp_unary{fp_unop=FpUnOp, dst=Dst, src=Src}.
+
+mk_pseudo_fmove(Dst, Src) -> #pseudo_fmove{dst=Dst, src=Src}.
+is_pseudo_fmove(I) -> case I of #pseudo_fmove{} -> true; _ -> false end.
+pseudo_fmove_dst(#pseudo_fmove{dst=Dst}) -> Dst.
+pseudo_fmove_src(#pseudo_fmove{src=Src}) -> Src.
+
+mk_defun(MFA, Formals, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
+ #defun{mfa=MFA, formals=Formals, code=Code, data=Data,
+ isclosure=IsClosure, isleaf=IsLeaf,
+ var_range=VarRange, label_range=LabelRange}.
+defun_mfa(#defun{mfa=MFA}) -> MFA.
+defun_formals(#defun{formals=Formals}) -> Formals.
+defun_is_closure(#defun{isclosure=IsClosure}) -> IsClosure.
+defun_is_leaf(#defun{isleaf=IsLeaf}) -> IsLeaf.
+defun_code(#defun{code=Code}) -> Code.
+defun_data(#defun{data=Data}) -> Data.
+defun_var_range(#defun{var_range=VarRange}) -> VarRange.
diff --git a/lib/hipe/ppc/hipe_ppc.hrl b/lib/hipe/ppc/hipe_ppc.hrl
new file mode 100644
index 0000000000..25e7ae0b5f
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc.hrl
@@ -0,0 +1,118 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+
+
+%%%--------------------------------------------------------------------
+%%% Basic Values:
+%%%
+%%% temp ::= {ppc_temp, reg, type, allocatable}
+%%% reg ::= <token from hipe_ppc_registers>
+%%% type ::= tagged | untagged
+%%% allocatable ::= true | false
+%%%
+%%% sdesc ::= {ppc_sdesc, exnlab, fsize, arity, live}
+%%% exnlab ::= [] | label
+%%% fsize ::= int32 (frame size in words)
+%%% live ::= <tuple of int32> (word offsets)
+%%% arity ::= uint8
+%%%
+%%% mfa ::= {ppc_mfa, atom, atom, arity}
+%%% prim ::= {ppc_prim, atom}
+
+-record(ppc_mfa, {m::atom(), f::atom(), a::arity()}).
+-record(ppc_prim, {prim}).
+-record(ppc_sdesc, {exnlab, fsize, arity::arity(), live}).
+-record(ppc_simm16, {value}).
+-record(ppc_temp, {reg, type, allocatable}).
+-record(ppc_uimm16, {value}).
+
+%%% Instruction Operands:
+%%%
+%%% aluop ::= add | add. | addi | addic. | addis | addo. | subf | subf. | subfo.
+%%% | and | and. | andi. | or | or. | ori | xor | xor. | xori
+%%% | slw | slw. | slwi | slwi. | srw | srw. | srwi | srwi.
+%%% | sraw | sraw. | srawi | srawi. | mulli | mullw | mullw. | mullwo.
+%%% bcond ::= eq | ne | gt | ge | lt | le | so | ns
+%%% cmpop ::= cmp | cmpi | cmpl | cmpli
+%%% ldop ::= lbz | lha | lhz | lwz
+%%% ldxop ::= lbzx | lhax | lhzx | lwzx | lhbrx | lwbrx
+%%% stop ::= stb | stw (HW has sth, but we don't use it)
+%%% stxop ::= stbx | stwx (HW has sthx/sthbrx/stwbrx, but we don't use them)
+%%% unop ::= extsb | extsh | {rlwinm,SH,MB,ME} | {rlwinm.,SH,MB,ME}
+%%%
+%%% immediate ::= int32 | atom | {label, label_type}
+%%% label_type ::= constant | closure | c_const
+%%%
+%%% dst ::= temp
+%%% src ::= temp
+%%% | simm16 | uimm16 (only in alu.src2, cmp.src2)
+%%% base ::= temp
+%%% disp ::= sint16 (untagged simm16)
+%%%
+%%% fun ::= mfa | prim
+%%% func ::= mfa | prim | 'ctr'
+%%%
+%%% spr ::= ctr | lr | xer
+
+%%% Instructions:
+
+-record(alu, {aluop, dst, src1, src2}).
+-record(b_fun, {'fun', linkage}). % known tailcall
+-record(b_label, {label}). % local jump, unconditional
+-record(bc, {bcond, label, pred}). % local jump, conditional
+-record(bctr, {labels}). % computed tailcall or switch
+-record(bctrl, {sdesc}). % computed recursive call
+-record(bl, {'fun', sdesc, linkage}). % known recursive call
+-record(blr, {}). % unconditional bclr (return)
+-record(cmp, {cmpop, src1, src2}).
+-record(comment, {term}).
+-record(label, {label}).
+-record(load, {ldop, dst, disp, base}). % non-indexed, non-update form
+-record(loadx, {ldxop, dst, base1, base2}). % indexed, non-update form
+-record(mfspr, {dst, spr}). % for reading LR and XER
+-record(mtcr, {src}). % for copying XER[CA] to CR0[EQ] via a temp
+-record(mtspr, {spr, src}). % for writing LR, CTR, and XER
+-record(pseudo_bc, {bcond, true_label, false_label, pred}).
+-record(pseudo_call, {func, sdesc, contlab, linkage}).
+-record(pseudo_call_prepare, {nrstkargs}).
+-record(pseudo_li, {dst, imm}).
+-record(pseudo_move, {dst, src}).
+-record(pseudo_tailcall, {func, arity, stkargs, linkage}).
+-record(pseudo_tailcall_prepare, {}).
+-record(store, {stop, src, disp, base}). % non-indexed, non-update form
+-record(storex, {stxop, src, base1, base2}).% indexed, non-update form
+-record(unary, {unop, dst, src}).
+-record(lfd, {dst, disp, base}).
+-record(lfdx, {dst, base1, base2}).
+-record(stfd, {src, disp, base}).
+-record(stfdx, {src, base1, base2}).
+-record(fp_binary, {fp_binop, dst, src1, src2}).
+-record(fp_unary, {fp_unop, dst, src}).
+-record(pseudo_fmove, {dst, src}).
+
+%%% Function definitions.
+
+-include("../misc/hipe_consttab.hrl").
+
+-record(defun, {mfa :: mfa(), formals, code,
+ data :: hipe_consttab(),
+ isclosure :: boolean(),
+ isleaf :: boolean(),
+ var_range, label_range}).
diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl
new file mode 100644
index 0000000000..6f06f8b841
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_assemble.erl
@@ -0,0 +1,603 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(hipe_ppc_assemble).
+-export([assemble/4]).
+
+-include("../main/hipe.hrl"). % for VERSION_STRING, when_option
+-include("hipe_ppc.hrl").
+-include("../../kernel/src/hipe_ext_format.hrl").
+-include("../rtl/hipe_literals.hrl").
+-include("../misc/hipe_sdi.hrl").
+-undef(ASSERT).
+-define(ASSERT(G), if G -> [] ; true -> exit({assertion_failed,?MODULE,?LINE,??G}) end).
+
+assemble(CompiledCode, Closures, Exports, Options) ->
+ print("****************** Assembling *******************\n", [], Options),
+ %%
+ Code = [{MFA,
+ hipe_ppc:defun_code(Defun),
+ hipe_ppc:defun_data(Defun)}
+ || {MFA, Defun} <- CompiledCode],
+ %%
+ {ConstAlign,ConstSize,ConstMap,RefsFromConsts} =
+ hipe_pack_constants:pack_constants(Code, 4),
+ %%
+ {CodeSize,CodeBinary,AccRefs,LabelMap,ExportMap} =
+ encode(translate(Code, ConstMap), Options),
+ print("Total num bytes=~w\n", [CodeSize], Options),
+ %%
+ SC = hipe_pack_constants:slim_constmap(ConstMap),
+ DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap),
+ SSE = slim_sorted_exportmap(ExportMap,Closures,Exports),
+ SlimRefs = hipe_pack_constants:slim_refs(AccRefs),
+ Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC},
+ ConstAlign, ConstSize,
+ SC,
+ DataRelocs, % nee LM, LabelMap
+ SSE,
+ CodeSize,CodeBinary,SlimRefs,
+ 0,[] % ColdCodeSize, SlimColdRefs
+ ]),
+ %%
+ Bin.
+
+%%%
+%%% Assembly Pass 1.
+%%% Process initial {MFA,Code,Data} list.
+%%% Translate each MFA's body, choosing operand & instruction kinds.
+%%%
+%%% Assembly Pass 2.
+%%% Perform short/long form optimisation for jumps.
+%%%
+%%% Result is {MFA,NewCode,CodeSize,LabelMap} list.
+%%%
+
+translate(Code, ConstMap) ->
+ translate_mfas(Code, ConstMap, []).
+
+translate_mfas([{MFA,Insns,_Data}|Code], ConstMap, NewCode) ->
+ {NewInsns,CodeSize,LabelMap} =
+ translate_insns(Insns, MFA, ConstMap, hipe_sdi:pass1_init(), 0, []),
+ translate_mfas(Code, ConstMap, [{MFA,NewInsns,CodeSize,LabelMap}|NewCode]);
+translate_mfas([], _ConstMap, NewCode) ->
+ lists:reverse(NewCode).
+
+translate_insns([I|Insns], MFA, ConstMap, SdiPass1, Address, NewInsns) ->
+ NewIs = translate_insn(I, MFA, ConstMap),
+ add_insns(NewIs, Insns, MFA, ConstMap, SdiPass1, Address, NewInsns);
+translate_insns([], _MFA, _ConstMap, SdiPass1, Address, NewInsns) ->
+ {LabelMap,CodeSizeIncr} = hipe_sdi:pass2(SdiPass1),
+ {lists:reverse(NewInsns), Address+CodeSizeIncr, LabelMap}.
+
+add_insns([I|Is], Insns, MFA, ConstMap, SdiPass1, Address, NewInsns) ->
+ NewSdiPass1 =
+ case I of
+ {'.label',L,_} ->
+ hipe_sdi:pass1_add_label(SdiPass1, Address, L);
+ {bc_sdi,{_,{label,L},_},_} ->
+ SdiInfo = #sdi_info{incr=(8-4),lb=-16#2000*4,ub=16#1FFF*4},
+ hipe_sdi:pass1_add_sdi(SdiPass1, Address, L, SdiInfo);
+ _ ->
+ SdiPass1
+ end,
+ Address1 = Address + insn_size(I),
+ add_insns(Is, Insns, MFA, ConstMap, NewSdiPass1, Address1, [I|NewInsns]);
+add_insns([], Insns, MFA, ConstMap, SdiPass1, Address, NewInsns) ->
+ translate_insns(Insns, MFA, ConstMap, SdiPass1, Address, NewInsns).
+
+insn_size(I) ->
+ case I of
+ {'.label',_,_} -> 0;
+ {'.reloc',_,_} -> 0;
+ _ -> 4 % bc_sdi included in this case
+ end.
+
+translate_insn(I, MFA, ConstMap) -> % -> [{Op,Opnd,OrigI}]
+ case I of
+ #alu{} -> do_alu(I);
+ #b_fun{} -> do_b_fun(I);
+ #b_label{} -> do_b_label(I);
+ #bc{} -> do_bc(I);
+ #bctr{} -> do_bctr(I);
+ #bctrl{} -> do_bctrl(I);
+ #bl{} -> do_bl(I);
+ #blr{} -> do_blr(I);
+ #comment{} -> [];
+ #cmp{} -> do_cmp(I);
+ #label{} -> do_label(I);
+ #load{} -> do_load(I);
+ #loadx{} -> do_loadx(I);
+ #mfspr{} -> do_mfspr(I);
+ #mtcr{} -> do_mtcr(I);
+ #mtspr{} -> do_mtspr(I);
+ %% pseudo_bc: eliminated before assembly
+ %% pseudo_call: eliminated before assembly
+ %% pseudo_call_prepare: eliminated before assembly
+ #pseudo_li{} -> do_pseudo_li(I, MFA, ConstMap);
+ %% pseudo_move: eliminated before assembly
+ %% pseudo_tailcall: eliminated before assembly
+ %% pseudo_tailcall_prepare: eliminated before assembly
+ #store{} -> do_store(I);
+ #storex{} -> do_storex(I);
+ #unary{} -> do_unary(I);
+ #lfd{} -> do_lfd(I);
+ #stfd{} -> do_stfd(I);
+ #fp_binary{} -> do_fp_binary(I);
+ #fp_unary{} -> do_fp_unary(I);
+ _ -> exit({?MODULE,translate_insn,I})
+ end.
+
+do_alu(I) ->
+ #alu{aluop=AluOp,dst=Dst,src1=Src1,src2=Src2} = I,
+ NewDst = do_reg(Dst),
+ NewSrc1 = do_reg(Src1),
+ NewSrc2 = do_reg_or_imm(Src2),
+ {NewI,NewOpnds} =
+ case AluOp of
+ 'slwi' -> {'rlwinm', do_slwi_opnds(NewDst, NewSrc1, NewSrc2)};
+ 'slwi.' -> {'rlwinm.', do_slwi_opnds(NewDst, NewSrc1, NewSrc2)};
+ 'srwi' -> {'rlwinm', do_srwi_opnds(NewDst, NewSrc1, NewSrc2)};
+ 'srwi.' -> {'rlwinm.', do_srwi_opnds(NewDst, NewSrc1, NewSrc2)};
+ 'srawi' -> {'srawi', {NewDst,NewSrc1,do_srawi_src2(NewSrc2)}};
+ 'srawi.' -> {'srawi.', {NewDst,NewSrc1,do_srawi_src2(NewSrc2)}};
+ _ -> {AluOp, {NewDst,NewSrc1,NewSrc2}}
+ end,
+ [{NewI, NewOpnds, I}].
+
+do_slwi_opnds(Dst, Src1, {uimm,N}) when is_integer(N), 0 =< N, N < 32 ->
+ {Dst, Src1, {sh,N}, {mb,0}, {me,31-N}}.
+
+do_srwi_opnds(Dst, Src1, {uimm,N}) when is_integer(N), 0 =< N, N < 32 ->
+ {Dst, Src1, {sh,32-N}, {mb,N}, {me,31}}.
+
+do_srawi_src2({uimm,N}) when is_integer(N), 0 =< N, N < 32 -> {sh,N}.
+
+do_b_fun(I) ->
+ #b_fun{'fun'=Fun,linkage=Linkage} = I,
+ [{'.reloc', {b_fun,Fun,Linkage}, #comment{term='fun'}},
+ {b, {{li,0}}, I}].
+
+do_b_label(I) ->
+ #b_label{label=Label} = I,
+ [{b, do_label_ref(Label), I}].
+
+do_bc(I) ->
+ #bc{bcond=BCond,label=Label,pred=Pred} = I,
+ [{bc_sdi, {{bcond,BCond},do_label_ref(Label),{pred,Pred}}, I}].
+
+do_bctr(I) ->
+ [{bcctr, {{bo,2#10100},{bi,0}}, I}].
+
+do_bctrl(I) ->
+ #bctrl{sdesc=SDesc} = I,
+ [{bcctrl, {{bo,2#10100},{bi,0}}, I},
+ {'.reloc', {sdesc,SDesc}, #comment{term=sdesc}}].
+
+do_bl(I) ->
+ #bl{'fun'=Fun,sdesc=SDesc,linkage=Linkage} = I,
+ [{'.reloc', {b_fun,Fun,Linkage}, #comment{term='fun'}},
+ {bl, {{li,0}}, I},
+ {'.reloc', {sdesc,SDesc}, #comment{term=sdesc}}].
+
+do_blr(I) ->
+ [{bclr, {{bo,2#10100},{bi,0}}, I}].
+
+do_cmp(I) ->
+ #cmp{cmpop=CmpOp,src1=Src1,src2=Src2} = I,
+ NewSrc1 = do_reg(Src1),
+ NewSrc2 = do_reg_or_imm(Src2),
+ [{CmpOp, {{crf,0},0,NewSrc1,NewSrc2}, I}].
+
+do_label(I) ->
+ #label{label=Label} = I,
+ [{'.label', Label, I}].
+
+do_load(I) ->
+ #load{ldop=LdOp,dst=Dst,disp=Disp,base=Base} = I,
+ NewDst = do_reg(Dst),
+ NewDisp = do_disp(Disp),
+ NewBase = do_reg(Base),
+ [{LdOp, {NewDst,NewDisp,NewBase}, I}].
+
+do_loadx(I) ->
+ #loadx{ldxop=LdxOp,dst=Dst,base1=Base1,base2=Base2} = I,
+ NewDst = do_reg(Dst),
+ NewBase1 = do_reg(Base1),
+ NewBase2 = do_reg(Base2),
+ [{LdxOp, {NewDst,NewBase1,NewBase2}, I}].
+
+do_mfspr(I) ->
+ #mfspr{dst=Dst,spr=SPR} = I,
+ NewDst = do_reg(Dst),
+ NewSPR = do_spr(SPR),
+ [{mfspr, {NewDst,NewSPR}, I}].
+
+do_mtcr(I) ->
+ #mtcr{src=Src} = I,
+ NewSrc = do_reg(Src),
+ [{mtcrf, {{crm,16#80},NewSrc}, I}].
+
+do_mtspr(I) ->
+ #mtspr{spr=SPR,src=Src} = I,
+ NewSPR = do_spr(SPR),
+ NewSrc = do_reg(Src),
+ [{mtspr, {NewSPR,NewSrc}, I}].
+
+do_pseudo_li(I, MFA, ConstMap) ->
+ #pseudo_li{dst=Dst,imm=Imm} = I,
+ RelocData =
+ case Imm of
+ Atom when is_atom(Atom) ->
+ {load_atom, Atom};
+%%% {mfa,MFAorPrim,Linkage} ->
+%%% Tag =
+%%% case Linkage of
+%%% remote -> remote_function;
+%%% not_remote -> local_function
+%%% end,
+%%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}};
+ {Label,constant} ->
+ ConstNo = find_const({MFA,Label}, ConstMap),
+ {load_address, {constant,ConstNo}};
+ {Label,closure} ->
+ {load_address, {closure,Label}};
+ {Label,c_const} ->
+ {load_address, {c_const,Label}}
+ end,
+ NewDst = do_reg(Dst),
+ Simm0 = {simm,0},
+ [{'.reloc', RelocData, #comment{term=reloc}},
+ {addi, {NewDst,{r,0},Simm0}, I},
+ {addis, {NewDst,NewDst,Simm0}, I}].
+
+do_store(I) ->
+ #store{stop=StOp,src=Src,disp=Disp,base=Base} = I,
+ NewSrc = do_reg(Src),
+ NewDisp = do_disp(Disp),
+ NewBase = do_reg(Base),
+ [{StOp, {NewSrc,NewDisp,NewBase}, I}].
+
+do_storex(I) ->
+ #storex{stxop=StxOp,src=Src,base1=Base1,base2=Base2} = I,
+ NewSrc = do_reg(Src),
+ NewBase1 = do_reg(Base1),
+ NewBase2 = do_reg(Base2),
+ [{StxOp, {NewSrc,NewBase1,NewBase2}, I}].
+
+do_unary(I) ->
+ #unary{unop=UnOp,dst=Dst,src=Src} = I,
+ NewDst = do_reg(Dst),
+ NewSrc = do_reg(Src),
+ {NewI,NewOpnds} =
+ case UnOp of
+ {RLWINM,SH,MB,ME} -> {RLWINM, {NewDst,NewSrc,{sh,SH},{mb,MB},{me,ME}}};
+ _ -> {UnOp, {NewDst,NewSrc}}
+ end,
+ [{NewI, NewOpnds, I}].
+
+do_lfd(I) ->
+ #lfd{dst=Dst,disp=Disp,base=Base} = I,
+ NewDst = do_fpreg(Dst),
+ NewDisp = do_disp(Disp),
+ NewBase = do_reg(Base),
+ [{lfd, {NewDst,NewDisp,NewBase}, I}].
+
+do_stfd(I) ->
+ #stfd{src=Src,disp=Disp,base=Base} = I,
+ NewSrc = do_fpreg(Src),
+ NewDisp = do_disp(Disp),
+ NewBase = do_reg(Base),
+ [{stfd, {NewSrc,NewDisp,NewBase}, I}].
+
+do_fp_binary(I) ->
+ #fp_binary{fp_binop=FpBinOp,dst=Dst,src1=Src1,src2=Src2} = I,
+ NewDst = do_fpreg(Dst),
+ NewSrc1 = do_fpreg(Src1),
+ NewSrc2 = do_fpreg(Src2),
+ [{FpBinOp, {NewDst,NewSrc1,NewSrc2}, I}].
+
+do_fp_unary(I) ->
+ #fp_unary{fp_unop=FpUnOp,dst=Dst,src=Src} = I,
+ NewDst = do_fpreg(Dst),
+ NewSrc = do_fpreg(Src),
+ [{FpUnOp, {NewDst,NewSrc}, I}].
+
+do_fpreg(#ppc_temp{reg=Reg,type='double'}) when is_integer(Reg), 0 =< Reg, Reg < 32 ->
+ {fr,Reg}.
+
+do_reg(#ppc_temp{reg=Reg,type=Type})
+ when is_integer(Reg), 0 =< Reg, Reg < 32, Type =/= 'double' ->
+ {r,Reg}.
+
+do_label_ref(Label) when is_integer(Label) ->
+ {label,Label}. % symbolic, since offset is not yet computable
+
+do_reg_or_imm(Src) ->
+ case Src of
+ #ppc_temp{} ->
+ do_reg(Src);
+ #ppc_simm16{value=Value} when is_integer(Value), -32768 =< Value, Value =< 32767 ->
+ {simm, Value band 16#ffff};
+ #ppc_uimm16{value=Value} when is_integer(Value), 0 =< Value, Value =< 65535 ->
+ {uimm, Value}
+ end.
+
+do_disp(Disp) when is_integer(Disp), -32768 =< Disp, Disp =< 32767 ->
+ {d, Disp band 16#ffff}.
+
+do_spr(SPR) ->
+ SPR_NR =
+ case SPR of
+ 'xer' -> 1;
+ 'lr' -> 8;
+ 'ctr' -> 9
+ end,
+ {spr,SPR_NR}.
+
+%%%
+%%% Assembly Pass 3.
+%%% Process final {MFA,Code,CodeSize,LabelMap} list from pass 2.
+%%% Translate to a single binary code segment.
+%%% Collect relocation patches.
+%%% Build ExportMap (MFA-to-address mapping).
+%%% Combine LabelMaps to a single one (for mk_data_relocs/2 compatibility).
+%%% Return {CombinedCodeSize,BinaryCode,Relocs,CombinedLabelMap,ExportMap}.
+%%%
+
+encode(Code, Options) ->
+ CodeSize = compute_code_size(Code, 0),
+ ExportMap = build_export_map(Code, 0, []),
+ {AccCode,Relocs} = encode_mfas(Code, 0, [], [], Options),
+ CodeBinary = list_to_binary(lists:reverse(AccCode)),
+ ?ASSERT(CodeSize =:= byte_size(CodeBinary)),
+ CombinedLabelMap = combine_label_maps(Code, 0, gb_trees:empty()),
+ {CodeSize,CodeBinary,Relocs,CombinedLabelMap,ExportMap}.
+
+compute_code_size([{_MFA,_Insns,CodeSize,_LabelMap}|Code], Size) ->
+ compute_code_size(Code, Size+CodeSize);
+compute_code_size([], Size) -> Size.
+
+build_export_map([{{M,F,A},_Insns,CodeSize,_LabelMap}|Code], Address, ExportMap) ->
+ build_export_map(Code, Address+CodeSize, [{Address,M,F,A}|ExportMap]);
+build_export_map([], _Address, ExportMap) -> ExportMap.
+
+combine_label_maps([{MFA,_Insns,CodeSize,LabelMap}|Code], Address, CLM) ->
+ NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM),
+ combine_label_maps(Code, Address+CodeSize, NewCLM);
+combine_label_maps([], _Address, CLM) -> CLM.
+
+merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) ->
+ NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM),
+ merge_label_map(Rest, MFA, Address, NewCLM);
+merge_label_map([], _MFA, _Address, CLM) -> CLM.
+
+encode_mfas([{MFA,Insns,CodeSize,LabelMap}|Code], Address, AccCode, Relocs, Options) ->
+ print("Generating code for: ~w\n", [MFA], Options),
+ print("Offset | Opcode | Instruction\n", [], Options),
+ {Address1,Relocs1,AccCode1} =
+ encode_insns(Insns, Address, Address, LabelMap, Relocs, AccCode, Options),
+ ExpectedAddress = Address + CodeSize,
+ ?ASSERT(Address1 =:= ExpectedAddress),
+ print("Finished.\n", [], Options),
+ encode_mfas(Code, Address1, AccCode1, Relocs1, Options);
+encode_mfas([], _Address, AccCode, Relocs, _Options) ->
+ {AccCode,Relocs}.
+
+encode_insns([I|Insns], Address, FunAddress, LabelMap, Relocs, AccCode, Options) ->
+ case I of
+ {'.label',L,_} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ ?ASSERT(Address =:= LabelAddress), % sanity check
+ print_insn(Address, [], I, Options),
+ encode_insns(Insns, Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ {'.reloc',Data,_} ->
+ Reloc = encode_reloc(Data, Address, FunAddress, LabelMap),
+ encode_insns(Insns, Address, FunAddress, LabelMap, [Reloc|Relocs], AccCode, Options);
+ {bc_sdi,_,_} ->
+ encode_insns(fix_bc_sdi(I, Insns, Address, FunAddress, LabelMap),
+ Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ _ ->
+ {Op,Arg,_} = fix_jumps(I, Address, FunAddress, LabelMap),
+ Word = hipe_ppc_encode:insn_encode(Op, Arg),
+ print_insn(Address, Word, I, Options),
+ Segment = <<Word:32/integer-big>>,
+ NewAccCode = [Segment|AccCode],
+ encode_insns(Insns, Address+4, FunAddress, LabelMap, Relocs, NewAccCode, Options)
+ end;
+encode_insns([], Address, _FunAddress, _LabelMap, Relocs, AccCode, _Options) ->
+ {Address,Relocs,AccCode}.
+
+encode_reloc(Data, Address, FunAddress, LabelMap) ->
+ case Data of
+ {b_fun,MFAorPrim,Linkage} ->
+ %% b and bl are patched the same, so no need to distinguish
+ %% call from tailcall
+ PatchTypeExt =
+ case Linkage of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ {PatchTypeExt, Address, untag_mfa_or_prim(MFAorPrim)};
+ {load_atom,Atom} ->
+ {?LOAD_ATOM, Address, Atom};
+ {load_address,X} ->
+ {?LOAD_ADDRESS, Address, X};
+ {sdesc,SDesc} ->
+ #ppc_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live} = SDesc,
+ ExnRA =
+ case ExnLab of
+ [] -> []; % don't cons up a new one
+ ExnLab -> gb_trees:get(ExnLab, LabelMap) + FunAddress
+ end,
+ {?SDESC, Address,
+ ?STACK_DESC(ExnRA, FSize, Arity, Live)}
+ end.
+
+untag_mfa_or_prim(#ppc_mfa{m=M,f=F,a=A}) -> {M,F,A};
+untag_mfa_or_prim(#ppc_prim{prim=Prim}) -> Prim.
+
+fix_bc_sdi(I, Insns, InsnAddress, FunAddress, LabelMap) ->
+ {bc_sdi,Opnds,OrigI} = I,
+ {{bcond,BCond},Label,{pred,Pred}} = Opnds,
+ {label,L} = Label,
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ BD = (LabelAddress - InsnAddress) div 4,
+ if BD >= -(16#2000), BD =< 16#1FFF ->
+ [{bc, Opnds, OrigI} | Insns];
+ true ->
+ NewBCond = hipe_ppc:negate_bcond(BCond),
+ NewPred = 1.0 - Pred,
+ [{bc,
+ {{bcond,NewBCond},'.+8',{pred,NewPred}},
+ #bc{bcond=NewBCond,label='.+8',pred=NewPred}}, %% pp will be ugly
+ {b, Label, #b_label{label=L}} |
+ Insns]
+ end.
+
+fix_jumps(I, InsnAddress, FunAddress, LabelMap) ->
+ case I of
+ {b, {label,L}, OrigI} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ LI = (LabelAddress - InsnAddress) div 4,
+ %% ensure LI fits in a 24 bit sign-extended field
+ ?ASSERT(LI =< 16#7FFFFF),
+ ?ASSERT(LI >= -(16#800000)),
+ {b, {{li,LI band 16#FFFFFF}}, OrigI};
+ {bc, {{bcond,BCond},Target,{pred,Pred}}, OrigI} ->
+ LabelAddress =
+ case Target of
+ {label,L} -> gb_trees:get(L, LabelMap) + FunAddress;
+ '.+8' -> InsnAddress + 8
+ end,
+ BD = (LabelAddress - InsnAddress) div 4,
+ %% ensure BD fits in a 14 bit sign-extended field
+ ?ASSERT(BD =< 16#1FFF),
+ ?ASSERT(BD >= -(16#2000)),
+ {BO1,BI} = split_bcond(BCond),
+ BO = mk_bo(BO1, Pred, BD),
+ {bc, {{bo,BO},{bi,BI},{bd,BD band 16#3FFF}}, OrigI};
+ _ -> I
+ end.
+
+split_bcond(BCond) -> % {BO[1], BI for CR0}
+ case BCond of
+ 'lt' -> {1, 2#0000};
+ 'ge' -> {0, 2#0000}; % not lt
+ 'gt' -> {1, 2#0001};
+ 'le' -> {0, 2#0001}; % not gt
+ 'eq' -> {1, 2#0010};
+ 'ne' -> {0, 2#0010}; % not eq
+ 'so' -> {1, 2#0011};
+ 'ns' -> {0, 2#0011} % not so
+ end.
+
+mk_bo(BO1, Pred, BD) ->
+ (BO1 bsl 3) bor 2#00100 bor mk_y(Pred, BD).
+
+mk_y(Pred, BD) ->
+ if Pred < 0.5 -> % not taken
+ if BD < 0 -> 1; true -> 0 end;
+ true -> % taken
+ if BD < 0 -> 0; true -> 1 end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+mk_data_relocs(RefsFromConsts, LabelMap) ->
+ lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])).
+
+mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) ->
+ Map = [case Label of
+ {L,Pos} ->
+ Offset = find({MFA,L}, LabelMap),
+ {Pos,Offset};
+ {sorted,Base,OrderedLabels} ->
+ {sorted, Base, [begin
+ Offset = find({MFA,L}, LabelMap),
+ {Order, Offset}
+ end
+ || {L,Order} <- OrderedLabels]}
+ end
+ || Label <- Labels],
+ %% msg("Map: ~w Map\n",[Map]),
+ mk_data_relocs(Rest, LabelMap, [Map,Acc]);
+mk_data_relocs([],_,Acc) -> Acc.
+
+find({_MFA,_L} = MFAL,LabelMap) ->
+ gb_trees:get(MFAL, LabelMap).
+
+slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) ->
+ IsClosure = lists:member({M,F,A}, Closures),
+ IsExported = is_exported(F, A, Exports),
+ [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)];
+slim_sorted_exportmap([],_,_) -> [].
+
+is_exported(F, A, Exports) -> lists:member({F,A}, Exports).
+
+%%%
+%%% Assembly listing support (pp_asm option).
+%%%
+
+print(String, Arglist, Options) ->
+ ?when_option(pp_asm, Options, io:format(String, Arglist)).
+
+print_insn(Address, Word, I, Options) ->
+ ?when_option(pp_asm, Options, print_insn_2(Address, Word, I)).
+
+print_insn_2(Address, Word, {_,_,OrigI}) ->
+ io:format("~8.16.0b | ", [Address]),
+ print_code_list(word_to_bytes(Word), 0),
+ hipe_ppc_pp:pp_insn(OrigI).
+
+word_to_bytes(W) ->
+ case W of
+ [] -> []; % label or other pseudo instruction
+ _ -> [(W bsr 24) band 16#FF, (W bsr 16) band 16#FF,
+ (W bsr 8) band 16#FF, W band 16#FF]
+ end.
+
+print_code_list([Byte|Rest], Len) ->
+ print_byte(Byte),
+ print_code_list(Rest, Len+1);
+print_code_list([], Len) ->
+ fill_spaces(8-(Len*2)),
+ io:format(" | ").
+
+print_byte(Byte) ->
+ io:format("~2.16.0b", [Byte band 16#FF]).
+
+fill_spaces(N) when N > 0 ->
+ io:format(" "),
+ fill_spaces(N-1);
+fill_spaces(0) ->
+ [].
+
+%%%
+%%% Lookup a constant in a ConstMap.
+%%%
+
+find_const({MFA,Label}, [{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) ->
+ ConstNo;
+find_const(N, [_|R]) ->
+ find_const(N, R);
+find_const(C, []) ->
+ ?EXIT({constant_not_found,C}).
diff --git a/lib/hipe/ppc/hipe_ppc_cfg.erl b/lib/hipe/ppc/hipe_ppc_cfg.erl
new file mode 100644
index 0000000000..13a7754831
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_cfg.erl
@@ -0,0 +1,131 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_cfg).
+
+-export([init/1,
+ labels/1, start_label/1,
+ succ/2,
+ bb/2, bb_add/3]).
+-export([postorder/1]).
+-export([linearise/1, params/1, reverse_postorder/1]).
+-export([arity/1]).
+%%%-export([redirect_jmp/3, arity/1]).
+
+%%% these tell cfg.inc what to define (ugly as hell)
+-define(BREADTH_ORDER,true).
+-define(PARAMS_NEEDED,true).
+-define(START_LABEL_UPDATE_NEEDED,true).
+
+-include("hipe_ppc.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/cfg.inc").
+
+init(Defun) ->
+ Code = hipe_ppc:defun_code(Defun),
+ StartLab = hipe_ppc:label_label(hd(Code)),
+ Data = hipe_ppc:defun_data(Defun),
+ IsClosure = hipe_ppc:defun_is_closure(Defun),
+ Name = hipe_ppc:defun_mfa(Defun),
+ IsLeaf = hipe_ppc:defun_is_leaf(Defun),
+ Formals = hipe_ppc:defun_formals(Defun),
+ CFG0 = mk_empty_cfg(Name, StartLab, Data, IsClosure, IsLeaf, Formals),
+ take_bbs(Code, CFG0).
+
+is_branch(I) ->
+ case I of
+ #b_fun{} -> true;
+ #b_label{} -> true;
+ %% not bc
+ #bctr{} -> true;
+ %% not bctrl
+ %% not bl
+ #blr{} -> true;
+ #pseudo_bc{} -> true;
+ #pseudo_call{} -> true;
+ #pseudo_tailcall{} -> true;
+ _ -> false
+ end.
+
+branch_successors(Branch) ->
+ case Branch of
+ #b_fun{} -> [];
+ #b_label{label=Label} -> [Label];
+ #bctr{labels=Labels} -> Labels;
+ #blr{} -> [];
+ #pseudo_bc{true_label=TrueLab,false_label=FalseLab} -> [FalseLab,TrueLab];
+ #pseudo_call{contlab=ContLab, sdesc=#ppc_sdesc{exnlab=ExnLab}} ->
+ case ExnLab of
+ [] -> [ContLab];
+ _ -> [ContLab,ExnLab]
+ end;
+ #pseudo_tailcall{} -> []
+ end.
+
+-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
+fails_to(_Instr) -> [].
+-endif.
+
+-ifdef(notdef).
+redirect_jmp(I, Old, New) ->
+ case I of
+ #b_label{label=Label} ->
+ if Old =:= Label -> I#b_label{label=New};
+ true -> I
+ end;
+ #pseudo_bc{true_label=TrueLab, false_label=FalseLab} ->
+ I1 = if Old =:= TrueLab -> I#pseudo_bc{true_label=New};
+ true -> I
+ end,
+ if Old =:= FalseLab -> I1#pseudo_bc{false_label=New};
+ true -> I1
+ end;
+ %% handle pseudo_call too?
+ _ -> I
+ end.
+-endif.
+
+mk_goto(Label) ->
+ hipe_ppc:mk_b_label(Label).
+
+is_label(I) ->
+ hipe_ppc:is_label(I).
+
+label_name(Label) ->
+ hipe_ppc:label_label(Label).
+
+mk_label(Name) ->
+ hipe_ppc:mk_label(Name).
+
+linearise(CFG) -> % -> defun, not insn list
+ MFA = function(CFG),
+ Formals = params(CFG),
+ Code = linearize_cfg(CFG),
+ Data = data(CFG),
+ VarRange = hipe_gensym:var_range(ppc),
+ LabelRange = hipe_gensym:label_range(ppc),
+ IsClosure = is_closure(CFG),
+ IsLeaf = is_leaf(CFG),
+ hipe_ppc:mk_defun(MFA, Formals, IsClosure, IsLeaf,
+ Code, Data, VarRange, LabelRange).
+
+arity(CFG) ->
+ {_M, _F, A} = function(CFG),
+ A.
diff --git a/lib/hipe/ppc/hipe_ppc_defuse.erl b/lib/hipe/ppc/hipe_ppc_defuse.erl
new file mode 100644
index 0000000000..03a8f82abf
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_defuse.erl
@@ -0,0 +1,145 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_defuse).
+-export([insn_def_all/1, insn_use_all/1]).
+-export([insn_def_gpr/1, insn_use_gpr/1]).
+-export([insn_def_fpr/1, insn_use_fpr/1]).
+-include("hipe_ppc.hrl").
+
+%%%
+%%% Defs and uses for both general-purpose and floating-point registers.
+%%% This is needed for the frame module, alas.
+%%%
+insn_def_all(I) ->
+ addtemps(insn_def_fpr(I), insn_def_gpr(I)).
+
+insn_use_all(I) ->
+ addtemps(insn_use_fpr(I), insn_use_gpr(I)).
+
+%%%
+%%% Defs and uses for general-purpose (integer) registers only.
+%%%
+insn_def_gpr(I) ->
+ case I of
+ #alu{dst=Dst} -> [Dst];
+ #load{dst=Dst} -> [Dst];
+ #loadx{dst=Dst} -> [Dst];
+ #mfspr{dst=Dst} -> [Dst];
+ #pseudo_call{} -> call_clobbered_gpr();
+ #pseudo_li{dst=Dst} -> [Dst];
+ #pseudo_move{dst=Dst} -> [Dst];
+ #pseudo_tailcall_prepare{} -> tailcall_clobbered_gpr();
+ #unary{dst=Dst} -> [Dst];
+ _ -> []
+ end.
+
+call_clobbered_gpr() ->
+ [hipe_ppc:mk_temp(R, T)
+ || {R,T} <- hipe_ppc_registers:call_clobbered() ++ all_fp_pseudos()].
+
+all_fp_pseudos() -> []. % XXX: for now
+
+tailcall_clobbered_gpr() ->
+ [hipe_ppc:mk_temp(R, T)
+ || {R,T} <- hipe_ppc_registers:tailcall_clobbered() ++ all_fp_pseudos()].
+
+insn_use_gpr(I) ->
+ case I of
+ #alu{src1=Src1,src2=Src2} -> addsrc(Src2, [Src1]);
+ #blr{} ->
+ [hipe_ppc:mk_temp(hipe_ppc_registers:return_value(), 'tagged')];
+ #cmp{src1=Src1,src2=Src2} -> addsrc(Src2, [Src1]);
+ #load{base=Base} -> [Base];
+ #loadx{base1=Base1,base2=Base2} -> addtemp(Base1, [Base2]);
+ #mtcr{src=Src} -> [Src];
+ #mtspr{src=Src} -> [Src];
+ #pseudo_call{sdesc=#ppc_sdesc{arity=Arity}} -> arity_use_gpr(Arity);
+ #pseudo_move{src=Src} -> [Src];
+ #pseudo_tailcall{arity=Arity,stkargs=StkArgs} ->
+ addsrcs(StkArgs, addtemps(tailcall_clobbered_gpr(), arity_use_gpr(Arity)));
+ #store{src=Src,base=Base} -> addtemp(Src, [Base]);
+ #storex{src=Src,base1=Base1,base2=Base2} ->
+ addtemp(Src, addtemp(Base1, [Base2]));
+ #unary{src=Src} -> [Src];
+ #lfd{base=Base} -> [Base];
+ #lfdx{base1=Base1,base2=Base2} -> addtemp(Base1, [Base2]);
+ #stfd{base=Base} -> [Base];
+ #stfdx{base1=Base1,base2=Base2} -> addtemp(Base1, [Base2]);
+ _ -> []
+ end.
+
+arity_use_gpr(Arity) ->
+ [hipe_ppc:mk_temp(R, 'tagged')
+ || R <- hipe_ppc_registers:args(Arity)].
+
+addsrcs([Arg|Args], Set) ->
+ addsrcs(Args, addsrc(Arg, Set));
+addsrcs([], Set) ->
+ Set.
+
+addsrc(Src, Set) ->
+ case Src of
+ #ppc_temp{} -> addtemp(Src, Set);
+ _ -> Set
+ end.
+
+%%%
+%%% Defs and uses for floating-point registers only.
+%%%
+insn_def_fpr(I) ->
+ case I of
+ #pseudo_call{} -> call_clobbered_fpr();
+ #lfd{dst=Dst} -> [Dst];
+ #lfdx{dst=Dst} -> [Dst];
+ #fp_binary{dst=Dst} -> [Dst];
+ #fp_unary{dst=Dst} -> [Dst];
+ #pseudo_fmove{dst=Dst} -> [Dst];
+ _ -> []
+ end.
+
+call_clobbered_fpr() ->
+ [hipe_ppc:mk_temp(R, 'double') || R <- hipe_ppc_registers:allocatable_fpr()].
+
+insn_use_fpr(I) ->
+ case I of
+ #stfd{src=Src} -> [Src];
+ #stfdx{src=Src} -> [Src];
+ #fp_binary{src1=Src1,src2=Src2} -> addtemp(Src1, [Src2]);
+ #fp_unary{src=Src} -> [Src];
+ #pseudo_fmove{src=Src} -> [Src];
+ _ -> []
+ end.
+
+%%%
+%%% Auxiliary operations on sets of temps
+%%% These sets are small. No point using gb_trees, right?
+%%%
+
+addtemps([Arg|Args], Set) ->
+ addtemps(Args, addtemp(Arg, Set));
+addtemps([], Set) ->
+ Set.
+
+addtemp(Temp, Set) ->
+ case lists:member(Temp, Set) of
+ false -> [Temp|Set];
+ _ -> Set
+ end.
diff --git a/lib/hipe/ppc/hipe_ppc_encode.erl b/lib/hipe/ppc/hipe_ppc_encode.erl
new file mode 100644
index 0000000000..97cb0bf635
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_encode.erl
@@ -0,0 +1,1558 @@
+%%% -*- erlang-indent-level: 4 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Encode symbolic PowerPC instructions to binary form.
+%%% Copyright (C) 2003-2005, 2009 Mikael Pettersson
+%%%
+%%% Notes:
+%%% - PowerPC manuals use reversed bit numbering. In a 32-bit word,
+%%% the most significant bit has number 0, and the least significant
+%%% bit has number 31.
+%%% - PowerPC manuals list opcodes in decimal, not hex.
+%%% - This module does not support AltiVec instructions.
+%%%
+%%% Instruction Operands:
+%%%
+%%% {li,LI} long branch offset/address (24 bits, signed)
+%%% {bo,BO} branch control operand (5 bits, restricted)
+%%% {bi,BI} branch CR field and bits operand (5 bits)
+%%% {bd,BD} branch offset (14 bits, signed)
+%%% {to,TO} trap condition (5 bits)
+%%% {nb,NB} number of bytes to copy (5 bits)
+%%% {sh,SH} shift count (5 bits)
+%%% {mb,MB} mask begin bit number (5 bits)
+%%% {mb6,MB6} mask begin bit number (6 bits) (64-bit)
+%%% {me,ME} mask end bit number (5 bits)
+%%% {me6,ME6} mask end bit number (6 bits) (64-bit)
+%%% {sr,SR} segment register (4 bits)
+%%% {crimm,IMM} FPSCR CR image (4 bits)
+%%% {simm,SIMM} immediate operand (16 bits, signed)
+%%% {uimm,UIMM} immediate operand (16 bits, unsigned)
+%%% {d,Disp} load/store byte displacement (16 bits, signed)
+%%% {ds,DS} load/store word displacement (14 bits, signed) (64-bit)
+%%% {r,R} integer register (5 bits)
+%%% {fr,FR} floating-point register (5 bits)
+%%% {crf,CRF} CR field number (3 bits)
+%%% {crb,CRB} CR bit number (5 bits)
+%%% {tbr,TBR} TBR number (10 bits, 268 or 269)
+%%% {spr,SPR} SPR number (10 bits)
+%%% {crm,CRM} CR fields set (8 bits)
+%%% {fm,FM} FPSCR fields set (8 bits)
+
+-module(hipe_ppc_encode).
+
+-export([insn_encode/2]).
+
+%-define(TESTING,1).
+-ifdef(TESTING).
+-export([dotest/0, dotest/1]).
+-endif.
+
+-define(ASSERT(G), if G -> [] ; true -> exit({assertion_failed,?MODULE,?LINE,??G}) end).
+
+-define(BF(LB,RB,V), bf(LB,RB,V)).
+
+bf(LeftBit, RightBit, Value) ->
+ ?ASSERT(LeftBit >= 0),
+ ?ASSERT(LeftBit =< RightBit),
+ ?ASSERT(RightBit < 32),
+ ?ASSERT(Value >= 0),
+ ?ASSERT(Value < (1 bsl ((RightBit - LeftBit) + 1))),
+ Value bsl (31 - RightBit).
+
+-define(BIT(Pos,Val), ?BF(Pos,Pos,Val)).
+-define(BITS(N,Val), ?BF(32-N,31,Val)).
+
+%%% I-Form Instructions
+%%% b, ba, bl, bla
+
+b_AA_LK({{li,LI}}, AA, LK) ->
+ ?BF(0,5,10#18) bor ?BF(6,29,LI) bor ?BIT(30,AA) bor ?BIT(31,LK).
+
+%%% B-Form Instructions
+%%% bc, bca, bcl, bcla
+
+bc_AA_LK({{bo,BO}, {bi,BI}, {bd,BD}}, AA, LK) ->
+ ?BF(0,5,10#16) bor ?BF(6,10,BO) bor ?BF(11,15,BI) bor ?BF(16,29,BD) bor ?BIT(30,AA) bor ?BIT(31,LK).
+
+%%% SC-Form Instructions
+%%% sc
+
+sc({}) ->
+ ?BF(0,5,10#17) bor ?BIT(30,1).
+
+%%% D-Form Instructions
+%%% addi, addic, addic., addis, mulli, subfic
+%%% andi., andis., ori, oris, xori, xoris
+%%% lbz, lbzu, lha, lhau, lhz, lhzu, lwz, lwzu, lfd, lfdu, lfs, lfsu, lmw
+%%% stb, stbu, sth, sthu, stw, stwu, stfd, stfdu, stfs, stfsu, stmw
+%%% cmpi, cmpli, twi
+%%% tdi (64-bit)
+
+d_form(OPCD, D, A, IMM) ->
+ ?BF(0,5,OPCD) bor ?BF(6,10,D) bor ?BF(11,15,A) bor ?BF(16,31,IMM).
+
+d_form_D_A_SIMM(OPCD, {{r,D}, {r,A}, {simm,SIMM}}) ->
+ d_form(OPCD, D, A, SIMM).
+
+addi(Opnds) -> d_form_D_A_SIMM(10#14, Opnds).
+addic(Opnds) -> d_form_D_A_SIMM(10#12, Opnds).
+addic_dot(Opnds) -> d_form_D_A_SIMM(10#13, Opnds).
+addis(Opnds) -> d_form_D_A_SIMM(10#15, Opnds).
+mulli(Opnds) -> d_form_D_A_SIMM(10#07, Opnds).
+subfic(Opnds) -> d_form_D_A_SIMM(10#08, Opnds).
+
+d_form_S_A_UIMM(OPCD, {{r,A}, {r,S}, {uimm,UIMM}}) ->
+ d_form(OPCD, S, A, UIMM).
+
+andi_dot(Opnds) -> d_form_S_A_UIMM(10#28, Opnds).
+andis_dot(Opnds) -> d_form_S_A_UIMM(10#29, Opnds).
+ori(Opnds) -> d_form_S_A_UIMM(10#24, Opnds).
+oris(Opnds) -> d_form_S_A_UIMM(10#25, Opnds).
+xori(Opnds) -> d_form_S_A_UIMM(10#26, Opnds).
+xoris(Opnds) -> d_form_S_A_UIMM(10#27, Opnds).
+
+d_form_D_A_d_simple(OPCD, {{r,D}, {d,Disp}, {r,A}}) ->
+ d_form(OPCD, D, A, Disp).
+
+d_form_D_A_d_update(OPCD, {{r,D}, {d,Disp}, {r,A}}) ->
+ ?ASSERT(A =/= 0),
+ ?ASSERT(A =/= D),
+ d_form(OPCD, D, A, Disp).
+
+lbz(Opnds) -> d_form_D_A_d_simple(10#34, Opnds).
+lbzu(Opnds) -> d_form_D_A_d_update(10#35, Opnds).
+lha(Opnds) -> d_form_D_A_d_simple(10#42, Opnds).
+lhau(Opnds) -> d_form_D_A_d_update(10#43, Opnds).
+lhz(Opnds) -> d_form_D_A_d_simple(10#40, Opnds).
+lhzu(Opnds) -> d_form_D_A_d_update(10#41, Opnds).
+lwz(Opnds) -> d_form_D_A_d_simple(10#32, Opnds).
+lwzu(Opnds) -> d_form_D_A_d_update(10#33, Opnds).
+
+d_form_frD_A_d_simple(OPCD, {{fr,D}, {d,Disp}, {r,A}}) ->
+ d_form(OPCD, D, A, Disp).
+
+d_form_frD_A_d_update(OPCD, {{fr,D}, {d,Disp}, {r,A}}) ->
+ ?ASSERT(A =/= 0),
+ d_form(OPCD, D, A, Disp).
+
+lfd(Opnds) -> d_form_frD_A_d_simple(10#50, Opnds).
+lfdu(Opnds) -> d_form_frD_A_d_update(10#51, Opnds).
+lfs(Opnds) -> d_form_frD_A_d_simple(10#48, Opnds).
+lfsu(Opnds) -> d_form_frD_A_d_update(10#49, Opnds).
+
+lmw({{r,D}, {d,Disp}, {r,A}}) ->
+ ?ASSERT(A < D),
+ d_form(10#46, D, A, Disp).
+
+d_form_S_A_d_simple(OPCD, {{r,S}, {d,Disp}, {r,A}}) ->
+ d_form(OPCD, S, A, Disp).
+
+d_form_S_A_d_update(OPCD, {{r,S}, {d,Disp}, {r,A}}) ->
+ ?ASSERT(A =/= 0),
+ d_form(OPCD, S, A, Disp).
+
+stb(Opnds) -> d_form_S_A_d_simple(10#38, Opnds).
+stbu(Opnds) -> d_form_S_A_d_update(10#39, Opnds).
+sth(Opnds) -> d_form_S_A_d_simple(10#44, Opnds).
+sthu(Opnds) -> d_form_S_A_d_update(10#45, Opnds).
+stmw(Opnds) -> d_form_S_A_d_simple(10#47, Opnds).
+stw(Opnds) -> d_form_S_A_d_simple(10#36, Opnds).
+stwu(Opnds) -> d_form_S_A_d_update(10#37, Opnds).
+
+d_form_frS_A_d_simple(OPCD, {{fr,S}, {d,Disp}, {r,A}}) ->
+ d_form(OPCD, S, A, Disp).
+
+d_form_frS_A_d_update(OPCD, {{fr,S}, {d,Disp}, {r,A}}) ->
+ ?ASSERT(A =/= 0),
+ d_form(OPCD, S, A, Disp).
+
+stfd(Opnds) -> d_form_frS_A_d_simple(10#54, Opnds).
+stfdu(Opnds) -> d_form_frS_A_d_update(10#55, Opnds).
+stfs(Opnds) -> d_form_frS_A_d_simple(10#52, Opnds).
+stfsu(Opnds) -> d_form_frS_A_d_update(10#53, Opnds).
+
+cmpi({{crf,CRFD}, L, {r,A}, {simm,SIMM}}) ->
+ %% ?ASSERT(L == 0), % L must be zero in 32-bit code
+ d_form(10#11, (CRFD bsl 2) bor L, A, SIMM).
+
+cmpli({{crf,CRFD}, L, {r,A}, {uimm,UIMM}}) ->
+ %% ?ASSERT(L == 0), % L must be zero in 32-bit code
+ d_form(10#10, (CRFD bsl 2) bor L, A, UIMM).
+
+d_form_OPCD_TO_A_SIMM(OPCD, {{to,TO}, {r,A}, {simm,SIMM}}) ->
+ d_form(OPCD, TO, A, SIMM).
+
+tdi(Opnds) -> d_form_OPCD_TO_A_SIMM(10#02, Opnds). % 64-bit
+twi(Opnds) -> d_form_OPCD_TO_A_SIMM(10#03, Opnds).
+
+%%% DS-Form Instructions
+%%% ld, ldu, lwa, std, stdu (64-bit)
+
+ds_form(OPCD, D, A, DS, XO) ->
+ ?BF(0,5,OPCD) bor ?BF(6,10,D) bor ?BF(11,15,A) bor ?BF(16,29,DS) bor ?BF(30,31,XO).
+
+ds_form_D_A_DS_XO_simple(OPCD, {{r,D}, {ds,DS}, {r,A}}, XO) ->
+ ds_form(OPCD, D, A, DS, XO).
+
+ds_form_D_A_DS_XO_update(OPCD, {{r,D}, {ds,DS}, {r,A}}, XO) ->
+ ?ASSERT(A =/= 0),
+ ?ASSERT(A =/= D),
+ ds_form(OPCD, D, A, DS, XO).
+
+ld(Opnds) -> ds_form_D_A_DS_XO_simple(10#58, Opnds, 10#0). % 64-bit
+ldu(Opnds) -> ds_form_D_A_DS_XO_update(10#58, Opnds, 10#1). % 64-bit
+lwa(Opnds) -> ds_form_D_A_DS_XO_simple(10#58, Opnds, 10#2). % 64-bit
+std(Opnds) -> ds_form_D_A_DS_XO_simple(10#62, Opnds, 10#0). % 64-bit
+stdu(Opnds) -> ds_form_D_A_DS_XO_update(10#62, Opnds, 10#1). % 64-bit
+
+%%% X-Form Instructions
+%%% ecixw, lbzux, lbzx, lhaux, lhax, lhbrx, lhzux, lhzx, lwarx, lwbrx, lwzux, lwzx, lswx
+%%% lwaux, lwax (64-bit)
+%%% lfdux, lfdx, lfsux, lfsx
+%%% lswi
+%%% fabs, fctiw, fctiwz, fmr, fnabs, fneg, frsp
+%%% fcfid, fctid, fctidz (64-bit)
+%%% mfsrin
+%%% mffs
+%%% mfcr, mfmsr
+%%% mfsr
+%%% and, andc, eqv, nand, nor, or, orc, slw, sraw, srw, xor
+%%% sld, srad, srd (64-bit)
+%%% stwcx.
+%%% stdcx. (64-bit)
+%%% ecowx, stbx, stbux, sthbrx, sthx, sthux, stswx, stwbrx, stwx, stwux
+%%% stdux, stdx (64-bit)
+%%% stfdx, stfdux, stfiwx, stfsx, stfsux
+%%% stswi
+%%% cntlzw, extsb, extsh
+%%% cntlzd, extsw (64-bit)
+%%% mtmsr
+%%% mtmsrd (64-bit)
+%%% mtsr, mtsrin
+%%% mtsrd, mtsrdin (64-bit)
+%%% srawi
+%%% sradi (64-bit)
+%%% cmp, cmpl
+%%% fcmpo, fcmpu
+%%% mcrfs
+%%% mcrxr (obsolete)
+%%% mtfsfi
+%%% tw
+%%% td (64-bit)
+%%% mtfsb0, mtfsb1
+%%% dcba, dcbf, dcbi, dcbst, dcbt, dcbtst, dcbz, icbi
+%%% tlbie
+%%% eieio, sync, tlbia, tlbsync
+
+x_form(OPCD, D, A, B, XO, Rc) ->
+ ?BF(0,5,OPCD) bor ?BF(6,10,D) bor ?BF(11,15,A) bor ?BF(16,20,B) bor ?BF(21,30,XO) bor ?BIT(31,Rc).
+
+x_form_D_A_B_XO_simple({{r,D}, {r,A}, {r,B}}, XO) ->
+ x_form(10#31, D, A, B, XO, 0).
+
+x_form_D_A_B_XO_update({{r,D}, {r,A}, {r,B}}, XO) ->
+ ?ASSERT(A =/= 0),
+ ?ASSERT(A =/= D),
+ x_form(10#31, D, A, B, XO, 0).
+
+eciwx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#310). % optional
+lbzux(Opnds) -> x_form_D_A_B_XO_update(Opnds, 10#119).
+lbzx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#87).
+ldarx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#84). % 64-bit
+ldux(Opnds) -> x_form_D_A_B_XO_update(Opnds, 10#53). % 64-bit
+ldx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#21). % 64-bit
+lhaux(Opnds) -> x_form_D_A_B_XO_update(Opnds, 10#375).
+lhax(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#343).
+lhbrx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#790).
+lhzux(Opnds) -> x_form_D_A_B_XO_update(Opnds, 10#311).
+lhzx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#279).
+lswx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#533). % XXX: incomplete checks
+lwarx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#20).
+lwaux(Opnds) -> x_form_D_A_B_XO_update(Opnds, 10#373). % 64-bit
+lwax(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#341). % 64-bit
+lwbrx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#534).
+lwzux(Opnds) -> x_form_D_A_B_XO_update(Opnds, 10#55).
+lwzx(Opnds) -> x_form_D_A_B_XO_simple(Opnds, 10#23).
+
+x_form_frD_A_B_XO_simple({{fr,D}, {r,A}, {r,B}}, XO) ->
+ x_form(10#31, D, A, B, XO, 0).
+
+x_form_frD_A_B_XO_update({{fr,D}, {r,A}, {r,B}}, XO) ->
+ ?ASSERT(A =/= 0),
+ x_form(10#31, D, A, B, XO, 0).
+
+lfdux(Opnds) -> x_form_frD_A_B_XO_update(Opnds, 10#631).
+lfdx(Opnds) -> x_form_frD_A_B_XO_simple(Opnds, 10#599).
+lfsux(Opnds) -> x_form_frD_A_B_XO_update(Opnds, 10#567).
+lfsx(Opnds) -> x_form_frD_A_B_XO_simple(Opnds, 10#535).
+
+lswi({{r,D}, {r,A}, {nb,NB}}) -> % XXX: incomplete checks
+ x_form(10#31, D, A, NB, 10#597, 0).
+
+x_form_D_B_XO_Rc({{fr,D}, {fr,B}}, XO, Rc) ->
+ x_form(10#63, D, 0, B, XO, Rc).
+
+fabs_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#264, Rc).
+fcfid_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#846, Rc). % 64-bit
+fctid_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#814, Rc). % 64-bit
+fctidz_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#815, Rc). % 64-bit
+fctiw_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#14, Rc).
+fctiwz_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#15, Rc).
+fmr_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#72, Rc).
+fnabs_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#136, Rc).
+fneg_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#40, Rc).
+frsp_Rc(Opnds, Rc) -> x_form_D_B_XO_Rc(Opnds, 10#12, Rc).
+
+mfsrin({{r,D}, {r,B}}) -> % supervisor
+ x_form(10#31, D, 0, B, 10#659, 0).
+
+mffs_Rc({{fr,D}}, Rc) ->
+ x_form(10#63, D, 0, 0, 10#583, Rc).
+
+x_form_D_XO({{r,D}}, XO) ->
+ x_form(10#31, D, 0, 0, XO, 0).
+
+mfcr(Opnds) -> x_form_D_XO(Opnds, 10#19).
+mfmsr(Opnds) -> x_form_D_XO(Opnds, 10#83). % supervisor
+
+mfsr({{r,D}, {sr,SR}}) -> % supervisor
+ x_form(10#31, D, ?BITS(4,SR), 0, 10#595, 0).
+
+x_form_S_A_B_XO_Rc({{r,A}, {r,S}, {r,B}}, XO, Rc) ->
+ x_form(10#31, S, A, B, XO, Rc).
+
+and_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#28, Rc).
+andc_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#60, Rc).
+eqv_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#284, Rc).
+nand_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#476, Rc).
+nor_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#124, Rc).
+or_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#444, Rc).
+orc_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#412, Rc).
+sld_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#27, Rc). % 64-bit
+slw_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#24, Rc).
+srad_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#794, Rc). % 64-bit
+sraw_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#792, Rc).
+srd_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#539, Rc). % 64-bit
+srw_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#536, Rc).
+xor_Rc(Opnds, Rc) -> x_form_S_A_B_XO_Rc(Opnds, 10#316, Rc).
+
+xform_S_A_B_XO_1({{r,S}, {r,A}, {r,B}}, XO) ->
+ x_form(10#31, S, A, B, XO, 1).
+
+stdcx_dot(Opnds) -> xform_S_A_B_XO_1(Opnds, 10#214). % 64-bit
+stwcx_dot(Opnds) -> xform_S_A_B_XO_1(Opnds, 10#150).
+
+x_form_S_A_B_XO_simple({{r,S}, {r,A}, {r,B}}, XO) ->
+ x_form(10#31, S, A, B, XO, 0).
+
+x_form_S_A_B_XO_update({{r,S}, {r,A}, {r,B}}, XO) ->
+ ?ASSERT(A =/= 0),
+ x_form(10#31, S, A, B, XO, 0).
+
+ecowx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#438). % optional
+stbx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#215).
+stbux(Opnds) -> x_form_S_A_B_XO_update(Opnds, 10#247).
+sthbrx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#918).
+stdx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#149). % 64-bit
+stdux(Opnds) -> x_form_S_A_B_XO_update(Opnds, 10#181). % 64-bit
+sthx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#407).
+sthux(Opnds) -> x_form_S_A_B_XO_update(Opnds, 10#439).
+stswx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#661).
+stwbrx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#662).
+stwx(Opnds) -> x_form_S_A_B_XO_simple(Opnds, 10#151).
+stwux(Opnds) -> x_form_S_A_B_XO_update(Opnds, 10#183).
+
+x_form_frS_A_B_XO_simple({{fr,S}, {r,A}, {r,B}}, XO) ->
+ x_form(10#31, S, A, B, XO, 0).
+
+x_form_frS_A_B_XO_update({{fr,S}, {r,A}, {r,B}}, XO) ->
+ ?ASSERT(A =/= 0),
+ x_form(10#31, S, A, B, XO, 0).
+
+stfdx(Opnds) -> x_form_frS_A_B_XO_simple(Opnds, 10#727).
+stfdux(Opnds) -> x_form_frS_A_B_XO_update(Opnds, 10#759).
+stfiwx(Opnds) -> x_form_frS_A_B_XO_simple(Opnds, 10#983). % optional
+stfsx(Opnds) -> x_form_frS_A_B_XO_simple(Opnds, 10#663).
+stfsux(Opnds) -> x_form_frS_A_B_XO_update(Opnds, 10#695).
+
+stswi({{r,S}, {r,A}, {nb,NB}}) ->
+ x_form(10#31, S, A, NB, 10#725, 0).
+
+x_form_S_A_XO_Rc({{r,A}, {r,S}}, XO, Rc) ->
+ x_form(10#31, S, A, 0, XO, Rc).
+
+cntlzd_Rc(Opnds, Rc) -> x_form_S_A_XO_Rc(Opnds, 10#58, Rc). % 64-bit
+cntlzw_Rc(Opnds, Rc) -> x_form_S_A_XO_Rc(Opnds, 10#26, Rc).
+extsb_Rc(Opnds, Rc) -> x_form_S_A_XO_Rc(Opnds, 10#954, Rc).
+extsh_Rc(Opnds, Rc) -> x_form_S_A_XO_Rc(Opnds, 10#922, Rc).
+extsw_Rc(Opnds, Rc) -> x_form_S_A_XO_Rc(Opnds, 10#986, Rc). % 64-bit
+
+mtmsr({{r,S}}) -> % supervisor
+ x_form(10#31, S, 0, 0, 10#146, 0).
+
+mtmsrd({{r,S}}) -> % supervisor, 64-bit
+ x_form(10#31, S, 0, 0, 10#178, 0).
+
+mtsr({{sr,SR}, {r,S}}) -> % supervisor
+ x_form(10#31, S, ?BITS(4,SR), 0, 10#210, 0).
+
+mtsrd({{sr,SR}, {r,S}}) -> % supervisor, 64-bit
+ x_form(10#31, S, ?BITS(4,SR), 0, 10#82, 0).
+
+mtsrdin({{r,S}, {r,B}}) -> % supervisor, 64-bit
+ x_form(10#31, S, 0, B, 10#114, 0).
+
+mtsrin({{r,S}, {r,B}}) -> % supervisor, 32-bit
+ x_form(10#31, S, 0, B, 10#242, 0).
+
+slbia({}) -> % supervisor, 64-bit
+ x_form(10#31, 0, 0, 0, 10#498, 0).
+
+slbie({{r,B}}) -> % supervisor, 64-bit
+ x_form(10#31, 0, 0, B, 10#434, 0).
+
+srawi_Rc({{r,A}, {r,S}, {sh,SH}}, Rc) ->
+ x_form(10#31, S, A, SH, 10#824, Rc).
+
+x_form_crfD_L_A_B_XO({{crf,CRFD}, L, {r,A}, {r,B}}, XO) ->
+ %% ?ASSERT(L == 0), % L should be zero in 32-bit code
+ x_form(10#31, (CRFD bsl 2) bor L, A, B, XO, 0).
+
+cmp(Opnds) -> x_form_crfD_L_A_B_XO(Opnds, 0).
+cmpl(Opnds) -> x_form_crfD_L_A_B_XO(Opnds, 10#32).
+
+x_form_crfD_A_B_XO({{crf,CRFD}, {fr,A}, {fr,B}}, XO) ->
+ x_form(10#63, CRFD bsl 2, A, B, XO, 0).
+
+fcmpo(Opnds) -> x_form_crfD_A_B_XO(Opnds, 10#32).
+fcmpu(Opnds) -> x_form_crfD_A_B_XO(Opnds, 0).
+
+mcrfs({{crf,CRFD}, {crf,CRFS}}) ->
+ x_form(10#63, CRFD bsl 2, CRFS bsl 2, 0, 10#64, 0).
+
+%% mcrxr({{crf,CRFD}}) ->
+%% x_form(10#31, CRFD bsl 2, 0, 0, 10#512, 0).
+
+mtfsfi_Rc({{crf,CRFD}, {crimm,IMM}}, Rc) ->
+ x_form(10#63, CRFD bsl 2, 0, IMM bsl 1, 10#134, Rc).
+
+x_form_TO_A_B_XO({{to,TO}, {r,A}, {r,B}}, XO) ->
+ x_form(10#31, TO, A, B, XO, 0).
+
+td(Opnds) -> x_form_TO_A_B_XO(Opnds, 10#68). % 64-bit
+tw(Opnds) -> x_form_TO_A_B_XO(Opnds, 10#4).
+
+x_form_crbD_XO_Rc({{crb,CRBD}}, XO, Rc) ->
+ x_form(10#63, CRBD, 0, 0, XO, Rc).
+
+mtfsb0_Rc(Opnds, Rc) -> x_form_crbD_XO_Rc(Opnds, 10#70, Rc).
+mtfsb1_Rc(Opnds, Rc) -> x_form_crbD_XO_Rc(Opnds, 10#38, Rc).
+
+x_form_A_B_XO({{r,A}, {r,B}}, XO) ->
+ x_form(10#31, 0, A, B, XO, 0).
+
+dcba(Opnds) -> x_form_A_B_XO(Opnds, 10#758). % optional
+dcbf(Opnds) -> x_form_A_B_XO(Opnds, 10#86).
+dcbi(Opnds) -> x_form_A_B_XO(Opnds, 10#470). % supervisor
+dcbst(Opnds) -> x_form_A_B_XO(Opnds, 10#54).
+dcbt(Opnds) -> x_form_A_B_XO(Opnds, 10#278).
+dcbtst(Opnds) -> x_form_A_B_XO(Opnds, 10#246).
+dcbz(Opnds) -> x_form_A_B_XO(Opnds, 10#1014).
+icbi(Opnds) -> x_form_A_B_XO(Opnds, 10#982).
+
+x_form_B_XO({{r,B}}, XO) ->
+ x_form(10#31, 0, 0, B, XO, 0).
+
+tlbie(Opnds) -> x_form_B_XO(Opnds, 10#306). % supervisor, optional
+tlbld(Opnds) -> x_form_B_XO(Opnds, 10#978). % supervisor, optional
+tlbli(Opnds) -> x_form_B_XO(Opnds, 10#1010). % supervisor, optional
+
+x_form_XO({}, XO) ->
+ x_form(10#31, 0, 0, 0, XO, 0).
+
+eieio(Opnds) -> x_form_XO(Opnds, 10#854).
+sync(Opnds) -> x_form_XO(Opnds, 10#598).
+tlbia(Opnds) -> x_form_XO(Opnds, 10#370). % supervisor, optional
+tlbsync(Opnds) -> x_form_XO(Opnds, 10#566). % supervisor, optional
+
+%%% XL-Form Instructions
+%%% bcctr, bclr
+%%% crand, crandc, creqv, crnand, crnor, cror, crorc, crxor
+%%% mcrf
+%%% isync, rfi
+%%% rfid (64-bit)
+
+xl_form(A, B, C, XO, LK) ->
+ ?BF(0,5,10#19) bor ?BF(6,10,A) bor ?BF(11,15,B) bor ?BF(16,20,C) bor ?BF(21,30,XO) bor ?BIT(31,LK).
+
+xl_form_BO_BI_XO_LK({{bo,BO}, {bi,BI}}, XO, LK) ->
+ xl_form(BO, BI, 0, XO, LK).
+
+bcctr_lk(Opnds, LK) -> xl_form_BO_BI_XO_LK(Opnds, 10#528, LK).
+bclr_lk(Opnds, LK) -> xl_form_BO_BI_XO_LK(Opnds, 10#16, LK).
+
+xl_form_crbD_crbA_crbB_XO({{crb,CRBD}, {crb,CRBA}, {crb,CRBB}}, XO) ->
+ xl_form(CRBD, CRBA, CRBB, XO, 0).
+
+crand(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#257).
+crandc(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#129).
+creqv(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#289).
+crnand(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#225).
+crnor(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#33).
+cror(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#449).
+crorc(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#417).
+crxor(Opnds) -> xl_form_crbD_crbA_crbB_XO(Opnds, 10#193).
+
+mcrf({{crf,CRFD}, {crf,CRFS}}) ->
+ xl_form(CRFD bsl 2, CRFS bsl 2, 0, 0, 0).
+
+xl_form_XO({}, XO) ->
+ xl_form(0, 0, 0, XO, 0).
+
+isync(Opnds) -> xl_form_XO(Opnds, 10#150).
+rfi(Opnds) -> xl_form_XO(Opnds, 10#50). % supervisor
+rfid(Opnds) -> xl_form_XO(Opnds, 10#18). % supervisor, 64-bit
+
+%%% XFX-Form Instructions
+%%% mfspr, mtspr, mftb, mtcrf
+
+xfx_form(A, B, XO) ->
+ ?BF(0,5,10#31) bor ?BF(6,10,A) bor ?BF(11,20,B) bor ?BF(21,30,XO).
+
+xfx_form_R_SPR_XO(R, SPR, XO) ->
+ SPR04 = SPR band 16#1F,
+ SPR59 = (SPR bsr 5) band 16#1F,
+ xfx_form(R, (SPR04 bsl 5) bor SPR59, XO).
+
+mfspr({{r,D}, {spr,SPR}}) -> xfx_form_R_SPR_XO(D, SPR, 10#339).
+mtspr({{spr,SPR}, {r,S}}) -> xfx_form_R_SPR_XO(S, SPR, 10#467).
+mftb({{r,D}, {tbr,TBR}}) -> xfx_form_R_SPR_XO(D, TBR, 10#371).
+
+mtcrf({{crm,CRM}, {r,S}}) -> xfx_form(S, ?BITS(8,CRM) bsl 1, 10#144).
+
+%%% XFL-Form Instructions
+%%% mtfsf
+
+xfl_form(FM, B, Rc) ->
+ ?BF(0,5,10#63) bor ?BF(7,14,FM) bor ?BF(16,20,B) bor ?BF(21,30,10#711) bor ?BIT(31,Rc).
+
+mtfsf_Rc({{fm,FM}, {fr,B}}, Rc) -> xfl_form(FM, B, Rc).
+
+%%% XS-Form Instructions
+%%% sradi (64-bit)
+
+xs_form(S, A, SH1, XO, SH2, Rc) ->
+ ?BF(0,5,10#31) bor ?BF(6,10,S) bor ?BF(11,15,A) bor ?BF(16,20,SH1) bor ?BF(21,29,XO) bor ?BIT(30,SH2) bor ?BIT(31,Rc).
+
+sradi_Rc({{r,A}, {r,S}, {sh6,SH6}}, Rc) -> % 64-bit
+ xs_form(S, A, sh6_bits0to4(SH6), 10#413, sh6_bit5(SH6), Rc).
+
+%%% XO-Form Instructions
+%%% add, addc, adde, divw, divwu, mullw, subf, subfc, subfe
+%%% divd, divdu, mulld (64-bit)
+%%% mulhw, mulhwu
+%%% mulhd, mulhdu (64-bit)
+%%% addme, addze, neg, subfme, subfze
+
+xo_form(D, A, B, OE, XO, Rc) ->
+ ?BF(0,5,10#31) bor ?BF(6,10,D) bor ?BF(11,15,A) bor ?BF(16,20,B) bor ?BIT(21,OE) bor ?BF(22,30,XO) bor ?BIT(31,Rc).
+
+xo_form_D_A_B_OE_XO_Rc({{r,D}, {r,A}, {r,B}}, OE, XO, Rc) ->
+ xo_form(D, A, B, OE, XO, Rc).
+
+add_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#266, Rc).
+addc_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#10, Rc).
+adde_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#138, Rc).
+divd_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#489, Rc). % 64-bit
+divdu_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#457, Rc). % 64-bit
+divw_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#491, Rc).
+divwu_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#459, Rc).
+mulld_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#233, Rc). % 64-bit
+mullw_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#235, Rc).
+subf_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#40, Rc).
+subfc_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#8, Rc).
+subfe_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, OE, 10#136, Rc).
+
+mulhd_Rc(Opnds, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, 0, 10#73, Rc). % 64-bit
+mulhdu_Rc(Opnds, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, 0, 10#9, Rc). % 64-bit
+mulhw_Rc(Opnds, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, 0, 10#75, Rc).
+mulhwu_Rc(Opnds, Rc) -> xo_form_D_A_B_OE_XO_Rc(Opnds, 0, 10#11, Rc).
+
+xo_form_D_A_OE_XO_Rc({{r,D}, {r,A}}, OE, XO, Rc) ->
+ xo_form(D, A, 0, OE, XO, Rc).
+
+addme_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_OE_XO_Rc(Opnds, OE, 10#234, Rc).
+addze_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_OE_XO_Rc(Opnds, OE, 10#202, Rc).
+neg_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_OE_XO_Rc(Opnds, OE, 10#104, Rc).
+subfme_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_OE_XO_Rc(Opnds, OE, 10#232, Rc).
+subfze_OE_Rc(Opnds, OE, Rc) -> xo_form_D_A_OE_XO_Rc(Opnds, OE, 10#200, Rc).
+
+%%% A-Form Instructions
+%%% fadd, fadds, fdiv, fdivs, fsub, fsubs
+%%% fmadd, fmadds, fmsub, fmsubs, fnmadd, fnmadds, fnmsub, fnmsubs, fsel
+%%% fmul, fmuls
+%%% fres, fsqrte, fsqrt, fsqrts
+
+a_form(OPCD, D, A, B, C, XO, Rc) ->
+ ?BF(0,5,OPCD) bor ?BF(6,10,D) bor ?BF(11,15,A) bor ?BF(16,20,B) bor ?BF(21,25,C) bor ?BF(26,30,XO) bor ?BIT(31,Rc).
+
+a_form_D_A_B_XO_Rc(OPCD, {{fr,D}, {fr,A}, {fr,B}}, XO, Rc) ->
+ a_form(OPCD, D, A, B, 0, XO, Rc).
+
+fadd_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_XO_Rc(OPCD, Opnds, 10#21, Rc).
+fadd_Rc(Opnds, Rc) -> fadd_OPCD_Rc(10#63, Opnds, Rc).
+fadds_Rc(Opnds, Rc) -> fadd_OPCD_Rc(10#59, Opnds, Rc).
+
+fdiv_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_XO_Rc(OPCD, Opnds, 10#18, Rc).
+fdiv_Rc(Opnds, Rc) -> fdiv_OPCD_Rc(10#63, Opnds, Rc).
+fdivs_Rc(Opnds, Rc) -> fdiv_OPCD_Rc(10#59, Opnds, Rc).
+
+fsub_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_XO_Rc(OPCD, Opnds, 10#20, Rc).
+fsub_Rc(Opnds, Rc) -> fsub_OPCD_Rc(10#63, Opnds, Rc).
+fsubs_Rc(Opnds, Rc) -> fsub_OPCD_Rc(10#59, Opnds, Rc).
+
+a_form_D_A_B_C_XO_Rc(OPCD, {{fr,D}, {fr,A}, {fr,C}, {fr,B}}, XO, Rc) ->
+ a_form(OPCD, D, A, B, C, XO, Rc).
+
+fmadd_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_C_XO_Rc(OPCD, Opnds, 10#29, Rc).
+fmadd_Rc(Opnds, Rc) -> fmadd_OPCD_Rc(10#63, Opnds, Rc).
+fmadds_Rc(Opnds, Rc) -> fmadd_OPCD_Rc(10#59, Opnds, Rc).
+
+fmsub_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_C_XO_Rc(OPCD, Opnds, 10#28, Rc).
+fmsub_Rc(Opnds, Rc) -> fmsub_OPCD_Rc(10#63, Opnds, Rc).
+fmsubs_Rc(Opnds, Rc) -> fmsub_OPCD_Rc(10#59, Opnds, Rc).
+
+fnmadd_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_C_XO_Rc(OPCD, Opnds, 10#31, Rc).
+fnmadd_Rc(Opnds, Rc) -> fnmadd_OPCD_Rc(10#63, Opnds, Rc).
+fnmadds_Rc(Opnds, Rc) -> fnmadd_OPCD_Rc(10#59, Opnds, Rc).
+
+fnmsub_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_A_B_C_XO_Rc(OPCD, Opnds, 10#30, Rc).
+fnmsub_Rc(Opnds, Rc) -> fnmsub_OPCD_Rc(10#63, Opnds, Rc).
+fnmsubs_Rc(Opnds, Rc) -> fnmsub_OPCD_Rc(10#59, Opnds, Rc).
+
+fsel_Rc(Opnds, Rc) -> a_form_D_A_B_C_XO_Rc(10#63, Opnds, 10#23, Rc). % optional
+
+fmul_OPCD_Rc(OPCD, {{fr,D}, {fr,A}, {fr,C}}, Rc) ->
+ a_form(OPCD, D, A, 0, C, 10#25, Rc).
+
+fmul_Rc(Opnds, Rc) -> fmul_OPCD_Rc(10#63, Opnds, Rc).
+fmuls_Rc(Opnds, Rc) -> fmul_OPCD_Rc(10#59, Opnds, Rc).
+
+a_form_D_B_XO_Rc(OPCD, {{fr,D}, {fr,B}}, XO, Rc) ->
+ a_form(OPCD, D, 0, B, 0, XO, Rc).
+
+fres_Rc(Opnds, Rc) -> a_form_D_B_XO_Rc(10#59, Opnds, 10#24, Rc). % optional
+frsqrte_Rc(Opnds, Rc) -> a_form_D_B_XO_Rc(10#63, Opnds, 10#26, Rc). % optional
+
+fsqrt_OPCD_Rc(OPCD, Opnds, Rc) -> a_form_D_B_XO_Rc(OPCD, Opnds, 10#22, Rc). % optional
+fsqrt_Rc(Opnds, Rc) -> fsqrt_OPCD_Rc(10#63, Opnds, Rc). % optional
+fsqrts_Rc(Opnds, Rc) -> fsqrt_OPCD_Rc(10#59, Opnds, Rc). % optional
+
+%%% M-Form Instructions
+%%% rlwimi, rlwinm
+%%% rlwnm
+
+m_form(OPCD, S, A, SH, MB, ME, Rc) ->
+ ?BF(0,5,OPCD) bor ?BF(6,10,S) bor ?BF(11,15,A) bor ?BF(16,20,SH) bor ?BF(21,25,MB) bor ?BF(26,30,ME) bor ?BIT(31,Rc).
+
+m_form_S_A_SH_MB_ME_Rc(OPCD, {{r,A}, {r,S}, {sh,SH}, {mb,MB}, {me,ME}}, Rc) ->
+ m_form(OPCD, S, A, SH, MB, ME, Rc).
+
+rlwimi_Rc(Opnds, Rc) -> m_form_S_A_SH_MB_ME_Rc(10#20, Opnds, Rc).
+rlwinm_Rc(Opnds, Rc) -> m_form_S_A_SH_MB_ME_Rc(10#21, Opnds, Rc).
+
+rlwnm_Rc({{r,A}, {r,S}, {r,B}, {mb,MB}, {me,ME}}, Rc) ->
+ m_form(10#23, S, A, B, MB, ME, Rc).
+
+%%% MD-Form Instructions
+%%% rldic, rldicl, rldicr, rldimi (64-bit)
+
+md_form(S, A, SH1, MB, XO, SH2, Rc) ->
+ ?BF(0,5,10#30) bor ?BF(6,10,S) bor ?BF(11,15,A) bor ?BF(16,20,SH1) bor ?BF(21,26,MB) bor ?BF(27,29,XO) bor ?BIT(30,SH2) bor ?BIT(31,Rc).
+
+mb6_reformat(MB6) ->
+ ((MB6 band 16#1F) bsl 1) bor ((MB6 bsr 5) band 1).
+
+sh6_bits0to4(SH6) ->
+ SH6 band 16#1F.
+
+sh6_bit5(SH6) ->
+ (SH6 bsr 5) band 1.
+
+md_form_S_A_SH6_MB6_XO_Rc({{r,A}, {r,S}, {sh6,SH6}, {mb6,MB6}}, XO, Rc) ->
+ md_form(S, A, sh6_bits0to4(SH6), mb6_reformat(MB6), XO, sh6_bit5(SH6), Rc).
+
+rldic_Rc(Opnds, Rc) -> md_form_S_A_SH6_MB6_XO_Rc(Opnds, 10#2, Rc). % 64-bit
+rldicl_Rc(Opnds, Rc) -> md_form_S_A_SH6_MB6_XO_Rc(Opnds, 10#0, Rc). % 64-bit
+rldimi_Rc(Opnds, Rc) -> md_form_S_A_SH6_MB6_XO_Rc(Opnds, 10#3, Rc). % 64-bit
+
+rldicr_Rc({{r,A}, {r,S}, {sh6,SH6}, {me6,ME6}}, Rc) -> % 64-bit
+ md_form(S, A, sh6_bits0to4(SH6), mb6_reformat(ME6), 10#1, sh6_bit5(SH6), Rc).
+
+%%% MDS-Form Instructions
+%%% rldcl, rldcr (64-bit)
+
+mds_form(S, A, B, MB, XO, Rc) ->
+ ?BF(0,5,10#30) bor ?BF(6,10,S) bor ?BF(11,15,A) bor ?BF(16,20,B) bor ?BF(21,26,MB) bor ?BF(27,30,XO) bor ?BIT(31,Rc).
+
+rldcl({{r,A}, {r,S}, {r,B}, {mb6,MB6}}, Rc) -> % 64-bit
+ mds_form(S, A, B, mb6_reformat(MB6), 10#8, Rc).
+
+rldcr({{r,A}, {r,S}, {r,B}, {me6,ME6}}, Rc) -> % 64-bit
+ mds_form(S, A, B, mb6_reformat(ME6), 10#9, Rc).
+
+%%% main encode dispatch
+
+insn_encode(Op, Opnds) ->
+ case Op of
+ %% I-Form
+ 'b' -> b_AA_LK(Opnds, 0, 0);
+ 'ba' -> b_AA_LK(Opnds, 1, 0);
+ 'bl' -> b_AA_LK(Opnds, 0, 1);
+ 'bla' -> b_AA_LK(Opnds, 1, 1);
+ %% B-Form
+ 'bc' -> bc_AA_LK(Opnds, 0, 0);
+ 'bca' -> bc_AA_LK(Opnds, 1, 0);
+ 'bcl' -> bc_AA_LK(Opnds, 0, 1);
+ 'bcla' -> bc_AA_LK(Opnds, 1, 1);
+ %% SC-Form
+ 'sc' -> sc(Opnds);
+ %% D-Form
+ 'addi' -> addi(Opnds);
+ 'addic' -> addic(Opnds);
+ 'addic.' -> addic_dot(Opnds);
+ 'addis' -> addis(Opnds);
+ 'andi.' -> andi_dot(Opnds);
+ 'andis.' -> andis_dot(Opnds);
+ 'cmpi' -> cmpi(Opnds);
+ 'cmpli' -> cmpli(Opnds);
+ 'lbz' -> lbz(Opnds);
+ 'lbzu' -> lbzu(Opnds);
+ 'lfd' -> lfd(Opnds);
+ 'lfdu' -> lfdu(Opnds);
+ 'lfs' -> lfs(Opnds);
+ 'lfsu' -> lfsu(Opnds);
+ 'lha' -> lha(Opnds);
+ 'lhau' -> lhau(Opnds);
+ 'lhz' -> lhz(Opnds);
+ 'lhzu' -> lhzu(Opnds);
+ 'lmw' -> lmw(Opnds);
+ 'lwz' -> lwz(Opnds);
+ 'lwzu' -> lwzu(Opnds);
+ 'mulli' -> mulli(Opnds);
+ 'ori' -> ori(Opnds);
+ 'oris' -> oris(Opnds);
+ 'stb' -> stb(Opnds);
+ 'stbu' -> stbu(Opnds);
+ 'stfd' -> stfd(Opnds);
+ 'stfdu' -> stfdu(Opnds);
+ 'stfs' -> stfs(Opnds);
+ 'stfsu' -> stfsu(Opnds);
+ 'sth' -> sth(Opnds);
+ 'sthu' -> sthu(Opnds);
+ 'stmw' -> stmw(Opnds);
+ 'stw' -> stw(Opnds);
+ 'stwu' -> stwu(Opnds);
+ 'subfic' -> subfic(Opnds);
+ 'tdi' -> tdi(Opnds);
+ 'twi' -> twi(Opnds);
+ 'xori' -> xori(Opnds);
+ 'xoris' -> xoris(Opnds);
+ %% DS-Form
+ 'ld' -> ld(Opnds);
+ 'ldu' -> ldu(Opnds);
+ 'lwa' -> lwa(Opnds);
+ 'std' -> std(Opnds);
+ 'stdu' -> stdu(Opnds);
+ %% X-Form
+ 'and' -> and_Rc(Opnds, 0);
+ 'and.' -> and_Rc(Opnds, 1);
+ 'andc' -> andc_Rc(Opnds, 0);
+ 'andc.' -> andc_Rc(Opnds, 1);
+ 'cmp' -> cmp(Opnds);
+ 'cmpl' -> cmpl(Opnds);
+ 'cntlzd' -> cntlzd_Rc(Opnds, 0);
+ 'cntlzd.' -> cntlzd_Rc(Opnds, 1);
+ 'cntlzw' -> cntlzw_Rc(Opnds, 0);
+ 'cntlzw.' -> cntlzw_Rc(Opnds, 1);
+ 'dcba' -> dcba(Opnds);
+ 'dcbf' -> dcbf(Opnds);
+ 'dcbi' -> dcbi(Opnds);
+ 'dcbst' -> dcbst(Opnds);
+ 'dcbt' -> dcbt(Opnds);
+ 'dcbtst' -> dcbtst(Opnds);
+ 'dcbz' -> dcbz(Opnds);
+ 'eciwx' -> eciwx(Opnds);
+ 'ecowx' -> ecowx(Opnds);
+ 'eieio' -> eieio(Opnds);
+ 'eqv' -> eqv_Rc(Opnds, 0);
+ 'eqv.' -> eqv_Rc(Opnds, 1);
+ 'extsb' -> extsb_Rc(Opnds, 0);
+ 'extsb.' -> extsb_Rc(Opnds, 1);
+ 'extsh' -> extsh_Rc(Opnds, 0);
+ 'extsh.' -> extsh_Rc(Opnds, 1);
+ 'extsw' -> extsw_Rc(Opnds, 0);
+ 'extsw.' -> extsw_Rc(Opnds, 1);
+ 'fabs' -> fabs_Rc(Opnds, 0);
+ 'fabs.' -> fabs_Rc(Opnds, 1);
+ 'fcfid' -> fcfid_Rc(Opnds, 0);
+ 'fcfid.' -> fcfid_Rc(Opnds, 1);
+ 'fcmpo' -> fcmpo(Opnds);
+ 'fcmpu' -> fcmpu(Opnds);
+ 'fctid' -> fctid_Rc(Opnds, 0);
+ 'fctid.' -> fctid_Rc(Opnds, 1);
+ 'fctidz' -> fctidz_Rc(Opnds, 0);
+ 'fctidz.' -> fctidz_Rc(Opnds, 1);
+ 'fctiw' -> fctiw_Rc(Opnds, 0);
+ 'fctiw.' -> fctiw_Rc(Opnds, 1);
+ 'fctiwz' -> fctiwz_Rc(Opnds, 0);
+ 'fctiwz.' -> fctiwz_Rc(Opnds, 1);
+ 'fmr' -> fmr_Rc(Opnds, 0);
+ 'fmr.' -> fmr_Rc(Opnds, 1);
+ 'fnabs' -> fnabs_Rc(Opnds, 0);
+ 'fnabs.' -> fnabs_Rc(Opnds, 1);
+ 'fneg' -> fneg_Rc(Opnds, 0);
+ 'fneg.' -> fneg_Rc(Opnds, 1);
+ 'frsp' -> frsp_Rc(Opnds, 0);
+ 'frsp.' -> frsp_Rc(Opnds, 1);
+ 'icbi' -> icbi(Opnds);
+ 'lbzux' -> lbzux(Opnds);
+ 'lbzx' -> lbzx(Opnds);
+ 'ldarx' -> ldarx(Opnds);
+ 'ldux' -> ldux(Opnds);
+ 'ldx' -> ldx(Opnds);
+ 'lfdux' -> lfdux(Opnds);
+ 'lfdx' -> lfdx(Opnds);
+ 'lfsux' -> lfsux(Opnds);
+ 'lfsx' -> lfsx(Opnds);
+ 'lhaux' -> lhaux(Opnds);
+ 'lhax' -> lhax(Opnds);
+ 'lhbrx' -> lhbrx(Opnds);
+ 'lhzux' -> lhzux(Opnds);
+ 'lhzx' -> lhzx(Opnds);
+ 'lswi' -> lswi(Opnds);
+ 'lswx' -> lswx(Opnds);
+ 'lwarx' -> lwarx(Opnds);
+ 'lwaux' -> lwaux(Opnds);
+ 'lwax' -> lwax(Opnds);
+ 'lwbrx' -> lwbrx(Opnds);
+ 'lwzux' -> lwzux(Opnds);
+ 'lwzx' -> lwzx(Opnds);
+ 'mcrfs' -> mcrfs(Opnds);
+ %% 'mcrxr' -> mcrxr(Opnds);
+ 'mfcr' -> mfcr(Opnds);
+ 'mffs' -> mffs_Rc(Opnds, 0);
+ 'mffs.' -> mffs_Rc(Opnds, 1);
+ 'mfmsr' -> mfmsr(Opnds);
+ 'mfsr' -> mfsr(Opnds);
+ 'mfsrin' -> mfsrin(Opnds);
+ 'mtfsb0' -> mtfsb0_Rc(Opnds, 0);
+ 'mtfsb0.' -> mtfsb0_Rc(Opnds, 1);
+ 'mtfsb1' -> mtfsb1_Rc(Opnds, 0);
+ 'mtfsb1.' -> mtfsb1_Rc(Opnds, 1);
+ 'mtfsfi' -> mtfsfi_Rc(Opnds, 0);
+ 'mtfsfi.' -> mtfsfi_Rc(Opnds, 1);
+ 'mtmsr' -> mtmsr(Opnds);
+ 'mtmsrd' -> mtmsrd(Opnds);
+ 'mtsr' -> mtsr(Opnds);
+ 'mtsrd' -> mtsrd(Opnds);
+ 'mtsrdin' -> mtsrdin(Opnds);
+ 'mtsrin' -> mtsrin(Opnds);
+ 'nand' -> nand_Rc(Opnds, 0);
+ 'nand.' -> nand_Rc(Opnds, 1);
+ 'nor' -> nor_Rc(Opnds, 0);
+ 'nor.' -> nor_Rc(Opnds, 1);
+ 'or' -> or_Rc(Opnds, 0);
+ 'or.' -> or_Rc(Opnds, 1);
+ 'orc' -> orc_Rc(Opnds, 0);
+ 'orc.' -> orc_Rc(Opnds, 1);
+ 'slbia' -> slbia(Opnds);
+ 'slbie' -> slbie(Opnds);
+ 'sld' -> sld_Rc(Opnds, 0);
+ 'sld.' -> sld_Rc(Opnds, 1);
+ 'slw' -> slw_Rc(Opnds, 0);
+ 'slw.' -> slw_Rc(Opnds, 1);
+ 'srad' -> srad_Rc(Opnds, 0);
+ 'srad.' -> srad_Rc(Opnds, 1);
+ 'sraw' -> sraw_Rc(Opnds, 0);
+ 'sraw.' -> sraw_Rc(Opnds, 1);
+ 'srawi' -> srawi_Rc(Opnds, 0);
+ 'srawi.' -> srawi_Rc(Opnds, 1);
+ 'srd' -> srd_Rc(Opnds, 0);
+ 'srd.' -> srd_Rc(Opnds, 1);
+ 'srw' -> srw_Rc(Opnds, 0);
+ 'srw.' -> srw_Rc(Opnds, 1);
+ 'stbux' -> stbux(Opnds);
+ 'stbx' -> stbx(Opnds);
+ 'stdcx.' -> stdcx_dot(Opnds);
+ 'stdux' -> stdux(Opnds);
+ 'stdx' -> stdx(Opnds);
+ 'stfdux' -> stfdux(Opnds);
+ 'stfdx' -> stfdx(Opnds);
+ 'stfiwx' -> stfiwx(Opnds);
+ 'stfsux' -> stfsux(Opnds);
+ 'stfsx' -> stfsx(Opnds);
+ 'sthbrx' -> sthbrx(Opnds);
+ 'sthux' -> sthux(Opnds);
+ 'sthx' -> sthx(Opnds);
+ 'stswi' -> stswi(Opnds);
+ 'stswx' -> stswx(Opnds);
+ 'stwbrx' -> stwbrx(Opnds);
+ 'stwcx.' -> stwcx_dot(Opnds);
+ 'stwux' -> stwux(Opnds);
+ 'stwx' -> stwx(Opnds);
+ 'sync' -> sync(Opnds);
+ 'td' -> td(Opnds);
+ 'tlbia' -> tlbia(Opnds); % not implemented in MPC603e or MPC7450
+ 'tlbie' -> tlbie(Opnds);
+ 'tlbld' -> tlbld(Opnds);
+ 'tlbli' -> tlbli(Opnds);
+ 'tlbsync' -> tlbsync(Opnds);
+ 'tw' -> tw(Opnds);
+ 'xor' -> xor_Rc(Opnds, 0);
+ 'xor.' -> xor_Rc(Opnds, 1);
+ %% XL-Form
+ 'bcctr' -> bcctr_lk(Opnds, 0);
+ 'bcctrl' -> bcctr_lk(Opnds, 1);
+ 'bclr' -> bclr_lk(Opnds, 0);
+ 'bclrl' -> bclr_lk(Opnds, 1);
+ 'crand' -> crand(Opnds);
+ 'crandc' -> crandc(Opnds);
+ 'creqv' -> creqv(Opnds);
+ 'crnand' -> crnand(Opnds);
+ 'crnor' -> crnor(Opnds);
+ 'cror' -> cror(Opnds);
+ 'crorc' -> crorc(Opnds);
+ 'crxor' -> crxor(Opnds);
+ 'isync' -> isync(Opnds);
+ 'mcrf' -> mcrf(Opnds);
+ 'rfi' -> rfi(Opnds);
+ 'rfid' -> rfid(Opnds);
+ %% XFX-Form
+ 'mfspr' -> mfspr(Opnds);
+ 'mftb' -> mftb(Opnds);
+ 'mtcrf' -> mtcrf(Opnds);
+ 'mtspr' -> mtspr(Opnds);
+ %% XFL-Form
+ 'mtfsf' -> mtfsf_Rc(Opnds, 0);
+ 'mtfsf.' -> mtfsf_Rc(Opnds, 1);
+ %% XS-Form
+ 'sradi' -> sradi_Rc(Opnds, 0);
+ 'sradi.' -> sradi_Rc(Opnds, 1);
+ %% XO-Form
+ 'add' -> add_OE_Rc(Opnds, 0, 0);
+ 'add.' -> add_OE_Rc(Opnds, 0, 1);
+ 'addo' -> add_OE_Rc(Opnds, 1, 0);
+ 'addo.' -> add_OE_Rc(Opnds, 1, 1);
+ 'addc' -> addc_OE_Rc(Opnds, 0, 0);
+ 'addc.' -> addc_OE_Rc(Opnds, 0, 1);
+ 'addco' -> addc_OE_Rc(Opnds, 1, 0);
+ 'addco.' -> addc_OE_Rc(Opnds, 1, 1);
+ 'adde' -> adde_OE_Rc(Opnds, 0, 0);
+ 'adde.' -> adde_OE_Rc(Opnds, 0, 1);
+ 'addeo' -> adde_OE_Rc(Opnds, 1, 0);
+ 'addeo.' -> adde_OE_Rc(Opnds, 1, 1);
+ 'addme' -> addme_OE_Rc(Opnds, 0, 0);
+ 'addme.' -> addme_OE_Rc(Opnds, 0, 1);
+ 'addmeo' -> addme_OE_Rc(Opnds, 1, 0);
+ 'addmeo.' -> addme_OE_Rc(Opnds, 1, 1);
+ 'addze' -> addze_OE_Rc(Opnds, 0, 0);
+ 'addze.' -> addze_OE_Rc(Opnds, 0, 1);
+ 'addzeo' -> addze_OE_Rc(Opnds, 1, 0);
+ 'addzeo.' -> addze_OE_Rc(Opnds, 1, 1);
+ 'divd' -> divd_OE_Rc(Opnds, 0, 0);
+ 'divd.' -> divd_OE_Rc(Opnds, 0, 1);
+ 'divdo' -> divd_OE_Rc(Opnds, 1, 0);
+ 'divdo.' -> divd_OE_Rc(Opnds, 1, 1);
+ 'divdu' -> divdu_OE_Rc(Opnds, 0, 0);
+ 'divdu.' -> divdu_OE_Rc(Opnds, 0, 1);
+ 'divduo' -> divdu_OE_Rc(Opnds, 1, 0);
+ 'divduo.' -> divdu_OE_Rc(Opnds, 1, 1);
+ 'divw' -> divw_OE_Rc(Opnds, 0, 0);
+ 'divw.' -> divw_OE_Rc(Opnds, 0, 1);
+ 'divwo' -> divw_OE_Rc(Opnds, 1, 0);
+ 'divwo.' -> divw_OE_Rc(Opnds, 1, 1);
+ 'divwu' -> divwu_OE_Rc(Opnds, 0, 0);
+ 'divwu.' -> divwu_OE_Rc(Opnds, 0, 1);
+ 'divwuo' -> divwu_OE_Rc(Opnds, 1, 0);
+ 'divwuo.' -> divwu_OE_Rc(Opnds, 1, 1);
+ 'mulhd' -> mulhd_Rc(Opnds, 0);
+ 'mulhd.' -> mulhd_Rc(Opnds, 1);
+ 'mulhdu' -> mulhdu_Rc(Opnds, 0);
+ 'mulhdu.' -> mulhdu_Rc(Opnds, 1);
+ 'mulhw' -> mulhw_Rc(Opnds, 0);
+ 'mulhw.' -> mulhw_Rc(Opnds, 1);
+ 'mulhwu' -> mulhwu_Rc(Opnds, 0);
+ 'mulhwu.' -> mulhwu_Rc(Opnds, 1);
+ 'mulld' -> mulld_OE_Rc(Opnds, 0, 0);
+ 'mulld.' -> mulld_OE_Rc(Opnds, 0, 1);
+ 'mulldo' -> mulld_OE_Rc(Opnds, 1, 0);
+ 'mulldo.' -> mulld_OE_Rc(Opnds, 1, 1);
+ 'mullw' -> mullw_OE_Rc(Opnds, 0, 0);
+ 'mullw.' -> mullw_OE_Rc(Opnds, 0, 1);
+ 'mullwo' -> mullw_OE_Rc(Opnds, 1, 0);
+ 'mullwo.' -> mullw_OE_Rc(Opnds, 1, 1);
+ 'neg' -> neg_OE_Rc(Opnds, 0, 0);
+ 'neg.' -> neg_OE_Rc(Opnds, 0, 1);
+ 'nego' -> neg_OE_Rc(Opnds, 1, 0);
+ 'nego.' -> neg_OE_Rc(Opnds, 1, 1);
+ 'subf' -> subf_OE_Rc(Opnds, 0, 0);
+ 'subf.' -> subf_OE_Rc(Opnds, 0, 1);
+ 'subfo' -> subf_OE_Rc(Opnds, 1, 0);
+ 'subfo.' -> subf_OE_Rc(Opnds, 1, 1);
+ 'subfc' -> subfc_OE_Rc(Opnds, 0, 0);
+ 'subfc.' -> subfc_OE_Rc(Opnds, 0, 1);
+ 'subfco' -> subfc_OE_Rc(Opnds, 1, 0);
+ 'subfco.' -> subfc_OE_Rc(Opnds, 1, 1);
+ 'subfe' -> subfe_OE_Rc(Opnds, 0, 0);
+ 'subfe.' -> subfe_OE_Rc(Opnds, 0, 1);
+ 'subfeo' -> subfe_OE_Rc(Opnds, 1, 0);
+ 'subfeo.' -> subfe_OE_Rc(Opnds, 1, 1);
+ 'subfme' -> subfme_OE_Rc(Opnds, 0, 0);
+ 'subfme.' -> subfme_OE_Rc(Opnds, 0, 1);
+ 'subfmeo' -> subfme_OE_Rc(Opnds, 1, 0);
+ 'subfmeo.' -> subfme_OE_Rc(Opnds, 1, 1);
+ 'subfze' -> subfze_OE_Rc(Opnds, 0, 0);
+ 'subfze.' -> subfze_OE_Rc(Opnds, 0, 1);
+ 'subfzeo' -> subfze_OE_Rc(Opnds, 1, 0);
+ 'subfzeo.' -> subfze_OE_Rc(Opnds, 1, 1);
+ %% A-Form
+ 'fadd' -> fadd_Rc(Opnds, 0);
+ 'fadd.' -> fadd_Rc(Opnds, 1);
+ 'fadds' -> fadds_Rc(Opnds, 0);
+ 'fadds.' -> fadds_Rc(Opnds, 1);
+ 'fdiv' -> fdiv_Rc(Opnds, 0);
+ 'fdiv.' -> fdiv_Rc(Opnds, 1);
+ 'fdivs' -> fdivs_Rc(Opnds, 0);
+ 'fdivs.' -> fdivs_Rc(Opnds, 1);
+ 'fmadd' -> fmadd_Rc(Opnds, 0);
+ 'fmadd.' -> fmadd_Rc(Opnds, 1);
+ 'fmadds' -> fmadds_Rc(Opnds, 0);
+ 'fmadds.' -> fmadds_Rc(Opnds, 1);
+ 'fmsub' -> fmsub_Rc(Opnds, 0);
+ 'fmsub.' -> fmsub_Rc(Opnds, 1);
+ 'fmsubs' -> fmsubs_Rc(Opnds, 0);
+ 'fmsubs.' -> fmsubs_Rc(Opnds, 1);
+ 'fmul' -> fmul_Rc(Opnds, 0);
+ 'fmul.' -> fmul_Rc(Opnds, 1);
+ 'fmuls' -> fmuls_Rc(Opnds, 0);
+ 'fmuls.' -> fmuls_Rc(Opnds, 1);
+ 'fnmadd' -> fnmadd_Rc(Opnds, 0);
+ 'fnmadd.' -> fnmadd_Rc(Opnds, 1);
+ 'fnmadds' -> fnmadds_Rc(Opnds, 0);
+ 'fnmadds.' -> fnmadds_Rc(Opnds, 1);
+ 'fnmsub' -> fnmsub_Rc(Opnds, 0);
+ 'fnmsub.' -> fnmsub_Rc(Opnds, 1);
+ 'fnmsubs' -> fnmsubs_Rc(Opnds, 0);
+ 'fnmsubs.' -> fnmsubs_Rc(Opnds, 1);
+ 'fres' -> fres_Rc(Opnds, 0);
+ 'fres.' -> fres_Rc(Opnds, 1);
+ 'frsqrte' -> frsqrte_Rc(Opnds, 0);
+ 'frsqrte.' -> frsqrte_Rc(Opnds, 1);
+ 'fsel' -> fsel_Rc(Opnds, 0);
+ 'fsel.' -> fsel_Rc(Opnds, 1);
+ 'fsqrt' -> fsqrt_Rc(Opnds, 0); % not implemented in MPC603e or MPC7450
+ 'fsqrt.' -> fsqrt_Rc(Opnds, 1); % not implemented in MPC603e or MPC7450
+ 'fsqrts' -> fsqrts_Rc(Opnds, 0); % not implemented in MPC603e or MPC7450
+ 'fsqrts.' -> fsqrts_Rc(Opnds, 1); % not implemented in MPC603e or MPC7450
+ 'fsub' -> fsub_Rc(Opnds, 0);
+ 'fsub.' -> fsub_Rc(Opnds, 1);
+ 'fsubs' -> fsubs_Rc(Opnds, 0);
+ 'fsubs.' -> fsubs_Rc(Opnds, 1);
+ %% M-Form
+ 'rlwimi' -> rlwimi_Rc(Opnds, 0);
+ 'rlwimi.' -> rlwimi_Rc(Opnds, 1);
+ 'rlwinm' -> rlwinm_Rc(Opnds, 0);
+ 'rlwinm.' -> rlwinm_Rc(Opnds, 1);
+ 'rlwnm' -> rlwnm_Rc(Opnds, 0);
+ 'rlwnm.' -> rlwnm_Rc(Opnds, 1);
+ %% MD-Form
+ 'rldic' -> rldic_Rc(Opnds, 0);
+ 'rldic.' -> rldic_Rc(Opnds, 1);
+ 'rldicl' -> rldicl_Rc(Opnds, 0);
+ 'rldicl.' -> rldicl_Rc(Opnds, 1);
+ 'rldicr' -> rldicr_Rc(Opnds, 0);
+ 'rldicr.' -> rldicr_Rc(Opnds, 1);
+ 'rldimi' -> rldimi_Rc(Opnds, 0);
+ 'rldimi.' -> rldimi_Rc(Opnds, 1);
+ %% MDS-Form
+ 'rldcl' -> rldcl(Opnds, 0);
+ 'rldcl.' -> rldcl(Opnds, 1);
+ 'rldcr' -> rldcr(Opnds, 0);
+ 'rldcr.' -> rldcr(Opnds, 1);
+ _ -> exit({?MODULE,insn_encode,Op})
+ end.
+
+%%% testing interface
+
+-ifdef(TESTING).
+
+say(OS, Str) ->
+ file:write(OS, Str).
+
+hex_digit(Dig0) ->
+ Dig = Dig0 band 16#F,
+ if Dig >= 16#A -> $A + (Dig - 16#A);
+ true -> $0 + Dig
+ end.
+
+say_byte(OS, Byte) ->
+ say(OS, [hex_digit(Byte bsr 4)]),
+ say(OS, [hex_digit(Byte)]).
+
+say_word(OS, Word) ->
+ say(OS, "0x"),
+ say_byte(OS, Word bsr 24),
+ say_byte(OS, Word bsr 16),
+ say_byte(OS, Word bsr 8),
+ say_byte(OS, Word).
+
+t(OS, Op, Opnds) ->
+ Word = insn_encode(Op, Opnds),
+ say(OS, "\t.long "),
+ say_word(OS, Word),
+ say(OS, "\n").
+
+dotest1(OS) ->
+ say(OS, "\t.text\n\t.align 4\n"),
+ %%
+ R14 = {r,14},
+ R10 = {r,10},
+ R11 = {r,11},
+ F2 = {fr,2},
+ F4 = {fr,4},
+ F6 = {fr,6},
+ F8 = {fr,8},
+ DispM3 = {d,16#FFFD},
+ DS = {ds,16#FFFD bsr 2},
+ SIMM99 = {simm,10#99},
+ UIMM4711 = {uimm,10#4711},
+ TO_LLE = {to, 2#00110}, % =, <U
+ CR7 = {crf,7},
+ CR5 = {crf,5},
+ CRB_CR0_LT = {crb,0},
+ CRB_CR7_SO = {crb,31},
+ CRB_CR1_GT = {crb,5},
+ CRM192 = {crm,192},
+ FM255 = {fm,16#FF}, % all fields
+ CRIMM15 = {crimm,16#F},
+ TBR268 = {tbr, 10#268}, % TBL
+ SPR9 = {spr, 10#9}, % CTR
+ SR9 = {sr,9},
+ NB7 = {nb,7},
+ SH16 = {sh,16},
+ SH45 = {sh6,45},
+ MB10 = {mb,10},
+ MB40 = {mb6,40},
+ ME20 = {me,20},
+ ME50 = {me6,50},
+ LI = {li,16#ffffff},
+ BD = {bd,16#3ff},
+ BO_NZ_PLUS = {bo,2#01101}, % branch if cond true, predict taken
+ BI_CR0_EQ = {bi,2#00010}, % CR0[2], Zero
+ %% I-Form
+ t(OS,'b',{LI}),
+ t(OS,'ba',{LI}),
+ t(OS,'bl',{LI}),
+ t(OS,'bla',{LI}),
+ %% B-Form
+ t(OS,'bc',{BO_NZ_PLUS,BI_CR0_EQ,BD}),
+ t(OS,'bca',{BO_NZ_PLUS,BI_CR0_EQ,BD}),
+ t(OS,'bcl',{BO_NZ_PLUS,BI_CR0_EQ,BD}),
+ t(OS,'bcla',{BO_NZ_PLUS,BI_CR0_EQ,BD}),
+ %% SC-Form
+ t(OS,'sc',{}),
+ %% D-Form
+ t(OS,'addi',{R14,R10,SIMM99}),
+ t(OS,'addic',{R14,R10,SIMM99}),
+ t(OS,'addic.',{R14,R10,SIMM99}),
+ t(OS,'addis',{R14,R10,SIMM99}),
+ t(OS,'andi.',{R14,R10,UIMM4711}),
+ t(OS,'andis.',{R14,R10,UIMM4711}),
+ t(OS,'cmpi',{CR7,0,R10,SIMM99}),
+ t(OS,'cmpi',{CR7,1,R10,SIMM99}),
+ t(OS,'cmpli',{CR7,0,R10,UIMM4711}),
+ t(OS,'cmpli',{CR7,1,R10,UIMM4711}),
+ t(OS,'lbz',{R14,DispM3,R10}),
+ t(OS,'lbzu',{R14,DispM3,R10}),
+ t(OS,'lfd',{F2,DispM3,R10}),
+ t(OS,'lfdu',{F2,DispM3,R10}),
+ t(OS,'lfs',{F2,DispM3,R10}),
+ t(OS,'lfsu',{F2,DispM3,R10}),
+ t(OS,'lha',{R14,DispM3,R10}),
+ t(OS,'lhau',{R14,DispM3,R10}),
+ t(OS,'lhz',{R14,DispM3,R10}),
+ t(OS,'lhzu',{R14,DispM3,R10}),
+ t(OS,'lmw',{R14,DispM3,R10}),
+ t(OS,'lwz',{R14,DispM3,R10}),
+ t(OS,'lwzu',{R14,DispM3,R10}),
+ t(OS,'mulli',{R14,R10,SIMM99}),
+ t(OS,'ori',{R14,R10,UIMM4711}),
+ t(OS,'oris',{R14,R10,UIMM4711}),
+ t(OS,'stb',{R14,DispM3,R10}),
+ t(OS,'stbu',{R14,DispM3,R10}),
+ t(OS,'stfd',{F2,DispM3,R10}),
+ t(OS,'stfdu',{F2,DispM3,R10}),
+ t(OS,'stfs',{F2,DispM3,R10}),
+ t(OS,'stfsu',{F2,DispM3,R10}),
+ t(OS,'sth',{R14,DispM3,R10}),
+ t(OS,'sthu',{R14,DispM3,R10}),
+ t(OS,'stmw',{R14,DispM3,R10}),
+ t(OS,'stw',{R14,DispM3,R10}),
+ t(OS,'stwu',{R14,DispM3,R10}),
+ t(OS,'subfic',{R14,R10,SIMM99}),
+ t(OS,'tdi',{TO_LLE,R10,SIMM99}),
+ t(OS,'twi',{TO_LLE,R10,SIMM99}),
+ t(OS,'xori',{R14,R10,UIMM4711}),
+ t(OS,'xoris',{R14,R10,UIMM4711}),
+ %% DS-Form
+ t(OS,'ld',{R14,DS,R10}),
+ t(OS,'ldu',{R14,DS,R10}),
+ t(OS,'lwa',{R14,DS,R10}),
+ t(OS,'std',{R14,DS,R10}),
+ t(OS,'stdu',{R14,DS,R10}),
+ %% X-Form
+ t(OS,'and',{R14,R10,R11}),
+ t(OS,'and.',{R14,R10,R11}),
+ t(OS,'andc',{R14,R10,R11}),
+ t(OS,'andc.',{R14,R10,R11}),
+ t(OS,'cmp',{CR7,0,R10,R11}),
+ t(OS,'cmp',{CR7,1,R10,R11}),
+ t(OS,'cmpl',{CR7,0,R10,R11}),
+ t(OS,'cmpl',{CR7,1,R10,R11}),
+ t(OS,'cntlzd',{R14,R10}),
+ t(OS,'cntlzd.',{R14,R10}),
+ t(OS,'cntlzw',{R14,R10}),
+ t(OS,'cntlzw.',{R14,R10}),
+ t(OS,'dcba',{R10,R11}),
+ t(OS,'dcbf',{R10,R11}),
+ t(OS,'dcbi',{R10,R11}),
+ t(OS,'dcbst',{R10,R11}),
+ t(OS,'dcbt',{R10,R11}),
+ t(OS,'dcbtst',{R10,R11}),
+ t(OS,'dcbz',{R10,R11}),
+ t(OS,'eciwx',{R14,R10,R11}),
+ t(OS,'ecowx',{R14,R10,R11}),
+ t(OS,'eieio',{}),
+ t(OS,'eqv',{R14,R10,R11}),
+ t(OS,'eqv.',{R14,R10,R11}),
+ t(OS,'extsb',{R14,R10}),
+ t(OS,'extsb.',{R14,R10}),
+ t(OS,'extsh',{R14,R10}),
+ t(OS,'extsh.',{R14,R10}),
+ t(OS,'extsw',{R14,R10}),
+ t(OS,'extsw.',{R14,R10}),
+ t(OS,'fabs',{F2,F8}),
+ t(OS,'fabs.',{F2,F8}),
+ t(OS,'fcfid',{F2,F8}),
+ t(OS,'fcfid.',{F2,F8}),
+ t(OS,'fcmpo',{CR7,F4,F8}),
+ t(OS,'fcmpu',{CR7,F4,F8}),
+ t(OS,'fctid',{F2,F8}),
+ t(OS,'fctid.',{F2,F8}),
+ t(OS,'fctidz',{F2,F8}),
+ t(OS,'fctidz.',{F2,F8}),
+ t(OS,'fctiw',{F2,F8}),
+ t(OS,'fctiw.',{F2,F8}),
+ t(OS,'fctiwz',{F2,F8}),
+ t(OS,'fctiwz.',{F2,F8}),
+ t(OS,'fmr',{F2,F8}),
+ t(OS,'fmr.',{F2,F8}),
+ t(OS,'fnabs',{F2,F8}),
+ t(OS,'fnabs.',{F2,F8}),
+ t(OS,'fneg',{F2,F8}),
+ t(OS,'fneg.',{F2,F8}),
+ t(OS,'frsp',{F2,F8}),
+ t(OS,'frsp.',{F2,F8}),
+ t(OS,'icbi',{R10,R11}),
+ t(OS,'lbzux',{R14,R10,R11}),
+ t(OS,'lbzx',{R14,R10,R11}),
+ t(OS,'ldarx',{R14,R10,R11}),
+ t(OS,'ldux',{R14,R10,R11}),
+ t(OS,'ldx',{R14,R10,R11}),
+ t(OS,'lfdux',{F2,R10,R11}),
+ t(OS,'lfdx',{F2,R10,R11}),
+ t(OS,'lfsux',{F2,R10,R11}),
+ t(OS,'lfsx',{F2,R10,R11}),
+ t(OS,'lhaux',{R14,R10,R11}),
+ t(OS,'lhax',{R14,R10,R11}),
+ t(OS,'lhbrx',{R14,R10,R11}),
+ t(OS,'lhzux',{R14,R10,R11}),
+ t(OS,'lhzx',{R14,R10,R11}),
+ t(OS,'lswi',{R14,R10,NB7}),
+ t(OS,'lswx',{R14,R10,R11}),
+ t(OS,'lwarx',{R14,R10,R11}),
+ t(OS,'lwaux',{R14,R10,R11}),
+ t(OS,'lwax',{R14,R10,R11}),
+ t(OS,'lwbrx',{R14,R10,R11}),
+ t(OS,'lwzux',{R14,R10,R11}),
+ t(OS,'lwzx',{R14,R10,R11}),
+ t(OS,'mcrfs',{CR7,CR5}),
+ %% t(OS,'mcrxr',{CR7}),
+ t(OS,'mfcr',{R14}),
+ t(OS,'mffs',{F2}),
+ t(OS,'mffs.',{F2}),
+ t(OS,'mfmsr',{R14}),
+ t(OS,'mfsr',{R14,SR9}),
+ t(OS,'mfsrin',{R14,R11}),
+ t(OS,'mtfsb0',{CRB_CR0_LT}),
+ t(OS,'mtfsb0.',{CRB_CR0_LT}),
+ t(OS,'mtfsb1',{CRB_CR0_LT}),
+ t(OS,'mtfsb1.',{CRB_CR0_LT}),
+ t(OS,'mtfsfi',{CR7,CRIMM15}),
+ t(OS,'mtfsfi.',{CR7,CRIMM15}),
+ t(OS,'mtmsr',{R14}),
+ t(OS,'mtmsrd',{R14}),
+ t(OS,'mtsr',{SR9,R14}),
+ t(OS,'mtsrd',{SR9,R14}),
+ t(OS,'mtsrdin',{R14,R11}),
+ t(OS,'mtsrin',{R14,R11}),
+ t(OS,'nand',{R14,R10,R11}),
+ t(OS,'nand.',{R14,R10,R11}),
+ t(OS,'nor',{R14,R10,R11}),
+ t(OS,'nor.',{R14,R10,R11}),
+ t(OS,'or',{R14,R10,R11}),
+ t(OS,'or.',{R14,R10,R11}),
+ t(OS,'orc',{R14,R10,R11}),
+ t(OS,'orc.',{R14,R10,R11}),
+ t(OS,'slbia',{}),
+ t(OS,'slbie',{R11}),
+ t(OS,'sld',{R14,R10,R11}),
+ t(OS,'sld.',{R14,R10,R11}),
+ t(OS,'slw',{R14,R10,R11}),
+ t(OS,'slw.',{R14,R10,R11}),
+ t(OS,'srad',{R14,R10,R11}),
+ t(OS,'srad.',{R14,R10,R11}),
+ t(OS,'sraw',{R14,R10,R11}),
+ t(OS,'sraw.',{R14,R10,R11}),
+ t(OS,'srawi',{R14,R10,SH16}),
+ t(OS,'srawi.',{R14,R10,SH16}),
+ t(OS,'srd',{R14,R10,R11}),
+ t(OS,'srd.',{R14,R10,R11}),
+ t(OS,'srw',{R14,R10,R11}),
+ t(OS,'srw.',{R14,R10,R11}),
+ t(OS,'stbux',{R14,R10,R11}),
+ t(OS,'stbx',{R14,R10,R11}),
+ t(OS,'stdcx.',{R14,R10,R11}),
+ t(OS,'stdux',{R14,R10,R11}),
+ t(OS,'stdx',{R14,R10,R11}),
+ t(OS,'stfdux',{F2,R10,R11}),
+ t(OS,'stfdx',{F2,R10,R11}),
+ t(OS,'stfiwx',{F2,R10,R11}),
+ t(OS,'stfsux',{F2,R10,R11}),
+ t(OS,'stfsx',{F2,R10,R11}),
+ t(OS,'sthbrx',{R14,R10,R11}),
+ t(OS,'sthux',{R14,R10,R11}),
+ t(OS,'sthx',{R14,R10,R11}),
+ t(OS,'stswi',{R14,R10,NB7}),
+ t(OS,'stswx',{R14,R10,R11}),
+ t(OS,'stwbrx',{R14,R10,R11}),
+ t(OS,'stwcx.',{R14,R10,R11}),
+ t(OS,'stwux',{R14,R10,R11}),
+ t(OS,'stwx',{R14,R10,R11}),
+ t(OS,'sync',{}),
+ t(OS,'td',{TO_LLE,R10,R11}),
+ t(OS,'tlbia',{}),
+ t(OS,'tlbie',{R11}),
+ t(OS,'tlbld',{R11}),
+ t(OS,'tlbli',{R11}),
+ t(OS,'tlbsync',{}),
+ t(OS,'tw',{TO_LLE,R10,R11}),
+ t(OS,'xor',{R14,R10,R11}),
+ t(OS,'xor.',{R14,R10,R11}),
+ %% XL-Form
+ t(OS,'bcctr',{BO_NZ_PLUS,BI_CR0_EQ}),
+ t(OS,'bcctrl',{BO_NZ_PLUS,BI_CR0_EQ}),
+ t(OS,'bclr',{BO_NZ_PLUS,BI_CR0_EQ}),
+ t(OS,'bclrl',{BO_NZ_PLUS,BI_CR0_EQ}),
+ t(OS,'crand',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'crandc',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'creqv',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'crnand',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'crnor',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'cror',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'crorc',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'crxor',{CRB_CR0_LT,CRB_CR7_SO,CRB_CR1_GT}),
+ t(OS,'isync',{}),
+ t(OS,'mcrf',{CR7,CR5}),
+ t(OS,'rfi',{}),
+ t(OS,'rfid',{}),
+ %% XFX-Form
+ t(OS,'mfspr',{R14,SPR9}),
+ t(OS,'mftb',{R14,TBR268}),
+ t(OS,'mtcrf',{CRM192,R14}),
+ t(OS,'mtspr',{SPR9,R14}),
+ %% XFL-Form
+ t(OS,'mtfsf',{FM255,F8}),
+ t(OS,'mtfsf.',{FM255,F8}),
+ %% XS-Form
+ t(OS,'sradi',{R14,R10,SH45}),
+ t(OS,'sradi.',{R14,R10,SH45}),
+ %% XO-Form
+ t(OS,'add',{R14,R10,R11}),
+ t(OS,'add.',{R14,R10,R11}),
+ t(OS,'addo',{R14,R10,R11}),
+ t(OS,'addo.',{R14,R10,R11}),
+ t(OS,'addc',{R14,R10,R11}),
+ t(OS,'addc.',{R14,R10,R11}),
+ t(OS,'addco',{R14,R10,R11}),
+ t(OS,'addco.',{R14,R10,R11}),
+ t(OS,'adde',{R14,R10,R11}),
+ t(OS,'adde.',{R14,R10,R11}),
+ t(OS,'addeo',{R14,R10,R11}),
+ t(OS,'addeo.',{R14,R10,R11}),
+ t(OS,'addme',{R14,R10}),
+ t(OS,'addme.',{R14,R10}),
+ t(OS,'addmeo',{R14,R10}),
+ t(OS,'addmeo.',{R14,R10}),
+ t(OS,'addze',{R14,R10}),
+ t(OS,'addze.',{R14,R10}),
+ t(OS,'addzeo',{R14,R10}),
+ t(OS,'addzeo.',{R14,R10}),
+ t(OS,'divd',{R14,R10,R11}),
+ t(OS,'divd.',{R14,R10,R11}),
+ t(OS,'divdo',{R14,R10,R11}),
+ t(OS,'divdo.',{R14,R10,R11}),
+ t(OS,'divdu',{R14,R10,R11}),
+ t(OS,'divdu.',{R14,R10,R11}),
+ t(OS,'divduo',{R14,R10,R11}),
+ t(OS,'divduo.',{R14,R10,R11}),
+ t(OS,'divw',{R14,R10,R11}),
+ t(OS,'divw.',{R14,R10,R11}),
+ t(OS,'divwo',{R14,R10,R11}),
+ t(OS,'divwo.',{R14,R10,R11}),
+ t(OS,'divwu',{R14,R10,R11}),
+ t(OS,'divwu.',{R14,R10,R11}),
+ t(OS,'divwuo',{R14,R10,R11}),
+ t(OS,'divwuo.',{R14,R10,R11}),
+ t(OS,'mulhd',{R14,R10,R11}),
+ t(OS,'mulhd.',{R14,R10,R11}),
+ t(OS,'mulhdu',{R14,R10,R11}),
+ t(OS,'mulhdu.',{R14,R10,R11}),
+ t(OS,'mulhw',{R14,R10,R11}),
+ t(OS,'mulhw.',{R14,R10,R11}),
+ t(OS,'mulhwu',{R14,R10,R11}),
+ t(OS,'mulhwu.',{R14,R10,R11}),
+ t(OS,'mulld',{R14,R10,R11}),
+ t(OS,'mulld.',{R14,R10,R11}),
+ t(OS,'mulldo',{R14,R10,R11}),
+ t(OS,'mulldo.',{R14,R10,R11}),
+ t(OS,'mullw',{R14,R10,R11}),
+ t(OS,'mullw.',{R14,R10,R11}),
+ t(OS,'mullwo',{R14,R10,R11}),
+ t(OS,'mullwo.',{R14,R10,R11}),
+ t(OS,'neg',{R14,R10}),
+ t(OS,'neg.',{R14,R10}),
+ t(OS,'nego',{R14,R10}),
+ t(OS,'nego.',{R14,R10}),
+ t(OS,'subf',{R14,R10,R11}),
+ t(OS,'subf.',{R14,R10,R11}),
+ t(OS,'subfo',{R14,R10,R11}),
+ t(OS,'subfo.',{R14,R10,R11}),
+ t(OS,'subfc',{R14,R10,R11}),
+ t(OS,'subfc.',{R14,R10,R11}),
+ t(OS,'subfco',{R14,R10,R11}),
+ t(OS,'subfco.',{R14,R10,R11}),
+ t(OS,'subfe',{R14,R10,R11}),
+ t(OS,'subfe.',{R14,R10,R11}),
+ t(OS,'subfeo',{R14,R10,R11}),
+ t(OS,'subfeo.',{R14,R10,R11}),
+ t(OS,'subfme',{R14,R10}),
+ t(OS,'subfme.',{R14,R10}),
+ t(OS,'subfmeo',{R14,R10}),
+ t(OS,'subfmeo.',{R14,R10}),
+ t(OS,'subfze',{R14,R10}),
+ t(OS,'subfze.',{R14,R10}),
+ t(OS,'subfzeo',{R14,R10}),
+ t(OS,'subfzeo.',{R14,R10}),
+ %% A-Form
+ t(OS,'fadd',{F2,F4,F8}),
+ t(OS,'fadd.',{F2,F4,F8}),
+ t(OS,'fadds',{F2,F4,F8}),
+ t(OS,'fadds.',{F2,F4,F8}),
+ t(OS,'fdiv',{F2,F4,F8}),
+ t(OS,'fdiv.',{F2,F4,F8}),
+ t(OS,'fdivs',{F2,F4,F8}),
+ t(OS,'fdivs.',{F2,F4,F8}),
+ t(OS,'fmadd',{F2,F4,F6,F8}),
+ t(OS,'fmadd.',{F2,F4,F6,F8}),
+ t(OS,'fmadds',{F2,F4,F6,F8}),
+ t(OS,'fmadds.',{F2,F4,F6,F8}),
+ t(OS,'fmsub',{F2,F4,F6,F8}),
+ t(OS,'fmsub.',{F2,F4,F6,F8}),
+ t(OS,'fmsubs',{F2,F4,F6,F8}),
+ t(OS,'fmsubs.',{F2,F4,F6,F8}),
+ t(OS,'fmul',{F2,F4,F6}),
+ t(OS,'fmul.',{F2,F4,F6}),
+ t(OS,'fmuls',{F2,F4,F6}),
+ t(OS,'fmuls.',{F2,F4,F6}),
+ t(OS,'fnmadd',{F2,F4,F6,F8}),
+ t(OS,'fnmadd.',{F2,F4,F6,F8}),
+ t(OS,'fnmadds',{F2,F4,F6,F8}),
+ t(OS,'fnmadds.',{F2,F4,F6,F8}),
+ t(OS,'fnmsub',{F2,F4,F6,F8}),
+ t(OS,'fnmsub.',{F2,F4,F6,F8}),
+ t(OS,'fnmsubs',{F2,F4,F6,F8}),
+ t(OS,'fnmsubs.',{F2,F4,F6,F8}),
+ t(OS,'fres',{F2,F8}),
+ t(OS,'fres.',{F2,F8}),
+ t(OS,'frsqrte',{F2,F8}),
+ t(OS,'frsqrte.',{F2,F8}),
+ t(OS,'fsel',{F2,F4,F6,F8}),
+ t(OS,'fsel.',{F2,F4,F6,F8}),
+ t(OS,'fsqrt',{F2,F8}),
+ t(OS,'fsqrt.',{F2,F8}),
+ t(OS,'fsqrts',{F2,F8}),
+ t(OS,'fsqrts.',{F2,F8}),
+ t(OS,'fsub',{F2,F4,F8}),
+ t(OS,'fsub.',{F2,F4,F8}),
+ t(OS,'fsubs',{F2,F4,F8}),
+ t(OS,'fsubs.',{F2,F4,F8}),
+ %% M-Form
+ t(OS,'rlwimi',{R14,R10,SH16,MB10,ME20}),
+ t(OS,'rlwimi.',{R14,R10,SH16,MB10,ME20}),
+ t(OS,'rlwinm',{R14,R10,SH16,MB10,ME20}),
+ t(OS,'rlwinm.',{R14,R10,SH16,MB10,ME20}),
+ t(OS,'rlwnm',{R14,R10,R11,MB10,ME20}),
+ t(OS,'rlwnm.',{R14,R10,R11,MB10,ME20}),
+ %% MD-Form
+ t(OS,'rldic',{R14,R10,SH45,MB40}),
+ t(OS,'rldic.',{R14,R10,SH45,MB40}),
+ t(OS,'rldicl',{R14,R10,SH45,MB40}),
+ t(OS,'rldicl.',{R14,R10,SH45,MB40}),
+ t(OS,'rldicr',{R14,R10,SH45,ME50}),
+ t(OS,'rldicr.',{R14,R10,SH45,ME50}),
+ t(OS,'rldimi',{R14,R10,SH45,MB40}),
+ t(OS,'rldimi.',{R14,R10,SH45,MB40}),
+ %% MDS-Form
+ t(OS,'rldcl',{R14,R10,R11,MB40}),
+ t(OS,'rldcl.',{R14,R10,R11,MB40}),
+ t(OS,'rldcr',{R14,R10,R11,ME50}),
+ t(OS,'rldcr.',{R14,R10,R11,ME50}),
+ [].
+
+dotest() -> dotest1(group_leader()).
+
+dotest(File) ->
+ {ok,OS} = file:open(File, [write]),
+ dotest1(OS),
+ file:close(OS).
+
+-endif.
diff --git a/lib/hipe/ppc/hipe_ppc_finalise.erl b/lib/hipe/ppc/hipe_ppc_finalise.erl
new file mode 100644
index 0000000000..c4b9526fec
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_finalise.erl
@@ -0,0 +1,65 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_finalise).
+-export([finalise/1]).
+-include("hipe_ppc.hrl").
+
+finalise(Defun) ->
+ #defun{code=Code0} = Defun,
+ Code1 = peep(expand(Code0)),
+ Defun#defun{code=Code1}.
+
+expand(Insns) ->
+ expand_list(Insns, []).
+
+expand_list([I|Insns], Accum) ->
+ expand_list(Insns, expand_insn(I, Accum));
+expand_list([], Accum) ->
+ lists:reverse(Accum).
+
+expand_insn(I, Accum) ->
+ case I of
+ #pseudo_bc{bcond=BCond,true_label=TrueLab,false_label=FalseLab,pred=Pred} ->
+ [hipe_ppc:mk_b_label(FalseLab),
+ hipe_ppc:mk_bc(BCond, TrueLab, Pred) |
+ Accum];
+ #pseudo_call{func=FunC,sdesc=SDesc,contlab=ContLab,linkage=Linkage} ->
+ [hipe_ppc:mk_b_label(ContLab),
+ case FunC of
+ 'ctr' -> hipe_ppc:mk_bctrl(SDesc);
+ Fun -> hipe_ppc:mk_bl(Fun, SDesc, Linkage)
+ end |
+ Accum];
+ #pseudo_tailcall_prepare{} ->
+ Accum;
+ _ ->
+ [I|Accum]
+ end.
+
+peep(Insns) ->
+ peep_list(Insns, []).
+
+peep_list([#b_label{label=Label} | (Insns = [#label{label=Label}|_])], Accum) ->
+ peep_list(Insns, Accum);
+peep_list([I|Insns], Accum) ->
+ peep_list(Insns, [I|Accum]);
+peep_list([], Accum) ->
+ lists:reverse(Accum).
diff --git a/lib/hipe/ppc/hipe_ppc_frame.erl b/lib/hipe/ppc/hipe_ppc_frame.erl
new file mode 100644
index 0000000000..158009872f
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_frame.erl
@@ -0,0 +1,657 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_frame).
+-export([frame/1]).
+-include("hipe_ppc.hrl").
+-include("../rtl/hipe_literals.hrl").
+
+frame(Defun) ->
+ Formals = fix_formals(hipe_ppc:defun_formals(Defun)),
+ Temps0 = all_temps(hipe_ppc:defun_code(Defun), Formals),
+ MinFrame = defun_minframe(Defun),
+ Temps = ensure_minframe(MinFrame, Temps0),
+ ClobbersLR = clobbers_lr(hipe_ppc:defun_code(Defun)),
+ CFG0 = hipe_ppc_cfg:init(Defun),
+ Liveness = hipe_ppc_liveness_all:analyse(CFG0),
+ CFG1 = do_body(CFG0, Liveness, Formals, Temps, ClobbersLR),
+ hipe_ppc_cfg:linearise(CFG1).
+
+fix_formals(Formals) ->
+ fix_formals(hipe_ppc_registers:nr_args(), Formals).
+
+fix_formals(0, Rest) -> Rest;
+fix_formals(N, [_|Rest]) -> fix_formals(N-1, Rest);
+fix_formals(_, []) -> [].
+
+do_body(CFG0, Liveness, Formals, Temps, ClobbersLR) ->
+ Context = mk_context(Liveness, Formals, Temps, ClobbersLR),
+ CFG1 = do_blocks(CFG0, Context),
+ do_prologue(CFG1, Context).
+
+do_blocks(CFG, Context) ->
+ Labels = hipe_ppc_cfg:labels(CFG),
+ do_blocks(Labels, CFG, Context).
+
+do_blocks([Label|Labels], CFG, Context) ->
+ Liveness = context_liveness(Context),
+ LiveOut = hipe_ppc_liveness_all:liveout(Liveness, Label),
+ Block = hipe_ppc_cfg:bb(CFG, Label),
+ Code = hipe_bb:code(Block),
+ NewCode = do_block(Code, LiveOut, Context),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ NewCFG = hipe_ppc_cfg:bb_add(CFG, Label, NewBlock),
+ do_blocks(Labels, NewCFG, Context);
+do_blocks([], CFG, _) ->
+ CFG.
+
+do_block(Insns, LiveOut, Context) ->
+ do_block(Insns, LiveOut, Context, context_framesize(Context), []).
+
+do_block([I|Insns], LiveOut, Context, FPoff0, RevCode) ->
+ {NewIs, FPoff1} = do_insn(I, LiveOut, Context, FPoff0),
+ do_block(Insns, LiveOut, Context, FPoff1, lists:reverse(NewIs, RevCode));
+do_block([], _, Context, FPoff, RevCode) ->
+ FPoff0 = context_framesize(Context),
+ if FPoff =:= FPoff0 -> [];
+ true -> exit({?MODULE,do_block,FPoff})
+ end,
+ lists:reverse(RevCode, []).
+
+do_insn(I, LiveOut, Context, FPoff) ->
+ case I of
+ #blr{} ->
+ {do_blr(I, Context, FPoff), context_framesize(Context)};
+ #pseudo_call{} ->
+ do_pseudo_call(I, LiveOut, Context, FPoff);
+ #pseudo_call_prepare{} ->
+ do_pseudo_call_prepare(I, FPoff);
+ #pseudo_move{} ->
+ {do_pseudo_move(I, Context, FPoff), FPoff};
+ #pseudo_tailcall{} ->
+ {do_pseudo_tailcall(I, Context), context_framesize(Context)};
+ #pseudo_fmove{} ->
+ {do_pseudo_fmove(I, Context, FPoff), FPoff};
+ _ ->
+ {[I], FPoff}
+ end.
+
+%%%
+%%% Moves, with Dst or Src possibly a pseudo
+%%%
+
+do_pseudo_move(I, Context, FPoff) ->
+ Dst = hipe_ppc:pseudo_move_dst(I),
+ Src = hipe_ppc:pseudo_move_src(I),
+ case temp_is_pseudo(Dst) of
+ true ->
+ Offset = pseudo_offset(Dst, FPoff, Context),
+ mk_store('stw', Src, Offset, mk_sp(), []);
+ _ ->
+ case temp_is_pseudo(Src) of
+ true ->
+ Offset = pseudo_offset(Src, FPoff, Context),
+ mk_load('lwz', Dst, Offset, mk_sp(), []);
+ _ ->
+ [hipe_ppc:mk_alu('or', Dst, Src, Src)]
+ end
+ end.
+
+do_pseudo_fmove(I, Context, FPoff) ->
+ Dst = hipe_ppc:pseudo_fmove_dst(I),
+ Src = hipe_ppc:pseudo_fmove_src(I),
+ case temp_is_pseudo(Dst) of
+ true ->
+ Offset = pseudo_offset(Dst, FPoff, Context),
+ hipe_ppc:mk_fstore(Src, Offset, mk_sp(), 0);
+ _ ->
+ case temp_is_pseudo(Src) of
+ true ->
+ Offset = pseudo_offset(Src, FPoff, Context),
+ hipe_ppc:mk_fload(Dst, Offset, mk_sp(), 0);
+ _ ->
+ [hipe_ppc:mk_fp_unary('fmr', Dst, Src)]
+ end
+ end.
+
+pseudo_offset(Temp, FPoff, Context) ->
+ FPoff + context_offset(Context, Temp).
+
+%%%
+%%% Return - deallocate frame and emit 'ret $N' insn.
+%%%
+
+do_blr(I, Context, FPoff) ->
+ %% XXX: perhaps use explicit pseudo_move;mtlr,
+ %% avoiding the need to hard-code Temp1 here
+ %% XXX: typically only one instruction between
+ %% the mtlr and the blr, ouch
+ restore_lr(FPoff, Context,
+ adjust_sp(FPoff + word_size() * context_arity(Context),
+ [I])).
+
+restore_lr(FPoff, Context, Rest) ->
+ case context_clobbers_lr(Context) of
+ false -> Rest;
+ true ->
+ Temp = mk_temp1(),
+ mk_load('lwz', Temp, FPoff - word_size(), mk_sp(),
+ [hipe_ppc:mk_mtspr('lr', Temp) |
+ Rest])
+ end.
+
+adjust_sp(N, Rest) ->
+ if N =:= 0 ->
+ Rest;
+ true ->
+ SP = mk_sp(),
+ hipe_ppc:mk_addi(SP, SP, N, Rest)
+ end.
+
+%%%
+%%% Recursive calls.
+%%%
+
+do_pseudo_call_prepare(I, FPoff0) ->
+ %% Create outgoing arguments area on the stack.
+ NrStkArgs = hipe_ppc:pseudo_call_prepare_nrstkargs(I),
+ Offset = NrStkArgs * word_size(),
+ {adjust_sp(-Offset, []), FPoff0 + Offset}.
+
+do_pseudo_call(I, LiveOut, Context, FPoff0) ->
+ #ppc_sdesc{exnlab=ExnLab,arity=OrigArity} = hipe_ppc:pseudo_call_sdesc(I),
+ FunC = hipe_ppc:pseudo_call_func(I),
+ LiveTemps = [Temp || Temp <- LiveOut, temp_is_pseudo(Temp)],
+ SDesc = mk_sdesc(ExnLab, Context, LiveTemps),
+ ContLab = hipe_ppc:pseudo_call_contlab(I),
+ Linkage = hipe_ppc:pseudo_call_linkage(I),
+ CallCode = [hipe_ppc:mk_pseudo_call(FunC, SDesc, ContLab, Linkage)],
+ StkArity = erlang:max(0, OrigArity - hipe_ppc_registers:nr_args()),
+ context_need_stack(Context, stack_need(FPoff0, StkArity, FunC)),
+ ArgsBytes = word_size() * StkArity,
+ {CallCode, FPoff0 - ArgsBytes}.
+
+stack_need(FPoff, StkArity, FunC) ->
+ case FunC of
+ #ppc_prim{} -> FPoff;
+ #ppc_mfa{m=M,f=F,a=A} ->
+ case erlang:is_builtin(M, F, A) of
+ true -> FPoff;
+ false -> stack_need_general(FPoff, StkArity)
+ end;
+ 'ctr' -> stack_need_general(FPoff, StkArity)
+ end.
+
+stack_need_general(FPoff, StkArity) ->
+ erlang:max(FPoff, FPoff + (?PPC_LEAF_WORDS - StkArity) * word_size()).
+
+%%%
+%%% Create stack descriptors for call sites.
+%%%
+
+mk_sdesc(ExnLab, Context, Temps) -> % for normal calls
+ Temps0 = only_tagged(Temps),
+ Live = mk_live(Context, Temps0),
+ Arity = context_arity(Context),
+ FSize = context_framesize(Context),
+ hipe_ppc:mk_sdesc(ExnLab, (FSize div word_size())-1, Arity,
+ list_to_tuple(Live)).
+
+only_tagged(Temps)->
+ [X || X <- Temps, hipe_ppc:temp_type(X) =:= 'tagged'].
+
+mk_live(Context, Temps) ->
+ lists:sort([temp_to_slot(Context, Temp) || Temp <- Temps]).
+
+temp_to_slot(Context, Temp) ->
+ (context_framesize(Context) + context_offset(Context, Temp))
+ div word_size().
+
+mk_minimal_sdesc(Context) -> % for inc_stack_0 calls
+ hipe_ppc:mk_sdesc([], 0, context_arity(Context), {}).
+
+%%%
+%%% Tailcalls.
+%%%
+
+do_pseudo_tailcall(I, Context) -> % always at FPoff=context_framesize(Context)
+ Arity = context_arity(Context),
+ Args = hipe_ppc:pseudo_tailcall_stkargs(I),
+ FunC = hipe_ppc:pseudo_tailcall_func(I),
+ Linkage = hipe_ppc:pseudo_tailcall_linkage(I),
+ {Insns, FPoff1} = do_tailcall_args(Args, Context),
+ context_need_stack(Context, FPoff1),
+ StkArity = length(Args),
+ FPoff2 = FPoff1 + (Arity - StkArity) * word_size(),
+ context_need_stack(Context, stack_need(FPoff2, StkArity, FunC)),
+ I2 =
+ case FunC of
+ 'ctr' ->
+ hipe_ppc:mk_bctr([]);
+ Fun ->
+ hipe_ppc:mk_b_fun(Fun, Linkage)
+ end,
+ %% XXX: break out the LR restore, just like for blr?
+ restore_lr(context_framesize(Context), Context,
+ Insns ++ adjust_sp(FPoff2, [I2])).
+
+do_tailcall_args(Args, Context) ->
+ FPoff0 = context_framesize(Context),
+ Arity = context_arity(Context),
+ FrameTop = word_size()*Arity,
+ DangerOff = FrameTop - word_size()*length(Args),
+ %%
+ Moves = mk_moves(Args, FrameTop, []),
+ %%
+ {Stores, Simple, Conflict} =
+ split_moves(Moves, Context, DangerOff, [], [], []),
+ %% sanity check (shouldn't trigger any more)
+ if DangerOff < -FPoff0 ->
+ exit({?MODULE,do_tailcall_args,DangerOff,-FPoff0});
+ true -> []
+ end,
+ FPoff1 = FPoff0,
+ %%
+ {Pushes, Pops, FPoff2} = split_conflict(Conflict, FPoff1, [], []),
+ %%
+ TempReg = hipe_ppc_registers:temp1(),
+ %%
+ {adjust_sp(-(FPoff2 - FPoff1),
+ simple_moves(Pushes, FPoff2, TempReg,
+ store_moves(Stores, FPoff2, TempReg,
+ simple_moves(Simple, FPoff2, TempReg,
+ simple_moves(Pops, FPoff2, TempReg,
+ []))))),
+ FPoff2}.
+
+mk_moves([Arg|Args], Off, Moves) ->
+ Off1 = Off - word_size(),
+ mk_moves(Args, Off1, [{Arg,Off1}|Moves]);
+mk_moves([], _, Moves) ->
+ Moves.
+
+split_moves([Move|Moves], Context, DangerOff, Stores, Simple, Conflict) ->
+ {Src,DstOff} = Move,
+ case src_is_pseudo(Src) of
+ false ->
+ split_moves(Moves, Context, DangerOff, [Move|Stores],
+ Simple, Conflict);
+ true ->
+ SrcOff = context_offset(Context, Src),
+ Type = typeof_temp(Src),
+ if SrcOff =:= DstOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, Conflict);
+ SrcOff >= DangerOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, [{SrcOff,DstOff,Type}|Conflict]);
+ true ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ [{SrcOff,DstOff,Type}|Simple], Conflict)
+ end
+ end;
+split_moves([], _, _, Stores, Simple, Conflict) ->
+ {Stores, Simple, Conflict}.
+
+split_conflict([{SrcOff,DstOff,Type}|Conflict], FPoff, Pushes, Pops) ->
+ FPoff1 = FPoff + word_size(),
+ Push = {SrcOff,-FPoff1,Type},
+ Pop = {-FPoff1,DstOff,Type},
+ split_conflict(Conflict, FPoff1, [Push|Pushes], [Pop|Pops]);
+split_conflict([], FPoff, Pushes, Pops) ->
+ {lists:reverse(Pushes), Pops, FPoff}.
+
+simple_moves([{SrcOff,DstOff,Type}|Moves], FPoff, TempReg, Rest) ->
+ Temp = hipe_ppc:mk_temp(TempReg, Type),
+ SP = mk_sp(),
+ LoadOff = FPoff+SrcOff,
+ StoreOff = FPoff+DstOff,
+ simple_moves(Moves, FPoff, TempReg,
+ mk_load('lwz', Temp, LoadOff, SP,
+ mk_store('stw', Temp, StoreOff, SP,
+ Rest)));
+simple_moves([], _, _, Rest) ->
+ Rest.
+
+store_moves([{Src,DstOff}|Moves], FPoff, TempReg, Rest) ->
+ %%Type = typeof_temp(Src),
+ SP = mk_sp(),
+ StoreOff = FPoff+DstOff,
+ {NewSrc,FixSrc} =
+ case hipe_ppc:is_temp(Src) of
+ true ->
+ {Src, []};
+ _ ->
+ Temp = hipe_ppc:mk_temp(TempReg, 'untagged'),
+ {Temp, hipe_ppc:mk_li(Temp, Src)}
+ end,
+ store_moves(Moves, FPoff, TempReg,
+ FixSrc ++ mk_store('stw', NewSrc, StoreOff, SP, Rest));
+store_moves([], _, _, Rest) ->
+ Rest.
+
+%%%
+%%% Contexts
+%%%
+
+-record(context, {liveness, framesize, arity, map, clobbers_lr, ref_maxstack}).
+
+mk_context(Liveness, Formals, Temps, ClobbersLR) ->
+ {Map, MinOff} = mk_temp_map(Formals, ClobbersLR, Temps),
+ FrameSize = (-MinOff),
+ RefMaxStack = hipe_bifs:ref(FrameSize),
+ #context{liveness=Liveness,
+ framesize=FrameSize, arity=length(Formals),
+ map=Map, clobbers_lr=ClobbersLR, ref_maxstack=RefMaxStack}.
+
+context_need_stack(#context{ref_maxstack=RM}, N) ->
+ M = hipe_bifs:ref_get(RM),
+ if N > M -> hipe_bifs:ref_set(RM, N);
+ true -> []
+ end.
+
+context_maxstack(#context{ref_maxstack=RM}) ->
+ hipe_bifs:ref_get(RM).
+
+context_arity(#context{arity=Arity}) ->
+ Arity.
+
+context_framesize(#context{framesize=FrameSize}) ->
+ FrameSize.
+
+context_liveness(#context{liveness=Liveness}) ->
+ Liveness.
+
+context_offset(#context{map=Map}, Temp) ->
+ tmap_lookup(Map, Temp).
+
+context_clobbers_lr(#context{clobbers_lr=ClobbersLR}) -> ClobbersLR.
+
+mk_temp_map(Formals, ClobbersLR, Temps) ->
+ {Map, 0} = enter_vars(Formals, word_size() * length(Formals),
+ tmap_empty()),
+ TempsList = tset_to_list(Temps),
+ AllTemps =
+ case ClobbersLR of
+ false -> TempsList;
+ true ->
+ RA = hipe_ppc:mk_new_temp('untagged'),
+ [RA|TempsList]
+ end,
+ enter_vars(AllTemps, 0, Map).
+
+enter_vars([V|Vs], PrevOff, Map) ->
+ Off =
+ case hipe_ppc:temp_type(V) of
+ 'double' -> PrevOff - 2*word_size();
+ _ -> PrevOff - word_size()
+ end,
+ enter_vars(Vs, Off, tmap_bind(Map, V, Off));
+enter_vars([], Off, Map) ->
+ {Map, Off}.
+
+tmap_empty() ->
+ gb_trees:empty().
+
+tmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+tmap_lookup(Map, Key) ->
+ gb_trees:get(Key, Map).
+
+%%%
+%%% do_prologue: prepend stack frame allocation code.
+%%%
+%%% NewStart:
+%%% temp1 = *(P + P_SP_LIMIT)
+%%% temp2 = SP - MaxStack
+%%% cmp temp2, temp1
+%%% temp1 = LR [if ClobbersLR][hoisted]
+%%% if (ltu) goto IncStack else goto AllocFrame
+%%% AllocFrame:
+%%% SP = temp2 [if FrameSize == MaxStack]
+%%% SP -= FrameSize [if FrameSize != MaxStack]
+%%% *(SP + FrameSize-WordSize) = temp1 [if ClobbersLR]
+%%% goto OldStart
+%%% OldStart:
+%%% ...
+%%% IncStack:
+%%% temp1 = LR [if not ClobbersLR]
+%%% bl inc_stack
+%%% LR = temp1
+%%% goto NewStart
+
+do_prologue(CFG, Context) ->
+ MaxStack = context_maxstack(Context),
+ if MaxStack > 0 ->
+ FrameSize = context_framesize(Context),
+ OldStartLab = hipe_ppc_cfg:start_label(CFG),
+ NewStartLab = hipe_gensym:get_next_label(ppc),
+ %%
+ P = hipe_ppc:mk_temp(hipe_ppc_registers:proc_pointer(), 'untagged'),
+ Temp1 = mk_temp1(),
+ SP = mk_sp(),
+ %%
+ ClobbersLR = context_clobbers_lr(Context),
+ GotoOldStartCode = [hipe_ppc:mk_b_label(OldStartLab)],
+ AllocFrameCodeTail =
+ case ClobbersLR of
+ false -> GotoOldStartCode;
+ true -> mk_store('stw', Temp1, FrameSize-word_size(), SP, GotoOldStartCode)
+ end,
+ %%
+ Arity = context_arity(Context),
+ Guaranteed = erlang:max(0, (?PPC_LEAF_WORDS - Arity) * word_size()),
+ %%
+ {CFG1,NewStartCode} =
+ if MaxStack =< Guaranteed ->
+ %% io:format("~w: MaxStack ~w =< Guaranteed ~w :-)\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameCode = adjust_sp(-FrameSize, AllocFrameCodeTail),
+ NewStartCode0 =
+ case ClobbersLR of
+ false -> AllocFrameCode;
+ true -> [hipe_ppc:mk_mfspr(Temp1, 'lr') | AllocFrameCode]
+ end,
+ {CFG,NewStartCode0};
+ true ->
+ %% io:format("~w: MaxStack ~w > Guaranteed ~w :-(\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameLab = hipe_gensym:get_next_label(ppc),
+ IncStackLab = hipe_gensym:get_next_label(ppc),
+ Temp2 = mk_temp2(),
+ %%
+ NewStartCodeTail2 =
+ [hipe_ppc:mk_pseudo_bc('lt', IncStackLab, AllocFrameLab, 0.01)],
+ NewStartCodeTail1 =
+ case ClobbersLR of
+ false -> NewStartCodeTail2;
+ true -> [hipe_ppc:mk_mfspr(Temp1, 'lr') | NewStartCodeTail2]
+ end,
+ NewStartCode0 =
+ [hipe_ppc:mk_load('lwz', Temp1, ?P_NSP_LIMIT, P) |
+ hipe_ppc:mk_addi(Temp2, SP, -MaxStack,
+ [hipe_ppc:mk_cmp('cmpl', Temp2, Temp1) |
+ NewStartCodeTail1])],
+ %%
+ AllocFrameCode =
+ if MaxStack =:= FrameSize ->
+ %% io:format("~w: MaxStack =:= FrameSize =:= ~w :-)\n", [?MODULE,MaxStack]),
+ [hipe_ppc:mk_alu('or', SP, Temp2, Temp2) |
+ AllocFrameCodeTail];
+ true ->
+ %% io:format("~w: MaxStack ~w =/= FrameSize ~w :-(\n", [?MODULE,MaxStack,FrameSize]),
+ adjust_sp(-FrameSize, AllocFrameCodeTail)
+ end,
+ %%
+ IncStackCodeTail =
+ [hipe_ppc:mk_bl(hipe_ppc:mk_prim('inc_stack_0'),
+ mk_minimal_sdesc(Context), not_remote),
+ hipe_ppc:mk_mtspr('lr', Temp1),
+ hipe_ppc:mk_b_label(NewStartLab)],
+ IncStackCode =
+ case ClobbersLR of
+ true -> IncStackCodeTail;
+ false -> [hipe_ppc:mk_mfspr(Temp1, 'lr') | IncStackCodeTail]
+ end,
+ %%
+ CFG0a = hipe_ppc_cfg:bb_add(CFG, AllocFrameLab,
+ hipe_bb:mk_bb(AllocFrameCode)),
+ CFG0b = hipe_ppc_cfg:bb_add(CFG0a, IncStackLab,
+ hipe_bb:mk_bb(IncStackCode)),
+ %%
+ {CFG0b,NewStartCode0}
+ end,
+ %%
+ CFG2 = hipe_ppc_cfg:bb_add(CFG1, NewStartLab,
+ hipe_bb:mk_bb(NewStartCode)),
+ hipe_ppc_cfg:start_label_update(CFG2, NewStartLab);
+ true ->
+ CFG
+ end.
+
+%%% Create a load instruction.
+%%% May clobber Dst early for large offsets. In principle we could
+%%% clobber R0 if Dst =:= Base, but Dst =/= Base here in frame.
+
+mk_load(LdOp, Dst, Offset, Base, Rest) ->
+ hipe_ppc:mk_load(LdOp, Dst, Offset, Base, 'error', Rest).
+
+%%% Create a store instruction.
+%%% May clobber R0 for large offsets.
+
+mk_store(StOp, Src, Offset, Base, Rest) ->
+ hipe_ppc:mk_store(StOp, Src, Offset, Base, 0, Rest).
+
+%%% typeof_temp -- what's temp's type?
+
+typeof_temp(Temp) ->
+ hipe_ppc:temp_type(Temp).
+
+%%% Cons up an 'SP' Temp.
+
+mk_sp() ->
+ hipe_ppc:mk_temp(hipe_ppc_registers:stack_pointer(), 'untagged').
+
+%%% Cons up a 'TEMP1' Temp.
+
+mk_temp1() ->
+ hipe_ppc:mk_temp(hipe_ppc_registers:temp1(), 'untagged').
+
+%%% Cons up a 'TEMP2' Temp.
+
+mk_temp2() ->
+ hipe_ppc:mk_temp(hipe_ppc_registers:temp2(), 'untagged').
+
+%%% Check if an operand is a pseudo-Temp.
+
+src_is_pseudo(Src) ->
+ hipe_ppc:is_temp(Src) andalso temp_is_pseudo(Src).
+
+temp_is_pseudo(Temp) ->
+ not(hipe_ppc:temp_is_precoloured(Temp)).
+
+%%%
+%%% Detect if a Defun's body clobbers LR.
+%%%
+
+clobbers_lr([I|Insns]) ->
+ case I of
+ #pseudo_call{} -> true;
+ %% mtspr to lr cannot occur yet
+ _ -> clobbers_lr(Insns)
+ end;
+clobbers_lr([]) -> false.
+
+%%%
+%%% Build the set of all temps used in a Defun's body.
+%%%
+
+all_temps(Code, Formals) ->
+ S0 = find_temps(Code, tset_empty()),
+ S1 = tset_del_list(S0, Formals),
+ tset_filter(S1, fun(T) -> temp_is_pseudo(T) end).
+
+find_temps([I|Insns], S0) ->
+ S1 = tset_add_list(S0, hipe_ppc_defuse:insn_def_all(I)),
+ S2 = tset_add_list(S1, hipe_ppc_defuse:insn_use_all(I)),
+ find_temps(Insns, S2);
+find_temps([], S) ->
+ S.
+
+tset_empty() ->
+ gb_sets:new().
+
+tset_size(S) ->
+ gb_sets:size(S).
+
+tset_insert(S, T) ->
+ gb_sets:add_element(T, S).
+
+tset_add_list(S, Ts) ->
+ gb_sets:union(S, gb_sets:from_list(Ts)).
+
+tset_del_list(S, Ts) ->
+ gb_sets:subtract(S, gb_sets:from_list(Ts)).
+
+tset_filter(S, F) ->
+ gb_sets:filter(F, S).
+
+tset_to_list(S) ->
+ gb_sets:to_list(S).
+
+%%%
+%%% Compute minimum permissible frame size, ignoring spilled temps.
+%%% This is done to ensure that we won't have to adjust the frame size
+%%% in the middle of a tailcall.
+%%%
+
+defun_minframe(Defun) ->
+ MaxTailArity = body_mta(hipe_ppc:defun_code(Defun), 0),
+ MyArity = length(fix_formals(hipe_ppc:defun_formals(Defun))),
+ erlang:max(MaxTailArity - MyArity, 0).
+
+body_mta([I|Code], MTA) ->
+ body_mta(Code, insn_mta(I, MTA));
+body_mta([], MTA) ->
+ MTA.
+
+insn_mta(I, MTA) ->
+ case I of
+ #pseudo_tailcall{arity=Arity} ->
+ erlang:max(MTA, Arity - hipe_ppc_registers:nr_args());
+ _ -> MTA
+ end.
+
+%%%
+%%% Ensure that we have enough temps to satisfy the minimum frame size,
+%%% if necessary by prepending unused dummy temps.
+%%%
+
+ensure_minframe(MinFrame, Temps) ->
+ ensure_minframe(MinFrame, tset_size(Temps), Temps).
+
+ensure_minframe(MinFrame, Frame, Temps) ->
+ if MinFrame > Frame ->
+ Temp = hipe_ppc:mk_new_temp('untagged'),
+ ensure_minframe(MinFrame, Frame+1, tset_insert(Temps, Temp));
+ true -> Temps
+ end.
+
+word_size() ->
+ hipe_rtl_arch:word_size().
diff --git a/lib/hipe/ppc/hipe_ppc_liveness_all.erl b/lib/hipe/ppc/hipe_ppc_liveness_all.erl
new file mode 100644
index 0000000000..c9234e8100
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_liveness_all.erl
@@ -0,0 +1,38 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_liveness_all).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_ppc.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_ppc_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_ppc_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_ppc_cfg:succ(CFG, L).
+uses(Insn) -> hipe_ppc_defuse:insn_use_all(Insn).
+defines(Insn) -> hipe_ppc_defuse:insn_def_all(Insn).
+liveout_no_succ() ->
+ ordsets:from_list(lists:map(fun({Reg,Type}) ->
+ hipe_ppc:mk_temp(Reg, Type)
+ end,
+ hipe_ppc_registers:live_at_return())).
diff --git a/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl b/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl
new file mode 100644
index 0000000000..ff9db21e2b
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl
@@ -0,0 +1,34 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_liveness_fpr).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_ppc.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_ppc_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_ppc_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_ppc_cfg:succ(CFG, L).
+uses(Insn) -> hipe_ppc_defuse:insn_use_fpr(Insn).
+defines(Insn) -> hipe_ppc_defuse:insn_def_fpr(Insn).
+liveout_no_succ() -> [].
diff --git a/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl b/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl
new file mode 100644
index 0000000000..a55052b944
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl
@@ -0,0 +1,38 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_liveness_gpr).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_ppc.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_ppc_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_ppc_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_ppc_cfg:succ(CFG, L).
+uses(Insn) -> hipe_ppc_defuse:insn_use_gpr(Insn).
+defines(Insn) -> hipe_ppc_defuse:insn_def_gpr(Insn).
+liveout_no_succ() ->
+ ordsets:from_list(lists:map(fun({Reg,Type}) ->
+ hipe_ppc:mk_temp(Reg, Type)
+ end,
+ hipe_ppc_registers:live_at_return())).
diff --git a/lib/hipe/ppc/hipe_ppc_main.erl b/lib/hipe/ppc/hipe_ppc_main.erl
new file mode 100644
index 0000000000..1d84f6db11
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_main.erl
@@ -0,0 +1,51 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_main).
+-export([rtl_to_ppc/3]).
+
+rtl_to_ppc(MFA, RTL, Options) ->
+ PPC1 = hipe_rtl_to_ppc:translate(RTL),
+ PPC2 = hipe_ppc_ra:ra(PPC1, Options),
+ PPC3 = hipe_ppc_frame:frame(PPC2),
+ PPC4 = hipe_ppc_finalise:finalise(PPC3),
+ ppc_pp(PPC4, MFA, Options),
+ {native, powerpc, {unprofiled, PPC4}}.
+
+ppc_pp(PPC, MFA, Options) ->
+ case proplists:get_value(pp_native, Options) of
+ true ->
+ hipe_ppc_pp:pp(PPC);
+ {only,Lst} when is_list(Lst) ->
+ case lists:member(MFA,Lst) of
+ true ->
+ hipe_ppc_pp:pp(PPC);
+ false ->
+ ok
+ end;
+ {only,MFA} ->
+ hipe_ppc_pp:pp(PPC);
+ {file,FileName} ->
+ {ok, File} = file:open(FileName, [write,append]),
+ hipe_ppc_pp:pp(File, PPC),
+ ok = file:close(File);
+ _ ->
+ ok
+ end.
diff --git a/lib/hipe/ppc/hipe_ppc_pp.erl b/lib/hipe/ppc/hipe_ppc_pp.erl
new file mode 100644
index 0000000000..f88e922808
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_pp.erl
@@ -0,0 +1,350 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_pp).
+-export([pp/1, pp/2, pp_insn/1]).
+
+-include("hipe_ppc.hrl").
+
+pp(Defun) ->
+ pp(standard_io, Defun).
+
+pp(Dev, #defun{mfa={M,F,A}, code=Code, data=Data}) ->
+ Fname = atom_to_list(M)++"_"++atom_to_list(F)++"_"++integer_to_list(A),
+ io:format(Dev, "\t.text\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ io:format(Dev, "\t.global ~s\n", [Fname]),
+ io:format(Dev, "~s:\n", [Fname]),
+ pp_insns(Dev, Code, Fname),
+ io:format(Dev, "\t.rodata\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ hipe_data_pp:pp(Dev, Data, ppc, Fname),
+ io:format(Dev, "\n", []).
+
+pp_insns(Dev, [I|Is], Fname) ->
+ pp_insn(Dev, I, Fname),
+ pp_insns(Dev, Is, Fname);
+pp_insns(_, [], _) ->
+ [].
+
+pp_insn(I) ->
+ pp_insn(standard_io, I, "").
+
+pp_insn(Dev, I, Pre) ->
+ case I of
+ #alu{aluop=AluOp, dst=Dst, src1=Src1, src2=Src2} ->
+ io:format(Dev, "\t~s ", [alu_op_name(AluOp)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src1),
+ io:format(Dev, ", ", []),
+ pp_src(Dev, Src2),
+ io:format(Dev, "\n", []);
+ #b_fun{'fun'=Fun, linkage=Linkage} ->
+ io:format(Dev, "\tb ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " # ~w\n", [Linkage]);
+ #b_label{label=Label} ->
+ io:format(Dev, "\tb .~s_~w\n", [Pre, Label]);
+ #bc{bcond=BCond, label=Label, pred=Pred} ->
+ io:format(Dev, "\tb~w ~s_~w # ~.2f\n", [bcond_name(BCond), Pre, Label, Pred]);
+ #bctr{labels=Labels} ->
+ io:format(Dev, "\tbctr", []),
+ case Labels of
+ [] -> [];
+ _ ->
+ io:format(Dev, " #", []),
+ pp_labels(Dev, Labels, Pre)
+ end,
+ io:format(Dev, "\n", []);
+ #bctrl{sdesc=SDesc} ->
+ io:format(Dev, "\tbctrl #", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, "\n", []);
+ #bl{'fun'=Fun, sdesc=SDesc, linkage=Linkage} ->
+ io:format(Dev, "\tbl ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " #", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #blr{} ->
+ io:format(Dev, "\tblr\n", []);
+ #comment{term=Term} ->
+ io:format(Dev, "\t# ~p\n", [Term]);
+ #cmp{cmpop=CmpOp, src1=Src1, src2=Src2} ->
+ io:format(Dev, "\t~s ", [cmp_op_name(CmpOp)]),
+ pp_temp(Dev, Src1),
+ io:format(Dev, ", ", []),
+ pp_src(Dev, Src2),
+ io:format(Dev, "\n", []);
+ #label{label=Label} ->
+ io:format(Dev, ".~s_~w:~n", [Pre, Label]);
+ #load{ldop=LdOp, dst=Dst, disp=Disp, base=Base} ->
+ io:format(Dev, "\t~w ", [ldop_name(LdOp)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ~s(", [to_hex(Disp)]),
+ pp_temp(Dev, Base),
+ io:format(Dev, ")\n", []);
+ #loadx{ldxop=LdxOp, dst=Dst, base1=Base1, base2=Base2} ->
+ io:format(Dev, "\t~w ", [ldxop_name(LdxOp)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base2),
+ io:format(Dev, "\n", []);
+ #mfspr{dst=Dst, spr=SPR} ->
+ io:format(Dev, "\tmf~w ", [spr_name(SPR)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #mtcr{src=Src} ->
+ io:format(Dev, "\tmtcrf 0x80, ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #mtspr{spr=SPR, src=Src} ->
+ io:format(Dev, "\tmt~w ", [spr_name(SPR)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #pseudo_bc{bcond=BCond, true_label=TrueLab, false_label=FalseLab, pred=Pred} ->
+ io:format(Dev, "\tpseudo_bc ~w, .~s_~w # .~s_~w ~.2f\n",
+ [bcond_name(BCond), Pre, TrueLab, Pre, FalseLab, Pred]);
+ #pseudo_call{func=FunC, sdesc=SDesc, contlab=ContLab, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_call ", []),
+ pp_func(Dev, FunC),
+ io:format(Dev, " # contlab .~s_~w", [Pre, ContLab]),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #pseudo_call_prepare{nrstkargs=NrStkArgs} ->
+ SP = hipe_ppc_registers:reg_name_gpr(hipe_ppc_registers:stack_pointer()),
+ io:format(Dev, "\taddi ~s, ~s, ~w # pseudo_call_prepare\n",
+ [SP, SP, -(4*NrStkArgs)]);
+ #pseudo_li{dst=Dst, imm=Imm} ->
+ io:format(Dev, "\tpseudo_li ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_imm(Dev, Imm),
+ io:format(Dev, "\n", []);
+ #pseudo_move{dst=Dst, src=Src} ->
+ io:format(Dev, "\tpseudo_move ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #pseudo_tailcall{func=FunC, arity=Arity, stkargs=StkArgs, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_tailcall ", []),
+ pp_func(Dev, FunC),
+ io:format(Dev, "/~w (", [Arity]),
+ pp_args(Dev, StkArgs),
+ io:format(Dev, ") ~w\n", [Linkage]);
+ #pseudo_tailcall_prepare{} ->
+ io:format(Dev, "\tpseudo_tailcall_prepare\n", []);
+ #store{stop=StOp, src=Src, disp=Disp, base=Base} ->
+ io:format(Dev, "\t~s ", [stop_name(StOp)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ~s(", [to_hex(Disp)]),
+ pp_temp(Dev, Base),
+ io:format(Dev, ")\n", []);
+ #storex{stxop=StxOp, src=Src, base1=Base1, base2=Base2} ->
+ io:format(Dev, "\t~s ", [stxop_name(StxOp)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base2),
+ io:format(Dev, "\n", []);
+ #unary{unop=UnOp, dst=Dst, src=Src} ->
+ io:format(Dev, "\t~w ", [unop_name(UnOp)]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #lfd{dst=Dst, disp=Disp, base=Base} ->
+ io:format(Dev, "\tlfd ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ~s(", [to_hex(Disp)]),
+ pp_temp(Dev, Base),
+ io:format(Dev, ")\n", []);
+ #lfdx{dst=Dst, base1=Base1, base2=Base2} ->
+ io:format(Dev, "\tlfdx ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base2),
+ io:format(Dev, "\n", []);
+ #stfd{src=Src, disp=Disp, base=Base} ->
+ io:format(Dev, "\tstfd ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ~s(", [to_hex(Disp)]),
+ pp_temp(Dev, Base),
+ io:format(Dev, ")\n", []);
+ #stfdx{src=Src, base1=Base1, base2=Base2} ->
+ io:format(Dev, "\tstfdx ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Base2),
+ io:format(Dev, "\n", []);
+ #fp_binary{fp_binop=FpBinOp, dst=Dst, src1=Src1, src2=Src2} ->
+ io:format(Dev, "\t~s ", [FpBinOp]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src2),
+ io:format(Dev, "\n", []);
+ #fp_unary{fp_unop=FpUnOp, dst=Dst, src=Src} ->
+ io:format(Dev, "\t~s ", [FpUnOp]),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ #pseudo_fmove{dst=Dst, src=Src} ->
+ io:format(Dev, "\tpseudo_fmove ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, "\n", []);
+ _ ->
+ exit({?MODULE, pp_insn, I})
+ end.
+
+to_hex(N) ->
+ io_lib:format("~.16x", [N, "0x"]).
+
+pp_sdesc(Dev, Pre, #ppc_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live}) ->
+ pp_sdesc_exnlab(Dev, Pre, ExnLab),
+ io:format(Dev, " ~s ~w [", [to_hex(FSize), Arity]),
+ pp_sdesc_live(Dev, Live),
+ io:format(Dev, "]", []).
+
+pp_sdesc_exnlab(Dev, _, []) -> io:format(Dev, " []", []);
+pp_sdesc_exnlab(Dev, Pre, ExnLab) -> io:format(Dev, " .~s_~w", [Pre, ExnLab]).
+
+pp_sdesc_live(_, {}) -> [];
+pp_sdesc_live(Dev, Live) -> pp_sdesc_live(Dev, Live, 1).
+
+pp_sdesc_live(Dev, Live, I) ->
+ io:format(Dev, "~s", [to_hex(element(I, Live))]),
+ if I < tuple_size(Live) ->
+ io:format(Dev, ",", []),
+ pp_sdesc_live(Dev, Live, I+1);
+ true -> []
+ end.
+
+pp_labels(Dev, [Label|Labels], Pre) ->
+ io:format(Dev, " .~s_~w", [Pre, Label]),
+ pp_labels(Dev, Labels, Pre);
+pp_labels(_, [], _) ->
+ [].
+
+pp_fun(Dev, Fun) ->
+ case Fun of
+ #ppc_mfa{m=M, f=F, a=A} ->
+ io:format(Dev, "~w:~w/~w", [M, F, A]);
+ #ppc_prim{prim=Prim} ->
+ io:format(Dev, "~w", [Prim])
+ end.
+
+pp_func(Dev, FunC) ->
+ case FunC of
+ 'ctr' ->
+ io:format(Dev, "ctr", []);
+ Fun ->
+ pp_fun(Dev, Fun)
+ end.
+
+alu_op_name(Op) -> Op.
+
+bcond_name(BCond) -> BCond.
+
+cmp_op_name(Op) -> Op.
+
+spr_name(SPR) -> SPR.
+
+ldop_name(LdOp) -> LdOp.
+
+ldxop_name(LdxOp) -> LdxOp.
+
+stop_name(StOp) -> StOp.
+
+stxop_name(StxOp) -> StxOp.
+
+unop_name(UnOp) -> UnOp.
+
+pp_temp(Dev, Temp=#ppc_temp{reg=Reg, type=Type}) ->
+ case hipe_ppc:temp_is_precoloured(Temp) of
+ true ->
+ Name =
+ case Type of
+ 'double' -> hipe_ppc_registers:reg_name_fpr(Reg);
+ _ -> hipe_ppc_registers:reg_name_gpr(Reg)
+ end,
+ io:format(Dev, "~s", [Name]);
+ false ->
+ Tag =
+ case Type of
+ double -> "f";
+ tagged -> "t";
+ untagged -> "u"
+ end,
+ io:format(Dev, "~s~w", [Tag, Reg])
+ end.
+
+pp_hex(Dev, Value) -> io:format(Dev, "~s", [to_hex(Value)]).
+pp_simm16(Dev, #ppc_simm16{value=Value}) -> pp_hex(Dev, Value).
+pp_uimm16(Dev, #ppc_uimm16{value=Value}) -> pp_hex(Dev, Value).
+
+pp_imm(Dev, Value) ->
+ if is_integer(Value) -> pp_hex(Dev, Value);
+ true -> io:format(Dev, "~w", [Value])
+ end.
+
+pp_src(Dev, Src) ->
+ case Src of
+ #ppc_temp{} ->
+ pp_temp(Dev, Src);
+ #ppc_simm16{} ->
+ pp_simm16(Dev, Src);
+ #ppc_uimm16{} ->
+ pp_uimm16(Dev, Src)
+ end.
+
+pp_arg(Dev, Arg) ->
+ case Arg of
+ #ppc_temp{} ->
+ pp_temp(Dev, Arg);
+ _ ->
+ pp_hex(Dev, Arg)
+ end.
+
+pp_args(Dev, [A|As]) ->
+ pp_arg(Dev, A),
+ pp_comma_args(Dev, As);
+pp_args(_, []) ->
+ [].
+
+pp_comma_args(Dev, [A|As]) ->
+ io:format(Dev, ", ", []),
+ pp_arg(Dev, A),
+ pp_comma_args(Dev, As);
+pp_comma_args(_, []) ->
+ [].
diff --git a/lib/hipe/ppc/hipe_ppc_ra.erl b/lib/hipe/ppc/hipe_ppc_ra.erl
new file mode 100644
index 0000000000..3de7f48de1
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_ra.erl
@@ -0,0 +1,56 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_ra).
+-export([ra/2]).
+
+ra(Defun0, Options) ->
+ %% hipe_ppc_pp:pp(Defun0),
+ {Defun1, Coloring_fp, SpillIndex}
+ = case proplists:get_bool(inline_fp, Options) of
+ true ->
+ hipe_regalloc_loop:ra_fp(Defun0, Options,
+ hipe_coalescing_regalloc,
+ hipe_ppc_specific_fp);
+ false ->
+ {Defun0,[],0}
+ end,
+ %% hipe_ppc_pp:pp(Defun1),
+ {Defun2, Coloring}
+ = case proplists:get_value(regalloc, Options, coalescing) of
+ coalescing ->
+ ra(Defun1, SpillIndex, Options, hipe_coalescing_regalloc);
+ optimistic ->
+ ra(Defun1, SpillIndex, Options, hipe_optimistic_regalloc);
+ graph_color ->
+ ra(Defun1, SpillIndex, Options, hipe_graph_coloring_regalloc);
+ linear_scan ->
+ hipe_ppc_ra_ls:ra(Defun1, SpillIndex, Options);
+ naive ->
+ hipe_ppc_ra_naive:ra(Defun1, Coloring_fp, Options);
+ _ ->
+ exit({unknown_regalloc_compiler_option,
+ proplists:get_value(regalloc,Options)})
+ end,
+ %% hipe_ppc_pp:pp(Defun2),
+ hipe_ppc_ra_finalise:finalise(Defun2, Coloring, Coloring_fp).
+
+ra(Defun, SpillIndex, Options, RegAllocMod) ->
+ hipe_regalloc_loop:ra(Defun, SpillIndex, Options, RegAllocMod, hipe_ppc_specific).
diff --git a/lib/hipe/ppc/hipe_ppc_ra_finalise.erl b/lib/hipe/ppc/hipe_ppc_ra_finalise.erl
new file mode 100644
index 0000000000..53f8b739c2
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_ra_finalise.erl
@@ -0,0 +1,271 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_ra_finalise).
+-export([finalise/3]).
+-include("hipe_ppc.hrl").
+
+finalise(Defun, TempMap, FPMap0) ->
+ Code = hipe_ppc:defun_code(Defun),
+ {_, SpillLimit} = hipe_ppc:defun_var_range(Defun),
+ Map = mk_ra_map(TempMap, SpillLimit),
+ FPMap1 = mk_ra_map_fp(FPMap0, SpillLimit),
+ NewCode = ra_code(Code, Map, FPMap1, []),
+ Defun#defun{code=NewCode}.
+
+ra_code([I|Insns], Map, FPMap, Accum) ->
+ ra_code(Insns, Map, FPMap, [ra_insn(I, Map, FPMap) | Accum]);
+ra_code([], _Map, _FPMap, Accum) ->
+ lists:reverse(Accum).
+
+ra_insn(I, Map, FPMap) ->
+ case I of
+ #alu{} -> ra_alu(I, Map);
+ #cmp{} -> ra_cmp(I, Map);
+ #load{} -> ra_load(I, Map);
+ #loadx{} -> ra_loadx(I, Map);
+ #mfspr{} -> ra_mfspr(I, Map);
+ #mtcr{} -> ra_mtcr(I, Map);
+ #mtspr{} -> ra_mtspr(I, Map);
+ #pseudo_li{} -> ra_pseudo_li(I, Map);
+ #pseudo_move{} -> ra_pseudo_move(I, Map);
+ #pseudo_tailcall{} -> ra_pseudo_tailcall(I, Map);
+ #store{} -> ra_store(I, Map);
+ #storex{} -> ra_storex(I, Map);
+ #unary{} -> ra_unary(I, Map);
+ #lfd{} -> ra_lfd(I, Map, FPMap);
+ #lfdx{} -> ra_lfdx(I, Map, FPMap);
+ #stfd{} -> ra_stfd(I, Map, FPMap);
+ #stfdx{} -> ra_stfdx(I, Map, FPMap);
+ #fp_binary{} -> ra_fp_binary(I, FPMap);
+ #fp_unary{} -> ra_fp_unary(I, FPMap);
+ #pseudo_fmove{} -> ra_pseudo_fmove(I, FPMap);
+ _ -> I
+ end.
+
+ra_alu(I=#alu{dst=Dst,src1=Src1,src2=Src2}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewSrc1 = ra_temp(Src1, Map),
+ NewSrc2 = ra_temp_or_imm(Src2, Map),
+ I#alu{dst=NewDst,src1=NewSrc1,src2=NewSrc2}.
+
+ra_cmp(I=#cmp{src1=Src1,src2=Src2}, Map) ->
+ NewSrc1 = ra_temp(Src1, Map),
+ NewSrc2 = ra_temp_or_imm(Src2, Map),
+ I#cmp{src1=NewSrc1,src2=NewSrc2}.
+
+ra_load(I=#load{dst=Dst,base=Base}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewBase = ra_temp(Base, Map),
+ I#load{dst=NewDst,base=NewBase}.
+
+ra_loadx(I=#loadx{dst=Dst,base1=Base1,base2=Base2}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewBase1 = ra_temp(Base1, Map),
+ NewBase2 = ra_temp(Base2, Map),
+ I#loadx{dst=NewDst,base1=NewBase1,base2=NewBase2}.
+
+ra_mfspr(I=#mfspr{dst=Dst}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ I#mfspr{dst=NewDst}.
+
+ra_mtcr(I=#mtcr{src=Src}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ I#mtcr{src=NewSrc}.
+
+ra_mtspr(I=#mtspr{src=Src}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ I#mtspr{src=NewSrc}.
+
+ra_pseudo_li(I=#pseudo_li{dst=Dst}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ I#pseudo_li{dst=NewDst}.
+
+ra_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewSrc = ra_temp(Src, Map),
+ I#pseudo_move{dst=NewDst,src=NewSrc}.
+
+ra_pseudo_tailcall(I=#pseudo_tailcall{stkargs=StkArgs}, Map) ->
+ NewStkArgs = ra_args(StkArgs, Map),
+ I#pseudo_tailcall{stkargs=NewStkArgs}.
+
+ra_store(I=#store{src=Src,base=Base}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewBase = ra_temp(Base, Map),
+ I#store{src=NewSrc,base=NewBase}.
+
+ra_storex(I=#storex{src=Src,base1=Base1,base2=Base2}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewBase1 = ra_temp(Base1, Map),
+ NewBase2 = ra_temp(Base2, Map),
+ I#storex{src=NewSrc,base1=NewBase1,base2=NewBase2}.
+
+ra_unary(I=#unary{dst=Dst,src=Src}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewSrc = ra_temp(Src, Map),
+ I#unary{dst=NewDst,src=NewSrc}.
+
+ra_lfd(I=#lfd{dst=Dst,base=Base}, Map, FPMap) ->
+ NewDst = ra_temp_fp(Dst, FPMap),
+ NewBase = ra_temp(Base, Map),
+ I#lfd{dst=NewDst,base=NewBase}.
+
+ra_lfdx(I=#lfdx{dst=Dst,base1=Base1,base2=Base2}, Map, FPMap) ->
+ NewDst = ra_temp_fp(Dst, FPMap),
+ NewBase1 = ra_temp(Base1, Map),
+ NewBase2 = ra_temp(Base2, Map),
+ I#lfdx{dst=NewDst,base1=NewBase1,base2=NewBase2}.
+
+ra_stfd(I=#stfd{src=Src,base=Base}, Map, FPMap) ->
+ NewSrc = ra_temp_fp(Src, FPMap),
+ NewBase = ra_temp(Base, Map),
+ I#stfd{src=NewSrc,base=NewBase}.
+
+ra_stfdx(I=#stfdx{src=Src,base1=Base1,base2=Base2}, Map, FPMap) ->
+ NewSrc = ra_temp_fp(Src, FPMap),
+ NewBase1 = ra_temp(Base1, Map),
+ NewBase2 = ra_temp(Base2, Map),
+ I#stfdx{src=NewSrc,base1=NewBase1,base2=NewBase2}.
+
+ra_fp_binary(I=#fp_binary{dst=Dst,src1=Src1,src2=Src2}, FPMap) ->
+ NewDst = ra_temp_fp(Dst, FPMap),
+ NewSrc1 = ra_temp_fp(Src1, FPMap),
+ NewSrc2 = ra_temp_fp(Src2, FPMap),
+ I#fp_binary{dst=NewDst,src1=NewSrc1,src2=NewSrc2}.
+
+ra_fp_unary(I=#fp_unary{dst=Dst,src=Src}, FPMap) ->
+ NewDst = ra_temp_fp(Dst, FPMap),
+ NewSrc = ra_temp_fp(Src, FPMap),
+ I#fp_unary{dst=NewDst,src=NewSrc}.
+
+ra_pseudo_fmove(I=#pseudo_fmove{dst=Dst,src=Src}, FPMap) ->
+ NewDst = ra_temp_fp(Dst, FPMap),
+ NewSrc = ra_temp_fp(Src, FPMap),
+ I#pseudo_fmove{dst=NewDst,src=NewSrc}.
+
+ra_args([Arg|Args], Map) ->
+ [ra_temp_or_imm(Arg, Map) | ra_args(Args, Map)];
+ra_args([], _) ->
+ [].
+
+ra_temp_or_imm(Arg, Map) ->
+ case hipe_ppc:is_temp(Arg) of
+ true ->
+ ra_temp(Arg, Map);
+ false ->
+ Arg
+ end.
+
+ra_temp_fp(Temp, FPMap) ->
+ Reg = hipe_ppc:temp_reg(Temp),
+ case hipe_ppc:temp_type(Temp) of
+ 'double' ->
+ case hipe_ppc_registers:is_precoloured_fpr(Reg) of
+ true -> Temp;
+ _ -> ra_temp_common(Reg, Temp, FPMap)
+ end
+ end.
+
+ra_temp(Temp, Map) ->
+ Reg = hipe_ppc:temp_reg(Temp),
+ case hipe_ppc:temp_type(Temp) of
+ 'double' ->
+ exit({?MODULE,ra_temp,Temp});
+ _ ->
+ case hipe_ppc_registers:is_precoloured_gpr(Reg) of
+ true -> Temp;
+ _ -> ra_temp_common(Reg, Temp, Map)
+ end
+ end.
+
+ra_temp_common(Reg, Temp, Map) ->
+ case gb_trees:lookup(Reg, Map) of
+ {value,NewReg} -> Temp#ppc_temp{reg=NewReg};
+ _ -> Temp
+ end.
+
+mk_ra_map(TempMap, SpillLimit) ->
+ %% Build a partial map from pseudo to reg or spill.
+ %% Spills are represented as pseudos with indices above SpillLimit.
+ %% (I'd prefer to use negative indices, but that breaks
+ %% hipe_ppc_registers:is_precoloured/1.)
+ %% The frame mapping proper is unchanged, since spills look just like
+ %% ordinary (un-allocated) pseudos.
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit, is_precoloured_gpr),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ TempMap).
+
+conv_ra_maplet(MapLet = {From,To}, SpillLimit, IsPrecoloured) ->
+ %% From should be a pseudo, or a hard reg mapped to itself.
+ if is_integer(From), From =< SpillLimit ->
+ case hipe_ppc_registers:IsPrecoloured(From) of
+ false -> [];
+ _ ->
+ case To of
+ {reg, From} -> [];
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of From check
+ case To of
+ {reg, NewReg} ->
+ %% NewReg should be a hard reg, or a pseudo mapped
+ %% to itself (formals are handled this way).
+ if is_integer(NewReg) ->
+ case hipe_ppc_registers:IsPrecoloured(NewReg) of
+ true -> [];
+ _ -> if From =:= NewReg -> [];
+ true ->
+ exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of NewReg check
+ {From, NewReg};
+ {spill, SpillIndex} ->
+ %% SpillIndex should be >= 0.
+ if is_integer(SpillIndex), SpillIndex >= 0 -> [];
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of SpillIndex check
+ ToTempNum = SpillLimit+SpillIndex+1,
+ MaxTempNum = hipe_gensym:get_var(ppc),
+ if MaxTempNum >= ToTempNum -> ok;
+ true -> hipe_gensym:set_var(ppc, ToTempNum)
+ end,
+ {From, ToTempNum};
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end.
+
+mk_ra_map_fp(FPMap, SpillLimit) ->
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit,
+ is_precoloured_fpr),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ FPMap).
diff --git a/lib/hipe/ppc/hipe_ppc_ra_ls.erl b/lib/hipe/ppc/hipe_ppc_ra_ls.erl
new file mode 100644
index 0000000000..0b5d915ee8
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_ra_ls.erl
@@ -0,0 +1,56 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Linear Scan register allocator for PowerPC
+
+-module(hipe_ppc_ra_ls).
+-export([ra/3]).
+
+ra(Defun, SpillIndex, Options) ->
+ NewDefun = Defun, %% hipe_${ARCH}_ra_rename:rename(Defun,Options),
+ CFG = hipe_ppc_cfg:init(NewDefun),
+ SpillLimit = hipe_ppc_specific:number_of_temporaries(CFG),
+ alloc(NewDefun, SpillIndex, SpillLimit, Options).
+
+alloc(Defun, SpillIndex, SpillLimit, Options) ->
+ CFG = hipe_ppc_cfg:init(Defun),
+ {Coloring, _NewSpillIndex} =
+ regalloc(
+ CFG,
+ hipe_ppc_registers:allocatable_gpr()--
+ [hipe_ppc_registers:temp3(),
+ hipe_ppc_registers:temp2(),
+ hipe_ppc_registers:temp1()],
+ [hipe_ppc_cfg:start_label(CFG)],
+ SpillIndex, SpillLimit, Options,
+ hipe_ppc_specific),
+ {NewDefun, _DidSpill} =
+ hipe_ppc_ra_postconditions:check_and_rewrite(
+ Defun, Coloring, 'linearscan'),
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_ppc_specific),
+ {TempMap2,_NewSpillIndex2} =
+ hipe_spillmin:stackalloc(CFG, [], SpillIndex, Options,
+ hipe_ppc_specific, TempMap),
+ Coloring2 =
+ hipe_spillmin:mapmerge(hipe_temp_map:to_substlist(TempMap), TempMap2),
+ {NewDefun, Coloring2}.
+
+regalloc(CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target) ->
+ hipe_ls_regalloc:regalloc(
+ CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target).
diff --git a/lib/hipe/ppc/hipe_ppc_ra_naive.erl b/lib/hipe/ppc/hipe_ppc_ra_naive.erl
new file mode 100644
index 0000000000..f0ca41b49e
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_ra_naive.erl
@@ -0,0 +1,29 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_ra_naive).
+-export([ra/3]).
+
+-include("hipe_ppc.hrl").
+
+ra(Defun, _Coloring_fp, _Options) -> % -> {Defun, Coloring}
+ {NewDefun,_DidSpill} =
+ hipe_ppc_ra_postconditions:check_and_rewrite2(Defun, [], 'naive'),
+ {NewDefun, []}.
diff --git a/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl b/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl
new file mode 100644
index 0000000000..142bce39cc
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl
@@ -0,0 +1,243 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_ra_postconditions).
+
+-export([check_and_rewrite/3, check_and_rewrite2/3]).
+
+-include("hipe_ppc.hrl").
+
+check_and_rewrite(Defun, Coloring, Allocator) ->
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_ppc_specific),
+ check_and_rewrite2(Defun, TempMap, Allocator).
+
+check_and_rewrite2(Defun, TempMap, Allocator) ->
+ Strategy = strategy(Allocator),
+ #defun{code=Code0} = Defun,
+ {Code1,DidSpill} = do_insns(Code0, TempMap, Strategy, [], false),
+ VarRange = {0, hipe_gensym:get_var(ppc)},
+ {Defun#defun{code=Code1, var_range=VarRange},
+ DidSpill}.
+
+strategy(Allocator) ->
+ case Allocator of
+ 'normal' -> 'new';
+ 'linearscan' -> 'fixed';
+ 'naive' -> 'fixed'
+ end.
+
+do_insns([I|Insns], TempMap, Strategy, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap, Strategy),
+ do_insns(Insns, TempMap, Strategy, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, _Strategy, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap, Strategy) ->
+ case I of
+ #alu{} -> do_alu(I, TempMap, Strategy);
+ #cmp{} -> do_cmp(I, TempMap, Strategy);
+ #load{} -> do_load(I, TempMap, Strategy);
+ #loadx{} -> do_loadx(I, TempMap, Strategy);
+ #mfspr{} -> do_mfspr(I, TempMap, Strategy);
+ #mtcr{} -> do_mtcr(I, TempMap, Strategy);
+ #mtspr{} -> do_mtspr(I, TempMap, Strategy);
+ #pseudo_li{} -> do_pseudo_li(I, TempMap, Strategy);
+ #pseudo_move{} -> do_pseudo_move(I, TempMap, Strategy);
+ #store{} -> do_store(I, TempMap, Strategy);
+ #storex{} -> do_storex(I, TempMap, Strategy);
+ #unary{} -> do_unary(I, TempMap, Strategy);
+ #lfd{} -> do_lfd(I, TempMap, Strategy);
+ #lfdx{} -> do_lfdx(I, TempMap, Strategy);
+ #stfd{} -> do_stfd(I, TempMap, Strategy);
+ #stfdx{} -> do_stfdx(I, TempMap, Strategy);
+ _ -> {[I], false}
+ end.
+
+%%% Fix relevant instruction types.
+
+do_alu(I=#alu{dst=Dst,src1=Src1,src2=Src2}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixSrc1,NewSrc1,DidSpill2} = fix_src1(Src1, TempMap, Strategy),
+ {FixSrc2,NewSrc2,DidSpill3} = fix_src2_or_imm(Src2, TempMap, Strategy),
+ NewI = I#alu{dst=NewDst,src1=NewSrc1,src2=NewSrc2},
+ {FixSrc1 ++ FixSrc2 ++ [NewI | FixDst], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_cmp(I=#cmp{src1=Src1,src2=Src2}, TempMap, Strategy) ->
+ {FixSrc1,NewSrc1,DidSpill1} = fix_src1(Src1, TempMap, Strategy),
+ {FixSrc2,NewSrc2,DidSpill2} = fix_src2_or_imm(Src2, TempMap, Strategy),
+ NewI = I#cmp{src1=NewSrc1,src2=NewSrc2},
+ {FixSrc1 ++ FixSrc2 ++ [NewI], DidSpill1 or DidSpill2}.
+
+do_load(I=#load{dst=Dst,base=Base}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixBase,NewBase,DidSpill2} = fix_src1(Base, TempMap, Strategy),
+ NewI = I#load{dst=NewDst,base=NewBase},
+ {FixBase ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_loadx(I=#loadx{dst=Dst,base1=Base1,base2=Base2}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixBase1,NewBase1,DidSpill2} = fix_src1(Base1, TempMap, Strategy),
+ {FixBase2,NewBase2,DidSpill3} = fix_src2(Base2, TempMap, Strategy),
+ NewI = I#loadx{dst=NewDst,base1=NewBase1,base2=NewBase2},
+ {FixBase1 ++ FixBase2 ++ [NewI | FixDst], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_mfspr(I=#mfspr{dst=Dst}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap, Strategy),
+ NewI = I#mfspr{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_mtcr(I=#mtcr{src=Src}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#mtcr{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill}.
+
+do_mtspr(I=#mtspr{src=Src}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#mtspr{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill}.
+
+do_pseudo_li(I=#pseudo_li{dst=Dst}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap, Strategy),
+ NewI = I#pseudo_li{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, TempMap, Strategy) ->
+ %% Either Dst or Src (but not both) may be a pseudo temp.
+ %% pseudo_move and pseudo_tailcall are special cases: in
+ %% all other instructions, all temps must be non-pseudos
+ %% after register allocation.
+ case temp_is_spilled(Dst, TempMap) of
+ true -> % Src must not be a pseudo
+ {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#pseudo_move{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill};
+ _ ->
+ {[I], false}
+ end.
+
+do_store(I=#store{src=Src,base=Base}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill1} = fix_src1(Src, TempMap, Strategy),
+ {FixBase,NewBase,DidSpill2} = fix_src2(Base, TempMap, Strategy),
+ NewI = I#store{src=NewSrc,base=NewBase},
+ {FixSrc ++ FixBase ++ [NewI], DidSpill1 or DidSpill2}.
+
+do_storex(I=#storex{src=Src,base1=Base1,base2=Base2}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill1} = fix_src1(Src, TempMap, Strategy),
+ {FixBase1,NewBase1,DidSpill2} = fix_src2(Base1, TempMap, Strategy),
+ {FixBase2,NewBase2,DidSpill3} = fix_src3(Base2, TempMap, Strategy),
+ NewI = I#storex{src=NewSrc,base1=NewBase1,base2=NewBase2},
+ {FixSrc ++ FixBase1 ++ FixBase2 ++ [NewI], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_unary(I=#unary{dst=Dst,src=Src}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixSrc,NewSrc,DidSpill2} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#unary{dst=NewDst,src=NewSrc},
+ {FixSrc ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_lfd(I=#lfd{base=Base}, TempMap, Strategy) ->
+ {FixBase,NewBase,DidSpill} = fix_src1(Base, TempMap, Strategy),
+ NewI = I#lfd{base=NewBase},
+ {FixBase ++ [NewI], DidSpill}.
+
+do_lfdx(I=#lfdx{base1=Base1,base2=Base2}, TempMap, Strategy) ->
+ {FixBase1,NewBase1,DidSpill1} = fix_src1(Base1, TempMap, Strategy),
+ {FixBase2,NewBase2,DidSpill2} = fix_src2(Base2, TempMap, Strategy),
+ NewI = I#lfdx{base1=NewBase1,base2=NewBase2},
+ {FixBase1 ++ FixBase2 ++ [NewI], DidSpill1 or DidSpill2}.
+
+do_stfd(I=#stfd{base=Base}, TempMap, Strategy) ->
+ {FixBase,NewBase,DidSpill} = fix_src1(Base, TempMap, Strategy),
+ NewI = I#stfd{base=NewBase},
+ {FixBase ++ [NewI], DidSpill}.
+
+do_stfdx(I=#stfdx{base1=Base1,base2=Base2}, TempMap, Strategy) ->
+ {FixBase1,NewBase1,DidSpill1} = fix_src1(Base1, TempMap, Strategy),
+ {FixBase2,NewBase2,DidSpill2} = fix_src2(Base2, TempMap, Strategy),
+ NewI = I#stfdx{base1=NewBase1,base2=NewBase2},
+ {FixBase1 ++ FixBase2 ++ [NewI], DidSpill1 or DidSpill2}.
+
+%%% Fix Dst and Src operands.
+
+fix_src2_or_imm(Src2, TempMap, Strategy) ->
+ case Src2 of
+ #ppc_temp{} -> fix_src2(Src2, TempMap, Strategy);
+ _ -> {[], Src2, false}
+ end.
+
+fix_src1(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp1(Strategy)).
+
+temp1('new') -> [];
+temp1('fixed') -> hipe_ppc_registers:temp1().
+
+fix_src2(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp2(Strategy)).
+
+temp2('new') -> [];
+temp2('fixed') -> hipe_ppc_registers:temp2().
+
+fix_src3(Src, TempMap, Strategy) -> % storex :-(
+ fix_src(Src, TempMap, temp3(Strategy)).
+
+temp3('new') -> [];
+temp3('fixed') -> hipe_ppc_registers:temp3().
+
+fix_src(Src, TempMap, RegOpt) ->
+ case temp_is_spilled(Src, TempMap) of
+ true ->
+ NewSrc = clone(Src, RegOpt),
+ {[hipe_ppc:mk_pseudo_move(NewSrc, Src)],
+ NewSrc,
+ true};
+ _ ->
+ {[], Src, false}
+ end.
+
+fix_dst(Dst, TempMap, Strategy) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ NewDst = clone(Dst, temp3(Strategy)),
+ {[hipe_ppc:mk_pseudo_move(Dst, NewDst)],
+ NewDst,
+ true};
+ _ ->
+ {[], Dst, false}
+ end.
+
+%%% Check if an operand is a pseudo-temp.
+
+temp_is_spilled(Temp, []) -> % special case for naive regalloc
+ not(hipe_ppc:temp_is_precoloured(Temp));
+temp_is_spilled(Temp, TempMap) ->
+ case hipe_ppc:temp_is_allocatable(Temp) of
+ true ->
+ Reg = hipe_ppc:temp_reg(Temp),
+ tuple_size(TempMap) > Reg andalso hipe_temp_map:is_spilled(Reg, TempMap);
+ false -> true
+ end.
+
+%%% Make a certain reg into a clone of Temp.
+
+clone(Temp, RegOpt) ->
+ Type = hipe_ppc:temp_type(Temp),
+ case RegOpt of
+ [] -> hipe_ppc:mk_new_temp(Type);
+ Reg -> hipe_ppc:mk_temp(Reg, Type)
+ end.
diff --git a/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl b/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl
new file mode 100644
index 0000000000..889c5681ac
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl
@@ -0,0 +1,130 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_ra_postconditions_fp).
+-export([check_and_rewrite/2]).
+-include("hipe_ppc.hrl").
+
+check_and_rewrite(Defun, Coloring) ->
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_ppc_specific_fp),
+ #defun{code=Code0} = Defun,
+ {Code1,DidSpill} = do_insns(Code0, TempMap, [], false),
+ VarRange = {0, hipe_gensym:get_var(ppc)},
+ {Defun#defun{code=Code1, var_range=VarRange},
+ DidSpill}.
+
+do_insns([I|Insns], TempMap, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap),
+ do_insns(Insns, TempMap, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap) ->
+ case I of
+ #lfd{} -> do_lfd(I, TempMap);
+ #lfdx{} -> do_lfdx(I, TempMap);
+ #stfd{} -> do_stfd(I, TempMap);
+ #stfdx{} -> do_stfdx(I, TempMap);
+ #fp_binary{} -> do_fp_binary(I, TempMap);
+ #fp_unary{} -> do_fp_unary(I, TempMap);
+ #pseudo_fmove{} -> do_pseudo_fmove(I, TempMap);
+ _ -> {[I], false}
+ end.
+
+%%% Fix relevant instruction types.
+
+do_lfd(I=#lfd{dst=Dst}, TempMap) ->
+ {FixDst, NewDst, DidSpill} = fix_dst(Dst, TempMap),
+ NewI = I#lfd{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_lfdx(I=#lfdx{dst=Dst}, TempMap) ->
+ {FixDst, NewDst, DidSpill} = fix_dst(Dst, TempMap),
+ NewI = I#lfdx{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_stfd(I=#stfd{src=Src}, TempMap) ->
+ {FixSrc, NewSrc, DidSpill} = fix_src(Src, TempMap),
+ NewI = I#stfd{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill}.
+
+do_stfdx(I=#stfdx{src=Src}, TempMap) ->
+ {FixSrc, NewSrc, DidSpill} = fix_src(Src, TempMap),
+ NewI = I#stfdx{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill}.
+
+do_fp_binary(I=#fp_binary{dst=Dst,src1=Src1,src2=Src2}, TempMap) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap),
+ {FixSrc1,NewSrc1,DidSpill2} = fix_src(Src1, TempMap),
+ {FixSrc2,NewSrc2,DidSpill3} = fix_src(Src2, TempMap),
+ NewI = I#fp_binary{dst=NewDst,src1=NewSrc1,src2=NewSrc2},
+ {FixSrc1 ++ FixSrc2 ++ [NewI | FixDst], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_fp_unary(I=#fp_unary{dst=Dst,src=Src}, TempMap) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap),
+ {FixSrc,NewSrc,DidSpill2} = fix_src(Src, TempMap),
+ NewI = I#fp_unary{dst=NewDst,src=NewSrc},
+ {FixSrc ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_pseudo_fmove(I=#pseudo_fmove{dst=Dst,src=Src}, TempMap) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ {FixSrc,NewSrc,DidSpill} = fix_src(Src, TempMap),
+ NewI = I#pseudo_fmove{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill};
+ _ ->
+ {[I], false}
+ end.
+
+%%% Fix Dst and Src operands.
+
+fix_src(Src, TempMap) ->
+ case temp_is_spilled(Src, TempMap) of
+ true ->
+ NewSrc = clone(Src),
+ {[hipe_ppc:mk_pseudo_fmove(NewSrc, Src)], NewSrc, true};
+ _ ->
+ {[], Src, false}
+ end.
+
+fix_dst(Dst, TempMap) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ NewDst = clone(Dst),
+ {[hipe_ppc:mk_pseudo_fmove(Dst, NewDst)], NewDst, true};
+ _ ->
+ {[], Dst, false}
+ end.
+
+%%% Check if an operand is a pseudo-temp.
+
+temp_is_spilled(Temp, TempMap) ->
+ case hipe_ppc:temp_is_allocatable(Temp) of
+ true ->
+ Reg = hipe_ppc:temp_reg(Temp),
+ tuple_size(TempMap) > Reg andalso hipe_temp_map:is_spilled(Reg, TempMap);
+ false -> true
+ end.
+
+%%% Create a new temp with the same type as an old one.
+
+clone(Temp) ->
+ Type = hipe_ppc:temp_type(Temp), % XXX: always double?
+ hipe_ppc:mk_new_temp(Type).
diff --git a/lib/hipe/ppc/hipe_ppc_registers.erl b/lib/hipe/ppc/hipe_ppc_registers.erl
new file mode 100644
index 0000000000..74aeab3df4
--- /dev/null
+++ b/lib/hipe/ppc/hipe_ppc_registers.erl
@@ -0,0 +1,246 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_registers).
+
+-export([reg_name_gpr/1,
+ reg_name_fpr/1,
+ first_virtual/0,
+ is_precoloured_gpr/1,
+ is_precoloured_fpr/1,
+ all_precoloured/0,
+ return_value/0,
+ temp1/0,
+ temp2/0,
+ temp3/0, % for base2 in storeix :-(
+ heap_pointer/0,
+ stack_pointer/0,
+ proc_pointer/0,
+ %%heap_limit/0,
+ %%fcalls/0,
+ allocatable_gpr/0,
+ allocatable_fpr/0,
+ is_fixed/1,
+ nr_args/0,
+ arg/1,
+ args/1,
+ is_arg/1, % for linear scan
+ call_clobbered/0,
+ tailcall_clobbered/0,
+ live_at_return/0
+ ]).
+
+-include("../rtl/hipe_literals.hrl").
+
+-define(R0, 0).
+-define(R1, 1).
+-define(R2, 2).
+-define(R3, 3).
+-define(R4, 4).
+-define(R5, 5).
+-define(R6, 6).
+-define(R7, 7).
+-define(R8, 8).
+-define(R9, 9).
+-define(R10, 10).
+-define(R11, 11).
+-define(R12, 12).
+-define(R13, 13).
+-define(R14, 14).
+-define(R15, 15).
+-define(R16, 16).
+-define(R17, 17).
+-define(R18, 18).
+-define(R19, 19).
+-define(R20, 20).
+-define(R21, 21).
+-define(R22, 22).
+-define(R23, 23).
+-define(R24, 24).
+-define(R25, 25).
+-define(R26, 26).
+-define(R27, 27).
+-define(R28, 28).
+-define(R29, 29).
+-define(R30, 30).
+-define(R31, 31).
+-define(LAST_PRECOLOURED, 31). % must handle both GPR and FPR ranges
+
+-define(ARG0, ?R4).
+-define(ARG1, ?R5).
+-define(ARG2, ?R6).
+-define(ARG3, ?R7).
+-define(ARG4, ?R8).
+-define(ARG5, ?R9).
+-define(ARG6, ?R10).
+
+-define(TEMP1, ?R28).
+-define(TEMP2, ?R27).
+-define(TEMP3, ?R26). % XXX: for base2 in storeix, switch to R0 instead?
+
+-define(RETURN_VALUE, ?R3).
+-define(HEAP_POINTER, ?R29).
+-define(STACK_POINTER, ?R30).
+-define(PROC_POINTER, ?R31).
+
+reg_name_gpr(R) -> [$r | integer_to_list(R)].
+reg_name_fpr(R) -> [$f | integer_to_list(R)].
+
+%%% Must handle both GPR and FPR ranges.
+first_virtual() -> ?LAST_PRECOLOURED + 1.
+
+%%% These two tests have the same implementation, but that's
+%%% not something we should cast in stone in the interface.
+is_precoloured_gpr(R) -> R =< ?LAST_PRECOLOURED.
+is_precoloured_fpr(R) -> R =< ?LAST_PRECOLOURED.
+
+all_precoloured() ->
+ %% XXX: skip R1, R2, and R13. They should never occur anywhere.
+ [ ?R0, ?R1, ?R2, ?R3, ?R4, ?R5, ?R6, ?R7,
+ ?R8, ?R9, ?R10, ?R11, ?R12, ?R13, ?R14, ?R15,
+ ?R16, ?R17, ?R18, ?R19, ?R20, ?R21, ?R22, ?R23,
+ ?R24, ?R25, ?R26, ?R27, ?R28, ?R29, ?R30, ?R31].
+
+return_value() -> ?RETURN_VALUE.
+
+temp1() -> ?TEMP1.
+temp2() -> ?TEMP2.
+temp3() -> ?TEMP3. % for base2 in storeix :-(
+
+heap_pointer() -> ?HEAP_POINTER.
+
+stack_pointer() -> ?STACK_POINTER.
+
+proc_pointer() -> ?PROC_POINTER.
+
+allocatable_gpr() ->
+ %% r0 is too restricted to be useful for variables
+ %% r1, r2, and r13 are reserved for C
+ %% r29, r30, and r31 are fixed global registers
+ [ ?R3, ?R4, ?R5, ?R6, ?R7,
+ ?R8, ?R9, ?R10, ?R11, ?R12, ?R14, ?R15,
+ ?R16, ?R17, ?R18, ?R19, ?R20, ?R21, ?R22, ?R23,
+ ?R24, ?R25, ?R26, ?R27, ?R28].
+
+allocatable_fpr() ->
+ [ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 23,
+ 24, 25, 26, 27, 28, 29, 30, 31].
+
+%% Needed for hipe_graph_coloring_regalloc.
+%% Presumably true for Reg in AllPrecoloured \ Allocatable.
+is_fixed(Reg) ->
+ case Reg of
+ ?HEAP_POINTER -> true;
+ ?STACK_POINTER -> true;
+ ?PROC_POINTER -> true;
+ %% The following cases are required for linear scan:
+ %% it gets confused if it sees a register which is
+ %% neither allocatable nor global (fixed or one of
+ %% the scratch registers set aside for linear scan).
+ ?R0 -> true;
+ ?R1 -> true;
+ ?R2 -> true;
+ ?R13 -> true;
+ _ -> false
+ end.
+
+nr_args() -> ?PPC_NR_ARG_REGS.
+
+args(Arity) when is_integer(Arity) ->
+ N = erlang:min(Arity, ?PPC_NR_ARG_REGS),
+ args(N-1, []).
+
+args(I, Rest) when is_integer(I), I < 0 -> Rest;
+args(I, Rest) -> args(I-1, [arg(I) | Rest]).
+
+arg(N) ->
+ if N < ?PPC_NR_ARG_REGS ->
+ case N of
+ 0 -> ?ARG0;
+ 1 -> ?ARG1;
+ 2 -> ?ARG2;
+ 3 -> ?ARG3;
+ 4 -> ?ARG4;
+ 5 -> ?ARG5;
+ 6 -> ?ARG6;
+ _ -> exit({?MODULE, arg, N})
+ end;
+ true ->
+ exit({?MODULE, arg, N})
+ end.
+
+is_arg(R) ->
+ case R of
+ ?ARG0 -> ?PPC_NR_ARG_REGS > 0;
+ ?ARG1 -> ?PPC_NR_ARG_REGS > 1;
+ ?ARG2 -> ?PPC_NR_ARG_REGS > 2;
+ ?ARG3 -> ?PPC_NR_ARG_REGS > 3;
+ ?ARG4 -> ?PPC_NR_ARG_REGS > 4;
+ ?ARG5 -> ?PPC_NR_ARG_REGS > 5;
+ ?ARG6 -> ?PPC_NR_ARG_REGS > 6;
+ _ -> false
+ end.
+
+call_clobbered() -> % does the RA strip the type or not?
+ [{?R0,tagged},{?R0,untagged},
+ %% R1 is reserved for C
+ %% R2 is reserved for C
+ {?R3,tagged},{?R3,untagged},
+ {?R4,tagged},{?R4,untagged},
+ {?R5,tagged},{?R5,untagged},
+ {?R6,tagged},{?R6,untagged},
+ {?R7,tagged},{?R7,untagged},
+ {?R8,tagged},{?R8,untagged},
+ {?R9,tagged},{?R9,untagged},
+ {?R10,tagged},{?R10,untagged},
+ {?R11,tagged},{?R11,untagged},
+ {?R12,tagged},{?R12,untagged},
+ %% R13 is reserved for C
+ {?R14,tagged},{?R14,untagged},
+ {?R15,tagged},{?R15,untagged},
+ {?R16,tagged},{?R16,untagged},
+ {?R17,tagged},{?R17,untagged},
+ {?R18,tagged},{?R18,untagged},
+ {?R19,tagged},{?R19,untagged},
+ {?R20,tagged},{?R20,untagged},
+ {?R21,tagged},{?R21,untagged},
+ {?R22,tagged},{?R22,untagged},
+ {?R23,tagged},{?R23,untagged},
+ {?R24,tagged},{?R24,untagged},
+ {?R25,tagged},{?R25,untagged},
+ {?R26,tagged},{?R26,untagged},
+ {?R27,tagged},{?R27,untagged},
+ {?R28,tagged},{?R28,untagged}
+ %% R29 is fixed (HP)
+ %% R30 is fixed (NSP)
+ %% R31 is fixed (P)
+ ].
+
+tailcall_clobbered() -> % tailcall crapola needs one temp
+ [{?TEMP1,tagged},{?TEMP1,untagged}].
+
+live_at_return() ->
+ [%%{?LR,untagged},
+ {?HEAP_POINTER,untagged},
+ {?STACK_POINTER,untagged},
+ {?PROC_POINTER,untagged}
+ ].
diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl
new file mode 100644
index 0000000000..458af250de
--- /dev/null
+++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl
@@ -0,0 +1,1249 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% The PowerPC instruction set is quite irregular.
+%%% The following quirks must be handled by the translation:
+%%%
+%%% - The instruction names are different for reg/reg and reg/imm
+%%% source operands. For some operations, completely different
+%%% instructions handle the reg/reg and reg/imm cases.
+%%% - The name of an arithmetic instruction depends on whether any
+%%% condition codes are to be set or not. Overflow is treated
+%%% separately from other conditions.
+%%% - Some combinations or RTL ALU operations, source operand shapes,
+%%% and requested conditions have no direct correspondence in the
+%%% PowerPC instruction set.
+%%% - The tagging of immediate operands as simm16 or uimm16 depends
+%%% on the actual instruction.
+%%% - Conditional branches have no unsigned conditions. Instead there
+%%% are signed and unsigned versions of the compare instruction.
+%%% - The arithmetic overflow flag XER[SO] is sticky: once set it
+%%% remains set until explicitly cleared.
+
+-module(hipe_rtl_to_ppc).
+-export([translate/1]).
+
+-include("../rtl/hipe_rtl.hrl").
+
+translate(RTL) ->
+ hipe_gensym:init(ppc),
+ hipe_gensym:set_var(ppc, hipe_ppc_registers:first_virtual()),
+ hipe_gensym:set_label(ppc, hipe_gensym:get_label(rtl)),
+ Map0 = vmap_empty(),
+ {Formals, Map1} = conv_formals(hipe_rtl:rtl_params(RTL), Map0),
+ OldData = hipe_rtl:rtl_data(RTL),
+ {Code0, NewData} = conv_insn_list(hipe_rtl:rtl_code(RTL), Map1, OldData),
+ {RegFormals, _} = split_args(Formals),
+ Code =
+ case RegFormals of
+ [] -> Code0;
+ _ -> [hipe_ppc:mk_label(hipe_gensym:get_next_label(ppc)) |
+ move_formals(RegFormals, Code0)]
+ end,
+ IsClosure = hipe_rtl:rtl_is_closure(RTL),
+ IsLeaf = hipe_rtl:rtl_is_leaf(RTL),
+ hipe_ppc:mk_defun(hipe_rtl:rtl_fun(RTL),
+ Formals,
+ IsClosure,
+ IsLeaf,
+ Code,
+ NewData,
+ [],
+ []).
+
+conv_insn_list([H|T], Map, Data) ->
+ {NewH, NewMap, NewData1} = conv_insn(H, Map, Data),
+ %% io:format("~w \n ==>\n ~w\n- - - - - - - - -\n",[H,NewH]),
+ {NewT, NewData2} = conv_insn_list(T, NewMap, NewData1),
+ {NewH ++ NewT, NewData2};
+conv_insn_list([], _, Data) ->
+ {[], Data}.
+
+conv_insn(I, Map, Data) ->
+ case I of
+ #alu{} -> conv_alu(I, Map, Data);
+ #alub{} -> conv_alub(I, Map, Data);
+ #branch{} -> conv_branch(I, Map, Data);
+ #call{} -> conv_call(I, Map, Data);
+ #comment{} -> conv_comment(I, Map, Data);
+ #enter{} -> conv_enter(I, Map, Data);
+ #goto{} -> conv_goto(I, Map, Data);
+ #label{} -> conv_label(I, Map, Data);
+ #load{} -> conv_load(I, Map, Data);
+ #load_address{} -> conv_load_address(I, Map, Data);
+ #load_atom{} -> conv_load_atom(I, Map, Data);
+ #move{} -> conv_move(I, Map, Data);
+ #return{} -> conv_return(I, Map, Data);
+ #store{} -> conv_store(I, Map, Data);
+ #switch{} -> conv_switch(I, Map, Data);
+ #fconv{} -> conv_fconv(I, Map, Data);
+ #fmove{} -> conv_fmove(I, Map, Data);
+ #fload{} -> conv_fload(I, Map, Data);
+ #fstore{} -> conv_fstore(I, Map, Data);
+ #fp{} -> conv_fp_binary(I, Map, Data);
+ #fp_unop{} -> conv_fp_unary(I, Map, Data);
+ _ -> exit({?MODULE,conv_insn,I})
+ end.
+
+conv_fconv(I, Map, Data) ->
+ %% Dst := (double)Src, where Dst is FP reg and Src is int reg
+ {Dst, Map0} = conv_fpreg(hipe_rtl:fconv_dst(I), Map),
+ {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), % exclude imm src
+ I2 = mk_fconv(Dst, Src),
+ {I2, Map1, Data}.
+
+mk_fconv(Dst, Src) ->
+ CSP = hipe_ppc:mk_temp(1, 'untagged'),
+ R0 = hipe_ppc:mk_temp(0, 'untagged'),
+ RTmp1 = hipe_ppc:mk_new_temp('untagged'),
+ RTmp2 = hipe_ppc:mk_new_temp('untagged'),
+ RTmp3 = hipe_ppc:mk_new_temp('untagged'),
+ FTmp1 = hipe_ppc:mk_new_temp('double'),
+ FTmp2 = hipe_ppc:mk_new_temp('double'),
+ [hipe_ppc:mk_pseudo_li(RTmp1, {fconv_constant,c_const}),
+ hipe_ppc:mk_lfd(FTmp1, 0, RTmp1),
+ hipe_ppc:mk_alu('xoris', RTmp2, Src, hipe_ppc:mk_uimm16(16#8000)),
+ hipe_ppc:mk_store('stw', RTmp2, 28, CSP),
+ hipe_ppc:mk_alu('addis', RTmp3, R0, hipe_ppc:mk_simm16(16#4330)),
+ hipe_ppc:mk_store('stw', RTmp3, 24, CSP),
+ hipe_ppc:mk_lfd(FTmp2, 24, CSP),
+ hipe_ppc:mk_fp_binary('fsub', Dst, FTmp2, FTmp1)].
+
+conv_fmove(I, Map, Data) ->
+ %% Dst := Src, where both Dst and Src are FP regs
+ {Dst, Map0} = conv_fpreg(hipe_rtl:fmove_dst(I), Map),
+ {Src, Map1} = conv_fpreg(hipe_rtl:fmove_src(I), Map0),
+ I2 = mk_fmove(Dst, Src),
+ {I2, Map1, Data}.
+
+mk_fmove(Dst, Src) ->
+ [hipe_ppc:mk_pseudo_fmove(Dst, Src)].
+
+conv_fload(I, Map, Data) ->
+ %% Dst := MEM[Base+Off], where Dst is FP reg
+ {Dst, Map0} = conv_fpreg(hipe_rtl:fload_dst(I), Map),
+ {Base1, Map1} = conv_src(hipe_rtl:fload_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:fload_offset(I), Map1),
+ I2 = mk_fload(Dst, Base1, Base2),
+ {I2, Map2, Data}.
+
+mk_fload(Dst, Base1, Base2) ->
+ case hipe_ppc:is_temp(Base1) of
+ true ->
+ case hipe_ppc:is_temp(Base2) of
+ true ->
+ mk_fload_rr(Dst, Base1, Base2);
+ _ ->
+ mk_fload_ri(Dst, Base1, Base2)
+ end;
+ _ ->
+ case hipe_ppc:is_temp(Base2) of
+ true ->
+ mk_fload_ri(Dst, Base2, Base1);
+ _ ->
+ mk_fload_ii(Dst, Base1, Base2)
+ end
+ end.
+
+mk_fload_ii(Dst, Base1, Base2) ->
+ io:format("~w: RTL fload with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Base1,
+ mk_fload_ri(Dst, Tmp, Base2)).
+
+mk_fload_ri(Dst, Base, Disp) ->
+ hipe_ppc:mk_fload(Dst, Disp, Base, 'new').
+
+mk_fload_rr(Dst, Base1, Base2) ->
+ [hipe_ppc:mk_lfdx(Dst, Base1, Base2)].
+
+conv_fstore(I, Map, Data) ->
+ %% MEM[Base+Off] := Src, where Src is FP reg
+ {Base1, Map0} = conv_dst(hipe_rtl:fstore_base(I), Map),
+ {Src, Map1} = conv_fpreg(hipe_rtl:fstore_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:fstore_offset(I), Map1),
+ I2 = mk_fstore(Src, Base1, Base2),
+ {I2, Map2, Data}.
+
+mk_fstore(Src, Base1, Base2) ->
+ case hipe_ppc:is_temp(Base2) of
+ true ->
+ mk_fstore_rr(Src, Base1, Base2);
+ _ ->
+ mk_fstore_ri(Src, Base1, Base2)
+ end.
+
+mk_fstore_ri(Src, Base, Disp) ->
+ hipe_ppc:mk_fstore(Src, Disp, Base, 'new').
+
+mk_fstore_rr(Src, Base1, Base2) ->
+ [hipe_ppc:mk_stfdx(Src, Base1, Base2)].
+
+conv_fp_binary(I, Map, Data) ->
+ {Dst, Map0} = conv_fpreg(hipe_rtl:fp_dst(I), Map),
+ {Src1, Map1} = conv_fpreg(hipe_rtl:fp_src1(I), Map0),
+ {Src2, Map2} = conv_fpreg(hipe_rtl:fp_src2(I), Map1),
+ RtlFpOp = hipe_rtl:fp_op(I),
+ I2 = mk_fp_binary(Dst, Src1, RtlFpOp, Src2),
+ {I2, Map2, Data}.
+
+mk_fp_binary(Dst, Src1, RtlFpOp, Src2) ->
+ FpBinOp =
+ case RtlFpOp of
+ 'fadd' -> 'fadd';
+ 'fdiv' -> 'fdiv';
+ 'fmul' -> 'fmul';
+ 'fsub' -> 'fsub'
+ end,
+ [hipe_ppc:mk_fp_binary(FpBinOp, Dst, Src1, Src2)].
+
+conv_fp_unary(I, Map, Data) ->
+ {Dst, Map0} = conv_fpreg(hipe_rtl:fp_unop_dst(I), Map),
+ {Src, Map1} = conv_fpreg(hipe_rtl:fp_unop_src(I), Map0),
+ RtlFpUnOp = hipe_rtl:fp_unop_op(I),
+ I2 = mk_fp_unary(Dst, Src, RtlFpUnOp),
+ {I2, Map1, Data}.
+
+mk_fp_unary(Dst, Src, RtlFpUnOp) ->
+ FpUnOp =
+ case RtlFpUnOp of
+ 'fchs' -> 'fneg'
+ end,
+ [hipe_ppc:mk_fp_unary(FpUnOp, Dst, Src)].
+
+conv_alu(I, Map, Data) ->
+ %% dst = src1 aluop src2
+ {Dst, Map0} = conv_dst(hipe_rtl:alu_dst(I), Map),
+ {Src1, Map1} = conv_src(hipe_rtl:alu_src1(I), Map0),
+ {Src2, Map2} = conv_src(hipe_rtl:alu_src2(I), Map1),
+ RtlAluOp = hipe_rtl:alu_op(I),
+ I2 = mk_alu(Dst, Src1, RtlAluOp, Src2),
+ {I2, Map2, Data}.
+
+mk_alu(Dst, Src1, RtlAluOp, Src2) ->
+ case hipe_ppc:is_temp(Src1) of
+ true ->
+ case hipe_ppc:is_temp(Src2) of
+ true ->
+ mk_alu_rr(Dst, Src1, RtlAluOp, Src2);
+ _ ->
+ mk_alu_ri(Dst, Src1, RtlAluOp, Src2)
+ end;
+ _ ->
+ case hipe_ppc:is_temp(Src2) of
+ true ->
+ mk_alu_ir(Dst, Src1, RtlAluOp, Src2);
+ _ ->
+ mk_alu_ii(Dst, Src1, RtlAluOp, Src2)
+ end
+ end.
+
+mk_alu_ii(Dst, Src1, RtlAluOp, Src2) ->
+ io:format("~w: RTL alu with two immediates (~w ~w ~w)\n",
+ [?MODULE, Src1, RtlAluOp, Src2]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_alu_ri(Dst, Tmp, RtlAluOp, Src2)).
+
+mk_alu_ir(Dst, Src1, RtlAluOp, Src2) ->
+ case rtl_aluop_commutes(RtlAluOp) of
+ true ->
+ mk_alu_ri(Dst, Src2, RtlAluOp, Src1);
+ _ ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_alu_rr(Dst, Tmp, RtlAluOp, Src2))
+ end.
+
+mk_alu_ri(Dst, Src1, RtlAluOp, Src2) ->
+ case RtlAluOp of
+ 'sub' -> % there is no 'subi'
+ mk_alu_ri_addi(Dst, Src1, -Src2);
+ 'add' -> % 'addi' has a 16-bit simm operand
+ mk_alu_ri_addi(Dst, Src1, Src2);
+ 'mul' -> % 'mulli' has a 16-bit simm operand
+ mk_alu_ri_simm16(Dst, Src1, RtlAluOp, 'mulli', Src2);
+ 'and' -> % 'andi.' has a 16-bit uimm operand
+ case rlwinm_mask(Src2) of
+ {MB,ME} ->
+ [hipe_ppc:mk_unary({'rlwinm',0,MB,ME}, Dst, Src1)];
+ _ ->
+ mk_alu_ri_bitop(Dst, Src1, RtlAluOp, 'andi.', Src2)
+ end;
+ 'or' -> % 'ori' has a 16-bit uimm operand
+ mk_alu_ri_bitop(Dst, Src1, RtlAluOp, 'ori', Src2);
+ 'xor' -> % 'xori' has a 16-bit uimm operand
+ mk_alu_ri_bitop(Dst, Src1, RtlAluOp, 'xori', Src2);
+ _ -> % shift ops have 5-bit uimm operands
+ mk_alu_ri_shift(Dst, Src1, RtlAluOp, Src2)
+ end.
+
+rlwinm_mask(Imm) ->
+ Res1 = rlwinm_mask2(Imm),
+ case Res1 of
+ {_MB,_ME} -> Res1;
+ [] ->
+ case rlwinm_mask2(bnot Imm) of
+ {MB,ME} -> {ME+1,MB-1};
+ [] -> []
+ end
+ end.
+
+rlwinm_mask2(Imm) ->
+ case Imm band 16#ffffffff of
+ 0 -> [];
+ Word ->
+ MB = lsb_log2(Word), % first 1 bit
+ case bnot(Word bsr MB) band 16#ffffffff of
+ 0 -> []; % Imm was all-bits-one XXX: we should handle this
+ Word1 ->
+ ME1 = lsb_log2(Word1),% first 0 bit after the 1s
+ case Word bsr (MB+ME1) of
+ 0 ->
+ ME = MB+ME1-1, % last 1 bit
+ {31-ME, 31-MB}; % convert to PPC sick and twisted bit numbers
+ _ ->
+ []
+ end
+ end
+ end.
+
+lsb_log2(Word) -> % PRE: Word =/= 0
+ bitN_log2(Word band -Word, 0).
+
+bitN_log2(BitN, ShiftN) ->
+ if BitN > 16#ffff ->
+ bitN_log2(BitN bsr 16, ShiftN + 16);
+ true ->
+ ShiftN + hweight16(BitN - 1)
+ end.
+
+hweight16(Word) -> % PRE: 0 <= Word <= 16#ffff
+ Res1 = (Word band 16#5555) + ((Word bsr 1) band 16#5555),
+ Res2 = (Res1 band 16#3333) + ((Res1 bsr 2) band 16#3333),
+ Res3 = (Res2 band 16#0F0F) + ((Res2 bsr 4) band 16#0F0F),
+ (Res3 band 16#00FF) + ((Res3 bsr 8) band 16#00FF).
+
+mk_alu_ri_addi(Dst, Src1, Src2) ->
+ mk_alu_ri_simm16(Dst, Src1, 'add', 'addi', Src2).
+
+mk_alu_ri_simm16(Dst, Src1, RtlAluOp, AluOp, Src2) ->
+ if is_integer(Src2), -32768 =< Src2, Src2 < 32768 ->
+ [hipe_ppc:mk_alu(AluOp, Dst, Src1,
+ hipe_ppc:mk_simm16(Src2))];
+ true ->
+ mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2)
+ end.
+
+mk_alu_ri_bitop(Dst, Src1, RtlAluOp, AluOp, Src2) ->
+ if is_integer(Src2), 0 =< Src2, Src2 < 65536 ->
+ [hipe_ppc:mk_alu(AluOp, Dst, Src1,
+ hipe_ppc:mk_uimm16(Src2))];
+ true ->
+ mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2)
+ end.
+
+mk_alu_ri_shift(Dst, Src1, RtlAluOp, Src2) ->
+ if Src2 < 32, Src2 >= 0 ->
+ AluOp =
+ case RtlAluOp of
+ 'sll' -> 'slwi'; % alias for rlwinm
+ 'srl' -> 'srwi'; % alias for rlwinm
+ 'sra' -> 'srawi'
+ end,
+ [hipe_ppc:mk_alu(AluOp, Dst, Src1,
+ hipe_ppc:mk_uimm16(Src2))];
+ true ->
+ mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2)
+ end.
+
+mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2) ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src2,
+ mk_alu_rr(Dst, Src1, RtlAluOp, Tmp)).
+
+mk_alu_rr(Dst, Src1, RtlAluOp, Src2) ->
+ case RtlAluOp of
+ 'sub' -> % PPC weirdness
+ [hipe_ppc:mk_alu('subf', Dst, Src2, Src1)];
+ _ ->
+ AluOp =
+ case RtlAluOp of
+ 'add' -> 'add';
+ 'mul' -> 'mullw';
+ 'or' -> 'or';
+ 'and' -> 'and';
+ 'xor' -> 'xor';
+ 'sll' -> 'slw';
+ 'srl' -> 'srw';
+ 'sra' -> 'sraw'
+ end,
+ [hipe_ppc:mk_alu(AluOp, Dst, Src1, Src2)]
+ end.
+
+conv_alub(I, Map, Data) ->
+ %% dst = src1 aluop src2; if COND goto label
+ {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map),
+ {Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0),
+ {Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1),
+ {AluOp, BCond} =
+ case {hipe_rtl:alub_op(I), hipe_rtl:alub_cond(I)} of
+ {'add', 'ltu'} ->
+ {'addc', 'eq'};
+ {RtlAlubOp, RtlAlubCond} ->
+ {conv_alub_op(RtlAlubOp), conv_alub_cond(RtlAlubCond)}
+ end,
+ BC = mk_pseudo_bc(BCond,
+ hipe_rtl:alub_true_label(I),
+ hipe_rtl:alub_false_label(I),
+ hipe_rtl:alub_pred(I)),
+ I2 =
+ case {AluOp, BCond} of
+ {'addc', 'eq'} -> % copy XER[CA] to CR0[EQ] before the BC
+ TmpR = new_untagged_temp(),
+ [hipe_ppc:mk_mfspr(TmpR, 'xer'),
+ hipe_ppc:mk_mtcr(TmpR) |
+ BC];
+ _ -> BC
+ end,
+ {NewSrc1, NewSrc2} =
+ case AluOp of
+ 'subf' -> {Src2, Src1};
+ _ -> {Src1, Src2}
+ end,
+ I1 = mk_alub(Dst, NewSrc1, AluOp, NewSrc2, BCond),
+ {I1 ++ I2, Map2, Data}.
+
+conv_alub_op(RtlAluOp) ->
+ case RtlAluOp of
+ 'add' -> 'add';
+ 'sub' -> 'subf'; % XXX: must swap operands
+ 'mul' -> 'mullw';
+ 'or' -> 'or';
+ 'and' -> 'and';
+ 'xor' -> 'xor';
+ 'sll' -> 'slw';
+ 'srl' -> 'srw';
+ 'sra' -> 'sraw'
+ end.
+
+aluop_commutes(AluOp) ->
+ case AluOp of
+ 'add' -> true;
+ 'addc' -> true;
+ 'subf' -> false;
+ 'mullw' -> true;
+ 'or' -> true;
+ 'and' -> true;
+ 'xor' -> true;
+ 'slw' -> false;
+ 'srw' -> false;
+ 'sraw' -> false
+ end.
+
+conv_alub_cond(Cond) -> % only signed
+ case Cond of
+ eq -> 'eq';
+ ne -> 'ne';
+ gt -> 'gt';
+ ge -> 'ge';
+ lt -> 'lt';
+ le -> 'le';
+ overflow -> 'so';
+ not_overflow -> 'ns';
+ _ -> exit({?MODULE,conv_alub_cond,Cond})
+ end.
+
+mk_alub(Dst, Src1, AluOp, Src2, BCond) ->
+ case hipe_ppc:is_temp(Src1) of
+ true ->
+ case hipe_ppc:is_temp(Src2) of
+ true ->
+ mk_alub_rr(Dst, Src1, AluOp, Src2, BCond);
+ _ ->
+ mk_alub_ri(Dst, Src1, AluOp, Src2, BCond)
+ end;
+ _ ->
+ case hipe_ppc:is_temp(Src2) of
+ true ->
+ mk_alub_ir(Dst, Src1, AluOp, Src2, BCond);
+ _ ->
+ mk_alub_ii(Dst, Src1, AluOp, Src2, BCond)
+ end
+ end.
+
+mk_alub_ii(Dst, Src1, AluOp, Src2, BCond) ->
+ io:format("~w: RTL alub with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_alub_ri(Dst, Tmp, AluOp, Src2, BCond)).
+
+mk_alub_ir(Dst, Src1, AluOp, Src2, BCond) ->
+ case aluop_commutes(AluOp) of
+ true ->
+ mk_alub_ri(Dst, Src2, AluOp, Src1, BCond);
+ _ ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_alub_rr(Dst, Tmp, AluOp, Src2, BCond))
+ end.
+
+mk_alub_ri(Dst, Src1, AluOp, Src2, BCond) ->
+ true = is_integer(Src2),
+ case BCond of
+ 'so' -> mk_alub_ri_OE(Dst, Src1, AluOp, Src2);
+ 'ns' -> mk_alub_ri_OE(Dst, Src1, AluOp, Src2);
+ _ -> mk_alub_ri_Rc(Dst, Src1, AluOp, Src2)
+ end.
+
+mk_alub_ri_OE(Dst, Src1, AluOp, Src2) ->
+ %% Only 'add', 'subf', and 'mullw' apply here, and 'subf' becomes 'add'.
+ %% 'add' and 'mullw' have no immediate+Rc+OE forms.
+ %% Rewrite to reg/reg form. Sigh.
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src2,
+ mk_alub_rr_OE(Dst, Src1, AluOp, Tmp)).
+
+mk_alub_ri_Rc(Dst, Src1, AluOp, Src2) ->
+ case AluOp of
+ 'subf' -> % there is no 'subfi.', use 'addic.' or 'add.'
+ mk_alub_ri_Rc_addi(Dst, Src1, -Src2, 'addic.', 'add.');
+ 'add' -> % 'addic.' has a 16-bit simm operand
+ mk_alub_ri_Rc_addi(Dst, Src1, Src2, 'addic.', 'add.');
+ 'addc' -> % 'addic' has a 16-bit simm operand
+ mk_alub_ri_Rc_addi(Dst, Src1, Src2, 'addic', 'addc');
+ 'mullw' -> % there is no 'mulli.'
+ mk_alub_ri_Rc_rr(Dst, Src1, 'mullw.', Src2);
+ 'or' -> % there is no 'ori.'
+ mk_alub_ri_Rc_rr(Dst, Src1, 'or.', Src2);
+ 'xor' -> % there is no 'xori.'
+ mk_alub_ri_Rc_rr(Dst, Src1, 'xor.', Src2);
+ 'and' -> % 'andi.' has a 16-bit uimm operand
+ case rlwinm_mask(Src2) of
+ {MB,ME} ->
+ [hipe_ppc:mk_unary({'rlwinm.',0,MB,ME}, Dst, Src1)];
+ _ ->
+ mk_alub_ri_Rc_andi(Dst, Src1, Src2)
+ end;
+ _ -> % shift ops have 5-bit uimm operands
+ mk_alub_ri_Rc_shift(Dst, Src1, AluOp, Src2)
+ end.
+
+mk_alub_ri_Rc_addi(Dst, Src1, Src2, AddImmOp, AddRegOp) ->
+ if is_integer(Src2), -32768 =< Src2, Src2 < 32768 ->
+ [hipe_ppc:mk_alu(AddImmOp, Dst, Src1,
+ hipe_ppc:mk_simm16(Src2))];
+ true ->
+ mk_alub_ri_Rc_rr(Dst, Src1, AddRegOp, Src2)
+ end.
+
+mk_alub_ri_Rc_andi(Dst, Src1, Src2) ->
+ if Src2 < 65536, Src2 >= 0 ->
+ [hipe_ppc:mk_alu('andi.', Dst, Src1,
+ hipe_ppc:mk_uimm16(Src2))];
+ true ->
+ mk_alub_ri_Rc_rr(Dst, Src1, 'and.', Src2)
+ end.
+
+mk_alub_ri_Rc_shift(Dst, Src1, AluOp, Src2) ->
+ if Src2 < 32, Src2 >= 0 ->
+ AluOpIDot =
+ case AluOp of
+ 'slw' -> 'slwi.'; % alias for rlwinm.
+ 'srw' -> 'srwi.'; % alias for rlwinm.
+ 'sraw' -> 'srawi.'
+ end,
+ [hipe_ppc:mk_alu(AluOpIDot, Dst, Src1,
+ hipe_ppc:mk_uimm16(Src2))];
+ true ->
+ AluOpDot =
+ case AluOp of
+ 'slw' -> 'slw.';
+ 'srw' -> 'srw.';
+ 'sraw' -> 'sraw.'
+ end,
+ mk_alub_ri_Rc_rr(Dst, Src1, AluOpDot, Src2)
+ end.
+
+mk_alub_ri_Rc_rr(Dst, Src1, AluOp, Src2) ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src2,
+ [hipe_ppc:mk_alu(AluOp, Dst, Src1, Tmp)]).
+
+mk_alub_rr(Dst, Src1, AluOp, Src2, BCond) ->
+ case BCond of
+ 'so' -> mk_alub_rr_OE(Dst, Src1, AluOp, Src2);
+ 'ns' -> mk_alub_rr_OE(Dst, Src1, AluOp, Src2);
+ _ -> mk_alub_rr_Rc(Dst, Src1, AluOp, Src2)
+ end.
+
+mk_alub_rr_OE(Dst, Src1, AluOp, Src2) ->
+ AluOpODot =
+ case AluOp of
+ 'subf' -> 'subfo.';
+ 'add' -> 'addo.';
+ 'mullw' -> 'mullwo.'
+ %% fail for addc, or, and, xor, slw, srw, sraw
+ end,
+ [hipe_ppc:mk_alu(AluOpODot, Dst, Src1, Src2)].
+
+mk_alub_rr_Rc(Dst, Src1, AluOp, Src2) ->
+ AluOpDot =
+ case AluOp of
+ 'subf' -> 'subf.';
+ 'add' -> 'add.';
+ 'addc' -> 'addc'; % only interested in CA, no Rc needed
+ 'mullw' -> 'mullw.';
+ 'or' -> 'or.';
+ 'and' -> 'and.';
+ 'xor' -> 'xor.';
+ 'slw' -> 'slw.';
+ 'srw' -> 'srw.';
+ 'sraw' -> 'sraw.'
+ end,
+ [hipe_ppc:mk_alu(AluOpDot, Dst, Src1, Src2)].
+
+conv_branch(I, Map, Data) ->
+ %% <unused> = src1 - src2; if COND goto label
+ {Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map),
+ {Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0),
+ {BCond,Sign} = conv_branch_cond(hipe_rtl:branch_cond(I)),
+ I2 = mk_branch(Src1, BCond, Sign, Src2,
+ hipe_rtl:branch_true_label(I),
+ hipe_rtl:branch_false_label(I),
+ hipe_rtl:branch_pred(I)),
+ {I2, Map1, Data}.
+
+conv_branch_cond(Cond) -> % may be unsigned
+ case Cond of
+ gtu -> {'gt', 'unsigned'};
+ geu -> {'ge', 'unsigned'};
+ ltu -> {'lt', 'unsigned'};
+ leu -> {'le', 'unsigned'};
+ _ -> {conv_alub_cond(Cond), 'signed'}
+ end.
+
+mk_branch(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) ->
+ case hipe_ppc:is_temp(Src1) of
+ true ->
+ case hipe_ppc:is_temp(Src2) of
+ true ->
+ mk_branch_rr(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred);
+ _ ->
+ mk_branch_ri(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred)
+ end;
+ _ ->
+ case hipe_ppc:is_temp(Src2) of
+ true ->
+ NewBCond = commute_bcond(BCond),
+ mk_branch_ri(Src2, NewBCond, Sign, Src1, TrueLab, FalseLab, Pred);
+ _ ->
+ mk_branch_ii(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred)
+ end
+ end.
+
+commute_bcond(BCond) -> % if x BCond y, then y commute_bcond(BCond) x
+ case BCond of
+ 'eq' -> 'eq'; % ==, ==
+ 'ne' -> 'ne'; % !=, !=
+ 'gt' -> 'lt'; % >, <
+ 'ge' -> 'le'; % >=, <=
+ 'lt' -> 'gt'; % <, >
+ 'le' -> 'ge'; % <=, >=
+ %% so/ns: n/a
+ _ -> exit({?MODULE,commute_bcond,BCond})
+ end.
+
+mk_branch_ii(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) ->
+ io:format("~w: RTL branch with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src1,
+ mk_branch_ri(Tmp, BCond, Sign, Src2,
+ TrueLab, FalseLab, Pred)).
+
+mk_branch_ri(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) ->
+ {FixSrc2,NewSrc2,CmpOp} =
+ case Sign of
+ 'signed' ->
+ if is_integer(Src2), -32768 =< Src2, Src2 < 32768 ->
+ {[], hipe_ppc:mk_simm16(Src2), 'cmpi'};
+ true ->
+ Tmp = new_untagged_temp(),
+ {mk_li(Tmp, Src2), Tmp, 'cmp'}
+ end;
+ 'unsigned' ->
+ if is_integer(Src2), 0 =< Src2, Src2 < 65536 ->
+ {[], hipe_ppc:mk_uimm16(Src2), 'cmpli'};
+ true ->
+ Tmp = new_untagged_temp(),
+ {mk_li(Tmp, Src2), Tmp, 'cmpl'}
+ end
+ end,
+ FixSrc2 ++
+ mk_cmp_bc(CmpOp, Src1, NewSrc2, BCond, TrueLab, FalseLab, Pred).
+
+mk_branch_rr(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) ->
+ CmpOp =
+ case Sign of
+ 'signed' -> 'cmp';
+ 'unsigned' -> 'cmpl'
+ end,
+ mk_cmp_bc(CmpOp, Src1, Src2, BCond, TrueLab, FalseLab, Pred).
+
+mk_cmp_bc(CmpOp, Src1, Src2, BCond, TrueLab, FalseLab, Pred) ->
+ [hipe_ppc:mk_cmp(CmpOp, Src1, Src2) |
+ mk_pseudo_bc(BCond, TrueLab, FalseLab, Pred)].
+
+conv_call(I, Map, Data) ->
+ {Args, Map0} = conv_src_list(hipe_rtl:call_arglist(I), Map),
+ {Dsts, Map1} = conv_dst_list(hipe_rtl:call_dstlist(I), Map0),
+ {Fun, Map2} = conv_fun(hipe_rtl:call_fun(I), Map1),
+ ContLab = hipe_rtl:call_continuation(I),
+ ExnLab = hipe_rtl:call_fail(I),
+ Linkage = hipe_rtl:call_type(I),
+ I2 = mk_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage),
+ {I2, Map2, Data}.
+
+mk_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_ppc:is_prim(Fun) of
+ true ->
+ mk_primop_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage);
+ false ->
+ mk_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage)
+ end.
+
+mk_primop_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_ppc:prim_prim(Prim) of
+ 'extsh' ->
+ mk_extsh_call(Dsts, Args, ContLab, ExnLab, Linkage);
+ 'lhbrx' ->
+ mk_lhbrx_call(Dsts, Args, ContLab, ExnLab, Linkage);
+ 'lwbrx' ->
+ mk_lwbrx_call(Dsts, Args, ContLab, ExnLab, Linkage);
+ _ ->
+ mk_general_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage)
+ end.
+
+mk_extsh_call([Dst], [Src], [], [], not_remote) ->
+ true = hipe_ppc:is_temp(Src),
+ [hipe_ppc:mk_unary('extsh', Dst, Src)].
+
+mk_lhbrx_call(Dsts, [Base,Offset], [], [], not_remote) ->
+ case Dsts of
+ [Dst] -> mk_loadx('lhbrx', Dst, Base, Offset);
+ [] -> [] % result unused, cancel the operation
+ end.
+
+mk_lwbrx_call([Dst], [Base,Offset], [], [], not_remote) ->
+ mk_loadx('lwbrx', Dst, Base, Offset).
+
+mk_loadx(LdxOp, Dst, Base, Offset) ->
+ true = hipe_ppc:is_temp(Base),
+ {FixOff,NewOff} =
+ case hipe_ppc:is_temp(Offset) of
+ true -> {[], Offset};
+ false ->
+ Tmp = new_untagged_temp(),
+ {mk_li(Tmp, Offset), Tmp}
+ end,
+ FixOff ++ [hipe_ppc:mk_loadx(LdxOp, Dst, Base, NewOff)].
+
+mk_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ %% The backend does not support pseudo_calls without a
+ %% continuation label, so we make sure each call has one.
+ {RealContLab, Tail} =
+ case mk_call_results(Dsts) of
+ [] ->
+ %% Avoid consing up a dummy basic block if the moves list
+ %% is empty, as is typical for calls to suspend/0.
+ %% This should be subsumed by a general "optimise the CFG"
+ %% module, and could probably be removed.
+ case ContLab of
+ [] ->
+ NewContLab = hipe_gensym:get_next_label(ppc),
+ {NewContLab, [hipe_ppc:mk_label(NewContLab)]};
+ _ ->
+ {ContLab, []}
+ end;
+ Moves ->
+ %% Change the call to continue at a new basic block.
+ %% In this block move the result registers to the Dsts,
+ %% then continue at the call's original continuation.
+ NewContLab = hipe_gensym:get_next_label(ppc),
+ case ContLab of
+ [] ->
+ %% This is just a fallthrough
+ %% No jump back after the moves.
+ {NewContLab,
+ [hipe_ppc:mk_label(NewContLab) |
+ Moves]};
+ _ ->
+ %% The call has a continuation. Jump to it.
+ {NewContLab,
+ [hipe_ppc:mk_label(NewContLab) |
+ Moves ++
+ [hipe_ppc:mk_b_label(ContLab)]]}
+ end
+ end,
+ SDesc = hipe_ppc:mk_sdesc(ExnLab, 0, length(Args), {}),
+ {FixFunC,FunC} = fix_func(Fun),
+ CallInsn = hipe_ppc:mk_pseudo_call(FunC, SDesc, RealContLab, Linkage),
+ {RegArgs,StkArgs} = split_args(Args),
+ FixFunC ++
+ mk_push_args(StkArgs, move_actuals(RegArgs, [CallInsn | Tail])).
+
+mk_call_results([]) ->
+ [];
+mk_call_results([Dst]) ->
+ RV = hipe_ppc:mk_temp(hipe_ppc_registers:return_value(), 'tagged'),
+ [hipe_ppc:mk_pseudo_move(Dst, RV)];
+mk_call_results(Dsts) ->
+ exit({?MODULE,mk_call_results,Dsts}).
+
+fix_func(Fun) ->
+ case hipe_ppc:is_temp(Fun) of
+ true -> {[hipe_ppc:mk_mtspr('ctr', Fun)], 'ctr'};
+ _ -> {[], Fun}
+ end.
+
+mk_push_args(StkArgs, Tail) ->
+ case length(StkArgs) of
+ 0 ->
+ Tail;
+ NrStkArgs ->
+ [hipe_ppc:mk_pseudo_call_prepare(NrStkArgs) |
+ mk_store_args(StkArgs, NrStkArgs * word_size(), Tail)]
+ end.
+
+mk_store_args([Arg|Args], PrevOffset, Tail) ->
+ Offset = PrevOffset - word_size(),
+ {Src,FixSrc} =
+ case hipe_ppc:is_temp(Arg) of
+ true ->
+ {Arg, []};
+ _ ->
+ Tmp = new_tagged_temp(),
+ {Tmp, mk_li(Tmp, Arg)}
+ end,
+ Store = hipe_ppc:mk_store('stw', Src, Offset, mk_sp()),
+ mk_store_args(Args, Offset, FixSrc ++ [Store | Tail]);
+mk_store_args([], _, Tail) ->
+ Tail.
+
+conv_comment(I, Map, Data) ->
+ I2 = [hipe_ppc:mk_comment(hipe_rtl:comment_text(I))],
+ {I2, Map, Data}.
+
+conv_enter(I, Map, Data) ->
+ {Args, Map0} = conv_src_list(hipe_rtl:enter_arglist(I), Map),
+ {Fun, Map1} = conv_fun(hipe_rtl:enter_fun(I), Map0),
+ I2 = mk_enter(Fun, Args, hipe_rtl:enter_type(I)),
+ {I2, Map1, Data}.
+
+mk_enter(Fun, Args, Linkage) ->
+ {FixFunC,FunC} = fix_func(Fun),
+ Arity = length(Args),
+ {RegArgs,StkArgs} = split_args(Args),
+ FixFunC ++
+ move_actuals(RegArgs,
+ [hipe_ppc:mk_pseudo_tailcall_prepare(),
+ hipe_ppc:mk_pseudo_tailcall(FunC, Arity, StkArgs, Linkage)]).
+
+conv_goto(I, Map, Data) ->
+ I2 = [hipe_ppc:mk_b_label(hipe_rtl:goto_label(I))],
+ {I2, Map, Data}.
+
+conv_label(I, Map, Data) ->
+ I2 = [hipe_ppc:mk_label(hipe_rtl:label_name(I))],
+ {I2, Map, Data}.
+
+conv_load(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_dst(I), Map),
+ {Base1, Map1} = conv_src(hipe_rtl:load_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:load_offset(I), Map1),
+ LoadSize = hipe_rtl:load_size(I),
+ LoadSign = hipe_rtl:load_sign(I),
+ I2 = mk_load(Dst, Base1, Base2, LoadSize, LoadSign),
+ {I2, Map2, Data}.
+
+mk_load(Dst, Base1, Base2, LoadSize, LoadSign) ->
+ Rest =
+ case LoadSize of
+ byte ->
+ case LoadSign of
+ signed -> [hipe_ppc:mk_unary('extsb', Dst, Dst)];
+ _ -> []
+ end;
+ _ -> []
+ end,
+ LdOp =
+ case LoadSize of
+ byte -> 'lbz';
+ int32 -> 'lwz';
+ word -> 'lwz';
+ int16 ->
+ case LoadSign of
+ signed -> 'lha';
+ unsigned -> 'lhz'
+ end
+ end,
+ case hipe_ppc:is_temp(Base1) of
+ true ->
+ case hipe_ppc:is_temp(Base2) of
+ true ->
+ mk_load_rr(Dst, Base1, Base2, LdOp, Rest);
+ _ ->
+ mk_load_ri(Dst, Base1, Base2, LdOp, Rest)
+ end;
+ _ ->
+ case hipe_ppc:is_temp(Base2) of
+ true ->
+ mk_load_ri(Dst, Base2, Base1, LdOp, Rest);
+ _ ->
+ mk_load_ii(Dst, Base1, Base2, LdOp, Rest)
+ end
+ end.
+
+mk_load_ii(Dst, Base1, Base2, LdOp, Rest) ->
+ io:format("~w: RTL load with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Base1,
+ mk_load_ri(Dst, Tmp, Base2, LdOp, Rest)).
+
+mk_load_ri(Dst, Base, Disp, LdOp, Rest) ->
+ hipe_ppc:mk_load(LdOp, Dst, Disp, Base, 'new', Rest).
+
+mk_load_rr(Dst, Base1, Base2, LdOp, Rest) ->
+ LdxOp = hipe_ppc:ldop_to_ldxop(LdOp),
+ [hipe_ppc:mk_loadx(LdxOp, Dst, Base1, Base2) | Rest].
+
+conv_load_address(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_address_dst(I), Map),
+ Addr = hipe_rtl:load_address_addr(I),
+ Type = hipe_rtl:load_address_type(I),
+ Src = {Addr,Type},
+ I2 = [hipe_ppc:mk_pseudo_li(Dst, Src)],
+ {I2, Map0, Data}.
+
+conv_load_atom(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_atom_dst(I), Map),
+ Src = hipe_rtl:load_atom_atom(I),
+ I2 = [hipe_ppc:mk_pseudo_li(Dst, Src)],
+ {I2, Map0, Data}.
+
+conv_move(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:move_dst(I), Map),
+ {Src, Map1} = conv_src(hipe_rtl:move_src(I), Map0),
+ I2 = mk_move(Dst, Src, []),
+ {I2, Map1, Data}.
+
+mk_move(Dst, Src, Tail) ->
+ case hipe_ppc:is_temp(Src) of
+ true -> [hipe_ppc:mk_pseudo_move(Dst, Src) | Tail];
+ _ -> mk_li(Dst, Src, Tail)
+ end.
+
+conv_return(I, Map, Data) ->
+ %% TODO: multiple-value returns
+ {[Arg], Map0} = conv_src_list(hipe_rtl:return_varlist(I), Map),
+ I2 = mk_move(mk_rv(), Arg,
+ [hipe_ppc:mk_blr()]),
+ {I2, Map0, Data}.
+
+conv_store(I, Map, Data) ->
+ {Base1, Map0} = conv_dst(hipe_rtl:store_base(I), Map),
+ {Src, Map1} = conv_src(hipe_rtl:store_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:store_offset(I), Map1),
+ StoreSize = hipe_rtl:store_size(I),
+ I2 = mk_store(Src, Base1, Base2, StoreSize),
+ {I2, Map2, Data}.
+
+mk_store(Src, Base1, Base2, StoreSize) ->
+ StOp =
+ case StoreSize of
+ byte -> 'stb';
+ int16 -> 'sth';
+ int32 -> 'stw';
+ word -> 'stw'
+ end,
+ case hipe_ppc:is_temp(Src) of
+ true ->
+ mk_store2(Src, Base1, Base2, StOp);
+ _ ->
+ Tmp = new_untagged_temp(),
+ mk_li(Tmp, Src,
+ mk_store2(Tmp, Base1, Base2, StOp))
+ end.
+
+mk_store2(Src, Base1, Base2, StOp) ->
+ case hipe_ppc:is_temp(Base2) of
+ true ->
+ mk_store_rr(Src, Base1, Base2, StOp);
+ _ ->
+ mk_store_ri(Src, Base1, Base2, StOp)
+ end.
+
+mk_store_ri(Src, Base, Disp, StOp) ->
+ hipe_ppc:mk_store(StOp, Src, Disp, Base, 'new', []).
+
+mk_store_rr(Src, Base1, Base2, StOp) ->
+ StxOp = hipe_ppc:stop_to_stxop(StOp),
+ [hipe_ppc:mk_storex(StxOp, Src, Base1, Base2)].
+
+conv_switch(I, Map, Data) ->
+ Labels = hipe_rtl:switch_labels(I),
+ LMap = [{label,L} || L <- Labels],
+ {NewData, JTabLab} =
+ case hipe_rtl:switch_sort_order(I) of
+ [] ->
+ hipe_consttab:insert_block(Data, word, LMap);
+ SortOrder ->
+ hipe_consttab:insert_sorted_block(
+ Data, word, LMap, SortOrder)
+ end,
+ %% no immediates allowed here
+ {IndexR, Map1} = conv_dst(hipe_rtl:switch_src(I), Map),
+ JTabR = new_untagged_temp(),
+ OffsetR = new_untagged_temp(),
+ DestR = new_untagged_temp(),
+ I2 =
+ [hipe_ppc:mk_pseudo_li(JTabR, {JTabLab,constant}),
+ hipe_ppc:mk_alu('slwi', OffsetR, IndexR, hipe_ppc:mk_uimm16(2)),
+ hipe_ppc:mk_loadx('lwzx', DestR, JTabR, OffsetR),
+ hipe_ppc:mk_mtspr('ctr', DestR),
+ hipe_ppc:mk_bctr(Labels)],
+ {I2, Map1, NewData}.
+
+%%% Create a conditional branch.
+%%% If the condition tests CR0[SO], rewrite the path
+%%% corresponding to SO being set to clear XER[SO].
+
+mk_pseudo_bc(BCond, TrueLabel, FalseLabel, Pred) ->
+ case BCond of
+ 'so' ->
+ NewTrueLabel = hipe_gensym:get_next_label(ppc),
+ ZeroR = new_untagged_temp(),
+ [hipe_ppc:mk_pseudo_bc(BCond, NewTrueLabel, FalseLabel, Pred),
+ hipe_ppc:mk_label(NewTrueLabel) |
+ mk_li(ZeroR, 0,
+ [hipe_ppc:mk_mtspr('xer', ZeroR),
+ hipe_ppc:mk_b_label(TrueLabel)])];
+ 'ns' ->
+ NewFalseLabel = hipe_gensym:get_next_label(ppc),
+ ZeroR = new_untagged_temp(),
+ [hipe_ppc:mk_pseudo_bc(BCond, TrueLabel, NewFalseLabel, Pred),
+ hipe_ppc:mk_label(NewFalseLabel) |
+ mk_li(ZeroR, 0,
+ [hipe_ppc:mk_mtspr('xer', ZeroR),
+ hipe_ppc:mk_b_label(FalseLabel)])];
+ _ ->
+ [hipe_ppc:mk_pseudo_bc(BCond, TrueLabel, FalseLabel, Pred)]
+ end.
+
+%%% Load an integer constant into a register.
+
+mk_li(Dst, Value) -> mk_li(Dst, Value, []).
+
+mk_li(Dst, Value, Tail) ->
+ hipe_ppc:mk_li(Dst, Value, Tail).
+
+%%% Check if an RTL ALU or ALUB operator commutes.
+
+rtl_aluop_commutes(RtlAluOp) ->
+ case RtlAluOp of
+ 'add' -> true;
+ 'mul' -> true;
+ 'or' -> true;
+ 'and' -> true;
+ 'xor' -> true;
+ _ -> false
+ end.
+
+%%% Split a list of formal or actual parameters into the
+%%% part passed in registers and the part passed on the stack.
+%%% The parameters passed in registers are also tagged with
+%%% the corresponding registers.
+
+split_args(Args) ->
+ split_args(0, hipe_ppc_registers:nr_args(), Args, []).
+
+split_args(I, N, [Arg|Args], RegArgs) when I < N ->
+ Reg = hipe_ppc_registers:arg(I),
+ Temp = hipe_ppc:mk_temp(Reg, 'tagged'),
+ split_args(I+1, N, Args, [{Arg,Temp}|RegArgs]);
+split_args(_, _, StkArgs, RegArgs) ->
+ {RegArgs, StkArgs}.
+
+%%% Convert a list of actual parameters passed in
+%%% registers (from split_args/1) to a list of moves.
+
+move_actuals([{Src,Dst}|Actuals], Rest) ->
+ move_actuals(Actuals, mk_move(Dst, Src, Rest));
+move_actuals([], Rest) ->
+ Rest.
+
+%%% Convert a list of formal parameters passed in
+%%% registers (from split_args/1) to a list of moves.
+
+move_formals([{Dst,Src}|Formals], Rest) ->
+ move_formals(Formals, [hipe_ppc:mk_pseudo_move(Dst, Src) | Rest]);
+move_formals([], Rest) ->
+ Rest.
+
+%%% Convert a 'fun' operand (MFA, prim, or temp)
+
+conv_fun(Fun, Map) ->
+ case hipe_rtl:is_var(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ case hipe_rtl:is_reg(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ if is_atom(Fun) ->
+ {hipe_ppc:mk_prim(Fun), Map};
+ true ->
+ {conv_mfa(Fun), Map}
+ end
+ end
+ end.
+
+%%% Convert an MFA operand.
+
+conv_mfa({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) ->
+ hipe_ppc:mk_mfa(M, F, A).
+
+%%% Convert an RTL source operand (imm/var/reg).
+%%% Returns a temp or a naked integer.
+
+conv_src(Opnd, Map) ->
+ case hipe_rtl:is_imm(Opnd) of
+ true ->
+ Value = hipe_rtl:imm_value(Opnd),
+ if is_integer(Value) ->
+ {Value, Map}
+ end;
+ false ->
+ conv_dst(Opnd, Map)
+ end.
+
+conv_src_list([O|Os], Map) ->
+ {V, Map1} = conv_src(O, Map),
+ {Vs, Map2} = conv_src_list(Os, Map1),
+ {[V|Vs], Map2};
+conv_src_list([], Map) ->
+ {[], Map}.
+
+%%% Convert an RTL destination operand (var/reg).
+
+conv_fpreg(Opnd, Map) ->
+ case hipe_rtl:is_fpreg(Opnd) of
+ true -> conv_dst(Opnd, Map)
+ end.
+
+conv_dst(Opnd, Map) ->
+ {Name, Type} =
+ case hipe_rtl:is_var(Opnd) of
+ true ->
+ {hipe_rtl:var_index(Opnd), 'tagged'};
+ false ->
+ case hipe_rtl:is_fpreg(Opnd) of
+ true ->
+ {hipe_rtl:fpreg_index(Opnd), 'double'};
+ false ->
+ {hipe_rtl:reg_index(Opnd), 'untagged'}
+ end
+ end,
+ IsPrecoloured =
+ case Type of
+ 'double' -> hipe_ppc_registers:is_precoloured_fpr(Name);
+ _ -> hipe_ppc_registers:is_precoloured_gpr(Name)
+ end,
+ case IsPrecoloured of
+ true ->
+ {hipe_ppc:mk_temp(Name, Type), Map};
+ false ->
+ case vmap_lookup(Map, Opnd) of
+ {value, NewTemp} ->
+ {NewTemp, Map};
+ _ ->
+ NewTemp = hipe_ppc:mk_new_temp(Type),
+ {NewTemp, vmap_bind(Map, Opnd, NewTemp)}
+ end
+ end.
+
+conv_dst_list([O|Os], Map) ->
+ {Dst, Map1} = conv_dst(O, Map),
+ {Dsts, Map2} = conv_dst_list(Os, Map1),
+ {[Dst|Dsts], Map2};
+conv_dst_list([], Map) ->
+ {[], Map}.
+
+conv_formals(Os, Map) ->
+ conv_formals(hipe_ppc_registers:nr_args(), Os, Map, []).
+
+conv_formals(N, [O|Os], Map, Res) ->
+ Type =
+ case hipe_rtl:is_var(O) of
+ true -> 'tagged';
+ _ -> 'untagged'
+ end,
+ Dst =
+ if N > 0 -> hipe_ppc:mk_new_temp(Type); % allocatable
+ true -> hipe_ppc:mk_new_nonallocatable_temp(Type)
+ end,
+ Map1 = vmap_bind(Map, O, Dst),
+ conv_formals(N-1, Os, Map1, [Dst|Res]);
+conv_formals(_, [], Map, Res) ->
+ {lists:reverse(Res), Map}.
+
+%%% Create a temp representing the stack pointer register.
+
+mk_sp() ->
+ hipe_ppc:mk_temp(hipe_ppc_registers:stack_pointer(), 'untagged').
+
+%%% Create a temp representing the return value register.
+
+mk_rv() ->
+ hipe_ppc:mk_temp(hipe_ppc_registers:return_value(), 'tagged').
+
+%%% new_untagged_temp -- conjure up an untagged scratch reg
+
+new_untagged_temp() ->
+ hipe_ppc:mk_new_temp('untagged').
+
+%%% new_tagged_temp -- conjure up a tagged scratch reg
+
+new_tagged_temp() ->
+ hipe_ppc:mk_new_temp('tagged').
+
+%%% Map from RTL var/reg operands to temps.
+
+vmap_empty() ->
+ gb_trees:empty().
+
+vmap_lookup(Map, Key) ->
+ gb_trees:lookup(Key, Map).
+
+vmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+word_size() ->
+ hipe_rtl_arch:word_size().
diff --git a/lib/hipe/prebuild.skip b/lib/hipe/prebuild.skip
new file mode 100644
index 0000000000..9c558e357c
--- /dev/null
+++ b/lib/hipe/prebuild.skip
@@ -0,0 +1 @@
+.
diff --git a/lib/hipe/regalloc/Makefile b/lib/hipe/regalloc/Makefile
new file mode 100644
index 0000000000..5ab70d1837
--- /dev/null
+++ b/lib/hipe/regalloc/Makefile
@@ -0,0 +1,123 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = hipe_ig hipe_ig_moves hipe_moves \
+ hipe_node_sets hipe_spillcost hipe_reg_worklists \
+ hipe_adj_list \
+ hipe_temp_map \
+ hipe_optimistic_regalloc \
+ hipe_coalescing_regalloc \
+ hipe_graph_coloring_regalloc \
+ hipe_regalloc_loop \
+ hipe_ls_regalloc \
+ hipe_ppc_specific hipe_ppc_specific_fp \
+ hipe_sparc_specific hipe_sparc_specific_fp \
+ hipe_arm_specific \
+ hipe_x86_specific hipe_x86_specific_x87 \
+ hipe_amd64_specific hipe_amd64_specific_sse2 hipe_amd64_specific_x87
+
+HRL_FILES=
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars# +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+$(EBIN)/hipe_amd64_specific.beam: hipe_x86_specific.erl
+$(EBIN)/hipe_amd64_specific_x87.beam: hipe_x86_specific_x87.erl
+$(EBIN)/hipe_coalescing_regalloc.beam: ../main/hipe.hrl
+$(EBIN)/hipe_graph_coloring_regalloc.beam: ../main/hipe.hrl
+$(EBIN)/hipe_ig.beam: ../main/hipe.hrl ../flow/cfg.hrl hipe_spillcost.hrl
+$(EBIN)/hipe_ig_moves.beam: ../util/hipe_vectors.hrl
+$(EBIN)/hipe_ls_regalloc.beam: ../main/hipe.hrl
+$(EBIN)/hipe_optimistic_regalloc.beam: ../main/hipe.hrl
+$(EBIN)/hipe_regalloc_loop.beam: ../main/hipe.hrl
+$(EBIN)/hipe_spillcost.beam: hipe_spillcost.hrl
+$(EBIN)/hipe_temp_map.beam: ../main/hipe.hrl
diff --git a/lib/hipe/regalloc/hipe_adj_list.erl b/lib/hipe/regalloc/hipe_adj_list.erl
new file mode 100644
index 0000000000..b55b22cb22
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_adj_list.erl
@@ -0,0 +1,143 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_adj_list.erl
+%% Author : Andreas Wallin <d96awa@it.uu.se>
+%% Purpose : Keeps track of adjacency lists for the inference graph.
+%% Created : 18 Mar 2000 by Andreas Wallin <d96awa@it.uu.se>
+%%----------------------------------------------------------------------
+
+-module(hipe_adj_list).
+-author("Andreas Wallin").
+-export([new/1,
+ add_edge/3,
+ %% add_edges/3,
+ remove_edge/3,
+ %% remove_edges/3,
+ edges/2]).
+
+%%----------------------------------------------------------------------
+%% Function: new
+%%
+%% Description: Creates an empty structure for adjacency lists
+%%
+%% Parameters:
+%% Max_nodes -- Limit for node numbers
+%%
+%% Returns:
+%% Empty adj_list structure
+%%
+%%----------------------------------------------------------------------
+
+new(Max_nodes) ->
+ hipe_vectors:new(Max_nodes, []).
+
+%%----------------------------------------------------------------------
+%% Function: add_edges
+%%
+%% Description: Adds edges from a node to other nodes
+%%
+%% Parameters:
+%% U -- A node
+%% Vs -- Nodes to add edges to
+%% Adj_list -- Old adjacency lists
+%%
+%% Returns:
+%% An updated adj_list data-structure
+%%
+%%----------------------------------------------------------------------
+
+%%add_edges(_, [], Adj_list) -> Adj_list;
+%%add_edges(U, Vs, Adj_list) when is_list(Vs), is_integer(U) ->
+%% hipe_vectors:set(Adj_list, U, ordsets:union(Vs, hipe_vectors:get(Adj_list, U))).
+
+%%----------------------------------------------------------------------
+%% Function: add_edge
+%%
+%% Description: Creates an edge between two nodes
+%%
+%% Parameters:
+%% U -- A node
+%% V -- Another node
+%% Adj_list -- Old adjacency lists
+%%
+%% Returns:
+%% New adj_list data-structure with (U and V connected)
+%%
+%%----------------------------------------------------------------------
+
+add_edge(U, V, Adj_list) -> % PRE: U =/= V, not V \in adjList[U]
+ hipe_vectors:set(Adj_list, U,
+ [V | hipe_vectors:get(Adj_list, U)]).
+
+%%----------------------------------------------------------------------
+%% Function: remove_edges
+%%
+%% Description: Removes edges from a node to other nodes
+%%
+%% Parameters:
+%% U -- A node
+%% Vs -- Nodes to remove edges to
+%% Adj_list -- Old adjacency lists
+%%
+%% Returns:
+%% An updated adj_list data-structure
+%%
+%%----------------------------------------------------------------------
+
+%% remove_edges(_, [], Adj_list) -> Adj_list;
+remove_edges(U, Vs, Adj_list) when is_list(Vs), is_integer(U) ->
+ hipe_vectors:set(Adj_list, U, hipe_vectors:get(Adj_list, U) -- Vs).
+
+%%----------------------------------------------------------------------
+%% Function: remove_edge
+%%
+%% Description: Removes an edge between two nodes
+%%
+%% Parameters:
+%% U -- A node
+%% V -- Another node
+%% Adj_list -- Old adjacency lists
+%%
+%% Returns:
+%% New adjacency lists with (U and V not connected)
+%%
+%%----------------------------------------------------------------------
+
+remove_edge(U, U, Adj_list) -> Adj_list;
+remove_edge(U, V, Adj_list) when is_integer(U), is_integer(V) ->
+ remove_edges(U, [V], Adj_list).
+
+%%----------------------------------------------------------------------
+%% Function: edges
+%%
+%% Description: Tells where the edges of a node go
+%%
+%% Parameters:
+%% U -- A node
+%% Adj_list -- Adjacency lists
+%%
+%% Returns:
+%% The set of nodes connected to U
+%%
+%%----------------------------------------------------------------------
+
+edges(U, Adj_list) ->
+ hipe_vectors:get(Adj_list, U).
diff --git a/lib/hipe/regalloc/hipe_amd64_specific.erl b/lib/hipe/regalloc/hipe_amd64_specific.erl
new file mode 100644
index 0000000000..91a8c7253a
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_amd64_specific.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-define(HIPE_AMD64, true).
+-include("hipe_x86_specific.erl").
diff --git a/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl b/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl
new file mode 100644
index 0000000000..5654455b44
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl
@@ -0,0 +1,175 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_amd64_specific_sse2).
+
+-export([number_of_temporaries/1]).
+
+% The following exports are used as M:F(...) calls from other modules;
+%% e.g. hipe_amd64_ra_ls.
+-export([analyze/1,
+ bb/2,
+ args/1,
+ labels/1,
+ livein/2,
+ liveout/2,
+ uses/1,
+ defines/1,
+ def_use/1,
+ is_arg/1, %% used by hipe_ls_regalloc
+ is_move/1,
+ is_fixed/1, %% used by hipe_graph_coloring_regalloc
+ is_global/1,
+ is_precoloured/1,
+ reg_nr/1,
+ non_alloc/1,
+ allocatable/0,
+ physical_name/1,
+ all_precoloured/0,
+ new_spill_index/1, %% used by hipe_ls_regalloc
+ var_range/1,
+ breadthorder/1,
+ postorder/1,
+ reverse_postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+%%----------------------------------------------------------------------------
+
+-include("../flow/cfg.hrl").
+
+%%----------------------------------------------------------------------------
+
+defun_to_cfg(Defun) ->
+ hipe_x86_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ hipe_amd64_ra_sse2_postconditions:check_and_rewrite(Defun, Coloring).
+
+reverse_postorder(CFG) ->
+ hipe_x86_cfg:reverse_postorder(CFG).
+
+breadthorder(CFG) ->
+ hipe_x86_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_x86_cfg:postorder(CFG).
+
+is_global(_Reg) ->
+ false.
+
+is_fixed(_Reg) ->
+ false.
+
+is_arg(_Reg) ->
+ false.
+
+-spec args(#cfg{}) -> [].
+args(_CFG) ->
+ [].
+
+non_alloc(_) ->
+ [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ hipe_amd64_liveness:analyze(CFG).
+
+livein(Liveness, L) ->
+ [X || X <- hipe_amd64_liveness:livein(Liveness, L),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'].
+
+liveout(BB_in_out_liveness, Label) ->
+ [X || X <- hipe_amd64_liveness:liveout(BB_in_out_liveness, Label),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'].
+
+%% Registers stuff
+
+allocatable() ->
+ hipe_amd64_registers:allocatable_sse2().
+
+all_precoloured() ->
+ allocatable().
+
+is_precoloured(Reg) ->
+ lists:member(Reg,all_precoloured()).
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_x86_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(x86).
+
+-spec number_of_temporaries(#cfg{}) -> non_neg_integer().
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(x86),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG, L) ->
+ hipe_x86_cfg:bb(CFG, L).
+
+%% AMD64 stuff
+
+def_use(Instruction) ->
+ {[X || X <- hipe_amd64_defuse:insn_def(Instruction),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'],
+ [X || X <- hipe_amd64_defuse:insn_use(Instruction),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double']
+ }.
+
+uses(I) ->
+ [X || X <- hipe_amd64_defuse:insn_use(I),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'].
+
+defines(I) ->
+ [X || X <- hipe_amd64_defuse:insn_def(I),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'].
+
+is_move(Instruction) ->
+ case hipe_x86:is_fmove(Instruction) of
+ true ->
+ Src = hipe_x86:fmove_src(Instruction),
+ Dst = hipe_x86:fmove_dst(Instruction),
+ hipe_x86:is_temp(Src) andalso hipe_x86:temp_is_allocatable(Src)
+ andalso hipe_x86:is_temp(Dst) andalso hipe_x86:temp_is_allocatable(Dst);
+ false -> false
+ end.
+
+reg_nr(Reg) ->
+ hipe_x86:temp_reg(Reg).
+
+-spec new_spill_index(non_neg_integer()) -> pos_integer().
+new_spill_index(SpillIndex) when is_integer(SpillIndex) ->
+ SpillIndex + 1.
diff --git a/lib/hipe/regalloc/hipe_amd64_specific_x87.erl b/lib/hipe/regalloc/hipe_amd64_specific_x87.erl
new file mode 100644
index 0000000000..b5e8253ae1
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_amd64_specific_x87.erl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-define(HIPE_AMD64, true).
+-include("hipe_x86_specific_x87.erl").
diff --git a/lib/hipe/regalloc/hipe_arm_specific.erl b/lib/hipe/regalloc/hipe_arm_specific.erl
new file mode 100644
index 0000000000..246095e926
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_arm_specific.erl
@@ -0,0 +1,168 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_arm_specific).
+
+%% for hipe_coalescing_regalloc:
+-export([number_of_temporaries/1
+ ,analyze/1
+ ,labels/1
+ ,all_precoloured/0
+ ,bb/2
+ ,liveout/2
+ ,reg_nr/1
+ ,def_use/1
+ ,is_move/1
+ ,is_precoloured/1
+ ,var_range/1
+ ,allocatable/0
+ ,non_alloc/1
+ ,physical_name/1
+ ,reverse_postorder/1
+ ,livein/2
+ ,uses/1
+ ,defines/1
+ ]).
+
+%% for hipe_graph_coloring_regalloc:
+-export([is_fixed/1]).
+
+%% for hipe_ls_regalloc:
+-export([args/1, is_arg/1, is_global/1, new_spill_index/1]).
+-export([breadthorder/1, postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+defun_to_cfg(Defun) ->
+ hipe_arm_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ hipe_arm_ra_postconditions:check_and_rewrite(Defun, Coloring, 'normal').
+
+reverse_postorder(CFG) ->
+ hipe_arm_cfg:reverse_postorder(CFG).
+
+non_alloc(CFG) ->
+ non_alloc(hipe_arm_registers:nr_args(), hipe_arm_cfg:params(CFG)).
+
+%% same as hipe_arm_frame:fix_formals/2
+non_alloc(0, Rest) -> Rest;
+non_alloc(N, [_|Rest]) -> non_alloc(N-1, Rest);
+non_alloc(_, []) -> [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ hipe_arm_liveness_gpr:analyse(CFG).
+
+livein(Liveness,L) ->
+ [X || X <- hipe_arm_liveness_gpr:livein(Liveness,L),
+ hipe_arm:temp_is_allocatable(X)].
+
+liveout(BB_in_out_liveness,Label) ->
+ [X || X <- hipe_arm_liveness_gpr:liveout(BB_in_out_liveness,Label),
+ hipe_arm:temp_is_allocatable(X)].
+
+%% Registers stuff
+
+allocatable() ->
+ hipe_arm_registers:allocatable_gpr().
+
+all_precoloured() ->
+ hipe_arm_registers:all_precoloured().
+
+is_precoloured(Reg) ->
+ hipe_arm_registers:is_precoloured_gpr(Reg).
+
+is_fixed(R) ->
+ hipe_arm_registers:is_fixed(R).
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_arm_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(arm).
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(arm),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG,L) ->
+ hipe_arm_cfg:bb(CFG,L).
+
+%% ARM stuff
+
+def_use(Instruction) ->
+ {defines(Instruction), uses(Instruction)}.
+
+uses(I) ->
+ [X || X <- hipe_arm_defuse:insn_use_gpr(I),
+ hipe_arm:temp_is_allocatable(X)].
+
+defines(I) ->
+ [X || X <- hipe_arm_defuse:insn_def_gpr(I),
+ hipe_arm:temp_is_allocatable(X)].
+
+is_move(Instruction) ->
+ case hipe_arm:is_pseudo_move(Instruction) of
+ true ->
+ Dst = hipe_arm:pseudo_move_dst(Instruction),
+ case hipe_arm:temp_is_allocatable(Dst) of
+ false -> false;
+ _ ->
+ Src = hipe_arm:pseudo_move_src(Instruction),
+ hipe_arm:temp_is_allocatable(Src)
+ end;
+ false -> false
+ end.
+
+reg_nr(Reg) ->
+ hipe_arm:temp_reg(Reg).
+
+%%% Linear Scan stuff
+
+new_spill_index(SpillIndex) when is_integer(SpillIndex) ->
+ SpillIndex+1.
+
+breadthorder(CFG) ->
+ hipe_arm_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_arm_cfg:postorder(CFG).
+
+is_global(R) ->
+ R =:= hipe_arm_registers:temp1() orelse
+ R =:= hipe_arm_registers:temp2() orelse
+ R =:= hipe_arm_registers:temp3() orelse
+ hipe_arm_registers:is_fixed(R).
+
+is_arg(R) ->
+ hipe_arm_registers:is_arg(R).
+
+args(CFG) ->
+ hipe_arm_registers:args(hipe_arm_cfg:arity(CFG)).
diff --git a/lib/hipe/regalloc/hipe_coalescing_regalloc.erl b/lib/hipe/regalloc/hipe_coalescing_regalloc.erl
new file mode 100644
index 0000000000..5a4b017c71
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_coalescing_regalloc.erl
@@ -0,0 +1,1029 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------
+%% File : hipe_coalescing_regalloc.erl
+%% Authors : Andreas Wallin <d96awa@it.uu.se>
+%% Thorild Sel�n <d95ths@.it.uu.se>
+%% Ingemar �berg <d95ina@it.uu.se>
+%% Purpose : Play paintball with registers on a target machine. We win
+%% if they are all colored. This is an iterated coalescing
+%% register allocator.
+%% Created : 4 Mar 2000
+%%-----------------------------------------------------------------------
+
+-module(hipe_coalescing_regalloc).
+-export([regalloc/5]).
+
+%%-ifndef(DEBUG).
+%%-define(DEBUG,true).
+%%-endif.
+-include("../main/hipe.hrl").
+
+%%-----------------------------------------------------------------------
+%% Function: regalloc
+%%
+%% Description: Creates a K coloring for a function.
+%% Parameters:
+%% CFG -- A control flow graph
+%% SpillIndex -- Last index of spill variable
+%% SpillLimit -- Temporaries with numbers higher than this have
+%% infinite spill cost.
+%% Consider changing this to a set.
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% Coloring -- A coloring for specified CFG
+%% SpillIndex0 -- A new spill index
+%%-----------------------------------------------------------------------
+
+regalloc(CFG, SpillIndex, SpillLimit, Target, _Options) ->
+ %% Build interference graph
+ ?debug_msg("Build IG\n", []),
+ IG = hipe_ig:build(CFG, Target),
+ %% io:format("IG: ~p\n", [IG]),
+
+ ?debug_msg("Init\n", []),
+ Num_Temps = Target:number_of_temporaries(CFG),
+ ?debug_msg("Coalescing RA: num_temps = ~p~n", [Num_Temps]),
+ Allocatable = Target:allocatable(),
+ K = length(Allocatable),
+ All_colors = colset_from_list(Allocatable),
+
+ %% Add registers with their own coloring
+ ?debug_msg("Moves\n", []),
+ Move_sets = hipe_moves:new(IG),
+
+ ?debug_msg("Build Worklist\n", []),
+ Worklists = hipe_reg_worklists:new(IG, Target, CFG, Move_sets, K, Num_Temps),
+ Alias = initAlias(Num_Temps),
+
+ ?debug_msg("Do coloring\n~p~n", [Worklists]),
+ {_IG0, Worklists0, _Moves0, Alias0} =
+ do_coloring(IG, Worklists, Move_sets, Alias, K, SpillLimit, Target),
+ %% io:format("SelStk0 ~w\n",[SelStk0]),
+ ?debug_msg("Init node sets\n", []),
+ Node_sets = hipe_node_sets:new(),
+ %% io:format("NodeSet: ~w\n NonAlloc ~w\n",[Node_sets,Target:non_alloc(CFG)]),
+ ?debug_msg("Default coloring\n", []),
+ {Color0,Node_sets1} =
+ defaultColoring(Target:all_precoloured(),
+ initColor(Num_Temps), Node_sets, Target),
+
+ ?debug_msg("Assign colors\n", []),
+ {Color1,Node_sets2} =
+ assignColors(hipe_reg_worklists:stack(Worklists0), Node_sets1, Color0,
+ Alias0, All_colors, Target),
+ %% io:format("color0:~w\nColor1:~w\nNodes:~w\nNodes2:~w\nNum_Temps:~w\n",[Color0,Color1,Node_sets,Node_sets2,Num_Temps]),
+
+ ?debug_msg("Build mapping ~p\n", [Node_sets2]),
+ Coloring = build_namelist(Node_sets2, SpillIndex, Alias0, Color1),
+ ?debug_msg("Coloring ~p\n", [Coloring]),
+ Coloring.
+
+%%----------------------------------------------------------------------
+%% Function: do_coloring
+%%
+%% Description: Create a coloring. That is, play paintball.
+%% Parameters:
+%% IG -- An interference graph
+%% Worklists -- Worklists, that is simplify, spill and freeze
+%% Moves -- Moves sets, that is coalesced, constrained
+%% and so on.
+%% Alias -- Tells if two temporaries can have their value
+%% in the same register.
+%% K -- Want to create a K coloring.
+%% SpillLimit -- Try not to spill nodes that are above the spill limit.
+%%
+%% Returns:
+%% IG -- Updated interference graph
+%% Worklists -- Updated Worklists structure
+%% Moves -- Updated Moves structure
+%% Alias -- Updates Alias structure
+%%
+%%----------------------------------------------------------------------
+
+do_coloring(IG, Worklists, Moves, Alias, K, SpillLimit, Target) ->
+ Simplify = not(hipe_reg_worklists:is_empty_simplify(Worklists)),
+ Coalesce = not(hipe_moves:is_empty_worklist(Moves)),
+ Freeze = not(hipe_reg_worklists:is_empty_freeze(Worklists)),
+ Spill = not(hipe_reg_worklists:is_empty_spill(Worklists)),
+ if Simplify =:= true ->
+ {IG0, Worklists0, Moves0} =
+ simplify(hipe_reg_worklists:simplify(Worklists),
+ IG,
+ Worklists,
+ Moves,
+ K),
+ do_coloring(IG0, Worklists0, Moves0, Alias, K, SpillLimit, Target);
+ Coalesce =:= true ->
+ {Moves0, IG0, Worklists0, Alias0} =
+ coalesce(Moves, IG, Worklists, Alias, K, Target),
+ do_coloring(IG0, Worklists0, Moves0, Alias0, K, SpillLimit, Target);
+ Freeze =:= true ->
+ {Worklists0,Moves0} =
+ freeze(K, Worklists, Moves, IG, Alias),
+ do_coloring(IG, Worklists0, Moves0, Alias,
+ K, SpillLimit, Target);
+ Spill =:= true ->
+ {Worklists0, Moves0} =
+ selectSpill(Worklists, Moves, IG, K, Alias, SpillLimit),
+ do_coloring(IG, Worklists0, Moves0, Alias, K, SpillLimit, Target);
+ true -> % Catchall case
+ {IG, Worklists, Moves, Alias}
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: adjacent
+%%
+%% Description: Adjacent nodes that's not coalesced, on the stack or
+%% precoloured.
+%% Parameters:
+%% Node -- Node that you want to adjacents of
+%% IG -- The interference graph
+%%
+%% Returns:
+%% A set with nodes/temporaries that are not coalesced, on the
+%% stack or precoloured.
+%%----------------------------------------------------------------------
+
+adjacent(Node, IG, Worklists) ->
+ Adjacent_edges = hipe_ig:node_adj_list(Node, IG),
+ hipe_reg_worklists:non_stacked_or_coalesced_nodes(Adjacent_edges, Worklists).
+
+%%----------------------------------------------------------------------
+%% Function: simplify
+%%
+%% Description: Simplify graph by removing nodes of low degree. This
+%% function simplifies all nodes it can at once.
+%% Parameters:
+%% [Node|Nodes] -- The simplify worklist
+%% IG -- The interference graph
+%% Worklists -- The worklists data-structure
+%% Moves -- The moves data-structure
+%% K -- Produce a K coloring
+%%
+%% Returns:
+%% IG -- An updated interference graph
+%% Worklists -- An updated worklists data-structure
+%% Moves -- An updated moves data-structure
+%%----------------------------------------------------------------------
+
+simplify([], IG, Worklists, Moves, _K) ->
+ {IG, Worklists, Moves};
+simplify([Node|Nodes], IG, Worklists, Moves, K) ->
+ Worklists0 = hipe_reg_worklists:remove_simplify(Node, Worklists),
+ ?debug_msg("putting ~w on stack~n",[Node]),
+ Adjacent = adjacent(Node, IG, Worklists0),
+ Worklists01 = hipe_reg_worklists:push_stack(Node, Adjacent, Worklists0),
+ {New_ig, Worklists1, New_moves} =
+ decrement_degree(Adjacent, IG, Worklists01, Moves, K),
+ simplify(Nodes, New_ig, Worklists1, New_moves, K).
+
+%%----------------------------------------------------------------------
+%% Function: decrement_degree
+%%
+%% Description: Decrement the degree on a number of nodes/temporaries.
+%% Parameters:
+%% [Node|Nodes] -- Decrement degree on these nodes
+%% IG -- The interference graph
+%% Worklists -- The Worklists data structure
+%% Moves -- The Moves data structure.
+%% K -- We want to create a coloring with K colors
+%%
+%% Returns:
+%% IG -- An updated interference graph (the degrees)
+%% Worklists -- Updated Worklists. Changed if one degree goes
+%% down to K.
+%% Moves -- Updated Moves. Changed if a move related temporary
+%% gets degree K.
+%%----------------------------------------------------------------------
+
+decrement_degree([], IG, Worklists, Moves, _K) ->
+ {IG, Worklists, Moves};
+decrement_degree([Node|Nodes], IG, Worklists, Moves, K) ->
+ PrevDegree = hipe_ig:get_node_degree(Node, IG),
+ IG0 = hipe_ig:dec_node_degree(Node, IG),
+ if PrevDegree =:= K ->
+ AdjList = hipe_ig:node_adj_list(Node, IG0),
+ %% Ok since Node (a) is still in IG, and (b) cannot be adjacent to itself
+ Moves00 = enable_moves_active_to_worklist(hipe_moves:node_movelist(Node, Moves),
+ Moves),
+ Moves0 = enable_moves(AdjList, Worklists, Moves00),
+ Worklists0 = hipe_reg_worklists:remove_spill(Node, Worklists),
+ case hipe_moves:move_related(Node, Moves0) of
+ true ->
+ Worklists1 = hipe_reg_worklists:add_freeze(Node, Worklists0),
+ decrement_degree(Nodes, IG0, Worklists1, Moves0, K);
+ _ ->
+ Worklists1 = hipe_reg_worklists:add_simplify(Node, Worklists0),
+ decrement_degree(Nodes, IG0, Worklists1, Moves0, K)
+ end;
+ true ->
+ decrement_degree(Nodes, IG0, Worklists, Moves, K)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: enable_moves
+%%
+%% Description: Make (move-related) nodes that are not yet considered for
+%% coalescing, ready for possible coalescing.
+%%
+%% Parameters:
+%% [Node|Nodes] -- A list of move nodes
+%% Moves -- The moves data-structure
+%%
+%% Returns:
+%% An updated moves data-structure
+%%----------------------------------------------------------------------
+
+enable_moves([], _Worklists, Moves) -> Moves;
+enable_moves([Node|Nodes], Worklists, Moves) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(Node, Worklists) of
+ true -> enable_moves(Nodes, Worklists, Moves);
+ _ ->
+ %% moveList[n] suffices since we're checking for activeMoves membership
+ Node_moves = hipe_moves:node_movelist(Node, Moves),
+ New_moves = enable_moves_active_to_worklist(Node_moves, Moves),
+ enable_moves(Nodes, Worklists, New_moves)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: enable_moves_active_to_worklist
+%%
+%% Description: Make (move-related) nodes that are not yet considered for
+%% coalescing, ready for possible coalescing.
+%%
+%% Parameters:
+%% [Node|Nodes] -- A list of move nodes
+%% Moves -- The moves data structure
+%%
+%% Returns:
+%% An updated moves data structure
+%%----------------------------------------------------------------------
+
+enable_moves_active_to_worklist([], Moves) -> Moves;
+enable_moves_active_to_worklist([Node|Nodes], Moves) ->
+ NewMoves =
+ case hipe_moves:member_active(Node, Moves) of
+ true ->
+ hipe_moves:add_worklist(Node, hipe_moves:remove_active(Node, Moves));
+ _ ->
+ Moves
+ end,
+ enable_moves_active_to_worklist(Nodes, NewMoves).
+
+%% Build the namelists, these functions are fast hacks, they use knowledge
+%% about data representation that they shouldn't know, bad abstraction.
+
+build_namelist(NodeSets, Index, Alias, Color) ->
+ ?debug_msg("Building mapping\n",[]),
+ ?debug_msg("Vector to list\n",[]),
+ AliasList = build_alias_list(aliasToList(Alias),
+ 0, %% The first temporary has index 0
+ []), %% Accumulator
+ ?debug_msg("Alias list:~p\n",[AliasList]),
+ ?debug_msg("Coalesced\n",[]),
+ NL1 = build_coalescedlist(AliasList, Color, Alias, []),
+ ?debug_msg("Coalesced list:~p\n",[NL1]),
+ ?debug_msg("Regs\n",[]),
+ NL2 = build_reglist(hipe_node_sets:colored(NodeSets), Color, NL1),
+ ?debug_msg("Regs list:~p\n",[NL2]),
+ ?debug_msg("Spills\n",[]),
+ build_spillist(hipe_node_sets:spilled(NodeSets), Index, NL2).
+
+build_spillist([], Index, List) ->
+ {List,Index};
+build_spillist([Node|Nodes], Index, List) ->
+ ?debug_msg("[~p]: Spill ~p to ~p\n", [?MODULE,Node,Index]),
+ build_spillist(Nodes, Index+1, [{Node,{spill,Index}}|List]).
+
+build_coalescedlist([], _Color, _Alias, List) ->
+ List;
+build_coalescedlist([Node|Ns], Color, Alias, List) when is_integer(Node) ->
+ ?debug_msg("Alias of ~p is ~p~n", [Node, getAlias(Node,Alias)]),
+ AC = getColor(getAlias(Node, Alias), Color),
+ build_coalescedlist(Ns, Color, Alias, [{Node,{reg,AC}}|List]).
+
+build_reglist([], _Color, List) ->
+ List;
+build_reglist([Node|Ns], Color, List) ->
+ build_reglist(Ns, Color, [{Node,{reg,getColor(Node,Color)}}|List]).
+
+build_alias_list([], _I, List) ->
+ List;
+build_alias_list([Alias|Aliases], I, List) when is_integer(Alias) ->
+ build_alias_list(Aliases, I+1, [I|List]);
+build_alias_list([_Alias|Aliases], I, List) ->
+ build_alias_list(Aliases, I+1, List).
+
+%%----------------------------------------------------------------------
+%% Function: assignColors
+%%
+%% Description: Tries to assign colors to nodes in a stack.
+%% Parameters:
+%% Stack -- The SelectStack built by the Select function,
+%% this stack contains tuples in the form {Node,Edges}
+%% where Node is the Node number and Edges is an ordset
+%% containing the numbers of all the adjacent nodes.
+%% NodeSets -- This is a record containing all the different node
+%% sets that are used in the register allocator.
+%% Alias -- This is a mapping from nodes to nodes, if a node has
+%% been coalesced this mapping shows the alias for that
+%% node.
+%% AllColors -- This is an ordset containing all the available colors
+%%
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% Color -- A mapping from nodes to their respective color.
+%% NodeSets -- The updated node sets.
+%%----------------------------------------------------------------------
+
+assignColors(Stack, NodeSets, Color, Alias, AllColors, Target) ->
+ case Stack of
+ [] ->
+ {Color,NodeSets};
+ [{Node,Edges}|Stack1] ->
+ ?debug_msg("Coloring Node: ~p~n",[Node]),
+ ?IF_DEBUG(lists:foreach(fun (_E) ->
+ ?msg(" Edge ~w-><~w>->~w~n",
+ begin A = getAlias(_E,Alias),
+ [_E,A,getColor(A,Color)]
+ end)
+ end, Edges),
+ []),
+ %% When debugging, check that Node isn't precoloured.
+ OkColors = findOkColors(Edges, AllColors, Color, Alias),
+ case colset_is_empty(OkColors) of
+ true -> % Spill case
+ NodeSets1 = hipe_node_sets:add_spilled(Node, NodeSets),
+ assignColors(Stack1, NodeSets1, Color, Alias, AllColors, Target);
+ false -> % Colour case
+ Col = colset_smallest(OkColors),
+ NodeSets1 = hipe_node_sets:add_colored(Node, NodeSets),
+ Color1 = setColor(Node, Target:physical_name(Col), Color),
+ assignColors(Stack1, NodeSets1, Color1, Alias, AllColors, Target)
+ end
+ end.
+
+%%---------------------------------------------------------------------
+%% Function: defaultColoring
+%%
+%% Description: Make the default coloring
+%% Parameters:
+%% Regs -- The list of registers to be default colored
+%% Color -- The color mapping that shall be changed
+%% NodeSets -- The node sets that shall be updated
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% NewColor -- The updated color mapping
+%% NewNodeSets -- The updated node sets
+%%---------------------------------------------------------------------
+
+defaultColoring([], Color, NodeSets, _Target) ->
+ {Color,NodeSets};
+defaultColoring([Reg|Regs], Color, NodeSets, Target) ->
+ Color1 = setColor(Reg,Target:physical_name(Reg), Color),
+ NodeSets1 = hipe_node_sets:add_colored(Reg, NodeSets),
+ defaultColoring(Regs, Color1, NodeSets1, Target).
+
+%% Find the colors that are OK for a node with certain edges.
+
+findOkColors(Edges, AllColors, Color, Alias) ->
+ find(Edges, AllColors, Color, Alias).
+
+%% Find all the colors of the nodes in the list [Node|Nodes] and remove them
+%% from the set OkColors, when the list is empty, return OkColors.
+
+find([], OkColors, _Color, _Alias) ->
+ OkColors;
+find([Node0|Nodes], OkColors, Color, Alias) ->
+ Node = getAlias(Node0, Alias),
+ case getColor(Node, Color) of
+ [] ->
+ find(Nodes, OkColors, Color, Alias);
+ Col ->
+ OkColors1 = colset_del_element(Col, OkColors),
+ find(Nodes, OkColors1, Color, Alias)
+ end.
+
+%%%
+%%% ColSet -- ADT for the set of available colours while
+%%% assigning colours.
+%%%
+-ifdef(notdef). % old ordsets-based implementation
+colset_from_list(Allocatable) ->
+ ordsets:from_list(Allocatable).
+
+colset_del_element(Colour, ColSet) ->
+ ordsets:del_element(Colour, ColSet).
+
+colset_is_empty(ColSet) ->
+ case ColSet of
+ [] -> true;
+ [_|_] -> false
+ end.
+
+colset_smallest([Colour|_]) ->
+ Colour.
+-endif.
+
+-ifdef(notdef). % new gb_sets-based implementation
+colset_from_list(Allocatable) ->
+ gb_sets:from_list(Allocatable).
+
+colset_del_element(Colour, ColSet) ->
+ %% Must use gb_sets:delete_any/2 since gb_sets:del_element/2
+ %% fails if the element isn't present. Bummer.
+ gb_sets:delete_any(Colour, ColSet).
+
+colset_is_empty(ColSet) ->
+ gb_sets:is_empty(ColSet).
+
+colset_smallest(ColSet) ->
+ gb_sets:smallest(ColSet).
+-endif.
+
+%%-ifdef(notdef). % new bitmask-based implementation
+colset_from_list(Allocatable) ->
+ colset_from_list(Allocatable, 0).
+
+colset_from_list([], ColSet) ->
+ ColSet;
+colset_from_list([Colour|Allocatable], ColSet) ->
+ colset_from_list(Allocatable, ColSet bor (1 bsl Colour)).
+
+colset_del_element(Colour, ColSet) ->
+ ColSet band bnot(1 bsl Colour).
+
+colset_is_empty(0) -> true;
+colset_is_empty(_) -> false.
+
+colset_smallest(ColSet) ->
+ bitN_log2(ColSet band -ColSet, 0).
+
+bitN_log2(BitN, ShiftN) ->
+ if BitN > 16#ffff ->
+ bitN_log2(BitN bsr 16, ShiftN + 16);
+ true ->
+ ShiftN + hweight16(BitN - 1)
+ end.
+
+hweight16(W) ->
+ Res1 = ( W band 16#5555) + (( W bsr 1) band 16#5555),
+ Res2 = (Res1 band 16#3333) + ((Res1 bsr 2) band 16#3333),
+ Res3 = (Res2 band 16#0F0F) + ((Res2 bsr 4) band 16#0F0F),
+ (Res3 band 16#00FF) + ((Res3 bsr 8) band 16#00FF).
+%%-endif.
+
+%%%
+%%% Colour ADT providing a partial mapping from nodes to colours.
+%%%
+
+initColor(NrNodes) ->
+ {colmap, hipe_bifs:array(NrNodes, [])}.
+
+getColor(Node, {colmap, ColMap}) ->
+ hipe_bifs:array_sub(ColMap, Node).
+
+setColor(Node, Colour, {colmap, ColMap} = Col) ->
+ hipe_bifs:array_update(ColMap, Node, Colour),
+ Col.
+
+%%%
+%%% Alias ADT providing a partial mapping from nodes to nodes.
+%%%
+
+initAlias(NrNodes) ->
+ {alias, hipe_bifs:array(NrNodes, [])}.
+
+getAlias(Node, {alias, AliasMap} = Alias) ->
+ case hipe_bifs:array_sub(AliasMap, Node) of
+ [] ->
+ Node;
+ AliasNode ->
+ getAlias(AliasNode, Alias)
+ end.
+
+setAlias(Node, AliasNode, {alias, AliasMap} = Alias) ->
+ hipe_bifs:array_update(AliasMap, Node, AliasNode),
+ Alias.
+
+aliasToList({alias,AliasMap}) ->
+ aliasToList(AliasMap, hipe_bifs:array_length(AliasMap), []).
+
+aliasToList(AliasMap, I1, Tail) ->
+ I0 = I1 - 1,
+ if I0 >= 0 ->
+ aliasToList(AliasMap, I0, [hipe_bifs:array_sub(AliasMap, I0)|Tail]);
+ true ->
+ Tail
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: coalesce
+%%
+%% Description: Coalesces nodes in worklist
+%% Parameters:
+%% Moves -- Current move information
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Alias -- Current aliases for temporaries
+%% K -- Number of registers
+%%
+%% Returns:
+%% {Moves, IG, Worklists, Alias}
+%% (Updated versions of above structures, after coalescing)
+%%----------------------------------------------------------------------
+
+coalesce(Moves, IG, Worklists, Alias, K, Target) ->
+ case hipe_moves:worklist_get_and_remove(Moves) of
+ {[],Moves0} ->
+ %% Moves marked for removal from worklistMoves by FreezeMoves()
+ %% are removed by worklist_get_and_remove(). This case is unlikely,
+ %% but can occur if only stale moves remain in worklistMoves.
+ {Moves0,IG,Worklists,Alias};
+ {Move,Moves0} ->
+ {Dest,Source} = hipe_moves:get_move(Move, Moves0),
+ ?debug_msg("Testing nodes ~p and ~p for coalescing~n",[Dest,Source]),
+ Alias_src = getAlias(Source, Alias),
+ Alias_dst = getAlias(Dest, Alias),
+ {U,V} = case Target:is_precoloured(Alias_dst) of
+ true -> {Alias_dst, Alias_src};
+ false -> {Alias_src, Alias_dst}
+ end,
+ %% When debugging, check that neither V nor U is on the stack.
+ if U =:= V ->
+ Moves1 = Moves0, % drop coalesced move Move
+ Worklists1 = add_worklist(Worklists, U, K, Moves1, IG, Target),
+ {Moves1, IG, Worklists1, Alias};
+ true ->
+ case (Target:is_precoloured(V) orelse
+ hipe_ig:nodes_are_adjacent(U, V, IG)) of
+ true ->
+ Moves1 = Moves0, % drop constrained move Move
+ Worklists1 = add_worklist(Worklists, U, K, Moves1, IG, Target),
+ Worklists2 = add_worklist(Worklists1, V, K, Moves1, IG, Target),
+ {Moves1, IG, Worklists2, Alias};
+ false ->
+ case (case Target:is_precoloured(U) of
+ true ->
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ all_adjacent_ok(AdjV, U, Worklists, IG, K, Target);
+ false ->
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ AdjU = hipe_ig:node_adj_list(U, IG),
+ conservative(AdjU, AdjV, U, Worklists, IG, K)
+ end) of
+ true ->
+ Moves1 = Moves0, % drop coalesced move Move
+ {IG1,Worklists1,Moves2,Alias1} =
+ combine(U, V, IG, Worklists, Moves1, Alias, K, Target),
+ Worklists2 = add_worklist(Worklists1, U, K, Moves2, IG1, Target),
+ {Moves2, IG1, Worklists2, Alias1};
+ false ->
+ Moves1 = hipe_moves:add_active(Move, Moves0),
+ {Moves1, IG, Worklists, Alias}
+ end
+ end
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: add_worklist
+%%
+%% Description: Builds new worklists where U is transferred from freeze
+%% to simplify, if possible
+%%
+%% Parameters:
+%% Worklists -- Current worklists
+%% U -- Node to operate on
+%% K -- Number of registers
+%% Moves -- Current move information
+%% IG -- Interference graph
+%% Target -- The containing the target-specific functions
+%%
+%% Returns:
+%% Worklists (updated)
+%%----------------------------------------------------------------------
+
+add_worklist(Worklists, U, K, Moves, IG, Target) ->
+ case (not(Target:is_precoloured(U))
+ andalso not(hipe_moves:move_related(U, Moves))
+ andalso (hipe_ig:is_trivially_colourable(U, K, IG))) of
+ true ->
+ hipe_reg_worklists:transfer_freeze_simplify(U, Worklists);
+ false ->
+ Worklists
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: combine
+%%
+%% Description: Combines two nodes into one (used when coalescing)
+%%
+%% Parameters:
+%% U -- First node to operate on
+%% V -- Second node to operate on
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Moves -- Current move information
+%% Alias -- Current aliases for temporaries
+%% K -- Number of registers
+%%
+%% Returns:
+%% {IG, Worklists, Moves, Alias} (updated)
+%%----------------------------------------------------------------------
+
+combine(U, V, IG, Worklists, Moves, Alias, K, Target) ->
+ Worklists1 = case hipe_reg_worklists:member_freeze(V, Worklists) of
+ true -> hipe_reg_worklists:remove_freeze(V, Worklists);
+ false -> hipe_reg_worklists:remove_spill(V, Worklists)
+ end,
+ Worklists11 = hipe_reg_worklists:add_coalesced(V, Worklists1),
+
+ ?debug_msg("Coalescing ~p and ~p to ~p~n",[V,U,U]),
+
+ Alias1 = setAlias(V, U, Alias),
+
+ %% Typo in published algorithm: s/nodeMoves/moveList/g to fix.
+ %% XXX: moveList[u] \union moveList[v] OR NodeMoves(u) \union NodeMoves(v) ???
+ %% XXX: NodeMoves() is correct, but unnecessarily strict. The ordsets:union
+ %% constrains NodeMoves() to return an ordset.
+ Moves1 = hipe_moves:update_movelist(U,
+ ordsets:union(hipe_moves:node_moves(U, Moves),
+ hipe_moves:node_moves(V, Moves)),
+ Moves),
+ %% Missing in published algorithm. From Tiger book Errata.
+ Moves2 = enable_moves_active_to_worklist(hipe_moves:node_movelist(V, Moves1), Moves1),
+ AdjV = hipe_ig:node_adj_list(V, IG),
+
+ {IG1, Worklists2, Moves3} =
+ combine_edges(AdjV, U, IG, Worklists11, Moves2, K, Target),
+
+ New_worklists = case (not(hipe_ig:is_trivially_colourable(U, K, IG1))
+ andalso
+ hipe_reg_worklists:member_freeze(U, Worklists2)) of
+ true ->
+ hipe_reg_worklists:transfer_freeze_spill(U, Worklists2);
+ false -> Worklists2
+ end,
+ {IG1, New_worklists, Moves3, Alias1}.
+
+%%----------------------------------------------------------------------
+%% Function: combine_edges
+%%
+%% Description: For each node in a list, make an edge between that node
+%% and node U, and decrement its degree by 1
+%% (Used when two nodes are coalesced, to connect all nodes
+%% adjacent to one node to the other node)
+%%
+%% Parameters:
+%% [T|Ts] -- List of nodes to make edges to
+%% U -- Node to make edges from
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Moves -- Current move information
+%% K -- Number of registers
+%%
+%% Returns:
+%% {IG, Worklists, Moves} (updated)
+%%----------------------------------------------------------------------
+
+combine_edges([], _U, IG, Worklists, Moves, _K, _Target) ->
+ {IG, Worklists, Moves};
+combine_edges([T|Ts], U, IG, Worklists, Moves, K, Target) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(T, Worklists) of
+ true -> combine_edges(Ts, U, IG, Worklists, Moves, K, Target);
+ _ ->
+ %% XXX: The issue below occurs because the T->V edge isn't removed.
+ %% This causes adjList[T] to contain stale entries, to possibly grow
+ %% (if T isn't already adjacent to U), and degree[T] to possibly
+ %% increase (again, if T isn't already adjacent to U).
+ %% The decrement_degree() call repairs degree[T] but not adjList[T].
+ %% It would be better to physically replace T->V with T->U, and only
+ %% decrement_degree(T) if T->U already existed.
+ %%
+ %% add_edge() may change a low-degree move-related node to be of
+ %% significant degree. In this case the node belongs in the spill
+ %% worklist, and that's where decrement_degree() expects to find it.
+ %% This issue is not covered in the published algorithm.
+ OldDegree = hipe_ig:get_node_degree(T, IG),
+ IG1 = hipe_ig:add_edge(T, U, IG, Target),
+ NewDegree = hipe_ig:get_node_degree(T, IG1),
+ Worklists0 =
+ if NewDegree =:= K, OldDegree =:= K-1 ->
+ %% io:format("~w:combine_edges(): repairing worklist membership for node ~w\n", [?MODULE,T]),
+ %% The node T must be on the freeze worklist:
+ %% 1. Since we're coalescing, the simplify worklist must have been
+ %% empty when combine_edges() started.
+ %% 2. decrement_degree() may put the node T back on the simplify
+ %% worklist, but that occurs after the worklists repair step.
+ %% 3. There are no duplicates among the edges.
+ Worklists00 = hipe_reg_worklists:remove_freeze(T, Worklists),
+ hipe_reg_worklists:add_spill(T, Worklists00);
+ true ->
+ Worklists
+ end,
+ {IG2, Worklists1, Moves1} =
+ decrement_degree([T], IG1, Worklists0, Moves, K),
+ combine_edges(Ts, U, IG2, Worklists1, Moves1, K, Target)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: ok
+%%
+%% Description: Checks if a node T is suitable to coalesce with R
+%%
+%% Parameters:
+%% T -- Node to test
+%% R -- Other node to test
+%% IG -- Interference graph
+%% K -- Number of registers
+%% Target -- The module containing the target-specific functions
+%%
+%% Returns:
+%% true iff coalescing is OK
+%%----------------------------------------------------------------------
+
+ok(T, R, IG, K, Target) ->
+ ((hipe_ig:is_trivially_colourable(T, K, IG))
+ orelse Target:is_precoloured(T)
+ orelse hipe_ig:nodes_are_adjacent(T, R, IG)).
+
+%%----------------------------------------------------------------------
+%% Function: all_ok
+%%
+%% Description: True iff, for every T in the list, OK(T,U)
+%%
+%% Parameters:
+%% [T|Ts] -- Nodes to test
+%% U -- Node to test for coalescing
+%% IG -- Interference graph
+%% K -- Number of registers
+%% Target -- The module containing the target-specific functions
+%%
+%% Returns:
+%% true iff coalescing is OK for all nodes in the list
+%%----------------------------------------------------------------------
+
+all_adjacent_ok([], _U, _Worklists, _IG, _K, _Target) -> true;
+all_adjacent_ok([T|Ts], U, Worklists, IG, K, Target) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(T, Worklists) of
+ true -> all_adjacent_ok(Ts, U, Worklists, IG, K, Target);
+ _ ->
+ %% 'andalso' does not preserve tail-recursion
+ case ok(T, U, IG, K, Target) of
+ true -> all_adjacent_ok(Ts, U, Worklists, IG, K, Target);
+ false -> false
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: conservative
+%%
+%% Description: Checks if nodes can be safely coalesced according to
+%% the Briggs' conservative coalescing heuristic
+%%
+%% Parameters:
+%% Nodes -- Adjacent nodes
+%% IG -- Interference graph
+%% K -- Number of registers
+%%
+%% Returns:
+%% true iff coalescing is safe
+%%----------------------------------------------------------------------
+
+conservative(AdjU, AdjV, U, Worklists, IG, K) ->
+ conservative_countU(AdjU, AdjV, U, Worklists, IG, K, 0).
+
+%%----------------------------------------------------------------------
+%% Function: conservative_count
+%%
+%% Description: Counts degrees for conservative (Briggs' heuristic)
+%%
+%% Parameters:
+%% Nodes -- (Remaining) adjacent nodes
+%% IG -- Interference graph
+%% K -- Number of registers
+%% Cnt -- Accumulator for counting
+%%
+%% Returns:
+%% Final value of accumulator
+%%----------------------------------------------------------------------
+
+conservative_countU([], AdjV, U, Worklists, IG, K, Cnt) ->
+ conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+conservative_countU([Node|AdjU], AdjV, U, Worklists, IG, K, Cnt) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(Node, Worklists) of
+ true -> conservative_countU(AdjU, AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ case hipe_ig:is_trivially_colourable(Node, K, IG) of
+ true -> conservative_countU(AdjU, AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ Cnt1 = Cnt + 1,
+ if Cnt1 < K ->
+ conservative_countU(AdjU, AdjV, U, Worklists, IG, K, Cnt1);
+ true -> false
+ end
+ end
+ end.
+
+conservative_countV([], _U, _Worklists, _IG, _K, _Cnt) -> true;
+conservative_countV([Node|AdjV], U, Worklists, IG, K, Cnt) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(Node, Worklists) of
+ true -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ case hipe_ig:nodes_are_adjacent(Node, U, IG) of
+ true -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ case hipe_ig:is_trivially_colourable(Node, K, IG) of
+ true -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ Cnt1 = Cnt + 1,
+ if Cnt1 < K ->
+ conservative_countV(AdjV, U, Worklists, IG, K, Cnt1);
+ true -> false
+ end
+ end
+ end
+ end.
+
+%%---------------------------------------------------------------------
+%% Function: selectSpill
+%%
+%% Description: Select the node to spill and spill it
+%% Parameters:
+%% WorkLists -- A datatype containing the different worklists
+%% Moves -- A datatype containing the move sets
+%% IG -- The interference graph
+%% K -- The number of available registers
+%% Alias -- The alias mapping
+%% SpillLimit -- Try not to spill any nodes above the spill limit
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%% Moves -- The updated moves
+%%---------------------------------------------------------------------
+
+selectSpill(WorkLists, Moves, IG, K, Alias, SpillLimit) ->
+ [CAR|CDR] = hipe_reg_worklists:spill(WorkLists),
+
+ SpillCost = getCost(CAR, IG, SpillLimit),
+ M = findCheapest(CDR, IG, SpillCost, CAR, SpillLimit),
+
+ WorkLists1 = hipe_reg_worklists:remove_spill(M, WorkLists),
+ %% The published algorithm adds M to the simplify worklist
+ %% before the freezeMoves() call. That breaks the worklist
+ %% invariants, which is why the order is switched here.
+ {WorkLists2,Moves1} = freezeMoves(M, K, WorkLists1, Moves, IG, Alias),
+ WorkLists3 = hipe_reg_worklists:add_simplify(M, WorkLists2),
+ {WorkLists3,Moves1}.
+
+%% Find the node that is cheapest to spill
+
+findCheapest([], _IG, _Cost, Cheapest, _SpillLimit) ->
+ Cheapest;
+findCheapest([Node|Nodes], IG, Cost, Cheapest, SpillLimit) ->
+ ThisCost = getCost(Node, IG, SpillLimit),
+ case ThisCost < Cost of
+ true ->
+ findCheapest(Nodes, IG, ThisCost, Node, SpillLimit);
+ false ->
+ findCheapest(Nodes, IG, Cost, Cheapest, SpillLimit)
+ end.
+
+%% Get the cost for spilling a certain node, node numbers above the spill
+%% limit are extremely expensive.
+
+getCost(Node, IG, SpillLimit) ->
+ case Node > SpillLimit of
+ true -> inf;
+ false -> hipe_ig:node_spill_cost(Node, IG)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: freeze
+%%
+%% Description: When both simplifying and coalescing is impossible we
+%% rather freezes a node in stead of spilling, this function
+%% selects a node for freezing (it just picks the first one in
+%% the list)
+%%
+%% Parameters:
+%% K -- The number of available registers
+%% WorkLists -- A datatype containing the different worklists
+%% Moves -- A datatype containing the different movelists
+%% IG -- Interference graph
+%% Alias -- An alias mapping, shows the alias of all coalesced
+%% nodes
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%% Moves -- The updated movelists
+%%----------------------------------------------------------------------
+
+freeze(K, WorkLists, Moves, IG, Alias) ->
+ [U|_] = hipe_reg_worklists:freeze(WorkLists), % Smarter routine?
+ ?debug_msg("freezing node ~p~n", [U]),
+ WorkLists0 = hipe_reg_worklists:remove_freeze(U, WorkLists),
+ %% The published algorithm adds U to the simplify worklist
+ %% before the freezeMoves() call. That breaks the worklist
+ %% invariants, which is why the order is switched here.
+ {WorkLists1,Moves1} = freezeMoves(U,K,WorkLists0,Moves,IG,Alias),
+ WorkLists2 = hipe_reg_worklists:add_simplify(U, WorkLists1),
+ {WorkLists2,Moves1}.
+
+%%----------------------------------------------------------------------
+%% Function: freezeMoves
+%%
+%% Description: Make all move related interferences for a certain node
+%% into ordinary interference arcs.
+%%
+%% Parameters:
+%% U -- The node we want to freeze
+%% K -- The number of available registers
+%% WorkLists -- A datatype containing the different worklists
+%% Moves -- A datatype containing the different movelists
+%% IG -- Interference graph
+%% Alias -- An alias mapping, shows the alias of all coalesced
+%% nodes
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%% Moves -- The updated movelists
+%%----------------------------------------------------------------------
+
+freezeMoves(U, K, WorkLists, Moves, IG, Alias) ->
+ Nodes = hipe_moves:node_moves(U, Moves),
+ freezeEm(U, Nodes, K, WorkLists, Moves, IG, Alias).
+
+%% Find what the other value in a copy instruction is, return false if
+%% the instruction isn't a move with the first argument in it.
+
+moves(U, Move, Alias, Moves) ->
+ {X,Y} = hipe_moves:get_move(Move, Moves),
+ %% The old code (which followed the published algorithm) did
+ %% not follow aliases before looking for "the other" node.
+ %% This caused moves() to skip some moves, making some nodes
+ %% still move-related after freezeMoves(). These move-related
+ %% nodes were then added to the simplify worklist (by freeze()
+ %% or selectSpill()), breaking the worklist invariants. Nodes
+ %% already simplified appeared in coalesce(), were re-added to
+ %% the simplify worklist by add_worklist(), simplified again,
+ %% and coloured multiple times by assignColors(). Ouch!
+ X1 = getAlias(X, Alias),
+ Y1 = getAlias(Y, Alias),
+ if U =:= X1 -> Y1;
+ U =:= Y1 -> X1;
+ true -> exit({?MODULE,moves}) % XXX: shouldn't happen
+ end.
+
+freezeEm(_U, [], _K, WorkLists, Moves, _IG, _Alias) ->
+ {WorkLists,Moves};
+freezeEm(U,[M|Ms], K, WorkLists, Moves, IG, Alias) ->
+ V = moves(U, M, Alias, Moves),
+ {WorkLists2,Moves2} = freezeEm2(U, V, M, K, WorkLists, Moves, IG, Alias),
+ freezeEm(U, Ms, K, WorkLists2, Moves2, IG, Alias).
+
+freezeEm2(U, V, M, K, WorkLists, Moves, IG, Alias) ->
+ case hipe_moves:member_active(M, Moves) of
+ true ->
+ Moves1 = hipe_moves:remove_active(M, Moves),
+ freezeEm3(U, V, M, K, WorkLists, Moves1, IG, Alias);
+ false ->
+ Moves1 = hipe_moves:remove_worklist(M, Moves),
+ freezeEm3(U, V, M, K, WorkLists, Moves1, IG, Alias)
+ end.
+
+freezeEm3(_U, V, _M, K, WorkLists, Moves, IG, _Alias) ->
+ Moves1 = Moves, % drop frozen move M
+ V1 = V, % getAlias(V,Alias),
+ %% "not MoveRelated(v)" is cheaper than "NodeMoves(v) = {}"
+ case ((not hipe_moves:move_related(V1, Moves1)) andalso
+ hipe_ig:is_trivially_colourable(V1, K, IG)) of
+ true ->
+ ?debug_msg("freezing move to ~p~n", [V]),
+ Worklists1 = hipe_reg_worklists:transfer_freeze_simplify(V1, WorkLists),
+ {Worklists1, Moves1};
+ false ->
+ {WorkLists, Moves1}
+ end.
diff --git a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl
new file mode 100644
index 0000000000..ac555b933c
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl
@@ -0,0 +1,806 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%@doc
+%% GRAPH COLORING REGISTER ALLOCATOR
+%%
+%% A simple graph coloring register allocator:
+%%
+%% - build interference graph + estimate spill costs
+%% - simplify graph (push on stack + spill)
+%% - select colors
+%%
+%% Emits a coloring: a list of {TempName,Location}
+%% where Location is {reg,N} or {spill,M}
+%% and {reg,N} denotes some register N
+%% and {spill,M} denotes the Mth spilled node
+%% You have to figure out how to rewrite the code yourself.
+%%
+%% This version uses vectors rather than hash tables, and uses
+%% faster algorithms since all vars are known at the start.
+%% The result should be considerably quicker than earlier versions.
+%%
+%% Deficiencies:
+%% - no renaming (to reduce unnecessary register pressure)
+%% - spill costs are naive (should use better; e.g., exec.estimates)
+%% - no biased coloring (which coalesces moves)
+%% - no live range splitting (possibly not critical)
+%%
+%% *** NOTE ***
+%% Uses apply for target specific functions, takes the module name as
+%% argument. This target specific module should implement all target
+%% specific functions, see the end of the file.
+%%
+
+-module(hipe_graph_coloring_regalloc).
+-export([regalloc/5]).
+
+%%-ifndef(DO_ASSERT).
+%%-define(DO_ASSERT, true).
+%%-endif.
+
+%%-ifndef(DEBUG).
+%%-define(DEBUG,0).
+%%-endif.
+-include("../main/hipe.hrl").
+
+%% Define these as 'ok' or 'report(X,Y)' depending on how much output you want.
+-define(report0(X,Y), ?IF_DEBUG_LEVEL(0,?msg(X, Y),ok)).
+-define(report(X,Y), ?IF_DEBUG_LEVEL(1,?msg(X, Y),ok)).
+-define(report2(X,Y), ?IF_DEBUG_LEVEL(2,?msg(X, Y),ok)).
+-define(report3(X,Y), ?IF_DEBUG_LEVEL(3,?msg(X, Y),ok)).
+
+%% Given CFG and number of colors K, produce a coloring list
+%% of items {reg,N} (0 =< N =< K) and {spill,M}, where M is
+%% an index denoting 'a location'.
+%% (You might use it as a stack index, perhaps.)
+%%
+%% You can in principle delete check_coloring/2; it merely checks
+%% that the coloring agrees with the interference graph (that is, that
+%% no neighbors have the same register or spill location).
+
+%% @spec regalloc(#cfg{}, non_neg_fixnum(), non_neg_fixnum(), atom(), list()) -> {, non_neg_fixnum()}
+
+regalloc(CFG, SpillIndex, SpillLimit, Target, _Options) ->
+ PhysRegs = Target:allocatable(),
+ ?report2("building IG~n", []),
+ {IG, Spill} = build_ig(CFG, Target),
+
+ %% check_ig(IG),
+ ?report3("graph: ~p~nphysical regs: ~p~n", [list_ig(IG), PhysRegs]),
+
+ %% These nodes *can't* be allocated to registers.
+ NotAllocatable = [Target:reg_nr(X) || X <- Target:non_alloc(CFG)],
+ %% i.e. Arguments on x86
+ ?report2("Nonalloc ~w~n", [NotAllocatable]),
+
+ {Cols, NewSpillIndex} =
+ color(IG, Spill,
+ ordsets:from_list(PhysRegs),
+ SpillIndex,
+ SpillLimit,
+ Target:number_of_temporaries(CFG),
+ Target, NotAllocatable),
+ Coloring = [{X, {reg, X}} || X <- NotAllocatable] ++ Cols,
+ ?ASSERT(check_coloring(Coloring, IG, Target)),
+
+ {Coloring, NewSpillIndex}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** BUILD THE INTERFERENCE GRAPH ***
+%%
+%% Returns {Interference_graph, Spill_cost_dictionary}
+%%
+
+build_ig(CFG, Target) ->
+ try build_ig0(CFG, Target)
+ catch error:Rsn -> exit({?MODULE, build_ig, Rsn})
+ end.
+
+build_ig0(CFG, Target) ->
+ Live = Target:analyze(CFG),
+ NumN = Target:number_of_temporaries(CFG), % poss. N-1?
+ {IG, Spill} = build_ig_bbs(Target:labels(CFG),
+ CFG,
+ Live,
+ empty_ig(NumN),
+ empty_spill(NumN),
+ Target),
+ {normalize_ig(IG), Spill}.
+
+build_ig_bbs([], _CFG, _Live, IG, Spill, _Target) ->
+ {IG, Spill};
+build_ig_bbs([L|Ls], CFG, Live, IG, Spill, Target) ->
+ Xs = bb(CFG, L, Target),
+ {_, NewIG, NewSpill} =
+ build_ig_bb(Xs, liveout(Live, L, Target), IG, Spill, Target),
+ build_ig_bbs(Ls, CFG, Live, NewIG, NewSpill, Target).
+
+build_ig_bb([], LiveOut, IG, Spill, _Target) ->
+ {LiveOut, IG, Spill};
+build_ig_bb([X|Xs], LiveOut, IG, Spill, Target) ->
+ {Live,NewIG,NewSpill} = build_ig_bb(Xs, LiveOut, IG, Spill, Target),
+ build_ig_instr(X, Live, NewIG, NewSpill, Target).
+
+%% Note: We could add move-related arcs here as well.
+%%
+%% Note: Ideally, we would like to add all registers to the IG
+%% at once rather than doing 'add_nodes' for each instruction.
+%% (This is costly, since nodes that already are present are checked!)
+
+build_ig_instr(X, Live, IG, Spill, Target) ->
+ {Def, Use} = def_use(X, Target),
+ ?report3("Live ~w\n~w : Def: ~w Use ~w\n", [Live, X, Def,Use]),
+ DefList = ordsets:to_list(Def),
+ NewSpill = inc_spill_costs(DefList,
+ inc_spill_costs(ordsets:to_list(Use), Spill)),
+ NewIG = interference_arcs(DefList, ordsets:to_list(Live), IG),
+ NewLive = ordsets:union(Use, ordsets:subtract(Live, Def)),
+ {NewLive, NewIG, NewSpill}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+interference_arcs([], _Live, IG) ->
+ IG;
+interference_arcs([X|Xs], Live, IG) ->
+ interference_arcs(Xs, Live, i_arcs(X, Live, IG)).
+
+i_arcs(_X, [], IG) ->
+ IG;
+i_arcs(X, [Y|Ys], IG) ->
+ i_arcs(X, Ys, add_edge(X,Y, IG)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+inc_spill_costs([], Spill) -> Spill;
+inc_spill_costs([X|Xs], Spill) ->
+ inc_spill_costs(Xs, inc_spill_cost(X, Spill)).
+
+inc_spill_cost(X, Spill) ->
+ set_spill_cost(X, get_spill_cost(X, Spill)+1, Spill).
+
+get_spill_cost(X, Spill) ->
+ spill_cost_lookup(X, Spill).
+
+set_spill_cost(X, N, Spill) ->
+ spill_cost_update(X, N, Spill).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** COLORING ***
+%%
+%% Coloring is done straightforwardly:
+%% - find the low-degree nodes, put them in low
+%% - while low non-empty:
+%% * remove x from low
+%% * push x on stack
+%% * decrement degree of neighbors of x
+%% * for each neighbor y of low degree, put y on low
+%% - when low empty:
+%% - if graph empty, return stack
+%% - otherwise
+%% * select a node z to spill
+%% * push z on stack
+%% * decrement degree of neighbors of z
+%% * add low-degree neighbors of z to low
+%% * restart the while-loop above
+
+color(IG, Spill, PhysRegs, SpillIx, SpillLimit, NumNodes, Target, NotAllocatable) ->
+ try color_0(IG, Spill, PhysRegs, SpillIx, SpillLimit,
+ NumNodes, Target, NotAllocatable)
+ catch
+ error:Rsn ->
+ ?error_msg("Coloring failed with ~p~n", [Rsn]),
+ ?EXIT(Rsn)
+ end.
+
+color_0(IG, Spill, PhysRegs, SpillIx, SpillLimit, NumNodes, Target,
+ NotAllocatable) ->
+ ?report("simplification of IG~n", []),
+ K = ordsets:size(PhysRegs),
+ Nodes = list_ig(IG),
+
+ Low = low_degree_nodes(Nodes, K, NotAllocatable),
+
+ %% Any nodes above the spillimit must be colored first...
+ MustNotSpill =
+ if NumNodes > SpillLimit+1 ->
+ sort_on_degree(lists:seq(SpillLimit+1,NumNodes-1) -- Low,IG);
+ true -> []
+ end,
+
+ ?report(" starting with low degree nodes ~p~n",[Low]),
+ EmptyStk = [],
+ Precolored = Target:all_precoloured(),
+ {Stk, NewSpillIx} =
+ simplify(Low, NumNodes, Precolored,
+ IG, Spill, K, SpillIx, EmptyStk,
+ SpillLimit, Target, NotAllocatable, MustNotSpill),
+ ?report("selecting colors~n",[]),
+ {select(Stk, Precolored, IG, K, PhysRegs, NumNodes, Target),
+ NewSpillIx}.
+
+sort_on_degree(Nodes, IG) ->
+ [ Node3 || {_,Node3} <-
+ lists:sort([{degree(Info),Node2} ||
+ {Info,Node2} <- [{hipe_vectors:get(IG, Node),
+ Node} || Node <-
+ Nodes]])].
+
+%%%%%%%%%%%%%%%%%%%%
+%%
+%% Simplification: push all easily colored nodes on a stack;
+%% when the list of easy nodes becomes empty, see if graph is
+%% empty as well. If it is not, spill a node and continue.
+%% If it is empty, return the stack.
+%%
+%% Notes:
+%% - We keep the set of visited nodes around for spill purposes
+%% (visited nodes are not considered for spilling)
+%%
+%% - At present, nodes can be pushed onto the stack even if they
+%% already are on the stack. This can be fixed by another 'Vis'
+%% dictionary that keeps track of what is on the stack.
+%% Currently, we just skip already colored nodes.
+%%
+%% - Arguments:
+%% Low: low-degree nodes (ready to color)
+%% NumNodes: number of remaining nodes in graph
+%% IG: interference graph
+%% Spill: spill costs of nodes
+%% K: number of colors
+%% Ix: next spill index
+%% Stk: stack of already simplified nodes
+%%
+%% Physical registers are marked as 'visited' prior to simplify.
+%% This has the following effect:
+%% - they are not considered for spilling
+%% - they are not pushed on the stack
+%% - since we do NOT decrement degrees of surrounding vars, the
+%% non-physreg variables must still take them into account.
+
+simplify(Low, NumNodes, PreC, IG, Spill, K, Ix, Stk, SpillLimit,
+ Target, NotAllocatable, MustNotSpill) ->
+ Vis = visit_all(PreC, none_visited(NumNodes)),
+ Vis1 = visit_all(NotAllocatable, Vis),
+ ActualNumNodes = (NumNodes-length(PreC))-length(NotAllocatable),
+ %% Make sure that the registers that must not be spilled
+ %% get a degree less than K by spilling other regs.
+ {Stk2, Ix2, Vis2, Low2} =
+ handle_non_spill(MustNotSpill, IG, Spill, K, Ix, Stk, Vis1, Low,
+ SpillLimit, Target),
+ simplify_ig(Low2, ActualNumNodes-length(Stk2), IG, Spill, K, Ix2, Stk2, Vis2,
+ SpillLimit, Target).
+
+handle_non_spill([], _IG, _Spill, _K, Ix, Stk, Vis, Low, _SpillLimit, _Target) ->
+ {Stk, Ix, Vis, Low};
+handle_non_spill([X|Xs] = L, IG, Spill, K, Ix, Stk, Vis, Low, SpillLimit, Target) ->
+ Info = hipe_vectors:get(IG, X),
+ Degree = degree(Info),
+ ?report("Can't Spill ~w with degree ~w\n", [X,Degree]),
+ if Degree > K ->
+ ?report(" *** spill required (N<~w)***~n", [SpillLimit]),
+ {Y, NewLow, NewIG} = spill(IG, Vis, Spill, K, SpillLimit, Target),
+ NewVis = visit(Y,Vis),
+ {NewStk, NewIx} = push_spill_node(Y, Ix, Stk),
+ ?report(" node ~w spilled~n", [Y]),
+ handle_non_spill(L, NewIG, Spill, K, NewIx, NewStk, NewVis,
+ Low ++ NewLow, SpillLimit, Target);
+ true ->
+ {NewLow, NewIG} = decrement_neighbors(X, Low, IG, Vis, K),
+ ?report(" node ~w pushed\n(~w now ready)~n", [X,NewLow]),
+ NewStk = push_colored(X, Stk),
+ handle_non_spill(Xs, NewIG, Spill, K, Ix, NewStk, visit(X,Vis),
+ NewLow, SpillLimit, Target)
+ end.
+
+simplify_ig([], 0, _IG, _Spill, _K, Ix, Stk, _Vis, _SpillLimit, _Target) ->
+ {Stk, Ix};
+simplify_ig([], N, IG, Spill, K, Ix, Stk, Vis, SpillLimit, Target)
+ when N > 0 ->
+ ?report3("N: ~w Stk: ~w N+Stk ~w\n", [N,length(Stk),N+length(Stk)]),
+ ?report(" *** spill required (N<~w)***~n", [SpillLimit]),
+ {X, Low, NewIG} = spill(IG, Vis, Spill, K, SpillLimit, Target),
+ NewVis = visit(X,Vis),
+ {NewStk, NewIx} = push_spill_node(X, Ix, Stk),
+ ?report(" node ~w spilled\n(~w now ready)~n", [X, Low]),
+ simplify_ig(Low, N-1, NewIG, Spill, K, NewIx, NewStk, NewVis,
+ SpillLimit, Target);
+simplify_ig([X|Xs], N, IG, Spill, K, Ix, Stk, Vis, SpillLimit, Target) ->
+ ?report3("N: ~w Stk: ~w N+Stk ~w\n", [N,length(Stk),N+length(Stk)]),
+ case is_visited(X,Vis) of
+ true ->
+ ?report(" node ~p already visited~n",[X]),
+ simplify_ig(Xs, N, IG, Spill, K, Ix, Stk, Vis, SpillLimit, Target);
+ false ->
+ ?report("Stack ~w\n", [Stk]),
+ {NewLow, NewIG} = decrement_neighbors(X, Xs, IG, Vis, K),
+ ?report(" node ~w pushed\n(~w now ready)~n", [X,NewLow]),
+ NewStk = push_colored(X, Stk),
+ simplify_ig(NewLow, N-1, NewIG, Spill, K, Ix, NewStk, visit(X,Vis),
+ SpillLimit, Target)
+ end.
+
+%% Returns { NowLowDegreeNeighbors, NewIG }
+
+decrement_neighbors(X, Xs, IG, Vis, K) ->
+ Ns = unvisited_neighbors(X, Vis, IG),
+ ?report(" node ~p has neighbors ~w\n(unvisited ~p)~n",
+ [X, neighbors(X, IG), Ns]),
+ decrement_each(Ns, Xs, IG, Vis, K).
+
+%% For each node, decrement its degree and check if it is now
+%% a low-degree node. In that case, add it to the 'low list'.
+
+decrement_each([], Low, IG, _Vis, _K) ->
+ {Low, IG};
+decrement_each([N|Ns], OldLow, IG, Vis, K) ->
+ {Low, CurrIG} = Res = decrement_each(Ns, OldLow, IG, Vis, K),
+ case is_visited(N, Vis) of
+ true ->
+ Res;
+ false ->
+ {D, NewIG} = decrement_degree(N, CurrIG),
+ if
+ D =:= K-1 ->
+ {[N|Low], NewIG};
+ true ->
+ {Low, NewIG}
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%
+%%
+%% The spill cost of a node is:
+%% est_spill_cost / current_degree
+%%
+%% For all unvisited nodes, compute spill cost and select the minimum.
+%% This node is chosen to be spilled. Then decrement the degree of its
+%% neighbors, and return those of low degree.
+%%
+%% Notes:
+%% - A better method for computing spill costs is to just keep the
+%% minimum cost node. But for debugging purposes, we compute a list
+%% of {node,spillcost} pairs and select the minimum.
+%%
+%% Returns:
+%% {Spilled_node, Low_degree_neighbors, New_interference_graph}
+
+spill(IG, Vis, Spill, K, SpillLimit, Target) ->
+ Ns = list_ig(IG),
+ Costs = spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target),
+ ?report3("spill costs are ~p~n",[Costs]),
+ ActualCosts = lists:sort(Costs),
+ ?report3("actual costs are ~p~n",[ActualCosts]),
+ case ActualCosts of
+ [] ->
+ ?error_msg("There is no node to spill",[]),
+ ?EXIT('no node to spill');
+ [{_Cost,N}|_] ->
+ {Low, NewIG} = decrement_neighbors(N, [], IG, Vis, K),
+ %?report("spilled node ~p at cost ~p (~p now ready)~n",[N,Cost,Low]),
+ {N, Low, NewIG}
+ end.
+
+spill_costs([], _IG, _Vis, _Spill, _SpillLimit, _Target) ->
+ [];
+spill_costs([{N,Info}|Ns], IG, Vis, Spill, SpillLimit, Target) ->
+ case degree(Info) of
+ 0 -> spill_costs(Ns,IG,Vis,Spill, SpillLimit, Target);
+ Deg ->
+ case is_visited(N,Vis) of
+ true ->
+ spill_costs(Ns,IG,Vis,Spill, SpillLimit, Target);
+ _ ->
+ case Target:is_fixed(N) of
+ true ->
+ spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target);
+ false ->
+ if N > SpillLimit ->
+ spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target);
+ true ->
+ [{spill_cost_of(N,Spill)/Deg,N} |
+ spill_costs(Ns,IG, Vis, Spill, SpillLimit, Target)]
+ end
+ end
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%
+%%
+%% Returns a list of {Name,Location}, where Location is
+%% either {spill,M} or {reg,R}
+%%
+%% Note: we use pessimistic coloring here.
+%% - we could use optimistic coloring: for spilled node, check if there is
+%% an unused color among the neighbors and choose that.
+
+select(Stk, PreC, IG, K, PhysRegs, NumNodes, Target) ->
+ %% NumNodes = length(Stk)+length(PreC),
+ {PhysColors, Cols} = precolor(PreC, none_colored(NumNodes), Target),
+ ?report("precoloring has yielded ~p~n",[list_coloring(Cols)]),
+ PhysColors ++ select_colors(Stk, IG, Cols, PhysRegs, K).
+
+select_colors([], _IG, _Cols, _PhysRegs, _K) ->
+ ?report("all nodes colored~n",[]),
+ [];
+select_colors([{X,colorable}|Xs], IG, Cols, PhysRegs, K) ->
+ ?report("color of ~p\n",[X]),
+ {Reg,NewCols} = select_color(X, IG, Cols, PhysRegs),
+ ?report("~p~n",[Reg]),
+ [{X,{reg,Reg}} | select_colors(Xs, IG, NewCols, PhysRegs, K)];
+%select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) ->
+% ?report('spilled: ~p~n',[X]),
+% %% Check if optimistic coloring could have found a color
+% case catch select_color(X,IG,Cols,K) of
+% {'EXIT',_} -> % no color possible
+% ?report('(no optimistic color)~n',[]),
+% [{X,{spill,M}}|select_colors(Xs, IG, Cols, PhysRegs, K)];
+% {Reg,NewCols} ->
+% ?report('(optimistic color: ~p)~n',[Reg]),
+% [{X,{reg,Reg}}|select_colors(Xs, IG, Cols, PhysRegs, K)]
+% end.
+
+%% Old code / pessimistic coloring:
+select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) ->
+ ?report("spilled: ~p~n",[X]),
+ %% Check if optimistic coloring could have found a color
+% case catch select_color(X,IG,Cols,K) of
+% {'EXIT',_} -> % no color possible
+% ?report('(no optimistic color)~n',[]);
+% {Reg,NewCols} ->
+% ?report('(optimistic color: ~p)~n',[Reg])
+% end,
+ [{X,{spill,M}} | select_colors(Xs, IG, Cols, PhysRegs, K)].
+
+select_color(X, IG, Cols, PhysRegs) ->
+ UsedColors = get_colors(neighbors(X, IG), Cols),
+ Reg = select_unused_color(UsedColors, PhysRegs),
+ {Reg, set_color(X, Reg, Cols)}.
+
+%%%%%%%%%%%%%%%%%%%%
+
+get_colors([], _Cols) -> [];
+get_colors([X|Xs], Cols) ->
+ case color_of(X, Cols) of
+ uncolored ->
+ get_colors(Xs, Cols);
+ {color,R} ->
+ [R|get_colors(Xs, Cols)]
+ end.
+
+select_unused_color(UsedColors, PhysRegs) ->
+ Summary = ordsets:from_list(UsedColors),
+ AvailRegs = ordsets:to_list(ordsets:subtract(PhysRegs, Summary)),
+ hd(AvailRegs).
+ %% select_avail_reg(AvailRegs).
+
+%% We choose the register to use randomly from the set of available
+%% registers.
+%%
+%% Note: Another way of doing it is LRU-order:
+%% - Have an LRU-queue of register names; when coloring, try the colors in that
+%% order (some may be occupied).
+%% - When a color has been selected, put it at the end of the LRU.
+
+%% select_avail_reg(Regs) ->
+%% case get(seeded) of
+%% undefined ->
+%% random:seed(),
+%% put(seeded,true);
+%% true ->
+%% ok
+%% end,
+%% NReg = length(Regs),
+%% RegNo = random:uniform(NReg),
+%% lists:nth(RegNo, Regs).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+push_spill_node(X, M, Stk) ->
+ {[{X,{spill,M}}|Stk], M+1}.
+
+push_colored(X, Stk) ->
+ [{X, colorable} | Stk].
+
+%%%%%%%%%%%%%%%%%%%%
+
+low_degree_nodes([], _K, _NotAllocatable) -> [];
+low_degree_nodes([{N,Info}|Xs], K, NotAllocatable) ->
+ case lists:member(N, NotAllocatable) of
+ true ->
+ low_degree_nodes(Xs,K, NotAllocatable);
+ false ->
+ ?report0("node ~p has degree ~p: ~w~n",[N,degree(Info),neighbors(Info)]),
+ Deg = degree(Info),
+ if
+ Deg < K ->
+ [N|low_degree_nodes(Xs, K, NotAllocatable)];
+ true ->
+ low_degree_nodes(Xs, K, NotAllocatable)
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%
+
+unvisited_neighbors(X, Vis, IG) ->
+ ordsets:from_list(unvisited(neighbors(X,IG), Vis)).
+
+unvisited([], _Vis) -> [];
+unvisited([X|Xs], Vis) ->
+ case is_visited(X, Vis) of
+ true ->
+ unvisited(Xs, Vis);
+ false ->
+ [X|unvisited(Xs, Vis)]
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** ABSTRACT DATATYPES ***
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The ig datatype:
+%%
+%% Note: if we know the number of temps used, we can use a VECTOR
+%% instead, which will speed up things.
+%%
+%% Note: later on, we may wish to add 'move-related' support.
+
+-record(ig_info, {neighbors=[], degree=0 :: integer()}).
+
+empty_ig(NumNodes) ->
+ hipe_vectors:new(NumNodes, #ig_info{neighbors=[], degree=0}).
+
+degree(Info) ->
+ Info#ig_info.degree.
+
+neighbors(Info) ->
+ Info#ig_info.neighbors.
+
+add_edge(X, X, IG) -> IG;
+add_edge(X, Y, IG) ->
+ add_arc(X, Y, add_arc(Y, X, IG)).
+
+add_arc(X, Y, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Old = neighbors(Info),
+ New = Info#ig_info{neighbors=[Y|Old]},
+ hipe_vectors:set(IG, X, New).
+
+normalize_ig(IG) ->
+ Size = hipe_vectors:size(IG),
+ normalize_ig(Size-1, IG).
+
+normalize_ig(-1, IG) ->
+ IG;
+normalize_ig(I, IG) ->
+ Info = hipe_vectors:get(IG, I),
+ N = ordsets:from_list(neighbors(Info)),
+ NewIG = hipe_vectors:set(IG, I, Info#ig_info{neighbors=N, degree=length(N)}),
+ normalize_ig(I-1, NewIG).
+
+%%degree(X, IG) ->
+%% Info = hipe_vectors:get(IG, X),
+%% Info#ig_info.degree.
+
+neighbors(X, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Info#ig_info.neighbors.
+
+decrement_degree(X, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Degree = degree(Info),
+ NewDegree = Degree-1,
+ NewInfo = Info#ig_info{degree=NewDegree},
+ {NewDegree, hipe_vectors:set(IG,X,NewInfo)}.
+
+list_ig(IG) ->
+ hipe_vectors:list(IG).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The spill cost datatype:
+%%
+%% Note: if we know the number of temps used, we can use a VECTOR
+%% instead, which will speed up things.
+
+empty_spill(NumNodes) ->
+ hipe_vectors:new(NumNodes, 0).
+
+spill_cost_of(X, Spill) ->
+ hipe_vectors:get(Spill, X).
+
+spill_cost_lookup(X, Spill) ->
+ spill_cost_of(X, Spill).
+
+spill_cost_update(X, N, Spill) ->
+ hipe_vectors:set(Spill, X, N).
+
+%%list_spill_costs(Spill) ->
+%% hipe_vectors:list(Spill).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The coloring datatype:
+
+none_colored(NumNodes) ->
+ hipe_vectors:new(NumNodes,uncolored).
+
+color_of(X,Cols) ->
+ hipe_vectors:get(Cols,X).
+
+set_color(X,R,Cols) ->
+ hipe_vectors:set(Cols,X,{color,R}).
+
+-ifdef(DEBUG).
+list_coloring(Cols) ->
+ hipe_vectors:list(Cols).
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Note: there might be a slight gain in separating the two versions
+%% of visit/2 and visited/2. (So that {var,X} selects X and calls the
+%% integer version.
+
+none_visited(NumNodes) ->
+ hipe_vectors:new(NumNodes, false).
+
+visit(X,Vis) ->
+ hipe_vectors:set(Vis, X, true).
+
+is_visited(X,Vis) ->
+ hipe_vectors:get(Vis, X).
+
+visit_all([], Vis) -> Vis;
+visit_all([X|Xs], Vis) ->
+ visit_all(Xs, visit(X, Vis)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Check that all arcs in IG are bidirectional + degree is correct
+
+%% check_ig(IG) ->
+%% check_ig(list_ig(IG),IG).
+
+%% check_ig([],IG) ->
+%% ok;
+%% check_ig([{N,Info}|Xs],IG) ->
+%% Ns = neighbors(Info),
+%% NumNs = length(Ns),
+%% D = degree(Info),
+%% if
+%% D =:= NumNs ->
+%% ok;
+%% true ->
+%% ?WARNING_MSG('node ~p has degree ~p but ~p neighbors~n',[N,D,NumNs])
+%% end,
+%% check_neighbors(N,Ns,IG),
+%% check_ig(Xs,IG).
+
+%% check_neighbors(N,[],IG) ->
+%% ok;
+%% check_neighbors(N,[M|Ms],IG) ->
+%% Ns = neighbors(M,IG),
+%% case member(N,Ns) of
+%% true ->
+%% ok;
+%% true ->
+%% ?WARNING_MSG('node ~p should have ~p as neighbor (has ~p)~n',[M,N,Ns])
+%% end,
+%% check_neighbors(N,Ms,IG).
+
+-ifdef(DO_ASSERT).
+%%%%%%%%%%%%%%%%%%%%
+%% Check that the coloring is correct (if the IG is correct):
+%%
+
+check_coloring(Coloring, IG, Target) ->
+ ?report0("checking coloring ~p~n",[Coloring]),
+ check_cols(list_ig(IG),init_coloring(Coloring, Target)).
+
+init_coloring(Xs, Target) ->
+ hipe_temp_map:cols2tuple(Xs, Target).
+
+check_color_of(X, Cols) ->
+%% if
+%% is_precoloured(X) ->
+%% phys_reg_color(X,Cols);
+%% true ->
+ case hipe_temp_map:find(X, Cols) of
+ unknown ->
+ ?WARNING_MSG("node ~p: color not found~n", [X]),
+ uncolored;
+ C ->
+ C
+ end.
+
+check_cols([], Cols) ->
+ ?report("coloring valid~n",[]),
+ true;
+check_cols([{X,Info}|Xs], Cols) ->
+ Cs = [{N, check_color_of(N, Cols)} || N <- neighbors(Info)],
+ C = check_color_of(X, Cols),
+ case valid_coloring(X, C, Cs) of
+ yes ->
+ check_cols(Xs, Cols);
+ {no,Invalids} ->
+ ?WARNING_MSG("node ~p has same color (~p) as ~p~n", [X,C,Invalids]),
+ check_cols(Xs, Cols)
+ end.
+
+valid_coloring(X, C, []) ->
+ yes;
+valid_coloring(X, C, [{Y,C}|Ys]) ->
+ case valid_coloring(X, C, Ys) of
+ yes -> {no, [Y]};
+ {no,Zs} -> {no, [Y|Zs]}
+ end;
+valid_coloring(X, C, [_|Ys]) ->
+ valid_coloring(X, C, Ys).
+-endif.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% *** INTERFACES TO OTHER MODULES ***
+%%
+
+liveout(CFG, L, Target) ->
+ ordsets:from_list(reg_names(Target:liveout(CFG, L), Target)).
+
+bb(CFG, L, Target) ->
+ hipe_bb:code(Target:bb(CFG, L)).
+
+def_use(X, Target) ->
+ {ordsets:from_list(reg_names(Target:defines(X), Target)),
+ ordsets:from_list(reg_names(Target:uses(X), Target))}.
+
+reg_names(Regs, Target) ->
+ [Target:reg_nr(X) || X <- Regs].
+
+%%
+%% Precoloring: use this version when a proper implementation of
+%% physical_name(X) is available!
+%%
+
+precolor(Xs, Cols, Target) ->
+ ?report("precoloring ~p~n", [Xs]),
+ {_Cs, _NewCol} = Res = precolor0(Xs, Cols, Target),
+ ?report(" yielded ~p~n", [_Cs]),
+ Res.
+
+precolor0([], Cols, _Target) ->
+ {[], Cols};
+precolor0([R|Rs], Cols, Target) ->
+ {Cs, Cols1} = precolor0(Rs, Cols, Target),
+ {[{R, {reg, physical_name(R, Target)}}|Cs],
+ set_color(R, physical_name(R, Target), Cols1)}.
+
+physical_name(X, Target) ->
+ Target:physical_name(X).
diff --git a/lib/hipe/regalloc/hipe_ig.erl b/lib/hipe/regalloc/hipe_ig.erl
new file mode 100644
index 0000000000..4991e73e53
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_ig.erl
@@ -0,0 +1,776 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_ig.erl
+%% Author : Andreas Wallin <d96awa@csd.uu.se>
+%% Purpose : Creates an interference graph that tells which temporaries
+%% interfere with each other.
+%% Created : 5 Feb 2000
+%%----------------------------------------------------------------------
+
+-module(hipe_ig).
+
+-export([build/2,
+ nodes_are_adjacent/3,
+ node_spill_cost/2,
+ node_adj_list/2,
+ get_moves/1,
+ %% degree/1,
+ %% number_of_temps/1,
+ spill_costs/1,
+ adj_list/1,
+ %% adj_set/1,
+ add_edge/4,
+ remove_edge/4,
+ %% set_adj_set/2,
+ %% set_adj_list/2,
+ %% set_ig_moves/2,
+ %% set_spill_costs/2,
+ %% set_degree/2
+ get_node_degree/2,
+ dec_node_degree/2,
+ is_trivially_colourable/3
+ ]).
+-ifdef(DEBUG_PRINTOUTS).
+-export([print_spill_costs/1,
+ print_adjacent/1,
+ print_degrees/1
+ ]).
+-endif.
+
+%%-ifndef(DEBUG).
+%%-define(DEBUG,true).
+%%-endif.
+
+-include("../main/hipe.hrl").
+-include("../flow/cfg.hrl").
+-include("hipe_spillcost.hrl").
+
+%%----------------------------------------------------------------------
+
+-record(igraph, {adj_set, adj_list, ig_moves, degree,
+ spill_costs :: #spill_cost{},
+ num_temps :: non_neg_integer()}).
+
+%%----------------------------------------------------------------------
+%% Degree: array mapping nodes to integer degrees.
+%% Precoloured nodes have 'infinite' degrees: they are initialised with
+%% degrees K + number_of_temporaries.
+%% Operations include incrementing, decrementing, and querying a node's
+%% degree, and testing for trivial colourability (degree < K).
+%%----------------------------------------------------------------------
+
+degree_new(No_temporaries, Target) ->
+ Degree = hipe_bifs:array(No_temporaries, 0),
+ K = length(Target:allocatable()),
+ Inf = K + No_temporaries,
+ precoloured_to_inf_degree(Target:all_precoloured(), Inf, Degree).
+
+precoloured_to_inf_degree([], _Inf, Degree) -> Degree;
+precoloured_to_inf_degree([P|Ps], Inf, Degree) ->
+ hipe_bifs:array_update(Degree, P, Inf),
+ precoloured_to_inf_degree(Ps, Inf, Degree).
+
+degree_inc(Node, Degree) ->
+ hipe_bifs:array_update(Degree, Node, hipe_bifs:array_sub(Degree, Node) + 1).
+
+degree_dec(Node, Degree) ->
+ hipe_bifs:array_update(Degree, Node, hipe_bifs:array_sub(Degree, Node) - 1).
+
+degree_get(Node, Degree) ->
+ hipe_bifs:array_sub(Degree, Node).
+
+degree_is_trivially_colourable(Node, K, Degree) ->
+ hipe_bifs:array_sub(Degree, Node) < K.
+
+%%----------------------------------------------------------------------
+%% AdjSet:
+%% Implements sets of adjacent nodes.
+%% Symmetry implies that when (U,V) is a member, then so is (V,U).
+%% Hence, only (U,V), where U<V, is actually stored.
+%% Supports queries and destructive updates, but not enumeration.
+%% Implemented as a bit array in an array of bytes, augmented by an
+%% index vector for fast address calculations.
+%%----------------------------------------------------------------------
+
+-define(USE_NEW_BITARRAY_BIFS, true).
+%%-define(EMULATE_BITARRAY_BIFS, true).
+
+-ifdef(USE_NEW_BITARRAY_BIFS).
+-define(HIPE_BIFS_BITARRAY(ArrayBits, Val), hipe_bifs:bitarray(ArrayBits, Val)).
+-define(HIPE_BIFS_BITARRAY_UPDATE(Array, BitNr, Val), hipe_bifs:bitarray_update(Array, BitNr, Val)).
+-define(HIPE_BIFS_BITARRAY_SUB(Array, BitNr), hipe_bifs:bitarray_sub(Array, BitNr)).
+-endif.
+
+-ifdef(EMULATE_BITARRAY_BIFS).
+
+-define(LOG2_BITS_PER_WORD, 3).
+-define(BITS_PER_WORD, (1 bsl ?LOG2_BITS_PER_WORD)).
+
+hipe_bifs_bitarray(ArrayBits, Val) ->
+ ArrayWords = (ArrayBits + (?BITS_PER_WORD - 1)) bsr ?LOG2_BITS_PER_WORD,
+ Byte =
+ case Val of
+ true -> 16#FF;
+ false -> 16#00
+ end,
+ hipe_bifs:bytearray(ArrayWords, Byte).
+
+hipe_bifs_bitarray_update(Array, BitNr, Val) ->
+ WordNr = BitNr bsr ?LOG2_BITS_PER_WORD,
+ WordMask = 1 bsl (BitNr band (?BITS_PER_WORD - 1)),
+ Word = hipe_bifs:bytearray_sub(Array, WordNr),
+ NewWord =
+ case Val of
+ true -> Word bor WordMask;
+ false -> Word band (bnot WordMask)
+ end,
+ hipe_bifs:bytearray_update(Array, WordNr, NewWord).
+
+hipe_bifs_bitarray_sub(Array, BitNr) ->
+ WordNr = BitNr bsr ?LOG2_BITS_PER_WORD,
+ WordMask = 1 bsl (BitNr band (?BITS_PER_WORD - 1)),
+ Word = hipe_bifs:bytearray_sub(Array, WordNr),
+ Word band WordMask =/= 0.
+
+-define(HIPE_BIFS_BITARRAY(ArrayBits, Val), hipe_bifs_bitarray(ArrayBits, Val)).
+-define(HIPE_BIFS_BITARRAY_UPDATE(Array, BitNr, Val), hipe_bifs_bitarray_update(Array, BitNr, Val)).
+-define(HIPE_BIFS_BITARRAY_SUB(Array, BitNr), hipe_bifs_bitarray_sub(Array, BitNr)).
+
+-endif. % EMULATE_BITARRAY_BIFS
+
+-record(adjset, {index, array}).
+-record(adjset_chunked, {index, chunks}).
+
+-spec adjset_new(non_neg_integer()) -> #adjset{} | #adjset_chunked{}.
+
+adjset_new(NrTemps) ->
+ ArrayBits = (NrTemps * (NrTemps - 1)) div 2,
+ Index = adjset_mk_index(NrTemps, []),
+ try ?HIPE_BIFS_BITARRAY(ArrayBits, false) of
+ Array ->
+ #adjset{index=Index,array=Array}
+ catch
+ _:_ ->
+ #adjset_chunked{index=Index,chunks=adjset_mk_chunks(ArrayBits)}
+ end.
+
+-define(LOG2_CHUNK_BITS, 19). % 2^19 bits == 64KB
+-define(CHUNK_BITS, (1 bsl ?LOG2_CHUNK_BITS)).
+
+adjset_mk_chunks(ArrayBits) ->
+ Tail =
+ case ArrayBits band (?CHUNK_BITS - 1) of
+ 0 -> [];
+ LastChunkBits -> [?HIPE_BIFS_BITARRAY(LastChunkBits, false)]
+ end,
+ N = ArrayBits bsr ?LOG2_CHUNK_BITS,
+ adjset_mk_chunks(N, Tail).
+
+adjset_mk_chunks(0, Tail) ->
+ list_to_tuple(Tail);
+adjset_mk_chunks(N, Tail) ->
+ adjset_mk_chunks(N-1, [?HIPE_BIFS_BITARRAY(?CHUNK_BITS, false) | Tail]).
+
+adjset_mk_index(0, Tail) ->
+ list_to_tuple(Tail);
+adjset_mk_index(N, Tail) ->
+ I = N - 1,
+ adjset_mk_index(I, [(I * (I-1)) div 2 | Tail]).
+
+adjset_add_edge(U0, V0, #adjset{index=Index,array=Array}) -> % PRE: U0 =/= V0
+ {U,V} =
+ if U0 < V0 -> {U0,V0};
+ true -> {V0,U0}
+ end,
+ %% INV: U < V
+ BitNr = element(V+1, Index) + U,
+ ?HIPE_BIFS_BITARRAY_UPDATE(Array, BitNr, true);
+adjset_add_edge(U0, V0, #adjset_chunked{index=Index,chunks=Chunks}) -> % PRE: U0 =/= V0
+ {U,V} =
+ if U0 < V0 -> {U0,V0};
+ true -> {V0,U0}
+ end,
+ %% INV: U < V
+ BitNr = element(V+1, Index) + U,
+ %% here things become different
+ ChunkNr = BitNr bsr ?LOG2_CHUNK_BITS,
+ ChunkBit = BitNr band (?CHUNK_BITS - 1),
+ Chunk = element(ChunkNr+1, Chunks),
+ ?HIPE_BIFS_BITARRAY_UPDATE(Chunk, ChunkBit, true).
+
+adjset_remove_edge(U0, V0, #adjset{index=Index,array=Array}) -> % PRE: U0 =/= V0
+ {U,V} =
+ if U0 < V0 -> {U0,V0};
+ true -> {V0,U0}
+ end,
+ %% INV: U < V
+ BitNr = element(V+1, Index) + U,
+ ?HIPE_BIFS_BITARRAY_UPDATE(Array, BitNr, false);
+adjset_remove_edge(U0, V0, #adjset_chunked{index=Index,chunks=Chunks}) -> % PRE: U0 =/= V0
+ {U,V} =
+ if U0 < V0 -> {U0,V0};
+ true -> {V0,U0}
+ end,
+ %% INV: U < V
+ BitNr = element(V+1, Index) + U,
+ %% here things become different
+ ChunkNr = BitNr bsr ?LOG2_CHUNK_BITS,
+ ChunkBit = BitNr band (?CHUNK_BITS - 1),
+ Chunk = element(ChunkNr+1, Chunks),
+ ?HIPE_BIFS_BITARRAY_UPDATE(Chunk, ChunkBit, false).
+
+adjset_are_adjacent(U0, V0, #adjset{index=Index,array=Array}) ->
+ {U,V} =
+ if U0 < V0 -> {U0,V0};
+ U0 =:= V0 -> exit({?MODULE,adjacent,U0,V0}); % XXX: probably impossible
+ true -> {V0,U0}
+ end,
+ %% INV: U < V
+ BitNr = element(V+1, Index) + U,
+ ?HIPE_BIFS_BITARRAY_SUB(Array, BitNr);
+adjset_are_adjacent(U0, V0, #adjset_chunked{index=Index,chunks=Chunks}) ->
+ {U,V} =
+ if U0 < V0 -> {U0,V0};
+ U0 =:= V0 -> exit({?MODULE,adjacent,U0,V0}); % XXX: probably impossible
+ true -> {V0,U0}
+ end,
+ %% INV: U < V
+ BitNr = element(V+1, Index) + U,
+ %% here things become different
+ ChunkNr = BitNr bsr ?LOG2_CHUNK_BITS,
+ ChunkBit = BitNr band (?CHUNK_BITS - 1),
+ Chunk = element(ChunkNr+1, Chunks),
+ ?HIPE_BIFS_BITARRAY_SUB(Chunk, ChunkBit).
+
+%%---------------------------------------------------------------------
+%% Print functions - only used for debugging
+
+-ifdef(DEBUG_PRINTOUTS).
+print_adjacent(IG) ->
+ ?debug_msg("Adjacent nodes:\n", []),
+ adjset_print(number_of_temps(IG),IG).
+
+adjset_print(2, IG) ->
+ adjset_print(1, 0, IG);
+adjset_print(Ntemps, IG) ->
+ adjset_print(Ntemps - 1, Ntemps - 2, IG),
+ adjset_print(Ntemps - 1, IG).
+
+adjset_print(U, 0, IG) ->
+ case nodes_are_adjacent(U, 0, IG) of
+ true -> ?debug_msg("edge ~w ~w\n", [U, 0]);
+ _ -> true
+ end;
+adjset_print(U, V, IG) ->
+ case nodes_are_adjacent(U, V, IG) of
+ true -> ?debug_msg("edge ~w ~w\n", [U, V]);
+ _ -> true
+ end,
+ adjset_print(U, V - 1, IG).
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: adj_set, adj_list, degree, spill_costs
+%%
+%% Description: Selector functions. Used to get one of the encapsulated
+%% data-structure contained in the IG structure.
+%% Parameters:
+%% IG -- An interference graph
+%%
+%% Returns:
+%% One of the encapsulated data-structures.
+%%----------------------------------------------------------------------
+adj_set(IG) -> IG#igraph.adj_set.
+adj_list(IG) -> IG#igraph.adj_list.
+ig_moves(IG) -> IG#igraph.ig_moves.
+degree(IG) -> IG#igraph.degree.
+
+-spec spill_costs(#igraph{}) -> #spill_cost{}.
+spill_costs(IG) -> IG#igraph.spill_costs.
+
+-ifdef(DEBUG_PRINTOUTS).
+number_of_temps(IG) -> IG#igraph.no_temps.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: set_adj_set, set_adj_list, set_degree, set_spill_costs
+%%
+%% Description: Modifier functions. Used to set one of the encapsulated
+%% data-structure contained in the IG structure.
+%% Parameters:
+%% Data-structure -- Data-structure you want to set. An adj_set
+%% data-structure for example.
+%% IG -- An interference graph
+%%
+%% Returns:
+%% An updated interference graph.
+%%----------------------------------------------------------------------
+
+%%set_adj_set(Adj_set, IG) -> IG#igraph{adj_set = Adj_set}.
+set_adj_list(Adj_list, IG) -> IG#igraph{adj_list = Adj_list}.
+set_ig_moves(IG_moves, IG) -> IG#igraph{ig_moves = IG_moves}.
+%%set_degree(Degree, IG) -> IG#igraph{degree = Degree}.
+set_spill_costs(Spill_costs, IG) -> IG#igraph{spill_costs = Spill_costs}.
+
+%%----------------------------------------------------------------------
+%% Function: initial_ig
+%%
+%% Description: The initial interference record that we start with when
+%% building the interference graph.
+%% Parameters:
+%% NumTemps -- Number of temporaries in the CFG we work on. This is
+%% because we have some data structures built out of vectors.
+%%
+%% Returns:
+%% A new interference record
+%%----------------------------------------------------------------------
+
+-spec initial_ig(non_neg_integer(), atom()) -> #igraph{}.
+
+initial_ig(NumTemps, Target) ->
+ #igraph{adj_set = adjset_new(NumTemps),
+ adj_list = hipe_adj_list:new(NumTemps),
+ ig_moves = hipe_ig_moves:new(NumTemps),
+ degree = degree_new(NumTemps, Target),
+ spill_costs = hipe_spillcost:new(NumTemps),
+ num_temps = NumTemps
+ }.
+
+%%----------------------------------------------------------------------
+%% Function: build
+%%
+%% Description: Constructs an interference graph for the specifyed CFG.
+%%
+%% Parameters:
+%% CFG -- A Control Flow Graph
+%% Target -- The module that contains the target-specific functions
+%%
+%% Returns:
+%% An interference graph for the given CFG.
+%%----------------------------------------------------------------------
+
+-spec build(#cfg{}, atom()) -> #igraph{}.
+
+build(CFG, Target) ->
+ BBs_in_out_liveness = Target:analyze(CFG),
+ Labels = Target:labels(CFG),
+ %% How many temporaries exist?
+ NumTemps = Target:number_of_temporaries(CFG),
+ IG0 = initial_ig(NumTemps, Target),
+ %%?debug_msg("initial adjset: ~p\n",[element(2, IG0)]),
+ %%?debug_msg("initial adjset array: ~.16b\n",[element(3, element(2, IG0))]),
+ analyze_bbs(Labels, BBs_in_out_liveness, IG0, CFG, Target).
+
+%%----------------------------------------------------------------------
+%% Function: analyze_bbs
+%%
+%% Description: Looks up the code that exists in all basic blocks and
+%% analyse instructions use and def's to see what
+%% temporaries that interfere with each other.
+%%
+%% Parameters:
+%% L -- A label
+%% Ls -- Other labels that exits in the CFG
+%% BBs_in_out_liveness -- The in and out liveness on all basic blocks
+%% IG -- The interference graph in it's current state
+%% CFG -- The Control Flow Graph that we constructs
+%% the interference graph from.
+%% Target -- The module containing the target-specific
+%% functions
+%%
+%% Returns:
+%% An interference graph for the given CFG.
+%%----------------------------------------------------------------------
+
+analyze_bbs([], _, IG, _, _) -> IG;
+analyze_bbs([L|Ls], BBs_in_out_liveness, IG, CFG, Target) ->
+ % Get basic block associated with label L
+ BB = Target:bb(CFG, L),
+ % Get basic block code
+ BB_code = hipe_bb:code(BB),
+ % Temporaries that are live out from this basic block
+ BB_liveout = Target:liveout(BBs_in_out_liveness, L),
+ % Only temporary numbers
+ BB_liveout_numbers = reg_numbers(BB_liveout, Target),
+ % {Liveness, New Interference Graph}
+ {_, New_ig, Ref} = analyze_bb_instructions(BB_code,
+ ordsets:from_list(BB_liveout_numbers),
+ IG,
+ Target),
+ Newer_ig = set_spill_costs(hipe_spillcost:ref_in_bb(Ref,
+ spill_costs(New_ig)),
+ New_ig),
+ analyze_bbs(Ls, BBs_in_out_liveness, Newer_ig, CFG, Target).
+
+%%----------------------------------------------------------------------
+%% Function: analyze_bb_instructions
+%%
+%% Description: Analyzes all instructions that is contained in a basic
+%% block in reverse order.
+%%
+%% Parameters:
+%% Instruction -- An instruction
+%% Instructions -- The remaining instructions
+%% Live -- All temporaries that are live at the time.
+%% Live is a set of temporary "numbers only".
+%% IG -- The interference graph in it's current state
+%% Target -- The mopdule containing the target-specific functions
+%%
+%% Returns:
+%% Live -- Temporaries that are live at entery of basic block
+%% that we analyze.
+%% IG -- Updated interference graph.
+%% Ref -- Set of temporaries referred to in this bb.
+%%----------------------------------------------------------------------
+
+%% Ref: set of temporaries referred to in this bb
+analyze_bb_instructions([], Live, IG, _) -> {Live, IG, ordsets:new()};
+analyze_bb_instructions([Instruction|Instructions], Live, IG, Target) ->
+ %% Analyze last instruction first.
+ {Live0, IG0, Ref} = analyze_bb_instructions(Instructions, Live,
+ IG, Target),
+ %% Check for temporaries that are defined and used in instruction
+ {Def, Use} = Target:def_use(Instruction),
+ %% Convert to register numbers
+ Def_numbers = ordsets:from_list(reg_numbers(Def, Target)),
+ Use_numbers = ordsets:from_list(reg_numbers(Use, Target)),
+ Ref_numbers = ordsets:union(Ref, ordsets:union(Def_numbers, Use_numbers)),
+ %% Increase spill cost on all used temporaries
+ IG1 = set_spill_costs(hipe_spillcost:inc_costs(Use_numbers,
+ spill_costs(IG0)),
+ IG0),
+ {Live1, IG2} = analyze_move(Instruction,
+ Live0,
+ Def_numbers,
+ Use_numbers,
+ IG1,
+ Target),
+ %% Adding Def to Live here has the effect of creating edges between
+ %% the defined registers, which is O(N^2) for an instruction that
+ %% clobbers N registers.
+ %%
+ %% Adding Def to Live is redundant when:
+ %% 1. Def is empty, or
+ %% 2. Def is a singleton, or
+ %% 3. Def contains only precoloured registers, or
+ %% 4. Def contains exactly one non-precoloured register, and the
+ %% remaining ones are all non-allocatable precoloured registers.
+ %%
+ %% HiPE's backends only create multiple-element Def sets
+ %% for CALL instructions, and then all elements are precoloured.
+ %%
+ %% Therefore we can avoid adding Def to Live. The benefit is greatest
+ %% on backends with many physical registers, since CALLs clobber all
+ %% physical registers.
+ Live2 = Live1, % ordsets:union(Live1, Def_numbers),
+ IG3 = interfere(Def_numbers, Live2, IG2, Target),
+ Live3 = ordsets:union(Use_numbers, ordsets:subtract(Live2, Def_numbers)),
+ {Live3, IG3, Ref_numbers}.
+
+%%----------------------------------------------------------------------
+%% Function: analyze_move
+%%
+%% Description: If a move instructions is discovered, this function is
+%% called. It is used to remember what move instructions
+%% a temporary is associated with and all moves that exists
+%% in the CFG.
+%%
+%% Parameters:
+%% Instruction -- An instruction
+%% Live -- All temporaries that are live at the time.
+%% Live is a set of temporary "numbers only".
+%% Def_numbers -- Temporaries that are defined at this instruction
+%% Use_numbers -- Temporaries that are used at this instruction
+%% IG -- The interference graph in its current state
+%% Target -- The module containing the target-specific functions
+%% Returns:
+%% Live -- An updated live set
+%% IG -- An updated interference graph
+%%----------------------------------------------------------------------
+
+analyze_move(Instruction, Live, Def_numbers, Use_numbers, IG, Target) ->
+ case Target:is_move(Instruction) of
+ true ->
+ case {Def_numbers, Use_numbers} of
+ {[Dst], [Src]} ->
+ New_IG = set_ig_moves(hipe_ig_moves:new_move(Dst, Src, ig_moves(IG)), IG),
+ New_live = ordsets:del_element(Src, Live),
+ {New_live, New_IG};
+ _ ->
+ {Live, IG}
+ end;
+ _ ->
+ {Live, IG}
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: interfere
+%%
+%% Description: A number of temporaries that are defined interfere with
+%% everything in the current live set.
+%%
+%% Parameters:
+%% Define -- A Define temporary
+%% Defines -- Rest of temporaries.
+%% Live -- Current live set
+%% IG -- An interference graph
+%%
+%% Returns:
+%% An updated interference graph.
+%%----------------------------------------------------------------------
+
+interfere([], _, IG, _) -> IG;
+interfere([Define|Defines], Living, IG, Target) ->
+ New_ig = interfere_with_living(Define, Living, IG, Target),
+ interfere(Defines, Living, New_ig, Target).
+
+%%----------------------------------------------------------------------
+%% Function: interfere_with_living
+%%
+%% Description: Let one temporary that is in the define set interfere
+%% with all live temporaries.
+%%
+%% Parameters:
+%% Define -- A Define temporary
+%% Live -- Current live set
+%% Lives -- Rest of living temporaries.
+%% IG -- An interference graph
+%% Target -- The module containing the target-specific functions
+%% Returns:
+%% An updated interference graph
+%%----------------------------------------------------------------------
+
+interfere_with_living(_, [], IG, _) -> IG;
+interfere_with_living(Define, [Live|Living], IG, Target) ->
+ New_ig = add_edge(Define, Live, IG, Target),
+ interfere_with_living(Define, Living, New_ig, Target).
+
+%%
+%% nodes_are_adjacent(U, V, IG)
+%% returns true if nodes U and V are adjacent in interference graph IG
+%%
+-spec nodes_are_adjacent(integer(), integer(), #igraph{}) -> boolean().
+nodes_are_adjacent(U, V, IG) ->
+ adjset_are_adjacent(U, V, adj_set(IG)).
+
+%%
+%% node_adj_set(Node, IG)
+%% returns list of Node's adjacent nodes in interference graph IG
+%%
+node_adj_list(Node, IG) ->
+ hipe_adj_list:edges(Node, adj_list(IG)).
+
+%%
+%% node_spill_cost(Node, IG)
+%% returns the Node's spill cost
+%%
+node_spill_cost(Node, IG) ->
+ hipe_spillcost:spill_cost(Node, spill_costs(IG)).
+
+%%----------------------------------------------------------------------
+%% Print functions - only used for debugging
+
+-ifdef(DEBUG_PRINTOUTS).
+print_spill_costs(IG) ->
+ ?debug_msg("Spill costs:\n", []),
+ print_spill_costs(number_of_temps(IG), IG).
+
+print_spill_costs(0, _) ->
+ true;
+print_spill_costs(Node, IG) ->
+ NextNode = Node - 1,
+ case hipe_spillcost:nr_of_use(NextNode, spill_costs(IG)) of
+ 0 ->
+ ?debug_msg("node ~w not used\n", [NextNode]);
+ _ ->
+ ?debug_msg("node ~w sc ~p\n", [NextNode, node_spill_cost(NextNode, IG)])
+ end,
+ print_spill_costs(NextNode, IG).
+-endif.
+
+%%----------------------------------------------------------------------
+
+get_moves(IG) ->
+ hipe_ig_moves:get_moves(ig_moves(IG)).
+
+%%----------------------------------------------------------------------
+%% Function: add_edge
+%%
+%% Description: Adds an edge to the adj_set data structure if it is
+%% not already a part of it and if U is not precoloured
+%% we add V to its adj_list. If V is not precoloured
+%% we add U to its adj_list.
+%%
+%% Parameters:
+%% U -- A temporary number
+%% V -- A temporary number
+%% Target -- The module containing the target-specific functions
+%% Returns:
+%% An updated interference graph.
+%%----------------------------------------------------------------------
+
+add_edge(U, U, IG, _) -> IG;
+add_edge(U, V, IG, Target) ->
+ case nodes_are_adjacent(U, V, IG) of
+ true ->
+ IG;
+ false ->
+ _ = adjset_add_edge(U, V, adj_set(IG)),
+ Degree = degree(IG),
+ AdjList0 = interfere_if_uncolored(U, V, adj_list(IG), Degree, Target),
+ AdjList1 = interfere_if_uncolored(V, U, AdjList0, Degree, Target),
+ set_adj_list(AdjList1, IG)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: remove_edge
+%%
+%% Description: Removes an edge to the adj_set data-structure if it's
+%% a part of it and if U is not precoloured
+%% we remove V from it's adj_list. If V is not precoloured
+%% we remove U from it's adj_list.
+%%
+%% Parameters:
+%% U -- A temporary number
+%% V -- A temporary number
+%% Target -- The module containing the target-specific functions
+%% Returns:
+%% An updated interference graph.
+%%----------------------------------------------------------------------
+
+remove_edge(U, U, IG, _) -> IG;
+remove_edge(U, V, IG, Target) ->
+ case nodes_are_adjacent(U, V, IG) of
+ false ->
+ IG;
+ true ->
+ _ = adjset_remove_edge(U, V, adj_set(IG)),
+ Degree = degree(IG),
+ AdjList0 = remove_if_uncolored(U, V, adj_list(IG), Degree, Target),
+ AdjList1 = remove_if_uncolored(V, U, AdjList0, Degree, Target),
+ set_adj_list(AdjList1, IG)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: remove_if_uncolored
+%%
+%% Description:
+%%
+%% Parameters:
+%% Temporary -- A temporary that is added to the adjacent
+%% list if it's not precoloured.
+%% Interfere_temporary -- Temporary will interfere with
+%% Interfere_temporary if temporary is not
+%% precoloured.
+%% Adj_list -- An adj_list
+%% Degree -- The degree that all nodes currently have
+%% Target -- The module containing the target-specific
+%% functions
+%%
+%% Returns:
+%% Adj_list -- An updated adj_list data structure
+%% Degree -- An updated degree data structure (via side-effects)
+%%----------------------------------------------------------------------
+
+remove_if_uncolored(Temp, InterfereTemp, Adj_list, Degree, Target) ->
+ case Target:is_precoloured(Temp) of
+ false ->
+ New_adj_list = hipe_adj_list:remove_edge(Temp, InterfereTemp, Adj_list),
+ degree_dec(Temp, Degree),
+ New_adj_list;
+ true ->
+ Adj_list
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: interfere_if_uncolored
+%%
+%% Description: Let a not precoloured temporary interfere with another.
+%%
+%% Parameters:
+%% Temporary -- A temporary that is added to the adjacent
+%% list if it's not precoloured.
+%% Interfere_temporary -- Temporary will interfere with
+%% Interfere_temporary if temporary is not
+%% precoloured.
+%% Adj_list -- An adj_list
+%% Degree -- The degree that all nodes currently have
+%% Target -- The module containing the target-specific
+%% functions
+%%
+%% Returns:
+%% Adj_list -- An updated adj_list data structure
+%% Degree -- An updated degree data structure (via side-effects)
+%%----------------------------------------------------------------------
+
+interfere_if_uncolored(Temp, InterfereTemp, Adj_list, Degree, Target) ->
+ case Target:is_precoloured(Temp) of
+ false ->
+ New_adj_list = hipe_adj_list:add_edge(Temp, InterfereTemp, Adj_list),
+ degree_inc(Temp, Degree),
+ New_adj_list;
+ true ->
+ Adj_list
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: reg_numbers
+%%
+%% Description: Converts a list of tuple with {something, reg_number}
+%% to a list of register numbers.
+%%
+%% Parameters:
+%% TRs -- A list of temporary registers
+%% Target -- The module containing the target-specific functions
+%% Returns:
+%% A list of register numbers.
+%%----------------------------------------------------------------------
+
+reg_numbers(Regs, Target) ->
+ [Target:reg_nr(X) || X <- Regs].
+
+%%---------------------------------------------------------------------
+%% Print functions - only used for debugging
+
+-ifdef(DEBUG_PRINTOUTS).
+print_degrees(IG) ->
+ ?debug_msg("The nodes degrees:\n", []),
+ print_node_degree(number_of_temps(IG), IG).
+
+print_node_degree(0, _) ->
+ true;
+print_node_degree(Node, IG) ->
+ NextNode = Node - 1,
+ ?debug_msg("node ~w ~w\n", [NextNode, get_node_degree(NextNode, IG)]),
+ print_node_degree(NextNode, IG).
+-endif.
+
+%%----------------------------------------------------------------------
+
+get_node_degree(Node, IG) ->
+ degree_get(Node, degree(IG)).
+
+dec_node_degree(Node, IG) ->
+ degree_dec(Node, degree(IG)),
+ IG.
+
+is_trivially_colourable(Node, K, IG) ->
+ degree_is_trivially_colourable(Node, K, degree(IG)).
diff --git a/lib/hipe/regalloc/hipe_ig_moves.erl b/lib/hipe/regalloc/hipe_ig_moves.erl
new file mode 100644
index 0000000000..186c87a690
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_ig_moves.erl
@@ -0,0 +1,81 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%=============================================================================
+
+-module(hipe_ig_moves).
+-export([new/1,
+ new_move/3,
+ get_moves/1]).
+
+-include("../util/hipe_vectors.hrl").
+
+%%-----------------------------------------------------------------------------
+%% The main data structure; its fields are:
+%% - movelist : mapping from temp to set of associated move numbers
+%% - nrmoves : number of distinct move instructions seen so far
+%% - moveinsns : list of move instructions, in descending move number order
+%% - moveset : set of move instructions
+
+-record(ig_moves, {movelist :: hipe_vector(),
+ nrmoves = 0 :: non_neg_integer(),
+ moveinsns = [] :: [{_,_}],
+ moveset = gb_sets:empty() :: gb_set()}).
+
+%%-----------------------------------------------------------------------------
+
+-spec new(non_neg_integer()) -> #ig_moves{}.
+
+new(NrTemps) ->
+ MoveList = hipe_vectors:new(NrTemps, ordsets:new()),
+ #ig_moves{movelist = MoveList}.
+
+-spec new_move(_, _, #ig_moves{}) -> #ig_moves{}.
+
+new_move(Dst, Src, IG_moves) ->
+ MoveSet = IG_moves#ig_moves.moveset,
+ MoveInsn = {Dst, Src},
+ case gb_sets:is_member(MoveInsn, MoveSet) of
+ true ->
+ IG_moves;
+ false ->
+ MoveNr = IG_moves#ig_moves.nrmoves,
+ Movelist0 = IG_moves#ig_moves.movelist,
+ Movelist1 = add_movelist(MoveNr, Dst,
+ add_movelist(MoveNr, Src, Movelist0)),
+ IG_moves#ig_moves{nrmoves = MoveNr+1,
+ movelist = Movelist1,
+ moveinsns = [MoveInsn|IG_moves#ig_moves.moveinsns],
+ moveset = gb_sets:insert(MoveInsn, MoveSet)}
+ end.
+
+-spec add_movelist(non_neg_integer(), non_neg_integer(), hipe_vector()) -> hipe_vector().
+
+add_movelist(MoveNr, Temp, MoveList) ->
+ AssocMoves = hipe_vectors:get(MoveList, Temp),
+ %% XXX: MoveNr does not occur in moveList[Temp], but the new list must be an
+ %% ordset due to the ordsets:union in hipe_coalescing_regalloc:combine().
+ hipe_vectors:set(MoveList, Temp, ordsets:add_element(MoveNr, AssocMoves)).
+
+-spec get_moves(#ig_moves{}) -> {hipe_vector(), non_neg_integer(), tuple()}.
+
+get_moves(IG_moves) -> % -> {MoveList, NrMoves, MoveInsns}
+ {IG_moves#ig_moves.movelist,
+ IG_moves#ig_moves.nrmoves,
+ list_to_tuple(lists:reverse(IG_moves#ig_moves.moveinsns))}.
diff --git a/lib/hipe/regalloc/hipe_ls_regalloc.erl b/lib/hipe/regalloc/hipe_ls_regalloc.erl
new file mode 100644
index 0000000000..d06b938bea
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_ls_regalloc.erl
@@ -0,0 +1,788 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% =====================================================================
+%% @doc
+%% <pre>
+%% Module : hipe_ls_regalloc
+%% Purpose : Perform a register allocation based on the
+%% "linear-scan algorithm".
+%% Notes : * This is an implementation of
+%% "Linear Scan Register Allocation" by
+%% Massimiliano Poletto & Vivek Sarkar described in
+%% ACM TOPLAS Vol 21, No 5, September 1999.
+%%
+%% * This implementation is target-independent and
+%% requires a target specific interface module
+%% as argument.
+%% (Still waiting for a modular module system for Erlang.)
+%% </pre>
+%% @end
+%%
+%% History : * 2000-04-07 Erik Johansson (happi@it.uu.se): Created.
+%% * 2001-07-16 Erik Johansson: Made less sparc-specific.
+%% =====================================================================
+%% Exported functions (short description):
+%% regalloc(CFG,PhysRegs,Entrypoints, Options) ->
+%% {Coloring, NumberOfSpills}
+%% Takes a CFG and returns a coloring of all used registers.
+%% PhysRegs should be a list of available physical registers.
+%% Entrypoints should be a list of names of Basic Blocks that have
+%% external entry points.
+%%
+%% The Coloring will be in the form of the "allocation datastructure"
+%% described below, that is, a list of tuples on the form
+%% {Name, {reg, PhysicalRegister}} or
+%% {Name, {spill, SpillIndex}}
+%% The NumberOfSpills is either 0 indicating no spill or the
+%% SpillIndex of the last spilled register.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_ls_regalloc).
+-export([regalloc/7]).
+
+%%-define(DEBUG,1).
+-define(HIPE_INSTRUMENT_COMPILER, true).
+
+-include("../main/hipe.hrl").
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% @spec
+%% regalloc(CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options,
+%% Target) ->
+%% {Coloring, NumberOfSpills}
+%% CFG = cfg()
+%% PhysRegs = [reg()]
+%% Entrypoints = [labelname()]
+%% DontSpill = reg()
+%% Options = proplist:proplist()
+%% Target = atom()
+%% Coloring = [{temp(), pos()}]
+%% NumberOfSpills = integer()
+%% reg() = integer()
+%% temp() = integer()
+%% pos() = {reg, reg()} | {spill, integer()}
+%%
+%% @doc
+%% Calculates an allocation of registers using a linear_scan algorithm.
+%% There are three steps in the algorithm:
+%% <ol>
+%% <li> Calculate live-ranges for all registers.</li>
+%% <li> Calculate live-intervals for each register.
+%% The live interval consists of a start position and an end
+%% position. These are the first definition and last use of the
+%% register given as instruction numbers in a breadth-first
+%% traversal of the control-flow-graph.</li>
+%% <li> Perform a linear scan allocation over the live intervals.</li>
+%% </ol>
+%% @end
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+regalloc(CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target) ->
+ ?debug_msg("LinearScan: ~w\n", [erlang:statistics(runtime)]),
+ %% Step 1: Calculate liveness (Call external implementation.)
+ Liveness = liveness(CFG, Target),
+ ?debug_msg("liveness (done)~w\n", [erlang:statistics(runtime)]),
+ USIntervals = calculate_intervals(CFG, Liveness,
+ Entrypoints, Options, Target),
+ ?debug_msg("intervals (done) ~w\n", [erlang:statistics(runtime)]),
+ Intervals = sort_on_start(USIntervals),
+ ?debug_msg("sort intervals (done) ~w\n", [erlang:statistics(runtime)]),
+ %% ?debug_msg("Intervals ~w\n", [Intervals]),
+ ?debug_msg("No intervals: ~w\n",[length(Intervals)]),
+ ?debug_msg("count intervals (done) ~w\n", [erlang:statistics(runtime)]),
+ Allocation = allocate(Intervals, PhysRegs, SpillIndex, DontSpill, Target),
+ ?debug_msg("allocation (done) ~w\n", [erlang:statistics(runtime)]),
+ Allocation.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Step 2: Calculate live-intervals for each register. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% calculate_intervals(CFG,Liveness,Entrypoints, Options, Target)
+%% CFG: The Control-Flow Graph.
+%% Liveness: A map of live-in and live-out sets for each Basic-Block.
+%% Entrypoints: A set of BB names that have external entrypoints.
+%%
+calculate_intervals(CFG,Liveness,_Entrypoints, Options, Target) ->
+ %% Add start point for the argument registers.
+ Args = arg_vars(CFG, Target),
+ Interval =
+ add_def_point(Args, 0, empty_interval(Target:number_of_temporaries(CFG))),
+ %% Interval = add_livepoint(Args, 0, empty_interval()),
+ Worklist =
+ case proplists:get_value(ls_order, Options) of
+ reversepostorder ->
+ Target:reverse_postorder(CFG);
+ breadth ->
+ Target:breadthorder(CFG);
+ postorder ->
+ Target:postorder(CFG);
+ inorder ->
+ Target:inorder(CFG);
+ reverse_inorder ->
+ Target:reverse_inorder(CFG);
+ preorder ->
+ Target:preorder(CFG);
+ prediction ->
+ Target:predictionorder(CFG);
+ random ->
+ Target:labels(CFG);
+ _ ->
+ Target:reverse_postorder(CFG)
+ end,
+ %% ?inc_counter(bbs_counter, length(Worklist)),
+ %% ?debug_msg("No BBs ~w\n",[length(Worklist)]),
+ intervals(Worklist, Interval, 1, CFG, Liveness, Target).
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% intervals(WorkList, Intervals, InstructionNr, CFG, Liveness, Target)
+%% WorkList: List of BB-names to handle.
+%% Intervals: Intervals seen so far (sorted on register names).
+%% InstructionNr: The number of examined insturctions.
+%% CFG: The Control-Flow Graph.
+%% Liveness: A map of live-in and live-out sets for each Basic-Block.
+%% Target: The backend for which we generate code.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+intervals([L|ToDO], Intervals, InstructionNr, CFG, Liveness, Target) ->
+ %% Add all variables that are live at the entry of this block
+ %% to the interval data structure.
+ LiveIn = livein(Liveness, L, Target),
+ Intervals2 = add_def_point(LiveIn, InstructionNr, Intervals),
+ LiveOut = liveout(Liveness, L, Target),
+
+ %% Traverse this block instruction by instruction and add all
+ %% uses and defines to the intervals.
+ Code = hipe_bb:code(bb(CFG, L, Target)),
+ {Intervals3, NewINr} =
+ traverse_block(Code, InstructionNr+1, Intervals2, Target),
+
+ %% Add end points for the registers that are in the live-out set.
+ Intervals4 = add_use_point(LiveOut, NewINr+1, Intervals3),
+
+ intervals(ToDO, Intervals4, NewINr+1, CFG, Liveness, Target);
+intervals([], Intervals, _, _, _, _) ->
+ %% Return the calculated intervals
+ LI = interval_to_list(Intervals),
+ %% io:format("Intervals:~n~p~n", [LI]),
+ LI.
+
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% traverse_block(Code, InstructionNo, Intervals, Unchanged)
+%% Examine each instruction in the Code:
+%% For each temporary T used or defined by instruction number N:
+%% extend the interval of T to include N.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+traverse_block([Instruction|Is],InstrNo,Intervals, Target) ->
+ %% Get defined temps.
+ DefsSet = defines(Instruction, Target),
+ Intervals1 = add_def_point(DefsSet, InstrNo, Intervals),
+
+ %% Get used temps.
+ UsesSet = uses(Instruction, Target),
+ %% Extend the intervals for these temporaries to include InstrNo.
+ Intervals2 = add_use_point(UsesSet, InstrNo, Intervals1),
+
+ %% Handle the next instruction.
+ traverse_block(Is,InstrNo+1,Intervals2,Target);
+traverse_block([], InstrNo, Intervals, _) ->
+ %% Return the new intervals and the number of the next instruction.
+ {Intervals,InstrNo}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Step 3. Do a linear scan allocation over the live intervals. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% allocate(Intervals, PhysicalRegisters, DontSpill, Target)
+%%
+%% This function performs the linear scan algorithm.
+%% Intervals contains the start and stop position of each register,
+%% sorted on increasing startpositions
+%% PhysicalRegisters is a list of available Physical registers to use.
+%%
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+allocate(Intervals, PhysRegs, SpillIndex, DontSpill, Target) ->
+ ActiveRegisters =[],
+ AllocatedRegisters = empty_allocation(),
+ AllFree = create_freeregs(PhysRegs),
+ allocate(Intervals, AllFree, ActiveRegisters,
+ AllocatedRegisters, SpillIndex, DontSpill, Target).
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+%% allocate(Intervals, Free, Active, Allocated, SpillIndex, Target)
+%% Iterates of each register interval.
+%% Intervals: The list of register intervals.
+%% Free: Currently available physical registers.
+%% Active: Currently used physical registers (sorted on increasing
+%% interval enpoints)
+%% Allocated: The mapping of register names to physical registers or
+%% to spill positions.
+%% SpillIndex: The number of spilled registers.
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+allocate([RegInt|RIS], Free, Active, Alloc, SpillIndex, DontSpill, Target) ->
+ %io:format("~nAlloc:~n~p", [Alloc]),
+ %% Remove from the active list those registers who's intervals
+ %% ends before the start of the current interval.
+ {NewActive, NewFree} =
+ expire_old_intervals(Active, startpoint(RegInt), Free, Target),
+ ?debug_msg("Alloc interval: ~w, Free ~w\n",[RegInt, NewFree]),
+ %% Get the name of the temp in the current interval.
+ Temp = reg(RegInt),
+ case is_precoloured(Temp, Target) of
+ true ->
+ %% This is a precoloured register we don't need to find a color
+ %% Get the physical name of the register.
+ PhysName = physical_name(Temp, Target),
+ %% Bind it to the precoloured name.
+ NewAlloc = alloc(Temp, PhysName, Alloc),
+ case is_global(Temp, Target) of
+ true ->
+ %% this is a global precoloured register
+ allocate(RIS, NewFree, NewActive,
+ NewAlloc, SpillIndex, DontSpill, Target);
+ false ->
+ case is_free(PhysName, NewFree) of
+ {true,Rest} ->
+ allocate(RIS, Rest,
+ add_active(endpoint(RegInt), startpoint(RegInt),
+ PhysName, Temp, NewActive),
+ NewAlloc,
+ SpillIndex, DontSpill, Target);
+ false ->
+ %% Some other temp has taken this precoloured register,
+ %% throw it out.
+ {OtherActive, NewActive2} = deactivate(PhysName, NewActive),
+ OtherTemp = active_name(OtherActive),
+ OtherEnd = active_endpoint(OtherActive),
+ OtherStart = active_startpoint(OtherActive),
+ NewActive3 = add_active(endpoint(RegInt), startpoint(RegInt),
+ PhysName, Temp, NewActive2),
+ case exists_free_register(OtherStart, NewFree) of
+ {true, NewPhys, RestFree} ->
+ allocate(RIS, RestFree,
+ add_active(OtherEnd, OtherStart,
+ NewPhys, OtherTemp, NewActive3),
+ alloc(OtherTemp,NewPhys,NewAlloc),
+ SpillIndex, DontSpill, Target);
+ false ->
+ NewSpillIndex = Target:new_spill_index(SpillIndex),
+ {NewAlloc2, NewActive4} =
+ spill(OtherTemp, OtherEnd, OtherStart, NewActive3,
+ NewAlloc, SpillIndex, DontSpill, Target),
+ allocate(RIS,
+ NewFree,
+ NewActive4,
+ NewAlloc2, NewSpillIndex, DontSpill, Target)
+ end
+ end
+ end;
+ false ->
+ %% This is not a precoloured register.
+ case NewFree of
+ [] ->
+ %% No physical registers available, we have to spill.
+ NewSpillIndex = Target:new_spill_index(SpillIndex),
+ {NewAlloc, NewActive2} =
+ spill(Temp, endpoint(RegInt), startpoint(RegInt),
+ Active, Alloc, SpillIndex, DontSpill, Target),
+ %% io:format("Spilled ~w\n",[NewAlloc]),
+ allocate(RIS, NewFree, NewActive2, NewAlloc, NewSpillIndex,
+ DontSpill, Target);
+
+ [{FreeReg,_Start} | Regs] ->
+ %% The register FreeReg is available, let's use it.
+ %%io:format("Allocating Reg:~p~n",[FreeReg]),
+ allocate(RIS,Regs,
+ add_active(endpoint(RegInt), startpoint(RegInt),
+ FreeReg, Temp, NewActive),
+ alloc(Temp, FreeReg, Alloc),
+ SpillIndex, DontSpill, Target)
+ end
+ end;
+allocate([],_,_,Alloc,SpillIndex, _, _) ->
+ %% No more register intervals to handle
+ %% return the result.
+ %%io:format("~nAlloc:~n~p", [Alloc]),
+ {Alloc, SpillIndex}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% expire_old_intervals(ActiveRegisters, CurrentPos, FreeRegisters)
+%% Remove all registers that have live-ranges that ends before the
+%% current position from the active list and put them into the free
+%% list instead.
+%%
+%% ---------------------------------------------------------------------
+expire_old_intervals([Act|Acts] = AllActives, CurrentPos, Free, Target) ->
+ %% Does the live-range of the first active register end before
+ %% the current position?
+
+ %% We expand multimove before regalloc, ignore the next 2 lines.
+ %% %% We don't free registers that end at the current position,
+ %% %% since a multimove can decide to do the moves in another order...
+ case active_endpoint(Act) =< CurrentPos of
+ true -> %% Yes -> Then we can free that register.
+ Reg = active_reg(Act),
+ %% Add the register to the free pool.
+ NewFree =
+ case is_arg(Reg, Target) of
+ true ->
+ [{Reg, CurrentPos}|Free];
+ false ->
+ [{Reg, CurrentPos}|Free]
+ %% Here we could try appending the
+ %% register to get a more widespread
+ %% use of registers.
+ %% Free ++ [active_reg(Act)]);
+ %% At the moment this does not seem to
+ %% improve performance at all,
+ %% on the other hand, the cost is very low.
+ end,
+ expire_old_intervals(Acts, CurrentPos, NewFree, Target);
+ false ->
+ %% No -> Then we cannot free any more registers.
+ %% (Since they are sorted on endpoints...)
+ {AllActives, Free}
+ end;
+expire_old_intervals([], _, Free, _) ->
+ {[], Free}.
+
+deactivate(Reg, [Active|Actives]) ->
+ case Reg =:= active_reg(Active) of
+ true ->
+ {Active, Actives};
+ false ->
+ {TheActive, NewActives} = deactivate(Reg, Actives),
+ {TheActive, [Active|NewActives]}
+ end;
+deactivate(_,[]) -> {no,[]}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% spill(CurrentReg, CurrentEndpoint, Active, Alloc, SpillIndex,
+%% DontSpill, Target)
+%% Find the register with the longest live range and spill it to memory.
+%%
+%% ---------------------------------------------------------------------
+spill(CurrentReg, CurrentEndpoint,CurrentStartpoint,
+ Active = [_|_],
+ Alloc, SpillIndex,
+ DontSpill, Target) ->
+ ?debug_msg("spilling one of ~w\nDOnt spill ~w\n",
+ [[CurrentReg|Active], DontSpill]),
+
+ %% Find a spill candidate (one of the active):
+ %% The register with the longest live-range.
+ {NewActive, SpillCandidate} = butlast_last(Active),
+
+ SpillStartpoint = active_startpoint(SpillCandidate) ,
+ SpillEndpoint = active_endpoint(SpillCandidate) ,
+ SpillName = active_name(SpillCandidate),
+ SpillPhysName = active_reg(SpillCandidate),
+
+ case SpillEndpoint > CurrentEndpoint of
+ true ->
+ %% There is an already allocated register that has
+ %% a longer live-range than the current register.
+ case can_spill(SpillName, DontSpill, Target) and
+ (SpillStartpoint =< CurrentStartpoint) of
+ false ->
+ {NewAlloc, NewActive2} =
+ spill(CurrentReg, CurrentEndpoint, CurrentStartpoint,
+ NewActive, Alloc, SpillIndex, DontSpill, Target),
+ {NewAlloc,
+ add_active(SpillEndpoint, SpillStartpoint, SpillPhysName,
+ SpillName, NewActive2)};
+ true ->
+ %% It is not precoloured... or have too short liverange
+
+ %% Allocate SpillCandidate to spill-slot SpillIndex
+ SpillAlloc =
+ spillalloc(active_name(SpillCandidate), SpillIndex,
+ Alloc),
+
+ %% Allocated the current register to the physical register
+ %% used by the spill candidate.
+ NewAlloc = alloc(CurrentReg, SpillPhysName, SpillAlloc),
+
+ %% Add the current register to the active registers
+ NewActive2 =
+ add_active(CurrentEndpoint, CurrentStartpoint,
+ SpillPhysName, CurrentReg, NewActive),
+ {NewAlloc, NewActive2}
+ end;
+
+ false ->
+ %% The current register has the longest live-range.
+
+ case can_spill(CurrentReg, DontSpill, Target) of
+ false ->
+ %% Cannot spill a precoloured register
+ {NewAlloc, NewActive2} =
+ spill(SpillName, SpillEndpoint, SpillStartpoint,
+ NewActive, Alloc, SpillIndex, DontSpill, Target),
+ NewActive3 =
+ add_active(CurrentEndpoint, CurrentStartpoint,
+ SpillPhysName, CurrentReg, NewActive2),
+ {NewAlloc, NewActive3};
+ true ->
+ %% It is not precoloured...
+ %% Allocate the current register to spill-slot SpillIndex
+ {spillalloc(CurrentReg, SpillIndex, Alloc), Active}
+ end
+ end;
+spill(CurrentReg, _CurrentEndpoint, _CurrentStartpoint, [],
+ Alloc, SpillIndex, DontSpill, Target) ->
+ case can_spill(CurrentReg, DontSpill, Target) of
+ false -> %% Can't spill current!
+ ?error_msg("Can't allocate registers\n",[]),
+ ?EXIT({cannot_allocate_regs});
+ true -> %% Can spill current.
+ %% Allocate the current register to spill-slot SpillIndex
+ {spillalloc(CurrentReg, SpillIndex, Alloc), []}
+ end.
+
+can_spill(Name, DontSpill, Target) ->
+ (Name < DontSpill) and (not is_precoloured(Name, Target)).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% D A T A S T R U C T U R E S %%
+%% & %%
+%% A U X I L I A R Y F U N C T I O N S %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The "allocation datastructure"
+%%
+%% This is an order list of register names paired with their allocations.
+%% {Name, Allocation}
+%% The allocation is either {reg, physical register} or
+%% {spill, spill index}
+%%
+%% ---------------------------------------------------------------------
+empty_allocation() -> [].
+
+alloc(Name,Reg,[{Name,_}|A]) ->
+ [{Name,{reg,Reg}}|A];
+alloc(Name,Reg,[{Name2,Binding}|Bindings]) when Name > Name2 ->
+ [{Name2,Binding}|alloc(Name,Reg,Bindings)];
+alloc(Name,Reg,Bindings) ->
+ [{Name,{reg,Reg}}|Bindings].
+
+spillalloc(Name,N,[{Name,_}|A]) ->
+ ?debug_msg("Spilled ~w\n",[Name]),
+ [{Name,{spill,N}}|A];
+spillalloc(Name,N,[{Name2,Binding}|Bindings]) when Name > Name2 ->
+ [{Name2,Binding}|spillalloc(Name,N,Bindings)];
+spillalloc(Name,N,Bindings) ->
+ [{Name,{spill,N}}|Bindings].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%%
+butlast_last([X]) ->
+ {[],X};
+butlast_last([X|Y]) ->
+ {L,Last} = butlast_last(Y),
+ {[X|L],Last}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The active datastructure.
+%% Keeps tracks of currently active (allocated) physical registers.
+%% It is sorted on end points in the intervals
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+add_active(Endpoint, StartPoint, PhysReg, RegName,
+ [{P1,R1,O1,S1}|Active]) when P1 < Endpoint ->
+ [{P1,R1,O1,S1}|add_active(Endpoint, StartPoint, PhysReg, RegName, Active)];
+add_active(Endpoint, StartPoint, PhysReg, RegName, Active) ->
+ [{Endpoint, PhysReg, RegName, StartPoint}|Active].
+
+active_reg({_,PhysReg,_,_}) ->
+ PhysReg.
+active_endpoint({EndPoint,_,_,_}) ->
+ EndPoint.
+active_startpoint({_,_,_,StartPoint}) ->
+ StartPoint.
+active_name({_,_,RegName,_}) ->
+ RegName.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Interval data structure.
+%%
+%%
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+
+%% mk_interval(Name, Start, End) ->
+%% {Name, Start, End}.
+
+endpoint({_R,_S,Endpoint}) ->
+ Endpoint.
+startpoint({_R,Startpoint,_E}) ->
+ Startpoint.
+reg({RegName,_S,_E}) ->
+ RegName.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Intervals data structure.
+
+sort_on_start(I) ->
+ lists:keysort(2, I).
+
+-ifdef(gb_intervals).
+empty_interval(_) ->
+ gb_trees:empty().
+
+interval_to_list(Intervals) ->
+ lists:flatten(
+ lists:map(
+ fun({T, I}) when list(I) ->
+ lists:map(
+ fun ({none, End}) ->
+ {T,End,End};
+ ({Beg, none}) ->
+ {T,Beg, Beg}
+ end,
+ I);
+ ({T,{B,E}}) -> {T, B, E}
+ end,
+ gb_trees:to_list(Intervals))).
+
+add_use_point([Temp|Temps],Pos,Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case gb_trees:lookup(Temp, Intervals) of
+ %% This temp has an old interval...
+ {value, Value} ->
+ %% ... extend it.
+ extend_interval(Pos, Value);
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos}
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = gb_trees:enter(Temp, NewInterval, Intervals),
+ %% Add the rest of teh temporaries.
+ add_use_point(Temps, Pos, Intervals2);
+add_use_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+add_def_point([Temp|Temps],Pos,Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case gb_trees:lookup(Temp, Intervals) of
+ %% This temp has an old interval...
+ {value, Value} ->
+ %% ... extend it.
+ extend_interval(Pos, Value);
+
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos}
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = gb_trees:enter(Temp, NewInterval, Intervals),
+ %% Add the rest of the temporaries.
+ add_def_point(Temps, Pos, Intervals2);
+add_def_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+extend_interval(Pos, {Beginning, End}) ->
+ %% If this position occures before the beginning
+ %% of the interval, then extend the beginning to
+ %% this position.
+ NewBeginning = erlang:min(Pos, Beginning),
+ %% If this position occures after the end
+ %% of the interval, then extend the end to
+ %% this position.
+ NewEnd = erlang:max(Pos, End),
+ {NewBeginning, NewEnd}.
+
+-else. %% isdef gb_intervals
+
+empty_interval(N) ->
+ hipe_vectors:new(N, none).
+
+interval_to_list(Intervals) ->
+ add_indices(hipe_vectors:vector_to_list(Intervals),0).
+
+add_indices([{B,E}|Xs],N) ->
+ [{N,B,E}|add_indices(Xs,N+1)];
+add_indices([List|Xs],N) when is_list(List) ->
+ flatten(List,N,Xs);
+add_indices([none|Xs],N) ->
+ add_indices(Xs,N+1);
+add_indices([],_N) -> [].
+
+flatten([{none, End}|Rest], N, More) ->
+ [{N,End,End} | flatten(Rest, N, More)];
+flatten([{Beg, none}|Rest], N ,More) ->
+ [{N,Beg,Beg} | flatten(Rest, N, More)];
+flatten([],N,More) ->
+ add_indices(More,N+1).
+
+add_use_point([Temp|Temps],Pos,Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case hipe_vectors:get(Intervals, Temp) of
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos};
+ %% This temp has an old interval...
+ Value ->
+ %% ... extend it.
+ extend_interval(Pos, Value)
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = hipe_vectors:set(Intervals, Temp, NewInterval),
+ %% Add the rest of the temporaries.
+ add_use_point(Temps, Pos, Intervals2);
+add_use_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+add_def_point([Temp|Temps],Pos,Intervals) ->
+ %% Extend the old interval...
+ NewInterval =
+ case hipe_vectors:get(Intervals, Temp) of
+ %% This is the first time we see this temp...
+ none ->
+ %% ... create a new interval
+ {Pos, Pos};
+ %% This temp has an old interval...
+ Value ->
+ %% ... extend it.
+ extend_interval(Pos, Value)
+ end,
+ %% Add or update the extended interval.
+ Intervals2 = hipe_vectors:set(Intervals, Temp, NewInterval),
+ %% Add the rest of teh temporaries.
+ add_def_point(Temps, Pos, Intervals2);
+add_def_point([], _, I) ->
+ %% No more to add return the interval.
+ I.
+
+extend_interval(Pos, {Beginning, End}) ->
+ %% If this position occurs before the beginning of the interval,
+ %% then extend the beginning to this position.
+ NewBeginning = erlang:min(Pos, Beginning),
+ %% If this position occures after the end
+ %% of the interval, then extend the end to
+ %% this position.
+ NewEnd = erlang:max(Pos, End),
+ {NewBeginning, NewEnd}.
+-endif. %% gb_intervals
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The Freel data structure.
+%%
+%%- - - - - - - - - - - - - - - - - - - - - - - -
+
+is_free(R, Free) ->
+ is_free(R, Free, []).
+
+is_free(R, [{R,_}|Rest], Acc) ->
+ {true,lists:reverse(Acc)++Rest};
+is_free(R, [X|Rs],Acc) ->
+ is_free(R, Rs, [X|Acc]);
+is_free(_, [], _) ->
+ false.
+
+exists_free_register(Start, Regs) ->
+ exists_free_register(Start, Regs, []).
+
+exists_free_register(Start, [{Phys, Start0}|Rest], Acc)
+ when Start > Start0 ->
+ {true, Phys, lists:reverse(Acc)++Rest};
+exists_free_register(Start, [Free|Rest], Acc) ->
+ exists_free_register(Start, Rest, [Free|Acc]);
+exists_free_register(_, [], _) ->
+ false.
+
+create_freeregs([Phys|Rest]) ->
+ [{Phys,-1}|create_freeregs(Rest)];
+create_freeregs([]) ->
+ [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface to external functions.
+%% XXX: Make this efficient somehow...
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+liveness(CFG, Target) ->
+ Target:analyze(CFG).
+
+bb(CFG, L, Target) ->
+ Target:bb(CFG,L).
+
+livein(Liveness,L, Target) ->
+ regnames(Target:livein(Liveness,L), Target).
+
+liveout(Liveness,L, Target) ->
+ regnames(Target:liveout(Liveness,L), Target).
+
+uses(I, Target) ->
+ regnames(Target:uses(I), Target).
+
+defines(I, Target) ->
+ regnames(Target:defines(I), Target).
+
+is_precoloured(R, Target) ->
+ Target:is_precoloured(R).
+
+is_global(R, Target) ->
+ Target:is_global(R).
+
+physical_name(R, Target) ->
+ Target:physical_name(R).
+
+regnames(Regs, Target) ->
+ [Target:reg_nr(X) || X <- Regs].
+
+arg_vars(CFG, Target) ->
+ Target:args(CFG).
+
+is_arg(Reg, Target) ->
+ Target:is_arg(Reg).
diff --git a/lib/hipe/regalloc/hipe_moves.erl b/lib/hipe/regalloc/hipe_moves.erl
new file mode 100644
index 0000000000..afec4aa4ce
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_moves.erl
@@ -0,0 +1,165 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_moves).
+-export([new/1,
+ update_movelist/3,
+ node_moves/2,
+ move_related/2,
+ node_movelist/2,
+ get_move/2,
+ is_empty_worklist/1,
+ worklist_get_and_remove/1,
+ remove_worklist/2,
+ remove_active/2,
+ add_worklist/2,
+ add_active/2,
+ member_active/2
+ ]).
+-ifdef(DEBUG_PRINTOUTS).
+-export([print_memberships/1]).
+-endif.
+
+-record(movesets,
+ {worklist, % Moves enabled for possible coalescing
+ membership, % Maps move numbers to 'worklist' or 'active' or 'none'
+ moveinsns, % Maps move numbers to move insns ({Dst,Src}-tuples)
+ movelist % Mapping from node to list of moves it's associated with
+ }).
+
+%%-ifndef(DEBUG).
+%%-define(DEBUG,true).
+%%-endif.
+-include("../main/hipe.hrl").
+
+worklist(MoveSets) -> MoveSets#movesets.worklist.
+movelist(MoveSets) -> MoveSets#movesets.movelist.
+
+set_worklist(New_worklist, MoveSets) ->
+ MoveSets#movesets{worklist = New_worklist}.
+set_movelist(New_movelist, MoveSets) ->
+ MoveSets#movesets{movelist = New_movelist}.
+
+update_movelist(Node, MoveList, MoveSets) ->
+ set_movelist(hipe_vectors:set(movelist(MoveSets), Node, MoveList),
+ MoveSets).
+
+new(IG) ->
+ {MoveList,NrMoves,MoveInsns} = hipe_ig:get_moves(IG),
+ Worklist = case NrMoves of 0 -> []; _ -> lists:seq(0, NrMoves-1) end,
+ #movesets{worklist = Worklist,
+ membership = hipe_bifs:array(NrMoves, 'worklist'),
+ moveinsns = MoveInsns,
+ movelist = MoveList}.
+
+remove_worklist(Element, MoveSets) ->
+ Membership = MoveSets#movesets.membership,
+ %% check for 'worklist' membership here, if debugging
+ hipe_bifs:array_update(Membership, Element, 'none'),
+ %% Implementing this faithfully would require a SET structure, such
+ %% as an ordset or a gb_set. However, removal of elements not at the
+ %% head of the structure is a fairly infrequent event (only done by
+ %% FreezeMoves()), so instead we let the elements remain but mark
+ %% them as being removed. It is the task of worklist_get_and_remove()
+ %% to filter out any stale elements.
+ MoveSets.
+
+remove_active(Element, MoveSets) ->
+ Membership = MoveSets#movesets.membership,
+ %% check for 'active' membership here, if debugging
+ hipe_bifs:array_update(Membership, Element, 'none'),
+ MoveSets.
+
+add_worklist(Element, MoveSets) ->
+ Membership = MoveSets#movesets.membership,
+ %% check for 'none' membership here, if debugging
+ hipe_bifs:array_update(Membership, Element, 'worklist'),
+ set_worklist([Element | worklist(MoveSets)], MoveSets).
+
+add_active(Element, MoveSets) ->
+ Membership = MoveSets#movesets.membership,
+ %% check for 'none' membership here, if debugging
+ hipe_bifs:array_update(Membership, Element, 'active'),
+ MoveSets.
+
+member_active(Element, MoveSets) ->
+ hipe_bifs:array_sub(MoveSets#movesets.membership, Element) =:= 'active'.
+
+is_empty_worklist(MoveSets) ->
+ %% This is an approximation. See worklist_get_and_remove().
+ worklist(MoveSets) =:= [].
+
+worklist_get_and_remove(MoveSets) ->
+ worklist_get_and_remove(worklist(MoveSets), MoveSets#movesets.membership, MoveSets).
+
+worklist_get_and_remove([], _Membership, MoveSets) ->
+ {[], set_worklist([], MoveSets)};
+worklist_get_and_remove([Move|Worklist], Membership, MoveSets) ->
+ case hipe_bifs:array_sub(Membership, Move) of
+ 'worklist' ->
+ hipe_bifs:array_update(Membership, Move, 'none'),
+ {Move, set_worklist(Worklist, MoveSets)};
+ _ ->
+ worklist_get_and_remove(Worklist, Membership, MoveSets)
+ end.
+
+node_moves(Node, MoveSets) ->
+ Associated = node_movelist(Node, MoveSets),
+ Membership = MoveSets#movesets.membership,
+ %% The ordsets:union() in hipe_coalescing_regalloc:combine()
+ %% constrains us to return an ordset here.
+ [X || X <- Associated, hipe_bifs:array_sub(Membership, X) =/= 'none'].
+
+move_related(Node, MoveSets) ->
+ %% Same as node_moves(Node, MoveSets) =/= [], but less expensive to compute.
+ %% XXX: George&Appel'96 hints that this should be maintained as a per-node counter.
+ move_related2(node_movelist(Node, MoveSets), MoveSets#movesets.membership).
+
+move_related2([], _Membership) -> false;
+move_related2([Move|MoveSets], Membership) ->
+ case hipe_bifs:array_sub(Membership, Move) of
+ 'none' -> move_related2(MoveSets, Membership);
+ _ -> true % 'active' or 'worklist'
+ end.
+
+node_movelist(Node, MoveSets) ->
+ hipe_vectors:get(movelist(MoveSets), Node).
+
+get_move(Move, MoveSets) ->
+ element(Move+1, MoveSets#movesets.moveinsns).
+
+%%----------------------------------------------------------------------
+%% Print functions - only used for debugging
+
+-ifdef(DEBUG_PRINTOUTS).
+print_memberships(MoveSets) ->
+ ?debug_msg("Move memeberships:\n", []),
+ Membership = MoveSets#movesets.membership,
+ NrMoves = hipe_bifs:array_length(Membership),
+ print_membership(NrMoves, Membership).
+
+print_membership(0, _) ->
+ true;
+print_membership(Element, Membership) ->
+ NextElement = Element - 1,
+ ?debug_msg("move ~w ~w\n", [NextElement, hipe_bifs:array_sub(Membership, NextElement)]),
+ print_membership(NextElement, Membership).
+-endif.
+
diff --git a/lib/hipe/regalloc/hipe_node_sets.erl b/lib/hipe/regalloc/hipe_node_sets.erl
new file mode 100644
index 0000000000..b5e2971c4d
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_node_sets.erl
@@ -0,0 +1,48 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_node_sets).
+
+-export([new/0,
+ spilled/1,
+ colored/1,
+ add_spilled/2,
+ add_colored/2
+ ]).
+
+-record(node_sets,
+ {spilled, % Nodes marked for spilling
+ colored % Nodes succesfully colored
+ }).
+
+spilled(Node_sets) -> Node_sets#node_sets.spilled.
+colored(Node_sets) -> Node_sets#node_sets.colored.
+
+set_spilled(Spilled, Node_sets) -> Node_sets#node_sets{spilled = Spilled}.
+set_colored(Colored, Node_sets) -> Node_sets#node_sets{colored = Colored}.
+
+new() ->
+ #node_sets{spilled = [], colored = []}.
+
+add_spilled(Node, Node_sets) ->
+ set_spilled([Node | spilled(Node_sets)], Node_sets).
+
+add_colored(Node, Node_sets) ->
+ set_colored([Node | colored(Node_sets)], Node_sets).
diff --git a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl
new file mode 100644
index 0000000000..183ec1994c
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl
@@ -0,0 +1,2043 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------
+%% File : hipe_optimistic_regalloc.erl
+%% Authors : NilsOla Linnermark <nilsola@abc.se>
+%% Petter Holmberg <petter.holmberg@usa.net>
+%% Purpose : Play paintball with registers on a target machine. We win
+%% if they are all colored. This is an optimistic coalescing
+%% register allocator.
+%% Created : Spring 2005
+%%-----------------------------------------------------------------------
+
+-module(hipe_optimistic_regalloc).
+-export([regalloc/5]).
+
+-ifndef(DEBUG).
+%%-define(DEBUG,true).
+-else.
+-ifndef(COMPARE_ITERATED_OPTIMISTIC).
+%% If this macro is turned on you can easily compare
+%% each intermediate step in the iterated coalescing
+%% register allocator and the optimitsitc coalescing
+%% register allocator. This is useful for debugging -
+%% many small erlang functions should render the same
+%% register allocaton for both allocators.
+-define(COMPARE_ITERATED_OPTIMISTIC, true).
+-endif.
+-endif.
+-include("../main/hipe.hrl").
+-ifdef(DEBUG_PRINTOUTS).
+-define(print_adjacent(IG), hipe_ig:print_adjacent(IG)).
+-define(print_degrees(IG), hipe_ig:print_degrees(IG)).
+-define(print_spill_costs(IG), hipe_ig:print_spill_costs(IG)).
+-define(mov_print_memberships(MV), hipe_moves:print_memberships(MV)).
+-define(reg_print_memberships(WL), hipe_reg_worklists:print_memberships(WL)).
+-define(print_alias(A), printAlias(A)).
+-define(print_colors(T,C), printColors(T,C)).
+-else.
+-define(print_adjacent(IG), no_print).
+-define(print_degrees(IG), no_print).
+-define(print_spill_costs(IG), no_print).
+-define(mov_print_memberships(MV), no_print).
+-define(reg_print_memberships(WL), no_print).
+-define(print_alias(A), no_print).
+-define(print_colors(T,C), no_print).
+-endif.
+
+
+%%-----------------------------------------------------------------------
+%% Function: regalloc
+%%
+%% Description: Creates a K coloring for a function.
+%% Parameters:
+%% CFG -- A control flow graph
+%% SpillIndex -- Last index of spill variable
+%% SpillLimit -- Temporaris with numbers higher than this have
+%% infinit spill cost.
+%% Consider changing this to a set.
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% Coloring -- A coloring for specified CFG
+%% SpillIndex0 -- A new spill index
+%%-----------------------------------------------------------------------
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+regalloc(CFG, SpillIndex, SpillLimit, Target, _Options) ->
+ ?debug_msg("optimistic ~w\n",[Target]),
+ ?debug_msg("CFG: ~p\n",[CFG]),
+ %% Build interference graph
+ ?debug_msg("Build IG\n",[]),
+ IG_O = hipe_ig:build(CFG, Target),
+ IG = hipe_ig:build(CFG, Target),
+ ?debug_msg("adjlist: ~p\n",[hipe_ig:adj_list(IG)]),
+ ?debug_msg("IG:\n",[]),
+ ?print_adjacent(IG),
+ ?print_degrees(IG),
+ ?print_spill_costs(IG),
+
+ SavedSpillCosts = hipe_ig:spill_costs(IG),
+ SavedAdjList = hipe_ig:adj_list(IG),
+
+ ?debug_msg("Init\n",[]),
+ No_temporaries = Target:number_of_temporaries(CFG),
+ ?debug_msg("Coalescing RA: num_temps = ~p~n", [No_temporaries]),
+ Allocatable = Target:allocatable(),
+ K = length(Allocatable),
+ All_colors = colset_from_list(Allocatable),
+ ?debug_msg("K: ~w~nAll_colors: ~p\n",[K, All_colors]),
+
+ %% Add registers with their own coloring
+ ?debug_msg("Moves\n",[]),
+ Move_sets_O = hipe_moves:new(IG_O),
+ Move_sets = hipe_moves:new(IG),
+ ?debug_msg("Move_sets:\n ~p\n",[Move_sets]),
+ ?mov_print_memberships(Move_sets),
+
+ ?debug_msg("Build Worklist\n",[]),
+ Worklists_O = hipe_reg_worklists:new(IG_O, Target, CFG, Move_sets_O, K, No_temporaries),
+ ?debug_msg("Worklists:\n ~p\n", [Worklists_O]),
+ ?reg_print_memberships(Worklists_O),
+
+ Worklists = hipe_reg_worklists:new(IG, Target, CFG, K, No_temporaries),
+ ?debug_msg("New Worklists:\n ~p\n", [Worklists]),
+ ?reg_print_memberships(Worklists),
+
+ Alias_O = initAlias(No_temporaries),
+ Alias = initAlias(No_temporaries),
+ ?print_alias(Alias),
+
+ ?debug_msg("Do coloring\n~p~n",[Worklists_O]),
+ {IG0_O, Worklists0_O, Moves0_O, Alias0_O} =
+ do_coloring(IG_O, Worklists_O, Move_sets_O, Alias_O,
+ K, SpillLimit, Target),
+ ?debug_msg("IG_O after color:\n ~p\n",[IG0_O]),
+ ?print_adjacent(IG0_O),
+ ?print_degrees(IG0_O),
+ ?print_spill_costs(IG0_O),
+ ?debug_msg("Move_sets after color:\n ~p\n",[Moves0_O]),
+ ?mov_print_memberships(Moves0_O),
+ ?debug_msg("Worklists after color:\n ~p\n", [Worklists0_O]),
+ ?reg_print_memberships(Worklists0_O),
+
+ {IG0, Moves0, Alias0, Worklists0} =
+ do_coalescing(IG, Worklists, Move_sets, Alias, K, Target),
+ ?debug_msg("IG after coalescing:\n",[]),
+ ?print_adjacent(IG0),
+ ?print_degrees(IG0),
+ ?print_spill_costs(IG0),
+ ?debug_msg("Move_sets after coalescing:\n ~p\n",[Moves0]),
+ ?mov_print_memberships(Moves0),
+ ?debug_msg("New Worklists after coalescing:\n ~p\n",
+ [Worklists0]),
+ ?reg_print_memberships(Worklists0),
+
+ {IG1, Worklists1, Moves1, Alias1} =
+ do_simplify_or_spill(IG0, Worklists0, Moves0, Alias0,
+ K, SpillLimit, Target),
+ ?debug_msg("IG after simplify_or_spill:\n",[]),
+ ?print_adjacent(IG1),
+ ?print_degrees(IG1),
+ ?print_spill_costs(IG1),
+ ?debug_msg("Saved spill costs ~p~n", [SavedSpillCosts]),
+ ?debug_msg("Move_sets after simplify_or_spill:\n ~p\n",[Moves1]),
+ ?mov_print_memberships(Moves1),
+ ?debug_msg("New Worklists after simplify_or_spill:\n ~p\n",
+ [Worklists1]),
+ ?reg_print_memberships(Worklists1),
+ ?print_alias(Alias1),
+
+ %% only for testing undoCoalescing and member_coalesced_to
+ %test_undoCoalescing(No_temporaries, Alias1, Worklists1),
+
+ %% only for testing fixAdj
+ %?debug_msg("adj_lists_before_fixAdj ~n~p~n", [hipe_ig:adj_list(IG1)]),
+ %IG2 = test_fixAdj(No_temporaries, SavedAdjList, IG1, Target),
+ %?debug_msg("adj_lists__after_fixAdj ~n~p~n", [hipe_ig:adj_list(IG2)]),
+
+ ?debug_msg("Init node sets\n",[]),
+ Node_sets = hipe_node_sets:new(),
+ %% ?debug_msg("NodeSet: ~w\n NonAlloc ~w\n",[Node_sets,Target:non_alloc(CFG)]),
+ ?debug_msg("Default coloring\n",[]),
+ {Color0,Node_sets1} =
+ defaultColoring(Target:all_precoloured(),
+ initColor(No_temporaries), Node_sets, Target),
+ ?debug_msg("Color0\n",[]),
+ ?print_colors(No_temporaries, Color0),
+
+ ?debug_msg("----------------------Assign colors _N\n",[]),
+
+ Stack = hipe_reg_worklists:stack(Worklists1),
+ ?debug_msg("The stack _N ~p~n", [Stack]),
+ %SortedStack = sort_stack(Stack),
+ %?debug_msg("The stack _N ~p~n", [SortedStack]),
+
+ %?debug_msg("Nodes _N ~w~n", [Node_sets1]),
+
+ {Color1,Node_sets2,Alias2} =
+ assignColors(Worklists1, Stack, Node_sets1, Color0,
+ No_temporaries, SavedAdjList, SavedSpillCosts, IG1, Alias1, All_colors, Target),
+ ?print_colors(No_temporaries, Color1),
+ ?debug_msg("Nodes:~w\nNodes2:~w\nNo_temporaries:~w\n",[Node_sets,Node_sets2,No_temporaries]),
+
+ ?debug_msg("Build mapping _N ~w\n",[Node_sets2]),
+ Coloring = build_namelist(Node_sets2,SpillIndex,Alias2,Color1),
+ ?debug_msg("Coloring ~p\n",[Coloring]),
+ SortedColoring = { sort_stack(element(1, Coloring)), element(2, Coloring)},
+ ?debug_msg("SortedColoring ~p\n",[SortedColoring]),
+ %%Coloring.
+ ?debug_msg("----------------------Assign colors _O\n",[]),
+ {Color1_O,Node_sets2_O} =
+ assignColors_O(hipe_reg_worklists:stack(Worklists0_O), Node_sets1, Color0,
+ Alias0_O, All_colors, Target),
+ ?print_colors(No_temporaries, Color1_O),
+ ?debug_msg("Nodes:~w\nNodes2:~w\nNo_temporaries:~w\n",[Node_sets,Node_sets2_O,No_temporaries]),
+
+ ?debug_msg("Build mapping ~w\n",[Node_sets2_O]),
+ Coloring_O = build_namelist_O(Node_sets2_O,SpillIndex,Alias0_O,Color1_O),
+ ?debug_msg("Coloring_O ~p\n",[Coloring_O]),
+ SortedColoring_O = {sort_stack(element(1, Coloring_O)), element(2, Coloring_O)},
+ ?debug_msg("SortedColoring_O ~p\n",[SortedColoring_O]),
+ sanity_compare(SortedColoring_O, SortedColoring),
+ Coloring.
+-else.
+regalloc(CFG, SpillIndex, SpillLimit, Target, _Options) ->
+ ?debug_msg("optimistic ~w\n",[Target]),
+ ?debug_msg("CFG: ~p\n",[CFG]),
+ %% Build interference graph
+ ?debug_msg("Build IG\n",[]),
+ IG = hipe_ig:build(CFG, Target),
+ ?debug_msg("adjlist: ~p\n",[hipe_ig:adj_list(IG)]),
+ ?debug_msg("IG:\n",[]),
+ ?print_adjacent(IG),
+ ?print_degrees(IG),
+ ?print_spill_costs(IG),
+
+ SavedSpillCosts = hipe_ig:spill_costs(IG),
+ SavedAdjList = hipe_ig:adj_list(IG),
+
+ ?debug_msg("Init\n",[]),
+ No_temporaries = Target:number_of_temporaries(CFG),
+ ?debug_msg("Coalescing RA: num_temps = ~p~n", [No_temporaries]),
+ Allocatable = Target:allocatable(),
+ K = length(Allocatable),
+ All_colors = colset_from_list(Allocatable),
+ ?debug_msg("K: ~w~nAll_colors: ~p\n",[K, All_colors]),
+
+ %% Add registers with their own coloring
+ ?debug_msg("Moves\n",[]),
+ Move_sets = hipe_moves:new(IG),
+ ?debug_msg("Move_sets:\n ~p\n",[Move_sets]),
+ ?mov_print_memberships(Move_sets),
+
+ ?debug_msg("Build Worklist\n",[]),
+
+ Worklists = hipe_reg_worklists:new(IG, Target, CFG, K, No_temporaries),
+ ?debug_msg("New Worklists:\n ~p\n", [Worklists]),
+ ?reg_print_memberships(Worklists),
+
+ Alias = initAlias(No_temporaries),
+ ?print_alias(Alias),
+
+ {IG0, Moves0, Alias0, Worklists0} =
+ do_coalescing(IG, Worklists, Move_sets, Alias, K, Target),
+ ?debug_msg("IG after coalescing:\n",[]),
+ ?print_adjacent(IG0),
+ ?print_degrees(IG0),
+ ?print_spill_costs(IG0),
+ ?debug_msg("Move_sets after coalescing:\n ~p\n",[Moves0]),
+ ?mov_print_memberships(Moves0),
+ ?debug_msg("New Worklists after coalescing:\n ~p\n",
+ [Worklists0]),
+ ?reg_print_memberships(Worklists0),
+
+ {IG1, Worklists1, _Moves1, Alias1} =
+ do_simplify_or_spill(IG0, Worklists0, Moves0, Alias0,
+ K, SpillLimit, Target),
+ ?debug_msg("IG after simplify_or_spill:\n",[]),
+ ?print_adjacent(IG1),
+ ?print_degrees(IG1),
+ ?print_spill_costs(IG1),
+ ?debug_msg("Saved spill costs ~p~n", [SavedSpillCosts]),
+ ?debug_msg("New Worklists after simplify_or_spill:\n ~p\n",
+ [Worklists1]),
+ ?reg_print_memberships(Worklists1),
+ ?print_alias(Alias1),
+
+ %% only for testing undoCoalescing and member_coalesced_to
+ %test_undoCoalescing(No_temporaries, Alias1, Worklists1),
+
+ %% only for testing fixAdj
+ %?debug_msg("adj_lists_before_fixAdj ~n~p~n", [hipe_ig:adj_list(IG1)]),
+ %IG2 = test_fixAdj(No_temporaries, SavedAdjList, IG1, Target),
+ %?debug_msg("adj_lists__after_fixAdj ~n~p~n", [hipe_ig:adj_list(IG2)]),
+
+ ?debug_msg("Init node sets\n",[]),
+ Node_sets = hipe_node_sets:new(),
+ %% ?debug_msg("NodeSet: ~w\n NonAlloc ~w\n",[Node_sets,Target:non_alloc(CFG)]),
+ ?debug_msg("Default coloring\n",[]),
+ {Color0,Node_sets1} =
+ defaultColoring(Target:all_precoloured(),
+ initColor(No_temporaries), Node_sets, Target),
+ ?debug_msg("Color0\n",[]),
+ ?print_colors(No_temporaries, Color0),
+
+ ?debug_msg("----------------------Assign colors _N\n",[]),
+
+ Stack = hipe_reg_worklists:stack(Worklists1),
+ ?debug_msg("The stack _N ~p~n", [Stack]),
+ %SortedStack = sort_stack(Stack),
+ %?debug_msg("The stack _N ~p~n", [SortedStack]),
+
+ %?debug_msg("Nodes _N ~w~n", [Node_sets1]),
+
+ {Color1,Node_sets2,Alias2} =
+ assignColors(Worklists1, Stack, Node_sets1, Color0,
+ No_temporaries, SavedAdjList, SavedSpillCosts, IG1, Alias1, All_colors, Target),
+ ?print_colors(No_temporaries, Color1),
+ ?debug_msg("Nodes:~w\nNodes2:~w\nNo_temporaries:~w\n",[Node_sets,Node_sets2,No_temporaries]),
+
+ ?debug_msg("Build mapping _N ~w\n",[Node_sets2]),
+ Coloring = build_namelist(Node_sets2,SpillIndex,Alias2,Color1),
+ ?debug_msg("Coloring ~p\n",[Coloring]),
+ Coloring.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: do_coloring
+%%
+%% Description: Create a coloring. That is, play paintball.
+%% Parameters:
+%% IG -- An interference graph
+%% Worklists -- Worklists, that is simplify, spill and freeze
+%% Moves -- Moves sets, that is coalesced, constrained
+%% and so on.
+%% Alias -- Tells if two temporaries can have their value
+%% in the same register.
+%% K -- Want to create a K coloring.
+%% SpillLimit -- Try not to spill nodes that are above the spill limit.
+%%
+%% Returns:
+%% IG -- Updated interference graph
+%% Worklists -- Updated Worklists structure
+%% Moves -- Updated Moves structure
+%% Alias -- Updates Alias structure
+%%
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+do_coloring(IG, Worklists, Moves, Alias, K, SpillLimit, Target) ->
+ Simplify = not(hipe_reg_worklists:is_empty_simplify(Worklists)),
+ Coalesce = not(hipe_moves:is_empty_worklist(Moves)),
+ Freeze = not(hipe_reg_worklists:is_empty_freeze(Worklists)),
+ Spill = not(hipe_reg_worklists:is_empty_spill(Worklists)),
+ if Simplify =:= true ->
+ {IG0, Worklists0, Moves0} =
+ simplify_O(hipe_reg_worklists:simplify(Worklists),
+ IG,
+ Worklists,
+ Moves,
+ K),
+ do_coloring(IG0, Worklists0, Moves0, Alias, K, SpillLimit, Target);
+ Coalesce =:= true ->
+ {Moves0, IG0, Worklists0, Alias0} =
+ coalesce_O(Moves, IG, Worklists, Alias, K, Target),
+ do_coloring(IG0, Worklists0, Moves0, Alias0, K, SpillLimit, Target);
+ Freeze =:= true ->
+ {Worklists0, Moves0} =
+ freeze(K, Worklists, Moves, IG, Alias),
+ do_coloring(IG, Worklists0, Moves0, Alias, K, SpillLimit, Target);
+ Spill =:= true ->
+ {Worklists0, Moves0} =
+ selectSpill_O(Worklists, Moves, IG, K, Alias, SpillLimit),
+ do_coloring(IG, Worklists0, Moves0, Alias, K, SpillLimit, Target);
+ true -> % Catchall case
+ {IG, Worklists, Moves, Alias}
+ end.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: do_coalescing
+%%
+%% Description: Try to coalesce everything (find out later if it was
+%% possible).
+%% Parameters:
+%% IG -- An interference graph
+%% Moves -- Moves sets, that is coalesced, constrained
+%% and so on.
+%% Alias -- Tells if two temporaries can have their value
+%% in the same register.
+%%
+%% Returns:
+%% IG -- Updated interference graph
+%% Moves -- Updated Moves structure
+%% Alias -- Updates Alias structure
+%%
+%%----------------------------------------------------------------------
+
+do_coalescing(IG, Worklists, Moves, Alias, K, Target) ->
+ case hipe_moves:is_empty_worklist(Moves) of
+ true ->
+ {IG, Moves, Alias, Worklists};
+ _ ->
+ {Moves0, IG0, Alias0, Worklists0} =
+ coalesce(Moves, IG, Worklists, Alias, K, Target),
+ do_coalescing(IG0, Worklists0, Moves0, Alias0, K, Target)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: do_simplify_or_spill
+%%
+%% Parameters:
+%% IG -- An interference graph
+%% Worklists -- Worklists, that is simplify, spill and freeze
+%% Moves -- Moves sets, that is coalesced, constrained
+%% and so on.
+%% Alias -- Tells if two temporaries can have their value
+%% in the same register.
+%% K -- Want to create a K coloring.
+%% SpillLimit -- Try not to spill nodes that are above the spill limit.
+%%
+%% Returns:
+%% IG -- Updated interference graph
+%% Worklists -- Updated Worklists structure
+%% Moves -- Updated Moves structure
+%% Alias -- Updates Alias structure
+%%
+%%----------------------------------------------------------------------
+
+do_simplify_or_spill(IG, Worklists, Moves, Alias, K, SpillLimit, Target) ->
+ Simplify = not(hipe_reg_worklists:is_empty_simplify(Worklists)),
+ Spill = not(hipe_reg_worklists:is_empty_spill(Worklists)),
+ if Simplify =:= true ->
+ {IG0, Worklists0, Moves0} =
+ simplify(hipe_reg_worklists:simplify(Worklists),
+ IG,
+ Worklists,
+ Moves,
+ K),
+ do_simplify_or_spill(IG0, Worklists0, Moves0, Alias,
+ K, SpillLimit, Target);
+ Spill =:= true ->
+ Worklists0 =
+ selectSpill(Worklists, IG, SpillLimit),
+ do_simplify_or_spill(IG, Worklists0, Moves, Alias,
+ K, SpillLimit, Target);
+ true -> % Catchall case
+ {IG, Worklists, Moves, Alias}
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: adjacent
+%%
+%% Description: Adjacent nodes that's not coalesced, on the stack or
+%% precoloured.
+%% Parameters:
+%% Node -- Node that you want to adjacents of
+%% IG -- The interference graph
+%%
+%% Returns:
+%% A set with nodes/temporaries that are not coalesced, on the
+%% stack or precoloured.
+%%----------------------------------------------------------------------
+
+adjacent(Node, IG, Worklists) ->
+ Adjacent_edges = hipe_ig:node_adj_list(Node, IG),
+ hipe_reg_worklists:non_stacked_or_coalesced_nodes(Adjacent_edges, Worklists).
+
+%%----------------------------------------------------------------------
+%% Function: simplify
+%%
+%% Description: Simplify graph by removing nodes of low degree. This
+%% function simplify all nodes it can at once.
+%% Parameters:
+%% [Node|Nodes] -- The simplify worklist
+%% IG -- The interference graph
+%% Worklists -- The worklists data-structure
+%% Moves -- The moves data-structure
+%% K -- Produce a K coloring
+%%
+%% Returns:
+%% IG -- An updated interference graph
+%% Worklists -- An updated worklists data-structure
+%% Moves -- An updated moves data-structure
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+simplify_O([], IG, Worklists, Moves, _K) ->
+ {IG, Worklists, Moves};
+simplify_O([Node|Nodes], IG, Worklists, Moves, K) ->
+ Worklists0 = hipe_reg_worklists:remove_simplify(Node, Worklists),
+ ?debug_msg("putting ~w on stack~n",[Node]),
+ Adjacent = adjacent(Node, IG, Worklists0),
+ Worklists01 = hipe_reg_worklists:push_stack(Node, Adjacent, Worklists0),
+ {New_ig, Worklists1, New_moves} =
+ decrement_degree_O(Adjacent, IG, Worklists01, Moves, K),
+ simplify_O(Nodes, New_ig, Worklists1, New_moves, K).
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: simplify
+%%
+%% Description: Simplify graph by removing nodes of low degree. This
+%% function simplify all nodes it can at once.
+%% Parameters:
+%% [Node|Nodes] -- The simplify worklist
+%% IG -- The interference graph
+%% Worklists -- The worklists data-structure
+%% Moves -- The moves data-structure
+%% K -- Produce a K coloring
+%%
+%% Returns:
+%% IG -- An updated interference graph
+%% Worklists -- An updated worklists data-structure
+%% Moves -- An updated moves data-structure
+%%----------------------------------------------------------------------
+
+simplify([], IG, Worklists, Moves, _K) ->
+ {IG, Worklists, Moves};
+simplify([Node|Nodes], IG, Worklists, Moves, K) ->
+ Worklists0 = hipe_reg_worklists:remove_simplify(Node, Worklists),
+ ?debug_msg("putting ~w on stack~n",[Node]),
+ Adjacent = adjacent(Node, IG, Worklists0),
+ Worklists01 = hipe_reg_worklists:push_stack(Node, Adjacent, Worklists0),
+ {New_ig, Worklists1} = decrement_degree(Adjacent, IG, Worklists01, K),
+ simplify(Nodes, New_ig, Worklists1, Moves, K).
+
+%%----------------------------------------------------------------------
+%% Function: decrement_degree
+%%
+%% Description: Decrement the degree on a number of nodes/temporaries.
+%% Parameters:
+%% [Node|Nodes] -- Decrement degree on these nodes
+%% IG -- The interference graph
+%% Worklists -- The Worklists data structure
+%% Moves -- The Moves data structure.
+%% K -- We want to create a coloring with K colors
+%%
+%% Returns:
+%% IG -- An updated interference graph (the degrees)
+%% Worklists -- Updated Worklists. Changed if one degree goes
+%% down to K.
+%% Moves -- Updated Moves. Changed if a move related temporary
+%% gets degree K.
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+decrement_degree_O([], IG, Worklists, Moves, _K) ->
+ {IG, Worklists, Moves};
+decrement_degree_O([Node|Nodes], IG, Worklists, Moves, K) ->
+ PrevDegree = hipe_ig:get_node_degree(Node, IG),
+ IG0 = hipe_ig:dec_node_degree(Node, IG),
+ case PrevDegree =:= K of
+ true ->
+ AdjList = hipe_ig:node_adj_list(Node, IG0),
+ %% OK since Node (a) is still in IG, and (b) cannot be adjacent to itself.
+ Moves00 = enable_moves_active_to_worklist(hipe_moves:node_movelist(Node, Moves),
+ Moves),
+ Moves0 = enable_moves(AdjList, Worklists, Moves00),
+ Worklists0 = hipe_reg_worklists:remove_spill(Node, Worklists),
+ case hipe_moves:move_related(Node, Moves0) of
+ true ->
+ Worklists1 = hipe_reg_worklists:add_freeze(Node, Worklists0),
+ decrement_degree_O(Nodes, IG0, Worklists1, Moves0, K);
+ _ ->
+ Worklists1 = hipe_reg_worklists:add_simplify(Node, Worklists0),
+ decrement_degree_O(Nodes, IG0, Worklists1, Moves0, K)
+ end;
+ _ ->
+ decrement_degree_O(Nodes, IG0, Worklists, Moves, K)
+ end.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: decrement_degree
+%%
+%% Description: Decrement the degree on a number of nodes/temporaries.
+%% Parameters:
+%% [Node|Nodes] -- Decrement degree on these nodes
+%% IG -- The interference graph
+%% Worklists -- The Worklists data structure
+%% Moves -- The Moves data structure.
+%% K -- We want to create a coloring with K colors
+%%
+%% Returns:
+%% IG -- An updated interference graph (the degrees)
+%% Worklists -- Updated Worklists. Changed if one degree goes
+%% down to K.
+%% Moves -- Updated Moves. Changed if a move related temporary
+%% gets degree K.
+%%----------------------------------------------------------------------
+
+decrement_degree([], IG, Worklists, _K) ->
+ {IG, Worklists};
+decrement_degree([Node|Nodes], IG, Worklists, K) ->
+ PrevDegree = hipe_ig:get_node_degree(Node, IG),
+ IG0 = hipe_ig:dec_node_degree(Node, IG),
+ case PrevDegree =:= K of
+ true ->
+ Worklists0 = hipe_reg_worklists:remove_spill(Node, Worklists),
+ Worklists1 = hipe_reg_worklists:add_simplify(Node, Worklists0),
+ decrement_degree(Nodes, IG0, Worklists1, K);
+ _ ->
+ decrement_degree(Nodes, IG0, Worklists, K)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: enable_moves
+%%
+%% Description: Make (move-related) nodes that are not yet considered for
+%% coalescing, ready for possible coalescing.
+%%
+%% Parameters:
+%% [Node|Nodes] -- A list of move nodes
+%% Moves -- The moves data-structure
+%%
+%% Returns:
+%% An updated moves data-structure
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+enable_moves([], _Worklists, Moves) -> Moves;
+enable_moves([Node|Nodes], Worklists, Moves) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(Node, Worklists) of
+ true -> enable_moves(Nodes, Worklists, Moves);
+ _ ->
+ %% moveList[n] suffices since we're checking for activeMoves membership
+ Node_moves = hipe_moves:node_movelist(Node, Moves),
+ New_moves = enable_moves_active_to_worklist(Node_moves, Moves),
+ enable_moves(Nodes, Worklists, New_moves)
+ end.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: enable_moves_active_to_worklist
+%%
+%% Description: Make (move-related) nodes that are not yeat considered for
+%% coalescing, ready for possible coalescing.
+%%
+%% Parameters:
+%% [Node|Nodes] -- A list of move nodes
+%% Moves -- The moves data-structure
+%%
+%% Returns:
+%% An updated moves data-structure
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+enable_moves_active_to_worklist([], Moves) -> Moves;
+enable_moves_active_to_worklist([Node|Nodes], Moves) ->
+ case hipe_moves:member_active(Node, Moves) of
+ true ->
+ New_moves =
+ hipe_moves:add_worklist(Node, hipe_moves:remove_active(Node, Moves)),
+ enable_moves_active_to_worklist(Nodes, New_moves);
+ _ ->
+ enable_moves_active_to_worklist(Nodes, Moves)
+ end.
+-endif.
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+sanity_compare(Coloring, Coloring_N) ->
+ case compare_sanity(Coloring, Coloring_N) of
+ false ->
+ ?debug_msg("mismatch for coloring: ~n~p~n~p", [Coloring, Coloring_N]);
+ _ -> true
+ end.
+compare_sanity({[], _C}, {[], _C_N}) ->
+ ?debug_msg("Sanity - OK!~n", []),
+ true;
+compare_sanity({_Coloring_list, _C}, {[], _C_N}) ->
+ ?debug_msg("Sanity - unequal numbers~n", []),
+ false;
+compare_sanity({[], _C}, {_Coloring_list_N, _C_N}) ->
+ ?debug_msg("Sanity - unequal numbers~n", []),
+ false;
+compare_sanity({[Color|Coloring_list], C}, {[Color_N|Coloring_list_N], C_N}) ->
+ case element(1, Color) =:= element(1, Color_N) of
+ false ->
+ ?debug_msg("Sanity - unequal measure~n", []),
+ false;
+ _ ->
+ case element(2, Color) =:= element(2, Color_N) of
+ false ->
+ ?debug_msg("Sanity - unequal color~n", []),
+ false;
+ _ ->
+ case C =:= C_N of
+ false ->
+ ?debug_msg("Sanity - unequal last element~n", []),
+ false;
+ _ ->
+ compare_sanity({Coloring_list, C}, {Coloring_list_N, C_N})
+ end
+ end
+ end.
+-endif.
+
+
+%% Build the namelists, these functions are fast hacks, they use knowledge
+%% about data representation that they shouldn't know, bad abstraction.
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+build_namelist_O(NodeSets,Index,Alias,Color) ->
+ ?debug_msg("NodeSets ~w~n", [NodeSets]),
+ ?debug_msg("Building mapping\n",[]),
+ ?debug_msg("Vector to list\n",[]),
+ AliasList =
+ build_alias_list(aliasToList(Alias),
+ 0, %% The first temporary has index 0
+ []), %% Accumulator
+ ?debug_msg("Alias list:~p\n",[AliasList]),
+ ?debug_msg("Coalesced\n",[]),
+ NL1 = build_coalescedlist(AliasList,Color,Alias,[]),
+ ?debug_msg("Coalesced list:~p\n",[NL1]),
+ ?debug_msg("Regs\n",[]),
+ NL2 = build_reglist_O(hipe_node_sets:colored(NodeSets),Color,NL1),
+ ?debug_msg("Regs list:~p\n",[NL2]),
+ ?debug_msg("Spills\n",[]),
+ build_spillist(hipe_node_sets:spilled(NodeSets),Index,NL2).
+-endif.
+
+build_namelist(NodeSets,Index,Alias,Color) ->
+ ?debug_msg("NodeSets _N ~w~n", [NodeSets]),
+ ?debug_msg("Building mapping _N\n",[]),
+ ?debug_msg("Vector to list _N\n",[]),
+ AliasList =
+ build_alias_list(aliasToList(Alias),
+ 0, %% The first temporary has index 0
+ []), %% Accumulator
+ ?debug_msg("Alias list _N:~p\n",[AliasList]),
+ ?debug_msg("Coalesced\n",[]),
+ NL1 = build_coalescedlist(AliasList,Color,Alias,[]),
+ ?debug_msg("Coalesced list:~p\n",[NL1]),
+ ?debug_msg("Regs _N\n",[]),
+ ColoredNodes = hipe_node_sets:colored(NodeSets),
+ ?debug_msg("ColoredNodes ~p~n", [ColoredNodes]),
+ NL2 = build_reglist_N(ColoredNodes,Color,NL1,NL1),
+ ?debug_msg("Regs list _N:~p\n",[NL2]),
+ ?debug_msg("Spills _N\n",[]),
+ build_spillist(hipe_node_sets:spilled(NodeSets),Index,NL2).
+
+build_spillist([],Index,List) ->
+ {List,Index};
+build_spillist([Node|Nodes],Index,List) ->
+ ?debug_msg("[~p]: Spill ~p to ~p\n", [?MODULE,Node,Index]),
+ build_spillist(Nodes,Index+1,[{Node,{spill,Index}}|List]).
+
+build_coalescedlist([],_Color,_Alias,List) ->
+ List;
+build_coalescedlist([Node|Ns],Color,Alias,List) when is_integer(Node) ->
+ ?debug_msg("Alias of ~p is ~p~n",[Node,getAlias(Node,Alias)]),
+ AC = getColor(getAlias(Node,Alias),Color),
+ build_coalescedlist(Ns,Color,Alias,[{Node,{reg,AC}}|List]).
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+build_reglist_O([],_Color,List) ->
+ List;
+build_reglist_O([Node|Ns],Color,List) ->
+ build_reglist_O(Ns,Color,[{Node,{reg,getColor(Node,Color)}}|List]).
+-endif.
+
+build_reglist_N([],_Color,List,_OrgList) ->
+ List;
+build_reglist_N([Node|Ns],Color,List,OrgList) ->
+ %% XXX this could be done more efficiently if both lists were sorted
+ case is_already_in_list(Node, OrgList) of
+ true -> build_reglist_N(Ns, Color, List, OrgList);
+ _ -> build_reglist_N(Ns,Color,[{Node,{reg,getColor(Node,Color)}}|List], OrgList)
+ end.
+
+is_already_in_list(_Node, []) ->
+ false;
+is_already_in_list(Node, [L|List]) ->
+ ?debug_msg("---test--- Node ~w element ~w~n", [Node, element(1, L)]),
+ case Node =:= element(1, L) of
+ true -> true;
+ _ -> is_already_in_list(Node, List)
+ end.
+
+build_alias_list([], _I, List) ->
+ List;
+build_alias_list([Alias|Aliases], I, List) when is_integer(Alias) ->
+ build_alias_list(Aliases, I+1, [I|List]);
+build_alias_list([_Alias|Aliases], I, List) ->
+ build_alias_list(Aliases, I+1, List).
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+sort_stack([]) -> [];
+sort_stack([Pivot|Rest]) ->
+ {Smaller, Bigger} = sort_stack_split(Pivot, Rest),
+ lists:append(sort_stack(Smaller), [Pivot|sort_stack(Bigger)]).
+
+sort_stack_split(Pivot, L) ->
+ sort_stack_split(Pivot, L, [], []).
+
+sort_stack_split(_Pivot, [], Smaller, Bigger) ->
+ {Smaller, Bigger};
+sort_stack_split(Pivot, [H|T], Smaller, Bigger) when element(1, H) > element(1, Pivot) ->
+ sort_stack_split(Pivot, T, [H|Smaller], Bigger);
+sort_stack_split(Pivot, [H|T], Smaller, Bigger) ->
+ sort_stack_split(Pivot, T, Smaller, [H|Bigger]).
+-endif.
+
+%sort([]) -> [];
+%sort([Pivot|Rest]) ->
+% {Smaller, Bigger} = sort_split(Pivot, Rest),
+% lists:append(sort(Smaller), [Pivot|sort(Bigger)]).
+%
+%sort_split(Pivot, L) ->
+% sort_split(Pivot, L, [], []).
+%
+%sort_split(_Pivot, [], Smaller, Bigger) -> {Smaller, Bigger};
+%sort_split(Pivot, [H|T], Smaller, Bigger) when H > Pivot ->
+% sort_split(Pivot, T, [H|Smaller], Bigger);
+%sort_split(Pivot, [H|T], Smaller, Bigger) ->
+% sort_split(Pivot, T, Smaller, [H|Bigger]).
+
+%%----------------------------------------------------------------------
+%% Function: assignColors
+%%
+%% Description: Tries to assign colors to nodes in a stack.
+%% Parameters:
+%% Worklists -- The Worklists data structure.
+%% Stack -- The SelectStack built by the Select function,
+%% this stack contains tuples in the form {Node,Edges}
+%% where Node is the Node number and Edges is an ordset
+%% containing the numbers of all the adjacent nodes.
+%% NodeSets -- This is a record containing all the different node
+%% sets that are used in the register allocator.
+%% Color -- A mapping from nodes to their respective color.
+%% No_temporaries -- Number of temporaries.
+%% SavedAdjList -- Saved adjacency list (from before coalescing).
+%% SavedSpillCosts -- Saved spill costs (from before coalescing).
+%% IG -- The interference graph.
+%% Alias -- This is a mapping from nodes to nodes. If a node has
+%% been coalesced, this mapping shows the alias for that
+%% node.
+%% AllColors -- This is an ordset containing all the available colors
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% Color -- A mapping from nodes to their respective color.
+%% NodeSets -- The updated node sets.
+%% Alias -- The updated aliases.
+%%----------------------------------------------------------------------
+
+assignColors(Worklists, Stack, NodeSets, Color, No_Temporaries,
+ SavedAdjList, SavedSpillCosts, IG, Alias, AllColors, Target) ->
+ case Stack of
+ [] ->
+ {Color,NodeSets,Alias};
+ [{Node,Edges}|Stack1] ->
+ ?debug_msg("Coloring Node: ~p~n",[Node]),
+ ?IF_DEBUG(lists:foreach(fun (_E) ->
+ ?msg(" Edge ~w-><~w>->~w~n",
+ begin A = getAlias(_E,Alias),
+ [_E,A,getColor(A,Color)]
+ end)
+ end, Edges),
+ []),
+ %% When debugging, check that Node isn't precoloured.
+ OkColors = findOkColors(Edges, AllColors, Color, Alias),
+ case colset_is_empty(OkColors) of
+ true -> % Spill case
+ case hipe_reg_worklists:member_coalesced_to(Node, Worklists) of
+ true ->
+ ?debug_msg("Alias case. Undoing coalescing.~n", []),
+ {Alias1, IG1, NodeSets1, Color1, Stack2} = tryPrimitiveNodes(Node, Stack1, NodeSets, AllColors, Color, No_Temporaries, SavedAdjList, SavedSpillCosts, IG, Alias, Target),
+ %{Alias1, IG1, NodeSets1, Color1, Stack2} = {Alias, IG, NodeSets, Color, Stack1},
+ assignColors(Worklists, Stack2, NodeSets1, Color1, No_Temporaries, SavedAdjList, SavedSpillCosts, IG1, Alias1, AllColors, Target);
+ false ->
+ ?debug_msg("Spill case. Spilling node.~n", []),
+ NodeSets1 = hipe_node_sets:add_spilled(Node, NodeSets),
+ assignColors(Worklists, Stack1, NodeSets1, Color, No_Temporaries, SavedAdjList, SavedSpillCosts, IG, Alias, AllColors, Target)
+ end;
+ false -> % Color case
+ Col = colset_smallest(OkColors),
+ NodeSets1 = hipe_node_sets:add_colored(Node, NodeSets),
+ Color1 = setColor(Node, Target:physical_name(Col), Color),
+ ?debug_msg("Color case. Assigning color ~p to node.~n", [Col]),
+ assignColors(Worklists, Stack1, NodeSets1, Color1, No_Temporaries, SavedAdjList, SavedSpillCosts, IG, Alias, AllColors, Target)
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: tryPrimitiveNodes
+%%
+%% Description: Undoes coalescing of a non-colorable coalesced node and tries
+%% to assign colors to its primitives, such that the cheapest
+%% potential spill cost is achieved.
+%% Parameters:
+%% Node -- The representative node to undo coalescing for.
+%% Stack -- The SelectStack built by the Select function,
+%% this stack contains tuples in the form {Node,Edges}
+%% where Node is the Node number and Edges is an ordset
+%% containing the numbers of all the adjacent nodes.
+%% NodeSets -- This is a record containing all the different node
+%% sets that are used in the register allocator.
+%% AllColors -- This is an ordset containing all the available colors.
+%% No_temporaries -- Number of temporaries.
+%% SavedAdjList -- Saved adjacency list (from before coalescing).
+%% SavedSpillCosts -- Saved spill costs (from before coalescing).
+%% IG -- The interference graph.
+%% Alias -- This is a mapping from nodes to nodes. If a node has
+%% been coalesced, this mapping shows the alias for that
+%% node.
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% Alias -- The restored aliases after the uncoalescing.
+%% IG -- An updated interference graph after the uncoalescing.
+%% NodeSets -- The updated node sets.
+%% Color -- A mapping from nodes to their respective color.
+%% Stack -- The updated SelectStack with non-colored primitives
+%% placed at the bottom.
+%%----------------------------------------------------------------------
+
+tryPrimitiveNodes(Node, Stack, NodeSets, AllColors, Color, No_temporaries, SavedAdjList, SavedSpillCosts, IG, Alias, Target) ->
+ ?debug_msg("Undoing coalescing of node ~p.~n", [Node]),
+ {PrimitiveNodes, Alias1, IG1} = undoCoalescing(Node, No_temporaries, Alias, SavedAdjList, IG, Target),
+ ?debug_msg("Spilling non-colorable primitives.~n", []),
+ {ColorableNodes, NodeSets1} = spillNonColorablePrimitives([], PrimitiveNodes, NodeSets, AllColors, Color, SavedAdjList, Alias1),
+ ?debug_msg("Generating splits of colorable nodes.~n", []),
+ Splits = splits(ColorableNodes, SavedSpillCosts),
+ {NodeSets2, Color1, Stack1} = processSplits(Splits, AllColors, IG1, Color, NodeSets1, Alias1, Target, Stack),
+ {Alias1, IG1, NodeSets2, Color1, Stack1}.
+
+%% Spill all non-colorable primitives and return the remaining set of nodes.
+
+spillNonColorablePrimitives(ColorableNodes, [], NodeSets, _AllColors, _Color, _SavedAdjList, _Alias) ->
+ {ColorableNodes, NodeSets};
+spillNonColorablePrimitives(ColorableNodes, [Primitive|Primitives], NodeSets, AllColors, Color, SavedAdjList, Alias) ->
+ OkColors = findOkColors(hipe_adj_list:edges(Primitive, SavedAdjList), AllColors, Color, Alias),
+ case colset_is_empty(OkColors) of
+ true -> % Spill case
+ ?debug_msg(" Spilling primitive node ~p.~n", [Primitive]),
+ NodeSets1 = hipe_node_sets:add_spilled(Primitive, NodeSets),
+ spillNonColorablePrimitives(ColorableNodes, Primitives, NodeSets1, AllColors, Color, SavedAdjList, Alias);
+ false -> % Colorable case
+ ?debug_msg(" Primitive node ~p is colorable.~n", [Primitive]),
+ spillNonColorablePrimitives([Primitive|ColorableNodes], Primitives, NodeSets, AllColors, Color, SavedAdjList, Alias)
+ end.
+
+%% Generate all splits of colorable primitives, sorted in spill cost order.
+
+splits([], _SavedSpillCosts) ->
+ [{[], [], 0}];
+splits([L|Ls], SavedSpillCosts) ->
+ Spl = splits(Ls, SavedSpillCosts),
+ SpillCost = hipe_spillcost:spill_cost(L, SavedSpillCosts),
+ Spl1 = [splits_1(S, L) || S <- Spl],
+ Spl2 = [splits_2(S, L, SpillCost) || S <- Spl],
+ spillCostOrderedMerge(Spl1, Spl2, []).
+
+splits_1({Cols, NonCols, OldSpillCost}, L) ->
+ {[L|Cols], NonCols, OldSpillCost}.
+
+splits_2({Cols, NonCols, OldSpillCost}, L, SpillCost) ->
+ {Cols, [L|NonCols], OldSpillCost + SpillCost}.
+
+%% Merge two ordered sub-splits into one.
+
+spillCostOrderedMerge(Spl1, [], Spl) ->
+ lists:reverse(Spl) ++ Spl1;
+spillCostOrderedMerge([], Spl2, Spl) ->
+ lists:reverse(Spl) ++ Spl2;
+spillCostOrderedMerge(Spl1, Spl2, Spl) ->
+ {_, _, SpillCost1} = hd(Spl1),
+ {_, _, SpillCost2} = hd(Spl2),
+ case SpillCost1 =< SpillCost2 of
+ true ->
+ spillCostOrderedMerge(tl(Spl1), Spl2, [hd(Spl1)|Spl]);
+ false ->
+ spillCostOrderedMerge(Spl1, tl(Spl2), [hd(Spl2)|Spl])
+ end.
+
+%% Process splits, finding the one with the smallest spill cost that
+%% can be assigned one color.
+
+processSplits([], _AllColors, _IG, Color, NodeSets, _Alias, _Target, Stack) ->
+ {NodeSets, Color, Stack};
+processSplits([{Cols, NonCols, _SpillCost}|Splits], AllColors, IG, Color, NodeSets, Alias, Target, Stack) ->
+ OkColors = findCommonColors(Cols, IG, Color, Alias, AllColors),
+ case colset_is_empty(OkColors) of
+ false -> % This split can be colored with one color - use it
+ ?debug_msg("Found a colorable split.~n", []),
+ Col = colset_smallest(OkColors),
+ {NodeSets1, Color1} = colorSplit(Cols, Col, NodeSets, Color, Target),
+ Stack1 = enqueueSplit(NonCols, IG, Stack),
+ {NodeSets1, Color1, Stack1};
+ true -> % This split cannot be colored with one color - try another
+ ?debug_msg("Unable to color split.~n", []),
+ processSplits(Splits, AllColors, IG, Color, NodeSets, Alias, Target, Stack)
+ end.
+
+%% Find the set of colors that can be assigned to one split.
+
+findCommonColors([], _IG, _Color, _Alias, OkColors) ->
+ OkColors;
+findCommonColors([Primitive|Primitives], IG, Color, Alias, OkColors) ->
+ OkColors1 = findOkColors(hipe_ig:node_adj_list(Primitive, IG), OkColors, Color, Alias),
+ findCommonColors(Primitives, IG, Color, Alias, OkColors1).
+
+%% Color nodes in a split.
+
+colorSplit([], _Col, NodeSets, Color, _Target) ->
+ {NodeSets, Color};
+colorSplit([Node|Nodes], Col, NodeSets, Color, Target) ->
+ ?debug_msg(" Coloring node ~p with color ~p.~n", [Node, Col]),
+ NodeSets1 = hipe_node_sets:add_colored(Node, NodeSets),
+ Color1 = setColor(Node, Target:physical_name(Col), Color),
+ colorSplit(Nodes, Col, NodeSets1, Color1, Target).
+
+%% Place non-colorable nodes in a split at the bottom of the SelectStack.
+
+enqueueSplit([], _IG, Stack) ->
+ Stack;
+enqueueSplit([Node|Nodes], IG, Stack) ->
+ ?debug_msg(" Placing node ~p at the bottom of the stack.~n", [Node]),
+ Edges = hipe_ig:node_adj_list(Node, IG),
+ Stack1 = Stack ++ [{Node, Edges}],
+ enqueueSplit(Nodes, IG, Stack1).
+
+%%----------------------------------------------------------------------
+%% Function: assignColors
+%%
+%% Description: Tries to assign colors to nodes in a stack.
+%% Parameters:
+%% Stack -- The SelectStack built by the Select function,
+%% this stack contains tuples in the form {Node,Edges}
+%% where Node is the Node number and Edges is an ordset
+%% containing the numbers of all the adjacent nodes.
+%% NodeSets -- This is a record containing all the different node
+%% sets that are used in the register allocator.
+%% Alias -- This is a mapping from nodes to nodes, if a node has
+%% been coalesced this mapping shows the alias for that
+%% node.
+%% AllColors -- This is an ordset containing all the available colors
+%%
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% Color -- A mapping from nodes to their respective color.
+%% NodeSets -- The updated node sets.
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+assignColors_O(Stack,NodeSets,Color,Alias,AllColors,Target) ->
+ case Stack of
+ [] ->
+ {Color,NodeSets};
+ [{Node,Edges}|Stack1] ->
+ ?debug_msg("Coloring Node: ~p~n",[Node]),
+ ?IF_DEBUG(lists:foreach(fun (_E) ->
+ ?msg(" Edge ~w-><~w>->~w~n",
+ begin A = getAlias(_E,Alias),
+ [_E,A,getColor(A,Color)]
+ end)
+ end, Edges),
+ []),
+ %% When debugging, check that Node isn't precoloured.
+ OkColors = findOkColors(Edges, AllColors, Color, Alias),
+ case colset_is_empty(OkColors) of
+ true -> % Spill case
+ NodeSets1 = hipe_node_sets:add_spilled(Node, NodeSets),
+ assignColors_O(Stack1, NodeSets1, Color, Alias, AllColors, Target);
+ false -> % Colour case
+ Col = colset_smallest(OkColors),
+ NodeSets1 = hipe_node_sets:add_colored(Node, NodeSets),
+ Color1 = setColor(Node, Target:physical_name(Col), Color),
+ assignColors_O(Stack1, NodeSets1, Color1, Alias, AllColors, Target)
+ end
+ end.
+-endif.
+
+%%---------------------------------------------------------------------
+%% Function: defaultColoring
+%%
+%% Description: Make the default coloring
+%% Parameters:
+%% Regs -- The list of registers to be default colored
+%% Color -- The color mapping that shall be changed
+%% NodeSets -- The node sets that shall be updated
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% NewColor -- The updated color mapping
+%% NewNodeSets -- The updated node sets
+%%---------------------------------------------------------------------
+
+defaultColoring([], Color, NodeSets, _Target) ->
+ {Color,NodeSets};
+defaultColoring([Reg|Regs], Color, NodeSets, Target) ->
+ Color1 = setColor(Reg,Target:physical_name(Reg), Color),
+ NodeSets1 = hipe_node_sets:add_colored(Reg, NodeSets),
+ defaultColoring(Regs, Color1, NodeSets1, Target).
+
+%% Find the colors that are OK for a node with certain edges.
+
+findOkColors(Edges, AllColors, Color, Alias) ->
+ find(Edges, AllColors, Color, Alias).
+
+%% Find all the colors of the nodes in the list [Node|Nodes] and remove them
+%% from the set OkColors, when the list is empty, return OkColors.
+
+find([], OkColors, _Color, _Alias) ->
+ OkColors;
+find([Node0|Nodes], OkColors, Color, Alias) ->
+ Node = getAlias(Node0, Alias),
+ case getColor(Node, Color) of
+ [] ->
+ find(Nodes, OkColors, Color, Alias);
+ Col ->
+ OkColors1 = colset_del_element(Col, OkColors),
+ find(Nodes, OkColors1, Color, Alias)
+ end.
+
+%%%
+%%% ColSet -- ADT for the set of available colours while
+%%% assigning colours.
+%%%
+-ifdef(notdef). % old ordsets-based implementation
+colset_from_list(Allocatable) ->
+ ordsets:from_list(Allocatable).
+
+colset_del_element(Colour, ColSet) ->
+ ordsets:del_element(Colour, ColSet).
+
+colset_is_empty(ColSet) ->
+ case ColSet of
+ [] -> true;
+ [_|_] -> false
+ end.
+
+colset_smallest([Colour|_]) ->
+ Colour.
+-endif.
+
+-ifdef(notdef). % new gb_sets-based implementation
+colset_from_list(Allocatable) ->
+ gb_sets:from_list(Allocatable).
+
+colset_del_element(Colour, ColSet) ->
+ %% Must use gb_sets:delete_any/2 since gb_sets:del_element/2
+ %% fails if the element isn't present. Bummer.
+ gb_sets:delete_any(Colour, ColSet).
+
+colset_is_empty(ColSet) ->
+ gb_sets:is_empty(ColSet).
+
+colset_smallest(ColSet) ->
+ gb_sets:smallest(ColSet).
+-endif.
+
+%%-ifdef(notdef). % new bitmask-based implementation
+colset_from_list(Allocatable) ->
+ colset_from_list(Allocatable, 0).
+
+colset_from_list([], ColSet) ->
+ ColSet;
+colset_from_list([Colour|Allocatable], ColSet) ->
+ colset_from_list(Allocatable, ColSet bor (1 bsl Colour)).
+
+colset_del_element(Colour, ColSet) ->
+ ColSet band bnot(1 bsl Colour).
+
+colset_is_empty(0) -> true;
+colset_is_empty(_) -> false.
+
+colset_smallest(ColSet) ->
+ bitN_log2(ColSet band -ColSet, 0).
+
+bitN_log2(BitN, ShiftN) ->
+ case BitN > 16#ffff of
+ true ->
+ bitN_log2(BitN bsr 16, ShiftN + 16);
+ _ ->
+ ShiftN + hweight16(BitN - 1)
+ end.
+
+hweight16(W) ->
+ Res1 = ( W band 16#5555) + (( W bsr 1) band 16#5555),
+ Res2 = (Res1 band 16#3333) + ((Res1 bsr 2) band 16#3333),
+ Res3 = (Res2 band 16#0F0F) + ((Res2 bsr 4) band 16#0F0F),
+ (Res3 band 16#00FF) + ((Res3 bsr 8) band 16#00FF).
+%%-endif.
+
+%%%
+%%% Colour ADT providing a partial mapping from nodes to colours.
+%%%
+
+initColor(NrNodes) ->
+ {colmap, hipe_bifs:array(NrNodes, [])}.
+
+getColor(Node, {colmap, ColMap}) ->
+ hipe_bifs:array_sub(ColMap, Node).
+
+setColor(Node, Color, {colmap, ColMap} = C) ->
+ hipe_bifs:array_update(ColMap, Node, Color),
+ C.
+
+-ifdef(DEBUG_PRINTOUTS).
+printColors(0, _) ->
+ true;
+printColors(Node, {colmap, ColMap} = C) ->
+ NextNode = Node - 1,
+ ?debug_msg("node ~w color ~w~n", [NextNode, hipe_bifs:array_sub(ColMap, NextNode)]),
+ printColors(NextNode, C).
+-endif.
+
+%%%
+%%% Alias ADT providing a partial mapping from nodes to nodes.
+%%%
+
+initAlias(NrNodes) ->
+ {alias, hipe_bifs:array(NrNodes, [])}.
+
+%% Get alias for a node.
+%% Note that non-aliased nodes could be represented in
+%% two ways, either not aliased or aliased to itself.
+%% Including the latter case prevents looping bugs.
+getAlias(Node, {alias, AliasMap} = Alias) ->
+ case hipe_bifs:array_sub(AliasMap, Node) of
+ [] ->
+ Node;
+ Node ->
+ Node;
+ AliasNode ->
+ getAlias(AliasNode, Alias)
+ end.
+
+-ifdef(DEBUG_PRINTOUTS).
+printAlias({alias, AliasMap} = Alias) ->
+ ?debug_msg("Aliases:\n",[]),
+ printAlias(hipe_bifs:array_length(AliasMap), Alias).
+
+printAlias(0, {alias, _}) ->
+ true ;
+printAlias(Node, {alias, _AliasMap} = Alias) ->
+ ?debug_msg("alias ~p ~p\n", [Node - 1, getAlias(Node - 1, Alias)]),
+ printAlias(Node - 1, Alias).
+-endif.
+
+setAlias(Node, AliasNode, {alias, AliasMap} = Alias) ->
+ hipe_bifs:array_update(AliasMap, Node, AliasNode),
+ Alias.
+
+aliasToList({alias, AliasMap}) ->
+ aliasToList(AliasMap, hipe_bifs:array_length(AliasMap), []).
+
+aliasToList(AliasMap, I1, Tail) ->
+ I0 = I1 - 1,
+ case I0 >= 0 of
+ true ->
+ aliasToList(AliasMap, I0, [hipe_bifs:array_sub(AliasMap, I0)|Tail]);
+ _ ->
+ Tail
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: coalesce
+%%
+%% Description: Coalesces nodes in worklist
+%% Parameters:
+%% Moves -- Current move information
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Alias -- Current aliases for temporaries
+%% K -- Number of registers
+%%
+%% Returns:
+%% {Moves, IG, Worklists, Alias}
+%% (Updated versions of above structures, after coalescing)
+%%----------------------------------------------------------------------
+
+coalesce(Moves, IG, Worklists, Alias, K, Target) ->
+ case hipe_moves:worklist_get_and_remove(Moves) of
+ {[],Moves0} ->
+ %% Moves marked for removal from worklistMoves by FreezeMoves()
+ %% are removed by worklist_get_and_remove(). This case is unlikely,
+ %% but can occur if only stale moves remain in worklistMoves.
+ {Moves0, IG, Alias};
+ {Move,Moves0} ->
+ {Dest,Source} = hipe_moves:get_move(Move, Moves0),
+ ?debug_msg("Testing nodes ~p and ~p for coalescing~n",[Dest,Source]),
+ Alias_src = getAlias(Source, Alias),
+ Alias_dst = getAlias(Dest, Alias),
+ {U,V} = case Target:is_precoloured(Alias_dst) of
+ true -> {Alias_dst, Alias_src};
+ false -> {Alias_src, Alias_dst}
+ end,
+ %% When debugging, check that neither V nor U is on the stack.
+ case U =:= V of
+ true ->
+ %% drop coalesced move Move
+ {Moves0, IG, Alias, Worklists};
+ _ ->
+ case (Target:is_precoloured(V) orelse
+ hipe_ig:nodes_are_adjacent(U, V, IG)) of
+ true ->
+ %% drop constrained move Move
+ {Moves0, IG, Alias, Worklists};
+ false ->
+ case (case Target:is_precoloured(U) of
+ true ->
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ all_adjacent_ok(AdjV, U, Worklists, IG, K, Target);
+ false ->
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ AdjU = hipe_ig:node_adj_list(U, IG),
+ conservative(AdjU, AdjV, U, Worklists, IG, K)
+ end) of
+ true ->
+ %% drop coalesced move Move
+ {IG1, Alias1, Worklists1} =
+ combine(U, V, IG, Alias, Worklists, K, Target),
+ {Moves0, IG1, Alias1, Worklists1};
+ false ->
+ Moves1 = hipe_moves:add_active(Move, Moves0),
+ {Moves1, IG, Alias, Worklists}
+ end
+ end
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: coalesce_O
+%%
+%% Description: Coalesces nodes in worklist
+%% Parameters:
+%% Moves -- Current move information
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Alias -- Current aliases for temporaries
+%% K -- Number of registers
+%%
+%% Returns:
+%% {Moves, IG, Worklists, Alias}
+%% (Updated versions of above structures, after coalescing)
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+coalesce_O(Moves, IG, Worklists, Alias, K, Target) ->
+ case hipe_moves:worklist_get_and_remove(Moves) of
+ {[],Moves0} ->
+ %% Moves marked for removal from worklistMoves by FreezeMoves()
+ %% are removed by worklist_get_and_remove(). This case is unlikely,
+ %% but can occur if only stale moves remain in worklistMoves.
+ {Moves0,IG,Worklists,Alias};
+ {Move,Moves0} ->
+ {Dest,Source} = hipe_moves:get_move(Move, Moves0),
+ ?debug_msg("Testing nodes ~p and ~p for coalescing~n",[Dest,Source]),
+ Alias_src = getAlias(Source, Alias),
+ Alias_dst = getAlias(Dest, Alias),
+ {U,V} = case Target:is_precoloured(Alias_dst) of
+ true -> {Alias_dst, Alias_src};
+ false -> {Alias_src, Alias_dst}
+ end,
+ %% When debugging, check that neither V nor U is on the stack.
+ case U =:= V of
+ true ->
+ Moves1 = Moves0, % drop coalesced move Move
+ Worklists1 = add_worklist(Worklists, U, K, Moves1, IG, Target),
+ {Moves1, IG, Worklists1, Alias};
+ _ ->
+ case (Target:is_precoloured(V) orelse
+ hipe_ig:nodes_are_adjacent(U, V, IG)) of
+ true ->
+ Moves1 = Moves0, % drop constrained move Move
+ Worklists1 = add_worklist(Worklists, U, K, Moves1, IG, Target),
+ Worklists2 = add_worklist(Worklists1, V, K, Moves1, IG, Target),
+ {Moves1, IG, Worklists2, Alias};
+ false ->
+ case (case Target:is_precoloured(U) of
+ true ->
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ all_adjacent_ok(AdjV, U, Worklists, IG, K, Target);
+ false ->
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ AdjU = hipe_ig:node_adj_list(U, IG),
+ conservative(AdjU, AdjV, U, Worklists, IG, K)
+ end) of
+ true ->
+ Moves1 = Moves0, % drop coalesced move Move
+ {IG1,Worklists1,Moves2,Alias1} =
+ combine_O(U, V, IG, Worklists, Moves1, Alias, K, Target),
+ Worklists2 = add_worklist(Worklists1, U, K, Moves2, IG1, Target),
+ {Moves2, IG1, Worklists2, Alias1};
+ false ->
+ Moves1 = hipe_moves:add_active(Move, Moves0),
+ {Moves1, IG, Worklists, Alias}
+ end
+ end
+ end
+ end.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: add_worklist
+%%
+%% Description: Builds new worklists where U is transferred from freeze
+%% to simplify, if possible
+%%
+%% Parameters:
+%% Worklists -- Current worklists
+%% U -- Node to operate on
+%% K -- Number of registers
+%% Moves -- Current move information
+%% IG -- Interference graph
+%% Target -- The containing the target-specific functions
+%%
+%% Returns:
+%% Worklists (updated)
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+add_worklist(Worklists, U, K, Moves, IG, Target) ->
+ case (not(Target:is_precoloured(U))
+ andalso not(hipe_moves:move_related(U, Moves))
+ andalso (hipe_ig:is_trivially_colourable(U, K, IG))) of
+ true ->
+ hipe_reg_worklists:transfer_freeze_simplify(U, Worklists);
+ false ->
+ Worklists
+ end.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: combine
+%%
+%% Description: Combines two nodes into one (used when coalescing)
+%%
+%% Parameters:
+%% U -- First node to operate on
+%% V -- Second node to operate on
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Moves -- Current move information
+%% Alias -- Current aliases for temporaries
+%% K -- Number of registers
+%%
+%% Returns:
+%% {IG, Worklists, Moves, Alias} (updated)
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+combine_O(U, V, IG, Worklists, Moves, Alias, K, Target) ->
+ Worklists1 = case hipe_reg_worklists:member_freeze(V, Worklists) of
+ true -> hipe_reg_worklists:remove_freeze(V, Worklists);
+ false -> hipe_reg_worklists:remove_spill(V, Worklists)
+ end,
+ Worklists11 = hipe_reg_worklists:add_coalesced(V, Worklists1),
+
+ ?debug_msg("Coalescing ~p and ~p to ~p~n",[V,U,U]),
+
+ Alias1 = setAlias(V, U, Alias),
+
+ %% Typo in published algorithm: s/nodeMoves/moveList/g to fix.
+ %% XXX: moveList[u] \union moveList[v] OR NodeMoves(u) \union NodeMoves(v) ???
+ %% XXX: NodeMoves() is correct, but unnecessarily strict. The ordsets:union
+ %% constrains NodeMoves() to return an ordset.
+ Moves1 = hipe_moves:update_movelist(U,
+ ordsets:union(hipe_moves:node_moves(U, Moves),
+ hipe_moves:node_moves(V, Moves)),
+ Moves),
+ %% Missing in published algorithm. From Tiger book Errata.
+ Moves2 = enable_moves_active_to_worklist(hipe_moves:node_movelist(V, Moves1), Moves1),
+ AdjV = hipe_ig:node_adj_list(V, IG),
+
+ {IG1, Worklists2, Moves3} =
+ combine_edges_O(AdjV, U, IG, Worklists11, Moves2, K, Target),
+
+ New_worklists = case (not(hipe_ig:is_trivially_colourable(U, K, IG1))
+ andalso hipe_reg_worklists:member_freeze(U, Worklists2)) of
+ true -> hipe_reg_worklists:transfer_freeze_spill(U, Worklists2);
+ false -> Worklists2
+ end,
+ {IG1, New_worklists, Moves3, Alias1}.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: combine
+%%
+%% Description: Combines two nodes into one (used when coalescing)
+%%
+%% Parameters:
+%% U -- First node to operate on
+%% V -- Second node to operate on
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Moves -- Current move information
+%% Alias -- Current aliases for temporaries
+%% K -- Number of registers
+%%
+%% Returns:
+%% {IG, Worklists, Moves, Alias} (updated)
+%%----------------------------------------------------------------------
+
+combine(U, V, IG, Alias, Worklists, K, Target) ->
+ ?debug_msg("N_Coalescing ~p and ~p to ~p~n",[V,U,U]),
+ Worklists1 = hipe_reg_worklists:add_coalesced(V, U, Worklists),
+ Alias1 = setAlias(V, U, Alias),
+ AdjV = hipe_ig:node_adj_list(V, IG),
+ IG1 = combine_edges(AdjV, U, IG, Worklists1, K, Target),
+ {IG1, Alias1, Worklists1}.
+
+%%----------------------------------------------------------------------
+%% Function: combine_edges
+%%
+%% Description: For each node in a list, make an edge between that node
+%% and node U, and decrement its degree by 1
+%% (Used when two nodes are coalesced, to connect all nodes
+%% adjacent to one node to the other node)
+%%
+%% Parameters:
+%% [T|Ts] -- List of nodes to make edges to
+%% U -- Node to make edges from
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Moves -- Current move information
+%% K -- Number of registers
+%%
+%% Returns:
+%% {IG, Worklists, Moves} (updated)
+%%----------------------------------------------------------------------
+
+combine_edges([], _U, IG, _Worklists, _K, _Target) ->
+ IG;
+combine_edges([T|Ts], U, IG, Worklists, K, Target) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(T, Worklists) of
+ true -> combine_edges(Ts, U, IG, Worklists, K, Target);
+ _ ->
+ IG1 = hipe_ig:add_edge(T, U, IG, Target),
+ IG2 = case Target:is_precoloured(T) of
+ true -> IG1;
+ false -> hipe_ig:dec_node_degree(T, IG1)
+ end,
+ combine_edges(Ts, U, IG2, Worklists, K, Target)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: combine_edges
+%%
+%% Description: For each node in a list, make an edge between that node
+%% and node U, and decrement its degree by 1
+%% (Used when two nodes are coalesced, to connect all nodes
+%% adjacent to one node to the other node)
+%%
+%% Parameters:
+%% [T|Ts] -- List of nodes to make edges to
+%% U -- Node to make edges from
+%% IG -- Interference graph
+%% Worklists -- Current worklists
+%% Moves -- Current move information
+%% K -- Number of registers
+%%
+%% Returns:
+%% {IG, Worklists, Moves} (updated)
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+combine_edges_O([], _U, IG, Worklists, Moves, _K, _Target) ->
+ {IG, Worklists, Moves};
+combine_edges_O([T|Ts], U, IG, Worklists, Moves, K, Target) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(T, Worklists) of
+ true -> combine_edges_O(Ts, U, IG, Worklists, Moves, K, Target);
+ _ ->
+ %% XXX: The issue below occurs because the T->V edge isn't removed.
+ %% This causes adjList[T] to contain stale entries, to possibly grow
+ %% (if T isn't already adjacent to U), and degree[T] to possibly
+ %% increase (again, if T isn't already adjacent to U).
+ %% The decrement_degree() call repairs degree[T] but not adjList[T].
+ %% It would be better to physically replace T->V with T->U, and only
+ %% decrement_degree(T) if T->U already existed.
+ %%
+ %% add_edge() may change a low-degree move-related node to be of
+ %% significant degree. In this case the node belongs in the spill
+ %% worklist, and that's where decrement_degree() expects to find it.
+ %% This issue is not covered in the published algorithm.
+ OldDegree = hipe_ig:get_node_degree(T, IG),
+ IG1 = hipe_ig:add_edge(T, U, IG, Target),
+ NewDegree = hipe_ig:get_node_degree(T, IG1),
+ Worklists0 =
+ if NewDegree =:= K, OldDegree =:= K-1 ->
+ %% ?debug_msg("~w:combine_edges_O(): repairing worklist membership for node ~w\n", [?MODULE,T]),
+ %% The node T must be on the freeze worklist:
+ %% 1. Since we're coalescing, the simplify worklist must have been
+ %% empty when combine_edges_O() started.
+ %% 2. decrement_degree() may put the node T back on the simplify
+ %% worklist, but that occurs after the worklists repair step.
+ %% 3. There are no duplicates among the edges.
+ Worklists00 = hipe_reg_worklists:remove_freeze(T, Worklists),
+ hipe_reg_worklists:add_spill(T, Worklists00);
+ true ->
+ Worklists
+ end,
+ {IG2, Worklists1, Moves1} =
+ decrement_degree_O([T], IG1, Worklists0, Moves, K),
+ combine_edges_O(Ts, U, IG2, Worklists1, Moves1, K, Target)
+ end.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: undoCoalescing
+%%
+%% Description: Returns necessary information for a coalesced node
+%%
+%% Parameters:
+%% N -- The node to uncoalesce
+%% No_temporaries -- Number of temporaries
+%% Alias -- The Alias vector before undoing
+%% SavedAdj -- Saved adjacency list
+%% IG -- Interference graph
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% list of primitive nodes, that is all nodes that were previously
+%% coalesced to N
+%% updated alias vector
+%% updated Interferece graph
+%%----------------------------------------------------------------------
+undoCoalescing(N, No_temporaries, Alias, SavedAdj, IG, Target) ->
+ Primitives = findPrimitiveNodes(No_temporaries, N, Alias),
+ Alias1 = restoreAliases(Primitives, Alias),
+ IG1 = fixAdj(N, SavedAdj, IG, Target),
+ {Primitives, Alias1, IG1}.
+
+%% Restore aliasinfo for primitive nodes, that is
+%% unalias the node sthat were aliased to the primitive
+%% nodes. Note that an unaliased node could be
+%% represented in two ways, either not aliased or aliased
+%% to itself. See also getAlias
+restoreAliases([], Alias) ->
+ Alias;
+restoreAliases([Primitive|Primitives], Alias) ->
+ Alias1 = setAlias(Primitive, Primitive, Alias),
+ restoreAliases(Primitives, Alias1).
+
+%% find the primitive nodes to N, that is find all
+%% nodes that are aliased to N
+findPrimitiveNodes(No_temporaries, N, Alias) ->
+ findPrimitiveNodes(No_temporaries, N, Alias, []).
+
+findPrimitiveNodes(0, _N, _Alias, PrimitiveNodes) ->
+ PrimitiveNodes;
+findPrimitiveNodes(Node, N, Alias, PrimitiveNodes) ->
+ NextNode = Node - 1,
+ case (getAlias(NextNode, Alias) =:= N) of
+ true -> findPrimitiveNodes(NextNode, N, Alias, [NextNode | PrimitiveNodes]);
+ _ -> findPrimitiveNodes(NextNode, N, Alias, PrimitiveNodes)
+ end.
+
+%test_undoCoalescing(No_temporaries, Alias, Worklists) ->
+% test_undoCoalescing(No_temporaries, No_temporaries, Alias, Worklists).
+%
+%test_undoCoalescing(0, _No_temporaries, _Alias, _Worklists) ->
+% true;
+%test_undoCoalescing(Node, No_temporaries, Alias, Worklists) ->
+% %?debug_msg("++ the adj list: ~p~n", [SavedAdj]),
+% %?debug_msg("Node ~p~n", [Node]),
+% NextNode = Node - 1,
+% Coalesced_to = hipe_reg_worklists:member_coalesced_to(NextNode, Worklists),
+% ?debug_msg("��-- member coalesced: ~p~n", [Coalesced_to]),
+% {Primitives, Alias1} = undoCoalescing(NextNode, No_temporaries, Alias),
+% ?debug_msg("��-- primitivenodes ~w\n", [Primitives]),
+% case (Coalesced_to) of
+% true -> printAlias(Alias1);
+% _ -> true
+% end,
+% test_undoCoalescing(NextNode, No_temporaries, Alias, Worklists).
+
+%%----------------------------------------------------------------------
+%% Function: fixAdj
+%%
+%% Description: Fixes adajency set and adjacency list when undoing coalescing
+%%
+%% Parameters:
+%% N -- Node that should be uncoalesced
+%% SavedAdj -- Saved adjacency list
+%% IG -- Interference graph
+%% Target -- The module containing the target-specific functions.
+%%
+%% Returns:
+%% updated Interferece graph
+%%----------------------------------------------------------------------
+fixAdj(N, SavedAdj, IG, Target) ->
+ %Saved = hipe_vectors:get(SavedAdj, N),
+ Saved = hipe_adj_list:edges(N, SavedAdj),
+ ?debug_msg("��--adj to ~p: ~p~n", [N, Saved]),
+ Adj = hipe_ig:node_adj_list(N, IG),
+ ?debug_msg("��--adj to ~p: ~p~n", [N, Adj]),
+ New = findNew(Adj, Saved),
+ ?debug_msg("++--new adj to ~p: ~p~n", [N, New]),
+ removeAdj(New, N, IG, Target),
+ %% XXX the following lines seems to make double nodes in
+ %% some adj_lists, which is a bug, apart from that they
+ %% don't seem to make any difference at all (even though
+ %% they are in the pseudocode of "optimistic coalescing")
+ %% addedge for all in the restored adj_list
+ %%RestoredAdj = hipe_ig:node_adj_list(N, IG),
+ %%?debug_msg("adj_lists_before_restore_o ~n~p~n", [hipe_ig:adj_list(IG)]),
+ %%restoreAdj(RestoredAdj, N, IG, Alias, Target).
+ IG.
+
+removeAdj([], _N, _IG, _Target) ->
+ true;
+removeAdj([V| New], N, IG, Target) ->
+ hipe_ig:remove_edge(V, N, IG, Target),
+ removeAdj(New, N, IG, Target).
+
+%%restoreAdj([], _N, IG, _Alias, _Target) ->
+%% %%?debug_msg("adj_lists__after_restore_o ~n~p~n", [hipe_ig:adj_list(IG)]),
+%% IG;
+%%restoreAdj([V| AdjToN], N, IG, Alias, Target) ->
+%% AliasToV = getAlias(V, Alias),
+%% IG1 = hipe_ig:add_edge(N, AliasToV, IG, Target),
+%% restoreAdj(AdjToN, N, IG1, Alias, Target).
+
+%% XXX This is probably a clumsy way of doing it
+%% better to assure the lists are sorted from the beginning
+%% also coalesce findNew and removeAdj should improve performance
+findNew(Adj, Saved) ->
+ findNew(Adj, Saved, []).
+
+findNew([], _Saved, New) ->
+ New;
+findNew([A| Adj], Saved, New) ->
+ case lists:member(A, Saved) of
+ true -> findNew(Adj, Saved, New);
+ _ -> findNew(Adj, Saved, [A| New])
+ end.
+
+%test_fixAdj(0, _SavedAdj, IG, _Target) ->
+% IG;
+%test_fixAdj(Node, SavedAdj, IG, Target) ->
+% NextNode = Node - 1,
+% IG1 = fixAdj(NextNode, SavedAdj, IG, Target),
+% test_fixAdj(NextNode, SavedAdj, IG1, Target).
+%%----------------------------------------------------------------------
+%% Function: ok
+%%
+%% Description: Checks if a node T is suitable to coalesce with R
+%%
+%% Parameters:
+%% T -- Node to test
+%% R -- Other node to test
+%% IG -- Interference graph
+%% K -- Number of registers
+%% Target -- The module containing the target-specific functions
+%%
+%% Returns:
+%% true iff coalescing is OK
+%%----------------------------------------------------------------------
+
+ok(T, R, IG, K, Target) ->
+ ((hipe_ig:is_trivially_colourable(T, K, IG))
+ orelse Target:is_precoloured(T)
+ orelse hipe_ig:nodes_are_adjacent(T, R, IG)).
+
+%%----------------------------------------------------------------------
+%% Function: all_ok
+%%
+%% Description: True iff, for every T in the list, OK(T,U)
+%%
+%% Parameters:
+%% [T|Ts] -- Nodes to test
+%% U -- Node to test for coalescing
+%% IG -- Interference graph
+%% K -- Number of registers
+%% Target -- The module containing the target-specific functions
+%%
+%% Returns:
+%% true iff coalescing is OK for all nodes in the list
+%%----------------------------------------------------------------------
+
+all_adjacent_ok([], _U, _Worklists, _IG, _K, _Target) -> true;
+all_adjacent_ok([T|Ts], U, Worklists, IG, K, Target) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(T, Worklists) of
+ true -> all_adjacent_ok(Ts, U, Worklists, IG, K, Target);
+ _ ->
+ %% 'andalso' does not preserve tail-recursion
+ case ok(T, U, IG, K, Target) of
+ true -> all_adjacent_ok(Ts, U, Worklists, IG, K, Target);
+ false -> false
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: conservative
+%%
+%% Description: Checks if nodes can be safely coalesced according to
+%% the Briggs' conservative coalescing heuristic
+%%
+%% Parameters:
+%% Nodes -- Adjacent nodes
+%% IG -- Interference graph
+%% K -- Number of registers
+%%
+%% Returns:
+%% true iff coalescing is safe
+%%----------------------------------------------------------------------
+
+conservative(AdjU, AdjV, U, Worklists, IG, K) ->
+ conservative_countU(AdjU, AdjV, U, Worklists, IG, K, 0).
+
+%%----------------------------------------------------------------------
+%% Function: conservative_count
+%%
+%% Description: Counts degrees for conservative (Briggs' heuristics)
+%%
+%% Parameters:
+%% Nodes -- (Remaining) adjacent nodes
+%% IG -- Interference graph
+%% K -- Number of registers
+%% Cnt -- Accumulator for counting
+%%
+%% Returns:
+%% Final value of accumulator
+%%----------------------------------------------------------------------
+
+conservative_countU([], AdjV, U, Worklists, IG, K, Cnt) ->
+ conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+conservative_countU([Node|AdjU], AdjV, U, Worklists, IG, K, Cnt) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(Node, Worklists) of
+ true -> conservative_countU(AdjU, AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ case hipe_ig:is_trivially_colourable(Node, K, IG) of
+ true -> conservative_countU(AdjU, AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ Cnt1 = Cnt + 1,
+ if Cnt1 < K -> conservative_countU(AdjU, AdjV, U, Worklists, IG, K, Cnt1);
+ true -> false
+ end
+ end
+ end.
+
+conservative_countV([], _U, _Worklists, _IG, _K, _Cnt) -> true;
+conservative_countV([Node|AdjV], U, Worklists, IG, K, Cnt) ->
+ case hipe_reg_worklists:member_stack_or_coalesced(Node, Worklists) of
+ true -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ case hipe_ig:nodes_are_adjacent(Node, U, IG) of
+ true -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ case hipe_ig:is_trivially_colourable(Node, K, IG) of
+ true -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt);
+ _ ->
+ Cnt1 = Cnt + 1,
+ if Cnt1 < K -> conservative_countV(AdjV, U, Worklists, IG, K, Cnt1);
+ true -> false
+ end
+ end
+ end
+ end.
+
+%%---------------------------------------------------------------------
+%% Function: selectSpill
+%%
+%% Description: Select the node to spill and spill it
+%% Parameters:
+%% WorkLists -- A datatype containing the different worklists
+%% IG -- The interference graph
+%% K -- The number of available registers
+%% Alias -- The alias mapping
+%% SpillLimit -- Try not to spill any nodes above the spill limit
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%%---------------------------------------------------------------------
+
+selectSpill(WorkLists, IG, SpillLimit) ->
+ [CAR|CDR] = hipe_reg_worklists:spill(WorkLists),
+ SpillCost = getCost(CAR, IG, SpillLimit),
+ M = findCheapest(CDR, IG, SpillCost, CAR, SpillLimit),
+ WorkLists1 = hipe_reg_worklists:remove_spill(M, WorkLists),
+ hipe_reg_worklists:add_simplify(M, WorkLists1).
+
+%%---------------------------------------------------------------------
+%% Function: selectSpill
+%%
+%% Description: Select the node to spill and spill it
+%% Parameters:
+%% WorkLists -- A datatype containing the different worklists
+%% Moves -- A datatype containing the move sets
+%% IG -- The interference graph
+%% K -- The number of available registers
+%% Alias -- The alias mapping
+%% SpillLimit -- Try not to spill any nodes above the spill limit
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%% Moves -- The updated moves
+%%---------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+selectSpill_O(WorkLists, Moves, IG, K, Alias, SpillLimit) ->
+ [CAR|CDR] = hipe_reg_worklists:spill(WorkLists),
+
+ SpillCost = getCost(CAR, IG, SpillLimit),
+ M = findCheapest(CDR, IG, SpillCost, CAR, SpillLimit),
+
+ WorkLists1 = hipe_reg_worklists:remove_spill(M, WorkLists),
+ %% The published algorithm adds M to the simplify worklist
+ %% before the freezeMoves() call. That breaks the worklist
+ %% invariants, which is why the order is switched here.
+ {WorkLists2,Moves1} = freezeMoves(M, K, WorkLists1, Moves, IG, Alias),
+ WorkLists3 = hipe_reg_worklists:add_simplify(M, WorkLists2),
+ {WorkLists3,Moves1}.
+-endif.
+
+%% Find the node that is cheapest to spill
+
+findCheapest([], _IG, _Cost, Cheapest, _SpillLimit) ->
+ Cheapest;
+findCheapest([Node|Nodes], IG, Cost, Cheapest, SpillLimit) ->
+ ThisCost = getCost(Node, IG, SpillLimit),
+ case ThisCost < Cost of
+ true ->
+ findCheapest(Nodes, IG, ThisCost, Node, SpillLimit);
+ false ->
+ findCheapest(Nodes, IG, Cost, Cheapest, SpillLimit)
+ end.
+
+%% Get the cost for spilling a certain node, node numbers above the spill
+%% limit are extremely expensive.
+
+getCost(Node, IG, SpillLimit) ->
+ case Node > SpillLimit of
+ true -> inf;
+ false ->
+ SpillCost = hipe_ig:node_spill_cost(Node, IG),
+ ?debug_msg("Actual spillcost f node ~w is ~w~n", [Node, SpillCost]),
+ SpillCost
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: freeze
+%%
+%% Description: When both simplifying and coalescing is impossible we
+%% rather freezes a node in stead of spilling, this function
+%% selects a node for freezing (it just picks the first one in
+%% the list)
+%%
+%% Parameters:
+%% K -- The number of available registers
+%% WorkLists -- A datatype containing the different worklists
+%% Moves -- A datatype containing the different movelists
+%% IG -- Interference graph
+%% Alias -- An alias mapping, shows the alias of all coalesced
+%% nodes
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%% Moves -- The updated movelists
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+freeze(K, WorkLists, Moves, IG, Alias) ->
+ [U|_] = hipe_reg_worklists:freeze(WorkLists), % Smarter routine?
+ ?debug_msg("freezing node ~p~n", [U]),
+ WorkLists0 = hipe_reg_worklists:remove_freeze(U, WorkLists),
+ %% The published algorithm adds U to the simplify worklist
+ %% before the freezeMoves() call. That breaks the worklist
+ %% invariants, which is why the order is switched here.
+ {WorkLists1, Moves1} = freezeMoves(U, K, WorkLists0, Moves, IG, Alias),
+ WorkLists2 = hipe_reg_worklists:add_simplify(U, WorkLists1),
+ {WorkLists2, Moves1}.
+-endif.
+
+%%----------------------------------------------------------------------
+%% Function: freezeMoves
+%%
+%% Description: Make all move related interferences for a certain node
+%% into ordinary interference arcs.
+%%
+%% Parameters:
+%% U -- The node we want to freeze
+%% K -- The number of available registers
+%% WorkLists -- A datatype containing the different worklists
+%% Moves -- A datatype containing the different movelists
+%% IG -- Interference graph
+%% Alias -- An alias mapping, shows the alias of all coalesced
+%% nodes
+%%
+%% Returns:
+%% WorkLists -- The updated worklists
+%% Moves -- The updated movelists
+%%----------------------------------------------------------------------
+
+-ifdef(COMPARE_ITERATED_OPTIMISTIC).
+freezeMoves(U, K, WorkLists, Moves, IG, Alias) ->
+ Nodes = hipe_moves:node_moves(U, Moves),
+ freezeEm(U, Nodes, K, WorkLists, Moves, IG, Alias).
+
+%% Find what the other value in a copy instruction is, return false if
+%% the instruction isn't a move with the first argument in it.
+
+moves(U, Move, Alias, Moves) ->
+ {X,Y} = hipe_moves:get_move(Move, Moves),
+ %% The old code (which followed the published algorithm) did
+ %% not follow aliases before looking for "the other" node.
+ %% This caused moves() to skip some moves, making some nodes
+ %% still move-related after freezeMoves(). These move-related
+ %% nodes were then added to the simplify worklist (by freeze()
+ %% or selectSpill()), breaking the worklist invariants. Nodes
+ %% already simplified appeared in coalesce_O(), were re-added to
+ %% the simplify worklist by add_worklist(), simplified again,
+ %% and coloured multiple times by assignColors(). Ouch!
+ X1 = getAlias(X, Alias),
+ Y1 = getAlias(Y, Alias),
+ if U =:= X1 -> Y1;
+ U =:= Y1 -> X1;
+ true -> exit({?MODULE,moves}) % XXX: shouldn't happen
+ end.
+
+freezeEm(_U, [], _K, WorkLists, Moves, _IG, _Alias) ->
+ {WorkLists,Moves};
+freezeEm(U, [M|Ms], K, WorkLists, Moves, IG, Alias) ->
+ V = moves(U, M, Alias, Moves),
+ {WorkLists2,Moves2} = freezeEm2(U, V, M, K, WorkLists, Moves, IG, Alias),
+ freezeEm(U, Ms, K, WorkLists2, Moves2, IG, Alias).
+
+freezeEm2(U, V, M, K, WorkLists, Moves, IG, Alias) ->
+ case hipe_moves:member_active(M, Moves) of
+ true ->
+ Moves1 = hipe_moves:remove_active(M, Moves),
+ freezeEm3(U, V, M, K, WorkLists, Moves1, IG, Alias);
+ false ->
+ Moves1 = hipe_moves:remove_worklist(M, Moves),
+ freezeEm3(U, V, M, K, WorkLists, Moves1, IG, Alias)
+ end.
+
+freezeEm3(_U,V,_M,K,WorkLists,Moves,IG,_Alias) ->
+ Moves1 = Moves, % drop frozen move M
+ V1 = V, % getAlias(V,Alias),
+ %% "not MoveRelated(v)" is cheaper than "NodeMoves(v) = {}"
+ case ((not hipe_moves:move_related(V1,Moves1)) andalso
+ hipe_ig:is_trivially_colourable(V1,K,IG)) of
+ true ->
+ ?debug_msg("freezing move to ~p~n", [V]),
+ Worklists1 = hipe_reg_worklists:transfer_freeze_simplify(V1, WorkLists),
+ {Worklists1,Moves1};
+ false ->
+ {WorkLists,Moves1}
+ end.
+-endif.
diff --git a/lib/hipe/regalloc/hipe_ppc_specific.erl b/lib/hipe/regalloc/hipe_ppc_specific.erl
new file mode 100644
index 0000000000..dd2855208b
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_ppc_specific.erl
@@ -0,0 +1,168 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_specific).
+
+%% for hipe_coalescing_regalloc:
+-export([number_of_temporaries/1
+ ,analyze/1
+ ,labels/1
+ ,all_precoloured/0
+ ,bb/2
+ ,liveout/2
+ ,reg_nr/1
+ ,def_use/1
+ ,is_move/1
+ ,is_precoloured/1
+ ,var_range/1
+ ,allocatable/0
+ ,non_alloc/1
+ ,physical_name/1
+ ,reverse_postorder/1
+ ,livein/2
+ ,uses/1
+ ,defines/1
+ ]).
+
+%% for hipe_graph_coloring_regalloc:
+-export([is_fixed/1]).
+
+%% for hipe_ls_regalloc:
+-export([args/1, is_arg/1, is_global/1, new_spill_index/1]).
+-export([breadthorder/1, postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+defun_to_cfg(Defun) ->
+ hipe_ppc_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ hipe_ppc_ra_postconditions:check_and_rewrite(Defun, Coloring, 'normal').
+
+reverse_postorder(CFG) ->
+ hipe_ppc_cfg:reverse_postorder(CFG).
+
+non_alloc(CFG) ->
+ non_alloc(hipe_ppc_registers:nr_args(), hipe_ppc_cfg:params(CFG)).
+
+%% same as hipe_ppc_frame:fix_formals/2
+non_alloc(0, Rest) -> Rest;
+non_alloc(N, [_|Rest]) -> non_alloc(N-1, Rest);
+non_alloc(_, []) -> [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ hipe_ppc_liveness_gpr:analyse(CFG).
+
+livein(Liveness,L) ->
+ [X || X <- hipe_ppc_liveness_gpr:livein(Liveness,L),
+ hipe_ppc:temp_is_allocatable(X)].
+
+liveout(BB_in_out_liveness,Label) ->
+ [X || X <- hipe_ppc_liveness_gpr:liveout(BB_in_out_liveness,Label),
+ hipe_ppc:temp_is_allocatable(X)].
+
+%% Registers stuff
+
+allocatable() ->
+ hipe_ppc_registers:allocatable_gpr().
+
+all_precoloured() ->
+ hipe_ppc_registers:all_precoloured().
+
+is_precoloured(Reg) ->
+ hipe_ppc_registers:is_precoloured_gpr(Reg).
+
+is_fixed(R) ->
+ hipe_ppc_registers:is_fixed(R).
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_ppc_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(ppc).
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(ppc),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG,L) ->
+ hipe_ppc_cfg:bb(CFG,L).
+
+%% PowerPC stuff
+
+def_use(Instruction) ->
+ {defines(Instruction), uses(Instruction)}.
+
+uses(I) ->
+ [X || X <- hipe_ppc_defuse:insn_use_gpr(I),
+ hipe_ppc:temp_is_allocatable(X)].
+
+defines(I) ->
+ [X || X <- hipe_ppc_defuse:insn_def_gpr(I),
+ hipe_ppc:temp_is_allocatable(X)].
+
+is_move(Instruction) ->
+ case hipe_ppc:is_pseudo_move(Instruction) of
+ true ->
+ Dst = hipe_ppc:pseudo_move_dst(Instruction),
+ case hipe_ppc:temp_is_allocatable(Dst) of
+ false -> false;
+ _ ->
+ Src = hipe_ppc:pseudo_move_src(Instruction),
+ hipe_ppc:temp_is_allocatable(Src)
+ end;
+ false -> false
+ end.
+
+reg_nr(Reg) ->
+ hipe_ppc:temp_reg(Reg).
+
+%%% Linear Scan stuff
+
+new_spill_index(SpillIndex) when is_integer(SpillIndex) ->
+ SpillIndex+1.
+
+breadthorder(CFG) ->
+ hipe_ppc_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_ppc_cfg:postorder(CFG).
+
+is_global(R) ->
+ R =:= hipe_ppc_registers:temp1() orelse
+ R =:= hipe_ppc_registers:temp2() orelse
+ R =:= hipe_ppc_registers:temp3() orelse
+ hipe_ppc_registers:is_fixed(R).
+
+is_arg(R) ->
+ hipe_ppc_registers:is_arg(R).
+
+args(CFG) ->
+ hipe_ppc_registers:args(hipe_ppc_cfg:arity(CFG)).
diff --git a/lib/hipe/regalloc/hipe_ppc_specific_fp.erl b/lib/hipe/regalloc/hipe_ppc_specific_fp.erl
new file mode 100644
index 0000000000..35623e7994
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_ppc_specific_fp.erl
@@ -0,0 +1,146 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_ppc_specific_fp).
+
+%% for hipe_coalescing_regalloc:
+-export([number_of_temporaries/1
+ ,analyze/1
+ ,labels/1
+ ,all_precoloured/0
+ ,bb/2
+ ,liveout/2
+ ,reg_nr/1
+ ,def_use/1
+ ,is_move/1
+ ,is_precoloured/1
+ ,var_range/1
+ ,allocatable/0
+ ,non_alloc/1
+ ,physical_name/1
+ ,reverse_postorder/1
+ ,livein/2
+ ,uses/1
+ ,defines/1
+ ]).
+
+%% for hipe_graph_coloring_regalloc:
+-export([is_fixed/1]).
+
+%% for hipe_ls_regalloc:
+%%-export([args/1, is_arg/1, is_global, new_spill_index/1]).
+%%-export([breadthorder/1, postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+defun_to_cfg(Defun) ->
+ hipe_ppc_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ hipe_ppc_ra_postconditions_fp:check_and_rewrite(Defun, Coloring).
+
+reverse_postorder(CFG) ->
+ hipe_ppc_cfg:reverse_postorder(CFG).
+
+non_alloc(_CFG) ->
+ [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ hipe_ppc_liveness_fpr:analyse(CFG).
+
+livein(Liveness, L) ->
+ hipe_ppc_liveness_fpr:livein(Liveness, L).
+
+liveout(BB_in_out_liveness, Label) ->
+ hipe_ppc_liveness_fpr:liveout(BB_in_out_liveness, Label).
+
+%% Registers stuff
+
+allocatable() ->
+ hipe_ppc_registers:allocatable_fpr().
+
+all_precoloured() ->
+ allocatable().
+
+is_precoloured(Reg) ->
+ hipe_ppc_registers:is_precoloured_fpr(Reg).
+
+is_fixed(_Reg) ->
+ false.
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_ppc_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(ppc).
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(ppc),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG, L) ->
+ hipe_ppc_cfg:bb(CFG, L).
+
+%% PowerPC stuff
+
+def_use(I) ->
+ {defines(I), uses(I)}.
+
+uses(I) ->
+ hipe_ppc_defuse:insn_use_fpr(I).
+
+defines(I) ->
+ hipe_ppc_defuse:insn_def_fpr(I).
+
+is_move(I) ->
+ hipe_ppc:is_pseudo_fmove(I).
+
+reg_nr(Reg) ->
+ hipe_ppc:temp_reg(Reg).
+
+-ifdef(notdef).
+new_spill_index(SpillIndex) ->
+ SpillIndex+1.
+
+breadthorder(CFG) ->
+ hipe_ppc_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_ppc_cfg:postorder(CFG).
+
+is_global(_R) ->
+ false.
+
+is_arg(_R) ->
+ false.
+
+args(_CFG) ->
+ [].
+-endif.
diff --git a/lib/hipe/regalloc/hipe_reg_worklists.erl b/lib/hipe/regalloc/hipe_reg_worklists.erl
new file mode 100644
index 0000000000..67a5788c7c
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_reg_worklists.erl
@@ -0,0 +1,360 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%----------------------------------------------------------------------
+%%% File : hipe_reg_worklists.erl
+%%% Author : Andreas Wallin <d96awa@csd.uu.se>
+%%% Purpose : Represents sets of nodes/temporaries that we are
+%%% working on, such as simplify and spill sets.
+%%% Created : 3 Feb 2000 by Andreas Wallin <d96awa@csd.uu.se>
+%%% Modified: Spring 2005 by NilsOla Linnermark <nilsola@abc.se>
+%%% to suit the optimistic coalesching allocator
+%%%----------------------------------------------------------------------
+
+-module(hipe_reg_worklists).
+-author(['Andreas Wallin', 'Thorild Sel�n']).
+-export([new/5, % only used by optimistic allocator
+ new/6,
+ simplify/1,
+ spill/1,
+ freeze/1,
+ stack/1,
+ add_simplify/2,
+ add_freeze/2,
+ add_coalesced/2,
+ add_coalesced/3, % only used by optimistic allocator
+ add_spill/2,
+ push_stack/3,
+ remove_simplify/2,
+ remove_spill/2,
+ remove_freeze/2,
+ is_empty_simplify/1,
+ is_empty_spill/1,
+ is_empty_freeze/1,
+ member_freeze/2,
+ member_coalesced_to/2, % only used by optimistic allocator
+ member_stack_or_coalesced/2,
+ non_stacked_or_coalesced_nodes/2,
+ transfer_freeze_simplify/2,
+ transfer_freeze_spill/2
+ ]).
+-ifdef(DEBUG_PRINTOUTS).
+-export([print_memberships/1]).
+-endif.
+
+-record(worklists,
+ {simplify, % Low-degree nodes (if coalescing non move-related)
+ stack, % Stack of removed low-degree nodes, with adjacency lists
+ membership, % Mapping from temp to which set it is in
+ coalesced_to, % if the node is coalesced to (only used by optimistic allocator)
+ spill, % Significant-degree nodes
+ freeze % Low-degree move-related nodes
+ }).
+
+%%-ifndef(DEBUG).
+%%-define(DEBUG,true).
+%%-endif.
+-include("../main/hipe.hrl").
+
+%%%----------------------------------------------------------------------
+%% Function: new
+%%
+%% Description: Constructor for worklists structure
+%%
+%% Parameters:
+%% IG -- Interference graph
+%% Target -- Target module name
+%% CFG -- Target-specific CFG
+%% Move_sets -- Move information
+%% K -- Number of registers
+%%
+%% Returns:
+%% A new worklists data structure
+%%
+%%%----------------------------------------------------------------------
+
+new(IG, Target, CFG, K, No_temporaries) -> % only used by optimistic allocator
+ CoalescedTo = hipe_bifs:array(No_temporaries, 'none'),
+ init(initial(Target, CFG), K, IG, empty(No_temporaries, CoalescedTo)).
+
+new(IG, Target, CFG, Move_sets, K, No_temporaries) ->
+ init(initial(Target, CFG), K, IG, Move_sets, empty(No_temporaries, [])).
+
+initial(Target, CFG) ->
+ {Min_temporary, Max_temporary} = Target:var_range(CFG),
+ NonAlloc = Target:non_alloc(CFG),
+ non_precoloured(Target, Min_temporary, Max_temporary, [])
+ -- [Target:reg_nr(X) || X <- NonAlloc].
+
+non_precoloured(Target, Current, Max_temporary, Initial) ->
+ if Current > Max_temporary ->
+ Initial;
+ true ->
+ NewInitial =
+ case Target:is_precoloured(Current) of
+ true -> Initial;
+ false -> [Current|Initial]
+ end,
+ non_precoloured(Target, Current+1, Max_temporary, NewInitial)
+ end.
+
+%% construct an empty initialized worklists data structure
+empty(No_temporaries, CoalescedTo) ->
+ #worklists{
+ membership = hipe_bifs:array(No_temporaries, 'none'),
+ coalesced_to = CoalescedTo, % only used by optimistic allocator
+ simplify = ordsets:new(),
+ stack = [],
+ spill = ordsets:new(),
+ freeze = ordsets:new()
+ }.
+
+%% Selectors for worklists record
+
+simplify(Worklists) -> Worklists#worklists.simplify.
+spill(Worklists) -> Worklists#worklists.spill.
+freeze(Worklists) -> Worklists#worklists.freeze.
+stack(Worklists) -> Worklists#worklists.stack.
+
+%% Updating worklists records
+
+set_simplify(Simplify, Worklists) ->
+ Worklists#worklists{simplify = Simplify}.
+set_spill(Spill, Worklists) ->
+ Worklists#worklists{spill = Spill}.
+set_freeze(Freeze, Worklists) ->
+ Worklists#worklists{freeze = Freeze}.
+
+
+%%----------------------------------------------------------------------
+%% Function: init
+%%
+%% Description: Initializes worklists
+%%
+%% Parameters:
+%% Initials -- Not precoloured temporaries
+%% K -- Number of registers
+%% IG -- Interference graph
+%% Move_sets -- Move information
+%% Worklists -- (Empty) worklists structure
+%%
+%% Returns:
+%% Initialized worklists structure
+%%
+%%----------------------------------------------------------------------
+
+init([], _, _, Worklists) -> Worklists;
+init([Initial|Initials], K, IG, Worklists) ->
+ case hipe_ig:is_trivially_colourable(Initial, K, IG) of
+ false ->
+ New_worklists = add_spill(Initial, Worklists),
+ init(Initials, K, IG, New_worklists);
+ _ ->
+ New_worklists = add_simplify(Initial, Worklists),
+ init(Initials, K, IG, New_worklists)
+ end.
+
+init([], _, _, _, Worklists) -> Worklists;
+init([Initial|Initials], K, IG, Move_sets, Worklists) ->
+ case hipe_ig:is_trivially_colourable(Initial, K, IG) of
+ false ->
+ New_worklists = add_spill(Initial, Worklists),
+ init(Initials, K, IG, Move_sets, New_worklists);
+ _ ->
+ case hipe_moves:move_related(Initial, Move_sets) of
+ true ->
+ New_worklists = add_freeze(Initial, Worklists),
+ init(Initials, K, IG, Move_sets, New_worklists);
+ _ ->
+ New_worklists = add_simplify(Initial, Worklists),
+ init(Initials, K, IG, Move_sets, New_worklists)
+ end
+ end.
+
+%%%----------------------------------------------------------------------
+%% Function: is_empty
+%%
+%% Description: Tests if the selected worklist if empty or not.
+%%
+%% Parameters:
+%% Worklists -- A worklists data structure
+%%
+%% Returns:
+%% true -- If the worklist was empty
+%% false -- otherwise
+%%
+%%%----------------------------------------------------------------------
+
+is_empty_simplify(Worklists) ->
+ simplify(Worklists) =:= [].
+
+is_empty_spill(Worklists) ->
+ spill(Worklists) =:= [].
+
+is_empty_freeze(Worklists) ->
+ freeze(Worklists) =:= [].
+
+%%%----------------------------------------------------------------------
+%% Function: add
+%%
+%% Description: Adds one element to one of the worklists.
+%%
+%% Parameters:
+%% Element -- An element you want to add to the
+%% selected worklist. The element should
+%% be a node/temporary.
+%% Worklists -- A worklists data structure
+%%
+%% Returns:
+%% An worklists data-structure that have Element in selected
+%% worklist.
+%%
+%%%----------------------------------------------------------------------
+add_coalesced(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'stack_or_coalesced'),
+ Worklists.
+
+add_coalesced(From, To, Worklists) -> % only used by optimistic allocator
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, From, 'stack_or_coalesced'),
+ Coalesced_to = Worklists#worklists.coalesced_to,
+ hipe_bifs:array_update(Coalesced_to, To, 'coalesced_to'),
+ Worklists.
+
+add_simplify(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'simplify'),
+ Simplify = ordsets:add_element(Element, simplify(Worklists)),
+ set_simplify(Simplify, Worklists).
+
+add_spill(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'spill'),
+ Spill = ordsets:add_element(Element, spill(Worklists)),
+ set_spill(Spill, Worklists).
+
+add_freeze(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'freeze'),
+ Freeze = ordsets:add_element(Element, freeze(Worklists)),
+ set_freeze(Freeze, Worklists).
+
+push_stack(Node, AdjList, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Node, 'stack_or_coalesced'),
+ Stack = Worklists#worklists.stack,
+ Worklists#worklists{stack = [{Node,AdjList}|Stack]}.
+
+%%%----------------------------------------------------------------------
+%% Function: remove
+%%
+%% Description: Removes one element to one of the worklists.
+%%
+%% Parameters:
+%% Element -- An element you want to remove from the
+%% selected worklist. The element should
+%% be a node/temporary.
+%% Worklists -- A worklists data structure
+%%
+%% Returns:
+%% A worklists data-structure that don't have Element in selected
+%% worklist.
+%%
+%%%----------------------------------------------------------------------
+remove_simplify(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'none'),
+ Simplify = ordsets:del_element(Element, simplify(Worklists)),
+ set_simplify(Simplify, Worklists).
+
+remove_spill(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'none'),
+ Spill = ordsets:del_element(Element, spill(Worklists)),
+ set_spill(Spill, Worklists).
+
+remove_freeze(Element, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ hipe_bifs:array_update(Membership, Element, 'none'),
+ Freeze = ordsets:del_element(Element, freeze(Worklists)),
+ set_freeze(Freeze, Worklists).
+
+%%%----------------------------------------------------------------------
+%% Function: transfer
+%%
+%% Description: Moves element from one worklist to another.
+%%
+%%%----------------------------------------------------------------------
+transfer_freeze_simplify(Element, Worklists) ->
+ add_simplify(Element, remove_freeze(Element, Worklists)).
+
+transfer_freeze_spill(Element, Worklists) ->
+ add_spill(Element, remove_freeze(Element, Worklists)).
+
+%%%----------------------------------------------------------------------
+%% Function: member
+%%
+%% Description: Checks if one element if member of selected worklist.
+%%
+%% Parameters:
+%% Element -- Element you want to know if it's a
+%% member of selected worklist.
+%% Worklists -- A worklists data structure
+%%
+%% Returns:
+%% true -- if Element is a member of selected worklist
+%% false -- Otherwise
+%%
+%%%----------------------------------------------------------------------
+
+member_coalesced_to(Element, Worklists) -> % only used by optimistic allocator
+ hipe_bifs:array_sub(Worklists#worklists.coalesced_to, Element) =:= 'coalesced_to'.
+
+member_freeze(Element, Worklists) ->
+ hipe_bifs:array_sub(Worklists#worklists.membership, Element) =:= 'freeze'.
+
+member_stack_or_coalesced(Element, Worklists) ->
+ hipe_bifs:array_sub(Worklists#worklists.membership, Element) =:= 'stack_or_coalesced'.
+
+non_stacked_or_coalesced_nodes(Nodes, Worklists) ->
+ Membership = Worklists#worklists.membership,
+ [Node || Node <- Nodes,
+ hipe_bifs:array_sub(Membership, Node) =/= 'stack_or_coalesced'].
+
+%%%----------------------------------------------------------------------
+%% Print functions - only used for debugging
+
+-ifdef(DEBUG_PRINTOUTS).
+print_memberships(Worklists) ->
+ ?debug_msg("Worklist memeberships:\n", []),
+ Membership = Worklists#worklists.membership,
+ NrElems = hipe_bifs:array_length(Membership),
+ Coalesced_to = Worklists#worklists.coalesced_to,
+ print_membership(NrElems, Membership, Coalesced_to).
+
+print_membership(0, _, _) ->
+ true;
+print_membership(Element, Membership, Coalesced_to) ->
+ NextElement = Element - 1,
+ ?debug_msg("worklist ~w ~w ~w\n",
+ [NextElement, hipe_bifs:array_sub(Membership, NextElement),
+ hipe_bifs:array_sub(Coalesced_to, NextElement)]),
+ print_membership(NextElement, Membership, Coalesced_to).
+-endif.
diff --git a/lib/hipe/regalloc/hipe_regalloc_loop.erl b/lib/hipe/regalloc/hipe_regalloc_loop.erl
new file mode 100644
index 0000000000..428a82c87b
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_regalloc_loop.erl
@@ -0,0 +1,68 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Common wrapper for graph_coloring and coalescing regallocs.
+
+-module(hipe_regalloc_loop).
+-export([ra/5, ra_fp/4]).
+
+%%-define(HIPE_INSTRUMENT_COMPILER, true). %% Turn on instrumentation.
+-include("../main/hipe.hrl").
+
+ra(Defun, SpillIndex, Options, RegAllocMod, TargetMod) ->
+ {NewDefun, Coloring, _NewSpillIndex} =
+ ra_common(Defun, SpillIndex, Options, RegAllocMod, TargetMod),
+ {NewDefun, Coloring}.
+
+ra_fp(Defun, Options, RegAllocMod, TargetMod) ->
+ ra_common(Defun, 0, Options, RegAllocMod, TargetMod).
+
+ra_common(Defun, SpillIndex, Options, RegAllocMod, TargetMod) ->
+ ?inc_counter(ra_calls_counter, 1),
+ CFG = TargetMod:defun_to_cfg(Defun),
+ SpillLimit = TargetMod:number_of_temporaries(CFG),
+ alloc(Defun, SpillLimit, SpillIndex, Options, RegAllocMod, TargetMod).
+
+alloc(Defun, SpillLimit, SpillIndex, Options, RegAllocMod, TargetMod) ->
+ ?inc_counter(ra_iteration_counter, 1),
+ CFG = TargetMod:defun_to_cfg(Defun),
+ {Coloring, _NewSpillIndex} =
+ RegAllocMod:regalloc(CFG, SpillIndex, SpillLimit, TargetMod, Options),
+ {NewDefun, DidSpill} = TargetMod:check_and_rewrite(Defun, Coloring),
+ case DidSpill of
+ false -> %% No new temps, we are done.
+ ?add_spills(Options, _NewSpillIndex),
+ TempMap = hipe_temp_map:cols2tuple(Coloring, TargetMod),
+ {TempMap2, NewSpillIndex2} =
+ hipe_spillmin:stackalloc(CFG, [], SpillIndex, Options,
+ TargetMod, TempMap),
+ Coloring2 =
+ hipe_spillmin:mapmerge(hipe_temp_map:to_substlist(TempMap), TempMap2),
+ %% case proplists:get_bool(verbose_spills, Options) of
+ %% true ->
+ %% ?msg("Num spill slots used: ~p~n", [NewSpillIndex2-SpillIndex]);
+ %% false ->
+ %% ok
+ %% end,
+ {NewDefun, Coloring2, NewSpillIndex2};
+ _ ->
+ %% Since SpillLimit is used as a low-water-mark
+ %% the list of temps not to spill is uninteresting.
+ alloc(NewDefun, SpillLimit, SpillIndex, Options, RegAllocMod, TargetMod)
+ end.
diff --git a/lib/hipe/regalloc/hipe_sparc_specific.erl b/lib/hipe/regalloc/hipe_sparc_specific.erl
new file mode 100644
index 0000000000..7b8c62e802
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_sparc_specific.erl
@@ -0,0 +1,168 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_specific).
+
+%% for hipe_coalescing_regalloc:
+-export([number_of_temporaries/1
+ ,analyze/1
+ ,labels/1
+ ,all_precoloured/0
+ ,bb/2
+ ,liveout/2
+ ,reg_nr/1
+ ,def_use/1
+ ,is_move/1
+ ,is_precoloured/1
+ ,var_range/1
+ ,allocatable/0
+ ,non_alloc/1
+ ,physical_name/1
+ ,reverse_postorder/1
+ ,livein/2
+ ,uses/1
+ ,defines/1
+ ]).
+
+%% for hipe_graph_coloring_regalloc:
+-export([is_fixed/1]).
+
+%% for hipe_ls_regalloc:
+-export([args/1, is_arg/1, is_global/1, new_spill_index/1]).
+-export([breadthorder/1, postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+defun_to_cfg(Defun) ->
+ hipe_sparc_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ hipe_sparc_ra_postconditions:check_and_rewrite(Defun, Coloring, 'normal').
+
+reverse_postorder(CFG) ->
+ hipe_sparc_cfg:reverse_postorder(CFG).
+
+non_alloc(CFG) ->
+ non_alloc(hipe_sparc_registers:nr_args(), hipe_sparc_cfg:params(CFG)).
+
+%% same as hipe_sparc_frame:fix_formals/2
+non_alloc(0, Rest) -> Rest;
+non_alloc(N, [_|Rest]) -> non_alloc(N-1, Rest);
+non_alloc(_, []) -> [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ hipe_sparc_liveness_gpr:analyse(CFG).
+
+livein(Liveness,L) ->
+ [X || X <- hipe_sparc_liveness_gpr:livein(Liveness,L),
+ hipe_sparc:temp_is_allocatable(X)].
+
+liveout(BB_in_out_liveness,Label) ->
+ [X || X <- hipe_sparc_liveness_gpr:liveout(BB_in_out_liveness,Label),
+ hipe_sparc:temp_is_allocatable(X)].
+
+%% Registers stuff
+
+allocatable() ->
+ hipe_sparc_registers:allocatable_gpr().
+
+all_precoloured() ->
+ hipe_sparc_registers:all_precoloured().
+
+is_precoloured(Reg) ->
+ hipe_sparc_registers:is_precoloured_gpr(Reg).
+
+is_fixed(R) ->
+ hipe_sparc_registers:is_fixed(R).
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_sparc_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(sparc).
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(sparc),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG,L) ->
+ hipe_sparc_cfg:bb(CFG,L).
+
+%% SPARC stuff
+
+def_use(Instruction) ->
+ {defines(Instruction), uses(Instruction)}.
+
+uses(I) ->
+ [X || X <- hipe_sparc_defuse:insn_use_gpr(I),
+ hipe_sparc:temp_is_allocatable(X)].
+
+defines(I) ->
+ [X || X <- hipe_sparc_defuse:insn_def_gpr(I),
+ hipe_sparc:temp_is_allocatable(X)].
+
+is_move(Instruction) ->
+ case hipe_sparc:is_pseudo_move(Instruction) of
+ true ->
+ Dst = hipe_sparc:pseudo_move_dst(Instruction),
+ case hipe_sparc:temp_is_allocatable(Dst) of
+ false -> false;
+ _ ->
+ Src = hipe_sparc:pseudo_move_src(Instruction),
+ hipe_sparc:temp_is_allocatable(Src)
+ end;
+ false -> false
+ end.
+
+reg_nr(Reg) ->
+ hipe_sparc:temp_reg(Reg).
+
+%%% Linear Scan stuff
+
+new_spill_index(SpillIndex) when is_integer(SpillIndex) ->
+ SpillIndex+1.
+
+breadthorder(CFG) ->
+ hipe_sparc_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_sparc_cfg:postorder(CFG).
+
+is_global(R) ->
+ R =:= hipe_sparc_registers:temp1() orelse
+ R =:= hipe_sparc_registers:temp2() orelse
+ R =:= hipe_sparc_registers:temp3() orelse
+ hipe_sparc_registers:is_fixed(R).
+
+is_arg(R) ->
+ hipe_sparc_registers:is_arg(R).
+
+args(CFG) ->
+ hipe_sparc_registers:args(hipe_sparc_cfg:arity(CFG)).
diff --git a/lib/hipe/regalloc/hipe_sparc_specific_fp.erl b/lib/hipe/regalloc/hipe_sparc_specific_fp.erl
new file mode 100644
index 0000000000..8a27f84e67
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_sparc_specific_fp.erl
@@ -0,0 +1,146 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_specific_fp).
+
+%% for hipe_coalescing_regalloc:
+-export([number_of_temporaries/1
+ ,analyze/1
+ ,labels/1
+ ,all_precoloured/0
+ ,bb/2
+ ,liveout/2
+ ,reg_nr/1
+ ,def_use/1
+ ,is_move/1
+ ,is_precoloured/1
+ ,var_range/1
+ ,allocatable/0
+ ,non_alloc/1
+ ,physical_name/1
+ ,reverse_postorder/1
+ ,livein/2
+ ,uses/1
+ ,defines/1
+ ]).
+
+%% for hipe_graph_coloring_regalloc:
+-export([is_fixed/1]).
+
+%% for hipe_ls_regalloc:
+%%-export([args/1, is_arg/1, is_global, new_spill_index/1]).
+%%-export([breadthorder/1, postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+defun_to_cfg(Defun) ->
+ hipe_sparc_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ hipe_sparc_ra_postconditions_fp:check_and_rewrite(Defun, Coloring).
+
+reverse_postorder(CFG) ->
+ hipe_sparc_cfg:reverse_postorder(CFG).
+
+non_alloc(_CFG) ->
+ [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ hipe_sparc_liveness_fpr:analyse(CFG).
+
+livein(Liveness, L) ->
+ hipe_sparc_liveness_fpr:livein(Liveness, L).
+
+liveout(BB_in_out_liveness, Label) ->
+ hipe_sparc_liveness_fpr:liveout(BB_in_out_liveness, Label).
+
+%% Registers stuff
+
+allocatable() ->
+ hipe_sparc_registers:allocatable_fpr().
+
+all_precoloured() ->
+ allocatable().
+
+is_precoloured(Reg) ->
+ hipe_sparc_registers:is_precoloured_fpr(Reg).
+
+is_fixed(_Reg) ->
+ false.
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_sparc_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(sparc).
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(sparc),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG, L) ->
+ hipe_sparc_cfg:bb(CFG, L).
+
+%% SPARC stuff
+
+def_use(I) ->
+ {defines(I), uses(I)}.
+
+uses(I) ->
+ hipe_sparc_defuse:insn_use_fpr(I).
+
+defines(I) ->
+ hipe_sparc_defuse:insn_def_fpr(I).
+
+is_move(I) ->
+ hipe_sparc:is_pseudo_fmove(I).
+
+reg_nr(Reg) ->
+ hipe_sparc:temp_reg(Reg).
+
+-ifdef(notdef).
+new_spill_index(SpillIndex)->
+ SpillIndex+1.
+
+breadthorder(CFG) ->
+ hipe_sparc_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_sparc_cfg:postorder(CFG).
+
+is_global(_R) ->
+ false.
+
+is_arg(_R) ->
+ false.
+
+args(_CFG) ->
+ [].
+-endif.
diff --git a/lib/hipe/regalloc/hipe_spillcost.erl b/lib/hipe/regalloc/hipe_spillcost.erl
new file mode 100644
index 0000000000..04b25f6339
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_spillcost.erl
@@ -0,0 +1,101 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_spillcost).
+
+-export([new/1,
+ inc_costs/2,
+ ref_in_bb/2,
+ spill_cost/2]).
+%% The following is exported only for debugging purposes.
+-ifdef(DEBUG_PRINTOUTS).
+-export([nr_of_use/2]).
+-endif.
+
+%%----------------------------------------------------------------------------
+
+-include("hipe_spillcost.hrl").
+
+%%----------------------------------------------------------------------------
+
+-spec new(non_neg_integer()) -> #spill_cost{}.
+
+new(NrTemps) ->
+ #spill_cost{uses = hipe_bifs:array(NrTemps, 0),
+ bb_uses = hipe_bifs:array(NrTemps, 0)}.
+
+%%----------------------------------------------------------------------------
+%% Function: inc_costs
+%%
+%% Description: Registers usage of a list of temporaries (for spill_cost)
+%%----------------------------------------------------------------------------
+
+-spec inc_costs([non_neg_integer()], #spill_cost{}) -> #spill_cost{}.
+
+inc_costs(Temps, SC) ->
+ Uses = SC#spill_cost.uses,
+ lists:foreach(fun (T) -> inc_use(T, Uses) end, Temps),
+ SC. % updated via side-effects
+
+inc_use(Temp, Uses) ->
+ hipe_bifs:array_update(Uses, Temp, get_uses(Temp, Uses) + 1).
+
+nr_of_use(Temp, SC) ->
+ get_uses(Temp, SC#spill_cost.uses).
+
+get_uses(Temp, Uses) ->
+ hipe_bifs:array_sub(Uses, Temp).
+
+%%----------------------------------------------------------------------------
+%% Function: ref_in_bb
+%%
+%% Description: Registers that a set of temporaries are used in one basic
+%% block; should be done exactly once per basic block
+%%----------------------------------------------------------------------------
+
+-spec ref_in_bb([non_neg_integer()], #spill_cost{}) -> #spill_cost{}.
+
+ref_in_bb(Temps, SC) ->
+ BBUses = SC#spill_cost.bb_uses,
+ lists:foreach(fun (T) -> inc_bb_use(T, BBUses) end, Temps),
+ SC. % updated via side-effects
+
+inc_bb_use(Temp, BBUses) ->
+ hipe_bifs:array_update(BBUses, Temp, get_bb_uses(Temp, BBUses) + 1).
+
+bb_use(Temp, SC) ->
+ get_bb_uses(Temp, SC#spill_cost.bb_uses).
+
+get_bb_uses(Temp, BBUses) ->
+ hipe_bifs:array_sub(BBUses, Temp).
+
+%%----------------------------------------------------------------------------
+%% Function: spill_cost
+%%
+%% Description: Computes a spill cost for a temporary
+%%
+%% Returns:
+%% Spill cost (a real number -- higher means worse to spill)
+%%----------------------------------------------------------------------------
+
+-spec spill_cost(non_neg_integer(), #spill_cost{}) -> float().
+
+spill_cost(Temp, SC) ->
+ nr_of_use(Temp, SC) / bb_use(Temp, SC).
diff --git a/lib/hipe/regalloc/hipe_spillcost.hrl b/lib/hipe/regalloc/hipe_spillcost.hrl
new file mode 100644
index 0000000000..e736a561d7
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_spillcost.hrl
@@ -0,0 +1,27 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-type hipe_array() :: integer().
+
+-record(spill_cost,
+ {uses :: hipe_array(), % number of uses of each temp
+ bb_uses :: hipe_array() % number of basic blocks each temp occurs in
+ }).
+
diff --git a/lib/hipe/regalloc/hipe_temp_map.erl b/lib/hipe/regalloc/hipe_temp_map.erl
new file mode 100644
index 0000000000..85678edd54
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_temp_map.erl
@@ -0,0 +1,125 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ===========================================================================
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% Time-stamp: <2008-04-20 14:54:00 richard>
+%% ===========================================================================
+%% Module : hipe_temp_map
+%% Purpose :
+%% Notes :
+%% History : * 2001-07-24 Erik Johansson (happi@it.uu.se): Created.
+%% ===========================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_temp_map).
+
+-export([cols2tuple/2, is_spilled/2, to_substlist/1]).
+
+-include("../main/hipe.hrl").
+
+%%----------------------------------------------------------------------------
+%% Convert a list of [{R0, C1}, {R1, C2}, ...] to a temp_map
+%% (Currently implemented as a tuple) tuple {C1, C2, ...}.
+%%
+%% The indices (Ri) must be unique but do not have to be sorted and
+%% they can be sparse.
+%% Note that the first allowed index is 0 -- this will be mapped to
+%% element 1
+%%----------------------------------------------------------------------------
+
+-spec cols2tuple(hipe_map(), atom()) -> hipe_temp_map().
+
+cols2tuple(Map, Target) ->
+ ?ASSERT(check_list(Map)),
+ SortedMap = lists:keysort(1, Map),
+ cols2tuple(0, SortedMap, [], Target).
+
+%% sorted_cols2tuple(Map, Target) ->
+%% ?ASSERT(check_list(Map)),
+%% ?ASSERT(Map =:= lists:keysort(1, Map)),
+%% cols2tuple(0, Map, [], Target).
+
+%% Build a dense mapping
+cols2tuple(_, [], Vs, _) ->
+ %% Done reverse the list and convert to tuple.
+ list_to_tuple(lists:reverse(Vs));
+cols2tuple(N, [{R, C}|Ms], Vs, Target) when N =:= R ->
+ %% N makes sure the mapping is dense. N is he next key.
+ cols2tuple(N+1, Ms, [C|Vs], Target);
+cols2tuple(N, SourceMapping, Vs, Target) ->
+ %% The source was sparse, make up some placeholders...
+ Val =
+ case Target:is_precoloured(N) of
+ %% If it is precoloured, we know what to map it to.
+ true -> {reg, N};
+ false -> unknown
+ end,
+ cols2tuple(N+1, SourceMapping, [Val|Vs], Target).
+
+%%
+%% True if temp Temp is spilled.
+%%
+-spec is_spilled(non_neg_integer(), hipe_temp_map()) -> boolean().
+
+is_spilled(Temp, Map) ->
+ case element(Temp+1, Map) of
+ {reg, _R} -> false;
+ {fp_reg, _R}-> false;
+ {spill, _N} -> true;
+ unknown -> false
+ end.
+
+%% %% True if temp Temp is allocated to a reg.
+%% in_reg(Temp, Map) ->
+%% case element(Temp+1, Map) of
+%% {reg, _R} -> true;
+%% {fp_reg, _R}-> false;
+%% {spill, _N} -> false;
+%% unknown -> false
+%% end.
+%%
+%% %% True if temp Temp is allocated to a fp_reg.
+%% in_fp_reg(Temp, Map) ->
+%% case element(Temp+1, Map) of
+%% {fp_reg, _R} -> true;
+%% {reg, _R} -> false;
+%% {spill, _N} -> false;
+%% unknown -> false
+%% end.
+%%
+%% %% Returns the inf temp Temp is mapped to.
+%% find(Temp, Map) -> element(Temp+1, Map).
+
+
+%%
+%% Converts a temp_map tuple back to a (sorted) key-list.
+%%
+-spec to_substlist(hipe_temp_map()) -> hipe_map().
+
+to_substlist(Map) ->
+ T = tuple_to_list(Map),
+ mapping(T, 0).
+
+mapping([R|Rs], Temp) ->
+ [{Temp, R}| mapping(Rs, Temp+1)];
+mapping([], _) ->
+ [].
diff --git a/lib/hipe/regalloc/hipe_x86_specific.erl b/lib/hipe/regalloc/hipe_x86_specific.erl
new file mode 100644
index 0000000000..0f490ba14d
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_x86_specific.erl
@@ -0,0 +1,203 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_SPECIFIC, hipe_amd64_specific).
+-define(HIPE_X86_RA_POSTCONDITIONS, hipe_amd64_ra_postconditions).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_LIVENESS, hipe_amd64_liveness).
+-define(HIPE_X86_DEFUSE, hipe_amd64_defuse).
+-else.
+-define(HIPE_X86_SPECIFIC, hipe_x86_specific).
+-define(HIPE_X86_RA_POSTCONDITIONS, hipe_x86_ra_postconditions).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_LIVENESS, hipe_x86_liveness).
+-define(HIPE_X86_DEFUSE, hipe_x86_defuse).
+-endif.
+
+-module(?HIPE_X86_SPECIFIC).
+
+-export([number_of_temporaries/1]).
+
+%% The following exports are used as M:F(...) calls from other modules;
+%% e.g. hipe_x86_ra_ls.
+-export([analyze/1,
+ bb/2,
+ args/1,
+ labels/1,
+ livein/2,
+ liveout/2,
+ uses/1,
+ defines/1,
+ def_use/1,
+ is_arg/1, % used by hipe_ls_regalloc
+ is_move/1,
+ is_fixed/1, % used by hipe_graph_coloring_regalloc
+ is_global/1,
+ is_precoloured/1,
+ reg_nr/1,
+ non_alloc/1,
+ allocatable/0,
+ physical_name/1,
+ all_precoloured/0,
+ new_spill_index/1, % used by hipe_ls_regalloc
+ var_range/1,
+ breadthorder/1,
+ postorder/1,
+ reverse_postorder/1]).
+
+%% callbacks for hipe_regalloc_loop
+-export([defun_to_cfg/1,
+ check_and_rewrite/2]).
+
+defun_to_cfg(Defun) ->
+ hipe_x86_cfg:init(Defun).
+
+check_and_rewrite(Defun, Coloring) ->
+ ?HIPE_X86_RA_POSTCONDITIONS:check_and_rewrite(Defun, Coloring, 'normal').
+
+reverse_postorder(CFG) ->
+ hipe_x86_cfg:reverse_postorder(CFG).
+
+breadthorder(CFG) ->
+ hipe_x86_cfg:breadthorder(CFG).
+
+postorder(CFG) ->
+ hipe_x86_cfg:postorder(CFG).
+
+%% Globally defined registers for linear scan
+is_global(R) ->
+ ?HIPE_X86_REGISTERS:temp1() =:= R orelse
+ ?HIPE_X86_REGISTERS:temp0() =:= R orelse
+ ?HIPE_X86_REGISTERS:is_fixed(R).
+
+is_fixed(R) ->
+ ?HIPE_X86_REGISTERS:is_fixed(R).
+
+is_arg(R) ->
+ ?HIPE_X86_REGISTERS:is_arg(R).
+
+args(CFG) ->
+ ?HIPE_X86_REGISTERS:args(hipe_x86_cfg:arity(CFG)).
+
+non_alloc(CFG) ->
+ non_alloc(?HIPE_X86_REGISTERS:nr_args(), hipe_x86_cfg:params(CFG)).
+
+%% same as hipe_x86_frame:fix_formals/2
+non_alloc(0, Rest) -> Rest;
+non_alloc(N, [_|Rest]) -> non_alloc(N-1, Rest);
+non_alloc(_, []) -> [].
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ ?HIPE_X86_LIVENESS:analyze(CFG).
+
+livein(Liveness,L) ->
+ [X || X <- ?HIPE_X86_LIVENESS:livein(Liveness,L),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_reg(X) =/= ?HIPE_X86_REGISTERS:fcalls(),
+ hipe_x86:temp_reg(X) =/= ?HIPE_X86_REGISTERS:heap_limit(),
+ hipe_x86:temp_type(X) =/= 'double'].
+
+liveout(BB_in_out_liveness,Label) ->
+ [X || X <- ?HIPE_X86_LIVENESS:liveout(BB_in_out_liveness,Label),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_reg(X) =/= ?HIPE_X86_REGISTERS:fcalls(),
+ hipe_x86:temp_reg(X) =/= ?HIPE_X86_REGISTERS:heap_limit(),
+ hipe_x86:temp_type(X) =/= 'double'].
+
+%% Registers stuff
+
+allocatable() ->
+ ?HIPE_X86_REGISTERS:allocatable().
+
+all_precoloured() ->
+ ?HIPE_X86_REGISTERS:all_precoloured().
+
+is_precoloured(Reg) ->
+ ?HIPE_X86_REGISTERS:is_precoloured(Reg).
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_x86_cfg:labels(CFG).
+
+var_range(_CFG) ->
+ hipe_gensym:var_range(x86).
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(x86),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG,L) ->
+ hipe_x86_cfg:bb(CFG,L).
+
+%% X86 stuff
+
+def_use(Instruction) ->
+ {[X || X <- ?HIPE_X86_DEFUSE:insn_def(Instruction),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =/= 'double'],
+ [X || X <- ?HIPE_X86_DEFUSE:insn_use(Instruction),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =/= 'double']
+ }.
+
+uses(I) ->
+ [X || X <- ?HIPE_X86_DEFUSE:insn_use(I),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =/= 'double'].
+
+defines(I) ->
+ [X || X <- ?HIPE_X86_DEFUSE:insn_def(I),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =/= 'double'].
+
+is_move(Instruction) ->
+ case hipe_x86:is_move(Instruction) of
+ true ->
+ Src = hipe_x86:move_src(Instruction),
+ Dst = hipe_x86:move_dst(Instruction),
+ case hipe_x86:is_temp(Src) of
+ true ->
+ case hipe_x86:temp_is_allocatable(Src) of
+ true ->
+ case hipe_x86:is_temp(Dst) of
+ true ->
+ hipe_x86:temp_is_allocatable(Dst);
+ false -> false
+ end;
+ false -> false
+ end;
+ false -> false
+ end;
+ false -> false
+ end.
+
+reg_nr(Reg) ->
+ hipe_x86:temp_reg(Reg).
+
+new_spill_index(SpillIndex) when is_integer(SpillIndex) ->
+ SpillIndex+1.
diff --git a/lib/hipe/regalloc/hipe_x86_specific_x87.erl b/lib/hipe/regalloc/hipe_x86_specific_x87.erl
new file mode 100644
index 0000000000..7fd80b63d8
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_x86_specific_x87.erl
@@ -0,0 +1,164 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_SPECIFIC_X87, hipe_amd64_specific_x87).
+-define(HIPE_X86_LIVENESS, hipe_amd64_liveness).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_DEFUSE, hipe_amd64_defuse).
+-else.
+-define(HIPE_X86_SPECIFIC_X87, hipe_x86_specific_x87).
+-define(HIPE_X86_LIVENESS, hipe_x86_liveness).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_DEFUSE, hipe_x86_defuse).
+-endif.
+
+-module(?HIPE_X86_SPECIFIC_X87).
+-export([allocatable/0,
+ is_precoloured/1,
+ %% var_range/1,
+ %% def_use/1,
+ %% is_fixed/1,
+ is_arg/1,
+ %% non_alloc/1,
+ new_spill_index/1,
+ number_of_temporaries/1
+ ]).
+
+%% The following exports are used as M:F(...) calls from other modules;
+%% e.g. hipe_x86_ra_ls.
+-export([analyze/1,
+ bb/2,
+ args/1,
+ labels/1,
+ livein/2,
+ liveout/2,
+ uses/1,
+ defines/1,
+ is_global/1,
+ reg_nr/1,
+ physical_name/1,
+ breadthorder/1,
+ postorder/1,
+ reverse_postorder/1]).
+
+breadthorder(CFG) ->
+ hipe_x86_cfg:breadthorder(CFG).
+postorder(CFG) ->
+ hipe_x86_cfg:postorder(CFG).
+reverse_postorder(CFG) ->
+ hipe_x86_cfg:reverse_postorder(CFG).
+
+is_global(_) ->
+ false.
+
+-ifdef(notdef).
+is_fixed(_) ->
+ false.
+-endif.
+
+is_arg(_) ->
+ false.
+
+args(_) ->
+ [].
+
+-ifdef(notdef).
+non_alloc(_) ->
+ [].
+-endif.
+
+%% Liveness stuff
+
+analyze(CFG) ->
+ ?HIPE_X86_LIVENESS:analyze(CFG).
+
+livein(Liveness,L) ->
+ [X || X <- ?HIPE_X86_LIVENESS:livein(Liveness,L),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'].
+
+liveout(BB_in_out_liveness,Label) ->
+ [X || X <- ?HIPE_X86_LIVENESS:liveout(BB_in_out_liveness,Label),
+ hipe_x86:temp_is_allocatable(X),
+ hipe_x86:temp_type(X) =:= 'double'].
+
+%% Registers stuff
+
+allocatable() ->
+ ?HIPE_X86_REGISTERS:allocatable_x87().
+
+is_precoloured(Reg) ->
+ ?HIPE_X86_REGISTERS:is_precoloured_x87(Reg).
+
+physical_name(Reg) ->
+ Reg.
+
+%% CFG stuff
+
+labels(CFG) ->
+ hipe_x86_cfg:labels(CFG).
+
+-ifdef(notdef).
+var_range(_CFG) ->
+ {Min,Max} = hipe_gensym:var_range(x86),
+ %% io:format("Var_range: ~w\n",[{Min,Max}]),
+ {Min,Max}.
+-endif.
+
+number_of_temporaries(_CFG) ->
+ Highest_temporary = hipe_gensym:get_var(x86),
+ %% Since we can have temps from 0 to Max adjust by +1.
+ Highest_temporary + 1.
+
+bb(CFG,L) ->
+ hipe_x86_cfg:bb(CFG,L).
+
+%% X86 stuff
+
+-ifdef(notdef).
+def_use(Instruction) ->
+ {[X || X <- ?HIPE_X86_DEFUSE:insn_def(Instruction),
+ hipe_x86:temp_is_allocatable(X),
+ temp_is_double(X)],
+ [X || X <- ?HIPE_X86_DEFUSE:insn_use(Instruction),
+ hipe_x86:temp_is_allocatable(X),
+ temp_is_double(X)]
+ }.
+-endif.
+
+uses(I) ->
+ [X || X <- ?HIPE_X86_DEFUSE:insn_use(I),
+ hipe_x86:temp_is_allocatable(X),
+ temp_is_double(X)].
+
+defines(I) ->
+ [X || X <- ?HIPE_X86_DEFUSE:insn_def(I),
+ hipe_x86:temp_is_allocatable(X),
+ temp_is_double(X)].
+
+temp_is_double(Temp) ->
+ hipe_x86:temp_type(Temp) =:= 'double'.
+
+reg_nr(Reg) ->
+ hipe_x86:temp_reg(Reg).
+
+new_spill_index(SpillIndex) ->
+ SpillIndex+1.
diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile
new file mode 100644
index 0000000000..beab8da547
--- /dev/null
+++ b/lib/hipe/rtl/Makefile
@@ -0,0 +1,142 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+ifdef HIPE_ENABLED
+HIPE_MODULES = hipe_rtl hipe_rtl_cfg \
+ hipe_rtl_liveness \
+ hipe_icode2rtl hipe_rtl_mk_switch \
+ hipe_rtl_primops \
+ hipe_rtl_varmap hipe_rtl_exceptions \
+ hipe_rtl_binary_match hipe_rtl_binary_construct \
+ hipe_rtl_arith_32 hipe_rtl_arith_64 \
+ hipe_rtl_ssa hipe_rtl_ssa_const_prop \
+ hipe_rtl_cleanup_const hipe_rtl_symbolic hipe_rtl_lcm \
+ hipe_rtl_ssapre hipe_rtl_binary hipe_rtl_ssa_avail_expr \
+ hipe_rtl_arch hipe_tagscheme
+else
+HIPE_MODULES =
+endif
+
+MODULES = $(HIPE_MODULES)
+
+HRL_FILES= hipe_literals.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+# APP_FILE=
+# App_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS: Please keep +inline below
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +inline
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs:
+
+clean:
+ rm -f hipe_literals.hrl
+ rm -f $(TARGET_FILES)
+ rm -f core erl_crash.dump
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/rtl
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/rtl
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+
+HIPE_MKLITERALS=$(ERL_TOP)/bin/$(TARGET)/hipe_mkliterals
+
+hipe_literals.hrl: $(HIPE_MKLITERALS)
+ $(HIPE_MKLITERALS) -e > hipe_literals.hrl
+
+../main/hipe.hrl: ../vsn.mk ../main/hipe.hrl.src
+ sed -e "s;%VSN%;$(HIPE_VSN);" ../main/hipe.hrl.src > ../main/hipe.hrl
+
+$(EBIN)/hipe_rtl.beam: hipe_rtl.hrl ../main/hipe.hrl
+$(EBIN)/hipe_rtl_arch.beam: hipe_rtl.hrl hipe_literals.hrl
+$(EBIN)/hipe_rtl_binary.beam: hipe_rtl.hrl hipe_literals.hrl
+$(EBIN)/hipe_rtl_bin_util.beam: hipe_rtl.hrl hipe_literals.hrl
+$(EBIN)/hipe_rtl_cfg.beam: hipe_rtl.hrl ../flow/cfg.hrl ../flow/cfg.inc ../main/hipe.hrl
+$(EBIN)/hipe_rtl_cleanup_const.beam: hipe_rtl.hrl
+$(EBIN)/hipe_rtl_liveness.beam: hipe_rtl.hrl ../flow/cfg.hrl ../flow/liveness.inc
+$(EBIN)/hipe_icode2rtl.beam: hipe_literals.hrl ../main/hipe.hrl ../icode/hipe_icode.hrl
+$(EBIN)/hipe_tagscheme.beam: hipe_rtl.hrl hipe_literals.hrl
+$(EBIN)/hipe_rtl_primops.beam: hipe_rtl.hrl ../icode/hipe_icode_primops.hrl hipe_literals.hrl ../main/hipe.hrl
+$(EBIN)/hipe_rtl_arith_32.beam: ../main/hipe.hrl hipe_rtl_arith.inc
+$(EBIN)/hipe_rtl_arith_64.beam: ../main/hipe.hrl hipe_rtl_arith.inc
+$(EBIN)/hipe_rtl_bs_ops.beam: hipe_literals.hrl ../main/hipe.hrl
+$(EBIN)/hipe_rtl_cerl_bs_ops.beam: ../main/hipe.hrl hipe_literals.hrl hipe_rtl.hrl
+$(EBIN)/hipe_rtl_exceptions.beam: hipe_literals.hrl ../main/hipe.hrl
+$(EBIN)/hipe_rtl_inline_bs_ops.beam: hipe_rtl.hrl hipe_literals.hrl ../main/hipe.hrl
+$(EBIN)/hipe_rtl_mk_switch.beam: ../main/hipe.hrl
+$(EBIN)/hipe_rtl_lcm.beam: ../flow/cfg.hrl hipe_rtl.hrl
+$(EBIN)/hipe_rtl_symbolic.beam: hipe_rtl.hrl hipe_literals.hrl ../flow/cfg.hrl ../icode/hipe_icode_primops.hrl
+$(EBIN)/hipe_rtl_varmap.beam: ../main/hipe.hrl ../icode/hipe_icode.hrl
+
+$(EBIN)/hipe_rtl_ssa.beam: ../ssa/hipe_ssa.inc ../main/hipe.hrl ../ssa/hipe_ssa_liveness.inc hipe_rtl.hrl
+$(EBIN)/hipe_rtl_ssa_const_prop.beam: hipe_rtl.hrl ../main/hipe.hrl ../flow/cfg.hrl ../ssa/hipe_ssa_const_prop.inc
+$(EBIN)/hipe_rtl_ssapre.beam: ../main/hipe.hrl ../flow/cfg.hrl hipe_rtl.hrl
diff --git a/lib/hipe/rtl/hipe_icode2rtl.erl b/lib/hipe/rtl/hipe_icode2rtl.erl
new file mode 100644
index 0000000000..034153a3cb
--- /dev/null
+++ b/lib/hipe/rtl/hipe_icode2rtl.erl
@@ -0,0 +1,727 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%=======================================================================
+%% File : hipe_icode2rtl.erl
+%% Author(s) : Erik Johansson
+%% Description : Translates Icode to RTL
+%%=======================================================================
+%%
+%% $Id$
+%%
+%% TODO: Better handling of switches...
+
+-module(hipe_icode2rtl).
+
+-export([translate/2]).
+-export([translate_instrs/4]). %% used in hipe_rtl_mk_switch
+
+%%-------------------------------------------------------------------------
+
+%% -define(DEBUG,1). % used by hipe.hrl below
+
+-include("../main/hipe.hrl").
+-include("../icode/hipe_icode.hrl").
+-include("hipe_literals.hrl").
+
+%%-------------------------------------------------------------------------
+
+%% @spec translate(IcodeRecord::#icode{}, Options::options()) -> term()
+%%
+%% options() = [option()]
+%% option() = term()
+%%
+%% @doc Translates a linear form of Icode for a single function to a
+%% linear form of RTL-code.
+%%
+translate(IcodeRecord = #icode{}, Options) ->
+ ?IF_DEBUG_LEVEL(2, put(hipe_mfa, hipe_icode:icode_fun(IcodeRecord)), ok),
+ %% hipe_icode_pp:pp(Fun),
+
+ %% Initialize gensym and varmap
+ {Args, VarMap} = hipe_rtl_varmap:init(IcodeRecord),
+ %% Get the name and other info of the function to translate.
+ MFA = hipe_icode:icode_fun(IcodeRecord),
+ ConstTab = hipe_consttab:new(), % hipe_icode:icode_data(IcodeRecord),
+ %% io:format("~w\n", [ConstTab]),
+ Icode = hipe_icode:icode_code(IcodeRecord),
+ IsClosure = hipe_icode:icode_is_closure(IcodeRecord),
+ IsLeaf = hipe_icode:icode_is_leaf(IcodeRecord),
+ IcodeInfo = hipe_icode:icode_info(IcodeRecord),
+
+ %% Translate Icode instructions to RTL instructions
+ ?opt_start_timer("Icode to nested RTL"),
+ {Code, _VarMap1, ConstTab1} =
+ translate_instrs(Icode, VarMap, ConstTab, Options),
+ ?opt_stop_timer("Icode to nested RTL"),
+ %% We build the code as list of lists of...
+ %% in order to avoid appends.
+ ?opt_start_timer("Flatten RTL"),
+ Code1 = lists:flatten(Code),
+ ?opt_stop_timer("Flatten RTL"),
+ %% Build the RTL structure.
+ Rtl = hipe_rtl:mk_rtl(MFA,
+ Args,
+ IsClosure,
+ IsLeaf,
+ Code1,
+ ConstTab1,
+ {1, hipe_gensym:get_var(rtl)},
+ {1, hipe_gensym:get_label(rtl)}),
+ %% hipe_rtl:pp(Rtl),
+ %% Propagate info from Icode to RTL.
+ hipe_rtl:rtl_info_update(Rtl, IcodeInfo).
+
+%%-------------------------------------------------------------------------
+
+%%
+%% @doc Translates a list of Icode instructions to a list of RTL instructions.
+%%
+translate_instrs(Is, VarMap, ConstTab, Options) ->
+ translate_instrs(Is, VarMap, [], ConstTab, Options).
+
+translate_instrs([], VarMap, RTL_Code, ConstTab, _Options) ->
+ {RTL_Code, VarMap, ConstTab};
+translate_instrs([I|Is], VarMap, AccCode, ConstTab, Options) ->
+ %% Translate one instruction.
+ {Code, VarMap0, ConstTab0} =
+ translate_instruction(I, VarMap, ConstTab, Options),
+ %% ?IF_DEBUG_LEVEL(3,?msg(" To Instr: ~w~n",[Code]),no_debug),
+ ?IF_DEBUG(?when_option(rtl_show_translation, Options,
+ ?msg(" To Instr: ~w~n", [Code])), ok),
+ translate_instrs(Is, VarMap0, [AccCode,Code], ConstTab0, Options).
+
+%%
+%% @doc Translates an Icode instruction to one or more RTL instructions.
+%%
+
+translate_instruction(I, VarMap, ConstTab, Options) ->
+ %% ?IF_DEBUG_LEVEL(3,?msg("From Instr: ~w~n",[I]),no_debug),
+ ?IF_DEBUG(?when_option(rtl_show_translation, Options,
+ ?msg("From Instr: ~w~n", [I])), ok),
+ case I of
+ #icode_call{} ->
+ gen_call(I, VarMap, ConstTab);
+ #icode_comment{} ->
+ {hipe_rtl:mk_comment(hipe_icode:comment_text(I)), VarMap, ConstTab};
+ #icode_enter{} ->
+ gen_enter(I, VarMap, ConstTab);
+ #icode_fail{} ->
+ gen_fail(I, VarMap, ConstTab);
+ #icode_goto{} ->
+ gen_goto(I, VarMap, ConstTab);
+ #icode_if{} ->
+ gen_if(I, VarMap, ConstTab);
+ #icode_label{} ->
+ gen_label(I, VarMap, ConstTab);
+ #icode_move{} ->
+ gen_move(I, VarMap, ConstTab);
+ #icode_begin_handler{} ->
+ hipe_rtl_exceptions:gen_begin_handler(I, VarMap, ConstTab);
+ #icode_return{} ->
+ gen_return(I, VarMap, ConstTab);
+ #icode_switch_val{} ->
+ gen_switch_val(I, VarMap, ConstTab, Options);
+ #icode_switch_tuple_arity{} ->
+ gen_switch_tuple(I, VarMap, ConstTab, Options);
+ #icode_type{} ->
+ gen_type(I, VarMap, ConstTab);
+ X ->
+ exit({?MODULE,{"unknown Icode instruction",X}})
+ end.
+
+%%-------------------------------------------------------------------------
+
+%%
+%% CALL
+%%
+
+gen_call(I, VarMap, ConstTab) ->
+ Fun = hipe_icode:call_fun(I),
+ {Dst, VarMap0} = hipe_rtl_varmap:ivs2rvs(hipe_icode:call_dstlist(I), VarMap),
+ Fail = hipe_icode:call_fail_label(I),
+
+ {Args, VarMap1, ConstTab1, InitCode} =
+ args_to_vars(hipe_icode:call_args(I), VarMap0, ConstTab),
+
+ IsGuard = hipe_icode:call_in_guard(I),
+
+ {FailLblName, VarMap3} =
+ case Fail of
+ [] -> %% Not in a catch
+ {[], VarMap1};
+ _ ->
+ {FLbl, VarMap2} =
+ hipe_rtl_varmap:icode_label2rtl_label(Fail, VarMap1),
+ {hipe_rtl:label_name(FLbl), VarMap2}
+ end,
+
+ {ContLblName, ContLbl, VarMap4} =
+ case hipe_icode:call_continuation(I) of
+ [] -> %% This call does not end a BB.
+ CLbl = hipe_rtl:mk_new_label(),
+ {hipe_rtl:label_name(CLbl), CLbl, VarMap3};
+ Cont ->
+ {CLbl, NewVarMap} =
+ hipe_rtl_varmap:icode_label2rtl_label(Cont, VarMap3),
+ {hipe_rtl:label_name(CLbl), [], NewVarMap}
+ end,
+
+ {Code, ConstTab2} =
+ case hipe_icode:call_type(I) of
+ primop ->
+ hipe_rtl_primops:gen_primop(
+ {Fun, Dst, Args, ContLblName, FailLblName},
+ IsGuard, ConstTab1);
+ Type ->
+ Call = gen_call_1(Fun, Dst, Args, IsGuard, ContLblName,
+ FailLblName, Type),
+ {Call, ConstTab1}
+ end,
+ {[InitCode,Code,ContLbl], VarMap4, ConstTab2}.
+
+%% This catches those standard functions that we inline expand
+
+gen_call_1(Fun={_M,_F,_A}, Dst, Args, IsGuard, Cont, Fail, Type) ->
+ case hipe_rtl_primops:gen_call_builtin(Fun, Dst, Args, IsGuard, Cont,
+ Fail) of
+ [] ->
+ hipe_rtl:mk_call(Dst, Fun, Args, Cont, Fail, conv_call_type(Type));
+ Code ->
+ Code
+ end.
+
+conv_call_type(remote) -> remote;
+conv_call_type(local) -> not_remote.
+
+%% --------------------------------------------------------------------
+
+%%
+%% ENTER
+%%
+
+gen_enter(I, VarMap, ConstTab) ->
+ Fun = hipe_icode:enter_fun(I),
+ {Args, VarMap1, ConstTab1, InitCode} =
+ args_to_vars(hipe_icode:enter_args(I), VarMap, ConstTab),
+ {Code1, ConstTab2} =
+ case hipe_icode:enter_type(I) of
+ primop ->
+ IsGuard = false, % enter can not happen in a guard
+ hipe_rtl_primops:gen_enter_primop({Fun, Args}, IsGuard, ConstTab1);
+ Type ->
+ Call = gen_enter_1(Fun, Args, Type),
+ {Call, ConstTab1}
+ end,
+ {[InitCode,Code1], VarMap1, ConstTab2}.
+
+%% This catches those standard functions that we inline expand
+
+gen_enter_1(Fun, Args, Type) ->
+ case hipe_rtl_primops:gen_enter_builtin(Fun, Args) of
+ [] ->
+ hipe_rtl:mk_enter(Fun, Args, conv_call_type(Type));
+ Code ->
+ Code
+ end.
+
+%% --------------------------------------------------------------------
+
+%%
+%% FAIL
+%%
+
+gen_fail(I, VarMap, ConstTab) ->
+ Fail = hipe_icode:fail_label(I),
+ {Label, VarMap0} =
+ if Fail =:= [] ->
+ %% not in a catch
+ {[], VarMap};
+ true ->
+ {Lbl, Map} = hipe_rtl_varmap:icode_label2rtl_label(Fail, VarMap),
+ {hipe_rtl:label_name(Lbl), Map}
+ end,
+ {Args, VarMap1, ConstTab1, InitCode} =
+ args_to_vars(hipe_icode:fail_args(I), VarMap0, ConstTab),
+ Class = hipe_icode:fail_class(I),
+ FailCode = hipe_rtl_exceptions:gen_fail(Class, Args, Label),
+ {[InitCode, FailCode], VarMap1, ConstTab1}.
+
+%% --------------------------------------------------------------------
+
+%%
+%% GOTO
+%%
+
+gen_goto(I, VarMap, ConstTab) ->
+ {Label, Map0} =
+ hipe_rtl_varmap:icode_label2rtl_label(hipe_icode:goto_label(I), VarMap),
+ {hipe_rtl:mk_goto(hipe_rtl:label_name(Label)), Map0, ConstTab}.
+
+%% --------------------------------------------------------------------
+
+%%
+%% IF
+%%
+
+gen_if(I, VarMap, ConstTab) ->
+ {Args, VarMap1, ConstTab1, InitCode} =
+ args_to_vars(hipe_icode:if_args(I), VarMap, ConstTab),
+ {TrueLbl, VarMap2} =
+ hipe_rtl_varmap:icode_label2rtl_label(hipe_icode:if_true_label(I), VarMap1),
+ {FalseLbl, VarMap3} =
+ hipe_rtl_varmap:icode_label2rtl_label(hipe_icode:if_false_label(I),VarMap2),
+ CondCode =
+ gen_cond(hipe_icode:if_op(I),
+ Args,
+ hipe_rtl:label_name(TrueLbl),
+ hipe_rtl:label_name(FalseLbl),
+ hipe_icode:if_pred(I)),
+ {[InitCode,CondCode], VarMap3, ConstTab1}.
+
+
+%% --------------------------------------------------------------------
+
+%%
+%% LABEL
+%%
+
+gen_label(I, VarMap, ConstTab) ->
+ LabelName = hipe_icode:label_name(I),
+ {NewLabel,Map0} = hipe_rtl_varmap:icode_label2rtl_label(LabelName, VarMap),
+ {NewLabel,Map0,ConstTab}.
+
+%% --------------------------------------------------------------------
+
+%%
+%% MOVE
+%%
+
+gen_move(I, VarMap, ConstTab) ->
+ MovedSrc = hipe_icode:move_src(I),
+ {Dst, VarMap0} =
+ hipe_rtl_varmap:icode_var2rtl_var(hipe_icode:move_dst(I), VarMap),
+ case hipe_icode:is_const(MovedSrc) of
+ true ->
+ {Code, NewConstMap} = gen_const_move(Dst, MovedSrc, ConstTab),
+ {[Code], VarMap0, NewConstMap};
+ false ->
+ {Src, VarMap1} = hipe_rtl_varmap:icode_var2rtl_var(MovedSrc, VarMap0),
+ Code =
+ case hipe_icode:is_fvar(MovedSrc) of
+ true ->
+ hipe_rtl:mk_fmove(Dst, Src);
+ false -> % It is a var or reg
+ hipe_rtl:mk_move(Dst, Src)
+ end,
+ {[Code], VarMap1, ConstTab}
+ end.
+
+%% --------------------------------------------------------------------
+
+%%
+%% RETURN
+%%
+
+gen_return(I, VarMap, ConstTab) ->
+ {RetVars, VarMap0, ConstTab0, Code} =
+ args_to_vars(hipe_icode:return_vars(I), VarMap, ConstTab),
+ {Code ++ [hipe_rtl:mk_return(RetVars)], VarMap0, ConstTab0}.
+
+%% --------------------------------------------------------------------
+
+%%
+%% SWITCH
+%%
+
+%%
+%% Rewrite switch_val to the equivalent Icode if-then-else sequence,
+%% then translate that sequence instead.
+%% Doing this at the RTL level would generate the exact same code,
+%% but would also require _a_lot_ more work.
+%% (Don't believe me? Try it. I did, and threw the code away in disgust.
+%% The main ugliness comes from (1) maintaining ConstTab for the constants
+%% that may be added there [switch_val is not limited to immediates!],
+%% (2) maintaining Map for the translated labels, and (3) expanding
+%% equality tests to eq-or-call-primop-exact_eqeq_2.)
+%%
+%% TODO:
+%% - separate immediate and non-immediate cases,
+%% and translate each list separately
+%%
+-ifdef(usesjumptable).
+-define(uumess,?msg("~w Use jtab: ~w\n",
+ [Options,proplists:get_bool(use_jumptable, Options)])).
+-else.
+-define(uumess,ok).
+-endif.
+
+gen_switch_val(I, VarMap, ConstTab, Options) ->
+ %% If you want to see whether jumptables are used or not...
+ ?uumess,
+ hipe_rtl_mk_switch:gen_switch_val(I, VarMap, ConstTab, Options).
+
+gen_switch_tuple(I, Map, ConstTab, Options) ->
+ hipe_rtl_mk_switch:gen_switch_tuple(I, Map, ConstTab, Options).
+
+%% --------------------------------------------------------------------
+
+%%
+%% TYPE
+%%
+
+gen_type(I, VarMap, ConstTab) ->
+ {Vars, Map0, NewConstTab, Code1} =
+ args_to_vars(hipe_icode:type_args(I), VarMap, ConstTab),
+ {TrueLbl, Map1} =
+ hipe_rtl_varmap:icode_label2rtl_label(hipe_icode:type_true_label(I), Map0),
+ {FalseLbl, Map2} =
+ hipe_rtl_varmap:icode_label2rtl_label(hipe_icode:type_false_label(I), Map1),
+ {Code2, NewConstTab1} = gen_type_test(Vars, hipe_icode:type_test(I),
+ hipe_rtl:label_name(TrueLbl),
+ hipe_rtl:label_name(FalseLbl),
+ hipe_icode:type_pred(I),
+ NewConstTab),
+ {Code1 ++ Code2, Map2, NewConstTab1}.
+
+%% --------------------------------------------------------------------
+
+%%
+%% Generate code for a type test. If X is not of type Type then goto Label.
+%%
+
+gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) ->
+ case Type of
+ atom ->
+ {hipe_tagscheme:test_atom(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ bignum ->
+ {hipe_tagscheme:test_bignum(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ binary ->
+ {hipe_tagscheme:test_binary(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ bitstr ->
+ {hipe_tagscheme:test_bitstr(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ boolean ->
+ TmpT = hipe_rtl:mk_new_var(),
+ TmpF = hipe_rtl:mk_new_var(),
+ Lbl = hipe_rtl:mk_new_label(),
+ {[hipe_rtl:mk_load_atom(TmpT, true),
+ hipe_rtl:mk_branch(X, eq, TmpT, TrueLbl,hipe_rtl:label_name(Lbl),Pred),
+ Lbl,
+ hipe_rtl:mk_load_atom(TmpF, false),
+ hipe_rtl:mk_branch(X, eq, TmpF, TrueLbl, FalseLbl, Pred)], ConstTab};
+ cons ->
+ {hipe_tagscheme:test_cons(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ constant ->
+ {hipe_tagscheme:test_constant(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ fixnum ->
+ {hipe_tagscheme:test_fixnum(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ float ->
+ {hipe_tagscheme:test_flonum(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ function ->
+ {hipe_tagscheme:test_fun(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ integer ->
+ {hipe_tagscheme:test_integer(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ list ->
+ {hipe_tagscheme:test_list(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ nil ->
+ {hipe_tagscheme:test_nil(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ number ->
+ {hipe_tagscheme:test_number(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ pid ->
+ {hipe_tagscheme:test_any_pid(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ port ->
+ {hipe_tagscheme:test_any_port(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ reference ->
+ {hipe_tagscheme:test_ref(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ tuple ->
+ {hipe_tagscheme:test_tuple(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ {atom, Atom} ->
+ Tmp = hipe_rtl:mk_new_var(),
+ {[hipe_rtl:mk_load_atom(Tmp, Atom),
+ hipe_rtl:mk_branch(X, eq, Tmp, TrueLbl, FalseLbl, Pred)], ConstTab};
+ {integer, N} when is_integer(N) ->
+ %% XXX: warning, does not work for bignums
+ case hipe_tagscheme:is_fixnum(N) of
+ true ->
+ Int = hipe_tagscheme:mk_fixnum(N),
+ {hipe_rtl:mk_branch(X, eq, hipe_rtl:mk_imm(Int),
+ TrueLbl, FalseLbl, Pred),
+ ConstTab};
+ false ->
+ BignumLbl = hipe_rtl:mk_new_label(),
+ RetLbl = hipe_rtl:mk_new_label(),
+ BigN = hipe_rtl:mk_new_var(),
+ Tmp = hipe_rtl:mk_new_var(),
+ {BigCode,NewConstTab} = gen_big_move(BigN, N, ConstTab),
+ {[hipe_tagscheme:test_fixnum(X, FalseLbl,
+ hipe_rtl:label_name(BignumLbl),1-Pred),
+ BignumLbl, BigCode]
+ ++
+ [hipe_rtl:mk_call([Tmp], op_exact_eqeq_2 , [X,BigN],
+ hipe_rtl:label_name(RetLbl),[],not_remote),
+ RetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)],
+ NewConstTab}
+ end;
+ {record, A, S} ->
+ TupleLbl = hipe_rtl:mk_new_label(),
+ TupleLblName = hipe_rtl:label_name(TupleLbl),
+ AtomLab = hipe_rtl:mk_new_label(),
+ AtomLabName = hipe_rtl:label_name(AtomLab),
+ TagVar = hipe_rtl:mk_new_var(),
+ TmpAtomVar = hipe_rtl:mk_new_var(),
+ {UntagCode, ConstTab1} =
+ hipe_rtl_primops:gen_primop({{unsafe_element,1},[TagVar],[X],
+ AtomLabName,[]},
+ false, ConstTab),
+ Code =
+ hipe_tagscheme:test_tuple_N(X, S, TupleLblName, FalseLbl, Pred) ++
+ [TupleLbl|UntagCode] ++
+ [AtomLab,
+ hipe_rtl:mk_load_atom(TmpAtomVar, A),
+ hipe_rtl:mk_branch(TagVar, eq, TmpAtomVar, TrueLbl, FalseLbl, Pred)],
+ {Code,
+ ConstTab1};
+ {tuple, N} ->
+ {hipe_tagscheme:test_tuple_N(X, N, TrueLbl, FalseLbl, Pred), ConstTab};
+ Other ->
+ exit({?MODULE,{"unknown type",Other}})
+ end;
+gen_type_test(Z = [X,Y], Type, TrueLbl, FalseLbl, Pred, ConstTab) ->
+ case Type of
+ function2 ->
+ {hipe_tagscheme:test_fun2(X, Y, TrueLbl, FalseLbl, Pred), ConstTab};
+ fixnum ->
+ {hipe_tagscheme:test_fixnums(Z, TrueLbl, FalseLbl, Pred), ConstTab};
+ Other ->
+ exit({?MODULE,{"unknown type",Other}})
+ end;
+gen_type_test(X, Type, TrueLbl, FalseLbl, Pred, ConstTab) ->
+ case Type of
+ fixnum ->
+ {hipe_tagscheme:test_fixnums(X, TrueLbl, FalseLbl, Pred), ConstTab};
+ Other ->
+ exit({?MODULE,{"type cannot have several arguments",Other}})
+ end.
+
+
+%% --------------------------------------------------------------------
+%%
+%% Generate code for the if-conditional.
+%%
+
+gen_cond(CondOp, Args, TrueLbl, FalseLbl, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ GenLbl = hipe_rtl:mk_new_label(),
+ TestRetLbl = hipe_rtl:mk_new_label(),
+ TestRetName = hipe_rtl:label_name(TestRetLbl),
+
+ case CondOp of
+ 'fixnum_eq' ->
+ [Arg1, Arg2] = Args,
+ [hipe_rtl:mk_branch(Arg1, eq, Arg2, TrueLbl,
+ FalseLbl, Pred)];
+ '=:=' ->
+ [Arg1, Arg2] = Args,
+ [hipe_rtl:mk_branch(Arg1, eq, Arg2, TrueLbl,
+ hipe_rtl:label_name(GenLbl), Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], op_exact_eqeq_2, Args,
+ TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ 'fixnum_neq' ->
+ [Arg1, Arg2] = Args,
+ [hipe_rtl:mk_branch(Arg1, eq, Arg2, FalseLbl,
+ TrueLbl, 1-Pred)];
+ '=/=' ->
+ [Arg1, Arg2] = Args,
+ [hipe_rtl:mk_branch(Arg1, eq, Arg2, FalseLbl,
+ hipe_rtl:label_name(GenLbl), 1-Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], op_exact_eqeq_2, Args,
+ TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ FalseLbl, TrueLbl, Pred)];
+ '==' ->
+ [Arg1, Arg2] = Args,
+ [hipe_rtl:mk_branch(Arg1, eq, Arg2,
+ TrueLbl, hipe_rtl:label_name(GenLbl), Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], cmp_2, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, eq, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ '/=' ->
+ [Arg1, Arg2] = Args,
+ [hipe_rtl:mk_branch(Arg1, eq, Arg2,
+ FalseLbl, hipe_rtl:label_name(GenLbl), 1-Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], cmp_2, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ 'fixnum_gt' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_gt(Arg1, Arg2, TrueLbl, FalseLbl, Pred)];
+ 'fixnum_ge' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_ge(Arg1, Arg2, TrueLbl, FalseLbl, Pred)];
+ 'fixnum_lt' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_lt(Arg1, Arg2, TrueLbl, FalseLbl, Pred)];
+ 'fixnum_le' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_le(Arg1, Arg2, TrueLbl, FalseLbl, Pred)];
+ '>' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenLbl)),
+ hipe_tagscheme:fixnum_gt(Arg1, Arg2, TrueLbl, FalseLbl, Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], cmp_2, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, gt, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ '<' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenLbl)),
+ hipe_tagscheme:fixnum_lt(Arg1, Arg2, TrueLbl, FalseLbl, Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], cmp_2, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, lt, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ '>=' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenLbl)),
+ hipe_tagscheme:fixnum_ge(Arg1, Arg2, TrueLbl, FalseLbl, Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], cmp_2, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, ge, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ '=<' ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenLbl)),
+ hipe_tagscheme:fixnum_le(Arg1, Arg2, TrueLbl, FalseLbl, Pred),
+ GenLbl,
+ hipe_rtl:mk_call([Tmp], cmp_2, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, le, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)];
+ _Other ->
+ [hipe_rtl:mk_call([Tmp], CondOp, Args, TestRetName, [], not_remote),
+ TestRetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ TrueLbl, FalseLbl, Pred)]
+ end.
+
+%% --------------------------------------------------------------------
+%%
+%% Translate a list argument list of icode vars to rtl vars. Also
+%% handles constants in arguments.
+%%
+
+args_to_vars([Arg|Args],VarMap, ConstTab) ->
+ {Vars, VarMap1, ConstTab1, Code} =
+ args_to_vars(Args, VarMap, ConstTab),
+ case hipe_icode:is_variable(Arg) of
+ true ->
+ {Var, VarMap2} = hipe_rtl_varmap:icode_var2rtl_var(Arg, VarMap1),
+ {[Var|Vars], VarMap2, ConstTab1, Code};
+ false ->
+ case type_of_const(Arg) of
+ big ->
+ ConstVal = hipe_icode:const_value(Arg),
+ {ConstTab2, Label} = hipe_consttab:insert_term(ConstTab1, ConstVal),
+ NewArg = hipe_rtl:mk_const_label(Label),
+ {[NewArg|Vars], VarMap1, ConstTab2, Code};
+ fixnum ->
+ ConstVal = hipe_icode:const_value(Arg),
+ NewArg = hipe_rtl:mk_imm(tagged_val_of(ConstVal)),
+ {[NewArg|Vars], VarMap1, ConstTab1, Code};
+ nil ->
+ NewArg = hipe_rtl:mk_imm(tagged_val_of([])),
+ {[NewArg|Vars], VarMap1, ConstTab1, Code};
+ _ ->
+ Var = hipe_rtl:mk_new_var(),
+ {Code2, ConstTab2} = gen_const_move(Var, Arg, ConstTab1),
+ {[Var|Vars], VarMap1, ConstTab2, [Code2,Code]}
+ end
+ end;
+args_to_vars([], VarMap, ConstTab) ->
+ {[], VarMap, ConstTab, []}.
+
+%% --------------------------------------------------------------------
+
+%%
+%% Translate a move where the source is a constant
+%%
+
+gen_const_move(Dst, Const, ConstTab) ->
+ ConstVal = hipe_icode:const_value(Const),
+ case type_of_const(Const) of
+ %% const_fun ->
+ %% gen_fun_move(Dst, ConstVal, ConstTab);
+ nil ->
+ Src = hipe_rtl:mk_imm(tagged_val_of([])),
+ {hipe_rtl:mk_move(Dst, Src), ConstTab};
+ fixnum ->
+ Src = hipe_rtl:mk_imm(tagged_val_of(ConstVal)),
+ {hipe_rtl:mk_move(Dst, Src), ConstTab};
+ atom ->
+ {hipe_rtl:mk_load_atom(Dst, ConstVal), ConstTab};
+ big ->
+ gen_big_move(Dst, ConstVal, ConstTab)
+ end.
+
+%% gen_fun_move(Dst, Fun, ConstTab) ->
+%% ?WARNING_MSG("Funmove ~w! -- NYI\n", [Fun]),
+%% {NewTab, Label} = hipe_consttab:insert_fun(ConstTab, Fun),
+%% {hipe_rtl:mk_load_address(Dst, Label, constant), NewTab}.
+
+gen_big_move(Dst, Big, ConstTab) ->
+ {NewTab, Label} = hipe_consttab:insert_term(ConstTab, Big),
+ {hipe_rtl:mk_move(Dst, hipe_rtl:mk_const_label(Label)),
+ NewTab}.
+
+type_of_const(Const) ->
+ case hipe_icode:const_value(Const) of
+ [] ->
+ nil;
+ X when is_integer(X) ->
+ case hipe_tagscheme:is_fixnum(X) of
+ true -> fixnum;
+ false -> big
+ end;
+ A when is_atom(A) ->
+ atom;
+ _ ->
+ big
+ end.
+
+tagged_val_of([]) -> hipe_tagscheme:mk_nil();
+tagged_val_of(X) when is_integer(X) -> hipe_tagscheme:mk_fixnum(X).
diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl
new file mode 100644
index 0000000000..ef06b2abf8
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl.erl
@@ -0,0 +1,1655 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% @doc
+%%
+%% Provides an abstract datatype for HiPE's RTL (Register Transfer Language).
+%%
+%% <h3> RTL - Register Transfer Language </h3>
+%%
+%% Consists of the instructions:
+%% <ul>
+%% <li> {alu, Dst, Src1, Op, Src2} </li>
+%% <li> {alub, Dst, Src1, Op, Src2, RelOp, TrueLabel, FalseLabel, P} </li>
+%% <li> {branch, Src1, Src2, RelOp, TrueLabel, FalseLabel, P} </li>
+%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation}
+%% Type is one of {local, remote, primop, closure} </li>
+%% <li> {comment, Text} </li>
+%% <li> {enter, Fun, ArgList, Type}
+%% Type is one of {local, remote, primop, closure} </li>
+%% <li> {fconv, Dst, Src} </li>
+%% <li> {fload, Dst, Src, Offset} </li>
+%% <li> {fmove, Dst, Src} </li>
+%% <li> {fp, Dst, Src1, Op, Src2} </li>
+%% <li> {fp_unop, Dst, Src, Op} </li>
+%% <li> {fstore, Base, Offset, Src} </li>
+%% <li> {gctest, Words} </li>
+%% <li> {goto, Label} </li>
+%% <li> {goto_index, Block, Index, LabelList} </li>
+%% <li> {label, Name} </li>
+%% <li> {load, Dst, Src, Offset, Size, Sign} </li>
+%% <li> {load_address, Dst, Addr, Type} </li>
+%% <li> {load_atom, Dst, Atom} </li>
+%% <li> {load_word_index, Dst, Block, Index} </li>
+%% <li> {move, Dst, Src} </li>
+%% <li> {multimove, [Dst1, ..., DstN], [Src1, ..., SrcN]} </li>
+%% <li> {phi, Dst, Id, [Src1, ..., SrcN]} </li>
+%% <li> {return, VarList} </li>
+%% <li> {store, Base, Offset, Src, Size} </li>
+%% <li> {switch, Src1, Labels, SortedBy} </li>
+%% </ul>
+%%
+%% There are three kinds of 'registers' in RTL.
+%% <ol>
+%% <li> Variables containing tagged data that are traced by the GC. </li>
+%% <li> Registers that are ignored by the GC. </li>
+%% <li> Floating point registers. </li>
+%% </ol>
+%% These registers all share the same namespace.
+%%
+%% IMPORTANT:
+%%
+%% The variables contain tagged Erlang terms, the registers
+%% contain untagged values (that can be all sorts of things) and
+%% the floating point registers contain untagged floating point
+%% values. This means that the different kinds of 'registers' are
+%% incompatible and CANNOT be assigned to each other unless the
+%% proper conversions are made.
+%%
+%% When performing optimizations, it is reasonably safe to move
+%% values stored in variables. However, when moving around untagged
+%% values from either registers or floating point registers make
+%% sure you know what you are doing.
+%%
+%% Example 1: A register might contain the untagged pointer to
+%% something on the heap. If this value is moved across
+%% a program point where a garbage collection might
+%% occur, the pointer can be invalid. If you are lucky
+%% you will end up with a segmentation fault; if unlucky,
+%% you will be stuck on a wild goose chase.
+%%
+%% Example 2: Floating point arithmetic instructions must occur in
+%% a floating point block. Otherwise, exceptions can be
+%% masked.
+%%
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl).
+-include("../main/hipe.hrl").
+
+-export([mk_rtl/8,
+ rtl_fun/1,
+ rtl_params/1,
+ rtl_is_closure/1,
+ rtl_is_leaf/1,
+ rtl_code/1,
+ rtl_code_update/2,
+ rtl_data/1,
+ %% rtl_data_update/2,
+ %% rtl_var_range/1,
+ %% rtl_var_range_update/2,
+ %% rtl_label_range/1,
+ %% rtl_label_range_update/2,
+ rtl_info/1,
+ rtl_info_update/2]).
+
+-export([mk_move/2,
+ move_dst/1,
+ move_src/1,
+ %% move_src_update/2,
+ %% is_move/1,
+
+ mk_multimove/2,
+ multimove_dstlist/1,
+ multimove_srclist/1,
+ %% multimove_srclist_update/2,
+ %% is_multimove/1,
+
+ mk_phi/1,
+ phi_dst/1,
+ phi_id/1,
+ phi_arg/2,
+ phi_arglist/1,
+ is_phi/1,
+ phi_enter_pred/3,
+ phi_remove_pred/2,
+
+ mk_alu/4,
+ alu_dst/1,
+ alu_src1/1,
+ alu_src1_update/2,
+ alu_src2/1,
+ alu_src2_update/2,
+ alu_op/1,
+ %% is_alu_op/1,
+ is_shift_op/1,
+
+ mk_load/3,
+ mk_load/5,
+ load_dst/1,
+ load_src/1,
+ load_offset/1,
+ load_size/1,
+ load_sign/1,
+
+ mk_load_atom/2,
+ load_atom_dst/1,
+ load_atom_atom/1,
+
+ mk_load_word_index/3,
+ load_word_index_dst/1,
+ %% load_word_index_index/1,
+ %% load_word_index_block/1,
+
+ mk_goto_index/3,
+ goto_index_index/1,
+ %% goto_index_block/1,
+ goto_index_labels/1,
+
+ mk_load_address/3,
+ load_address_dst/1,
+ %% load_address_dst_update/2,
+ load_address_addr/1,
+ load_address_addr_update/2,
+ load_address_type/1,
+ %% load_address_type_update/2,
+
+ mk_store/3,
+ mk_store/4,
+ store_base/1,
+ store_src/1,
+ store_offset/1,
+ store_size/1,
+
+ mk_label/1,
+ mk_new_label/0,
+ label_name/1,
+ is_label/1,
+
+ mk_branch/5,
+ mk_branch/6,
+ branch_src1/1,
+ branch_src2/1,
+ branch_cond/1,
+ branch_true_label/1,
+ branch_false_label/1,
+ branch_pred/1,
+ %% is_branch/1,
+ %% branch_true_label_update/2,
+ %% branch_false_label_update/2,
+
+ mk_alub/7,
+ mk_alub/8,
+ alub_dst/1,
+ alub_src1/1,
+ alub_op/1,
+ alub_src2/1,
+ alub_cond/1,
+ alub_true_label/1,
+ %% alub_true_label_update/2,
+ alub_false_label/1,
+ %% alub_false_label_update/2,
+ alub_pred/1,
+ %% is_alub/1,
+
+ mk_switch/2,
+ %% mk_switch/3,
+ mk_sorted_switch/3,
+ switch_src/1,
+ %% switch_src_update/2,
+ switch_labels/1,
+ %% switch_labels_update/2,
+ switch_sort_order/1,
+ %% switch_sort_order_update/2,
+
+ mk_goto/1,
+ goto_label/1,
+ is_goto/1,
+ %% goto_label_update/2,
+
+ mk_call/6,
+ call_fun/1,
+ call_dstlist/1,
+ call_dstlist_update/2,
+ call_arglist/1,
+ call_continuation/1,
+ call_fail/1,
+ call_type/1,
+ %% call_continuation_update/2,
+ %% call_fail_update/2,
+ is_call/1,
+
+ mk_enter/3,
+ enter_fun/1,
+ enter_arglist/1,
+ enter_type/1,
+
+ mk_return/1,
+ return_varlist/1,
+
+ mk_gctest/1,
+ gctest_words/1,
+
+ mk_comment/1,
+ comment_text/1,
+ is_comment/1,
+
+ mk_fload/3,
+ fload_dst/1,
+ fload_src/1,
+ %% fload_src_update/2,
+ fload_offset/1,
+ %% fload_offset_update/2,
+
+ mk_fstore/3,
+ fstore_base/1,
+ fstore_src/1,
+ fstore_offset/1,
+
+ mk_fp/4,
+ fp_dst/1,
+ fp_src1/1,
+ %% fp_src1_update/2,
+ fp_src2/1,
+ %% fp_src2_update/2,
+ fp_op/1,
+
+ mk_fp_unop/3,
+ fp_unop_dst/1,
+ fp_unop_src/1,
+ %% fp_unop_src_update/2,
+ fp_unop_op/1,
+
+ mk_fmove/2,
+ fmove_dst/1,
+ fmove_src/1,
+ %% fmove_src_update/2,
+ %% is_fmove/1,
+
+ mk_fconv/2,
+ fconv_dst/1,
+ fconv_src/1,
+ %% fconv_src_update/2,
+ %% is_fconv/1,
+
+ %% mk_var/1,
+ mk_new_var/0,
+ is_var/1,
+ var_index/1,
+
+ %% change_vars_to_regs/1,
+
+ mk_fixnumop/3,
+ fixnumop_dst/1,
+ fixnumop_src/1,
+ fixnumop_type/1,
+
+ mk_reg/1, % assumes non gc-safe
+ mk_reg_gcsafe/1,
+ mk_new_reg/0, % assumes non gc-safe
+ mk_new_reg_gcsafe/0,
+ is_reg/1,
+ reg_index/1,
+ reg_is_gcsafe/1,
+
+ %% mk_fpreg/1,
+ mk_new_fpreg/0,
+ is_fpreg/1,
+ fpreg_index/1,
+
+ mk_imm/1,
+ is_imm/1,
+ imm_value/1,
+
+ mk_const_label/1,
+ const_label_label/1,
+ is_const_label/1,
+
+ args/1,
+ uses/1,
+ %% subst/2,
+ subst_uses/2,
+ subst_defines/2,
+ defines/1,
+ redirect_jmp/3,
+ is_safe/1,
+ %% highest_var/1,
+ pp/1,
+ pp/2,
+ pp_block/1,
+
+ %% FIXME _dst_update command. Ok to export these?
+ alu_dst_update/2,
+ fconv_dst_update/2,
+ fload_dst_update/2,
+ %% fmove_dst_update/2,
+ fp_dst_update/2,
+ fp_unop_dst_update/2,
+ load_dst_update/2,
+ load_address_dst_update/2,
+ load_atom_dst_update/2,
+ load_word_index_dst_update/2,
+ %% move_dst_update/2,
+ fixnumop_dst_update/2,
+ pp_instr/2,
+ %% pp_arg/2,
+ phi_arglist_update/2,
+ phi_redirect_pred/3]).
+
+%%
+%% RTL
+%%
+
+-record(rtl, {'fun', %% Name of the function (MFA)
+ arglist, %% List of argument names (formals)
+ is_closure, %% True if this is code for a closure.
+ is_leaf, %% True if this is a leaf function.
+ code, %% Linear list of RTL-instructions.
+ data, %% Data segment
+ var_range, %% {Min,Max} First and last name used for
+ %% regs, fpregs, or vars.
+ %% (they use a common namespace)
+ label_range, %% {Min,Max} First and last name used for labels
+ info=[] %% A keylist with arbitrary information.
+ }).
+
+mk_rtl(Fun, ArgList, Closure, Leaf, Code, Data, VarRange, LabelRange) ->
+ #rtl{'fun'=Fun, arglist=ArgList, code=Code,
+ data=Data, is_closure=Closure, is_leaf=Leaf,
+ var_range=VarRange, label_range=LabelRange}.
+rtl_fun(#rtl{'fun'=Fun}) -> Fun.
+rtl_params(#rtl{arglist=ArgList}) -> ArgList.
+rtl_is_closure(#rtl{is_closure=Closure}) -> Closure.
+rtl_is_leaf(#rtl{is_leaf=Leaf}) -> Leaf.
+rtl_code(#rtl{code=Code}) -> Code.
+rtl_code_update(Rtl, Code) -> Rtl#rtl{code=Code}.
+rtl_data(#rtl{data=Data}) -> Data.
+%% rtl_data_update(Rtl, Data) -> Rtl#rtl{data=Data}.
+%% rtl_var_range(#rtl{var_range=VarRange}) -> VarRange.
+%% rtl_var_range_update(Rtl, VarRange) -> Rtl#rtl{var_range=VarRange}.
+%% rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange.
+%% rtl_label_range_update(Rtl, LabelRange) -> Rtl#rtl{label_range=LabelRange}.
+rtl_info(#rtl{info=Info}) -> Info.
+rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}.
+
+%%-----------------------------------------------------------------------------
+
+-include("hipe_rtl.hrl").
+
+%%-----------------------------------------------------------------------------
+
+%%
+%% move
+%%
+
+mk_move(Dst, Src) -> #move{dst=Dst, src=Src}.
+move_dst(#move{dst=Dst}) -> Dst.
+move_dst_update(M, NewDst) -> M#move{dst=NewDst}.
+move_src(#move{src=Src}) -> Src.
+move_src_update(M, NewSrc) -> M#move{src=NewSrc}.
+%% is_move(#move{}) -> true;
+%% is_move(_) -> false.
+
+%%
+%% multimove
+%%
+
+mk_multimove(DstList, SrcList) ->
+ case length(DstList) =:= length(SrcList) of
+ true -> true;
+ false ->
+ exit({?MODULE,mk_multimove,
+ {"different arities",{dstlist,DstList},{srclist,SrcList}}})
+ end,
+ #multimove{dstlist=DstList, srclist=SrcList}.
+multimove_dstlist(#multimove{dstlist=DstList}) -> DstList.
+multimove_dstlist_update(M, NewDstList) -> M#multimove{dstlist=NewDstList}.
+multimove_srclist(#multimove{srclist=SrcList}) -> SrcList.
+multimove_srclist_update(M, NewSrcList) -> M#multimove{srclist=NewSrcList}.
+%% is_multimove(#multimove{}) -> true;
+%% is_multimove(_) -> false.
+
+%%
+%% phi
+%%
+
+%% The id field is not entirely redundant. It is used in mappings
+%% in the SSA pass since the dst field can change.
+mk_phi(Var) -> #phi{dst = Var, id = Var, arglist = []}.
+%% mk_phi(Var, ArgList) -> #phi{dst = Var, id = Var, arglist = ArgList}.
+phi_dst(#phi{dst=Dst}) -> Dst.
+phi_dst_update(Phi, NewDst) -> Phi#phi{dst = NewDst}.
+phi_id(#phi{id=Id}) -> Id.
+phi_args(Phi) -> [X || {_,X} <- phi_arglist(Phi)].
+phi_arg(Phi, Pred) ->
+ case lists:keyfind(Pred, 1, phi_arglist(Phi)) of
+ false ->
+ exit({?MODULE,phi_arg,{"Uknown Phi predecessor",Phi,{pred,Pred}}});
+ {_, Var} -> Var
+ end.
+phi_arglist(#phi{arglist=ArgList}) -> ArgList.
+phi_arglist_update(P,NewArgList) ->P#phi{arglist=NewArgList}.
+is_phi(#phi{}) -> true;
+is_phi(_) -> false.
+phi_enter_pred(Phi, Pred, Var) ->
+ Phi#phi{arglist=[{Pred,Var}|lists:keydelete(Pred, 1, phi_arglist(Phi))]}.
+phi_remove_pred(Phi, Pred) ->
+ NewArgList = lists:keydelete(Pred, 1, phi_arglist(Phi)),
+ case NewArgList of
+ [Arg] -> %% the phi should be turned into a move instruction
+ {_Label,Var} = Arg,
+ mk_move(phi_dst(Phi), Var);
+ %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]),
+ [_|_] ->
+ Phi#phi{arglist=NewArgList}
+ end.
+phi_argvar_subst(Phi, Subst) ->
+ NewArgList = [{Pred,subst1(Subst, Var)} || {Pred,Var} <- phi_arglist(Phi)],
+ Phi#phi{arglist=NewArgList}.
+phi_redirect_pred(P, OldPred, NewPred)->
+ Subst = [{OldPred, NewPred}],
+ NewArgList = [{subst1(Subst, Pred), Var} || {Pred,Var} <- phi_arglist(P)],
+ P#phi{arglist=NewArgList}.
+
+
+%%
+%% alu
+%%
+
+mk_alu(Dst, Src1, Op, Src2) ->
+ #alu{dst=Dst, src1=Src1, op=Op, src2=Src2}.
+alu_dst(#alu{dst=Dst}) -> Dst.
+alu_dst_update(Alu, NewDst) -> Alu#alu{dst=NewDst}.
+alu_src1(#alu{src1=Src1}) -> Src1.
+alu_src1_update(Alu, NewSrc) -> Alu#alu{src1=NewSrc}.
+alu_src2(#alu{src2=Src2}) -> Src2.
+alu_src2_update(Alu, NewSrc) -> Alu#alu{src2=NewSrc}.
+alu_op(#alu{op=Op}) -> Op.
+
+%%
+%% load
+%%
+
+mk_load(Dst, Src, Offset) -> mk_load(Dst, Src, Offset, word, unsigned).
+mk_load(Dst, Src, Offset, Size, Sign) ->
+ ?ASSERT((Sign =:= unsigned) orelse (Sign =:= signed)),
+ ?ASSERT((Size =:= word) orelse (Size =:= int32) orelse
+ (Size =:= int16) orelse (Size =:= byte)),
+ #load{dst=Dst, src=Src, offset=Offset, size=Size, sign=Sign}.
+load_dst(#load{dst=Dst}) -> Dst.
+load_dst_update(L, NewDst) -> L#load{dst=NewDst}.
+load_src(#load{src=Src}) -> Src.
+load_src_update(L, NewSrc) -> L#load{src=NewSrc}.
+load_offset(#load{offset=Offset}) -> Offset.
+load_offset_update(L, NewOffset) -> L#load{offset=NewOffset}.
+load_size(#load{size=Size}) -> Size.
+load_sign(#load{sign=Sign}) -> Sign.
+
+%%
+%% load_atom
+%%
+
+mk_load_atom(Dst, Atom) -> #load_atom{dst=Dst,atom=Atom}.
+load_atom_dst(#load_atom{dst=Dst}) -> Dst.
+load_atom_dst_update(L, NewDst) -> L#load_atom{dst=NewDst}.
+load_atom_atom(#load_atom{atom=Atom}) -> Atom.
+
+mk_load_word_index(Dst, Block, Index) ->
+ #load_word_index{dst=Dst, block=Block, index=Index}.
+load_word_index_dst(#load_word_index{dst=Dst}) -> Dst.
+load_word_index_dst_update(L, NewDst) -> L#load_word_index{dst=NewDst}.
+load_word_index_block(#load_word_index{block=Block}) -> Block.
+load_word_index_index(#load_word_index{index=Index}) -> Index.
+
+mk_goto_index(Block, Index, Labels) ->
+ #goto_index{block=Block, index=Index, labels=Labels}.
+goto_index_block(#goto_index{block=Block}) -> Block.
+goto_index_index(#goto_index{index=Index}) -> Index.
+goto_index_labels(#goto_index{labels=Labels}) -> Labels.
+
+%%
+%% load_address
+%%
+
+mk_load_address(Dst, Addr, Type) ->
+ #load_address{dst=Dst, addr=Addr, type=Type}.
+load_address_dst(#load_address{dst=Dst}) -> Dst.
+load_address_dst_update(LA, NewDst) -> LA#load_address{dst=NewDst}.
+load_address_addr(#load_address{addr=Addr}) -> Addr.
+load_address_addr_update(LoadAddress, NewAdr) ->
+ LoadAddress#load_address{addr=NewAdr}.
+load_address_type(#load_address{type=Type}) -> Type.
+%% load_address_type_update(LA, NewType) -> LA#load_address{type=NewType}.
+
+%%
+%% store
+%%
+
+mk_store(Base, Offset, Src) -> mk_store(Base, Offset, Src, word).
+mk_store(Base, Offset, Src, Size) ->
+ ?ASSERT((Size =:= word) orelse (Size =:= int32) orelse
+ (Size =:= int16) orelse (Size =:= byte)),
+ #store{base=Base, src=Src, offset=Offset, size=Size}.
+store_base(#store{base=Base}) -> Base.
+store_base_update(S, NewBase) -> S#store{base=NewBase}.
+store_offset(#store{offset=Offset}) -> Offset.
+store_offset_update(S, NewOffset) -> S#store{offset=NewOffset}.
+store_src(#store{src=Src}) -> Src.
+store_src_update(S, NewSrc) -> S#store{src=NewSrc}.
+store_size(#store{size=Size}) -> Size.
+
+%%
+%% label
+%%
+
+mk_label(Name) -> #label{name=Name}.
+mk_new_label() -> mk_label(hipe_gensym:get_next_label(rtl)).
+label_name(#label{name=Name}) -> Name.
+is_label(#label{}) -> true;
+is_label(_) -> false.
+
+%%
+%% branch
+%%
+
+mk_branch(Src1, Op, Src2, True, False) ->
+ mk_branch(Src1, Op, Src2, True, False, 0.5).
+mk_branch(Src1, Op, Src2, True, False, P) ->
+ #branch{src1=Src1, 'cond'=Op, src2=Src2, true_label=True,
+ false_label=False, p=P}.
+branch_src1(#branch{src1=Src1}) -> Src1.
+branch_src1_update(Br, NewSrc) -> Br#branch{src1=NewSrc}.
+branch_src2(#branch{src2=Src2}) -> Src2.
+branch_src2_update(Br, NewSrc) -> Br#branch{src2=NewSrc}.
+branch_cond(#branch{'cond'=Cond}) -> Cond.
+branch_true_label(#branch{true_label=TrueLbl}) -> TrueLbl.
+branch_true_label_update(Br, NewTrue) -> Br#branch{true_label=NewTrue}.
+branch_false_label(#branch{false_label=FalseLbl}) -> FalseLbl.
+branch_false_label_update(Br, NewFalse) -> Br#branch{false_label=NewFalse}.
+branch_pred(#branch{p=P}) -> P.
+
+%%
+%% alub
+%%
+
+mk_alub(Dst, Src1, Op, Src2, Cond, True, False) ->
+ mk_alub(Dst, Src1, Op, Src2, Cond, True, False, 0.5).
+mk_alub(Dst, Src1, Op, Src2, Cond, True, False, P) ->
+ #alub{dst=Dst, src1=Src1, op=Op, src2=Src2, 'cond'=Cond,
+ true_label=True, false_label=False, p=P}.
+alub_dst(#alub{dst=Dst}) -> Dst.
+alub_dst_update(A, NewDst) -> A#alub{dst=NewDst}.
+alub_src1(#alub{src1=Src1}) -> Src1.
+alub_src1_update(A, NewSrc) -> A#alub{src1=NewSrc}.
+alub_op(#alub{op=Op}) -> Op.
+alub_src2(#alub{src2=Src2}) -> Src2.
+alub_src2_update(A, NewSrc) -> A#alub{src2=NewSrc}.
+alub_cond(#alub{'cond'=Cond}) -> Cond.
+alub_true_label(#alub{true_label=TrueLbl}) -> TrueLbl.
+alub_true_label_update(A, NewTrue) -> A#alub{true_label=NewTrue}.
+alub_false_label(#alub{false_label=FalseLbl}) -> FalseLbl.
+alub_false_label_update(A, NewFalse) -> A#alub{false_label=NewFalse}.
+alub_pred(#alub{p=P}) -> P.
+
+%%
+%% switch
+%%
+
+mk_switch(Src, Labels) -> #switch{src=Src, labels=Labels}.
+mk_sorted_switch(Src, Labels, Order) ->
+ #switch{src=Src, labels=Labels, sorted_by=Order}.
+switch_src(#switch{src=Src}) -> Src.
+switch_src_update(I, N) -> I#switch{src=N}.
+switch_labels(#switch{labels=Labels}) -> Labels.
+switch_labels_update(I,N) -> I#switch{labels=N}.
+switch_sort_order(#switch{sorted_by=Order}) -> Order.
+%% switch_sort_order_update(I,N) -> I#switch{sorted_by=N}.
+
+%%
+%% goto
+%%
+
+mk_goto(Label) -> #goto{label=Label}.
+goto_label(#goto{label=Label}) -> Label.
+goto_label_update(I, NewLabel) ->
+ I#goto{label=NewLabel}.
+is_goto(#goto{}) -> true;
+is_goto(_) -> false.
+
+%%
+%% call
+%%
+
+mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) ->
+ case Type of
+ remote -> ok;
+ not_remote -> ok
+ end,
+ #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type,
+ continuation=Continuation,
+ failcontinuation=FailContinuation}.
+call_dstlist(#call{dstlist=DstList}) -> DstList.
+call_dstlist_update(C, NewDstList) -> C#call{dstlist=NewDstList}.
+call_fun(#call{'fun'=Fun}) -> Fun.
+call_fun_update(C, F) -> C#call{'fun'=F}.
+call_arglist(#call{arglist=ArgList}) -> ArgList.
+call_arglist_update(C, NewArgList) -> C#call{arglist=NewArgList}.
+call_continuation(#call{continuation=Continuation}) -> Continuation.
+call_fail(#call{failcontinuation=FailContinuation}) -> FailContinuation.
+call_type(#call{type=Type}) -> Type.
+call_continuation_update(C, NewCont) -> C#call{continuation=NewCont}.
+call_fail_update(C, NewCont) -> C#call{failcontinuation=NewCont}.
+is_call(#call{}) -> true;
+is_call(_) -> false.
+call_is_known(C) ->
+ Fun = call_fun(C),
+ call_or_enter_fun_is_known(Fun).
+
+call_or_enter_fun_is_known(Fun) ->
+ case is_atom(Fun) of
+ true -> true; %% make the expected common case fast
+ false ->
+ case is_reg(Fun) of
+ true -> false;
+ false ->
+ case is_var(Fun) of
+ true -> false;
+ false ->
+ case Fun of
+ {M,F,A} when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
+ true;
+ {F,A} when is_atom(F), is_integer(A), A >= 0 ->
+ true;
+ _ -> %% colored versions of rtl_reg or rtl_var (used in SSA)
+ false
+ end
+ end
+ end
+ end.
+
+%%
+%% enter
+%%
+
+mk_enter(Fun, ArgList, Type) ->
+ case Type of
+ remote -> ok;
+ not_remote -> ok % {local,primop,closure,pointer}
+ end,
+ #enter{'fun'=Fun, arglist=ArgList, type=Type}.
+enter_fun(#enter{'fun'=Fun}) -> Fun.
+enter_fun_update(I, F) -> I#enter{'fun' = F}.
+enter_arglist(#enter{arglist=ArgList}) -> ArgList.
+enter_arglist_update(E, NewArgList) -> E#enter{arglist=NewArgList}.
+enter_type(#enter{type=Type}) -> Type.
+enter_is_known(E) ->
+ Fun = enter_fun(E),
+ call_or_enter_fun_is_known(Fun).
+
+%%
+%% return
+%%
+
+mk_return(VarList) -> #return{varlist=VarList}.
+return_varlist(#return{varlist=VarList}) -> VarList.
+return_varlist_update(R, NewVarList) -> R#return{varlist=NewVarList}.
+
+%%
+%% gctests
+%%
+
+mk_gctest(Words) when is_integer(Words) -> #gctest{words=mk_imm(Words)};
+mk_gctest(Reg) -> #gctest{words=Reg}. % This handles rtl_regs and rtl_vars
+gctest_words(#gctest{words=Words}) -> Words.
+gctest_words_update(S, NewWords) -> S#gctest{words=NewWords}.
+
+
+%%
+%% fixnumop
+%%
+
+mk_fixnumop(Dst, Src, Type) ->
+ #fixnumop{dst=Dst, src=Src, type=Type}.
+fixnumop_dst(#fixnumop{dst=Dst}) -> Dst.
+fixnumop_dst_update(S, Dst) -> S#fixnumop{dst=Dst}.
+fixnumop_src(#fixnumop{src=Src}) -> Src.
+fixnumop_src_update(S, Src) -> S#fixnumop{src=Src}.
+fixnumop_type(#fixnumop{type=Type}) -> Type.
+
+%%
+%% comments
+%%
+
+mk_comment(Text) -> #comment{text=Text}.
+comment_text(#comment{text=Text}) -> Text.
+is_comment(#comment{}) -> true;
+is_comment(_) -> false.
+
+%%-------------------------------------------------------------------------
+%% Floating point stuff.
+%%-------------------------------------------------------------------------
+
+%%
+%% fload
+%%
+
+mk_fload(Dst, Src, Offset) -> #fload{dst=Dst, src=Src, offset=Offset}.
+fload_dst(#fload{dst=Dst}) -> Dst.
+fload_dst_update(L, NewDst) -> L#fload{dst=NewDst}.
+fload_src(#fload{src=Src}) -> Src.
+fload_src_update(L, NewSrc) -> L#fload{src=NewSrc}.
+fload_offset(#fload{offset=Offset}) -> Offset.
+fload_offset_update(L, NewOffset) -> L#fload{offset=NewOffset}.
+
+%%
+%% fstore
+%%
+
+mk_fstore(Base, Offset, Src) ->
+ #fstore{base=Base, offset=Offset, src=Src}.
+fstore_base(#fstore{base=Base}) -> Base.
+fstore_base_update(F, NewBase) -> F#fstore{base=NewBase}.
+fstore_offset(#fstore{offset=Offset}) -> Offset.
+fstore_offset_update(F, NewOff) -> F#fstore{offset=NewOff}.
+fstore_src(#fstore{src=Src}) -> Src.
+fstore_src_update(F, NewSrc) -> F#fstore{src=NewSrc}.
+
+%%
+%% fp
+%%
+
+mk_fp(Dst, Src1, Op, Src2) ->
+ #fp{dst=Dst, src1=Src1, op=Op, src2=Src2}.
+fp_dst(#fp{dst=Dst}) -> Dst.
+fp_dst_update(Fp, NewDst) -> Fp#fp{dst=NewDst}.
+fp_src1(#fp{src1=Src1}) -> Src1.
+fp_src1_update(Fp, NewSrc) -> Fp#fp{src1=NewSrc}.
+fp_src2(#fp{src2=Src2}) -> Src2.
+fp_src2_update(Fp, NewSrc) -> Fp#fp{src2=NewSrc}.
+fp_op(#fp{op=Op}) -> Op.
+
+%%
+%% fp_unop
+%%
+
+mk_fp_unop(Dst, Src, Op) ->
+ #fp_unop{dst=Dst, src=Src, op=Op}.
+fp_unop_dst(#fp_unop{dst=Dst}) -> Dst.
+fp_unop_dst_update(Fp, NewDst) -> Fp#fp_unop{dst=NewDst}.
+fp_unop_src(#fp_unop{src=Src}) -> Src.
+fp_unop_src_update(Fp, NewSrc) -> Fp#fp_unop{src=NewSrc}.
+fp_unop_op(#fp_unop{op=Op}) -> Op.
+
+%%
+%% fmove
+%%
+
+mk_fmove(X, Y) -> #fmove{dst=X, src=Y}.
+fmove_dst(#fmove{dst=Dst}) -> Dst.
+fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}.
+fmove_src(#fmove{src=Src}) -> Src.
+fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}.
+
+%%
+%% fconv
+%%
+
+mk_fconv(X, Y) -> #fconv{dst=X, src=Y}.
+fconv_dst(#fconv{dst=Dst}) -> Dst.
+fconv_dst_update(C, NewDst) -> C#fconv{dst=NewDst}.
+fconv_src(#fconv{src=Src}) -> Src.
+fconv_src_update(C, NewSrc) -> C#fconv{src=NewSrc}.
+
+%%
+%% The values
+%%
+%% change_vars_to_regs(Vars) ->
+%% change_vars_to_regs(Vars, []).
+%% change_vars_to_regs([Var|Rest], Acc) ->
+%% change_vars_to_regs(Rest,[change_var_to_reg(Var)|Acc]);
+%% change_vars_to_regs([], Acc) ->
+%% lists:reverse(Acc).
+%%
+%% change_var_to_reg(Var) ->
+%% mk_reg(var_index(Var)).
+
+-record(rtl_reg, {index :: integer(),
+ is_gc_safe :: boolean()}).
+
+mk_reg(Num, IsGcSafe) when is_integer(Num), Num >= 0 ->
+ #rtl_reg{index=Num,is_gc_safe=IsGcSafe}.
+mk_reg(Num) -> mk_reg(Num, false).
+mk_reg_gcsafe(Num) -> mk_reg(Num, true).
+mk_new_reg() -> mk_reg(hipe_gensym:get_next_var(rtl), false).
+mk_new_reg_gcsafe() -> mk_reg(hipe_gensym:get_next_var(rtl), true).
+reg_index(#rtl_reg{index=Index}) -> Index.
+reg_is_gcsafe(#rtl_reg{is_gc_safe=IsGcSafe}) -> IsGcSafe.
+is_reg(#rtl_reg{}) -> true;
+is_reg(_) -> false.
+
+-record(rtl_var, {index :: non_neg_integer()}).
+
+mk_var(Num) when is_integer(Num), Num >= 0 -> #rtl_var{index=Num}.
+mk_new_var() -> mk_var(hipe_gensym:get_next_var(rtl)).
+var_index(#rtl_var{index=Index}) -> Index.
+is_var(#rtl_var{}) -> true;
+is_var(_) -> false.
+
+-record(rtl_fpreg, {index :: non_neg_integer()}).
+
+mk_fpreg(Num) when is_integer(Num), Num >= 0 -> #rtl_fpreg{index=Num}.
+mk_new_fpreg() -> mk_fpreg(hipe_gensym:get_next_var(rtl)).
+fpreg_index(#rtl_fpreg{index=Index}) -> Index.
+is_fpreg(#rtl_fpreg{}) -> true;
+is_fpreg(_) -> false.
+
+-record(rtl_imm, {value}).
+
+mk_imm(Value) -> #rtl_imm{value=Value}.
+imm_value(#rtl_imm{value=Value}) -> Value.
+is_imm(#rtl_imm{}) -> true;
+is_imm(_) -> false.
+
+-record(rtl_const_lbl, {label}).
+
+mk_const_label(Label) -> #rtl_const_lbl{label=Label}.
+const_label_label(#rtl_const_lbl{label=Label}) -> Label.
+is_const_label(#rtl_const_lbl{}) -> true;
+is_const_label(_) -> false.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Utilities - no representation visible below this point
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%
+%% @doc Returns the list of variables, constant labels and immediates
+%% an RTL instruction uses.
+%%
+
+uses(I) ->
+ remove_imms_and_const_lbls(args(I)).
+
+%%
+%% @doc Returns the list of variables an RTL instruction uses.
+%%
+
+args(I) ->
+ case I of
+ #alu{} -> [alu_src1(I), alu_src2(I)];
+ #alub{} -> [alub_src1(I), alub_src2(I)];
+ #branch{} -> [branch_src1(I), branch_src2(I)];
+ #call{} ->
+ Args = call_arglist(I) ++ hipe_rtl_arch:call_used(),
+ case call_is_known(I) of
+ false -> [call_fun(I) | Args];
+ true -> Args
+ end;
+ #comment{} -> [];
+ #enter{} ->
+ Args = enter_arglist(I) ++ hipe_rtl_arch:tailcall_used(),
+ case enter_is_known(I) of
+ false -> [enter_fun(I) | Args];
+ true -> Args
+ end;
+ #fconv{} -> [fconv_src(I)];
+ #fixnumop{} -> [fixnumop_src(I)];
+ #fload{} -> [fload_src(I), fload_offset(I)];
+ #fmove{} -> [fmove_src(I)];
+ #fp{} -> [fp_src1(I), fp_src2(I)];
+ #fp_unop{} -> [fp_unop_src(I)];
+ #fstore{} -> [fstore_base(I), fstore_offset(I), fstore_src(I)];
+ #goto{} -> [];
+ #goto_index{} -> [];
+ #gctest{} -> [gctest_words(I)];
+ #label{} -> [];
+ #load{} -> [load_src(I), load_offset(I)];
+ #load_address{} -> [];
+ #load_atom{} -> [];
+ #load_word_index{} -> [];
+ #move{} -> [move_src(I)];
+ #multimove{} -> multimove_srclist(I);
+ #phi{} -> phi_args(I);
+ #return{} -> return_varlist(I) ++ hipe_rtl_arch:return_used();
+ #store{} -> [store_base(I), store_offset(I), store_src(I)];
+ #switch{} -> [switch_src(I)]
+ end.
+
+%%
+%% @doc Returns a list of variables that an RTL instruction defines.
+%%
+
+defines(Instr) ->
+ Defs = case Instr of
+ #alu{} -> [alu_dst(Instr)];
+ #alub{} -> [alub_dst(Instr)];
+ #branch{} -> [];
+ #call{} -> call_dstlist(Instr) ++ hipe_rtl_arch:call_defined();
+ #comment{} -> [];
+ #enter{} -> [];
+ #fconv{} -> [fconv_dst(Instr)];
+ #fixnumop{} -> [fixnumop_dst(Instr)];
+ #fload{} -> [fload_dst(Instr)];
+ #fmove{} -> [fmove_dst(Instr)];
+ #fp{} -> [fp_dst(Instr)];
+ #fp_unop{} -> [fp_unop_dst(Instr)];
+ #fstore{} -> [];
+ #gctest{} -> [];
+ #goto{} -> [];
+ #goto_index{} -> [];
+ #label{} -> [];
+ #load{} -> [load_dst(Instr)];
+ #load_address{} -> [load_address_dst(Instr)];
+ #load_atom{} -> [load_atom_dst(Instr)];
+ #load_word_index{} -> [load_word_index_dst(Instr)];
+ #move{} -> [move_dst(Instr)];
+ #multimove{} -> multimove_dstlist(Instr);
+ #phi{} -> [phi_dst(Instr)];
+ #return{} -> [];
+ #store{} -> [];
+ #switch{} -> []
+ end,
+ remove_imms_and_const_lbls(Defs).
+
+%% @spec remove_imms_and_const_lbls([rtl_argument()]) -> [rtl_argument()]
+%%
+%% @doc Removes all RTL immediates and constant labels from a list of arguments.
+
+remove_imms_and_const_lbls([]) ->
+ [];
+remove_imms_and_const_lbls([Arg|Args]) ->
+ case is_imm(Arg) orelse is_const_label(Arg) of
+ true -> remove_imms_and_const_lbls(Args);
+ false -> [Arg | remove_imms_and_const_lbls(Args)]
+ end.
+
+%%
+%% Substitution: replace occurrences of X by Y if {X,Y} is in Subst.
+%%
+%% subst(Subst, X) ->
+%% subst_defines(Subst, subst_uses(Subst,X)).
+
+subst_uses(Subst, I) ->
+ case I of
+ #alu{} ->
+ I0 = alu_src1_update(I, subst1(Subst, alu_src1(I))),
+ alu_src2_update(I0, subst1(Subst, alu_src2(I)));
+ #alub{} ->
+ I0 = alub_src1_update(I, subst1(Subst, alub_src1(I))),
+ alub_src2_update(I0, subst1(Subst, alub_src2(I)));
+ #branch{} ->
+ I0 = branch_src1_update(I, subst1(Subst, branch_src1(I))),
+ branch_src2_update(I0, subst1(Subst, branch_src2(I)));
+ #call{} ->
+ case call_is_known(I) of
+ false ->
+ I0 = call_fun_update(I, subst1(Subst, call_fun(I))),
+ call_arglist_update(I0, subst_list(Subst, call_arglist(I0)));
+ true ->
+ call_arglist_update(I, subst_list(Subst, call_arglist(I)))
+ end;
+ #comment{} ->
+ I;
+ #enter{} ->
+ case enter_is_known(I) of
+ false ->
+ I0 = enter_fun_update(I, subst1(Subst, enter_fun(I))),
+ enter_arglist_update(I0, subst_list(Subst, enter_arglist(I0)));
+ true ->
+ enter_arglist_update(I, subst_list(Subst, enter_arglist(I)))
+ end;
+ #fconv{} ->
+ fconv_src_update(I, subst1(Subst, fconv_src(I)));
+ #fixnumop{} ->
+ fixnumop_src_update(I, subst1(Subst, fixnumop_src(I)));
+ #fload{} ->
+ I0 = fload_src_update(I, subst1(Subst, fload_src(I))),
+ fload_offset_update(I0, subst1(Subst, fload_offset(I)));
+ #fmove{} ->
+ fmove_src_update(I, subst1(Subst, fmove_src(I)));
+ #fp{} ->
+ I0 = fp_src1_update(I, subst1(Subst, fp_src1(I))),
+ fp_src2_update(I0, subst1(Subst, fp_src2(I)));
+ #fp_unop{} ->
+ fp_unop_src_update(I, subst1(Subst, fp_unop_src(I)));
+ #fstore{} ->
+ I0 = fstore_src_update(I, subst1(Subst, fstore_src(I))),
+ I1 = fstore_base_update(I0, subst1(Subst, fstore_base(I))),
+ fstore_offset_update(I1, subst1(Subst, fstore_offset(I)));
+ #goto{} ->
+ I;
+ #goto_index{} ->
+ I;
+ #gctest{} ->
+ gctest_words_update(I, subst1(Subst, gctest_words(I)));
+ #label{} ->
+ I;
+ #load{} ->
+ I0 = load_src_update(I, subst1(Subst, load_src(I))),
+ load_offset_update(I0, subst1(Subst, load_offset(I)));
+ #load_address{} ->
+ I;
+ #load_atom{} ->
+ I;
+ #load_word_index{} ->
+ I;
+ #move{} ->
+ move_src_update(I, subst1(Subst, move_src(I)));
+ #multimove{} ->
+ multimove_srclist_update(I, subst_list(Subst, multimove_srclist(I)));
+ #phi{} ->
+ phi_argvar_subst(I, Subst);
+ #return{} ->
+ return_varlist_update(I, subst_list(Subst, return_varlist(I)));
+ #store{} ->
+ I0 = store_src_update(I, subst1(Subst, store_src(I))),
+ I1 = store_base_update(I0, subst1(Subst, store_base(I))),
+ store_offset_update(I1, subst1(Subst, store_offset(I)));
+ #switch{} ->
+ switch_src_update(I, subst1(Subst, switch_src(I)))
+ end.
+
+subst_defines(Subst, I)->
+ case I of
+ #alu{} ->
+ alu_dst_update(I, subst1(Subst, alu_dst(I)));
+ #alub{} ->
+ alub_dst_update(I, subst1(Subst, alub_dst(I)));
+ #branch{} ->
+ I;
+ #call{} ->
+ call_dstlist_update(I, subst_list(Subst, call_dstlist(I)));
+ #comment{} ->
+ I;
+ #enter{} ->
+ I;
+ #fconv{} ->
+ fconv_dst_update(I, subst1(Subst, fconv_dst(I)));
+ #fixnumop{} ->
+ fixnumop_dst_update(I, subst1(Subst, fixnumop_dst(I)));
+ #fload{} ->
+ fload_dst_update(I, subst1(Subst, fload_dst(I)));
+ #fmove{} ->
+ fmove_dst_update(I, subst1(Subst, fmove_dst(I)));
+ #fp{} ->
+ fp_dst_update(I, subst1(Subst, fp_dst(I)));
+ #fp_unop{} ->
+ fp_unop_dst_update(I, subst1(Subst, fp_unop_dst(I)));
+ #fstore{} ->
+ I;
+ #gctest{} ->
+ I;
+ #goto{} ->
+ I;
+ #goto_index{} ->
+ I;
+ #label{} ->
+ I;
+ #load{} ->
+ load_dst_update(I, subst1(Subst, load_dst(I)));
+ #load_address{} ->
+ load_address_dst_update(I, subst1(Subst, load_address_dst(I)));
+ #load_atom{} ->
+ load_atom_dst_update(I, subst1(Subst, load_atom_dst(I)));
+ #load_word_index{} ->
+ load_word_index_dst_update(I, subst1(Subst, load_word_index_dst(I)));
+ #move{} ->
+ move_dst_update(I, subst1(Subst, move_dst(I)));
+ #multimove{} ->
+ multimove_dstlist_update(I, subst_list(Subst, multimove_dstlist(I)));
+ #phi{} ->
+ phi_dst_update(I, subst1(Subst, phi_dst(I)));
+ #return{} ->
+ I;
+ #store{} ->
+ I;
+ #switch{} ->
+ I
+ end.
+
+subst_list(S, Xs) ->
+ [subst1(S, X) || X <- Xs].
+
+subst1([], X) -> X;
+subst1([{X,Y}|_], X) -> Y;
+subst1([_|Xs], X) -> subst1(Xs,X).
+
+%% @spec is_safe(rtl_instruction()) -> boolean()
+%%
+%% @doc Succeeds if an RTL instruction is safe and can be deleted if the
+%% result is not used.
+
+is_safe(Instr) ->
+ case Instr of
+ #alu{} -> true;
+ #alub{} -> false;
+ #branch{} -> false;
+ #call{} -> false;
+ #comment{} -> false;
+ #enter{} -> false;
+ #fconv{} -> true;
+ #fixnumop{} -> true;
+ #fload{} -> true;
+ #fmove{} -> true;
+ #fp{} -> false;
+ #fp_unop{} -> false;
+ #fstore{} -> false;
+ #gctest{} -> false;
+ #goto{} -> false;
+ #goto_index{} -> false; % ???
+ #label{} -> true;
+ #load{} -> true;
+ #load_address{} -> true;
+ #load_atom{} -> true;
+ #load_word_index{} -> true;
+ #move{} -> true;
+ #multimove{} -> true;
+ #phi{} -> true;
+ #return{} -> false;
+ #store{} -> false;
+ #switch{} -> false %% Maybe this is safe...
+ end.
+
+%%
+%% True if argument is an alu-operator
+%%
+
+%% is_alu_op(add) -> true;
+%% is_alu_op(sub) -> true;
+%% is_alu_op('or') -> true;
+%% is_alu_op('and') -> true;
+%% is_alu_op('xor') -> true;
+%% is_alu_op(andnot) -> true;
+%% is_alu_op(sll) -> true;
+%% is_alu_op(srl) -> true;
+%% is_alu_op(sra) -> true;
+%% is_alu_op(_) -> false.
+
+%% @spec is_shift_op(rtl_operator()) -> boolean()
+%%
+%% @doc Succeeds if its argument is an RTL operator.
+is_shift_op(sll) -> true;
+is_shift_op(srl) -> true;
+is_shift_op(sra) -> true;
+is_shift_op(_) -> false.
+
+
+%%
+%% True if argument is an relational operator
+%%
+
+%% is_rel_op(eq) -> true;
+%% is_rel_op(ne) -> true;
+%% is_rel_op(gt) -> true;
+%% is_rel_op(gtu) -> true;
+%% is_rel_op(ge) -> true;
+%% is_rel_op(geu) -> true;
+%% is_rel_op(lt) -> true;
+%% is_rel_op(ltu) -> true;
+%% is_rel_op(le) -> true;
+%% is_rel_op(leu) -> true;
+%% is_rel_op(overflow) -> true;
+%% is_rel_op(not_overflow) -> true;
+%% is_rel_op(_) -> false.
+
+redirect_jmp(Jmp, ToOld, ToNew) ->
+ %% OBS: In a jmp instruction more than one labels may be identical
+ %% and thus need redirection!
+ case Jmp of
+ #branch{} ->
+ TmpJmp = case branch_true_label(Jmp) of
+ ToOld -> branch_true_label_update(Jmp, ToNew);
+ _ -> Jmp
+ end,
+ case branch_false_label(TmpJmp) of
+ ToOld ->
+ branch_false_label_update(TmpJmp, ToNew);
+ _ ->
+ TmpJmp
+ end;
+ #switch{} ->
+ NewLbls = [case Lbl =:= ToOld of
+ true -> ToNew;
+ false -> Lbl
+ end || Lbl <- switch_labels(Jmp)],
+ switch_labels_update(Jmp, NewLbls);
+ #alub{} ->
+ TmpJmp = case alub_true_label(Jmp) of
+ ToOld -> alub_true_label_update(Jmp, ToNew);
+ _ -> Jmp
+ end,
+ case alub_false_label(TmpJmp) of
+ ToOld -> alub_false_label_update(TmpJmp, ToNew);
+ _ -> TmpJmp
+ end;
+ #goto{} ->
+ case goto_label(Jmp) of
+ ToOld -> goto_label_update(Jmp, ToNew);
+ _ -> Jmp
+ end;
+ #call{} ->
+ TmpJmp = case call_continuation(Jmp) of
+ ToOld -> call_continuation_update(Jmp, ToNew);
+ _ -> Jmp
+ end,
+ case call_fail(TmpJmp) of
+ ToOld -> call_fail_update(TmpJmp, ToNew);
+ _ -> TmpJmp
+ end;
+ _ ->
+ Jmp
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% highest_var(Code) ->
+%% highest_var(Code,0).
+%%
+%% highest_var([I|Is],Max) ->
+%% Defs = defines(I),
+%% Uses = uses(I),
+%% highest_var(Is,new_max(Defs++Uses,Max));
+%% highest_var([],Max) ->
+%% Max.
+%%
+%% new_max([V|Vs],Max) ->
+%% VName =
+%% case is_var(V) of
+%% true ->
+%% var_index(V);
+%% false ->
+%% case is_fpreg(V) of
+%% true ->
+%% fpreg_index(V);
+%% _ ->
+%% reg_index(V)
+%% end
+%% end,
+%% if VName > Max ->
+%% new_max(Vs, VName);
+%% true ->
+%% new_max(Vs, Max)
+%% end;
+%% new_max([],Max) ->
+%% Max.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% @doc Pretty-printer for RTL.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+pp(Rtl) ->
+ pp(standard_io, Rtl).
+
+pp_block(Instrs) ->
+ pp_instrs(standard_io, Instrs).
+
+pp(Dev, Rtl) ->
+ io:format(Dev, "~w(", [rtl_fun(Rtl)]),
+ pp_args(Dev, rtl_params(Rtl)),
+ io:format(Dev, ") ->~n", []),
+ case rtl_is_closure(Rtl) of
+ true ->
+ io:format(Dev, ";; Closure\n", []);
+ false -> ok
+ end,
+ case rtl_is_leaf(Rtl) of
+ true ->
+ io:format(Dev, ";; Leaf function\n", []);
+ false -> ok
+ end,
+ io:format(Dev, ";; Info: ~w\n", [rtl_info(Rtl)]),
+ io:format(Dev, ".DataSegment\n", []),
+ hipe_data_pp:pp(Dev, rtl_data(Rtl), rtl, ""),
+ io:format(Dev, ".CodeSegment\n", []),
+ pp_instrs(Dev, rtl_code(Rtl)).
+
+pp_instrs(_Dev, []) ->
+ ok;
+pp_instrs(Dev, [I|Is]) ->
+ try pp_instr(Dev, I)
+ catch _:_ -> io:format("*** ~w ***\n", [I])
+ end,
+ pp_instrs(Dev, Is).
+
+pp_instr(Dev, I) ->
+ case I of
+ #phi{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, phi_dst(I)),
+ io:format(Dev, " <- phi(", []),
+ pp_phi_args(Dev, phi_arglist(I)),
+ io:format(Dev, ")~n", []);
+ #move{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, move_dst(I)),
+ io:format(Dev, " <- ", []),
+ pp_arg(Dev, move_src(I)),
+ io:format(Dev, "~n", []);
+ #multimove{} ->
+ io:format(Dev, " ", []),
+ pp_args(Dev, multimove_dstlist(I)),
+ io:format(Dev, " <= ", []),
+ pp_args(Dev, multimove_srclist(I)),
+ io:format(Dev, "~n", []);
+ #alu{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, alu_dst(I)),
+ io:format(Dev, " <- ", []),
+ pp_arg(Dev, alu_src1(I)),
+ io:format(Dev, " ~w ", [alu_op(I)]),
+ pp_arg(Dev, alu_src2(I)),
+ io:format(Dev, "~n", []);
+ #load{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, load_dst(I)),
+ io:format(Dev, " <- [", []),
+ pp_arg(Dev, load_src(I)),
+ io:format(Dev, "+", []),
+ pp_arg(Dev, load_offset(I)),
+ io:format(Dev, "]", []),
+ case load_sign(I) of
+ signed -> io:format(Dev, " -signed",[]);
+ _ -> ok
+ end,
+ case load_size(I) of
+ byte -> io:format(Dev, " -byte",[]);
+ int16 -> io:format(Dev, " -int16",[]);
+ int32 -> io:format(Dev, " -int32",[]);
+ _ -> ok
+ end,
+ io:format(Dev, "~n", []);
+ #load_atom{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, load_atom_dst(I)),
+ io:format(Dev, " <- atom_no(\'~s\')~n", [load_atom_atom(I)]);
+ #load_word_index{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, load_word_index_dst(I)),
+ io:format(Dev, " <- word_index_no( DL~p[~p] )~n",
+ [load_word_index_block(I),load_word_index_index(I)]);
+ #goto_index{} ->
+ io:format(Dev, " ", []),
+ io:format(Dev, "goto_index DL~p[~p]~n",
+ [goto_index_block(I), goto_index_index(I)]);
+ #load_address{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, load_address_dst(I)),
+ case load_address_type(I) of
+ constant ->
+ io:format(Dev, " <- DL~p~n", [load_address_addr(I)]);
+ closure ->
+ io:format(Dev, " <- L~p [closure]~n", [load_address_addr(I)]);
+ Type ->
+ io:format(Dev, " <- L~p [~p]~n", [load_address_addr(I),Type])
+ end;
+ #store{} ->
+ io:format(Dev, " [", []),
+ pp_arg(Dev, store_base(I)),
+ io:format(Dev, "+", []),
+ pp_arg(Dev, store_offset(I)),
+ io:format(Dev, "] <- ", []),
+ pp_arg(Dev, store_src(I)),
+ case store_size(I) of
+ byte -> io:format(Dev, " -byte",[]);
+ int16 -> io:format(Dev, " -int16",[]);
+ int32 -> io:format(Dev, " -int32",[]);
+ _ -> ok
+ end,
+ io:format(Dev, "~n", []);
+ #label{} ->
+ io:format(Dev, "L~w:~n", [label_name(I)]);
+ #branch{} ->
+ io:format(Dev, " if (", []),
+ pp_arg(Dev, branch_src1(I)),
+ io:format(Dev, " ~w ", [branch_cond(I)]),
+ pp_arg(Dev, branch_src2(I)),
+ io:format(Dev, ") then L~w (~.2f) else L~w~n",
+ [branch_true_label(I), branch_pred(I), branch_false_label(I)]);
+ #switch{} ->
+ io:format(Dev, " switch (", []),
+ pp_arg(Dev, switch_src(I)),
+ io:format(Dev, ") <", []),
+ pp_switch_labels(Dev, switch_labels(I)),
+ io:format(Dev, ">\n", []);
+ #alub{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, alub_dst(I)),
+ io:format(Dev, " <- ", []),
+ pp_arg(Dev, alub_src1(I)),
+ io:format(Dev, " ~w ", [alub_op(I)]),
+ pp_arg(Dev, alub_src2(I)),
+ io:format(Dev, " if",[]),
+ io:format(Dev, " ~w ", [alub_cond(I)]),
+ io:format(Dev, "then L~w (~.2f) else L~w~n",
+ [alub_true_label(I), alub_pred(I), alub_false_label(I)]);
+ #goto{} ->
+ io:format(Dev, " goto L~w~n", [goto_label(I)]);
+ #call{} ->
+ io:format(Dev, " ", []),
+ pp_args(Dev, call_dstlist(I)),
+ io:format(Dev, " <- ", []),
+ case call_is_known(I) of
+ true ->
+ case call_fun(I) of
+ F when is_atom(F) ->
+ io:format(Dev, "~w(", [F]);
+ {M,F,A} when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
+ io:format(Dev, "~w:~w(", [M, F]);
+ {F,A} when is_atom(F), is_integer(A), A >=0 ->
+ io:format(Dev, "~w(", [F])
+ end;
+ false ->
+ io:format(Dev, "(",[]),
+ pp_arg(Dev, call_fun(I)),
+ io:format(Dev, ")(",[])
+ end,
+ pp_args(Dev, call_arglist(I)),
+ io:format(Dev, ")", []),
+ case call_continuation(I) of
+ [] -> true;
+ CC ->
+ io:format(Dev, " then L~w", [CC])
+ end,
+ case call_fail(I) of
+ [] -> true;
+ L ->
+ io:format(Dev, " fail to L~w", [L])
+ end,
+ io:format(Dev, "~n", []);
+ #enter{} ->
+ io:format(Dev, " ", []),
+ case enter_is_known(I) of
+ true ->
+ case enter_fun(I) of
+ F when is_atom(F) ->
+ io:format(Dev, "~w(", [F]);
+ {M,F,A} when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
+ io:format(Dev, "~w:~w(", [M, F]);
+ {F,A} when is_atom(F), is_integer(A), A >= 0 ->
+ io:format(Dev, "~w(", [F])
+ end;
+ false ->
+ io:format(Dev, "(",[]),
+ pp_arg(Dev, enter_fun(I)),
+ io:format(Dev, ")(",[])
+ end,
+ pp_args(Dev, enter_arglist(I)),
+ io:format(Dev, ")~n", []);
+ #return{} ->
+ io:format(Dev, " return(", []),
+ pp_args(Dev, return_varlist(I)),
+ io:format(Dev, ")~n", []);
+ #comment{} ->
+ io:format(Dev, " ;; ~p~n", [comment_text(I)]);
+ #fixnumop{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, fixnumop_dst(I)),
+ io:format(Dev, " <- ", []),
+ case fixnumop_type(I) of
+ tag ->
+ io:format(Dev, "fixnum_tag(", []);
+ untag ->
+ io:format(Dev, "fixnum_untag(", [])
+ end,
+ pp_arg(Dev, fixnumop_src(I)),
+ io:format(Dev, ")~n", []);
+ #gctest{} ->
+ io:format(Dev, " gctest(", []),
+ pp_arg(Dev, gctest_words(I)),
+ io:format(Dev, ")~n", []);
+ %% Floating point handling instructions below
+ #fload{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, fload_dst(I)),
+ io:format(Dev, " <-f [", []),
+ pp_arg(Dev, fload_src(I)),
+ io:format(Dev, "+", []),
+ pp_arg(Dev, fload_offset(I)),
+ io:format(Dev, "]~n", []);
+ #fstore{} ->
+ io:format(Dev, " [", []),
+ pp_arg(Dev, fstore_base(I)),
+ io:format(Dev, "+", []),
+ pp_arg(Dev, fstore_offset(I)),
+ io:format(Dev, "] <- ", []),
+ pp_arg(Dev, fstore_src(I)),
+ io:format(Dev, "~n", []);
+ #fp{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, fp_dst(I)),
+ io:format(Dev, " <- ", []),
+ pp_arg(Dev, fp_src1(I)),
+ io:format(Dev, " ~w ", [fp_op(I)]),
+ pp_arg(Dev, fp_src2(I)),
+ io:format(Dev, "~n", []);
+ #fp_unop{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, fp_unop_dst(I)),
+ io:format(Dev, " <- ", []),
+ io:format(Dev, " ~w ", [fp_unop_op(I)]),
+ pp_arg(Dev, fp_unop_src(I)),
+ io:format(Dev, "~n", []);
+ #fmove{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, fmove_dst(I)),
+ io:format(Dev, " <- ", []),
+ pp_arg(Dev, fmove_src(I)),
+ io:format(Dev, "~n", []);
+ #fconv{} ->
+ io:format(Dev, " ", []),
+ pp_arg(Dev, fconv_dst(I)),
+ io:format(Dev, " <-fconv ", []),
+ pp_arg(Dev, fconv_src(I)),
+ io:format(Dev, "~n", []);
+ Other ->
+ exit({?MODULE,pp_instr,{"unknown RTL instruction",Other}})
+ end.
+
+pp_args(_Dev, []) ->
+ ok;
+pp_args(Dev, [A]) ->
+ pp_arg(Dev, A);
+pp_args(Dev, [A|As]) ->
+ pp_arg(Dev, A),
+ io:format(Dev, ", ", []),
+ pp_args(Dev, As).
+
+pp_phi_args(_Dev, []) -> ok;
+pp_phi_args(Dev, [{Pred,A}]) ->
+ io:format(Dev, "{~w, ", [Pred]),
+ pp_arg(Dev, A),
+ io:format(Dev, "}", []);
+pp_phi_args(Dev, [{Pred,A}|Args]) ->
+ io:format(Dev, "{~w, ", [Pred]),
+ pp_arg(Dev, A),
+ io:format(Dev, "}, ", []),
+ pp_phi_args(Dev, Args);
+pp_phi_args(Dev, Args) ->
+ pp_args(Dev, Args).
+
+pp_hard_reg(Dev, N) ->
+ io:format(Dev, "~s", [hipe_rtl_arch:reg_name(N)]).
+
+pp_reg(Dev, Arg) ->
+ case hipe_rtl_arch:is_precoloured(Arg) of
+ true ->
+ pp_hard_reg(Dev, reg_index(Arg));
+ false ->
+ io:format(Dev, "r~w", [reg_index(Arg)])
+ end.
+
+pp_var(Dev, Arg) ->
+ case hipe_rtl_arch:is_precoloured(Arg) of
+ true ->
+ pp_hard_reg(Dev, var_index(Arg));
+ false ->
+ io:format(Dev, "v~w", [var_index(Arg)])
+ end.
+
+pp_arg(Dev, A) ->
+ case is_var(A) of
+ true ->
+ pp_var(Dev, A);
+ false ->
+ case is_reg(A) of
+ true ->
+ pp_reg(Dev, A);
+ false ->
+ case is_imm(A) of
+ true ->
+ io:format(Dev, "~w", [imm_value(A)]);
+ false ->
+ case is_fpreg(A) of
+ true ->
+ io:format(Dev, "f~w", [fpreg_index(A)]);
+ false ->
+ case is_const_label(A) of
+ true ->
+ io:format(Dev, "DL~w", [const_label_label(A)]);
+ false ->
+ exit({?MODULE,pp_arg,{"bad RTL arg",A}})
+ end
+ end
+ end
+ end
+ end.
+
+pp_switch_labels(Dev,Lbls) ->
+ pp_switch_labels(Dev,Lbls,1).
+
+pp_switch_labels(Dev, [L], _Pos) ->
+ io:format(Dev, "L~w", [L]);
+pp_switch_labels(Dev, [L|Ls], Pos) ->
+ io:format(Dev, "L~w, ", [L]),
+ NewPos =
+ case Pos of
+ 5 -> io:format(Dev, "\n ",[]),
+ 0;
+ N -> N + 1
+ end,
+ pp_switch_labels(Dev, Ls, NewPos);
+pp_switch_labels(_Dev, [], _) ->
+ ok.
diff --git a/lib/hipe/rtl/hipe_rtl.hrl b/lib/hipe/rtl/hipe_rtl.hrl
new file mode 100644
index 0000000000..974e40f830
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl.hrl
@@ -0,0 +1,61 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Provides abstract datatypes for HiPE's RTL (Register Transfer Language).
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%---------------------------------------------------------------------
+
+-record(alu, {dst, src1, op, src2}).
+-record(alub, {dst, src1, op, src2, 'cond', true_label, false_label, p}).
+-record(branch, {src1, src2, 'cond', true_label, false_label, p}).
+-record(call, {dstlist, 'fun', arglist, type, continuation, failcontinuation}).
+-record(comment, {text}).
+-record(enter, {'fun', arglist, type}).
+-record(fconv, {dst, src}).
+-record(fixnumop, {dst, src, type}).
+-record(fload, {dst, src, offset}).
+-record(fmove, {dst, src}).
+-record(fp, {dst, src1, op, src2}).
+-record(fp_unop, {dst, src, op}).
+-record(fstore, {base, offset, src}).
+-record(gctest, {words}).
+-record(goto, {label}).
+-record(goto_index, {block, index, labels}).
+-record(label, {name}).
+-record(load, {dst, src, offset, size, sign}).
+-record(load_address, {dst, addr, type}).
+-record(load_atom, {dst, atom}).
+-record(load_word_index, {dst, block, index}).
+-record(move, {dst, src}).
+-record(multimove, {dstlist, srclist}).
+-record(phi, {dst, id, arglist}).
+-record(return, {varlist}).
+-record(store, {base, offset, src, size}).
+-record(switch, {src, labels, sorted_by=[]}).
+
+%%---------------------------------------------------------------------
+
+%% An efficient macro to convert byte sizes to bit sizes
+-define(bytes_to_bits(Bytes), ((Bytes) bsl 3)). % (N * 8)
+
+%%---------------------------------------------------------------------
diff --git a/lib/hipe/rtl/hipe_rtl_arch.erl b/lib/hipe/rtl/hipe_rtl_arch.erl
new file mode 100644
index 0000000000..2afdf4eb6b
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_arch.erl
@@ -0,0 +1,612 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson.
+%%=====================================================================
+%% Filename : hipe_rtl_arch.erl
+%% History : * 2001-04-10 Erik Johansson (happi@it.uu.se): Created.
+%%=====================================================================
+%% @doc
+%%
+%% This module contains interface functions whose semantics and
+%% implementation depend on the target architecture.
+%%
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_arch).
+
+-export([first_virtual_reg/0,
+ heap_pointer/0,
+ heap_limit/0,
+ fcalls/0,
+ reg_name/1,
+ is_precoloured/1,
+ call_defined/0,
+ call_used/0,
+ tailcall_used/0,
+ return_used/0,
+ live_at_return/0,
+ endianess/0,
+ load_big_2/4,
+ load_little_2/4,
+ load_big_4/4,
+ load_little_4/4,
+ %% store_4/3,
+ eval_alu/3,
+ %% eval_alub/4,
+ eval_cond/3,
+ eval_cond_bits/5,
+ fwait/0,
+ handle_fp_exception/0,
+ pcb_load/2,
+ pcb_load/3,
+ pcb_store/2,
+ pcb_store/3,
+ pcb_address/2,
+ call_bif/5,
+ %% alignment/0,
+ nr_of_return_regs/0,
+ log2_word_size/0,
+ word_size/0
+ ]).
+
+-include("hipe_literals.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% ____________________________________________________________________
+%%
+%% ARCH-specific stuff
+%% ____________________________________________________________________
+%%
+%%
+%% XXX: x86 might not _have_ real registers for some of these things
+%%
+
+first_virtual_reg() ->
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ hipe_sparc_registers:first_virtual();
+ powerpc ->
+ hipe_ppc_registers:first_virtual();
+ arm ->
+ hipe_arm_registers:first_virtual();
+ x86 ->
+ hipe_x86_registers:first_virtual();
+ amd64 ->
+ hipe_amd64_registers:first_virtual()
+ end.
+
+heap_pointer() -> % {GetHPInsn, HPReg, PutHPInsn}
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ heap_pointer_from_reg(hipe_sparc_registers:heap_pointer());
+ powerpc ->
+ heap_pointer_from_reg(hipe_ppc_registers:heap_pointer());
+ arm ->
+ heap_pointer_from_reg(hipe_arm_registers:heap_pointer());
+ x86 ->
+ x86_heap_pointer();
+ amd64 ->
+ amd64_heap_pointer()
+ end.
+
+heap_pointer_from_reg(Reg) ->
+ {hipe_rtl:mk_comment('get_heap_pointer'),
+ hipe_rtl:mk_reg(Reg),
+ hipe_rtl:mk_comment('put_heap_pointer')}.
+
+-ifdef(AMD64_HP_IN_REGISTER).
+amd64_heap_pointer() ->
+ heap_pointer_from_reg(hipe_amd64_registers:heap_pointer()).
+-else.
+-define(HEAP_POINTER_FROM_PCB_NEEDED,1).
+amd64_heap_pointer() ->
+ heap_pointer_from_pcb().
+-endif.
+
+-ifdef(X86_HP_IN_ESI).
+x86_heap_pointer() ->
+ heap_pointer_from_reg(hipe_x86_registers:heap_pointer()).
+-else.
+-define(HEAP_POINTER_FROM_PCB_NEEDED,1).
+x86_heap_pointer() ->
+ heap_pointer_from_pcb().
+-endif.
+
+-ifdef(HEAP_POINTER_FROM_PCB_NEEDED).
+heap_pointer_from_pcb() ->
+ Reg = hipe_rtl:mk_new_reg(),
+ {pcb_load(Reg, ?P_HP), Reg, pcb_store(?P_HP, Reg)}.
+-endif.
+
+heap_limit() -> % {GetHLIMITInsn, HLIMITReg}
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ heap_limit_from_pcb();
+ powerpc ->
+ heap_limit_from_pcb();
+ arm ->
+ heap_limit_from_pcb();
+ x86 ->
+ heap_limit_from_reg(hipe_x86_registers:heap_limit());
+ amd64 ->
+ heap_limit_from_reg(hipe_amd64_registers:heap_limit())
+ end.
+
+heap_limit_from_reg(Reg) ->
+ {hipe_rtl:mk_comment('get_heap_limit'),
+ hipe_rtl:mk_reg(Reg)}.
+
+heap_limit_from_pcb() ->
+ Reg = hipe_rtl:mk_new_reg(),
+ {pcb_load(Reg, ?P_HP_LIMIT), Reg}.
+
+fcalls() -> % {GetFCallsInsn, FCallsReg, PutFCallsInsn}
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ fcalls_from_pcb();
+ powerpc ->
+ fcalls_from_pcb();
+ arm ->
+ fcalls_from_pcb();
+ x86 ->
+ fcalls_from_reg(hipe_x86_registers:fcalls());
+ amd64 ->
+ fcalls_from_reg(hipe_amd64_registers:fcalls())
+ end.
+
+fcalls_from_reg(Reg) ->
+ {hipe_rtl:mk_comment('get_fcalls'),
+ hipe_rtl:mk_reg(Reg),
+ hipe_rtl:mk_comment('put_fcalls')}.
+
+fcalls_from_pcb() ->
+ Reg = hipe_rtl:mk_new_reg(),
+ {pcb_load(Reg, ?P_FCALLS), Reg, pcb_store(?P_FCALLS, Reg)}.
+
+reg_name(Reg) ->
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ hipe_sparc_registers:reg_name_gpr(Reg);
+ powerpc ->
+ hipe_ppc_registers:reg_name_gpr(Reg);
+ arm ->
+ hipe_arm_registers:reg_name_gpr(Reg);
+ x86 ->
+ hipe_x86_registers:reg_name(Reg);
+ amd64 ->
+ hipe_amd64_registers:reg_name(Reg)
+ end.
+
+%% @spec is_precoloured(rtl_arg()) -> boolean()
+%%
+%% @doc Succeeds if Arg is mapped to a precoloured register in the target.
+%%
+is_precoloured(Arg) ->
+ case hipe_rtl:is_reg(Arg) of
+ true ->
+ is_precolored_regnum(hipe_rtl:reg_index(Arg));
+ false ->
+ hipe_rtl:is_var(Arg) andalso
+ is_precolored_regnum(hipe_rtl:var_index(Arg))
+ end.
+
+is_precolored_regnum(RegNum) ->
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ hipe_sparc_registers:is_precoloured_gpr(RegNum);
+ powerpc ->
+ hipe_ppc_registers:is_precoloured_gpr(RegNum);
+ arm ->
+ hipe_arm_registers:is_precoloured_gpr(RegNum);
+ x86 ->
+ hipe_x86_registers:is_precoloured(RegNum);
+ amd64 ->
+ hipe_amd64_registers:is_precoloured(RegNum)
+ end.
+
+call_defined() ->
+ call_used().
+
+call_used() ->
+ live_at_return().
+
+tailcall_used() ->
+ call_used().
+
+return_used() ->
+ tailcall_used().
+
+live_at_return() ->
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ ordsets:from_list([hipe_rtl:mk_reg(R)
+ || {R,_} <- hipe_sparc_registers:live_at_return()]);
+ powerpc ->
+ ordsets:from_list([hipe_rtl:mk_reg(R)
+ || {R,_} <- hipe_ppc_registers:live_at_return()]);
+ arm ->
+ ordsets:from_list([hipe_rtl:mk_reg(R)
+ || {R,_} <- hipe_arm_registers:live_at_return()]);
+ x86 ->
+ ordsets:from_list([hipe_rtl:mk_reg(R)
+ || {R,_} <- hipe_x86_registers:live_at_return()]);
+ amd64 ->
+ ordsets:from_list([hipe_rtl:mk_reg(R)
+ || {R,_} <- hipe_amd64_registers:live_at_return()])
+ end.
+
+%% @spec word_size() -> integer()
+%%
+%% @doc Returns the target's word size.
+%%
+word_size() ->
+ case get(hipe_target_arch) of
+ ultrasparc -> 4;
+ powerpc -> 4;
+ arm -> 4;
+ x86 -> 4;
+ amd64 -> 8
+ end.
+
+%% alignment() ->
+%% case get(hipe_target_arch) of
+%% ultrasparc -> 4;
+%% powerpc -> 4;
+%% arm -> 4;
+%% x86 -> 4;
+%% amd64 -> 8
+%% end.
+
+%% @spec log2_word_size() -> integer()
+%%
+%% @doc Returns log2 of the target's word size.
+%%
+log2_word_size() ->
+ case get(hipe_target_arch) of
+ ultrasparc -> 2;
+ powerpc -> 2;
+ arm -> 2;
+ x86 -> 2;
+ amd64 -> 3
+ end.
+
+%% @spec endianess() -> big | little
+%%
+%% @doc Returns the target's endianess.
+%%
+endianess() ->
+ case get(hipe_target_arch) of
+ ultrasparc -> big;
+ powerpc -> big;
+ x86 -> little;
+ amd64 -> little;
+ arm -> ?ARM_ENDIANESS
+ end.
+
+%%%------------------------------------------------------------------------
+%%% Reading integers from binaries, in various sizes and endianesses.
+%%% Operand-sized alignment is NOT guaranteed, only byte alignment.
+%%%------------------------------------------------------------------------
+
+%%% Load a 2-byte big-endian integer from a binary.
+%%% Increment Offset by 2.
+load_big_2(Dst, Base, Offset, Signedness) ->
+ case get(hipe_target_arch) of
+ powerpc ->
+ load_2_directly(Dst, Base, Offset, Signedness);
+ %% Note: x86 could use a "load;xchgb" or "load;rol $8,<16-bit reg>"
+ %% sequence here. This has been implemented, but unfortunately didn't
+ %% make consistent improvements to our benchmarks.
+ _ ->
+ load_big_2_in_pieces(Dst, Base, Offset, Signedness)
+ end.
+
+%%% Load a 2-byte little-endian integer from a binary.
+%%% Increment Offset by 2.
+load_little_2(Dst, Base, Offset, Signedness) ->
+ case get(hipe_target_arch) of
+ x86 ->
+ load_2_directly(Dst, Base, Offset, Signedness);
+ powerpc ->
+ [hipe_rtl:mk_call([Dst], 'lhbrx', [Base,Offset], [], [], not_remote),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(2)) |
+ case Signedness of
+ unsigned -> [];
+ signed -> [hipe_rtl:mk_call([Dst], 'extsh', [Dst], [], [], not_remote)]
+ end];
+ _ ->
+ load_little_2_in_pieces(Dst, Base, Offset, Signedness)
+ end.
+
+load_2_directly(Dst, Base, Offset, Signedness) ->
+ [hipe_rtl:mk_load(Dst, Base, Offset, int16, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(2))].
+
+load_big_2_in_pieces(Dst, Base, Offset, Signedness) ->
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))].
+
+load_little_2_in_pieces(Dst, Base, Offset, Signedness) ->
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))].
+
+%%% Load a 4-byte big-endian integer from a binary.
+%%% Increment Offset by 4.
+load_big_4(Dst, Base, Offset, Signedness) ->
+ case get(hipe_target_arch) of
+ powerpc ->
+ load_4_directly(Dst, Base, Offset, Signedness);
+ %% Note: x86 could use a "load;bswap" sequence here.
+ %% This has been implemented, but unfortunately didn't
+ %% make any noticeable improvements in our benchmarks.
+ arm ->
+ %% When loading 4 bytes into a 32-bit register, the
+ %% signedness of the high-order byte doesn't matter.
+ %% ARM prefers unsigned byte loads so we'll use that.
+ load_big_4_in_pieces(Dst, Base, Offset, unsigned);
+ _ ->
+ load_big_4_in_pieces(Dst, Base, Offset, Signedness)
+ end.
+
+%%% Load a 4-byte little-endian integer from a binary.
+%%% Increment Offset by 4.
+load_little_4(Dst, Base, Offset, Signedness) ->
+ case get(hipe_target_arch) of
+ x86 ->
+ load_4_directly(Dst, Base, Offset, Signedness);
+ powerpc ->
+ [hipe_rtl:mk_call([Dst], 'lwbrx', [Base,Offset], [], [], not_remote),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4))];
+ arm ->
+ %% When loading 4 bytes into a 32-bit register, the
+ %% signedness of the high-order byte doesn't matter.
+ %% ARM prefers unsigned byte loads so we'll use that.
+ load_little_4_in_pieces(Dst, Base, Offset, unsigned);
+ _ ->
+ load_little_4_in_pieces(Dst, Base, Offset, Signedness)
+ end.
+
+load_4_directly(Dst, Base, Offset, Signedness) ->
+ [hipe_rtl:mk_load(Dst, Base, Offset, word, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4))].
+
+load_big_4_in_pieces(Dst, Base, Offset, Signedness) ->
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))].
+
+load_little_4_in_pieces(Dst, Base, Offset, Signedness) ->
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(16)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(24)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))].
+
+-ifdef(STORE_4_NEEDED).
+store_4(Base, Offset, Src) ->
+ case get(hipe_target_arch) of
+ x86 ->
+ store_4_directly(Base, Offset, Src);
+ powerpc ->
+ store_4_directly(Base, Offset, Src);
+ arm ->
+ store_big_4_in_pieces(Base, Offset, Src);
+ ultrasparc ->
+ store_big_4_in_pieces(Base, Offset, Src);
+ amd64 ->
+ store_4_directly(Base, Offset, Src)
+ end.
+
+store_4_directly(Base, Offset, Src) ->
+ [hipe_rtl:mk_store(Base, Offset, Src, int32),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4))].
+
+store_big_4_in_pieces(Base, Offset, Src) ->
+ [hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_store(Base, Offset, Src, byte),
+ hipe_rtl:mk_alu(Offset, Offset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Src, Src, srl, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, Offset, Src, byte),
+ hipe_rtl:mk_alu(Offset, Offset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Src, Src, srl, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, Offset, Src, byte),
+ hipe_rtl:mk_alu(Offset, Offset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Src, Src, srl, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, Offset, Src, byte),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4))].
+-endif.
+
+%%----------------------------------------------------------------------
+%% Handling of arithmetic -- depends on the size of word.
+%%----------------------------------------------------------------------
+
+eval_alu(Op, Arg1, Arg2) ->
+ %% io:format("Evaluated alu: ~w ~w ~w = ",[Arg1, Op, Arg2]),
+ Res = case word_size() of
+ 4 ->
+ hipe_rtl_arith_32:eval_alu(Op, Arg1, Arg2);
+ 8 ->
+ hipe_rtl_arith_64:eval_alu(Op, Arg1, Arg2)
+ end,
+ %% io:format("~w~n ",[Res]),
+ Res.
+
+-ifdef(EVAL_ALUB_NEEDED).
+eval_alub(Op, Cond, Arg1, Arg2) ->
+ %% io:format("Evaluated alub: ~w ~w ~w cond ~w = ",[Arg1, Op, Arg2, Cond]),
+ Res = case word_size() of
+ 4 ->
+ hipe_rtl_arith_32:eval_alub(Op, Cond, Arg1, Arg2);
+ 8 ->
+ hipe_rtl_arith_64:eval_alub(Op, Cond, Arg1, Arg2)
+ end,
+ %% io:format("~w~n ",[Res]),
+ Res.
+-endif.
+
+eval_cond(Cond, Arg1, Arg2) ->
+ %% io:format("Evaluated cond: ~w ~w ~w = ",[Arg1, Cond, Arg2]),
+ Res = case word_size() of
+ 4 ->
+ hipe_rtl_arith_32:eval_cond(Cond, Arg1, Arg2);
+ 8 ->
+ hipe_rtl_arith_64:eval_cond(Cond, Arg1, Arg2)
+ end,
+ %% io:format("~w~n ",[Res]),
+ Res.
+
+eval_cond_bits(Cond, N, Z, V, C) ->
+ %% io:format("Evaluated cond: ~w ~w ~w = ",[Arg1, Cond, Arg2]),
+ Res = case word_size() of
+ 4 ->
+ hipe_rtl_arith_32:eval_cond_bits(Cond, N, Z, V, C);
+ 8 ->
+ hipe_rtl_arith_64:eval_cond_bits(Cond, N, Z, V, C)
+ end,
+ %% io:format("~w~n ",[Res]),
+ Res.
+
+%%----------------------------------------------------------------------
+
+fwait() ->
+ case get(hipe_target_arch) of
+ x86 -> [hipe_rtl:mk_call([], 'fwait', [], [], [], not_remote)];
+ amd64 -> [hipe_rtl:mk_call([], 'fwait', [], [], [], not_remote)];
+ arm -> [];
+ powerpc -> [];
+ ultrasparc -> []
+ end.
+
+%% @spec handle_fp_exception() -> [term()]
+%%
+%% @doc
+%% Returns RTL code to restore the FPU after a floating-point exception.
+%% @end
+handle_fp_exception() ->
+ case get(hipe_target_arch) of
+ x86 ->
+ ContLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([], handle_fp_exception, [],
+ hipe_rtl:label_name(ContLbl), [], not_remote),
+ ContLbl];
+ amd64 ->
+ ContLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([], handle_fp_exception, [],
+ hipe_rtl:label_name(ContLbl), [], not_remote),
+ ContLbl];
+ arm ->
+ [];
+ powerpc ->
+ [];
+ ultrasparc ->
+ []
+ end.
+
+%%
+%% PCB accesses.
+%% Wrapped to avoid leaking the PCB pointer to the wrong places.
+%%
+
+pcb_load(Dst, Off) -> pcb_load(Dst, Off, word).
+
+pcb_load(Dst, Off, Size) ->
+ hipe_rtl:mk_load(Dst, proc_pointer(), hipe_rtl:mk_imm(Off), Size, unsigned).
+
+pcb_store(Off, Src) -> pcb_store(Off, Src, word).
+
+pcb_store(Off, Src, Size) ->
+ hipe_rtl:mk_store(proc_pointer(), hipe_rtl:mk_imm(Off), Src, Size).
+
+pcb_address(Dst, Off) ->
+ hipe_rtl:mk_alu(Dst, proc_pointer(), 'add', hipe_rtl:mk_imm(Off)).
+
+proc_pointer() -> % must not be exported
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ hipe_rtl:mk_reg_gcsafe(hipe_sparc_registers:proc_pointer());
+ powerpc ->
+ hipe_rtl:mk_reg_gcsafe(hipe_ppc_registers:proc_pointer());
+ arm ->
+ hipe_rtl:mk_reg_gcsafe(hipe_arm_registers:proc_pointer());
+ x86 ->
+ hipe_rtl:mk_reg_gcsafe(hipe_x86_registers:proc_pointer());
+ amd64 ->
+ hipe_rtl:mk_reg_gcsafe(hipe_amd64_registers:proc_pointer())
+ end.
+
+%%
+%% Special BIF calls.
+%% Wrapped to avoid leaking the PCB pointer to the wrong places,
+%% and to allow ARCH-specific expansion.
+%%
+
+call_bif(Dst, Name, Args, Cont, Fail) ->
+ hipe_rtl:mk_call(Dst, Name, Args, Cont, Fail, not_remote).
+
+nr_of_return_regs() ->
+ case get(hipe_target_arch) of
+ ultrasparc ->
+ 1;
+ %% hipe_sparc_registers:nr_rets();
+ powerpc ->
+ 1;
+ %% hipe_ppc_registers:nr_rets();
+ arm ->
+ 1;
+ x86 ->
+ hipe_x86_registers:nr_rets();
+ amd64 ->
+ 1
+ %% hipe_amd64_registers:nr_rets();
+ end.
diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc
new file mode 100644
index 0000000000..31fedd927e
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_arith.inc
@@ -0,0 +1,177 @@
+%% -*- Erlang -*-
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_rtl_arith.inc
+%% Created : Feb 2004
+%% Purpose : Implements arithmetic which is parameterized by the size
+%% of the word of the target architecture (given as defines).
+%%----------------------------------------------------------------------
+
+
+%% Returns a tuple
+%% {Res, Sign, Zero, Overflow, Carry}
+%% Res will be a number in the range
+%% MAX_SIGNED_INT >= Res >= MIN_SIGNED_INT
+%% The other four values are flags that are either true or false
+%%
+eval_alu(Op, Arg1, Arg2)
+ when Arg1 =< ?MAX_SIGNED_INT,
+ Arg1 >= ?MIN_SIGNED_INT,
+ Arg2 =< ?MAX_SIGNED_INT,
+ Arg2 >= ?MIN_SIGNED_INT ->
+
+ Sign1 = sign_bit(Arg1),
+ Sign2 = sign_bit(Arg2),
+
+ case Op of
+ 'sub' ->
+ Res = (Arg1 - Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = (Sign1 and (not Sign2) and (not N))
+ or
+ ((not Sign1) and Sign2 and N),
+ C = ((not Sign1) and Sign2)
+ or
+ (N and ((not Sign1) or Sign2));
+ 'add' ->
+ Res = (Arg1 + Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = (Sign1 and Sign2 and (not N))
+ or
+ ((not Sign1) and (not Sign2) and N),
+ C = (Sign1 and Sign2)
+ or
+ ((not N) and (Sign1 or Sign2));
+ 'mul' ->
+ FullRes = Arg1 * Arg2,
+ Res = FullRes band ?WORDMASK,
+ ResHi = FullRes bsr ?BITS,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = (N and (ResHi =/= -1)) or ((not N) and (ResHi =/= 0)),
+ C = V;
+ 'sra' ->
+ Res = (Arg1 bsr Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = 0,
+ C = 0;
+ 'srl' ->
+ Res = (Arg1 bsr Arg2) band shiftmask(Arg2),
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = 0,
+ C = 0;
+ 'sll' ->
+ Res = (Arg1 bsl Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = 0,
+ C = 0;
+ 'or' ->
+ Res = (Arg1 bor Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = 0,
+ C = 0;
+ 'and' ->
+ Res = (Arg1 band Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = 0,
+ C = 0;
+ 'xor' ->
+ Res = (Arg1 bxor Arg2) band ?WORDMASK,
+ N = sign_bit(Res),
+ Z = zero(Res),
+ V = 0,
+ C = 0;
+ Op ->
+ Res = N = Z = V = C = 0,
+ ?EXIT({"unknown alu op", Op})
+ end,
+ {two_comp_to_erl(Res), N, Z, V, C};
+eval_alu(Op, Arg1, Arg2) ->
+ ?EXIT({argument_overflow,Op,Arg1,Arg2}).
+
+%% Bj�rn & Bjarni:
+%% We need to be able to do evaluations based only on the bits, since
+%% there are cases where we can evaluate a subset of the bits, but can
+%% not do a full eval-alub call (eg. a + 0 gives no carry)
+%%
+-spec eval_cond_bits(atom(), boolean(), boolean(), boolean(), boolean()) -> boolean().
+
+eval_cond_bits(Cond, N, Z, V, C) ->
+ case Cond of
+ 'eq' ->
+ Z;
+ 'ne' ->
+ not Z;
+ 'gt' ->
+ not (Z or (N xor V));
+ 'gtu' ->
+ not (C or Z);
+ 'ge' ->
+ not (N xor V);
+ 'geu'->
+ not C;
+ 'lt' ->
+ N xor V;
+ 'ltu'->
+ C;
+ 'le' ->
+ Z or (N xor V);
+ 'leu'->
+ C or Z;
+ 'overflow' ->
+ V;
+ 'not_overflow' ->
+ not V;
+ _ ->
+ ?EXIT({'condition code not handled',Cond})
+ end.
+
+eval_alub(Op, Cond, Arg1, Arg2) ->
+ {Res, N, Z, V, C} = eval_alu(Op, Arg1, Arg2),
+ {Res, eval_cond_bits(Cond, N, Z, V, C)}.
+
+eval_cond(Cond, Arg1, Arg2) ->
+ {_, Bool} = eval_alub('sub', Cond, Arg1, Arg2),
+ Bool.
+
+sign_bit(Val) ->
+ ((Val bsr ?SIGN_BIT) band 1) =:= 1.
+
+two_comp_to_erl(V) ->
+ if V > ?MAX_SIGNED_INT ->
+ - ((?MAX_UNSIGNED_INT + 1) - V);
+ true -> V
+ end.
+
+shiftmask(Arg) ->
+ Setbits = ?BITS - Arg,
+ (1 bsl Setbits) - 1.
+
+zero(Val) ->
+ Val =:= 0.
+
diff --git a/lib/hipe/rtl/hipe_rtl_arith_32.erl b/lib/hipe/rtl/hipe_rtl_arith_32.erl
new file mode 100644
index 0000000000..a8a6043cda
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_arith_32.erl
@@ -0,0 +1,50 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2002 by Erik Johansson.
+%% ====================================================================
+%% Filename : hipe_rtl_arith_32.erl
+%% Module : hipe_rtl_arith_32
+%% Purpose : To implement 32-bit RTL-arithmetic
+%% Notes : The arithmetic works on 32-bit signed integers.
+%% The implementation is taken from the implementation
+%% of arithmetic on SPARC.
+%% XXX: This code is seldom used, and hence also
+%% seldom tested.
+%% Look here for strange bugs appearing when
+%% turning on rtl_prop.
+%%
+%% History : * 2002-10-23 Erik Stenman (happi@it.uu.se): Created.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_arith_32).
+
+-export([eval_alu/3, eval_alub/4, eval_cond/3, eval_cond_bits/5]).
+
+-define(BITS, 32).
+-define(SIGN_BIT, 31).
+-define(WORDMASK, 16#ffffffff).
+-define(MAX_SIGNED_INT, 16#7fffffff).
+-define(MIN_SIGNED_INT, -16#80000000).
+-define(MAX_UNSIGNED_INT, 16#ffffffff).
+
+-include("../main/hipe.hrl"). %% for ?EXIT
+
+-include("hipe_rtl_arith.inc").
diff --git a/lib/hipe/rtl/hipe_rtl_arith_64.erl b/lib/hipe/rtl/hipe_rtl_arith_64.erl
new file mode 100644
index 0000000000..d0d576b65e
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_arith_64.erl
@@ -0,0 +1,38 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_rtl_arith_64.erl
+%% Created : Feb 2004
+%% Purpose : Implements arithmetic for 64-bit target architectures.
+%%----------------------------------------------------------------------
+
+-module(hipe_rtl_arith_64).
+-export([eval_alu/3, eval_alub/4, eval_cond/3, eval_cond_bits/5]).
+
+-define(BITS, 64).
+-define(SIGN_BIT, 63).
+-define(WORDMASK, 16#ffffffffffffffff).
+-define(MAX_SIGNED_INT, 16#7fffffffffffffff).
+-define(MIN_SIGNED_INT, -16#8000000000000000).
+-define(MAX_UNSIGNED_INT,16#ffffffffffffffff).
+
+-include("../main/hipe.hrl"). %% for ?EXIT
+
+-include("hipe_rtl_arith.inc").
diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl
new file mode 100644
index 0000000000..5ea51acedb
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_binary.erl
@@ -0,0 +1,80 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_rtl_binary_2.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 5 Mar 2007 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+-module(hipe_rtl_binary).
+
+-export([gen_rtl/7]).
+
+gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) ->
+ case type_of_operation(BsOP) of
+ match ->
+ {hipe_rtl_binary_match:gen_rtl(
+ BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab};
+ construct ->
+ hipe_rtl_binary_construct:gen_rtl(
+ BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab)
+ end.
+
+type_of_operation({bs_start_match,_}) -> match;
+type_of_operation({{bs_start_match,_},_}) -> match;
+type_of_operation({bs_get_binary,_,_}) -> match;
+type_of_operation({bs_get_binary_all,_,_}) -> match;
+type_of_operation({bs_get_binary_all_2,_,_}) -> match;
+type_of_operation({bs_get_integer,_,_}) -> match;
+type_of_operation({bs_get_float,_,_}) -> match;
+type_of_operation({bs_skip_bits,_}) -> match;
+type_of_operation({bs_skip_bits_all,_,_}) -> match;
+type_of_operation({bs_test_tail,_}) -> match;
+type_of_operation({bs_restore,_}) -> match;
+type_of_operation({bs_save,_}) -> match;
+type_of_operation({bs_test_unit,_}) -> match;
+type_of_operation({bs_match_string,_,_}) -> match;
+type_of_operation(bs_context_to_binary) -> match;
+type_of_operation({bs_add,_}) -> construct;
+type_of_operation({bs_add,_,_}) -> construct;
+type_of_operation(bs_bits_to_bytes) -> construct;
+type_of_operation(bs_bits_to_bytes2) -> construct;
+type_of_operation({bs_init,_}) -> construct;
+type_of_operation({bs_init,_,_}) -> construct;
+type_of_operation({bs_init_bits,_}) -> construct;
+type_of_operation({bs_init_bits,_,_}) -> construct;
+type_of_operation({bs_put_binary,_,_}) -> construct;
+type_of_operation({bs_put_binary_all,_}) -> construct;
+type_of_operation({bs_put_float,_,_,_}) -> construct;
+type_of_operation({bs_put_integer,_,_,_}) -> construct;
+type_of_operation({bs_put_string,_,_}) -> construct;
+type_of_operation({unsafe_bs_put_integer,_,_,_}) -> construct;
+type_of_operation(bs_utf8_size) -> construct;
+type_of_operation(bs_put_utf8) -> construct;
+type_of_operation(bs_get_utf8) -> match;
+type_of_operation(bs_utf16_size) -> construct;
+type_of_operation({bs_put_utf16,_}) -> construct;
+type_of_operation({bs_get_utf16,_}) -> match;
+type_of_operation(bs_validate_unicode) -> construct;
+type_of_operation(bs_validate_unicode_retract) -> match;
+type_of_operation(bs_final) -> construct;
+type_of_operation({bs_append,_,_,_,_}) -> construct;
+type_of_operation({bs_private_append,_,_}) -> construct;
+type_of_operation(bs_init_writable) -> construct.
diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
new file mode 100644
index 0000000000..29993b9715
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
@@ -0,0 +1,1363 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ====================================================================
+%% Module : hipe_rtl_inline_bs_ops
+%% Purpose :
+%% Notes :
+%% History : * 2001-06-14 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_binary_construct).
+-export([gen_rtl/7]).
+-import(hipe_tagscheme, [set_field_from_term/3,
+ get_field_from_term/3,
+ set_field_from_pointer/3,
+ get_field_from_pointer/3]).
+%%-------------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+-include("hipe_rtl.hrl").
+-include("hipe_literals.hrl").
+
+-define(BYTE_SHIFT, hipe_rtl:mk_imm(3)). %% Turn bits into bytes or vice versa
+-define(LOW_BITS, hipe_rtl:mk_imm(7)). %% Three lowest bits set
+-define(LOW_BITS_INT, 7).
+-define(BYTE_SIZE, 8).
+-define(MAX_BINSIZE, ((1 bsl ((hipe_rtl_arch:word_size()*?BYTE_SIZE)-3)) - 1)).
+
+
+%% -------------------------------------------------------------------------
+%% The code is generated as a list of lists, it will be flattened later.
+%%
+
+gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab) ->
+ %%io:format("~w, ~w, ~w~n", [BsOP, Args, Dst]),
+ case BsOP of
+ {bs_put_string, String, SizeInBytes} ->
+ [NewOffset] = get_real(Dst),
+ [Base, Offset] = Args,
+ put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset,
+ TrueLblName);
+ _ ->
+ Code =
+ case BsOP of
+ {bs_init, Size, _Flags} ->
+ [] = Args,
+ [Dst0, Base, Offset] = Dst,
+ case is_illegal_const(Size bsl 3) of
+ true ->
+ hipe_rtl:mk_goto(SystemLimitLblName);
+ false ->
+ const_init2(Size, Dst0, Base, Offset, TrueLblName)
+ end;
+
+ {bs_init, _Flags} ->
+ [Size] = Args,
+ [Dst0, Base, Offset] = Dst,
+ var_init2(Size, Dst0, Base, Offset, TrueLblName,
+ SystemLimitLblName, FalseLblName);
+
+ {bs_init_bits, Size, _Flags} ->
+ [] = Args,
+ [Dst0, Base, Offset] = Dst,
+ case is_illegal_const(Size) of
+ true ->
+ hipe_rtl:mk_goto(SystemLimitLblName);
+ false ->
+ const_init_bits(Size, Dst0, Base, Offset, TrueLblName)
+ end;
+
+ {bs_init_bits, _Flags} ->
+ [Size] = Args,
+ [Dst0, Base, Offset] = Dst,
+ var_init_bits(Size, Dst0, Base, Offset, TrueLblName,
+ SystemLimitLblName, FalseLblName);
+
+ {bs_put_binary_all, _Flags} ->
+ [Src, Base, Offset] = Args,
+ [NewOffset] = get_real(Dst),
+ put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName);
+
+ {bs_put_binary, Size, _Flags} ->
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ [NewOffset] = get_real(Dst),
+ case Args of
+ [Src, Base, Offset] ->
+ put_static_binary(NewOffset, Src, Size, Base, Offset,
+ TrueLblName, FalseLblName);
+ [Src, Bits, Base, Offset] ->
+ {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName),
+ InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base,
+ Offset, TrueLblName, FalseLblName),
+ SizeCode ++ InCode
+ end
+ end;
+
+ {bs_put_float, Size, Flags, ConstInfo} ->
+ [NewOffset] = get_real(Dst),
+ Aligned = aligned(Flags),
+ LittleEndian = littleendian(Flags),
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ case Args of
+ [Src, Base, Offset] ->
+ CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags,
+ TrueLblName, FalseLblName),
+ put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned,
+ LittleEndian, ConstInfo, TrueLblName);
+ [Src, Bits, Base, Offset] ->
+ {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName),
+ InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg,
+ Flags, TrueLblName, FalseLblName),
+ SizeCode ++ InCode
+ end
+ end;
+
+ {bs_put_integer, Size, Flags, ConstInfo} ->
+ Aligned = aligned(Flags),
+ LittleEndian = littleendian(Flags),
+ [NewOffset] = get_real(Dst),
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ case ConstInfo of
+ fail ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ _ ->
+ case Args of
+ [Src, Base, Offset] ->
+ CCode = static_int_c_code(NewOffset, Src,
+ Base, Offset, Size,
+ Flags, TrueLblName,
+ FalseLblName),
+ put_static_int(NewOffset, Src, Base, Offset, Size,
+ CCode, Aligned, LittleEndian, TrueLblName);
+ [Src, Bits, Base, Offset] ->
+ {SizeCode, SizeReg} = make_size(Size, Bits,
+ FalseLblName),
+ CCode = int_c_code(NewOffset, Src, Base,
+ Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName),
+ InCode =
+ put_dynamic_int(NewOffset, Src, Base, Offset,
+ SizeReg, CCode, Aligned,
+ LittleEndian, TrueLblName),
+ SizeCode ++ InCode
+ end
+ end
+ end;
+
+ {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} ->
+ [NewOffset] = get_real(Dst),
+ case Args of
+ [_Src, _Base, Offset] ->
+ [hipe_rtl:mk_move(NewOffset,Offset),
+ hipe_rtl:mk_goto(TrueLblName)];
+ [_Src, _Bits, _Base, Offset] ->
+ [hipe_rtl:mk_move(NewOffset,Offset),
+ hipe_rtl:mk_goto(TrueLblName)]
+ end;
+
+ {unsafe_bs_put_integer, Size, Flags, ConstInfo} ->
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ Aligned = aligned(Flags),
+ LittleEndian = littleendian(Flags),
+ [NewOffset] = get_real(Dst),
+ case ConstInfo of
+ fail ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ _ ->
+ case Args of
+ [Src, Base, Offset] ->
+ CCode = static_int_c_code(NewOffset, Src,
+ Base, Offset, Size,
+ Flags, TrueLblName,
+ FalseLblName),
+ put_unsafe_static_int(NewOffset, Src, Base,
+ Offset, Size,
+ CCode, Aligned, LittleEndian,
+ TrueLblName);
+ [Src, Bits, Base, Offset] ->
+ {SizeCode, SizeReg} = make_size(Size, Bits,
+ FalseLblName),
+ CCode = int_c_code(NewOffset, Src, Base,
+ Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName),
+ InCode =
+ put_unsafe_dynamic_int(NewOffset, Src, Base,
+ Offset, SizeReg, CCode,
+ Aligned, LittleEndian,
+ TrueLblName),
+ SizeCode ++ InCode
+ end
+ end
+ end;
+
+ bs_utf8_size ->
+ case Dst of
+ [_DstVar] ->
+ [_Arg] = Args,
+ [hipe_rtl:mk_call(Dst, bs_utf8_size, Args,
+ TrueLblName, [], not_remote)];
+ [] ->
+ [hipe_rtl:mk_goto(TrueLblName)]
+ end;
+
+ bs_put_utf8 ->
+ [_Src, _Base, _Offset] = Args,
+ NewDsts = get_real(Dst),
+ [hipe_rtl:mk_call(NewDsts, bs_put_utf8, Args,
+ TrueLblName, FalseLblName, not_remote)];
+
+ bs_utf16_size ->
+ case Dst of
+ [_DstVar] ->
+ [_Arg] = Args,
+ [hipe_rtl:mk_call(Dst, bs_utf16_size, Args,
+ TrueLblName, [], not_remote)];
+ [] ->
+ [hipe_rtl:mk_goto(TrueLblName)]
+ end;
+
+ {bs_put_utf16, Flags} ->
+ [_Src, _Base, _Offset] = Args,
+ NewDsts = get_real(Dst),
+ PrimOp = % workaround for bif/primop arity restrictions
+ case littleendian(Flags) of
+ false -> bs_put_utf16be;
+ true -> bs_put_utf16le
+ end,
+ [hipe_rtl:mk_call(NewDsts, PrimOp, Args,
+ TrueLblName, FalseLblName, not_remote)];
+
+ bs_validate_unicode ->
+ [_Arg] = Args,
+ [hipe_rtl:mk_call([], bs_validate_unicode, Args,
+ TrueLblName, FalseLblName, not_remote)];
+
+ bs_final ->
+ Zero = hipe_rtl:mk_imm(0),
+ [Src, Offset] = Args,
+ [BitSize, ByteSize] = create_regs(2),
+ [ShortLbl, LongLbl] = create_lbls(2),
+ case Dst of
+ [DstVar] ->
+ [hipe_rtl:mk_alub(BitSize, Offset, 'and', ?LOW_BITS, eq,
+ hipe_rtl:label_name(ShortLbl),
+ hipe_rtl:label_name(LongLbl)), ShortLbl,
+ hipe_rtl:mk_move(DstVar, Src),
+ hipe_rtl:mk_goto(TrueLblName),
+ LongLbl,
+ hipe_rtl:mk_alu(ByteSize, Offset, 'srl', ?BYTE_SHIFT),
+ hipe_tagscheme:mk_sub_binary(DstVar, ByteSize,
+ Zero, BitSize, Zero, Src),
+ hipe_rtl:mk_goto(TrueLblName)];
+ [] ->
+ [hipe_rtl:mk_goto(TrueLblName)]
+ end;
+
+ bs_init_writable ->
+ Zero = hipe_rtl:mk_imm(0),
+ [Size] = Args,
+ [DstVar] = Dst,
+ [SizeReg] = create_regs(1),
+ [Base] = create_unsafe_regs(1),
+ [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE),
+ check_and_untag_fixnum(Size, SizeReg, FalseLblName),
+ allocate_writable(DstVar, Base, SizeReg, Zero, Zero),
+ hipe_rtl:mk_goto(TrueLblName)];
+
+ {bs_private_append, _U, _F} ->
+ [Size, Bin] = Args,
+ [DstVar, Base, Offset] = Dst,
+ [ProcBin] = create_vars(1),
+ [SubSize, SizeReg, EndSubSize, EndSubBitSize] = create_regs(4),
+ SubBinSize = {sub_binary, binsize},
+ [get_field_from_term({sub_binary, orig}, Bin, ProcBin),
+ get_field_from_term(SubBinSize, Bin, SubSize),
+ check_and_untag_fixnum(Size, SizeReg, FalseLblName),
+ realloc_binary(SizeReg, ProcBin, Base),
+ calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize),
+ set_field_from_term(SubBinSize, Bin, EndSubSize),
+ set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize),
+ hipe_rtl:mk_move(DstVar, Bin),
+ hipe_rtl:mk_goto(TrueLblName)];
+
+ {bs_append, _U, _F, _B, _Bla} ->
+ [Size, Bin] = Args,
+ [DstVar, Base, Offset] = Dst,
+ [ProcBin] = create_vars(1),
+ [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] =
+ create_regs(5),
+ [ContLbl,ContLbl2,ContLbl3,WritableLbl,NotWritableLbl] = Lbls =
+ create_lbls(5),
+ [ContLblName, ContLbl2Name, ContLbl3Name, Writable, NotWritable] =
+ [hipe_rtl:label_name(Lbl) || Lbl <- Lbls],
+ Zero = hipe_rtl:mk_imm(0),
+ SubIsWritable = {sub_binary, is_writable},
+ [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE),
+ check_and_untag_fixnum(Size, SizeReg, FalseLblName),
+ hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99),
+ ContLbl,
+ hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable),
+ ContLbl2,
+ get_field_from_term(SubIsWritable, Bin, IsWritable),
+ hipe_rtl:mk_branch(IsWritable, 'ne', Zero,
+ ContLbl3Name, NotWritable),
+ ContLbl3,
+ get_field_from_term({sub_binary, orig}, Bin, ProcBin),
+ get_field_from_term({proc_bin, flags}, ProcBin, Flags),
+ hipe_rtl:mk_alub(Flags, Flags, 'and',
+ hipe_rtl:mk_imm(?PB_IS_WRITABLE),
+ eq, NotWritable, Writable, 0.01),
+ WritableLbl,
+ set_field_from_term(SubIsWritable, Bin, Zero),
+ realloc_binary(SizeReg, ProcBin, Base),
+ calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize),
+ hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero,
+ EndSubBitSize, Zero,
+ hipe_rtl:mk_imm(1), ProcBin),
+ hipe_rtl:mk_goto(TrueLblName),
+ NotWritableLbl,
+ not_writable_code(Bin, SizeReg, DstVar, Base, Offset,
+ TrueLblName, FalseLblName)]
+ end,
+ {Code, ConstTab}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Code that is used in the append and init writeable functions
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+not_writable_code(Bin, SizeReg, Dst, Base, Offset,
+ TrueLblName, FalseLblName) ->
+ [SrcBase] = create_unsafe_regs(1),
+ [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5),
+ [IncLbl,AllLbl] = Lbls = create_lbls(2),
+ [IncLblName,AllLblName] = get_label_names(Lbls),
+ [get_base_offset_size(Bin, SrcBase, SrcOffset, SrcSize, FalseLblName),
+ hipe_rtl:mk_alu(TotSize, SrcSize, add, SizeReg),
+ hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS),
+ hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(UsedBytes, TotBytes, sll, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_branch(UsedBytes, ge, hipe_rtl:mk_imm(256),
+ AllLblName, IncLblName),
+ IncLbl,
+ hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)),
+ AllLbl,
+ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize),
+ put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0),
+ TrueLblName, FalseLblName)].
+
+allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) ->
+ Zero = hipe_rtl:mk_imm(0),
+ [NextLbl] = create_lbls(1),
+ [EndSubSize, EndSubBitSize, ProcBin] = create_regs(3),
+ [hipe_rtl:mk_call([Base], bs_allocate, [UsedBytes],
+ hipe_rtl:label_name(NextLbl), [], not_remote),
+ NextLbl,
+ hipe_tagscheme:create_refc_binary(Base, TotBytes,
+ hipe_rtl:mk_imm(?PB_IS_WRITABLE bor
+ ?PB_ACTIVE_WRITER),
+ ProcBin),
+ hipe_rtl:mk_alu(EndSubSize, TotSize, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(EndSubBitSize, TotSize, 'and', ?LOW_BITS),
+ hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize,
+ Zero, hipe_rtl:mk_imm(1), ProcBin)].
+
+check_and_untag_fixnum(Size, SizeReg, FalseLblName) ->
+ [ContLbl,NextLbl] = Lbls = create_lbls(2),
+ [ContLblName,NextLblName] = get_label_names(Lbls),
+ [hipe_tagscheme:test_fixnum(Size, ContLblName, FalseLblName, 0.99),
+ ContLbl,
+ hipe_tagscheme:untag_fixnum(SizeReg,Size),
+ hipe_rtl:mk_branch(SizeReg, ge, hipe_rtl:mk_imm(0), NextLblName,
+ FalseLblName),
+ NextLbl].
+
+realloc_binary(SizeReg, ProcBin, Base) ->
+ [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4),
+ [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] =
+ [hipe_rtl:label_name(Lbl) || Lbl <- Lbls],
+ [PBSize, Tmp, ByteSize, NewSize, Flags, ResultingSize, OrigSize,
+ BinPointer] = create_regs(8),
+ ProcBinSizeTag = {proc_bin, binsize},
+ ProcBinFlagsTag = {proc_bin, flags},
+ ProcBinValTag = {proc_bin, val},
+ ProcBinBytesTag = {proc_bin, bytes},
+ BinOrigSizeTag = {binary, orig_size},
+ [get_field_from_term(ProcBinSizeTag, ProcBin, PBSize),
+ hipe_rtl:mk_alu(Tmp, SizeReg, 'add', ?LOW_BITS),
+ hipe_rtl:mk_alu(ByteSize, Tmp, 'srl', ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(ResultingSize, ByteSize, 'add', PBSize),
+ set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize),
+ get_field_from_term(ProcBinFlagsTag, ProcBin, Flags),
+ hipe_rtl:mk_alu(Flags, Flags, 'or', hipe_rtl:mk_imm(?PB_ACTIVE_WRITER)),
+ set_field_from_term(ProcBinFlagsTag, ProcBin, Flags),
+ get_field_from_term(ProcBinValTag, ProcBin, BinPointer),
+ get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize),
+ hipe_rtl:mk_branch(OrigSize, 'lt', ResultingSize,
+ ReallocLblName, NoReallocLblName),
+ NoReallocLbl,
+ get_field_from_term(ProcBinBytesTag, ProcBin, Base),
+ hipe_rtl:mk_goto(ContLblName),
+ ReallocLbl,
+ hipe_rtl:mk_alu(NewSize, ResultingSize, 'sll', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize],
+ NextLblName, [], not_remote),
+ NextLbl,
+ set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize),
+ set_field_from_term(ProcBinValTag, ProcBin, BinPointer),
+ hipe_tagscheme:extract_binary_bytes(BinPointer, Base),
+ set_field_from_term(ProcBinBytesTag, ProcBin, Base),
+ ContLbl].
+
+calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize) ->
+ [SubSize, SubBitSize, EndSize] = create_regs(3),
+ [get_field_from_term({sub_binary, binsize}, Bin, SubSize),
+ get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize),
+ hipe_rtl:mk_alu(Offset, SubSize, 'sll', ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(Offset, Offset, 'add', SubBitSize),
+ hipe_rtl:mk_alu(EndSize, Offset, 'add', SizeReg),
+ hipe_rtl:mk_alu(EndSubSize, EndSize, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(EndSubBitSize, EndSize, 'and', ?LOW_BITS)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Code that is used to create calls to beam functions
+%%
+%% X_c_code/8, used for putting terms into binaries
+%%
+%% X_get_c_code/10, used for getting terms from binaries
+%%
+%% - gen_test_sideffect_bs_call/4 is used to make a C-call that might
+%% fail but doesn't return an erlang value.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags,
+ TrueLblName, FalseLblName) ->
+ [SizeReg] = create_regs(1),
+ [hipe_rtl:mk_move(SizeReg, hipe_rtl:mk_imm(Size))|
+ float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName)].
+
+float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName) ->
+ put_c_code(bs_put_small_float, NewOffset, Src, Base, Offset, SizeReg,
+ Flags, TrueLblName, FalseLblName).
+
+static_int_c_code(NewOffset, Src, Base, Offset, Size, Flags,
+ TrueLblName, FalseLblName) ->
+ [SizeReg] = create_regs(1),
+ [hipe_rtl:mk_move(SizeReg, hipe_rtl:mk_imm(Size))|
+ int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName)].
+
+int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName) ->
+ put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg,
+ Flags, TrueLblName, FalseLblName).
+
+binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) ->
+ PassedLbl = hipe_rtl:mk_new_label(),
+ [SizeReg, FlagsReg] = create_regs(2),
+ [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_move(SizeReg, Size),
+ hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg],
+ hipe_rtl:label_name(PassedLbl),[],not_remote),
+ PassedLbl,
+ hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+put_c_code(Func, NewOffset, Src, Base, Offset, SizeReg, Flags,
+ TrueLblName, FalseLblName) ->
+ PassedLbl = hipe_rtl:mk_new_label(),
+ [FlagsReg] = create_regs(1),
+ [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)),
+ gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg],
+ hipe_rtl:label_name(PassedLbl), FalseLblName),
+ PassedLbl,
+ hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+gen_test_sideffect_bs_call(Name, Args, TrueLblName, FalseLblName) ->
+ [Tmp1] = create_regs(1),
+ RetLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([Tmp1], Name, Args,
+ hipe_rtl:label_name(RetLbl), [], not_remote),
+ RetLbl,
+ hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0),
+ FalseLblName, TrueLblName, 0.01)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Small utility functions:
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+create_regs(X) when X > 0 ->
+ [hipe_rtl:mk_new_reg_gcsafe()|create_regs(X-1)];
+create_regs(0) ->
+ [].
+
+create_unsafe_regs(X) when X > 0 ->
+ [hipe_rtl:mk_new_reg()|create_unsafe_regs(X-1)];
+create_unsafe_regs(0) ->
+ [].
+
+create_vars(X) when X > 0 ->
+ [hipe_rtl:mk_new_var()|create_vars(X-1)];
+create_vars(0) ->
+ [].
+
+create_lbls(X) when X > 0 ->
+ [hipe_rtl:mk_new_label()|create_lbls(X-1)];
+create_lbls(0) ->
+ [].
+
+get_label_names(Lbls) ->
+ [hipe_rtl:label_name(Lbl) || Lbl <- Lbls].
+
+aligned(Flags) ->
+ case Flags band ?BSF_ALIGNED of
+ 1 -> true;
+ 0 -> false
+ end.
+
+littleendian(Flags) ->
+ case Flags band 2 of
+ 2 -> true;
+ 0 -> false
+ end.
+
+is_illegal_const(Const) ->
+ Const >= (1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE)) orelse Const < 0.
+
+get_real(Dst) ->
+ case Dst of
+ [_NewOffset] -> Dst;
+ [] -> create_regs(1)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Help functions implementing the bs operations in rtl code.
+%%
+%% The following functions are called from the translation switch:
+%%
+%% - put_string/7 creates code to copy a string to a binary
+%% starting at base+offset and ending at base+newoffset
+%%
+%% - const_init2/6 initializes the creation of a binary of constant size
+%%
+%% - var_init2/6 initializes the creation of a binary of variable size
+%%
+%% - get_int_from_unaligned_bin/11 creates code to extract a fixed
+%% size integer from a binary or makes a c-call if it does not
+%% conform to some certain rules.
+%%
+%% - get_unknown_size_int/11 creates code to extract a variable size
+%% byte-aligned integer from a binary or makes a c-call if it
+%% does not conform to some certain rules.
+%%
+%% - skip_no_of_bits/5 creates code to skip a variable amount of bits
+%% in a binary.
+%%
+%% - load_match_buffer/7 reloads the C-matchbuffer to RTL registers.
+%%
+%% - expand_runtime/4 creates code that calculates a maximal heap need
+%% before a binary match
+%%-----------------------------------------------------------------------------
+
+put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TLName) ->
+ [StringBase] = create_regs(1),
+ {NewTab, Lbl} = hipe_consttab:insert_block(ConstTab, byte, String),
+ {[hipe_rtl:mk_load_address(StringBase, Lbl, constant)|
+ copy_string(StringBase, SizeInBytes, Base, Offset,
+ NewOffset, TLName)],
+ NewTab}.
+
+const_init2(Size, Dst, Base, Offset, TrueLblName) ->
+ Log2WordSize = hipe_rtl_arch:log2_word_size(),
+ WordSize = hipe_rtl_arch:word_size(),
+ NextLbl = hipe_rtl:mk_new_label(),
+ case Size =< ?MAX_HEAP_BIN_SIZE of
+ true ->
+ [hipe_rtl:mk_gctest(((Size + 3*WordSize-1) bsr Log2WordSize)+?SUB_BIN_WORDSIZE),
+ hipe_tagscheme:create_heap_binary(Base, Size, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_goto(TrueLblName)];
+ false ->
+ ByteSize = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm(Size)),
+ hipe_rtl:mk_call([Base], bs_allocate, [ByteSize],
+ hipe_rtl:label_name(NextLbl), [], not_remote),
+ NextLbl,
+ hipe_tagscheme:create_refc_binary(Base, ByteSize, Dst),
+ hipe_rtl:mk_goto(TrueLblName)]
+ end.
+
+const_init_bits(Size, Dst, Base, Offset, TrueLblName) ->
+ Log2WordSize = hipe_rtl_arch:log2_word_size(),
+ WordSize = hipe_rtl_arch:word_size(),
+ [NextLbl] = create_lbls(1),
+ TmpDst = hipe_rtl:mk_new_var(),
+ Zero = hipe_rtl:mk_imm(0),
+ {ExtraSpace, SubBinCode} =
+ if (Size rem ?BYTE_SIZE) =:= 0 ->
+ {0,[hipe_rtl:mk_move(Dst, TmpDst)]};
+ true ->
+ {?SUB_BIN_WORDSIZE,
+ hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero,
+ hipe_rtl:mk_imm(Size band ?LOW_BITS_INT),
+ Zero, TmpDst)}
+ end,
+ BaseBinCode =
+ if Size =< (?MAX_HEAP_BIN_SIZE * 8) ->
+ ByteSize = (Size + 7) div 8,
+ [hipe_rtl:mk_gctest(((ByteSize+ 3*WordSize-1) bsr Log2WordSize)+ ExtraSpace),
+ hipe_tagscheme:create_heap_binary(Base, ByteSize, TmpDst),
+ hipe_rtl:mk_move(Offset, Zero)];
+ true ->
+ ByteSize = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+ExtraSpace),
+ hipe_rtl:mk_move(Offset, Zero),
+ hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm((Size+7) bsr 3)),
+ hipe_rtl:mk_call([Base], bs_allocate, [ByteSize],
+ hipe_rtl:label_name(NextLbl),[],not_remote),
+ NextLbl,
+ hipe_tagscheme:create_refc_binary(Base, ByteSize, TmpDst)]
+ end,
+ [BaseBinCode, SubBinCode, hipe_rtl:mk_goto(TrueLblName)].
+
+var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) ->
+ Log2WordSize = hipe_rtl_arch:log2_word_size(),
+ WordSize = hipe_rtl_arch:word_size(),
+ [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4),
+ [USize,Tmp] = create_unsafe_regs(2),
+ [get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName),
+ hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE),
+ hipe_rtl:label_name(ContLbl),
+ SystemLimitLblName),
+ ContLbl,
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE),
+ hipe_rtl:label_name(HeapLbl),
+ hipe_rtl:label_name(REFCLbl)),
+ HeapLbl,
+ hipe_rtl:mk_alu(Tmp, USize, add, hipe_rtl:mk_imm(3*WordSize-1)),
+ hipe_rtl:mk_alu(Tmp, Tmp, srl, hipe_rtl:mk_imm(Log2WordSize)),
+ hipe_rtl:mk_alu(Tmp, Tmp, add, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)),
+ hipe_rtl:mk_gctest(Tmp),
+ hipe_tagscheme:create_heap_binary(Base, USize, Dst),
+ hipe_rtl:mk_goto(TrueLblName),
+ REFCLbl,
+ hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE),
+ hipe_rtl:mk_call([Base], bs_allocate, [USize],
+ hipe_rtl:label_name(NextLbl), [], not_remote),
+ NextLbl,
+ hipe_tagscheme:create_refc_binary(Base, USize, Dst),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) ->
+ [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl,ContLbl,
+ NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(10),
+ [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4),
+ [TmpDst] = create_unsafe_regs(1),
+ Log2WordSize = hipe_rtl_arch:log2_word_size(),
+ WordSize = hipe_rtl_arch:word_size(),
+ MaximumWords =
+ erlang:max((?MAX_HEAP_BIN_SIZE + 3*WordSize) bsr Log2WordSize,
+ ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE,
+ Zero = hipe_rtl:mk_imm(0),
+ [hipe_rtl:mk_gctest(MaximumWords),
+ get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName),
+ hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq,
+ hipe_rtl:label_name(NoSubLbl),
+ hipe_rtl:label_name(SubLbl)),
+ NoSubLbl,
+ hipe_rtl:mk_move(TotByteSize, ByteSize),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl)),
+ SubLbl,
+ hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)),
+ JoinLbl,
+ hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE),
+ hipe_rtl:label_name(ContLbl),
+ SystemLimitLblName),
+ ContLbl,
+ hipe_rtl:mk_branch(TotByteSize, 'le', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE),
+ hipe_rtl:label_name(HeapLbl),
+ hipe_rtl:label_name(REFCLbl)),
+ HeapLbl,
+ hipe_tagscheme:create_heap_binary(Base, TotByteSize, TmpDst),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl2)),
+ REFCLbl,
+ hipe_rtl:mk_call([Base], bs_allocate, [TotByteSize],
+ hipe_rtl:label_name(NextLbl),[],not_remote),
+ NextLbl,
+ hipe_tagscheme:create_refc_binary(Base, TotByteSize, TmpDst),
+ JoinLbl2,
+ hipe_rtl:mk_move(Offset, Zero),
+ hipe_rtl:mk_branch(OffsetBits, 'eq', Zero,
+ hipe_rtl:label_name(NoCreateSubBin),
+ hipe_rtl:label_name(CreateSubBin)),
+ CreateSubBin,
+ hipe_tagscheme:mk_sub_binary(Dst, ByteSize, Zero, OffsetBits, Zero, TmpDst),
+ hipe_rtl:mk_goto(TrueLblName),
+ NoCreateSubBin,
+ hipe_rtl:mk_move(Dst, TmpDst),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) ->
+ [SrcBase,SrcOffset,NumBits] = create_regs(3),
+ CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName),
+ AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset,
+ NewOffset, TLName),
+ get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++
+ test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode).
+
+test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) ->
+ [Tmp] = create_regs(1),
+ [AlignedLbl,CLbl] = create_lbls(2),
+ [hipe_rtl:mk_alu(Tmp, SrcOffset, 'or', NumBits),
+ hipe_rtl:mk_alu(Tmp, Tmp, 'or', Offset),
+ hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq',
+ hipe_rtl:label_name(AlignedLbl),
+ hipe_rtl:label_name(CLbl)),
+ AlignedLbl,
+ AlignedCode,
+ CLbl,
+ CCode].
+
+put_static_binary(NewOffset, Src, Size, Base, Offset, TLName, FLName) ->
+ [SrcBase] = create_unsafe_regs(1),
+ [SrcOffset, SrcSize] = create_regs(2),
+ case Size of
+ 0 ->
+ get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++
+ [hipe_rtl:mk_move(NewOffset, Offset),
+ hipe_rtl:mk_goto(TLName)];
+ _ ->
+ SizeImm = hipe_rtl:mk_imm(Size),
+ CCode = binary_c_code(NewOffset, Src, Base, Offset, SizeImm, TLName),
+ AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeImm, Base,
+ Offset, NewOffset, TLName),
+ get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++
+ small_check(SizeImm, SrcSize, FLName) ++
+ test_alignment(SrcOffset, SizeImm, Offset, AlignedCode, CCode)
+ end.
+
+put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TLName, FLName) ->
+ [SrcBase] = create_unsafe_regs(1),
+ [SrcOffset, SrcSize] = create_regs(2),
+ CCode = binary_c_code(NewOffset, Src, Base, Offset, SizeReg, TLName),
+ AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset,
+ NewOffset, TLName),
+ get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++
+ small_check(SizeReg, SrcSize, FLName) ++
+ test_alignment(SrcOffset, SizeReg, Offset, AlignedCode, CCode).
+
+put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian,
+ ConstInfo, TrueLblName) ->
+ [CLbl] = create_lbls(1),
+ case {Aligned, LittleEndian} of
+ {true, false} ->
+ copy_float_big(Base, Offset, NewOffset, Src,
+ hipe_rtl:label_name(CLbl), TrueLblName, ConstInfo) ++
+ [CLbl|CCode];
+ {true, true} ->
+ copy_float_little(Base, Offset, NewOffset, Src,
+ hipe_rtl:label_name(CLbl), TrueLblName, ConstInfo) ++
+ [CLbl|CCode];
+ {false, _} ->
+ CCode
+ end;
+put_float(_NewOffset, _Src, _Base, _Offset, _Size, CCode, _Aligned,
+ _LittleEndian, _ConstInfo, _TrueLblName) ->
+ CCode.
+
+put_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned,
+ LittleEndian, TrueLblName) ->
+ {Init, End, UntaggedSrc} = make_init_end(Src, CCode, TrueLblName),
+ case {Aligned, LittleEndian} of
+ {true, true} ->
+ Init ++
+ copy_int_little(Base, Offset, NewOffset, Size, UntaggedSrc) ++
+ End;
+ {true, false} ->
+ Init ++
+ copy_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++
+ End;
+ {false, true} ->
+ CCode;
+ {false, false} ->
+ Init ++
+ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++
+ End
+ end.
+
+put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned,
+ LittleEndian, TrueLblName) ->
+ {Init, End, UntaggedSrc} = make_init_end(Src, TrueLblName),
+ case {Aligned, LittleEndian} of
+ {true, true} ->
+ Init ++
+ copy_int_little(Base, Offset, NewOffset, Size, UntaggedSrc) ++
+ End;
+ {true, false} ->
+ Init ++
+ copy_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++
+ End;
+ {false, true} ->
+ CCode;
+ {false, false} ->
+ Init ++
+ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++
+ End
+ end.
+
+put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned,
+ LittleEndian, TrueLblName) ->
+ {Init, End, UntaggedSrc} = make_init_end(Src, CCode, TrueLblName),
+ case Aligned of
+ true ->
+ case LittleEndian of
+ true ->
+ Init ++
+ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++
+ End;
+ false ->
+ Init ++
+ copy_int_big(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++
+ End
+ end;
+ false ->
+ CCode
+ end.
+
+put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned,
+ LittleEndian, TrueLblName) ->
+ {Init, End, UntaggedSrc} = make_init_end(Src, TrueLblName),
+ case Aligned of
+ true ->
+ case LittleEndian of
+ true ->
+ Init ++
+ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++
+ End;
+ false ->
+ Init ++
+ copy_int_big(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++
+ End
+ end;
+ false ->
+ CCode
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Help functions used by the above
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+make_init_end(Src, CCode, TrueLblName) ->
+ [CLbl, SuccessLbl] = create_lbls(2),
+ [UntaggedSrc] = create_regs(1),
+ Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl),
+ hipe_rtl:label_name(CLbl), 0.99),
+ SuccessLbl,
+ hipe_tagscheme:untag_fixnum(UntaggedSrc,Src)],
+ End = [hipe_rtl:mk_goto(TrueLblName), CLbl| CCode],
+ {Init, End, UntaggedSrc}.
+
+make_init_end(Src, TrueLblName) ->
+ [UntaggedSrc] = create_regs(1),
+ Init = [hipe_tagscheme:untag_fixnum(UntaggedSrc,Src)],
+ End = [hipe_rtl:mk_goto(TrueLblName)],
+ {Init, End, UntaggedSrc}.
+
+get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) ->
+ [JoinLbl, EndLbl, SuccessLbl, SubLbl, OtherLbl, HeapLbl, REFCLbl] =
+ Lbls = create_lbls(7),
+ [JoinLblName, EndLblName, SuccessLblName, SubLblName,
+ OtherLblName, HeapLblName, REFCLblName] = get_label_names(Lbls),
+ [BitSize,BitOffset] = create_regs(2),
+ [Orig] = create_vars(1),
+ [hipe_tagscheme:test_bitstr(Binary, SuccessLblName, FLName, 0.99),
+ SuccessLbl,
+ get_field_from_term({sub_binary,binsize}, Binary, SrcSize),
+ hipe_rtl:mk_alu(SrcSize, SrcSize, sll, ?BYTE_SHIFT),
+ hipe_tagscheme:test_subbinary(Binary, SubLblName, OtherLblName),
+ SubLbl,
+ get_field_from_term({sub_binary,bitsize}, Binary, BitSize),
+ get_field_from_term({sub_binary,offset}, Binary, SrcOffset),
+ hipe_rtl:mk_alu(SrcSize, SrcSize, add, BitSize),
+ get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset),
+ hipe_rtl:mk_alu(SrcOffset, SrcOffset, sll, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(SrcOffset, SrcOffset, add, BitOffset),
+ get_field_from_term({sub_binary,orig}, Binary, Orig),
+ hipe_rtl:mk_goto(JoinLblName),
+ OtherLbl,
+ hipe_rtl:mk_move(SrcOffset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_move(Orig, Binary),
+ JoinLbl,
+ hipe_tagscheme:test_heap_binary(Orig, HeapLblName, REFCLblName),
+ HeapLbl,
+ hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
+ hipe_rtl:mk_goto(EndLblName),
+ REFCLbl,
+ get_field_from_term({proc_bin,bytes}, Orig, SrcBase),
+ EndLbl].
+
+copy_aligned_bytes(CopyBase, CopyOffset, Size, Base, Offset, NewOffset, TrueLblName) ->
+ [BaseDst, BaseSrc] = create_unsafe_regs(2),
+ [Iter, Extra, BothOffset] = create_regs(3),
+ initializations(BaseSrc, BaseDst, BothOffset, CopyOffset, Offset, CopyBase, Base) ++
+ [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS),
+ hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)] ++
+ easy_loop(BaseSrc, BaseDst, BothOffset, Iter, Extra, TrueLblName).
+
+copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) ->
+ [TmpOffset,BothOffset,InitOffs] = create_regs(3),
+ [NewBinBase] = create_unsafe_regs(1),
+ [EasyLbl,HardLbl] = create_lbls(2),
+ [hipe_rtl:mk_alu(TmpOffset, BinOffset, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(NewBinBase, BinBase, add, TmpOffset),
+ hipe_rtl:mk_move(BothOffset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_alub(InitOffs, BinOffset, 'and', ?LOW_BITS, eq,
+ hipe_rtl:label_name(EasyLbl), hipe_rtl:label_name(HardLbl)),
+ EasyLbl,
+ hipe_rtl:mk_alu(NewOffset, BinOffset, add,
+ hipe_rtl:mk_imm(?bytes_to_bits(StringSize)))] ++
+ easy_loop(StringBase, NewBinBase, BothOffset,
+ hipe_rtl:mk_imm(StringSize), hipe_rtl:mk_imm(0), TrueLblName) ++
+ [HardLbl,
+ hipe_rtl:mk_alu(NewOffset, BinOffset, add,
+ hipe_rtl:mk_imm(?bytes_to_bits(StringSize)))] ++
+ hard_loop(StringBase, NewBinBase, BothOffset, hipe_rtl:mk_imm(StringSize),
+ InitOffs, TrueLblName).
+
+small_check(SizeVar, CopySize, FalseLblName) ->
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_branch(SizeVar, le, CopySize,
+ hipe_rtl:label_name(SuccessLbl), FalseLblName),
+ SuccessLbl].
+
+easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) ->
+ [Tmp1,Shift] = create_regs(2),
+ [LoopLbl,TopLbl,EndLbl,ExtraLbl] = create_lbls(4),
+ [TopLbl,
+ hipe_rtl:mk_branch(BothOffset, ne, Iterations, hipe_rtl:label_name(LoopLbl),
+ hipe_rtl:label_name(EndLbl), 0.99),
+ LoopLbl,
+ hipe_rtl:mk_load(Tmp1, BaseSrc, BothOffset, byte, unsigned),
+ hipe_rtl:mk_store(BaseDst, BothOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(BothOffset, BothOffset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(TopLbl)),
+ EndLbl,
+ hipe_rtl:mk_branch(Extra, eq, hipe_rtl:mk_imm(0), TrueLblName,
+ hipe_rtl:label_name(ExtraLbl)),
+ ExtraLbl,
+ hipe_rtl:mk_load(Tmp1, BaseSrc, BothOffset, byte, unsigned),
+ hipe_rtl:mk_alu(Shift, hipe_rtl:mk_imm(?BYTE_SIZE), sub, Extra),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, srl, Shift),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, Shift),
+ hipe_rtl:mk_store(BaseDst, BothOffset, Tmp1, byte),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+hard_loop(BaseSrc, BaseDst, BothOffset, Iterations,
+ InitOffset, TrueLblName) ->
+ [Tmp1, Tmp2, OldByte, NewByte, SaveByte] = create_regs(5),
+ [LoopLbl,EndLbl,TopLbl] = create_lbls(3),
+ [hipe_rtl:mk_load(OldByte, BaseDst, BothOffset, byte, unsigned),
+ hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset),
+ TopLbl,
+ hipe_rtl:mk_branch(BothOffset, ne, Iterations,
+ hipe_rtl:label_name(LoopLbl),
+ hipe_rtl:label_name(EndLbl)),
+ LoopLbl,
+ hipe_rtl:mk_load(NewByte, BaseSrc, BothOffset, byte, unsigned),
+ hipe_rtl:mk_alu(Tmp2, NewByte, srl, InitOffset),
+ hipe_rtl:mk_alu(SaveByte, OldByte, 'or', Tmp2),
+ hipe_rtl:mk_store(BaseDst, BothOffset, SaveByte, byte),
+ hipe_rtl:mk_alu(OldByte, NewByte, sll, Tmp1),
+ hipe_rtl:mk_alu(BothOffset, BothOffset, 'add', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(TopLbl)),
+ EndLbl,
+ hipe_rtl:mk_store(BaseDst, BothOffset, OldByte, byte),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+initializations(BaseTmp1, BaseTmp2, BothOffset, CopyOffset, Offset, CopyBase, Base) ->
+ [OffsetTmp1,OffsetTmp2] = create_regs(2),
+ [hipe_rtl:mk_alu(OffsetTmp1, CopyOffset, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(OffsetTmp2, Offset, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(BaseTmp1, CopyBase, add, OffsetTmp1),
+ hipe_rtl:mk_alu(BaseTmp2, Base, add, OffsetTmp2),
+ hipe_rtl:mk_move(BothOffset, hipe_rtl:mk_imm(0))].
+
+copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) ->
+ [Tmp2,TmpOffset] = create_regs(2),
+ ByteSize = Size div ?BYTE_SIZE,
+ [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++
+
+ little_loop(Tmp1, Tmp2, TmpOffset, Base) ++
+
+ case Size band 7 of
+ 0 ->
+ [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))];
+ Bits ->
+ [hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(?BYTE_SIZE-Bits)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]
+ end;
+
+copy_int_little(Base, Offset, NewOffset, Size, Tmp1) ->
+ [Tmp2, Tmp3, Tmp4, TmpOffset] = create_regs(4),
+
+ [hipe_rtl:mk_alu(Tmp2, Size, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(Tmp3, Tmp2, 'add', TmpOffset)] ++
+
+ little_loop(Tmp1, Tmp3, TmpOffset, Base) ++
+
+ [hipe_rtl:mk_alu(Tmp4, Size, 'and', ?LOW_BITS),
+ hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, Tmp4),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)].
+
+little_loop(Tmp1, Tmp3, TmpOffset, Base) ->
+ [BranchLbl, BodyLbl, EndLbl] = create_lbls(3),
+ [BranchLbl,
+ hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3,
+ hipe_rtl:label_name(BodyLbl),
+ hipe_rtl:label_name(EndLbl)),
+ BodyLbl,
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(BranchLbl)),
+ EndLbl].
+
+big_loop(Tmp1, Tmp3, TmpOffset, Base) ->
+ [BranchLbl, BodyLbl, EndLbl] = create_lbls(3),
+ [BranchLbl,
+ hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3,
+ hipe_rtl:label_name(BodyLbl),
+ hipe_rtl:label_name(EndLbl)),
+ BodyLbl,
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'sub', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(BranchLbl)),
+ EndLbl].
+
+copy_int_big(_Base, Offset, NewOffset, 0, _Tmp1) ->
+ [hipe_rtl:mk_move(NewOffset, Offset)];
+copy_int_big(Base, Offset, NewOffset, ?BYTE_SIZE, Tmp1) ->
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))];
+copy_int_big(Base, Offset, NewOffset, 2*?BYTE_SIZE, Tmp1) ->
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))];
+copy_int_big(Base, Offset, NewOffset, 3*?BYTE_SIZE, Tmp1) ->
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))];
+copy_int_big(Base, Offset,NewOffset, 4*?BYTE_SIZE, Tmp1) ->
+ copy_big_word(Base, Offset, NewOffset, Tmp1);
+copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) ->
+ [OldOffset, TmpOffset, Bits] = create_regs(3),
+ ByteSize = (Size + 7) div ?BYTE_SIZE,
+ case Size band 7 of
+ 0 ->
+ [hipe_rtl:mk_alu(OldOffset, Offset, sra, hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(TmpOffset, OldOffset, add, hipe_rtl:mk_imm(ByteSize))];
+ Rest ->
+ [hipe_rtl:mk_alu(OldOffset, Offset, sra, hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(TmpOffset, OldOffset, add, hipe_rtl:mk_imm(ByteSize-1)),
+ hipe_rtl:mk_alu(Bits, Tmp1, sll, hipe_rtl:mk_imm(?BYTE_SIZE-Rest)),
+ hipe_rtl:mk_store(Base, TmpOffset, Bits, byte),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(Rest))]
+ end ++
+ big_loop(Tmp1, OldOffset, TmpOffset, Base) ++
+ [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))];
+copy_int_big(Base, Offset, NewOffset, Size, Tmp1) ->
+ Tmp2 = hipe_rtl:mk_new_reg(),
+ Tmp3 = hipe_rtl:mk_new_reg(),
+ Tmp4 = hipe_rtl:mk_new_reg(),
+ Tmp5 = hipe_rtl:mk_new_reg(),
+ Tmp6 = hipe_rtl:mk_new_reg(),
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ EvenLbl = hipe_rtl:mk_new_label(),
+ OddLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_alu(Tmp2, Size, 'srl', hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(Tmp3, Offset, 'srl', hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(TmpOffset, Tmp2, 'add', Tmp3),
+ hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq',
+ hipe_rtl:label_name(EvenLbl), hipe_rtl:label_name(OddLbl)),
+ OddLbl,
+ hipe_rtl:mk_alu(Tmp6, hipe_rtl:mk_imm(8), 'sub', Tmp4),
+ hipe_rtl:mk_alu(Tmp5, Tmp1, 'sll', Tmp6),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp5, byte),
+ EvenLbl,
+ hipe_rtl:mk_alu(Tmp1, Tmp1, srl, Tmp4)] ++
+
+ big_loop(Tmp1, Tmp3, TmpOffset, Base) ++
+
+ [hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)].
+
+copy_big_word(Base, Offset, NewOffset, Word) ->
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'sub', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Word, Word, 'sra', hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'sub', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Word, Word, 'sra', hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'sub', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Word, Word, 'sra', hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(32))].
+
+copy_little_word(Base, Offset, NewOffset, Word) ->
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', ?BYTE_SHIFT),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Word, Word, 'sra', hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Word, Word, 'sra', hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Word, Word, 'sra', hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_store(Base, TmpOffset, Word, byte),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(32))].
+
+copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) ->
+ Tmp2 = hipe_rtl:mk_new_reg(),
+ Tmp3 = hipe_rtl:mk_new_reg(),
+ Tmp4 = hipe_rtl:mk_new_reg(),
+ Tmp5 = hipe_rtl:mk_new_reg(),
+ Tmp6 = hipe_rtl:mk_new_reg(),
+ Tmp7 = hipe_rtl:mk_new_reg(),
+ Tmp8 = hipe_rtl:mk_new_reg(),
+ Tmp9 = hipe_rtl:mk_new_reg(),
+ OldByte = hipe_rtl:mk_new_reg(),
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ BranchLbl = hipe_rtl:mk_new_label(),
+ BodyLbl = hipe_rtl:mk_new_label(),
+ EndLbl = hipe_rtl:mk_new_label(),
+ NextLbl = hipe_rtl:mk_new_label(),
+ WordSize = hipe_rtl_arch:word_size(),
+ [hipe_rtl:mk_alu(Tmp2, Offset, 'and', ?LOW_BITS),
+ hipe_rtl:mk_alu(Tmp3, Offset, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size)),
+ hipe_rtl:mk_alu(Tmp9, NewOffset, 'sub', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(TmpOffset, Tmp9, srl, ?BYTE_SHIFT),
+ hipe_rtl:mk_alu(Tmp4, NewOffset, 'and', ?LOW_BITS),
+ hipe_rtl:mk_alu(Tmp6, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4),
+ hipe_rtl:mk_alu(Tmp6, Tmp6, 'and', ?LOW_BITS),
+ hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp6),
+ hipe_rtl:mk_move(Tmp5, Tmp1),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6),
+ hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl),
+ hipe_rtl:label_name(EndLbl)),
+ NextLbl,
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_move(Tmp1, Tmp5),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', Tmp4),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'sub', hipe_rtl:mk_imm(1)),
+ BranchLbl,
+ hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(BodyLbl),
+ hipe_rtl:label_name(EndLbl)),
+ BodyLbl,
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'sub', hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(BranchLbl)),
+ EndLbl,
+ hipe_rtl:mk_load(OldByte, Base, TmpOffset, byte, unsigned),
+ hipe_rtl:mk_alu(Tmp8, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp2),
+ hipe_rtl:mk_alu(OldByte, OldByte, 'srl', Tmp8),
+ hipe_rtl:mk_alu(OldByte, OldByte, 'sll', Tmp8),
+ hipe_rtl:mk_alu(Tmp7, Tmp2, 'add',
+ hipe_rtl:mk_imm(?bytes_to_bits(WordSize-1))),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp7),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'srl', Tmp7),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, 'or', OldByte),
+ hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte)].
+
+copy_float_little(_Base, _Offset, _NewOffset, _Src, FalseLblName, _TrueLblName, fail) ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+copy_float_little(Base, Offset, NewOffset, Src, _FalseLblName, TrueLblName, pass) ->
+ FloatLo = hipe_rtl:mk_new_reg(),
+ FloatHi = hipe_rtl:mk_new_reg(),
+ TmpOffset = hipe_rtl:mk_new_reg(),
+ hipe_tagscheme:unsafe_load_float(FloatLo, FloatHi, Src) ++
+ copy_little_word(Base, Offset, TmpOffset, FloatLo) ++
+ copy_little_word(Base, TmpOffset, NewOffset, FloatHi) ++
+ [hipe_rtl:mk_goto(TrueLblName)];
+copy_float_little(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) ->
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++
+ [SuccessLbl|copy_float_little(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)].
+
+copy_float_big(_Base, _Offset, _NewOffset, _Src, FalseLblName, _TrueLblName, fail) ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+copy_float_big(Base, Offset, NewOffset, Src, _FalseLblName, TrueLblName,pass) ->
+ FloatLo = hipe_rtl:mk_new_reg(),
+ FloatHi = hipe_rtl:mk_new_reg(),
+ TmpOffset =hipe_rtl:mk_new_reg(),
+ hipe_tagscheme:unsafe_load_float(FloatLo, FloatHi, Src) ++
+ copy_big_word(Base, Offset, TmpOffset, FloatHi) ++
+ copy_big_word(Base, TmpOffset, NewOffset, FloatLo) ++
+ [hipe_rtl:mk_goto(TrueLblName)];
+copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) ->
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++
+ [SuccessLbl|copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)].
+
+make_size(1, BitsVar, FalseLblName) ->
+ [DstReg] = create_regs(1),
+ {first_part(BitsVar, DstReg, FalseLblName), DstReg};
+make_size(?BYTE_SIZE, BitsVar, FalseLblName) ->
+ [DstReg] = create_regs(1),
+ Code =
+ first_part(BitsVar, DstReg, FalseLblName) ++
+ [hipe_rtl:mk_alu(DstReg, DstReg, 'sll', ?BYTE_SHIFT)],
+ {Code, DstReg};
+make_size(UnitImm, BitsVar, FalseLblName) ->
+ [DstReg] = create_regs(1),
+ UnitList = number2list(UnitImm),
+ Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName),
+ {Code, DstReg}.
+
+multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) ->
+ Test = set_high(Head),
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ Register = hipe_rtl:mk_new_reg(),
+ Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))|
+ first_part(Variable, Register, FalseLblName)]
+ ++
+ [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test),
+ 'eq', hipe_rtl:label_name(SuccessLbl),
+ FalseLblName, 0.99),
+ SuccessLbl],
+ multiply_code(List, Register, Result, FalseLblName, Tmp1, Code).
+
+multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) ->
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, 'sll',
+ hipe_rtl:mk_imm(ShiftSize)),
+ hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99),
+ SuccessLbl],
+ multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code);
+multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) ->
+ Code.
+
+number2list(X) when is_integer(X), X >= 0 ->
+ number2list(X, []).
+
+number2list(1, Acc) ->
+ lists:reverse([0|Acc]);
+number2list(0, Acc) ->
+ lists:reverse(Acc);
+number2list(X, Acc) ->
+ F = floorlog2(X),
+ number2list(X-(1 bsl F), [F|Acc]).
+
+floorlog2(X) ->
+ round(math:log(X)/math:log(2)-0.5).
+
+set_high(X) ->
+ set_high(X, 0).
+
+set_high(0, Y) ->
+ Y;
+set_high(X, Y) ->
+ set_high(X-1, Y+(1 bsl (27-X))).
+
+get_32_bit_value(Size, USize, SystemLimitLblName, NegLblName) ->
+ Lbls = [FixLbl, BigLbl, OkLbl, PosBigLbl] = create_lbls(4),
+ [FixLblName, BigLblName, OkLblName, PosBigLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls],
+ [hipe_tagscheme:test_fixnum(Size, FixLblName, BigLblName, 0.99),
+ FixLbl,
+ hipe_tagscheme:untag_fixnum(USize, Size),
+ hipe_rtl:mk_branch(USize, ge, hipe_rtl:mk_imm(0), OkLblName, NegLblName),
+ BigLbl,
+ hipe_tagscheme:test_pos_bignum(Size, PosBigLblName, NegLblName, 0.99),
+ PosBigLbl,
+ hipe_tagscheme:get_one_word_pos_bignum(USize, Size, SystemLimitLblName),
+ OkLbl].
+
+
+first_part(Var, Register, FalseLblName) ->
+ [SuccessLbl1, SuccessLbl2] = create_lbls(2),
+ [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1),
+ FalseLblName, 0.99),
+ SuccessLbl1,
+ hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)),
+ hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99),
+ SuccessLbl2,
+ hipe_tagscheme:untag_fixnum(Register, Var)].
+
+
diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl
new file mode 100644
index 0000000000..d147bed6d8
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl
@@ -0,0 +1,1134 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_rtl_binary_match.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 5 Mar 2007 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+-module(hipe_rtl_binary_match).
+
+-export([gen_rtl/5]).
+
+-import(hipe_tagscheme, [set_field_from_term/3, get_field_from_term/3]).
+
+-include("hipe_literals.hrl").
+
+%%--------------------------------------------------------------------
+
+-define(MAX_BINSIZE, trunc(?MAX_HEAP_BIN_SIZE / hipe_rtl_arch:word_size()) + 2).
+-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa
+-define(LOW_BITS, 7). %% Three lowest bits set
+-define(BYTE_SIZE, 8).
+-define(MAX_SMALL_BITS, (hipe_rtl_arch:word_size() * ?BYTE_SIZE - 5)).
+
+%%--------------------------------------------------------------------
+
+gen_rtl({bs_start_match, 0}, [Ms], [Binary], TrueLblName, FalseLblName) ->
+ ReInitLbl = hipe_rtl:mk_new_label(),
+ BinaryLbl = hipe_rtl:mk_new_label(),
+ TestCode =
+ [hipe_rtl:mk_move(Ms,Binary),
+ hipe_tagscheme:test_matchstate(Binary,
+ hipe_rtl:label_name(ReInitLbl),
+ hipe_rtl:label_name(BinaryLbl),
+ 0.99)],
+ ReInitCode = reinit_matchstate(Ms, TrueLblName),
+ OrdinaryCode = make_matchstate(Binary, 0, Ms, TrueLblName, FalseLblName),
+ [TestCode,[ReInitLbl|ReInitCode],[BinaryLbl|OrdinaryCode]];
+gen_rtl({bs_start_match, Max}, [Ms], [Binary], TrueLblName, FalseLblName) ->
+ MatchStateLbl = hipe_rtl:mk_new_label(),
+ BinaryLbl = hipe_rtl:mk_new_label(),
+ ReSizeLbl = hipe_rtl:mk_new_label(),
+ ReInitLbl = hipe_rtl:mk_new_label(),
+ TestCode =
+ [hipe_rtl:mk_move(Ms,Binary),
+ hipe_tagscheme:test_matchstate(Binary,
+ hipe_rtl:label_name(MatchStateLbl),
+ hipe_rtl:label_name(BinaryLbl),
+ 0.99)],
+ MatchStateTestCode =
+ [hipe_tagscheme:compare_matchstate(Max, Ms,
+ hipe_rtl:label_name(ReInitLbl),
+ hipe_rtl:label_name(ReSizeLbl))],
+ ReSizeCode = resize_matchstate(Ms, Max, TrueLblName),
+ ReInitCode = reinit_matchstate(Ms, TrueLblName),
+ OrdinaryCode = make_matchstate(Binary, Max, Ms, TrueLblName, FalseLblName),
+ [TestCode, [MatchStateLbl|MatchStateTestCode], [ReSizeLbl|ReSizeCode],
+ [ReInitLbl|ReInitCode], [BinaryLbl|OrdinaryCode]];
+gen_rtl({bs_start_match, _Max}, [], [Binary], TrueLblName, FalseLblName) ->
+ MatchStateLbl = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_bitstr(Binary, TrueLblName,
+ hipe_rtl:label_name(MatchStateLbl), 0.99),
+ MatchStateLbl,
+ hipe_tagscheme:test_matchstate(Binary, TrueLblName, FalseLblName, 0.99)];
+gen_rtl({{bs_start_match, bitstr}, Max}, [Ms], [Binary],
+ TrueLblName, FalseLblName) ->
+ make_matchstate(Binary, Max, Ms, TrueLblName, FalseLblName);
+gen_rtl({{bs_start_match, bitstr}, _Max}, [], [_Binary],
+ TrueLblName, _FalseLblName) ->
+ [hipe_rtl:mk_goto(TrueLblName)];
+gen_rtl({{bs_start_match,ok_matchstate}, Max}, [Ms], [Binary],
+ TrueLblName, FalseLblName) ->
+ MatchStateLbl = hipe_rtl:mk_new_label(),
+ BinaryLbl = hipe_rtl:mk_new_label(),
+ TestCode =
+ [hipe_rtl:mk_move(Ms,Binary),
+ hipe_tagscheme:test_matchstate(Binary,
+ hipe_rtl:label_name(MatchStateLbl),
+ hipe_rtl:label_name(BinaryLbl),
+ 0.99)],
+ MatchStateCode = reinit_matchstate(Ms, TrueLblName),
+ OrdinaryCode = make_matchstate(Binary, Max, Ms, TrueLblName, FalseLblName),
+ TestCode ++ [MatchStateLbl|MatchStateCode] ++ [BinaryLbl|OrdinaryCode];
+gen_rtl({{bs_start_match, ok_matchstate}, _Max}, [], [Binary],
+ TrueLblName, FalseLblName) ->
+ MatchStateLbl = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_bitstr(Binary, TrueLblName,
+ hipe_rtl:label_name(MatchStateLbl), 0.99),
+ MatchStateLbl,
+ hipe_tagscheme:test_matchstate(Binary, TrueLblName, FalseLblName, 0.99)];
+gen_rtl({bs_get_integer, 0, _Flags}, [Dst, NewMs], [Ms],
+ TrueLblName, _FalseLblName) ->
+ update_ms(NewMs, Ms) ++
+ [hipe_rtl:mk_move(Dst, hipe_rtl:mk_imm(15)),
+ hipe_rtl:mk_goto(TrueLblName)];
+gen_rtl({bs_get_integer,Size,Flags}, [Dst,NewMs], Args,
+ TrueLblName, FalseLblName) ->
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ Signed = signed(Flags),
+ LittleEndian = littleendian(Flags),
+ Aligned = aligned(Flags),
+ UnSafe = unsafe(Flags),
+ case Args of
+ [Ms] ->
+ CCode= int_get_c_code(Dst, Ms, hipe_rtl:mk_imm(Size),
+ Flags, TrueLblName, FalseLblName),
+ update_ms(NewMs, Ms) ++
+ get_static_int(Dst, Ms, Size, CCode,
+ Signed, LittleEndian, Aligned, UnSafe,
+ TrueLblName, FalseLblName);
+ [Ms, Arg] ->
+ {SizeCode1, SizeReg1} =
+ make_size(Size, Arg, FalseLblName),
+ CCode = int_get_c_code(Dst, Ms, SizeReg1, Flags,
+ TrueLblName, FalseLblName),
+ InCode = get_dynamic_int(Dst, Ms, SizeReg1, CCode,
+ Signed, LittleEndian, Aligned,
+ TrueLblName, FalseLblName),
+ update_ms(NewMs, Ms) ++ SizeCode1 ++ InCode
+ end
+ end;
+gen_rtl({bs_get_float,Size,Flags}, [Dst1,NewMs], Args,
+ TrueLblName, FalseLblName) ->
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ [hipe_rtl:mk_gctest(3)] ++
+ case Args of
+ [Ms] ->
+ CCode = float_get_c_code(Dst1, Ms, hipe_rtl:mk_imm(Size), Flags,
+ TrueLblName, FalseLblName),
+ update_ms(NewMs, Ms) ++ CCode;
+ [Ms,Arg] ->
+ {SizeCode, SizeReg} = make_size(Size, Arg,
+ FalseLblName),
+ CCode = float_get_c_code(Dst1, Ms, SizeReg, Flags,
+ TrueLblName, FalseLblName),
+ update_ms(NewMs, Ms) ++ SizeCode ++ CCode
+ end
+ end;
+gen_rtl({bs_get_binary_all, Unit, _Flags}, [Dst], [Ms],
+ TrueLblName, FalseLblName) ->
+ [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE)] ++
+ get_binary_all(Dst, Unit, Ms, TrueLblName,FalseLblName);
+gen_rtl({bs_get_binary_all_2, Unit, _Flags}, [Dst,NewMs], [Ms],
+ TrueLblName, FalseLblName) ->
+ [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE)] ++
+ update_ms(NewMs, Ms) ++
+ get_binary_all(Dst, Unit, Ms, TrueLblName, FalseLblName);
+gen_rtl({bs_get_binary,Size,Flags}, [Dst,NewMs], Args,
+ TrueLblName, FalseLblName) ->
+ case is_illegal_const(Size) of
+ true ->
+ [hipe_rtl:mk_goto(FalseLblName)];
+ false ->
+ Unsafe = unsafe(Flags),
+ case Args of
+ [Ms] ->
+ SizeReg = hipe_rtl:mk_new_reg(),
+ SizeCode = [hipe_rtl:mk_move(SizeReg, hipe_rtl:mk_imm(Size))];
+ [Ms, BitsVar] ->
+ {SizeCode, SizeReg} = make_size(Size, BitsVar, FalseLblName)
+ end,
+ InCode = get_binary(Dst, Ms, SizeReg, Unsafe,
+ TrueLblName, FalseLblName),
+ [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE)] ++
+ update_ms(NewMs, Ms) ++ SizeCode ++ InCode
+ end;
+gen_rtl(bs_get_utf8, [Dst,NewMs], [Ms], TrueLblName, FalseLblName) ->
+ update_ms(NewMs, Ms) ++ utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName);
+gen_rtl({bs_get_utf16,Flags}, [Dst,NewMs], [Ms], TrueLblName, FalseLblName) ->
+ update_ms(NewMs, Ms) ++ utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName);
+gen_rtl(bs_validate_unicode_retract, [NewMs], [Src,Ms], TrueLblName, FalseLblName) ->
+ update_ms(NewMs, Ms) ++ validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName);
+gen_rtl({bs_test_tail, NumBits}, [NewMs], [Ms], TrueLblName, FalseLblName) ->
+ {[Offset,BinSize], ExCode} = extract_matchstate_vars([offset,binsize], Ms),
+ update_ms(NewMs, Ms) ++ ExCode ++
+ [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(NumBits), FalseLblName),
+ hipe_rtl:mk_branch(Offset, eq, BinSize, TrueLblName, FalseLblName)];
+gen_rtl({bs_test_unit, Unit}, [], [Ms], TrueLblName, FalseLblName) ->
+ {[Offset,BinSize], ExCode} = extract_matchstate_vars([offset,binsize], Ms),
+ SizeReg = hipe_rtl:mk_new_reg(),
+ ExCode ++
+ [hipe_rtl:mk_alu(SizeReg, BinSize, sub, Offset)|
+ test_alignment_code(SizeReg, Unit, TrueLblName, FalseLblName)];
+gen_rtl({bs_test_tail, NumBits}, [], [Ms], TrueLblName, FalseLblName) ->
+ {[Offset,BinSize], ExCode} = extract_matchstate_vars([offset,binsize], Ms),
+ ExCode ++
+ [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(NumBits), FalseLblName),
+ hipe_rtl:mk_branch(Offset, eq, BinSize, TrueLblName, FalseLblName)];
+gen_rtl({bs_skip_bits_all, Unit, _Flags}, Dst, [Ms],
+ TrueLblName, FalseLblName) ->
+ opt_update_ms(Dst, Ms) ++
+ skip_bits_all(Unit, Ms, TrueLblName, FalseLblName);
+gen_rtl({bs_skip_bits, Bits}, Dst, [Ms|Args], TrueLblName, FalseLblName) ->
+ opt_update_ms(Dst,Ms) ++
+ case Args of
+ [] ->
+ skip_bits2(Ms, hipe_rtl:mk_imm(Bits), TrueLblName, FalseLblName);
+ [Arg] ->
+ {SizeCode, SizeReg} = make_size(Bits, Arg, FalseLblName),
+ InCode = skip_bits2(Ms, SizeReg, TrueLblName, FalseLblName),
+ SizeCode ++ InCode
+ end;
+gen_rtl({bs_restore, Slot}, [NewMs], [Ms], TrueLblName, _FalseLblName) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ update_ms(NewMs, Ms) ++
+ [get_field_from_term({matchstate, {saveoffset, Slot}}, Ms, Tmp1),
+ set_field_from_term({matchstate, {matchbuffer, offset}}, Ms, Tmp1),
+ hipe_rtl:mk_goto(TrueLblName)];
+gen_rtl({bs_save, Slot}, [NewMs], [Ms], TrueLblName, _FalseLblName) ->
+ {Offset, Instr} = extract_matchstate_var(offset, Ms),
+ update_ms(NewMs, Ms) ++
+ [Instr,
+ set_field_from_term({matchstate, {saveoffset, Slot}}, Ms, Offset),
+ hipe_rtl:mk_goto(TrueLblName)];
+gen_rtl({bs_match_string, String, ByteSize}, [NewMs],
+ [Ms], TrueLblName, FalseLblName) ->
+ {[Offset, BinSize, Base], Instrs} =
+ extract_matchstate_vars([offset, binsize, base], Ms),
+ [SuccessLbl, ALbl, ULbl] = create_lbls(3),
+ [NewOffset,BitOffset] = create_gcsafe_regs(2),
+ Unit = hipe_rtl_arch:word_size() - 1,
+ Loops = ByteSize div Unit,
+ Init =
+ [Instrs,
+ update_ms(NewMs,Ms),
+ check_size(Offset, hipe_rtl:mk_imm(ByteSize*?BYTE_SIZE), BinSize,
+ NewOffset, hipe_rtl:label_name(SuccessLbl), FalseLblName),
+ SuccessLbl],
+ SplitCode =
+ [hipe_rtl:mk_alub(BitOffset, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS), eq,
+ hipe_rtl:label_name(ALbl), hipe_rtl:label_name(ULbl))],
+ Loops = ByteSize div Unit,
+ SkipSize = Loops * Unit,
+ {ACode1,UCode1} =
+ case Loops of
+ 0 ->
+ {[],[]};
+ _ ->
+ create_loops(Loops, Unit, String, Base,
+ Offset, BitOffset, FalseLblName)
+ end,
+ <<_:SkipSize/binary, RestString/binary>> = String,
+ {ACode2, UCode2} =
+ case ByteSize rem Unit of
+ 0 ->
+ {[],[]};
+ Rem ->
+ create_rests(Rem, RestString, Base, Offset, BitOffset, FalseLblName)
+ end,
+ End = [update_offset(NewOffset, NewMs), hipe_rtl:mk_goto(TrueLblName)],
+ [Init, SplitCode, ALbl, ACode1, ACode2, End, ULbl, UCode1, UCode2,End];
+gen_rtl(bs_context_to_binary, [Bin], [Var], TrueLblName, _FalseLblName) ->
+ MSLabel = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_move(Bin, Var),
+ hipe_tagscheme:test_matchstate(Var, hipe_rtl:label_name(MSLabel),
+ TrueLblName, 0.5),
+ MSLabel,
+ hipe_tagscheme:convert_matchstate(Bin),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Calls to C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+int_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) ->
+ make_int_gc_code(Size) ++
+ get_c_code(bs_get_integer_2, Dst1, Ms, Size, Flags,
+ TrueLblName, FalseLblName).
+
+float_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) ->
+ get_c_code(bs_get_float_2, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName).
+
+get_c_code(Func, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) ->
+ SizeReg = hipe_rtl:mk_new_reg_gcsafe(),
+ FlagsReg = hipe_rtl:mk_new_reg_gcsafe(),
+ MatchBuf = hipe_rtl:mk_new_reg(),
+ RetLabel = hipe_rtl:mk_new_label(),
+ NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
+ [hipe_rtl:mk_move(SizeReg, Size),
+ hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)),
+ hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
+ hipe_rtl_arch:call_bif([Dst1], Func, [SizeReg, FlagsReg, MatchBuf],
+ hipe_rtl:label_name(RetLabel), FalseLblName),
+ RetLabel,
+ hipe_rtl:mk_branch(Dst1, eq, NonVal,
+ FalseLblName,
+ TrueLblName, 0.01)].
+
+utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName) ->
+ MatchBuf = hipe_rtl:mk_new_reg(),
+ NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
+ [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
+ hipe_rtl_arch:call_bif([Dst], bs_get_utf8, [MatchBuf], [], []),
+ hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)].
+
+utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName) ->
+ MatchBuf = hipe_rtl:mk_new_reg(),
+ NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
+ FlagsReg = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
+ hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)),
+ hipe_rtl_arch:call_bif([Dst], bs_get_utf16, [MatchBuf, FlagsReg], [], []),
+ hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)].
+
+validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) ->
+ MatchBuf = hipe_rtl:mk_new_reg(),
+ Zero = hipe_rtl:mk_imm(0),
+ Tmp = hipe_rtl:mk_new_reg(),
+ [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
+ hipe_rtl_arch:call_bif([Tmp], bs_validate_unicode_retract,
+ [MatchBuf,Src], [], []),
+ hipe_rtl:mk_branch(Tmp, eq, Zero, FalseLblName, TrueLblName, 0.01)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Int Code %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+create_loops(Loops, Unit, String, Base, Offset, BitOffset, FalseLblName) ->
+ [Reg] = create_gcsafe_regs(1),
+ AlignedFun = fun(Value) ->
+ [get_int_to_reg(Reg, Unit*?BYTE_SIZE, Base, Offset, 'srl',
+ {unsigned, big}),
+ update_and_test(Reg, Unit, Offset, Value, FalseLblName)]
+ end,
+ UnAlignedFun = fun(Value) ->
+ [get_unaligned_int_to_reg(Reg, Unit*?BYTE_SIZE,
+ Base, Offset, BitOffset,
+ 'srl', {unsigned, big})|
+ update_and_test(Reg, Unit, Offset, Value, FalseLblName)]
+ end,
+ {create_loops(Loops, Unit, String, AlignedFun),
+ create_loops(Loops, Unit, String, UnAlignedFun)}.
+
+create_rests(Rem, String, Base, Offset, BitOffset, FalseLblName) ->
+ [Reg] = create_gcsafe_regs(1),
+ AlignedFun = fun(Value) ->
+ [get_int_to_reg(Reg, Rem*?BYTE_SIZE, Base, Offset, 'srl',
+ {unsigned, big})|
+ just_test(Reg, Value, FalseLblName)]
+ end,
+ UnAlignedFun = fun(Value) ->
+ [get_unaligned_int_to_reg(Reg, Rem*?BYTE_SIZE,
+ Base, Offset, BitOffset,
+ 'srl', {unsigned, big})|
+ just_test(Reg, Value, FalseLblName)]
+ end,
+ {create_loops(1, Rem, String, AlignedFun),
+ create_loops(1, Rem, String, UnAlignedFun)}.
+
+create_loops(0, _Unit, _String, _IntFun) ->
+ [];
+create_loops(N, Unit, String, IntFun) ->
+ {Value, RestString} = get_value(Unit,String),
+ [IntFun(Value),
+ create_loops(N-1, Unit, RestString, IntFun)].
+
+update_and_test(Reg, Unit, Offset, Value, FalseLblName) ->
+ [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(Unit*?BYTE_SIZE), FalseLblName),
+ just_test(Reg, Value, FalseLblName)].
+
+just_test(Reg, Value, FalseLblName) ->
+ [ContLbl] = create_lbls(1),
+ [hipe_rtl:mk_branch(Reg, eq, hipe_rtl:mk_imm(Value),
+ hipe_rtl:label_name(ContLbl), FalseLblName),
+ ContLbl].
+
+get_value(N,String) ->
+ <<I:N/integer-unit:8, Rest/binary>> = String,
+ {I, Rest}.
+
+make_int_gc_code(I) when is_integer(I) ->
+ case hipe_tagscheme:bignum_sizeneed(I) of
+ 0 -> [];
+ X when is_integer(X) -> [hipe_rtl:mk_gctest(X)]
+ end;
+make_int_gc_code(SReg) ->
+ FixNumLbl = hipe_rtl:mk_new_label(),
+ FixNumLblName = hipe_rtl:label_name(FixNumLbl),
+ {ResReg,Code} = hipe_tagscheme:bignum_sizeneed_code(SReg, FixNumLblName),
+ Code ++
+ [hipe_rtl:mk_gctest(ResReg),
+ hipe_rtl:mk_goto(FixNumLblName),
+ FixNumLbl].
+
+get_static_int(Dst1, Ms, Size, CCode, Signed, LittleEndian, Aligned,
+ Unsafe, TrueLblName, FalseLblName) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ case Size =< WordSize*?BYTE_SIZE of
+ true ->
+ case {Aligned, LittleEndian} of
+ {true, false} ->
+ get_int_from_bin(Ms, Size, Dst1,Signed, LittleEndian,
+ Unsafe, FalseLblName, TrueLblName);
+ {true, true} ->
+ case Size rem ?BYTE_SIZE of
+ 0 ->
+ get_int_from_bin(Ms, Size, Dst1, Signed, LittleEndian,
+ Unsafe, FalseLblName, TrueLblName);
+ _ ->
+ CCode
+ end;
+ {false, false} ->
+ get_int_from_unaligned_bin(Ms, Size, Dst1, Signed,
+ Unsafe, FalseLblName, TrueLblName);
+ {false, true} ->
+ CCode
+ end;
+ false ->
+ CCode
+ end.
+
+get_dynamic_int(Dst1, Ms, SizeReg, CCode, Signed, LittleEndian, true,
+ TrueLblName, FalseLblName) ->
+ {Init, End} = make_dyn_prep(SizeReg, CCode),
+ Init ++
+ get_unknown_size_int(SizeReg, Ms, Dst1, Signed, LittleEndian,
+ FalseLblName, TrueLblName) ++
+ End;
+get_dynamic_int(_Dst1, _Ms, _SizeReg, CCode, _Signed, _LittleEndian, false,
+ _TrueLblName, _FalseLblName) ->
+ CCode.
+
+get_int_from_bin(Ms, Size, Dst1, Signed, LittleEndian,
+ Unsafe, FalseLblName, TrueLblName) ->
+ Shiftr = shift_type(Signed),
+ Type = get_type(Signed, LittleEndian),
+ NewOffset = hipe_rtl:mk_new_reg_gcsafe(),
+ [SuccessLbl] = create_lbls(1),
+ {[Base,Offset,BinSize], ExCode} =
+ extract_matchstate_vars([base,offset,binsize], Ms),
+ ExCode ++
+ [check_size(Offset, hipe_rtl:mk_imm(Size), BinSize, NewOffset,
+ Unsafe, hipe_rtl:label_name(SuccessLbl), FalseLblName),
+ SuccessLbl] ++
+ [update_offset(NewOffset, Ms)] ++
+ get_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName).
+
+get_int_from_unaligned_bin(Ms, Size, Dst1, Signed,
+ UnSafe, FalseLblName, TrueLblName) ->
+ Shiftr = shift_type(Signed),
+ Type = get_type(Signed, false),
+ NewOffset = hipe_rtl:mk_new_reg_gcsafe(),
+ [SuccessLbl] = create_lbls(1),
+ {[Base,Offset,BinSize], ExCode} =
+ extract_matchstate_vars([base,offset,binsize], Ms),
+ ExCode ++
+ [check_size(Offset, hipe_rtl:mk_imm(Size), BinSize, NewOffset,
+ UnSafe, hipe_rtl:label_name(SuccessLbl), FalseLblName),
+ SuccessLbl] ++
+ [update_offset(NewOffset, Ms)] ++
+ get_unaligned_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName).
+
+get_unknown_size_int(SizeReg, Ms, Dst1, Signed, Little,
+ FalseLblName, TrueLblName) ->
+ Shiftr = shift_type(Signed),
+ Type = get_type(Signed, false),
+ [NewOffset] = create_gcsafe_regs(1),
+ [SuccessLbl] = create_lbls(1),
+ {[Base,Offset,BinSize], ExCode} =
+ extract_matchstate_vars([base,offset,binsize], Ms),
+ ExCode ++
+ [check_size(Offset, SizeReg, BinSize, NewOffset,
+ hipe_rtl:label_name(SuccessLbl), FalseLblName),
+ SuccessLbl,
+ update_offset(NewOffset, Ms)] ++
+ case Little of
+ true ->
+ get_little_unknown_int(Dst1, Base, Offset, NewOffset,
+ Shiftr, Type, TrueLblName);
+ false ->
+ get_big_unknown_int(Dst1, Base, Offset, NewOffset,
+ Shiftr, Type, TrueLblName)
+ end.
+
+make_matchstate(Binary, Max, Ms, TrueLblName, FalseLblName) ->
+ Base = hipe_rtl:mk_new_reg(),
+ Orig = hipe_rtl:mk_new_var(),
+ BinSize = hipe_rtl:mk_new_reg_gcsafe(),
+ Offset = hipe_rtl:mk_new_reg_gcsafe(),
+ Lbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_gctest(?MS_MIN_SIZE+Max),
+ get_binary_bytes(Binary, BinSize, Base, Offset,
+ Orig, hipe_rtl:label_name(Lbl), FalseLblName),
+ Lbl,
+ hipe_tagscheme:create_matchstate(Max, BinSize, Base, Offset, Orig, Ms),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+resize_matchstate(Ms, Max, TrueLblName) ->
+ Base = hipe_rtl:mk_new_reg(),
+ Orig = hipe_rtl:mk_new_var(),
+ BinSize = hipe_rtl:mk_new_reg_gcsafe(),
+ Offset = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_gctest(?MS_MIN_SIZE+Max),
+ get_field_from_term({matchstate, {matchbuffer, binsize}}, Ms, BinSize),
+ get_field_from_term({matchstate, {matchbuffer, base}}, Ms, Base),
+ get_field_from_term({matchstate, {matchbuffer, orig}}, Ms, Orig),
+ get_field_from_term({matchstate, {matchbuffer, offset}}, Ms, Offset),
+ hipe_tagscheme:create_matchstate(Max, BinSize, Base, Offset, Orig, Ms),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+reinit_matchstate(Ms, TrueLblName) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [get_field_from_term({matchstate, {matchbuffer, offset}}, Ms, Tmp),
+ set_field_from_term({matchstate, {saveoffset, 0}}, Ms, Tmp),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%% Binary Code %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_binary_all(Dst1, 1, Ms, TrueLblName, _FalseLblName) ->
+ [SizeReg] = create_gcsafe_regs(1),
+ {[Offset,BinSize,Orig], ExCode} =
+ extract_matchstate_vars([offset,binsize,orig], Ms),
+ MakeCode =
+ [hipe_rtl:mk_alu(SizeReg, BinSize, sub, Offset)|
+ construct_subbin(Dst1,SizeReg,Offset,Orig)] ++
+ [update_offset(BinSize, Ms),
+ hipe_rtl:mk_goto(TrueLblName)],
+ ExCode ++ MakeCode;
+get_binary_all(Dst1, Unit, Ms, TrueLblName, FalseLblName) ->
+ [SizeReg] = create_gcsafe_regs(1),
+ [SuccessLbl] = create_lbls(1),
+ SLblName = hipe_rtl:label_name(SuccessLbl),
+ {[Offset,BinSize,Orig], ExCode} =
+ extract_matchstate_vars([offset,binsize,orig], Ms),
+ MakeCode =
+ [hipe_rtl:mk_alu(SizeReg, BinSize, sub, Offset)|
+ test_alignment_code(SizeReg,Unit,SLblName,FalseLblName)] ++
+ [SuccessLbl|
+ construct_subbin(Dst1,SizeReg,Offset,Orig)] ++
+ [update_offset(BinSize, Ms),
+ hipe_rtl:mk_goto(TrueLblName)],
+ ExCode ++ MakeCode.
+
+get_binary(Dst1, Ms, SizeReg,
+ UnSafe, TrueLblName, FalseLblName) ->
+ [SuccessLbl] = create_lbls(1),
+ [EndOffset] = create_gcsafe_regs(1),
+ {[Offset,BinSize,Orig], ExCode} =
+ extract_matchstate_vars([offset,binsize,orig], Ms),
+ CheckCode =
+ [check_size(Offset, SizeReg, BinSize, EndOffset,
+ UnSafe, hipe_rtl:label_name(SuccessLbl),
+ FalseLblName),
+ SuccessLbl],
+ MakeCode =
+ construct_subbin(Dst1,SizeReg,Offset,Orig)
+ ++ [update_offset(EndOffset, Ms),
+ hipe_rtl:mk_goto(TrueLblName)],
+ ExCode ++ CheckCode ++ MakeCode.
+
+construct_subbin(Dst,Size,Offset,Orig) ->
+ [BitOffset, ByteOffset, BitSize, ByteSize] = create_gcsafe_regs(4),
+ [hipe_rtl:mk_alu(ByteSize, Size, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ hipe_rtl:mk_alu(BitSize, Size, 'and', hipe_rtl:mk_imm(?LOW_BITS)),
+ hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ hipe_rtl:mk_alu(BitOffset, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS)),
+ hipe_tagscheme:mk_sub_binary(Dst, ByteSize, ByteOffset,
+ BitSize, BitOffset, Orig)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%% Skip Bits %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+skip_bits_all(1, Ms, TrueLblName,_FalseLblName) ->
+ {[BinSize], ExCode} = extract_matchstate_vars([binsize], Ms),
+ ExCode ++
+ [update_offset(BinSize,Ms),
+ hipe_rtl:mk_goto(TrueLblName)];
+skip_bits_all(Unit,Ms, TrueLblName,FalseLblName) ->
+ [Size] = create_gcsafe_regs(1),
+ [SuccessLbl] = create_lbls(1),
+ SLblName = hipe_rtl:label_name(SuccessLbl),
+ {[Offset,BinSize], ExCode} = extract_matchstate_vars([offset,binsize], Ms),
+ ExCode ++
+ [hipe_rtl:mk_alu(Size,BinSize,sub,Offset)]
+ ++
+ test_alignment_code(Size,Unit,SLblName,FalseLblName) ++
+ [SuccessLbl,
+ update_offset(BinSize,Ms),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+test_alignment_code(Size,Unit,SLblName,FalseLblName) ->
+ case Unit of
+ 1 -> [hipe_rtl:mk_goto(SLblName)];
+ 2 -> get_fast_test_code(Size,1,SLblName,FalseLblName);
+ 4 -> get_fast_test_code(Size,3,SLblName,FalseLblName);
+ 8 -> get_fast_test_code(Size,7,SLblName,FalseLblName);
+ 16 -> get_fast_test_code(Size,15,SLblName,FalseLblName);
+ 32 -> get_fast_test_code(Size,31,SLblName,FalseLblName);
+ _ -> get_slow_test_code(Size,Unit,SLblName,FalseLblName)
+ end.
+
+get_fast_test_code(Size,AndTest,SLblName,FalseLblName) ->
+ [Tmp] = create_gcsafe_regs(1),
+ [hipe_rtl:mk_alub(Tmp,Size,'and',hipe_rtl:mk_imm(AndTest),
+ eq,SLblName,FalseLblName)].
+
+%% This is really slow
+get_slow_test_code(Size,Unit,SLblName,FalseLblName) ->
+ [Tmp] = create_gcsafe_regs(1),
+ [LoopLbl,Lbl1,Lbl2] = create_lbls(3),
+ LoopLblName = hipe_rtl:label_name(LoopLbl),
+ Lbl1Name = hipe_rtl:label_name(Lbl1),
+ Lbl2Name = hipe_rtl:label_name(Lbl2),
+ [hipe_rtl:mk_move(Tmp,Size),
+ LoopLbl,
+ hipe_rtl:mk_branch(Tmp, eq, hipe_rtl:mk_imm(0), SLblName, Lbl1Name),
+ Lbl1,
+ hipe_rtl:mk_branch(Tmp, lt, hipe_rtl:mk_imm(0), FalseLblName, Lbl2Name),
+ Lbl2,
+ hipe_rtl:mk_alu(Tmp,Tmp,sub,hipe_rtl:mk_imm(Unit)),
+ hipe_rtl:mk_goto(LoopLblName)].
+
+skip_bits2(Ms, NoOfBits, TrueLblName, FalseLblName) ->
+ [NewOffset] = create_gcsafe_regs(1),
+ [TempLbl] = create_lbls(1),
+ {[Offset,BinSize], ExCode} = extract_matchstate_vars([offset,binsize], Ms),
+ ExCode ++
+ add_to_offset(NewOffset, NoOfBits, Offset, FalseLblName) ++
+ [hipe_rtl:mk_branch(BinSize, 'ltu', NewOffset, FalseLblName,
+ hipe_rtl:label_name(TempLbl), 0.01),
+ TempLbl,
+ update_offset(NewOffset,Ms),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+add_to_offset(Result, Extra, Original, FalseLblName) ->
+ TrueLbl = hipe_rtl:mk_new_label(),
+ %% Note: 'ltu' means 'unsigned overflow'.
+ [hipe_rtl:mk_alub(Result, Extra, 'add', Original, 'ltu',
+ FalseLblName, hipe_rtl:label_name(TrueLbl)),
+ TrueLbl].
+
+%%%%%%%%%%%%%%%%%%%%%%% Code for start match %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_binary_bytes(Binary, BinSize, Base, Offset, Orig,
+ TrueLblName, FalseLblName) ->
+ [OrigOffset,BitSize,BitOffset] = create_gcsafe_regs(3),
+ [SuccessLbl,SubLbl,OtherLbl,JoinLbl] = create_lbls(4),
+ [hipe_tagscheme:test_bitstr(Binary, hipe_rtl:label_name(SuccessLbl),
+ FalseLblName, 0.99),
+ SuccessLbl,
+ get_field_from_term({sub_binary, binsize}, Binary, BinSize),
+ hipe_rtl:mk_alu(BinSize, BinSize, sll, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ hipe_tagscheme:test_subbinary(Binary, hipe_rtl:label_name(SubLbl),
+ hipe_rtl:label_name(OtherLbl)),
+ SubLbl,
+ get_field_from_term({sub_binary, offset}, Binary, OrigOffset),
+ hipe_rtl:mk_alu(Offset, OrigOffset, sll, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ get_field_from_term({sub_binary, bitoffset}, Binary, BitOffset),
+ hipe_rtl:mk_alu(Offset, Offset, add, BitOffset),
+ get_field_from_term({sub_binary, bitsize}, Binary, BitSize),
+ hipe_rtl:mk_alu(BinSize, BinSize, add, Offset),
+ hipe_rtl:mk_alu(BinSize, BinSize, add, BitSize),
+ get_field_from_term({sub_binary, orig}, Binary, Orig),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl)),
+ OtherLbl,
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_move(Orig, Binary),
+ JoinLbl] ++
+ get_base(Orig,Base) ++
+ [hipe_rtl:mk_goto(TrueLblName)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%% UTILS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_base(Orig,Base) ->
+ [HeapLbl,REFCLbl,EndLbl] = create_lbls(3),
+ [hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl),
+ hipe_rtl:label_name(REFCLbl)),
+ HeapLbl,
+ hipe_rtl:mk_alu(Base, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)),
+ REFCLbl,
+ hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)),
+ EndLbl].
+
+extract_matchstate_var(binsize, Ms) ->
+ BinSize = hipe_rtl:mk_new_reg_gcsafe(),
+ {BinSize,
+ get_field_from_term({matchstate, {matchbuffer, binsize}}, Ms, BinSize)};
+extract_matchstate_var(offset, Ms) ->
+ Offset = hipe_rtl:mk_new_reg_gcsafe(),
+ {Offset,
+ get_field_from_term({matchstate, {matchbuffer, offset}}, Ms, Offset)};
+extract_matchstate_var(base, Ms) ->
+ Base = hipe_rtl:mk_new_reg(),
+ {Base,
+ get_field_from_term({matchstate, {matchbuffer, base}}, Ms, Base)};
+extract_matchstate_var(orig, Ms) ->
+ Orig = hipe_rtl:mk_new_var(),
+ {Orig,
+ get_field_from_term({matchstate, {matchbuffer, orig}}, Ms, Orig)}.
+
+extract_matchstate_vars(List, Ms) ->
+ lists:unzip([extract_matchstate_var(Name, Ms) || Name <- List]).
+
+check_size(Offset, Size, BinSize, Tmp1, ContLblName, FalseLblName) ->
+ [add_to_offset(Tmp1, Offset, Size, FalseLblName),
+ hipe_rtl:mk_branch(Tmp1, leu, BinSize, ContLblName, FalseLblName, 0.99)].
+
+check_size(Offset, Size, _BinSize, Tmp1, true, ContLblName, _FalseLblName) ->
+ [hipe_rtl:mk_alu(Tmp1, Offset, add, Size),
+ hipe_rtl:mk_goto(ContLblName)];
+check_size(Offset, Size, BinSize, Tmp1, false, ContLblName, FalseLblName) ->
+ check_size(Offset, Size, BinSize, Tmp1, ContLblName, FalseLblName).
+
+shift_type(true) ->
+ sra;
+shift_type(false) ->
+ srl.
+
+get_type(true, LittleEndian) ->
+ {signed, endianess(LittleEndian)};
+get_type(false, LittleEndian) ->
+ {unsigned, endianess(LittleEndian)}.
+
+endianess(true) ->
+ little;
+endianess(false) ->
+ big.
+
+aligned(Flags) ->
+ case Flags band ?BSF_ALIGNED of
+ 1 -> true;
+ 0 -> false
+ end.
+
+littleendian(Flags) ->
+ case Flags band 2 of
+ 2 -> true;
+ 0 -> false
+ end.
+
+signed(Flags) ->
+ case Flags band 4 of
+ 4 -> true;
+ 0 -> false
+ end.
+
+unsafe(Flags) ->
+ case Flags band 16 of
+ 16 -> true;
+ 0 -> false
+ end.
+
+update_offset(NewOffset, Ms) ->
+ set_field_from_term({matchstate,{matchbuffer,offset}},
+ Ms, NewOffset).
+
+opt_update_ms([NewMs], OldMs) ->
+ [hipe_rtl:mk_move(NewMs, OldMs)];
+opt_update_ms([], _OldMs) ->
+ [].
+
+update_ms(NewMs, OldMs) ->
+ [hipe_rtl:mk_move(NewMs, OldMs)].
+
+create_lbls(0) ->
+ [];
+create_lbls(X) when X > 0->
+ [hipe_rtl:mk_new_label()|create_lbls(X-1)].
+
+make_dyn_prep(SizeReg, CCode) ->
+ [CLbl, SuccessLbl] = create_lbls(2),
+ Init = [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(?MAX_SMALL_BITS),
+ hipe_rtl:label_name(SuccessLbl),
+ hipe_rtl:label_name(CLbl)),
+ SuccessLbl],
+ End = [CLbl|CCode],
+ {Init, End}.
+
+%%------------------------------------------------------------------------
+%% From hipe_rtl_binutil.erl
+%%------------------------------------------------------------------------
+
+get_unaligned_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName) ->
+ [Reg] = create_regs(1),
+ [get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type),
+ do_bignum_code(Size, Type, Reg, Dst1, TrueLblName)].
+
+get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type) ->
+ [LowBits] = create_regs(1),
+ [AlignedLbl, UnAlignedLbl, EndLbl] = create_lbls(3),
+ [hipe_rtl:mk_alub(LowBits, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS),
+ eq, hipe_rtl:label_name(AlignedLbl),
+ hipe_rtl:label_name(UnAlignedLbl)),
+ AlignedLbl,
+ get_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)),
+ UnAlignedLbl,
+ get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type),
+ EndLbl].
+
+get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type) ->
+ [ByteOffset, ShiftBits, LoadDst, Tmp, TotBits] = create_gcsafe_regs(5),
+ [MoreLbl, LessLbl, JoinLbl] = create_lbls(3),
+ WordSize = hipe_rtl_arch:word_size(),
+ MinLoad = (Size-1) div ?BYTE_SIZE +1,
+ MaxLoad = MinLoad + 1,
+ Code1 =
+ [hipe_rtl:mk_alu(TotBits, LowBits, 'add', hipe_rtl:mk_imm(Size)),
+ hipe_rtl:mk_alu(ByteOffset, Offset, 'srl', hipe_rtl:mk_imm(?BYTE_SHIFT))],
+ Code2 =
+ case {Size rem ?BYTE_SIZE, MinLoad} of
+ {1, _} ->
+ [load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad),
+ hipe_rtl:mk_alu(ShiftBits, LowBits, 'add',
+ hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE))];
+ {_, WordSize} ->
+ UnsignedBig = {unsigned, big},
+ [hipe_rtl:mk_branch(TotBits, le, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE),
+ hipe_rtl:label_name(LessLbl),
+ hipe_rtl:label_name(MoreLbl)),
+ LessLbl,
+ load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad),
+ hipe_rtl:mk_alu(ShiftBits, LowBits, 'add',
+ hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl)),
+ MoreLbl,
+ load_bytes(LoadDst, Base, ByteOffset, UnsignedBig, MinLoad),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, 'sll', LowBits),
+ load_bytes(Tmp, Base, ByteOffset, UnsignedBig, 1),
+ hipe_rtl:mk_alu(LowBits, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', LowBits),
+ hipe_rtl:mk_alu(Tmp, Tmp, 'srl', LowBits),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, 'or', Tmp),
+ hipe_rtl:mk_move(ShiftBits, hipe_rtl:mk_imm(0)),
+ JoinLbl];
+ {_, _} ->
+ [load_bytes(LoadDst, Base, ByteOffset, Type, MaxLoad),
+ hipe_rtl:mk_alu(ShiftBits, LowBits, 'add',
+ hipe_rtl:mk_imm((WordSize-MaxLoad)*?BYTE_SIZE))]
+ end,
+ Code3 =
+ [hipe_rtl:mk_alu(Tmp, LoadDst, sll, ShiftBits),
+ hipe_rtl:mk_alu(Reg, Tmp, Shiftr,
+ hipe_rtl:mk_imm(WordSize*?BYTE_SIZE-Size))],
+ Code1 ++ Code2 ++ Code3.
+
+get_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName) ->
+ [Reg] = create_gcsafe_regs(1),
+ [get_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type),
+ do_bignum_code(Size, Type, Reg, Dst1, TrueLblName)].
+
+get_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type) ->
+ [ByteOffset] = create_gcsafe_regs(1),
+ Code1 =
+ [hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ load_bytes(Reg, Base, ByteOffset, Type, ((Size-1) div ?BYTE_SIZE +1))],
+ Code2 =
+ case Size rem ?BYTE_SIZE of
+ 0 ->
+ [];
+ _ ->
+ [hipe_rtl:mk_alu(Reg, Reg, Shiftr,
+ hipe_rtl:mk_imm(?BYTE_SIZE -Size rem ?BYTE_SIZE))]
+ end,
+ Code1 ++ Code2.
+
+get_big_unknown_int(Dst1, Base, Offset, NewOffset,
+ Shiftr, Type, TrueLblName) ->
+ [LoadDst, ByteOffset, Limit, Tmp, LowBits] = create_gcsafe_regs(5),
+ [ContLbl, BackLbl, LoopLbl, TagLbl, LastLbl, EndLbl] = create_lbls(6),
+ [hipe_rtl:mk_move(LoadDst, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_branch(NewOffset, ne, Offset, hipe_rtl:label_name(ContLbl),
+ hipe_rtl:label_name(TagLbl), 0.99),
+ ContLbl,
+ hipe_rtl:mk_alu(Limit, NewOffset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Limit, Limit, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ load_bytes(LoadDst, Base, ByteOffset, Type, 1),
+ BackLbl,
+ hipe_rtl:mk_branch(ByteOffset, le, Limit, hipe_rtl:label_name(LoopLbl),
+ hipe_rtl:label_name(EndLbl)),
+ LoopLbl,
+ load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, sll, hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, 'or', Tmp),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(BackLbl)),
+ EndLbl,
+ hipe_rtl:mk_alub(LowBits, NewOffset, 'and', hipe_rtl:mk_imm(?LOW_BITS), eq,
+ hipe_rtl:label_name(TagLbl), hipe_rtl:label_name(LastLbl)),
+ LastLbl,
+ hipe_rtl:mk_alu(LowBits, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', LowBits),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, Shiftr, LowBits),
+ TagLbl] ++
+ do_bignum_code(64, Type, LoadDst, Dst1, TrueLblName).
+
+get_little_unknown_int(Dst1, Base, Offset, NewOffset,
+ Shiftr, Type, TrueLblName) ->
+ [LoadDst, ByteOffset, Limit, ShiftReg, LowBits, Tmp] = create_gcsafe_regs(6),
+ [ContLbl, BackLbl, LoopLbl, DoneLbl, TagLbl] = create_lbls(5),
+ [hipe_rtl:mk_move(LoadDst, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_branch(NewOffset, ne, Offset, hipe_rtl:label_name(ContLbl),
+ hipe_rtl:label_name(TagLbl), 0.99),
+ ContLbl,
+ hipe_rtl:mk_alu(Tmp, NewOffset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ hipe_rtl:mk_alu(Limit, Tmp, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)),
+ hipe_rtl:mk_move(ShiftReg, hipe_rtl:mk_imm(0)),
+ BackLbl,
+ hipe_rtl:mk_branch(ByteOffset, lt, Limit,
+ hipe_rtl:label_name(LoopLbl),
+ hipe_rtl:label_name(DoneLbl)),
+ LoopLbl,
+ load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1),
+ hipe_rtl:mk_alu(Tmp, Tmp, sll, ShiftReg),
+ hipe_rtl:mk_alu(ShiftReg, ShiftReg, add, hipe_rtl:mk_imm(?BYTE_SIZE)),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, 'or', Tmp),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(BackLbl)),
+ DoneLbl,
+ hipe_rtl:mk_alu(LowBits, NewOffset, 'and', hipe_rtl:mk_imm(?LOW_BITS)),
+ hipe_rtl:mk_alu(LowBits, hipe_rtl:mk_imm(?BYTE_SIZE), sub, LowBits),
+ hipe_rtl:mk_alu(LowBits, LowBits, 'and', hipe_rtl:mk_imm(?LOW_BITS)),
+ load_bytes(Tmp, Base, ByteOffset, Type, 1),
+ hipe_rtl:mk_alu(Tmp, Tmp, Shiftr, LowBits),
+ hipe_rtl:mk_alu(Tmp, Tmp, sll, ShiftReg),
+ hipe_rtl:mk_alu(LoadDst, LoadDst, 'or', Tmp),
+ TagLbl] ++
+ do_bignum_code(64, Type, LoadDst, Dst1, TrueLblName).
+
+do_bignum_code(Size, {Signedness,_}, Src, Dst1, TrueLblName)
+ when is_integer(Size) ->
+ case {Size > ?MAX_SMALL_BITS, Signedness} of
+ {false, _} ->
+ [hipe_tagscheme:tag_fixnum(Dst1, Src),
+ hipe_rtl:mk_goto(TrueLblName)];
+ {true, signed} ->
+ make_int_gc_code(Size) ++
+ signed_bignum(Dst1, Src, TrueLblName);
+ {true, unsigned} ->
+ make_int_gc_code(Size) ++
+ unsigned_bignum(Dst1, Src, TrueLblName)
+ end.
+
+signed_bignum(Dst1, Src, TrueLblName) ->
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ BignumLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:realtag_fixnum(Dst1, Src),
+ hipe_tagscheme:realuntag_fixnum(Tmp1, Dst1),
+ hipe_rtl:mk_branch(Tmp1, eq, Src, TrueLblName,
+ hipe_rtl:label_name(BignumLabel)),
+ BignumLabel,
+ hipe_tagscheme:unsafe_mk_big(Dst1, Src, signed),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+unsigned_bignum(Dst1, Src, TrueLblName) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ BignumLbl = hipe_rtl:mk_new_label(),
+ BignumLblName = hipe_rtl:label_name(BignumLbl),
+ NxtLbl = hipe_rtl:mk_new_label(),
+ NxtLblName = hipe_rtl:label_name(NxtLbl),
+ [hipe_rtl:mk_branch(Src, lt, hipe_rtl:mk_imm(0), BignumLblName, NxtLblName),
+ NxtLbl,
+ hipe_tagscheme:realtag_fixnum(Dst1, Src),
+ hipe_tagscheme:realuntag_fixnum(Tmp1, Dst1),
+ hipe_rtl:mk_branch(Tmp1, eq, Src, TrueLblName, BignumLblName),
+ BignumLbl,
+ hipe_tagscheme:unsafe_mk_big(Dst1, Src, unsigned),
+ hipe_rtl:mk_goto(TrueLblName)].
+
+load_bytes(Dst, Base, Offset, {Signedness, _Endianess},1) ->
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))];
+load_bytes(Dst, Base, Offset, {Signedness, Endianess},2) ->
+ case Endianess of
+ big ->
+ hipe_rtl_arch:load_big_2(Dst, Base, Offset, Signedness);
+ little ->
+ hipe_rtl_arch:load_little_2(Dst, Base, Offset, Signedness)
+ end;
+load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) ->
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ case Endianess of
+ big ->
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))];
+ little ->
+ [hipe_rtl:mk_load(Dst, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte,unsigned),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte,Signedness),
+ hipe_rtl:mk_alu(Tmp1, Tmp1, sll, hipe_rtl:mk_imm(16)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))]
+ end;
+load_bytes(Dst, Base, Offset, {Signedness, Endianess}, 4) ->
+ case Endianess of
+ big ->
+ hipe_rtl_arch:load_big_4(Dst, Base, Offset, Signedness);
+ little ->
+ hipe_rtl_arch:load_little_4(Dst, Base, Offset, Signedness)
+ end;
+
+load_bytes(Dst, Base, Offset, {Signedness, Endianess}, X) when X > 1 ->
+ [LoopLbl, EndLbl] = create_lbls(2),
+ [Tmp1, Limit, TmpOffset] = create_regs(3),
+ case Endianess of
+ big ->
+ [hipe_rtl:mk_alu(Limit, Offset, add, hipe_rtl:mk_imm(X)),
+ hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ LoopLbl,
+ hipe_rtl:mk_load(Tmp1, Base, Offset, byte, unsigned),
+ hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_branch(Offset, lt, Limit, hipe_rtl:label_name(LoopLbl),
+ hipe_rtl:label_name(EndLbl)),
+ EndLbl];
+ little ->
+ [hipe_rtl:mk_alu(Limit, Offset, add, hipe_rtl:mk_imm(X)),
+ hipe_rtl:mk_alu(TmpOffset, Limit, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Dst, Base, TmpOffset, byte, Signedness),
+ LoopLbl,
+ hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_load(Tmp1, Base, TmpOffset, byte, Signedness),
+ hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)),
+ hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1),
+ hipe_rtl:mk_branch(Offset, lt, TmpOffset, hipe_rtl:label_name(LoopLbl),
+ hipe_rtl:label_name(EndLbl)),
+ EndLbl,
+ hipe_rtl:mk_move(Offset, Limit)]
+ end.
+
+create_regs(X) when X > 0 ->
+ [hipe_rtl:mk_new_reg()|create_regs(X-1)];
+create_regs(0) ->
+ [].
+
+create_gcsafe_regs(X) when X > 0 ->
+ [hipe_rtl:mk_new_reg_gcsafe()|create_gcsafe_regs(X-1)];
+create_gcsafe_regs(0) ->
+ [].
+
+first_part(Var, Register, FalseLblName) ->
+ [SuccessLbl1, SuccessLbl2] = create_lbls(2),
+ [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1),
+ FalseLblName, 0.99),
+ SuccessLbl1,
+ hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)),
+ hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99),
+ SuccessLbl2,
+ hipe_tagscheme:untag_fixnum(Register, Var)].
+
+make_size(1, BitsVar, FalseLblName) ->
+ [DstReg] = create_regs(1),
+ {first_part(BitsVar, DstReg, FalseLblName), DstReg};
+make_size(?BYTE_SIZE, BitsVar, FalseLblName) ->
+ [DstReg] = create_regs(1),
+ Code =
+ first_part(BitsVar, DstReg, FalseLblName) ++
+ [hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))],
+ {Code, DstReg};
+make_size(UnitImm, BitsVar, FalseLblName) ->
+ [DstReg] = create_regs(1),
+ UnitList = number2list(UnitImm),
+ Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName),
+ {Code, DstReg}.
+
+multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) ->
+ Test = set_high(Head),
+ Tmp1 = hipe_rtl:mk_new_reg(),
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ Register = hipe_rtl:mk_new_reg(),
+ Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))|
+ first_part(Variable, Register, FalseLblName)]
+ ++
+ [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test),
+ eq, hipe_rtl:label_name(SuccessLbl),
+ FalseLblName, 0.99),
+ SuccessLbl],
+ multiply_code(List, Register, Result, FalseLblName, Tmp1, Code).
+
+multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) ->
+ SuccessLbl = hipe_rtl:mk_new_label(),
+ Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)),
+ hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99),
+ SuccessLbl],
+ multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code);
+multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) ->
+ Code.
+
+number2list(X) when is_integer(X), X >= 0 ->
+ number2list(X, []).
+
+number2list(1, Acc) ->
+ lists:reverse([0|Acc]);
+number2list(0, Acc) ->
+ lists:reverse(Acc);
+number2list(X, Acc) ->
+ F = floorlog2(X),
+ number2list(X-(1 bsl F), [F|Acc]).
+
+floorlog2(X) ->
+ round(math:log(X)/math:log(2)-0.5).
+
+set_high(X) ->
+ set_high(X, 0).
+
+set_high(0, Y) ->
+ Y;
+set_high(X, Y) ->
+ set_high(X-1, Y+(1 bsl (27-X))).
+
+is_illegal_const(Const) ->
+ Const >= 1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0.
diff --git a/lib/hipe/rtl/hipe_rtl_cfg.erl b/lib/hipe/rtl/hipe_rtl_cfg.erl
new file mode 100644
index 0000000000..b6c1d63262
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_cfg.erl
@@ -0,0 +1,201 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_rtl_cfg).
+
+-export([init/1,
+ labels/1,
+ params/1, params_update/2,
+ start_label/1,
+ succ/2,
+ pred/2,
+ bb/2, bb_add/3, bb_insert_between/5,
+ redirect/4,
+ remove_trivial_bbs/1, remove_unreachable_code/1,
+ linearize/1,
+ pp/1, pp/2]).
+-export([preorder/1, postorder/1, reverse_postorder/1]).
+
+-define(RTL_CFG, true). % needed for cfg.inc below
+
+-include("../main/hipe.hrl").
+-include("hipe_rtl.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/cfg.inc").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% CFG interface to RTL.
+%%
+
+init(Rtl) ->
+ %% hipe_rtl:pp(Rtl),
+ Code = hipe_rtl:rtl_code(Rtl),
+ StartLabel = hipe_rtl:label_name(hd(Code)),
+ CFG0 = mk_empty_cfg(hipe_rtl:rtl_fun(Rtl),
+ StartLabel,
+ hipe_rtl:rtl_data(Rtl),
+ hipe_rtl:rtl_is_closure(Rtl),
+ hipe_rtl:rtl_is_leaf(Rtl),
+ hipe_rtl:rtl_params(Rtl)),
+ CFG = info_update(CFG0, hipe_rtl:rtl_info(Rtl)),
+ take_bbs(Code, CFG).
+
+%% @spec is_comment(hipe_rtl:rtl_instruction()) -> boolean()
+%% @doc Succeeds if Instr has no effect.
+is_comment(Instr) ->
+ hipe_rtl:is_comment(Instr).
+
+%% @spec is_goto(hipe_rtl:rtl_instruction()) -> boolean()
+%% @doc Succeeds if Instr is just a jump (no side-effects).
+is_goto(Instr) ->
+ hipe_rtl:is_goto(Instr).
+
+is_label(Instr) ->
+ hipe_rtl:is_label(Instr).
+
+label_name(Instr) ->
+ hipe_rtl:label_name(Instr).
+
+mk_label(Name) ->
+ hipe_rtl:mk_label(Name).
+
+mk_goto(Name) ->
+ hipe_rtl:mk_goto(Name).
+
+branch_successors(Instr) ->
+ case Instr of
+ #branch{} -> [hipe_rtl:branch_true_label(Instr),
+ hipe_rtl:branch_false_label(Instr)];
+ #alub{} -> [hipe_rtl:alub_true_label(Instr),
+ hipe_rtl:alub_false_label(Instr)];
+ #switch{} -> hipe_rtl:switch_labels(Instr);
+ #call{} ->
+ case hipe_rtl:call_fail(Instr) of
+ [] -> [hipe_rtl:call_continuation(Instr)];
+ Fail -> [hipe_rtl:call_continuation(Instr),Fail]
+ end;
+ #goto{} -> [hipe_rtl:goto_label(Instr)];
+ #goto_index{} -> hipe_rtl:goto_index_labels(Instr);
+ _ -> []
+ end.
+
+fails_to(Instr) ->
+ case Instr of
+ #call{} -> [hipe_rtl:call_fail(Instr)];
+ _ -> []
+ end.
+
+is_branch(Instr) ->
+ case Instr of
+ #branch{} -> true;
+ #alub{} -> true;
+ #switch{} -> true;
+ #goto{} -> true;
+ #goto_index{} -> true;
+ #enter{} -> true;
+ #return{} -> true;
+ #call{} ->
+ case hipe_rtl:call_fail(Instr) of
+ [] ->
+ case hipe_rtl:call_continuation(Instr) of
+ [] -> false;
+ _ -> true
+ end;
+ _ -> true
+ end;
+ _ -> false
+ end.
+
+is_pure_branch(Instr) ->
+ case Instr of
+ #branch{} -> true;
+ #switch{} -> true;
+ #goto{} -> true;
+ _ -> false
+ end.
+
+redirect_jmp(Jmp, ToOld, ToNew) ->
+ hipe_rtl:redirect_jmp(Jmp, ToOld, ToNew).
+
+redirect_ops([Label|Labels], CFG, Map) ->
+ BB = bb(CFG, Label),
+ Code = hipe_bb:code(BB),
+ NewCode = [rewrite(I,Map) || I <- Code],
+ NewCFG = bb_add(CFG, Label, hipe_bb:code_update(BB, NewCode)),
+ redirect_ops(Labels, NewCFG, Map);
+redirect_ops([],CFG,_) -> CFG.
+
+rewrite(I, Map) ->
+ case I of
+ #load_address{} ->
+ case hipe_rtl:load_address_type(I) of
+ constant -> I;
+ _ ->
+ NewL =
+ find_new_label(hipe_rtl:load_address_addr(I), Map),
+ hipe_rtl:load_address_addr_update(I, NewL)
+ end;
+ _ -> I
+ end.
+
+
+pp(CFG) ->
+ hipe_rtl:pp(linearize(CFG)).
+
+pp(Dev, CFG) ->
+ hipe_rtl:pp(Dev, linearize(CFG)).
+
+linearize(CFG) ->
+ Code = linearize_cfg(CFG),
+ Rtl = hipe_rtl:mk_rtl(function(CFG),
+ params(CFG),
+ is_closure(CFG),
+ is_leaf(CFG),
+ Code,
+ data(CFG),
+ hipe_gensym:var_range(rtl),
+ hipe_gensym:label_range(rtl)),
+ hipe_rtl:rtl_info_update(Rtl, info(CFG)).
+
+%% %% Warning: this arity might not be the true arity.
+%% %% The true arity of a closure usually differs.
+%% arity(CFG) ->
+%% {_M,_F,A} = function(CFG),
+%% A.
+
+%% init_gensym(CFG)->
+%% HighestVar = find_highest_var(CFG),
+%% HighestLabel = find_highest_label(CFG),
+%% hipe_gensym:init(),
+%% hipe_gensym:set_var(rtl, HighestVar),
+%% hipe_gensym:set_label(rtl, HighestLabel).
+%%
+%% highest_var(Code)->
+%% hipe_rtl:highest_var(Code).
+
+is_phi(I) ->
+ hipe_rtl:is_phi(I).
+
+phi_remove_pred(I, Pred) ->
+ hipe_rtl:phi_remove_pred(I, Pred).
+
+phi_redirect_pred(I, OldPred, NewPred) ->
+ hipe_rtl:phi_redirect_pred(I, OldPred, NewPred).
diff --git a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
new file mode 100644
index 0000000000..d3e71a56c1
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
@@ -0,0 +1,85 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_rtl_cleanup_const.erl
+%%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 5 Mar 2004 by Tobias Lindahl <tobiasl@it.uu.se>
+%%%-------------------------------------------------------------------
+
+%% Big constants (floats, bignums) can be used as arguments to
+%% arbitrary instructions in RTL. Since these are located in the
+%% constants area and the only instruction that currently can access
+%% them is load_address, the constants have to be moved out of the
+%% instruction and loaded into temporary variables before the
+%% instruction.
+%%
+%% Some backends can make use of the information that the arguments
+%% are really constants. Here is the place to add new backend-specific
+%% behaviour depending on this.
+
+%%--------------------------------------------------------------------
+
+-module(hipe_rtl_cleanup_const).
+
+-export([cleanup/1]).
+
+-include("hipe_rtl.hrl").
+
+%%--------------------------------------------------------------------
+
+%%-spec cleanup(#rtl{}) -> #rtl{}.
+
+cleanup(Rtl) ->
+ Code = cleanup(hipe_rtl:rtl_code(Rtl), []),
+ hipe_rtl:rtl_code_update(Rtl, Code).
+
+cleanup([I|Left], Acc) ->
+ Args = hipe_rtl:args(I),
+ case [X || X <- Args, hipe_rtl:is_const_label(X)] of
+ [] ->
+ cleanup(Left, [I|Acc]);
+ ConstArgs ->
+ NewIns = cleanup_instr(ConstArgs, I),
+ cleanup(Left, NewIns ++ Acc)
+ end;
+cleanup([], Acc) ->
+ lists:reverse(Acc).
+
+cleanup_instr(Consts, I) ->
+ cleanup_instr(ordsets:from_list(Consts), I, []).
+
+cleanup_instr([Const|Left], I, Acc) ->
+ Dst = hipe_rtl:mk_new_var(),
+ ConstLabel = hipe_rtl:const_label_label(Const),
+ Load = hipe_rtl:mk_load_address(Dst, ConstLabel, constant),
+ case I of
+ X when is_record(X, fp_unop) orelse is_record(X, fp) ->
+ Fdst = hipe_rtl:mk_new_fpreg(),
+ Fconv = hipe_tagscheme:unsafe_untag_float(Fdst, Dst),
+ NewI = hipe_rtl:subst_uses([{Const, Fdst}], I),
+ cleanup_instr(Left, NewI, Fconv ++ [Load|Acc]);
+ _ ->
+ NewI = hipe_rtl:subst_uses([{Const, Dst}], I),
+ cleanup_instr(Left, NewI, [Load|Acc])
+ end;
+cleanup_instr([], I, Acc) ->
+ [I|Acc].
diff --git a/lib/hipe/rtl/hipe_rtl_exceptions.erl b/lib/hipe/rtl/hipe_rtl_exceptions.erl
new file mode 100644
index 0000000000..879b84c0b0
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_exceptions.erl
@@ -0,0 +1,120 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Filename : hipe_rtl_exceptions.erl
+%% Module : hipe_rtl_exceptions
+%% Purpose :
+%% Notes :
+%% History : * 2001-04-10 Erik Johansson (happi@it.uu.se):
+%% Created.
+%% CVS :
+%% $Id$
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_exceptions).
+
+-export([gen_fail/3, gen_begin_handler/3]).
+
+-include("../main/hipe.hrl").
+-include("hipe_literals.hrl").
+
+%% --------------------------------------------------------------------
+%% Handle the Icode instruction
+%% FAIL
+%%
+gen_fail(Class, Args, L) ->
+ case Args of
+ [Reason] ->
+ case Class of
+ exit ->
+ gen_exit(Reason, L);
+ throw ->
+ gen_throw(Reason, L);
+ error ->
+ gen_error(Reason, L)
+ end;
+ [Arg1,Arg2] ->
+ case Class of
+ error ->
+ Reason = Arg1, ArgList = Arg2,
+ gen_error(Reason, ArgList, L);
+ rethrow ->
+ Exception = Arg1, Reason = Arg2,
+ gen_rethrow(Exception, Reason, L)
+ end
+ end.
+
+%% --------------------------------------------------------------------
+%% Exception handler glue; interfaces between the runtime system's
+%% exception state and the Icode view of exception handling.
+
+gen_begin_handler(I, VarMap, ConstTab) ->
+ Ds = hipe_icode:begin_handler_dstlist(I),
+ {Vars, VarMap1} = hipe_rtl_varmap:ivs2rvs(Ds, VarMap),
+ [FTagVar,FValueVar,FTraceVar] = Vars,
+ {[hipe_rtl:mk_comment('begin_handler'),
+ hipe_rtl_arch:pcb_load(FValueVar, ?P_FVALUE),
+ hipe_rtl_arch:pcb_load(FTraceVar, ?P_FTRACE),
+ %% synthesized from P->freason by hipe_handle_exception()
+ hipe_rtl_arch:pcb_load(FTagVar, ?P_ARG0)
+ ],
+ VarMap1, ConstTab}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Exceptions
+
+gen_exit(Reason, L) ->
+ gen_fail_call({erlang,exit,1}, [Reason], L).
+
+gen_throw(Reason, L) ->
+ gen_fail_call({erlang,throw,1}, [Reason], L).
+
+gen_error(Reason, L) ->
+ gen_fail_call({erlang,error,1}, [Reason], L).
+
+gen_error(Reason, ArgList, L) ->
+ gen_fail_call({erlang,error,2}, [Reason,ArgList], L).
+
+gen_rethrow(Exception, Reason, L) ->
+ gen_fail_call(rethrow, [Exception,Reason], L).
+
+%% Generic fail. We can't use 'enter' with a fail label (there can be no
+%% stack descriptor info for an enter), so for a non-nil fail label we
+%% generate a call followed by a dummy return.
+%%
+%% Update: The runtime system now interprets the return address of
+%% the BIF call in order to list the invoking MFA in the stack trace.
+%% Generating tailcalls here defeats that purpose, so we no longer do that.
+
+%%gen_fail_call(Fun, Args, []) ->
+%% [hipe_rtl:mk_enter(Fun, Args, remote)];
+gen_fail_call(Fun, Args, L) ->
+ ContLbl = hipe_rtl:mk_new_label(),
+ Cont = hipe_rtl:label_name(ContLbl),
+ Zero = hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)),
+ [hipe_rtl:mk_call([], Fun, Args, Cont, L, remote),
+ ContLbl,
+ hipe_rtl:mk_return([Zero])].
diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl
new file mode 100644
index 0000000000..5d65389d48
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_lcm.erl
@@ -0,0 +1,1696 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% File : hipe_rtl_lcm.erl
+%% Author : Henrik Nyman and Erik Cedheim
+%% Description : Performs Lazy Code Motion on RTL
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% @doc
+%%
+%% This module implements Lazy Code Motion on RTL.
+%%
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_lcm).
+
+-export([rtl_lcm/2]).
+
+-define(SETS, ordsets). %% Which set implementation module to use
+ %% We have tried gb_sets, sets and ordsets and
+ %% ordsets seems to be a lot faster according to
+ %% our test runs.
+
+-include("../main/hipe.hrl").
+-include("hipe_rtl.hrl").
+-include("../flow/cfg.hrl").
+
+%%-define(LCM_DEBUG, true). %% When defined and true, produces debug printouts
+
+%%=============================================================================
+
+%%
+%% @doc Performs Lazy Code Motion on RTL.
+%%
+
+-spec rtl_lcm(cfg(), comp_options()) -> cfg().
+
+rtl_lcm(CFG, Options) ->
+ %% Perform pre-calculation of the data sets.
+ ?opt_start_timer("RTL LCM precalc"),
+ {NodeInfo, EdgeInfo, AllExpr, ExprMap, IdMap, Labels} = lcm_precalc(CFG, Options),
+ ?opt_stop_timer("RTL LCM precalc"),
+ %% {NodeInfo, EdgeInfo, AllExpr, ExprMap, Labels} =
+ %% ?option_time(lcm_precalc(CFG, Options), "RTL LCM precalc", Options),
+
+ pp_debug("-------------------------------------------------~n",[]),
+ %% pp_debug( "~w~n", [MFA]),
+
+ %% A check if we should pretty print the result.
+ case proplists:get_bool(pp_rtl_lcm, Options) of
+ true->
+ pp_debug("-------------------------------------------------~n",[]),
+ %% pp_debug("AllExpr: ~w~n", [AllExpr]),
+ pp_debug("AllExpr:~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(AllExpr)),
+ %% pp_sets(ExprMap, NodeInfo, EdgeInfo, AllExpr, CFG2<-ERROR!, Labels);
+ pp_sets(ExprMap, IdMap, NodeInfo, EdgeInfo, AllExpr, CFG, Labels);
+ _ ->
+ ok
+ end,
+
+ pp_debug("-------------------------------------------------~n",[]),
+ ?option_time({CFG1, MoveSet} = perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap,
+ IdMap, AllExpr, mk_edge_bb_map(),
+ ?SETS:new(), Labels),
+ "RTL LCM perform_lcm", Options),
+
+ %% Scan through list of moved expressions and replace their
+ %% assignments with the new temporary created for that expression
+ MoveList = ?SETS:to_list(MoveSet),
+ ?option_time(CFG2 = moved_expr_replace_assignments(CFG1, ExprMap, IdMap,
+ MoveList),
+ "RTL LCM moved_expr_replace_assignments", Options),
+ pp_debug("-------------------------------------------------~n~n",[]),
+
+ CFG2.
+
+%%=============================================================================
+%% Performs lazy code motion given the pre-calculated data sets.
+perform_lcm(CFG, _, _, _, _, _, _, MoveSet, []) ->
+ {CFG, MoveSet};
+perform_lcm(CFG0, NodeInfo, EdgeInfo, ExprMap, IdMap, AllExp, BetweenMap,
+ MoveSet0, [Label|Labels]) ->
+ Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
+ DeleteSet = delete(NodeInfo, Label),
+
+ %% Check if something should be deleted from this block.
+ {CFG1, MoveSet1} =
+ case ?SETS:size(DeleteSet) > 0 of
+ true ->
+ pp_debug("Label ~w: Expressions Deleted: ~n", [Label]),
+ Code1 = delete_exprs(Code0, ExprMap, IdMap, ?SETS:to_list(DeleteSet)),
+ BB = hipe_bb:mk_bb(Code1),
+ {hipe_rtl_cfg:bb_add(CFG0, Label, BB),
+ ?SETS:union(MoveSet0, DeleteSet)};
+ false ->
+ {CFG0, MoveSet0}
+ end,
+
+ Succs = hipe_rtl_cfg:succ(CFG1, Label),
+
+ %% Go through the list of successors and insert expression where needed.
+ %% Also collect a list of expressions that are inserted somewhere
+ {CFG2, NewBetweenMap, MoveSet2} =
+ lists:foldl(fun(Succ, {CFG, BtwMap, MoveSet}) ->
+ InsertSet = calc_insert_edge(NodeInfo, EdgeInfo,
+ Label, Succ),
+ %% Check if something should be inserted on this edge.
+ case ?SETS:size(InsertSet) > 0 of
+ true ->
+ pp_debug("Label ~w: Expressions Inserted for Successor: ~w~n", [Label, Succ]),
+ InsertList = ?SETS:to_list(InsertSet),
+ {NewCFG, NewBtwMap} =
+ insert_exprs(CFG, Label, Succ, ExprMap, IdMap,
+ BtwMap, InsertList),
+ {NewCFG, NewBtwMap, ?SETS:union(MoveSet, InsertSet)};
+ false ->
+ {CFG, BtwMap, MoveSet}
+ end
+ end,
+ {CFG1, BetweenMap, MoveSet1}, Succs),
+
+ perform_lcm(CFG2, NodeInfo, EdgeInfo, ExprMap, IdMap, AllExp, NewBetweenMap,
+ MoveSet2, Labels).
+
+%%=============================================================================
+%% Scan through list of moved expressions and replace their
+%% assignments with the new temporary created for that expression.
+moved_expr_replace_assignments(CFG, _, _, []) ->
+ CFG;
+moved_expr_replace_assignments(CFG0, ExprMap, IdMap, [ExprId|Exprs]) ->
+ Expr = expr_id_map_get_expr(IdMap, ExprId),
+ case expr_map_lookup(ExprMap, Expr) of
+ {value, {_, ReplaceList, NewReg}} ->
+ CFG1 = lists:foldl(fun({Label, Reg}, CFG) ->
+ %% Find and replace expression in block
+ pp_debug("Label ~w: Expressions Replaced:~n", [Label]),
+ Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG, Label)),
+ Code1 =
+ moved_expr_do_replacement(expr_set_dst(Expr, Reg),
+ Reg, NewReg, Code0),
+ hipe_rtl_cfg:bb_add(CFG, Label, hipe_bb:mk_bb(Code1))
+ end, CFG0, ReplaceList),
+ moved_expr_replace_assignments(CFG1, ExprMap, IdMap, Exprs);
+ none ->
+ moved_expr_replace_assignments(CFG0, ExprMap, IdMap, Exprs)
+ end.
+
+moved_expr_do_replacement(_, _, _, []) ->
+ [];
+moved_expr_do_replacement(Expr, Reg, NewReg, [Expr|Instrs]) ->
+ NewExpr = expr_set_dst(Expr, NewReg),
+ Move = mk_expr_move_instr(Reg, NewReg),
+ pp_debug(" Replacing:~n", []),
+ pp_debug_instr(Expr),
+ pp_debug(" With:~n", []),
+ pp_debug_instr(NewExpr),
+ pp_debug_instr(Move),
+ [NewExpr, Move | moved_expr_do_replacement(Expr, Reg, NewReg, Instrs)];
+moved_expr_do_replacement(Expr, Reg, NewReg, [Instr|Instrs]) ->
+ [Instr | moved_expr_do_replacement(Expr, Reg, NewReg, Instrs)].
+
+%%=============================================================================
+%% Goes through the given list of expressions and deletes them from the code.
+%% NOTE We do not actually delete an expression, but instead we replace it
+%% with an assignment from the new temporary containing the result of the
+%% expressions which is guaranteed to have been calculated earlier in
+%% the code.
+delete_exprs(Code, _, _, []) ->
+ Code;
+delete_exprs(Code, ExprMap, IdMap, [ExprId|Exprs]) ->
+ Expr = expr_id_map_get_expr(IdMap, ExprId),
+ %% Perform a foldl that goes through the code and deletes all
+ %% occurences of the expression.
+ NewCode =
+ lists:reverse
+ (lists:foldl(fun(CodeExpr, Acc) ->
+ case is_expr(CodeExpr) of
+ true ->
+ case expr_clear_dst(CodeExpr) =:= Expr of
+ true ->
+ pp_debug(" Deleting: ", []),
+ pp_debug_instr(CodeExpr),
+ %% Lookup expression entry.
+ Defines =
+ case expr_map_lookup(ExprMap, Expr) of
+ {value, {_, _, Defs}} ->
+ Defs;
+ none ->
+ exit({?MODULE, expr_map_lookup,
+ "expression missing"})
+ end,
+ MoveCode =
+ mk_expr_move_instr(hipe_rtl:defines(CodeExpr),
+ Defines),
+ pp_debug(" Replacing with: ", []),
+ pp_debug_instr(MoveCode),
+ [MoveCode|Acc];
+ false ->
+ [CodeExpr|Acc]
+ end;
+ false ->
+ [CodeExpr|Acc]
+ end
+ end,
+ [], Code)),
+ delete_exprs(NewCode, ExprMap, IdMap, Exprs).
+
+%%=============================================================================
+%% Goes through the given list of expressions and inserts them at
+%% appropriate places in the code.
+insert_exprs(CFG, _, _, _, _, BetweenMap, []) ->
+ {CFG, BetweenMap};
+insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) ->
+ Expr = expr_id_map_get_expr(IdMap, ExprId),
+ Instr = expr_map_get_instr(ExprMap, Expr),
+ case hipe_rtl_cfg:succ(CFG, Pred) of
+ [_] ->
+ pp_debug(" Inserted last: ", []),
+ pp_debug_instr(Instr),
+ NewCFG = insert_expr_last(CFG, Pred, Instr),
+ insert_exprs(NewCFG, Pred, Succ, ExprMap, IdMap, BetweenMap, Exprs);
+ _ ->
+ case hipe_rtl_cfg:pred(CFG, Succ) of
+ [_] ->
+ pp_debug(" Inserted first: ", []),
+ pp_debug_instr(Instr),
+ NewCFG = insert_expr_first(CFG, Succ, Instr),
+ insert_exprs(NewCFG, Pred, Succ, ExprMap, IdMap, BetweenMap, Exprs);
+ _ ->
+ pp_debug(" Inserted between: ", []),
+ pp_debug_instr(Instr),
+ {NewCFG, NewBetweenMap} =
+ insert_expr_between(CFG, BetweenMap, Pred, Succ, Instr),
+ insert_exprs(NewCFG, Pred, Succ, ExprMap, IdMap, NewBetweenMap, Exprs)
+ end
+ end.
+
+%%=============================================================================
+%% Recursively goes through the code in a block and returns a new block
+%% with the new code inserted second to last (assuming the last expression
+%% is a branch operation).
+insert_expr_last(CFG0, Label, Instr) ->
+ Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
+ %% FIXME: Use hipe_bb:butlast() instead?
+ Code1 = insert_expr_last_work(Label, Instr, Code0),
+ hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1)).
+
+%%=============================================================================
+%% Recursively goes through the code in a block and returns a new block
+%% with the new code inserted second to last (assuming the last expression
+%% is a branch operation).
+insert_expr_last_work(_, Instr, []) ->
+ %% This case should not happen since this means that block was completely
+ %% empty when the function was called. For compability we insert it last.
+ [Instr];
+insert_expr_last_work(_, Instr, [Code1]) ->
+ %% We insert the code next to last.
+ [Instr, Code1];
+insert_expr_last_work(Label, Instr, [Code|Codes]) ->
+ [Code|insert_expr_last_work(Label, Instr, Codes)].
+
+%%=============================================================================
+%% Inserts expression first in the block for the given label.
+insert_expr_first(CFG0, Label, Instr) ->
+ %% The first instruction is always a label
+ [Lbl|Code0] = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
+ Code1 = [Lbl, Instr | Code0],
+ hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1)).
+
+%%=============================================================================
+%% Inserts an expression on and edge between two existing blocks.
+%% It creates a new basic block to hold the expression.
+%% Created bbs are inserted into BetweenMap to be able to reuse them for
+%% multiple inserts on the same edge.
+%% NOTE Currently creates multiple blocks for identical expression with the
+%% same successor. Since the new bb usually contains very few instructions
+%% this should not be a problem.
+insert_expr_between(CFG0, BetweenMap, Pred, Succ, Instr) ->
+ PredSucc = {Pred, Succ},
+ case edge_bb_map_lookup(BetweenMap, PredSucc) of
+ none ->
+ NewLabel = hipe_rtl:mk_new_label(),
+ NewLabelName = hipe_rtl:label_name(NewLabel),
+ pp_debug(" Creating new bb ~w~n", [NewLabel]),
+ Code = [Instr, hipe_rtl:mk_goto(Succ)],
+ CFG1 = hipe_rtl_cfg:bb_add(CFG0, NewLabelName, hipe_bb:mk_bb(Code)),
+ CFG2 = hipe_rtl_cfg:redirect(CFG1, Pred, Succ, NewLabelName),
+ NewBetweenMap = edge_bb_map_insert(BetweenMap, PredSucc, NewLabelName),
+ pp_debug(" Mapping edge (~w,~w) to label ~w~n",
+ [Pred, Succ, NewLabelName]),
+ {CFG2, NewBetweenMap};
+ {value, Label} ->
+ pp_debug(" Using existing new bb for edge (~w,~w) with label ~w~n",
+ [Pred, Succ, Label]),
+ {insert_expr_last(CFG0, Label, Instr), BetweenMap}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%% GENERAL UTILITY FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Returns true if the list of registers only contains virtual registers and
+%% no machine registers.
+no_machine_regs([]) ->
+ true;
+no_machine_regs([Reg|Regs]) ->
+ case hipe_rtl:is_reg(Reg) of
+ true ->
+ N = hipe_rtl:reg_index(Reg),
+ (N >= hipe_rtl_arch:first_virtual_reg()) andalso no_machine_regs(Regs);
+ _ ->
+ case hipe_rtl:is_fpreg(Reg) of
+ true ->
+ N = hipe_rtl:fpreg_index(Reg),
+ (N >= hipe_rtl_arch:first_virtual_reg()) andalso no_machine_regs(Regs);
+ _ ->
+ no_machine_regs(Regs)
+ end
+ end.
+
+%%=============================================================================
+%% Returns true if an RTL instruction is an expression.
+%%
+is_expr(I) ->
+ Defines = hipe_rtl:defines(I),
+ Uses = hipe_rtl:uses(I),
+
+ %% We don't cosider something that doesn't define anything as an expression.
+ %% Also we don't consider machine registers to be expressions.
+ case length(Defines) > 0 andalso no_machine_regs(Defines)
+ andalso no_machine_regs(Uses) of
+ true ->
+ case I of
+ #alu{} -> true;
+%% #alu{} ->
+%% Dst = hipe_rtl:alu_dst(I),
+%% Src1 = hipe_rtl:alu_src1(I),
+%% Src2 = hipe_rtl:alu_src2(I),
+
+ %% Check if dst updates src
+%% case Dst =:= Src1 orelse Dst =:= Src2 of
+%% true ->
+%% false;
+%% false ->
+%% true
+%% end;
+
+ %% Check if alu expression is untagging of boxed (rX <- vX sub 2)
+%% case hipe_rtl:is_reg(Dst) andalso hipe_rtl:is_var(Src1) andalso
+%% (hipe_rtl:alu_op(I) =:= sub) andalso hipe_rtl:is_imm(Src2) of
+%% true ->
+%% case hipe_rtl:imm_value(Src2) of
+%% 2 -> false; %% Tag for boxed. TODO: Should not be hardcoded...
+%% _ -> true
+%% end;
+%% false ->
+%% true
+%% end;
+
+ #alub{} -> false; %% TODO: Split instruction to consider alu expression?
+ #branch{} -> false;
+ #call{} -> false; %% We cannot prove that a call has no side-effects
+ #comment{} -> false;
+ #enter{} -> false;
+ %% #fail_to{} -> false; %% Deprecated?
+ #fconv{} -> true;
+ #fixnumop{} -> true;
+ #fload{} -> true;
+ #fmove{} -> false;
+ #fp{} -> true;
+ #fp_unop{} -> true;
+ #fstore{} -> false;
+ #goto{} -> false;
+ #goto_index{} -> false;
+ #gctest{} -> false;
+ #label{} -> false;
+ #load{} -> true;
+ #load_address{} ->
+ case hipe_rtl:load_address_type(I) of
+ c_const -> false;
+ closure -> false; %% not sure whether safe to move;
+ %% also probably not worth it
+ constant -> true
+ end;
+ #load_atom{} -> true;
+ #load_word_index{} -> true;
+ #move{} -> false;
+ #multimove{} -> false;
+ #phi{} -> false;
+ #return{} -> false;
+ #store{} -> false;
+ #switch{} -> false
+ end;
+ false ->
+ false
+ end.
+
+%%=============================================================================
+%% Replaces destination of RTL expression with empty list.
+%%
+expr_set_dst(I, [Dst|_Dsts] = DstList) ->
+ case I of
+ #alu{} -> hipe_rtl:alu_dst_update(I, Dst);
+ #call{} -> hipe_rtl:call_dstlist_update(I, DstList);
+ #fconv{} -> hipe_rtl:fconv_dst_update(I, Dst);
+ #fixnumop{} -> hipe_rtl:fixnumop_dst_update(I, Dst);
+ #fload{} -> hipe_rtl:fload_dst_update(I, Dst);
+ %% #fmove{} -> hipe_rtl:fmove_dst_update(I, Dst);
+ #fp{} -> hipe_rtl:fp_dst_update(I, Dst);
+ #fp_unop{} -> hipe_rtl:fp_unop_dst_update(I, Dst);
+ #load{} -> hipe_rtl:load_dst_update(I, Dst);
+ #load_address{} -> hipe_rtl:load_address_dst_update(I, Dst);
+ #load_atom{} -> hipe_rtl:load_atom_dst_update(I, Dst);
+ #load_word_index{} -> hipe_rtl:load_word_index_dst_update(I, Dst);
+ %% #move{} -> hipe_rtl:move_dst_update(I, Dst);
+ _ -> exit({?MODULE, expr_set_dst, "bad expression"})
+ end.
+
+%%=============================================================================
+%% Replaces destination of RTL expression with empty list.
+%%
+expr_clear_dst(I) ->
+ case I of
+ #alu{} -> hipe_rtl:alu_dst_update(I, nil);
+ #call{} -> hipe_rtl:call_dstlist_update(I, nil);
+ #fconv{} -> hipe_rtl:fconv_dst_update(I, nil);
+ #fixnumop{} -> hipe_rtl:fixnumop_dst_update(I, nil);
+ #fload{} -> hipe_rtl:fload_dst_update(I, nil);
+ %% #fmove{} -> hipe_rtl:fmove_dst_update(I, nil);
+ #fp{} -> hipe_rtl:fp_dst_update(I, nil);
+ #fp_unop{} -> hipe_rtl:fp_unop_dst_update(I, nil);
+ #load{} -> hipe_rtl:load_dst_update(I, nil);
+ #load_address{} -> hipe_rtl:load_address_dst_update(I, nil);
+ #load_atom{} -> hipe_rtl:load_atom_dst_update(I, nil);
+ #load_word_index{} -> hipe_rtl:load_word_index_dst_update(I, nil);
+ %% #move{} -> hipe_rtl:move_dst_update(I, nil);
+ _ -> exit({?MODULE, expr_clear_dst, "bad expression"})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%% PRECALC FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Pre-calculates the flow analysis and puts the calculated sets in maps for
+%% easy access later.
+lcm_precalc(CFG, Options) ->
+ %% Calculate use map and expression map.
+ ?option_time({ExprMap, IdMap} = mk_expr_map(CFG),
+ "RTL LCM mk_expr_map", Options),
+ ?option_time(UseMap = mk_use_map(CFG, ExprMap),
+ "RTL LCM mk_use_map", Options),
+ %% Labels = hipe_rtl_cfg:reverse_postorder(CFG),
+ Labels = hipe_rtl_cfg:labels(CFG),
+ %% StartLabel = hipe_rtl_cfg:start_label(CFG),
+ %% AllExpr = all_exprs(CFG, Labels),
+ AllExpr = ?SETS:from_list(gb_trees:keys(IdMap)),
+
+ %% Calculate the data sets.
+ ?option_time(NodeInfo0 = mk_node_info(Labels), "RTL LCM mk_node_info",
+ Options),
+ %% ?option_time(EdgeInfo0 = mk_edge_info(), "RTL LCM mk_edge_info",
+ %% Options),
+ EdgeInfo0 = mk_edge_info(),
+ ?option_time(NodeInfo1 = calc_up_exp(CFG, ExprMap, NodeInfo0, Labels),
+ "RTL LCM calc_up_exp", Options),
+ ?option_time(NodeInfo2 = calc_down_exp(CFG, ExprMap, NodeInfo1, Labels),
+ "RTL LCM calc_down_exp", Options),
+ ?option_time(NodeInfo3 = calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr,
+ Labels),
+ "RTL LCM calc_killed_exp", Options),
+ ?option_time(NodeInfo4 = calc_avail(CFG, NodeInfo3),
+ "RTL LCM calc_avail", Options),
+ ?option_time(NodeInfo5 = calc_antic(CFG, NodeInfo4, AllExpr),
+ "RTL LCM calc_antic", Options),
+ ?option_time(EdgeInfo1 = calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels),
+ "RTL LCM calc_earliest", Options),
+ ?option_time({NodeInfo6, EdgeInfo2} = calc_later(CFG, NodeInfo5, EdgeInfo1),
+ "RTL LCM calc_later", Options),
+ ?option_time(NodeInfo7 = calc_delete(CFG, NodeInfo6, Labels),
+ "RTL LCM calc_delete", Options),
+ {NodeInfo7, EdgeInfo2, AllExpr, ExprMap, IdMap, Labels}.
+
+%%%%%%%%%%%%%%%%%%% AVAILABLE IN/OUT FLOW ANALYSIS %%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Fixpoint calculation of anticipated in/out sets.
+%% Uses a worklist algorithm.
+%% Performs the avail in/out flow analysis.
+
+%%=============================================================================
+%% Calculates the available in/out sets, and returns an updated NodeInfo.
+
+calc_avail(CFG, NodeInfo) ->
+ StartLabel = hipe_rtl_cfg:start_label(CFG),
+ Work = init_work([StartLabel]),
+ %% Initialize start node
+ NewNodeInfo = set_avail_in(NodeInfo, StartLabel, ?SETS:new()),
+ calc_avail_fixpoint(Work, CFG, NewNodeInfo).
+
+calc_avail_fixpoint(Work, CFG, NodeInfo) ->
+ case get_work(Work) of
+ fixpoint ->
+ NodeInfo;
+ {Label, NewWork} ->
+ {NewNodeInfo, NewLabels} = calc_avail_node(Label, CFG, NodeInfo),
+ NewWork2 = add_work(NewWork, NewLabels),
+ calc_avail_fixpoint(NewWork2, CFG, NewNodeInfo)
+ end.
+
+calc_avail_node(Label, CFG, NodeInfo) ->
+ %% Get avail in
+ AvailIn = avail_in(NodeInfo, Label),
+
+ %% Calculate avail out
+ AvailOut = ?SETS:union(down_exp(NodeInfo, Label),
+ ?SETS:subtract(AvailIn,
+ killed_expr(NodeInfo, Label))),
+
+ {Changed, NodeInfo2} =
+ case avail_out(NodeInfo, Label) of
+ none ->
+ %% If there weren't any old avail out we use this one.
+ {true, set_avail_out(NodeInfo, Label, AvailOut)};
+ OldAvailOut ->
+ %% Check if the avail outs are equal.
+ case AvailOut =:= OldAvailOut of
+ true ->
+ {false, NodeInfo};
+ false ->
+ {true, set_avail_out(NodeInfo, Label, AvailOut)}
+ end
+ end,
+
+ case Changed of
+ true ->
+ %% Update AvailIn-sets of successors and add them to worklist
+ Succs = hipe_rtl_cfg:succ(CFG, Label),
+ NodeInfo3 =
+ lists:foldl
+ (fun(Succ, NewNodeInfo) ->
+ case avail_in(NewNodeInfo, Succ) of
+ none ->
+ %% Initialize avail in to all expressions
+ set_avail_in(NewNodeInfo, Succ, AvailOut);
+ OldAvailIn ->
+ set_avail_in(NewNodeInfo, Succ,
+ ?SETS:intersection(OldAvailIn, AvailOut))
+ end
+ end,
+ NodeInfo2, Succs),
+ {NodeInfo3, Succs};
+ false ->
+ {NodeInfo2, []}
+ end.
+
+%%%%%%%%%%%%%%%%%% ANTICIPATED IN/OUT FLOW ANALYSIS %%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Fixpoint calculation of anticipated in/out sets.
+%% Uses a worklist algorithm.
+
+%%=============================================================================
+%% Calculates the anicipated in/out sets, and returns an updated NodeInfo.
+calc_antic(CFG, NodeInfo, AllExpr) ->
+ %% Initialize worklist with all nodes in postorder
+ Labels = hipe_rtl_cfg:postorder(CFG),
+ Work = init_work(Labels),
+ calc_antic_fixpoint(Work, CFG, NodeInfo, AllExpr).
+
+calc_antic_fixpoint(Work, CFG, NodeInfo, AllExpr) ->
+ case get_work(Work) of
+ fixpoint ->
+ NodeInfo;
+ {Label, NewWork} ->
+ {NewNodeInfo, NewLabels} = calc_antic_node(Label, CFG, NodeInfo, AllExpr),
+ NewWork2 = add_work(NewWork, NewLabels),
+ calc_antic_fixpoint(NewWork2, CFG, NewNodeInfo, AllExpr)
+ end.
+
+calc_antic_node(Label, CFG, NodeInfo, AllExpr) ->
+ %% Get antic out
+ AnticOut =
+ case antic_out(NodeInfo, Label) of
+ none ->
+ case is_exit_label(CFG, Label) of
+ true ->
+ ?SETS:new();
+ false ->
+ AllExpr
+ end;
+
+ AnticOutTemp -> AnticOutTemp
+ end,
+
+ %% Calculate antic in
+ AnticIn = ?SETS:union(up_exp(NodeInfo, Label),
+ ?SETS:subtract(AnticOut,
+ killed_expr(NodeInfo, Label))),
+ {Changed, NodeInfo2} =
+ case antic_in(NodeInfo, Label) of
+ %% If there weren't any old antic in we use this one.
+ none ->
+ {true, set_antic_in(NodeInfo, Label, AnticIn)};
+
+ OldAnticIn ->
+ %% Check if the antic in:s are equal.
+ case AnticIn =:= OldAnticIn of
+ true ->
+ {false, NodeInfo};
+ false ->
+ {true,
+ set_antic_in(NodeInfo, Label, AnticIn)}
+ end
+ end,
+
+ case Changed of
+ true ->
+ %% Update AnticOut-sets of predecessors and add them to worklist
+ Preds = hipe_rtl_cfg:pred(CFG, Label),
+ NodeInfo3 =
+ lists:foldl
+ (fun(Pred, NewNodeInfo) ->
+ case antic_out(NewNodeInfo, Pred) of
+ none ->
+ %% Initialize antic out to all expressions
+ set_antic_out(NewNodeInfo, Pred, AnticIn);
+ OldAnticOut ->
+ set_antic_out(NewNodeInfo, Pred,
+ ?SETS:intersection(OldAnticOut, AnticIn))
+ end
+ end,
+ NodeInfo2, Preds),
+ {NodeInfo3, Preds};
+ false ->
+ {NodeInfo2, []}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%% LATER / LATER IN FLOW ANALYSIS %%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Fixpoint calculations of Later and LaterIn sets.
+%% Uses a worklist algorithm.
+%% Note that the Later set is calculated on edges.
+
+%%=============================================================================
+%% Calculates the Later and LaterIn sets, and returns updates of both
+%% NodeInfo (with LaterIn sets) and EdgeInfo (with Later sets).
+
+calc_later(CFG, NodeInfo, EdgeInfo) ->
+ StartLabel = hipe_rtl_cfg:start_label(CFG),
+ Work = init_work([{node, StartLabel}]),
+ %% Initialize start node
+ NewNodeInfo = set_later_in(NodeInfo, StartLabel, ?SETS:new()),
+ calc_later_fixpoint(Work, CFG, NewNodeInfo, EdgeInfo).
+
+calc_later_fixpoint(Work, CFG, NodeInfo, EdgeInfo) ->
+ case get_work(Work) of
+ {{edge, From, To}, Work2} ->
+ {NewNodeInfo, NewEdgeInfo, AddWork} =
+ calc_later_edge(From, To, CFG, NodeInfo, EdgeInfo),
+ Work3 = add_work(Work2, AddWork),
+ calc_later_fixpoint(Work3, CFG, NewNodeInfo, NewEdgeInfo);
+ {{node, Label}, Work2} ->
+ AddWork = calc_later_node(Label, CFG),
+ Work3 = add_work(Work2, AddWork),
+ calc_later_fixpoint(Work3, CFG, NodeInfo, EdgeInfo);
+ fixpoint ->
+ {NodeInfo, EdgeInfo}
+ end.
+
+calc_later_node(Label, CFG) ->
+ Succs = hipe_rtl_cfg:succ(CFG, Label),
+ [{edge, Label, Succ} || Succ <- Succs].
+
+calc_later_edge(From, To, _CFG, NodeInfo, EdgeInfo) ->
+ FromTo = {From, To},
+ Earliest = earliest(EdgeInfo, FromTo),
+ LaterIn = later_in(NodeInfo, From),
+ UpExp = up_exp(NodeInfo, From),
+ Later = ?SETS:union(Earliest, ?SETS:subtract(LaterIn, UpExp)),
+ {Changed, EdgeInfo2} =
+ case lookup_later(EdgeInfo, FromTo) of
+ none -> {true, set_later(EdgeInfo, FromTo, Later)};
+ Later -> {false, EdgeInfo};
+ _Old -> {true, set_later(EdgeInfo, FromTo, Later)}
+ end,
+ case Changed of
+ true ->
+ %% Update later in set of To-node
+ case lookup_later_in(NodeInfo, To) of
+ %% If the data isn't set initialize to all expressions
+ none ->
+ {set_later_in(NodeInfo, To, Later), EdgeInfo2, [{node, To}]};
+ OldLaterIn ->
+ NewLaterIn = ?SETS:intersection(OldLaterIn, Later),
+ %% Check if something changed
+ %% FIXME: Implement faster equality test?
+ case NewLaterIn =:= OldLaterIn of
+ true ->
+ {NodeInfo, EdgeInfo2, []};
+ false ->
+ {set_later_in(NodeInfo, To, NewLaterIn),
+ EdgeInfo2, [{node, To}]}
+ end
+ end;
+ false ->
+ {NodeInfo, EdgeInfo2, []}
+ end.
+
+%%%%%%%%%%%%%%%%%% UPWARDS/DOWNWARDS EXPOSED EXPRESSIONS %%%%%%%%%%%%%%%%%%%%%%
+%% Calculates upwards and downwards exposed expressions.
+
+%%=============================================================================
+%% Calculates the downwards exposed expression sets for the given labels in
+%% the CFG.
+calc_down_exp(_, _, NodeInfo, []) ->
+ NodeInfo;
+calc_down_exp(CFG, ExprMap, NodeInfo, [Label|Labels]) ->
+ Code = hipe_bb:code(hipe_rtl_cfg:bb(CFG, Label)),
+ %% Data = ?SETS:from_list(lists:map(fun expr_clear_dst/1, exp_work(Code))),
+ Data = ?SETS:from_list(get_expr_ids(ExprMap, exp_work(Code))),
+ NewNodeInfo = set_down_exp(NodeInfo, Label, Data),
+ calc_down_exp(CFG, ExprMap, NewNodeInfo, Labels).
+
+%%=============================================================================
+%% Calculates the upwards exposed expressions sets for the given labels in
+%% the CFG.
+calc_up_exp(_, _, NodeInfo, []) ->
+ NodeInfo;
+calc_up_exp(CFG, ExprMap, NodeInfo, [Label|Labels]) ->
+ BB = hipe_rtl_cfg:bb(CFG, Label),
+ RevCode = lists:reverse(hipe_bb:code(BB)),
+ Data = ?SETS:from_list(get_expr_ids(ExprMap, exp_work(RevCode))),
+ NewNodeInfo = set_up_exp(NodeInfo, Label, Data),
+ calc_up_exp(CFG, ExprMap, NewNodeInfo, Labels).
+
+%%=============================================================================
+%% Given a list of expression instructions, gets a list of expression ids
+%% from an expression map.
+get_expr_ids(ExprMap, Instrs) ->
+ [expr_map_get_id(ExprMap, expr_clear_dst(I)) || I <- Instrs].
+
+%%=============================================================================
+%% Does the work of the calc_*_exp functions.
+exp_work(Code) ->
+ exp_work([], Code).
+
+exp_work([], [Instr|Instrs]) ->
+ case is_expr(Instr) of
+ true ->
+ exp_work([Instr], Instrs);
+ false ->
+ exp_work([], Instrs)
+ end;
+exp_work(Exprs, []) ->
+ Exprs;
+exp_work(Exprs, [Instr|Instrs]) ->
+ NewExprs = case is_expr(Instr) of
+ true ->
+ exp_kill_expr(Instr, [Instr|Exprs]);
+ false ->
+ exp_kill_expr(Instr, Exprs)
+ end,
+ exp_work(NewExprs, Instrs).
+
+%%=============================================================================
+%% Checks if the given instruction redefines any operands of
+%% instructions in the instruction list.
+%% It returns the list of expressions with those instructions that has
+%% operands redefined removed.
+exp_kill_expr(_Instr, []) ->
+ [];
+exp_kill_expr(Instr, [CheckedExpr|Exprs]) ->
+ %% Calls, gctests and stores potentially clobber everything
+ case Instr of
+ #call{} -> [];
+ #gctest{} -> [];
+ #store{} -> []; %% FIXME: Only regs and vars clobbered, not fregs...
+ #fstore{} ->
+ %% fstore potentially clobber float expressions
+ [ExprDefine|_] = hipe_rtl:defines(CheckedExpr),
+ case hipe_rtl:is_fpreg(ExprDefine) of
+ true ->
+ exp_kill_expr(Instr, Exprs);
+ false ->
+ [CheckedExpr | exp_kill_expr(Instr, Exprs)]
+ end;
+ _ ->
+ InstrDefines = hipe_rtl:defines(Instr),
+ ExprUses = hipe_rtl:uses(CheckedExpr),
+ Diff = ExprUses -- InstrDefines,
+ case length(Diff) < length(ExprUses) of
+ true ->
+ exp_kill_expr(Instr, Exprs);
+ false ->
+ [CheckedExpr | exp_kill_expr(Instr, Exprs)]
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%% KILLED EXPRESSIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Calculates the killed expression sets for all given labels.
+calc_killed_expr(_, NodeInfo, _, _, []) ->
+ NodeInfo;
+calc_killed_expr(CFG, NodeInfo, UseMap, AllExpr, [Label|Labels]) ->
+ Code = hipe_bb:code(hipe_rtl_cfg:bb(CFG, Label)),
+ KilledExprs = calc_killed_expr_bb(Code, UseMap, AllExpr, ?SETS:new()),
+ NewNodeInfo = set_killed_expr(NodeInfo, Label, KilledExprs),
+ calc_killed_expr(CFG, NewNodeInfo, UseMap, AllExpr, Labels).
+
+%%=============================================================================
+%% Calculates the killed expressions set for one basic block.
+calc_killed_expr_bb([], _UseMap, _AllExpr, KilledExprs) ->
+ KilledExprs;
+calc_killed_expr_bb([Instr|Instrs], UseMap, AllExpr, KilledExprs) ->
+ %% Calls, gctests and stores potentially clobber everything
+ case Instr of
+ #call{} -> AllExpr;
+ #gctest{} -> AllExpr;
+ #store{} -> AllExpr; %% FIXME: Only regs and vars clobbered, not fregs...
+ #fstore{} ->
+ %% Kill all float expressions
+ %% FIXME: Make separate function is_fp_expr
+ ?SETS:from_list
+ (lists:foldl(fun(Expr, Fexprs) ->
+ [Define|_] = hipe_rtl:defines(Expr),
+ case hipe_rtl:is_fpreg(Define) of
+ true ->
+ [Expr|Fexprs];
+ false ->
+ Fexprs
+ end
+ end, [], ?SETS:to_list(AllExpr)));
+ _ ->
+ case hipe_rtl:defines(Instr) of
+ [] ->
+ calc_killed_expr_bb(Instrs, UseMap, AllExpr, KilledExprs);
+ [Define|_] ->
+ NewKilledExprs = use_map_get_expr_uses(UseMap, Define),
+ calc_killed_expr_bb(Instrs, UseMap, AllExpr,
+ ?SETS:union(NewKilledExprs, KilledExprs))
+ end
+ end.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%% EARLIEST %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Calculates the earliest set for all edges in the CFG.
+
+calc_earliest(_, _, EdgeInfo, []) ->
+ EdgeInfo;
+calc_earliest(CFG, NodeInfo, EdgeInfo, [To|Labels]) ->
+ EmptySet = ?SETS:new(),
+ Preds = hipe_rtl_cfg:pred(CFG, To),
+ NewEdgeInfo =
+ case EmptySet =:= antic_in(NodeInfo, To) of
+ true ->
+ %% Earliest is empty for all edges into this block.
+ lists:foldl(fun(From, EdgeInfoAcc) ->
+ set_earliest(EdgeInfoAcc, {From, To}, EmptySet)
+ end, EdgeInfo, Preds);
+ false ->
+ lists:foldl(fun(From, EdgeInfoAcc) ->
+ IsStartLabel = (From =:= hipe_rtl_cfg:start_label(CFG)),
+ Earliest =
+ calc_earliest_edge(NodeInfo, IsStartLabel, From, To),
+ set_earliest(EdgeInfoAcc, {From, To}, Earliest)
+ end, EdgeInfo, Preds)
+ end,
+ calc_earliest(CFG, NodeInfo, NewEdgeInfo, Labels).
+
+%%=============================================================================
+%% Calculates the earliest set for one edge.
+
+calc_earliest_edge(NodeInfo, IsStartLabel, From, To) ->
+ AnticIn = antic_in(NodeInfo, To),
+ AvailOut = avail_out(NodeInfo, From),
+
+ case IsStartLabel of
+ true ->
+ ?SETS:subtract(AnticIn, AvailOut);
+ false ->
+ AnticOut = antic_out(NodeInfo, From),
+ ExprKill = killed_expr(NodeInfo, From),
+ ?SETS:subtract(?SETS:subtract(AnticIn, AvailOut),
+ ?SETS:subtract(AnticOut, ExprKill))
+ end.
+%% The above used to be:
+%%
+%% ?SETS:intersection(?SETS:subtract(AnticIn, AvailOut),
+%% ?SETS:union(ExprKill, ?SETS:subtract(AllExpr, AnticOut)))
+%%
+%% But it is costly to use the AllExpr, so let's do some tricky set algebra.
+%%
+%% Let A = AnticIn, B = AvailOut, C = ExprKill, D = AnticOut, U = AllExpr
+%% Let n = intersection, u = union, ' = inverse
+%%
+%% Then
+%% (A - B) n (C u (U - D)) = <Remove D unless it is in C>
+%% = (A - B) n ((C u U) - (D - C)) = <But U is the whole universe>
+%% = (A - B) n (U - (D - C)) = <We are really meaning the complement>
+%% = (A - B) n (D - C)' = <Intersection w complement is subtraction>
+%% = (A - B) - (D - C) <Simple enough, let's stop>
+%%
+%% or in other words
+%% ?SETS:subtract(?SETS:subtract(AnticIn, AvailOut),
+%% ?SETS:subtract(AnticOut, ExprKill))
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%% INSERT / DELETE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Calculates the insert set for one edge and returns the resulting set.
+%% NOTE This does not modify the EdgeInfo set, since the resulting set is
+%% returned and used immediately, instead of being pre-calculated as are
+%% the other sets.
+calc_insert_edge(NodeInfo, EdgeInfo, From, To) ->
+ Later = later(EdgeInfo, {From, To}),
+ LaterIn = later_in(NodeInfo, To),
+ ?SETS:subtract(Later, LaterIn).
+
+%%=============================================================================
+%% Calculates the delete set for all given labels in a CFG.
+calc_delete(_, NodeInfo, []) ->
+ NodeInfo;
+calc_delete(CFG, NodeInfo, [Label|Labels]) ->
+ case Label =:= hipe_rtl_cfg:start_label(CFG) of
+ true ->
+ NewNodeInfo = set_delete(NodeInfo, Label, ?SETS:new());
+ false ->
+ UpExp = up_exp(NodeInfo, Label),
+ LaterIn = later_in(NodeInfo, Label),
+ Delete = ?SETS:subtract(UpExp, LaterIn),
+ NewNodeInfo = set_delete(NodeInfo, Label, Delete)
+ end,
+ calc_delete(CFG, NewNodeInfo, Labels).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%% FIXPOINT FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Worklist used by the fixpoint calculations.
+%%
+%% We use gb_sets here, which is optimized for continuous inserts and
+%% membership tests.
+
+init_work(Labels) ->
+ {Labels, [], gb_sets:from_list(Labels)}.
+
+get_work({[Label|Left], List, Set}) ->
+ NewWork = {Left, List, gb_sets:delete(Label, Set)},
+ {Label, NewWork};
+get_work({[], [], _Set}) ->
+ fixpoint;
+get_work({[], List, Set}) ->
+ get_work({lists:reverse(List), [], Set}).
+
+add_work(Work = {List1, List2, Set}, [Label|Labels]) ->
+ case gb_sets:is_member(Label, Set) of
+ true ->
+ add_work(Work, Labels);
+ false ->
+ %%io:format("Adding work: ~w\n", [Label]),
+ add_work({List1, [Label|List2], gb_sets:insert(Label, Set)}, Labels)
+ end;
+add_work(Work, []) ->
+ Work.
+
+%%=============================================================================
+%% Calculates the labels that are the exit labels.
+%% FIXME We do not detect dead-end loops spanning more than one block.
+%% This could potentially cause a bug in the future...
+%% exit_labels(CFG) ->
+%% Labels = hipe_rtl_cfg:labels(CFG),
+%% lists:foldl(fun(Label, ExitLabels) ->
+%% Succs = hipe_rtl_cfg:succ(CFG, Label),
+%% case Succs of
+%% [] ->
+%% [Label|ExitLabels];
+%% [Label] -> %% Count single bb dead-end loops as exit labels
+%% [Label|ExitLabels];
+%% _ ->
+%% ExitLabels
+%% end
+%% end, [], Labels ).
+
+%%=============================================================================
+%% Return true if label is an exit label,
+%% i.e. its bb has no successors or itself as only successor.
+is_exit_label(CFG, Label) ->
+ case hipe_rtl_cfg:succ(CFG, Label) of
+ [] -> true;
+ [Label] -> true;
+ _ -> false
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%% DATASET FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The dataset is a collection of data about the CFG.
+%% It is divided into two parts, NodeInfo and EdgeInfo.
+%% The pre-calculation step stores the calculated sets here.
+
+-record(node_data, {up_exp = none,
+ down_exp = none,
+ killed_expr = none,
+ avail_in = none,
+ avail_out = none,
+ antic_in = none,
+ antic_out = none,
+ later_in = none,
+ delete = none}).
+
+-record(edge_data, {earliest = none,
+ later = none,
+ insert = none}).
+
+%%=============================================================================
+%% Creates a node info from a CFG (one entry for each Label).
+mk_node_info(Labels) ->
+ lists:foldl(fun(Label, DataTree) ->
+ gb_trees:insert(Label, #node_data{}, DataTree)
+ %%gb_trees:enter(Label, #node_data{}, DataTree)
+ end,
+ gb_trees:empty(), Labels).
+
+%%mk_edge_info(Labels) ->
+%% FIXME Should we traverse cfg and initialize edges?
+mk_edge_info() ->
+ gb_trees:empty().
+
+%%=============================================================================
+%% Get methods
+up_exp(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.up_exp.
+
+down_exp(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.down_exp.
+
+killed_expr(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.killed_expr.
+
+avail_in(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.avail_in.
+
+avail_out(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.avail_out.
+
+antic_in(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.antic_in.
+
+antic_out(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.antic_out.
+
+later_in(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.later_in.
+
+lookup_later_in(NodeInfo, Label) ->
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ none;
+ {value, #node_data{later_in = Data}} ->
+ Data
+ end.
+
+delete(NodeInfo, Label) ->
+ Data = gb_trees:get(Label, NodeInfo),
+ Data#node_data.delete.
+
+earliest(EdgeInfo, Edge) ->
+ Data = gb_trees:get(Edge, EdgeInfo),
+ Data#edge_data.earliest.
+
+-ifdef(LOOKUP_EARLIEST_NEEDED).
+lookup_earliest(EdgeInfo, Edge) ->
+ case gb_trees:lookup(Edge, EdgeInfo) of
+ none ->
+ none;
+ {value, #edge_data{earliest = Data}} ->
+ Data
+ end.
+-endif.
+
+later(EdgeInfo, Edge) ->
+ Data = gb_trees:get(Edge, EdgeInfo),
+ Data#edge_data.later.
+
+lookup_later(EdgeInfo, Edge) ->
+ case gb_trees:lookup(Edge, EdgeInfo) of
+ none ->
+ none;
+ {value, #edge_data{later = Data}} ->
+ Data
+ end.
+
+%% insert(EdgeInfo, Edge) ->
+%% case gb_trees:lookup(Edge, EdgeInfo) of
+%% none ->
+%% exit({?MODULE, insert, "edge info not found"}),
+%% none;
+%% {value, #edge_data{insert = Data}} ->
+%% Data
+%% end.
+
+%%=============================================================================
+%% Set methods
+set_up_exp(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{up_exp = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{up_exp = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_down_exp(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{down_exp = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{down_exp = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_killed_expr(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{killed_expr = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{killed_expr = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_avail_in(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{avail_in = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{avail_in = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_avail_out(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{avail_out = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{avail_out = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_antic_in(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{antic_in = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{antic_in = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_antic_out(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{antic_out = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{antic_out = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_later_in(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{later_in = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{later_in = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_delete(NodeInfo, Label, Data) ->
+ NodeData =
+ case gb_trees:lookup(Label, NodeInfo) of
+ none ->
+ #node_data{delete = Data};
+ {value, OldNodeData} ->
+ OldNodeData#node_data{delete = Data}
+ end,
+ gb_trees:enter(Label, NodeData, NodeInfo).
+
+set_earliest(EdgeInfo, Edge, Data) ->
+ EdgeData =
+ case gb_trees:lookup(Edge, EdgeInfo) of
+ none ->
+ #edge_data{earliest = Data};
+ {value, OldEdgeData} ->
+ OldEdgeData#edge_data{earliest = Data}
+ end,
+ gb_trees:enter(Edge, EdgeData, EdgeInfo).
+
+set_later(EdgeInfo, Edge, Data) ->
+ EdgeData =
+ case gb_trees:lookup(Edge, EdgeInfo) of
+ none ->
+ #edge_data{later = Data};
+ {value, OldEdgeData} ->
+ OldEdgeData#edge_data{later = Data}
+ end,
+ gb_trees:enter(Edge, EdgeData, EdgeInfo).
+
+%% set_insert(EdgeInfo, Edge, Data) ->
+%% EdgeData =
+%% case gb_trees:lookup(Edge, EdgeInfo) of
+%% none ->
+%% #edge_data{insert = Data};
+%% {value, OldEdgeData} ->
+%% OldEdgeData#edge_data{insert = Data}
+%% end,
+%% gb_trees:enter(Edge, EdgeData, EdgeInfo).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%% USE MAP %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The use map is a mapping from "use" (which is an rtl register/variable)
+%% to a set of expressions (IDs) where that register/variable is used.
+%% It is used by calc_killed_expr to know what expressions are affected by
+%% a definition.
+
+%%=============================================================================
+%% Creates and calculates the use map for a CFG.
+%% It uses ExprMap to lookup the expression IDs.
+mk_use_map(CFG, ExprMap) ->
+ Labels = hipe_rtl_cfg:reverse_postorder(CFG),
+ NewMap = mk_use_map(gb_trees:empty(), CFG, ExprMap, Labels),
+ gb_trees:balance(NewMap).
+
+mk_use_map(Map, _, _, []) ->
+ Map;
+mk_use_map(Map, CFG, ExprMap, [Label|Labels]) ->
+ Code = hipe_bb:code(hipe_rtl_cfg:bb(CFG, Label)),
+ NewMap = mk_use_map_bb(Map, ExprMap, Code),
+ mk_use_map(NewMap, CFG, ExprMap, Labels).
+
+mk_use_map_bb(UseMap, _, []) ->
+ UseMap;
+mk_use_map_bb(UseMap, ExprMap, [Instr|Instrs]) ->
+ case is_expr(Instr) of
+ true ->
+ Uses = hipe_rtl:uses(Instr),
+ ExprId = expr_map_get_id(ExprMap, expr_clear_dst(Instr)),
+ NewUseMap = mk_use_map_insert_uses(UseMap, ExprId, Uses),
+ mk_use_map_bb(NewUseMap, ExprMap, Instrs);
+ false ->
+ mk_use_map_bb(UseMap, ExprMap, Instrs)
+ end.
+
+%%=============================================================================
+%% Worker function for mk_use_map that inserts the expression id for every
+%% rtl register the expression uses in a use map.
+mk_use_map_insert_uses(Map, _, []) ->
+ Map;
+mk_use_map_insert_uses(Map, Expr, [Use|Uses]) ->
+ case gb_trees:lookup(Use, Map) of
+ {value, UseSet} ->
+ NewUseSet = ?SETS:add_element(Expr, UseSet),
+ mk_use_map_insert_uses(gb_trees:update(Use, NewUseSet, Map), Expr, Uses);
+ none ->
+ UseSet = ?SETS:new(),
+ NewUseSet = ?SETS:add_element(Expr, UseSet),
+ mk_use_map_insert_uses(gb_trees:insert(Use, NewUseSet, Map), Expr, Uses)
+ end.
+
+%%=============================================================================
+%% Gets a set of expressions where the given rtl register is used.
+use_map_get_expr_uses(Map, Reg) ->
+ case gb_trees:lookup(Reg, Map) of
+ {value, UseSet} ->
+ UseSet;
+ none ->
+ ?SETS:new()
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%% EXPRESSION MAP %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The expression map is a mapping from expression to
+%% (1) Expression Id (Integer used to speed up set operations)
+%% (2) List of definitions (labels where the expression is defined and the
+%% list of registers or variables defined by an instruction in that label,
+%% represented as a tuple {Label, Defines})
+%% (3) The list of replacement registers created for the expression
+
+%%=============================================================================
+%% Creates and calculates the expression map for a CFG.
+mk_expr_map(CFG) ->
+ init_expr_id(),
+ Labels = hipe_rtl_cfg:reverse_postorder(CFG),
+ {ExprMap, IdMap} = mk_expr_map(gb_trees:empty(), gb_trees:empty(),
+ CFG, Labels),
+ {gb_trees:balance(ExprMap), gb_trees:balance(IdMap)}.
+
+mk_expr_map(ExprMap, IdMap, _, []) ->
+ {ExprMap, IdMap};
+mk_expr_map(ExprMap, IdMap, CFG, [Label|Labels]) ->
+ Code = hipe_bb:code(hipe_rtl_cfg:bb(CFG, Label)),
+ {NewExprMap, NewIdMap} = mk_expr_map_bb(ExprMap, IdMap, Label, Code),
+ mk_expr_map(NewExprMap, NewIdMap, CFG, Labels).
+
+mk_expr_map_bb(ExprMap, IdMap, _, []) ->
+ {ExprMap, IdMap};
+mk_expr_map_bb(ExprMap, IdMap, Label, [Instr|Instrs]) ->
+ case is_expr(Instr) of
+ true ->
+ Expr = expr_clear_dst(Instr),
+ Defines = hipe_rtl:defines(Instr),
+ case gb_trees:lookup(Expr, ExprMap) of
+ {value, {ExprId, DefinesList, ReplRegs}} ->
+ NewExprMap = gb_trees:update(Expr, {ExprId,
+ [{Label, Defines}|DefinesList],
+ ReplRegs}, ExprMap),
+ mk_expr_map_bb(NewExprMap, IdMap, Label, Instrs);
+ none ->
+ NewExprId = new_expr_id(),
+ NewReplRegs = mk_replacement_regs(Defines),
+ NewExprMap = gb_trees:insert(Expr, {NewExprId,
+ [{Label, Defines}],
+ NewReplRegs}, ExprMap),
+ NewIdMap = gb_trees:insert(NewExprId, Expr, IdMap),
+ mk_expr_map_bb(NewExprMap, NewIdMap, Label, Instrs)
+ end;
+ false ->
+ mk_expr_map_bb(ExprMap, IdMap, Label, Instrs)
+ end.
+
+%%=============================================================================
+%% Creates new temporaries to replace defines in moved expressions.
+mk_replacement_regs([]) ->
+ [];
+mk_replacement_regs(Defines) ->
+ mk_replacement_regs(Defines, []).
+
+mk_replacement_regs([], NewRegs) ->
+ lists:reverse(NewRegs);
+mk_replacement_regs([Define|Defines], NewRegs) ->
+ case hipe_rtl:is_reg(Define) of
+ true ->
+ NewReg =
+ case hipe_rtl:reg_is_gcsafe(Define) of
+ true -> hipe_rtl:mk_new_reg_gcsafe();
+ false -> hipe_rtl:mk_new_reg()
+ end,
+ mk_replacement_regs(Defines, [NewReg|NewRegs]);
+ false ->
+ case hipe_rtl:is_var(Define) of
+ true ->
+ mk_replacement_regs(Defines, [hipe_rtl:mk_new_var()|NewRegs]);
+ false ->
+ true = hipe_rtl:is_fpreg(Define),
+ mk_replacement_regs(Defines, [hipe_rtl:mk_new_fpreg()|NewRegs])
+ end
+ end.
+
+%%=============================================================================
+%% Performs a lookup, which returns a tuple
+%% {expression ID, list of definitions, list of replacement registers}
+expr_map_lookup(Map, Expr) ->
+ gb_trees:lookup(Expr, Map).
+
+%%=============================================================================
+%% Gets the actual RTL instruction to be generated for insertions of an
+%% expression.
+expr_map_get_instr(Map, Expr) ->
+ case gb_trees:lookup(Expr, Map) of
+ {value, {_, _, Regs}} ->
+ expr_set_dst(Expr, Regs);
+ none ->
+ exit({?MODULE, expr_map_get_instr, "expression missing"})
+ end.
+
+%%=============================================================================
+%% Gets expression id.
+expr_map_get_id(Map, Expr) ->
+ case gb_trees:lookup(Expr, Map) of
+ {value, {ExprId, _, _}} ->
+ ExprId;
+ none ->
+ exit({?MODULE, expr_map_get_instr, "expression missing"})
+ end.
+
+%%=============================================================================
+%% Creates an rtl instruction that moves a value
+mk_expr_move_instr([Reg], [Define]) ->
+ case hipe_rtl:is_fpreg(Reg) of
+ true ->
+ hipe_rtl:mk_fmove(Reg, Define);
+ false ->
+ %% FIXME Check is_var() orelse is_reg() ?
+ hipe_rtl:mk_move(Reg, Define)
+ end;
+mk_expr_move_instr([_Reg|_Regs] = RegList, Defines) ->
+ %% FIXME Does this really work? What about floats...
+ %% (Multiple defines does not seem to be used by any of the
+ %% instructions considered by rtl_lcm at the moment so this is pretty much
+ %% untested/unused.)
+ hipe_rtl:mk_multimove(RegList, Defines);
+mk_expr_move_instr(_, []) ->
+ exit({?MODULE, mk_expr_move_instr, "bad match"}).
+
+%%=============================================================================
+%% Returns a set of all expressions in the code.
+%% all_exprs(_CFG, []) ->
+%% ?SETS:new();
+%% all_exprs(CFG, [Label|Labels]) ->
+%% BB = hipe_rtl_cfg:bb(CFG, Label),
+%% Code = hipe_bb:code(BB),
+%% ?SETS:union(all_exprs_bb(Code),
+%% all_exprs(CFG, Labels)).
+
+%%=============================================================================
+%% Returns a set of expressions in a basic block.
+%% all_exprs_bb([]) ->
+%% ?SETS:new();
+%% all_exprs_bb([Instr|Instrs]) ->
+%% case is_expr(Instr) of
+%% true ->
+%% Expr = expr_clear_dst(Instr),
+%% ExprSet = all_exprs_bb(Instrs),
+%% ?SETS:add_element(Expr, ExprSet);
+%% false ->
+%% all_exprs_bb(Instrs)
+%% end.
+
+%%%%%%%%%%%%%%%%%% EXPRESSION ID -> EXPRESSION MAP %%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Map from expression IDs to expressions.
+%%=============================================================================
+%% mk_expr_id_map() ->
+%% gb_trees:empty().
+
+%% expr_id_map_insert(Map, ExprId, Expr) ->
+%% gb_trees:insert(ExprId, Expr, Map).
+
+%% expr_id_map_lookup(Map, ExprId) ->
+%% gb_trees:lookup(ExprId, Map).
+
+%%=============================================================================
+%% Given expression id, gets expression.
+expr_id_map_get_expr(Map, ExprId) ->
+ case gb_trees:lookup(ExprId, Map) of
+ {value, Expr} ->
+ Expr;
+ none ->
+ exit({?MODULE, expr_id_map_get_expr, "expression id missing"})
+ end.
+
+%%=============================================================================
+%% Expression ID counter
+init_expr_id() ->
+ put({rtl_lcm,expr_id_count}, 0),
+ ok.
+
+-spec new_expr_id() -> non_neg_integer().
+new_expr_id() ->
+ Obj = {rtl_lcm, expr_id_count},
+ V = get(Obj),
+ put(Obj, V+1),
+ V.
+
+%%%%%%%%%%%%%%%%%% EDGE BB (INSERT BETWEEN) MAP %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Map from edges to labels.
+%% This is used by insert_expr_between to remember what new bbs it has created
+%% for insertions on edges, and thus for multiple insertions on the same edge
+%% to end up in the same bb.
+%%=============================================================================
+mk_edge_bb_map() ->
+ gb_trees:empty().
+
+edge_bb_map_insert(Map, Edge, Label) ->
+ gb_trees:enter(Edge, Label, Map).
+
+edge_bb_map_lookup(Map, Edge) ->
+ gb_trees:lookup(Edge, Map).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PRETTY-PRINTING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%=============================================================================
+%% Prints debug messages.
+-ifdef(LCM_DEBUG).
+
+pp_debug(Str, Args) ->
+ case ?LCM_DEBUG of
+ true ->
+ io:format(standard_io, Str, Args);
+ false ->
+ ok
+ end.
+
+pp_debug_instr(Instr) ->
+ case ?LCM_DEBUG of
+ true ->
+ hipe_rtl:pp_instr(standard_io, Instr);
+ false ->
+ ok
+ end.
+
+-else.
+
+pp_debug(_, _) ->
+ ok.
+
+pp_debug_instr(_) ->
+ ok.
+
+-endif. %% DEBUG
+
+%%=============================================================================
+%% Pretty-prints the calculated sets for the lazy code motion.
+pp_sets(_, _, _, _, _, _, []) ->
+ ok;
+pp_sets(ExprMap, IdMap, NodeInfo, EdgeInfo, AllExpr, CFG, [Label|Labels]) ->
+ Preds = hipe_rtl_cfg:pred(CFG, Label),
+ Succs = hipe_rtl_cfg:succ(CFG, Label),
+
+ io:format(standard_io, "Label ~w~n", [Label]),
+ io:format(standard_io, " Preds: ~w~n", [Preds]),
+ io:format(standard_io, " Succs: ~w~n", [Succs]),
+
+ case up_exp(NodeInfo, Label) of
+ none -> ok;
+ UpExp ->
+ case ?SETS:size(UpExp) =:= 0 of
+ false ->
+ io:format(standard_io, " UEExpr: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(UpExp));
+ true -> ok
+ end
+ end,
+ case down_exp(NodeInfo, Label) of
+ none -> ok;
+ DownExp ->
+ case ?SETS:size(DownExp) =:= 0 of
+ false ->
+ io:format(standard_io, " DEExpr: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(DownExp));
+ true -> ok
+ end
+ end,
+ case killed_expr(NodeInfo, Label) of
+ none -> ok;
+ KilledExpr ->
+ case ?SETS:size(KilledExpr) =:= 0 of
+ false ->
+ io:format(standard_io, " ExprKill: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(KilledExpr));
+ true -> ok
+ end
+ end,
+ case avail_in(NodeInfo, Label) of
+ none -> ok;
+ AvailIn ->
+ case ?SETS:size(AvailIn) =:= 0 of
+ false ->
+ io:format(standard_io, " AvailIn: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(AvailIn));
+ true -> ok
+ end
+ end,
+ case avail_out(NodeInfo, Label) of
+ none -> ok;
+ AvailOut ->
+ case ?SETS:size(AvailOut) =:= 0 of
+ false ->
+ io:format(standard_io, " AvailOut: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(AvailOut));
+ true -> ok
+ end
+ end,
+ case antic_in(NodeInfo, Label) of
+ none -> ok;
+ AnticIn ->
+ case ?SETS:size(AnticIn) =:= 0 of
+ false ->
+ io:format(standard_io, " AnticIn: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(AnticIn));
+ true -> ok
+ end
+ end,
+ case antic_out(NodeInfo, Label) of
+ none -> ok;
+ AnticOut ->
+ case ?SETS:size(AnticOut) =:= 0 of
+ false ->
+ io:format(standard_io, " AnticOut: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(AnticOut));
+ true -> ok
+ end
+ end,
+ case later_in(NodeInfo, Label) of
+ none -> ok;
+ LaterIn ->
+ case ?SETS:size(LaterIn) =:= 0 of
+ false ->
+ io:format(standard_io, " LaterIn: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(LaterIn));
+ true -> ok
+ end
+ end,
+
+ pp_earliest(ExprMap, IdMap, EdgeInfo, Label, Succs),
+ pp_later(ExprMap, IdMap, EdgeInfo, Label, Succs),
+
+ case delete(NodeInfo, Label) of
+ none -> ok;
+ Delete ->
+ case ?SETS:size(Delete) =:= 0 of
+ false ->
+ io:format(standard_io, " Delete: ~n", []),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(Delete));
+ true -> ok
+ end
+ end,
+ pp_sets(ExprMap, IdMap, NodeInfo, EdgeInfo, AllExpr, CFG, Labels).
+
+%%=============================================================================
+%% Pretty-prints the later set.
+pp_later(_, _, _, _, []) ->
+ ok;
+pp_later(ExprMap, IdMap, EdgeInfo, Pred, [Succ|Succs]) ->
+ case later(EdgeInfo, {Pred, Succ}) of
+ none -> ok;
+ Later ->
+ case ?SETS:size(Later) =:= 0 of
+ false ->
+ io:format(standard_io, " Later(~w->~w): ~n", [Pred,Succ]),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(Later));
+ true -> ok
+ end
+ end,
+ pp_later(ExprMap, IdMap, EdgeInfo, Pred, Succs).
+
+%%=============================================================================
+%% Pretty-prints the earliest set.
+pp_earliest(_, _, _, _, []) ->
+ ok;
+pp_earliest(ExprMap, IdMap, EdgeInfo, Pred, [Succ|Succs]) ->
+ case earliest(EdgeInfo, {Pred, Succ}) of
+ none -> ok;
+ Earliest ->
+ case ?SETS:size(Earliest) =:= 0 of
+ false ->
+ io:format(standard_io, " Earliest(~w->~w): ~n", [Pred,Succ]),
+ pp_exprs(ExprMap, IdMap, ?SETS:to_list(Earliest));
+ true -> ok
+ end
+ end,
+ pp_earliest(ExprMap, IdMap, EdgeInfo, Pred, Succs).
+
+%%=============================================================================
+%% Pretty-prints an expression
+pp_expr(ExprMap, IdMap, ExprId) ->
+ Expr = expr_id_map_get_expr(IdMap, ExprId),
+ hipe_rtl:pp_instr(standard_io, expr_map_get_instr(ExprMap, Expr)).
+
+pp_exprs(_, _, []) ->
+ ok;
+pp_exprs(ExprMap, IdMap, [E|Es]) ->
+ pp_expr(ExprMap, IdMap, E),
+ pp_exprs(ExprMap, IdMap, Es).
diff --git a/lib/hipe/rtl/hipe_rtl_liveness.erl b/lib/hipe/rtl/hipe_rtl_liveness.erl
new file mode 100644
index 0000000000..3cfada9d6c
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_liveness.erl
@@ -0,0 +1,145 @@
+%% $Id$
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% LIVENESS ANALYSIS
+%%
+%% Exports:
+%% ~~~~~~~
+%% analyze(CFG) - returns a liveness analysis of CFG.
+%% liveout(Liveness, Label) - returns a set of variables that are live on
+%% exit from basic block named Label.
+%% livein(Liveness, Label) - returns a set of variables that are live on
+%% entry to the basic block named Label.
+%% list(Instructions, LiveOut) - Given a list of instructions and a liveout
+%% set, returns a set of variables live at the first instruction.
+%%
+
+-module(hipe_rtl_liveness).
+
+%% -define(LIVEOUT_NEEDED,true). % needed for liveness.inc below.
+-define(PRETTY_PRINT,false).
+
+-include("hipe_rtl.hrl").
+-include("../flow/liveness.inc").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface to CFG and RTL.
+%%
+
+cfg_bb(CFG, L) ->
+ hipe_rtl_cfg:bb(CFG, L).
+
+cfg_postorder(CFG) ->
+ hipe_rtl_cfg:postorder(CFG).
+
+cfg_succ(CFG, L) ->
+ hipe_rtl_cfg:succ(CFG, L).
+
+uses(Instr) ->
+ hipe_rtl:uses(Instr).
+
+defines(Instr) ->
+ hipe_rtl:defines(Instr).
+
+%%
+%% This is the list of registers that are live at exit from a function
+%%
+
+liveout_no_succ() ->
+ hipe_rtl_arch:live_at_return().
+
+%%
+%% The following are used only if annotation of the code is requested.
+%%
+
+cfg_labels(CFG) ->
+ hipe_rtl_cfg:reverse_postorder(CFG).
+
+pp_block(Label, CFG) ->
+ BB=hipe_rtl_cfg:bb(CFG, Label),
+ Code=hipe_bb:code(BB),
+ hipe_rtl:pp_block(Code).
+
+pp_liveness_info(LiveList) ->
+ NewList=remove_precoloured(LiveList),
+ print_live_list(NewList).
+
+print_live_list([]) ->
+ io:format(" none~n", []);
+print_live_list([Last]) ->
+ io:format(" ", []),
+ print_var(Last),
+ io:format("~n", []);
+print_live_list([Var|Rest]) ->
+ io:format(" ", []),
+ print_var(Var),
+ io:format(",", []),
+ print_live_list(Rest).
+
+print_var(A) ->
+ case hipe_rtl:is_var(A) of
+ true ->
+ pp_var(A);
+ false ->
+ case hipe_rtl:is_reg(A) of
+ true ->
+ pp_reg(A);
+ false ->
+ case hipe_rtl:is_fpreg(A) of
+ true ->
+ io:format("f~w", [hipe_rtl:fpreg_index(A)]);
+ false ->
+ io:format("unknown:~w", [A])
+ end
+ end
+ end.
+
+pp_hard_reg(N) ->
+ io:format("~s", [hipe_rtl_arch:reg_name(N)]).
+
+pp_reg(Arg) ->
+ case hipe_rtl_arch:is_precoloured(Arg) of
+ true ->
+ pp_hard_reg(hipe_rtl:reg_index(Arg));
+ false ->
+ io:format("r~w", [hipe_rtl:reg_index(Arg)])
+ end.
+
+pp_var(Arg) ->
+ case hipe_rtl_arch:is_precoloured(Arg) of
+ true ->
+ pp_hard_reg(hipe_rtl:var_index(Arg));
+ false ->
+ io:format("v~w", [hipe_rtl:var_index(Arg)])
+ end.
+
+remove_precoloured(List) ->
+ List.
+ %% [X || X <- List, not hipe_rtl_arch:is_precoloured(X)].
+
+-ifdef(DEBUG_LIVENESS).
+cfg_bb_add(CFG, L, NewBB) ->
+ hipe_rtl_cfg:bb_add(CFG, L, NewBB).
+
+mk_comment(Text) ->
+ hipe_rtl:mk_comment(Text).
+-endif.
diff --git a/lib/hipe/rtl/hipe_rtl_mk_switch.erl b/lib/hipe/rtl/hipe_rtl_mk_switch.erl
new file mode 100644
index 0000000000..e5175217d6
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_mk_switch.erl
@@ -0,0 +1,985 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Filename : hipe_rtl_mk_switch.erl
+%% Module : hipe_rtl_mk_switch
+%% Purpose : Implements switching on Erlang values.
+%% Notes : Only fixnums are supported well,
+%% atoms work with table search,
+%% the inline search of atoms might have some bugs.
+%% Should be extended to handle bignums and floats.
+%%
+%% History : * 2001-02-28 Erik Johansson (happi@it.uu.se):
+%% Created.
+%% * 2001-04-01 Erik Trulsson (ertr1013@csd.uu.se):
+%% Stefan Lindstr�m (stli3993@csd.uu.se):
+%% Added clustering and inlined binary search trees.
+%% * 2001-07-30 EJ (happi@it.uu.se):
+%% Fixed some bugs and started cleanup.
+%% ====================================================================
+%% Exports :
+%% gen_switch_val(I, VarMap, ConstTab, Options)
+%% gen_switch_tuple(I, Map, ConstTab, Options)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_mk_switch).
+
+-export([gen_switch_val/4, gen_switch_tuple/4]).
+
+%%-------------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+
+%%-------------------------------------------------------------------------
+
+-define(MINFORJUMPTABLE,9).
+ % Minimum number of integers needed to use something else than an inline search.
+-define(MINFORINTSEARCHTREE,65). % Must be at least 3
+ % Minimum number of integer elements needed to use a non-inline binary search.
+
+-define(MININLINEATOMSEARCH,8).
+ % Minimum number of atoms needed to use an inline binary search instead
+ % of a fast linear search.
+
+-define(MINFORATOMSEARCHTREE,20). % Must be at least 3
+ % Minimum number of atoms needed to use a non-inline binary search instead
+ % of a linear search.
+
+-define(MAXINLINEATOMSEARCH,64). % Must be at least 3
+ % The cutoff point between inlined and non-inlined binary search for atoms
+
+-define(WORDSIZE, hipe_rtl_arch:word_size()).
+-define(MINDENSITY, 0.5).
+ % Minimum density required to use a jumptable instead of a binary search.
+
+%% The reason why MINFORINTSEARCHTREE and MINFORATOMSEARCHTREE must be
+%% at least 3 is that the function tab/5 will enter an infinite loop
+%% and hang when faced with a switch of size 1 or 2.
+
+
+%% Options used by this module:
+%%
+%% [no_]use_indexing
+%% Determines if any indexing be should be done at all. Turned on
+%% by default at optimization level o2 and higher.
+%%
+%% [no_]use_clusters
+%% Controls whether we attempt to divide sparse integer switches
+%% into smaller dense clusters for which jumptables are practical.
+%% Turned off by default since it can increase compilation time
+%% considerably and most programs will gain little benefit from it.
+%%
+%% [no_]use_inline_atom_search
+%% Controls whether we use an inline binary search for small number
+%% of atoms. Turned off by default since this is currently only
+%% supported on SPARC (and not on x86) and probably needs a bit
+%% more testing before it can be turned on by default.
+
+gen_switch_val(I, VarMap, ConstTab, Options) ->
+ case proplists:get_bool(use_indexing, Options) of
+ false -> gen_slow_switch_val(I, VarMap, ConstTab, Options);
+ true -> gen_fast_switch_val(I, VarMap, ConstTab, Options)
+ end.
+
+gen_fast_switch_val(I, VarMap, ConstTab, Options) ->
+ {Arg, VarMap0} =
+ hipe_rtl_varmap:icode_var2rtl_var(hipe_icode:switch_val_term(I), VarMap),
+ IcodeFail = hipe_icode:switch_val_fail_label(I),
+ {Fail, VarMap1} = hipe_rtl_varmap:icode_label2rtl_label(IcodeFail, VarMap0),
+ %% Important that the list of cases is sorted when handling integers.
+ UnsortedCases = hipe_icode:switch_val_cases(I),
+ Cases = lists:sort(UnsortedCases),
+
+ check_duplicates(Cases),
+ %% This check is currently not really necessary. The checking
+ %% happens at an earlier phase of the compilation.
+ {Types, InitCode} = split_types(Cases, Arg),
+ handle_types(Types, InitCode, VarMap1, ConstTab, Arg, {I, Fail, Options}).
+
+handle_types([{Type,Lbl,Cases}|Types], Code, VarMap, ConstTab, Arg, Info) ->
+ {Code1,VarMap1,ConstTab1} = gen_fast_switch_on(Type, Cases,
+ VarMap,
+ ConstTab, Arg, Info),
+ handle_types(Types, [Code,Lbl,Code1], VarMap1, ConstTab1, Arg, Info);
+handle_types([], Code, VarMap, ConstTab, _, _) ->
+ {Code, VarMap, ConstTab}.
+
+
+gen_fast_switch_on(integer, Cases, VarMap, ConstTab, Arg, {I, Fail, Options}) ->
+ {First,_} = hd(Cases),
+ Min = hipe_icode:const_value(First),
+ if length(Cases) < ?MINFORJUMPTABLE ->
+ gen_small_switch_val(Arg,Cases,Fail,VarMap,ConstTab,Options);
+ true ->
+ case proplists:get_bool(use_clusters, Options) of
+ false ->
+ M = list_to_tuple(Cases),
+ D = density(M, 1, tuple_size(M)),
+ if
+ D >= ?MINDENSITY ->
+ gen_jump_table(Arg,Fail,hipe_icode:switch_val_fail_label(I),VarMap,ConstTab,Cases,Min);
+ true ->
+ gen_search_switch_val(Arg, Cases, Fail, VarMap, ConstTab, Options)
+ end;
+ true ->
+ MC = minclusters(Cases),
+ Cl = cluster_split(Cases,MC),
+ CM = cluster_merge(Cl),
+ find_cluster(CM,VarMap,ConstTab,Options,Arg,Fail,hipe_icode:switch_val_fail_label(I))
+ end
+ end;
+gen_fast_switch_on(atom, Cases, VarMap, ConstTab, Arg, {_I, Fail, Options}) ->
+ case proplists:get_bool(use_inline_atom_search, Options) of
+ true ->
+ if
+ length(Cases) < ?MININLINEATOMSEARCH ->
+ gen_linear_switch_val(Arg, Cases, Fail, VarMap, ConstTab, Options);
+ length(Cases) > ?MAXINLINEATOMSEARCH ->
+ gen_search_switch_val(Arg, Cases, Fail, VarMap, ConstTab, Options);
+ true ->
+ gen_atom_switch_val(Arg,Cases,Fail,VarMap,ConstTab,Options)
+ end;
+ false ->
+ if length(Cases) < ?MINFORATOMSEARCHTREE ->
+ gen_linear_switch_val(Arg, Cases, Fail, VarMap, ConstTab, Options);
+ true ->
+ gen_search_switch_val(Arg, Cases, Fail, VarMap, ConstTab, Options)
+ end
+ end;
+gen_fast_switch_on(_, _, VarMap, ConstTab, _, {I,_Fail,Options}) ->
+ %% We can only handle smart indexing of integers and atoms
+ %% TODO: Consider bignum
+ gen_slow_switch_val(I, VarMap, ConstTab, Options).
+
+
+%% Split different types into separate switches.
+split_types([Case|Cases], Arg) ->
+ Type1 = casetype(Case),
+ Types = split(Cases,Type1,[Case],[]),
+ switch_on_types(Types,[], [], Arg);
+split_types([],_) ->
+ %% Cant happen.
+ ?EXIT({empty_caselist}).
+
+switch_on_types([{Type,Cases}], AccCode, AccCases, _Arg) ->
+ Lbl = hipe_rtl:mk_new_label(),
+ I = hipe_rtl:mk_goto(hipe_rtl:label_name(Lbl)),
+ {[{Type,Lbl,lists:reverse(Cases)} | AccCases], lists:reverse([I|AccCode])};
+switch_on_types([{other,Cases} | Rest], AccCode, AccCases, Arg) ->
+ %% Make sure the general case is handled last.
+ switch_on_types(Rest ++ [{other,Cases}], AccCode, AccCases, Arg);
+switch_on_types([{Type,Cases} | Rest], AccCode, AccCases, Arg) ->
+ TLab = hipe_rtl:mk_new_label(),
+ FLab = hipe_rtl:mk_new_label(),
+ TestCode =
+ case Type of
+ integer ->
+ hipe_tagscheme:test_fixnum(Arg, hipe_rtl:label_name(TLab),
+ hipe_rtl:label_name(FLab), 0.5);
+ atom ->
+ hipe_tagscheme:test_atom(Arg, hipe_rtl:label_name(TLab),
+ hipe_rtl:label_name(FLab), 0.5);
+ bignum ->
+ hipe_tagscheme:test_bignum(Arg, hipe_rtl:label_name(TLab),
+ hipe_rtl:label_name(FLab), 0.5);
+ _ -> ?EXIT({ooops, type_not_handled, Type})
+ end,
+ switch_on_types(Rest, [[TestCode,FLab] | AccCode],
+ [{Type,TLab,lists:reverse(Cases)} | AccCases], Arg).
+
+split([Case|Cases], Type, Current, Rest) ->
+ case casetype(Case) of
+ Type ->
+ split(Cases, Type, [Case|Current],Rest);
+ Other ->
+ split(Cases, Other, [Case], [{Type,Current}|Rest])
+ end;
+split([], Type, Current, Rest) ->
+ [{Type, Current} | Rest].
+
+%% Determine what type an entry in the caselist has
+
+casetype({Const,_}) ->
+ casetype(hipe_icode:const_value(Const));
+casetype(A) ->
+ if
+ is_integer(A) ->
+ case hipe_tagscheme:is_fixnum(A) of
+ true -> integer;
+ false -> bignum
+ end;
+ is_float(A) -> float;
+ is_atom(A) -> atom;
+ true -> other
+ end.
+
+%% check that no duplicate values occur in the case list and also
+%% check that all case values have the same type.
+check_duplicates([]) -> true;
+check_duplicates([_]) -> true;
+check_duplicates([{Const1,_},{Const2,L2}|T]) ->
+ C1 = hipe_icode:const_value(Const1),
+ C2 = hipe_icode:const_value(Const2),
+ %% T1 = casetype(C1),
+ %% T2 = casetype(C2),
+ if C1 =/= C2 -> %% , T1 =:= T2 ->
+ check_duplicates([{Const2,L2}|T]);
+ true ->
+ ?EXIT({bad_values_in_switchval,C1})
+ end.
+
+%%
+%% Determine the optimal way to divide Cases into clusters such that each
+%% cluster is dense.
+%%
+%% See:
+%% Producing Good Code for the Case Statement, Robert L. Bernstein
+%% Software - Practice and Experience vol 15, 1985, no 10, pp 1021--1024
+%% And
+%% Correction to "Producing Good Code for the Case Statement"
+%% Sampath Kannan and Todd A. Proebsting,
+%% Software - Practice and Experience vol 24, 1994, no 2, p 233
+%%
+%% (The latter is where the algorithm comes from.)
+
+%% This function will return a tuple with the first element being 0
+%% The rest of the elements being integers. A value of M at index N
+%% (where the first element is considered to have index 0) means that
+%% the first N cases can be divided into M (but no fewer) clusters where
+%% each cluster is dense.
+
+minclusters(Cases) when is_list(Cases) ->
+ minclusters(list_to_tuple(Cases));
+minclusters(Cases) when is_tuple(Cases) ->
+ N = tuple_size(Cases),
+ MinClusters = list_to_tuple([0|n_list(N,inf)]),
+ i_loop(1,N,MinClusters,Cases).
+
+%% Create a list with N elements initialized to Init
+n_list(0,_) -> [];
+n_list(N,Init) -> [Init | n_list(N-1,Init)].
+
+%% Do the dirty work of minclusters
+i_loop(I,N,MinClusters,_Cases) when I > N ->
+ MinClusters;
+i_loop(I,N,MinClusters,Cases) when I =< N ->
+ M = j_loop(0, I-1, MinClusters, Cases),
+ i_loop(I+1, N, M, Cases).
+
+%% More dirty work
+j_loop(J,I1,MinClusters,_Cases) when J > I1 ->
+ MinClusters;
+j_loop(J,I1,MinClusters,Cases) when J =< I1 ->
+ D = density(Cases,J+1,I1+1),
+ A0 = element(J+1,MinClusters),
+ A = if
+ is_number(A0) ->
+ A0+1;
+ true ->
+ A0
+ end,
+ B = element(I1+2,MinClusters),
+ M = if
+ D >= ?MINDENSITY, A<B ->
+ setelement(I1+2,MinClusters,A);
+ true ->
+ MinClusters
+ end,
+ j_loop(J+1,I1,M,Cases).
+
+
+%% Determine the density of a (subset of a) case list
+%% A is a tuple with the cases in order from smallest to largest
+%% I is the index of the first element and J of the last
+
+density(A,I,J) ->
+ {AI,_} = element(I,A),
+ {AJ,_} = element(J,A),
+ (J-I+1)/(hipe_icode:const_value(AJ)-hipe_icode:const_value(AI)+1).
+
+
+%% Split a case list into dense clusters
+%% Returns a list of lists of cases.
+%%
+%% Cases is the case list and Clust is a list describing the optimal
+%% clustering as returned by minclusters
+%%
+%% If the value in the last place in minclusters is M then we can
+%% split the case list into M clusters. We then search for the last
+%% (== right-most) occurance of the value M-1 in minclusters. That
+%% indicates the largest number of cases that can be split into M-1
+%% clusters. This means that the cases in between constitute one
+%% cluster. Then we recurse on the remainder of the cases.
+%%
+%% The various calls to lists:reverse are just to ensure that the
+%% cases remain in the correct, sorted order.
+
+cluster_split(Cases, Clust) ->
+ A = tl(tuple_to_list(Clust)),
+ Max = element(tuple_size(Clust), Clust),
+ L1 = lists:reverse(Cases),
+ L2 = lists:reverse(A),
+ cluster_split(Max, [], [], L1, L2).
+
+cluster_split(0, [], Res, Cases, _Clust) ->
+ L = lists:reverse(Cases),
+ {H,_} = hd(L),
+ {T,_} = hd(Cases),
+ [{dense,hipe_icode:const_value(H),hipe_icode:const_value(T),L}|Res];
+cluster_split(N, [], Res, Cases, [N|_] = Clust) ->
+ cluster_split(N-1, [], Res, Cases, Clust);
+cluster_split(N,Sofar,Res,Cases,[N|Clust]) ->
+ {H,_} = hd(Sofar),
+ {T,_} = lists:last(Sofar),
+ cluster_split(N-1,[],[{dense,hipe_icode:const_value(H),hipe_icode:const_value(T),Sofar}|Res],Cases,[N|Clust]);
+cluster_split(N,Sofar,Res,[C|Cases],[_|Clust]) ->
+ cluster_split(N,[C|Sofar],Res,Cases,Clust).
+
+%%
+%% Merge adjacent small clusters into larger sparse clusters
+%%
+cluster_merge([C]) -> [C];
+cluster_merge([{dense,Min,Max,C}|T]) when length(C) >= ?MINFORJUMPTABLE ->
+ C2 = cluster_merge(T),
+ [{dense,Min,Max,C}|C2];
+cluster_merge([{sparse,Min,_,C},{sparse,_,Max,D}|T]) ->
+ R = {sparse,Min,Max,C ++ D},
+ cluster_merge([R|T]);
+cluster_merge([{sparse,Min,_,C},{dense,_,Max,D}|T]) when length(D) < ?MINFORJUMPTABLE ->
+ R = {sparse,Min,Max,C ++ D},
+ cluster_merge([R|T]);
+cluster_merge([{dense,Min,_,C},{dense,_,Max,D}|T]) when length(C) < ?MINFORJUMPTABLE, length(D) < ?MINFORJUMPTABLE ->
+ R = {sparse,Min,Max,C ++ D},
+ cluster_merge([R|T]);
+cluster_merge([{dense,Min,_,D},{sparse,_,Max,C}|T]) when length(D) < ?MINFORJUMPTABLE ->
+ R = {sparse,Min,Max,C ++ D},
+ cluster_merge([R|T]);
+cluster_merge([A,{dense,Min,Max,C}|T]) when length(C) >= ?MINFORJUMPTABLE ->
+ R = cluster_merge([{dense,Min,Max,C}|T]),
+ [A|R].
+
+
+%% Generate code to search for the correct cluster
+
+find_cluster([{sparse,_Min,_Max,C}],VarMap,ConstTab,Options,Arg,Fail,_IcodeFail) ->
+ case length(C) < ?MINFORINTSEARCHTREE of
+ true ->
+ gen_small_switch_val(Arg,C,Fail,VarMap,ConstTab,Options);
+ _ ->
+ gen_search_switch_val(Arg,C,Fail,VarMap,ConstTab,Options)
+ end;
+find_cluster([{dense,Min,_Max,C}],VarMap,ConstTab,Options,Arg,Fail,IcodeFail) ->
+ case length(C) < ?MINFORJUMPTABLE of
+ true ->
+ gen_small_switch_val(Arg,C,Fail,VarMap,ConstTab,Options);
+ _ ->
+ gen_jump_table(Arg,Fail,IcodeFail,VarMap,ConstTab,C,Min)
+ end;
+find_cluster([{Density,Min,Max,C}|T],VarMap,ConstTab,Options,Arg,Fail,IcodeFail) ->
+ ClustLab = hipe_rtl:mk_new_label(),
+ NextLab = hipe_rtl:mk_new_label(),
+ {ClustCode,V1,C1} = find_cluster([{Density,Min,Max,C}],VarMap,ConstTab,Options,Arg,Fail,IcodeFail),
+
+ {Rest,V2,C2} = find_cluster(T,V1,C1,Options,Arg,Fail,IcodeFail),
+
+ {[
+ hipe_rtl:mk_branch(Arg, gt, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(Max)),
+ hipe_rtl:label_name(NextLab),
+ hipe_rtl:label_name(ClustLab), 0.50),
+ ClustLab
+ ] ++
+ ClustCode ++
+ [NextLab] ++
+ Rest,
+ V2,C2}.
+
+%% Generate efficient code for a linear search through the case list.
+%% Only works for atoms and integer.
+gen_linear_switch_val(Arg,Cases,Fail,VarMap,ConstTab,_Options) ->
+ {Values,_Labels} = split_cases(Cases),
+ {LabMap,VarMap1} = lbls_from_cases(Cases,VarMap),
+ Code = fast_linear_search(Arg,Values,LabMap,Fail),
+ {Code,VarMap1,ConstTab}.
+
+fast_linear_search(_Arg,[],[],Fail) ->
+ [hipe_rtl:mk_goto(hipe_rtl:label_name(Fail))];
+fast_linear_search(Arg,[Case|Cases],[Label|Labels],Fail) ->
+ Reg = hipe_rtl:mk_new_reg_gcsafe(),
+ NextLab = hipe_rtl:mk_new_label(),
+ C2 = fast_linear_search(Arg,Cases,Labels,Fail),
+ C1 =
+ if
+ is_integer(Case) ->
+ TVal = hipe_tagscheme:mk_fixnum(Case),
+ [
+ hipe_rtl:mk_move(Reg,hipe_rtl:mk_imm(TVal)),
+ hipe_rtl:mk_branch(Arg,eq,Reg,
+ Label,
+ hipe_rtl:label_name(NextLab), 0.5),
+ NextLab
+ ];
+ is_atom(Case) ->
+ [
+ hipe_rtl:mk_load_atom(Reg,Case),
+ hipe_rtl:mk_branch(Arg,eq,Reg,
+ Label,
+ hipe_rtl:label_name(NextLab), 0.5),
+ NextLab
+ ];
+ true -> % This should never happen !
+ ?EXIT({internal_error_in_switch_val,Case})
+ end,
+ [C1,C2].
+
+
+%% Generate code to search through a small cluster of integers using
+%% binary search
+gen_small_switch_val(Arg,Cases,Fail,VarMap,ConstTab,_Options) ->
+ {Values,_Labels} = split_cases(Cases),
+ {LabMap,VarMap1} = lbls_from_cases(Cases,VarMap),
+ Keys = [hipe_tagscheme:mk_fixnum(X) % Add tags to the values
+ || X <- Values],
+ Code = inline_search(Keys, LabMap, Arg, Fail),
+ {Code, VarMap1, ConstTab}.
+
+
+%% Generate code to search through a small cluster of atoms
+gen_atom_switch_val(Arg,Cases,Fail,VarMap,ConstTab,_Options) ->
+ {Values, _Labels} = split_cases(Cases),
+ {LabMap,VarMap1} = lbls_from_cases(Cases,VarMap),
+ LMap = [{label,L} || L <- LabMap],
+ {NewConstTab,Id} = hipe_consttab:insert_sorted_block(ConstTab, Values),
+ {NewConstTab2,LabId} =
+ hipe_consttab:insert_sorted_block(NewConstTab, word, LMap, Values),
+ Code = inline_atom_search(0, length(Cases)-1, Id, LabId, Arg, Fail, LabMap),
+ {Code, VarMap1, NewConstTab2}.
+
+
+%% calculate the middle position of a list (+ 1 because of 1-indexing of lists)
+get_middle(List) ->
+ N = length(List),
+ N div 2 + 1.
+
+%% get element [N1, N2] from a list
+get_cases(_, 0, 0) ->
+ [];
+get_cases([H|T], 0, N) ->
+ [H | get_cases(T, 0, N - 1)];
+get_cases([_|T], N1, N2) ->
+ get_cases(T, N1 - 1, N2 - 1).
+
+
+%% inline_search/4 creates RTL code for a inlined binary search.
+%% It requires two sorted tables - one with the keys to search
+%% through and one with the corresponding labels to jump to.
+%%
+%% Input:
+%% KeyList - A list of keys to search through.
+%% LableList - A list of labels to jump to.
+%% KeyReg - A register containing the key to search for.
+%% Default - A label to jump to if the key is not found.
+%%
+
+inline_search([], _LabelList, _KeyReg, _Default) -> [];
+inline_search(KeyList, LabelList, KeyReg, Default) ->
+ %% Create some registers and labels that we need.
+ Reg = hipe_rtl:mk_new_reg_gcsafe(),
+ Lab1 = hipe_rtl:mk_new_label(),
+ Lab2 = hipe_rtl:mk_new_label(),
+ Lab3 = hipe_rtl:mk_new_label(),
+
+ Length = length(KeyList),
+
+ if
+ Length >= 3 ->
+ %% Get middle element and keys/labels before that and after
+ Middle_pos = get_middle(KeyList),
+ Middle_key = lists:nth(Middle_pos, KeyList),
+ Keys_beginning = get_cases(KeyList, 0, Middle_pos - 1),
+ Labels_beginning = get_cases(LabelList, 0, Middle_pos - 1),
+ Keys_ending = get_cases(KeyList, Middle_pos, Length),
+ Labels_ending = get_cases(LabelList, Middle_pos, Length),
+
+ %% Create the code.
+
+ %% Get the label and build it up properly
+ Middle_label = lists:nth(Middle_pos, LabelList),
+
+ A = [hipe_rtl:mk_move(Reg, hipe_rtl:mk_imm(Middle_key)),
+ hipe_rtl:mk_branch(KeyReg, lt, Reg,
+ hipe_rtl:label_name(Lab2),
+ hipe_rtl:label_name(Lab1), 0.5),
+ Lab1,
+ hipe_rtl:mk_branch(KeyReg, gt, Reg,
+ hipe_rtl:label_name(Lab3),
+ Middle_label , 0.5),
+ Lab2],
+ %% build search tree for keys less than the middle element
+ B = inline_search(Keys_beginning, Labels_beginning, KeyReg, Default),
+ %% ...and for keys bigger than the middle element
+ D = inline_search(Keys_ending, Labels_ending, KeyReg, Default),
+
+ %% append the code and return it
+ A ++ B ++ [Lab3] ++ D;
+
+ Length =:= 2 ->
+ %% get the first and second elements and theirs labels
+ Key_first = hd(KeyList),
+ First_label = hd(LabelList),
+
+ %% Key_second = hipe_tagscheme:mk_fixnum(lists:nth(2, KeyList)),
+ Key_second = lists:nth(2, KeyList),
+ Second_label = lists:nth(2, LabelList),
+
+ NewLab = hipe_rtl:mk_new_label(),
+
+ %% compare them
+ A = [hipe_rtl:mk_move(Reg,hipe_rtl:mk_imm(Key_first)),
+ hipe_rtl:mk_branch(KeyReg, eq, Reg,
+ First_label,
+ hipe_rtl:label_name(NewLab) , 0.5),
+ NewLab],
+
+ B = [hipe_rtl:mk_move(Reg,hipe_rtl:mk_imm(Key_second)),
+ hipe_rtl:mk_branch(KeyReg, eq, Reg,
+ Second_label,
+ hipe_rtl:label_name(Default) , 0.5)],
+ A ++ B;
+
+ Length =:= 1 ->
+ Key = hd(KeyList),
+ Label = hd(LabelList),
+
+ [hipe_rtl:mk_move(Reg,hipe_rtl:mk_imm(Key)),
+ hipe_rtl:mk_branch(KeyReg, eq, Reg,
+ Label,
+ hipe_rtl:label_name(Default) , 0.5)]
+ end.
+
+
+inline_atom_search(Start, End, Block, LBlock, KeyReg, Default, Labels) ->
+ Reg = hipe_rtl:mk_new_reg_gcsafe(),
+
+ Length = (End - Start) + 1,
+
+ if
+ Length >= 3 ->
+ Lab1 = hipe_rtl:mk_new_label(),
+ Lab2 = hipe_rtl:mk_new_label(),
+ Lab3 = hipe_rtl:mk_new_label(),
+ Lab4 = hipe_rtl:mk_new_label(),
+
+ Mid = ((End-Start) div 2)+Start,
+ End1 = Mid-1,
+ Start1 = Mid+1,
+ A = [
+ hipe_rtl:mk_load_word_index(Reg,Block,Mid),
+ hipe_rtl:mk_branch(KeyReg, lt, Reg,
+ hipe_rtl:label_name(Lab2),
+ hipe_rtl:label_name(Lab1), 0.5),
+ Lab1,
+ hipe_rtl:mk_branch(KeyReg, gt, Reg,
+ hipe_rtl:label_name(Lab3),
+ hipe_rtl:label_name(Lab4), 0.5),
+ Lab4,
+ hipe_rtl:mk_goto_index(LBlock, Mid, Labels),
+ Lab2
+ ],
+ B = [inline_atom_search(Start,End1,Block,LBlock,KeyReg,Default,Labels)],
+ C = [inline_atom_search(Start1,End,Block,LBlock,KeyReg,Default,Labels)],
+ A ++ B ++ [Lab3] ++ C;
+
+ Length =:= 2 ->
+ L1 = hipe_rtl:mk_new_label(),
+ L2 = hipe_rtl:mk_new_label(),
+ L3 = hipe_rtl:mk_new_label(),
+ [
+ hipe_rtl:mk_load_word_index(Reg,Block,Start),
+ hipe_rtl:mk_branch(KeyReg,eq,Reg,
+ hipe_rtl:label_name(L1),
+ hipe_rtl:label_name(L2), 0.5),
+ L1,
+ hipe_rtl:mk_goto_index(LBlock,Start,Labels),
+
+ L2,
+ hipe_rtl:mk_load_word_index(Reg,Block,End),
+ hipe_rtl:mk_branch(KeyReg,eq,Reg,
+ hipe_rtl:label_name(L3),
+ hipe_rtl:label_name(Default), 0.5),
+ L3,
+ hipe_rtl:mk_goto_index(LBlock, End, Labels)
+ ];
+
+ Length =:= 1 ->
+ NewLab = hipe_rtl:mk_new_label(),
+ [
+ hipe_rtl:mk_load_word_index(Reg,Block,Start),
+ hipe_rtl:mk_branch(KeyReg, eq, Reg,
+ hipe_rtl:label_name(NewLab),
+ hipe_rtl:label_name(Default), 0.9),
+ NewLab,
+ hipe_rtl:mk_goto_index(LBlock, Start, Labels)
+ ]
+ end.
+
+
+%% Create a jumptable
+gen_jump_table(Arg,Fail,IcodeFail,VarMap,ConstTab,Cases,Min) ->
+ %% Map is a rtl mapping of Dense
+ {Max,DenseTbl} = dense_interval(Cases,Min,IcodeFail),
+ {Map,VarMap2} = lbls_from_cases(DenseTbl,VarMap),
+
+ %% Make some labels and registers that we need.
+ BelowLab = hipe_rtl:mk_new_label(),
+ UntaggedR = hipe_rtl:mk_new_reg_gcsafe(),
+ StartR = hipe_rtl:mk_new_reg_gcsafe(),
+
+ %% Generate the code to do the switch...
+ {[
+ %% Untag the index.
+ hipe_tagscheme:untag_fixnum(UntaggedR, Arg)|
+ %% Check that the index is within Min and Max.
+ case Min of
+ 0 -> %% First element is 0 this is simple.
+ [hipe_rtl:mk_branch(UntaggedR, gtu, hipe_rtl:mk_imm(Max),
+ hipe_rtl:label_name(Fail),
+ hipe_rtl:label_name(BelowLab), 0.01),
+ BelowLab,
+ %% StartR contains the index into the jumptable
+ hipe_rtl:mk_switch(UntaggedR, Map)];
+ _ -> %% First element is not 0
+ [hipe_rtl:mk_alu(StartR, UntaggedR, sub,
+ hipe_rtl:mk_imm(Min)),
+ hipe_rtl:mk_branch(StartR, gtu, hipe_rtl:mk_imm(Max-Min),
+ hipe_rtl:label_name(Fail),
+ hipe_rtl:label_name(BelowLab), 0.01),
+ BelowLab,
+ %% StartR contains the index into the jumptable
+ hipe_rtl:mk_switch(StartR, Map)]
+ end],
+ VarMap2,
+ ConstTab}.
+
+
+%% Generate the jumptable for Cases while filling in unused positions
+%% with the fail label
+
+dense_interval(Cases, Min, IcodeFail) ->
+ dense_interval(Cases, Min, IcodeFail, 0, 0).
+dense_interval([Pair = {Const,_}|Rest], Pos, Fail, Range, NoEntries) ->
+ Val = hipe_icode:const_value(Const),
+ if
+ Pos < Val ->
+ {Max, Res} =
+ dense_interval([Pair|Rest], Pos+1, Fail, Range+1, NoEntries),
+ {Max,[{hipe_icode:mk_const(Pos), Fail}|Res]};
+ true ->
+ {Max, Res} = dense_interval(Rest, Pos+1, Fail, Range+1, NoEntries+1),
+ {Max, [Pair | Res]}
+ end;
+dense_interval([], Max, _, _, _) ->
+ {Max-1, []}.
+
+
+%%-------------------------------------------------------------------------
+%% switch_val without jumptable
+%%
+
+gen_slow_switch_val(I, VarMap, ConstTab, Options) ->
+ Is = rewrite_switch_val(I),
+ ?IF_DEBUG_LEVEL(3,?msg("Switch: ~w\n", [Is]), no_debug),
+ hipe_icode2rtl:translate_instrs(Is, VarMap, ConstTab, Options).
+
+rewrite_switch_val(I) ->
+ Var = hipe_icode:switch_val_term(I),
+ Fail = hipe_icode:switch_val_fail_label(I),
+ Cases = hipe_icode:switch_val_cases(I),
+ rewrite_switch_val_cases(Cases, Fail, Var).
+
+rewrite_switch_val_cases([{C,L}|Cases], Fail, Arg) ->
+ Tmp = hipe_icode:mk_new_var(),
+ NextLab = hipe_icode:mk_new_label(),
+ [hipe_icode:mk_move(Tmp, C),
+ hipe_icode:mk_if(op_exact_eqeq_2, [Arg, Tmp], L,
+ hipe_icode:label_name(NextLab)),
+ NextLab |
+ rewrite_switch_val_cases(Cases, Fail, Arg)];
+rewrite_switch_val_cases([], Fail, _Arg) ->
+ [hipe_icode:mk_goto(Fail)].
+
+
+%%-------------------------------------------------------------------------
+%% switch_val with binary search jumptable
+%%
+
+gen_search_switch_val(Arg, Cases, Default, VarMap, ConstTab, _Options) ->
+ ValTableR = hipe_rtl:mk_new_reg_gcsafe(),
+
+ {Values,_Labels} = split_cases(Cases),
+ {NewConstTab,Id} = hipe_consttab:insert_sorted_block(ConstTab, Values),
+ {LabMap,VarMap1} = lbls_from_cases(Cases,VarMap),
+
+ Code =
+ [hipe_rtl:mk_load_address(ValTableR, Id, constant)|
+ tab(Values,LabMap,Arg,ValTableR,Default)],
+ {Code, VarMap1, NewConstTab}.
+
+
+%%-------------------------------------------------------------------------
+%%
+%% tab/5 creates RTL code for a binary search.
+%% It requires two sorted tables one with the keys to search
+%% through and one with the corresponding labels to jump to.
+%%
+%% The implementation is derived from John Bentlys
+%% Programming Pearls.
+%%
+%% Input:
+%% KeyList - A list of keys to search through.
+%% (Just used to calculate the number of elements.)
+%% LableList - A list of labels to jump to.
+%% KeyReg - A register containing the key to search for.
+%% TablePntrReg - A register containing a pointer to the
+%% tables with keys
+%% Default - A lable to jump to if the key is not found.
+%%
+%% Example:
+%% KeyTbl: < a, b, d, f, h, i, z >
+%% Lbls: < 5, 3, 2, 4, 1, 7, 6 >
+%% Default: 8
+%% KeyReg: v37
+%% TablePntrReg: r41
+%%
+%% should give code like:
+%% r41 <- KeyTbl
+%% r42 <- 0
+%% r43 <- [r41+16]
+%% if (r43 gt v37) then L17 (0.50) else L16
+%% L16:
+%% r42 <- 16
+%% goto L17
+%% L17:
+%% r46 <- r42 add 16
+%% r45 <- [r41+r46]
+%% if (r45 gt v37) then L21 (0.50) else L20
+%% L20:
+%% r42 <- r46
+%% goto L21
+%% L21:
+%% r48 <- r42 add 8
+%% r47 <- [r41+r48]
+%% if (r47 gt v37) then L23 (0.50) else L22
+%% L22:
+%% r42 <- r48
+%% goto L23
+%% L23:
+%% r50 <- r42 add 4
+%% r49 <- [r41+r50]
+%% if (r49 gt v37) then L25 (0.50) else L24
+%% L24:
+%% r42 <- r42 add 4
+%% goto L25
+%% L25:
+%% if (r42 gt 28) then L6 (0.50) else L18
+%% L18:
+%% r44 <- [r41+r42]
+%% if (r44 eq v37) then L19 (0.90) else L8
+%% L19:
+%% r42 <- r42 sra 2
+%% switch (r42) <L5, L3, L2, L4, L1,
+%% L7, L6>
+
+%%
+%% The search is done like a rolled out binary search,
+%% but instead of starting in the middle we start at
+%% the power of two closest above the middle.
+%%
+%% We let IndexReg point to the lower bound of our
+%% search, and then we speculatively look at a
+%% position at IndexReg + I where I is a power of 2.
+%%
+%% Example: Looking for 'h' in
+%% KeyTbl: < a, b, d, f, h, i, z >
+%%
+%% We start with IndexReg=0 and I=4
+%% < a, b, d, f, h, i, z >
+%% ^ ^
+%% IndexReg + I
+%%
+%% 'f' < 'h' so we add I to IndexReg and divide I with 2
+%% IndexReg=4 and I=2
+%% < a, b, d, f, h, i, z >
+%% ^ ^
+%% IndexReg + I
+%%
+%% 'i' > 'h' so we keep IndexReg and divide I with 2
+%% IndexReg=4 and I=1
+%% < a, b, d, f, h, i, z >
+%% ^ ^
+%% IndexReg+ I
+%% Now we have found 'h' so we add I to IndexReg -> 5
+%% And we can load switch to the label at position 5 in
+%% the label table.
+%%
+%% Now since the wordsize is 4 all numbers above are
+%% Multiples of 4.
+
+tab(KeyList, LabelList, KeyReg, TablePntrReg, Default) ->
+ %% Calculate the size of the table:
+ %% the number of keys * wordsize
+ LastOffset = (length(KeyList)-1)*?WORDSIZE,
+
+ %% Calculate the power of two closest to the size of the table.
+ Pow2 = 1 bsl trunc(math:log(LastOffset) / math:log(2)),
+
+ %% Create some registers and lables that we need
+ IndexReg = hipe_rtl:mk_new_reg_gcsafe(),
+ Temp = hipe_rtl:mk_new_reg_gcsafe(),
+ Temp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ Lab1 = hipe_rtl:mk_new_label(),
+ Lab2 = hipe_rtl:mk_new_label(),
+ Lab3 = hipe_rtl:mk_new_label(),
+ Lab4 = hipe_rtl:mk_new_label(),
+
+ %% Calculate the position to start looking at
+ Init = (LastOffset)-Pow2,
+
+ %% Create the code
+ [
+ hipe_rtl:mk_move(IndexReg,hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_load(Temp,TablePntrReg,hipe_rtl:mk_imm(Init)),
+ hipe_rtl:mk_branch(Temp, geu, KeyReg,
+ hipe_rtl:label_name(Lab2),
+ hipe_rtl:label_name(Lab1), 0.5),
+ Lab1,
+ hipe_rtl:mk_alu(IndexReg, IndexReg, add, hipe_rtl:mk_imm(Init+?WORDSIZE)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(Lab2)),
+ Lab2] ++
+
+ step(Pow2 div 2, TablePntrReg, IndexReg, KeyReg) ++
+
+ [hipe_rtl:mk_branch(IndexReg, gt, hipe_rtl:mk_imm(LastOffset),
+ hipe_rtl:label_name(Default),
+ hipe_rtl:label_name(Lab3), 0.5),
+ Lab3,
+ hipe_rtl:mk_load(Temp2,TablePntrReg,IndexReg),
+ hipe_rtl:mk_branch(Temp2, eq, KeyReg,
+ hipe_rtl:label_name(Lab4),
+ hipe_rtl:label_name(Default), 0.9),
+ Lab4,
+ hipe_rtl:mk_alu(IndexReg, IndexReg, sra,
+ hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
+ hipe_rtl:mk_sorted_switch(IndexReg, LabelList, KeyList)
+ ].
+
+step(I,TablePntrReg,IndexReg,KeyReg) ->
+ Temp = hipe_rtl:mk_new_reg_gcsafe(),
+ TempIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Lab1 = hipe_rtl:mk_new_label(),
+ Lab2 = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_alu(TempIndex, IndexReg, add, hipe_rtl:mk_imm(I)),
+ hipe_rtl:mk_load(Temp,TablePntrReg,TempIndex),
+ hipe_rtl:mk_branch(Temp, gtu, KeyReg,
+ hipe_rtl:label_name(Lab2),
+ hipe_rtl:label_name(Lab1) , 0.5),
+ Lab1] ++
+ case ?WORDSIZE of
+ I -> %% Recursive base case
+ [hipe_rtl:mk_alu(IndexReg, IndexReg, add, hipe_rtl:mk_imm(I)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(Lab2)),
+ Lab2
+ ];
+ _ -> %% Recursion case
+ [hipe_rtl:mk_move(IndexReg, TempIndex),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(Lab2)),
+ Lab2
+ | step(I div 2, TablePntrReg, IndexReg, KeyReg)
+ ]
+ end.
+
+%%-------------------------------------------------------------------------
+
+lbls_from_cases([{_,L}|Rest], VarMap) ->
+ {Map,VarMap1} = lbls_from_cases(Rest, VarMap),
+ {RtlL, VarMap2} = hipe_rtl_varmap:icode_label2rtl_label(L,VarMap1),
+ %% {[{label,hipe_rtl:label_name(RtlL)}|Map],VarMap2};
+ {[hipe_rtl:label_name(RtlL)|Map],VarMap2};
+lbls_from_cases([], VarMap) ->
+ {[], VarMap}.
+
+%%-------------------------------------------------------------------------
+
+split_cases(L) ->
+ split_cases(L, [], []).
+
+split_cases([], Vs, Ls) -> {lists:reverse(Vs),lists:reverse(Ls)};
+split_cases([{V,L}|Rest], Vs, Ls) ->
+ split_cases(Rest, [hipe_icode:const_value(V)|Vs], [L|Ls]).
+
+%%-------------------------------------------------------------------------
+%%
+%% {switch_tuple_arity,X,Fail,N,[{A1,L1},...,{AN,LN}]}
+%%
+%% if not boxed(X) goto Fail
+%% Hdr := *boxed_val(X)
+%% switch_int(Hdr,Fail,[{H(A1),L1},...,{H(AN),LN}])
+%% where H(Ai) = make_arityval(Ai)
+%%
+%%-------------------------------------------------------------------------
+
+gen_switch_tuple(I, Map, ConstTab, _Options) ->
+ Var = hipe_icode:switch_tuple_arity_term(I),
+ {X, Map1} = hipe_rtl_varmap:icode_var2rtl_var(Var, Map),
+ Fail0 = hipe_icode:switch_tuple_arity_fail_label(I),
+ {Fail1, Map2} = hipe_rtl_varmap:icode_label2rtl_label(Fail0, Map1),
+ FailLab = hipe_rtl:label_name(Fail1),
+ {Cases, Map3} =
+ lists:foldr(fun({A,L}, {Rest,M}) ->
+ {L1,M1} = hipe_rtl_varmap:icode_label2rtl_label(L, M),
+ L2 = hipe_rtl:label_name(L1),
+ A1 = hipe_icode:const_value(A),
+ H1 = hipe_tagscheme:mk_arityval(A1),
+ {[{H1,L2}|Rest], M1} end,
+ {[], Map2},
+ hipe_icode:switch_tuple_arity_cases(I)),
+ Hdr = hipe_rtl:mk_new_reg_gcsafe(),
+ IsBoxedLab = hipe_rtl:mk_new_label(),
+ {[hipe_tagscheme:test_is_boxed(X, hipe_rtl:label_name(IsBoxedLab),
+ FailLab, 0.9),
+ IsBoxedLab,
+ hipe_tagscheme:get_header(Hdr, X) |
+ gen_switch_int(Hdr, FailLab, Cases)],
+ Map3, ConstTab}.
+
+%%
+%% RTL-level switch-on-int
+%%
+
+gen_switch_int(X, FailLab, [{C,L}|Rest]) ->
+ NextLab = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_branch(X, eq, hipe_rtl:mk_imm(C), L,
+ hipe_rtl:label_name(NextLab), 0.5),
+ NextLab |
+ gen_switch_int(X, FailLab, Rest)];
+gen_switch_int(_, FailLab, []) ->
+ [hipe_rtl:mk_goto(FailLab)].
+
diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl
new file mode 100644
index 0000000000..560e0259f8
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_primops.erl
@@ -0,0 +1,1259 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Filename : hipe_rtl_primops.erl
+%% Purpose :
+%% Notes :
+%% History : * 2001-03-15 Erik Johansson (happi@it.uu.se):
+%% Created.
+%%
+%% $Id$
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_primops).
+
+-export([gen_primop/3, gen_enter_primop/3, gen_call_builtin/6,
+ gen_enter_builtin/2]).
+
+%% --------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+-include("../icode/hipe_icode_primops.hrl").
+-include("hipe_rtl.hrl").
+-include("hipe_literals.hrl").
+
+%% --------------------------------------------------------------------
+%% Handling of known MFA builtins that are inline expanded
+
+gen_call_builtin(Fun, Dst, Args, IsGuard, Cont, Fail) ->
+ case Fun of
+ {erlang, apply, 3} ->
+ gen_apply(Dst, Args, Cont, Fail);
+
+ {erlang, element, 2} ->
+ gen_element(Dst, Args, IsGuard, Cont, Fail);
+
+ {erlang, self, 0} ->
+ gen_self(Dst, Cont);
+
+ {erlang, is_tuple, 1} ->
+ gen_is_tuple(Dst, Args, Cont);
+
+ {hipe_bifs, in_native, 0} ->
+ Dst1 =
+ case Dst of
+ [] -> %% The result is not used.
+ hipe_rtl:mk_new_var();
+ [Dst0] -> Dst0
+ end,
+ [hipe_rtl:mk_load_atom(Dst1, true), hipe_rtl:mk_goto(Cont)];
+
+ _ -> [] % not a builtin
+ end.
+
+%% (Recall that enters cannot occur within a catch-region in the same
+%% function, so we do not need to consider fail-continuations here.)
+%% TODO: should we inline expand more functions here? Cf. above.
+gen_enter_builtin(Fun, Args) ->
+ case Fun of
+ {erlang, apply, 3} ->
+ gen_enter_apply(Args);
+
+%% TODO
+%% {erlang, element, 2} ->
+%% gen_enter_element(Args, IsGuard);
+
+%% TODO
+%% {erlang, self, 0} ->
+%% gen_enter_self();
+
+ {hipe_bifs, in_native, 0} ->
+ Dst = hipe_rtl:mk_new_var(),
+ [hipe_rtl:mk_load_atom(Dst, true), hipe_rtl:mk_return([Dst])];
+
+ _ -> [] % not a builtin
+ end.
+
+%% --------------------------------------------------------------------
+%% Generate code to jump to in case the inlined function fails.
+
+gen_fail_code(Fail, Type) ->
+ gen_fail_code(Fail, Type, false).
+
+gen_fail_code(Fail, Type, IsGuard) ->
+ case IsGuard of
+ true when Fail =/= [] ->
+ {Fail, []}; % go directly to target
+ false ->
+ NewLabel = hipe_rtl:mk_new_label(),
+ NewLabelName = hipe_rtl:label_name(NewLabel),
+ {NewLabelName, [NewLabel | fail_code(Fail, Type)]}
+ end.
+
+fail_code(Fail, Type) when is_atom(Type) ->
+ Var = hipe_rtl:mk_new_var(),
+ [hipe_rtl:mk_load_atom(Var, Type),
+ hipe_rtl_exceptions:gen_fail(error, [Var], Fail)];
+fail_code(Fail, {Type, Value}) when is_atom(Type) ->
+ Var = hipe_rtl:mk_new_var(),
+ [hipe_rtl:mk_load_atom(Var, Type),
+ hipe_rtl:mk_gctest(3), % room for a 2-tuple
+ gen_mk_tuple(Var,[Var,Value]),
+ hipe_rtl_exceptions:gen_fail(error, [Var], Fail)].
+
+fp_fail_code(TmpFailLbl, FailLbl) ->
+ [TmpFailLbl |
+ hipe_rtl_arch:handle_fp_exception() ++
+ [fail_code(FailLbl, badarith)]].
+
+%% --------------------------------------------------------------------
+%% CALL PRIMOP
+%%
+%% @doc
+%% Generates RTL code for primops. This is mostly a dispatch function.
+%% Tail calls to primops (enter_fun, apply, etc.) are not handled here!
+%% @end
+
+gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
+ GotoCont = hipe_rtl:mk_goto(Cont),
+ case Op of
+ %%
+ %% Binary Syntax
+ %%
+ {hipe_bs_primop, BsOP} ->
+ {FailLabelName, FailCode1} = gen_fail_code(Fail, badarg, IsGuard),
+ {SysLimLblName, FailCode2} = gen_fail_code(Fail, system_limit, IsGuard),
+ {Code1,NewConstTab} =
+ hipe_rtl_binary:gen_rtl(BsOP, Dst, Args, Cont, FailLabelName,
+ SysLimLblName, ConstTab),
+ {[Code1,FailCode1,FailCode2], NewConstTab};
+ %%
+ %% Other primops
+ %%
+ _ ->
+ Code =
+ case Op of
+ %% Arithmetic
+ '+' ->
+ %gen_extra_unsafe_add_2(Dst, Args, Cont);
+ gen_add_sub_2(Dst, Args, Cont, Fail, Op, add);
+ '-' ->
+ gen_add_sub_2(Dst, Args, Cont, Fail, Op, sub);
+ '*' ->
+ gen_mul_2(Dst, Args, Cont, Fail);
+ '/' ->
+ %% BIF call: am_Div -> nbif_div_2 -> erts_mixed_div
+ [hipe_rtl:mk_call(Dst, '/', Args, Cont, Fail, not_remote)];
+ 'gen_add' ->
+ gen_general_add_sub(Dst, Args, Cont, Fail, '+');
+ 'gen_sub' ->
+ gen_general_add_sub(Dst, Args, Cont, Fail, '-');
+ 'unsafe_add' ->
+ %gen_extra_unsafe_add_2(Dst, Args, Cont);
+ gen_unsafe_add_sub_2(Dst, Args, Cont, Fail, '+', add);
+ 'extra_unsafe_add' ->
+ gen_extra_unsafe_add_2(Dst, Args, Cont);
+ 'unsafe_sub' ->
+ gen_unsafe_add_sub_2(Dst, Args, Cont, Fail, '-', sub);
+ 'extra_unsafe_sub' ->
+ gen_extra_unsafe_sub_2(Dst, Args, Cont);
+ %'unsafe_mul' ->
+ % gen_unsafe_mul_2(Dst, Args, Cont, Fail, '*');
+ 'div' ->
+ %% BIF call: am_div -> nbif_intdiv_2 -> intdiv_2
+ [hipe_rtl:mk_call(Dst, 'div', Args, Cont, Fail, not_remote)];
+ 'rem' ->
+ %% BIF call: am_rem -> nbif_rem_2 -> rem_2
+ [hipe_rtl:mk_call(Dst, 'rem', Args, Cont, Fail, not_remote)];
+ 'band' ->
+ gen_bitop_2(Dst, Args, Cont, Fail, Op, 'and');
+ 'bor' ->
+ gen_bitop_2(Dst, Args, Cont, Fail, Op, 'or');
+ 'bxor' ->
+ gen_bitop_2(Dst, Args, Cont, Fail, Op, 'xor');
+ 'bnot' ->
+ gen_bnot_2(Dst, Args, Cont, Fail, Op);
+ 'bsr'->
+ %% BIF call: am_bsr -> nbif_bsr_2 -> bsr_2
+ gen_bsr_2(Dst, Args, Cont, Fail, Op);
+ %[hipe_rtl:mk_call(Dst, 'bsr', Args, Cont, Fail, not_remote)];
+ 'bsl' ->
+ %% BIF call: am_bsl -> nbif_bsl_2 -> bsl_2
+ [hipe_rtl:mk_call(Dst, 'bsl', Args, Cont, Fail, not_remote)];
+ unsafe_band ->
+ gen_unsafe_bitop_2(Dst, Args, Cont, 'and');
+ unsafe_bor ->
+ gen_unsafe_bitop_2(Dst, Args, Cont, 'or');
+ unsafe_bxor ->
+ gen_unsafe_bitop_2(Dst, Args, Cont, 'xor');
+ unsafe_bnot ->
+ gen_unsafe_bnot_2(Dst, Args, Cont);
+ unsafe_bsr ->
+ gen_unsafe_bsr_2(Dst, Args, Cont);
+ unsafe_bsl ->
+ gen_unsafe_bsl_2(Dst, Args, Cont);
+ %%---------------------------------------------
+ %% List handling
+ %%---------------------------------------------
+ cons ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ [gen_cons(Dst1, Args), GotoCont]
+ end;
+ unsafe_hd ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ [gen_unsafe_hd(Dst1, Args), GotoCont]
+ end;
+ unsafe_tl ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ [gen_unsafe_tl(Dst1, Args),GotoCont]
+ end;
+ %%---------------------------------------------
+ %% Tuple handling
+ %%---------------------------------------------
+ mktuple ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ [gen_mk_tuple(Dst1, Args),GotoCont]
+ end;
+ #unsafe_element{index=N} ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ [Tuple] = Args,
+ [gen_unsafe_element(Dst1, hipe_rtl:mk_imm(N), Tuple),GotoCont]
+ end;
+ #unsafe_update_element{index=N} ->
+ [Dst1] = Dst,
+ [Tuple, Value] = Args,
+ [gen_unsafe_update_element(Tuple, hipe_rtl:mk_imm(N), Value),
+ hipe_rtl:mk_move(Dst1, Tuple),
+ GotoCont];
+ {element, [TupleInfo, IndexInfo]} ->
+ Dst1 =
+ case Dst of
+ [] -> %% The result is not used.
+ hipe_rtl:mk_new_var();
+ [Dst0] -> Dst0
+ end,
+ [Index, Tuple] = Args,
+ [gen_element_1(Dst1, Index, Tuple, IsGuard, Cont, Fail,
+ TupleInfo, IndexInfo)];
+
+ %%---------------------------------------------
+ %% Apply-fixarity
+ %%---------------------------------------------
+ #apply_N{arity = Arity} ->
+ gen_apply_N(Dst, Arity, Args, Cont, Fail);
+
+ %%---------------------------------------------
+ %% GC test
+ %%---------------------------------------------
+ #gc_test{need = Need} ->
+ [hipe_rtl:mk_gctest(Need), GotoCont];
+
+ %%---------------------------------------------
+ %% Process handling
+ %%---------------------------------------------
+ redtest ->
+ [gen_redtest(1), GotoCont];
+ %%---------------------------------------------
+ %% Receives
+ %%---------------------------------------------
+ check_get_msg ->
+ gen_check_get_msg(Dst, GotoCont, Fail);
+ next_msg ->
+ gen_next_msg(Dst, GotoCont);
+ select_msg ->
+ gen_select_msg(Dst, Cont);
+ clear_timeout ->
+ gen_clear_timeout(Dst, GotoCont);
+ set_timeout ->
+ %% BIF call: am_set_timeout -> nbif_set_timeout -> hipe_set_timeout
+ [hipe_rtl:mk_call(Dst, set_timeout, Args, Cont, Fail, not_remote)];
+ suspend_msg ->
+ gen_suspend_msg(Dst, Cont);
+ %%---------------------------------------------
+ %% Closures
+ %%---------------------------------------------
+ call_fun ->
+ gen_call_fun(Dst, Args, Cont, Fail);
+ #mkfun{mfa=MFA, magic_num=MagicNum, index=Index} ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ _ ->
+ [gen_mkfun(Dst, MFA, MagicNum, Index, Args), GotoCont]
+ end;
+ #closure_element{n=N} ->
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ [Closure] = Args,
+ [gen_closure_element(Dst1, hipe_rtl:mk_imm(N), Closure),
+ GotoCont]
+ end;
+ %%---------------------------------------------
+ %% Floating point instructions.
+ %%---------------------------------------------
+ fp_add ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ hipe_rtl:mk_fp(hipe_rtl:mk_new_fpreg(), Arg1, 'fadd', Arg2);
+ [Dst1] ->
+ hipe_rtl:mk_fp(Dst1, Arg1, 'fadd', Arg2)
+ end;
+ fp_sub ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ hipe_rtl:mk_fp(hipe_rtl:mk_new_fpreg(), Arg1, 'fsub', Arg2);
+ [Dst1] ->
+ hipe_rtl:mk_fp(Dst1, Arg1, 'fsub', Arg2)
+ end;
+ fp_mul ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ hipe_rtl:mk_fp(hipe_rtl:mk_new_fpreg(), Arg1, 'fmul', Arg2);
+ [Dst1] ->
+ hipe_rtl:mk_fp(Dst1, Arg1, 'fmul', Arg2)
+ end;
+ fp_div ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ hipe_rtl:mk_fp(hipe_rtl:mk_new_fpreg(), Arg1, 'fdiv', Arg2);
+ [Dst1] ->
+ hipe_rtl:mk_fp(Dst1, Arg1, 'fdiv', Arg2)
+ end;
+ fnegate ->
+ [Arg] = Args,
+ case Dst of
+ [] ->
+ hipe_rtl:mk_fp_unop(hipe_rtl:mk_new_fpreg(), Arg, 'fchs');
+ [Dst1] ->
+ hipe_rtl:mk_fp_unop(Dst1, Arg, 'fchs')
+ end;
+ fclearerror ->
+ gen_fclearerror();
+ fcheckerror ->
+ gen_fcheckerror(Cont, Fail);
+ conv_to_float ->
+ case Dst of
+ [] ->
+ gen_conv_to_float(hipe_rtl:mk_new_fpreg(), Args, Cont, Fail);
+ [Dst1] ->
+ gen_conv_to_float(Dst1, Args, Cont, Fail)
+ end;
+ unsafe_untag_float ->
+ [Arg] = Args,
+ case Dst of
+ [] ->
+ hipe_tagscheme:unsafe_untag_float(hipe_rtl:mk_new_fpreg(),
+ Arg);
+ [Dst1]->
+ hipe_tagscheme:unsafe_untag_float(Dst1, Arg)
+ end;
+ unsafe_tag_float ->
+ [Arg] = Args,
+ case Dst of
+ [] ->
+ hipe_tagscheme:unsafe_tag_float(hipe_rtl:mk_new_var(), Arg);
+ [Dst1]->
+ hipe_tagscheme:unsafe_tag_float(Dst1, Arg)
+ end;
+
+ %% Only names listed above are accepted! MFA:s are not primops!
+ _ ->
+ erlang:error({bad_primop, Op})
+ end,
+ {Code, ConstTab}
+ end.
+
+gen_enter_primop({Op, Args}, IsGuard, ConstTab) ->
+ case Op of
+ enter_fun ->
+ %% Tail-call to a closure must preserve tail-callness!
+ %% (Passing Continuation = [] to gen_call_fun/5 does this.)
+ Code = gen_call_fun([], Args, [], []),
+ {Code, ConstTab};
+
+ #apply_N{arity=Arity} ->
+ %% Tail-call to a closure must preserve tail-callness!
+ %% (Passing Continuation = [] to gen_apply_N/5 does this.)
+ Code = gen_apply_N([], Arity, Args, [], []),
+ {Code, ConstTab};
+
+ _ ->
+ %% All other primop tail calls are converted to call + return.
+ Dst = [hipe_rtl:mk_new_var()],
+ OkLab = hipe_rtl:mk_new_label(),
+ {Code,ConstTab1} =
+ gen_primop({Op,Dst,Args,hipe_rtl:label_name(OkLab),[]},
+ IsGuard, ConstTab),
+ {Code ++ [OkLab, hipe_rtl:mk_return(Dst)], ConstTab1}
+ end.
+
+
+%% --------------------------------------------------------------------
+%% ARITHMETIC
+%% --------------------------------------------------------------------
+
+%%
+%% Inline addition & subtraction
+%%
+
+gen_general_add_sub(Dst, Args, Cont, Fail, Op) ->
+ case Dst of
+ [] ->
+ [hipe_rtl:mk_call([hipe_rtl:mk_new_var()],
+ Op, Args, Cont, Fail, not_remote)];
+ [Res] ->
+ [hipe_rtl:mk_call([Res], Op, Args, Cont, Fail, not_remote)]
+ end.
+
+gen_add_sub_2(Dst, Args, Cont, Fail, Op, AluOp) ->
+ [Arg1, Arg2] = Args,
+ GenCaseLabel = hipe_rtl:mk_new_label(),
+ case Dst of
+ [] ->
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenCaseLabel))|
+ gen_op_general_case(hipe_rtl:mk_new_var(),
+ Op, Args, Cont, Fail, GenCaseLabel)];
+ [Res] ->
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenCaseLabel)),
+ hipe_tagscheme:fixnum_addsub(AluOp, Arg1, Arg2, Res, GenCaseLabel)|
+ gen_op_general_case(Res,Op, Args, Cont, Fail, GenCaseLabel)]
+ end.
+
+gen_unsafe_add_sub_2(Dst, Args, Cont, Fail, Op, AluOp) ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ [hipe_rtl:mk_goto(Cont)];
+ [Res] ->
+ case Fail of
+ []->
+ GenCaseLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:fixnum_addsub(AluOp, Arg1, Arg2, Res, GenCaseLabel)|
+ gen_op_general_case(Res,Op, Args, Cont, Fail, GenCaseLabel)];
+ _ ->
+ [hipe_tagscheme:fixnum_addsub(AluOp, Arg1, Arg2, Res,
+ hipe_rtl:mk_label(Fail))]
+ end
+ end.
+
+gen_extra_unsafe_add_2(Dst, Args, Cont) ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ [hipe_rtl:mk_goto(Cont)];
+ [Res] ->
+ hipe_tagscheme:unsafe_fixnum_add(Arg1, Arg2, Res)
+ end.
+
+gen_extra_unsafe_sub_2(Dst, Args, Cont) ->
+ [Arg1, Arg2] = Args,
+ case Dst of
+ [] ->
+ [hipe_rtl:mk_goto(Cont)];
+ [Res] ->
+ hipe_tagscheme:unsafe_fixnum_sub(Arg1, Arg2, Res)
+ end.
+
+gen_op_general_case(Res, Op, Args, Cont, Fail, GenCaseLabel) ->
+ [hipe_rtl:mk_goto(Cont),
+ GenCaseLabel,
+ hipe_rtl:mk_call([Res], Op, Args, Cont, Fail, not_remote)].
+
+%%
+%% Inline multiplication
+%%
+
+gen_mul_2(Dst, Args, Cont, Fail) ->
+ [Arg1,Arg2] = Args,
+ GenCaseLabel = hipe_rtl:mk_new_label(),
+ {Res1,I2} =
+ case Dst of
+ [] ->
+ {hipe_rtl:mk_new_var(), []};
+ [Res0] ->
+ {Res0, hipe_tagscheme:fixnum_mul(Arg1, Arg2, Res0, GenCaseLabel)}
+ end,
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2, hipe_rtl:label_name(GenCaseLabel)),
+ I2,
+ %% BIF call: am_Times -> nbif_mul_2 -> erts_mixed_times
+ gen_op_general_case(Res1, '*', Args, Cont, Fail, GenCaseLabel)].
+
+%% gen_unsafe_mul_2([Res], Args, Cont, Fail, Op) ->
+%% [Arg1, Arg2] = Args,
+%% GenCaseLabel = hipe_rtl:mk_new_label(),
+%% [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+%% hipe_rtl:label_name(GenCaseLabel)),
+%% hipe_tagscheme:fixnum_mul(Arg1, Arg2, Res, GenCaseLabel)|
+%% gen_op_general_case(Res, Op, Args, Cont, Fail, GenCaseLabel)].
+
+%%
+%% Inline bitoperations.
+%% Only works for band, bor and bxor.
+%% The shift operations are too expensive to inline.
+%%
+
+gen_bitop_2(Res, Args, Cont, Fail, Op, BitOp) ->
+ [Arg1, Arg2] = Args,
+ GenCaseLabel = hipe_rtl:mk_new_label(),
+ case Res of
+ [] -> %% The result is not used.
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenCaseLabel))|
+ gen_op_general_case(hipe_rtl:mk_new_var(),
+ Op, Args, Cont, Fail, GenCaseLabel)];
+ [Res0] ->
+ [hipe_tagscheme:test_two_fixnums(Arg1, Arg2,
+ hipe_rtl:label_name(GenCaseLabel)),
+ hipe_tagscheme:fixnum_andorxor(BitOp, Arg1, Arg2, Res0)|
+ gen_op_general_case(Res0, Op, Args, Cont, Fail, GenCaseLabel)]
+ end.
+
+gen_unsafe_bitop_2(Res, Args, Cont, BitOp) ->
+ case Res of
+ [] -> %% The result is not used.
+ [hipe_rtl:mk_goto(Cont)];
+ [Res0] ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_andorxor(BitOp, Arg1, Arg2, Res0),
+ hipe_rtl:mk_goto(Cont)]
+ end.
+
+gen_bsr_2(Res, Args, Cont, Fail, Op) ->
+ [Arg1, Arg2] = Args,
+ GenCaseLabel = hipe_rtl:mk_new_label(),
+ case hipe_rtl:is_imm(Arg2) of
+ true ->
+ Val = hipe_tagscheme:fixnum_val(hipe_rtl:imm_value(Arg2)),
+ Limit = ?bytes_to_bits(hipe_rtl_arch:word_size()),
+ if
+ Val < Limit, Val >= 0 ->
+ case Res of
+ [] ->
+ FixLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_fixnum(Arg1,
+ hipe_rtl:label_name(FixLabel),
+ hipe_rtl:label_name(GenCaseLabel),
+ 0.99),
+ FixLabel,
+ gen_op_general_case(hipe_rtl:mk_new_var(), Op, Args, Cont, Fail,
+ GenCaseLabel)];
+ [Res0] ->
+ FixLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_fixnum(Arg1,
+ hipe_rtl:label_name(FixLabel),
+ hipe_rtl:label_name(GenCaseLabel),
+ 0.99),
+ FixLabel,
+ hipe_tagscheme:fixnum_bsr(Arg1, Arg2, Res0),
+ gen_op_general_case(Res0, Op, Args, Cont, Fail, GenCaseLabel)]
+ end;
+ true ->
+ [hipe_rtl:mk_call(Res, 'bsr', Args, Cont, Fail, not_remote)]
+ end;
+ false ->
+ [hipe_rtl:mk_call(Res, 'bsr', Args, Cont, Fail, not_remote)]
+ end.
+
+gen_unsafe_bsr_2(Res, Args, Cont) ->
+ case Res of
+ [] -> %% The result is not used.
+ [hipe_rtl:mk_goto(Cont)];
+ [Res0] ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_bsr(Arg1, Arg2, Res0),
+ hipe_rtl:mk_goto(Cont)]
+ end.
+
+gen_unsafe_bsl_2(Res, Args, Cont) ->
+ case Res of
+ [] -> %% The result is not used.
+ [hipe_rtl:mk_goto(Cont)];
+ [Res0] ->
+ [Arg1, Arg2] = Args,
+ [hipe_tagscheme:fixnum_bsl(Arg1, Arg2, Res0),
+ hipe_rtl:mk_goto(Cont)]
+ end.
+
+%%
+%% Inline not.
+%%
+
+gen_bnot_2(Res, Args, Cont, Fail, Op) ->
+ [Arg] = Args,
+ GenCaseLabel = hipe_rtl:mk_new_label(),
+ case Res of
+ [] -> %% The result is not used.
+ FixLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_fixnum(Arg, hipe_rtl:label_name(FixLabel),
+ hipe_rtl:label_name(GenCaseLabel), 0.99),
+ FixLabel,
+ gen_op_general_case(hipe_rtl:mk_new_var(), Op, Args, Cont, Fail,
+ GenCaseLabel)];
+
+ [Res0] ->
+ FixLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_fixnum(Arg, hipe_rtl:label_name(FixLabel),
+ hipe_rtl:label_name(GenCaseLabel), 0.99),
+ FixLabel,
+ hipe_tagscheme:fixnum_not(Arg, Res0),
+ gen_op_general_case(Res0, Op, Args, Cont, Fail, GenCaseLabel)]
+ end.
+
+gen_unsafe_bnot_2(Res, Args, Cont) ->
+ case Res of
+ [] -> %% The result is not used.
+ [hipe_rtl:mk_goto(Cont)];
+ [Res0] ->
+ [Arg1] = Args,
+ [hipe_tagscheme:fixnum_not(Arg1, Res0),
+ hipe_rtl:mk_goto(Cont)]
+ end.
+
+
+%% --------------------------------------------------------------------
+%%
+
+%%
+%% Inline cons
+%%
+
+gen_cons(Dst, [Arg1, Arg2]) ->
+ Tmp = hipe_rtl:mk_new_reg(),
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ WordSize = hipe_rtl_arch:word_size(),
+ HeapNeed = 2*WordSize,
+ [GetHPInsn,
+ hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(0), Arg1),
+ hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(WordSize), Arg2),
+ hipe_rtl:mk_move(Tmp, HP),
+ hipe_tagscheme:tag_cons(Dst, Tmp),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(HeapNeed)),
+ PutHPInsn].
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% --------------------------------------------------------------------
+%% Handling of closures...
+%% --------------------------------------------------------------------
+
+%% --------------------------------------------------------------------
+%% gen_mkfun
+%%
+%% The gc_test should have expanded to
+%% unsigned needed = ERL_FUN_SIZE + num_free;
+%% ErlFunThing* funp = (ErlFunThing *) HAlloc(p, needed);
+%%
+%% The code generated should do the equivalent of:
+%% Copy arguments to the fun thing
+%% Eterm* hp = funp->env;
+%% for (i = 0; i < num_free; i++) {
+%% *hp++ = reg[i];
+%% }
+%%
+%% Fill in fileds
+%% funp->thing_word = HEADER_FUN;
+%% funp->fe = fe;
+%% funp->num_free = num_free;
+%% funp->creator = p->id;
+%% funp->native_code = fe->native_code;
+%% Increase refcount
+%% fe->refc++;
+%%
+%% Link to the process off_heap.funs list
+%% funp->next = p->off_heap.funs;
+%% p->off_heap.funs = funp;
+%%
+%% Tag the thing
+%% return make_fun(funp);
+%%
+gen_mkfun([Dst], {_Mod, _FunId, _Arity} = MFidA, MagicNr, Index, FreeVars) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ NumFree = length(FreeVars),
+
+ %% Copy arguments to the fun thing
+ %% Eterm* hp = funp->env;
+ %% for (i = 0; i < num_free; i++) {
+ %% *hp++ = reg[i];
+ %% }
+ CopyFreeVarsCode = gen_free_vars(FreeVars, HP),
+
+ %% Fill in fields
+ %% funp->thing_word = HEADER_FUN;
+ %% funp->fe = fe;
+ %% funp->num_free = num_free;
+ %% funp->creator = p->id;
+ %% funp->native_code = fe->native_code;
+ %% Increase refcount
+ %% fe->refc++;
+ SkeletonCode = gen_fun_thing_skeleton(HP, MFidA, NumFree, MagicNr, Index),
+
+ %% Link to the process off_heap.funs list
+ %% funp->next = p->off_heap.funs;
+ %% p->off_heap.funs = funp;
+ LinkCode = gen_link_closure(HP),
+
+ %% Tag the thing and increase the heap_pointer.
+ %% make_fun(funp);
+ WordSize�= hipe_rtl_arch:word_size(),
+ HeapNeed = (?ERL_FUN_SIZE + NumFree) * WordSize,
+ TagCode = [hipe_tagscheme:tag_fun(Dst, HP),
+ %% AdjustHPCode
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(HeapNeed)),
+ PutHPInsn],
+ [[GetHPInsn | CopyFreeVarsCode], SkeletonCode, LinkCode, TagCode].
+
+
+gen_fun_thing_skeleton(FunP, FunName={_Mod,_FunId,Arity}, NumFree,
+ MagicNr, Index) ->
+ %% Assumes that funp == heap_pointer
+ %% Fill in fields
+ %% funp->thing_word = HEADER_FUN;
+ %% funp->fe = fe;
+ %% funp->num_free = num_free;
+ %% funp->creator = p->id;
+ %% funp->native_code = fe->native_code;
+ %% And creates a fe (at load time).
+ FeVar = hipe_rtl:mk_new_reg(),
+ PidVar = hipe_rtl:mk_new_reg_gcsafe(),
+ NativeVar = hipe_rtl:mk_new_reg(),
+
+ [hipe_rtl:mk_load_address(FeVar, {FunName, MagicNr, Index}, closure),
+ store_struct_field(FunP, ?EFT_FE, FeVar),
+ load_struct_field(NativeVar, FeVar, ?EFE_NATIVE_ADDRESS),
+ store_struct_field(FunP, ?EFT_NATIVE_ADDRESS, NativeVar),
+
+ store_struct_field(FunP, ?EFT_ARITY, hipe_rtl:mk_imm(Arity-NumFree)),
+
+ gen_inc_refc(FeVar, ?EFE_REFC),
+
+ store_struct_field(FunP, ?EFT_NUM_FREE, hipe_rtl:mk_imm(NumFree)),
+ load_p_field(PidVar, ?P_ID),
+ store_struct_field(FunP, ?EFT_CREATOR, PidVar),
+ store_struct_field(FunP, ?EFT_THING, hipe_tagscheme:mk_fun_header())].
+
+gen_inc_refc(Ptr, Offset) ->
+ case ?ERTS_IS_SMP of
+ 0 -> gen_inc_refc_notsmp(Ptr, Offset);
+ 1 -> gen_inc_refc_smp(Ptr, Offset)
+ end.
+
+gen_inc_refc_notsmp(Ptr, Offset) ->
+ Refc = hipe_rtl:mk_new_reg(),
+ [load_struct_field(Refc, Ptr, Offset, int32),
+ hipe_rtl:mk_alu(Refc, Refc, add, hipe_rtl:mk_imm(1)),
+ store_struct_field(Ptr, Offset, Refc, int32)].
+
+gen_inc_refc_smp(Ptr, Offset) ->
+ Refc = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_alu(Refc, Ptr, 'add', hipe_rtl:mk_imm(Offset)),
+ hipe_rtl:mk_call([], 'atomic_inc', [Refc], [], [], not_remote)].
+
+gen_link_closure(FUNP) ->
+ case ?P_OFF_HEAP_FUNS of
+ [] -> gen_link_closure_non_private(FUNP);
+ _ -> gen_link_closure_private(FUNP)
+ end.
+
+gen_link_closure_private(FUNP) ->
+ %% Link to the process off_heap.funs list
+ %% funp->next = p->off_heap.funs;
+ %% p->off_heap.funs = funp;
+ FunsVar = hipe_rtl:mk_new_reg(),
+
+ [load_p_field(FunsVar,?P_OFF_HEAP_FUNS),
+ hipe_rtl:mk_store(FUNP, hipe_rtl:mk_imm(?EFT_NEXT), FunsVar),
+ store_p_field(FUNP,?P_OFF_HEAP_FUNS)].
+
+gen_link_closure_non_private(_FUNP) -> [].
+
+load_p_field(Dst,Offset) ->
+ hipe_rtl_arch:pcb_load(Dst, Offset).
+store_p_field(Src, Offset) ->
+ hipe_rtl_arch:pcb_store(Offset, Src).
+
+store_struct_field(StructP, Offset, Src) ->
+ hipe_rtl:mk_store(StructP, hipe_rtl:mk_imm(Offset), Src).
+
+load_struct_field(Dest, StructP, Offset) ->
+ hipe_rtl:mk_load(Dest, StructP, hipe_rtl:mk_imm(Offset)).
+
+store_struct_field(StructP, Offset, Src, int32) ->
+ hipe_rtl:mk_store(StructP, hipe_rtl:mk_imm(Offset), Src, int32).
+
+load_struct_field(Dest, StructP, Offset, int32) ->
+ hipe_rtl:mk_load(Dest, StructP, hipe_rtl:mk_imm(Offset), int32, signed).
+
+gen_free_vars(Vars, HPReg) ->
+ HPVar = hipe_rtl:mk_new_var(),
+ WordSize�= hipe_rtl_arch:word_size(),
+ [hipe_rtl:mk_alu(HPVar, HPReg, add, hipe_rtl:mk_imm(?EFT_ENV)) |
+ gen_free_vars(Vars, HPVar, 0, WordSize, [])].
+
+gen_free_vars([Var|Vars], EnvPVar, Offset, WordSize, AccCode) ->
+ Code = hipe_rtl:mk_store(EnvPVar, hipe_rtl:mk_imm(Offset), Var),
+ gen_free_vars(Vars, EnvPVar, Offset + WordSize, WordSize,
+ [Code|AccCode]);
+gen_free_vars([], _, _, _, AccCode) -> AccCode.
+
+%% ------------------------------------------------------------------
+%%
+%% call_fun (also handles enter_fun when Continuation = [])
+
+gen_call_fun(Dst, ArgsAndFun, Continuation, Fail) ->
+ NAddressReg = hipe_rtl:mk_new_reg(),
+ ArityReg = hipe_rtl:mk_new_reg_gcsafe(),
+ [Fun|RevArgs] = lists:reverse(ArgsAndFun),
+
+ %% {BadFunLabName, BadFunCode} = gen_fail_code(Fail, {badfun, Fun}),
+ Args = lists:reverse(RevArgs),
+ NonClosureLabel = hipe_rtl:mk_new_label(),
+ CallNonClosureLabel = hipe_rtl:mk_new_label(),
+ BadFunLabName = hipe_rtl:label_name(NonClosureLabel),
+ BadFunCode =
+ [NonClosureLabel,
+ hipe_rtl:mk_call([NAddressReg],
+ 'nonclosure_address',
+ [Fun, hipe_rtl:mk_imm(length(Args))],
+ hipe_rtl:label_name(CallNonClosureLabel),
+ Fail,
+ not_remote),
+ CallNonClosureLabel,
+ case Continuation of
+ [] ->
+ hipe_rtl:mk_enter(NAddressReg, Args, not_remote);
+ _ ->
+ hipe_rtl:mk_call(Dst, NAddressReg, Args,
+ Continuation, Fail, not_remote)
+ end],
+
+ {BadArityLabName, BadArityCode} = gen_fail_code(Fail, {badarity, Fun}),
+
+ CheckGetCode =
+ hipe_tagscheme:if_fun_get_arity_and_address(ArityReg, NAddressReg,
+ Fun, BadFunLabName,
+ 0.9),
+ CheckArityCode = check_arity(ArityReg, length(RevArgs), BadArityLabName),
+ CallCode =
+ case Continuation of
+ [] -> %% This is a tailcall
+ [hipe_rtl:mk_enter(NAddressReg, ArgsAndFun, not_remote)];
+ _ -> %% Ordinary call
+ [hipe_rtl:mk_call(Dst, NAddressReg, ArgsAndFun,
+ Continuation, Fail, not_remote)]
+ end,
+ [CheckGetCode, CheckArityCode, CallCode, BadFunCode, BadArityCode].
+
+check_arity(ArityReg, Arity, BadArityLab) ->
+ TrueLab1 = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_branch(ArityReg, eq, hipe_rtl:mk_imm(Arity),
+ hipe_rtl:label_name(TrueLab1), BadArityLab, 0.9),
+ TrueLab1].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% apply
+%%
+%% The tail call case is not handled here.
+
+gen_apply(Dst, Args = [_M,_F,_AppArgs], Cont, Fail) ->
+ %% Dst can be [Res] or [].
+ [hipe_rtl:mk_call(Dst, hipe_apply, Args, Cont, Fail, not_remote)].
+
+gen_enter_apply(Args=[_M,_F,_AppArgs]) ->
+ %% 'apply' in tail-call context
+ [hipe_rtl:mk_enter(hipe_apply, Args, not_remote)].
+
+%%
+%% apply_N
+%% also handles tailcall case (Cont=[])
+%%
+
+gen_apply_N(Dst, Arity, [M,F|CallArgs], Cont, Fail) ->
+ MM = hipe_rtl:mk_new_var(),
+ NotModuleLbl = hipe_rtl:mk_new_label(),
+ NotModuleLblName = hipe_rtl:label_name(NotModuleLbl),
+ Tuple = M,
+ Index = hipe_rtl:mk_imm(1),
+ IndexInfo = 1,
+ [hipe_tagscheme:element(MM, Index, Tuple, NotModuleLblName, unknown, IndexInfo),
+ gen_apply_N_common(Dst, Arity+1, MM, F, CallArgs ++ [M], Cont, Fail),
+ NotModuleLbl,
+ gen_apply_N_common(Dst, Arity, M, F, CallArgs, Cont, Fail)].
+
+gen_apply_N_common(Dst, Arity, M, F, CallArgs, Cont, Fail) ->
+ CallLabel = hipe_rtl:mk_new_label(),
+ CodeAddress = hipe_rtl:mk_new_reg(),
+ [hipe_rtl:mk_call([CodeAddress], find_na_or_make_stub,
+ [M,F,hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(Arity))],
+ hipe_rtl:label_name(CallLabel),
+ Fail, not_remote),
+ CallLabel,
+ case Cont of
+ [] -> % tailcall
+ hipe_rtl:mk_enter(CodeAddress, CallArgs, not_remote);
+ _ -> % recursive call
+ hipe_rtl:mk_call(Dst, CodeAddress, CallArgs, Cont, Fail, not_remote)
+ end].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% mkTuple
+%%
+
+gen_mk_tuple(Dst, Elements) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ Arity = length(Elements),
+ WordSize = hipe_rtl_arch:word_size(),
+ HeapNeed = (Arity+1)*WordSize,
+ [GetHPInsn,
+ gen_tuple_header(HP, Arity),
+ set_tuple_elements(HP, WordSize, WordSize, Elements, []),
+ hipe_tagscheme:tag_tuple(Dst, HP),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(HeapNeed)),
+ PutHPInsn].
+
+set_tuple_elements(HP, Offset, WordSize, [Element|Elements], Stores) ->
+ Store = hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(Offset), Element),
+ set_tuple_elements(HP, Offset+WordSize, WordSize, Elements, [Store|Stores]);
+set_tuple_elements(_, _, _, [], Stores) ->
+ lists:reverse(Stores).
+
+%%
+%% @doc Generate RTL code for the reduction test.
+%%
+gen_redtest(Amount) ->
+ {GetFCallsInsn, FCalls, PutFCallsInsn} = hipe_rtl_arch:fcalls(),
+ SuspendLabel = hipe_rtl:mk_new_label(),
+ StayLabel = hipe_rtl:mk_new_label(),
+ ContinueLabel = hipe_rtl:mk_new_label(),
+ [GetFCallsInsn,
+ hipe_rtl:mk_alub(FCalls, FCalls, 'sub', hipe_rtl:mk_imm(Amount), 'lt',
+ hipe_rtl:label_name(SuspendLabel),
+ hipe_rtl:label_name(StayLabel), 0.01),
+ SuspendLabel,
+ %% The suspend path should not execute PutFCallsInsn.
+ hipe_rtl:mk_call([], suspend_0, [],
+ hipe_rtl:label_name(ContinueLabel), [], not_remote),
+ StayLabel,
+ PutFCallsInsn,
+ ContinueLabel].
+
+gen_self(Dst, Cont) ->
+ case Dst of
+ [] -> %% The result is not used.
+ [hipe_rtl:mk_goto(Cont)];
+ [Dst1] ->
+ [load_p_field(Dst1, ?P_ID),
+ hipe_rtl:mk_goto(Cont)]
+ end.
+
+%%
+%% @doc Generate is_tuple/1 test
+%%
+gen_is_tuple(Dst, [Arg], Cont) ->
+ GotoCont = hipe_rtl:mk_goto(Cont),
+ case Dst of
+ [] -> %% The result is not used.
+ [GotoCont];
+ [Dst1] ->
+ TrueLabel = hipe_rtl:mk_new_label(),
+ FalseLabel = hipe_rtl:mk_new_label(),
+ [hipe_tagscheme:test_tuple(Arg, hipe_rtl:label_name(TrueLabel),
+ hipe_rtl:label_name(FalseLabel), 0.5),
+ TrueLabel,
+ hipe_rtl:mk_load_atom(Dst1, true),
+ GotoCont,
+ FalseLabel,
+ hipe_rtl:mk_load_atom(Dst1, false),
+ GotoCont]
+ end.
+
+%%
+%% @doc Generate unsafe head
+%%
+gen_unsafe_hd(Dst, [Arg]) -> hipe_tagscheme:unsafe_car(Dst, Arg).
+
+%%
+%% @doc Generate unsafe tail
+%%
+gen_unsafe_tl(Dst, [Arg]) -> hipe_tagscheme:unsafe_cdr(Dst, Arg).
+
+%%
+%% element
+%%
+gen_element(Dst, Args, IsGuard, Cont, Fail) ->
+ Dst1 =
+ case Dst of
+ [] -> %% The result is not used.
+ hipe_rtl:mk_new_var();
+ [Dst0] -> Dst0
+ end,
+ [Index, Tuple] = Args,
+ gen_element_1(Dst1, Index, Tuple, IsGuard, Cont, Fail, unknown, unknown).
+
+gen_element_1(Dst, Index, Tuple, IsGuard, Cont, Fail, TupleInfo, IndexInfo) ->
+ {FailLblName, FailCode} = gen_fail_code(Fail, badarg, IsGuard),
+ [hipe_tagscheme:element(Dst, Index, Tuple, FailLblName, TupleInfo, IndexInfo),
+ hipe_rtl:mk_goto(Cont),
+ FailCode].
+
+%%
+%% unsafe element
+%%
+gen_unsafe_element(Dst, Index, Tuple) ->
+ case hipe_rtl:is_imm(Index) of
+ true -> hipe_tagscheme:unsafe_constant_element(Dst, Index, Tuple);
+ false -> ?EXIT({illegal_index_to_unsafe_element,Index})
+ end.
+
+gen_unsafe_update_element(Tuple, Index, Value) ->
+ case hipe_rtl:is_imm(Index) of
+ true ->
+ hipe_tagscheme:unsafe_update_element(Tuple, Index, Value);
+ false ->
+ ?EXIT({illegal_index_to_unsafe_update_element,Index})
+ end.
+
+
+gen_closure_element(Dst, Index, Closure) ->
+ hipe_tagscheme:unsafe_closure_element(Dst, Index, Closure).
+
+%%
+%% @doc Generate RTL code that writes a tuple header.
+%%
+gen_tuple_header(Ptr, Arity) ->
+ Header = hipe_tagscheme:mk_arityval(Arity),
+ hipe_rtl:mk_store(Ptr, hipe_rtl:mk_imm(0), hipe_rtl:mk_imm(Header)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% Receives
+
+gen_check_get_msg(Dsts, GotoCont, Fail) ->
+ gen_check_get_msg_outofline(Dsts, GotoCont, Fail).
+
+gen_clear_timeout([], GotoCont) ->
+ case ?ERTS_IS_SMP of
+ 0 -> gen_clear_timeout_notsmp(GotoCont);
+ 1 -> gen_clear_timeout_smp(GotoCont)
+ end.
+
+-ifdef(notdef). % for reference, currently unused
+%%% check_get_msg is:
+%%% if (!PEEK_MESSAGE(p)) goto Fail;
+%%% Dst = ERL_MESSAGE_TERM(PEEK_MESSAGE(p));
+%%% i.e.,
+%%% ErlMessage **save = p->msg.save;
+%%% ErlMessage *msg = *save;
+%%% if (!msg) goto Fail;
+%%% Dst = msg->m[0];
+gen_check_get_msg_inline(Dsts, GotoCont, Fail) ->
+ Save = hipe_rtl:mk_new_reg(),
+ Msg = hipe_rtl:mk_new_reg(),
+ TrueLbl = hipe_rtl:mk_new_label(),
+ [load_p_field(Save, ?P_MSG_SAVE),
+ load_struct_field(Msg, Save, 0),
+ hipe_rtl:mk_branch(Msg, eq, hipe_rtl:mk_imm(0), Fail,
+ hipe_rtl:label_name(TrueLbl), 0.1),
+ TrueLbl |
+ case Dsts of
+ [Dst] ->
+ [load_struct_field(Dst, Msg, ?MSG_MESSAGE),
+ GotoCont];
+ [] -> % receive which throws away the message
+ [GotoCont]
+ end].
+-endif.
+
+%%% next_msg is:
+%%% SAVE_MESSAGE(p);
+%%% i.e.,
+%%% ErlMessage **save = p->msg.save;
+%%% ErlMessage *msg = *save;
+%%% ErlMessage **next = &msg->next;
+%%% p->msg.save = next;
+gen_next_msg([], GotoCont) ->
+ Save = hipe_rtl:mk_new_reg(),
+ Msg = hipe_rtl:mk_new_reg(),
+ Next = hipe_rtl:mk_new_reg(),
+ [load_p_field(Save, ?P_MSG_SAVE),
+ load_struct_field(Msg, Save, 0),
+ hipe_rtl:mk_alu(Next, Msg, 'add', hipe_rtl:mk_imm(?MSG_NEXT)),
+ store_p_field(Next, ?P_MSG_SAVE),
+ GotoCont].
+
+%%% clear_timeout is:
+%%% p->flags &= ~F_TIMO; JOIN_MESSAGE(p);
+%%% i.e.,
+%%% p->flags &= ~F_TIMO;
+%%% p->msg.save = &p->msg.first;
+gen_clear_timeout_notsmp(GotoCont) ->
+ Flags1 = hipe_rtl:mk_new_reg(),
+ Flags2 = hipe_rtl:mk_new_reg_gcsafe(),
+ First = hipe_rtl:mk_new_reg_gcsafe(),
+ [load_p_field(Flags1, ?P_FLAGS),
+ hipe_rtl:mk_alu(Flags2, Flags1, 'and', hipe_rtl:mk_imm(bnot(?F_TIMO))),
+ store_p_field(Flags2, ?P_FLAGS),
+ hipe_rtl_arch:pcb_address(First, ?P_MSG_FIRST),
+ store_p_field(First, ?P_MSG_SAVE),
+ GotoCont].
+
+gen_check_get_msg_outofline(Dsts, GotoCont, Fail) ->
+ RetLbl = hipe_rtl:mk_new_label(),
+ TrueLbl = hipe_rtl:mk_new_label(),
+ Tmp = hipe_rtl:mk_new_reg(),
+ TheNonValue = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
+ [hipe_rtl_arch:call_bif([Tmp], check_get_msg, [],
+ hipe_rtl:label_name(RetLbl), []),
+ RetLbl,
+ hipe_rtl:mk_branch(Tmp, eq, TheNonValue, Fail,
+ hipe_rtl:label_name(TrueLbl), 0.1),
+ TrueLbl |
+ case Dsts of
+ [Dst] ->
+ [hipe_rtl:mk_move(Dst, Tmp),
+ GotoCont];
+ [] -> % receive which throws away the message
+ [GotoCont]
+ end].
+
+gen_clear_timeout_smp(GotoCont) ->
+ RetLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl_arch:call_bif([], clear_timeout, [],
+ hipe_rtl:label_name(RetLbl), []),
+ RetLbl,
+ GotoCont].
+
+gen_select_msg([], Cont) ->
+ [hipe_rtl_arch:call_bif([], select_msg, [], Cont, [])].
+
+gen_suspend_msg([], Cont) ->
+ [hipe_rtl:mk_call([], suspend_msg, [], Cont, [], not_remote)].
+
+%% --------------------------------------------------------------------
+%%
+%% Floating point handling
+%%
+
+gen_fclearerror() ->
+ case ?P_FP_EXCEPTION of
+ [] ->
+ [];
+ Offset ->
+ Tmp = hipe_rtl:mk_new_reg(),
+ FailLbl = hipe_rtl:mk_new_label(),
+ ContLbl = hipe_rtl:mk_new_label(),
+ ContLblName = hipe_rtl:label_name(ContLbl),
+ [hipe_rtl_arch:pcb_load(Tmp, Offset),
+ hipe_rtl:mk_branch(Tmp, eq, hipe_rtl:mk_imm(0), ContLblName,
+ hipe_rtl:label_name(FailLbl), 0.9),
+ FailLbl,
+ hipe_rtl:mk_call([], 'fclearerror_error', [], [], [], not_remote),
+ hipe_rtl:mk_goto(ContLblName),
+ ContLbl]
+ end.
+
+gen_fcheckerror(ContLbl, FailLbl) ->
+ case ?P_FP_EXCEPTION of
+ [] ->
+ [];
+ Offset ->
+ Tmp = hipe_rtl:mk_new_reg(),
+ TmpFailLbl0 = hipe_rtl:mk_new_label(),
+ FailCode = fp_fail_code(TmpFailLbl0, FailLbl),
+ PreFailLbl = hipe_rtl:mk_new_label(),
+ hipe_rtl_arch:fwait() ++
+ [hipe_rtl_arch:pcb_load(Tmp, Offset),
+ hipe_rtl:mk_branch(Tmp, eq, hipe_rtl:mk_imm(0), ContLbl,
+ hipe_rtl:label_name(PreFailLbl), 0.9),
+ PreFailLbl,
+ hipe_rtl_arch:pcb_store(Offset, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(TmpFailLbl0)) |
+ FailCode]
+ end.
+
+gen_conv_to_float(Dst, [Src], ContLbl, FailLbl) ->
+ case hipe_rtl:is_var(Src) of
+ true ->
+ Tmp = hipe_rtl:mk_new_var(),
+ TmpReg = hipe_rtl:mk_new_reg_gcsafe(),
+ TrueFixNum = hipe_rtl:mk_new_label(),
+ ContFixNum = hipe_rtl:mk_new_label(),
+ TrueFp = hipe_rtl:mk_new_label(),
+ ContFp = hipe_rtl:mk_new_label(),
+ ContBigNum = hipe_rtl:mk_new_label(),
+ TestFixNum = hipe_tagscheme:test_fixnum(Src,
+ hipe_rtl:label_name(TrueFixNum),
+ hipe_rtl:label_name(ContFixNum),
+ 0.5),
+ TestFp = hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(TrueFp),
+ hipe_rtl:label_name(ContFp), 0.5),
+ GotoCont = hipe_rtl:mk_goto(ContLbl),
+ TmpFailLbl0 = hipe_rtl:mk_new_label(),
+ FailCode = fp_fail_code(TmpFailLbl0, FailLbl),
+
+ TestFixNum ++
+ [TrueFixNum,
+ hipe_tagscheme:untag_fixnum(TmpReg, Src),
+ hipe_rtl:mk_fconv(Dst, TmpReg),
+ GotoCont,
+ ContFixNum] ++
+ TestFp ++
+ [TrueFp,
+ hipe_tagscheme:unsafe_untag_float(Dst, Src),
+ GotoCont,
+ ContFp] ++
+ [hipe_rtl:mk_call([Tmp], conv_big_to_float, [Src],
+ hipe_rtl:label_name(ContBigNum),
+ hipe_rtl:label_name(TmpFailLbl0), not_remote)]++
+ FailCode ++
+ [ContBigNum,
+ hipe_tagscheme:unsafe_untag_float(Dst, Tmp)];
+ _ ->
+ %% This must be an attempt to convert an illegal term.
+ [gen_fail_code(FailLbl, badarith)]
+ end.
+
diff --git a/lib/hipe/rtl/hipe_rtl_ssa.erl b/lib/hipe/rtl/hipe_rtl_ssa.erl
new file mode 100644
index 0000000000..f55cc0dd5c
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_ssa.erl
@@ -0,0 +1,93 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_rtl_ssa.erl
+%% Author : Kostis Sagonas <kostis@it.uu.se>
+%% Created : 30 Jan 2004
+%% Purpose : Provides interface functions for converting RTL code into
+%% SSA form and back using the generic SSA converter.
+%%----------------------------------------------------------------------
+
+-module(hipe_rtl_ssa).
+
+-export([uses_to_rename/1]). %% needed by hipe_rtl_ssa_const_prop
+
+%% The following defines are needed by the included file below
+-define(CODE, hipe_rtl).
+-define(CFG, hipe_rtl_cfg).
+-define(LIVENESS, hipe_rtl_liveness).
+
+-include("hipe_rtl.hrl").
+-include("../ssa/hipe_ssa.inc").
+
+%%----------------------------------------------------------------------
+%% Auxiliary operations which seriously differ between Icode and RTL.
+%%----------------------------------------------------------------------
+
+defs_to_rename(Statement) ->
+ Defs = hipe_rtl:defines(Statement),
+ [D || D <- Defs, not hipe_rtl_arch:is_precoloured(D)].
+
+uses_to_rename(Statement) ->
+ Uses = hipe_rtl:uses(Statement),
+ [U || U <- Uses, not hipe_rtl_arch:is_precoloured(U)].
+
+liveout_no_succ() ->
+ hipe_rtl_arch:live_at_return().
+
+%-----------------------------------------------------------------------
+
+reset_var_indx() ->
+ hipe_gensym:set_var(rtl, hipe_rtl_arch:first_virtual_reg()).
+
+%%----------------------------------------------------------------------
+
+is_fp_temp(Temp) ->
+ hipe_rtl:is_fpreg(Temp).
+
+mk_new_fp_temp() ->
+ hipe_rtl:mk_new_fpreg().
+
+%-----------------------------------------------------------------------
+%% Procedure : makePhiMove
+%% Purpose : Create an RTL-specific version of a move instruction
+%% depending on the type of the arguments.
+%% Arguments : Dst, Src - the arguments of a Phi instruction that is
+%% to be moved up the predecessor block as part
+%% of the SSA un-convert phase.
+%% Returns : Code
+%% Note : ?CODE here is hipe_rtl
+%%----------------------------------------------------------------------
+
+makePhiMove(Dst, Src) ->
+ case hipe_rtl:is_fpreg(Dst) of
+ false ->
+ case hipe_rtl:is_fpreg(Src) of %% this test is just a sanity check
+ false ->
+ hipe_rtl:mk_move(Dst, Src)
+ end;
+ true ->
+ case hipe_rtl:is_fpreg(Src) of %% this test is just a sanity check
+ true ->
+ hipe_rtl:mk_fmove(Dst, Src)
+ end
+ end.
+
+%-----------------------------------------------------------------------
diff --git a/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl b/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl
new file mode 100644
index 0000000000..cae6da542f
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl
@@ -0,0 +1,357 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_rtl_ssa_avail_expr.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description : A couple of optimizations on rtl_ssa
+%%% 1. Remove unnecessary loads (Global)
+%%% 2. Remove unnecessary stores (Local)
+%%% 3. Remove unnecessary tag/untag operations
+%%%
+%%% Changed : 7 Feb 2007 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+-module(hipe_rtl_ssa_avail_expr).
+
+-export([cfg/1]).
+
+-include("../main/hipe.hrl").
+-include("hipe_rtl.hrl").
+
+cfg(CFG) ->
+ CFG1 = remove_loads(CFG),
+ CFG2 = remove_stores(CFG1),
+ CFG3 = optimize_fixnums(CFG2),
+ hipe_rtl_ssa:remove_dead_code(CFG3).
+
+%%%=============================================================================
+%%%
+%%% Remove unnecessary loads
+%%%
+%%%=============================================================================
+
+remove_loads(CFG) ->
+ LoadsFun = fun spread_info/2,
+ Info=fix_point(CFG, LoadsFun),
+ pass_through(CFG, LoadsFun, Info).
+
+spread_info(Code, Info) ->
+ lists:foldl(fun do_instr/2, {[],Info}, Code).
+
+do_instr(Instr, {Acc,Info}) ->
+ case Instr of
+ #call{} ->
+ {Acc++[Instr], new_env()};
+ #store{} ->
+ {Acc++[Instr], new_env()};
+ #gctest{} ->
+ {Acc++[Instr], new_env()};
+ #load{} ->
+ Dst = hipe_rtl:load_dst(Instr),
+ LoadType = {hipe_rtl:load_src(Instr), hipe_rtl:load_offset(Instr),
+ hipe_rtl:load_size(Instr), hipe_rtl:load_sign(Instr)},
+ NewInstr =
+ case lookup_y(LoadType, Info) of
+ none ->
+ Instr;
+ Var ->
+ hipe_rtl:mk_move(Dst, Var)
+ end,
+ Fun = fun load_filter_fun/2,
+ {Acc++[NewInstr], insert(Dst,LoadType,remove_defines(Instr,Info,Fun))};
+ _ ->
+ {Acc++[Instr],remove_defines(Instr,Info,fun load_filter_fun/2)}
+ end.
+
+load_filter_fun({X1,{X2,X3,_,_}},PreColDefs) ->
+ not (lists:member(X1,PreColDefs) or
+ lists:member(X2,PreColDefs) or
+ lists:member(X3,PreColDefs)).
+
+%%%=============================================================================
+%%%
+%%% Remove unnecessary stores (local optimization)
+%%%
+%%%=============================================================================
+
+remove_stores(CFG) ->
+ pass_through(CFG, fun remove_store/2, new_info()).
+
+remove_store(Code,_) ->
+ remove_store_from_bb(Code).
+
+remove_store_from_bb(Code) ->
+ remove_store_from_bb(lists:reverse(Code), new_env(), []).
+
+remove_store_from_bb([Instr|Instrs], Env, Acc) ->
+ {NewAcc, NewEnv} =
+ case Instr of
+ #call{} ->
+ {[Instr|Acc],new_env()};
+ #gctest{} ->
+ {[Instr|Acc], new_env()};
+ #store{} ->
+ Base = hipe_rtl:store_base(Instr),
+ Offset = hipe_rtl:store_offset(Instr),
+ Size = hipe_rtl:store_size(Instr),
+ StoreType = {Base, Offset, Size},
+ case lookup_y(StoreType, Env) of
+ none ->
+ {[Instr|Acc], insert(StoreType, true, Env)};
+ true ->
+ {Acc, Env}
+ end;
+ #load{} ->
+ {[Instr|Acc],new_env()};
+ _ ->
+ {[Instr|Acc],remove_defines(Instr,Env,fun store_filter_fun/2)}
+ end,
+ remove_store_from_bb(Instrs, NewEnv, NewAcc);
+remove_store_from_bb([], Env, Acc) ->
+ {Acc,Env}.
+
+store_filter_fun({{X1,X2,_},_},PreColDefs) ->
+ not (lists:member(X1,PreColDefs) or
+ lists:member(X2,PreColDefs)).
+
+%%%=============================================================================
+%%%
+%%% Optimize Fixnum Operations
+%%%
+%%%=============================================================================
+
+optimize_fixnums(CFG) ->
+ FixFun = fun fixnum_opt/2,
+ Info=fix_point(CFG, FixFun),
+ pass_through(CFG, FixFun, Info).
+
+fixnum_opt(Code,Info) ->
+ lists:foldl(fun do_fixnums/2, {[],Info}, Code).
+
+do_fixnums(Instr, {Acc,Env}) ->
+ case Instr of
+ #call{} ->
+ {Acc++[Instr],Env};
+ #gctest{} ->
+ {Acc++[Instr],Env};
+ #fixnumop{dst=Dst,src=Src} ->
+ case lookup_y(Src,Env) of
+ none ->
+ case lookup_x(Src,Env) of
+ none ->
+ case hipe_rtl_arch:is_precoloured(Src) or
+ hipe_rtl_arch:is_precoloured(Dst) of
+ true ->
+ {Acc++[Instr],Env}; %% To Avoid non ssa problems
+ false ->
+ {Acc++[Instr],insert(Dst,Src,Env)}
+ end;
+ OtherSrc ->
+ {Acc++[hipe_rtl:mk_move(Dst,OtherSrc)],Env}
+ end;
+ OtherDst ->
+ {Acc++[hipe_rtl:mk_move(Dst,OtherDst)],Env}
+ end;
+ _ ->
+ {Acc++[Instr],Env}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Code handling functions
+%%
+
+get_code_from_label(Label,CFG) ->
+ CurrentBB = hipe_rtl_cfg:bb(CFG, Label),
+ hipe_bb:code(CurrentBB).
+
+put_code_at_label(Label,Code,CFG) ->
+ NewBB = hipe_bb:mk_bb(Code),
+ hipe_rtl_cfg:bb_add(CFG, Label, NewBB).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The info environment.
+%% An info environment is a mapping from labels to info_out
+%%
+
+new_info() ->
+ gb_trees:empty().
+
+get_info(Label,Info) ->
+ case gb_trees:lookup(Label, Info) of
+ {value, V} -> V;
+ none -> none
+ end.
+
+add_info(Label, NewInfo, OldInfo) ->
+ gb_trees:enter(Label, NewInfo, OldInfo).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Simple worklist utility
+%%
+
+add_succ_to_list(NewList, OldList) ->
+ RealNew = [New || New <- NewList, lists:member(New,OldList)],
+ OldList ++ RealNew.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Generic Fixpoint Code
+%%
+
+fix_point(CFG, Fun) ->
+ Start = hipe_rtl_cfg:start_label(CFG),
+ Info = new_info(),
+ fix_point([Start], CFG, Fun, Info).
+
+fix_point([Label|Labels], CFG, Fun, Info) ->
+ case initial_stage(Label,CFG,Fun,Info) of
+ {true, _, _} ->
+ fix_point(Labels, CFG, Fun, Info);
+ {false, _, NewInfoOut} ->
+ Succ = hipe_rtl_cfg:succ(CFG, Label),
+ NewList = add_succ_to_list(Succ, Labels),
+ NewInfo = add_info(Label, NewInfoOut, Info),
+ fix_point(NewList, CFG, Fun, NewInfo)
+ end;
+fix_point([], _CFG, _Fun, Info) ->
+ Info.
+
+pass_through(CFG, Fun, Info) ->
+ pass_through(hipe_rtl_cfg:reverse_postorder(CFG),
+ CFG, Fun, Info).
+
+pass_through([Label|Labels], CFG, Fun, Info) ->
+ {_, NewCode, _} = initial_stage(Label,CFG,Fun,Info),
+ NewCFG = put_code_at_label(Label,NewCode,CFG),
+ pass_through(Labels, NewCFG, Fun, Info);
+pass_through([], CFG, _Fun, _Info) ->
+ CFG.
+
+initial_stage(Label,CFG,Fun,Info) ->
+ OldInfoOut = get_info(Label,Info),
+ Pred = hipe_rtl_cfg:pred(CFG,Label),
+ InfoEnv = join([get_info(L,Info) || L <- Pred]),
+ OldCode = get_code_from_label(Label,CFG),
+ {PhiCode,Code} = split_code(OldCode),
+ InfoIn = join_phi(PhiCode,Info,InfoEnv),
+ {NewCode, NewInfoOut} = Fun(Code, InfoIn),
+ {OldInfoOut=:=NewInfoOut,PhiCode++NewCode, NewInfoOut}.
+
+join_phi([#phi{dst=Dst,arglist=AList}|Rest], Info, Env) ->
+ case lists:foldl(fun(Val,Acc) ->
+ check_label(Val,Info,Acc)
+ end, none, AList) of
+ no_val ->
+ join_phi(Rest,Info,Env);
+ none ->
+ join_phi(Rest,Info,Env);
+ Expr ->
+ join_phi(Rest,Info,insert(Dst,Expr,Env))
+ end;
+join_phi([], _Info, Env) ->
+ Env.
+
+check_label({Lbl,Var}, Info, Acc) ->
+ case gb_trees:lookup(Lbl,Info) of
+ none -> Acc;
+ {value,Env} ->
+ case lookup_x(Var,Env) of
+ none -> no_val;
+ Acc -> Acc;
+ V ->
+ if Acc =:= none -> V;
+ true -> no_val
+ end
+ end
+ end.
+
+split_code(Code) ->
+ Phis = extract_phis(Code),
+ {Phis,Code--Phis}.
+
+extract_phis(Code) ->
+ [I || #phi{}=I <- Code].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% One2One Environment
+%%
+
+new_env() ->
+ {gb_trees:empty(),gb_trees:empty()}.
+
+insert(X,Y,{XtoY,YtoX}) ->
+ NewYtoX = remove_old_binding(X,XtoY,YtoX),
+ NewXtoY = remove_old_binding(Y,YtoX,XtoY),
+ {gb_trees:enter(X,Y,NewXtoY),
+ gb_trees:enter(Y,X,NewYtoX)}.
+
+remove_old_binding(Key,LookupTree,ChangeTree) ->
+ case gb_trees:lookup(Key,LookupTree) of
+ none ->
+ ChangeTree;
+ {value,V} ->
+ gb_trees:balance(gb_trees:delete(V,ChangeTree))
+ end.
+
+lookup_x(X,{XtoY,_YtoX}) ->
+ case gb_trees:lookup(X,XtoY) of
+ none -> none;
+ {value,Val} -> Val
+ end.
+
+lookup_y(Y,{_XtoY,YtoX}) ->
+ case gb_trees:lookup(Y,YtoX) of
+ none -> none;
+ {value,Val} -> Val
+ end.
+
+join([]) -> new_env();
+join([none]) -> new_env();
+join([E]) -> E;
+join([E1,E2|Rest]) -> join([join(E1,E2)|Rest]).
+
+join({MapXY1,MapYX1},{MapXY2,MapYX2}) ->
+ {join_maps(MapXY1,MapXY2),
+ join_maps(MapYX1,MapYX2)};
+join(none,E) -> E;
+join(E,none) -> E.
+
+join_maps(Map1,Map2) ->
+ OrdDict = ordsets:intersection(gb_trees:to_list(Map1),
+ gb_trees:to_list(Map2)),
+ gb_trees:from_orddict(OrdDict).
+
+remove_defines(Instr,Info,Fun) ->
+ Defs = hipe_rtl:defines(Instr),
+ case [Def || Def <- Defs, hipe_rtl_arch:is_precoloured(Def)] of
+ [] ->
+ Info;
+ PreColDefs ->
+ filter_environments(PreColDefs,Info,Fun)
+ end.
+
+filter_environments(PreColDefs,{M1,_M2},Fun) ->
+ L1 = gb_trees:to_list(M1),
+ F1 = [Tup || Tup <- L1, Fun(Tup,PreColDefs)],
+ F2 = [{Y,X} || {X,Y} <- F1],
+ {gb_trees:from_orddict(F1),gb_trees:from_orddict(orddict:from_list(F2))}.
diff --git a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl
new file mode 100644
index 0000000000..76c0a88933
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl
@@ -0,0 +1,1082 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ============================================================================
+%% Filename : hipe_rtl_ssa_const_prop.erl
+%% Authors : Bjorn Bergman, Bjarni Juliusson
+%% Purpose : Perform sparse conditional constant propagation on RTL.
+%% Notes : Works on an SSA-converted control-flow graph.
+%%
+%% History : * 2004-03-14: Blatantly stolen from Icode (code by
+%% Daniel Luna and Erik Andersson) and query-replaced for RTL.
+%% * 2004-04-30: Added in the repository.
+%% ============================================================================
+%%
+%% Exports: propagate/1.
+%%
+%% ============================================================================
+%%
+%% Some things to note:
+%%
+%% 1. All precoloured registers are assumed to contain bottom. We can not
+%% do anything with them since they are not in SSA-form. This might be
+%% possible to resolve in some way, but we decided to not go there.
+%%
+%% 2. const_labels are assumed to be bottom, we can not find the address
+%% in any nice way (that I know of, maybe someone can help ?). I
+%% suppose they don't get a value until linking (or some step that
+%% resembles it). They are only affecting bignums and floats (at least
+%% as far as I can tell), which are both stored in memory and hence
+%% not handled very well by us anyway.
+%%
+%% 3. can v <- Constant be removed ? I think so. all uses of v will be
+%% replaced with an immediate. So why not ?
+%%
+%% ============================================================================
+%%
+%% TODO:
+%%
+%% Take care of failures in call and replace operation with apropriate
+%% failure.
+%%
+%% Handle ifs with non-binary operators
+%%
+%% We want multisets for easier (and faster) creation of env->ssa_edges
+%%
+%% Propagation of constant arguments when some of the arguments are bottom
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+-module(hipe_rtl_ssa_const_prop).
+-export([propagate/1]).
+
+-include("../main/hipe.hrl").
+-include("hipe_rtl.hrl").
+-include("../flow/cfg.hrl").
+
+%-define(DEBUG, true).
+
+-ifdef(DEBUG).
+-define(SCCPDBG(W), W).
+-define(DEBUG_TST, true). % make sure that we can use ?DEBUG in if-cases...
+-else.
+-define(DEBUG_TST, false). % make sure that we can use ?DEBUG in if-cases...
+-define(SCCPDBG(W), ok).
+-endif.
+
+%%-----------------------------------------------------------------------------
+%% Include stuff shared between SCCP on Icode and RTL.
+%% NOTE: Needs to appear after DEBUG is possibly defined.
+%%-----------------------------------------------------------------------------
+
+-define(CODE, hipe_rtl).
+-define(CFG, hipe_rtl_cfg).
+-include("../ssa/hipe_ssa_const_prop.inc").
+
+-type bool_lattice() :: 'true' | 'false' | 'top' | 'bottom'.
+-type conditional() :: 'eq' | 'ne' | 'ge' | 'geu' | 'gt' | 'gtu' | 'le'
+ | 'leu' | 'lt' | 'ltu' | 'overflow' | 'not_overflow'.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_expression/2
+%% Purpose : do a symbolic execution of the given instruction. This is just
+%% a wrapper that chooses the right function to handle a particular
+%% instruction.
+%% Arguments : Instructions - the instruction
+%% Environment - have a guess.
+%% Returns : {FlowWorkList, SSAWorkList, Environment}
+%%-----------------------------------------------------------------------------
+visit_expression(Instruction, Environment) ->
+ case Instruction of
+ #alu{} ->
+ visit_alu(Instruction, Environment);
+ #alub{} ->
+ visit_alub(Instruction, Environment);
+ #branch{} ->
+ visit_branch(Instruction, Environment);
+ #call{} ->
+ visit_call(Instruction, Environment);
+%% #comment{} ->
+%% visit_comment(Instruction, Environment);
+%% #enter{} ->
+%% visit_enter(Instruction, Environment);
+ #fconv{} ->
+ visit_fconv(Instruction, Environment);
+ #fixnumop{} ->
+ visit_fixnumop(Instruction, Environment);
+ #fload{} ->
+ visit_fload(Instruction, Environment);
+ #fmove{} ->
+ visit_fmove(Instruction, Environment);
+ #fp{} ->
+ visit_fp(Instruction, Environment);
+ #fp_unop{} ->
+ visit_fp_unop(Instruction, Environment);
+%% #fstore{} ->
+%% visit_fstore(Instruction, Environment);
+%% #gctest{} ->
+%% visit_gctest(Instruction, Environment);
+ #goto{} ->
+ visit_goto(Instruction, Environment);
+ #goto_index{} ->
+ visit_goto_index(Instruction, Environment);
+%% #label{} ->
+%% visit_label(Instruction, Environment);
+ #load{} ->
+ visit_load(Instruction, Environment);
+ #load_address{} ->
+ visit_load_address(Instruction, Environment);
+ #load_atom{} ->
+ visit_load_atom(Instruction, Environment);
+ #load_word_index{} ->
+ visit_load_word_index(Instruction, Environment);
+ #move{} ->
+ visit_move(Instruction, Environment);
+ #multimove{} ->
+ visit_multimove(Instruction, Environment);
+%% phi-nodes are handled in scc
+%% #phi{} ->
+%% visit_phi(Instruction, Environment);
+%% #return{} ->
+%% visit_return(Instruction, Environment);
+%% #store{} ->
+%% visit_store(Instruction, Environment);
+ #switch{} ->
+ visit_switch(Instruction, Environment);
+ _ ->
+ %% label, end_try, comment, return, fail, et al
+ {[], [], Environment}
+ end.
+
+
+%%-----------------------------------------------------------------------------
+%% Procedure : set_to/3
+%% Purpose : many of the visit_<inst> functions ends in a update of the
+%% environment (and resulting SSA-edges) this function does the
+%% update in a nice way and formats the result so that it can be
+%% imediatly returned to visit_expression
+%% Arguments : Dst - the destination may be a list of destinations.
+%% Val - the new value (bottom, or some constant).
+%% Env - the environment in which the update should be done.
+%% Returns : { FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+set_to(Dst, Val, Env) ->
+ {Env1, SSAWork} = update_lattice_value({Dst, Val}, Env),
+ {[], SSAWork, Env1}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_branch/2
+%% Purpose : do symbolic exection of branch instructions.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : { FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_branch(Inst, Env) -> %% Titta ocks� p� exekverbarflagga
+ Val1 = lookup_lattice_value(hipe_rtl:branch_src1(Inst), Env),
+ Val2 = lookup_lattice_value(hipe_rtl:branch_src2(Inst), Env),
+ CFGWL = case evaluate_relop(Val1, hipe_rtl:branch_cond(Inst), Val2) of
+ true -> [hipe_rtl:branch_true_label(Inst)];
+ false -> [hipe_rtl:branch_false_label(Inst)];
+ bottom -> [hipe_rtl:branch_true_label(Inst),
+ hipe_rtl:branch_false_label(Inst)];
+ top -> []
+ end,
+ {CFGWL, [], Env}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : evaluate_relop/3
+%% Purpose : evaluate the given relop. While taking care to handle top &
+%% bottom in some sane way.
+%% Arguments : Val1, Val2 - The operands Integers or top or bottom
+%% RelOp - some relop atom from rtl.
+%% Returns : bottom, top, true or false
+%%-----------------------------------------------------------------------------
+
+evaluate_relop(Val1, RelOp, Val2) ->
+ if
+ (Val1==bottom) or (Val2==bottom) -> bottom ;
+ (Val1==top) or (Val2==top) -> top;
+ true -> hipe_rtl_arch:eval_cond(RelOp, Val1, Val2)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : evaluate_fixnumop/2
+%% Purpose : try to evaluate a fixnumop.
+%% Arguments : Val1 - operand (an integer, 'top' or 'bottom')
+%% Op - the operation.
+%% Returns : Result
+%% where result is an integer, 'top' or 'bottom'
+%%-----------------------------------------------------------------------------
+
+evaluate_fixnumop(Val1, Op) ->
+ if Val1 =:= top ->
+ top;
+ Val1 =:= bottom ->
+ bottom;
+ is_integer(Val1) ->
+ case Op of
+ tag ->
+ hipe_tagscheme:mk_fixnum(Val1);
+ untag ->
+ hipe_tagscheme:fixnum_val(Val1)
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_alu/2
+%% Purpose : do symbolic exection of a alu
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : { FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_alu(Inst, Env) ->
+ Val1 = lookup_lattice_value(hipe_rtl:alu_src1(Inst), Env),
+ Val2 = lookup_lattice_value(hipe_rtl:alu_src2(Inst), Env),
+ {NewVal, _, _, _, _} = evaluate_alu(Val1, hipe_rtl:alu_op(Inst), Val2),
+ set_to(hipe_rtl:alu_dst(Inst), NewVal, Env).
+
+%% Here follows the alu-evaluation stuff. This is the most involved part I
+%% guess. The function that you may want to use is evaluate_alu/3. The
+%% evaluation functions returns
+%% { Result, SignFlag, ZeroFlag, Overflow flag, CarryBit}
+%% it uses some helpers which are explained breifly:
+%% lattice_meet/2 - handles the general case of most alu-operations, called
+%% when at least one of the operands is nonconstant, and the
+%% operation-specifics have been taken care of.
+%% all_ones/0 - returns the value of a rtl-word set to all 1 bits.
+%% partial_eval_alu - tries to catch some operation specific special cases
+%% when one (or both) of the operands is nonconstant.
+
+lattice_meet(Val1, Val2) ->
+ M = if (Val1 =:= top) or (Val2 =:= top) -> top;
+ (Val1 =:= bottom) or (Val2 =:= bottom) -> bottom
+ % the check is realy just sanity
+ end,
+ {M, M, M, M, M}.
+
+all_ones() ->
+ (1 bsl ?bytes_to_bits(hipe_rtl_arch:word_size())) - 1.
+
+%% when calling partial_eval*() we know that at least one of the Values
+%% are bottom or top. They return { Value, Sign, Zero, Overflow, Carry }.
+%% (just like hipe_rtl_arch:eval_alu)
+
+%% logic shifts are very similar each other. Limit is the number of
+%% bits in the words.
+partial_eval_shift(Limit, Val1, Val2) ->
+ if
+ Val2 =:= 0 -> {Val1, Val1, Val1, Val1, Val1};
+ Val1 =:= 0 -> {0, false, true, false, false};
+ is_integer(Val2), Val2 >= Limit -> % (Val2 =/= top) and (Val2 =/= bottom)
+ {0, false, true, Val1, Val1}; % OVerflow & carry we dont know about.
+ true -> lattice_meet(Val1, Val2)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : partial_eval_alu/3
+%% Purpose : try to evaluate as much as possible an alu operation where at
+%% least one of the operands is not constant.
+%% Arguments : Val1, Val2 - operands (integer, top or bottom)
+%% Op - the operation.
+%% Returns : {Result, Sign, Zero, Overflow, Carry}
+%% where Result is an integer, 'top' or 'bottom'
+%% and the others are bool, 'top' or 'bottom'.
+%%-----------------------------------------------------------------------------
+
+partial_eval_alu(Val1, add, Val2) ->
+ if
+ (Val1 == 0) -> {Val2, Val2, Val2, false, false};
+ (Val2 == 0) -> {Val1, Val1, Val1, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, sub, Val2) ->
+ if
+ (Val2 == 0) -> {Val1, Val1, Val1, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, 'or', Val2) ->
+ All_ones = all_ones(),
+ if
+ (Val1 == 0) -> {Val2, Val2, Val2, false, false};
+ (Val2 == 0) -> {Val1, Val1, Val1, false, false};
+ (Val1 == All_ones) or (Val2 == All_ones) ->
+ {All_ones, true, false, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, 'and', Val2) ->
+ All_ones = all_ones(),
+ if
+ Val1 == All_ones -> {Val2, Val2, Val2, false, false};
+ Val2 == All_ones -> {Val1, Val1, Val1, false, false};
+ (Val1 == 0) or (Val2 == 0) -> {0, false, true, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, 'xor', Val2) ->
+ if
+ (Val1 == 0) -> {Val2, Val2, Val2, false, false};
+ (Val2 == 0) -> {Val1, Val1, Val1, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, 'xornot', Val2) ->
+ All_ones = all_ones(),
+ if
+ Val1 == All_ones -> {Val2, Val2, Val2, false, false};
+ Val2 == All_ones -> {Val1, Val1, Val1, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, andnot, Val2) ->
+ All_ones = all_ones(),
+ if
+ (Val2 == 0) -> {Val1, Val1, Val1, false, false};
+ (Val1 == 0) or (Val2 == All_ones) -> {0, false, true, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end;
+partial_eval_alu(Val1, Op, Val2) when (Op =:= 'sll') or (Op =:= 'srl') ->
+ BitSize = ?bytes_to_bits(hipe_rtl_arch:word_size()),
+ partial_eval_shift(BitSize, Val1, Val2);
+partial_eval_alu(Val1, Op, Val2) when (Op =:= 'sllx') or (Op =:= 'srlx') ->
+ partial_eval_shift(64, Val1, Val2);
+partial_eval_alu(Val1, mul, Val2) -> lattice_meet(Val1, Val2); % XXX: suboptimal
+
+% arithmetic shifts are more tricky, shifting something unknown can
+% generate all_ones() and 0 depenging on the sign of Val1.
+partial_eval_alu(Val1, Op, Val2) when (Op =:= 'sra') or (Op =:= 'srax') ->
+ if
+ (Val2 == 0) -> {Val1, Val1, Val1, false, false};
+ (Val1 == 0) -> {0, false, true, false, false};
+ true -> lattice_meet(Val1, Val2)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : evaluate_alu/3
+%% Purpose : try to evaluate as much as possible of a alu operation.
+%% Arguments : Val1, Val2 - operands (an integer, 'top' or 'bottom')
+%% Op - the operation.
+%% Returns : {Result, Sign, Zero, Overflow, Carry}
+%% where result is an integer, 'top' or 'bottom'
+%% and the others are Bool, 'top' or 'bottom'.
+%%-----------------------------------------------------------------------------
+
+evaluate_alu(Val1, Op, Val2) ->
+ if
+ (Val1 =:= top) or (Val2 =:= top) or
+ (Val1 =:= bottom) or (Val2 =:= bottom) -> partial_eval_alu(Val1, Op, Val2);
+ true ->
+ case Op of
+ sllx -> hipe_rtl_arith_64:eval_alu('sll', Val1, Val2);
+ srlx -> hipe_rtl_arith_64:eval_alu('srl', Val1, Val2);
+ srax -> hipe_rtl_arith_64:eval_alu('sra', Val1, Val2);
+ _ -> hipe_rtl_arch:eval_alu(Op, Val1, Val2)
+ end
+ end.
+
+maybe_top_or_bottom(List) ->
+ maybe_top_or_bottom(List, false).
+
+maybe_top_or_bottom([], TB) -> TB;
+maybe_top_or_bottom([top | Rest], _) -> maybe_top_or_bottom(Rest, top);
+maybe_top_or_bottom([bottom | _], _) -> bottom;
+maybe_top_or_bottom([_ | Rest], TB) -> maybe_top_or_bottom(Rest, TB).
+
+-spec partial_eval_branch(conditional(), bool_lattice(), bool_lattice(),
+ bool_lattice() | 0, bool_lattice() | 0) ->
+ bool_lattice().
+partial_eval_branch(Cond, N0, Z0, V0, C0) ->
+ {N, Z, V, C} =
+ if Cond =:= 'eq';
+ Cond =:= 'ne' -> {true, Z0, true, true};
+ Cond =:= 'gt';
+ Cond =:= 'le' -> {N0, Z0, V0, true};
+ Cond =:= 'gtu' -> {true, Z0, true, C0 };
+ Cond =:= 'lt';
+ Cond =:= 'ge' -> {N0, true, V0, true};
+ Cond =:= 'geu';
+ Cond =:= 'ltu' -> {true, true, true, C0 };
+ Cond =:= 'overflow';
+ Cond =:= 'not_overflow' -> {true, true, V0, true}
+ end,
+ case maybe_top_or_bottom([N, Z, V, C]) of
+ false -> hipe_rtl_arch:eval_cond_bits(Cond, N, Z, V, C);
+ top -> top;
+ bottom -> bottom
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_alub/2
+%% Purpose : do symbolic exection of a alub instruction
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : { FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_alub(Inst, Env) ->
+ Val1 = lookup_lattice_value(hipe_rtl:alub_src1(Inst), Env),
+ Val2 = lookup_lattice_value(hipe_rtl:alub_src2(Inst), Env),
+ {NewVal, N, Z, C, V} = evaluate_alu(Val1, hipe_rtl:alub_op(Inst), Val2),
+ Labels =
+ case NewVal of
+ bottom -> [hipe_rtl:alub_true_label(Inst),
+ hipe_rtl:alub_false_label(Inst)];
+ top -> [];
+ _ ->
+ %if the partial branch cannot be evaluated we must execute the
+ % instruction at runtime.
+ case partial_eval_branch(hipe_rtl:alub_cond(Inst), N, Z, C, V) of
+ bottom -> [hipe_rtl:alub_true_label(Inst),
+ hipe_rtl:alub_false_label(Inst)];
+ top -> [];
+ true -> [hipe_rtl:alub_true_label(Inst) ];
+ false -> [hipe_rtl:alub_false_label(Inst) ]
+ end
+ end,
+ {[], NewSSA, NewEnv} = set_to(hipe_rtl:alub_dst(Inst), NewVal, Env),
+ {Labels, NewSSA, NewEnv}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_fixnumop/2
+%% Purpose : do symbolic exection of a fixnumop instruction.
+%% fixnumop is like a specialized alu.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : { FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_fixnumop(Inst, Env) ->
+ Val = lookup_lattice_value(hipe_rtl:fixnumop_src(Inst), Env),
+ Res = evaluate_fixnumop(Val, hipe_rtl:fixnumop_type(Inst)),
+ set_to(hipe_rtl:fixnumop_dst(Inst), Res, Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_f*
+%% Purpose : Do symbolic execution of floating point instructions.
+%% All floating-point hitngs are mapped to bottom. In order to
+%% implement them we would have to add hipe_rtl_arch:eval_f*
+%% instructions since floating point is no exact science.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_fconv(Inst, Env) ->
+ set_to(hipe_rtl:fconv_dst(Inst), bottom, Env).
+
+visit_fp(Inst, Env) ->
+ set_to(hipe_rtl:fp_dst(Inst), bottom, Env).
+
+visit_fp_unop(Inst, Env) ->
+ set_to(hipe_rtl:fp_unop_dst(Inst), bottom, Env).
+
+visit_fload(Inst, Env) ->
+ set_to(hipe_rtl:fload_dst(Inst), bottom, Env).
+
+visit_fmove(Inst, Env) ->
+ set_to(hipe_rtl:fmove_dst(Inst), bottom, Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_move/2
+%% Purpose : execute a register-copy
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_move(Inst, Env) ->
+ Src = hipe_rtl:move_src(Inst),
+ Dst = hipe_rtl:move_dst(Inst),
+ set_to(Dst, lookup_lattice_value(Src, Env), Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_goto/2
+%% Purpose : execute a goto
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_goto(Instruction, Environment) ->
+ GotoLabel = hipe_rtl:goto_label(Instruction),
+ {[GotoLabel], [], Environment}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_goto_index/2
+%% Purpose : execute a goto_index
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_goto_index(Inst, Env) ->
+ Index = hipe_rtl:goto_index_index(Inst),
+ case lookup_lattice_value(Index, Env) of
+ top -> { [], [], Env };
+ bottom -> %% everything is reachable
+ { hipe_rtl:goto_index_labels(Inst), [], Env };
+ I -> %% only the ith label will be taken.
+ io:format("hipe_rtl_ssa_const_prop foud goto-index with constant index ~w in ~w\n",
+ [I, Inst]),
+ { [ lists:nth(hipe_rtl:goto_index_labels(Inst), I) ], [], Env }
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_load/2
+%% Purpose : do a visit_load. Its hard to track whats in memory, and it's
+%% not in ssa form, so let's assume bottom-values !
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_load(Inst, Env) ->
+ set_to(hipe_rtl:load_dst(Inst), bottom, Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_load_address/2
+%% Purpose : execute a load_address instruction, while there might be things
+%% here that are runtime-constant they are not compile-time
+%% constant since code loading interferes with addresses.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_load_address(Inst, Env) ->
+ Dst = hipe_rtl:load_address_dst(Inst),
+ Val = bottom, %% all these are probably run-time, but not
+ %% compile-time constants
+ set_to(Dst, Val, Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_load_atom/2
+%% Purpose : Like loadadress this one gets something that is not
+%% compiletime-constant
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_load_atom(Inst, Env) ->
+ set_to(hipe_rtl:load_atom_dst(Inst), bottom, Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_load_word_index/2
+%% Purpose : execute a load_word_index. Here is probably room for
+%% improvement, we should be able to find some constants here,
+%% since we can get the labeled values from the environment, and
+%% then find the value with the given index.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_load_word_index(Inst, Env) ->
+ io:format(" this is load word index: ~w\n", [Inst]),
+ set_to(hipe_rtl:load_word_index_dst(Inst), bottom, Env).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_multimove/2 & visit_multimove/4
+%% Purpose : execute a multimove instruction.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_multimove([Dst | Dsts], [Val | Vals], MyEnv, MySSA) ->
+ {NewEnv, NewSSA} = update_lattice_value({Dst, Val}, MyEnv),
+ visit_multimove(Dsts, Vals, NewEnv, MySSA ++ NewSSA);
+visit_multimove([], [], MyEnv, MySSA) ->
+ {MyEnv, MySSA}.
+
+visit_multimove(Inst, Env) ->
+ Srcs = [lookup_lattice_value(S, Env) ||
+ S <- hipe_rtl:multimove_srclist(Inst)],
+ {NewEnv, NewSSA} = visit_multimove(hipe_rtl:multimove_dstlist(Inst),
+ Srcs, Env, []),
+ {[], NewSSA, NewEnv}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_call/2
+%% Purpose : execute a call-instruction. All calls return bottom. We make
+%% this assumption since the icode-leel have taken care of BIF's
+%% and we belive that we are left with the things that can not be
+%% done att compile time.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+visit_call(Inst, Env) ->
+ {Env1, SSAWork} =
+ update_lattice_value({hipe_rtl:call_dstlist(Inst), bottom}, Env),
+ % remeber to add both continuation & failto things to the cfgwl
+ Cont = case hipe_rtl:call_continuation(Inst) of
+ [] -> [];
+ C -> [C]
+ end,
+ Succ = case hipe_rtl:call_fail(Inst) of
+ [] -> Cont;
+ Fail -> [Fail | Cont]
+ end,
+ {Succ, SSAWork, Env1}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_switch/2
+%% Purpose : execute a switch-statement.
+%% Arguments : Inst - The instruction
+%% Env - The environment
+%% Returns : {FlowWorkList, SSAWorkList, NewEnvironment}
+%%-----------------------------------------------------------------------------
+
+%% first two helpers that are used to handle the mapping from value to label.
+%% why isn't there a function that does this ?
+
+find_switch_label(Inst, Val) ->
+ Labels = hipe_rtl:switch_labels(Inst),
+ ?SCCPDBG(io:format("finding switch_label, ~w in ~w\n", [Val,Inst])),
+ %% it seems like the index is zero based. nth uses 1-based indexing.
+ lists:nth(Val + 1, Labels).
+
+%% Switches seem tricky. the sort-order is a list of key-values to be
+%% tested in order. (if elem i matches then we should jump to elem i of
+%% the labels-list)
+visit_switch(Inst, Env) ->
+ case lookup_lattice_value(hipe_rtl:switch_src(Inst), Env) of
+ top ->
+ {[], [], Env};
+ bottom ->
+ {hipe_rtl:switch_labels(Inst), [], Env};
+ Val ->
+ {[find_switch_label(Inst, Val) ], [], Env}
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_instruction/2
+%% Purpose : update the given instruction using any information found in
+%% the environment.
+%% Arguments : Inst - the instruction
+%% Environment - in which everything happens.
+%% Returns : list of new instructions.
+%%-----------------------------------------------------------------------------
+
+%% idea: what to do with vi <- Constant. wouldn't it be possible to
+%% remove those ? (and similarily for alu-instructions. and alub
+%% instructions also ! (of course this will be done in some later step dead
+%% code elimination ? but it's a simple check.)
+update_instruction(Inst, Env) ->
+ case Inst of
+ #alu{} ->
+ update_alu(Inst, Env);
+ #alub{} ->
+ update_alub(Inst, Env);
+ #branch{} ->
+ update_branch(Inst, Env);
+ #call{} ->
+ subst_all_uses(Inst, Env);
+%% #comment{} ->
+%% [Inst];
+ #enter{} ->
+ subst_all_uses(Inst, Env);
+ #fconv{} ->
+ subst_all_uses(Inst, Env);
+ #fload{} ->
+ subst_all_uses(Inst, Env);
+ #fmove{} ->
+ subst_all_uses(Inst, Env);
+ #fp{} ->
+ subst_all_uses(Inst, Env);
+ #fp_unop{} ->
+ subst_all_uses(Inst, Env);
+ #fstore{} ->
+ subst_all_uses(Inst, Env);
+ #gctest{} ->
+ subst_all_uses(Inst, Env);
+%% #goto{} ->
+%% [ Inst ];
+ #goto_index{} ->
+ update_goto_index(Inst, Env);
+%% #label{} ->
+%% [ Inst ];
+ #load{} ->
+ subst_all_uses(Inst, Env);
+ #load_address{} ->
+ subst_all_uses(Inst, Env);
+ #load_atom{} ->
+ subst_all_uses(Inst, Env);
+ #load_word_index{} ->
+ subst_all_uses(Inst, Env);
+ #move{} ->
+ subst_all_uses(Inst, Env);
+ #multimove{} ->
+ subst_all_uses(Inst, Env);
+ #return{} ->
+ subst_all_uses(Inst, Env);
+ #store{} ->
+ subst_all_uses(Inst, Env);
+ #switch{} ->
+ update_switch(Inst, Env);
+ #phi{} ->
+ update_phi(Inst, Env);
+ _ -> % for the others it's sufficient to just update any thing they use.
+ [ Inst ]
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : subst_uses/2
+%% Purpose : looks up all things that an instruction uses and replaces
+%% anything that is determined to be constant.
+%% Arguments : Inst - the instruction
+%% Env - in which everything happen.
+%% Returns : list of instructions to replace Inst with.
+%%-----------------------------------------------------------------------------
+
+subst_all_uses(Inst, Env) ->
+ Uses = hipe_rtl_ssa:uses_to_rename(Inst),
+ [ hipe_rtl:subst_uses(update_srcs(Uses, Env), Inst) ].
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_srcs/2
+%% Purpose : given the things that a instruction use return a list
+%% {Src, NewValue} pairs that can be sent to subs_uses.
+%% Arguments : Srcs - list of uses
+%% Env - in which everything happens.
+%% Returns : list of {Src, NewValue} pairs.
+%%-----------------------------------------------------------------------------
+
+update_srcs(Srcs, Env) ->
+ Update =
+ fun(Src, Os) ->
+ case lookup_lattice_value(Src, Env) of
+ bottom -> Os;
+ top -> % this would be realy strange.
+ ?EXIT({"update_src, top", Src });
+ Constant ->
+ [ {Src, hipe_rtl:mk_imm(Constant)} | Os]
+ end
+ end,
+ lists:foldl(Update, [], Srcs ).
+
+%%-----------------------------------------------------------------------------
+%% functions for performing partial evaluation of alu-operations. They can
+%% return either an integer (the actual result), move_src1 or move_src2 in
+%% which case the alu-operation can be replace with a move, or keep_it in
+%% which case the instruction must be kept.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : partial_update_shift/3
+%% Purpose : perform a shift
+%% Arguments : Limit - the number of bits in the word to shift.
+%% Val1 - the shiftee
+%% Val2 - number of bits to shift
+%% Returns : Integer, move_src1, keep_it
+%%-----------------------------------------------------------------------------
+
+partial_update_shift(Limit, Val1, Val2) ->
+ if
+ (Val1 =:= bottom) and (Val2 =:= 0) -> move_src1;
+ (Val1 =:= 0) or ((Val2 =/= bottom) and (Val2 >= Limit)) -> 0;
+ true -> keep_it
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : partial_update_alu/3
+%% Purpose : perform as much of alu-operations where exatcly one of the
+%% operands is bottom.
+%% Arguments : Val1, Val2 - operands
+%% Op - the operation.
+%% Returns : Integer, move_src1, move_src2, keep_it
+%%-----------------------------------------------------------------------------
+
+%% we know that exactly one of the operands are bottom this one
+%% returns what to do with the instruction (it's either replace with
+%% src1, replace src2 replace with constant or keep it.
+
+partial_update_alu(Val1, 'add', Val2) ->
+ if
+ (Val1 == 0) -> move_src2;
+ (Val2 == 0) -> move_src1;
+ true -> keep_it
+ end;
+partial_update_alu(_Val1, 'sub', Val2) ->
+ if
+ (Val2 == 0) -> move_src1;
+ true -> keep_it
+ end;
+partial_update_alu(Val1, 'or', Val2) ->
+ All_ones = all_ones(),
+ if
+ (Val1 == 0) -> move_src2;
+ (Val2 == 0) -> move_src1;
+ (Val1 == All_ones) or (Val2 == All_ones) -> All_ones;
+ true -> keep_it
+ end;
+partial_update_alu(Val1, 'and', Val2) ->
+ All_ones = all_ones(),
+ if
+ Val1 == All_ones -> move_src2;
+ Val2 == All_ones -> move_src1;
+ (Val1 == 0) or (Val2 == 0) -> 0;
+ true -> keep_it
+ end;
+partial_update_alu(Val1, 'xor', Val2) ->
+ if
+ (Val1 == 0) -> move_src2;
+ (Val2 == 0) -> move_src1;
+ true -> keep_it
+ end;
+partial_update_alu(Val1, 'xornot', Val2) ->
+ All_ones = all_ones(),
+ if
+ (Val1 == All_ones) -> move_src2;
+ (Val2 == All_ones) -> move_src1;
+ true -> keep_it
+ end;
+partial_update_alu(Val1, andnot, Val2) ->
+ All_ones = all_ones(),
+ if
+ Val2 == 0 -> move_src1;
+ (Val1 == 0) or (Val2 == All_ones) -> 0;
+ true -> keep_it
+ end;
+partial_update_alu(Val1, Op, Val2) when (Op =:= 'sll') or (Op =:= 'srl') ->
+ BitSize = ?bytes_to_bits(hipe_rtl_arch:word_size()),
+ partial_update_shift(BitSize, Val1, Val2);
+partial_update_alu(Val1, Op, Val2) when (Op =:= 'sllx') or (Op =:= 'srlx') ->
+ partial_update_shift(64, Val1, Val2);
+partial_update_alu(Val1, Op, Val2) when (Op =:= 'sra') or (Op =:= 'srax') ->
+ if
+ Val2 == 0 -> move_src1;
+ Val1 == 0 -> 0;
+ true -> keep_it
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_alu/2
+%% Purpose : update an alu-instruction.
+%% Arguments : Inst - the instruction.
+%% Env - in which everything happens.
+%% Returns : list of new instruction
+%%-----------------------------------------------------------------------------
+
+update_alu(Inst, Env) ->
+ Val1 = lookup_lattice_value(hipe_rtl:alu_src1(Inst), Env),
+ Val2 = lookup_lattice_value(hipe_rtl:alu_src2(Inst), Env),
+ if
+ (Val1 =:= bottom) and (Val2 =:= bottom) ->
+ [Inst];
+ (Val1 =:= bottom) or (Val2 =:= bottom) ->
+ NewInst =
+ case partial_update_alu(Val1, hipe_rtl:alu_op(Inst), Val2) of
+ move_src1 ->
+ hipe_rtl:mk_move(hipe_rtl:alu_dst(Inst), hipe_rtl:alu_src1(Inst));
+ move_src2 ->
+ hipe_rtl:mk_move(hipe_rtl:alu_dst(Inst), hipe_rtl:alu_src2(Inst));
+ keep_it ->
+ S1 = make_alub_subst_list(Val1, hipe_rtl:alu_src1(Inst), []),
+ S2 = make_alub_subst_list(Val2, hipe_rtl:alu_src2(Inst), S1),
+ hipe_rtl:subst_uses(S2, Inst);
+ Constant ->
+ hipe_rtl:mk_move(hipe_rtl:alu_dst(Inst), hipe_rtl:mk_imm(Constant))
+ end,
+ [NewInst];
+ true ->
+ {Val,_,_,_,_} = evaluate_alu(Val1, hipe_rtl:alu_op(Inst), Val2),
+ [hipe_rtl:mk_move(hipe_rtl:alu_dst(Inst), hipe_rtl:mk_imm(Val))]
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_branch/2
+%% Purpose : update an branch-instruction
+%% Arguments : Inst - the instruction.
+%% Env - in which everything happens.
+%% Returns : list of new instruction
+%%-----------------------------------------------------------------------------
+
+update_branch(Inst, Env) ->
+ Src1 = hipe_rtl:branch_src1(Inst),
+ Src2 = hipe_rtl:branch_src2(Inst),
+ Val1 = lookup_lattice_value(Src1, Env),
+ Val2 = lookup_lattice_value(Src2, Env),
+ if
+ (Val1 =:= bottom) and (Val2 =:= bottom) ->
+ [Inst];
+ Val1 =:= bottom ->
+ [hipe_rtl:subst_uses([{Src2, hipe_rtl:mk_imm(Val2)}], Inst)];
+ Val2 =:= bottom ->
+ [hipe_rtl:subst_uses([{Src1, hipe_rtl:mk_imm(Val1)}], Inst)];
+ true ->
+ case hipe_rtl_arch:eval_cond(hipe_rtl:branch_cond(Inst), Val1, Val2) of
+ true -> [hipe_rtl:mk_goto(hipe_rtl:branch_true_label(Inst))];
+ false -> [hipe_rtl:mk_goto(hipe_rtl:branch_false_label(Inst))]
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_alub/2
+%% Purpose : update an alub-instruction. Here are some finer points, we might
+%% be able to do the math (think b = a+0), but it's hard to replace
+%% the branch, since the mapping b/w AluOp,RelOp to BranchInstr is
+%% boring to do. (lazyness is a bliss).
+%% Arguments : Inst - the instruction.
+%% Env - in which everything happens.
+%% Returns : list of new instructions
+%%-----------------------------------------------------------------------------
+
+%% some small helpers.
+alub_to_move(Inst, Res, Lab) ->
+ [ hipe_rtl:mk_move(hipe_rtl:alub_dst(Inst), Res),
+ hipe_rtl:mk_goto(Lab) ].
+
+make_alub_subst_list(bottom, _, Tail) -> Tail;
+make_alub_subst_list(top, Src, _) ->
+ ?EXIT({"~w is top during update",Src });
+make_alub_subst_list(Val, Src, Tail) ->
+ case hipe_rtl:is_imm(Src) of
+ true -> Tail;
+ false -> [{Src, hipe_rtl:mk_imm(Val)} | Tail]
+ end.
+
+update_alub(Inst, Env) ->
+ Src1 = hipe_rtl:alub_src1(Inst),
+ Src2 = hipe_rtl:alub_src2(Inst),
+ Val1 = lookup_lattice_value(Src1, Env),
+ Val2 = lookup_lattice_value(Src2, Env),
+ {ResVal, N, Z, C, V} = evaluate_alu(Val1, hipe_rtl:alub_op(Inst), Val2),
+ CondRes = partial_eval_branch(hipe_rtl:alub_cond(Inst), N, Z, C, V),
+ case CondRes of
+ bottom ->
+ %% if we can't evaluate the branch, we have to keep it as a alub isnt
+ %% since other optimizations might insert other instructions b/w the
+ %% move and the branch. We can however replace variable with constants:
+ S1 = make_alub_subst_list(Val1, Src1, []),
+ S2 = make_alub_subst_list(Val2, Src2, S1),
+ [ hipe_rtl:subst_uses(S2, Inst) ];
+ _ -> % we know where we will be going, let's find out what Dst should be.
+ % knowing where we are going means that at most one of the values is
+ % bottom, hence we can replace the alu-instr with a move.
+ % remember, a = b + 0 can give us enough info to know what jump to
+ % do without knowing the value of a. (I wonder if this will ever
+ % actualy happen ;)
+ Res = case ResVal of
+ bottom -> % something nonconstant.
+ if (Val1 =:= bottom) -> Src1;
+ (Val2 =:= bottom) -> Src2
+ end;
+ _ -> hipe_rtl:mk_imm(ResVal)
+ end,
+ case CondRes of
+ top -> io:format("oops. something VERY bad: ~w ~w V1 & 2 ~w ~w\n",
+ [Inst, {ResVal, N, Z, C, V} , Val1, Val2]),
+ [Inst ];
+ true -> alub_to_move(Inst, Res, hipe_rtl:alub_true_label(Inst));
+ false -> alub_to_move(Inst, Res, hipe_rtl:alub_false_label(Inst))
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_goto_index/2
+%% Purpose : update a goto_index instruction.
+%% Arguments : Inst - the instruction.
+%% Env - in which everything happens.
+%% Returns : list of new instructions.
+%%-----------------------------------------------------------------------------
+
+update_goto_index(Inst, Env) ->
+ Index = hipe_rtl:goto_index_index(Inst),
+ case lookup_lattice_value(Index, Env) of
+ bottom -> %% everything is reachable
+ [Inst];
+ I -> %% only the ith label will be taken.
+ [hipe_rtl:mk_goto(lists:nth(hipe_rtl:goto_index_labels(Inst), I))]
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_switch/2
+%% Purpose : update a switch instruction.
+%% Arguments : Inst - the instruction.
+%% Env - in which everything happens.
+%% Returns : list of new instructions.
+%%-----------------------------------------------------------------------------
+
+update_switch(Inst, Env) ->
+ case lookup_lattice_value(hipe_rtl:switch_src(Inst), Env) of
+ bottom ->
+ [Inst];
+ Const ->
+ Lab = find_switch_label(Inst, Const),
+ [hipe_rtl:mk_goto(Lab)]
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_phi/3
+%% Purpose : Update a phi-function w.r.t. constants. do nothing for now.
+%% Arguments : Instruction - The instruction
+%% Environment - The environment
+%% Returns : [NewInstruction]
+%%-----------------------------------------------------------------------------
+
+update_phi(Instruction, Environment) ->
+ Destination = hipe_rtl:phi_dst(Instruction),
+ case lookup_lattice_value(Destination, Environment) of
+ bottom ->
+ [Instruction];
+ top ->
+ ?WARNING_MSG("The dst of ~w is top after SCCP. Strange\n",[Instruction]),
+ ?EXIT({"bang !", Instruction}),
+ [Instruction];
+ Value ->
+ [hipe_rtl:mk_move(Destination, hipe_rtl:mk_imm(Value))]
+ end.
+
+%%-----------------------------------------------------------------------------
+
+%% make sure that all precoloured rgisters are taken out of the equation.
+lookup_lattice_value(X, Environment) ->
+ case hipe_rtl_arch:is_precoloured(X) or hipe_rtl:is_const_label(X) of
+ true ->
+ bottom;
+ false ->
+ lookup_lattice_value2(X, Environment)
+ end.
+
+lookup_lattice_value2(X, Environment) ->
+ LatticeValues = env__lattice_values(Environment),
+ case hipe_rtl:is_imm(X) of
+ true ->
+ hipe_rtl:imm_value(X);
+ false ->
+ case gb_trees:lookup(X, LatticeValues) of
+ none ->
+ io:format("~w~n",[LatticeValues]),
+ ?WARNING_MSG("Earlier compiler steps generated erroneous "
+ "code for X = ~w. We are ignoring this.\n",[X]),
+ bottom;
+ {value, top} ->
+ ?EXIT({"lookup_lattice_value, top", X}),
+ top;
+ {value, Y} ->
+ Y
+ end
+ end.
+
+%%----------------------------- End of file -----------------------------------
diff --git a/lib/hipe/rtl/hipe_rtl_ssapre.erl b/lib/hipe/rtl/hipe_rtl_ssapre.erl
new file mode 100644
index 0000000000..a9e92e5688
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_ssapre.erl
@@ -0,0 +1,1679 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% File : hipe_rtl_ssapre.erl
+%% Author : He Bingwen and Fr�d�ric Haziza
+%% Description : Performs Partial Redundancy Elimination on SSA form.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% @doc
+%%
+%% This module implements the <a href="http://cs.wheaton.edu/%7Etvandrun/writings/spessapre.pdf">Anticipation-SSAPRE algorithm</a>,
+%% with several modifications for Partial Redundancy Elimination on SSA form.
+%% We actually found problems in this algorithm, so
+%% we implement another version with several advantages:
+%% - No loop for Xsi insertions
+%% - No fix point iteration for the downsafety part
+%% - Less computations for Will Be Available part
+%% - Complexity of the overall algorithm is improved
+%%
+%% We were supposed to publish these results anyway :D
+%%
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_ssapre).
+
+-export([rtl_ssapre/2]).
+
+-include("../main/hipe.hrl").
+-include("hipe_rtl.hrl").
+
+%%-define(SSAPRE_DEBUG, true ). %% When uncommented, produces debug printouts
+-define( SETS, ordsets ). %% Which set implementation module to use
+-define( CFG, hipe_rtl_cfg ).
+-define( RTL, hipe_rtl ).
+-define( BB, hipe_bb ).
+-define( ARCH, hipe_rtl_arch ).
+-define( GRAPH, digraph ).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Debugging stuff
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-ifndef(SSAPRE_DEBUG).
+-define(pp_debug(_Str, _Args), ok).
+-else.
+-define(pp_debug(Str, Args), io:format(standard_io, Str, Args)).
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Records / Structures
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-record(xsi_link, {num}). %% Number is the index of the temporary (a Key into the Xsi Tree)
+-record(temp, {key, var}).
+-record(bottom, {key, var}).
+-record(xsi, {inst, %% Associated instruction
+ def, %% Hypothetical temporary variable
+ %% that stores the result of the computation
+ label, %% Block Label where the xsi is inserted
+ opList, %% List of operands
+ cba, %%
+ later, %%
+ wba
+ }).
+
+-record(pre_candidate, {alu, def}).
+-record(xsi_op, {pred, op}).
+
+-record(mp, {xsis, maps, preds, defs, uses, ndsSet}).
+-record(block, {type, attributes}).
+
+-record(eop, {expr, var, stopped_by}).
+-record(insertion, {code, from}).
+
+-record(const_expr, {var, value}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Main function
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+rtl_ssapre(RtlSSACfg, Options) ->
+ %% io:format("\n################ Original CFG ################\n"),
+ %% hipe_rtl_cfg:pp(RtlSSACfg),
+ %% io:format("\n\n############ SSA-Form CHECK ==> ~w\n",[hipe_rtl_ssa:check(RtlSSACfg)]),
+
+ {CFG2,XsiGraph,CFGGraph,MPs} = perform_Xsi_insertion(RtlSSACfg,Options),
+ %%?pp_debug("~n~n################ Xsi CFG ################\n",[]),pp_cfg(CFG2,XsiGraph),
+ XsiList = ?GRAPH:vertices(XsiGraph),
+ case XsiList of
+ [] ->
+ %% No Xsi
+ ?option_time(?pp_debug("~n~n################ No Xsi Inserted ################~n",[]),"RTL A-SSAPRE No Xsi inserted (skip Downsafety and Will Be Available)",Options),
+ ok;
+ _ ->
+ ?pp_debug("~n############ Downsafety ##########~n",[]),
+ ?option_time(perform_downsafety(MPs,CFGGraph,XsiGraph),"RTL A-SSAPRE Downsafety",Options),
+ ?pp_debug("~n~n################ CFG Graph ################~n",[]),pp_cfggraph(CFGGraph),
+ ?pp_debug("~n############ Will Be Available ##########~n",[]),
+ ?option_time(perform_will_be_available(XsiGraph,CFGGraph,Options),"RTL A-SSAPRE WillBeAvailable",Options)
+ end,
+
+ ?pp_debug("~n############ No more need for the CFG Graph....Deleting...",[]),?GRAPH:delete(CFGGraph),
+ ?pp_debug("~n~n################ Xsi Graph ################~n",[]),pp_xsigraph(XsiGraph),
+
+ ?pp_debug("~n############ Code Motion ##########~n",[]),
+ Labels = ?CFG:preorder(CFG2),
+
+ ?pp_debug("~n~n################ Xsi CFG ################~n",[]),pp_cfg(CFG2,XsiGraph),
+
+ init_redundancy_count(),
+ ?option_time(FinalCFG=perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options),
+
+ ?pp_debug("\n############ No more need for the Xsi Graph....Deleting...",[]),?GRAPH:delete(XsiGraph),
+
+ %% io:format("\n################ Final CFG ################\n"),
+ %% hipe_rtl_cfg:pp(FinalCFG),
+ %% io:format("\n\n############ SSA-Form CHECK ==> ~w\n",
+ %% [hipe_rtl_ssa:check(FinalCFG)]),
+ ?pp_debug("\nSSAPRE : ~w redundancies were found\n",[get_redundancy_count()]),
+
+ FinalCFG.
+
+%% ##########################################################################
+%% ######################## XSI INSERTION ###################################
+%% ##########################################################################
+
+perform_Xsi_insertion(Cfg, Options) ->
+ init_counters(), %% Init counters for Bottoms and Temps
+ DigraphOpts = [cyclic, private],
+ XsiGraph = digraph:new(DigraphOpts),
+ %% Be carefull, the digraph component is NOT garbage collected,
+ %% so don't create 20 millions of instances!
+ %% finds the longest depth
+ %% Depth-first, preorder traversal over Basic Blocks.
+ %%Labels = ?CFG:reverse_postorder(Cfg),
+ Labels = ?CFG:preorder(Cfg),
+
+ ?pp_debug("~n~n############# Finding definitions for computation~n~n",[]),
+ ?option_time({Cfg2,XsiGraph} = find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options),
+
+ %% Active List creation
+ GeneratorXsiList = lists:sort(?GRAPH:vertices(XsiGraph)),
+ ?pp_debug("~n~n############# Inserted Xsis ~w",[GeneratorXsiList]),
+ ?pp_debug("~n~n############# Finding operands~n",[]),
+ ?option_time({Cfg3,XsiGraph} = find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options),
+
+ %% Creating the CFGGraph
+ ?pp_debug("~n~n############# Creating CFG Graph",[]),
+ ?pp_debug("~n############# Labels = ~w",[Labels]),
+ CFGGraph = digraph:new(DigraphOpts),
+ [StartLabel|Others] = Labels, % adding the start label as a leaf
+ ?pp_debug("~nAdding a vertex for the start label: ~w",[StartLabel]),
+ ?GRAPH:add_vertex(CFGGraph, StartLabel, #block{type = top}),
+ % Doing the others
+ ?option_time(MPs=create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options),
+
+ %% Return the bloody collected information
+ {Cfg3,XsiGraph,CFGGraph,MPs}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+find_definition_for_computations([], Cfg, XsiGraph) ->
+ {Cfg,XsiGraph}; %% No more block to inspect in the depth-first order
+find_definition_for_computations([Label|Rest], Cfg, XsiGraph) ->
+ Code = ?BB:code(?CFG:bb(Cfg,Label)),
+ {NewCfg,XsiGraph} = find_definition_for_computations_in_block(Label,Code,Cfg,[],XsiGraph),
+ find_definition_for_computations(Rest, NewCfg, XsiGraph).
+
+%%===========================================================================
+%% Searches from instruction for one block BlockLabel.
+%% We process forward over instructions.
+
+find_definition_for_computations_in_block(BlockLabel,[],Cfg,
+ VisitedInstructions,XsiGraph)->
+ Code = lists:reverse(VisitedInstructions),
+ NewBB = ?BB:mk_bb(Code),
+ NewCfg = ?CFG:bb_add(Cfg,BlockLabel,NewBB),
+ {NewCfg,XsiGraph}; %% No more instructions to inspect in this block
+find_definition_for_computations_in_block(BlockLabel,[Inst|Rest],Cfg,
+ VisitedInstructions,XsiGraph) ->
+ %% ?pp_debug(" Inspecting instruction: ",[]),pp_instr(Inst,nil),
+ case Inst of
+ #alu{} ->
+ %% Is Inst interesting for SSAPRE?
+ %% i.e., is Inst an arithmetic operation which doesn't deal with precoloured?
+ %% Note that since we parse forward, we have no 'pre_candidate'-type so far.
+ case check_definition(Inst,VisitedInstructions,BlockLabel,Cfg,XsiGraph) of
+ {def_found,Def} ->
+ %% Replacing Inst in Cfg
+ NewInst = #pre_candidate{alu=Inst,def=Def},
+ NewVisited = [NewInst|VisitedInstructions],
+ %% Recurse forward over instructions, same CFG, same XsiGraph
+ find_definition_for_computations_in_block(BlockLabel,Rest,Cfg,
+ NewVisited,XsiGraph);
+ {merge_point,Xsi} ->
+ Def = Xsi#xsi.def,
+ Key = Def#temp.key,
+ NewInst = #pre_candidate{alu=Inst,def=Def},
+ XsiLink = #xsi_link{num=Key},
+
+ %% Add a vertex to the Xsi Graph
+ ?GRAPH:add_vertex(XsiGraph,Key,Xsi),
+ ?pp_debug(" Inserting Xsi: ",[]),pp_xsi(Xsi),
+
+ Label = Xsi#xsi.label,
+ case BlockLabel =:= Label of
+ false ->
+ %% Insert the Xsi in the appropriate block
+ Code = hipe_bb:code(?CFG:bb(Cfg,Label)),
+ {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]),
+ NewCode = BeforeCode++[XsiLink|AfterCode],
+ NewBB = hipe_bb:mk_bb(NewCode),
+ NewCfg = ?CFG:bb_add(Cfg,Label,NewBB),
+ NewVisited = [NewInst|VisitedInstructions];
+ _->
+ {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]),
+ TempVisited = BeforeCode++[XsiLink|AfterCode],
+ TempVisited2 = lists:reverse(TempVisited),
+ NewVisited = [NewInst|TempVisited2],
+ NewCfg = Cfg
+ end,
+ find_definition_for_computations_in_block(BlockLabel, Rest, NewCfg,
+ NewVisited, XsiGraph)
+ end;
+ _ ->
+ %%?pp_debug("~n [L~w] Not concerned with: ~w",[BlockLabel,Inst]),
+ %% If the instruction is not a SSAPRE candidate, we skip it and keep on
+ %% processing instructions
+ %% Prepend Inst, so that we have all in reverse order.
+ %% Easy to parse backwards
+ find_definition_for_computations_in_block(BlockLabel, Rest, Cfg,
+ [Inst|VisitedInstructions], XsiGraph)
+ end.
+
+%% ############################################################################
+%% We have E as an expression, I has an alu (arithmetic operation), and
+%% we inspect backwards the previous instructions to find a definition for E.
+%% Since we parse in forward order, we know that the previous SSAPRE
+%% instruction will have a definition.
+
+check_definition(E,[],BlockLabel,Cfg,XsiGraph)->
+ %% No more instructions in that block
+ %% No definition found in that block
+ %% Search is previous blocks
+ Preds = ?CFG:pred(Cfg, BlockLabel),
+ %% ?pp_debug("~n CHECKING DEFINITION ####### Is L~w a merge block? It has ~w preds. So far E=",[BlockLabel,length(Preds)]),pp_expr(E),
+ case Preds of
+ [] ->
+ %% Entry Point
+ {def_found,bottom};
+ [P] ->
+ %% One predecessor only, we just keep looking for a definition in that block
+ VisitedInstructions = lists:reverse(hipe_bb:code(?CFG:bb(Cfg,P))),
+ check_definition(E,VisitedInstructions,P,Cfg,XsiGraph);
+ _ ->
+ Temp = new_temp(),
+ %% It's a merge point
+ OpList = [#xsi_op{pred=X} || X<-Preds],
+ Xsi = #xsi{inst=E,def=Temp,label=BlockLabel,opList=OpList},
+ {merge_point,Xsi}
+ end;
+check_definition(E,[CC|Rest],BlockLabel,Cfg,XsiGraph) ->
+ SRC1 = ?RTL:alu_src1(E),
+ SRC2 = ?RTL:alu_src2(E),
+ case CC of
+ #alu{} ->
+ exit({?MODULE,should_not_be_an_alu,
+ {"Why the hell do we still have an alu???",CC}});
+ #pre_candidate{} ->
+ %% C is the previous instruction
+ C = CC#pre_candidate.alu,
+ DST = ?RTL:alu_dst(C),
+ case DST =:= SRC1 orelse DST =:= SRC2 of
+ false ->
+ case check_match(E,C) of
+ true -> %% It's a computation of E!
+ %% Get the dst of the alu
+ {def_found,DST};
+ _->
+ check_definition(E,Rest,BlockLabel,Cfg,XsiGraph)
+ end;
+ true ->
+ %% Get the definition of C, since C is PRE-candidate AND has been processed before
+ DEF = CC#pre_candidate.def,
+ case DEF of
+ bottom ->
+ %% Def(E)=bottom, STOP
+ {def_found,bottom};
+ _ ->
+ %% Emend E with this def(C)
+ %%?pp_debug("Parameters are E=~w, DST=~w, DEF=~w",[E,DST,DEF]),
+ F = emend(E,DST,DEF),
+ check_definition(F,Rest,BlockLabel,Cfg,XsiGraph) %% Continue the search
+ end
+ end;
+ #move{} ->
+ %% It's a move, we emend E, and continue the definition search
+ DST = ?RTL:move_dst(CC),
+ F = case SRC1 =:= DST orelse SRC2 =:= DST of
+ true ->
+ SRC = ?RTL:move_src(CC),
+ emend(E,DST,SRC);
+ _ ->
+ E
+ end,
+ check_definition(F,Rest,BlockLabel,Cfg,XsiGraph); %% Continue the search
+ #xsi_link{} ->
+ {_K,Xsi} = ?GRAPH:vertex(XsiGraph,CC#xsi_link.num),
+ C = Xsi#xsi.inst,
+ case check_match(C,E) of
+ true -> %% There is a Xsi already with a computation of E!
+ %% fetch definition of C, and give it to E
+ {def_found,Xsi#xsi.def};
+ _->
+ check_definition(E,Rest,BlockLabel,Cfg,XsiGraph)
+ end;
+ #phi{} ->
+ %% skip them. NOTE: Important to separate this case from the next one
+ check_definition(E,Rest,BlockLabel,Cfg,XsiGraph);
+ _ ->
+ %% Note: the function calls or some other instructions can change the pre-coloured registers
+ %% which are able to be redefined. This breaks of course the SSA form.
+ %% If there is a redefinition we can give bottom to the computation, and no xsi will be inserted.
+ %% (In some sens, the result of the computation is new at that point.)
+ PreColouredTest = ?ARCH:is_precoloured(SRC1) orelse ?ARCH:is_precoloured(SRC2),
+
+ %%RegisterTest = ?RTL:is_reg(?RTL:alu_dst(E)) orelse ?RTL:is_reg(SRC1) orelse ?RTL:is_reg(SRC2),
+ RegisterTest = ?RTL:is_reg(?RTL:alu_dst(E)), %% That means we cannot reuse the result held in this register...
+
+ case PreColouredTest orelse RegisterTest of
+ true ->
+ {def_found,bottom};
+ false ->
+ DC = ?RTL:defines(CC),
+ case lists:member(SRC1,DC) orelse lists:member(SRC2,DC) of
+ true ->
+ {def_found,bottom};
+ false ->
+ %% Orthogonal to E, we continue the search
+ check_definition(E,Rest,BlockLabel,Cfg,XsiGraph)
+ end
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+check_match(E, C) ->
+ OpE = ?RTL:alu_op(E),
+ OpC = ?RTL:alu_op(C),
+ case OpE =:= OpC of
+ false ->
+ false;
+ true ->
+ Src1E = ?RTL:alu_src1(E),
+ Src2E = ?RTL:alu_src2(E),
+ Src1C = ?RTL:alu_src1(C),
+ Src2C = ?RTL:alu_src2(C),
+ case Src1E =:= Src1C of
+ true ->
+ Src2E =:= Src2C;
+ false ->
+ Src1E =:= Src2C andalso Src2E =:= Src1C
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+expr_is_const(E) ->
+ ?RTL:is_imm(?RTL:alu_src1(E)) andalso ?RTL:is_imm(?RTL:alu_src2(E)).
+%% is_number(?RTL:alu_src1(E)) andalso is_number(?RTL:alu_src2(E)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Must be an arithmetic operation, i.e. #alu{}
+emend(Expr, S, Var) ->
+ SRC1 = ?RTL:alu_src1(Expr),
+ NewExpr = case SRC1 =:= S of
+ true -> ?RTL:alu_src1_update(Expr,Var);
+ false -> Expr
+ end,
+ SRC2 = ?RTL:alu_src2(NewExpr),
+ case SRC2 =:= S of
+ true -> ?RTL:alu_src2_update(NewExpr,Var);
+ false -> NewExpr
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+split_for_xsi([], Acc) ->
+ {[], Acc}; % no_xsi_no_phi_found;
+split_for_xsi([I|Is] = Code, Acc) -> %% [I|Is] in backward order, Acc in order
+ case I of
+ #xsi_link{} ->
+ {lists:reverse(Code), Acc};
+ #phi{} ->
+ {lists:reverse(Code), Acc};
+ _ ->
+ split_for_xsi(Is, [I|Acc])
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Phase 1.B : Search for operands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+find_operands(Cfg,XsiGraph,[],_Count) ->
+ {Cfg,XsiGraph};
+find_operands(Cfg,XsiGraph,ActiveList,Count) ->
+ {NewCfg,TempActiveList} = find_operands_for_active_list(Cfg,XsiGraph,ActiveList,[]),
+ NewActiveList = lists:reverse(TempActiveList),
+ ?pp_debug("~n################ Finding operands (iteration ~w): ~w have been introduced. Now ~w in total~n",
+ [Count+1, length(NewActiveList), length(?GRAPH:vertices(XsiGraph))]),
+ find_operands(NewCfg,XsiGraph,NewActiveList,Count+1).
+
+find_operands_for_active_list(Cfg,_XsiGraph,[],ActiveListAcc) ->
+ {Cfg,ActiveListAcc};
+find_operands_for_active_list(Cfg,XsiGraph,[K|Ks],ActiveListAcc) ->
+ {_Key,Xsi} = ?GRAPH:vertex(XsiGraph,K),
+ ?pp_debug("~n Inspecting operands of : ~n",[]),pp_xsi(Xsi),
+ Preds = ?CFG:pred(Cfg, Xsi#xsi.label),
+ {NewCfg,NewActiveListAcc}=determine_operands(Xsi,Preds,Cfg,K,XsiGraph,ActiveListAcc),
+ {_Key2,Xsi2} = ?GRAPH:vertex(XsiGraph,K),
+ ?pp_debug("~n ** Final Xsi: ~n",[]),pp_xsi(Xsi2),
+ ?pp_debug("~n #####################################################~n",[]),
+ find_operands_for_active_list(NewCfg,XsiGraph,Ks,NewActiveListAcc).
+
+determine_operands(_Xsi,[],Cfg,_K,_XsiGraph,ActiveAcc) ->
+ %% All operands have been determined.
+ %% The CFG is not updated, only the XsiGraph
+ {Cfg,ActiveAcc};
+determine_operands(Xsi,[P|Ps],Cfg,K,XsiGraph,ActiveAcc) ->
+ Label = Xsi#xsi.label,
+ ReverseCode = lists:reverse(hipe_bb:code(?CFG:bb(Cfg,Label))),
+ VisitedInstructions = get_visited_instructions(Xsi,ReverseCode),
+ Res = determine_e_prime(Xsi#xsi.inst,VisitedInstructions,P,XsiGraph),
+ case Res of
+ operand_is_bottom ->
+ NewXsi = xsi_arg_update(Xsi,P,new_bottom()),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+ determine_operands(NewXsi,Ps,Cfg,K,XsiGraph,ActiveAcc);
+ operand_is_const_expr ->
+ NewXsi = xsi_arg_update(Xsi,P,new_bottom()),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+ determine_operands(NewXsi,Ps,Cfg,K,XsiGraph,ActiveAcc);
+ {sharing_operand,Op} ->
+ NewXsi = xsi_arg_update(Xsi,P,Op),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+ determine_operands(NewXsi,Ps,Cfg,K,XsiGraph,ActiveAcc);
+ {revised_expression,E_prime} ->
+ ?pp_debug(" E' is determined : ",[]),pp_expr(E_prime),
+ ?pp_debug(" and going along the edge L~w~n",[P]),
+ %% Go along the edge P
+ RevCode = lists:reverse(hipe_bb:code(?CFG:bb(Cfg,P))),
+ case check_one_operand(E_prime,RevCode,P,Cfg,K,XsiGraph) of
+ {def_found,Def} ->
+ NewXsi = xsi_arg_update(Xsi,P,Def),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+ determine_operands(NewXsi,Ps,Cfg,K,XsiGraph,ActiveAcc);
+
+ {expr_found,ChildExpr} ->
+ NewXsi = xsi_arg_update(Xsi,P,ChildExpr),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+ determine_operands(NewXsi,Ps,Cfg,K,XsiGraph,ActiveAcc);
+
+ {expr_is_const, Op} ->
+ %% We detected that the expression is of the form: 'N op M'
+ %% where N and M are constant.
+ NewXsi = xsi_arg_update(Xsi,P,Op),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+ determine_operands(NewXsi,Ps,Cfg,K,XsiGraph,ActiveAcc);
+
+ {merge_point,XsiChild} ->
+ %% Update that Xsi, give its definition as Operand for the
+ %% search, and go on
+ XsiChildDef = XsiChild#xsi.def,
+ NewXsi = xsi_arg_update(Xsi,P,XsiChildDef),
+ ?GRAPH:add_vertex(XsiGraph,K,NewXsi),
+
+ KeyChild = XsiChildDef#temp.key,
+ XsiChildLink = #xsi_link{num=KeyChild},
+ ?GRAPH:add_vertex(XsiGraph,KeyChild,XsiChild),
+
+ %% Should not be the same block !!!!!!!
+ RCode = lists:reverse(hipe_bb:code(?CFG:bb(Cfg,XsiChild#xsi.label))),
+ {BCode,ACode} = split_code_for_xsi(RCode,[]),
+
+ NewCode = BCode++[XsiChildLink|ACode],
+ NewBB = hipe_bb:mk_bb(NewCode),
+ NewCfg = ?CFG:bb_add(Cfg, XsiChild#xsi.label, NewBB),
+
+ ?pp_debug(" -- ",[]),pp_arg(Xsi#xsi.def),?pp_debug(" causes insertion of: ~n",[]),pp_xsi(XsiChild),
+ ?pp_debug(" -- Adding an edge ",[]),pp_arg(Xsi#xsi.def),?pp_debug(" -> ",[]),pp_arg(XsiChild#xsi.def),
+
+ %% Adding an edge...
+ %%?GRAPH:add_edge(XsiGraph,K,KeyChild,"family"),
+ ?GRAPH:add_edge(XsiGraph,K,KeyChild),
+ determine_operands(NewXsi,Ps,NewCfg,K,XsiGraph,[KeyChild|ActiveAcc])
+ end
+ end.
+
+determine_e_prime(Expr,VisitedInstructions,Pred,XsiGraph) ->
+ %% MUST FETCH FROM THE XSI TREE, since Xsis are not updated yet in the CFG
+ NewExpr = emend_with_phis(Expr,VisitedInstructions,Pred),
+ emend_with_processed_xsis(NewExpr,VisitedInstructions,Pred,XsiGraph).
+
+emend_with_phis(EmendedE, [], _) ->
+ EmendedE;
+emend_with_phis(E, [I|Rest], Pred) ->
+ case I of
+ #phi{} ->
+ Dst = ?RTL:phi_dst(I),
+ UE = ?RTL:uses(E), %% Should we get SRC1 and SRC2 instead?
+ case lists:member(Dst, UE) of
+ false ->
+ emend_with_phis(E, Rest, Pred);
+ true ->
+ NewE = emend(E, Dst, ?RTL:phi_arg(I,Pred)),
+ emend_with_phis(NewE, Rest, Pred)
+ end;
+ _ ->
+ emend_with_phis(E, Rest, Pred)
+ end.
+
+emend_with_processed_xsis(EmendedE, [], _, _) ->
+ {revised_expression,EmendedE};
+emend_with_processed_xsis(E, [I|Rest], Pred, XsiGraph) ->
+ case I of
+ #xsi_link{} ->
+ Key = I#xsi_link.num,
+ {_KK,Xsi} = ?GRAPH:vertex(XsiGraph,Key),
+ Def = Xsi#xsi.def,
+ UE = ?RTL:uses(E), %% Should we get SRC1 and SRC2 instead?
+ case lists:member(Def,UE) of
+ false ->
+ CE = Xsi#xsi.inst,
+ case check_match(E,CE) of
+ true -> %% It's a computation of E!
+ case xsi_arg(Xsi,Pred) of
+ undetermined_operand ->
+ exit({?MODULE,check_operand_sharing,"######## �h Dear, we trusted Kostis !!!!!!!!! #############"});
+ XsiOp ->
+ {sharing_operand,XsiOp} %% They share operands
+ end;
+ _->
+ emend_with_processed_xsis(E,Rest,Pred,XsiGraph)
+ end;
+ true ->
+ A = xsi_arg(Xsi,Pred),
+ %% ?pp_debug(" ######### xsi_arg(I:~w,Pred:~w) = ~w~n",[I,Pred,A]),
+ case A of
+ #bottom{} ->
+ operand_is_bottom;
+ #const_expr{} ->
+ operand_is_const_expr;
+ #eop{} ->
+ NewE = emend(E,Def,A#eop.var),
+ emend_with_processed_xsis(NewE,Rest,Pred,XsiGraph);
+ undetermined_operand ->
+ exit({?MODULE,emend_with_processed_xsis,"######## �h Dear, we trusted Kostis, again !!!!!!!!! #############"});
+ XsiOp ->
+ NewE = emend(E,Def,XsiOp),
+ emend_with_processed_xsis(NewE,Rest,Pred,XsiGraph)
+ end
+ end;
+ _ ->
+ emend_with_processed_xsis(E,Rest,Pred,XsiGraph)
+ end.
+
+%% get_visited_instructions(Xsi,[]) ->
+%% ?pp_debug("~nWe don't find this xsi with def ",[]),pp_arg(Xsi#xsi.def),?pp_debug(" in L~w : ",[Xsi#xsi.label]),
+%% exit({?MODULE,no_such_xsi_in_block,"We didn't find that Xsi in the block"});
+get_visited_instructions(Xsi, [I|Is]) ->
+ case I of
+ #xsi_link{} ->
+ XsiDef = Xsi#xsi.def,
+ Key = XsiDef#temp.key,
+ case I#xsi_link.num =:= Key of
+ true ->
+ Is;
+ false ->
+ get_visited_instructions(Xsi, Is)
+ end;
+ _ ->
+ get_visited_instructions(Xsi, Is)
+ end.
+
+split_code_for_xsi([], Acc) ->
+ {[],Acc};
+split_code_for_xsi([I|Is] = Code, Acc) ->
+ case I of
+ #xsi_link{} ->
+ {lists:reverse(Code), Acc};
+ #phi{} ->
+ {lists:reverse(Code), Acc};
+ _ ->
+ split_code_for_xsi(Is, [I|Acc])
+ end.
+
+check_one_operand(E, [], BlockLabel, Cfg, XsiKey, XsiGraph) ->
+ %% No more instructions in that block
+ %% No definition found in that block
+ %% Search is previous blocks
+ Preds = ?CFG:pred(Cfg, BlockLabel),
+ case Preds of
+ [] ->
+ %% Entry Point
+ {def_found,new_bottom()};
+ [P] ->
+ %% One predecessor only, we just keep looking for a definition in that block
+ case expr_is_const(E) of
+ true ->
+ ?pp_debug("\n\n############## Wow expr is constant: ~w",[E]),
+ Var = ?RTL:mk_new_var(),
+ Value = eval_expr(E),
+ Op = #const_expr{var = Var, value = Value},
+ {expr_is_const, Op};
+ false ->
+ VisitedInstructions = lists:reverse(?BB:code(?CFG:bb(Cfg,P))),
+ check_one_operand(E, VisitedInstructions, P, Cfg, XsiKey, XsiGraph)
+ end;
+ _ ->
+ %% It's a merge point
+ case expr_is_const(E) of
+ true ->
+ ?pp_debug("\n\n############## Wow expr is constant at merge point: ~w",[E]),
+ Var = ?RTL:mk_new_var(),
+ Value = eval_expr(E),
+ Op = #const_expr{var = Var, value = Value},
+ {expr_is_const, Op};
+ false ->
+ Temp = new_temp(),
+ OpList = [#xsi_op{pred = X} || X <- Preds],
+ Xsi = #xsi{inst = E, def = Temp, label = BlockLabel, opList = OpList},
+ {merge_point, Xsi}
+ end
+ end;
+check_one_operand(E, [CC|Rest], BlockLabel, Cfg, XsiKey, XsiGraph) ->
+ SRC1 = ?RTL:alu_src1(E),
+ SRC2 = ?RTL:alu_src2(E),
+ %% C is the previous instruction
+ case CC of
+ #alu{} ->
+ exit({?MODULE,should_not_be_an_alu,
+ {"Why the hell do we still have an alu???",CC}});
+ #xsi{} ->
+ exit({?MODULE,should_not_be_a_xsi,
+ {"Why the hell do we still have a xsi???",CC}});
+ #pre_candidate{} ->
+ C = CC#pre_candidate.alu,
+ DST = ?RTL:alu_dst(C),
+ case DST =:= SRC1 orelse DST =:= SRC2 of
+ true ->
+ %% Get the definition of C, since C is PRE-candidate AND has
+ %% been processed before
+ DEF = CC#pre_candidate.def,
+ case DEF of
+ bottom ->
+ %% Def(E)=bottom, STOP
+ %% No update of the XsiGraph
+ {def_found,new_bottom()};
+ _->
+ %% Simply emend
+ F = emend(E,DST,DEF),
+ ?pp_debug("~nEmendation : E= ",[]),pp_expr(E),?pp_debug(" ==> E'= ",[]),pp_expr(F),?pp_debug("~n",[]),
+ check_one_operand(F,Rest,BlockLabel,Cfg,XsiKey,XsiGraph)
+ end;
+ false ->
+ case check_match(C,E) of
+ true -> %% It's a computation of E!
+ %% It should give DST and not Def
+ %% No update of the XsiGraph, cuz we use DST and not Def
+ %% The operand is therefore gonna be a real variable
+ {def_found,DST};
+ _->
+ %% Nothing to do with E
+ check_one_operand(E,Rest,BlockLabel,Cfg,XsiKey,XsiGraph)
+ end
+ end;
+ #move{} ->
+ %% It's a move, we emend E, and continue the definition search
+ DST = ?RTL:move_dst(CC),
+ case SRC1 =:= DST orelse SRC2 =:= DST of
+ true ->
+ SRC = ?RTL:move_src(CC),
+ F = emend(E,DST,SRC),
+ check_one_operand(F,Rest,BlockLabel,Cfg,XsiKey,XsiGraph); %% Continue the search
+ _ ->
+ check_one_operand(E,Rest,BlockLabel,Cfg,XsiKey,XsiGraph) %% Continue the search
+ end;
+ #xsi_link{} ->
+ Key = CC#xsi_link.num,
+ %% Is Key a family member of XsiDef ?
+ {_KK,Xsi} = ?GRAPH:vertex(XsiGraph,Key),
+ C = Xsi#xsi.inst,
+ case check_match(E,C) of
+ true -> %% There is a Xsi already with a computation of E!
+ %% fetch definition of C, and give it to E
+ %% Must update an edge in the XsiGraph, and here, we know it's a Temp
+ %% Note: this can create a loop (= a cycle of length 1)
+ ?pp_debug(" -- Found a cycle with match: Adding an edge t~w -> t~w",[XsiKey,Key]),
+ ?GRAPH:add_edge(XsiGraph,XsiKey,Key),
+ {def_found,Xsi#xsi.def};
+ _ ->
+ case ?GRAPH:get_path(XsiGraph,Key,XsiKey) of
+ false ->
+ %% Is it a loop back to itself???
+ case Key =:= XsiKey of
+ false ->
+ check_one_operand(E,Rest,BlockLabel,Cfg,XsiKey,XsiGraph);
+ _ ->
+ {expr_found,#eop{expr=E,var=?RTL:mk_new_var(),stopped_by=Key}}
+ end;
+ _ ->
+ %% Returning the expression instead of looping
+ %% And in case of no match
+ ExprOp = #eop{expr=E,var=?RTL:mk_new_var(),stopped_by=Key},
+ {expr_found,ExprOp}
+ end
+ end;
+ #phi{} -> %% skip them
+ check_one_operand(E,Rest,BlockLabel,Cfg,XsiKey,XsiGraph);
+ _ ->
+ PreColouredTest = ?ARCH:is_precoloured(SRC1) orelse ?ARCH:is_precoloured(SRC2),
+
+ %%RegisterTest = ?RTL:is_reg(?RTL:alu_dst(E)) orelse ?RTL:is_reg(SRC1) orelse ?RTL:is_reg(SRC2),
+ RegisterTest = ?RTL:is_reg(?RTL:alu_dst(E)),
+ case PreColouredTest orelse RegisterTest of
+ true ->
+ {def_found,new_bottom()};
+ _->
+ DC = ?RTL:defines(CC),
+ case lists:member(SRC1,DC) orelse lists:member(SRC2,DC) of
+ true ->
+ {def_found,new_bottom()};
+ _ ->
+ %% Orthogonal to E, we continue the search
+ check_one_operand(E,Rest,BlockLabel,Cfg,XsiKey,XsiGraph)
+ end
+ end
+ end.
+
+eval_expr(E) ->
+ ?pp_debug("~n Evaluating the result of ~w~n", [E]),
+ Op1 = ?RTL:alu_src1(E),
+ Op2 = ?RTL:alu_src2(E),
+ true = ?RTL:is_imm(Op1),
+ Val1 = ?RTL:imm_value(Op1),
+ true = ?RTL:is_imm(Op2),
+ Val2 = ?RTL:imm_value(Op2),
+ {Result, _Sign, _Zero, _Overflow, _Carry} = ?ARCH:eval_alu(?RTL:alu_op(E), Val1, Val2),
+ ?pp_debug("~n Result is then ~w~n", [Result]),
+ ?RTL:mk_imm(Result).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%% CREATTING CFGGRAPH %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+create_cfggraph([],_Cfg,CFGGraph,ToBeFactorizedAcc,MPAcc,LateEdges,_XsiGraph) ->
+ ?pp_debug("~n~n ############# PostProcessing ~n~w~n",[LateEdges]),
+ post_process(LateEdges,CFGGraph),
+ ?pp_debug("~n~n ############# Factorizing ~n~w~n",[ToBeFactorizedAcc]),
+ factorize(ToBeFactorizedAcc,CFGGraph),
+ MPAcc;
+create_cfggraph([Label|Ls],Cfg,CFGGraph,ToBeFactorizedAcc,MPAcc,LateEdges,XsiGraph) ->
+ Preds = ?CFG:pred(Cfg, Label),
+ case Preds of
+ [] ->
+ exit({?MODULE,do_not_call_on_top,{"Why the hell do we call that function on the start label???",Label}});
+ [P] ->
+ Code = ?BB:code(?CFG:bb(Cfg, Label)),
+ Defs = get_defs_in_non_merge_block(Code, []),
+ ?pp_debug("~nAdding a vertex for ~w", [Label]),
+ Succs = ?CFG:succ(Cfg, Label),
+ case Succs of
+ [] -> %% Exit point
+ ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}),
+ NewToBeFactorizedAcc = ToBeFactorizedAcc;
+ _ -> %% Split point
+ ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}),
+ NewToBeFactorizedAcc = [Label|ToBeFactorizedAcc]
+ end,
+ ?pp_debug("~nAdding an edge ~w -> ~w (~w)",[P,Label,Defs]),
+ case ?GRAPH:add_edge(CFGGraph,P,Label,Defs) of
+ {error,Reason} ->
+ exit({?MODULE,forget_that_for_christs_sake_bingwen_please,{"Bad edge",Reason}});
+ _ ->
+ ok
+ end,
+ create_cfggraph(Ls,Cfg,CFGGraph,NewToBeFactorizedAcc,MPAcc,LateEdges,XsiGraph);
+ _ -> %% Merge point
+ Code = ?BB:code(?CFG:bb(Cfg,Label)),
+ {Defs,Xsis,Maps,Uses} = get_info_in_merge_block(Code,XsiGraph,[],[],gb_trees:empty(),gb_trees:empty()),
+ Attributes = #mp{preds=Preds,xsis=Xsis,defs=Defs,maps=Maps,uses=Uses},
+ MergeBlock = #block{type=mp,attributes=Attributes},
+ ?pp_debug("~nAdding a vertex for ~w with Defs= ~w",[Label,Defs]),
+ ?GRAPH:add_vertex(CFGGraph,Label,MergeBlock),
+ %% Add edges
+ NewLateEdges = add_edges_for_mp(Preds,Label,LateEdges),
+ create_cfggraph(Ls,Cfg,CFGGraph,ToBeFactorizedAcc,[Label|MPAcc],NewLateEdges,XsiGraph)
+ end.
+
+get_defs_in_non_merge_block([], Acc) ->
+ ?SETS:from_list(Acc);
+get_defs_in_non_merge_block([Inst|Rest], Acc) ->
+ case Inst of
+ #pre_candidate{} ->
+ Def = Inst#pre_candidate.def,
+ case Def of
+ #temp{} ->
+ %% {temp,Key,_Var} ->
+ %% get_defs_in_non_merge_block(Rest,[Key|Acc]);
+ get_defs_in_non_merge_block(Rest, [Def#temp.key|Acc]);
+ _-> %% Real variables or bottom
+ get_defs_in_non_merge_block(Rest, Acc)
+ end;
+ _ ->
+ get_defs_in_non_merge_block(Rest, Acc)
+ end.
+
+get_info_in_merge_block([],_XsiGraph,Defs,Xsis,Maps,Uses) ->
+ {?SETS:from_list(Defs),Xsis,Maps,Uses}; %% Xsis are in backward order
+get_info_in_merge_block([Inst|Rest],XsiGraph,Defs,Xsis,Maps,Uses) ->
+ case Inst of
+ #pre_candidate{} ->
+ Def = Inst#pre_candidate.def,
+ case Def of
+ #temp{} ->
+ get_info_in_merge_block(Rest,XsiGraph,[Def#temp.key|Defs],Xsis,Maps,Uses);
+ _ ->
+ get_info_in_merge_block(Rest,XsiGraph,Defs,Xsis,Maps,Uses)
+ end;
+ #xsi_link{} ->
+ Key = Inst#xsi_link.num,
+ {_Key,Xsi} = ?GRAPH:vertex(XsiGraph,Key),
+ OpList = xsi_oplist(Xsi),
+ {NewMaps,NewUses} = add_map_and_uses(OpList,Key,Maps,Uses),
+ get_info_in_merge_block(Rest,XsiGraph,Defs,[Key|Xsis],NewMaps,NewUses);
+ _ ->
+ get_info_in_merge_block(Rest,XsiGraph,Defs,Xsis,Maps,Uses)
+ end.
+
+add_edges_for_mp([], _Label, LateEdges) ->
+ LateEdges;
+add_edges_for_mp([P|Ps], Label, LateEdges) ->
+ add_edges_for_mp(Ps,Label,[{P,Label}|LateEdges]).
+
+%% Doesn't do anything so far
+add_map_and_uses([], _Key, Maps, Uses) ->
+ {Maps,Uses};
+add_map_and_uses([XsiOp|Ops], Key, Maps, Uses) ->
+ case XsiOp#xsi_op.op of
+ #bottom{} ->
+ Set = case gb_trees:lookup(XsiOp,Maps) of
+ {value, V} ->
+ ?SETS:add_element(Key,V);
+ none ->
+ ?SETS:from_list([Key])
+ end,
+ NewMaps = gb_trees:enter(XsiOp,Set,Maps),
+ NewUses = Uses;
+ #temp{} ->
+ Set = case gb_trees:lookup(XsiOp,Maps) of
+ {value, V} ->
+ ?SETS:add_element(Key,V);
+ none ->
+ ?SETS:from_list([Key])
+ end,
+ NewMaps = gb_trees:enter(XsiOp,Set,Maps),
+ Pred = XsiOp#xsi_op.pred,
+ OOP = XsiOp#xsi_op.op,
+ SSet = case gb_trees:lookup(Pred,Uses) of
+ {value, VV} ->
+ ?SETS:add_element(OOP#temp.key,VV);
+ none ->
+ ?SETS:from_list([OOP#temp.key])
+ end,
+ NewUses = gb_trees:enter(Pred,SSet,Uses);
+ #eop{} ->
+ Set = case gb_trees:lookup(XsiOp,Maps) of
+ {value, V} ->
+ ?SETS:add_element(Key,V);
+ none ->
+ ?SETS:from_list([Key])
+ end,
+ NewMaps = gb_trees:enter(XsiOp,Set,Maps),
+ Pred = XsiOp#xsi_op.pred,
+ Op = XsiOp#xsi_op.op,
+ SSet = case gb_trees:lookup(Pred,Uses) of
+ {value, VV} ->
+ ?SETS:add_element(Op#eop.stopped_by,VV);
+ none ->
+ ?SETS:from_list([Op#eop.stopped_by])
+ end,
+ NewUses = gb_trees:enter(Pred,SSet,Uses);
+ _->
+ NewMaps = Maps,
+ NewUses = Uses
+ end,
+ add_map_and_uses(Ops, Key, NewMaps, NewUses).
+
+post_process([], _CFGGraph) -> ok;
+post_process([E|Es], CFGGraph) ->
+ {Pred,Label} = E,
+ {_PP,Block} = ?GRAPH:vertex(CFGGraph,Label),
+ Att = Block#block.attributes,
+ Uses = Att#mp.uses,
+ SetToAdd = case gb_trees:lookup(Pred,Uses) of
+ {value, Set} ->
+ Set;
+ none ->
+ ?SETS:new()
+ end,
+ %% ?pp_debug("~nAdding an edge ~w -> ~w (~w)",[Pred,Label,SetToAdd]),
+ ?GRAPH:add_edge(CFGGraph, Pred, Label, SetToAdd),
+ post_process(Es, CFGGraph).
+
+factorize([], _CFGGraph) -> ok;
+factorize([P|Ps], CFGGraph) ->
+ [OE|OEs] = ?GRAPH:out_edges(CFGGraph,P),
+ %% ?pp_debug("~nIn_degrees ~w : ~w",[P,?GRAPH:in_degree(CFGGraph,P)]),
+ [InEdge] = ?GRAPH:in_edges(CFGGraph,P),
+ {E,V1,V2,Label} = ?GRAPH:edge(CFGGraph,InEdge),
+ {_OEE,_OEV1,_OEV2,LOE} = ?GRAPH:edge(CFGGraph,OE),
+ List = shoot_info_upwards(OEs,LOE,CFGGraph),
+ NewLabel = ?SETS:union(Label,List),
+ ?GRAPH:add_edge(CFGGraph,E,V1,V2,NewLabel),
+ factorize(Ps, CFGGraph).
+
+shoot_info_upwards([], Acc, _CFGGraph) -> Acc;
+shoot_info_upwards([E|Es], Acc, CFGGraph) ->
+ {_E,_V1,_V2,Set} = ?GRAPH:edge(CFGGraph,E),
+ NewAcc = ?SETS:intersection(Acc, Set),
+ case ?SETS:size(NewAcc) of
+ 0 -> NewAcc;
+ _ -> shoot_info_upwards(Es,NewAcc,CFGGraph)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DOWNSAFETY %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+perform_downsafety([], _G, _XsiG) ->
+ ok;
+perform_downsafety([MP|MPs], G, XG) ->
+ {V,Block} = ?GRAPH:vertex(G, MP),
+ NDS = ?SETS:new(),
+ Att = Block#block.attributes,
+ Maps = Att#mp.maps,
+ Defs = Att#mp.defs,
+ OutEdges = ?GRAPH:out_edges(G, MP),
+ %% ?pp_debug("~n Inspection Maps : ~w",[Maps]),
+ NewNDS = parse_keys(gb_trees:keys(Maps),Maps,OutEdges,G,Defs,NDS,XG),
+ NewAtt = Att#mp{ndsSet = NewNDS},
+ ?GRAPH:add_vertex(G, V, Block#block{attributes = NewAtt}),
+ ?pp_debug("~n Not Downsafe at L~w: ~w", [V, NewNDS]),
+ %%io:format(standard_io,"~n Not Downsafe at L~w: ~w",[V,NewNDS]),
+ perform_downsafety(MPs, G, XG).
+
+parse_keys([], _Maps, _OutEdges, _G, _Defs, NDS, _XsiG) ->
+ NDS;
+parse_keys([M|Ms], Maps, OutEdges, G, Defs, NDS, XsiG) ->
+ KillerSet = gb_trees:get(M,Maps),
+ %% ?pp_debug("~n Inspection ~w -> ~w",[M,KillerSet]),
+ TempSet = ?SETS:intersection(KillerSet,Defs),
+ NewNDS = case ?SETS:size(TempSet) of
+ 0 -> getNDS(M,KillerSet,NDS,OutEdges,G,XsiG);
+ _ ->
+ %% One Xsi which has M as operand has killed it
+ %% M is then Downsafe
+ %% and is not added to the NotDownsafeSet (NDS)
+ NDS
+ end,
+ parse_keys(Ms, Maps, OutEdges, G, Defs, NewNDS, XsiG).
+
+getNDS(_M, _KillerSet, NDS, [], _G, _XsiG) ->
+ NDS;
+getNDS(M, KillerSet, NDS, [E|Es], G, XsiG) ->
+ {_EE,_V1,_V2,Label} = ?GRAPH:edge(G, E),
+ Set = ?SETS:intersection(KillerSet, Label),
+ %% ?pp_debug("~n ######## Intersection between KillerSet: ~w and Label: ~w",[KillerSet,Label]),
+ %% ?pp_debug("~n ######## ~w",[Set]),
+ case ?SETS:size(Set) of
+ 0 ->
+ %% M is not downsafe
+ ?SETS:add_element(M, NDS);
+ _ ->
+ %% Try the other edges
+ getNDS(M, KillerSet, NDS, Es, G, XsiG)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%% WILL BE AVAILABLE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+perform_will_be_available(XsiGraph,CFGGraph,Options) ->
+ Keys = ?GRAPH:vertices(XsiGraph),
+ ?pp_debug("~n############ Can Be Available ##########~n",[]),
+ ?option_time(perform_can_be_available(Keys,XsiGraph,CFGGraph),"RTL A-SSAPRE WillBeAvailable - Compute CanBeAvailable",Options),
+ ?pp_debug("~n############ Later ##########~n",[]),
+ ?option_time(perform_later(Keys,XsiGraph),"RTL A-SSAPRE WillBeAvailable - Compute Later",Options).
+
+perform_can_be_available([],_XsiGraph,_CFGGraph) -> ok;
+perform_can_be_available([Key|Keys],XsiGraph,CFGGraph) ->
+ {V,Xsi} = ?GRAPH:vertex(XsiGraph,Key),
+ case Xsi#xsi.cba of
+ undefined ->
+ {_VV,Block} = ?GRAPH:vertex(CFGGraph,Xsi#xsi.label),
+ Att = Block#block.attributes,
+ NDS = Att#mp.ndsSet,
+ OpList = ?SETS:from_list(xsi_oplist(Xsi)),
+ Set = ?SETS:intersection(NDS,OpList),
+ case ?SETS:size(Set) of
+ 0 ->
+ ?GRAPH:add_vertex(XsiGraph, V, Xsi#xsi{cba = true}),
+ perform_can_be_available(Keys, XsiGraph, CFGGraph);
+ _ ->
+ LIST = [X || #temp{key=X} <- ?SETS:to_list(Set)],
+ case LIST of
+ [] ->
+ ?GRAPH:add_vertex(XsiGraph, V, Xsi#xsi{cba = false}),
+ ImmediateParents = ?GRAPH:in_neighbours(XsiGraph, Key),
+ propagate_cba(ImmediateParents,XsiGraph,Xsi#xsi.def,CFGGraph);
+ _ ->
+ ok
+ end,
+ perform_can_be_available(Keys, XsiGraph, CFGGraph)
+ end;
+ _ -> %% True or False => recurse
+ perform_can_be_available(Keys, XsiGraph, CFGGraph)
+ end.
+
+propagate_cba([],_XG,_Def,_CFGG) -> ok;
+propagate_cba([IPX|IPXs],XsiGraph,XsiDef,CFGGraph) ->
+ {V,IPXsi} = ?GRAPH:vertex(XsiGraph,IPX),
+ {_VV,Block} = ?GRAPH:vertex(CFGGraph,IPXsi#xsi.label),
+ Att = Block#block.attributes,
+ NDS = Att#mp.ndsSet,
+ List = ?SETS:to_list(?SETS:intersection(NDS,?SETS:from_list(xsi_oplist(IPXsi)))),
+ case IPXsi#xsi.cba of
+ false -> ok;
+ _ ->
+ case lists:keymember(XsiDef, #xsi_op.op, List) of
+ true ->
+ ?GRAPH:add_vertex(XsiGraph, V, IPXsi#xsi{cba = false}),
+ ImmediateParents = ?GRAPH:in_neighbours(XsiGraph, IPX),
+ propagate_cba(ImmediateParents,XsiGraph,IPXsi#xsi.def,CFGGraph);
+ _ ->
+ ok
+ end
+ end,
+ propagate_cba(IPXs,XsiGraph,XsiDef,CFGGraph).
+
+perform_later([], _XsiGraph) -> ok;
+perform_later([Key|Keys], XsiGraph) ->
+ {V, Xsi} = ?GRAPH:vertex(XsiGraph, Key),
+ %% ?pp_debug("~n DEBUG : inspecting later of ~w (~w)~n",[Key,Xsi#xsi.later]),
+ case Xsi#xsi.later of
+ undefined ->
+ OpList = xsi_oplist(Xsi),
+ case parse_ops(OpList,fangpi) of %% It means "fart" in chinese :D
+ has_temp ->
+ perform_later(Keys,XsiGraph);
+ has_real ->
+ case Xsi#xsi.cba of
+ true ->
+ ?GRAPH:add_vertex(XsiGraph,V,Xsi#xsi{later=false,wba=true});
+ undefined ->
+ ?GRAPH:add_vertex(XsiGraph,V,Xsi#xsi{later=false,wba=true});
+ _ ->
+ ?GRAPH:add_vertex(XsiGraph,V,Xsi#xsi{later=false,wba=false})
+ end,
+ AllParents = digraph_utils:reaching([Key], XsiGraph),
+ ?pp_debug("~nPropagating to all parents of t~w: ~w",[Key,AllParents]),
+ propagate_later(AllParents,XsiGraph),
+ perform_later(Keys,XsiGraph);
+ _ -> %% Just contains bottoms and/or expressions
+ ?GRAPH:add_vertex(XsiGraph,V,Xsi#xsi{later=true}),
+ perform_later(Keys,XsiGraph)
+ end;
+ _ -> %% True or False => recurse
+ perform_later(Keys,XsiGraph)
+ end.
+
+propagate_later([], _XG) -> ok;
+propagate_later([IPX|IPXs], XsiGraph) ->
+ {V,IPXsi} = ?GRAPH:vertex(XsiGraph,IPX),
+ case IPXsi#xsi.later of
+ false ->
+ ?pp_debug("~nThrough propagation, later of t~w is already reset",[IPX]),
+ propagate_later(IPXs,XsiGraph);
+ _ ->
+ ?pp_debug("~nThrough propagation, resetting later of t~w",[IPX]),
+ case IPXsi#xsi.cba of
+ true ->
+ ?GRAPH:add_vertex(XsiGraph,V,IPXsi#xsi{later=false,wba=true});
+ undefined ->
+ ?GRAPH:add_vertex(XsiGraph,V,IPXsi#xsi{later=false,wba=true});
+ _ ->
+ ?GRAPH:add_vertex(XsiGraph,V,IPXsi#xsi{later=false,wba=false})
+ end,
+ propagate_later(IPXs,XsiGraph)
+ end.
+
+parse_ops([], Res) ->
+ Res;
+parse_ops([Op|Ops], Res) ->
+ case Op#xsi_op.op of
+ #temp{} ->
+ NewRes = has_temp,
+ parse_ops(Ops,NewRes);
+ #bottom{} ->
+ parse_ops(Ops,Res);
+ #eop{} ->
+ parse_ops(Ops,Res);
+ _ ->
+ has_real
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CODE MOTION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+perform_code_motion([], Cfg, _XsiG) ->
+ Cfg;
+perform_code_motion([L|Labels], Cfg, XsiG) ->
+ Code=?BB:code(?CFG:bb(Cfg,L)),
+ ?pp_debug("~n################ Code Motion in L~w~n",[L]),
+ ?pp_debug("~nCode to move ~n",[]),
+ pp_instrs(Code,XsiG),
+ NewCfg = code_motion_in_block(L,Code,Cfg,XsiG,[],gb_trees:empty()),
+ ?pp_debug("~n################ Code Motion successful in L~w~n",[L]),
+ perform_code_motion(Labels,NewCfg,XsiG).
+
+code_motion_in_block(Label,[],Cfg,_XsiG,Visited,InsertionsAcc) ->
+ InsertionsAlong = gb_trees:keys(InsertionsAcc),
+ Code = lists:reverse(Visited),
+ NewBB = ?BB:mk_bb(Code),
+ Cfg2 = ?CFG:bb_add(Cfg,Label,NewBB),
+ %% Must come after the bb_add, since redirect will update the Phis too...
+ Cfg3 = make_insertions(Label,InsertionsAlong,InsertionsAcc,Cfg2),
+ %% ?pp_debug("~nChecking the Code at L~w:~n~p",[Label,?BB:code(?CFG:bb(Cfg3,Label))]),
+ Cfg3;
+code_motion_in_block(L,[Inst|Insts],Cfg,XsiG,Visited,InsertionsAcc) ->
+ ?pp_debug("~nInspecting Inst : ~n",[]),pp_instr(Inst,XsiG),
+ case Inst of
+ #pre_candidate{} ->
+ Def = Inst#pre_candidate.def,
+ Alu = Inst#pre_candidate.alu,
+ case Def of
+ bottom ->
+ InstToAdd = Alu;
+ #temp{} ->
+ Key = Def#temp.key,
+ {_V,Xsi} = ?GRAPH:vertex(XsiG,Key),
+ case Xsi#xsi.wba of
+ true ->
+ %% Turn into a move
+ Dst = ?RTL:alu_dst(Alu),
+ Move = ?RTL:mk_move(Dst,Def#temp.var),
+ pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil),
+ %% Counting redundancies
+ redundancy_add(),
+ InstToAdd = Move;
+ _ ->
+ InstToAdd = Alu
+ end;
+ _ -> %% Def is a real variable
+ %% Turn into a move
+ Dst = ?RTL:alu_dst(Alu),
+ Move = ?RTL:mk_move(Dst,Def),
+ pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil),
+ %% Counting redundancies
+ redundancy_add(),
+ InstToAdd = Move
+ end,
+ code_motion_in_block(L,Insts,Cfg,XsiG,[InstToAdd|Visited],InsertionsAcc);
+ #xsi_link{} ->
+ Key = Inst#xsi_link.num,
+ {_V,Xsi} = ?GRAPH:vertex(XsiG,Key),
+ case Xsi#xsi.wba of
+ true ->
+ %% Xsi is a WBA, it might trigger insertions
+ OpList = xsi_oplist(Xsi),
+ ?pp_debug(" This Xsi is a 'Will be available'",[]),
+ %% Cleaning the instruction
+ Expr = prepare_inst(Xsi#xsi.inst),
+ {NewOpList,NewInsertionsAcc} = get_insertions(OpList,[],InsertionsAcc,Visited,Expr,XsiG),
+ %% Making Xsi a Phi with Oplist
+ PhiOpList = [{Pred,Var} || #xsi_op{pred=Pred,op=Var} <- NewOpList],
+ Def = Xsi#xsi.def,
+ Phi = ?RTL:phi_arglist_update(?RTL:mk_phi(Def#temp.var),PhiOpList),
+ ?pp_debug("~n Xsi is turned into Phi : ~w",[Phi]),
+ code_motion_in_block(L,Insts,Cfg,XsiG,[Phi|Visited],NewInsertionsAcc);
+ _ ->
+ ?pp_debug(" This Xsi is not a 'Will be available'",[]),
+ code_motion_in_block(L,Insts,Cfg,XsiG,Visited,InsertionsAcc)
+ end;
+%% phi ->
+%% code_motion_in_block(L,Insts,Cfg,XsiG,[Inst|Visited],InsertionsAcc);
+ _ ->
+ %% Other instructions.... Phis too
+ code_motion_in_block(L,Insts,Cfg,XsiG,[Inst|Visited],InsertionsAcc)
+ end.
+
+prepare_inst(Expr) ->
+ S1 = ?RTL:alu_src1(Expr),
+ S2 = ?RTL:alu_src2(Expr),
+ NewInst = case S1 of
+ #temp{} -> ?RTL:alu_src1_update(Expr,S1#temp.var);
+ _ -> Expr
+ end,
+ case S2 of
+ #temp{} -> ?RTL:alu_src2_update(NewInst,S2#temp.var);
+ _ -> NewInst
+ end.
+
+get_insertions([],OpAcc,InsertionsAcc,_Visited,_Expr,_XsiG) ->
+ {OpAcc,InsertionsAcc};
+get_insertions([XsiOp|Ops],OpAcc,InsertionsAcc,Visited,Expr,XsiG) ->
+ Pred = XsiOp#xsi_op.pred,
+ Op = XsiOp#xsi_op.op,
+ case Op of
+ #bottom{} ->
+ case gb_trees:lookup(Pred,InsertionsAcc) of
+ {value,Insertion} ->
+ From = Insertion#insertion.from,
+ case lists:keyfind(Op, 1, From) of
+ false ->
+ ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op),
+ Dst = Op#bottom.var,
+ Expr2 = ?RTL:alu_dst_update(Expr,Dst),
+ Inst = manufacture_computation(Pred,Expr2,Visited),
+ Code = Insertion#insertion.code,
+ NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]},
+ NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc);
+ {_, Val} ->
+ ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op),
+ Dst = Val,
+ NewInsertionsAcc = InsertionsAcc
+ end;
+ none ->
+ ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op),
+ Dst = Op#bottom.var,
+ Expr2 = ?RTL:alu_dst_update(Expr,Dst),
+ Inst = manufacture_computation(Pred,Expr2,Visited),
+ NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]},
+ NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc)
+ end;
+ #const_expr{} ->
+ case gb_trees:lookup(Pred,InsertionsAcc) of
+ {value,Insertion} ->
+ From = Insertion#insertion.from,
+ case lists:keyfind(Op, 1, From) of
+ false ->
+ ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op),
+ Dst = Op#const_expr.var,
+ Val = Op#const_expr.value,
+ Inst = ?RTL:mk_move(Dst,Val),
+ Code = Insertion#insertion.code,
+ NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]},
+ NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc);
+ {_, Val} ->
+ ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op),
+ Dst = Val,
+ NewInsertionsAcc = InsertionsAcc
+ end;
+ none ->
+ ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op),
+ Dst = Op#const_expr.var,
+ Val = Op#const_expr.value,
+ Inst = ?RTL:mk_move(Dst,Val),
+ NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]},
+ NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc)
+ end;
+ #eop{} ->
+ %% We treat expressions like bottoms
+ %% The value must be recomputed, and therefore not available...
+ case gb_trees:lookup(Pred,InsertionsAcc) of
+ {value,Insertion} ->
+ From = Insertion#insertion.from,
+ case lists:keyfind(Op, 1, From) of
+ false ->
+ ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op),
+ Dst = Op#eop.var,
+ Expr2 = ?RTL:alu_dst_update(Expr,Dst),
+ Inst = manufacture_computation(Pred,Expr2,Visited),
+ Code = Insertion#insertion.code,
+ NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]},
+ NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc);
+ {_, Val} ->
+ ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op),
+ Dst = Val,
+ NewInsertionsAcc = InsertionsAcc
+ end;
+ none ->
+ ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op),
+ Dst = Op#eop.var,
+ Expr2 = ?RTL:alu_dst_update(Expr,Dst),
+ Inst = manufacture_computation(Pred,Expr2,Visited),
+ NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]},
+ NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc)
+ end;
+ #temp{} ->
+ case gb_trees:lookup(Pred,InsertionsAcc) of
+ {value,Insertion} ->
+ From = Insertion#insertion.from,
+ case lists:keyfind(Op, 1, From) of
+ false ->
+ ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op),
+ Key = Op#temp.key,
+ {_V,Xsi} = ?GRAPH:vertex(XsiG,Key),
+ case Xsi#xsi.wba of
+ true ->
+ ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]),
+ Dst = Op#temp.var,
+ NewInsertionsAcc = InsertionsAcc;
+ _ ->
+ ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]),
+ Dst = ?RTL:mk_new_var(),
+ Expr2 = ?RTL:alu_dst_update(Expr,Dst),
+ Inst = manufacture_computation(Pred,Expr2,Visited),
+ Code = Insertion#insertion.code,
+ NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]},
+ NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc)
+ end;
+ {_, Val} ->
+ ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]),
+ ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]),
+ Dst = Val,
+ NewInsertionsAcc = InsertionsAcc
+ end;
+ none ->
+ ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op),
+ Key = Op#temp.key,
+ {_V,Xsi} = ?GRAPH:vertex(XsiG,Key),
+ case Xsi#xsi.wba of
+ true ->
+ ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]),
+ Dst = Op#temp.var,
+ NewInsertionsAcc = InsertionsAcc;
+ _ ->
+ ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]),
+ Dst = ?RTL:mk_new_var(),
+ Expr2 = ?RTL:alu_dst_update(Expr,Dst),
+ Inst = manufacture_computation(Pred,Expr2,Visited),
+ NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]},
+ NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc)
+ end
+ end;
+ _ ->
+ ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]),
+ Dst = Op,
+ NewInsertionsAcc = InsertionsAcc
+ end,
+ NewXsiOp = XsiOp#xsi_op{op=Dst},
+ get_insertions(Ops, [NewXsiOp|OpAcc], NewInsertionsAcc, Visited, Expr, XsiG).
+
+manufacture_computation(_Pred, Expr, []) ->
+ ?pp_debug("~n Manufactured computation : ~w", [Expr]),
+ Expr;
+manufacture_computation(Pred, Expr, [I|Rest]) ->
+ %% ?pp_debug("~n Expr = ~w",[Expr]),
+ SRC1 = ?RTL:alu_src1(Expr),
+ SRC2 = ?RTL:alu_src2(Expr),
+ case I of
+ #xsi_link{} ->
+ exit({?MODULE,should_not_be_a_xsi_link,{"Why the hell do we still have a xsi link???",I}});
+ #xsi{} ->
+ exit({?MODULE,should_not_be_a_xsi,{"Why the hell do we still have a xsi ???",I}});
+ #phi{} ->
+ DST = ?RTL:phi_dst(I),
+ Arg = ?RTL:phi_arg(I,Pred),
+ NewInst = case DST =:= SRC1 of
+ true -> ?RTL:alu_src1_update(Expr,Arg);
+ false -> Expr
+ end,
+ NewExpr = case DST =:= SRC2 of
+ true -> ?RTL:alu_src2_update(NewInst,Arg);
+ false -> NewInst
+ end,
+ manufacture_computation(Pred,NewExpr,Rest)
+ end.
+
+make_insertions(_L, [], _ITree, Cfg) ->
+ Cfg;
+make_insertions(L, [OldPred|Is], ITree, Cfg) ->
+ NewPred = ?RTL:label_name(?RTL:mk_new_label()),
+ I = gb_trees:get(OldPred, ITree),
+ CodeToInsert = lists:reverse([?RTL:mk_goto(L)|I#insertion.code]),
+ BBToInsert = ?BB:mk_bb(CodeToInsert),
+ NewCfg = ?CFG:bb_insert_between(Cfg, NewPred, BBToInsert, OldPred, L),
+ make_insertions(L, Is, ITree, NewCfg).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%% XSI INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+xsi_oplist(#xsi{opList=OpList}) ->
+ case OpList of undefined -> [] ; _ -> OpList end.
+xsi_arg(Xsi, Pred) ->
+ case lists:keyfind(Pred, #xsi_op.pred, xsi_oplist(Xsi)) of
+ false ->
+ undetermined_operand;
+ R ->
+ R#xsi_op.op
+ end.
+xsi_arg_update(Xsi, Pred, Op) ->
+ NewOpList = lists:keyreplace(Pred, #xsi_op.pred, xsi_oplist(Xsi),
+ #xsi_op{pred=Pred,op=Op}),
+ Xsi#xsi{opList=NewOpList}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PRETTY-PRINTING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-ifndef(SSAPRE_DEBUG).
+
+%%pp_cfg(Cfg,_) -> ?CFG:pp(Cfg).
+pp_cfg(_,_) -> ok.
+pp_instr(_,_) -> ok.
+pp_instrs(_,_) -> ok.
+pp_expr(_) -> ok.
+pp_xsi(_) -> ok.
+pp_arg(_) -> ok.
+pp_xsigraph(_) -> ok.
+pp_cfggraph(_) -> ok.
+%% pp_xsigraph(G) ->
+%% Vertices = lists:sort(?GRAPH:vertices(G)),
+%% io:format(standard_io, "Size of the Xsi Graph: ~w", [length(Vertices)]).
+%% pp_cfggraph(G) ->
+%% Vertices = lists:sort(?GRAPH:vertices(G)),
+%% io:format(standard_io, "Size of the CFG Graph: ~w", [length(Vertices)]).
+
+-else.
+
+pp_cfg(Cfg, Graph) ->
+ Labels = ?CFG:preorder(Cfg),
+ pp_blocks(Labels, Cfg, Graph).
+
+pp_blocks([], _, _) ->
+ ok;
+pp_blocks([L|Ls], Cfg, Graph) ->
+ Code = hipe_bb:code(?CFG:bb(Cfg,L)),
+ io:format(standard_io,"~n########## Label L~w~n", [L]),
+ pp_instrs(Code, Graph),
+ pp_blocks(Ls, Cfg, Graph).
+
+pp_instrs([], _) ->
+ ok;
+pp_instrs([I|Is], Graph) ->
+ pp_instr(I, Graph),
+ pp_instrs(Is, Graph).
+
+pp_xsi_link(Key, Graph) ->
+ {_Key,Xsi} = ?GRAPH:vertex(Graph, Key),
+ pp_xsi(Xsi).
+
+pp_xsi(Xsi) ->
+ io:format(standard_io, " [L~w] ", [Xsi#xsi.label]),
+ io:format(standard_io, "[", []), pp_expr(Xsi#xsi.inst),
+ io:format(standard_io, "] Xsi(", []), pp_xsi_args(xsi_oplist(Xsi)),
+ io:format(standard_io, ") (", []), pp_xsi_def(Xsi#xsi.def),
+ io:format(standard_io, ") cba=~w, later=~w | wba=~w~n", [Xsi#xsi.cba,Xsi#xsi.later,Xsi#xsi.wba]).
+
+pp_instr(I, Graph) ->
+ case I of
+ #alu{} ->
+ io:format(standard_io, " ", []),
+ pp_arg(?RTL:alu_dst(I)),
+ io:format(standard_io, " <- ", []),
+ pp_expr(I),
+ io:format(standard_io, "~n", []);
+ _ ->
+ try ?RTL:pp_instr(standard_io, I)
+ catch _:_ ->
+ case I of
+ #pre_candidate{} ->
+ pp_pre(I);
+ #xsi{} ->
+ pp_xsi(I);
+ #xsi_link{} ->
+ pp_xsi_link(I#xsi_link.num, Graph);
+ _->
+ io:format(standard_io,"*** ~w ***~n", [I])
+ end
+ end
+ end.
+
+pp_pre(I) ->
+ A = I#pre_candidate.alu,
+ io:format(standard_io, " ", []),
+ pp_arg(?RTL:alu_dst(A)),
+ io:format(standard_io, " <- ", []),pp_expr(A),
+ io:format(standard_io, " [ ", []),pp_arg(I#pre_candidate.def),
+ %%io:format(standard_io, "~w", [I#pre_candidate.def]),
+ io:format(standard_io, " ]~n",[]).
+
+pp_expr(I) ->
+ pp_arg(?RTL:alu_dst(I)),
+ io:format(standard_io, " <- ", []),
+ pp_arg(?RTL:alu_src1(I)),
+ io:format(standard_io, " ~w ", [?RTL:alu_op(I)]),
+ pp_arg(?RTL:alu_src2(I)).
+
+pp_arg(Arg) ->
+ case Arg of
+ bottom ->
+ io:format(standard_io, "_|_", []);
+ #bottom{} ->
+ io:format(standard_io, "_|_:~w (", [Arg#bottom.key]),pp_arg(Arg#bottom.var),io:format(standard_io,")",[]);
+ #temp{} ->
+ pp_xsi_def(Arg);
+ #eop{} ->
+ io:format(standard_io,"#",[]),pp_expr(Arg#eop.expr),io:format(standard_io,"(",[]),pp_arg(Arg#eop.var),io:format(standard_io,")#",[]);
+ #const_expr{} ->
+ io:format(standard_io,"*",[]),pp_arg(Arg#const_expr.var),io:format(standard_io," -> ",[]),pp_arg(Arg#const_expr.value),io:format(standard_io,"*",[]);
+ undefined ->
+ io:format(standard_io, "...", []); %%"undefined", []);
+ _->
+ case Arg of
+ #alu{} ->
+ pp_expr(Arg);
+ _->
+ ?RTL:pp_arg(standard_io, Arg)
+ end
+ end.
+
+pp_args([]) ->
+ ok;
+pp_args(undefined) ->
+ io:format(standard_io, "...,...,...", []);
+pp_args([A]) ->
+ pp_arg(A);
+pp_args([A|As]) ->
+ pp_arg(A),
+ io:format(standard_io, ", ", []),
+ pp_args(As).
+
+pp_xsi_args([]) -> ok;
+pp_xsi_args([XsiOp]) ->
+ io:format(standard_io, "{~w| ", [XsiOp#xsi_op.pred]),
+ pp_arg(XsiOp#xsi_op.op),
+ io:format(standard_io, "}", []);
+pp_xsi_args([XsiOp|Args]) ->
+ io:format(standard_io, "{~w| ", [XsiOp#xsi_op.pred]),
+ pp_arg(XsiOp#xsi_op.op),
+ io:format(standard_io, "}, ", []),
+ pp_xsi_args(Args);
+pp_xsi_args(Args) ->
+ pp_args(Args).
+
+pp_xsi_def(Arg) ->
+ D = Arg#temp.key,
+ V = Arg#temp.var,
+ io:format(standard_io, "t~w (", [D]),pp_arg(V),io:format(standard_io,")",[]).
+
+pp_cfggraph(G) ->
+ Vertices = lists:sort(?GRAPH:vertices(G)),
+ io:format(standard_io, "Size of the CFG Graph: ~w ~n", [length(Vertices)]),
+ pp_cfgvertex(Vertices, G).
+
+pp_xsigraph(G) ->
+ Vertices = lists:sort(?GRAPH:vertices(G)),
+ io:format(standard_io, "Size of the Xsi Graph: ~w ~n", [length(Vertices)]),
+ pp_xsivertex(Vertices,G).
+
+pp_xsivertex([], _G) ->
+ ok;
+pp_xsivertex([Key|Keys], G) ->
+ {V,Xsi} = ?GRAPH:vertex(G, Key),
+ OutNeighbours = ?GRAPH:out_neighbours(G, V),
+ ?pp_debug(" ~w -> ~w", [V,OutNeighbours]), pp_xsi(Xsi),
+ pp_xsivertex(Keys, G).
+
+pp_cfgvertex([], _G) ->
+ ok;
+pp_cfgvertex([Key|Keys], G) ->
+ {V,Block} = ?GRAPH:vertex(G,Key),
+ case Block#block.type of
+ mp ->
+ ?pp_debug("~n Block ~w's attributes: ~n", [V]),
+ pp_attributes(Block),
+ ?pp_debug("~n Block ~w's edges: ~n", [V]),
+ pp_edges(G, ?GRAPH:in_edges(G,Key), ?GRAPH:out_edges(G,Key));
+ _->
+ ok
+ end,
+ pp_cfgvertex(Keys, G).
+
+pp_attributes(Block) ->
+ Att = Block#block.attributes,
+ case Att of
+ undefined ->
+ ok;
+ _ ->
+ ?pp_debug(" Maps: ~n",[]),pp_maps(gb_trees:keys(Att#mp.maps),Att#mp.maps),
+ ?pp_debug(" Uses: ~n",[]),pp_uses(gb_trees:keys(Att#mp.uses),Att#mp.uses),
+ ?pp_debug(" Defs: ~w~n",[Att#mp.defs]),
+ ?pp_debug(" Xsis: ~w~n",[Att#mp.xsis]),
+ ?pp_debug(" NDS : ",[]),pp_nds(?SETS:to_list(Att#mp.ndsSet))
+ end.
+
+pp_maps([], _Maps) -> ok;
+pp_maps([K|Ks], Maps) ->
+ ?pp_debug(" ",[]),pp_arg(K#xsi_op.op),?pp_debug("-> ~w~n",[?SETS:to_list(gb_trees:get(K,Maps))]),
+ pp_maps(Ks, Maps).
+
+pp_uses([], _Maps) -> ok;
+pp_uses([K|Ks], Maps) ->
+ ?pp_debug(" ~w -> ~w~n",[K,?SETS:to_list(gb_trees:get(K,Maps))]),
+ pp_uses(Ks, Maps).
+
+pp_nds([]) -> ?pp_debug("~n",[]);
+pp_nds(undefined) -> ?pp_debug("None",[]);
+pp_nds([K]) ->
+ pp_arg(K#xsi_op.op), ?pp_debug("~n",[]);
+pp_nds([K|Ks]) ->
+ pp_arg(K#xsi_op.op), ?pp_debug(", ",[]),
+ pp_nds(Ks).
+
+pp_edges(_G, [], []) -> ok;
+pp_edges(G, [], [OUT|OUTs]) ->
+ {_E,V1,V2,Label} = ?GRAPH:edge(G,OUT),
+ ?pp_debug(" Out edge ~w -> ~w (~w)~n", [V1,V2,?SETS:to_list(Label)]),
+ pp_edges(G, [], OUTs);
+pp_edges(G, [IN|INs], Outs) ->
+ {_E,V1,V2,Label} = ?GRAPH:edge(G,IN),
+ ?pp_debug(" In edge ~w -> ~w (~w)~n", [V1,V2,?SETS:to_list(Label)]),
+ pp_edges(G, INs, Outs).
+
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% COUNTERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init_counters() ->
+ put({ssapre_temp,temp_count}, 0),
+ put({ssapre_index,index_count}, 0).
+
+new_bottom() ->
+ IndxCountPair = {ssapre_index, index_count},
+ V = get(IndxCountPair),
+ put(IndxCountPair, V+1),
+ #bottom{key = V, var = ?RTL:mk_new_var()}.
+
+new_temp() ->
+ TmpCountPair = {ssapre_temp, temp_count},
+ V = get(TmpCountPair),
+ put(TmpCountPair, V+1),
+ #temp{key = V, var = ?RTL:mk_new_var()}.
+
+init_redundancy_count() ->
+ put({ssapre_redundancy,redundancy_count}, 0).
+
+redundancy_add() ->
+ RedCountPair = {ssapre_redundancy, redundancy_count},
+ V = get(RedCountPair),
+ put(RedCountPair, V+1).
+
+-ifdef(SSAPRE_DEBUG).
+get_redundancy_count() ->
+ get({ssapre_redundancy,redundancy_count}).
+-endif.
diff --git a/lib/hipe/rtl/hipe_rtl_symbolic.erl b/lib/hipe/rtl/hipe_rtl_symbolic.erl
new file mode 100644
index 0000000000..bc8640dec9
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_symbolic.erl
@@ -0,0 +1,99 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-------------------------------------------------------------------
+%% File : hipe_rtl_symbolic.erl
+%% Author : Per Gustafsson <pergu@it.uu.se>
+%% Description : Expansion of symbolic instructions.
+%%
+%% Created : 18 May 2004 by Per Gustafsson <pergu@it.uu.se>
+%%-------------------------------------------------------------------
+
+-module(hipe_rtl_symbolic).
+
+-export([expand/1]).
+
+-include("hipe_rtl.hrl").
+-include("hipe_literals.hrl").
+-include("../icode/hipe_icode_primops.hrl").
+
+expand(Cfg) ->
+ Linear = hipe_rtl_cfg:linearize(Cfg),
+ Code = hipe_rtl:rtl_code(Linear),
+ NonFlatCode = [expand_instr(Instr) || Instr <- Code],
+ NewCode = lists:flatten(NonFlatCode),
+ Linear1 = hipe_rtl:rtl_code_update(Linear, NewCode),
+ hipe_rtl_cfg:init(Linear1).
+
+expand_instr(Instr) ->
+ case Instr of
+ #fixnumop{} ->
+ expand_fixnumop(Instr);
+ #gctest{} ->
+ expand_gctest(Instr);
+ _ ->
+ Instr
+ end.
+
+expand_fixnumop(Instr) ->
+ case hipe_rtl:fixnumop_type(Instr) of
+ untag ->
+ Dst = hipe_rtl:fixnumop_dst(Instr),
+ Src = hipe_rtl:fixnumop_src(Instr),
+ hipe_tagscheme:realuntag_fixnum(Dst, Src);
+ tag ->
+ Dst = hipe_rtl:fixnumop_dst(Instr),
+ Src = hipe_rtl:fixnumop_src(Instr),
+ hipe_tagscheme:realtag_fixnum(Dst, Src)
+ end.
+
+expand_gctest(Instr) ->
+ HeapNeed = hipe_rtl:gctest_words(Instr),
+ {GetHPInsn, HP, _PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ {GetHLIMITInsn, H_LIMIT} = hipe_rtl_arch:heap_limit(),
+ ContLabel = hipe_rtl:mk_new_label(),
+ GCLabel = hipe_rtl:mk_new_label(),
+ ContLabelName = hipe_rtl:label_name(ContLabel),
+ GCLabelName = hipe_rtl:label_name(GCLabel),
+ Tmp = hipe_rtl:mk_new_reg(), % diff between two gc-unsafe pointers
+ StartCode =
+ [GetHPInsn,
+ GetHLIMITInsn,
+ hipe_rtl:mk_alu(Tmp, H_LIMIT, 'sub', HP)],
+ {SeparateCode, GCAmount, HPAmount} =
+ case hipe_rtl:is_reg(HeapNeed) of
+ true ->
+ GA = hipe_rtl:mk_new_reg_gcsafe(),
+ HA = hipe_rtl:mk_new_reg_gcsafe(),
+ {[hipe_rtl:mk_alu(HA, HeapNeed, sll,
+ hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size()))|
+ hipe_tagscheme:realtag_fixnum(GA, HeapNeed)], GA, HA};
+ false ->
+ WordsNeeded = hipe_rtl:imm_value(HeapNeed),
+ GA = hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(WordsNeeded)),
+ HA = hipe_rtl:mk_imm(WordsNeeded*hipe_rtl_arch:word_size()),
+ {[], GA, HA}
+ end,
+ EndCode =
+ [hipe_rtl:mk_branch(Tmp, 'lt', HPAmount, GCLabelName, ContLabelName, 0.01),
+ GCLabel,
+ hipe_rtl:mk_call([], 'gc_1', [GCAmount], ContLabelName, [], not_remote),
+ ContLabel],
+ StartCode ++ SeparateCode ++ EndCode.
+
diff --git a/lib/hipe/rtl/hipe_rtl_varmap.erl b/lib/hipe/rtl/hipe_rtl_varmap.erl
new file mode 100644
index 0000000000..9bd5e88611
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_varmap.erl
@@ -0,0 +1,161 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% Time-stamp: <2008-04-20 14:55:35 richard>
+%% ====================================================================
+%% Module : hipe_rtl_varmap
+%% Purpose :
+%% Notes :
+%% History : * 2001-04-10 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_rtl_varmap).
+
+-export([init/1,
+ ivs2rvs/2,
+ icode_var2rtl_var/2,
+ icode_label2rtl_label/2]).
+
+%-------------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+-include("../icode/hipe_icode.hrl").
+
+%-------------------------------------------------------------------------
+
+%% @spec init(IcodeRecord::#icode{}) -> {Args, VarMap}
+%%
+%% @doc Initializes gensym for RTL.
+
+-spec init(#icode{}) -> {[_], _}. % XXX: fix me please
+
+init(IcodeRecord) ->
+ hipe_gensym:init(rtl),
+ hipe_gensym:set_var(rtl, hipe_rtl_arch:first_virtual_reg()),
+ hipe_gensym:set_label(rtl, 0),
+ VarMap = new_var_map(),
+ {_Args, _VarMap1} = ivs2rvs(hipe_icode:icode_params(IcodeRecord), VarMap).
+
+
+%%------------------------------------------------------------------------
+%%
+%% Mapping of labels and variables from Icode to RTL.
+%%
+%%------------------------------------------------------------------------
+
+
+%% @spec icode_label2rtl_label(Icode_Label::term(), LabelMap::term()) ->
+%% {RTL_Label, NewLabelMap}
+%%
+%% @doc Converts an Icode label to an RTL label.
+
+icode_label2rtl_label(LabelName, Map) ->
+ case lookup(LabelName, Map) of
+ {value, NewLabel} ->
+ {NewLabel, Map};
+ none ->
+ NewLabel = hipe_rtl:mk_new_label(),
+ {NewLabel, insert(LabelName, NewLabel, Map)}
+ end.
+
+
+%% @spec ivs2rvs(Icode_Vars::[term()], VarMap::term()) -> {[RTL_Var],NewVarMap}
+%%
+%% @doc Converts a list of Icode variables to a list of RTL variables.
+
+ivs2rvs([], VarMap) ->
+ {[], VarMap};
+ivs2rvs([V|Vs], VarMap) ->
+ {NewV, VarMap0} = icode_var2rtl_var(V, VarMap),
+ {NewVs, VarMap1} = ivs2rvs(Vs, VarMap0),
+ {[NewV|NewVs], VarMap1}.
+
+
+%% @spec icode_var2rtl_var(Icode_Var::term(), VarMap::term()) ->
+%% {RTL_Var, NewVarMap}
+%%
+%% @doc Converts an Icode variable to an RTL variable.
+
+icode_var2rtl_var(Var, Map) ->
+ Value = lookup(Var, Map),
+ case Value of
+ none ->
+ case type_of_var(Var) of
+ fvar ->
+ NewVar = hipe_rtl:mk_new_fpreg(),
+ {NewVar, insert(Var, NewVar, Map)};
+ var ->
+ NewVar = hipe_rtl:mk_new_var(),
+ {NewVar, insert(Var, NewVar, Map)};
+ {reg, IsGcSafe} ->
+ NewVar =
+ case IsGcSafe of
+ %% true -> hipe_rtl:mk_new_reg_gcsafe();
+ false -> hipe_rtl:mk_new_reg()
+ end,
+ {NewVar, insert(Var, NewVar, Map)}
+ end;
+ {value, NewVar} ->
+ {NewVar, Map}
+ end.
+
+%%
+%% Simple type test
+%%
+
+type_of_var(X) ->
+ case hipe_icode:is_fvar(X) of
+ true ->
+ fvar;
+ false ->
+ case hipe_icode:is_var(X) of
+ true ->
+ var;
+ false ->
+ case hipe_icode:is_reg(X) of
+ true ->
+ {reg, hipe_icode:reg_is_gcsafe(X)};
+ false ->
+ %% Sanity check
+ case hipe_icode:is_const(X) of
+ true -> const;
+ false ->
+ exit({"Unknown Icode variable", X})
+ end
+ end
+ end
+ end.
+
+%%
+%% Helping utilities
+%%
+
+new_var_map() ->
+ gb_trees:empty().
+
+lookup(V, Map) ->
+ gb_trees:lookup(V, Map).
+
+insert(Key, Val, Map) ->
+ gb_trees:insert(Key, Val, Map).
diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl
new file mode 100644
index 0000000000..dc44b803a1
--- /dev/null
+++ b/lib/hipe/rtl/hipe_tagscheme.erl
@@ -0,0 +1,1209 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%========================================================================
+%%
+%% Filename : hipe_tagscheme.erl
+%% Note : This is specific to Erlang 5.* (i.e. R9 to R13).
+%%
+%% Modifications:
+%% 020904: Happi - added support for external pids and ports.
+%%
+%%========================================================================
+%% $Id$
+%%========================================================================
+
+-module(hipe_tagscheme).
+
+-export([mk_nil/0, mk_fixnum/1, mk_arityval/1, mk_non_value/0]).
+-export([is_fixnum/1]).
+-export([tag_tuple/2, tag_cons/2]).
+-export([test_is_boxed/4, get_header/2]).
+-export([test_nil/4, test_cons/4, test_flonum/4, test_fixnum/4,
+ test_tuple/4, test_atom/4, test_bignum/4, test_pos_bignum/4,
+ test_any_pid/4, test_any_port/4,
+ test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4,
+ test_binary/4, test_bitstr/4, test_list/4,
+ test_integer/4, test_number/4, test_constant/4, test_tuple_N/5]).
+-export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]).
+-export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3,
+ unsafe_fixnum_sub/3,
+ fixnum_gt/5, fixnum_lt/5, fixnum_ge/5, fixnum_le/5, fixnum_val/1,
+ fixnum_mul/4,
+ fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2,
+ fixnum_bsr/3, fixnum_bsl/3]).
+-export([unsafe_car/2, unsafe_cdr/2,
+ unsafe_constant_element/3, unsafe_update_element/3, element/6]).
+-export([unsafe_closure_element/3]).
+-export([mk_fun_header/0, tag_fun/2]).
+-export([unsafe_untag_float/2, unsafe_tag_float/2]).
+-export([mk_sub_binary/6,mk_sub_binary/7]).
+-export([unsafe_mk_big/3, unsafe_load_float/3]).
+-export([bignum_sizeneed/1,bignum_sizeneed_code/2, get_one_word_pos_bignum/3]).
+-export([test_subbinary/3, test_heap_binary/3]).
+-export([create_heap_binary/3, create_refc_binary/3, create_refc_binary/4]).
+-export([create_matchstate/6, convert_matchstate/1, compare_matchstate/4]).
+-export([get_field_from_term/3, get_field_from_pointer/3,
+ set_field_from_term/3, set_field_from_pointer/3,
+ extract_matchbuffer/2, extract_binary_bytes/2]).
+
+-include("hipe_rtl.hrl").
+-include("hipe_literals.hrl").
+
+-ifdef(EFT_NATIVE_ADDRESS).
+-export([if_fun_get_arity_and_address/5]).
+-endif.
+
+-undef(TAG_PRIMARY_BOXED).
+-undef(TAG_IMMED2_MASK).
+-undef(TAG_IMMED2_CATCH).
+-undef(TAG_IMMED2_SIZE).
+
+%%------------------------------------------------------------------------
+
+-define(TAG_PRIMARY_SIZE, 2).
+-define(TAG_PRIMARY_MASK, 16#3).
+-define(TAG_PRIMARY_HEADER, 16#0).
+-define(TAG_PRIMARY_LIST, 16#1).
+-define(TAG_PRIMARY_BOXED, 16#2).
+-define(TAG_PRIMARY_IMMED1, 16#3).
+
+-define(TAG_IMMED1_SIZE, 4).
+-define(TAG_IMMED1_MASK, 16#F).
+-define(TAG_IMMED1_PID, ((16#0 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)).
+-define(TAG_IMMED1_PORT, ((16#1 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)).
+-define(TAG_IMMED1_IMMED2,((16#2 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)).
+-define(TAG_IMMED1_SMALL, ((16#3 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)).
+
+-define(TAG_IMMED2_SIZE, 6).
+-define(TAG_IMMED2_MASK, 16#3F).
+-define(TAG_IMMED2_ATOM, ((16#0 bsl ?TAG_IMMED1_SIZE) bor ?TAG_IMMED1_IMMED2)).
+-define(TAG_IMMED2_CATCH, ((16#1 bsl ?TAG_IMMED1_SIZE) bor ?TAG_IMMED1_IMMED2)).
+-define(TAG_IMMED2_NIL, ((16#3 bsl ?TAG_IMMED1_SIZE) bor ?TAG_IMMED1_IMMED2)).
+
+-define(TAG_HEADER_ARITYVAL,((16#0 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_BIN_MATCHSTATE, ((16#1 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_POS_BIG, ((16#2 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_NEG_BIG, ((16#3 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(BIG_SIGN_BIT, (16#1 bsl ?TAG_PRIMARY_SIZE)).
+-define(TAG_HEADER_REF, ((16#4 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_FUN, ((16#5 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_FLOAT, ((16#6 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_EXPORT, ((16#7 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(BINARY_XXX_MASK, (16#3 bsl ?TAG_PRIMARY_SIZE)).
+-define(TAG_HEADER_REFC_BIN,((16#8 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_HEAP_BIN,((16#9 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_SUB_BIN, ((16#A bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_EXTERNAL_PID, ((16#C bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_EXTERNAL_PORT,((16#D bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_EXTERNAL_REF, ((16#E bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+
+-define(TAG_HEADER_MASK, 16#3F).
+-define(HEADER_ARITY_OFFS, 6).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+mk_header(SZ,TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG.
+mk_arityval(SZ) -> mk_header(SZ, ?TAG_HEADER_ARITYVAL).
+
+size_from_header(Sz, Header) ->
+ [hipe_rtl:mk_alu(Sz, Header, 'srl', hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))].
+
+mk_var_header(Header, Size, Tag) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_alu(Tmp, Size, sll, hipe_rtl:mk_imm(?HEADER_ARITY_OFFS)),
+ hipe_rtl:mk_alu(Header, Tmp, 'add', hipe_rtl:mk_imm(Tag))].
+
+mk_fixnum(X) -> (X bsl ?TAG_IMMED1_SIZE) + ?TAG_IMMED1_SMALL.
+
+-define(NIL, ((-1 bsl ?TAG_IMMED2_SIZE) bor ?TAG_IMMED2_NIL)).
+mk_nil() -> ?NIL.
+%% mk_atom(X) -> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM.
+mk_non_value() -> ?THE_NON_VALUE.
+
+-spec is_fixnum(integer()) -> boolean().
+is_fixnum(N) when is_integer(N) ->
+ Bits = ?bytes_to_bits(hipe_rtl_arch:word_size()) - ?TAG_IMMED1_SIZE,
+ (N =< ((1 bsl (Bits - 1)) - 1)) and (N >= -(1 bsl (Bits - 1))).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(HEADER_EXPORT, mk_header(1, ?TAG_HEADER_EXPORT)).
+-define(HEADER_FUN, mk_header(?ERL_FUN_SIZE-2, ?TAG_HEADER_FUN)).
+-define(HEADER_PROC_BIN, mk_header(?PROC_BIN_WORDSIZE-1, ?TAG_HEADER_REFC_BIN)).
+-define(HEADER_SUB_BIN, mk_header(?SUB_BIN_WORDSIZE-2, ?TAG_HEADER_SUB_BIN)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+tag_boxed(Res, X) ->
+ hipe_rtl:mk_alu(Res, X, 'add', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)).
+
+%% tag_bignum(Res, X) -> tag_boxed(Res, X).
+tag_flonum(Res, X) -> tag_boxed(Res, X).
+tag_tuple(Res, X) -> tag_boxed(Res, X).
+
+tag_cons(Res, X) ->
+ hipe_rtl:mk_alu(Res, X, 'add', hipe_rtl:mk_imm(?TAG_PRIMARY_LIST)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Operations to test if an object has a known type T.
+
+test_nil(X, TrueLab, FalseLab, Pred) ->
+ hipe_rtl:mk_branch(X, eq, hipe_rtl:mk_imm(?NIL), TrueLab, FalseLab, Pred).
+
+test_cons(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ Mask = hipe_rtl:mk_imm(?TAG_PRIMARY_MASK - ?TAG_PRIMARY_LIST),
+ hipe_rtl:mk_alub(Tmp, X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred).
+
+test_is_boxed(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ Mask = hipe_rtl:mk_imm(?TAG_PRIMARY_MASK - ?TAG_PRIMARY_BOXED),
+ hipe_rtl:mk_alub(Tmp, X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred).
+
+get_header(Res, X) ->
+ hipe_rtl:mk_load(Res, X, hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED))).
+
+mask_and_compare(X, Mask, Value, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_alu(Tmp, X, 'and', hipe_rtl:mk_imm(Mask)),
+ hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(Value), TrueLab, FalseLab, Pred)].
+
+test_immed1(X, Value, TrueLab, FalseLab, Pred) ->
+ mask_and_compare(X, ?TAG_IMMED1_MASK, Value, TrueLab, FalseLab, Pred).
+
+test_internal_pid(X, TrueLab, FalseLab, Pred) ->
+ test_immed1(X, ?TAG_IMMED1_PID, TrueLab, FalseLab, Pred).
+
+test_any_pid(X, TrueLab, FalseLab, Pred) ->
+ NotInternalPidLab = hipe_rtl:mk_new_label(),
+ [test_internal_pid(X, TrueLab, hipe_rtl:label_name(NotInternalPidLab), Pred),
+ NotInternalPidLab,
+ test_external_pid(X, TrueLab, FalseLab, Pred)].
+
+test_external_pid(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ ExternalPidMask = ?TAG_HEADER_MASK,
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, ExternalPidMask, ?TAG_HEADER_EXTERNAL_PID,
+ TrueLab, FalseLab, Pred)].
+
+test_internal_port(X, TrueLab, FalseLab, Pred) ->
+ test_immed1(X, ?TAG_IMMED1_PORT, TrueLab, FalseLab, Pred).
+
+test_any_port(X, TrueLab, FalseLab, Pred) ->
+ NotInternalPortLab = hipe_rtl:mk_new_label(),
+ [test_internal_port(X, TrueLab, hipe_rtl:label_name(NotInternalPortLab), Pred),
+ NotInternalPortLab,
+ test_external_port(X, TrueLab, FalseLab, Pred)].
+
+test_external_port(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ ExternalPortMask = ?TAG_HEADER_MASK,
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, ExternalPortMask, ?TAG_HEADER_EXTERNAL_PORT,
+ TrueLab, FalseLab, Pred)].
+
+test_fixnum(X, TrueLab, FalseLab, Pred) ->
+ test_immed1(X, ?TAG_IMMED1_SMALL, TrueLab, FalseLab, Pred).
+
+test_atom(X, TrueLab, FalseLab, Pred) ->
+ mask_and_compare(X, ?TAG_IMMED2_MASK, ?TAG_IMMED2_ATOM,
+ TrueLab, FalseLab, Pred).
+
+test_tuple(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ hipe_rtl:mk_alub(Tmp2, Tmp, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq',
+ TrueLab, FalseLab, Pred)].
+
+test_tuple_N(X, N, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(mk_arityval(N)),
+ TrueLab, FalseLab, Pred)].
+
+test_ref(X, TrueLab, FalseLab, Pred) ->
+ Hdr = hipe_rtl:mk_new_reg_gcsafe(),
+ Tag = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ TwoThirdsTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Hdr, X),
+ hipe_rtl:mk_alu(Tag, Hdr, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK)),
+ hipe_rtl:mk_branch(Tag, 'eq', hipe_rtl:mk_imm(?TAG_HEADER_REF),
+ TrueLab, hipe_rtl:label_name(TwoThirdsTrueLab), Pred),
+ TwoThirdsTrueLab,
+ hipe_rtl:mk_branch(Tag, 'eq', hipe_rtl:mk_imm(?TAG_HEADER_EXTERNAL_REF),
+ TrueLab, FalseLab, Pred)
+ ].
+
+-ifdef(EFT_NATIVE_ADDRESS).
+test_closure(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, ?TAG_HEADER_MASK, ?TAG_HEADER_FUN,
+ TrueLab, FalseLab, Pred)].
+-endif.
+
+test_fun(X, TrueLab, FalseLab, Pred) ->
+ Hdr = hipe_rtl:mk_new_reg_gcsafe(),
+ Tag = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ TwoThirdsTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Hdr, X),
+ hipe_rtl:mk_alu(Tag, Hdr, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK)),
+ hipe_rtl:mk_branch(Tag, 'eq', hipe_rtl:mk_imm(?TAG_HEADER_FUN),
+ TrueLab, hipe_rtl:label_name(TwoThirdsTrueLab), Pred),
+ TwoThirdsTrueLab,
+ hipe_rtl:mk_branch(Tag, 'eq', hipe_rtl:mk_imm(?TAG_HEADER_EXPORT),
+ TrueLab, FalseLab, Pred)].
+
+test_fun2(X, Arity, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ TFalse = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([Tmp], {erlang,is_function,2}, [X,Arity],
+ hipe_rtl:label_name(HalfTrueLab), FalseLab, 'not_remote'),
+ HalfTrueLab,
+ hipe_rtl:mk_load_atom(TFalse, 'false'),
+ hipe_rtl:mk_branch(Tmp, 'ne', TFalse, TrueLab, FalseLab, Pred)].
+
+flonum_header() ->
+ mk_header(8 div hipe_rtl_arch:word_size(), ?TAG_HEADER_FLOAT).
+
+test_flonum(X, TrueLab, FalseLab, Pred) ->
+ HeaderFlonum = flonum_header(),
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(HeaderFlonum),
+ TrueLab, FalseLab, Pred)].
+
+test_bignum(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ BigMask = ?TAG_HEADER_MASK - ?BIG_SIGN_BIT,
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG,
+ TrueLab, FalseLab, Pred)].
+
+test_pos_bignum(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ BigMask = ?TAG_HEADER_MASK,
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG,
+ TrueLab, FalseLab, Pred)].
+
+test_matchstate(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, ?TAG_HEADER_MASK, ?TAG_HEADER_BIN_MATCHSTATE,
+ TrueLab, FalseLab, Pred)].
+
+test_bitstr(X, TrueLab, FalseLab, Pred) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ HalfTrueLab = hipe_rtl:mk_new_label(),
+ Mask = ?TAG_HEADER_MASK - ?BINARY_XXX_MASK,
+ [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+ HalfTrueLab,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, Mask, ?TAG_HEADER_REFC_BIN, TrueLab, FalseLab, Pred)].
+
+test_binary(X, TrueLab, FalseLab, Pred) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ IsBoxedLab = hipe_rtl:mk_new_label(),
+ IsBitStrLab = hipe_rtl:mk_new_label(),
+ IsSubBinLab = hipe_rtl:mk_new_label(),
+ Mask = ?TAG_HEADER_MASK - ?BINARY_XXX_MASK,
+ [test_is_boxed(X, hipe_rtl:label_name(IsBoxedLab), FalseLab, Pred),
+ IsBoxedLab,
+ get_header(Tmp1, X),
+ mask_and_compare(Tmp1, Mask, ?TAG_HEADER_REFC_BIN,
+ hipe_rtl:label_name(IsBitStrLab), FalseLab, Pred),
+ IsBitStrLab,
+ mask_and_compare(Tmp1, ?TAG_HEADER_MASK, ?TAG_HEADER_SUB_BIN,
+ hipe_rtl:label_name(IsSubBinLab), TrueLab, 0.5),
+ IsSubBinLab,
+ get_field_from_term({sub_binary, bitsize}, X, Tmp2),
+ hipe_rtl:mk_branch(Tmp2, eq, hipe_rtl:mk_imm(0), TrueLab, FalseLab, Pred)].
+
+test_list(X, TrueLab, FalseLab, Pred) ->
+ Lab = hipe_rtl:mk_new_label(),
+ [test_cons(X, TrueLab, hipe_rtl:label_name(Lab), 0.5),
+ Lab,
+ test_nil(X, TrueLab, FalseLab, Pred)].
+
+test_integer(X, TrueLab, FalseLab, Pred) ->
+ Lab = hipe_rtl:mk_new_label(),
+ [test_fixnum(X, TrueLab, hipe_rtl:label_name(Lab), 0.5),
+ Lab,
+ test_bignum(X, TrueLab, FalseLab, Pred)].
+
+test_number(X, TrueLab, FalseLab, Pred) ->
+ Lab1 = hipe_rtl:mk_new_label(),
+ Lab2 = hipe_rtl:mk_new_label(),
+ Lab3 = hipe_rtl:mk_new_label(),
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ BigMask = ?TAG_HEADER_MASK - ?BIG_SIGN_BIT,
+ HeaderFlonum = flonum_header(),
+ [test_fixnum(X, TrueLab, hipe_rtl:label_name(Lab1), 0.5),
+ Lab1,
+ test_is_boxed(X, hipe_rtl:label_name(Lab2), FalseLab, 0.5),
+ Lab2,
+ get_header(Tmp, X),
+ mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG,
+ TrueLab, hipe_rtl:label_name(Lab3), 0.5),
+ Lab3,
+ hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(HeaderFlonum),
+ TrueLab, FalseLab, Pred)].
+
+%% CONS, NIL, and TUPLE are not constants, everything else is
+test_constant(X, TrueLab, FalseLab, Pred) ->
+ Lab1 = hipe_rtl:mk_new_label(),
+ Lab2 = hipe_rtl:mk_new_label(),
+ Pred1 = 1-Pred,
+ [test_cons(X, FalseLab, hipe_rtl:label_name(Lab1), Pred1),
+ Lab1,
+ test_nil(X, FalseLab, hipe_rtl:label_name(Lab2), Pred1),
+ Lab2,
+ test_tuple(X, FalseLab, TrueLab, Pred1)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+tag_fixnum(DestVar, SrcReg) ->
+ [hipe_rtl:mk_fixnumop(DestVar, SrcReg, tag)].
+%% [hipe_rtl:mk_alu(DestVar, SrcReg, sll, hipe_rtl:mk_imm(?TAG_IMMED1_SIZE)),
+%% hipe_rtl:mk_alu(DestVar, DestVar, add, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL))].
+
+realtag_fixnum(DestVar, SrcReg) ->
+ [hipe_rtl:mk_alu(DestVar, SrcReg, sll, hipe_rtl:mk_imm(?TAG_IMMED1_SIZE)),
+ hipe_rtl:mk_alu(DestVar, DestVar, add, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL))].
+
+untag_fixnum(DestReg, SrcVar) ->
+ hipe_rtl:mk_fixnumop(DestReg, SrcVar, untag).
+%% hipe_rtl:mk_alu(DestReg, SrcVar, 'sra', hipe_rtl:mk_imm(?TAG_IMMED1_SIZE)).
+
+realuntag_fixnum(DestReg, SrcVar) ->
+ hipe_rtl:mk_alu(DestReg, SrcVar, 'sra', hipe_rtl:mk_imm(?TAG_IMMED1_SIZE)).
+
+fixnum_val(Fixnum) ->
+ Fixnum bsr ?TAG_IMMED1_SIZE.
+
+test_fixnums(Args, TrueLab, FalseLab, Pred) ->
+ {Reg, Ands} = test_fixnums_1(Args, []),
+ Ands ++ [test_fixnum(Reg, TrueLab, FalseLab, Pred)].
+
+test_fixnums_1([Arg1, Arg2], Acc) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ {Tmp, lists:reverse([hipe_rtl:mk_alu(Tmp, Arg1, 'and', Arg2)|Acc])};
+test_fixnums_1([Arg1, Arg2|Args], Acc) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ test_fixnums_1([Tmp|Args], [hipe_rtl:mk_alu(Tmp, Arg1, 'and', Arg2)|Acc]).
+
+test_two_fixnums(Arg1, Arg2, FalseLab) ->
+ TrueLab = hipe_rtl:mk_new_label(),
+ case hipe_rtl:is_imm(Arg2) of
+ true ->
+ Value = hipe_rtl:imm_value(Arg2),
+ case Value band ?TAG_IMMED1_MASK of
+ ?TAG_IMMED1_SMALL ->
+ [test_fixnum(Arg1, hipe_rtl:label_name(TrueLab), FalseLab, 0.99),
+ TrueLab];
+ _ ->
+ [hipe_rtl:mk_goto(FalseLab)]
+ end;
+ false ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_alu(Tmp, Arg1, 'and', Arg2),
+ test_fixnum(Tmp, hipe_rtl:label_name(TrueLab), FalseLab, 0.99),
+ TrueLab]
+ end.
+
+fixnum_cmp(Arg1, Arg2, TrueLab, FalseLab, Pred, CmpOp) ->
+ hipe_rtl:mk_branch(Arg1, CmpOp, Arg2, TrueLab, FalseLab, Pred).
+
+fixnum_gt(Arg1, Arg2, TrueLab, FalseLab, Pred) ->
+ fixnum_cmp(Arg1, Arg2, TrueLab, FalseLab, Pred, gt).
+
+fixnum_lt(Arg1, Arg2, TrueLab, FalseLab, Pred) ->
+ fixnum_cmp(Arg1, Arg2, TrueLab, FalseLab, Pred, lt).
+
+fixnum_ge(Arg1, Arg2, TrueLab, FalseLab, Pred) ->
+ fixnum_cmp(Arg1, Arg2, TrueLab, FalseLab, Pred, ge).
+
+fixnum_le(Arg1, Arg2, TrueLab, FalseLab, Pred) ->
+ fixnum_cmp(Arg1, Arg2, TrueLab, FalseLab, Pred, le).
+
+%% We know the answer will be a fixnum
+unsafe_fixnum_add(Arg1, Arg2, Res) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_alu(Tmp, Arg2, sub, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)),
+ hipe_rtl:mk_alu(Res, Arg1, add, Tmp)].
+
+%% We know the answer will be a fixnum
+unsafe_fixnum_sub(Arg1, Arg2, Res) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_alu(Tmp, Arg2, sub, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)),
+ hipe_rtl:mk_alu(Res, Arg1, sub, Tmp)].
+
+%%% (16X+tag)+((16Y+tag)-tag) = 16X+tag+16Y = 16(X+Y)+tag
+%%% (16X+tag)-((16Y+tag)-tag) = 16X+tag-16Y = 16(X-Y)+tag
+fixnum_addsub(AluOp, Arg1, Arg2, Res, OtherLab) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ %% XXX: Consider moving this test to the users of fixnum_addsub.
+ case Arg1 =/= Res andalso Arg2 =/= Res of
+ true ->
+ %% Args differ from res.
+ NoOverflowLab = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_alu(Tmp, Arg2, sub, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)),
+ hipe_rtl:mk_alub(Res, Arg1, AluOp, Tmp, not_overflow,
+ hipe_rtl:label_name(NoOverflowLab),
+ hipe_rtl:label_name(OtherLab), 0.99),
+ NoOverflowLab];
+ false ->
+ %% At least one of the arguments is the same as Res.
+ Tmp2 = hipe_rtl:mk_new_var(), % XXX: shouldn't this var be a reg?
+ NoOverflowLab = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_alu(Tmp, Arg2, sub, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)),
+ hipe_rtl:mk_alub(Tmp2, Arg1, AluOp, Tmp, not_overflow,
+ hipe_rtl:label_name(NoOverflowLab),
+ hipe_rtl:label_name(OtherLab), 0.99),
+ NoOverflowLab,
+ hipe_rtl:mk_move(Res, Tmp2)]
+ end.
+
+%%% ((16X+tag) div 16) * ((16Y+tag)-tag) + tag = X*16Y+tag = 16(XY)+tag
+fixnum_mul(Arg1, Arg2, Res, OtherLab) ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ U1 = hipe_rtl:mk_new_reg_gcsafe(),
+ U2 = hipe_rtl:mk_new_reg_gcsafe(),
+ NoOverflowLab = hipe_rtl:mk_new_label(),
+ [untag_fixnum(U1, Arg1),
+ hipe_rtl:mk_alu(U2, Arg2, 'sub', hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)),
+ hipe_rtl:mk_alub(Tmp, U1, 'mul', U2, overflow, hipe_rtl:label_name(OtherLab),
+ hipe_rtl:label_name(NoOverflowLab), 0.01),
+ NoOverflowLab,
+ hipe_rtl:mk_alu(Res, Tmp, 'add', hipe_rtl:mk_imm(?TAG_IMMED1_SMALL))].
+
+fixnum_andorxor(AluOp, Arg1, Arg2, Res) ->
+ case AluOp of
+ 'xor' ->
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_alu(Tmp, Arg1, 'xor', Arg2), % clears tag :-(
+ hipe_rtl:mk_alu(Res, Tmp, 'or', hipe_rtl:mk_imm(?TAG_IMMED1_SMALL))];
+ _ -> hipe_rtl:mk_alu(Res, Arg1, AluOp, Arg2)
+ end.
+
+fixnum_not(Arg, Res) ->
+ Mask = (-1 bsl ?TAG_IMMED1_SIZE),
+ hipe_rtl:mk_alu(Res, Arg, 'xor', hipe_rtl:mk_imm(Mask)).
+
+fixnum_bsr(Arg1, Arg2, Res) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ [untag_fixnum(Tmp1, Arg2),
+ hipe_rtl:mk_alu(Tmp2, Arg1, 'sra', Tmp1),
+ hipe_rtl:mk_alu(Res, Tmp2, 'or', hipe_rtl:mk_imm(?TAG_IMMED1_SMALL))].
+
+%% If someone knows how to make this better, please do.
+fixnum_bsl(Arg1, Arg2, Res) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp3 = hipe_rtl:mk_new_reg_gcsafe(),
+ [untag_fixnum(Tmp2, Arg2),
+ hipe_rtl:mk_alu(Tmp1, Arg1, 'sub', hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)),
+ hipe_rtl:mk_alu(Tmp3, Tmp1, 'sll', Tmp2),
+ hipe_rtl:mk_alu(Res, Tmp3, 'or', hipe_rtl:mk_imm(?TAG_IMMED1_SMALL))].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+unsafe_car(Dst, Arg) ->
+ hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST))).
+
+unsafe_cdr(Dst, Arg) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST)+WordSize)).
+
+unsafe_constant_element(Dst, Index, Tuple) -> % Index is an immediate
+ WordSize = hipe_rtl_arch:word_size(),
+ Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index),
+ hipe_rtl:mk_load(Dst, Tuple, hipe_rtl:mk_imm(Offset)).
+
+unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate
+ WordSize = hipe_rtl_arch:word_size(),
+ Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index),
+ hipe_rtl:mk_store(Tuple, hipe_rtl:mk_imm(Offset), Value).
+
+%%% wrong semantics
+%% unsafe_variable_element(Dst, Index, Tuple) -> % Index is an unknown fixnum
+%% %% Load word at (Tuple - 2) + ((Index >> 4) << 2).
+%% %% Offset = ((Index >> 4) << 2) - 2.
+%% %% Index = x..x1111 (fixnum tag is 2#1111).
+%% %% (Index >> 2) = 00x..x11 and ((Index >> 4) << 2) = 00x..x00.
+%% %% Therefore, ((Index >> 4) << 2) = (Index >> 2) - 3.
+%% %% So Offset = ((Index >> 4) << 2) - 2 = (Index >> 2) - (3 + 2).
+%% Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+%% Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+%% Shift = ?TAG_IMMED1_SIZE - 2,
+%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) + ?TAG_PRIMARY_BOXED,
+%% [hipe_rtl:mk_alu(Tmp1, Index, 'srl', hipe_rtl:mk_imm(Shift)),
+%% hipe_rtl:mk_alu(Tmp2, Tmp1, 'sub', hipe_rtl:mk_imm(OffAdj)),
+%% hipe_rtl:mk_load(Dst, Tuple, Tmp2)].
+
+element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) ->
+ FixnumOkLab = hipe_rtl:mk_new_label(),
+ IndexOkLab = hipe_rtl:mk_new_label(),
+ Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple
+ UIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Arity = hipe_rtl:mk_imm(A),
+ InvIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Offset = hipe_rtl:mk_new_reg_gcsafe(),
+ case IndexInfo of
+ valid ->
+ %% This is no branch, 1 load and 3 alus = 4 instr
+ [untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_alu(Offset, UIndex, 'sll',
+ hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
+ hipe_rtl:mk_load(Dst, Ptr, Offset)];
+ fixnums ->
+ %% This is 1 branch, 1 load and 4 alus = 6 instr
+ [untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub',hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset, UIndex,
+ FailLabName, IndexOkLab)];
+ _ ->
+ %% This is 3 branches, 1 load and 5 alus = 9 instr
+ [test_fixnum(Index, hipe_rtl:label_name(FixnumOkLab),
+ FailLabName, 0.99),
+ FixnumOkLab,
+ untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub',hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset, UIndex,
+ FailLabName, IndexOkLab)]
+ end;
+element(Dst, Index, Tuple, FailLabName, tuple, IndexInfo) ->
+ FixnumOkLab = hipe_rtl:mk_new_label(),
+ IndexOkLab = hipe_rtl:mk_new_label(),
+ Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple
+ Header = hipe_rtl:mk_new_reg_gcsafe(),
+ UIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Arity = hipe_rtl:mk_new_reg_gcsafe(),
+ InvIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Offset = hipe_rtl:mk_new_reg_gcsafe(),
+ case IndexInfo of
+ fixnums ->
+ %% This is 1 branch, 2 loads and 5 alus = 8 instr
+ [hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)),
+ untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Arity,Header,'srl',hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset, UIndex,
+ FailLabName, IndexOkLab)];
+ Num when is_integer(Num) ->
+ %% This is 1 branch, 1 load and 3 alus = 5 instr
+ [hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED))|
+ gen_element_tail(Dst, Ptr, InvIndex, hipe_rtl:mk_imm(Num),
+ Offset, UIndex, FailLabName, IndexOkLab)];
+ _ ->
+ %% This is 2 branches, 2 loads and 6 alus = 10 instr
+ [test_fixnum(Index, hipe_rtl:label_name(FixnumOkLab), FailLabName, 0.99),
+ FixnumOkLab,
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)),
+ untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Arity,Header,'srl',hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset, UIndex,
+ FailLabName, IndexOkLab)]
+ end;
+element(Dst, Index, Tuple, FailLabName, unknown, IndexInfo) ->
+ FixnumOkLab = hipe_rtl:mk_new_label(),
+ BoxedOkLab = hipe_rtl:mk_new_label(),
+ TupleOkLab = hipe_rtl:mk_new_label(),
+ IndexOkLab = hipe_rtl:mk_new_label(),
+ Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple
+ Header = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+ UIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Arity = hipe_rtl:mk_new_reg_gcsafe(),
+ InvIndex = hipe_rtl:mk_new_reg_gcsafe(),
+ Offset = hipe_rtl:mk_new_reg_gcsafe(),
+ case IndexInfo of
+ fixnums ->
+ %% This is 3 branches, 2 loads and 5 alus = 10 instr
+ [test_is_boxed(Tuple, hipe_rtl:label_name(BoxedOkLab),
+ FailLabName, 0.99),
+ BoxedOkLab,
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_alub(Tmp, Header, 'and',
+ hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq',
+ hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99),
+ TupleOkLab,
+ untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Arity, Header, 'srl',
+ hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset,
+ UIndex, FailLabName, IndexOkLab)];
+ Num when is_integer(Num) ->
+ %% This is 3 branches, 2 loads and 4 alus = 9 instr
+ [test_is_boxed(Tuple, hipe_rtl:label_name(BoxedOkLab),
+ FailLabName, 0.99),
+ BoxedOkLab,
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_alub(Tmp, Header, 'and',
+ hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq',
+ hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99),
+ TupleOkLab,
+ hipe_rtl:mk_alu(Arity, Header, 'srl',
+ hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset,
+ hipe_rtl:mk_imm(Num), FailLabName, IndexOkLab)];
+ _ ->
+ %% This is 4 branches, 2 loads, and 6 alus = 12 instr :(
+ [test_fixnum(Index, hipe_rtl:label_name(FixnumOkLab),
+ FailLabName, 0.99),
+ FixnumOkLab,
+ test_is_boxed(Tuple, hipe_rtl:label_name(BoxedOkLab),
+ FailLabName, 0.99),
+ BoxedOkLab,
+ hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)),
+ hipe_rtl:mk_alub(Tmp, Header, 'and',
+ hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq',
+ hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99),
+ TupleOkLab,
+ untag_fixnum(UIndex, Index),
+ hipe_rtl:mk_alu(Arity, Header, 'srl',
+ hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))|
+ gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset,
+ UIndex, FailLabName, IndexOkLab)]
+ end.
+
+gen_element_tail(Dst, Ptr, InvIndex, Arity, Offset,
+ UIndex, FailLabName, IndexOkLab) ->
+ %% now check that 1 <= UIndex <= Arity
+ %% if UIndex < 1, then (Arity - UIndex) >= Arity
+ %% if UIndex > Arity, then (Arity - UIndex) < 0, which is >=u Arity
+ %% otherwise, 0 <= (Arity - UIndex) < Arity
+ [hipe_rtl:mk_alu(InvIndex, Arity, 'sub', UIndex),
+ hipe_rtl:mk_branch(InvIndex, 'geu', Arity, FailLabName,
+ hipe_rtl:label_name(IndexOkLab), 0.01),
+ IndexOkLab,
+ hipe_rtl:mk_alu(Offset, UIndex, 'sll',
+ hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
+ hipe_rtl:mk_load(Dst, Ptr, Offset)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+unsafe_closure_element(Dst, Index, Closure) -> % Index is an immediate
+ Offset = -(?TAG_PRIMARY_BOXED) %% Untag
+ + ?EFT_ENV %% Field offset
+ %% Index from 1 to N hence -1)
+ + (hipe_rtl_arch:word_size() * (hipe_rtl:imm_value(Index)-1)),
+ hipe_rtl:mk_load(Dst, Closure, hipe_rtl:mk_imm(Offset)).
+
+mk_fun_header() ->
+ hipe_rtl:mk_imm(?HEADER_FUN).
+
+tag_fun(Res, X) ->
+ tag_boxed(Res, X).
+
+%% untag_fun(Res, X) ->
+%% hipe_rtl:mk_alu(Res, X, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)).
+
+-ifdef(EFT_NATIVE_ADDRESS).
+if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) ->
+ %% EmuAddressPtrReg = hipe_rtl:mk_new_reg(),
+ %% FEPtrReg = hipe_rtl:mk_new_reg(),
+ %% ArityReg = hipe_rtl:mk_new_reg(),
+ %% NumFreeReg = hipe_rtl:mk_new_reg(),
+ %% RealArityReg = hipe_rtl:mk_new_reg(),
+ TrueLab0 = hipe_rtl:mk_new_label(),
+ %% TrueLab1 = hipe_rtl:mk_new_label(),
+ IsFunCode = test_closure(FunP, hipe_rtl:label_name(TrueLab0), BadFunLab, Pred),
+ GetArityCode =
+ [TrueLab0,
+ %% Funp->arity contains the arity
+ hipe_rtl:mk_load(ArityReg, FunP,
+ hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+
+ ?EFT_ARITY)),
+ hipe_rtl:mk_load(AddressReg, FunP,
+ hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+
+ ?EFT_NATIVE_ADDRESS))],
+ IsFunCode ++ GetArityCode.
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Binary Code
+%%
+
+create_heap_binary(Base, Size, Dst) when is_integer(Size) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ WordSize = hipe_rtl_arch:word_size(),
+ NoWords=(Size + 3*WordSize-1) div WordSize,
+ NoBytes = NoWords*WordSize,
+ HeapBinHeader = hipe_rtl:mk_imm(mk_header(NoWords-1,
+ ?TAG_HEADER_HEAP_BIN)),
+ [GetHPInsn,
+ tag_boxed(Dst, HP),
+ set_field_from_pointer({heap_bin, thing_word}, HP, HeapBinHeader),
+ set_field_from_pointer({heap_bin, binsize}, HP, hipe_rtl:mk_imm(Size)),
+ hipe_rtl:mk_alu(Base, HP, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA)),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(NoBytes)),
+ PutHPInsn];
+
+create_heap_binary(Base, Size, Dst) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ WordSize = hipe_rtl_arch:word_size(),
+ Log2WordSize = hipe_rtl_arch:log2_word_size(),
+ EvenWordSize = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ Header = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp3 = hipe_rtl:mk_new_reg(), % offset from HP
+ Tmp4 = hipe_rtl:mk_new_reg(), % offset from HP
+ [GetHPInsn,
+ hipe_rtl:mk_alu(Tmp1, Size, add, hipe_rtl:mk_imm(WordSize-1)),
+ hipe_rtl:mk_alu(EvenWordSize, Tmp1, sra, hipe_rtl:mk_imm(Log2WordSize)),
+ hipe_rtl:mk_alu(Tmp2, EvenWordSize, add, hipe_rtl:mk_imm(1)),
+ hipe_rtl:mk_alu(Base, HP, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA)),
+ mk_var_header(Header, Tmp2, ?TAG_HEADER_HEAP_BIN),
+ set_field_from_pointer({heap_bin, thing_word}, HP, Header),
+ set_field_from_pointer({heap_bin, binsize}, HP, Size),
+ tag_boxed(Dst, HP),
+ hipe_rtl:mk_alu(Tmp3, HP, add, Size),
+ hipe_rtl:mk_alu(Tmp4, Tmp3, add, hipe_rtl:mk_imm(3*WordSize-1)),
+ hipe_rtl:mk_alu(HP, Tmp4, 'and', hipe_rtl:mk_imm(-WordSize)),
+ PutHPInsn].
+
+create_refc_binary(Base, Size, Dst) ->
+ create_refc_binary(Base, Size, hipe_rtl:mk_imm(0), Dst).
+
+create_refc_binary(Base, Size, Flags, Dst) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ ProcBinHeader = hipe_rtl:mk_imm(?HEADER_PROC_BIN),
+ WordSize = hipe_rtl_arch:word_size(),
+ Val = hipe_rtl:mk_new_reg(), % offset from Base
+ [GetHPInsn,
+ tag_boxed(Dst, HP),
+ set_field_from_pointer({proc_bin, thing_word}, HP, ProcBinHeader),
+ set_field_from_pointer({proc_bin, binsize}, HP, Size),
+ heap_arch_spec(HP),
+ hipe_rtl:mk_alu(Val, Base, sub, hipe_rtl:mk_imm(?BINARY_ORIG_BYTES)),
+ set_field_from_pointer({proc_bin, val}, HP, Val),
+ set_field_from_pointer({proc_bin, bytes}, HP, Base),
+ set_field_from_pointer({proc_bin, flags}, HP, Flags),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(?PROC_BIN_WORDSIZE*WordSize)),
+ PutHPInsn].
+
+heap_arch_spec(HP) ->
+ Tmp1 = hipe_rtl:mk_new_reg(), % MSO state
+ [hipe_rtl_arch:pcb_load(Tmp1, ?P_OFF_HEAP_MSO),
+ set_field_from_pointer({proc_bin, next}, HP, Tmp1),
+ hipe_rtl_arch:pcb_store(?P_OFF_HEAP_MSO, HP)].
+
+test_heap_binary(Binary, TrueLblName, FalseLblName) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ [get_header(Tmp1, Binary),
+ hipe_rtl:mk_alu(Tmp2, Tmp1, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK)),
+ hipe_rtl:mk_branch(Tmp2, eq, hipe_rtl:mk_imm(?TAG_HEADER_HEAP_BIN),
+ TrueLblName, FalseLblName)].
+
+mk_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs, Orig) ->
+ mk_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs,
+ hipe_rtl:mk_imm(0), Orig).
+
+mk_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs,
+ Writable, Orig) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ WordSize = hipe_rtl_arch:word_size(),
+ [GetHPInsn,
+ tag_boxed(Dst, HP),
+ build_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs, Writable, Orig),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize)),
+ PutHPInsn].
+
+build_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs,
+ Writable, Orig) ->
+ Head = hipe_rtl:mk_imm(?HEADER_SUB_BIN),
+ [set_field_from_term({sub_binary, thing_word}, Dst, Head),
+ set_field_from_term({sub_binary, binsize}, Dst, ByteSize),
+ set_field_from_term({sub_binary, offset}, Dst, ByteOffs),
+ set_field_from_term({sub_binary, bitsize}, Dst, BitSize),
+ set_field_from_term({sub_binary, bitoffset}, Dst, BitOffs),
+ set_field_from_term({sub_binary, is_writable}, Dst, Writable),
+ set_field_from_term({sub_binary, orig}, Dst, Orig)].
+
+test_subbinary(Binary, TrueLblName, FalseLblName) ->
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
+ [get_header(Tmp1, Binary),
+ hipe_rtl:mk_alu(Tmp2, Tmp1, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK)),
+ hipe_rtl:mk_branch(Tmp2, eq, hipe_rtl:mk_imm(?TAG_HEADER_SUB_BIN), TrueLblName, FalseLblName)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Float Code
+
+unsafe_load_float(DstLo, DstHi, Src) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ Offset1 = -(?TAG_PRIMARY_BOXED) + WordSize,
+ Offset2 = Offset1 + 4, %% This should really be 4 and not WordSize
+ case hipe_rtl_arch:endianess() of
+ little ->
+ [hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned),
+ hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)];
+ big ->
+ [hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned),
+ hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)]
+ end.
+
+unsafe_untag_float(Dst, Src) ->
+ Offset = -(?TAG_PRIMARY_BOXED) + hipe_rtl_arch:word_size(),
+ [hipe_rtl:mk_fload(Dst, Src, hipe_rtl:mk_imm(Offset))].
+
+unsafe_tag_float(Dst, Src) ->
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ Head = hipe_rtl:mk_imm(flonum_header()),
+ WordSize = hipe_rtl_arch:word_size(),
+ [GetHPInsn,
+ hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(0), Head),
+ hipe_rtl:mk_fstore(HP, hipe_rtl:mk_imm(WordSize), Src),
+ tag_flonum(Dst, HP),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(WordSize+8)),
+ PutHPInsn].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% BigNum Code
+
+unsafe_mk_big(Dst, Src, Signedness) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ PosHead = hipe_rtl:mk_imm(mk_header(1, ?TAG_HEADER_POS_BIG)),
+ NegHead = hipe_rtl:mk_imm(mk_header(1, ?TAG_HEADER_NEG_BIG)),
+ PosLabel = hipe_rtl:mk_new_label(),
+ NegLabel = hipe_rtl:mk_new_label(),
+ JoinLabel = hipe_rtl:mk_new_label(),
+ PutHeaderCode =
+ case Signedness of
+ unsigned ->
+ [hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(0*WordSize), PosHead)];
+ signed ->
+ [hipe_rtl:mk_branch(Src, ge, hipe_rtl:mk_imm(0),
+ hipe_rtl:label_name(PosLabel),
+ hipe_rtl:label_name(NegLabel)),
+ PosLabel,
+ hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(0*WordSize), PosHead),
+ hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLabel)),
+ NegLabel,
+ hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(0*WordSize), NegHead),
+ JoinLabel]
+ end,
+ RestCode =
+ [hipe_rtl:mk_store(HP, hipe_rtl:mk_imm(1*WordSize), Src),
+ tag_boxed(Dst, HP),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(2*WordSize)),
+ PutHPInsn],
+ [GetHPInsn] ++ PutHeaderCode ++ RestCode.
+
+get_one_word_pos_bignum(USize, Size, Fail) ->
+ Header = hipe_rtl:mk_new_reg(),
+ HalfLbl = hipe_rtl:mk_new_label(),
+ HalfLblName = hipe_rtl:label_name(HalfLbl),
+ WordSize = hipe_rtl_arch:word_size(),
+ PosHead = hipe_rtl:mk_imm(mk_header(1, ?TAG_HEADER_POS_BIG)),
+ [get_header(Header, Size),
+ hipe_rtl:mk_branch(Header, eq, PosHead, HalfLblName, Fail),
+ HalfLbl,
+ hipe_rtl:mk_load(USize, Size, hipe_rtl:mk_imm(1*WordSize
+ -?TAG_PRIMARY_BOXED))].
+
+-spec bignum_sizeneed(non_neg_integer()) -> non_neg_integer().
+
+bignum_sizeneed(Size) ->
+ WordSizeBits = hipe_rtl_arch:word_size() * 8,
+ case is_fixnum(1 bsl Size) of
+ true ->
+ 0;
+ false ->
+ ((Size + (WordSizeBits-1)) div WordSizeBits) + 1
+ end.
+
+bignum_sizeneed_code(SizeReg,FixNumLblName) ->
+ WordSizeBits = hipe_rtl_arch:word_size() * 8,
+ WordShifts = hipe_rtl_arch:log2_word_size() + 3,
+ MaxFixNum = WordSizeBits - ?TAG_IMMED1_SIZE - 1,
+ ResReg = hipe_rtl:mk_new_reg_gcsafe(),
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
+ BigLbl = hipe_rtl:mk_new_label(),
+ Code =
+ [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(MaxFixNum),
+ FixNumLblName, hipe_rtl:label_name(BigLbl)),
+ BigLbl,
+ hipe_rtl:mk_alu(Tmp1,SizeReg,add,hipe_rtl:mk_imm(WordSizeBits-1)),
+ hipe_rtl:mk_alu(ResReg,Tmp1,srl,hipe_rtl:mk_imm(WordShifts)),
+ hipe_rtl:mk_alu(ResReg,ResReg,add,hipe_rtl:mk_imm(1))],
+ {ResReg,Code}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% MatchState Code
+
+create_matchstate(Max, BinSize, Base, Offset, Orig, Ms) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
+ ByteSize = (Max+1)*WordSize + ?MS_SAVEOFFSET,
+ SizeInWords = ((ByteSize div WordSize) - 1),
+ Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)),
+ [GetHPInsn,
+ hipe_rtl:mk_alu(Ms, HP, add, hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ set_field_from_term({matchstate,thing_word}, Ms, Header),
+ set_field_from_term({matchstate,{matchbuffer,orig}}, Ms, Orig),
+ set_field_from_term({matchstate,{matchbuffer,base}}, Ms, Base),
+ set_field_from_term({matchstate,{matchbuffer,binsize}}, Ms, BinSize),
+ set_field_from_term({matchstate,{matchbuffer,offset}}, Ms, Offset),
+ set_field_from_term({matchstate,{saveoffset, 0}}, Ms, Offset),
+ hipe_rtl:mk_alu(HP, HP, add, hipe_rtl:mk_imm(ByteSize)),
+ PutHPInsn].
+
+convert_matchstate(Ms) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ Header = hipe_rtl:mk_new_reg_gcsafe(),
+ TmpSize = hipe_rtl:mk_new_reg_gcsafe(),
+ SavedOffset = hipe_rtl:mk_new_reg_gcsafe(),
+ Orig = hipe_rtl:mk_new_reg_gcsafe(),
+ BinSize = hipe_rtl:mk_new_reg_gcsafe(),
+ ByteSize = hipe_rtl:mk_new_reg_gcsafe(),
+ BitSize = hipe_rtl:mk_new_reg_gcsafe(),
+ ByteOffset = hipe_rtl:mk_new_reg_gcsafe(),
+ BitOffset = hipe_rtl:mk_new_reg_gcsafe(),
+ SizeInWords = hipe_rtl:mk_new_reg_gcsafe(),
+ Hole = hipe_rtl:mk_new_reg_gcsafe(),
+ BigIntHeader = hipe_rtl:mk_new_reg_gcsafe(),
+ [get_field_from_term({matchstate, {matchbuffer, orig}}, Ms, Orig),
+ get_field_from_term({matchstate, {matchbuffer, binsize}}, Ms, BinSize),
+ get_field_from_term({matchstate, {saveoffset, 0}}, Ms, SavedOffset),
+ get_field_from_term({matchstate, thing_word}, Ms, Header),
+ hipe_rtl:mk_alu(TmpSize, BinSize, sub, SavedOffset),
+ hipe_rtl:mk_alu(BitSize, TmpSize, 'and', hipe_rtl:mk_imm(7)),
+ hipe_rtl:mk_alu(BitOffset, SavedOffset, 'and', hipe_rtl:mk_imm(7)),
+ hipe_rtl:mk_alu(ByteSize, TmpSize, srl, hipe_rtl:mk_imm(3)),
+ hipe_rtl:mk_alu(ByteOffset, SavedOffset, srl, hipe_rtl:mk_imm(3)),
+ build_sub_binary(Ms, ByteSize, ByteOffset, BitSize, BitOffset,
+ hipe_rtl:mk_imm(0), Orig),
+ size_from_header(SizeInWords, Header),
+ hipe_rtl:mk_alu(Hole, SizeInWords, sub, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE-1)),
+ mk_var_header(BigIntHeader, Hole, ?TAG_HEADER_POS_BIG),
+ hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize-?TAG_PRIMARY_BOXED),
+ BigIntHeader)].
+
+compare_matchstate(Max, Ms, LargeEnough, TooSmall) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ ByteSize = (Max+1)*WordSize + ?MS_SAVEOFFSET,
+ SizeInWords = ((ByteSize div WordSize) - 1),
+ Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)),
+ RealHeader = hipe_rtl:mk_new_reg_gcsafe(),
+ [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Struct manipulation code
+
+get_field_offset({matchstate, thing_word}) ->
+ ?MS_THING_WORD;
+get_field_offset({matchstate, matchbuffer}) ->
+ ?MS_MATCHBUFFER;
+get_field_offset({matchstate, {matchbuffer, _} = Field}) ->
+ ?MS_MATCHBUFFER + get_field_offset(Field);
+get_field_offset({matchstate, {saveoffset, N}} = Field) ->
+ ?MS_SAVEOFFSET + N*get_field_size1(Field);
+get_field_offset({sub_binary, thing_word}) ->
+ ?SUB_BIN_THING_WORD;
+get_field_offset({sub_binary, binsize}) ->
+ ?SUB_BIN_BINSIZE;
+get_field_offset({sub_binary, bitsize}) ->
+ ?SUB_BIN_BITSIZE;
+get_field_offset({sub_binary, offset}) ->
+ ?SUB_BIN_OFFS;
+get_field_offset({sub_binary, bitoffset}) ->
+ ?SUB_BIN_BITOFFS;
+get_field_offset({sub_binary, is_writable}) ->
+ ?SUB_BIN_WRITABLE;
+get_field_offset({sub_binary, orig}) ->
+ ?SUB_BIN_ORIG;
+get_field_offset({proc_bin, thing_word}) ->
+ ?PROC_BIN_THING_WORD;
+get_field_offset({proc_bin, binsize}) ->
+ ?PROC_BIN_BINSIZE;
+get_field_offset({proc_bin, next}) ->
+ ?PROC_BIN_NEXT;
+get_field_offset({proc_bin, val}) ->
+ ?PROC_BIN_VAL;
+get_field_offset({proc_bin, bytes}) ->
+ ?PROC_BIN_BYTES;
+get_field_offset({proc_bin, flags}) ->
+ ?PROC_BIN_FLAGS;
+get_field_offset({binary, orig_bytes}) ->
+ ?BINARY_ORIG_BYTES;
+get_field_offset({binary, orig_size}) ->
+ ?BINARY_ORIG_SIZE;
+get_field_offset({heap_bin, thing_word}) ->
+ ?HEAP_BIN_THING_WORD;
+get_field_offset({heap_bin, binsize}) ->
+ ?HEAP_BIN_SIZE;
+get_field_offset({heap_bin, {data, N}} = Field) ->
+ ?HEAP_BIN_DATA+N*get_field_size1(Field);
+get_field_offset({matchbuffer, offset}) ->
+ ?MB_OFFSET;
+get_field_offset({matchbuffer, orig}) ->
+ ?MB_ORIG;
+get_field_offset({matchbuffer, base}) ->
+ ?MB_BASE;
+get_field_offset({matchbuffer, binsize}) ->
+ ?MB_SIZE.
+
+get_field_size(Field) ->
+ size_to_atom(get_field_size1(Field)).
+
+size_to_atom(Bytes) ->
+ WordSize = hipe_rtl_arch:word_size(),
+ case Bytes of
+ WordSize -> word;
+ 4 -> int32;
+ %%2 -> int16; So far there are no 2 byte fields
+ 1 -> byte
+ end.
+
+get_field_size1({matchstate, thing_word}) ->
+ ?MS_THING_WORD_SIZE;
+get_field_size1({matchstate, {matchbuffer, _} = Field}) ->
+ get_field_size1(Field);
+get_field_size1({matchstate, {saveoffset, _N}}) ->
+ ?MS_SAVEOFFSET_SIZE;
+get_field_size1({sub_binary, thing_word}) ->
+ ?SUB_BIN_THING_WORD_SIZE;
+get_field_size1({sub_binary, binsize}) ->
+ ?SUB_BIN_BINSIZE_SIZE;
+get_field_size1({sub_binary, bitsize}) ->
+ ?SUB_BIN_BITSIZE_SIZE;
+get_field_size1({sub_binary, offset}) ->
+ ?SUB_BIN_OFFS_SIZE;
+get_field_size1({sub_binary, bitoffset}) ->
+ ?SUB_BIN_BITOFFS_SIZE;
+get_field_size1({sub_binary, is_writable}) ->
+ ?SUB_BIN_WRITABLE_SIZE;
+get_field_size1({sub_binary, orig}) ->
+ ?SUB_BIN_ORIG_SIZE;
+get_field_size1({proc_bin, thing_word}) ->
+ ?PROC_BIN_THING_WORD_SIZE;
+get_field_size1({proc_bin, binsize}) ->
+ ?PROC_BIN_BINSIZE_SIZE;
+get_field_size1({proc_bin, next}) ->
+ ?PROC_BIN_NEXT_SIZE;
+get_field_size1({proc_bin, val}) ->
+ ?PROC_BIN_VAL_SIZE;
+get_field_size1({proc_bin, bytes}) ->
+ ?PROC_BIN_BYTES_SIZE;
+get_field_size1({proc_bin, flags}) ->
+ ?PROC_BIN_FLAGS_SIZE;
+get_field_size1({binary, orig_bytes}) ->
+ ?BINARY_ORIG_BYTES_SIZE;
+get_field_size1({binary, orig_size}) ->
+ ?BINARY_ORIG_SIZE_SIZE;
+get_field_size1({heap_bin, thing_word}) ->
+ ?HEAP_BIN_THING_WORD_SIZE;
+get_field_size1({heap_bin, binsize}) ->
+ ?HEAP_BIN_SIZE_SIZE;
+get_field_size1({heap_bin, {data, _}}) ->
+ ?HEAP_BIN_DATA_SIZE;
+get_field_size1({matchbuffer, offset}) ->
+ ?MB_OFFSET_SIZE;
+get_field_size1({matchbuffer, orig}) ->
+ ?MB_ORIG_SIZE;
+get_field_size1({matchbuffer, base}) ->
+ ?MB_BASE_SIZE;
+get_field_size1({matchbuffer, binsize}) ->
+ ?MB_SIZE_SIZE.
+
+get_field_from_term(Struct, Term, Dst) ->
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED),
+ Size = get_field_size(Struct),
+ hipe_rtl:mk_load(Dst, Term, Offset, Size, unsigned).
+
+set_field_from_term(Struct, Term, Value) ->
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED),
+ Size = get_field_size(Struct),
+ hipe_rtl:mk_store(Term, Offset, Value, Size).
+
+get_field_from_pointer(Struct, Term, Dst) ->
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct)),
+ Size = get_field_size(Struct),
+ hipe_rtl:mk_load(Dst, Term, Offset, Size, unsigned).
+
+set_field_from_pointer(Struct, Term, Value) ->
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct)),
+ Size = get_field_size(Struct),
+ hipe_rtl:mk_store(Term, Offset, Value, Size).
+
+extract_matchbuffer(Mb, Ms) ->
+ What = {matchstate, matchbuffer},
+ Offset = hipe_rtl:mk_imm(get_field_offset(What) - ?TAG_PRIMARY_BOXED),
+ hipe_rtl:mk_alu(Mb, Ms, add, Offset).
+
+extract_binary_bytes(Binary, Base) ->
+ Offset = hipe_rtl:mk_imm(get_field_offset({binary, orig_bytes})),
+ hipe_rtl:mk_alu(Base, Binary, add, Offset).
diff --git a/lib/hipe/sparc/Makefile b/lib/hipe/sparc/Makefile
new file mode 100644
index 0000000000..efd4996046
--- /dev/null
+++ b/lib/hipe/sparc/Makefile
@@ -0,0 +1,120 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+# Please keep this list sorted.
+MODULES=hipe_rtl_to_sparc \
+ hipe_sparc \
+ hipe_sparc_assemble \
+ hipe_sparc_cfg \
+ hipe_sparc_defuse \
+ hipe_sparc_encode \
+ hipe_sparc_finalise \
+ hipe_sparc_frame \
+ hipe_sparc_liveness_all \
+ hipe_sparc_liveness_fpr \
+ hipe_sparc_liveness_gpr \
+ hipe_sparc_main \
+ hipe_sparc_pp \
+ hipe_sparc_ra \
+ hipe_sparc_ra_finalise \
+ hipe_sparc_ra_ls \
+ hipe_sparc_ra_naive \
+ hipe_sparc_ra_postconditions \
+ hipe_sparc_ra_postconditions_fp \
+ hipe_sparc_registers
+
+HRL_FILES=hipe_sparc.hrl
+ERL_FILES=$(MODULES:%=%.erl)
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+# Please keep this list sorted.
+$(EBIN)/hipe_rtl_to_sparc.beam: ../rtl/hipe_rtl.hrl
+$(EBIN)/hipe_sparc_assemble.beam: ../main/hipe.hrl ../../kernel/src/hipe_ext_format.hrl ../rtl/hipe_literals.hrl ../misc/hipe_sdi.hrl
+$(EBIN)/hipe_sparc_cfg.beam: ../flow/cfg.hrl ../flow/cfg.inc
+$(EBIN)/hipe_sparc_frame.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_sparc_liveness_all.beam: ../flow/liveness.inc
+$(EBIN)/hipe_sparc_liveness_fpr.beam: ../flow/liveness.inc
+$(EBIN)/hipe_sparc_liveness_gpr.beam: ../flow/liveness.inc
+$(EBIN)/hipe_sparc_registers.beam: ../rtl/hipe_literals.hrl
+
+$(TARGET_FILES): hipe_sparc.hrl ../misc/hipe_consttab.hrl
diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl
new file mode 100644
index 0000000000..df5e2b0077
--- /dev/null
+++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl
@@ -0,0 +1,972 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_rtl_to_sparc).
+-export([translate/1]).
+
+-include("../rtl/hipe_rtl.hrl").
+
+translate(RTL) ->
+ hipe_gensym:init(sparc),
+ hipe_gensym:set_var(sparc, hipe_sparc_registers:first_virtual()),
+ hipe_gensym:set_label(sparc, hipe_gensym:get_label(rtl)),
+ Map0 = vmap_empty(),
+ {Formals, Map1} = conv_formals(hipe_rtl:rtl_params(RTL), Map0),
+ OldData = hipe_rtl:rtl_data(RTL),
+ {Code0, NewData} = conv_insn_list(hipe_rtl:rtl_code(RTL), Map1, OldData),
+ {RegFormals, _} = split_args(Formals),
+ Code =
+ case RegFormals of
+ [] -> Code0;
+ _ -> [hipe_sparc:mk_label(hipe_gensym:get_next_label(sparc)) |
+ move_formals(RegFormals, Code0)]
+ end,
+ IsClosure = hipe_rtl:rtl_is_closure(RTL),
+ IsLeaf = hipe_rtl:rtl_is_leaf(RTL),
+ hipe_sparc:mk_defun(hipe_rtl:rtl_fun(RTL),
+ Formals,
+ IsClosure,
+ IsLeaf,
+ Code,
+ NewData,
+ [],
+ []).
+
+conv_insn_list([H|T], Map, Data) ->
+ {NewH, NewMap, NewData1} = conv_insn(H, Map, Data),
+ %% io:format("~w \n ==>\n ~w\n- - - - - - - - -\n",[H,NewH]),
+ {NewT, NewData2} = conv_insn_list(T, NewMap, NewData1),
+ {NewH ++ NewT, NewData2};
+conv_insn_list([], _, Data) ->
+ {[], Data}.
+
+conv_insn(I, Map, Data) ->
+ case I of
+ #alu{} -> conv_alu(I, Map, Data);
+ #alub{} -> conv_alub(I, Map, Data);
+ #branch{} -> conv_branch(I, Map, Data);
+ #call{} -> conv_call(I, Map, Data);
+ #comment{} -> conv_comment(I, Map, Data);
+ #enter{} -> conv_enter(I, Map, Data);
+ #goto{} -> conv_goto(I, Map, Data);
+ #label{} -> conv_label(I, Map, Data);
+ #load{} -> conv_load(I, Map, Data);
+ #load_address{} -> conv_load_address(I, Map, Data);
+ #load_atom{} -> conv_load_atom(I, Map, Data);
+ #move{} -> conv_move(I, Map, Data);
+ #return{} -> conv_return(I, Map, Data);
+ #store{} -> conv_store(I, Map, Data);
+ #switch{} -> conv_switch(I, Map, Data); % XXX: only switch uses/updates Data
+ #fconv{} -> conv_fconv(I, Map, Data);
+ #fmove{} -> conv_fmove(I, Map, Data);
+ #fload{} -> conv_fload(I, Map, Data);
+ #fstore{} -> conv_fstore(I, Map, Data);
+ #fp{} -> conv_fp_binary(I, Map, Data);
+ #fp_unop{} -> conv_fp_unary(I, Map, Data);
+ _ -> exit({?MODULE,conv_insn,I})
+ end.
+
+conv_fconv(I, Map, Data) ->
+ %% Dst := (double)Src, where Dst is FP reg and Src is int reg
+ {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), % exclude imm src
+ {Dst, Map2} = conv_fpreg(hipe_rtl:fconv_dst(I), Map1),
+ I2 = mk_fconv(Src, Dst),
+ {I2, Map2, Data}.
+
+mk_fconv(Src, Dst) ->
+ CSP = hipe_sparc:mk_temp(14, 'untagged'), % o6
+ Disp = hipe_sparc:mk_simm13(100),
+ [hipe_sparc:mk_store('stw', Src, CSP, Disp),
+ hipe_sparc:mk_pseudo_fload(CSP, Disp, Dst, true),
+ hipe_sparc:mk_fp_unary('fitod', Dst, Dst)].
+
+conv_fmove(I, Map, Data) ->
+ %% Dst := Src, where both Dst and Src are FP regs
+ {Src, Map1} = conv_fpreg(hipe_rtl:fmove_src(I), Map),
+ {Dst, Map2} = conv_fpreg(hipe_rtl:fmove_dst(I), Map1),
+ I2 = mk_fmove(Src, Dst),
+ {I2, Map2, Data}.
+
+mk_fmove(Src, Dst) ->
+ [hipe_sparc:mk_pseudo_fmove(Src, Dst)].
+
+conv_fload(I, Map, Data) ->
+ %% Dst := MEM[Base+Off], where Dst is FP reg
+ {Base1, Map1} = conv_src(hipe_rtl:fload_src(I), Map),
+ {Base2, Map2} = conv_src(hipe_rtl:fload_offset(I), Map1),
+ {Dst, Map3} = conv_fpreg(hipe_rtl:fload_dst(I), Map2),
+ I2 = mk_fload(Base1, Base2, Dst),
+ {I2, Map3, Data}.
+
+mk_fload(Base1, Base2, Dst) ->
+ case hipe_sparc:is_temp(Base1) of
+ true ->
+ case hipe_sparc:is_temp(Base2) of
+ true ->
+ mk_fload_rr(Base1, Base2, Dst);
+ _ ->
+ mk_fload_ri(Base1, Base2, Dst)
+ end;
+ _ ->
+ case hipe_sparc:is_temp(Base2) of
+ true ->
+ mk_fload_ri(Base2, Base1, Dst);
+ _ ->
+ mk_fload_ii(Base1, Base2, Dst)
+ end
+ end.
+
+mk_fload_rr(Base1, Base2, Dst) ->
+ Tmp = new_untagged_temp(),
+ Disp = hipe_sparc:mk_simm13(0),
+ [hipe_sparc:mk_alu('add', Base1, Base2, Tmp),
+ hipe_sparc:mk_pseudo_fload(Tmp, Disp, Dst, false)].
+
+mk_fload_ii(Base1, Base2, Dst) ->
+ io:format("~w: RTL fload with two immediates\n", [?MODULE]),
+ Tmp = new_untagged_temp(),
+ mk_set(Base1, Tmp,
+ mk_fload_ri(Tmp, Base2, Dst)).
+
+mk_fload_ri(Base, Disp, Dst) ->
+ hipe_sparc:mk_fload(Base, Disp, Dst, 'new').
+
+conv_fstore(I, Map, Data) ->
+ %% MEM[Base+Off] := Src, where Src is FP reg
+ {Base1, Map1} = conv_dst(hipe_rtl:fstore_base(I), Map),
+ {Base2, Map2} = conv_src(hipe_rtl:fstore_offset(I), Map1),
+ {Src, Map3} = conv_fpreg(hipe_rtl:fstore_src(I), Map2),
+ I2 = mk_fstore(Src, Base1, Base2),
+ {I2, Map3, Data}.
+
+mk_fstore(Src, Base1, Base2) ->
+ case hipe_sparc:is_temp(Base2) of
+ true ->
+ mk_fstore_rr(Src, Base1, Base2);
+ _ ->
+ mk_fstore_ri(Src, Base1, Base2)
+ end.
+
+mk_fstore_rr(Src, Base1, Base2) ->
+ Tmp = new_untagged_temp(),
+ Disp = hipe_sparc:mk_simm13(0),
+ [hipe_sparc:mk_alu('add', Base1, Base2, Tmp),
+ hipe_sparc:mk_pseudo_fstore(Src, Tmp, Disp)].
+
+mk_fstore_ri(Src, Base, Disp) ->
+ hipe_sparc:mk_fstore(Src, Base, Disp, 'new').
+
+conv_fp_binary(I, Map, Data) ->
+ {Src1, Map1} = conv_fpreg(hipe_rtl:fp_src1(I), Map),
+ {Src2, Map2} = conv_fpreg(hipe_rtl:fp_src2(I), Map1),
+ {Dst, Map3} = conv_fpreg(hipe_rtl:fp_dst(I), Map2),
+ RtlFpOp = hipe_rtl:fp_op(I),
+ I2 = mk_fp_binary(RtlFpOp, Src1, Src2, Dst),
+ {I2, Map3, Data}.
+
+mk_fp_binary(RtlFpOp, Src1, Src2, Dst) ->
+ FpBinOp =
+ case RtlFpOp of
+ 'fadd' -> 'faddd';
+ 'fdiv' -> 'fdivd';
+ 'fmul' -> 'fmuld';
+ 'fsub' -> 'fsubd'
+ end,
+ [hipe_sparc:mk_fp_binary(FpBinOp, Src1, Src2, Dst)].
+
+conv_fp_unary(I, Map, Data) ->
+ {Src, Map1} = conv_fpreg(hipe_rtl:fp_unop_src(I), Map),
+ {Dst, Map2} = conv_fpreg(hipe_rtl:fp_unop_dst(I), Map1),
+ RtlFpUnOp = hipe_rtl:fp_unop_op(I),
+ I2 = mk_fp_unary(RtlFpUnOp, Src, Dst),
+ {I2, Map2, Data}.
+
+mk_fp_unary(RtlFpUnOp, Src, Dst) ->
+ FpUnOp =
+ case RtlFpUnOp of
+ 'fchs' -> 'fnegd'
+ end,
+ [hipe_sparc:mk_fp_unary(FpUnOp, Src, Dst)].
+
+conv_alu(I, Map, Data) ->
+ %% dst = src1 aluop src2
+ {Dst, Map0} = conv_dst(hipe_rtl:alu_dst(I), Map),
+ {Src1, Map1} = conv_src(hipe_rtl:alu_src1(I), Map0),
+ {Src2, Map2} = conv_src(hipe_rtl:alu_src2(I), Map1),
+ AluOp = conv_aluop(hipe_rtl:alu_op(I)),
+ {I2, _DidCommute} = mk_alu(AluOp, Src1, Src2, Dst),
+ {I2, Map2, Data}.
+
+mk_alu(XAluOp, Src1, Src2, Dst) ->
+ case hipe_sparc:is_temp(Src1) of
+ true ->
+ case hipe_sparc:is_temp(Src2) of
+ true ->
+ {mk_alu_rs(XAluOp, Src1, Src2, Dst),
+ false};
+ _ ->
+ {mk_alu_ri(XAluOp, Src1, Src2, Dst),
+ false}
+ end;
+ _ ->
+ case hipe_sparc:is_temp(Src2) of
+ true ->
+ mk_alu_ir(XAluOp, Src1, Src2, Dst);
+ _ ->
+ {mk_alu_ii(XAluOp, Src1, Src2, Dst),
+ false}
+ end
+ end.
+
+mk_alu_ii(XAluOp, Src1, Src2, Dst) ->
+ io:format("~w: ALU with two immediates (~w ~w ~w ~w)\n",
+ [?MODULE, XAluOp, Src1, Src2, Dst]),
+ Tmp = new_untagged_temp(),
+ mk_set(Src1, Tmp,
+ mk_alu_ri(XAluOp, Tmp, Src2, Dst)).
+
+mk_alu_ir(XAluOp, Src1, Src2, Dst) ->
+ case xaluop_commutes(XAluOp) of
+ true ->
+ {mk_alu_ri(XAluOp, Src2, Src1, Dst),
+ true};
+ _ ->
+ Tmp = new_untagged_temp(),
+ {mk_set(Src1, Tmp,
+ mk_alu_rs(XAluOp, Tmp, Src2, Dst)),
+ false}
+ end.
+
+mk_alu_ri(XAluOp, Src1, Src2, Dst) ->
+ case xaluop_is_shift(XAluOp) of
+ true ->
+ mk_shift_ri(XAluOp, Src1, Src2, Dst);
+ false ->
+ mk_arith_ri(XAluOp, Src1, Src2, Dst)
+ end.
+
+mk_shift_ri(XShiftOp, Src1, Src2, Dst) when is_integer(Src2) ->
+ if Src2 >= 0, Src2 < 32 -> % XXX: sparc64: < 64
+ mk_alu_rs(XShiftOp, Src1, hipe_sparc:mk_uimm5(Src2), Dst);
+ true ->
+ exit({?MODULE,mk_shift_ri,Src2}) % excessive shifts are errors
+ end.
+
+mk_arith_ri(XAluOp, Src1, Src2, Dst) when is_integer(Src2) ->
+ if -4096 =< Src2, Src2 < 4096 ->
+ mk_alu_rs(XAluOp, Src1, hipe_sparc:mk_simm13(Src2), Dst);
+ true ->
+ Tmp = new_untagged_temp(),
+ mk_set(Src2, Tmp,
+ mk_alu_rs(XAluOp, Src1, Tmp, Dst))
+ end.
+
+mk_alu_rs(XAluOp, Src1, Src2, Dst) ->
+ [hipe_sparc:mk_alu(xaluop_normalise(XAluOp), Src1, Src2, Dst)].
+
+conv_alub(I, Map, Data) ->
+ %% dst = src1 aluop src2; if COND goto label
+ {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map),
+ {Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0),
+ {Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1),
+ Cond = conv_cond(hipe_rtl:alub_cond(I)),
+ RtlAlubOp = hipe_rtl:alub_op(I),
+ I2 =
+ case RtlAlubOp of
+ 'mul' ->
+ %% To check for overflow in 32x32->32 multiplication:
+ %% smul Src1,Src2,Dst % Dst is lo32(Res), %y is %hi32(Res)
+ %% rd %y,TmpHi
+ %% sra Dst,31,TmpSign % fill TmpSign with sign of Dst
+ %% subcc TmpSign,TmpHi,%g0
+ %% [bne OverflowLabel]
+ NewCond =
+ case Cond of
+ vs -> ne;
+ vc -> eq
+ end,
+ TmpHi = hipe_sparc:mk_new_temp('untagged'),
+ TmpSign = hipe_sparc:mk_new_temp('untagged'),
+ G0 = hipe_sparc:mk_g0(),
+ {I1, _DidCommute} = mk_alu('smul', Src1, Src2, Dst),
+ I1 ++
+ [hipe_sparc:mk_rdy(TmpHi),
+ hipe_sparc:mk_alu('sra', Dst, hipe_sparc:mk_uimm5(31), TmpSign) |
+ conv_alub2(G0, TmpSign, 'sub', NewCond, TmpHi, I)];
+ _ ->
+ conv_alub2(Dst, Src1, RtlAlubOp, Cond, Src2, I)
+ end,
+ {I2, Map2, Data}.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+conv_alub2(Dst, Src1, RtlAlubOp, Cond, Src2, I) ->
+ case conv_cond_rcond(Cond) of
+ [] ->
+ conv_alub_bp(Dst, Src1, RtlAlubOp, Cond, Src2, I);
+ RCond ->
+ conv_alub_br(Dst, Src1, RtlAlubOp, RCond, Src2, I)
+ end.
+
+conv_alub_br(Dst, Src1, RtlAlubOp, RCond, Src2, I) ->
+ TrueLab = hipe_rtl:alub_true_label(I),
+ FalseLab = hipe_rtl:alub_false_label(I),
+ Pred = hipe_rtl:alub_pred(I),
+ %% "Dst = Src1 AluOp Src2; if COND" becomes
+ %% "Dst = Src1 AluOp Src2; if-COND(Dst)"
+ {I2, _DidCommute} = mk_alu(conv_alubop_nocc(RtlAlubOp), Src1, Src2, Dst),
+ I2 ++ mk_pseudo_br(RCond, Dst, TrueLab, FalseLab, Pred).
+
+conv_cond_rcond(Cond) ->
+ case Cond of
+ 'e' -> 'z';
+ 'ne' -> 'nz';
+ 'g' -> 'gz';
+ 'ge' -> 'gez';
+ 'l' -> 'lz';
+ 'le' -> 'lez';
+ _ -> [] % vs, vc, gu, geu, lu, leu
+ end.
+
+conv_alubop_nocc(RtlAlubOp) ->
+ case RtlAlubOp of
+ 'add' -> 'add';
+ 'sub' -> 'sub';
+ %% mul: handled elsewhere
+ 'or' -> 'or';
+ 'and' -> 'and';
+ 'xor' -> 'xor'
+ %% no shift ops
+ end.
+
+mk_pseudo_br(RCond, Dst, TrueLab, FalseLab, Pred) ->
+ [hipe_sparc:mk_pseudo_br(RCond, Dst, TrueLab, FalseLab, Pred)].
+-else.
+conv_alub2(Dst, Src1, RtlAlubOp, Cond, Src2, I) ->
+ conv_alub_bp(Dst, Src1, RtlAlubOp, Cond, Src2, I).
+-endif.
+
+conv_alub_bp(Dst, Src1, RtlAlubOp, Cond, Src2, I) ->
+ TrueLab = hipe_rtl:alub_true_label(I),
+ FalseLab = hipe_rtl:alub_false_label(I),
+ Pred = hipe_rtl:alub_pred(I),
+ %% "Dst = Src1 AluOp Src2; if COND" becomes
+ %% "Dst = Src1 AluOpCC Src22; if-COND(CC)"
+ {I2, _DidCommute} = mk_alu(conv_alubop_cc(RtlAlubOp), Src1, Src2, Dst),
+ I2 ++ mk_pseudo_bp(Cond, TrueLab, FalseLab, Pred).
+
+conv_alubop_cc(RtlAlubOp) ->
+ case RtlAlubOp of
+ 'add' -> 'addcc';
+ 'sub' -> 'subcc';
+ %% mul: handled elsewhere
+ 'or' -> 'orcc';
+ 'and' -> 'andcc';
+ 'xor' -> 'xorcc'
+ %% no shift ops
+ end.
+
+conv_branch(I, Map, Data) ->
+ %% <unused> = src1 - src2; if COND goto label
+ {Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map),
+ {Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0),
+ Cond = conv_cond(hipe_rtl:branch_cond(I)),
+ I2 = conv_branch2(Src1, Cond, Src2, I),
+ {I2, Map1, Data}.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+conv_branch2(Src1, Cond, Src2, I) ->
+ case conv_cond_rcond(Cond) of
+ [] ->
+ conv_branch_bp(Src1, Cond, Src2, I);
+ RCond ->
+ conv_branch_br(Src1, RCond, Src2, I)
+ end.
+
+conv_branch_br(Src1, RCond, Src2, I) ->
+ TrueLab = hipe_rtl:branch_true_label(I),
+ FalseLab = hipe_rtl:branch_false_label(I),
+ Pred = hipe_rtl:branch_pred(I),
+ %% "if src1-COND-src2" becomes
+ %% "sub src1,src2,tmp; if-COND(tmp)"
+ Dst = hipe_sparc:mk_new_temp('untagged'),
+ XAluOp = 'cmp', % == a sub that commutes
+ {I1, DidCommute} = mk_alu(XAluOp, Src1, Src2, Dst),
+ NewRCond =
+ case DidCommute of
+ true -> commute_rcond(RCond);
+ false -> RCond
+ end,
+ I1 ++ mk_pseudo_br(NewRCond, Dst, TrueLab, FalseLab, Pred).
+
+commute_rcond(RCond) -> % if x RCond y, then y commute_rcond(RCond) x
+ case RCond of
+ 'z' -> 'z'; % ==, ==
+ 'nz' -> 'nz'; % !=, !=
+ 'gz' -> 'lz'; % >, <
+ 'gez' -> 'lez'; % >=, <=
+ 'lz' -> 'gz'; % <, >
+ 'lez' -> 'gez' % <=, >=
+ end.
+-else.
+conv_branch2(Src1, Cond, Src2, I) ->
+ conv_branch_bp(Src1, Cond, Src2, I).
+-endif.
+
+conv_branch_bp(Src1, Cond, Src2, I) ->
+ TrueLab = hipe_rtl:branch_true_label(I),
+ FalseLab = hipe_rtl:branch_false_label(I),
+ Pred = hipe_rtl:branch_pred(I),
+ %% "if src1-COND-src2" becomes
+ %% "subcc src1,src2,%g0; if-COND(CC)"
+ Dst = hipe_sparc:mk_g0(),
+ XAluOp = 'cmpcc', % == a subcc that commutes
+ {I1, DidCommute} = mk_alu(XAluOp, Src1, Src2, Dst),
+ NewCond =
+ case DidCommute of
+ true -> commute_cond(Cond);
+ false -> Cond
+ end,
+ I1 ++ mk_pseudo_bp(NewCond, TrueLab, FalseLab, Pred).
+
+conv_call(I, Map, Data) ->
+ {Args, Map0} = conv_src_list(hipe_rtl:call_arglist(I), Map),
+ {Dsts, Map1} = conv_dst_list(hipe_rtl:call_dstlist(I), Map0),
+ {Fun, Map2} = conv_fun(hipe_rtl:call_fun(I), Map1),
+ ContLab = hipe_rtl:call_continuation(I),
+ ExnLab = hipe_rtl:call_fail(I),
+ Linkage = hipe_rtl:call_type(I),
+ I2 = mk_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage),
+ {I2, Map2, Data}.
+
+mk_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_sparc:is_prim(Fun) of
+ true ->
+ mk_primop_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage);
+ false ->
+ mk_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage)
+ end.
+
+mk_primop_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_sparc:prim_prim(Prim) of
+ %% no SPARC-specific primops defined yet
+ _ ->
+ mk_general_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage)
+ end.
+
+mk_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ %% The backend does not support pseudo_calls without a
+ %% continuation label, so we make sure each call has one.
+ {RealContLab, Tail} =
+ case mk_call_results(Dsts) of
+ [] ->
+ %% Avoid consing up a dummy basic block if the moves list
+ %% is empty, as is typical for calls to suspend/0.
+ %% This should be subsumed by a general "optimise the CFG"
+ %% module, and could probably be removed.
+ case ContLab of
+ [] ->
+ NewContLab = hipe_gensym:get_next_label(sparc),
+ {NewContLab, [hipe_sparc:mk_label(NewContLab)]};
+ _ ->
+ {ContLab, []}
+ end;
+ Moves ->
+ %% Change the call to continue at a new basic block.
+ %% In this block move the result registers to the Dsts,
+ %% then continue at the call's original continuation.
+ NewContLab = hipe_gensym:get_next_label(sparc),
+ case ContLab of
+ [] ->
+ %% This is just a fallthrough
+ %% No jump back after the moves.
+ {NewContLab,
+ [hipe_sparc:mk_label(NewContLab) |
+ Moves]};
+ _ ->
+ %% The call has a continuation. Jump to it.
+ {NewContLab,
+ [hipe_sparc:mk_label(NewContLab) |
+ Moves ++
+ [hipe_sparc:mk_b_label(ContLab)]]}
+ end
+ end,
+ SDesc = hipe_sparc:mk_sdesc(ExnLab, 0, length(Args), {}),
+ CallInsn = hipe_sparc:mk_pseudo_call(Fun, SDesc, RealContLab, Linkage),
+ {RegArgs,StkArgs} = split_args(Args),
+ mk_push_args(StkArgs, move_actuals(RegArgs, [CallInsn | Tail])).
+
+mk_call_results(Dsts) ->
+ case Dsts of
+ [] -> [];
+ [Dst] ->
+ RV = hipe_sparc:mk_rv(),
+ [hipe_sparc:mk_pseudo_move(RV, Dst)]
+ end.
+
+mk_push_args(StkArgs, Tail) ->
+ case length(StkArgs) of
+ 0 ->
+ Tail;
+ NrStkArgs ->
+ [hipe_sparc:mk_pseudo_call_prepare(NrStkArgs) |
+ mk_store_args(StkArgs, NrStkArgs * word_size(), Tail)]
+ end.
+
+mk_store_args([Arg|Args], PrevOffset, Tail) ->
+ Offset = PrevOffset - word_size(),
+ {Src,FixSrc} =
+ case hipe_sparc:is_temp(Arg) of
+ true ->
+ {Arg, []};
+ _ ->
+ Tmp = new_tagged_temp(),
+ {Tmp, mk_set(Arg, Tmp)}
+ end,
+ %% XXX: sparc64: stx
+ Store = hipe_sparc:mk_store('stw', Src, hipe_sparc:mk_sp(), hipe_sparc:mk_simm13(Offset)),
+ mk_store_args(Args, Offset, FixSrc ++ [Store | Tail]);
+mk_store_args([], _, Tail) ->
+ Tail.
+
+conv_comment(I, Map, Data) ->
+ I2 = [hipe_sparc:mk_comment(hipe_rtl:comment_text(I))],
+ {I2, Map, Data}.
+
+conv_enter(I, Map, Data) ->
+ {Args, Map0} = conv_src_list(hipe_rtl:enter_arglist(I), Map),
+ {Fun, Map1} = conv_fun(hipe_rtl:enter_fun(I), Map0),
+ I2 = mk_enter(Fun, Args, hipe_rtl:enter_type(I)),
+ {I2, Map1, Data}.
+
+mk_enter(Fun, Args, Linkage) ->
+ Arity = length(Args),
+ {RegArgs,StkArgs} = split_args(Args),
+ move_actuals(RegArgs,
+ [hipe_sparc:mk_pseudo_tailcall_prepare(),
+ hipe_sparc:mk_pseudo_tailcall(Fun, Arity, StkArgs, Linkage)]).
+
+conv_goto(I, Map, Data) ->
+ I2 = [hipe_sparc:mk_b_label(hipe_rtl:goto_label(I))],
+ {I2, Map, Data}.
+
+conv_label(I, Map, Data) ->
+ I2 = [hipe_sparc:mk_label(hipe_rtl:label_name(I))],
+ {I2, Map, Data}.
+
+conv_load(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_dst(I), Map),
+ {Base1, Map1} = conv_src(hipe_rtl:load_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:load_offset(I), Map1),
+ LdOp = conv_ldop(hipe_rtl:load_size(I), hipe_rtl:load_sign(I)),
+ {I2, _DidCommute} = mk_alu(LdOp, Base1, Base2, Dst),
+ {I2, Map2, Data}.
+
+conv_ldop(LoadSize, LoadSign) ->
+ case LoadSize of
+ word -> 'lduw'; % XXX: sparc64: ldx
+ int32 -> 'lduw'; % XXX: sparc64: lduw or ldsw
+ int16 ->
+ case LoadSign of
+ signed -> 'ldsh';
+ unsigned -> 'lduh'
+ end;
+ byte ->
+ case LoadSign of
+ signed -> 'ldsb';
+ unsigned -> 'ldub'
+ end
+ end.
+
+conv_load_address(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_address_dst(I), Map),
+ Addr = hipe_rtl:load_address_addr(I),
+ Type = hipe_rtl:load_address_type(I),
+ Src = {Addr,Type},
+ I2 = [hipe_sparc:mk_pseudo_set(Src, Dst)],
+ {I2, Map0, Data}.
+
+conv_load_atom(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_atom_dst(I), Map),
+ Src = hipe_rtl:load_atom_atom(I),
+ I2 = [hipe_sparc:mk_pseudo_set(Src, Dst)],
+ {I2, Map0, Data}.
+
+conv_move(I, Map, Data) ->
+ {Dst, Map0} = conv_dst(hipe_rtl:move_dst(I), Map),
+ {Src, Map1} = conv_src(hipe_rtl:move_src(I), Map0),
+ I2 = mk_move(Src, Dst, []),
+ {I2, Map1, Data}.
+
+mk_move(Src, Dst, Tail) ->
+ case hipe_sparc:is_temp(Src) of
+ true -> [hipe_sparc:mk_pseudo_move(Src, Dst) | Tail];
+ _ -> mk_set(Src, Dst, Tail)
+ end.
+
+conv_return(I, Map, Data) ->
+ %% TODO: multiple-value returns
+ {[Arg], Map0} = conv_src_list(hipe_rtl:return_varlist(I), Map),
+ I2 = mk_move(Arg, hipe_sparc:mk_rv(),
+ [hipe_sparc:mk_pseudo_ret()]),
+ {I2, Map0, Data}.
+
+conv_store(I, Map, Data) ->
+ {Base1, Map0} = conv_dst(hipe_rtl:store_base(I), Map), % no immediates allowed
+ {Src, Map1} = conv_src(hipe_rtl:store_src(I), Map0),
+ {Base2, Map2} = conv_src(hipe_rtl:store_offset(I), Map1),
+ StOp = conv_stop(hipe_rtl:store_size(I)),
+ I2 = mk_store(StOp, Src, Base1, Base2),
+ {I2, Map2, Data}.
+
+conv_stop(StoreSize) ->
+ case StoreSize of
+ word -> 'stw'; % XXX: sparc64: stx
+ int32 -> 'stw';
+ byte -> 'stb'
+ end.
+
+mk_store(StOp, Src, Base1, Base2) ->
+ case hipe_sparc:is_temp(Src) of
+ true ->
+ mk_store2(StOp, Src, Base1, Base2);
+ _ ->
+ Tmp = new_untagged_temp(),
+ mk_set(Src, Tmp,
+ mk_store2(StOp, Tmp, Base1, Base2))
+ end.
+
+mk_store2(StOp, Src, Base1, Base2) ->
+ case hipe_sparc:is_temp(Base2) of
+ true ->
+ mk_store_rr(StOp, Src, Base1, Base2);
+ _ ->
+ mk_store_ri(StOp, Src, Base1, Base2)
+ end.
+
+mk_store_ri(StOp, Src, Base, Disp) ->
+ hipe_sparc:mk_store(StOp, Src, Base, Disp, 'new', []).
+
+mk_store_rr(StOp, Src, Base1, Base2) ->
+ [hipe_sparc:mk_store(StOp, Src, Base1, Base2)].
+
+conv_switch(I, Map, Data) ->
+ Labels = hipe_rtl:switch_labels(I),
+ LMap = [{label,L} || L <- Labels],
+ {NewData, JTabLab} =
+ case hipe_rtl:switch_sort_order(I) of
+ [] ->
+ hipe_consttab:insert_block(Data, word, LMap);
+ SortOrder ->
+ hipe_consttab:insert_sorted_block(
+ Data, word, LMap, SortOrder)
+ end,
+ %% no immediates allowed here
+ {IndexR, Map1} = conv_dst(hipe_rtl:switch_src(I), Map),
+ JTabR = new_untagged_temp(),
+ OffsetR = new_untagged_temp(),
+ DestR = new_untagged_temp(),
+ I2 =
+ [hipe_sparc:mk_pseudo_set({JTabLab,constant}, JTabR),
+ %% XXX: sparc64: << 3
+ hipe_sparc:mk_alu('sll', IndexR, hipe_sparc:mk_uimm5(2), OffsetR),
+ %% XXX: sparc64: ldx
+ hipe_sparc:mk_alu('lduw', JTabR, OffsetR, DestR),
+ hipe_sparc:mk_jmp(DestR, hipe_sparc:mk_simm13(0), Labels)],
+ {I2, Map1, NewData}.
+
+%%% Create a conditional branch.
+
+mk_pseudo_bp(Cond, TrueLabel, FalseLabel, Pred) ->
+ [hipe_sparc:mk_pseudo_bp(Cond, TrueLabel, FalseLabel, Pred)].
+
+%%% Load an integer constant into a register.
+
+mk_set(Value, Dst) -> mk_set(Value, Dst, []).
+
+mk_set(Value, Dst, Tail) ->
+ hipe_sparc:mk_set(Value, Dst, Tail).
+
+%%% Convert an RTL ALU op.
+
+conv_aluop(RtlAluOp) ->
+ case RtlAluOp of
+ 'add' -> 'add';
+ 'sub' -> 'sub';
+ 'mul' -> 'mulx';
+ 'or' -> 'or';
+ 'and' -> 'and';
+ 'xor' -> 'xor';
+ 'sll' -> 'sll'; % XXX: sparc64: sllx
+ 'srl' -> 'srl'; % XXX: sparc64: srlx
+ 'sra' -> 'sra' % XXX: sparc64: srax
+ end.
+
+%%% Check if an extended SPARC AluOp commutes.
+
+xaluop_commutes(XAluOp) ->
+ case XAluOp of
+ 'cmp' -> true;
+ 'cmpcc' -> true;
+ 'add' -> true;
+ 'addcc' -> true;
+ 'and' -> true;
+ 'andcc' -> true;
+ 'or' -> true;
+ 'orcc' -> true;
+ 'xor' -> true;
+ 'xorcc' -> true;
+ 'sub' -> false;
+ 'subcc' -> false;
+ 'mulx' -> true;
+ 'smul' -> true;
+ 'sll' -> false;
+ 'srl' -> false;
+ 'sra' -> false;
+ 'sllx' -> false;
+ 'srlx' -> false;
+ 'srax' -> false;
+ 'ldsb' -> true;
+ 'ldsh' -> true;
+ 'ldsw' -> true;
+ 'ldub' -> true;
+ 'lduh' -> true;
+ 'lduw' -> true;
+ 'ldx' -> true
+ end.
+
+%%% Check if an extended SPARC AluOp is a shift.
+
+xaluop_is_shift(XAluOp) ->
+ case XAluOp of
+ 'sll' -> true;
+ 'srl' -> true;
+ 'sra' -> true;
+ 'sllx' -> true;
+ 'srlx' -> true;
+ 'srax' -> true;
+ _ -> false
+ end.
+
+%%% Convert an extended SPARC AluOp back to a plain AluOp.
+%%% This just maps cmp{,cc} to sub{,cc}.
+
+xaluop_normalise(XAluOp) ->
+ case XAluOp of
+ 'cmp' -> 'sub';
+ 'cmpcc' -> 'subcc';
+ _ -> XAluOp
+ end.
+
+%%% Convert an RTL condition code.
+
+conv_cond(RtlCond) ->
+ case RtlCond of
+ eq -> 'e';
+ ne -> 'ne';
+ gt -> 'g';
+ gtu -> 'gu'; % >u
+ ge -> 'ge';
+ geu -> 'geu'; % >=u
+ lt -> 'l';
+ ltu -> 'lu'; % <u
+ le -> 'le';
+ leu -> 'leu'; % <=u
+ overflow -> 'vs';
+ not_overflow -> 'vc'
+ end.
+
+%%% Commute a SPARC condition code.
+
+commute_cond(Cond) -> % if x Cond y, then y commute_cond(Cond) x
+ case Cond of
+ 'e' -> 'e'; % ==, ==
+ 'ne' -> 'ne'; % !=, !=
+ 'g' -> 'l'; % >, <
+ 'ge' -> 'le'; % >=, <=
+ 'l' -> 'g'; % <, >
+ 'le' -> 'ge'; % <=, >=
+ 'gu' -> 'lu'; % >u, <u
+ 'geu' -> 'leu'; % >=u, <=u
+ 'lu' -> 'gu'; % <u, >u
+ 'leu' -> 'geu' % <=u, >=u
+ %% vs/vc: n/a
+ end.
+
+%%% Split a list of formal or actual parameters into the
+%%% part passed in registers and the part passed on the stack.
+%%% The parameters passed in registers are also tagged with
+%%% the corresponding registers.
+
+split_args(Args) ->
+ split_args(0, hipe_sparc_registers:nr_args(), Args, []).
+
+split_args(I, N, [Arg|Args], RegArgs) when I < N ->
+ Reg = hipe_sparc_registers:arg(I),
+ Temp = hipe_sparc:mk_temp(Reg, 'tagged'),
+ split_args(I+1, N, Args, [{Arg,Temp}|RegArgs]);
+split_args(_, _, StkArgs, RegArgs) ->
+ {RegArgs, StkArgs}.
+
+%%% Convert a list of actual parameters passed in
+%%% registers (from split_args/1) to a list of moves.
+
+move_actuals([{Src,Dst}|Actuals], Rest) ->
+ move_actuals(Actuals, mk_move(Src, Dst, Rest));
+move_actuals([], Rest) ->
+ Rest.
+
+%%% Convert a list of formal parameters passed in
+%%% registers (from split_args/1) to a list of moves.
+
+move_formals([{Dst,Src}|Formals], Rest) ->
+ move_formals(Formals, [hipe_sparc:mk_pseudo_move(Src, Dst) | Rest]);
+move_formals([], Rest) ->
+ Rest.
+
+%%% Convert a 'fun' operand (MFA, prim, or temp)
+
+conv_fun(Fun, Map) ->
+ case hipe_rtl:is_var(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ case hipe_rtl:is_reg(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ if is_atom(Fun) ->
+ {hipe_sparc:mk_prim(Fun), Map};
+ true ->
+ {conv_mfa(Fun), Map}
+ end
+ end
+ end.
+
+%%% Convert an MFA operand.
+
+conv_mfa({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) ->
+ hipe_sparc:mk_mfa(M, F, A).
+
+%%% Convert an RTL source operand (imm/var/reg).
+%%% Returns a temp or a naked integer.
+
+conv_src(Opnd, Map) ->
+ case hipe_rtl:is_imm(Opnd) of
+ true ->
+ Value = hipe_rtl:imm_value(Opnd),
+ if is_integer(Value) ->
+ {Value, Map}
+ end;
+ false ->
+ conv_dst(Opnd, Map)
+ end.
+
+conv_src_list([O|Os], Map) ->
+ {V, Map1} = conv_src(O, Map),
+ {Vs, Map2} = conv_src_list(Os, Map1),
+ {[V|Vs], Map2};
+conv_src_list([], Map) ->
+ {[], Map}.
+
+%%% Convert an RTL destination operand (var/reg).
+
+conv_fpreg(Opnd, Map) ->
+ true = hipe_rtl:is_fpreg(Opnd),
+ conv_dst(Opnd, Map).
+
+conv_dst(Opnd, Map) ->
+ {Name, Type} =
+ case hipe_rtl:is_var(Opnd) of
+ true ->
+ {hipe_rtl:var_index(Opnd), 'tagged'};
+ false ->
+ case hipe_rtl:is_fpreg(Opnd) of
+ true ->
+ {hipe_rtl:fpreg_index(Opnd), 'double'};
+ false ->
+ {hipe_rtl:reg_index(Opnd), 'untagged'}
+ end
+ end,
+ IsPrecoloured =
+ case Type of
+ 'double' -> false; %hipe_sparc_registers:is_precoloured_fpr(Name);
+ _ -> hipe_sparc_registers:is_precoloured_gpr(Name)
+ end,
+ case IsPrecoloured of
+ true ->
+ {hipe_sparc:mk_temp(Name, Type), Map};
+ false ->
+ case vmap_lookup(Map, Opnd) of
+ {value, NewTemp} ->
+ {NewTemp, Map};
+ _ ->
+ NewTemp = hipe_sparc:mk_new_temp(Type),
+ {NewTemp, vmap_bind(Map, Opnd, NewTemp)}
+ end
+ end.
+
+conv_dst_list([O|Os], Map) ->
+ {Dst, Map1} = conv_dst(O, Map),
+ {Dsts, Map2} = conv_dst_list(Os, Map1),
+ {[Dst|Dsts], Map2};
+conv_dst_list([], Map) ->
+ {[], Map}.
+
+conv_formals(Os, Map) ->
+ conv_formals(hipe_sparc_registers:nr_args(), Os, Map, []).
+
+conv_formals(N, [O|Os], Map, Res) ->
+ Type =
+ case hipe_rtl:is_var(O) of
+ true -> 'tagged';
+ _ -> 'untagged'
+ end,
+ Dst =
+ if N > 0 -> hipe_sparc:mk_new_temp(Type); % allocatable
+ true -> hipe_sparc:mk_new_nonallocatable_temp(Type)
+ end,
+ Map1 = vmap_bind(Map, O, Dst),
+ conv_formals(N-1, Os, Map1, [Dst|Res]);
+conv_formals(_, [], Map, Res) ->
+ {lists:reverse(Res), Map}.
+
+%%% new_untagged_temp -- conjure up an untagged scratch reg
+
+new_untagged_temp() ->
+ hipe_sparc:mk_new_temp('untagged').
+
+%%% new_tagged_temp -- conjure up a tagged scratch reg
+
+new_tagged_temp() ->
+ hipe_sparc:mk_new_temp('tagged').
+
+%%% Map from RTL var/reg operands to temps.
+
+vmap_empty() ->
+ gb_trees:empty().
+
+vmap_lookup(Map, Key) ->
+ gb_trees:lookup(Key, Map).
+
+vmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+word_size() ->
+ hipe_rtl_arch:word_size().
diff --git a/lib/hipe/sparc/hipe_sparc.erl b/lib/hipe/sparc/hipe_sparc.erl
new file mode 100644
index 0000000000..9fcb94afb6
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc.erl
@@ -0,0 +1,407 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc).
+-export([
+ mk_temp/2,
+ mk_new_temp/1,
+ mk_new_nonallocatable_temp/1,
+ is_temp/1,
+ temp_reg/1,
+ temp_type/1,
+ temp_is_allocatable/1,
+ temp_is_precoloured/1,
+
+ mk_g0/0,
+ mk_ra/0,
+ mk_rv/0,
+ mk_sp/0,
+ mk_temp1/0,
+ mk_temp2/0,
+
+ mk_simm13/1,
+ mk_uimm5/1,
+
+ mk_mfa/3,
+
+ mk_prim/1,
+ is_prim/1,
+ prim_prim/1,
+
+ mk_sdesc/4,
+
+ mk_alu/4,
+ mk_mov/2,
+ mk_load/6,
+
+ mk_bp/3,
+ mk_b_label/1,
+
+ %% mk_br/4,
+
+ mk_call_rec/3,
+
+ mk_call_tail/2,
+
+ mk_comment/1,
+
+ mk_label/1,
+ is_label/1,
+ label_label/1,
+
+ mk_jmp/3,
+ mk_jmpl/2,
+
+ mk_pseudo_bp/4,
+ negate_cond/1,
+
+ %% mk_pseudo_br/5,
+ %% negate_rcond/1,
+
+ mk_pseudo_call/4,
+ pseudo_call_contlab/1,
+ pseudo_call_funv/1,
+ pseudo_call_linkage/1,
+ pseudo_call_sdesc/1,
+
+ mk_pseudo_call_prepare/1,
+ pseudo_call_prepare_nrstkargs/1,
+
+ mk_pseudo_move/2,
+ is_pseudo_move/1,
+ pseudo_move_dst/1,
+ pseudo_move_src/1,
+
+ mk_pseudo_ret/0,
+
+ mk_pseudo_set/2,
+
+ mk_pseudo_tailcall/4,
+ pseudo_tailcall_funv/1,
+ pseudo_tailcall_linkage/1,
+ pseudo_tailcall_stkargs/1,
+
+ mk_pseudo_tailcall_prepare/0,
+
+ mk_rdy/1,
+
+ %% mk_sethi/2,
+ mk_nop/0,
+ mk_set/2,
+ mk_set/3,
+ mk_addi/4,
+
+ mk_store/4,
+ mk_store/6,
+
+ mk_fp_binary/4,
+
+ mk_fp_unary/3,
+
+ mk_pseudo_fload/4,
+ mk_fload/4,
+
+ mk_pseudo_fmove/2,
+ is_pseudo_fmove/1,
+ pseudo_fmove_src/1,
+ pseudo_fmove_dst/1,
+
+ mk_pseudo_fstore/3,
+ mk_fstore/4,
+
+ mk_defun/8,
+ defun_code/1,
+ defun_data/1,
+ defun_formals/1,
+ defun_is_closure/1,
+ defun_is_leaf/1,
+ defun_mfa/1,
+ defun_var_range/1
+ ]).
+
+-include("hipe_sparc.hrl").
+
+mk_temp(Reg, Type, Allocatable) ->
+ #sparc_temp{reg=Reg, type=Type, allocatable=Allocatable}.
+mk_temp(Reg, Type) -> mk_temp(Reg, Type, true).
+mk_new_temp(Type, Allocatable) ->
+ mk_temp(hipe_gensym:get_next_var(sparc), Type, Allocatable).
+mk_new_temp(Type) -> mk_new_temp(Type, true).
+mk_new_nonallocatable_temp(Type) -> mk_new_temp(Type, false).
+is_temp(X) -> case X of #sparc_temp{} -> true; _ -> false end.
+temp_reg(#sparc_temp{reg=Reg}) -> Reg.
+temp_type(#sparc_temp{type=Type}) -> Type.
+temp_is_allocatable(#sparc_temp{allocatable=A}) -> A.
+temp_is_precoloured(#sparc_temp{reg=Reg,type=Type}) ->
+ case Type of
+ %% 'double' -> hipe_sparc_registers:is_precoloured_fpr(Reg);
+ _ -> hipe_sparc_registers:is_precoloured_gpr(Reg)
+ end.
+
+mk_g0() -> mk_temp(hipe_sparc_registers:g0(), 'untagged').
+mk_ra() -> mk_temp(hipe_sparc_registers:return_address(), 'untagged').
+mk_rv() -> mk_temp(hipe_sparc_registers:return_value(), 'tagged').
+mk_sp() -> mk_temp(hipe_sparc_registers:stack_pointer(), 'untagged').
+mk_temp1() -> mk_temp(hipe_sparc_registers:temp1(), 'untagged').
+mk_temp2() -> mk_temp(hipe_sparc_registers:temp2(), 'untagged').
+
+mk_simm13(Value) -> #sparc_simm13{value=Value}.
+mk_uimm5(Value) -> #sparc_uimm5{value=Value}.
+mk_uimm22(Value) -> #sparc_uimm22{value=Value}.
+
+mk_mfa(M, F, A) -> #sparc_mfa{m=M, f=F, a=A}.
+
+mk_prim(Prim) -> #sparc_prim{prim=Prim}.
+is_prim(X) -> case X of #sparc_prim{} -> true; _ -> false end.
+prim_prim(#sparc_prim{prim=Prim}) -> Prim.
+
+mk_sdesc(ExnLab, FSize, Arity, Live) ->
+ #sparc_sdesc{exnlab=ExnLab, fsize=FSize, arity=Arity, live=Live}.
+
+mk_alu(AluOp, Src1, Src2, Dst) ->
+ #alu{aluop=AluOp, src1=Src1, src2=Src2, dst=Dst}.
+mk_mov(Src, Dst) -> mk_alu('or', mk_g0(), Src, Dst).
+
+mk_bp(Cond, Label, Pred) -> #bp{'cond'=Cond, label=Label, pred=Pred}.
+mk_b_label(Label) -> mk_bp('a', Label, 1.0).
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+mk_br(RCond, Src, Label, Pred) ->
+ #br{rcond=RCond, src=Src, label=Label, pred=Pred}.
+-endif.
+
+mk_call_rec(Fun, SDesc, Linkage) ->
+ #call_rec{'fun'=Fun, sdesc=SDesc, linkage=Linkage}.
+
+mk_call_tail(Fun, Linkage) -> #call_tail{'fun'=Fun, linkage=Linkage}.
+
+mk_comment(Term) -> #comment{term=Term}.
+
+mk_label(Label) -> #label{label=Label}.
+is_label(I) -> case I of #label{} -> true; _ -> false end.
+label_label(#label{label=Label}) -> Label.
+
+mk_jmp(Src1, Src2, Labels) -> #jmp{src1=Src1, src2=Src2, labels=Labels}.
+
+mk_jmpl(Src, SDesc) -> #jmpl{src=Src, sdesc=SDesc}.
+
+mk_pseudo_bp(Cond, TrueLab, FalseLab, Pred) ->
+ if Pred >= 0.5 ->
+ mk_pseudo_bp_simple(negate_cond(Cond), FalseLab,
+ TrueLab, 1.0-Pred);
+ true ->
+ mk_pseudo_bp_simple(Cond, TrueLab, FalseLab, Pred)
+ end.
+
+mk_pseudo_bp_simple(Cond, TrueLab, FalseLab, Pred) when Pred =< 0.5 ->
+ #pseudo_bp{'cond'=Cond, true_label=TrueLab,
+ false_label=FalseLab, pred=Pred}.
+
+negate_cond(Cond) ->
+ case Cond of
+ 'l' -> 'ge'; % <, >=
+ 'ge' -> 'l'; % >=, <
+ 'g' -> 'le'; % >, <=
+ 'le' -> 'g'; % <=, >
+ 'e' -> 'ne'; % ==, !=
+ 'ne' -> 'e'; % !=, ==
+ 'gu' -> 'leu'; % >u, <=u
+ 'leu'-> 'gu'; % <=u, >u
+ 'geu'-> 'lu'; % >=u, <u
+ 'lu' -> 'geu'; % <u, >=u
+ 'vs' -> 'vc'; % overflow, not_overflow
+ 'vc' -> 'vs' % not_overflow, overflow
+ end.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+mk_pseudo_br(RCond, Src, TrueLab, FalseLab, Pred) ->
+ if Pred >= 0.5 ->
+ mk_pseudo_br_simple(negate_rcond(RCond), Src, FalseLab,
+ TrueLab, 1.0-Pred);
+ true ->
+ mk_pseudo_br_simple(RCond, Src, TrueLab, FalseLab, Pred)
+ end.
+
+mk_pseudo_br_simple(RCond, Src, TrueLab, FalseLab, Pred) when Pred =< 0.5 ->
+ #pseudo_br{rcond=RCond, src=Src, true_label=TrueLab,
+ false_label=FalseLab, pred=Pred}.
+
+negate_rcond(RCond) ->
+ case RCond of
+ 'z' -> 'nz'; % ==, !=
+ 'nz' -> 'z'; % !=, ==
+ 'gz' -> 'lez'; % >, <=
+ 'lez' -> 'gz'; % <=, >
+ 'gez' -> 'lz'; % >=, <
+ 'lz' -> 'gez' % <, >=
+ end.
+-endif.
+
+mk_pseudo_call(FunV, SDesc, ContLab, Linkage) ->
+ #pseudo_call{funv=FunV, sdesc=SDesc, contlab=ContLab, linkage=Linkage}.
+pseudo_call_funv(#pseudo_call{funv=FunV}) -> FunV.
+pseudo_call_contlab(#pseudo_call{contlab=ContLab}) -> ContLab.
+pseudo_call_linkage(#pseudo_call{linkage=Linkage}) -> Linkage.
+pseudo_call_sdesc(#pseudo_call{sdesc=SDesc}) -> SDesc.
+
+mk_pseudo_call_prepare(NrStkArgs) ->
+ #pseudo_call_prepare{nrstkargs=NrStkArgs}.
+pseudo_call_prepare_nrstkargs(#pseudo_call_prepare{nrstkargs=NrStkArgs}) ->
+ NrStkArgs.
+
+mk_pseudo_move(Src, Dst) -> #pseudo_move{src=Src, dst=Dst}.
+is_pseudo_move(I) -> case I of #pseudo_move{} -> true; _ -> false end.
+pseudo_move_dst(#pseudo_move{dst=Dst}) -> Dst.
+pseudo_move_src(#pseudo_move{src=Src}) -> Src.
+
+mk_pseudo_ret() -> #pseudo_ret{}.
+
+mk_pseudo_set(Imm, Dst) -> #pseudo_set{imm=Imm, dst=Dst}.
+
+mk_pseudo_tailcall(FunV, Arity, StkArgs, Linkage) ->
+ #pseudo_tailcall{funv=FunV, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
+pseudo_tailcall_funv(#pseudo_tailcall{funv=FunV}) -> FunV.
+pseudo_tailcall_linkage(#pseudo_tailcall{linkage=Linkage}) -> Linkage.
+pseudo_tailcall_stkargs(#pseudo_tailcall{stkargs=StkArgs}) -> StkArgs.
+
+mk_pseudo_tailcall_prepare() -> #pseudo_tailcall_prepare{}.
+
+mk_rdy(Dst) -> #rdy{dst=Dst}.
+
+mk_sethi(UImm22, Dst) -> #sethi{uimm22=UImm22, dst=Dst}.
+mk_nop() -> mk_sethi(mk_uimm22(0), mk_g0()).
+
+%%% Load an integer constant into a register.
+mk_set(Value, Dst) -> mk_set(Value, Dst, []).
+
+mk_set(Value, Dst, Tail) ->
+ if -4096 =< Value, Value < 4096 ->
+ [mk_alu('or', mk_g0(), mk_simm13(Value), Dst) | Tail];
+ true ->
+ Hi22 = mk_uimm22((Value bsr 10) band 16#003FFFFF),
+ case (Value band 16#3FF) of
+ 0 ->
+ [mk_sethi(Hi22, Dst) | Tail];
+ Lo10 ->
+ [mk_sethi(Hi22, Dst),
+ mk_alu('or', Dst, mk_simm13(Lo10), Dst) |
+ Tail]
+ end
+ end.
+
+%%% Add an integer constant. Dst may equal Src,
+%%% in which case temp2 may be clobbered.
+mk_addi(Src, Value, Dst, Tail) ->
+ if -4096 =< Value, Value < 4096 ->
+ [mk_alu('add', Src, mk_simm13(Value), Dst) | Tail];
+ true ->
+ Tmp =
+ begin
+ DstReg = temp_reg(Dst),
+ SrcReg = temp_reg(Src),
+ if DstReg =:= SrcReg -> mk_temp2();
+ true -> Dst
+ end
+ end,
+ mk_set(Value, Tmp, [mk_alu('add', Src, Tmp, Dst) | Tail])
+ end.
+
+mk_store(StOp, Src, Base, Disp) ->
+ #store{stop=StOp, src=Src, base=Base, disp=Disp}.
+
+mk_store(StOp, Src, Base, Offset, Scratch, Rest) when is_integer(Offset) ->
+ if -4096 =< Offset, Offset < 4096 ->
+ [mk_store(StOp, Src, Base, mk_simm13(Offset)) | Rest];
+ true ->
+ Index = mk_scratch(Scratch),
+ mk_set(Offset, Index, [mk_store(StOp, Src, Base, Index) | Rest])
+ end.
+
+mk_load(LdOp, Base, Disp, Dst) ->
+ mk_alu(LdOp, Base, Disp, Dst).
+
+mk_load(LdOp, Base, Offset, Dst, Scratch, Rest) when is_integer(Offset) ->
+ if -4096 =< Offset, Offset < 4096 ->
+ [mk_load(LdOp, Base, mk_simm13(Offset), Dst) | Rest];
+ true ->
+ Index =
+ begin
+ DstReg = temp_reg(Dst),
+ BaseReg = temp_reg(Base),
+ if DstReg =/= BaseReg -> Dst;
+ true -> mk_scratch(Scratch)
+ end
+ end,
+ mk_set(Offset, Index, [mk_load(LdOp, Base, Index, Dst) | Rest])
+ end.
+
+mk_scratch(Scratch) ->
+ case Scratch of
+ 'temp2' -> mk_temp2();
+ 'new' -> mk_new_temp('untagged')
+ end.
+
+mk_fp_binary(FpBinOp, Src1, Src2, Dst) ->
+ #fp_binary{fp_binop=FpBinOp, src1=Src1, src2=Src2, dst=Dst}.
+
+mk_fp_unary(FpUnOp, Src, Dst) -> #fp_unary{fp_unop=FpUnOp, src=Src, dst=Dst}.
+
+mk_pseudo_fload(Base, Disp, Dst, IsSingle) ->
+ #pseudo_fload{base=Base, disp=Disp, dst=Dst, is_single=IsSingle}.
+
+mk_fload(Base, Disp, Dst, Scratch) when is_integer(Disp) ->
+ if -4096 =< Disp, Disp < (4096-4) ->
+ [mk_pseudo_fload(Base, mk_simm13(Disp), Dst, false)];
+ true ->
+ Tmp = mk_scratch(Scratch),
+ mk_set(Disp, Tmp,
+ [mk_alu('add', Tmp, Base, Tmp),
+ mk_pseudo_fload(Tmp, mk_simm13(0), Dst, false)])
+ end.
+
+mk_pseudo_fmove(Src, Dst) -> #pseudo_fmove{src=Src, dst=Dst}.
+is_pseudo_fmove(I) -> case I of #pseudo_fmove{} -> true; _ -> false end.
+pseudo_fmove_src(#pseudo_fmove{src=Src}) -> Src.
+pseudo_fmove_dst(#pseudo_fmove{dst=Dst}) -> Dst.
+
+mk_pseudo_fstore(Src, Base, Disp) ->
+ #pseudo_fstore{src=Src, base=Base, disp=Disp}.
+
+mk_fstore(Src, Base, Disp, Scratch) when is_integer(Disp) ->
+ if -4096 =< Disp, Disp < (4096-4) ->
+ [mk_pseudo_fstore(Src, Base, hipe_sparc:mk_simm13(Disp))];
+ true ->
+ Tmp = mk_scratch(Scratch),
+ mk_set(Disp, Tmp,
+ [mk_alu('add', Tmp, Base, Tmp),
+ mk_pseudo_fstore(Src, Tmp, mk_simm13(0))])
+ end.
+
+mk_defun(MFA, Formals, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
+ #defun{mfa=MFA, formals=Formals, code=Code, data=Data,
+ isclosure=IsClosure, isleaf=IsLeaf,
+ var_range=VarRange, label_range=LabelRange}.
+defun_code(#defun{code=Code}) -> Code.
+defun_data(#defun{data=Data}) -> Data.
+defun_formals(#defun{formals=Formals}) -> Formals.
+defun_is_closure(#defun{isclosure=IsClosure}) -> IsClosure.
+defun_is_leaf(#defun{isleaf=IsLeaf}) -> IsLeaf.
+defun_mfa(#defun{mfa=MFA}) -> MFA.
+defun_var_range(#defun{var_range=VarRange}) -> VarRange.
diff --git a/lib/hipe/sparc/hipe_sparc.hrl b/lib/hipe/sparc/hipe_sparc.hrl
new file mode 100644
index 0000000000..107541f96a
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc.hrl
@@ -0,0 +1,116 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%--------------------------------------------------------------------
+%%% Basic Values:
+%%%
+%%% temp ::= #sparc_temp{reg, type, allocatable}
+%%% reg ::= <token from hipe_sparc_registers>
+%%% type ::= tagged | untagged | double
+%%% allocatable ::= true | false
+%%%
+%%% sdesc ::= #sparc_sdesc{exnlab, fsize, arity, live}
+%%% exnlab ::= [] | label
+%%% fsize ::= int32 (frame size in words)
+%%% live ::= <tuple of int32> (word offsets)
+%%% arity ::= uint8
+%%%
+%%% mfa ::= #sparc_mfa{atom, atom, arity}
+%%% prim ::= #sparc_prim{atom}
+
+-record(sparc_mfa, {m::atom(), f::atom(), a::arity()}).
+-record(sparc_prim, {prim}).
+-record(sparc_sdesc, {exnlab, fsize, arity::arity(), live}).
+-record(sparc_temp, {reg, type, allocatable}).
+-record(sparc_simm13, {value}).
+-record(sparc_uimm5, {value}).
+-record(sparc_uimm6, {value}). % shift counts in 64-bit mode
+-record(sparc_uimm22, {value}).
+
+%%% Instruction Operands:
+%%%
+%%% aluop ::= add | addcc | and | andcc | or | orcc
+%%% | xor | xorcc | sub | subcc | mulx | smul
+%%% | sll | srl | sra | sllx | srlx | srax
+%%% | ldsb | ldsh | ldsw | ldub | lduh | lduw | ldx
+%%% (HW has andn{,cc}, orn{,cc}, xnor{,cc}, addc{,cc},
+%%% and subc{,cc}, but we don't use them)
+%%% cond ::= n | e | le | l | leu | lu | neg | vs |
+%%% | a | ne | g | ge | gu | geu | pos | vc
+%%% rcond ::= z | lez | lz | nz | gz | gez
+%%% stop ::= stb | stw | stx (HW has sth, but we don't use it)
+%%%
+%%% immediate ::= int32 | atom | {label, label_type}
+%%% label_type ::= constant | closure | c_const
+%%%
+%%% dst ::= temp
+%%% src ::= temp
+%%% src1 ::= temp
+%%% src2 ::= temp
+%%% | simm13 (only in alu.src2, jmp.src2, jmpl.src2)
+%%% base ::= src1
+%%% disp ::= src2
+%%%
+%%% fun ::= mfa | prim
+%%% funv ::= fun | temp
+%%%
+%%% fp_binop ::= faddd | fdivd | fmuld | fsubd
+%%% fp_unop ::= fitod | fmovd | fnegd
+
+%%% Instructions:
+
+-record(alu, {aluop, src1, src2, dst}).
+-record(bp, {'cond', label, pred}). % local jump on %icc
+-ifdef(notdef). % XXX: only for sparc64, alas
+-record(br, {rcond, src, label, pred}). % local jump on register
+-endif.
+-record(call_rec, {'fun', sdesc, linkage}). % known recursive call
+-record(call_tail, {'fun', linkage}). % known tailcall
+-record(comment, {term}).
+-record(jmp, {src1, src2, labels}). % return, switch, or computed tailcall
+-record(jmpl, {src, sdesc}). % computed recursive call (jmpl [src+0],%o7)
+-record(label, {label}).
+-record(pseudo_bp, {'cond', true_label, false_label, pred}).
+%%-record(pseudo_br, {rcond, src, true_label, false_label, pred}).
+-record(pseudo_call, {funv, sdesc, contlab, linkage}).
+-record(pseudo_call_prepare, {nrstkargs}).
+-record(pseudo_move, {src, dst}).
+-record(pseudo_ret, {}).
+-record(pseudo_set, {imm, dst}).
+-record(pseudo_tailcall, {funv, arity, stkargs, linkage}).
+-record(pseudo_tailcall_prepare, {}).
+-record(rdy, {dst}).
+-record(sethi, {uimm22, dst}).
+-record(store, {stop, src, base, disp}).
+-record(fp_binary, {fp_binop, src1, src2, dst}).
+-record(fp_unary, {fp_unop, src, dst}).
+-record(pseudo_fload, {base, disp, dst, is_single}).
+-record(pseudo_fmove, {src, dst}).
+-record(pseudo_fstore, {src, base, disp}).
+
+%%% Function definitions.
+
+-include("../misc/hipe_consttab.hrl").
+
+-record(defun, {mfa :: mfa(), formals, code,
+ data :: hipe_consttab(),
+ isclosure :: boolean(),
+ isleaf :: boolean(),
+ var_range, label_range}).
diff --git a/lib/hipe/sparc/hipe_sparc_assemble.erl b/lib/hipe/sparc/hipe_sparc_assemble.erl
new file mode 100644
index 0000000000..b534fe20ec
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_assemble.erl
@@ -0,0 +1,588 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_assemble).
+-export([assemble/4]).
+
+-include("../main/hipe.hrl"). % for VERSION_STRING, when_option
+-include("hipe_sparc.hrl").
+-include("../../kernel/src/hipe_ext_format.hrl").
+-include("../rtl/hipe_literals.hrl").
+-include("../misc/hipe_sdi.hrl").
+-undef(ASSERT).
+-define(ASSERT(G), if G -> [] ; true -> exit({assertion_failed,?MODULE,?LINE,??G}) end).
+
+assemble(CompiledCode, Closures, Exports, Options) ->
+ print("****************** Assembling *******************\n", [], Options),
+ %%
+ Code = [{MFA,
+ hipe_sparc:defun_code(Defun),
+ hipe_sparc:defun_data(Defun)}
+ || {MFA, Defun} <- CompiledCode],
+ %%
+ {ConstAlign,ConstSize,ConstMap,RefsFromConsts} =
+ hipe_pack_constants:pack_constants(Code, 4),
+ %%
+ {CodeSize,CodeBinary,AccRefs,LabelMap,ExportMap} =
+ encode(translate(Code, ConstMap), Options),
+ print("Total num bytes=~w\n", [CodeSize], Options),
+ %%
+ SC = hipe_pack_constants:slim_constmap(ConstMap),
+ DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap),
+ SSE = slim_sorted_exportmap(ExportMap,Closures,Exports),
+ SlimRefs = hipe_pack_constants:slim_refs(AccRefs),
+ Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC},
+ ConstAlign, ConstSize,
+ SC,
+ DataRelocs, % nee LM, LabelMap
+ SSE,
+ CodeSize,CodeBinary,SlimRefs,
+ 0,[] % ColdCodeSize, SlimColdRefs
+ ]),
+ %%
+ Bin.
+
+%%%
+%%% Assembly Pass 1.
+%%% Process initial {MFA,Code,Data} list.
+%%% Translate each MFA's body, choosing operand & instruction kinds.
+%%%
+%%% Assembly Pass 2.
+%%% Perform short/long form optimisation for jumps.
+%%%
+%%% Result is {MFA,NewCode,CodeSize,LabelMap} list.
+%%%
+
+translate(Code, ConstMap) ->
+ translate_mfas(Code, ConstMap, []).
+
+translate_mfas([{MFA,Insns,_Data}|Code], ConstMap, NewCode) ->
+ {NewInsns,CodeSize,LabelMap} =
+ translate_insns(Insns, MFA, ConstMap, hipe_sdi:pass1_init(), 0, []),
+ translate_mfas(Code, ConstMap, [{MFA,NewInsns,CodeSize,LabelMap}|NewCode]);
+translate_mfas([], _ConstMap, NewCode) ->
+ lists:reverse(NewCode).
+
+translate_insns([I|Insns], MFA, ConstMap, SdiPass1, Address, NewInsns) ->
+ NewIs = translate_insn(I, MFA, ConstMap),
+ add_insns(NewIs, Insns, MFA, ConstMap, SdiPass1, Address, NewInsns);
+translate_insns([], _MFA, _ConstMap, SdiPass1, Address, NewInsns) ->
+ {LabelMap,CodeSizeIncr} = hipe_sdi:pass2(SdiPass1),
+ {lists:reverse(NewInsns), Address+CodeSizeIncr, LabelMap}.
+
+add_insns([I|Is], Insns, MFA, ConstMap, SdiPass1, Address, NewInsns) ->
+ NewSdiPass1 =
+ case I of
+ {'.label',L,_} ->
+ hipe_sdi:pass1_add_label(SdiPass1, Address, L);
+ {bp_sdi,{_,_,{label,L}},_} -> % BP has 19-bit offset
+ SdiInfo = #sdi_info{incr=(12-4),lb=-16#40000*4,ub=16#3FFFF*4},
+ hipe_sdi:pass1_add_sdi(SdiPass1, Address, L, SdiInfo);
+ %% {br_sdi,_,_} -> add_insns_br(I, SdiPass1, Address);
+ _ ->
+ SdiPass1
+ end,
+ Address1 = Address + insn_size(I),
+ add_insns(Is, Insns, MFA, ConstMap, NewSdiPass1, Address1, [I|NewInsns]);
+add_insns([], Insns, MFA, ConstMap, SdiPass1, Address, NewInsns) ->
+ translate_insns(Insns, MFA, ConstMap, SdiPass1, Address, NewInsns).
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+add_insns_br(I, SdiPass1, Address) -> % BR has 16-bit offset
+ {br_sdi,{_,_,_,{label,L}},_} = I,
+ SdiInfo = #sdi_info{incr=(12-4),lb=-16#8000*4,ub=16#7FFF*4},
+ hipe_sdi:pass1_add_sdi(SdiPass1, Address, L, SdiInfo).
+-endif.
+
+insn_size(I) ->
+ case I of
+ {'.label',_,_} -> 0;
+ {'.reloc',_,_} -> 0;
+ _ -> 4 % b{p,r}_sdi included in this case
+ end.
+
+translate_insn(I, MFA, ConstMap) -> % -> [{Op,Opnd,OrigI}]
+ case I of
+ #alu{} -> do_alu(I);
+ #bp{} -> do_bp(I);
+ %% #br{} -> do_br(I);
+ #call_rec{} -> do_call_rec(I);
+ #call_tail{} -> do_call_tail(I);
+ #comment{} -> [];
+ #jmp{} -> do_jmp(I);
+ #jmpl{} -> do_jmpl(I);
+ #label{} -> do_label(I);
+ %% pseudo_bp: eliminated before assembly
+ %% pseudo_br: eliminated before assembly
+ %% pseudo_call: eliminated before assembly
+ %% pseudo_call_prepare: eliminated before assembly
+ %% pseudo_move: eliminated before assembly
+ %% pseudo_ret: eliminated before assembly
+ #pseudo_set{} -> do_pseudo_set(I, MFA, ConstMap);
+ %% pseudo_tailcall: eliminated before assembly
+ %% pseudo_tailcall_prepare: eliminated before assembly
+ #rdy{} -> do_rdy(I);
+ #sethi{} -> do_sethi(I);
+ #store{} -> do_store(I);
+ #fp_binary{} -> do_fp_binary(I);
+ #fp_unary{} -> do_fp_unary(I);
+ #pseudo_fload{} -> do_pseudo_fload(I);
+ %% #pseudo_fmove: eliminated before assembly
+ #pseudo_fstore{} -> do_pseudo_fstore(I);
+ _ -> exit({?MODULE,translate_insn,I})
+ end.
+
+do_alu(I) ->
+ #alu{aluop=AluOp,src1=Src1,src2=Src2,dst=Dst} = I,
+ NewDst = do_reg(Dst),
+ NewSrc1 = do_reg(Src1),
+ NewSrc2 = do_reg_or_imm(Src2),
+ [{AluOp, {NewSrc1,NewSrc2,NewDst}, I}].
+
+do_bp(I) ->
+ #bp{'cond'=Cond,pred=Pred,label=Label} = I,
+ NewLabel = {label,Label},
+ case Cond of
+ 'a' ->
+ [{ba, NewLabel, I}]; % 3 more offset bits
+ _ ->
+ NewCond = {'cond',Cond},
+ NewPred = {pred,Pred},
+ [{bp_sdi, {NewCond,NewPred,NewLabel}, I}]
+ end.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+do_br(I) ->
+ #br{rcond=RCond,pred=Pred,src=Src,label=Label} = I,
+ NewRCond = {rcond,RCond},
+ NewPred = {pred,Pred},
+ NewSrc = do_reg(Src),
+ NewLabel = {label,Label},
+ [{br_sdi, {NewRCond,NewPred,NewSrc,NewLabel}, I}].
+-endif.
+
+do_call_rec(I) ->
+ #call_rec{'fun'=Fun,sdesc=SDesc,linkage=Linkage} = I,
+ [{'.reloc', {call,Fun,Linkage}, #comment{term='fun'}},
+ {'.reloc', {sdesc,SDesc}, #comment{term=sdesc}},
+ {call, {disp30,0}, I}].
+
+do_call_tail(I) ->
+ #call_tail{'fun'=Fun,linkage=Linkage} = I,
+ [{'.reloc', {call,Fun,Linkage}, #comment{term='fun'}},
+ {call, {disp30,0}, I}].
+
+do_jmp(I) ->
+ #jmp{src1=Src1,src2=Src2} = I,
+ NewSrc1 = do_reg(Src1),
+ NewSrc2 = do_reg_or_imm(Src2),
+ NewDst = {r,0},
+ [{jmpl, {NewSrc1,NewSrc2,NewDst}, I}].
+
+do_jmpl(I) ->
+ #jmpl{src=Src,sdesc=SDesc} = I,
+ NewSrc1 = do_reg(Src),
+ NewSrc2 = {simm13,0},
+ NewDst = {r,15}, % %o7
+ [{'.reloc', {sdesc,SDesc}, #comment{term=sdesc}},
+ {jmpl, {NewSrc1,NewSrc2,NewDst}, I}].
+
+do_label(I) ->
+ #label{label=Label} = I,
+ [{'.label', Label, I}].
+
+do_pseudo_set(I, MFA, ConstMap) ->
+ #pseudo_set{imm=Imm,dst=Dst} = I,
+ RelocData =
+ case Imm of
+ Atom when is_atom(Atom) ->
+ {load_atom, Atom};
+%%% {mfa,MFAorPrim,Linkage} ->
+%%% Tag =
+%%% case Linkage of
+%%% remote -> remote_function;
+%%% not_remote -> local_function
+%%% end,
+%%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}};
+ {Label,constant} ->
+ ConstNo = find_const({MFA,Label}, ConstMap),
+ {load_address, {constant,ConstNo}};
+ {Label,closure} ->
+ {load_address, {closure,Label}};
+ {Label,c_const} ->
+ {load_address, {c_const,Label}}
+ end,
+ NewDst = do_reg(Dst),
+ [{'.reloc', RelocData, #comment{term=reloc}},
+ {sethi, {{uimm22,0},NewDst}, I},
+ {'or', {NewDst,{simm13,0},NewDst}, I}].
+
+do_rdy(I) ->
+ #rdy{dst=Dst} = I,
+ NewDst = do_reg(Dst),
+ [{rd, {y,NewDst}, I}].
+
+do_sethi(I) ->
+ #sethi{uimm22=#sparc_uimm22{value=UImm22},dst=Dst} = I,
+ NewUImm22 = {uimm22,UImm22},
+ NewDst = do_reg(Dst),
+ [{sethi, {NewUImm22,NewDst}, I}].
+
+do_store(I) ->
+ #store{stop=StOp,src=Src,base=Base,disp=Disp} = I,
+ NewSrc = do_reg(Src),
+ NewBase = do_reg(Base),
+ NewDisp = do_reg_or_imm(Disp),
+ [{StOp, {NewSrc,NewBase,NewDisp}, I}].
+
+do_fp_binary(I) ->
+ #fp_binary{fp_binop=FpBinOp,src1=Src1,src2=Src2,dst=Dst} = I,
+ NewSrc1 = do_fpreg(Src1),
+ NewSrc2 = do_fpreg(Src2),
+ NewDst = do_fpreg(Dst),
+ [{FpBinOp, {NewSrc1,NewSrc2,NewDst}, I}].
+
+do_fp_unary(I) ->
+ #fp_unary{fp_unop=FpUnOp,src=Src,dst=Dst} = I,
+ NewSrc = do_fpreg(Src),
+ NewDst = do_fpreg(Dst),
+ [{FpUnOp, {NewSrc,NewDst}, I}].
+
+do_pseudo_fload(I) ->
+ #pseudo_fload{base=Base,disp=Disp,dst=Dst,is_single=IsSingle} = I,
+ NewBase = do_reg(Base),
+ #sparc_simm13{value=RawDisp} = Disp,
+ {fr,RawDst} = FrRawDst = do_fpreg(Dst),
+ case IsSingle of
+ true ->
+ [{'ldf', {NewBase,{simm13,RawDisp},FrRawDst}, I}];
+ _ ->
+ [{'ldf', {NewBase,{simm13,RawDisp},FrRawDst}, I},
+ {'ldf', {NewBase,{simm13,RawDisp+4},{fr,RawDst+1}}, I}]
+ end.
+
+do_pseudo_fstore(I) ->
+ #pseudo_fstore{src=Src,base=Base,disp=Disp} = I,
+ {fr,RawSrc} = FrRawSrc = do_fpreg(Src),
+ NewBase = do_reg(Base),
+ #sparc_simm13{value=RawDisp} = Disp,
+ [{'stf', {FrRawSrc,NewBase,{simm13,RawDisp}}, I},
+ {'stf', {{fr,RawSrc+1},NewBase,{simm13,RawDisp+4}}, I}].
+
+%% map a virtual double-precision fp reg in [0,15] to its
+%% corresponding single-precision fp reg in [0,2,4,...,28,30]
+do_fpreg(#sparc_temp{reg=Reg,type='double'})
+ when is_integer(Reg), 0 =< Reg, Reg < 16 ->
+ {fr,2*Reg}.
+
+do_reg(#sparc_temp{reg=Reg,type=Type})
+ when is_integer(Reg), 0 =< Reg, Reg < 32, Type =/= 'double' ->
+ {r,Reg}.
+
+do_reg_or_imm(Src) ->
+ case Src of
+ #sparc_temp{} ->
+ do_reg(Src);
+ #sparc_simm13{value=Value} when is_integer(Value), -4096 =< Value, Value =< 4095 ->
+ {simm13, Value band 16#1fff};
+ #sparc_uimm5{value=Value} when is_integer(Value), 0 =< Value, Value =< 31 ->
+ {uimm5, Value};
+ #sparc_uimm6{value=Value} when is_integer(Value), 0 =< Value, Value =< 63 ->
+ {uimm6, Value}
+ end.
+
+%%%
+%%% Assembly Pass 3.
+%%% Process final {MFA,Code,CodeSize,LabelMap} list from pass 2.
+%%% Translate to a single binary code segment.
+%%% Collect relocation patches.
+%%% Build ExportMap (MFA-to-address mapping).
+%%% Combine LabelMaps to a single one (for mk_data_relocs/2 compatibility).
+%%% Return {CombinedCodeSize,BinaryCode,Relocs,CombinedLabelMap,ExportMap}.
+%%%
+
+encode(Code, Options) ->
+ CodeSize = compute_code_size(Code, 0),
+ ExportMap = build_export_map(Code, 0, []),
+ {AccCode,Relocs} = encode_mfas(Code, 0, [], [], Options),
+ CodeBinary = list_to_binary(lists:reverse(AccCode)),
+ ?ASSERT(CodeSize =:= byte_size(CodeBinary)),
+ CombinedLabelMap = combine_label_maps(Code, 0, gb_trees:empty()),
+ {CodeSize,CodeBinary,Relocs,CombinedLabelMap,ExportMap}.
+
+compute_code_size([{_MFA,_Insns,CodeSize,_LabelMap}|Code], Size) ->
+ compute_code_size(Code, Size+CodeSize);
+compute_code_size([], Size) -> Size.
+
+build_export_map([{{M,F,A},_Insns,CodeSize,_LabelMap}|Code], Address, ExportMap) ->
+ build_export_map(Code, Address+CodeSize, [{Address,M,F,A}|ExportMap]);
+build_export_map([], _Address, ExportMap) -> ExportMap.
+
+combine_label_maps([{MFA,_Insns,CodeSize,LabelMap}|Code], Address, CLM) ->
+ NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM),
+ combine_label_maps(Code, Address+CodeSize, NewCLM);
+combine_label_maps([], _Address, CLM) -> CLM.
+
+merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) ->
+ NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM),
+ merge_label_map(Rest, MFA, Address, NewCLM);
+merge_label_map([], _MFA, _Address, CLM) -> CLM.
+
+encode_mfas([{MFA,Insns,CodeSize,LabelMap}|Code], Address, AccCode, Relocs, Options) ->
+ print("Generating code for: ~w\n", [MFA], Options),
+ print("Offset | Opcode | Instruction\n", [], Options),
+ {Address1,Relocs1,AccCode1} =
+ encode_insns(Insns, Address, Address, LabelMap, Relocs, AccCode, Options),
+ ExpectedAddress = Address + CodeSize,
+ ?ASSERT(Address1 =:= ExpectedAddress),
+ print("Finished.\n", [], Options),
+ encode_mfas(Code, Address1, AccCode1, Relocs1, Options);
+encode_mfas([], _Address, AccCode, Relocs, _Options) ->
+ {AccCode,Relocs}.
+
+encode_insns([I|Insns], Address, FunAddress, LabelMap, Relocs, AccCode, Options) ->
+ case I of
+ {'.label',L,_} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ ?ASSERT(Address =:= LabelAddress), % sanity check
+ print_insn(Address, [], I, Options),
+ encode_insns(Insns, Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ {'.reloc',Data,_} ->
+ Reloc = encode_reloc(Data, Address, FunAddress, LabelMap),
+ encode_insns(Insns, Address, FunAddress, LabelMap, [Reloc|Relocs], AccCode, Options);
+ {bp_sdi,_,_} ->
+ encode_insns(fix_bp_sdi(I, Insns, Address, FunAddress, LabelMap),
+ Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ %% {br_sdi,_,_} ->
+ %% encode_insns(fix_br_sdi(I, Insns, Address, FunAddress, LabelMap),
+ %% Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ _ ->
+ {Op,Arg,_} = fix_jumps(I, Address, FunAddress, LabelMap),
+ Word = hipe_sparc_encode:insn_encode(Op, Arg),
+ print_insn(Address, Word, I, Options),
+ Segment = <<Word:32/integer-big>>,
+ NewAccCode = [Segment|AccCode],
+ encode_insns(Insns, Address+4, FunAddress, LabelMap, Relocs, NewAccCode, Options)
+ end;
+encode_insns([], Address, _FunAddress, _LabelMap, Relocs, AccCode, _Options) ->
+ {Address,Relocs,AccCode}.
+
+encode_reloc(Data, Address, FunAddress, LabelMap) ->
+ case Data of
+ {call,MFAorPrim,Linkage} ->
+ %% call_rec and call_tail are patched the same, so no need to distinguish
+ %% call from tailcall
+ PatchTypeExt =
+ case Linkage of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ {PatchTypeExt, Address, untag_mfa_or_prim(MFAorPrim)};
+ {load_atom,Atom} ->
+ {?LOAD_ATOM, Address, Atom};
+ {load_address,X} ->
+ {?LOAD_ADDRESS, Address, X};
+ {sdesc,SDesc} ->
+ #sparc_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live} = SDesc,
+ ExnRA =
+ case ExnLab of
+ [] -> []; % don't cons up a new one
+ ExnLab -> gb_trees:get(ExnLab, LabelMap) + FunAddress
+ end,
+ {?SDESC, Address,
+ ?STACK_DESC(ExnRA, FSize, Arity, Live)}
+ end.
+
+untag_mfa_or_prim(#sparc_mfa{m=M,f=F,a=A}) -> {M,F,A};
+untag_mfa_or_prim(#sparc_prim{prim=Prim}) -> Prim.
+
+fix_bp_sdi(I, Insns, InsnAddress, FunAddress, LabelMap) ->
+ {bp_sdi,Opnds,OrigI} = I,
+ {{'cond',Cond},{pred,Pred},Label} = Opnds,
+ {label,L} = Label,
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ BD = (LabelAddress - InsnAddress) div 4,
+ if BD >= -16#40000, BD =< 16#3FFFF ->
+ [{bp, Opnds, OrigI} | Insns];
+ true ->
+ %% bp<cond>,<pred> L; Delay
+ %% -->
+ %% bp<!cond>,<!pred> 1f; Delay; ba L; nop; 1:
+ [Delay|Rest] = Insns,
+ NewCond = hipe_sparc:negate_cond(Cond),
+ NewPred = 1.0 - Pred,
+ [{bp,
+ {{'cond',NewCond},{pred,NewPred},'.+16'},
+ #bp{'cond'=NewCond,pred=NewPred,label='.+16'}}, % pp will be ugly
+ Delay, % should be a NOP
+ {ba, Label, #bp{'cond'='a',pred=1.0,label=L}},
+ {sethi, {{uimm22,0},{r,0}}, #comment{term=nop}} |
+ Rest]
+ end.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+fix_br_sdi(I, Insns, InsnAddress, FunAddress, LabelMap) ->
+ {br_sdi,Opnds,OrigI} = I,
+ {{rcond,RCond},{pred,Pred},Src,{label,L}} = Opnds,
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ BD = (LabelAddress - InsnAddress) div 4,
+ if BD >= -16#8000, BD =< 16#7FFF ->
+ [{br, Opnds, OrigI} | Insns];
+ true ->
+ %% br<rcond>,<pred> reg, L; Delay
+ %% -->
+ %% br<!rcond>,<!pred> reg, 1f; Delay; ba L; nop; 1:
+ [Delay|Rest] = Insns,
+ {reg,SrcReg} = Src,
+ NewRCond = hipe_sparc:negate_rcond(RCond),
+ NewPred = 1.0 - Pred,
+ [{br,
+ {{rcond,NewRCond},{pred,NewPred},Src,'.+16'},
+ #br{rcond=NewRCond,pred=NewPred,src=SrcReg,label='.+16'}}, % pp will be ugly
+ Delay, % should be a NOP
+ {ba, {label,L}, #bp{'cond'='a',pred=1.0,label=L}},
+ {sethi, {{uimm22,0},{r,0}}, #comment{term=nop}} |
+ Rest]
+ end.
+-endif.
+
+fix_jumps(I, InsnAddress, FunAddress, LabelMap) ->
+ case I of
+ {ba, {label,L}, OrigI} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ BD = (LabelAddress - InsnAddress) div 4,
+ %% ensure BD fits in a 22 bit sign-extended field
+ ?ASSERT(BD =< 16#1FFFFF),
+ ?ASSERT(BD >= -16#200000),
+ {ba, {disp22,BD band 16#3FFFFF}, OrigI};
+ {bp, {Cond,Pred,Target}, OrigI} ->
+ LabelAddress =
+ case Target of
+ {label,L} -> gb_trees:get(L, LabelMap) + FunAddress;
+ '.+16' -> InsnAddress + 16
+ end,
+ BD = (LabelAddress - InsnAddress) div 4,
+ %% ensure BD fits in a 19 bit sign-extended field
+ ?ASSERT(BD =< 16#3FFFF),
+ ?ASSERT(BD >= -16#40000),
+ {bp, {Cond,px(Pred),{disp19,BD band 16#7FFFF}}, OrigI};
+ %% {br, _, _} -> fix_br(I, InsnAddress, FunAddress, LabelMap);
+ _ -> I
+ end.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+fix_br(I, InsnAddress, FunAddress, LabelMap) ->
+ {br, {RCond,Pred,Src,Target}, OrigI} = I,
+ LabelAddress =
+ case Target of
+ {label,L} -> gb_trees:get(L, LabelMap) + FunAddress;
+ '.+16' -> InsnAddress + 16
+ end,
+ BD = (LabelAddress - InsnAddress) div 4,
+ %% ensure BD fits in a 16 bit sign-extended field
+ ?ASSERT(BD =< 16#7FFF),
+ ?ASSERT(BD >= -16#8000),
+ {br, {RCond,px(Pred),Src,{disp16,BD band 16#FFFF}}, OrigI}.
+-endif.
+
+px({pred,Pred}) -> % XXX: use pt/pn throughout entire backend
+ {pred, if Pred >= 0.5 -> 'pt'; true -> 'pn' end}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+mk_data_relocs(RefsFromConsts, LabelMap) ->
+ lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])).
+
+mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) ->
+ Map = [case Label of
+ {L,Pos} ->
+ Offset = find({MFA,L}, LabelMap),
+ {Pos,Offset};
+ {sorted,Base,OrderedLabels} ->
+ {sorted, Base, [begin
+ Offset = find({MFA,L}, LabelMap),
+ {Order, Offset}
+ end
+ || {L,Order} <- OrderedLabels]}
+ end
+ || Label <- Labels],
+ %% msg("Map: ~w Map\n",[Map]),
+ mk_data_relocs(Rest, LabelMap, [Map,Acc]);
+mk_data_relocs([],_,Acc) -> Acc.
+
+find({_MFA,_L} = MFAL, LabelMap) ->
+ gb_trees:get(MFAL, LabelMap).
+
+slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) ->
+ IsClosure = lists:member({M,F,A}, Closures),
+ IsExported = is_exported(F, A, Exports),
+ [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)];
+slim_sorted_exportmap([],_,_) -> [].
+
+is_exported(F, A, Exports) -> lists:member({F,A}, Exports).
+
+%%%
+%%% Assembly listing support (pp_asm option).
+%%%
+
+print(String, Arglist, Options) ->
+ ?when_option(pp_asm, Options, io:format(String, Arglist)).
+
+print_insn(Address, Word, I, Options) ->
+ ?when_option(pp_asm, Options, print_insn_2(Address, Word, I)).
+
+print_insn_2(Address, Word, {_,_,OrigI}) ->
+ io:format("~8.16.0b | ", [Address]),
+ print_code_list(word_to_bytes(Word), 0),
+ hipe_sparc_pp:pp_insn(OrigI).
+
+word_to_bytes(W) ->
+ case W of
+ [] -> []; % label or other pseudo instruction
+ _ -> [(W bsr 24) band 16#FF, (W bsr 16) band 16#FF,
+ (W bsr 8) band 16#FF, W band 16#FF]
+ end.
+
+print_code_list([Byte|Rest], Len) ->
+ print_byte(Byte),
+ print_code_list(Rest, Len+1);
+print_code_list([], Len) ->
+ fill_spaces(8-(Len*2)),
+ io:format(" | ").
+
+print_byte(Byte) ->
+ io:format("~2.16.0b", [Byte band 16#FF]).
+
+fill_spaces(N) when N > 0 ->
+ io:format(" "),
+ fill_spaces(N-1);
+fill_spaces(0) ->
+ [].
+
+%%%
+%%% Lookup a constant in a ConstMap.
+%%%
+
+find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) ->
+ ConstNo;
+find_const(N,[_|R]) ->
+ find_const(N,R);
+find_const(C,[]) ->
+ ?EXIT({constant_not_found,C}).
diff --git a/lib/hipe/sparc/hipe_sparc_cfg.erl b/lib/hipe/sparc/hipe_sparc_cfg.erl
new file mode 100644
index 0000000000..d938a3bdf1
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_cfg.erl
@@ -0,0 +1,134 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_cfg).
+
+-export([init/1,
+ labels/1, start_label/1,
+ succ/2,
+ bb/2, bb_add/3]).
+-export([postorder/1, reverse_postorder/1]).
+-export([linearise/1]).
+-export([params/1]).
+-export([arity/1]). % for linear scan
+
+-define(SPARC_CFG, true). % needed for cfg.inc
+
+-include("../main/hipe.hrl").
+-include("hipe_sparc.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/cfg.inc").
+
+%%----------------------------------------------------------------------------
+%% CFG interface to SPARC
+%%----------------------------------------------------------------------------
+
+init(Defun) ->
+ Code = hipe_sparc:defun_code(Defun),
+ StartLab = hipe_sparc:label_label(hd(Code)),
+ Data = hipe_sparc:defun_data(Defun),
+ IsClosure = hipe_sparc:defun_is_closure(Defun),
+ Name = hipe_sparc:defun_mfa(Defun),
+ IsLeaf = hipe_sparc:defun_is_leaf(Defun),
+ Formals = hipe_sparc:defun_formals(Defun),
+ CFG = mk_empty_cfg(Name, StartLab, Data, IsClosure, IsLeaf, Formals),
+ take_bbs(Code, CFG).
+
+is_branch(I) ->
+ case I of
+ #bp{'cond'='a'} -> true;
+ %% not br
+ #call_tail{} -> true;
+ #jmp{} -> true;
+ %% not jmpl
+ #pseudo_bp{} -> true;
+ %% #pseudo_br{} -> true;
+ #pseudo_call{} -> true;
+ #pseudo_ret{} -> true;
+ #pseudo_tailcall{} -> true;
+ _ -> false
+ end.
+
+branch_successors(Branch) ->
+ case Branch of
+ #bp{'cond'='a',label=Label} -> [Label];
+ #call_tail{} -> [];
+ #jmp{labels=Labels} -> Labels;
+ #pseudo_bp{true_label=TrueLab,false_label=FalseLab} -> [FalseLab,TrueLab];
+ %% #pseudo_br{true_label=TrueLab,false_label=FalseLab} -> [FalseLab,TrueLab];
+ #pseudo_call{contlab=ContLab, sdesc=#sparc_sdesc{exnlab=ExnLab}} ->
+ case ExnLab of
+ [] -> [ContLab];
+ _ -> [ContLab,ExnLab]
+ end;
+ #pseudo_ret{} -> [];
+ #pseudo_tailcall{} -> []
+ end.
+
+-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
+fails_to(_Instr) -> [].
+-endif.
+
+-ifdef(notdef).
+redirect_jmp(I, Old, New) ->
+ case I of
+ #b_label{label=Label} ->
+ if Old =:= Label -> I#b_label{label=New};
+ true -> I
+ end;
+ #pseudo_bc{true_label=TrueLab, false_label=FalseLab} ->
+ I1 = if Old =:= TrueLab -> I#pseudo_bc{true_label=New};
+ true -> I
+ end,
+ if Old =:= FalseLab -> I1#pseudo_bc{false_label=New};
+ true -> I1
+ end;
+ %% handle pseudo_call too?
+ _ -> I
+ end.
+-endif.
+
+mk_goto(Label) ->
+ hipe_sparc:mk_b_label(Label).
+
+is_label(I) ->
+ hipe_sparc:is_label(I).
+
+label_name(Label) ->
+ hipe_sparc:label_label(Label).
+
+mk_label(Name) ->
+ hipe_sparc:mk_label(Name).
+
+linearise(CFG) -> % -> defun, not insn list
+ MFA = function(CFG),
+ Formals = params(CFG),
+ Code = linearize_cfg(CFG),
+ Data = data(CFG),
+ VarRange = hipe_gensym:var_range(sparc),
+ LabelRange = hipe_gensym:label_range(sparc),
+ IsClosure = is_closure(CFG),
+ IsLeaf = is_leaf(CFG),
+ hipe_sparc:mk_defun(MFA, Formals, IsClosure, IsLeaf,
+ Code, Data, VarRange, LabelRange).
+
+arity(CFG) ->
+ {_M, _F, A} = function(CFG),
+ A.
diff --git a/lib/hipe/sparc/hipe_sparc_defuse.erl b/lib/hipe/sparc/hipe_sparc_defuse.erl
new file mode 100644
index 0000000000..d59ad436b5
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_defuse.erl
@@ -0,0 +1,143 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_defuse).
+-export([insn_def_all/1, insn_use_all/1]).
+-export([insn_def_gpr/1, insn_use_gpr/1]).
+-export([insn_def_fpr/1, insn_use_fpr/1]).
+-include("hipe_sparc.hrl").
+
+%%%
+%%% Defs and uses for both general-purpose and floating-point registers.
+%%% This is needed for the frame module, alas.
+%%%
+insn_def_all(I) ->
+ addtemps(insn_def_fpr(I), insn_def_gpr(I)).
+
+insn_use_all(I) ->
+ addtemps(insn_use_fpr(I), insn_use_gpr(I)).
+
+%%%
+%%% Defs and uses for general-purpose (integer) registers only.
+%%%
+insn_def_gpr(I) ->
+ case I of
+ #alu{dst=Dst} -> [Dst];
+ %% #jmpl{} -> [hipe_sparc:mk_ra()]; % XXX: can jmpl occur this early?
+ #pseudo_call{} -> call_clobbered_gpr();
+ #pseudo_move{dst=Dst} -> [Dst];
+ #pseudo_set{dst=Dst} -> [Dst];
+ #pseudo_tailcall_prepare{} -> tailcall_clobbered_gpr();
+ #rdy{dst=Dst} -> [Dst];
+ #sethi{dst=Dst} -> [Dst];
+ _ -> []
+ end.
+
+call_clobbered_gpr() ->
+ [hipe_sparc:mk_temp(R, T)
+ || {R,T} <- hipe_sparc_registers:call_clobbered() ++ all_fp_pseudos()].
+
+all_fp_pseudos() -> []. % XXX: for now
+
+tailcall_clobbered_gpr() ->
+ [hipe_sparc:mk_temp(R, T)
+ || {R,T} <- hipe_sparc_registers:tailcall_clobbered() ++ all_fp_pseudos()].
+
+insn_use_gpr(I) ->
+ case I of
+ #alu{src1=Src1,src2=Src2} -> addsrc(Src2, [Src1]);
+ %% #br{src=Src} -> [Src]; % XXX: can br occur this early?
+ #jmp{src1=Src1,src2=Src2} -> addsrc(Src2, [Src1]);
+ %% #jmpl{src=Src} -> [Src]; % XXX: can jmpl occur this early?
+ %% #pseudo_br{src=Src} -> [Src];
+ #pseudo_call{funv=FunV,sdesc=#sparc_sdesc{arity=Arity}} ->
+ funv_use(FunV, arity_use_gpr(Arity));
+ #pseudo_move{src=Src} -> [Src];
+ #pseudo_ret{} -> [hipe_sparc:mk_rv()];
+ #pseudo_tailcall{funv=FunV,arity=Arity,stkargs=StkArgs} ->
+ addsrcs(StkArgs, addtemps(tailcall_clobbered_gpr(), funv_use(FunV, arity_use_gpr(Arity))));
+ #store{src=Src,base=Base,disp=Disp} ->
+ addtemp(Src, addsrc(Disp, [Base]));
+ #pseudo_fload{base=Base} -> [Base];
+ #pseudo_fstore{base=Base} -> [Base];
+ _ -> []
+ end.
+
+arity_use_gpr(Arity) ->
+ [hipe_sparc:mk_temp(R, 'tagged')
+ || R <- hipe_sparc_registers:args(Arity)].
+
+funv_use(FunV, Set) ->
+ case FunV of
+ #sparc_temp{} -> addtemp(FunV, Set);
+ _ -> Set
+ end.
+
+addsrcs([Arg|Args], Set) ->
+ addsrcs(Args, addsrc(Arg, Set));
+addsrcs([], Set) ->
+ Set.
+
+addsrc(Src, Set) ->
+ case Src of
+ #sparc_temp{} -> addtemp(Src, Set);
+ _ -> Set
+ end.
+
+%%%
+%%% Defs and uses for floating-point registers only.
+%%%
+insn_def_fpr(I) ->
+ case I of
+ #pseudo_call{} -> call_clobbered_fpr();
+ #fp_binary{dst=Dst} -> [Dst];
+ #fp_unary{dst=Dst} -> [Dst];
+ #pseudo_fload{dst=Dst} -> [Dst];
+ #pseudo_fmove{dst=Dst} -> [Dst];
+ _ -> []
+ end.
+
+call_clobbered_fpr() ->
+ [hipe_sparc:mk_temp(R, 'double') || R <- hipe_sparc_registers:allocatable_fpr()].
+
+insn_use_fpr(I) ->
+ case I of
+ #fp_binary{src1=Src1,src2=Src2} -> addtemp(Src1, [Src2]);
+ #fp_unary{src=Src} -> [Src];
+ #pseudo_fmove{src=Src} -> [Src];
+ #pseudo_fstore{src=Src} -> [Src];
+ _ -> []
+ end.
+
+%%%
+%%% Auxiliary operations on sets of temps
+%%% These sets are small. No point using gb_trees, right?
+%%%
+
+addtemps([Arg|Args], Set) ->
+ addtemps(Args, addtemp(Arg, Set));
+addtemps([], Set) ->
+ Set.
+
+addtemp(Temp, Set) ->
+ case lists:member(Temp, Set) of
+ false -> [Temp|Set];
+ _ -> Set
+ end.
diff --git a/lib/hipe/sparc/hipe_sparc_encode.erl b/lib/hipe/sparc/hipe_sparc_encode.erl
new file mode 100644
index 0000000000..8a28f33ab9
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_encode.erl
@@ -0,0 +1,476 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Encode symbolic SPARC instructions to binary form.
+%%% Copyright (C) 2007-2008 Mikael Pettersson
+
+-module(hipe_sparc_encode).
+
+-export([insn_encode/2]).
+
+%%-define(TESTING,1).
+-ifdef(TESTING).
+-export([dotest/0, dotest/1]).
+-endif.
+
+-define(ASSERT(G),
+ if G -> [];
+ true -> exit({assertion_failed,?MODULE,?LINE,??G})
+ end).
+
+bf(LeftBit, RightBit, Value) ->
+ ?ASSERT(32 > LeftBit),
+ ?ASSERT(LeftBit >= RightBit),
+ ?ASSERT(RightBit >= 0),
+ ?ASSERT(Value >= 0),
+ ?ASSERT(Value < (1 bsl ((LeftBit - RightBit) + 1))),
+ Value bsl RightBit.
+
+-define(BF(LB,RB,V), bf(LB,RB,V)).
+-define(BIT(Pos,Val), ?BF(Pos,Pos,Val)).
+%%-define(BITS(N,Val), ?BF(N,0,Val)).
+
+%%%
+%%% Instruction Formats
+%%%
+
+format1(Disp30) ->
+ ?BIT(30,1) bor ?BF(29,0,Disp30).
+
+format2a(Rd, Op2, Imm22) ->
+ ?BF(29,25,Rd) bor ?BF(24,22,Op2) bor ?BF(21,0,Imm22).
+
+format2b(A, Cond, Op2, Disp22) ->
+ ?BIT(29,A) bor ?BF(28,25,Cond) bor ?BF(24,22,Op2) bor ?BF(21,0,Disp22).
+
+format2c(A, Cond, Op2, CC1, CC0, P, Disp19) ->
+ ?BIT(29,A) bor ?BF(28,25,Cond) bor ?BF(24,22,Op2) bor ?BIT(21,CC1)
+ bor ?BIT(20,CC0) bor ?BIT(19,P) bor ?BF(18,0,Disp19).
+
+format2d(A, RCond, Op2, P, Rs1, Disp16) ->
+ D16Hi = Disp16 bsr 14,
+ D16Lo = Disp16 band 16#3FFF,
+ ?BIT(29,A) bor ?BF(27,25,RCond) bor ?BF(24,22,Op2) bor ?BF(21,20,D16Hi)
+ bor ?BIT(19,P) bor ?BF(18,14,Rs1) bor ?BF(13,0,D16Lo).
+
+format3common(Op, Rd, Op3, Rs1) -> % format 3, bits 31..14
+ ?BF(31,30,Op) bor ?BF(29,25,Rd) bor ?BF(24,19,Op3) bor ?BF(18,14,Rs1).
+
+format3a(Op, Rd, Op3, Rs1, Rs2) ->
+ format3common(Op, Rd, Op3, Rs1) bor ?BF(4,0,Rs2).
+
+format3ax(Op, Rd, Op3, Rs1, Rs2) ->
+ format3a(Op, Rd, Op3, Rs1, Rs2) bor ?BIT(12,1).
+
+format3b(Op, Rd, Op3, Rs1, Simm13) ->
+ format3common(Op, Rd, Op3, Rs1) bor ?BIT(13,1) bor ?BF(12,0,Simm13).
+
+format3b32(Op, Rd, Op3, Rs1, Shcnt32) ->
+ format3a(Op, Rd, Op3, Rs1, Shcnt32) bor ?BIT(13,1).
+
+format3b64(Op, Rd, Op3, Rs1, Shcnt64) ->
+ format3common(Op, Rd, Op3, Rs1) bor ?BIT(13,1) bor ?BF(5,0,Shcnt64).
+
+format3ab(Op, {r,Rd}, Op3, {r,Rs1}, Src2) ->
+ case Src2 of
+ {r,Rs2} ->
+ format3a(Op, Rd, Op3, Rs1, Rs2);
+ {simm13,Simm13} ->
+ format3b(Op, Rd, Op3, Rs1, Simm13)
+ end.
+
+format3ab({Rs1,Src2,Rd}, Op3, Op) -> format3ab(Op, Rd, Op3, Rs1, Src2).
+
+-ifdef(notdef).
+format3c(Op, Rd, Op3, Rs1, Opf, Rs2) ->
+ format3h(Op, Rd, Op3, Rs1) bor (Opf bsl 5) bor Rs2.
+
+format3d(Op, Rd, Op3, Rs1, I, Rs2) ->
+ format3h(Op, Rd, Op3, Rs1) bor (I bsl 13) bor Rs2.
+-endif.
+
+%%%
+%%% Instruction Operands
+%%%
+
+'cond'(Cond) ->
+ case Cond of
+ 'n' -> 2#0000;
+ 'e' -> 2#0001;
+ 'le' -> 2#0010;
+ 'l' -> 2#0011;
+ 'leu' -> 2#0100;
+ 'lu' -> 2#0101; % a.k.a. 'cs'
+ 'neg' -> 2#0110;
+ 'vs' -> 2#0111;
+ 'a' -> 2#1000;
+ 'ne' -> 2#1001;
+ 'g' -> 2#1010;
+ 'ge' -> 2#1011;
+ 'gu' -> 2#1100;
+ 'geu' -> 2#1101; % a.k.a. 'cc'
+ 'pos' -> 2#1110;
+ 'vc' -> 2#1111
+ end.
+
+rcond(RCond) ->
+ case RCond of
+ 'z' -> 2#001;
+ 'lez' -> 2#010;
+ 'lz' -> 2#011;
+ 'nz' -> 2#101;
+ 'gz' -> 2#110;
+ 'gez' -> 2#111
+ end.
+
+pred(Pred) ->
+ case Pred of
+ 'pt' -> 1;
+ 'pn' -> 0
+ end.
+
+%%%
+%%% Branch Instructions
+%%%
+
+call({disp30,Disp30}) ->
+ format1(Disp30).
+
+ba({disp22,Disp22}) -> % V7 Bicc, only used for unconditional branches
+ format2b(0, 'cond'('a'), 2#010, Disp22).
+
+bp({{'cond',Cond},{pred,Pred},{disp19,Disp19}}) ->
+ %% XXX: sparc64 will need CC1=1 here
+ format2c(0, 'cond'(Cond), 2#001, 0, 0, pred(Pred), Disp19).
+
+br({{rcond,RCond},{pred,Pred},{r,Rs1},{disp16,Disp16}}) ->
+ format2d(0, rcond(RCond), 2#011, pred(Pred), Rs1, Disp16).
+
+%%%
+%%% Integer Arithmetic Instructions
+%%%
+
+alu(Opnds, Op3) -> format3ab(Opnds, Op3, 2#10).
+
+add(Opnds) -> alu(Opnds, 2#000000).
+addcc(Opnds) -> alu(Opnds, 2#010000).
+%%addc(Opnds) -> alu(Opnds, 2#001000).
+%%addccc(Opnds) -> alu(Opnds, 2#011000).
+
+sub(Opnds) -> alu(Opnds, 2#000100).
+subcc(Opnds) -> alu(Opnds, 2#010100).
+%%subc(Opnds) -> alu(Opnds, 2#001100). % XXX: hipe_sparc_op has bug here
+%%subccc(Opnds) -> alu(Opnds, 2#011100). % XXX: hipe_sparc_op has bug here
+
+%%taddcc(Opnds) -> alu(Opnds, 2#100000).
+%%taddcctv(Opnds) -> alu(Opnds, 2#100010).
+
+%%tsubcc(Opnds) -> alu(Opnds, 2#100001).
+%%tsubcctv(Opnds) -> alu(Opnds, 2#100011).
+
+mulx(Opnds) -> alu(Opnds, 2#001001).
+%%sdivx(Opnds) -> alu(Opnds, 2#101101).
+%%udivx(Opnds) -> alu(Opnds, 2#001101).
+
+%%umul(Opnds) -> alu(Opnds, 2#001010).
+smul(Opnds) -> alu(Opnds, 2#001011).
+%%umulcc(Opnds) -> alu(Opnds, 2#011010).
+%%smulcc(Opnds) -> alu(Opnds, 2#011011).
+
+'and'(Opnds) -> alu(Opnds, 2#000001).
+andcc(Opnds) -> alu(Opnds, 2#010001).
+%%andn(Opnds) -> alu(Opnds, 2#000101).
+%%andncc(Opnds) -> alu(Opnds, 2#010101).
+
+'or'(Opnds) -> alu(Opnds, 2#000010).
+orcc(Opnds) -> alu(Opnds, 2#010010).
+%%orn(Opnds) -> alu(Opnds, 2#000110).
+%%orncc(Opnds) -> alu(Opnds, 2#010110).
+
+'xor'(Opnds) -> alu(Opnds, 2#000011).
+xorcc(Opnds) -> alu(Opnds, 2#010011).
+%%xnor(Opnds) -> alu(Opnds, 2#000111).
+%%xnorcc(Opnds) -> alu(Opnds, 2#010111).
+
+shift32({{r,Rs1},Src2,{r,Rd}}, Op3) ->
+ case Src2 of
+ {r,Rs2} ->
+ format3a(2#10, Rd, Op3, Rs1, Rs2);
+ {uimm5,Shcnt32} ->
+ format3b32(2#10, Rd, Op3, Rs1, Shcnt32)
+ end.
+
+shift64({{r,Rs1},Src2,{r,Rd}}, Op3) ->
+ case Src2 of
+ {r,Rs2} ->
+ format3ax(2#10, Rd, Op3, Rs1, Rs2);
+ {uimm6,Shcnt64} ->
+ format3b64(2#10, Rd, Op3, Rs1, Shcnt64)
+ end.
+
+sll(Opnds) -> shift32(Opnds, 2#100101).
+sllx(Opnds) -> shift64(Opnds, 2#100101).
+srl(Opnds) -> shift32(Opnds, 2#100110).
+srlx(Opnds) -> shift64(Opnds, 2#100110).
+sra(Opnds) -> shift32(Opnds, 2#100111).
+srax(Opnds) -> shift64(Opnds, 2#100111).
+
+jmpl(Opnds) -> alu(Opnds, 2#111000).
+
+rd({y,{r,Rd}}) -> format3a(2#10, Rd, 2#101000, 0, 0).
+
+sethi({{uimm22,UImm22},{r,Rd}}) -> format2a(Rd, 2#100, UImm22).
+
+ld(Opnds, Op3) -> format3ab(Opnds, Op3, 2#11).
+
+ldsb(Opnds) -> ld(Opnds, 2#001001).
+ldsh(Opnds) -> ld(Opnds, 2#001010).
+ldsw(Opnds) -> ld(Opnds, 2#001000).
+ldub(Opnds) -> ld(Opnds, 2#000001).
+lduh(Opnds) -> ld(Opnds, 2#000010).
+lduw(Opnds) -> ld(Opnds, 2#000000).
+ldx(Opnds) -> ld(Opnds, 2#001011).
+%%ldd(Opnds) -> ld(Opnds, 2#000011).
+
+st({Rd,Rs1,Src2}, Op3) -> format3ab(2#11, Rd, Op3, Rs1, Src2).
+
+stb(Opnds) -> st(Opnds, 2#000101).
+%%sth(Opnds) -> st(Opnds, 2#000110).
+stw(Opnds) -> st(Opnds, 2#000100).
+stx(Opnds) -> st(Opnds, 2#001110).
+%%std(Opnds) -> st(Opnds, 2#000111).
+
+%%%
+%%% Floating-Point Instructions
+%%%
+
+format3f(Rd, Rs1, Opf, Rs2) ->
+ format3a(2#10, Rd, 2#110100, Rs1, Rs2) bor ?BF(13,5,Opf).
+
+fpop1binary(Opf, {{fr,Rs1},{fr,Rs2},{fr,Rd}}) ->
+ format3f(Rd, Rs1, Opf, Rs2).
+
+faddd(Opnds) -> fpop1binary(2#001000010, Opnds).
+fdivd(Opnds) -> fpop1binary(2#001001110, Opnds).
+fmuld(Opnds) -> fpop1binary(2#001001010, Opnds).
+fsubd(Opnds) -> fpop1binary(2#001000110, Opnds).
+
+fpop1unary(Opf, {{fr,Rs2},{fr,Rd}}) ->
+ format3f(Rd, 0, Opf, Rs2).
+
+fitod(Opnds) -> fpop1unary(2#011001000, Opnds).
+fmovd(Opnds) -> fpop1unary(2#000000010, Opnds).
+fnegd(Opnds) -> fpop1unary(2#000000110, Opnds).
+
+ldf({{r,Rs1},{simm13,Simm13},{fr,Rd}}) ->
+ format3b(2#11, Rd, 2#100000, Rs1, Simm13).
+
+stf({{fr,Rd},{r,Rs1},{simm13,Simm13}}) ->
+ format3b(2#11, Rd, 2#100100, Rs1, Simm13).
+
+-ifdef(notdef).
+fpop1(Rs1,Opf,Rs2,Rd) -> format3a(2#10, Rd, 2#110100, Rs1, Opf, Rs2).
+%% fpop2(Rs1,Opf,Rs2,Rd) -> format3a(2#10, Rd, 2#110101, Rs1, Opf, Rs2).
+
+%% fxtos(Rs2, Rd) -> fpop1(0,2#010000100,Rs2,Rd).
+%% fxtod(Rs2, Rd) -> fpop1(0,2#010001000,Rs2,Rd).
+%% fxtoq(Rs2, Rd) -> fpop1(0,2#010001100,Rs2,Rd).
+fitos(Rs2, Rd) -> fpop1(0,2#011000100,Rs2,Rd).
+fitoq(Rs2, Rd) -> fpop1(0,2#011001100,Rs2,Rd).
+
+%% fstox(Rs2, Rd) -> fpop1(0,2#010000001,Rs2,Rd).
+%% fdtox(Rs2, Rd) -> fpop1(0,2#010000010,Rs2,Rd).
+%% fqtox(Rs2, Rd) -> fpop1(0,2#010000011,Rs2,Rd).
+%% fstoi(Rs2, Rd) -> fpop1(0,2#011010001,Rs2,Rd).
+%% fdtoi(Rs2, Rd) -> fpop1(0,2#011010010,Rs2,Rd).
+%% fqtoi(Rs2, Rd) -> fpop1(0,2#011010011,Rs2,Rd).
+
+%% fstod(Rs2, Rd) -> fpop1(0,2#011001001,Rs2,Rd).
+%% fstoq(Rs2, Rd) -> fpop1(0,2#011001101,Rs2,Rd).
+%% fdtos(Rs2, Rd) -> fpop1(0,2#011000110,Rs2,Rd).
+%% fdtoq(Rs2, Rd) -> fpop1(0,2#011001110,Rs2,Rd).
+%% fqtos(Rs2, Rd) -> fpop1(0,2#011000111,Rs2,Rd).
+%% fqtod(Rs2, Rd) -> fpop1(0,2#011001011,Rs2,Rd).
+
+fmovs(Rs2, Rd) -> fpop1(0,2#000000001,Rs2,Rd).
+fnegs(Rs2, Rd) -> fpop1(0,2#000000101,Rs2,Rd).
+fabss(Rs2, Rd) -> fpop1(0,2#000001001,Rs2,Rd).
+fabsd(Rs2, Rd) -> fpop1(0,2#000001010,Rs2,Rd).
+fmovq(Rs2, Rd) -> fpop1(0,2#000000011,Rs2,Rd).
+fnegq(Rs2, Rd) -> fpop1(0,2#000000111,Rs2,Rd).
+fabsq(Rs2, Rd) -> fpop1(0,2#000001011,Rs2,Rd).
+
+%% fsqrts(Rs2, Rd) -> fpop1(0,2#000101001,Rs2,Rd).
+%% fsqrtd(Rs2, Rd) -> fpop1(0,2#000101010,Rs2,Rd).
+%% fsqrtq(Rs2, Rd) -> fpop1(0,2#000101011,Rs2,Rd).
+
+fadds(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001000001,Rs2,Rd).
+faddq(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001000011,Rs2,Rd).
+fsubs(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001000101,Rs2,Rd).
+fsubq(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001000111,Rs2,Rd).
+
+fmuls(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001001001,Rs2,Rd).
+fmulq(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001001011,Rs2,Rd).
+%% fsmuld(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001101001,Rs2,Rd).
+%% fdmulq(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001101110,Rs2,Rd).
+fdivs(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001001101,Rs2,Rd).
+fdivq(Rs1, Rs2, Rd) -> fpop1(Rs1,2#001001111,Rs2,Rd).
+
+%% Uses fcc0
+%% fcmps(Rs1, Rs2) -> fpop2(Rs1,2#001010001,Rs2,0).
+%% fcmpd(Rs1, Rs2) -> fpop2(Rs1,2#001010010,Rs2,0).
+%% fcmpq(Rs1, Rs2) -> fpop2(Rs1,2#001010011,Rs2,0).
+%% fcmpes(Rs1, Rs2) -> fpop2(Rs1,2#001010101,Rs2,0).
+%% fcmped(Rs1, Rs2) -> fpop2(Rs1,2#001010110,Rs2,0).
+%% fcmpeq(Rs1, Rs2) -> fpop2(Rs1,2#001010111,Rs2,0).
+
+%% fcmps(N, Rs1, Rs2) -> fpcn(N,2#001010001,Rs1,Rs2).
+%% fcmpd(N, Rs1, Rs2) -> fpcn(N,2#001010010,Rs1,Rs2).
+%% fcmpq(N, Rs1, Rs2) -> fpcn(N,2#001010011,Rs1,Rs2).
+%% fcmpes(N, Rs1, Rs2) -> fpcn(N,2#001010101,Rs1,Rs2).
+%% fcmped(N, Rs1, Rs2) -> fpcn(N,2#001010110,Rs1,Rs2).
+%% fcmpeq(N, Rs1, Rs2) -> fpcn(N,2#001010111,Rs1,Rs2).
+
+stfi(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100100, Rs1, Offset).
+stdf(Rd, Rs1, Rs2) -> format3a(2#11, Rd, 2#100111, Rs1, 0, Rs2).
+stdfi(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100111, Rs1, Offset).
+stqf(Rd, Rs1, Rs2) -> format3a(2#11, Rd, 2#100110, Rs1, 0, Rs2).
+stqfi(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100110, Rs1, Offset).
+%% stfsr(Rd, Rs1, Rs2) -> format3a(2#11, Rd, 2#100101, Rs1, 0, Rs2).
+%% stfsri(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100101, Rs1, Offset).
+
+ldfi(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100000, Rs1, Offset).
+lddf(Rd, Rs1, Rs2) -> format3a(2#11, Rd, 2#100011, Rs1, 0, Rs2).
+lddfi(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100011, Rs1, Offset).
+ldqf(Rd, Rs1, Rs2) -> format3a(2#11, Rd, 2#100010, Rs1, 0, Rs2).
+ldqfi(Rd, Rs1, Offset) -> format3b(2#11, Rd, 2#100010, Rs1, Offset).
+%% ldxfsr(Rs1, Rs2) -> format3a(2#11, 1, 2#100001, Rs1, 0, Rs2).
+%% ldxfsri(Rs1, Offset) -> format3b(2#11, 1, 2#100001, Rs1, Offset).
+
+%% fpcn(N, Opf, Rs1, Rs2) ->
+%% case N of
+%% 0 -> fpc0(Opf, Rs1, Rs2);
+%% 1 -> fpc1(Opf, Rs1, Rs2);
+%% 2 -> fpc2(Opf, Rs1, Rs2);
+%% 3 -> fpc3(Opf, Rs1, Rs2)
+%% end.
+
+%% fpc0(Opf, Rs1, Rs2) -> format3c(2#10, 2#00000, 2#110101, Rs1, Opf, Rs2).
+%% fpc1(Opf, Rs1, Rs2) -> format3c(2#10, 2#00001, 2#110101, Rs1, Opf, Rs2).
+%% fpc2(Opf, Rs1, Rs2) -> format3c(2#10, 2#00010, 2#110101, Rs1, Opf, Rs2).
+%% fpc3(Opf, Rs1, Rs2) -> format3c(2#10, 2#00011, 2#110101, Rs1, Opf, Rs2).
+-endif. % FP insns
+
+%%%
+%%% Main Encode Dispatch
+%%%
+
+insn_encode(Op, Opnds) ->
+ case Op of
+ 'add' -> add(Opnds);
+ 'addcc' -> addcc(Opnds);
+ 'and' -> 'and'(Opnds);
+ 'andcc' -> andcc(Opnds);
+ 'ba' -> ba(Opnds);
+ 'bp' -> bp(Opnds);
+ 'br' -> br(Opnds);
+ 'call' -> call(Opnds);
+ 'jmpl' -> jmpl(Opnds);
+ 'ldsb' -> ldsb(Opnds);
+ 'ldsh' -> ldsh(Opnds);
+ 'ldsw' -> ldsw(Opnds);
+ 'ldub' -> ldub(Opnds);
+ 'lduh' -> lduh(Opnds);
+ 'lduw' -> lduw(Opnds);
+ 'ldx' -> ldx(Opnds);
+ 'mulx' -> mulx(Opnds);
+ 'or' -> 'or'(Opnds);
+ 'orcc' -> orcc(Opnds);
+ 'rd' -> rd(Opnds);
+ 'sethi' -> sethi(Opnds);
+ 'sll' -> sll(Opnds);
+ 'sllx' -> sllx(Opnds);
+ 'smul' -> smul(Opnds);
+ 'sra' -> sra(Opnds);
+ 'srax' -> srax(Opnds);
+ 'srl' -> srl(Opnds);
+ 'srlx' -> srlx(Opnds);
+ 'stb' -> stb(Opnds);
+ 'stw' -> stw(Opnds);
+ 'stx' -> stx(Opnds);
+ 'sub' -> sub(Opnds);
+ 'subcc' -> subcc(Opnds);
+ 'xor' -> 'xor'(Opnds);
+ 'xorcc' -> xorcc(Opnds);
+ 'faddd' -> faddd(Opnds);
+ 'fdivd' -> fdivd(Opnds);
+ 'fmuld' -> fmuld(Opnds);
+ 'fsubd' -> fsubd(Opnds);
+ 'fitod' -> fitod(Opnds);
+ 'fmovd' -> fmovd(Opnds);
+ 'fnegd' -> fnegd(Opnds);
+ 'ldf' -> ldf(Opnds);
+ 'stf' -> stf(Opnds);
+ _ -> exit({?MODULE,insn_encode,Op})
+ end.
+
+%%%
+%%% Testing Interface
+%%%
+
+-ifdef(TESTING).
+
+say(OS, Str) ->
+ file:write(OS, Str).
+
+hex_digit(Dig0) ->
+ Dig = Dig0 band 16#F,
+ if Dig >= 16#A -> $A + (Dig - 16#A);
+ true -> $0 + Dig
+ end.
+
+say_byte(OS, Byte) ->
+ say(OS, [hex_digit(Byte bsr 4)]),
+ say(OS, [hex_digit(Byte)]).
+
+say_word(OS, Word) ->
+ say(OS, "0x"),
+ say_byte(OS, Word bsr 24),
+ say_byte(OS, Word bsr 16),
+ say_byte(OS, Word bsr 8),
+ say_byte(OS, Word).
+
+t(OS, Op, Opnds) ->
+ Word = insn_encode(Op, Opnds),
+ say(OS, "\t.long "),
+ say_word(OS, Word),
+ say(OS, "\n").
+
+dotest1(OS) ->
+ say(OS, "\t.text\n\t.align 4\n"),
+ [].
+
+dotest() -> dotest1(group_leader()).
+
+dotest(File) ->
+ {ok,OS} = file:open(File, [write]),
+ dotest1(OS),
+ file:close(OS).
+
+-endif.
diff --git a/lib/hipe/sparc/hipe_sparc_finalise.erl b/lib/hipe/sparc/hipe_sparc_finalise.erl
new file mode 100644
index 0000000000..b44a21f7c0
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_finalise.erl
@@ -0,0 +1,138 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_finalise).
+-export([finalise/1]).
+-include("hipe_sparc.hrl").
+
+finalise(Defun) ->
+ #defun{code=Code0} = Defun,
+ Code1 = peep(expand(Code0)),
+ Defun#defun{code=Code1}.
+
+expand(Insns) ->
+ expand_list(Insns, []).
+
+expand_list([I|Insns], Accum) ->
+ expand_list(Insns, expand_insn(I, Accum));
+expand_list([], Accum) ->
+ lists:reverse(Accum).
+
+expand_insn(I, Accum) ->
+ case I of
+ #bp{'cond'='a'} ->
+ [hipe_sparc:mk_nop(),
+ I |
+ Accum];
+ #call_rec{} ->
+ [hipe_sparc:mk_nop(),
+ I |
+ Accum];
+ #call_tail{} ->
+ RA = hipe_sparc:mk_ra(),
+ TempRA = hipe_sparc:mk_temp1(),
+ [hipe_sparc:mk_mov(TempRA, RA),
+ I, % becomes a call, which clobbers RA
+ hipe_sparc:mk_mov(RA, TempRA) |
+ Accum];
+ #jmp{} ->
+ [hipe_sparc:mk_nop(),
+ I |
+ Accum];
+ #pseudo_bp{'cond'=Cond,true_label=TrueLab,false_label=FalseLab, pred=Pred} ->
+ [hipe_sparc:mk_nop(),
+ hipe_sparc:mk_b_label(FalseLab),
+ hipe_sparc:mk_nop(),
+ hipe_sparc:mk_bp(Cond, TrueLab, Pred) |
+ Accum];
+ %% #pseudo_br{} -> expand_pseudo_br(I, Accum);
+ #pseudo_call{funv=FunV,sdesc=SDesc,contlab=ContLab,linkage=Linkage} ->
+ [hipe_sparc:mk_nop(),
+ hipe_sparc:mk_b_label(ContLab),
+ hipe_sparc:mk_nop(),
+ case FunV of
+ #sparc_temp{} ->
+ hipe_sparc:mk_jmpl(FunV, SDesc);
+ _ ->
+ hipe_sparc:mk_call_rec(FunV, SDesc, Linkage)
+ end |
+ Accum];
+ #pseudo_ret{} ->
+ RA = hipe_sparc:mk_ra(),
+ [hipe_sparc:mk_nop(),
+ hipe_sparc:mk_jmp(RA, hipe_sparc:mk_simm13(8), []) |
+ Accum];
+ #pseudo_tailcall_prepare{} ->
+ Accum;
+ _ ->
+ XXX =
+ case I of
+ #alu{} -> true;
+ #comment{} -> true;
+ #label{} -> true;
+ #pseudo_set{} -> true;
+ #rdy{} -> true;
+ #sethi{} -> true;
+ #store{} -> true;
+ #bp{} -> false;
+ %% #br{} -> false;
+ #call_rec{} -> false;
+ #call_tail{} -> false;
+ #jmp{} -> false;
+ #jmpl{} -> false;
+ #pseudo_bp{} -> false;
+ %% #pseudo_br{} -> false;
+ #pseudo_call{} -> false;
+ #pseudo_call_prepare{} -> false;
+ #pseudo_move{} -> false;
+ #pseudo_ret{} -> false;
+ #pseudo_tailcall{} -> false;
+ #pseudo_tailcall_prepare{} -> false;
+ #fp_binary{} -> true;
+ #fp_unary{} -> true;
+ #pseudo_fload{} -> true;
+ #pseudo_fstore{} -> true
+ end,
+ case XXX of
+ true -> [];
+ false -> exit({?MODULE,expand_insn,I})
+ end,
+ [I|Accum]
+ end.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+expand_pseudo_br(I, Accum) ->
+ #pseudo_br{rcond=RCond,src=Src,true_label=TrueLab,false_label=FalseLab, pred=Pred} = I,
+ [hipe_sparc:mk_nop(),
+ hipe_sparc:mk_b_label(FalseLab),
+ hipe_sparc:mk_nop(),
+ hipe_sparc:mk_br(RCond, Src, TrueLab, Pred) |
+ Accum].
+-endif.
+
+peep(Insns) ->
+ peep_list(Insns, []).
+
+peep_list([#bp{'cond'='a',label=Label}, #sethi{uimm22=#sparc_uimm22{value=0},dst=#sparc_temp{reg=0}} | (Insns = [#label{label=Label}|_])], Accum) ->
+ peep_list(Insns, Accum);
+peep_list([I|Insns], Accum) ->
+ peep_list(Insns, [I|Accum]);
+peep_list([], Accum) ->
+ lists:reverse(Accum).
diff --git a/lib/hipe/sparc/hipe_sparc_frame.erl b/lib/hipe/sparc/hipe_sparc_frame.erl
new file mode 100644
index 0000000000..f7d7f40df3
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_frame.erl
@@ -0,0 +1,636 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_frame).
+-export([frame/1]).
+
+-include("hipe_sparc.hrl").
+-include("../rtl/hipe_literals.hrl").
+
+frame(Defun) ->
+ Formals = fix_formals(hipe_sparc:defun_formals(Defun)),
+ Temps0 = all_temps(hipe_sparc:defun_code(Defun), Formals),
+ MinFrame = defun_minframe(Defun),
+ Temps = ensure_minframe(MinFrame, Temps0),
+ ClobbersRA = clobbers_ra(hipe_sparc:defun_code(Defun)),
+ CFG0 = hipe_sparc_cfg:init(Defun),
+ Liveness = hipe_sparc_liveness_all:analyse(CFG0),
+ CFG1 = do_body(CFG0, Liveness, Formals, Temps, ClobbersRA),
+ hipe_sparc_cfg:linearise(CFG1).
+
+fix_formals(Formals) ->
+ fix_formals(hipe_sparc_registers:nr_args(), Formals).
+
+fix_formals(0, Rest) -> Rest;
+fix_formals(N, [_|Rest]) -> fix_formals(N-1, Rest);
+fix_formals(_, []) -> [].
+
+do_body(CFG0, Liveness, Formals, Temps, ClobbersRA) ->
+ Context = mk_context(Liveness, Formals, Temps, ClobbersRA),
+ CFG1 = do_blocks(CFG0, Context),
+ do_prologue(CFG1, Context).
+
+do_blocks(CFG, Context) ->
+ Labels = hipe_sparc_cfg:labels(CFG),
+ do_blocks(Labels, CFG, Context).
+
+do_blocks([Label|Labels], CFG, Context) ->
+ Liveness = context_liveness(Context),
+ LiveOut = hipe_sparc_liveness_all:liveout(Liveness, Label),
+ Block = hipe_sparc_cfg:bb(CFG, Label),
+ Code = hipe_bb:code(Block),
+ NewCode = do_block(Code, LiveOut, Context),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ NewCFG = hipe_sparc_cfg:bb_add(CFG, Label, NewBlock),
+ do_blocks(Labels, NewCFG, Context);
+do_blocks([], CFG, _) ->
+ CFG.
+
+do_block(Insns, LiveOut, Context) ->
+ do_block(Insns, LiveOut, Context, context_framesize(Context), []).
+
+do_block([I|Insns], LiveOut, Context, FPoff0, RevCode) ->
+ {NewIs, FPoff1} = do_insn(I, LiveOut, Context, FPoff0),
+ do_block(Insns, LiveOut, Context, FPoff1, lists:reverse(NewIs, RevCode));
+do_block([], _, Context, FPoff, RevCode) ->
+ FPoff0 = context_framesize(Context),
+ if FPoff =:= FPoff0 -> [];
+ true -> exit({?MODULE,do_block,FPoff})
+ end,
+ lists:reverse(RevCode, []).
+
+do_insn(I, LiveOut, Context, FPoff) ->
+ case I of
+ #pseudo_call{} ->
+ do_pseudo_call(I, LiveOut, Context, FPoff);
+ #pseudo_call_prepare{} ->
+ do_pseudo_call_prepare(I, FPoff);
+ #pseudo_move{} ->
+ {do_pseudo_move(I, Context, FPoff), FPoff};
+ #pseudo_ret{} ->
+ {do_pseudo_ret(I, Context, FPoff), context_framesize(Context)};
+ #pseudo_tailcall{} ->
+ {do_pseudo_tailcall(I, Context), context_framesize(Context)};
+ #pseudo_fmove{} ->
+ {do_pseudo_fmove(I, Context, FPoff), FPoff};
+ _ ->
+ {[I], FPoff}
+ end.
+
+%%%
+%%% Moves, with Dst or Src possibly a pseudo
+%%%
+
+do_pseudo_move(I, Context, FPoff) ->
+ Dst = hipe_sparc:pseudo_move_dst(I),
+ Src = hipe_sparc:pseudo_move_src(I),
+ case temp_is_pseudo(Dst) of
+ true ->
+ Offset = pseudo_offset(Dst, FPoff, Context),
+ mk_store(Src, hipe_sparc:mk_sp(), Offset, []);
+ _ ->
+ case temp_is_pseudo(Src) of
+ true ->
+ Offset = pseudo_offset(Src, FPoff, Context),
+ mk_load(hipe_sparc:mk_sp(), Offset, Dst, []);
+ _ ->
+ [hipe_sparc:mk_mov(Src, Dst)]
+ end
+ end.
+
+do_pseudo_fmove(I, Context, FPoff) ->
+ Dst = hipe_sparc:pseudo_fmove_dst(I),
+ Src = hipe_sparc:pseudo_fmove_src(I),
+ case temp_is_pseudo(Dst) of
+ true ->
+ Offset = pseudo_offset(Dst, FPoff, Context),
+ mk_fstore(Src, hipe_sparc:mk_sp(), Offset);
+ _ ->
+ case temp_is_pseudo(Src) of
+ true ->
+ Offset = pseudo_offset(Src, FPoff, Context),
+ mk_fload(hipe_sparc:mk_sp(), Offset, Dst);
+ _ ->
+ [hipe_sparc:mk_fp_unary('fmovd', Src, Dst)]
+ end
+ end.
+
+pseudo_offset(Temp, FPoff, Context) ->
+ FPoff + context_offset(Context, Temp).
+
+%%%
+%%% Return - deallocate frame and emit 'ret $N' insn.
+%%%
+
+do_pseudo_ret(I, Context, FPoff) ->
+ %% XXX: typically only one instruction between
+ %% the move-to-RA and the jmp-via-RA, ouch
+ restore_ra(FPoff, Context,
+ adjust_sp(FPoff + word_size() * context_arity(Context),
+ [I])).
+
+restore_ra(FPoff, Context, Rest) ->
+ case context_clobbers_ra(Context) of
+ false -> Rest;
+ true ->
+ RA = hipe_sparc:mk_ra(),
+ mk_load(hipe_sparc:mk_sp(), FPoff - word_size(), RA, Rest)
+ end.
+
+adjust_sp(N, Rest) ->
+ if N =:= 0 ->
+ Rest;
+ true ->
+ SP = hipe_sparc:mk_sp(),
+ hipe_sparc:mk_addi(SP, N, SP, Rest)
+ end.
+
+%%%
+%%% Recursive calls.
+%%%
+
+do_pseudo_call_prepare(I, FPoff0) ->
+ %% Create outgoing arguments area on the stack.
+ NrStkArgs = hipe_sparc:pseudo_call_prepare_nrstkargs(I),
+ Offset = NrStkArgs * word_size(),
+ {adjust_sp(-Offset, []), FPoff0 + Offset}.
+
+do_pseudo_call(I, LiveOut, Context, FPoff0) ->
+ #sparc_sdesc{exnlab=ExnLab,arity=OrigArity} = hipe_sparc:pseudo_call_sdesc(I),
+ FunV = hipe_sparc:pseudo_call_funv(I),
+ LiveTemps = [Temp || Temp <- LiveOut, temp_is_pseudo(Temp)],
+ SDesc = mk_sdesc(ExnLab, Context, LiveTemps),
+ ContLab = hipe_sparc:pseudo_call_contlab(I),
+ Linkage = hipe_sparc:pseudo_call_linkage(I),
+ CallCode = [hipe_sparc:mk_pseudo_call(FunV, SDesc, ContLab, Linkage)],
+ StkArity = erlang:max(0, OrigArity - hipe_sparc_registers:nr_args()),
+ context_need_stack(Context, stack_need(FPoff0, StkArity, FunV)),
+ ArgsBytes = word_size() * StkArity,
+ {CallCode, FPoff0 - ArgsBytes}.
+
+stack_need(FPoff, StkArity, FunV) ->
+ case FunV of
+ #sparc_prim{} -> FPoff;
+ #sparc_mfa{m=M,f=F,a=A} ->
+ case erlang:is_builtin(M, F, A) of
+ true -> FPoff;
+ false -> stack_need_general(FPoff, StkArity)
+ end;
+ _ -> stack_need_general(FPoff, StkArity)
+ end.
+
+stack_need_general(FPoff, StkArity) ->
+ erlang:max(FPoff, FPoff + (?SPARC_LEAF_WORDS - StkArity) * word_size()).
+
+%%%
+%%% Create stack descriptors for call sites.
+%%%
+
+mk_sdesc(ExnLab, Context, Temps) -> % for normal calls
+ Temps0 = only_tagged(Temps),
+ Live = mk_live(Context, Temps0),
+ Arity = context_arity(Context),
+ FSize = context_framesize(Context),
+ hipe_sparc:mk_sdesc(ExnLab, (FSize div word_size())-1, Arity,
+ list_to_tuple(Live)).
+
+only_tagged(Temps)->
+ [X || X <- Temps, hipe_sparc:temp_type(X) =:= 'tagged'].
+
+mk_live(Context, Temps) ->
+ lists:sort([temp_to_slot(Context, Temp) || Temp <- Temps]).
+
+temp_to_slot(Context, Temp) ->
+ (context_framesize(Context) + context_offset(Context, Temp))
+ div word_size().
+
+mk_minimal_sdesc(Context) -> % for inc_stack_0 calls
+ hipe_sparc:mk_sdesc([], 0, context_arity(Context), {}).
+
+%%%
+%%% Tailcalls.
+%%%
+
+do_pseudo_tailcall(I, Context) -> % always at FPoff=context_framesize(Context)
+ Arity = context_arity(Context),
+ Args = hipe_sparc:pseudo_tailcall_stkargs(I),
+ FunV = hipe_sparc:pseudo_tailcall_funv(I),
+ Linkage = hipe_sparc:pseudo_tailcall_linkage(I),
+ {Insns, FPoff1} = do_tailcall_args(Args, Context),
+ context_need_stack(Context, FPoff1),
+ StkArity = length(Args),
+ FPoff2 = FPoff1 + (Arity - StkArity) * word_size(),
+ context_need_stack(Context, stack_need(FPoff2, StkArity, FunV)),
+ I2 =
+ case FunV of
+ #sparc_temp{} ->
+ hipe_sparc:mk_jmp(FunV, hipe_sparc:mk_simm13(0), []);
+ Fun ->
+ hipe_sparc:mk_call_tail(Fun, Linkage)
+ end,
+ %% XXX: break out the RA restore, just like for pseudo_ret?
+ restore_ra(context_framesize(Context), Context,
+ Insns ++ adjust_sp(FPoff2, [I2])).
+
+do_tailcall_args(Args, Context) ->
+ FPoff0 = context_framesize(Context),
+ Arity = context_arity(Context),
+ FrameTop = word_size()*Arity,
+ DangerOff = FrameTop - word_size()*length(Args),
+ %%
+ Moves = mk_moves(Args, FrameTop, []),
+ %%
+ {Stores, Simple, Conflict} =
+ split_moves(Moves, Context, DangerOff, [], [], []),
+ %% sanity check (shouldn't trigger any more)
+ if DangerOff < -FPoff0 ->
+ exit({?MODULE,do_tailcall_args,DangerOff,-FPoff0});
+ true -> []
+ end,
+ FPoff1 = FPoff0,
+ %%
+ {Pushes, Pops, FPoff2} = split_conflict(Conflict, FPoff1, [], []),
+ %%
+ TempReg = hipe_sparc_registers:temp1(),
+ %%
+ {adjust_sp(-(FPoff2 - FPoff1),
+ simple_moves(Pushes, FPoff2, TempReg,
+ store_moves(Stores, FPoff2, TempReg,
+ simple_moves(Simple, FPoff2, TempReg,
+ simple_moves(Pops, FPoff2, TempReg,
+ []))))),
+ FPoff2}.
+
+mk_moves([Arg|Args], Off, Moves) ->
+ Off1 = Off - word_size(),
+ mk_moves(Args, Off1, [{Arg,Off1}|Moves]);
+mk_moves([], _, Moves) ->
+ Moves.
+
+split_moves([Move|Moves], Context, DangerOff, Stores, Simple, Conflict) ->
+ {Src,DstOff} = Move,
+ case src_is_pseudo(Src) of
+ false ->
+ split_moves(Moves, Context, DangerOff, [Move|Stores],
+ Simple, Conflict);
+ true ->
+ SrcOff = context_offset(Context, Src),
+ Type = typeof_temp(Src),
+ if SrcOff =:= DstOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, Conflict);
+ SrcOff >= DangerOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, [{SrcOff,DstOff,Type}|Conflict]);
+ true ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ [{SrcOff,DstOff,Type}|Simple], Conflict)
+ end
+ end;
+split_moves([], _, _, Stores, Simple, Conflict) ->
+ {Stores, Simple, Conflict}.
+
+split_conflict([{SrcOff,DstOff,Type}|Conflict], FPoff, Pushes, Pops) ->
+ FPoff1 = FPoff + word_size(),
+ Push = {SrcOff,-FPoff1,Type},
+ Pop = {-FPoff1,DstOff,Type},
+ split_conflict(Conflict, FPoff1, [Push|Pushes], [Pop|Pops]);
+split_conflict([], FPoff, Pushes, Pops) ->
+ {lists:reverse(Pushes), Pops, FPoff}.
+
+simple_moves([{SrcOff,DstOff,Type}|Moves], FPoff, TempReg, Rest) ->
+ Temp = hipe_sparc:mk_temp(TempReg, Type),
+ SP = hipe_sparc:mk_sp(),
+ LoadOff = FPoff+SrcOff,
+ StoreOff = FPoff+DstOff,
+ simple_moves(Moves, FPoff, TempReg,
+ mk_load(SP, LoadOff, Temp,
+ mk_store(Temp, SP, StoreOff,
+ Rest)));
+simple_moves([], _, _, Rest) ->
+ Rest.
+
+store_moves([{Src,DstOff}|Moves], FPoff, TempReg, Rest) ->
+ %% Type = typeof_temp(Src),
+ SP = hipe_sparc:mk_sp(),
+ StoreOff = FPoff+DstOff,
+ {NewSrc,FixSrc} =
+ case hipe_sparc:is_temp(Src) of
+ true ->
+ {Src, []};
+ _ ->
+ Temp = hipe_sparc:mk_temp(TempReg, 'untagged'),
+ {Temp, hipe_sparc:mk_set(Src, Temp)}
+ end,
+ store_moves(Moves, FPoff, TempReg,
+ FixSrc ++ mk_store(NewSrc, SP, StoreOff, Rest));
+store_moves([], _, _, Rest) ->
+ Rest.
+
+%%%
+%%% Contexts
+%%%
+
+-record(context, {liveness, framesize, arity, map, clobbers_ra, ref_maxstack}).
+
+mk_context(Liveness, Formals, Temps, ClobbersRA) ->
+ {Map, MinOff} = mk_temp_map(Formals, ClobbersRA, Temps),
+ FrameSize = (-MinOff),
+ RefMaxStack = hipe_bifs:ref(FrameSize),
+ #context{liveness=Liveness,
+ framesize=FrameSize, arity=length(Formals),
+ map=Map, clobbers_ra=ClobbersRA, ref_maxstack=RefMaxStack}.
+
+context_need_stack(#context{ref_maxstack=RM}, N) ->
+ M = hipe_bifs:ref_get(RM),
+ if N > M -> hipe_bifs:ref_set(RM, N);
+ true -> []
+ end.
+
+context_maxstack(#context{ref_maxstack=RM}) ->
+ hipe_bifs:ref_get(RM).
+
+context_arity(#context{arity=Arity}) ->
+ Arity.
+
+context_framesize(#context{framesize=FrameSize}) ->
+ FrameSize.
+
+context_liveness(#context{liveness=Liveness}) ->
+ Liveness.
+
+context_offset(#context{map=Map}, Temp) ->
+ tmap_lookup(Map, Temp).
+
+context_clobbers_ra(#context{clobbers_ra=ClobbersRA}) -> ClobbersRA.
+
+mk_temp_map(Formals, ClobbersRA, Temps) ->
+ {Map, 0} = enter_vars(Formals, word_size() * length(Formals),
+ tmap_empty()),
+ TempsList = tset_to_list(Temps),
+ AllTemps =
+ case ClobbersRA of
+ false -> TempsList;
+ true ->
+ RA = hipe_sparc:mk_new_temp('untagged'),
+ [RA|TempsList]
+ end,
+ enter_vars(AllTemps, 0, Map).
+
+enter_vars([V|Vs], PrevOff, Map) ->
+ Off =
+ case hipe_sparc:temp_type(V) of
+ 'double' -> PrevOff - 2*word_size(); % XXX: sparc64: 1*word_size()
+ _ -> PrevOff - word_size()
+ end,
+ enter_vars(Vs, Off, tmap_bind(Map, V, Off));
+enter_vars([], Off, Map) ->
+ {Map, Off}.
+
+tmap_empty() ->
+ gb_trees:empty().
+
+tmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+tmap_lookup(Map, Key) ->
+ gb_trees:get(Key, Map).
+
+%%%
+%%% do_prologue: prepend stack frame allocation code.
+%%%
+%%% NewStart:
+%%% temp1 = *(P + P_SP_LIMIT)
+%%% temp2 = SP - MaxStack
+%%% cmp temp2, temp1
+%%% if (ltu) goto IncStack else goto AllocFrame
+%%% AllocFrame:
+%%% SP = temp2 [if FrameSize == MaxStack]
+%%% SP -= FrameSize [if FrameSize != MaxStack]
+%%% *(SP + FrameSize-WordSize) = RA [if ClobbersRA]
+%%% goto OldStart
+%%% OldStart:
+%%% ...
+%%% IncStack:
+%%% temp1 = RA
+%%% call inc_stack; nop
+%%% RA = temp1
+%%% goto NewStart
+
+do_prologue(CFG, Context) ->
+ MaxStack = context_maxstack(Context),
+ if MaxStack > 0 ->
+ FrameSize = context_framesize(Context),
+ OldStartLab = hipe_sparc_cfg:start_label(CFG),
+ NewStartLab = hipe_gensym:get_next_label(sparc),
+ %%
+ P = hipe_sparc:mk_temp(hipe_sparc_registers:proc_pointer(), 'untagged'),
+ Temp1 = hipe_sparc:mk_temp1(),
+ SP = hipe_sparc:mk_sp(),
+ %%
+ RA = hipe_sparc:mk_ra(),
+ ClobbersRA = context_clobbers_ra(Context),
+ GotoOldStartCode = [hipe_sparc:mk_b_label(OldStartLab)],
+ AllocFrameCodeTail =
+ case ClobbersRA of
+ false -> GotoOldStartCode;
+ true -> mk_store(RA, SP, FrameSize-word_size(), GotoOldStartCode)
+ end,
+ %%
+ Arity = context_arity(Context),
+ Guaranteed = erlang:max(0, (?SPARC_LEAF_WORDS - Arity) * word_size()),
+ %%
+ {CFG1,NewStartCode} =
+ if MaxStack =< Guaranteed ->
+ %% io:format("~w: MaxStack ~w =< Guaranteed ~w :-)\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameCode = adjust_sp(-FrameSize, AllocFrameCodeTail),
+ NewStartCode0 = AllocFrameCode, % no mflr needed
+ {CFG,NewStartCode0};
+ true ->
+ %% io:format("~w: MaxStack ~w > Guaranteed ~w :-(\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameLab = hipe_gensym:get_next_label(sparc),
+ IncStackLab = hipe_gensym:get_next_label(sparc),
+ Temp2 = hipe_sparc:mk_temp2(),
+ %%
+ NewStartCodeTail2 =
+ [hipe_sparc:mk_pseudo_bp('lu', IncStackLab, AllocFrameLab, 0.01)],
+ NewStartCodeTail1 = NewStartCodeTail2, % no mflr needed
+ NewStartCode0 =
+ mk_load(P, ?P_NSP_LIMIT, Temp1,
+ hipe_sparc:mk_addi(SP, -MaxStack, Temp2,
+ [hipe_sparc:mk_alu('subcc', Temp2, Temp1, hipe_sparc:mk_g0()) |
+ NewStartCodeTail1])),
+ %%
+ AllocFrameCode =
+ if MaxStack =:= FrameSize ->
+ %% io:format("~w: MaxStack =:= FrameSize =:= ~w :-)\n", [?MODULE,MaxStack]),
+ [hipe_sparc:mk_mov(Temp2, SP) |
+ AllocFrameCodeTail];
+ true ->
+ %% io:format("~w: MaxStack ~w =/= FrameSize ~w :-(\n", [?MODULE,MaxStack,FrameSize]),
+ adjust_sp(-FrameSize, AllocFrameCodeTail)
+ end,
+ %%
+ IncStackCodeTail =
+ [hipe_sparc:mk_call_rec(hipe_sparc:mk_prim('inc_stack_0'),
+ mk_minimal_sdesc(Context), not_remote),
+ hipe_sparc:mk_mov(Temp1, RA),
+ hipe_sparc:mk_b_label(NewStartLab)],
+ IncStackCode =
+ [hipe_sparc:mk_mov(RA, Temp1) | IncStackCodeTail], % mflr always needed
+ %%
+ CFG0a = hipe_sparc_cfg:bb_add(CFG, AllocFrameLab,
+ hipe_bb:mk_bb(AllocFrameCode)),
+ CFG0b = hipe_sparc_cfg:bb_add(CFG0a, IncStackLab,
+ hipe_bb:mk_bb(IncStackCode)),
+ %%
+ {CFG0b,NewStartCode0}
+ end,
+ %%
+ CFG2 = hipe_sparc_cfg:bb_add(CFG1, NewStartLab,
+ hipe_bb:mk_bb(NewStartCode)),
+ hipe_sparc_cfg:start_label_update(CFG2, NewStartLab);
+ true ->
+ CFG
+ end.
+
+%%% Create a load instruction.
+%%% May clobber Dst early for large offsets. In principle we could
+%%% clobber TEMP2 if Dst =:= Base, but Dst =/= Base here in frame.
+
+mk_load(Base, Offset, Dst, Rest) ->
+ LdOp = 'lduw', % XXX: sparc64: ldx
+ hipe_sparc:mk_load(LdOp, Base, Offset, Dst, 'error', Rest).
+
+mk_fload(Base, Offset, Dst) ->
+ hipe_sparc:mk_fload(Base, Offset, Dst, 'temp2').
+
+%%% Create a store instruction.
+%%% May clobber TEMP2 for large offsets.
+
+mk_store(Src, Base, Offset, Rest) ->
+ StOp = 'stw', % XXX: sparc64: stx
+ hipe_sparc:mk_store(StOp, Src, Base, Offset, 'temp2', Rest).
+
+mk_fstore(Src, Base, Offset) ->
+ hipe_sparc:mk_fstore(Src, Base, Offset, 'temp2').
+
+%%% typeof_temp -- what's temp's type?
+
+typeof_temp(Temp) ->
+ hipe_sparc:temp_type(Temp).
+
+%%% Check if an operand is a pseudo-Temp.
+
+src_is_pseudo(Src) ->
+ hipe_sparc:is_temp(Src) andalso temp_is_pseudo(Src).
+
+temp_is_pseudo(Temp) ->
+ not(hipe_sparc:temp_is_precoloured(Temp)).
+
+%%%
+%%% Detect if a Defun's body clobbers RA.
+%%%
+
+clobbers_ra(Insns) ->
+ case Insns of
+ [#pseudo_call{}|_] -> true;
+ %% moves to RA cannot occur yet
+ [_|Rest] -> clobbers_ra(Rest);
+ [] -> false
+ end.
+
+%%%
+%%% Build the set of all temps used in a Defun's body.
+%%%
+
+all_temps(Code, Formals) ->
+ S0 = find_temps(Code, tset_empty()),
+ S1 = tset_del_list(S0, Formals),
+ tset_filter(S1, fun(T) -> temp_is_pseudo(T) end).
+
+find_temps([I|Insns], S0) ->
+ S1 = tset_add_list(S0, hipe_sparc_defuse:insn_def_all(I)),
+ S2 = tset_add_list(S1, hipe_sparc_defuse:insn_use_all(I)),
+ find_temps(Insns, S2);
+find_temps([], S) ->
+ S.
+
+tset_empty() ->
+ gb_sets:new().
+
+tset_size(S) ->
+ gb_sets:size(S).
+
+tset_insert(S, T) ->
+ gb_sets:add_element(T, S).
+
+tset_add_list(S, Ts) ->
+ gb_sets:union(S, gb_sets:from_list(Ts)).
+
+tset_del_list(S, Ts) ->
+ gb_sets:subtract(S, gb_sets:from_list(Ts)).
+
+tset_filter(S, F) ->
+ gb_sets:filter(F, S).
+
+tset_to_list(S) ->
+ gb_sets:to_list(S).
+
+%%%
+%%% Compute minimum permissible frame size, ignoring spilled temps.
+%%% This is done to ensure that we won't have to adjust the frame size
+%%% in the middle of a tailcall.
+%%%
+
+defun_minframe(Defun) ->
+ MaxTailArity = body_mta(hipe_sparc:defun_code(Defun), 0),
+ MyArity = length(fix_formals(hipe_sparc:defun_formals(Defun))),
+ erlang:max(MaxTailArity - MyArity, 0).
+
+body_mta([I|Code], MTA) ->
+ body_mta(Code, insn_mta(I, MTA));
+body_mta([], MTA) ->
+ MTA.
+
+insn_mta(I, MTA) ->
+ case I of
+ #pseudo_tailcall{arity=Arity} ->
+ erlang:max(MTA, Arity - hipe_sparc_registers:nr_args());
+ _ -> MTA
+ end.
+
+%%%
+%%% Ensure that we have enough temps to satisfy the minimum frame size,
+%%% if necessary by prepending unused dummy temps.
+%%%
+
+ensure_minframe(MinFrame, Temps) ->
+ ensure_minframe(MinFrame, tset_size(Temps), Temps).
+
+ensure_minframe(MinFrame, Frame, Temps) ->
+ if MinFrame > Frame ->
+ Temp = hipe_sparc:mk_new_temp('untagged'),
+ ensure_minframe(MinFrame, Frame+1, tset_insert(Temps, Temp));
+ true -> Temps
+ end.
+
+word_size() ->
+ hipe_rtl_arch:word_size().
diff --git a/lib/hipe/sparc/hipe_sparc_liveness_all.erl b/lib/hipe/sparc/hipe_sparc_liveness_all.erl
new file mode 100644
index 0000000000..c6f78f9f7a
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_liveness_all.erl
@@ -0,0 +1,38 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_liveness_all).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_sparc.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_sparc_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_sparc_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_sparc_cfg:succ(CFG, L).
+uses(Insn) -> hipe_sparc_defuse:insn_use_all(Insn).
+defines(Insn) -> hipe_sparc_defuse:insn_def_all(Insn).
+liveout_no_succ() ->
+ ordsets:from_list(lists:map(fun({Reg,Type}) ->
+ hipe_sparc:mk_temp(Reg, Type)
+ end,
+ hipe_sparc_registers:live_at_return())).
diff --git a/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl b/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl
new file mode 100644
index 0000000000..ac67e499ad
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl
@@ -0,0 +1,34 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_liveness_fpr).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_sparc.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_sparc_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_sparc_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_sparc_cfg:succ(CFG, L).
+uses(Insn) -> hipe_sparc_defuse:insn_use_fpr(Insn).
+defines(Insn) -> hipe_sparc_defuse:insn_def_fpr(Insn).
+liveout_no_succ() -> [].
diff --git a/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl b/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl
new file mode 100644
index 0000000000..0b07ae5c9d
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl
@@ -0,0 +1,38 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_liveness_gpr).
+-export([analyse/1]).
+-export([liveout/2]).
+
+-include("hipe_sparc.hrl").
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_sparc_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_sparc_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_sparc_cfg:succ(CFG, L).
+uses(Insn) -> hipe_sparc_defuse:insn_use_gpr(Insn).
+defines(Insn) -> hipe_sparc_defuse:insn_def_gpr(Insn).
+liveout_no_succ() ->
+ ordsets:from_list(lists:map(fun({Reg,Type}) ->
+ hipe_sparc:mk_temp(Reg, Type)
+ end,
+ hipe_sparc_registers:live_at_return())).
diff --git a/lib/hipe/sparc/hipe_sparc_main.erl b/lib/hipe/sparc/hipe_sparc_main.erl
new file mode 100644
index 0000000000..2e5c8e0494
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_main.erl
@@ -0,0 +1,58 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_main).
+-export([rtl_to_sparc/3]).
+
+rtl_to_sparc(MFA, RTL, Options) ->
+ Defun1 = hipe_rtl_to_sparc:translate(RTL),
+ %% io:format("~w: after translate\n", [?MODULE]),
+ %% hipe_sparc_pp:pp(Defun1),
+ Defun2 = hipe_sparc_ra:ra(Defun1, Options),
+ %% io:format("~w: after regalloc\n", [?MODULE]),
+ %% hipe_sparc_pp:pp(Defun2),
+ Defun3 = hipe_sparc_frame:frame(Defun2),
+ %% io:format("~w: after frame\n", [?MODULE]),
+ %% hipe_sparc_pp:pp(Defun3),
+ Defun4 = hipe_sparc_finalise:finalise(Defun3),
+ %% io:format("~w: after finalise\n", [?MODULE]),
+ pp(Defun4, MFA, Options),
+ {native, sparc, {unprofiled, Defun4}}.
+
+pp(Defun, MFA, Options) ->
+ case proplists:get_value(pp_native, Options) of
+ true ->
+ hipe_sparc_pp:pp(Defun);
+ {only,Lst} when is_list(Lst) ->
+ case lists:member(MFA,Lst) of
+ true ->
+ hipe_sparc_pp:pp(Defun);
+ false ->
+ ok
+ end;
+ {only,MFA} ->
+ hipe_sparc_pp:pp(Defun);
+ {file,FileName} ->
+ {ok, File} = file:open(FileName, [write,append]),
+ hipe_sparc_pp:pp(File, Defun),
+ ok = file:close(File);
+ _ ->
+ ok
+ end.
diff --git a/lib/hipe/sparc/hipe_sparc_pp.erl b/lib/hipe/sparc/hipe_sparc_pp.erl
new file mode 100644
index 0000000000..6b49acdd11
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_pp.erl
@@ -0,0 +1,342 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_pp).
+-export([pp/1, pp/2, pp_insn/1]).
+-include("hipe_sparc.hrl").
+
+pp(Defun) ->
+ pp(standard_io, Defun).
+
+pp(Dev, #defun{mfa={M,F,A}, code=Code, data=Data}) ->
+ Fname = atom_to_list(M)++"_"++atom_to_list(F)++"_"++integer_to_list(A),
+ io:format(Dev, "\t.text\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ io:format(Dev, "\t.global ~s\n", [Fname]),
+ io:format(Dev, "~s:\n", [Fname]),
+ pp_insns(Dev, Code, Fname),
+ io:format(Dev, "\t.rodata\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ hipe_data_pp:pp(Dev, Data, sparc, Fname),
+ io:format(Dev, "\n", []).
+
+pp_insns(Dev, [I|Is], Fname) ->
+ pp_insn(Dev, I, Fname),
+ pp_insns(Dev, Is, Fname);
+pp_insns(_, [], _) ->
+ [].
+
+pp_insn(I) ->
+ pp_insn(standard_io, I, "").
+
+pp_insn(Dev, I, Pre) ->
+ case I of
+ #alu{aluop=AluOp, dst=Dst, src1=Src1, src2=Src2} ->
+ io:format(Dev, "\t~s ", [alu_op_name(AluOp)]),
+ case aluop_is_ldop(AluOp) of
+ true ->
+ io:format(Dev, "[", []),
+ pp_temp(Dev, Src1),
+ io:format(Dev, " + ", []),
+ pp_src(Dev, Src2),
+ io:format(Dev, "]", []);
+ false ->
+ pp_temp(Dev, Src1),
+ io:format(Dev, ", ", []),
+ pp_src(Dev, Src2)
+ end,
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #bp{'cond'=Cond, label=Label, pred=Pred} ->
+ io:format(Dev, "\tb~w,~w .~s_~w\n",
+ [cond_name(Cond), pred_name(Pred), Pre, Label]);
+ %% #br{} -> pp_br(Dev, I, Pre);
+ #call_rec{'fun'=Fun, sdesc=SDesc, linkage=Linkage} ->
+ io:format(Dev, "\tcall ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " #", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #call_tail{'fun'=Fun, linkage=Linkage} ->
+ io:format(Dev, "\tb ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " # ~w\n", [Linkage]);
+ #comment{term=Term} ->
+ io:format(Dev, "\t# ~p\n", [Term]);
+ #jmp{src1=Src1, src2=Src2, labels=Labels} ->
+ io:format(Dev, "\tjmp [", []),
+ pp_temp(Dev, Src1),
+ io:format(Dev, " + ", []),
+ pp_src(Dev, Src2),
+ io:format(Dev, "]", []),
+ case Labels of
+ [] -> [];
+ _ ->
+ io:format(Dev, " #", []),
+ pp_labels(Dev, Labels, Pre)
+ end,
+ io:format(Dev, "\n", []);
+ #jmpl{src=Src, sdesc=SDesc} ->
+ io:format(Dev, "\tjmpl [", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, " + 0], %o7 # ", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, "\n", []);
+ #label{label=Label} ->
+ io:format(Dev, ".~s_~w:~n", [Pre, Label]);
+ #pseudo_bp{'cond'=Cond, true_label=TrueLab, false_label=FalseLab, pred=Pred} ->
+ io:format(Dev, "\tpseudo_b~w,~w .~s_~w # .~s_~w\n",
+ [cond_name(Cond), pred_name(Pred), Pre, TrueLab, Pre, FalseLab]);
+ %% #pseudo_br{} -> pp_pseudo_br(Dev, I, Pre);
+ #pseudo_call{funv=FunV, sdesc=SDesc, contlab=ContLab, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_call ", []),
+ pp_funv(Dev, FunV),
+ io:format(Dev, " # contlab .~s_~w", [Pre, ContLab]),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #pseudo_call_prepare{nrstkargs=NrStkArgs} ->
+ SP = hipe_sparc_registers:reg_name_gpr(hipe_sparc_registers:stack_pointer()),
+ io:format(Dev, "\tsub ~s, ~w, ~s # pseudo_call_prepare\n",
+ [SP, 4*NrStkArgs, SP]);
+ #pseudo_move{src=Src, dst=Dst} ->
+ io:format(Dev, "\tpseudo_move ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #pseudo_ret{} ->
+ io:format(Dev, "\tpseudo_ret\n", []);
+ #pseudo_set{imm=Imm, dst=Dst} ->
+ io:format(Dev, "\tpseudo_set ", []),
+ pp_imm(Dev, Imm),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #pseudo_tailcall{funv=FunV, arity=Arity, stkargs=StkArgs, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_tailcall ", []),
+ pp_funv(Dev, FunV),
+ io:format(Dev, "/~w (", [Arity]),
+ pp_args(Dev, StkArgs),
+ io:format(Dev, ") ~w\n", [Linkage]);
+ #pseudo_tailcall_prepare{} ->
+ io:format(Dev, "\tpseudo_tailcall_prepare\n", []);
+ #rdy{dst=Dst} ->
+ io:format(Dev, "\trd %y, ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #sethi{dst=Dst, uimm22=#sparc_uimm22{value=Value}} ->
+ io:format(Dev, "\tsethi ", []),
+ pp_hex(Dev, Value),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #store{stop=StOp, src=Src, base=Base, disp=Disp} ->
+ io:format(Dev, "\t~s ", [stop_name(StOp)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", [", []),
+ pp_temp(Dev, Base),
+ io:format(Dev, " + ", []),
+ pp_src(Dev, Disp),
+ io:format(Dev, "]\n", []);
+ #fp_binary{fp_binop=FpBinOp, src1=Src1, src2=Src2, dst=Dst} ->
+ io:format(Dev, "\t~s ", [FpBinOp]),
+ pp_temp(Dev, Src1),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Src2),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #fp_unary{fp_unop=FpUnOp, src=Src, dst=Dst} ->
+ io:format(Dev, "\t~s ", [FpUnOp]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #pseudo_fload{base=Base, disp=Disp, dst=Dst, is_single=IsSingle} ->
+ io:format(Dev, "\t~s [",
+ [case IsSingle of
+ true -> 'ldf';
+ _ -> 'pseudo_fload' end]),
+ pp_temp(Dev, Base),
+ io:format(Dev, " + ", []),
+ pp_simm13(Dev, Disp),
+ io:format(Dev, "], ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #pseudo_fmove{src=Src, dst=Dst} ->
+ io:format(Dev, "\tpseudo_fmove ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #pseudo_fstore{src=Src, base=Base, disp=Disp} ->
+ io:format(Dev, "\tpseudo_fstore ", []),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", [", []),
+ pp_temp(Dev, Base),
+ io:format(Dev, " + ", []),
+ pp_simm13(Dev, Disp),
+ io:format(Dev, "]\n", []);
+ _ ->
+ exit({?MODULE, pp_insn, I})
+ end.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+pp_br(Dev, I, Pre) ->
+ #br{rcond=RCond, src=Src, label=Label, pred=Pred} = I,
+ io:format(Dev, "\tbr~w,~w ", [rcond_name(RCond), pred_name(Pred)]),
+ pp_temp(Dev, Src),
+ io:format(Dev, ", .~s_~w\n", [Pre, Label]).
+
+pp_pseudo_br(Dev, I, Pre) ->
+ #pseudo_br{rcond=RCond, src=Src, true_label=TrueLab, false_label=FalseLab, pred=Pred} = I,
+ io:format(Dev, "\tpseudo_br~w,~w ", [rcond_name(RCond), pred_name(Pred)]),
+ pp_src(Dev, Src),
+ io:format(Dev, ", .~s_~w # .~s_~w\n", [Pre, TrueLab, Pre, FalseLab]).
+-endif.
+
+to_hex(N) ->
+ io_lib:format("~.16x", [N, "0x"]).
+
+pp_sdesc(Dev, Pre, #sparc_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live}) ->
+ pp_sdesc_exnlab(Dev, Pre, ExnLab),
+ io:format(Dev, " ~s ~w [", [to_hex(FSize), Arity]),
+ pp_sdesc_live(Dev, Live),
+ io:format(Dev, "]", []).
+
+pp_sdesc_exnlab(Dev, _, []) -> io:format(Dev, " []", []);
+pp_sdesc_exnlab(Dev, Pre, ExnLab) -> io:format(Dev, " .~s_~w", [Pre, ExnLab]).
+
+pp_sdesc_live(_, {}) -> [];
+pp_sdesc_live(Dev, Live) -> pp_sdesc_live(Dev, Live, 1).
+
+pp_sdesc_live(Dev, Live, I) ->
+ io:format(Dev, "~s", [to_hex(element(I, Live))]),
+ if I < tuple_size(Live) ->
+ io:format(Dev, ",", []),
+ pp_sdesc_live(Dev, Live, I+1);
+ true -> []
+ end.
+
+pp_labels(Dev, [Label|Labels], Pre) ->
+ io:format(Dev, " .~s_~w", [Pre, Label]),
+ pp_labels(Dev, Labels, Pre);
+pp_labels(_, [], _) ->
+ [].
+
+pp_fun(Dev, Fun) ->
+ case Fun of
+ #sparc_mfa{m=M, f=F, a=A} ->
+ io:format(Dev, "~w:~w/~w", [M, F, A]);
+ #sparc_prim{prim=Prim} ->
+ io:format(Dev, "~w", [Prim])
+ end.
+
+pp_funv(Dev, FunV) ->
+ case FunV of
+ #sparc_temp{} ->
+ pp_temp(Dev, FunV);
+ Fun ->
+ pp_fun(Dev, Fun)
+ end.
+
+alu_op_name(Op) -> Op.
+
+aluop_is_ldop(AluOp) ->
+ case AluOp of
+ 'ldsb' -> true;
+ 'ldsh' -> true;
+ 'ldsw' -> true;
+ 'ldub' -> true;
+ 'lduh' -> true;
+ 'lduw' -> true;
+ 'ldx' -> true;
+ _ -> false
+ end.
+
+cond_name(Cond) -> Cond.
+%%rcond_name(RCond) -> RCond.
+
+pred_name(Pred) ->
+ if Pred >= 0.5 -> 'pt';
+ true -> 'pn'
+ end.
+
+stop_name(StOp) -> StOp.
+
+pp_temp(Dev, Temp=#sparc_temp{reg=Reg, type=Type}) ->
+ case hipe_sparc:temp_is_precoloured(Temp) of
+ true ->
+ Name =
+ case Type of
+ double -> hipe_sparc_registers:reg_name_fpr(Reg);
+ _ -> hipe_sparc_registers:reg_name_gpr(Reg)
+ end,
+ io:format(Dev, "~s", [Name]);
+ false ->
+ Tag =
+ case Type of
+ double -> "f";
+ tagged -> "t";
+ untagged -> "u"
+ end,
+ io:format(Dev, "~s~w", [Tag, Reg])
+ end.
+
+pp_hex(Dev, Value) -> io:format(Dev, "~s", [to_hex(Value)]).
+pp_simm13(Dev, #sparc_simm13{value=Value}) -> pp_hex(Dev, Value).
+pp_uimm5(Dev, #sparc_uimm5{value=Value}) -> pp_hex(Dev, Value).
+
+pp_imm(Dev, Value) ->
+ if is_integer(Value) -> pp_hex(Dev, Value);
+ true -> io:format(Dev, "~w", [Value])
+ end.
+
+pp_src(Dev, Src) ->
+ case Src of
+ #sparc_temp{} ->
+ pp_temp(Dev, Src);
+ #sparc_simm13{} ->
+ pp_simm13(Dev, Src);
+ #sparc_uimm5{} -> % XXX: sparc64: uimm6
+ pp_uimm5(Dev, Src)
+ end.
+
+pp_arg(Dev, Arg) ->
+ case Arg of
+ #sparc_temp{} ->
+ pp_temp(Dev, Arg);
+ _ ->
+ pp_hex(Dev, Arg)
+ end.
+
+pp_args(Dev, [A|As]) ->
+ pp_arg(Dev, A),
+ pp_comma_args(Dev, As);
+pp_args(_, []) ->
+ [].
+
+pp_comma_args(Dev, [A|As]) ->
+ io:format(Dev, ", ", []),
+ pp_arg(Dev, A),
+ pp_comma_args(Dev, As);
+pp_comma_args(_, []) ->
+ [].
diff --git a/lib/hipe/sparc/hipe_sparc_ra.erl b/lib/hipe/sparc/hipe_sparc_ra.erl
new file mode 100644
index 0000000000..40360e97fe
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_ra.erl
@@ -0,0 +1,56 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_ra).
+-export([ra/2]).
+
+ra(Defun0, Options) ->
+ %% hipe_sparc_pp:pp(Defun0),
+ {Defun1, Coloring_fp, SpillIndex}
+ = case proplists:get_bool(inline_fp, Options) of
+ true ->
+ hipe_regalloc_loop:ra_fp(Defun0, Options,
+ hipe_coalescing_regalloc,
+ hipe_sparc_specific_fp);
+ false ->
+ {Defun0,[],0}
+ end,
+ %% hipe_sparc_pp:pp(Defun1),
+ {Defun2, Coloring}
+ = case proplists:get_value(regalloc, Options, coalescing) of
+ coalescing ->
+ ra(Defun1, SpillIndex, Options, hipe_coalescing_regalloc);
+ optimistic ->
+ ra(Defun1, SpillIndex, Options, hipe_optimistic_regalloc);
+ graph_color ->
+ ra(Defun1, SpillIndex, Options, hipe_graph_coloring_regalloc);
+ linear_scan ->
+ hipe_sparc_ra_ls:ra(Defun1, SpillIndex, Options);
+ naive ->
+ hipe_sparc_ra_naive:ra(Defun1, Coloring_fp, Options);
+ _ ->
+ exit({unknown_regalloc_compiler_option,
+ proplists:get_value(regalloc,Options)})
+ end,
+ %% hipe_sparc_pp:pp(Defun2),
+ hipe_sparc_ra_finalise:finalise(Defun2, Coloring, Coloring_fp).
+
+ra(Defun, SpillIndex, Options, RegAllocMod) ->
+ hipe_regalloc_loop:ra(Defun, SpillIndex, Options, RegAllocMod, hipe_sparc_specific).
diff --git a/lib/hipe/sparc/hipe_sparc_ra_finalise.erl b/lib/hipe/sparc/hipe_sparc_ra_finalise.erl
new file mode 100644
index 0000000000..3403636118
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_ra_finalise.erl
@@ -0,0 +1,254 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_ra_finalise).
+-export([finalise/3]).
+-include("hipe_sparc.hrl").
+
+finalise(Defun, TempMap, FPMap0) ->
+ Code = hipe_sparc:defun_code(Defun),
+ {_, SpillLimit} = hipe_sparc:defun_var_range(Defun),
+ Map = mk_ra_map(TempMap, SpillLimit),
+ FPMap1 = mk_ra_map_fp(FPMap0, SpillLimit),
+ NewCode = ra_code(Code, Map, FPMap1, []),
+ Defun#defun{code=NewCode}.
+
+ra_code([I|Insns], Map, FPMap, Accum) ->
+ ra_code(Insns, Map, FPMap, [ra_insn(I, Map, FPMap) | Accum]);
+ra_code([], _Map, _FPMap, Accum) ->
+ lists:reverse(Accum).
+
+ra_insn(I, Map, FPMap) ->
+ case I of
+ #alu{} -> ra_alu(I, Map);
+ #jmp{} -> ra_jmp(I, Map);
+ %% #pseudo_br{} -> ra_pseudo_br(I, Map);
+ #pseudo_call{} -> ra_pseudo_call(I, Map);
+ #pseudo_move{} -> ra_pseudo_move(I, Map);
+ #pseudo_set{} -> ra_pseudo_set(I, Map);
+ #pseudo_tailcall{} -> ra_pseudo_tailcall(I, Map);
+ #rdy{} -> ra_rdy(I, Map);
+ #sethi{} -> ra_sethi(I, Map);
+ #store{} -> ra_store(I, Map);
+ #fp_binary{} -> ra_fp_binary(I, FPMap);
+ #fp_unary{} -> ra_fp_unary(I, FPMap);
+ #pseudo_fload{} -> ra_pseudo_fload(I, Map, FPMap);
+ #pseudo_fmove{} -> ra_pseudo_fmove(I, FPMap);
+ #pseudo_fstore{} -> ra_pseudo_fstore(I, Map, FPMap);
+ _ -> I
+ end.
+
+ra_alu(I=#alu{src1=Src1,src2=Src2,dst=Dst}, Map) ->
+ NewSrc1 = ra_temp(Src1, Map),
+ NewSrc2 = ra_src(Src2, Map),
+ NewDst = ra_temp(Dst, Map),
+ I#alu{src1=NewSrc1,src2=NewSrc2,dst=NewDst}.
+
+ra_jmp(I=#jmp{src1=Src1,src2=Src2}, Map) ->
+ NewSrc1 = ra_temp(Src1, Map),
+ NewSrc2 = ra_src(Src2, Map),
+ I#jmp{src1=NewSrc1,src2=NewSrc2}.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+ra_pseudo_br(I=#pseudo_br{src=Src}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ I#pseudo_br{src=NewSrc}.
+-endif.
+
+ra_pseudo_call(I=#pseudo_call{funv=FunV}, Map) ->
+ NewFunV = ra_funv(FunV, Map),
+ I#pseudo_call{funv=NewFunV}.
+
+ra_pseudo_move(I=#pseudo_move{src=Src,dst=Dst}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewDst = ra_temp(Dst, Map),
+ I#pseudo_move{src=NewSrc,dst=NewDst}.
+
+ra_pseudo_set(I=#pseudo_set{dst=Dst}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ I#pseudo_set{dst=NewDst}.
+
+ra_pseudo_tailcall(I=#pseudo_tailcall{funv=FunV,stkargs=StkArgs}, Map) ->
+ NewFunV = ra_funv(FunV, Map),
+ NewStkArgs = ra_args(StkArgs, Map),
+ I#pseudo_tailcall{funv=NewFunV,stkargs=NewStkArgs}.
+
+ra_rdy(I=#rdy{dst=Dst}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ I#rdy{dst=NewDst}.
+
+ra_sethi(I=#sethi{dst=Dst}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ I#sethi{dst=NewDst}.
+
+ra_store(I=#store{src=Src,base=Base,disp=Disp}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewBase = ra_temp(Base, Map),
+ NewDisp = ra_src(Disp, Map),
+ I#store{src=NewSrc,base=NewBase,disp=NewDisp}.
+
+ra_fp_binary(I=#fp_binary{src1=Src1,src2=Src2,dst=Dst}, FPMap) ->
+ NewSrc1 = ra_temp_fp(Src1, FPMap),
+ NewSrc2 = ra_temp_fp(Src2, FPMap),
+ NewDst = ra_temp_fp(Dst, FPMap),
+ I#fp_binary{src1=NewSrc1,src2=NewSrc2,dst=NewDst}.
+
+ra_fp_unary(I=#fp_unary{src=Src,dst=Dst}, FPMap) ->
+ NewSrc = ra_temp_fp(Src, FPMap),
+ NewDst = ra_temp_fp(Dst, FPMap),
+ I#fp_unary{src=NewSrc,dst=NewDst}.
+
+ra_pseudo_fload(I=#pseudo_fload{base=Base,dst=Dst}, Map, FPMap) ->
+ NewBase = ra_temp(Base, Map),
+ NewDst = ra_temp_fp(Dst, FPMap),
+ I#pseudo_fload{base=NewBase,dst=NewDst}.
+
+ra_pseudo_fmove(I=#pseudo_fmove{src=Src,dst=Dst}, FPMap) ->
+ NewSrc = ra_temp_fp(Src, FPMap),
+ NewDst = ra_temp_fp(Dst, FPMap),
+ I#pseudo_fmove{src=NewSrc,dst=NewDst}.
+
+ra_pseudo_fstore(I=#pseudo_fstore{src=Src,base=Base}, Map, FPMap) ->
+ NewSrc = ra_temp_fp(Src, FPMap),
+ NewBase = ra_temp(Base, Map),
+ I#pseudo_fstore{src=NewSrc,base=NewBase}.
+
+%%% Tailcall stack arguments.
+
+ra_args([Arg|Args], Map) ->
+ [ra_temp_or_imm(Arg, Map) | ra_args(Args, Map)];
+ra_args([], _) ->
+ [].
+
+ra_temp_or_imm(Arg, Map) ->
+ case hipe_sparc:is_temp(Arg) of
+ true ->
+ ra_temp(Arg, Map);
+ false ->
+ Arg
+ end.
+
+%%% FunV, Src, and Temp operands.
+
+ra_funv(FunV, Map) ->
+ case FunV of
+ #sparc_temp{} -> ra_temp(FunV, Map);
+ _ -> FunV
+ end.
+
+ra_src(Src, Map) ->
+ case Src of
+ #sparc_temp{} -> ra_temp(Src, Map);
+ _ -> Src
+ end.
+
+ra_temp_fp(Temp, FPMap) ->
+ Reg = hipe_sparc:temp_reg(Temp),
+ double = hipe_sparc:temp_type(Temp),
+ case hipe_sparc_registers:is_precoloured_fpr(Reg) of
+ true -> Temp;
+ _ -> ra_temp_common(Reg, Temp, FPMap)
+ end.
+
+ra_temp(Temp, Map) ->
+ Reg = hipe_sparc:temp_reg(Temp),
+ case hipe_sparc:temp_type(Temp) of
+ 'double' ->
+ exit({?MODULE,ra_temp,Temp});
+ _ ->
+ case hipe_sparc_registers:is_precoloured_gpr(Reg) of
+ true -> Temp;
+ _ -> ra_temp_common(Reg, Temp, Map)
+ end
+ end.
+
+ra_temp_common(Reg, Temp, Map) ->
+ case gb_trees:lookup(Reg, Map) of
+ {value, NewReg} -> Temp#sparc_temp{reg=NewReg};
+ _ -> Temp
+ end.
+
+mk_ra_map(TempMap, SpillLimit) ->
+ %% Build a partial map from pseudo to reg or spill.
+ %% Spills are represented as pseudos with indices above SpillLimit.
+ %% (I'd prefer to use negative indices, but that breaks
+ %% hipe_sparc_registers:is_precoloured/1.)
+ %% The frame mapping proper is unchanged, since spills look just like
+ %% ordinary (un-allocated) pseudos.
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit, is_precoloured_gpr),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ TempMap).
+
+conv_ra_maplet(MapLet = {From,To}, SpillLimit, IsPrecoloured) ->
+ %% From should be a pseudo, or a hard reg mapped to itself.
+ if is_integer(From), From =< SpillLimit ->
+ case hipe_sparc_registers:IsPrecoloured(From) of
+ false -> [];
+ _ ->
+ case To of
+ {reg, From} -> [];
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of From check
+ case To of
+ {reg, NewReg} ->
+ %% NewReg should be a hard reg, or a pseudo mapped
+ %% to itself (formals are handled this way).
+ if is_integer(NewReg) ->
+ case hipe_sparc_registers:IsPrecoloured(NewReg) of
+ true -> [];
+ _ -> if From =:= NewReg -> [];
+ true ->
+ exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of NewReg check
+ {From, NewReg};
+ {spill, SpillIndex} ->
+ %% SpillIndex should be >= 0.
+ if is_integer(SpillIndex), SpillIndex >= 0 -> [];
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of SpillIndex check
+ ToTempNum = SpillLimit+SpillIndex+1,
+ MaxTempNum = hipe_gensym:get_var(sparc),
+ if MaxTempNum >= ToTempNum -> ok;
+ true -> hipe_gensym:set_var(sparc, ToTempNum)
+ end,
+ {From, ToTempNum};
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end.
+
+mk_ra_map_fp(FPMap, SpillLimit) ->
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit,
+ is_precoloured_fpr),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ FPMap).
diff --git a/lib/hipe/sparc/hipe_sparc_ra_ls.erl b/lib/hipe/sparc/hipe_sparc_ra_ls.erl
new file mode 100644
index 0000000000..cdb15e738c
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_ra_ls.erl
@@ -0,0 +1,56 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Linear Scan register allocator for SPARC
+
+-module(hipe_sparc_ra_ls).
+-export([ra/3]).
+
+ra(Defun, SpillIndex, Options) ->
+ NewDefun = Defun, %% hipe_${ARCH}_ra_rename:rename(Defun,Options),
+ CFG = hipe_sparc_cfg:init(NewDefun),
+ SpillLimit = hipe_sparc_specific:number_of_temporaries(CFG),
+ alloc(NewDefun, SpillIndex, SpillLimit, Options).
+
+alloc(Defun, SpillIndex, SpillLimit, Options) ->
+ CFG = hipe_sparc_cfg:init(Defun),
+ {Coloring, _NewSpillIndex} =
+ regalloc(
+ CFG,
+ hipe_sparc_registers:allocatable_gpr()--
+ [hipe_sparc_registers:temp3(),
+ hipe_sparc_registers:temp2(),
+ hipe_sparc_registers:temp1()],
+ [hipe_sparc_cfg:start_label(CFG)],
+ SpillIndex, SpillLimit, Options,
+ hipe_sparc_specific),
+ {NewDefun, _DidSpill} =
+ hipe_sparc_ra_postconditions:check_and_rewrite(
+ Defun, Coloring, 'linearscan'),
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_sparc_specific),
+ {TempMap2,_NewSpillIndex2} =
+ hipe_spillmin:stackalloc(CFG, [], SpillIndex, Options,
+ hipe_sparc_specific, TempMap),
+ Coloring2 =
+ hipe_spillmin:mapmerge(hipe_temp_map:to_substlist(TempMap), TempMap2),
+ {NewDefun, Coloring2}.
+
+regalloc(CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target) ->
+ hipe_ls_regalloc:regalloc(
+ CFG, PhysRegs, Entrypoints, SpillIndex, DontSpill, Options, Target).
diff --git a/lib/hipe/sparc/hipe_sparc_ra_naive.erl b/lib/hipe/sparc/hipe_sparc_ra_naive.erl
new file mode 100644
index 0000000000..8c378c4850
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_ra_naive.erl
@@ -0,0 +1,29 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_ra_naive).
+-export([ra/3]).
+
+-include("hipe_sparc.hrl").
+
+ra(Defun, _Coloring_fp, _Options) -> % -> {Defun, Coloring}
+ {NewDefun,_DidSpill} =
+ hipe_sparc_ra_postconditions:check_and_rewrite2(Defun, [], 'naive'),
+ {NewDefun, []}.
diff --git a/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl b/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl
new file mode 100644
index 0000000000..f7fdae0491
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl
@@ -0,0 +1,222 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_ra_postconditions).
+
+-export([check_and_rewrite/3, check_and_rewrite2/3]).
+
+-include("hipe_sparc.hrl").
+
+check_and_rewrite(Defun, Coloring, Allocator) ->
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_sparc_specific),
+ check_and_rewrite2(Defun, TempMap, Allocator).
+
+check_and_rewrite2(Defun, TempMap, Allocator) ->
+ Strategy = strategy(Allocator),
+ #defun{code=Code0} = Defun,
+ {Code1,DidSpill} = do_insns(Code0, TempMap, Strategy, [], false),
+ VarRange = {0, hipe_gensym:get_var(sparc)},
+ {Defun#defun{code=Code1, var_range=VarRange},
+ DidSpill}.
+
+strategy(Allocator) ->
+ case Allocator of
+ 'normal' -> 'new';
+ 'linearscan' -> 'fixed';
+ 'naive' -> 'fixed'
+ end.
+
+do_insns([I|Insns], TempMap, Strategy, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap, Strategy),
+ do_insns(Insns, TempMap, Strategy, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, _Strategy, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap, Strategy) ->
+ case I of
+ #alu{} -> do_alu(I, TempMap, Strategy);
+ #jmp{} -> do_jmp(I, TempMap, Strategy);
+ %% #pseudo_br{} -> do_pseudo_br(I, TempMap, Strategy);
+ #pseudo_call{} -> do_pseudo_call(I, TempMap, Strategy);
+ #pseudo_move{} -> do_pseudo_move(I, TempMap, Strategy);
+ #pseudo_set{} -> do_pseudo_set(I, TempMap, Strategy);
+ #pseudo_tailcall{} -> do_pseudo_tailcall(I, TempMap, Strategy);
+ #rdy{} -> do_rdy(I, TempMap, Strategy);
+ #sethi{} -> do_sethi(I, TempMap, Strategy);
+ #store{} -> do_store(I, TempMap, Strategy);
+ #pseudo_fload{} -> do_pseudo_fload(I, TempMap, Strategy);
+ #pseudo_fstore{} -> do_pseudo_fstore(I, TempMap, Strategy);
+ _ -> {[I], false}
+ end.
+
+%%% Fix relevant instruction types.
+
+do_alu(I=#alu{dst=Dst,src1=Src1,src2=Src2}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill1} = fix_dst(Dst, TempMap, Strategy),
+ {FixSrc1,NewSrc1,DidSpill2} = fix_src1(Src1, TempMap, Strategy),
+ {FixSrc2,NewSrc2,DidSpill3} = fix_src2_or_imm(Src2, TempMap, Strategy),
+ NewI = I#alu{dst=NewDst,src1=NewSrc1,src2=NewSrc2},
+ {FixSrc1 ++ FixSrc2 ++ [NewI | FixDst], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_jmp(I=#jmp{src1=Src1,src2=Src2}, TempMap, Strategy) ->
+ {FixSrc1,NewSrc1,DidSpill1} = fix_src1(Src1, TempMap, Strategy),
+ {FixSrc2,NewSrc2,DidSpill2} = fix_src2_or_imm(Src2, TempMap, Strategy),
+ NewI = I#jmp{src1=NewSrc1,src2=NewSrc2},
+ {FixSrc1 ++ FixSrc2 ++ [NewI], DidSpill1 or DidSpill2}.
+
+-ifdef(notdef). % XXX: only for sparc64, alas
+do_pseudo_br(I=#pseudo_br{src=Src}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#pseudo_br{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill}.
+-endif.
+
+do_pseudo_call(I=#pseudo_call{funv=FunV}, TempMap, Strategy) ->
+ {FixFunV,NewFunV,DidSpill} = fix_funv(FunV, TempMap, Strategy),
+ NewI = I#pseudo_call{funv=NewFunV},
+ {FixFunV ++ [NewI], DidSpill}.
+
+do_pseudo_move(I=#pseudo_move{src=Src,dst=Dst}, TempMap, Strategy) ->
+ %% Either Dst or Src (but not both) may be a pseudo temp.
+ %% pseudo_move is a special case: in [XXX: not pseudo_tailcall]
+ %% all other instructions, all temps must be non-pseudos
+ %% after register allocation.
+ case temp_is_spilled(Dst, TempMap) of
+ true -> % Src must not be a pseudo
+ {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
+ NewI = I#pseudo_move{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill};
+ _ ->
+ {[I], false}
+ end.
+
+do_pseudo_set(I=#pseudo_set{dst=Dst}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap, Strategy),
+ NewI = I#pseudo_set{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_pseudo_tailcall(I=#pseudo_tailcall{funv=FunV}, TempMap, Strategy) ->
+ {FixFunV,NewFunV,DidSpill} = fix_funv(FunV, TempMap, Strategy),
+ NewI = I#pseudo_tailcall{funv=NewFunV},
+ {FixFunV ++ [NewI], DidSpill}.
+
+do_rdy(I=#rdy{dst=Dst}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap, Strategy),
+ NewI = I#rdy{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_sethi(I=#sethi{dst=Dst}, TempMap, Strategy) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap, Strategy),
+ NewI = I#sethi{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_store(I=#store{src=Src,base=Base,disp=Disp}, TempMap, Strategy) ->
+ {FixSrc,NewSrc,DidSpill1} = fix_src1(Src, TempMap, Strategy),
+ {FixBase,NewBase,DidSpill2} = fix_src2(Base, TempMap, Strategy),
+ {FixDisp,NewDisp,DidSpill3} = fix_src3_or_imm(Disp, TempMap, Strategy),
+ NewI = I#store{src=NewSrc,base=NewBase,disp=NewDisp},
+ {FixSrc ++ FixBase ++ FixDisp ++ [NewI], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_pseudo_fload(I=#pseudo_fload{base=Base}, TempMap, Strategy) ->
+ {FixBase,NewBase,DidSpill} = fix_src1(Base, TempMap, Strategy),
+ NewI = I#pseudo_fload{base=NewBase},
+ {FixBase ++ [NewI], DidSpill}.
+
+do_pseudo_fstore(I=#pseudo_fstore{base=Base}, TempMap, Strategy) ->
+ {FixBase,NewBase,DidSpill} = fix_src1(Base, TempMap, Strategy),
+ NewI = I#pseudo_fstore{base=NewBase},
+ {FixBase ++ [NewI], DidSpill}.
+
+%%% Fix Dst and Src operands.
+
+fix_funv(FunV, TempMap, Strategy) ->
+ case FunV of
+ #sparc_temp{} -> fix_src3(FunV, TempMap, Strategy);
+ _ -> {[], FunV, false}
+ end.
+
+fix_src2_or_imm(Src2, TempMap, Strategy) ->
+ case Src2 of
+ #sparc_temp{} -> fix_src2(Src2, TempMap, Strategy);
+ _ -> {[], Src2, false}
+ end.
+
+fix_src3_or_imm(Src3, TempMap, Strategy) ->
+ case Src3 of
+ #sparc_temp{} -> fix_src3(Src3, TempMap, Strategy);
+ _ -> {[], Src3, false}
+ end.
+
+fix_src1(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp1(Strategy)).
+
+temp1('new') -> [];
+temp1('fixed') -> hipe_sparc_registers:temp1().
+
+fix_src2(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp2(Strategy)).
+
+temp2('new') -> [];
+temp2('fixed') -> hipe_sparc_registers:temp2().
+
+fix_src3(Src, TempMap, Strategy) ->
+ fix_src(Src, TempMap, temp3(Strategy)).
+
+temp3('new') -> [];
+temp3('fixed') -> hipe_sparc_registers:temp3().
+
+fix_src(Src, TempMap, RegOpt) ->
+ case temp_is_spilled(Src, TempMap) of
+ true ->
+ NewSrc = clone(Src, RegOpt),
+ {[hipe_sparc:mk_pseudo_move(Src, NewSrc)], NewSrc, true};
+ _ ->
+ {[], Src, false}
+ end.
+
+fix_dst(Dst, TempMap, Strategy) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ NewDst = clone(Dst, temp1(Strategy)),
+ {[hipe_sparc:mk_pseudo_move(NewDst, Dst)], NewDst, true};
+ _ ->
+ {[], Dst, false}
+ end.
+
+%%% Check if an operand is a pseudo-temp.
+
+temp_is_spilled(Temp, []) -> % special case for naive regalloc
+ not(hipe_sparc:temp_is_precoloured(Temp));
+temp_is_spilled(Temp, TempMap) ->
+ case hipe_sparc:temp_is_allocatable(Temp) of
+ true ->
+ Reg = hipe_sparc:temp_reg(Temp),
+ tuple_size(TempMap) > Reg andalso hipe_temp_map:is_spilled(Reg, TempMap);
+ false -> true
+ end.
+
+%%% Make a certain reg into a clone of Temp.
+
+clone(Temp, RegOpt) ->
+ Type = hipe_sparc:temp_type(Temp),
+ case RegOpt of
+ [] -> hipe_sparc:mk_new_temp(Type);
+ Reg -> hipe_sparc:mk_temp(Reg, Type)
+ end.
diff --git a/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl b/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl
new file mode 100644
index 0000000000..17dc0f88d5
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl
@@ -0,0 +1,120 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_ra_postconditions_fp).
+
+-export([check_and_rewrite/2]).
+
+-include("hipe_sparc.hrl").
+
+check_and_rewrite(Defun, Coloring) ->
+ TempMap = hipe_temp_map:cols2tuple(Coloring, hipe_sparc_specific_fp),
+ #defun{code=Code0} = Defun,
+ {Code1,DidSpill} = do_insns(Code0, TempMap, [], false),
+ VarRange = {0, hipe_gensym:get_var(sparc)},
+ {Defun#defun{code=Code1, var_range=VarRange},
+ DidSpill}.
+
+do_insns([I|Insns], TempMap, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap),
+ do_insns(Insns, TempMap, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap) ->
+ case I of
+ #fp_binary{} -> do_fp_binary(I, TempMap);
+ #fp_unary{} -> do_fp_unary(I, TempMap);
+ #pseudo_fload{} -> do_pseudo_fload(I, TempMap);
+ #pseudo_fmove{} -> do_pseudo_fmove(I, TempMap);
+ #pseudo_fstore{} -> do_pseudo_fstore(I, TempMap);
+ _ -> {[I], false}
+ end.
+
+%%% Fix relevant instruction types.
+
+do_fp_binary(I=#fp_binary{src1=Src1,src2=Src2,dst=Dst}, TempMap) ->
+ {FixSrc1,NewSrc1,DidSpill1} = fix_src(Src1, TempMap),
+ {FixSrc2,NewSrc2,DidSpill2} = fix_src(Src2, TempMap),
+ {FixDst,NewDst,DidSpill3} = fix_dst(Dst, TempMap),
+ NewI = I#fp_binary{src1=NewSrc1,src2=NewSrc2,dst=NewDst},
+ {FixSrc1 ++ FixSrc2 ++ [NewI | FixDst], DidSpill1 or DidSpill2 or DidSpill3}.
+
+do_fp_unary(I=#fp_unary{src=Src,dst=Dst}, TempMap) ->
+ {FixSrc,NewSrc,DidSpill1} = fix_src(Src, TempMap),
+ {FixDst,NewDst,DidSpill2} = fix_dst(Dst, TempMap),
+ NewI = I#fp_unary{src=NewSrc,dst=NewDst},
+ {FixSrc ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
+
+do_pseudo_fload(I=#pseudo_fload{dst=Dst}, TempMap) ->
+ {FixDst,NewDst,DidSpill} = fix_dst(Dst, TempMap),
+ NewI = I#pseudo_fload{dst=NewDst},
+ {[NewI | FixDst], DidSpill}.
+
+do_pseudo_fmove(I=#pseudo_fmove{src=Src,dst=Dst}, TempMap) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ {FixSrc,NewSrc,DidSpill} = fix_src(Src, TempMap),
+ NewI = I#pseudo_fmove{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill};
+ _ ->
+ {[I], false}
+ end.
+
+do_pseudo_fstore(I=#pseudo_fstore{src=Src}, TempMap) ->
+ {FixSrc,NewSrc,DidSpill} = fix_src(Src, TempMap),
+ NewI = I#pseudo_fstore{src=NewSrc},
+ {FixSrc ++ [NewI], DidSpill}.
+
+%%% Fix Dst and Src operands.
+
+fix_src(Src, TempMap) ->
+ case temp_is_spilled(Src, TempMap) of
+ true ->
+ NewSrc = clone(Src),
+ {[hipe_sparc:mk_pseudo_fmove(Src, NewSrc)], NewSrc, true};
+ _ ->
+ {[], Src, false}
+ end.
+
+fix_dst(Dst, TempMap) ->
+ case temp_is_spilled(Dst, TempMap) of
+ true ->
+ NewDst = clone(Dst),
+ {[hipe_sparc:mk_pseudo_fmove(NewDst, Dst)], NewDst, true};
+ _ ->
+ {[], Dst, false}
+ end.
+
+%%% Check if an operand is a pseudo-temp.
+
+temp_is_spilled(Temp, TempMap) ->
+ case hipe_sparc:temp_is_allocatable(Temp) of
+ true ->
+ Reg = hipe_sparc:temp_reg(Temp),
+ tuple_size(TempMap) > Reg andalso hipe_temp_map:is_spilled(Reg, TempMap);
+ false -> true
+ end.
+
+%%% Create a new temp with the same type as an old one.
+
+clone(Temp) ->
+ Type = hipe_sparc:temp_type(Temp), % XXX: always double?
+ hipe_sparc:mk_new_temp(Type).
diff --git a/lib/hipe/sparc/hipe_sparc_registers.erl b/lib/hipe/sparc/hipe_sparc_registers.erl
new file mode 100644
index 0000000000..adb01a65ca
--- /dev/null
+++ b/lib/hipe/sparc/hipe_sparc_registers.erl
@@ -0,0 +1,291 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_sparc_registers).
+
+-export([reg_name_gpr/1,
+ reg_name_fpr/1,
+ first_virtual/0,
+ is_precoloured_gpr/1,
+ is_precoloured_fpr/1,
+ all_precoloured/0, % for coalescing ra
+ return_value/0,
+ temp1/0,
+ temp2/0,
+ temp3/0,
+ heap_pointer/0,
+ stack_pointer/0,
+ proc_pointer/0,
+ return_address/0,
+ g0/0,
+ %% heap_limit/0,
+ %% fcalls/0,
+ allocatable_gpr/0, % for coalescing ra
+ allocatable_fpr/0,
+ is_fixed/1, % for graph_coloring ra
+ nr_args/0,
+ arg/1,
+ args/1,
+ is_arg/1, % for linear_scan ra
+ call_clobbered/0,
+ tailcall_clobbered/0,
+ live_at_return/0
+ ]).
+
+-include("../rtl/hipe_literals.hrl").
+
+-define(G0, 0).
+-define(G1, 1).
+-define(G2, 2).
+-define(G3, 3).
+-define(G4, 4).
+-define(G5, 5).
+-define(G6, 6).
+-define(G7, 7).
+-define(O0, 8).
+-define(O1, 9).
+-define(O2, 10).
+-define(O3, 11).
+-define(O4, 12).
+-define(O5, 13).
+-define(O6, 14).
+-define(O7, 15).
+-define(L0, 16).
+-define(L1, 17).
+-define(L2, 18).
+-define(L3, 19).
+-define(L4, 20).
+-define(L5, 21).
+-define(L6, 22).
+-define(L7, 23).
+-define(I0, 24).
+-define(I1, 25).
+-define(I2, 26).
+-define(I3, 27).
+-define(I4, 28).
+-define(I5, 29).
+-define(I6, 30).
+-define(I7, 31).
+-define(LAST_PRECOLOURED,31). % must handle both GRP and FPR ranges
+
+-define(ARG0, ?O1).
+-define(ARG1, ?O2).
+-define(ARG2, ?O3).
+-define(ARG3, ?O4).
+-define(ARG4, ?O5).
+-define(ARG5, ?O0).
+
+-define(TEMP1, ?I3). % stores RA around inc_stack calls, must be C calleE-save
+-define(TEMP2, ?I4).
+-define(TEMP3, ?I5).
+
+-define(RETURN_VALUE, ?O0).
+-define(HEAP_POINTER, ?I2).
+-define(STACK_POINTER, ?I1).
+-define(PROC_POINTER, ?I0).
+
+reg_name_gpr(R) ->
+ case R of
+ ?G0 -> "%g0";
+ ?G1 -> "%g1";
+ ?G2 -> "%g2";
+ ?G3 -> "%g3";
+ ?G4 -> "%g4";
+ ?G5 -> "%g5";
+ ?G6 -> "%g6";
+ ?G7 -> "%g7";
+ ?O0 -> "%o0";
+ ?O1 -> "%o1";
+ ?O2 -> "%o2";
+ ?O3 -> "%o3";
+ ?O4 -> "%o4";
+ ?O5 -> "%o5";
+ ?O6 -> "%sp";
+ ?O7 -> "%o7";
+ ?L0 -> "%l0";
+ ?L1 -> "%l1";
+ ?L2 -> "%l2";
+ ?L3 -> "%l3";
+ ?L4 -> "%l4";
+ ?L5 -> "%l5";
+ ?L6 -> "%l6";
+ ?L7 -> "%l7";
+ ?I0 -> "%i0";
+ ?I1 -> "%i1";
+ ?I2 -> "%i2";
+ ?I3 -> "%i3";
+ ?I4 -> "%i4";
+ ?I5 -> "%i5";
+ ?I6 -> "%fp";
+ ?I7 -> "%i7";
+ %% to handle code before regalloc:
+ _ -> "%r" ++ integer_to_list(R)
+ end.
+
+reg_name_fpr(R) -> [$f | integer_to_list(2*R)].
+
+%%% Must handle both GPR and FPR ranges.
+first_virtual() -> ?LAST_PRECOLOURED + 1.
+
+%%% These two tests have the same implementation, but that's
+%%% not something we should cast in stone in the interface.
+is_precoloured_gpr(R) -> R =< ?LAST_PRECOLOURED.
+is_precoloured_fpr(R) -> R =< ?LAST_PRECOLOURED.
+
+all_precoloured() ->
+ %% <%g6, %g7, %o6, %i6> should be skipped as they are unused.
+ %% Unfortunately, gaps in the list of precoloured registers
+ %% cause the graph_color register allocator to create bogus
+ %% assignments for those "registers", which in turn causes
+ %% the "precoloured reg must map to itself" sanity check in
+ %% the frame module to signal errors.
+ [?G0, ?G1, ?G2, ?G3, ?G4, ?G5, ?G6, ?G7,
+ ?O0, ?O1, ?O2, ?O3, ?O4, ?O5, ?O6, ?O7,
+ ?L0, ?L1, ?L2, ?L3, ?L4, ?L5, ?L6, ?L7,
+ ?I0, ?I1, ?I2, ?I3, ?I4, ?I5, ?I6, ?I7].
+
+return_value() -> ?RETURN_VALUE.
+
+temp1() -> ?TEMP1.
+temp2() -> ?TEMP2.
+temp3() -> ?TEMP3.
+
+heap_pointer() -> ?HEAP_POINTER.
+
+stack_pointer() -> ?STACK_POINTER.
+
+proc_pointer() -> ?PROC_POINTER.
+
+return_address() -> ?O7.
+
+g0() -> ?G0.
+
+allocatable_gpr() ->
+ %% %g0 is not writable
+ %% %g6, %g7, %o6, and %i6 are reserved for C
+ %% %i0, %i1, and %i2 are fixed global registers
+ %% %i4 may be used by the frame module for large load/store offsets
+ [ ?G1, ?G2, ?G3, ?G4, ?G5,
+ ?O0, ?O1, ?O2, ?O3, ?O4, ?O5, ?O7,
+ ?L0, ?L1, ?L2, ?L3, ?L4, ?L5, ?L6, ?L7,
+ ?I3, ?I5, ?I7].
+
+allocatable_fpr() ->
+ %% We expose 16 virtual fp regs, 0-15, corresponding to the
+ %% f0/f2/f4/.../f28/f30 double-precision hardware fp regs.
+ %% The mapping is done by reg_name_fpr/1 and the assembler.
+ %% We ignore f32/.../f60 since they cannot be used in loads
+ %% or stores for non 8-byte aligned addresses.
+ [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].
+
+%% Needed for hipe_graph_coloring_regalloc.
+%% Presumably true for Reg in AllPrecoloured \ Allocatable.
+is_fixed(Reg) ->
+ case Reg of
+ ?HEAP_POINTER -> true;
+ ?STACK_POINTER -> true;
+ ?PROC_POINTER -> true;
+ %% The following cases are required for linear scan:
+ %% it gets confused if it sees a register which is
+ %% neither allocatable nor global (fixed or one of
+ %% the scratch registers set aside for linear scan).
+ ?G0 -> true;
+ ?G6 -> true;
+ ?G7 -> true;
+ ?O6 -> true;
+ ?I6 -> true;
+ _ -> false
+ end.
+
+nr_args() -> ?SPARC_NR_ARG_REGS.
+
+args(Arity) when is_integer(Arity) ->
+ N = erlang:min(Arity, ?SPARC_NR_ARG_REGS),
+ args(N-1, []).
+
+args(I, Rest) when is_integer(I), I < 0 -> Rest;
+args(I, Rest) -> args(I-1, [arg(I) | Rest]).
+
+arg(N) ->
+ if N < ?SPARC_NR_ARG_REGS ->
+ case N of
+ 0 -> ?ARG0;
+ 1 -> ?ARG1;
+ 2 -> ?ARG2;
+ 3 -> ?ARG3;
+ 4 -> ?ARG4;
+ 5 -> ?ARG5
+ end
+ end.
+
+is_arg(R) ->
+ case R of
+ ?ARG0 -> ?SPARC_NR_ARG_REGS > 0;
+ ?ARG1 -> ?SPARC_NR_ARG_REGS > 1;
+ ?ARG2 -> ?SPARC_NR_ARG_REGS > 2;
+ ?ARG3 -> ?SPARC_NR_ARG_REGS > 3;
+ ?ARG4 -> ?SPARC_NR_ARG_REGS > 4;
+ ?ARG5 -> ?SPARC_NR_ARG_REGS > 5;
+ _ -> false
+ end.
+
+call_clobbered() -> % does the RA strip the type or not?
+ [%% ?G0 is the non-allocatable constant zero
+ {?G1,tagged},{?G1,untagged},
+ {?G2,tagged},{?G2,untagged},
+ {?G3,tagged},{?G3,untagged},
+ {?G4,tagged},{?G4,untagged},
+ {?G5,tagged},{?G5,untagged},
+ %% ?G6 is reserved for C
+ %% ?G7 is reserved for C
+ {?O0,tagged},{?O0,untagged},
+ {?O1,tagged},{?O1,untagged},
+ {?O2,tagged},{?O2,untagged},
+ {?O3,tagged},{?O3,untagged},
+ {?O4,tagged},{?O4,untagged},
+ {?O5,tagged},{?O5,untagged},
+ %% ?O6 is reserved for C
+ {?O7,tagged},{?O7,untagged},
+ {?L0,tagged},{?L0,untagged},
+ {?L1,tagged},{?L1,untagged},
+ {?L2,tagged},{?L2,untagged},
+ {?L3,tagged},{?L3,untagged},
+ {?L4,tagged},{?L4,untagged},
+ {?L5,tagged},{?L5,untagged},
+ {?L6,tagged},{?L6,untagged},
+ {?L7,tagged},{?L7,untagged},
+ %% ?I0 is fixed (P)
+ %% ?I1 is fixed (NSP)
+ %% ?I2 is fixed (HP)
+ {?I3,tagged},{?I3,untagged},
+ {?I4,tagged},{?I4,untagged},
+ {?I5,tagged},{?I5,untagged},
+ %% ?I6 is reserved for C
+ {?I7,tagged},{?I7,untagged}
+ ].
+
+tailcall_clobbered() -> % tailcall crapola needs one temp
+ [{?TEMP1,tagged},{?TEMP1,untagged}].
+
+live_at_return() ->
+ [{?HEAP_POINTER,untagged},
+ {?STACK_POINTER,untagged},
+ {?PROC_POINTER,untagged}
+ ].
diff --git a/lib/hipe/ssa/hipe_ssa.inc b/lib/hipe/ssa/hipe_ssa.inc
new file mode 100644
index 0000000000..d15b5ddd56
--- /dev/null
+++ b/lib/hipe/ssa/hipe_ssa.inc
@@ -0,0 +1,978 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File : hipe_ssa.inc
+%% Authors : Christoffer Vikstr�m, Daniel Deogun, and Jesper Bengtsson
+%% Created : March 2002
+%% Purpose : Provides code which converts the code of a CFG into SSA
+%% (Static Single Assignment) form and back.
+%% A routine to check for SSA-ness is also provided.
+%%
+%% Major Modifications:
+%% * Feb 2003: Per Gustafsson - added SSA checker.
+%% * Aug 2003: Per Gustafsson - added removal of dead code.
+%% * Feb 2004: Kostis Sagonas - made it work on RTL level too.
+%% * Feb 2004: Tobias Lindahl - re-wrote the unconvert/1 function.
+%%----------------------------------------------------------------------
+
+-export([convert/1, check/1, unconvert/1, remove_dead_code/1]).
+
+-include("../main/hipe.hrl").
+-include("../flow/cfg.hrl"). %% needed for the specs
+-include("../ssa/hipe_ssa_liveness.inc"). %% needed for dead code removal
+
+%%----------------------------------------------------------------------
+%%
+%% NOTE! When the phi-instructions are placed, it is important that
+%% the internal order is preserved. Otherwise the (correct) order:
+%%
+%% v1 := phi({1, v2}, {2, v11})
+%% v2 := phi({1, v11}, {2, v12})
+%%
+%% can become (the incorrect)
+%%
+%% v2 := phi({1, v11}, {2, v12})
+%% v1 := phi({1, v2}, {2, v11})
+%%
+%% that will set v1 to the _new_ value of v2 instead of the old value.
+%%
+%%----------------------------------------------------------------------
+
+-spec convert(#cfg{}) -> #cfg{}.
+
+convert(CFG) ->
+ CFG1 = insertNewStartNode(CFG),
+
+ ?opt_start_timer("Dominator Tree construction"),
+ DomTree = hipe_dominators:domTree_create(CFG1),
+ ?opt_stop_timer("Dominator Tree construction done"),
+
+ ?opt_start_timer("Dominance Frontier"),
+ DomFrontier = hipe_dominators:domFrontier_create(CFG1, DomTree),
+ ?opt_stop_timer("Dominance Frontier done"),
+
+ ?opt_start_timer("placement of Phi-nodes"),
+ CFG2 = place_phi(CFG1, DomFrontier),
+ ?opt_stop_timer("placement of Phi-nodes done"),
+
+ ?opt_start_timer("Rename"),
+ CFG3 = rename(CFG2, DomTree),
+ ?opt_stop_timer("Rename done"),
+
+ CFG3.
+
+%%----------------------------------------------------------------------
+
+insertNewStartNode(CFG) ->
+ StartLabel = ?CFG:start_label(CFG),
+ NewStartLabel = ?CODE:label_name(?CODE:mk_new_label()),
+ BB = hipe_bb:mk_bb([?CODE:mk_goto(StartLabel)]),
+ CFG2 = ?CFG:bb_add(CFG, NewStartLabel, BB),
+ ?CFG:start_label_update(CFG2, NewStartLabel).
+
+
+%%======================================================================
+%% PlacePhi Algorithm
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Procedure : place_phi/2
+%% Purpose : Places phi nodes at appropriate places in the CFG.
+%% Arguments : CFG - Control Flow Graph.
+%% DF - Dominance Frontier.
+%% Returns : CFG with phi functions.
+%%----------------------------------------------------------------------
+
+place_phi(CFG, DF) ->
+ AssMap = insertParams(CFG),
+ AssMap2 = preProcess(CFG, AssMap),
+ VarList = gb_trees:to_list(AssMap2),
+ Liveness = ?LIVENESS:analyze(CFG),
+ variableTraverse(CFG, DF, gb_trees:empty(), gb_trees:empty(),
+ 0, AssMap2, Liveness, VarList).
+
+%%----------------------------------------------------------------------
+%% Procedure : insertParams/1
+%% Purpose : Inserts the parameters of the CFG into the AssMap.
+%% Arguments : CFG - Control Flow Graph
+%% Returns : AssMap - Assignment map.
+%%----------------------------------------------------------------------
+
+insertParams(CFG) ->
+ StartLabel = ?CFG:start_label(CFG),
+ Params = ?CFG:params(CFG),
+ insertParams(Params, StartLabel, gb_trees:empty()).
+
+insertParams([Param|T], StartLabel, AssMap) ->
+ insertParams(T, StartLabel, gb_trees:insert(Param, [StartLabel], AssMap));
+insertParams([], _, AssMap) -> AssMap.
+
+%%----------------------------------------------------------------------
+%% Procedure : preProcessg/2
+%% Purpose : Creates the assignment map.
+%% Arguments : CFG - Control Flow Graph
+%% AssMap - Assignment map
+%% Returns : AssMap.
+%%----------------------------------------------------------------------
+
+preProcess(CFG, AssMap) ->
+ traverseLabels(CFG, ?CFG:labels(CFG), AssMap).
+
+%%----------------------------------------------------------------------
+%% Procedure : traverseLabels/3
+%% Purpose : Traverses all labels and adds all assignments in the basic
+%% block to the assignment map.
+%% Arguments : CFG - Control Flow Graph
+%% AssMap - Assignment Map
+%% Label - A label for a node
+%% Returns : AssMap.
+%%----------------------------------------------------------------------
+
+traverseLabels(CFG, [Label|T], AssMap) ->
+ Code = get_code_from_label(CFG, Label),
+ NewVarList = getAssignments(Code),
+ traverseLabels(CFG, T, updateAssMap(NewVarList, Label, AssMap));
+traverseLabels(_, [], AssMap) -> AssMap.
+
+%%----------------------------------------------------------------------
+%% Procedure : getAssignments/1
+%% Purpose : Retrieves all assigned variables in a basic block.
+%% Arguments : InstrLst - A list of instructions from a basic block.
+%% VarList - A list of variables.
+%% Returns : VarList.
+%% Notes : This function may return a list containing duplicates.
+%%----------------------------------------------------------------------
+
+getAssignments(InstrList) -> getAssignments(InstrList, []).
+
+getAssignments([Instr|T], VarList) ->
+ getAssignments(T, defs_to_rename(Instr) ++ VarList);
+getAssignments([], VarList) -> VarList.
+
+%%----------------------------------------------------------------------
+%% Procedure : updateAssMap/3
+%% Purpose : Updates the assignment map with. Each variable in the AssVar
+%% list is inserted with the value Label.
+%% Arguments : Label - a label of a node
+%% AssVar - a variable that is assigned at Label
+%% AssMap - Assignment map.
+%% Returns : AssMap.
+%%----------------------------------------------------------------------
+
+updateAssMap([AssVar|T], Label, AssMap) ->
+ Lst = getAssMap(AssVar, AssMap),
+ updateAssMap(T, Label, gb_trees:enter(AssVar, [Label|Lst], AssMap));
+updateAssMap([], _, AssMap) -> AssMap.
+
+getAssMap(AssVar, AssMap) ->
+ case gb_trees:lookup(AssVar, AssMap) of
+ {value, L} -> L;
+ none -> []
+ end.
+
+%%----------------------------------------------------------------------
+%% Procedure : variableTraverse/7
+%% Purpose : This function traverses all variables and adds phi functions
+%% at appropriate nodes.
+%% Arguments : CFG - Control Flow Graph
+%% DFMap - Dominance Frontier Map
+%% HasAlready - A map of nodes which already have phi functions
+%% Work -
+%% IterCount - Counter of how many iterations have been done
+%% AssMap - Assignment map
+%% VarLst - Variable list that is traversed
+%% Returns : CFG.
+%%----------------------------------------------------------------------
+
+variableTraverse(CFG, DFMap, HasAlready, Work,
+ IterCount, AssMap, Liveness, [{Var,_}|VarLst]) ->
+ IterCount2 = IterCount + 1,
+ DefLst = getAssMap(Var, AssMap),
+ {Work2, WorkLst2} = workListBuilder(DefLst, Work, [], IterCount2),
+ {CFG2, HasAlready2, Work3} = doWork(CFG, DFMap, HasAlready,
+ Work2, IterCount2, WorkLst2,
+ Var, Liveness),
+ variableTraverse(CFG2, DFMap, HasAlready2, Work3,
+ IterCount2, AssMap, Liveness, VarLst);
+variableTraverse(CFG, _, _, _, _, _, _, []) -> CFG.
+
+%%----------------------------------------------------------------------
+%% Procedure : workListBuilder/4
+%% Purpose : Builds the worklist that the algorithm is working on.
+%% Arguments : Work -
+%% WorkLst - The worklist that is worked through
+%% IterCount - Counter of how many itterations that has been done
+%% Node - A node in the CFG
+%% Returns :
+%%----------------------------------------------------------------------
+
+workListBuilder([Node|T], Work, WorkLst, IterCount) ->
+ case getCount(Node, Work) of
+ 0 ->
+ Work2 = gb_trees:enter(Node, IterCount, Work),
+ workListBuilder(T, Work2, [Node|WorkLst], IterCount);
+ _ ->
+ Work2 = gb_trees:enter(Node, IterCount, Work),
+ workListBuilder(T, Work2, [Node|WorkLst], IterCount)
+ end;
+workListBuilder([], Work, WorkLst, _IterCount) ->
+ {Work, WorkLst}.
+
+getCount(Key, Dict) ->
+ case gb_trees:lookup(Key, Dict) of
+ {value, V} -> V;
+ none -> 0
+ end.
+
+%%----------------------------------------------------------------------
+%% Procedure : doWork/7
+%% Purpose : This procedure works itself through the worklist and checks
+%% if a node needs any phi functions.
+%% Arguments : CFG - Control Flow Graph
+%% DFMap - Dominance Frontier Map
+%% HasAlready - A map of nodes that already have phi functions
+%% Work -
+%% IterCount - Counter of how many iterations have taken place
+%% WorkLst - The worklist that is worked through
+%% Var - Variable
+%% Returns : {CFG, HasAlready, Work}
+%%----------------------------------------------------------------------
+
+doWork(CFG, DFMap, HasAlready, Work, IterCount,
+ [Node|WorkLst], Var, Liveness) ->
+ DFofX = hipe_dominators:domFrontier_get(Node, DFMap),
+ {CFG2, HasAlready2, Work2, WorkLst2} =
+ checkPhiNeeds(CFG, DFofX, HasAlready, Work,
+ IterCount, WorkLst, Var, Liveness),
+ doWork(CFG2, DFMap, HasAlready2, Work2,
+ IterCount, WorkLst2, Var, Liveness);
+doWork(CFG, _, HasAlready, Work, _, [], _, _) ->
+ {CFG, HasAlready, Work}.
+
+%%----------------------------------------------------------------------
+%% Procedure : checkPhiNeeds/7
+%% Purpose : This function checks if a node needs a phi function and adds
+%% one if its needed.
+%% Arguments : CFG - Control Flow Graph
+%% DFofX - Dominance Frontier of a node
+%% HasAlready - A map of nodes that already have phi functions
+%% Work -
+%% IterCount - Counter of how many iterations have taken place
+%% WorkLst - The worklist that is worked through
+%% Var - Variable
+%% Returns : {CFG, HasAlready, Work, WorkLst}
+%%----------------------------------------------------------------------
+
+checkPhiNeeds(CFG, [Node|DFofX], HasAlready, Work,
+ IterCount, WorkLst, Var, Liveness) ->
+ case getCount(Node, HasAlready) < IterCount of
+ true ->
+ LiveIn = ?LIVENESS:livein(Liveness, Node),
+ case lists:member(Var, LiveIn) of
+ true ->
+ CFG2 = insertPhiCode(CFG, Node, Var),
+ HasAlready2 = gb_trees:enter(Node, IterCount, HasAlready),
+ case getCount(Node, Work) < IterCount of
+ true ->
+ Work2 = gb_trees:enter(Node, IterCount, Work),
+ WorkLst2 = [Node|WorkLst],
+ checkPhiNeeds(CFG2, DFofX, HasAlready2, Work2,
+ IterCount, WorkLst2, Var, Liveness);
+ false ->
+ checkPhiNeeds(CFG2, DFofX, HasAlready2, Work,
+ IterCount, WorkLst, Var, Liveness)
+ end;
+ false ->
+ checkPhiNeeds(CFG, DFofX, HasAlready, Work, IterCount,
+ WorkLst, Var, Liveness)
+ end;
+ false ->
+ checkPhiNeeds(CFG, DFofX, HasAlready, Work, IterCount,
+ WorkLst, Var, Liveness)
+ end;
+checkPhiNeeds(CFG, [], HasAlready, Work, _, WorkLst, _, _) ->
+ {CFG, HasAlready, Work, WorkLst}.
+
+%%----------------------------------------------------------------------
+%% Procedure : insertPhiCode/3
+%% Purpose :
+%% Arguments : CFG - Control Flow Graph
+%% Node - A node
+%% Var - A variable
+%% Returns : CFG
+%%----------------------------------------------------------------------
+
+insertPhiCode(CFG, Node, Var) ->
+ BB = ?CFG:bb(CFG, Node),
+ Phi = ?CODE:mk_phi(Var),
+ Code = [Phi | hipe_bb:code(BB)],
+ ?CFG:bb_add(CFG, Node, hipe_bb:code_update(BB, Code)).
+
+
+%%======================================================================
+%% SSA Renaming pass
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Procedure : rename/2
+%% Purpose : Renames all the variables in the CFG according to the SSA
+%% conversion algorithm.
+%% Arguments : CFG - The CFG being translated.
+%% DomTree - The dominator tree of the CFG.
+%% Returns : A CFG where all variables are renamed.
+%%----------------------------------------------------------------------
+
+rename(CFG, DomTree) ->
+ %% Reset the appropriate variable index so that we start from low
+ %% variable numbers again
+ reset_var_indx(),
+ {CFG2,Current} = insertRenamedParams(CFG),
+ rename(CFG2, ?CFG:start_label(CFG2), DomTree, Current).
+
+rename(CFG, Node, DomTree, Current) ->
+ BB = ?CFG:bb(CFG, Node),
+ Statements = hipe_bb:code(BB),
+ {Statements2,Current2} = renameVars(Statements, Current),
+ CFG1 = ?CFG:bb_add(CFG, Node, hipe_bb:code_update(BB, Statements2)),
+ Succ = ?CFG:succ(CFG1, Node),
+ CFG2 = updateSuccPhi(Succ, Node, CFG1, Current2),
+ Children = hipe_dominators:domTree_getChildren(Node, DomTree),
+ childrenRename(Children, CFG2, DomTree, Current2).
+
+%%----------------------------------------------------------------------
+%% Procedure : childrenRename/5
+%% Purpose : Renames all the nodes in a list according to the SSA
+%% conversion algorithm.
+%% Arguments : ChildList - the list of nodes being renamed
+%% CFG - the CFG that the children are a part of
+%% DomTree - The dominator tree for the CFG
+%% Current - the current index of all variables encountered
+%% Returns : CFG
+%%----------------------------------------------------------------------
+
+childrenRename([Child|Children], CFG, DomTree, Current) ->
+ CFG2 = rename(CFG, Child, DomTree, Current),
+ childrenRename(Children, CFG2, DomTree, Current);
+childrenRename([], CFG, _, _) ->
+ CFG.
+
+%%----------------------------------------------------------------------
+%% Procedure : renameVars/3
+%% Purpose : Renames the variables in basic block
+%% Arguments : Statements - the basic block
+%% Current - the current index of all variables encountered
+%% Returns : {Statements,Current}
+%%----------------------------------------------------------------------
+
+renameVars(Statements, Current) ->
+ renameVars(Statements, Current, []).
+
+renameVars([Statement|Statements], Current, Result) ->
+ Statement2 = renameUses(Statement, Current),
+ {Statement3,Current2} = renameDefs(Statement2, Current),
+ renameVars(Statements, Current2, [Statement3|Result]);
+renameVars([], Current, Result) ->
+ {lists:reverse(Result),Current}.
+
+%%----------------------------------------------------------------------
+%% Procedure : renameUses/2
+%% Purpose : Renames all the uses of a variable in a statement.
+%% Arguments : Statement - the statement being renamed.
+%% Current - the current index of all variables encountered.
+%% Returns : Statement
+%%----------------------------------------------------------------------
+
+renameUses(Statement, Current) ->
+ case ?CODE:is_phi(Statement) of
+ true -> Statement;
+ false -> VarList = uses_to_rename(Statement),
+ updateStatementUses(VarList, Statement, Current)
+ end.
+
+%%----------------------------------------------------------------------
+%% Procedure : updateStatementUses/3
+%% Purpose : Traverses the variable list and renames all the instances
+%% of a variable in the Statement uses to its current value.
+%% Arguments : VarList - the list of variables being updated.
+%% Statement - the statement being updated.
+%% Current - the current index of all variables encountered.
+%% Returns : An updated statement.
+%%----------------------------------------------------------------------
+
+updateStatementUses(Vars, Statement, Current) ->
+ Substs = [{Var,gb_trees:get(Var, Current)} || Var <- Vars],
+ ?CODE:subst_uses(Substs, Statement).
+
+%%----------------------------------------------------------------------
+%% Procedure : renameDefs/3
+%% Purpose : Renames all the definitons in Statement.
+%% Arguments : Statement - the statement where the definitions are being
+%% renamed.
+%% Current - the current index of all variables encountered.
+%% Returns : Statement
+%%----------------------------------------------------------------------
+
+renameDefs(Statement, Current) ->
+ VarList = defs_to_rename(Statement),
+ updateStatementDefs(VarList, Statement, Current).
+
+%%----------------------------------------------------------------------
+%% Procedure : updateStatementDefs/4
+%% Purpose : traverses a variable list and exchanges all instances of
+%% the variable in the statements definitions by its current
+%% value.
+%% Arguments : VariableList - the list of varibles being renamed
+%% Statement - the statement whos definitions are being changed
+%% Current - the current index of all variables encountered
+%% Returns : {Statement, Current}
+%% Notes : Per Gustafsson:
+%% I changed this function to update the statement only when
+%% all substitutions are found.
+%%----------------------------------------------------------------------
+
+updateStatementDefs(Vars, Statement, Current) ->
+ updateStatementDefs(Vars, Statement, Current, []).
+
+updateStatementDefs([Var|Vars], Statement, Current, Acc) ->
+ {NewVar,Current2} = updateIndices(Current, Var),
+ updateStatementDefs(Vars, Statement, Current2, [{Var,NewVar}|Acc]);
+updateStatementDefs([], Statement, Current, Acc) ->
+ Statement2 = ?CODE:subst_defines(Acc, Statement),
+ {Statement2,Current}.
+
+%%----------------------------------------------------------------------
+%% Procedure : updateIndices/3
+%% Purpose : This function is used for updating the Current hash table
+%% and for getting a new variable/fp variable/register.
+%% Arguments : Current - Hash table containg the current index for a
+%% particular variable.
+%% Variable - The variable that is used as key in the hash table.
+%% Returns : A two-tuple containing the new variable and Current.
+%%----------------------------------------------------------------------
+
+updateIndices(Current, Variable) ->
+ case ?CODE:is_var(Variable) of
+ true ->
+ NewVar = ?CODE:mk_new_var(),
+ {NewVar,gb_trees:enter(Variable, NewVar, Current)};
+ false ->
+ case is_fp_temp(Variable) of
+ true ->
+ NewFVar = mk_new_fp_temp(),
+ {NewFVar,gb_trees:enter(Variable, NewFVar, Current)};
+ false ->
+ NewReg = ?CODE:mk_new_reg(),
+ {NewReg,gb_trees:enter(Variable, NewReg, Current)}
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Procedure : updateSuccPhi/4
+%% Purpose : This function is used for updating phi functions in a
+%% particular node's successors. That is, the function
+%% traverses the successor list of a node and updates the
+%% arguments in the phi function calls.
+%% Arguments : Succ - A successor to the node Parent.
+%% T - The remainder of the successor list
+%% Parent - The parent of the node Succ
+%% CFG - Control Flow Graph
+%% Current - Hash table containg the current index for a
+%% particular variable
+%% Returns : An updated version of the CFG
+%%----------------------------------------------------------------------
+
+updateSuccPhi([Succ|T], Parent, CFG, Current) ->
+ CFG2 = updatePhi(Succ, Parent, CFG, Current),
+ updateSuccPhi(T, Parent, CFG2, Current);
+updateSuccPhi([], _, CFG, _) ->
+ CFG.
+
+%%----------------------------------------------------------------------
+%% Procedure : updatePhi/4
+%% Purpose : This function prepares for an update of a phi function call.
+%% That is, if a statement contains a phi function call
+%% then the number of predecessors are computed and the index
+%% of the parent in the predecessor list is used for computing
+%% which variable in the argument list of the phi function call
+%% that need to be updated.
+%% Arguments : Node - A node in the CFG
+%% Parent - The parent of the node Node in the dominator tree
+%% CFG - Control Flow Graph
+%% Current - Hash table containg the current index for a
+%% particular variable
+%% Returns : An updated version of the CFG
+%%----------------------------------------------------------------------
+
+updatePhi(Node, Parent, CFG, Current) ->
+ BB = ?CFG:bb(CFG, Node),
+ case hipe_bb:code(BB) of
+ [Code|_] = Statements ->
+ case ?CODE:is_phi(Code) of
+ true ->
+ Code2 = updateCode(Statements, Parent, Current),
+ ?CFG:bb_add(CFG, Node, hipe_bb:code_update(BB, Code2));
+ _ ->
+ CFG
+ end;
+ _ ->
+ CFG
+ end.
+
+%%----------------------------------------------------------------------
+%% Procedure : updateCode/3
+%% Purpose : This function updates a statement that contains a phi
+%% function, i.e. it changes the arguments in the phi
+%% function to their correct names.
+%% Arguments : Code - A list of code
+%% Pred - A predecessor of the node containing the
+%% phi-function
+%% Current - Hash table containing the current index for a
+%% particular variable
+%% Returns : A list of Code
+%%----------------------------------------------------------------------
+
+updateCode(Code, Pred, Current) ->
+ updateCode(Code, Pred, Current, []).
+
+updateCode([Stat|Stats] = Statements, Pred, Current, Result) ->
+ case ?CODE:is_phi(Stat) of
+ true ->
+ Var = ?CODE:phi_id(Stat),
+ Result2 = case gb_trees:lookup(Var, Current) of
+ none ->
+ [Stat|Result];
+ {value,Var2} ->
+ Stat2 = ?CODE:phi_enter_pred(Stat, Pred, Var2),
+ [Stat2|Result]
+ end,
+ updateCode(Stats, Pred, Current, Result2);
+ _ ->
+ Result ++ Statements
+ end.
+
+%%----------------------------------------------------------------------
+%% Procedure : insertRenamedParams/1
+%% Purpose : Inserts the parameters of the CFG into the working hashmaps.
+%% Arguments : CFG - the target control flow graph.
+%% Returns : {CFG,Current}
+%%----------------------------------------------------------------------
+
+insertRenamedParams(CFG) ->
+ Params = ?CFG:params(CFG),
+ %% Current - the current variable we are working on.
+ {Current,Params2} = insertRenamedParams(Params, gb_trees:empty(), []),
+ CFG2 = ?CFG:params_update(CFG, Params2),
+ {CFG2,Current}.
+
+insertRenamedParams([Param|Params], Current, Result) ->
+ {Var,Current2} = updateIndices(Current, Param),
+ insertRenamedParams(Params, Current2, [Var|Result]);
+insertRenamedParams([], Current, Result) ->
+ {Current,lists:reverse(Result)}.
+
+
+%%======================================================================
+%% SSA Checker
+%%======================================================================
+
+%%
+%% @doc Checks the control flow graph CFG of a function for SSA-ness.
+%% More specifically, it checks that all variables in the CFG are only
+%% defined once and that all uses of each variable in the function are
+%% dominated by a define. If a variable does not abide by these rules,
+%% a warning message will be printed on stdout.
+%%
+-spec check(#cfg{}) -> 'ok'.
+
+check(CFG) ->
+ Labels = ?CFG:labels(CFG),
+ VarTree = traverse_labels(Labels, CFG),
+ DomTree = hipe_dominators:domTree_create(CFG),
+ test_uses(Labels, VarTree, DomTree, CFG).
+
+%%
+%% @doc Traverses all the labels in a CFG.
+%%
+traverse_labels(Labels, CFG) ->
+ VarTree = add_args(?CFG:params(CFG)),
+ traverse_labels(Labels, VarTree, CFG).
+
+traverse_labels([Label|Rest], VarTree, CFG) ->
+ Code = get_code_from_label(CFG, Label),
+ NewVarTree = traverse_code(Code, VarTree, Label),
+ traverse_labels(Rest, NewVarTree, CFG);
+traverse_labels([], VarTree, _CFG) ->
+ VarTree.
+
+%%
+%% @doc Traverses the code in a basic block.
+%%
+traverse_code([Instr|Rest], VarTree, Label) ->
+ Defined = defs_to_rename(Instr),
+ NewVarTree = add_to_var_tree(Defined, VarTree, Instr, Label),
+ traverse_code(Rest, NewVarTree, Label);
+traverse_code([], VarTree, _) ->
+ VarTree.
+
+%%
+%% @doc
+%% Adds a variable to the variable tree if the variable is defined.
+%% The entry in the variable tree will have the variable as key and a
+%% two tuple consisting of a list of Instructions and a list of labels
+%% where the variable is defined. If a variable is defined a second
+%% time a warning message to this effect is printed on stdout.
+%%
+add_to_var_tree([Var|Rest], VarTree, Instr, Label) ->
+ NewVarTree =
+ case gb_trees:lookup(Var, VarTree) of
+ {value,{OldInstr,OldLabel}} ->
+ ?WARNING_MSG("Variable: ~w defined a second time\n"++
+ "in Instr: ~w\n"++
+ "at Label: ~w\n"++
+ "variable was first defined at Label(s) ~w\n"++
+ "in Instr(s): ~w\n -> non SSA form\n",
+ [Var,Instr,Label,OldLabel,OldInstr]),
+ gb_trees:update(Var, {[Instr|OldInstr],[Label|OldLabel]}, VarTree);
+ none ->
+ gb_trees:insert(Var, {[Instr],[Label]}, VarTree)
+ end,
+ add_to_var_tree(Rest, NewVarTree, Instr, Label);
+add_to_var_tree([], VarTree, _, _) ->
+ VarTree.
+
+%%
+%% @doc Adds the argument of a function to the VarTree.
+%% They are defined at Label 0.
+%%
+add_args(Args) ->
+ add_args(Args, gb_trees:empty()).
+
+add_args([Arg|Rest], VarTree) ->
+ add_args(Rest, gb_trees:insert(Arg, {[argument_variable],[0]}, VarTree));
+add_args([], VarTree) ->
+ VarTree.
+
+%%
+%% The functions below test that a use is dominated by a corresponding def.
+%%
+
+%%
+%% This function is analogous to traverse_labels.
+%%
+test_uses([Label|Rest], VarTree, DomTree,CFG) ->
+ Code = get_code_from_label(CFG, Label),
+ test_code(Code, VarTree, Label, DomTree, CFG, []),
+ test_uses(Rest, VarTree, DomTree, CFG);
+test_uses([], _VarTree, _DomTree, _CFG) ->
+ ok.
+
+%%
+%% This function is analogous to traverse_code.
+%%
+test_code([Instr|Instrs], VarTree, Label, DomTree, CFG, Old) ->
+ case ?CODE:is_phi(Instr) of
+ true ->
+ ArgList = ?CODE:phi_arglist(Instr),
+ case ArgList of
+ [_Arg] ->
+ ?WARNING_MSG("Phi with only one source at BB with label ~w:\n",
+ [Label]),
+ %% case ?CODE of
+ %% hipe_rtl -> ?CODE:pp_block(get_code_from_label(CFG, Label));
+ %% _ -> ok
+ %% end,
+ ok;
+ [_|_] -> ok
+ end,
+ lists:foreach(fun ({Pred,Var}) ->
+ def_doms_use([Var], VarTree, Pred, DomTree,
+ get_code_from_label(CFG,Pred))
+ end, ArgList);
+ false ->
+ Uses = uses_to_rename(Instr),
+ def_doms_use(Uses, VarTree, Label, DomTree, Old)
+ end,
+ test_code(Instrs, VarTree, Label, DomTree, CFG, [Instr|Old]);
+test_code([], _VarTree, _Label, _DomTree, _CFG, _Old) ->
+ ok.
+
+get_code_from_label(CFG, Label) ->
+ case ?CFG:bb(CFG,Label) of
+ not_found ->
+ ?error_msg("Basic block with label ~w was not found\n", [Label]);
+ %% ?EXIT('Detected serious problem in SSA form');
+ BB ->
+ hipe_bb:code(BB)
+ end.
+
+%%
+%% This function checks whether a use is dominated by a def.
+%% There are five different cases:
+%% 1. A use of an argument register. This use is dominated by the def.
+%% 2. Use and Def in same basic block if Use comes first this will
+%% lead to a warning message, otherwise it is ok.
+%% 3. The deinition is in a basic block that dominates the basic block
+%% of the use. This is ok.
+%% 4. The definition is in a basic block that does not dominate the use.
+%% This will result in a warning message being printed.
+%% 5. A use without any definition. This will result in a warning message
+%% being printed.
+%%
+def_doms_use([Var|Vars], VarTree, Label, DomTree, Old) ->
+ case gb_trees:lookup(Var, VarTree) of
+ {value,{_,[DefLabel|_]}} ->
+ case DefLabel of
+ 0 ->
+ ok;
+ Label ->
+ Fun = fun(X) -> Defs = defs_to_rename(X),
+ lists:any(fun(Y) -> Var == Y end, Defs)
+ end,
+ case lists:any(Fun, Old) of
+ true ->
+ ok;
+ false ->
+ ?WARNING_MSG("Variable : ~w used before definition in bb: ~w\n",
+ [Var,Label])
+ end;
+ _ ->
+ case hipe_dominators:domTree_dominates(DefLabel, Label, DomTree) of
+ true ->
+ ok;
+ false ->
+ ?WARNING_MSG("Definition does not dominate use for variable: ~w "++
+ "at label: ~w (definition label: ~w)\n",
+ [Var, Label, DefLabel])
+ end
+ end;
+ none ->
+ ?WARNING_MSG("Use with no definition of variable: ~w at label: ~w\n",
+ [Var, Label])
+ end,
+ def_doms_use(Vars, VarTree, Label, DomTree, Old);
+def_doms_use([], _VarTree, _Label, _DomTree, _Old) ->
+ ok.
+
+
+%%======================================================================
+%% SSA Un-Converter
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Procedure : unconvert/2
+%% Purpose : Removes all phi functions and propagates all
+%% assignments up to the appropriate predecessors.
+%% Arguments : CFG - Control Flow Graph
+%% Node - A node in the CFG
+%% Returns : CFG
+%% Note : The call to remove_trivial_bbs is needed so that moves,
+%% which are introduced in new basic blocks as part of the
+%% un-conversion, are merged with the basic blocks of their
+%% predecessors, if possible.
+%%----------------------------------------------------------------------
+
+-spec unconvert(#cfg{}) -> #cfg{}.
+
+unconvert(CFG) ->
+ ?CFG:remove_trivial_bbs(unconvert(?CFG:reverse_postorder(CFG), CFG)).
+
+unconvert([Node|Nodes], CFG) ->
+ BB = ?CFG:bb(CFG, Node),
+ Code = hipe_bb:code(BB),
+ {Phis,Code2} = getPhiFuncts(Code, []),
+ case Phis of
+ [] ->
+ unconvert(Nodes, CFG);
+ _ ->
+ BB2 = hipe_bb:code_update(BB, Code2),
+ CFG2 = ?CFG:bb_add(CFG, Node, BB2),
+ Pred = ?CFG:pred(CFG2, Node),
+ PredMoveMap = get_moves(Pred, Phis),
+ CFG3 = insert_move_bbs(PredMoveMap, Node, CFG2),
+ unconvert(Nodes, CFG3)
+ end;
+unconvert([], CFG) ->
+ CFG.
+
+%%----------------------------------------------------------------------
+%% Procedure : get_moves/2 and /3
+%% Purpose : Find the moves that corresponds to phi-instructions of
+%% a block. Try to merge incoming edges to avoid duplicate
+%% blocks.
+%% Arguments : Preds - The predecessors to this block.
+%% Phis - The phi instructions that used to start this block.
+%% Returns : [{ListOfMoves, [Preds]}]
+%%----------------------------------------------------------------------
+
+get_moves(Preds, Phis) ->
+ get_moves(Preds, Phis, gb_trees:empty()).
+
+get_moves([Pred|Left], Phis, Map)->
+ Moves = get_moves_from_phis(Pred, Phis, []),
+ NewMap =
+ case gb_trees:lookup(Moves, Map) of
+ none -> gb_trees:insert(Moves, [Pred], Map);
+ {value,List} -> gb_trees:update(Moves, [Pred|List], Map)
+ end,
+ get_moves(Left, Phis, NewMap);
+get_moves([], _Phis, Map) ->
+ gb_trees:to_list(Map).
+
+%%----------------------------------------------------------------------
+%% Procedure : get_moves_from_phis/3
+%% Purpose : Find all the moves that should be done in the edge
+%% coming in from Pred.
+%% Arguments : Pred - The predecessor
+%% Phis - Reverse list of phi instructions.
+%% Returns : [{Dst,Src}] representing the move instructions;
+%% ORDERING IS SIGNIFICANT!
+%%----------------------------------------------------------------------
+
+get_moves_from_phis(Pred, [Phi|Left], Acc) ->
+ Dst = ?CODE:phi_dst(Phi),
+ Src = ?CODE:phi_arg(Phi, Pred),
+ NewAcc = [{Dst, Src}|Acc],
+ get_moves_from_phis(Pred, Left, NewAcc);
+get_moves_from_phis(_Pred, [], Acc) ->
+ Acc.
+
+%%----------------------------------------------------------------------
+%% Procedure : insert_move_bbs/3
+%% Purpose : Create the bbs that contains the moves.
+%% Arguments : Ordset - The move instruction tuples {Dst, Src}
+%% Preds - The predecessors that needs the moves in Ordset
+%% Label - The original label that contained the phis.
+%% Cfg - The current cfg
+%% Returns : The new Cfg.
+%%----------------------------------------------------------------------
+
+insert_move_bbs([{Ordset,Preds}|Left], Label, Cfg) ->
+ Code = create_moves(Ordset, []) ++ [?CODE:mk_goto(Label)],
+ BB = hipe_bb:mk_bb(Code),
+ NewLabel = ?CODE:label_name(?CODE:mk_new_label()),
+ NewCfg1 = ?CFG:bb_add(Cfg, NewLabel, BB),
+ NewCfg2 = lists:foldl(fun(X, Acc) ->
+ ?CFG:redirect(Acc, X, Label, NewLabel)
+ end,
+ NewCfg1, Preds),
+ insert_move_bbs(Left, Label, NewCfg2);
+insert_move_bbs([], _Label, Cfg) ->
+ Cfg.
+
+create_moves([{X,X}|Left], Acc) ->
+ create_moves(Left, Acc);
+create_moves([{Dst,Src}|Left], Acc) ->
+ create_moves(Left, [makePhiMove(Dst, Src)|Acc]);
+create_moves([], Acc) ->
+ %% NOTE: ORDERING IS SIGNIFICANT!
+ lists:reverse(Acc).
+
+%%----------------------------------------------------------------------
+%% Procedure : getPhiFuncts/2
+%% Purpose : This function returns the list of phi-functions from a
+%% list of intermediate code instructions.
+%% Arguments :
+%% List - A list of Code
+%% Result - Accumulative parameter to store the result
+%% Returns : Reverse list of the phi instructions. ORDERING IS SIGNIFICANT!
+%%----------------------------------------------------------------------
+
+getPhiFuncts([I|T] = List, Result) ->
+ case ?CODE:is_phi(I) of
+ true ->
+ getPhiFuncts(T, [I|Result]);
+ false ->
+ {Result,List}
+ end;
+getPhiFuncts([], Result) ->
+ {Result,[]}.
+
+
+%%======================================================================
+%% Dead Code Elimination on SSA form
+%%======================================================================
+
+-spec remove_dead_code(#cfg{}) -> #cfg{}.
+
+remove_dead_code(CFG) ->
+ Lbls = ?CFG:reverse_postorder(CFG),
+ Liveness = ssa_liveness__analyze(CFG),
+ case do_lbls(Lbls, CFG, Liveness, false) of
+ {CFG1,true} ->
+ remove_dead_code(CFG1);
+ {CFG1,false} ->
+ CFG1
+ end.
+
+do_lbls([Lbl|Rest], CFG, Liveness, Changed) ->
+ LiveOut = gb_sets:from_list(ssa_liveness__liveout(Liveness, Lbl)),
+ BB = ?CFG:bb(CFG, Lbl),
+ Code = hipe_bb:code(BB),
+ {NewCode,NewChanged} = do_code(lists:reverse(Code), LiveOut, Changed, []),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ NewCFG = ?CFG:bb_add(CFG, Lbl, NewBB),
+ do_lbls(Rest, NewCFG, Liveness, NewChanged);
+do_lbls([], CFG, _Liveness, Changed) ->
+ {CFG,Changed}.
+
+do_code([Instr|Instrs], LiveOut, Changed, Acc) ->
+ Def = ?CODE:defines(Instr),
+ Use = ?CODE:uses(Instr),
+ DefSet = gb_sets:from_list(Def),
+ UseSet = gb_sets:from_list(Use),
+ LiveIn = gb_sets:union(gb_sets:difference(LiveOut, DefSet), UseSet),
+ case gb_sets:is_empty(gb_sets:intersection(DefSet, LiveOut)) of
+ false ->
+ do_code(Instrs, LiveIn, Changed, [Instr|Acc]);
+ true ->
+ case ?CODE:is_safe(Instr) of
+ true ->
+ case ?CODE:is_call(Instr) of
+ true ->
+ case ?CODE:call_continuation(Instr) of
+ [] ->
+ do_code(Instrs, LiveOut, true, Acc);
+ SuccLblName ->
+ NewInstr = ?CODE:mk_goto(SuccLblName),
+ do_code(Instrs, LiveOut, true, [NewInstr|Acc])
+ end;
+ false ->
+ do_code(Instrs, LiveOut, true, Acc)
+ end;
+ false -> %% not a safe instruction - cannot be removed
+ case ?CODE:is_call(Instr) of
+ true ->
+ case ?CODE:call_dstlist(Instr) of
+ [] -> %% result was not used anyway; no change
+ do_code(Instrs, LiveIn, Changed, [Instr|Acc]);
+ [_Dst] -> %% remove the unused assignment to call's destination
+ NewInstr = ?CODE:call_dstlist_update(Instr, []),
+ do_code(Instrs, LiveIn, true, [NewInstr|Acc]);
+ [_|_] -> %% calls with multiple dests are left untouched
+ do_code(Instrs, LiveIn, Changed, [Instr|Acc])
+ end;
+ false ->
+ do_code(Instrs, LiveIn, Changed, [Instr|Acc])
+ end
+ end
+ end;
+do_code([], _LiveOut, Changed, Acc) ->
+ {Acc,Changed}.
+
diff --git a/lib/hipe/ssa/hipe_ssa_const_prop.inc b/lib/hipe/ssa/hipe_ssa_const_prop.inc
new file mode 100644
index 0000000000..2fce384197
--- /dev/null
+++ b/lib/hipe/ssa/hipe_ssa_const_prop.inc
@@ -0,0 +1,522 @@
+%% -*- Erlang -*-
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------------
+%% File : hipe_ssa_const_prop.inc
+%% Author : Kostis Sagonas <kostis@it.uu.se>
+%% Description : Supporting routines for sparse conditional constant
+%% propagation on SSA form.
+%%
+%% Created : 21 June 2004 by Kostis Sagonas <kostis@it.uu.se>
+%%-----------------------------------------------------------------------------
+
+%%-----------------------------------------------------------------------------
+%% Procedure : propagate/1
+%% Purpose : Perform sparse conditional constant propagation on a
+%% control flow graph
+%% Arguments : CFG - The cfg to work on
+%% Returns : A new cfg.
+%%-----------------------------------------------------------------------------
+
+-spec propagate(#cfg{}) -> #cfg{}.
+
+propagate(CFG) ->
+ Environment = create_env(CFG),
+ StartEdge = {?CFG:start_label(CFG), ?CFG:start_label(CFG)},
+ NewEnvironment = scc([StartEdge], [], Environment),
+ NewCFG = update_cfg(NewEnvironment),
+ NewCFG.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_expressions/2 & visit_expressions/4
+%% Purpose : visit each instruction in a list of instructions.
+%% Arguments : Instructions - the list of instructions to visit
+%% Environment - have a guess.
+%% FlowWork - list of destination part of flowgraph edges
+%% from the visited instructions
+%% SSAWork - resulting ssa-edges from visited instrs.
+%% Returns : {FlowWorkList, SSAWorkList, Environment}
+%%-----------------------------------------------------------------------------
+
+visit_expressions(Instructions, Environment) ->
+ visit_expressions(Instructions, Environment, [], []).
+
+visit_expressions([], Environment, FlowWork, SSAWork) ->
+ {FlowWork, SSAWork, Environment};
+visit_expressions([Inst | Insts], Environment, FlowWork, SSAWork) ->
+ {MoreFlowWork, MoreSSAWork, Environment1}
+ = visit_expression(Inst, Environment),
+ FlowWork1 = MoreFlowWork ++ FlowWork,
+ SSAWork1 = MoreSSAWork ++ SSAWork,
+ visit_expressions(Insts, Environment1, FlowWork1, SSAWork1).
+
+%%-----------------------------------------------------------------------------
+%% The environment record: Shared between incarnations of SCCP.
+%%-----------------------------------------------------------------------------
+
+-record(env, {cfg :: #cfg{},
+ executable_flags = gb_sets:empty() :: gb_set(),
+ handled_blocks = gb_sets:empty() :: gb_set(),
+ lattice_values = gb_trees:empty() :: gb_tree(),
+ ssa_edges = gb_trees:empty() :: gb_tree()
+ }).
+
+create_env(CFG) ->
+ #env{cfg = CFG,
+ executable_flags = gb_sets:empty(),
+ handled_blocks = gb_sets:empty(),
+ lattice_values = initialize_lattice(CFG),
+ ssa_edges = initialize_ssa_edges(CFG)
+ }.
+
+env__cfg(#env{cfg=CFG}) -> CFG.
+env__executable_flags(#env{executable_flags=Flags}) -> Flags.
+env__lattice_values(#env{lattice_values=Values}) -> Values.
+env__ssa_edges(#env{ssa_edges=Edges}) -> Edges.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : initialize_lattice/1
+%% Purpose : Compute the initial value-lattice for the CFG
+%% Arguments : CFG a control flow graph
+%% Returns : a value-latice (gb_tree)
+%%-----------------------------------------------------------------------------
+
+initialize_lattice(CFG) ->
+ Lattice = gb_trees:empty(),
+ Parameters = ?CFG:params(CFG),
+ Inserter = fun(Parameter, Tree) ->
+ gb_trees:insert(Parameter, bottom, Tree)
+ end,
+ lists:foldl(Inserter, Lattice, Parameters).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : initialize_ssa_edges/1
+%% Purpose : Compute the SSA edges in the CFG. SSA edges are used to map
+%% the definition of a value to its uses.
+%% Arguments : CFG - the cfg
+%% Returns : A gb_tree of values (variables & registers) to
+%% lists of {Node, Instruction} pairs.
+%%-----------------------------------------------------------------------------
+
+initialize_ssa_edges(CFG) ->
+ IterateNodes =
+ fun(Node, Tree1) ->
+ IterateInstructions =
+ fun(Instruction, Tree2) ->
+ IterateArguments =
+ fun(Argument, Tree3) ->
+ Data = gb_trees:lookup(Argument, Tree3),
+ NewEdge = {Node, Instruction},
+ case Data of
+ none ->
+ %% insert assumes key is not present
+ gb_trees:insert(Argument, [NewEdge], Tree3);
+ {value, EdgeList} ->
+ %% update assumes key is present
+ gb_trees:update(Argument, [NewEdge|EdgeList], Tree3)
+ end
+ end,
+ Arguments = ?CODE:uses(Instruction),
+ lists:foldl(IterateArguments, Tree2, Arguments)
+ end,
+ Instructions = hipe_bb:code(?CFG:bb(CFG, Node)),
+ lists:foldl(IterateInstructions, Tree1, Instructions)
+ end,
+ NodeList = ?CFG:labels(CFG),
+ lists:foldl(IterateNodes, gb_trees:empty(), NodeList).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : scc/3
+%% Purpose : Do the symbolic execution of a cfg and compute the resulting
+%% value-lattice, and reachability information (Environment).
+%% This is the main loop that does a fixpoint computation of the
+%% lattice-values for each variable and register.
+%% Arguments : FlowWorkList - work list of control-flow edges
+%% SSAWorkList - work list of ssa-edges
+%% Environment - the environment that have been computed so far.
+%% Returns : The environment after execution
+%%-----------------------------------------------------------------------------
+
+scc([], [], Environment) ->
+ Environment;
+%% Take an element from the FlowWorkList and process it
+scc([{Source,Destination} | FlowWorkList], SSAWorkList, Environment) ->
+ case executable({Source, Destination}, Environment) of
+ true ->
+ scc(FlowWorkList, SSAWorkList, Environment);
+ false ->
+ Environment1 = mark_as_executable({Source,Destination}, Environment),
+ Code = extract_code(Destination, Environment),
+ {Environment2, Code1, ExtraSSA} =
+ visit_phi_nodes(Code, Destination, Environment1, []),
+ case handled(Destination, Environment2) of
+ true ->
+ scc(FlowWorkList, ExtraSSA ++ SSAWorkList, Environment2);
+ false ->
+ {MoreFlowDests, MoreSSAWork, Environment3} =
+ visit_expressions(Code1, Environment2),
+ MoreFlowWork = [{Destination, Node} || Node <- MoreFlowDests],
+ FlowWorkList1 = MoreFlowWork ++ FlowWorkList,
+ SSAWorkList1 = ExtraSSA ++ MoreSSAWork ++ SSAWorkList,
+ Environment4 = mark_as_handled(Destination, Environment3),
+ scc(FlowWorkList1, SSAWorkList1, Environment4)
+ end
+ end;
+%% Take an element from the SSAWorkList and process it
+scc([], [{Node, Instruction} | SSAWorkList], Environment) ->
+ case reachable(Node, Environment) of
+ true ->
+ case ?CODE:is_phi(Instruction) of
+ true ->
+ {Environment1, MoreSSA} = visit_phi(Instruction, Node, Environment),
+ scc([], MoreSSA ++ SSAWorkList, Environment1);
+ false ->
+ {MoreFlowDests, MoreSSAWork, Environment1} =
+ visit_expression(Instruction, Environment),
+ SSAWorkList1 = MoreSSAWork ++ SSAWorkList,
+ MoreFlowWork = [{Node, Destination} || Destination<-MoreFlowDests],
+ scc(MoreFlowWork, SSAWorkList1, Environment1)
+ end;
+ false ->
+ scc([], SSAWorkList, Environment)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_cfg/1
+%% Purpose : Transforms the cfg into something more pleasant.
+%% Here the mapping of variables & registers to lattice-values is
+%% used to actually change the code.
+%% Arguments : Environment - in which everything happens.
+%% Returns : A new CFG.
+%%-----------------------------------------------------------------------------
+
+update_cfg(Environment) ->
+ NodeList = get_nodelist(Environment),
+ CFG1 = update_nodes(NodeList, Environment),
+ %% why not hipe_???_ssa:remove_dead_code ?
+ CFG2 = ?CFG:remove_unreachable_code(CFG1),
+ CFG2.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_nodes/2
+%% Purpose : loop over all nodes in a list of nodes, ignoring any
+%% non-reachable node.
+%% Arguments : NodeList - the list of nodes.
+%% Environment - in which everything happens.
+%% Returns : a new cfg.
+%%-----------------------------------------------------------------------------
+
+update_nodes([], Environment) ->
+ env__cfg(Environment);
+update_nodes([Node | NodeList], Environment) ->
+ NewEnvironment =
+ case reachable(Node, Environment) of
+ true ->
+ Instructions = extract_code(Node, Environment),
+ Updater = fun(Instruction) ->
+ update_instruction(Instruction, Environment)
+ end,
+ NewInstructions = lists:flatmap(Updater, Instructions),
+ update_code(Node, NewInstructions, Environment);
+ false ->
+ Environment
+ end,
+ update_nodes(NodeList, NewEnvironment).
+
+%%-----------------------------------------------------------------------------
+%% Procedure : update_code/3
+%% Purpose : Insert a list of new instructions into the cfg in the
+%% environment
+%% Arguments : Node - name of the bb whose instructions we replace.
+%% NewInstructions - The list of new instructions
+%% Env - The environment
+%% Returns : A new environment
+%%-----------------------------------------------------------------------------
+
+update_code(Node, NewInstructions, Environment) ->
+ CFG = env__cfg(Environment),
+ BB = ?CFG:bb(CFG, Node),
+ OrderedInstructions = put_phi_nodes_first(NewInstructions),
+ NewBB = hipe_bb:code_update(BB, OrderedInstructions),
+ NewCFG = ?CFG:bb_add(CFG, Node, NewBB),
+ Environment#env{cfg = NewCFG}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : put_phi_nodes_first/1
+%% Purpose : Move all phi-instructions to the beginning of the basic block.
+%% Arguments : Instructions - The list of instructions
+%% Returns : A list of instructions where the phi-nodes are first.
+%%-----------------------------------------------------------------------------
+
+put_phi_nodes_first(Instructions) ->
+ {PhiInstructions, OtherInstructions} =
+ partition(fun(X) -> ?CODE:is_phi(X) end, Instructions),
+ PhiInstructions ++ OtherInstructions.
+
+%%-----------------------------------------------------------------------------
+
+partition(Function, List) ->
+ partition(Function, List, [], []).
+
+partition(_Function, [], True, False) ->
+ {lists:reverse(True), lists:reverse(False)};
+
+partition(Function, [Hd | Tail], True, False) ->
+ case Function(Hd) of
+ true ->
+ partition(Function, Tail, [Hd | True], False);
+ false ->
+ partition(Function, Tail, True, [Hd | False])
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_phi_nodes/4
+%% Purpose : visit all the phi-nodes in a bb and return the list of
+%% remaining instructions, new ssa-edges and a new environment.
+%% Arguments : [Inst|Insts] - The list of instructions in the bb
+%% Node - Name of the current node.
+%% Environment - the environment
+%% SSAWork - the ssawork found so far.
+%% Returns : {Environment, Instruction list, SSAWorkList}
+%%-----------------------------------------------------------------------------
+
+visit_phi_nodes([], CurrentNode, _Environment, _SSAWork) ->
+ ?EXIT({"~w: visit_phi_nodes/4 Basic block contains no code",
+ ?MODULE, CurrentNode});
+visit_phi_nodes(Is = [Inst | Insts], Node, Environment, SSAWork) ->
+ case ?CODE:is_phi(Inst) of
+ true ->
+ {Environment1, NewSSA} = visit_phi(Inst, Node, Environment),
+ visit_phi_nodes(Insts, Node, Environment1, NewSSA ++ SSAWork);
+ false ->
+ {Environment, Is, SSAWork}
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : visit_phi/3
+%% Purpose : visit a phi-node
+%% Arguments : PhiInstruction- The instruction
+%% CurrentNode - Name of the current node.
+%% Environment - the environment
+%% Returns : {NewEnvironment, SSAWork}
+%%-----------------------------------------------------------------------------
+
+visit_phi(PhiInstruction, CurrentNode, Environment) ->
+ ArgumentList = ?CODE:phi_arglist(PhiInstruction),
+ Value = get_phi_value(ArgumentList, CurrentNode, Environment, top),
+ Name = ?CODE:phi_dst(PhiInstruction),
+ {Environment1, SSAWork} = update_lattice_value({Name, Value}, Environment),
+ {Environment1, SSAWork}.
+
+%%-----------------------------------------------------------------------------
+%% Procedure : get_phi_value/4
+%% Purpose : compute the result of a phi-function, taking care to ignore
+%% edges that are not yet executable.
+%% Arguments : ArgList - the list of arguments {Node, Value pair}
+%% CurrentNode - the current node
+%% Environment - well...
+%% CurrentValue - the meet of the relevant already processed values
+%% Returns : Integer, top or bottom
+%%-----------------------------------------------------------------------------
+
+%% the arglist contains {predecessor, variable} elements. Remember
+%% to be optimistic in this part, hopefully, topvalues will fall down
+%% to become constants. Hence topvalues are more or less ignored here.
+get_phi_value([], _CurrentNode, _Environment, CurrentValue) ->
+ CurrentValue;
+get_phi_value([{PredecessorNode, Variable}| ArgList],
+ CurrentNode,
+ Environment,
+ CurrentValue) ->
+ case executable({PredecessorNode, CurrentNode}, Environment) of
+ true ->
+ NewValue = lookup_lattice_value(Variable, Environment),
+ case NewValue of
+ bottom ->
+ bottom;
+ top ->
+ get_phi_value(ArgList, CurrentNode, Environment, CurrentValue);
+ _ ->
+ case CurrentValue of
+ top ->
+ get_phi_value(ArgList, CurrentNode, Environment, NewValue);
+ _ ->
+ case (NewValue =:= CurrentValue) of
+ true ->
+ get_phi_value(ArgList, CurrentNode, Environment, NewValue);
+ false -> %% two different constants.
+ bottom
+ end
+ end
+ end;
+ false -> %% non-executable transitions don't affect the value.
+ get_phi_value(ArgList, CurrentNode, Environment, CurrentValue)
+ end.
+
+%%------------------------------ environment ----------------------------------
+
+reachable(Node, Environment) ->
+ Predecessors = predecessors(Node, Environment),
+ Executable = fun(Pred) -> executable({Pred, Node}, Environment) end,
+ lists:any(Executable, Predecessors).
+
+%%-----------------------------------------------------------------------------
+
+mark_as_executable(Edge, Environment) ->
+ ExecutableFlags = env__executable_flags(Environment),
+ ExecutableFlags1 = gb_sets:add(Edge, ExecutableFlags),
+ Environment#env{executable_flags = ExecutableFlags1}.
+
+%%-----------------------------------------------------------------------------
+
+mark_as_handled(Node, Environment = #env{handled_blocks=Handled}) ->
+ NewHandled = gb_sets:add_element(Node, Handled),
+ Environment#env{handled_blocks=NewHandled}.
+
+handled(Node, #env{handled_blocks=Handled}) ->
+ gb_sets:is_element(Node, Handled).
+
+%%-----------------------------------------------------------------------------
+
+extract_code(Node, Environment) ->
+ CFG = env__cfg(Environment),
+ case ?CFG:bb(CFG, Node) of
+ not_found -> ?WARNING_MSG("Could not find label ~w.\n", [Node]),
+ [];
+ BB -> hipe_bb:code(BB)
+ end.
+
+%%-----------------------------------------------------------------------------
+
+predecessors(Node, Environment) ->
+ CFG = env__cfg(Environment),
+ ?CFG:pred(CFG, Node).
+
+%%-----------------------------------------------------------------------------
+
+executable(Edge, Environment) ->
+ ExecutableFlags = env__executable_flags(Environment),
+ gb_sets:is_member(Edge, ExecutableFlags).
+
+%%-----------------------------------------------------------------------------
+
+update_lattice_value({[], _NewValue}, Environment) ->
+ {Environment, []};
+update_lattice_value({Names, NewValue}, Environment) when is_list(Names) ->
+ Update =
+ fun(Dst, {Env, SSA}) ->
+ {NewEnv, NewSSA} =
+ update_lattice_value({Dst, NewValue}, Env),
+ {NewEnv, SSA ++ NewSSA}
+ end,
+ lists:foldl(Update, {Environment, []}, Names);
+%% update_lattice_value({Name, {Res, N, Z, C, V} }, _) ->
+%% ?EXIT({"inserting dumt grejs", {Name, {Res, N, Z, C, V} } });
+update_lattice_value({Name, NewValue}, Environment) ->
+ LatticeValues = env__lattice_values(Environment),
+ {LatticeValues1, SSAWork} =
+ case gb_trees:lookup(Name, LatticeValues) of
+ none ->
+ {gb_trees:insert(Name, NewValue, LatticeValues),
+ lookup_ssa_edges(Name, Environment)};
+ {value, NewValue} ->
+ {LatticeValues, []};
+ {value, _} ->
+ {gb_trees:update(Name, NewValue, LatticeValues),
+ lookup_ssa_edges(Name, Environment)}
+ end,
+ {Environment#env{lattice_values = LatticeValues1}, SSAWork}.
+
+%%-----------------------------------------------------------------------------
+
+lookup_ssa_edges(Variable, Environment) ->
+ SSAEdges = env__ssa_edges(Environment),
+ case gb_trees:lookup(Variable, SSAEdges) of
+ {value, X} ->
+ X;
+ _ -> % Unused variable
+ []
+ end.
+
+%%-----------------------------------------------------------------------------
+
+get_nodelist(Environment) ->
+ CFG = env__cfg(Environment),
+ ?CFG:labels(CFG).
+
+%%-----------------------------------------------------------------------------
+
+-ifdef(DEBUG).
+
+%%-----------------------------------------------------------------------------
+%%---------------------------------- DEBUG ------------------------------------
+
+error(Text) ->
+ error(Text, []).
+
+error(Text, Data) ->
+ io:format("Internal compiler error in ~w\n",[?MODULE]),
+ io:format(Text, Data),
+ io:format("\n\n"),
+ halt().
+
+%%-----------------------------------------------------------------------------
+
+print_environment(Environment) ->
+ io:format("============================================================\n"),
+ io:format("Executable flags: "),
+ print_executable_flags(env__executable_flags(Environment)),
+ io:format("Lattice values --->\n"),
+ print_lattice_values(env__lattice_values(Environment)),
+ io:format("SSA edges --->\n"),
+ print_ssa_edges(env__ssa_edges(Environment)),
+ io:format("============================================================\n").
+
+%%-----------------------------------------------------------------------------
+
+print_executable_flags(ExecutableFlags) ->
+ ListOfFlags = gb_sets:to_list(ExecutableFlags),
+ Printer = fun ({Source, Destination}) ->
+ io:format("(~w, ~w), ", [Source, Destination]) end,
+ lists:foreach(Printer, ListOfFlags),
+ io:format("()\n").
+
+%%-----------------------------------------------------------------------------
+
+print_lattice_values(LatticeValues) ->
+ ListOfLatticeValues = gb_trees:to_list(LatticeValues),
+ Printer = fun ({Key, Value}) ->
+ io:format("~w = ~w\n", [Key, Value]) end,
+ lists:foreach(Printer, ListOfLatticeValues).
+
+%%-----------------------------------------------------------------------------
+
+print_ssa_edges(SSAEdges) ->
+ ListOfSSAEdges = gb_trees:to_list(SSAEdges),
+ Printer = fun ({Key, Value}) ->
+ io:format("~w: ~w\n", [Key, Value]) end,
+ lists:foreach(Printer, ListOfSSAEdges).
+
+%%-----------------------------------------------------------------------------
+
+-endif. %% DEBUG
+
+%%-----------------------------------------------------------------------------
+
diff --git a/lib/hipe/ssa/hipe_ssa_copy_prop.inc b/lib/hipe/ssa/hipe_ssa_copy_prop.inc
new file mode 100644
index 0000000000..311940a1fc
--- /dev/null
+++ b/lib/hipe/ssa/hipe_ssa_copy_prop.inc
@@ -0,0 +1,198 @@
+%%% -*- Erlang -*-
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_ssa_copy_prop.inc
+%%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%%% Description : Copy propagation on SSA form.
+%%%
+%%% Created : 4 Apr 2003 by Tobias Lindahl <tobiasl@it.uu.se>
+%%%-------------------------------------------------------------------
+
+-export([cfg/1]).
+
+%%--------------------------------------------------------------------
+%% Two passes through the code visiting the blocks in reverse
+%% postorder. The first pass binds all destinations of copying moves
+%% to the sources, and the second propagates the copies and removes
+%% the copying moves.
+%%
+%% Problem:
+%% Since phi-nodes are implemented as instructions they are not
+%% atomic. If we are not careful we can get the situation (after propagation):
+%%
+%% v0 = phi(v0, v2)
+%% v1 = phi(v0, v3)
+%% ^^
+%% where the underlined v0 really corresponds to the v0 before the first
+%% phi-instruction.
+%%
+%% Solution:
+%% * Find all dependencies between the uses of a phi-instruction to
+%% the destination of any earlier phi-instruction in the same phi-node;
+%% * Keep the copying move that defines the variable used in the
+%% latter phi-instruction; and
+%% * Do not propagate the copy into the phi-instruction
+%%
+%%--------------------------------------------------------------------
+
+-spec cfg(#cfg{}) -> #cfg{}.
+
+cfg(Cfg) ->
+ Labels = ?cfg:reverse_postorder(Cfg),
+ {Info,PhiDep} = analyse(Labels, Cfg, gb_trees:empty(), gb_trees:empty()),
+ rewrite(Labels, Cfg, Info, PhiDep).
+
+analyse([Label|Left], Cfg, Info, PhiDep) ->
+ BB = ?cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ NewPhiDep = get_phi_dep(Code, gb_sets:empty(), PhiDep),
+ NewInfo = analyse_code(Code, Info),
+ analyse(Left, Cfg, NewInfo, NewPhiDep);
+analyse([], _Cfg, Info, PhiDep) ->
+ {Info,PhiDep}.
+
+get_phi_dep([I|Left], Defined, Dep) ->
+ case ?code:is_phi(I) of
+ true ->
+ Use = ?code:uses(I),
+ [Def] = ?code:defines(I),
+ NewDep = add_dep(Use, Defined, Dep),
+ get_phi_dep(Left, gb_sets:insert(Def, Defined), NewDep);
+ false ->
+ Dep
+ end;
+get_phi_dep([], _Defined, Dep) ->
+ Dep.
+
+add_dep([Use|Left], Defined, Dep) ->
+ case gb_trees:lookup(Use, Dep) of
+ none ->
+ add_dep(Left, Defined, gb_trees:insert(Use, Defined, Dep));
+ {value, Set} ->
+ NewSet = gb_sets:union(Defined, Set),
+ add_dep(Left, Defined, gb_trees:enter(Use, NewSet, Dep))
+ end;
+add_dep([], _Defined, Dep) ->
+ Dep.
+
+has_dep(Use, Def, Dep) ->
+ case gb_trees:lookup(Use, Dep) of
+ none ->
+ false;
+ {value, Set} ->
+ gb_sets:is_member(Def, Set)
+ end.
+
+analyse_code([I|Left], Info) ->
+ case ?code:is_move(I) of
+ true ->
+ NewInfo = get_info_move(I, Info),
+ analyse_code(Left, NewInfo);
+ false ->
+ analyse_code(Left, Info)
+ end;
+analyse_code([], Info) ->
+ Info.
+
+get_info_move(I, Info) ->
+ case ?code:uses(I) of
+ [] -> %% Constant.
+ Info;
+ [Src] ->
+ add_binding(?code:defines(I), Src, Info)
+ end.
+
+rewrite([Label|Left], Cfg, Info, PhiDep) ->
+ BB = ?cfg:bb(Cfg, Label),
+ Code = hipe_bb:code(BB),
+ NewCode = rewrite_code(Code, Info, PhiDep, []),
+ NewBB = hipe_bb:code_update(BB, NewCode),
+ rewrite(Left, ?cfg:bb_add(Cfg, Label, NewBB), Info, PhiDep);
+rewrite([], Cfg, _Info, _PhiDep) ->
+ Cfg.
+
+rewrite_code([I|Left], Info, PhiDep, Acc) ->
+ case ?code:is_move(I) of
+ true ->
+ Fun = fun(X, Y) -> ?code:mk_move(X, Y) end,
+ NewI = rewrite_move(I, Fun, Info, PhiDep),
+ rewrite_code(Left, Info, PhiDep, NewI++Acc);
+ false ->
+ NewI = rewrite_instr(I, Info, PhiDep),
+ rewrite_code(Left, Info, PhiDep, [NewI|Acc])
+ end;
+rewrite_code([], _Info, _PhiDep, Acc) ->
+ lists:reverse(Acc).
+
+rewrite_move(I, Fun, Info, PhiDep) ->
+ case ?code:uses(I) of
+ [] ->%% Constant move. Keep it!
+ [I];
+ _ ->
+ Dst = hd(?code:defines(I)),
+ case gb_trees:lookup(Dst, Info) of
+ {value, Root} ->
+ case has_dep(Dst, Root, PhiDep) of
+ true -> %% Must keep the copying move!
+ [Fun(Dst, Root)];
+ false ->
+ []
+ end;
+ none ->
+ []
+ end
+ end.
+
+rewrite_instr(I, Info, PhiDep) ->
+ rewrite_instr0(I, ?code:uses(I), Info, PhiDep, []).
+
+rewrite_instr0(I, [Key|Left], Info, PhiDep, UpdateInfo) ->
+ case gb_trees:lookup(Key, Info) of
+ none ->
+ rewrite_instr0(I, Left, Info, PhiDep, UpdateInfo);
+ {value, Root} ->
+ case gb_trees:lookup(Key, Info) of
+ {value, Root} ->
+ case has_dep(Key, Root, PhiDep) of
+ true -> %% Must keep Key!
+ rewrite_instr0(I, Left, Info, PhiDep, UpdateInfo);
+ false ->
+ rewrite_instr0(I, Left, Info, PhiDep, [{Key, Root}|UpdateInfo])
+ end;
+ _ ->
+ rewrite_instr0(I, Left, Info, PhiDep, UpdateInfo)
+ end
+ end;
+rewrite_instr0(I, [], _Info, _PhiDep, UpdateInfo) ->
+ ?code:subst(UpdateInfo, I).
+
+add_binding([Key|Left], Val, Info) ->
+ %% Make sure the key is bound to the end of any copy-chains.
+ NewInfo =
+ case gb_trees:lookup(Val, Info) of
+ {value, NewVal} ->
+ gb_trees:insert(Key, NewVal, Info);
+ none ->
+ gb_trees:insert(Key, Val, Info)
+ end,
+ add_binding(Left, Val, NewInfo);
+add_binding([], _, Info) ->
+ Info.
diff --git a/lib/hipe/ssa/hipe_ssa_liveness.inc b/lib/hipe/ssa/hipe_ssa_liveness.inc
new file mode 100644
index 0000000000..05c8a88059
--- /dev/null
+++ b/lib/hipe/ssa/hipe_ssa_liveness.inc
@@ -0,0 +1,328 @@
+%% -*- Erlang -*-
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GENERIC MODULE TO PERFORM LIVENESS ANALYSIS ON SSA FORM
+%%
+%% Exports:
+%% ~~~~~~~
+%% analyze(CFG) - returns a liveness analysis of CFG.
+%% liveout(Liveness, Label) - returns the list of variables that are
+%% live at exit from basic block named Label.
+%% livein(Liveness, Label) - returns the list of variables that are
+%% live on entry to the basic block named Label.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Uncomment the following if this is ever needed as an independent module
+%%
+-ifdef(LIVENESS_NEEDED).
+-export([ssa_liveness__analyze/1,
+ ssa_liveness__livein/2]).
+%% ssa_liveness__livein/3],
+%% ssa_liveness__liveout/2]).
+-endif.
+%% -ifdef(DEBUG_LIVENESS).
+%% -export([pp_liveness/1]).
+%% -endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Interface functions that MUST be implemented in the supporting files
+%%
+%% In the CFG file:
+%% ----------------
+%% - bb(CFG, L) -> BasicBlock, extract a basic block from a cfg.
+%% - postorder(CFG) -> [Labels], the labels of the cfg in postorder
+%% - succ(CFG, L) -> [Labels],
+%% - function(CFG) -> {M,F,A}
+%%
+%% In the CODE file:
+%% -----------------
+%% - uses(Instr) ->
+%% - defines(Instr) ->
+%% - is_phi(Instr) -> Boolean
+%% - phi_arglist(Instr) -> [{Pred, Var}]
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The generic liveness analysis on SSA form
+%%
+ssa_liveness__analyze(CFG) ->
+ PO = ?CFG:postorder(CFG),
+ InitLiveness = liveness_init(init(PO, CFG)),
+ merry_go_around(PO, InitLiveness).
+
+%%
+%% The fixpoint iteration
+%%
+
+merry_go_around(Labels, Liveness) ->
+ case doit_once(Labels, Liveness) of
+ {fixpoint, NewLiveness} ->
+ NewLiveness;
+ {value, NewLiveness} ->
+ merry_go_around(Labels, NewLiveness)
+ end.
+
+%%
+%% One iteration
+%%
+
+doit_once(Labels, Liveness) ->
+ doit_once(Labels, Liveness, true).
+
+doit_once([], Liveness, FixPoint) ->
+ if FixPoint -> {fixpoint, Liveness};
+ true -> {value, Liveness}
+ end;
+doit_once([L|Ls], Liveness, FixPoint) ->
+ LiveOut = join_livein(Liveness, L),
+ NewLiveness = update_liveout(L, LiveOut, Liveness),
+ Kill = set_subtract(LiveOut, kill(L, NewLiveness)),
+ LiveIn = set_union(Kill, gen(L, NewLiveness)),
+ case update_livein(L, LiveIn, NewLiveness) of
+ fixpoint -> doit_once(Ls, NewLiveness, FixPoint);
+ {value, NewLiveness1} -> doit_once(Ls, NewLiveness1, false)
+ end.
+
+%%
+%% updates liveness for a basic block
+%%
+
+update_livein(Label, NewLiveIn, Liveness) ->
+ {GKD, LiveIn, LiveOut, Succ} = liveness_lookup(Label, Liveness),
+ case LiveIn of
+ NewLiveIn ->
+ fixpoint;
+ _ ->
+ {value, liveness_update(Label, {GKD,NewLiveIn,LiveOut,Succ}, Liveness)}
+ end.
+
+update_liveout(Label, NewLiveOut, Liveness) ->
+ {GKD, LiveIn, _LiveOut, Succ} = liveness_lookup(Label, Liveness),
+ liveness_update(Label, {GKD,LiveIn,NewLiveOut,Succ}, Liveness).
+
+%%
+%% Join live in to get the new live out.
+%%
+
+join_livein(Liveness, L) ->
+ Succ = successors(L, Liveness),
+ case Succ of
+ [] -> % special case if no successors
+ gb_sets:from_list(liveout_no_succ());
+ _ ->
+ join_livein1(L, Succ, Liveness)
+ end.
+
+join_livein1(Pred, Labels, Liveness) ->
+ join_livein1(Pred, Labels, Liveness, new_set()).
+
+join_livein1(_Pred, [], _Liveness, Live) ->
+ Live;
+join_livein1(Pred, [L|Ls], Liveness, Live) ->
+ OldLivein = livein_set(Liveness, L, Pred),
+ NewLive = set_union(OldLivein, Live),
+ join_livein1(Pred, Ls, Liveness, NewLive).
+
+
+ssa_liveness__liveout(Liveness, L) ->
+ {_GKD, _LiveIn, LiveOut, Successors} = liveness_lookup(L, Liveness),
+ case Successors of
+ [] -> % special case if no successors
+ liveout_no_succ();
+ _ ->
+ set_to_list(LiveOut)
+ end.
+
+-ifdef(LIVENESS_NEEDED).
+ssa_liveness__livein(Liveness, L) ->
+ set_to_list(livein_set(Liveness, L)).
+
+%% ssa_liveness__livein(Liveness, L, Pred) ->
+%% set_to_list(livein_set(Liveness, L, Pred)).
+
+livein_set(Liveness, L) ->
+ {{_Gen,_Kill,{TotalDirGen, _DirGen}}, LiveIn, _LiveOut, _Successors} =
+ liveness_lookup(L, Liveness),
+ set_union(TotalDirGen, LiveIn).
+-endif.
+
+livein_set(Liveness, L, Pred) ->
+ {{_Gen,_Kill,{_TotalDirGen, DirGen}}, LiveIn, _LiveOut, _Successors} =
+ liveness_lookup(L, Liveness),
+ case gb_trees:lookup(Pred, DirGen) of
+ none ->
+ LiveIn;
+ {value, LiveInFromPred} ->
+ set_union(LiveInFromPred, LiveIn)
+ end.
+
+successors(L, Liveness) ->
+ {_GKD, _LiveIn, _LiveOut, Successors} = liveness_lookup(L, Liveness),
+ Successors.
+
+kill(L, Liveness) ->
+ {{_Gen,Kill,_DirGen},_LiveIn,_LiveOut,_Successors} =
+ liveness_lookup(L, Liveness),
+ Kill.
+
+gen(L, Liveness) ->
+ {{Gen,_Kill,_DirGen},_LiveIn,_LiveOut,_Successors} =
+ liveness_lookup(L, Liveness),
+ Gen.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% init returns a list of: {Label, {{Gen, Kill}, LiveIn, Successors}}
+%% - Label is the name of the basic block.
+%% - Gen is the set of varables that are used by this block.
+%% - Kill is the set of varables that are defined by this block.
+%% - LiveIn is the set of variables that are alive at entry to the
+%% block (initially empty).
+%% - Successors is a list of the successors to the block.
+
+init([], _) ->
+ [];
+init([L|Ls], CFG) ->
+ BB = ?CFG:bb(CFG, L),
+ Code = hipe_bb:code(BB),
+ Succ = ?CFG:succ(CFG, L),
+ {Gen, Kill} = make_bb_transfer(Code, Succ),
+ DirectedGen = get_directed_gen(Code),
+ [{L, {{Gen, Kill, DirectedGen}, new_set(), new_set(), Succ}}
+ | init(Ls, CFG)].
+
+make_bb_transfer([], _Succ) ->
+ {new_set(), new_set()}; % {Gen, Kill}
+make_bb_transfer([I|Is], Succ) ->
+ {Gen, Kill} = make_bb_transfer(Is, Succ),
+ case ?CODE:is_phi(I) of
+ true ->
+ InstrKill = set_from_list(?CODE:defines(I)),
+ Gen1 = set_subtract(Gen, InstrKill),
+ Kill1 = set_union(Kill, InstrKill),
+ {Gen1, Kill1};
+ false ->
+ InstrGen = set_from_list(?CODE:uses(I)),
+ InstrKill = set_from_list(?CODE:defines(I)),
+ Gen1 = set_subtract(Gen, InstrKill),
+ Gen2 = set_union(Gen1, InstrGen),
+ Kill1 = set_union(Kill, InstrKill),
+ Kill2 = set_subtract(Kill1, InstrGen),
+ {Gen2, Kill2}
+ end.
+
+get_directed_gen(Code) ->
+ Map = get_directed_gen_1(Code),
+ TotalGen = lists:foldl(fun({_Pred, Gen}, Acc) ->
+ set_union(Gen, Acc)
+ end, new_set(), gb_trees:to_list(Map)),
+ {TotalGen, Map}.
+
+get_directed_gen_1([I|Left])->
+ case ?CODE:is_phi(I) of
+ false ->
+ gb_trees:empty();
+ true ->
+ Map = get_directed_gen_1(Left),
+ ArgList = ?CODE:phi_arglist(I),
+ lists:foldl(fun update_directed_gen/2, Map, ArgList)
+ end.
+
+update_directed_gen({Pred, Var}, Map)->
+ case gb_trees:lookup(Pred, Map) of
+ none -> gb_trees:insert(Pred, set_from_list([Var]), Map);
+ {value, Set} -> gb_trees:update(Pred, set_add(Var, Set), Map)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% liveness
+%%
+
+liveness_init(List) ->
+ liveness_init1(List, gb_trees:empty()).
+
+liveness_init1([{Label, Info}|Left], Map) ->
+ liveness_init1(Left, gb_trees:insert(Label, Info, Map));
+liveness_init1([], Map) ->
+ Map.
+
+liveness_lookup(Label, Map) ->
+ {value, Info} = gb_trees:lookup(Label, Map),
+ Info.
+
+liveness_update(Label, NewInfo, Map) ->
+ gb_trees:update(Label, NewInfo, Map).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Sets
+%%
+
+new_set() ->
+ gb_sets:empty().
+
+set_union(S1, S2) ->
+ gb_sets:union(S1, S2).
+
+set_subtract(S1, S2) ->
+ gb_sets:subtract(S1, S2).
+
+set_from_list(List) ->
+ gb_sets:from_list(List).
+
+set_to_list(Set) ->
+ gb_sets:to_list(Set).
+
+set_add(Var, Set) ->
+ gb_sets:add(Var, Set).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Pretty printer
+%%
+
+-ifdef(DEBUG_LIVENESS).
+
+pp_liveness(CFG) ->
+ io:format("Liveness for ~p:\n", [?CFG:function(CGF)]),
+ Liveness = analyze(CFG),
+ RevPostorder = lists:reverse(?CFG:postorder(CFG)),
+ Edges = [{X, Y} || X <- RevPostorder, Y <- ?CFG:succ(CFG, X)],
+ pp_liveness_edges(Edges, Liveness).
+
+pp_liveness_edges([{From, To}|Left], Liveness)->
+ LiveIn = livein(Liveness, To, From),
+ io:format("Label ~w -> Label ~w: ~p\n", [From, To, LiveIn]),
+ LiveOut = liveout(Liveness, From),
+ io:format("Total live out from Label ~w: ~p\n", [From, LiveOut]),
+ pp_liveness_edges(Left, Liveness);
+pp_liveness_edges([], _Liveness) ->
+ ok.
+
+-endif.
diff --git a/lib/hipe/tools/Makefile b/lib/hipe/tools/Makefile
new file mode 100644
index 0000000000..6ce5cb1b8b
--- /dev/null
+++ b/lib/hipe/tools/Makefile
@@ -0,0 +1,111 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2002-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = hipe_tool hipe_profile hipe_ceach hipe_jit
+# hipe_timer
+
+HRL_FILES=
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+distclean: clean
+realclean: clean
+
+
+# ----------------------------------------------------
+# Include dependencies
+# ----------------------------------------------------
+
+$(EBIN)/hipe_ceach.beam: ../main/hipe.hrl
+$(EBIN)/hipe_tool.beam: ../main/hipe.hrl
+
diff --git a/lib/hipe/tools/hipe_ceach.erl b/lib/hipe/tools/hipe_ceach.erl
new file mode 100644
index 0000000000..b29615e169
--- /dev/null
+++ b/lib/hipe/tools/hipe_ceach.erl
@@ -0,0 +1,74 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% ====================================================================
+%% Module : hipe_ceach
+%% Purpose : Compile each function in a module, possibly applying a
+%% fun between each compilation. Useful for bug hunting by
+%% pinpointing a function that when compiled causes a bug.
+%% Notes :
+%% History : * 2001-12-11 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_ceach).
+
+-export([c/1, c/2, c/3]).
+
+-include("../main/hipe.hrl").
+
+%%---------------------------------------------------------------------
+
+-spec c(atom()) -> 'ok'.
+
+c(M) ->
+ lists:foreach(fun({F,A}) -> comp(M, F, A) end,
+ M:module_info(functions)).
+
+-spec c(atom(), comp_options()) -> 'ok'.
+
+c(M, Opts) ->
+ lists:foreach(fun({F,A}) -> comp(M, F, A, Opts) end,
+ M:module_info(functions)).
+
+-spec c(atom(), comp_options(), fun(() -> any())) -> 'ok'.
+
+c(M, Opts, Fn) ->
+ lists:foreach(fun({F,A}) -> comp(M, F, A, Opts), Fn() end,
+ M:module_info(functions)).
+
+-spec comp(atom(), atom(), arity()) -> 'ok'.
+
+comp(M, F, A) ->
+ io:format("~w:~w/~w... ", [M, F, A]),
+ MFA = {M, F, A},
+ {ok, MFA} = hipe:c(MFA),
+ io:format("OK\n").
+
+-spec comp(atom(), atom(), arity(), comp_options()) -> 'ok'.
+
+comp(M, F, A, Opts) ->
+ io:format("~w:~w/~w... ", [M, F, A]),
+ MFA = {M, F, A},
+ {ok, MFA} = hipe:c(MFA, Opts),
+ io:format("OK\n").
diff --git a/lib/hipe/tools/hipe_jit.erl b/lib/hipe/tools/hipe_jit.erl
new file mode 100644
index 0000000000..0ac84388ae
--- /dev/null
+++ b/lib/hipe/tools/hipe_jit.erl
@@ -0,0 +1,87 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2002 by Erik Johansson.
+%% ====================================================================
+%% Module : hipe_jit
+%% Purpose :
+%% Notes :
+%% History : * 2002-03-14 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% @doc
+%% A tool to enable using the HiPE compiler as an automatic JIT
+%% compiler rather than a user-controlled one.
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_jit).
+
+-export([start/0]).
+
+-record(state, {mode = start :: 'sleep' | 'start' | 'wait',
+ threshold = 5000 :: non_neg_integer(),
+ sleep = 5000 :: non_neg_integer(),
+ time = 1000 :: non_neg_integer()}).
+
+%%---------------------------------------------------------------------
+
+-spec start() -> pid().
+%% @doc
+%% Starts an Erlang process which calls the HiPE compiler every
+%% now and then (when it sees it fit to do so).
+%% @end
+start() ->
+ spawn(fun () -> loop(#state{}) end).
+
+loop(State) ->
+ case State#state.mode of
+ start ->
+ start(State);
+ wait ->
+ wait(State);
+ _ ->
+ sleep(State)
+ end.
+
+sleep(State) ->
+ receive
+ quit -> ok
+ after State#state.sleep ->
+ loop(State#state{mode=start})
+ end.
+
+start(State) ->
+ catch hipe_profile:prof(),
+ catch hipe_profile:clear(),
+ loop(State#state{mode=wait}).
+
+wait(State) ->
+ receive
+ quit -> ok
+ after State#state.time ->
+ R = [M || {M,C} <- (catch hipe_profile:mods_res()),
+ C > State#state.threshold],
+ catch hipe_profile:prof_off(),
+ lists:foreach(fun(M) ->
+ io:format("Compile ~w\n",[M]),
+ hipe:c(M,[o2,verbose])
+ end, R)
+ end,
+ loop(State#state{mode=sleep}).
diff --git a/lib/hipe/tools/hipe_profile.erl b/lib/hipe/tools/hipe_profile.erl
new file mode 100644
index 0000000000..7566acb8f4
--- /dev/null
+++ b/lib/hipe/tools/hipe_profile.erl
@@ -0,0 +1,191 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% Time-stamp: <2008-04-20 14:53:42 richard>
+%% ====================================================================
+%% Module : hipe_profile
+%% Purpose :
+%% History : * 2001-07-12 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_profile).
+
+-export([%% profile/1, mods_profile/1,
+ prof/0, prof_off/0, clear/0, res/0,
+ mods_res/0,
+ %% clear_module/1, res_module/1,
+ prof_module/1, prof_module_off/1]).
+
+%% %% @spec mods_profile(F) -> [{mod(),calls()}]
+%% %% F = () -> term()
+%% %% mod() = atom()
+%% %% calls()= integer()
+%% %%
+%% %% @doc Returns the number of calls per module generated by
+%% %% applying F().
+%% %% The resulting lists is sorted with the most called
+%% %% module first.
+%% mods_profile(F) ->
+%% F(),
+%% prof(),
+%% clear(),
+%% F(),
+%% R = mods_res(),
+%% prof_off(),
+%% R.
+
+-spec mods_res() -> [{atom(), non_neg_integer()}].
+%% @doc Returns the number of calls per module currently
+%% recordeed since hipe_bifs:call_count_on().
+%% The resulting list is sorted with the most called
+%% module first.
+mods_res() ->
+ lists:reverse(lists:keysort(2, calls())).
+
+-spec calls() -> [{atom(), non_neg_integer()}].
+%% @doc Returns the number of calls per module currently
+%% recordeed since hipe_bifs:call_count_on().
+calls() ->
+ [{Mod, total_calls(Mod)} || Mod <- mods(),
+ total_calls(Mod) > 1,
+ Mod =/= hipe_profile].
+
+%% %% @spec profile(F) -> [{mfa(),calls()}]
+%% %% F = () -> term()
+%% %% mfa() = {mod(),function(),arity()}
+%% %% function() = atom()
+%% %% arity() = intger()
+%% %%
+%% %% @doc Returns the number of calls per module generated by
+%% %% applying F().
+%% %% The resulting lists is sorted with the most called
+%% %% module first.
+%% profile(F) ->
+%% %% Make sure all code is loaded.
+%% F(),
+%% %% Turn profiling on.
+%% prof(),
+%% clear(),
+%% %% Apply the closure to profile.
+%% F(),
+%% %% Get result.
+%% R = res(),
+%% %% Turn of profiling.
+%% prof_off(),
+%% R.
+
+-spec prof() -> 'ok'.
+%% @doc Turns on profiling of all loaded modules.
+prof() ->
+ lists:foreach(fun prof_module/1, mods()).
+
+-spec prof_off() -> 'ok'.
+%% @doc Turns off profiling of all loaded modules.
+ prof_off() ->
+ lists:foreach(fun prof_module_off/1, mods()).
+
+-spec clear() -> 'ok'.
+%% @doc Clears all counters.
+clear() ->
+ lists:foreach(fun clear_module/1, mods()).
+
+-spec res() -> [{mfa(), non_neg_integer()}].
+%% @doc Returns a list of the numbers of calls to each profiled function.
+%% The list is sorted with the most called function first.
+res() ->
+ lists:reverse(lists:keysort(2, lists:flatten([res_module(M) || M <- mods()]))).
+
+%% --------------------------------------------------------------------
+-spec mods() -> [atom()].
+%% @doc Returns a list of all loaded modules.
+%@ --------------------------------------------------------------------
+
+mods() ->
+ [Mod || {Mod,_} <- code:all_loaded()].
+
+%% --------------------------------------------------------------------
+-spec prof_module(atom()) -> 'ok'.
+%% @doc Turns on profiling for given module.
+%@ ____________________________________________________________________
+
+prof_module(Mod) ->
+ Funs = Mod:module_info(functions),
+ lists:foreach(fun ({F,A}) -> catch hipe_bifs:call_count_on({Mod,F,A}) end,
+ Funs),
+ ok.
+
+%% --------------------------------------------------------------------
+-spec prof_module_off(atom()) -> 'ok'.
+%% @doc Turns off profiling of the module Mod.
+%@ --------------------------------------------------------------------
+
+prof_module_off(Mod) ->
+ Funs = Mod:module_info(functions),
+ lists:foreach(fun ({F,A}) -> catch hipe_bifs:call_count_off({Mod,F,A}) end,
+ Funs),
+ ok.
+
+%% --------------------------------------------------------------------
+-spec clear_module(atom()) -> 'ok'.
+%% @doc Clears the call counters for all functions in module Mod.
+%@ --------------------------------------------------------------------
+
+clear_module(Mod) ->
+ Funs = Mod:module_info(functions),
+ lists:foreach(fun ({F,A}) -> catch hipe_bifs:call_count_clear({Mod,F,A}) end,
+ Funs),
+ ok.
+
+%% --------------------------------------------------------------------
+-spec res_module(atom()) -> [{mfa(), non_neg_integer()}].
+%% @doc Returns the number of profiled calls to each function (MFA)
+%% in the module Mod.
+%@ --------------------------------------------------------------------
+
+res_module(Mod) ->
+ Fun = fun ({F,A}) when is_atom(F), is_integer(A) ->
+ MFA = {Mod,F,A},
+ {MFA, try hipe_bifs:call_count_get(MFA) of
+ N when is_integer(N) -> N;
+ false -> 0
+ catch
+ _:_ -> 0
+ end
+ }
+ end,
+ lists:reverse(lists:keysort(2, [Fun(FA) || FA <- Mod:module_info(functions)])).
+
+-spec total_calls(atom()) -> non_neg_integer().
+
+total_calls(Mod) ->
+ Funs = Mod:module_info(functions),
+ SumF = fun ({F,A}, Acc) ->
+ MFA = {Mod,F,A},
+ try hipe_bifs:call_count_get(MFA) of
+ N when is_integer(N) -> N+Acc;
+ false -> Acc
+ catch
+ _:_ -> Acc
+ end;
+ (_, Acc) -> Acc
+ end,
+ lists:foldl(SumF, 0, Funs).
diff --git a/lib/hipe/tools/hipe_timer.erl b/lib/hipe/tools/hipe_timer.erl
new file mode 100644
index 0000000000..03cc358f17
--- /dev/null
+++ b/lib/hipe/tools/hipe_timer.erl
@@ -0,0 +1,159 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved
+%% Time-stamp: <2008-04-20 14:53:36 richard>
+%% ====================================================================
+%% Module : hipe_timer
+%% Purpose :
+%% Notes :
+%% History : * 2001-03-15 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_timer).
+
+-export([tr/1, t/1, timer/1, time/1, empty_time/0]).
+-export([advanced/2]).
+
+t(F) ->
+ {EWT,ERT} = empty_time(),
+ {WT,RT} = time(F),
+ {WT-EWT,(RT-ERT)/1000}.
+
+tr(F) ->
+ {EWT,ERT} = empty_time(),
+ {R,{WT,RT}} = timer(F),
+ {R,{WT-EWT,(RT-ERT)/1000}}.
+
+empty_time() ->
+ {WT1,WT2,WT3} = erlang:now(),
+ {A,_} = erlang:statistics(runtime),
+ {WT12,WT22,WT32} = erlang:now(),
+ {B,_} = erlang:statistics(runtime),
+ {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}.
+
+time(F) ->
+ {WT1,WT2,WT3} = erlang:now(),
+ {A,_} = erlang:statistics(runtime),
+ F(),
+ {WT12,WT22,WT32} = erlang:now(),
+ {B,_} = erlang:statistics(runtime),
+ {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}.
+
+timer(F) ->
+ {WT1,WT2,WT3} = erlang:now(),
+ {A,_} = erlang:statistics(runtime),
+ R = F(),
+ {WT12,WT22,WT32} = erlang:now(),
+ {B,_} = erlang:statistics(runtime),
+ {R,{(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}}.
+
+advanced(_Fun, I) when I < 2 -> false;
+advanced(Fun, Iterations) ->
+ R = Fun(),
+ Measurements = [t(Fun) || _ <- lists:seq(1, Iterations)],
+ {Wallclock, RunTime} = split(Measurements),
+ WMin = lists:min(Wallclock),
+ RMin = lists:min(RunTime),
+ WMax = lists:max(Wallclock),
+ RMax = lists:max(RunTime),
+ WMean = mean(Wallclock),
+ RMean = mean(RunTime),
+ WMedian = median(Wallclock),
+ RMedian = median(RunTime),
+ WVariance = variance(Wallclock),
+ RVariance = variance(RunTime),
+ WStddev = stddev(Wallclock),
+ RStddev = stddev(RunTime),
+ WVarCoff = 100 * WStddev / WMean,
+ RVarCoff = 100 * RStddev / RMean,
+ WSum = lists:sum(Wallclock),
+ RSum = lists:sum(RunTime),
+ [{wallclock,[{min, WMin},
+ {max, WMax},
+ {mean, WMean},
+ {median, WMedian},
+ {variance, WVariance},
+ {stdev, WStddev},
+ {varcoff, WVarCoff},
+ {sum, WSum},
+ {values, Wallclock}]},
+ {runtime,[{min, RMin},
+ {max, RMax},
+ {mean, RMean},
+ {median, RMedian},
+ {variance, RVariance},
+ {stdev, RStddev},
+ {varcoff, RVarCoff},
+ {sum, RSum},
+ {values, RunTime}]},
+ {iterations, Iterations},
+ {result, R}].
+
+split(M) ->
+ split(M, [], []).
+
+split([{W,R}|More], AccW, AccR) ->
+ split(More, [W|AccW], [R|AccR]);
+split([], AccW, AccR) ->
+ {AccW, AccR}.
+
+mean(L) ->
+ mean(L, 0, 0).
+
+mean([V|Vs], No, Sum) ->
+ mean(Vs, No+1, Sum+V);
+mean([], No, Sum) when No > 0 ->
+ Sum/No;
+mean([], _No, _Sum) ->
+ exit(empty_list).
+
+median(L) ->
+ S = length(L),
+ SL = lists:sort(L),
+ case even(S) of
+ true ->
+ (lists:nth((S div 2), SL) + lists:nth((S div 2) + 1, SL)) / 2;
+ false ->
+ lists:nth((S div 2), SL)
+ end.
+
+even(S) ->
+ (S band 1) =:= 0.
+
+%% diffs(L, V) ->
+%% [X - V || X <- L].
+
+square_diffs(L, V) ->
+ [(X - V) * (X - V) || X <- L].
+
+variance(L) ->
+ Mean = mean(L),
+ N = length(L),
+ if N > 1 ->
+ lists:sum(square_diffs(L,Mean)) / (N-1);
+ true -> exit('too few values')
+ end.
+
+stddev(L) ->
+ math:sqrt(variance(L)).
diff --git a/lib/hipe/tools/hipe_tool.erl b/lib/hipe/tools/hipe_tool.erl
new file mode 100644
index 0000000000..ae1cad06cc
--- /dev/null
+++ b/lib/hipe/tools/hipe_tool.erl
@@ -0,0 +1,513 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2002 by Erik Johansson.
+%% ====================================================================
+%% Module : hipe_tool
+%% Purpose :
+%% Notes :
+%% History : * 2002-03-13 Erik Johansson (happi@it.uu.se): Created.
+%% ====================================================================
+%% Exports :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_tool).
+
+-export([start/0]).
+
+%%---------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+
+%%---------------------------------------------------------------------
+
+-define(WINDOW_WIDTH, 920).
+-define(WINDOW_HEIGHT, 460).
+-define(DEFAULT_BG_COLOR, {217,217,217}).
+-define(POLL_INTERVAL, 5000).
+-define(FONT, {screen, 12}).
+-define(HEADER_FONT, {screen, [bold], 12}).
+-define(NORMAL_FG_COLOR, {0,0,0}).
+
+%%---------------------------------------------------------------------
+
+-type fa() :: {atom(), arity()}. % {Fun,Arity}
+-type fa_address() :: {atom(), arity(), non_neg_integer()}. % {F,A,Address}
+
+%%---------------------------------------------------------------------
+
+-record(state, {win_created = false :: boolean(),
+ mindex = 0 :: integer(),
+ mod :: module(),
+ funs = [] :: [fa()],
+ mods = [] :: [module()],
+ options = [o2] :: comp_options(),
+ compiling = false :: 'false' | pid()
+ }).
+
+%%---------------------------------------------------------------------
+
+-spec start() -> pid().
+
+start() ->
+ spawn(fun () -> init() end).
+
+init() ->
+ process_flag(trap_exit, true),
+ gs:start(),
+ S = init_window(#state{}),
+ loop(S).
+
+-spec loop(#state{}) -> no_return().
+
+loop(State) ->
+ receive
+ {gs, code_listbox, click, Data, [Idx, Txt | _]} ->
+ NewState = update_module_box(State,Idx,Data,Txt),
+ loop(NewState);
+ {gs, module_listbox, click, Data, [Idx, _Txt | _]} ->
+ NewState = update_fun(State,Idx,Data),
+ loop(NewState);
+ {gs, compmod, click, _, _} ->
+ loop(compile(State));
+ {gs, prof, click, [], ["Turn off\nProfiling"]} ->
+ hipe_profile:prof_module_off(State#state.mod),
+ loop(update_module_box(State,State#state.mindex,State#state.mods,""));
+ {gs, prof, click, [], _} ->
+ hipe_profile:prof_module(State#state.mod),
+ loop(update_module_box(State,State#state.mindex,State#state.mods,""));
+ {gs, win, configure, _, _} ->
+ gs:config(win, [{width, ?WINDOW_WIDTH}, {height, ?WINDOW_HEIGHT}]),
+ loop(State);
+
+ show_window when State#state.win_created =:= true ->
+ gs:config(win, [raise]),
+ loop(State);
+ show_window when State#state.win_created =:= false ->
+ loop((init_window(State))#state{win_created = true});
+
+ {gs, _Id, click, close_menu, _Args} ->
+ gs:destroy(win),
+ loop(State#state{win_created = false});
+ {gs, _Id, keypress, _Data, [c, _, 0, 1 | _]} ->
+ gs:destroy(win),
+ loop(State#state{win_created = false});
+ {gs, _Id, keypress, _Data, ['C', _, 1, 1 | _]} ->
+ gs:destroy(win),
+ loop(State#state{win_created = false});
+ {gs, _Id, keypress, _Data, _Args} ->
+ loop(State);
+ {gs, _, destroy, _, _} ->
+ loop(State#state{win_created = false});
+
+ {compilation_done, _Res, Sender} ->
+ case State#state.compiling of
+ Sender ->
+ catch gs:config(compmod, [{enable, true}]),
+ update_text(compiling, ""),
+ loop(update_module_box(State,
+ State#state.mindex,
+ State#state.mods, ""));
+ _ ->
+ loop(State)
+ end;
+
+ {'EXIT', _Pid, _Reason} ->
+ exit(normal);
+ _Other ->
+ io:format("HiPE window received message ~p ~n", [_Other]),
+ loop(State)
+ after
+ ?POLL_INTERVAL ->
+ loop(update_code_listbox(State))
+ end.
+
+-spec init_window(#state{}) -> #state{}.
+
+init_window(State) ->
+ create_window(State),
+ gs:config(win, [{map,true}]),
+ update_code_listbox(State#state{win_created = true}).
+
+-spec create_window(#state{}) -> 'ok'.
+
+create_window(State) ->
+ gs:window(win, gs:start(), [{width, ?WINDOW_WIDTH},
+ {height, ?WINDOW_HEIGHT},
+ {bg, ?DEFAULT_BG_COLOR},
+ {title, "[HiPE] Code list"},
+ {configure, true},
+ {destroy, true},
+ {cursor, arrow},
+ {keypress, true}
+ ]),
+ create_menu(),
+ Xpos = 4,
+ Ypos1 = 60,
+ Width = (?WINDOW_WIDTH - (Xpos*4)) div 3,
+ create_labels([{mods,Ypos1-20,"Loaded Modules"}], Xpos + 1 + 3),
+ Xpos2 = Xpos*2+Width,
+ create_labels([{mod,Ypos1-20,"Module:"++atom_to_list(State#state.mod)},
+ {ver,Ypos1,""},
+ {time,Ypos1+20,""},
+ {native,Ypos1+40,""},
+ {compiling,Ypos1+60,""}], Xpos2),
+ create_labels([{function,Ypos1-20,"Function:"},
+ {nativefun,Ypos1,""}], Xpos*3+Width*2),
+ Ypos = 240,
+ Height1 = ?WINDOW_HEIGHT - Ypos1 - Xpos,
+ Height = ?WINDOW_HEIGHT - Ypos - Xpos,
+ gs:listbox(code_listbox, win, [{x, Xpos},
+ {y, Ypos1},
+ {width, Width},
+ {height, Height1},
+ {bg, {255,255,255}},
+ {vscroll, right},
+ {hscroll, true},
+ {click, true}]),
+ gs:listbox(module_listbox, win, [{x, Xpos*2+Width},
+ {y, Ypos},
+ {width, Width},
+ {height, Height},
+ {bg, {255,255,255}},
+ {vscroll, right},
+ {hscroll, true},
+ {click, true}]),
+ gs:listbox(profile_listbox, win, [{x, Xpos*3+Width*2},
+ {y, Ypos1+40},
+ {width, Width},
+ {height, Height-60},
+ {bg, {255,255,255}},
+ {vscroll, right},
+ {hscroll, true},
+ {click, true}]),
+ gs:button(compmod,win,[{label,{text,"Compile\nModule"}},
+ {justify,center},
+ {x,Xpos*2+Width*1},
+ {height,60},
+ {y,Ypos-80}]),
+ gs:button(prof,win,[{label,{text,"Profile\nModule"}},
+ {justify,center},
+ {x,Xpos*2+Width*1+100},
+ {height,60},
+ {y,Ypos-80}]),
+ gs:button(clearprof,win,[{label, {text,"Clear\nProfile"}},
+ {justify, center},
+ {x, Xpos*2+Width*1+200},
+ {height, 60},
+ {y, Ypos-80}]),
+ gs:editor(edoc,win,[{x, Xpos*3+Width*2}, {y, Ypos},
+ {width, Width}, {height, Height},
+ {insert, {'end',"Edit this text!"}},
+ {vscroll, right},
+ {hscroll, true},
+ {wrap, none}]),
+ ok.
+
+-spec create_menu() -> 'ok'.
+
+create_menu() ->
+ gs:menubar(menubar, win, [{bg, ?DEFAULT_BG_COLOR}]),
+ create_sub_menus([{mbutt, fmenu, " File",
+ [{" Close Ctrl-C ",close_menu}]},
+ {mbuttc,cmenu, " Compile ",
+ [{" Compile Module", comp_mod}]},
+ {mbuttp,pmenu, " Profile ",
+ [{" Profile Module", prof_mod}]},
+ {mbutte,emenu, " Edoc", [separator]},
+ {mbutta,amenu, " Analyze ", [separator]},
+ {mbuttb,bmenu, " Benchmark ", [separator]},
+ {mbuttj,jmenu, " Jit ", [separator]}]),
+ ok.
+
+create_menuitems(Parent, [{Text,Data}|Rest]) ->
+ gs:menuitem(Parent, [{bg, ?DEFAULT_BG_COLOR},
+ {fg, {178, 34, 34}},
+ {label, {text, Text}},
+ {data, Data},
+ {underline, 1}
+ ]),
+ create_menuitems(Parent, Rest);
+create_menuitems(Parent, [separator|Rest]) ->
+ gs:menuitem(Parent, [{itemtype, separator}]),
+ create_menuitems(Parent, Rest);
+create_menuitems(_, []) -> ok.
+
+create_sub_menus([{Parent, Name, Text, Items}|Rest]) ->
+ BG = {bg, ?DEFAULT_BG_COLOR},
+ FG = {fg, {178, 34, 34}}, % firebrick
+ Label = {label, {text, Text}},
+ gs:menubutton(Parent, menubar, [BG, FG, Label, {underline, 1}]),
+ gs:menu(Name, Parent, [BG, FG]),
+ create_menuitems(Name, Items),
+ create_sub_menus(Rest);
+create_sub_menus([]) -> ok.
+
+create_labels([{Name,Y,Text}|Rest], Xpos) ->
+ gs:label(Name, win, [{width, (?WINDOW_WIDTH - 16) div 3},
+ {height, 20},
+ {x, Xpos + 1 + 3},
+ {y, Y},
+ {bg, ?DEFAULT_BG_COLOR},
+ {fg, ?NORMAL_FG_COLOR},
+ {font, ?HEADER_FONT},
+ {align, w},
+ {label, {text, Text}}
+ ]),
+ create_labels(Rest,Xpos);
+create_labels([],_) -> ok.
+
+-spec update_code_listbox(#state{}) -> #state{}.
+
+update_code_listbox(State) ->
+ Mods = lists:sort(mods()),
+ case State#state.win_created of
+ false ->
+ State;
+ true ->
+ case Mods =:= State#state.mods of
+ true -> State;
+ false ->
+ update_text(mods,
+ "Loaded Modules ("++
+ integer_to_list(length(Mods))++")"),
+ catch gs:config(code_listbox, [{data, Mods},
+ {items, Mods},
+ {selection, 0}
+ ]),
+ update_module_box(State#state{mods = Mods}, 0, Mods, "")
+ end
+ end.
+
+-spec update_fun(#state{}, integer(), [mfa()]) -> #state{}.
+
+update_fun(State, Idx, Data) ->
+ case State#state.win_created of
+ false ->
+ State;
+ true ->
+ MFA = {M,F,A} = get_selection(Idx, Data, {?MODULE,start,0}),
+ update_text(function, "Function: "++mfa_to_string(MFA)),
+ case in_native(F, A, native_code(M)) of
+ true -> update_text(nativefun, "Native");
+ false -> update_text(nativefun, "Emulated")
+ end,
+ State
+ end.
+
+get_selection(Idx, Data, Default) ->
+ try lists:nth(Idx+1, Data) catch _:_ -> Default end.
+
+-spec update_module_box(#state{}, integer(), [atom()], string()) -> #state{}.
+
+update_module_box(State, Idx, Data, _Txt) ->
+ case State#state.win_created of
+ false ->
+ State;
+ true ->
+ Mod = get_selection(Idx, Data, hipe_tool),
+ %% io:format("~w\n", [Mod:module_info()]),
+ Info = Mod:module_info(),
+ Funs = lists:usort(funs(Mod)),
+ MFAs = mfas(Mod, Funs),
+ ModText = atom_to_list(Mod),
+ update_text(mod, "Module:"++ModText),
+ update_text(compmod, "Compile\nModule\n"++ModText),
+ Options = get_compile(Info),
+ update_text(ver, get_version(Options)),
+ update_text(time, get_time(Options)),
+ NativeCode = native_code(Mod),
+
+ Prof = is_profiled(Mod),
+ if Prof -> update_text(prof, "Turn off\nProfiling");
+ true -> update_text(prof, "Profile\n"++ModText)
+ end,
+
+ Mode = get_mode(Funs, NativeCode),
+
+ update_text(native, Mode),
+ Items = fun_names(Mod, Funs, NativeCode, Prof),
+
+ Selection = {selection, 0},
+ catch gs:config(module_listbox, [{data, MFAs},
+ {items, Items},
+ Selection]),
+ ProfData = [mfa_to_string(element(1, X)) ++ " " ++
+ integer_to_list(element(2,X))
+ || X <- hipe_profile:res(), element(2, X) > 0],
+ catch gs:config(profile_listbox, [{data, ProfData},
+ {items, ProfData},
+ Selection]),
+ get_edoc(Mod),
+ update_fun(State#state{mindex = Idx, mod = Mod, funs = Funs}, 0, MFAs)
+ end.
+
+update_text(Lab, Text) ->
+ catch gs:config(Lab, [{label, {text, Text}}]).
+
+%%---------------------------------------------------------------------
+%% @doc Returns a list of all loaded modules.
+%%---------------------------------------------------------------------
+
+-spec mods() -> [module()].
+
+mods() ->
+ [Mod || {Mod,_File} <- code:all_loaded()].
+
+-spec funs(module()) -> [fa()].
+
+funs(Mod) ->
+ Mod:module_info(functions).
+
+-spec native_code(module()) -> [fa_address()].
+
+native_code(Mod) ->
+ Mod:module_info(native_addresses).
+
+-spec mfas(module(), [fa()]) -> [mfa()].
+
+mfas(Mod, Funs) ->
+ [{Mod,F,A} || {F,A} <- Funs].
+
+-spec fun_names(module(), [fa()], [fa_address()], boolean()) -> string().
+
+fun_names(M, Funs, NativeCode, Prof) ->
+ [list_to_atom(atom_to_list(F) ++ "/" ++ integer_to_list(A) ++
+ (case in_native(F, A, NativeCode) of
+ true -> " [native] ";
+ false -> ""
+ end)
+ ++
+ if Prof ->
+ (catch integer_to_list(hipe_bifs:call_count_get({M,F,A})));
+ true -> ""
+ end) ||
+ {F,A} <- Funs].
+
+-spec in_native(atom(), arity(), [fa_address()]) -> boolean().
+
+in_native(F, A, NativeCode) ->
+ lists:any(fun({Fun,Arity,_}) ->
+ (Fun =:= F andalso Arity =:= A)
+ end,
+ NativeCode).
+
+-spec mfa_to_string(mfa()) -> [char(),...].
+
+mfa_to_string({M,F,A}) ->
+ atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A).
+
+get_mode(Funs, NativeCode) ->
+ case NativeCode of
+ [] -> "Emulated";
+ InNative when is_list(InNative) ->
+ if length(InNative) =:= length(Funs) ->
+ "Native";
+ true -> "Mixed"
+ end
+ end.
+
+get_time(Comp) ->
+ case lists:keyfind(time, 1, Comp) of
+ {_, {Y,Month,D,H,Min,S}} ->
+ integer_to_list(Y) ++
+ "-" ++ integer_to_list(Month) ++
+ "-" ++ integer_to_list(D) ++ " " ++
+ integer_to_list(H) ++ ":" ++ integer_to_list(Min) ++
+ ":" ++ integer_to_list(S);
+ false -> ""
+ end.
+
+get_version(Comp) ->
+ case lists:keyfind(version, 1, Comp) of
+ {_, V} when is_list(V) -> V;
+ false -> ""
+ end.
+
+get_cwd(Options) ->
+ case lists:keyfind(cwd, 1, Options) of
+ {_, V} when is_atom(V) -> atom_to_list(V);
+ {_, V} -> V;
+ false -> ""
+ end.
+
+get_options(Comp) ->
+ case lists:keyfind(options, 1, Comp) of
+ {_, V} when is_list(V) -> V;
+ false -> ""
+ end.
+
+get_compile(Info) ->
+ case lists:keyfind(compile, 1, Info) of
+ {_, O} when is_list(O) -> O;
+ false -> []
+ end.
+
+-spec is_profiled(module()) -> boolean().
+
+is_profiled(Mod) ->
+ case hipe_bifs:call_count_get({Mod,module_info,0}) of
+ false -> false;
+ C when is_integer(C) -> true
+ end.
+
+-spec compile(#state{}) -> #state{}.
+
+compile(State) ->
+ catch gs:config(compmod, [{enable, false}]),
+ update_text(compiling, "Compiling..."),
+ Parent = self(),
+ P = spawn(fun() -> c(Parent, State#state.mod, State#state.options) end),
+ State#state{compiling = P}.
+
+-spec c(pid(), module(), comp_options()) -> 'ok'.
+
+c(Parent, Mod, Options) ->
+ Res = hipe:c(Mod, Options),
+ Parent ! {compilation_done,Res,self()},
+ ok.
+
+get_edoc(Mod) ->
+ Info = Mod:module_info(),
+ Comp = get_compile(Info),
+ Options = get_options(Comp),
+ Dir = get_cwd(Options),
+ File =
+ case Dir of
+ "" -> atom_to_list(Mod) ++ ".erl";
+ _ -> Dir ++"/" ++ atom_to_list(Mod) ++ ".erl"
+ end,
+ %% io:format("Get ~s\n", [File]),
+ Text = try edoc(File, [{xml_export,xmerl_text}, no_output])
+ catch _:_ -> "error"
+ end,
+ gs:config(edoc, {enable, true}),
+ gs:config(edoc, clear),
+ gs:config(edoc, {insert, {insert, Text}}),
+ gs:config(edoc, {enable, false}),
+ ok.
+
+edoc(Name, Opts) ->
+ Doc = edoc:get_doc([Name, Opts]),
+ %% Comments = edoc:read_comments(Name, Opts),
+ %% Text = edoc:forms(Forms, Comments, Name, Opts),
+ edoc:layout([Doc, Opts]),
+ ok.
diff --git a/lib/hipe/util/Makefile b/lib/hipe/util/Makefile
new file mode 100644
index 0000000000..27cacedf11
--- /dev/null
+++ b/lib/hipe/util/Makefile
@@ -0,0 +1,109 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+ifdef HIPE_ENABLED
+HIPE_MODULES = hipe_vectors
+else
+HIPE_MODULES =
+endif
+MODULES = hipe_timing hipe_dot hipe_digraph $(HIPE_MODULES)
+
+HRL_FILES=
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/util
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/util
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+
+$(EBIN)/hipe_timing.beam: ../main/hipe.hrl
+$(EBIN)/hipe_vectors.beam: hipe_vectors.hrl
diff --git a/lib/hipe/util/hipe_digraph.erl b/lib/hipe/util/hipe_digraph.erl
new file mode 100644
index 0000000000..a62e913fe5
--- /dev/null
+++ b/lib/hipe/util/hipe_digraph.erl
@@ -0,0 +1,238 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------
+%% File : hipe_digraph.erl
+%% Author : Tobias Lindahl <tobiasl@it.uu.se>
+%% Purpose : Provides a simple implementation of a directed graph.
+%%
+%% Created : 9 Feb 2005 by Tobias Lindahl <tobiasl@it.uu.se>
+%%-----------------------------------------------------------------------
+-module(hipe_digraph).
+
+-export([new/0, add_edge/3, add_node/2, add_node_list/2,
+ from_list/1, to_list/1, get_parents/2, get_children/2]).
+-export([reverse_preorder_sccs/1]).
+
+%%------------------------------------------------------------------------
+
+-type ordset(T) :: [T]. % XXX: temporarily
+
+-record(hipe_digraph, {edges = dict:new() :: dict(),
+ rev_edges = dict:new() :: dict(),
+ leaves = ordsets:new() :: ordset(_), % ???
+ nodes = sets:new() :: set()}).
+
+-opaque hdg() :: #hipe_digraph{}.
+
+%%------------------------------------------------------------------------
+
+-spec new() -> hdg().
+
+new() ->
+ #hipe_digraph{edges = dict:new(), rev_edges = dict:new(),
+ leaves = ordsets:new(), nodes = sets:new()}.
+
+-spec from_list([_]) -> hdg().
+
+from_list(List) ->
+ Edges = lists:foldl(fun({From, To}, Dict) ->
+ Fun = fun(Set) -> ordsets:add_element(To, Set) end,
+ dict:update(From, Fun, [To], Dict)
+ end,
+ dict:new(), List),
+ RevEdges = lists:foldl(fun({From, To}, Dict) ->
+ Fun = fun(Set) ->
+ ordsets:add_element(From, Set)
+ end,
+ dict:update(To, Fun, [From], Dict)
+ end,
+ dict:new(), List),
+ Keys1 = sets:from_list(dict:fetch_keys(Edges)),
+ Keys2 = sets:from_list(dict:fetch_keys(RevEdges)),
+ Nodes = sets:union(Keys1, Keys2),
+ #hipe_digraph{edges = Edges, rev_edges = RevEdges,
+ leaves = [], nodes = Nodes}.
+
+-spec to_list(hdg()) -> [_].
+
+to_list(#hipe_digraph{edges = Edges}) ->
+ List1 = dict:to_list(Edges),
+ List2 = lists:foldl(fun({From, ToList}, Acc) ->
+ [[{From, To} || To <- ToList]|Acc]
+ end, [], List1),
+ lists:flatten(List2).
+
+-spec add_node(_, hdg()) -> hdg().
+
+add_node(NewNode, DG = #hipe_digraph{nodes=Nodes}) ->
+ DG#hipe_digraph{nodes = sets:add_element(NewNode, Nodes)}.
+
+-spec add_node_list([_], hdg()) -> hdg().
+
+add_node_list(NewNodes, DG = #hipe_digraph{nodes=Nodes}) ->
+ Set = sets:from_list(NewNodes),
+ DG#hipe_digraph{nodes = sets:union(Set, Nodes)}.
+
+-spec add_edge(_, _, hdg()) -> hdg().
+
+add_edge(From, To, #hipe_digraph{edges = Edges, rev_edges = RevEdges,
+ leaves = Leaves, nodes = Nodes}) ->
+ Fun1 = fun(Set) -> ordsets:add_element(To, Set) end,
+ NewEdges = dict:update(From, Fun1, [To], Edges),
+ Fun2 = fun(Set) -> ordsets:add_element(From, Set) end,
+ NewRevEdges = dict:update(To, Fun2, [From], RevEdges),
+ NewLeaves = ordsets:del_element(From, Leaves),
+ #hipe_digraph{edges = NewEdges,
+ rev_edges = NewRevEdges,
+ leaves = NewLeaves,
+ nodes = sets:add_element(From, sets:add_element(To, Nodes))}.
+
+%%-------------------------------------------------------------------------
+
+-spec take_indep_scc(hdg()) -> 'none' | {'ok', [_], hdg()}.
+
+take_indep_scc(DG = #hipe_digraph{edges = Edges, rev_edges = RevEdges,
+ leaves = Leaves, nodes = Nodes}) ->
+ case sets:size(Nodes) =:= 0 of
+ true -> none;
+ false ->
+ {SCC, NewLeaves} =
+ case Leaves of
+ [H|T] ->
+ {[H], T};
+ [] ->
+ case find_all_leaves(Edges) of
+ [] ->
+ {[Node|_], _} = dfs(Nodes, RevEdges),
+ {SCC1, _} = dfs(Node, Edges),
+ {SCC1, []};
+ [H|T] ->
+ {[H], T}
+ end
+ end,
+ NewEdges = remove_edges(SCC, Edges, RevEdges),
+ NewRevEdges = remove_edges(SCC, RevEdges, Edges),
+ NewNodes = sets:subtract(Nodes, sets:from_list(SCC)),
+ {ok, reverse_preorder(SCC, Edges),
+ DG#hipe_digraph{edges = NewEdges, rev_edges = NewRevEdges,
+ leaves = NewLeaves, nodes = NewNodes}}
+ end.
+
+find_all_leaves(Edges) ->
+ List = dict:fold(fun(Key, [Key], Acc) -> [Key|Acc];
+ (_, _, Acc) -> Acc
+ end, [], Edges),
+ ordsets:from_list(List).
+
+remove_edges(Nodes0, Edges, RevEdges) ->
+ Nodes = ordsets:from_list(Nodes0),
+ Fun = fun(N, Dict) -> dict:erase(N, Dict) end,
+ Edges1 = lists:foldl(Fun, Edges, Nodes),
+ remove_edges_in(Nodes, Edges1, RevEdges).
+
+remove_edges_in([Node|Nodes], Edges, RevEdges) ->
+ NewEdges =
+ case dict:find(Node, RevEdges) of
+ error ->
+ Edges;
+ {ok, Set} ->
+ Fun = fun(Key, Dict) ->
+ case dict:find(Key, Dict) of
+ error ->
+ Dict;
+ {ok, OldTo} ->
+ case ordsets:del_element(Node, OldTo) of
+ [] -> dict:store(Key, [Key], Dict);
+ NewSet -> dict:store(Key, NewSet, Dict)
+ end
+ end
+ end,
+ lists:foldl(Fun, Edges, Set)
+ end,
+ remove_edges_in(Nodes, NewEdges, RevEdges);
+remove_edges_in([], Edges, _RevEdges) ->
+ Edges.
+
+reverse_preorder([_] = Nodes, _Edges) ->
+ Nodes;
+reverse_preorder([N|_] = Nodes, Edges) ->
+ NodeSet = sets:from_list(Nodes),
+ {PreOrder, _} = dfs(N, Edges),
+ DFS = [X || X <- PreOrder, sets:is_element(X, NodeSet)],
+ lists:reverse(DFS).
+
+%%---------------------------------------------------------------------
+
+-spec reverse_preorder_sccs(hdg()) -> [[_]].
+
+reverse_preorder_sccs(DG) ->
+ reverse_preorder_sccs(DG, []).
+
+reverse_preorder_sccs(DG, Acc) ->
+ case take_indep_scc(DG) of
+ none -> lists:reverse(Acc);
+ {ok, SCC, DG1} -> reverse_preorder_sccs(DG1, [SCC|Acc])
+ end.
+
+%%---------------------------------------------------------------------
+
+-spec get_parents(_, hdg()) -> [_].
+
+get_parents(Node, #hipe_digraph{rev_edges = RevEdges}) ->
+ case dict:is_key(Node, RevEdges) of
+ true -> dict:fetch(Node, RevEdges);
+ false -> []
+ end.
+
+-spec get_children(_, hdg()) -> [_].
+
+get_children(Node, #hipe_digraph{edges = Edges}) ->
+ case dict:is_key(Node, Edges) of
+ true -> dict:fetch(Node, Edges);
+ false -> []
+ end.
+
+%%---------------------------------------------------------------------
+%% dfs/2 returns a preordered depth first search and the nodes visited.
+
+dfs(Node, Edges) ->
+ case sets:is_set(Node) of
+ true ->
+ dfs(sets:to_list(Node), Edges, sets:new(), []);
+ false ->
+ dfs([Node], Edges, sets:new(), [])
+ end.
+
+dfs([Node|Left], Edges, Visited, Order) ->
+ case sets:is_element(Node, Visited) of
+ true ->
+ dfs(Left, Edges, Visited, Order);
+ false ->
+ NewVisited = sets:add_element(Node, Visited),
+ case dict:find(Node, Edges) of
+ error ->
+ dfs(Left, Edges, NewVisited, [Node|Order]);
+ {ok, Succ} ->
+ {NewOrder, NewVisited1} = dfs(Succ, Edges, NewVisited, Order),
+ dfs(Left, Edges, NewVisited1, [Node|NewOrder])
+ end
+ end;
+dfs([], _Edges, Visited, Order) ->
+ {Order, Visited}.
diff --git a/lib/hipe/util/hipe_dot.erl b/lib/hipe/util/hipe_dot.erl
new file mode 100755
index 0000000000..d6ef801c88
--- /dev/null
+++ b/lib/hipe/util/hipe_dot.erl
@@ -0,0 +1,217 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%-------------------------------------------------------------------
+%%% File : hipe_dot.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 25 Nov 2004 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+
+-module(hipe_dot).
+
+-export([translate_digraph/3, translate_digraph/5,
+ translate_list/3, translate_list/4, translate_list/5]).
+
+%%--------------------------------------------------------------------
+
+-type gnode() :: any().
+-type edge() :: {gnode(), gnode()}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% This module creates .dot representations of graphs from their
+%% Erlang representations. There are two different forms of Erlang
+%% representations that the module accepts, digraphs and lists of two
+%% tuples (where each tuple represents a directed edge).
+%%
+%% The functions also require a FileName and a name of the graph. The
+%% filename is the name of the resulting .dot file the GraphName is
+%% pretty much useless.
+%%
+%% The resulting .dot reprsentation will be stored in the flie FileName.
+%%
+%% Interfaces:
+%%
+%% translate_list(Graph::[{Node,Node}], FileName::string(),
+%% GraphName::string()) -> ok
+%%
+%% translate_list(Graph::[{Node,Node}], FileName::string(),
+%% GraphName::string(), Options::[option] ) -> ok
+%%
+%% translate_list(Graph::[{Node,Node}], FileName::string(),
+%% GraphName::string(), Fun::fun(term() -> string()),
+%% Options::[option]) -> ok
+%%
+%% The optional Fun argument dictates how the node/names should be output.
+%%
+%% The option list can be used to pass options to .dot to decide how
+%% different nodes and edges should be displayed.
+%%
+%% translate_digraph has the same interface as translate_list except
+%% it takes a digraph rather than a list.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec translate_digraph(digraph(), string(), string()) -> 'ok'.
+
+translate_digraph(G, FileName, GName) ->
+ translate_digraph(G, FileName, GName,
+ fun(X) -> io_lib:format("~p", [X]) end, []).
+
+-spec translate_digraph(digraph(), string(), string(),
+ fun((_) -> string()), [_]) -> 'ok'.
+
+translate_digraph(G, FileName, GName, Fun, Opts) ->
+ Edges = [digraph:edge(G, X) || X <- digraph:edges(G)],
+ EdgeList = [{X, Y} || {_, X, Y, _} <- Edges],
+ translate_list(EdgeList, FileName, GName, Fun, Opts).
+
+%%--------------------------------------------------------------------
+
+-spec translate_list([edge()], string(), string()) -> 'ok'.
+
+translate_list(List, FileName, GName) ->
+ translate_list(List, FileName, GName,
+ fun(X) -> lists:flatten(io_lib:format("~p", [X])) end, []).
+
+-spec translate_list([edge()], string(), string(), [_]) -> 'ok'.
+
+translate_list(List, FileName, GName, Opts) ->
+ translate_list(List, FileName, GName,
+ fun(X) -> lists:flatten(io_lib:format("~p", [X])) end, Opts).
+
+-spec translate_list([edge()], string(), string(),
+ fun((_) -> string()), [_]) -> 'ok'.
+
+translate_list(List, FileName, GName, Fun, Opts) ->
+ {NodeList1, NodeList2} = lists:unzip(List),
+ NodeList = NodeList1 ++ NodeList2,
+ NodeSet = ordsets:from_list(NodeList),
+ Start = ["digraph ",GName ," {"],
+ VertexList = [node_format(Opts, Fun, V) ||V <- NodeSet],
+ End = ["graph [", GName, "=", GName, "]}"],
+ EdgeList = [edge_format(Opts, Fun, X, Y) || {X,Y} <- List],
+ String = [Start, VertexList, EdgeList, End],
+ %% io:format("~p~n", [lists:flatten([String])]),
+ ok = file:write_file(FileName, list_to_binary(String)).
+
+%%--------------------------------------------------------------------
+
+node_format(Opt, Fun, V) ->
+ OptText = nodeoptions(Opt, Fun ,V),
+ Tmp = io_lib:format("~p", [Fun(V)]),
+ String = lists:flatten(Tmp),
+ %% io:format("~p", [String]),
+ {Width, Heigth} = calc_dim(String),
+ W = ((Width div 7) + 1) * 0.55,
+ H = Heigth * 0.4,
+ SL = io_lib:format("~f", [W]),
+ SH = io_lib:format("~f", [H]),
+ [String, " [width=", SL, " heigth=", SH, " ", OptText,"];\n"].
+
+edge_format(Opt, Fun, V1, V2) ->
+ OptText =
+ case lists:flatten(edgeoptions(Opt, Fun ,V1, V2)) of
+ [] ->
+ [];
+ [_|X] ->
+ X
+ end,
+ String = [io_lib:format("~p", [Fun(V1)]), " -> ",
+ io_lib:format("~p", [Fun(V2)])],
+ [String, " [", OptText, "];\n"].
+
+calc_dim(String) ->
+ calc_dim(String, 1, 0, 0).
+
+calc_dim("\\n" ++ T, H, TmpW, MaxW) ->
+ calc_dim(T, H+1, 0, erlang:max(TmpW, MaxW));
+calc_dim([_|T], H, TmpW, MaxW) ->
+ calc_dim(T, H, TmpW+1, MaxW);
+calc_dim([], H, TmpW, MaxW) ->
+ {erlang:max(TmpW, MaxW), H}.
+
+edgeoptions([{all_edges, {OptName, OptVal}}|T], Fun, V1, V2) ->
+ case legal_edgeoption(OptName) of
+ true ->
+ [io_lib:format(",~p=~p ", [OptName, OptVal])|edgeoptions(T, Fun, V1, V2)]
+ %% false ->
+ %% edgeoptions(T, Fun, V1, V2)
+ end;
+edgeoptions([{N1, N2, {OptName, OptVal}}|T], Fun, V1, V2) ->
+ case %% legal_edgeoption(OptName) andalso
+ Fun(N1) =:= Fun(V1) andalso Fun(N2) =:= Fun(V2) of
+ true ->
+ [io_lib:format(",~p=~p ", [OptName, OptVal])|edgeoptions(T, Fun, V1, V2)];
+ false ->
+ edgeoptions(T, Fun, V1, V2)
+ end;
+edgeoptions([_|T], Fun, V1, V2) ->
+ edgeoptions(T, Fun, V1, V2);
+edgeoptions([], _, _, _) ->
+ [].
+
+nodeoptions([{all_nodes, {OptName, OptVal}}|T], Fun, V) ->
+ case legal_nodeoption(OptName) of
+ true ->
+ [io_lib:format(",~p=~p ", [OptName, OptVal])|nodeoptions(T, Fun, V)];
+ false ->
+ nodeoptions(T, Fun, V)
+ end;
+nodeoptions([{Node, {OptName, OptVal}}|T], Fun, V) ->
+ case Fun(Node) =:= Fun(V) andalso legal_nodeoption(OptName) of
+ true ->
+ [io_lib:format("~p=~p ", [OptName, OptVal])|nodeoptions(T, Fun, V)];
+ false ->
+ nodeoptions(T, Fun, V)
+ end;
+nodeoptions([_|T], Fun, V) ->
+ nodeoptions(T, Fun, V);
+nodeoptions([], _Fun, _V) ->
+ [].
+
+legal_nodeoption(bottomlabel) -> true;
+legal_nodeoption(color) -> true;
+legal_nodeoption(comment) -> true;
+legal_nodeoption(distortion) -> true;
+legal_nodeoption(fillcolor) -> true;
+legal_nodeoption(fixedsize) -> true;
+legal_nodeoption(fontcolor) -> true;
+legal_nodeoption(fontname) -> true;
+legal_nodeoption(fontsize) -> true;
+legal_nodeoption(group) -> true;
+legal_nodeoption(height) -> true;
+legal_nodeoption(label) -> true;
+legal_nodeoption(layer) -> true;
+legal_nodeoption(orientation) -> true;
+legal_nodeoption(peripheries) -> true;
+legal_nodeoption(regular) -> true;
+legal_nodeoption(shape) -> true;
+legal_nodeoption(shapefile) -> true;
+legal_nodeoption(sides) -> true;
+legal_nodeoption(skew) -> true;
+legal_nodeoption(style) -> true;
+legal_nodeoption(toplabel) -> true;
+legal_nodeoption('URL') -> true;
+legal_nodeoption(z) -> true;
+legal_nodeoption(Option) when is_atom(Option) -> false.
+
+legal_edgeoption(Option) when is_atom(Option) -> true.
diff --git a/lib/hipe/util/hipe_timing.erl b/lib/hipe/util/hipe_timing.erl
new file mode 100644
index 0000000000..191db497e2
--- /dev/null
+++ b/lib/hipe/util/hipe_timing.erl
@@ -0,0 +1,131 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%====================================================================
+%% Note: Uses the process keys:
+%% hipe_time - Indicates what to time.
+%% hipe_timers - A stack of timers.
+%% {hipe_timer,T} - Delata times for named timers.
+%% T - Acc times for all named timers T.
+%%====================================================================
+
+-module(hipe_timing).
+-export([start/2, stop/2,
+ %% start_timer/0, stop_timer/1,
+ %% get_hipe_timer_val/1, set_hipe_timer_val/2,
+ %% start_hipe_timer/1, stop_hipe_timer/1,
+ start_optional_timer/2, stop_optional_timer/2]).
+
+-include("../main/hipe.hrl").
+
+%%=====================================================================
+
+-spec start(string(), atom()) -> 'ok'.
+
+start(Text, Mod) when is_atom(Mod) ->
+ Timers =
+ case get(hipe_timers) of
+ undefined -> [];
+ Ts -> Ts
+ end,
+ Space = [$| || _ <- Timers],
+ Total = start_timer(),
+ put(hipe_timers, [Total|Timers]),
+ ?msg("[@~7w]" ++ Space ++ "> ~s~n", [Total,Text]).
+
+-spec stop(string(), atom()) -> 'ok'.
+
+stop(Text, Mod) when is_atom(Mod) ->
+ {Total,_Last} = erlang:statistics(runtime),
+ case get(hipe_timers) of
+ [StartTime|Timers] ->
+ Space = [$| || _ <- Timers],
+ put(hipe_timers,Timers),
+ ?msg("[@~7w]" ++ Space ++ "< ~s: ~w~n", [Total, Text, Total-StartTime]);
+ _ ->
+ put(hipe_timers, []),
+ ?msg("[@~7w]< ~s: ~w~n", [Total, Text, Total])
+ end.
+
+-spec start_optional_timer(string(), atom()) -> 'ok'.
+
+start_optional_timer(Text, Mod) ->
+ case get(hipe_time) of
+ true -> start(Text, Mod);
+ all -> start(Text, Mod);
+ Mod -> start(Text, Mod);
+ List when is_list(List) ->
+ case lists:member(Mod, List) of
+ true -> start(Text, Mod);
+ false -> ok
+ end;
+ _ -> ok
+ end.
+
+-spec stop_optional_timer(string(), atom()) -> 'ok'.
+
+stop_optional_timer(Text, Mod) ->
+ case get(hipe_time) of
+ true -> stop(Text, Mod);
+ all -> stop(Text, Mod);
+ Mod -> stop(Text, Mod);
+ List when is_list(List) ->
+ case lists:member(Mod, List) of
+ true -> stop(Text, Mod);
+ false -> ok
+ end;
+ _ -> ok
+ end.
+
+-spec start_timer() -> non_neg_integer().
+
+start_timer() ->
+ {Total, _Last} = erlang:statistics(runtime),
+ Total.
+
+%% stop_timer(T) ->
+%% {Total, _Last} = erlang:statistics(runtime),
+%% Total - T.
+%%
+%% start_hipe_timer(Timer) ->
+%% Time = erlang:statistics(runtime),
+%% put({hipe_timer,Timer}, Time).
+%%
+%% stop_hipe_timer(Timer) ->
+%% {T2, _} = erlang:statistics(runtime),
+%% T1 =
+%% case get({hipe_timer,Timer}) of
+%% {T0, _} -> T0;
+%% _ -> 0
+%% end,
+%% AccT =
+%% case get(Timer) of
+%% T when is_integer(T) -> T;
+%% _ -> 0
+%% end,
+%% put(Timer,AccT+T2-T1).
+%%
+%% get_hipe_timer_val(Timer) ->
+%% case get(Timer) of
+%% T when is_integer(T) -> T;
+%% _ -> 0
+%% end.
+%%
+%% set_hipe_timer_val(Timer, Val) ->
+%% put(Timer, Val).
diff --git a/lib/hipe/util/hipe_vectors.erl b/lib/hipe/util/hipe_vectors.erl
new file mode 100644
index 0000000000..d153f3a50d
--- /dev/null
+++ b/lib/hipe/util/hipe_vectors.erl
@@ -0,0 +1,111 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% VECTORS IN ERLANG
+%%
+%% Abstract interface to vectors, indexed from 0 to size-1.
+
+-module(hipe_vectors).
+-export([new/2,
+ set/3,
+ get/2,
+ size/1,
+ vector_to_list/1,
+ %% list_to_vector/1,
+ list/1]).
+
+-include("hipe_vectors.hrl").
+
+%% ---------------------------------------------------------------------
+
+-ifdef(USE_TUPLES).
+
+new(N, V) ->
+ erlang:make_tuple(N, V).
+
+size(V) -> erlang:tuple_size(V).
+
+list(Vec) ->
+ index(tuple_to_list(Vec), 0).
+
+index([X|Xs],N) ->
+ [{N,X} | index(Xs,N+1)];
+index([],_) ->
+ [].
+
+%% list_to_vector(Xs) ->
+%% list_to_tuple(Xs).
+
+vector_to_list(V) ->
+ tuple_to_list(V).
+
+set(Vec, Ix, V) ->
+ setelement(Ix+1, Vec, V).
+
+get(Vec, Ix) -> element(Ix+1, Vec).
+
+-endif. %% ifdef USE_TUPLES
+
+%% ---------------------------------------------------------------------
+
+-ifdef(USE_GBTREES).
+
+-spec new(non_neg_integer(), _) -> hipe_vector().
+new(N, V) when is_integer(N), N >= 0 ->
+ gb_trees:from_orddict(mklist(N, V)).
+
+mklist(N, V) ->
+ mklist(0, N, V).
+
+mklist(M, N, V) when M < N ->
+ [{M, V} | mklist(M+1, N, V)];
+mklist(_, _, _) ->
+ [].
+
+-spec size(hipe_vector()) -> non_neg_integer().
+size(V) -> gb_trees:size(V).
+
+-spec list(hipe_vector()) -> [{_, _}].
+list(Vec) ->
+ gb_trees:to_list(Vec).
+
+%% -spec list_to_vector([_]) -> hipe_vector().
+%% list_to_vector(Xs) ->
+%% gb_trees:from_orddict(index(Xs, 0)).
+%%
+%% index([X|Xs], N) ->
+%% [{N, X} | index(Xs, N+1)];
+%% index([],_) ->
+%% [].
+
+-spec vector_to_list(hipe_vector()) -> [_].
+vector_to_list(V) ->
+ gb_trees:values(V).
+
+-spec set(hipe_vector(), non_neg_integer(), _) -> hipe_vector().
+set(Vec, Ix, V) ->
+ gb_trees:update(Ix, V, Vec).
+
+-spec get(hipe_vector(), non_neg_integer()) -> any().
+get(Vec, Ix) ->
+ gb_trees:get(Ix, Vec).
+
+-endif. %% ifdef USE_GBTREES
diff --git a/lib/hipe/util/hipe_vectors.hrl b/lib/hipe/util/hipe_vectors.hrl
new file mode 100644
index 0000000000..043faf4c91
--- /dev/null
+++ b/lib/hipe/util/hipe_vectors.hrl
@@ -0,0 +1,28 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-define(USE_TUPLES, true).
+-define(USE_GBTREES, true).
+
+-ifdef(USE_TUPLES).
+-type hipe_vector() :: tuple().
+-endif.
+
+-ifdef(USE_GBTREES).
+-type hipe_vector() :: gb_tree().
+-endif.
diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk
new file mode 100644
index 0000000000..c75ac5efe7
--- /dev/null
+++ b/lib/hipe/vsn.mk
@@ -0,0 +1 @@
+HIPE_VSN = 3.7.4
diff --git a/lib/hipe/x86/Makefile b/lib/hipe/x86/Makefile
new file mode 100644
index 0000000000..065b56fce3
--- /dev/null
+++ b/lib/hipe/x86/Makefile
@@ -0,0 +1,134 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+# Please keep this list sorted.
+MODULES=hipe_rtl_to_x86 \
+ hipe_x86 \
+ hipe_x86_assemble \
+ hipe_x86_cfg \
+ hipe_x86_defuse \
+ hipe_x86_encode \
+ hipe_x86_frame \
+ hipe_x86_liveness \
+ hipe_x86_main \
+ hipe_x86_postpass \
+ hipe_x86_pp \
+ hipe_x86_ra \
+ hipe_x86_ra_finalise \
+ hipe_x86_ra_ls \
+ hipe_x86_ra_naive \
+ hipe_x86_ra_postconditions \
+ hipe_x86_ra_x87_ls \
+ hipe_x86_registers \
+ hipe_x86_spill_restore \
+ hipe_x86_x87
+
+HRL_FILES=hipe_x86.hrl
+ERL_FILES=$(MODULES:%=%.erl)
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE=
+# APP_SRC=$(APP_FILE).src
+# APP_TARGET=$(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE=
+# APPUP_SRC=$(APPUP_FILE).src
+# APPUP_TARGET=$(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+docs: $(DOC_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f core
+
+$(DOCS)/%.html:%.erl
+ erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+# Please keep this list sorted.
+$(EBIN)/hipe_rtl_to_x86.beam: ../rtl/hipe_rtl.hrl
+$(EBIN)/hipe_x86_assemble.beam: ../main/hipe.hrl ../rtl/hipe_literals.hrl ../misc/hipe_sdi.hrl
+$(EBIN)/hipe_x86_cfg.beam: ../flow/cfg.hrl ../flow/cfg.inc
+$(EBIN)/hipe_x86_frame.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_x86_liveness.beam: ../flow/liveness.inc
+$(EBIN)/hipe_x86_main.beam: ../main/hipe.hrl
+$(EBIN)/hipe_x86_ra: ../main/hipe.hrl
+$(EBIN)/hipe_x86_ra_dummy.beam: ../main/hipe.hrl
+$(EBIN)/hipe_x86_ra_ls.beam: ../main/hipe.hrl
+$(EBIN)/hipe_x86_ra_postconditions.beam: ../main/hipe.hrl
+$(EBIN)/hipe_x86_ra_x87_ls.beam: ../main/hipe.hrl
+$(EBIN)/hipe_x86_registers.beam: ../rtl/hipe_literals.hrl
+$(EBIN)/hipe_x86_spill_restore.beam: ../main/hipe.hrl ../flow/cfg.hrl
+$(EBIN)/hipe_x86_x87.beam: ../main/hipe.hrl
+
+$(TARGET_FILES): hipe_x86.hrl ../misc/hipe_consttab.hrl
diff --git a/lib/hipe/x86/NOTES.OPTIM b/lib/hipe/x86/NOTES.OPTIM
new file mode 100644
index 0000000000..4c241cacb4
--- /dev/null
+++ b/lib/hipe/x86/NOTES.OPTIM
@@ -0,0 +1,200 @@
+$Id$
+
+Partial x86 code optimisation guide
+===================================
+Priority should be given to P6 and P4, then K7,
+then P5, and last to K6.
+
+Rules that are blatantly obvious or irrelevant for HiPE are
+generally not listed. These includes things like alignment
+of basic data types, store-forwarding rules when alignment
+or sizes don't match, and partial register stalls.
+
+Intel P4
+--------
+The P6 4-1-1 insn decode template no longer applies.
+
+Simple insns (add/sub/cmp/test/and/or/xor/neg/not/mov/sahf)
+are twice as fast as in P6.
+
+Shifts are "movsx" (sign-extend) are slower than in P6.
+
+Always avoid "inc" and "dec", use "add" and "sub" instead,
+due to condition codes dependencies overhead.
+
+"fxch" is slightly more expensive than in P6, where it was free.
+
+Use "setcc" or "cmov" to eliminate unpredictable branches.
+
+For hot code executing out of the trace cache, alignment of
+branch targets is less of an issue compared to P6.
+
+Do use "fxch" to simulate a flat FP register file, but only
+for that purpose, not for manual scheduling for parallelism.
+
+Using "lea" is highly recommended.
+
+Eliminate redundant loads. Use regs as much as possible.
+
+Left shifts up to 3 have longer latencies than the equivalent
+sequence of adds.
+
+Do utilise the addressing modes, to save registers and trace
+cache bandwidth.
+
+"xor reg,reg" or "sub reg,reg" preferred over moving zero to reg.
+
+"test reg,reg" preferred over "cmp" with zero or "and".
+
+Avoid explicit cmp/test;jcc if the preceeding insn (alu, but not
+mov or lea) set the condition codes.
+
+Load-execute alu insns (mem src) are Ok.
+
+Add-reg-to-mem slightly better than add-mem-to-reg.
+
+Add-reg-to-mem is better than load;add;store.
+
+Intel P6
+--------
+4-1-1 instruction decoding template: can decode one semi-complex
+(max 4 uops) and two simple (1 uop) insns per clock; follow a
+complex insn by two simple ones, otherwise the decoders will stall.
+
+Load-execute (mem src) alu insns are 2 uops.
+Read-modify-write (mem dst) alu insns are 4 uops.
+
+Insns longer than 7 bytes block parallel decoding.
+Avoid insns longer than 7 bytes.
+
+Lea is useful.
+
+"movzx" is preferred for zero-extension; the xor;mov alternative
+causes a partial register stall.
+
+Use "test" instead of "cmp" with zero.
+
+Pull address calculations into load and store insn addressing modes.
+
+Clear a reg with "xor", not by moving zero to it.
+
+Many alu insns set the condition codes. Replace "alu;cmp;jcc"
+with "alu;jcc". This is not applicable for "mov" or "lea".
+
+For FP code, simulate a flat register file on the x87 stack by
+using fxch to reorder it.
+
+AMD K7
+------
+Select DirectPath insns. Avoid VectorPath insns due to slower decode.
+
+Alu insns with mem src are very efficient.
+Alu insns with mem dst are very efficient.
+
+Fetches from I-cache are 16-byte aligned. Align functions and frequently
+used labels at or near the start of 16-byte aligned blocks.
+
+"movzx" preferred over "xor;mov" for zero-extension.
+
+"push mem" preferred over "load;push reg".
+
+"xor reg,reg" preferred over moving zero to the reg.
+
+"test" preferred over "cmp".
+
+"pop" insns are VectorPath. "pop mem" has latency 3, "pop reg" has
+latency 4.
+
+"push reg" and "push imm" are DirectPath, "push mem" is VectorPath.
+The latency is 3 clocks.
+
+Intel P5
+--------
+If a loop header is less than 8 bytes away from a 16-byte
+boundary, align it to the 16-byte boundary.
+
+If a return address is less than 8 bytes away from a 16-byte
+boundary, align it to the 16-byte boundary.
+
+Align function entry points to 16-byte boundaries.
+
+Ensure that doubles are 64-bit aligned.
+
+Data cache line size is 32 bytes. The whole line is brought
+in on a read miss.
+
+"push mem" is not pairable; loading a temp reg and pushing
+the reg pairs better -- this is also faster on the 486.
+
+No conditional move instruction.
+
+Insns longer than 7 bytes can't go down the V-pipe or share
+the insn FIFO with other insns.
+Avoid insns longer than 7 bytes.
+
+Lea is useful when it replaces several other add/shift insns.
+Lea is not a good replacement for a single shl since a scaled
+index requires a disp32 (or base), making the insn longer.
+
+"movzx" is worse than the xor;mov alternative -- the opcode
+prefix causes a slowdown and it is not pariable.
+
+Use "test" instead of "cmp" with zero.
+
+"test eax,imm" and "test reg,reg" are pairable, other forms are not.
+
+Pull address calculations into load and store insn addressing modes.
+
+Clear a reg with "xor", not by moving zero to it.
+
+Many alu insns set the condition codes. Replace "alu;cmp;jcc"
+with "alu;jcc". This is not applicable for "mov" or "lea".
+
+For FP code, simulate a flat register file on the x87 stack by
+using fxch to reorder it.
+
+"neg" and "not" are not pairable. "test imm,reg" and "test imm,mem"
+are not pairable. Shifts by "cl" are not pairable. Shifts by "1" or
+"imm" are pairable but only execute in the U-pipe.
+
+AMD K6
+------
+The insn size predecoder has a 3-byte window. Insns with both prefix
+and SIB bytes cannot be short-decoded.
+
+Use short and simple insns, including mem src alu insns.
+
+Avoid insns longer than 7 bytes. They cannot be short-decoded.
+Short-decode: max 7 bytes, max 2 uops.
+Long-decode: max 11 bytes, max 4 uops.
+Vector-decode: longer than 11 bytes or more than 4 uops.
+
+Prefer read-modify-write alu insns (mem dst) over "load;op;store"
+sequences, for code density and register pressure reasons.
+
+Avoid the "(esi)" addressing mode: it forces the insn to be vector-decoded.
+Use a different reg or add an explicit zero displacement.
+
+"add reg,reg" preferred over a shl by 1, it parallelises better.
+
+"movzx" preferred over "xor;mov" for zero-extension.
+
+Moving zero to a reg preferred over "xor reg,reg" due to dependencies
+and condition codes overhead.
+
+"push mem" preferred over "load;push reg" due to code density and
+register pressure. (Page 64.)
+Explicit moves preferred when pushing args for fn calls, due to
+%esp dependencies and random access possibility. (Page 58.)
+[hmm, these two are in conflict]
+
+There is no penalty for seg reg prefix unless there are multiple prefixes.
+
+Align function entries and frequent branch targets to 16-byte boundaries.
+
+Shifts by imm only go down one of the pipes.
+
+"test reg,reg" preferred over "cmp" with zero.
+"test reg,imm" is a long-decode insn.
+
+No conditional move insn.
diff --git a/lib/hipe/x86/NOTES.RA b/lib/hipe/x86/NOTES.RA
new file mode 100644
index 0000000000..ce80411642
--- /dev/null
+++ b/lib/hipe/x86/NOTES.RA
@@ -0,0 +1,32 @@
+$Id$
+
+Register Allocation
+===================
+
+These are the rules that HiPE x86 register allocators must abide by.
+
+- Before RA, every Temp (precoloured or pseudo) is semantically
+ equivalent to Reg. Any operand may be Temp.
+
+- Before RA, only FIXED registers may occur in precoloured Temps.
+ Exception 1 is move: src or dst may be an argument register.
+ Exception 2 is call: the dst (if any) must be %eax.
+
+- After RA, an operand (src or dst) may refer to at most one memory cell.
+ Therefore, a pseudo-Temp MAY NOT occur as base or offset in an
+ explicit memory operand after RA.
+
+- After RA, a binary operation (alu, cmp, move) may refer to at most
+ one memory cell. Therefore, AT MOST ONE of src and dst may be a
+ pseudo-Temp after RA. If one of the operands (src or dst) is an
+ explicit memory operand, then the other operand MUST NOT be a
+ pseudo-Temp after RA.
+
+- After RA, the index in a jmp_switch must be a register.
+
+- After RA, the temp in a lea must be a register.
+
+- After RA, the temp in an imul must be a register.
+
+- After RA, a function's formal parameters must reside on the stack.
+ Therefore, the RA MUST NOT map the formals to actual registers.
diff --git a/lib/hipe/x86/TODO b/lib/hipe/x86/TODO
new file mode 100644
index 0000000000..7c93f7daf3
--- /dev/null
+++ b/lib/hipe/x86/TODO
@@ -0,0 +1,31 @@
+rtl_to_x86:
+* recognise alub(X,X,sub,1,lt,L1,L2,P) and turn it into 'dec',
+ this might improve the reduction test code slightly (X is
+ the pseudo for FCALLS)
+* recognise alu(Z,X,add,Y) and turn it into 'lea'.
+* rewrite tailcalls as parallel assignments before regalloc
+
+x86:
+* Use separate constructors for real regs (x86_reg) and pseudos (x86_temp).
+
+Frame:
+* drop tailcall rewrite
+
+Registers:
+* make the 2 regs now reserved for frame's tailcall rewrite available for arg passing
+
+Optimizations:
+* replace jcc cc,L1; jmp L0; L1: with jcc <not cc> L0; L1: (length:len/2)
+* Kill move X,X insns, either in frame or finalise
+* Instruction scheduling module
+* We can now choose to not have HP in %esi. However, this currently loses
+ performance due to (a) repeated moves to/from P_HP(P), and (b) spills of
+ the temp that contains a copy of P_HP(P). Both of these problems should be
+ fixed, and then, if we don't have any noticeable performance degradation, we
+ should permanently change to a non-reserved HP strategy.
+
+Loader:
+
+Assembler:
+
+Encode:
diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl
new file mode 100644
index 0000000000..d77e4fed3b
--- /dev/null
+++ b/lib/hipe/x86/hipe_rtl_to_x86.erl
@@ -0,0 +1,865 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%
+%%% Translate 3-address RTL code to 2-address pseudo-x86 code.
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_RTL_TO_X86, hipe_rtl_to_amd64).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(ECX, rcx).
+-define(EAX, rax).
+-else.
+-define(HIPE_RTL_TO_X86, hipe_rtl_to_x86).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(ECX, ecx).
+-define(EAX, eax).
+-endif.
+
+-module(?HIPE_RTL_TO_X86).
+-export([translate/1]).
+
+-include("../rtl/hipe_rtl.hrl").
+
+translate(RTL) -> % RTL function -> x86 defun
+ hipe_gensym:init(x86),
+ hipe_gensym:set_var(x86, ?HIPE_X86_REGISTERS:first_virtual()),
+ hipe_gensym:set_label(x86, hipe_gensym:get_label(rtl)),
+ Map0 = vmap_empty(),
+ {Formals, Map1} = conv_formals(hipe_rtl:rtl_params(RTL), Map0),
+ OldData = hipe_rtl:rtl_data(RTL),
+ {Code0, NewData} = conv_insn_list(hipe_rtl:rtl_code(RTL), Map1, OldData),
+ {RegFormals,_} = split_args(Formals),
+ Code =
+ case RegFormals of
+ [] -> Code0;
+ _ -> [hipe_x86:mk_label(hipe_gensym:get_next_label(x86)) |
+ move_formals(RegFormals, Code0)]
+ end,
+ IsClosure = hipe_rtl:rtl_is_closure(RTL),
+ IsLeaf = hipe_rtl:rtl_is_leaf(RTL),
+ hipe_x86:mk_defun(hipe_rtl:rtl_fun(RTL),
+ Formals,
+ IsClosure,
+ IsLeaf,
+ Code,
+ NewData,
+ [],
+ []).
+
+conv_insn_list([H|T], Map, Data) ->
+ {NewH, NewMap, NewData1} = conv_insn(H, Map, Data),
+ %% io:format("~w \n ==>\n ~w\n- - - - - - - - -\n",[H,NewH]),
+ {NewT, NewData2} = conv_insn_list(T, NewMap, NewData1),
+ {NewH ++ NewT, NewData2};
+conv_insn_list([], _, Data) ->
+ {[], Data}.
+
+conv_insn(I, Map, Data) ->
+ case I of
+ #alu{} ->
+ %% dst = src1 binop src2
+ BinOp = conv_binop(hipe_rtl:alu_op(I)),
+ {Dst, Map0} = conv_dst(hipe_rtl:alu_dst(I), Map),
+ {FixSrc1, Src1, Map1} = conv_src(hipe_rtl:alu_src1(I), Map0),
+ {FixSrc2, Src2, Map2} = conv_src(hipe_rtl:alu_src2(I), Map1),
+ I2 =
+ case hipe_rtl:is_shift_op(hipe_rtl:alu_op(I)) of
+ true ->
+ conv_shift(Dst, Src1, BinOp, Src2);
+ false ->
+ conv_alu(Dst, Src1, BinOp, Src2, [])
+ end,
+ {FixSrc1++FixSrc2++I2, Map2, Data};
+ #alub{} ->
+ %% dst = src1 op src2; if COND goto label
+ BinOp = conv_binop(hipe_rtl:alub_op(I)),
+ {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map),
+ {FixSrc1, Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0),
+ {FixSrc2, Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1),
+ Cc = conv_cond(hipe_rtl:alub_cond(I)),
+ I1 = [hipe_x86:mk_pseudo_jcc(Cc,
+ hipe_rtl:alub_true_label(I),
+ hipe_rtl:alub_false_label(I),
+ hipe_rtl:alub_pred(I))],
+ I2 = conv_alu(Dst, Src1, BinOp, Src2, I1),
+ {FixSrc1++FixSrc2++I2, Map2, Data};
+ #branch{} ->
+ %% <unused> = src1 - src2; if COND goto label
+ {FixSrc1, Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map),
+ {FixSrc2, Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0),
+ Cc = conv_cond(hipe_rtl:branch_cond(I)),
+ I2 = conv_branch(Src1, Cc, Src2,
+ hipe_rtl:branch_true_label(I),
+ hipe_rtl:branch_false_label(I),
+ hipe_rtl:branch_pred(I)),
+ {FixSrc1++FixSrc2++I2, Map1, Data};
+ #call{} ->
+ %% push <arg1>
+ %% ...
+ %% push <argn>
+ %% eax := call <Fun>; if exn goto <Fail> else goto Next
+ %% Next:
+ %% <Dst> := eax
+ %% goto <Cont>
+ {FixArgs, Args, Map0} = conv_src_list(hipe_rtl:call_arglist(I), Map),
+ {Dsts, Map1} = conv_dst_list(hipe_rtl:call_dstlist(I), Map0),
+ {Fun, Map2} = conv_fun(hipe_rtl:call_fun(I), Map1),
+ I2 = conv_call(Dsts, Fun, Args,
+ hipe_rtl:call_continuation(I),
+ hipe_rtl:call_fail(I),
+ hipe_rtl:call_type(I)),
+ %% XXX Fixme: this ++ is probably inefficient.
+ {FixArgs++I2, Map2, Data};
+ #comment{} ->
+ I2 = [hipe_x86:mk_comment(hipe_rtl:comment_text(I))],
+ {I2, Map, Data};
+ #enter{} ->
+ {FixArgs, Args, Map0} = conv_src_list(hipe_rtl:enter_arglist(I), Map),
+ {Fun, Map1} = conv_fun(hipe_rtl:enter_fun(I), Map0),
+ I2 = conv_tailcall(Fun, Args, hipe_rtl:enter_type(I)),
+ {FixArgs++I2, Map1, Data};
+ #goto{} ->
+ I2 = [hipe_x86:mk_jmp_label(hipe_rtl:goto_label(I))],
+ {I2, Map, Data};
+ #label{} ->
+ I2 = [hipe_x86:mk_label(hipe_rtl:label_name(I))],
+ {I2, Map, Data};
+ #load{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_dst(I), Map),
+ {FixSrc, Src, Map1} = conv_src(hipe_rtl:load_src(I), Map0),
+ {FixOff, Off, Map2} = conv_src(hipe_rtl:load_offset(I), Map1),
+ I2 = case {hipe_rtl:load_size(I), hipe_rtl:load_sign(I)} of
+ {byte, signed} ->
+ [hipe_x86:mk_movsx(hipe_x86:mk_mem(Src, Off, 'byte'), Dst)];
+ {byte, unsigned} ->
+ [hipe_x86:mk_movzx(hipe_x86:mk_mem(Src, Off, 'byte'), Dst)];
+ {int16, signed} ->
+ [hipe_x86:mk_movsx(hipe_x86:mk_mem(Src, Off, 'int16'), Dst)];
+ {int16, unsigned} ->
+ [hipe_x86:mk_movzx(hipe_x86:mk_mem(Src, Off, 'int16'), Dst)];
+ {LoadSize, LoadSign} ->
+ mk_load(LoadSize, LoadSign, Src, Off, Dst)
+ end,
+ {FixSrc++FixOff++I2, Map2, Data};
+ #load_address{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_address_dst(I), Map),
+ Addr = hipe_rtl:load_address_addr(I),
+ Type = hipe_rtl:load_address_type(I),
+ Src = hipe_x86:mk_imm_from_addr(Addr, Type),
+ I2 = mk_load_address(Type, Src, Dst),
+ {I2, Map0, Data};
+ #load_atom{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:load_atom_dst(I), Map),
+ Src = hipe_x86:mk_imm_from_atom(hipe_rtl:load_atom_atom(I)),
+ I2 = [hipe_x86:mk_move(Src, Dst)],
+ {I2, Map0, Data};
+ #move{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:move_dst(I), Map),
+ {FixSrc, Src, Map1} = conv_src(hipe_rtl:move_src(I), Map0),
+ I2 = [hipe_x86:mk_move(Src, Dst)],
+ {FixSrc++I2, Map1, Data};
+ #return{} ->
+ {FixArgs, Args, Map0} = conv_src_list(hipe_rtl:return_varlist(I), Map),
+ %% frame will fill in npop later, hence the "mk_ret(-1)"
+ I2 = move_retvals(Args, [hipe_x86:mk_ret(-1)]),
+ {FixArgs++I2, Map0, Data};
+ #store{} ->
+ {Ptr, Map0} = conv_dst(hipe_rtl:store_base(I), Map),
+ {FixSrc, Src, Map1} = conv_src(hipe_rtl:store_src(I), Map0),
+ {FixOff, Off, Map2} = conv_src(hipe_rtl:store_offset(I), Map1),
+ I2 = mk_store(hipe_rtl:store_size(I), Src, Ptr, Off),
+ {FixSrc++FixOff++I2, Map2, Data};
+ #switch{} -> % this one also updates Data :-(
+ %% from hipe_rtl2sparc, but we use a hairy addressing mode
+ %% instead of doing the arithmetic manually
+ Labels = hipe_rtl:switch_labels(I),
+ LMap = [{label,L} || L <- Labels],
+ {NewData, JTabLab} =
+ case hipe_rtl:switch_sort_order(I) of
+ [] ->
+ hipe_consttab:insert_block(Data, word, LMap);
+ SortOrder ->
+ hipe_consttab:insert_sorted_block(
+ Data, word, LMap, SortOrder)
+ end,
+ %% no immediates allowed here
+ {Index, Map1} = conv_dst(hipe_rtl:switch_src(I), Map),
+ I2 = mk_jmp_switch(Index, JTabLab, Labels),
+ {I2, Map1, NewData};
+ #fload{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:fload_dst(I), Map),
+ {[], Src, Map1} = conv_src(hipe_rtl:fload_src(I), Map0),
+ {[], Off, Map2} = conv_src(hipe_rtl:fload_offset(I), Map1),
+ I2 = [hipe_x86:mk_fmove(hipe_x86:mk_mem(Src, Off, 'double'),Dst)],
+ {I2, Map2, Data};
+ #fstore{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:fstore_base(I), Map),
+ {[], Src, Map1} = conv_src(hipe_rtl:fstore_src(I), Map0),
+ {[], Off, Map2} = conv_src(hipe_rtl:fstore_offset(I), Map1),
+ I2 = [hipe_x86:mk_fmove(Src, hipe_x86:mk_mem(Dst, Off, 'double'))],
+ {I2, Map2, Data};
+ #fp{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:fp_dst(I), Map),
+ {[], Src1, Map1} = conv_src(hipe_rtl:fp_src1(I), Map0),
+ {[], Src2, Map2} = conv_src(hipe_rtl:fp_src2(I), Map1),
+ FpBinOp = conv_fp_binop(hipe_rtl:fp_op(I)),
+ I2 = conv_fp_binary(Dst, Src1, FpBinOp, Src2),
+ {I2, Map2, Data};
+ #fp_unop{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:fp_unop_dst(I), Map),
+ {[], Src, Map1} = conv_src(hipe_rtl:fp_unop_src(I), Map0),
+ FpUnOp = conv_fp_unop(hipe_rtl:fp_unop_op(I)),
+ I2 = conv_fp_unary(Dst, Src, FpUnOp),
+ {I2, Map1, Data};
+ #fmove{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:fmove_dst(I), Map),
+ {[], Src, Map1} = conv_src(hipe_rtl:fmove_src(I), Map0),
+ I2 = [hipe_x86:mk_fmove(Src, Dst)],
+ {I2, Map1, Data};
+ #fconv{} ->
+ {Dst, Map0} = conv_dst(hipe_rtl:fconv_dst(I), Map),
+ {[], Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0),
+ I2 = [hipe_x86:mk_fmove(Src, Dst)],
+ {I2, Map1, Data};
+ X ->
+ %% gctest??
+ %% jmp, jmp_link, jsr, esr, multimove,
+ %% stackneed, pop_frame, restore_frame, save_frame
+ throw({?MODULE, {"unknown RTL instruction", X}})
+ end.
+
+%%% Finalise the conversion of a 3-address ALU operation, taking
+%%% care to not introduce more temps and moves than necessary.
+
+conv_alu(Dst, Src1, 'imul', Src2, Tail) ->
+ mk_imul(Src1, Src2, Dst, Tail);
+conv_alu(Dst, Src1, BinOp, Src2, Tail) ->
+ case same_opnd(Dst, Src1) of
+ true -> % x = x op y
+ [hipe_x86:mk_alu(BinOp, Src2, Dst) | Tail]; % x op= y
+ false -> % z = x op y, where z != x
+ case same_opnd(Dst, Src2) of
+ false -> % z = x op y, where z != x && z != y
+ [hipe_x86:mk_move(Src1, Dst), % z = x
+ hipe_x86:mk_alu(BinOp, Src2, Dst) | Tail]; % z op= y
+ true -> % y = x op y, where y != x
+ case binop_commutes(BinOp) of
+ true -> % y = y op x
+ [hipe_x86:mk_alu(BinOp, Src1, Dst) | Tail]; % y op= x
+ false -> % y = x op y, where op doesn't commute
+ Tmp = clone_dst(Dst),
+ [hipe_x86:mk_move(Src1, Tmp), % t = x
+ hipe_x86:mk_alu(BinOp, Src2, Tmp), % t op= y
+ hipe_x86:mk_move(Tmp, Dst) | Tail] % y = t
+ end
+ end
+ end.
+
+mk_imul(Src1, Src2, Dst, Tail) ->
+ case hipe_x86:is_imm(Src1) of
+ true ->
+ case hipe_x86:is_imm(Src2) of
+ true ->
+ mk_imul_iit(Src1, Src2, Dst, Tail);
+ _ ->
+ mk_imul_itt(Src1, Src2, Dst, Tail)
+ end;
+ _ ->
+ case hipe_x86:is_imm(Src2) of
+ true ->
+ mk_imul_itt(Src2, Src1, Dst, Tail);
+ _ ->
+ mk_imul_ttt(Src1, Src2, Dst, Tail)
+ end
+ end.
+
+mk_imul_iit(Src1, Src2, Dst, Tail) ->
+ io:format("~w: RTL mul with two immediates\n", [?MODULE]),
+ Tmp2 = new_untagged_temp(),
+ [hipe_x86:mk_move(Src2, Tmp2) |
+ mk_imul_itt(Src1, Tmp2, Dst, Tail)].
+
+mk_imul_itt(Src1, Src2, Dst, Tail) ->
+ [hipe_x86:mk_imul(Src1, Src2, Dst) | Tail].
+
+mk_imul_ttt(Src1, Src2, Dst, Tail) ->
+ case same_opnd(Dst, Src1) of
+ true ->
+ [hipe_x86:mk_imul([], Src2, Dst) | Tail];
+ false ->
+ case same_opnd(Dst, Src2) of
+ true ->
+ [hipe_x86:mk_imul([], Src1, Dst) | Tail];
+ false ->
+ [hipe_x86:mk_move(Src1, Dst),
+ hipe_x86:mk_imul([], Src2, Dst) | Tail]
+ end
+ end.
+
+conv_shift(Dst, Src1, BinOp, Src2) ->
+ {NewSrc2,I1} =
+ case hipe_x86:is_imm(Src2) of
+ true ->
+ {Src2, []};
+ false ->
+ NewSrc = hipe_x86:mk_temp(?HIPE_X86_REGISTERS:?ECX(), 'untagged'),
+ {NewSrc, [hipe_x86:mk_move(Src2, NewSrc)]}
+ end,
+ I2 = case same_opnd(Dst, Src1) of
+ true -> % x = x op y
+ [hipe_x86:mk_shift(BinOp, NewSrc2, Dst)]; % x op= y
+ false -> % z = x op y, where z != x
+ case same_opnd(Dst, Src2) of
+ false -> % z = x op y, where z != x && z != y
+ [hipe_x86:mk_move(Src1, Dst), % z = x
+ hipe_x86:mk_shift(BinOp, NewSrc2, Dst)];% z op= y
+ true -> % y = x op y, no shift op commutes
+ Tmp = clone_dst(Dst),
+ [hipe_x86:mk_move(Src1, Tmp), % t = x
+ hipe_x86:mk_shift(BinOp, NewSrc2, Tmp), % t op= y
+ hipe_x86:mk_move(Tmp, Dst)] % y = t
+ end
+ end,
+ I1 ++ I2.
+
+%%% Finalise the conversion of a conditional branch operation, taking
+%%% care to not introduce more temps and moves than necessary.
+
+conv_branch(Src1, Cc, Src2, TrueLab, FalseLab, Pred) ->
+ case hipe_x86:is_imm(Src1) of
+ false ->
+ mk_branch(Src1, Cc, Src2, TrueLab, FalseLab, Pred);
+ true ->
+ case hipe_x86:is_imm(Src2) of
+ false ->
+ NewCc = commute_cc(Cc),
+ mk_branch(Src2, NewCc, Src1, TrueLab, FalseLab, Pred);
+ true ->
+ %% two immediates, let the optimiser clean it up
+ Tmp = new_untagged_temp(),
+ [hipe_x86:mk_move(Src1, Tmp) |
+ mk_branch(Tmp, Cc, Src2, TrueLab, FalseLab, Pred)]
+ end
+ end.
+
+mk_branch(Src1, Cc, Src2, TrueLab, FalseLab, Pred) ->
+ %% PRE: not(is_imm(Src1))
+ [hipe_x86:mk_cmp(Src2, Src1),
+ hipe_x86:mk_pseudo_jcc(Cc, TrueLab, FalseLab, Pred)].
+
+%%% Convert an RTL ALU or ALUB binary operator.
+
+conv_binop(BinOp) ->
+ case BinOp of
+ 'add' -> 'add';
+ 'sub' -> 'sub';
+ 'or' -> 'or';
+ 'and' -> 'and';
+ 'xor' -> 'xor';
+ 'sll' -> 'shl';
+ 'srl' -> 'shr';
+ 'sra' -> 'sar';
+ 'mul' -> 'imul';
+ %% andnot ???
+ _ -> exit({?MODULE, {"unknown binop", BinOp}})
+ end.
+
+binop_commutes(BinOp) ->
+ case BinOp of
+ 'add' -> true;
+ 'or' -> true;
+ 'and' -> true;
+ 'xor' -> true;
+ _ -> false
+ end.
+
+%%% Convert an RTL conditional operator.
+
+conv_cond(Cond) ->
+ case Cond of
+ eq -> 'e';
+ ne -> 'ne';
+ gt -> 'g';
+ gtu -> 'a';
+ ge -> 'ge';
+ geu -> 'ae';
+ lt -> 'l';
+ ltu -> 'b';
+ le -> 'le';
+ leu -> 'be';
+ overflow -> 'o';
+ not_overflow -> 'no';
+ _ -> exit({?MODULE, {"unknown rtl cond", Cond}})
+ end.
+
+commute_cc(Cc) -> % if x Cc y, then y commute_cc(Cc) x
+ case Cc of
+ 'e' -> 'e'; % ==, ==
+ 'ne' -> 'ne'; % !=, !=
+ 'g' -> 'l'; % >, <
+ 'a' -> 'b'; % >u, <u
+ 'ge' -> 'le'; % >=, <=
+ 'ae' -> 'be'; % >=u, <=u
+ 'l' -> 'g'; % <, >
+ 'b' -> 'a'; % <u, >u
+ 'le' -> 'ge'; % <=, >=
+ 'be' -> 'ae'; % <=u, >=u
+ %% overflow/not_overflow: n/a
+ _ -> exit({?MODULE, {"unknown cc", Cc}})
+ end.
+
+%%% Test if Dst and Src are the same operand.
+
+same_opnd(Dst, Src) -> Dst =:= Src.
+
+%%% Finalise the conversion of a tailcall instruction.
+
+conv_tailcall(Fun, Args, Linkage) ->
+ Arity = length(Args),
+ {RegArgs,StkArgs} = split_args(Args),
+ move_actuals(RegArgs,
+ [hipe_x86:mk_pseudo_tailcall_prepare(),
+ hipe_x86:mk_pseudo_tailcall(Fun, Arity, StkArgs, Linkage)]).
+
+split_args(Args) ->
+ split_args(0, ?HIPE_X86_REGISTERS:nr_args(), Args, []).
+split_args(I, N, [Arg|Args], RegArgs) when I < N ->
+ Reg = ?HIPE_X86_REGISTERS:arg(I),
+ Temp = hipe_x86:mk_temp(Reg, 'tagged'),
+ split_args(I+1, N, Args, [{Arg,Temp}|RegArgs]);
+split_args(_, _, StkArgs, RegArgs) ->
+ {RegArgs, StkArgs}.
+
+move_actuals([], Rest) -> Rest;
+move_actuals([{Src,Dst}|Actuals], Rest) ->
+ move_actuals(Actuals, [hipe_x86:mk_move(Src, Dst) | Rest]).
+
+move_formals([], Rest) -> Rest;
+move_formals([{Dst,Src}|Formals], Rest) ->
+ move_formals(Formals, [hipe_x86:mk_move(Src, Dst) | Rest]).
+
+%%% Finalise the conversion of a call instruction.
+
+conv_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_x86:is_prim(Fun) of
+ true ->
+ conv_primop_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage);
+ false ->
+ conv_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage)
+ end.
+
+conv_primop_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage) ->
+ case hipe_x86:prim_prim(Prim) of
+ 'fwait' ->
+ conv_fwait_call(Dsts, Args, ContLab, ExnLab, Linkage);
+ _ ->
+ conv_general_call(Dsts, Prim, Args, ContLab, ExnLab, Linkage)
+ end.
+
+conv_fwait_call([], [], [], [], not_remote) ->
+ [hipe_x86:mk_fp_unop('fwait', [])].
+
+conv_general_call(Dsts, Fun, Args, ContLab, ExnLab, Linkage) ->
+ %% The backend does not support pseudo_calls without a
+ %% continuation label, so we make sure each call has one.
+ {RealContLab, Tail} =
+ case do_call_results(Dsts) of
+ [] ->
+ %% Avoid consing up a dummy basic block if the moves list
+ %% is empty, as is typical for calls to suspend/0.
+ %% This should be subsumed by a general "optimise the CFG"
+ %% module, and could probably be removed.
+ case ContLab of
+ [] ->
+ NewContLab = hipe_gensym:get_next_label(x86),
+ {NewContLab, [hipe_x86:mk_label(NewContLab)]};
+ _ ->
+ {ContLab, []}
+ end;
+ Moves ->
+ %% Change the call to continue at a new basic block.
+ %% In this block move the result registers to the Dsts,
+ %% then continue at the call's original continuation.
+ %%
+ %% This should be fixed to propagate "fallthrough calls"
+ %% When the rest of the backend supports them.
+ NewContLab = hipe_gensym:get_next_label(x86),
+ case ContLab of
+ [] ->
+ %% This is just a fallthrough
+ %% No jump back after the moves.
+ {NewContLab,
+ [hipe_x86:mk_label(NewContLab) |
+ Moves]};
+ _ ->
+ %% The call has a continuation
+ %% jump to it.
+ {NewContLab,
+ [hipe_x86:mk_label(NewContLab) |
+ Moves ++
+ [hipe_x86:mk_jmp_label(ContLab)]]}
+ end
+ end,
+ SDesc = hipe_x86:mk_sdesc(ExnLab, 0, length(Args), {}),
+ CallInsn = hipe_x86:mk_pseudo_call(Fun, SDesc, RealContLab, Linkage),
+ {RegArgs,StkArgs} = split_args(Args),
+ do_push_args(StkArgs, move_actuals(RegArgs, [CallInsn | Tail])).
+
+do_push_args([Arg|Args], Tail) ->
+ [hipe_x86:mk_push(Arg) | do_push_args(Args, Tail)];
+do_push_args([], Tail) ->
+ Tail.
+
+%%% Move return values from the return value registers.
+
+do_call_results(DstList) ->
+ do_call_results(DstList, 0, []).
+
+do_call_results([Dst|DstList], I, Rest) ->
+ Src = hipe_x86:mk_temp(?HIPE_X86_REGISTERS:ret(I), 'tagged'),
+ Move = hipe_x86:mk_move(Src, Dst),
+ do_call_results(DstList, I+1, [Move|Rest]);
+do_call_results([], _, Insns) -> Insns.
+
+%%% Move return values to the return value registers.
+
+move_retvals(SrcLst, Rest) ->
+ move_retvals(SrcLst, 0, Rest).
+
+move_retvals([Src|SrcLst], I, Rest) ->
+ Dst = hipe_x86:mk_temp(?HIPE_X86_REGISTERS:ret(I), 'tagged'),
+ Move = hipe_x86:mk_move(Src, Dst),
+ move_retvals(SrcLst, I+1, [Move|Rest]);
+move_retvals([], _, Insns) -> Insns.
+
+%%% Convert a 'fun' operand (MFA, prim, or temp)
+
+conv_fun(Fun, Map) ->
+ case hipe_rtl:is_var(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ case hipe_rtl:is_reg(Fun) of
+ true ->
+ conv_dst(Fun, Map);
+ false ->
+ case Fun of
+ Prim when is_atom(Prim) ->
+ {hipe_x86:mk_prim(Prim), Map};
+ {M,F,A} when is_atom(M), is_atom(F), is_integer(A) ->
+ {hipe_x86:mk_mfa(M,F,A), Map};
+ _ ->
+ exit({?MODULE,conv_fun,Fun})
+ end
+ end
+ end.
+
+%%% Convert an RTL source operand (imm/var/reg).
+
+conv_src(Opnd, Map) ->
+ case hipe_rtl:is_imm(Opnd) of
+ true ->
+ conv_imm(Opnd, Map);
+ false ->
+ {NewOpnd,NewMap} = conv_dst(Opnd, Map),
+ {[], NewOpnd, NewMap}
+ end.
+
+-ifdef(HIPE_AMD64).
+conv_imm(Opnd, Map) ->
+ ImmVal = hipe_rtl:imm_value(Opnd),
+ case is_imm64(ImmVal) of
+ true ->
+ Temp = hipe_x86:mk_new_temp('untagged'),
+ {[hipe_x86:mk_move64(hipe_x86:mk_imm(ImmVal), Temp)], Temp, Map};
+ false ->
+ {[], hipe_x86:mk_imm(ImmVal), Map}
+ end.
+
+is_imm64(Value) when is_integer(Value) ->
+ (Value < -(1 bsl (32 - 1))) or (Value > (1 bsl (32 - 1)) - 1);
+is_imm64({_,atom}) -> false; % Atoms are 32 bits.
+is_imm64({_,c_const}) -> false; % c_consts are 32 bits.
+is_imm64({_,_}) -> true . % Other relocs are 64 bits.
+-else.
+conv_imm(Opnd, Map) ->
+ {[], hipe_x86:mk_imm(hipe_rtl:imm_value(Opnd)), Map}.
+-endif.
+
+conv_src_list([O|Os], Map) ->
+ {NewInstr, V, Map1} = conv_src(O, Map),
+ {Instrs, Vs, Map2} = conv_src_list(Os, Map1),
+ {Instrs++NewInstr, [V|Vs], Map2};
+conv_src_list([], Map) ->
+ {[], [], Map}.
+
+%%% Convert an RTL destination operand (var/reg).
+
+conv_dst(Opnd, Map) ->
+ {Name, Type} =
+ case hipe_rtl:is_var(Opnd) of
+ true ->
+ {hipe_rtl:var_index(Opnd), 'tagged'};
+ false ->
+ case hipe_rtl:is_fpreg(Opnd) of
+ true ->
+ {hipe_rtl:fpreg_index(Opnd), 'double'};
+ false ->
+ {hipe_rtl:reg_index(Opnd), 'untagged'}
+ end
+ end,
+ case ?HIPE_X86_REGISTERS:is_precoloured(Name) of
+ true ->
+ case ?HIPE_X86_REGISTERS:proc_offset(Name) of
+ false ->
+ {hipe_x86:mk_temp(Name, Type), Map};
+ Offset ->
+ Preg = ?HIPE_X86_REGISTERS:proc_pointer(),
+ Pbase = hipe_x86:mk_temp(Preg, 'untagged'),
+ Poff = hipe_x86:mk_imm(Offset),
+ {hipe_x86:mk_mem(Pbase, Poff, Type), Map}
+ end;
+ false ->
+ case vmap_lookup(Map, Opnd) of
+ {value, NewTemp} ->
+ {NewTemp, Map};
+ _ ->
+ NewTemp = hipe_x86:mk_new_temp(Type),
+ {NewTemp, vmap_bind(Map, Opnd, NewTemp)}
+ end
+ end.
+
+conv_dst_list([O|Os], Map) ->
+ {Dst, Map1} = conv_dst(O, Map),
+ {Dsts, Map2} = conv_dst_list(Os, Map1),
+ {[Dst|Dsts], Map2};
+conv_dst_list([], Map) ->
+ {[], Map}.
+
+conv_formals(Os, Map) ->
+ conv_formals(?HIPE_X86_REGISTERS:nr_args(), Os, Map, []).
+
+conv_formals(N, [O|Os], Map, Res) ->
+ Type =
+ case hipe_rtl:is_var(O) of
+ true -> 'tagged';
+ false ->'untagged'
+ end,
+ Dst =
+ if N > 0 -> hipe_x86:mk_new_temp(Type); % allocatable
+ true -> hipe_x86:mk_new_nonallocatable_temp(Type)
+ end,
+ Map1 = vmap_bind(Map, O, Dst),
+ conv_formals(N-1, Os, Map1, [Dst|Res]);
+conv_formals(_, [], Map, Res) ->
+ {lists:reverse(Res), Map}.
+
+%%% typeof_src -- what's src's type?
+
+typeof_src(Src) ->
+ case hipe_x86:is_imm(Src) of
+ true ->
+ 'untagged';
+ _ ->
+ typeof_dst(Src)
+ end.
+
+%%% typeof_dst -- what's dst's type?
+
+typeof_dst(Dst) ->
+ case hipe_x86:is_temp(Dst) of
+ true ->
+ hipe_x86:temp_type(Dst);
+ _ ->
+ hipe_x86:mem_type(Dst)
+ end.
+
+%%% clone_dst -- conjure up a scratch reg with same type as dst
+
+clone_dst(Dst) ->
+ hipe_x86:mk_new_temp(typeof_dst(Dst)).
+
+%%% new_untagged_temp -- conjure up an untagged scratch reg
+
+new_untagged_temp() ->
+ hipe_x86:mk_new_temp('untagged').
+
+%%% Map from RTL var/reg operands to x86 temps.
+
+vmap_empty() ->
+ gb_trees:empty().
+
+vmap_lookup(Map, Key) ->
+ gb_trees:lookup(Key, Map).
+
+vmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+%%% Finalise the conversion of a 2-address FP operation.
+
+conv_fp_unary(Dst, Src, FpUnOp) ->
+ case same_opnd(Dst, Src) of
+ true ->
+ [hipe_x86:mk_fp_unop(FpUnOp, Dst)];
+ _ ->
+ [hipe_x86:mk_fmove(Src, Dst),
+ hipe_x86:mk_fp_unop(FpUnOp, Dst)]
+ end.
+
+conv_fp_unop(RtlFpUnOp) ->
+ case RtlFpUnOp of
+ 'fchs' -> 'fchs'
+ end.
+
+%%% Finalise the conversion of a 3-address FP operation.
+
+conv_fp_binary(Dst, Src1, FpBinOp, Src2) ->
+ case same_opnd(Dst, Src1) of
+ true -> % x = x op y
+ [hipe_x86:mk_fp_binop(FpBinOp, Src2, Dst)]; % x op= y
+ false -> % z = x op y, where z != x
+ case same_opnd(Dst, Src2) of
+ false -> % z = x op y, where z != x && z != y
+ [hipe_x86:mk_fmove(Src1, Dst), % z = x
+ hipe_x86:mk_fp_binop(FpBinOp, Src2, Dst)]; % z op= y
+ true -> % y = x op y, where y != x
+ case fp_binop_commutes(FpBinOp) of
+ true -> % y = y op x
+ [hipe_x86:mk_fp_binop(FpBinOp, Src1, Dst)]; % y op= x
+ false -> % y = x op y, where op doesn't commute
+ RevFpBinOp = reverse_fp_binop(FpBinOp),
+ [hipe_x86:mk_fp_binop(RevFpBinOp, Src1, Dst)]
+ end
+ end
+ end.
+
+%%% Convert an RTL FP binary operator.
+
+conv_fp_binop(RtlFpBinOp) ->
+ case RtlFpBinOp of
+ 'fadd' -> 'fadd';
+ 'fdiv' -> 'fdiv';
+ 'fmul' -> 'fmul';
+ 'fsub' -> 'fsub'
+ end.
+
+fp_binop_commutes(FpBinOp) ->
+ case FpBinOp of
+ 'fadd' -> true;
+ 'fmul' -> true;
+ _ -> false
+ end.
+
+reverse_fp_binop(FpBinOp) ->
+ case FpBinOp of
+ 'fsub' -> 'fsubr';
+ 'fdiv' -> 'fdivr'
+ end.
+
+%%% Create a jmp_switch instruction.
+
+-ifdef(HIPE_AMD64).
+mk_jmp_switch(Index, JTabLab, Labels) ->
+ JTabReg = hipe_x86:mk_new_temp('untagged'),
+ JTabImm = hipe_x86:mk_imm_from_addr(JTabLab, constant),
+ [hipe_x86:mk_move64(JTabImm, JTabReg),
+ hipe_x86:mk_jmp_switch(Index, JTabReg, Labels)].
+-else.
+mk_jmp_switch(Index, JTabLab, Labels) ->
+ %% this is equivalent to "jmp *JTabLab(,Index,4)"
+ %% ("r = Index; r *= 4; r += &JTab; jmp *r" isn't as nice)
+ [hipe_x86:mk_jmp_switch(Index, JTabLab, Labels)].
+-endif.
+
+%%% Finalise the translation of a load_address instruction.
+
+-ifdef(HIPE_AMD64).
+mk_load_address(Type, Src, Dst) ->
+ case Type of
+ c_const -> % 32 bits
+ [hipe_x86:mk_move(Src, Dst)];
+ _ ->
+ [hipe_x86:mk_move64(Src, Dst)]
+ end.
+-else.
+mk_load_address(_Type, Src, Dst) ->
+ [hipe_x86:mk_move(Src, Dst)].
+-endif.
+
+%%% Translate 32-bit and larger loads.
+
+-ifdef(HIPE_AMD64).
+mk_load(LoadSize, LoadSign, Src, Off, Dst) ->
+ case {LoadSize, LoadSign} of
+ {int32, signed} ->
+ [hipe_x86:mk_movsx(hipe_x86:mk_mem(Src, Off, 'int32'), Dst)];
+ {int32, unsigned} ->
+ %% The processor zero-extends for us. No need for 'movzx'.
+ [hipe_x86:mk_move(hipe_x86:mk_mem(Src, Off, 'int32'), Dst)];
+ {_, _} ->
+ mk_load_word(Src, Off, Dst)
+ end.
+-else.
+mk_load(_LoadSize, _LoadSign, Src, Off, Dst) ->
+ mk_load_word(Src, Off, Dst).
+-endif.
+
+mk_load_word(Src, Off, Dst) ->
+ Type = typeof_dst(Dst),
+ [hipe_x86:mk_move(hipe_x86:mk_mem(Src, Off, Type), Dst)].
+
+%%% Finalise the translation of a store instruction.
+
+-ifdef(HIPE_AMD64).
+mk_store(RtlStoreSize, Src, Ptr, Off) ->
+ Type = case RtlStoreSize of
+ word ->
+ typeof_src(Src);
+ OtherType ->
+ OtherType
+ end,
+ [hipe_x86:mk_move(Src, hipe_x86:mk_mem(Ptr, Off, Type))].
+-else.
+mk_store(RtlStoreSize, Src, Ptr, Off) ->
+ case RtlStoreSize of
+ word ->
+ Type = typeof_src(Src),
+ [hipe_x86:mk_move(Src, hipe_x86:mk_mem(Ptr, Off, Type))];
+ int32 ->
+ Type = typeof_src(Src),
+ [hipe_x86:mk_move(Src, hipe_x86:mk_mem(Ptr, Off, Type))];
+ int16 ->
+ Type = 'int16',
+ [hipe_x86:mk_move(Src, hipe_x86:mk_mem(Ptr, Off, Type))];
+ byte ->
+ Type = 'byte',
+ {NewSrc, I1} = conv_small_store(Src),
+ I1 ++ [hipe_x86:mk_move(NewSrc, hipe_x86:mk_mem(Ptr, Off, Type))]
+ end.
+
+conv_small_store(Src) ->
+ case hipe_x86:is_imm(Src) of
+ true ->
+ {Src, []};
+ false ->
+ NewSrc = hipe_x86:mk_temp(hipe_x86_registers:eax(), 'untagged'),
+ {NewSrc, [hipe_x86:mk_move(Src, NewSrc)]}
+ end.
+-endif.
diff --git a/lib/hipe/x86/hipe_x86.erl b/lib/hipe/x86/hipe_x86.erl
new file mode 100644
index 0000000000..3298151366
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86.erl
@@ -0,0 +1,496 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% representation of 2-address pseudo-amd64 code
+
+-module(hipe_x86).
+
+-include("hipe_x86.hrl").
+
+%% Commented out are interface functions which are currently not used.
+-export([mk_temp/2,
+ %% mk_nonallocatable_temp/2,
+ mk_new_temp/1,
+ mk_new_nonallocatable_temp/1,
+ is_temp/1,
+ temp_reg/1,
+ temp_type/1,
+ temp_is_allocatable/1,
+
+ mk_imm/1,
+ mk_imm_from_addr/2,
+ mk_imm_from_atom/1,
+ is_imm/1,
+ %% imm_value/1,
+
+ mk_mem/3,
+ %% is_mem/1,
+ %% mem_base/1,
+ %% mem_off/1,
+ mem_type/1,
+
+ mk_fpreg/1,
+ mk_fpreg/2,
+ %% is_fpreg/1,
+ %% fpreg_is_pseudo/1,
+ %% fpreg_reg/1,
+
+ mk_mfa/3,
+ %% is_mfa/1,
+
+ mk_prim/1,
+ is_prim/1,
+ prim_prim/1,
+
+ mk_sdesc/4,
+
+ %% insn_type/1,
+
+ mk_alu/3,
+ %% is_alu/1,
+ alu_op/1,
+ alu_src/1,
+ alu_dst/1,
+
+ mk_call/3,
+ %% is_call/1,
+ call_fun/1,
+ call_sdesc/1,
+ call_linkage/1,
+
+ %% mk_cmovcc/3,
+ %% is_cmovcc/1,
+ cmovcc_cc/1,
+ cmovcc_src/1,
+ cmovcc_dst/1,
+
+ mk_cmp/2,
+ %% is_cmp/1,
+ cmp_src/1,
+ cmp_dst/1,
+
+ mk_comment/1,
+ %% is_comment/1,
+ %% comment_term/1,
+
+ mk_fmove/2,
+ is_fmove/1,
+ fmove_src/1,
+ fmove_dst/1,
+
+ mk_fp_unop/2,
+ %% is_fp_unop/1,
+ fp_unop_arg/1,
+ fp_unop_op/1,
+
+ mk_fp_binop/3,
+ %% is_fp_binop/1,
+ fp_binop_src/1,
+ fp_binop_dst/1,
+ fp_binop_op/1,
+
+ mk_imul/3,
+ imul_imm_opt/1,
+ imul_src/1,
+ imul_temp/1,
+
+ mk_jcc/2,
+ %% is_jcc/1,
+ jcc_cc/1,
+ jcc_label/1,
+
+ mk_jmp_fun/2,
+ %% is_jmp_fun/1,
+ jmp_fun_fun/1,
+ jmp_fun_linkage/1,
+
+ mk_jmp_label/1,
+ %% is_jmp_label/1,
+ jmp_label_label/1,
+
+ mk_jmp_switch/3,
+ %% is_jmp_switch/1,
+ jmp_switch_temp/1,
+ jmp_switch_jtab/1,
+ %% jmp_switch_labels/1,
+
+ mk_label/1,
+ is_label/1,
+ label_label/1,
+
+ mk_lea/2,
+ %% is_lea/1,
+ lea_mem/1,
+ lea_temp/1,
+
+ mk_move/2,
+ is_move/1,
+ move_src/1,
+ move_dst/1,
+ mk_move64/2,
+ %% is_move64/1,
+ move64_src/1,
+ move64_dst/1,
+
+ mk_movsx/2,
+ %% is_movsx/1,
+ movsx_src/1,
+ movsx_dst/1,
+
+ mk_movzx/2,
+ %% is_movzx/1,
+ movzx_src/1,
+ movzx_dst/1,
+
+ mk_pseudo_call/4,
+ %% is_pseudo_call/1,
+ pseudo_call_fun/1,
+ pseudo_call_sdesc/1,
+ pseudo_call_contlab/1,
+ pseudo_call_linkage/1,
+
+ mk_pseudo_jcc/4,
+ %% is_pseudo_jcc/1,
+ %% pseudo_jcc_cc/1,
+ %% pseudo_jcc_true_label/1,
+ %% pseudo_jcc_false_label/1,
+ %% pseudo_jcc_pred/1,
+
+ mk_pseudo_spill/1,
+
+ mk_pseudo_tailcall/4,
+ %% is_pseudo_tailcall/1,
+ pseudo_tailcall_fun/1,
+ %% pseudo_tailcall_arity/1,
+ pseudo_tailcall_stkargs/1,
+ pseudo_tailcall_linkage/1,
+
+ mk_pseudo_tailcall_prepare/0,
+ %% is_pseudo_tailcall_prepare/1,
+
+ mk_push/1,
+ %% is_push/1,
+ push_src/1,
+
+ %% mk_pop/1,
+ pop_dst/1,
+
+ mk_ret/1,
+ %% is_ret/1,
+ ret_npop/1,
+
+ mk_shift/3,
+ %% is_shift/1,
+ shift_op/1,
+ shift_src/1,
+ shift_dst/1,
+
+ %% mk_test/2,
+ test_src/1,
+ test_dst/1,
+
+ mk_defun/8,
+ defun_mfa/1,
+ defun_formals/1,
+ defun_is_closure/1,
+ defun_is_leaf/1,
+ defun_code/1,
+ defun_data/1,
+ defun_var_range/1
+ %% defun_label_range/1,
+
+ %% highest_temp/1
+ ]).
+
+%%%
+%%% Low-level accessors.
+%%%
+
+mk_temp(Reg, Type) when is_integer(Reg) ->
+ #x86_temp{reg=Reg, type=Type, allocatable=true}.
+mk_nonallocatable_temp(Reg, Type) when is_integer(Reg) ->
+ #x86_temp{reg=Reg, type=Type, allocatable=false}.
+mk_new_temp(Type) ->
+ mk_temp(hipe_gensym:get_next_var(x86), Type).
+mk_new_nonallocatable_temp(Type) ->
+ mk_nonallocatable_temp(hipe_gensym:get_next_var(x86), Type).
+is_temp(X) -> case X of #x86_temp{} -> true; _ -> false end.
+temp_reg(#x86_temp{reg=Reg}) when is_integer(Reg) -> Reg.
+temp_type(#x86_temp{type=Type}) -> Type.
+temp_is_allocatable(#x86_temp{allocatable=A}) -> A.
+
+mk_imm(Value) -> #x86_imm{value=Value}.
+mk_imm_from_addr(Addr, Type) ->
+ mk_imm({Addr, Type}).
+mk_imm_from_atom(Atom) ->
+ mk_imm(Atom).
+is_imm(X) -> case X of #x86_imm{} -> true; _ -> false end.
+%% imm_value(#x86_imm{value=Value}) -> Value.
+
+mk_mem(Base, Off, Type) -> #x86_mem{base=Base, off=Off, type=Type}.
+%% is_mem(X) -> case X of #x86_mem{} -> true; _ -> false end.
+%% mem_base(#x86_mem{base=Base}) -> Base.
+%% mem_off(#x86_mem{off=Off}) -> Off.
+mem_type(#x86_mem{type=Type}) -> Type.
+
+mk_fpreg(Reg) -> #x86_fpreg{reg=Reg, pseudo=true}.
+mk_fpreg(Reg, Pseudo) -> #x86_fpreg{reg=Reg, pseudo=Pseudo}.
+%% is_fpreg(F) -> case F of #x86_fpreg{} -> true;_ -> false end.
+%% fpreg_is_pseudo(#x86_fpreg{pseudo=Pseudo}) -> Pseudo.
+%% fpreg_reg(#x86_fpreg{reg=Reg}) -> Reg.
+
+mk_mfa(M, F, A) -> #x86_mfa{m=M, f=F, a=A}.
+%% is_mfa(X) -> case X of #x86_mfa{} -> true; _ -> false end.
+
+mk_prim(Prim) -> #x86_prim{prim=Prim}.
+is_prim(X) -> case X of #x86_prim{} -> true; _ -> false end.
+prim_prim(#x86_prim{prim=Prim}) -> Prim.
+
+mk_sdesc(ExnLab, FSize, Arity, Live) ->
+ #x86_sdesc{exnlab=ExnLab, fsize=FSize, arity=Arity, live=Live}.
+
+insn_type(Insn) ->
+ element(1, Insn).
+
+is_insn_type(Insn, Type) ->
+ case insn_type(Insn) of
+ Type -> true;
+ _ -> false
+ end.
+
+mk_alu(Op, Src, Dst) -> #alu{aluop=Op, src=Src, dst=Dst}.
+%% is_alu(Insn) -> is_insn_type(Insn, alu).
+alu_op(#alu{aluop=Op}) -> Op.
+alu_src(#alu{src=Src}) -> Src.
+alu_dst(#alu{dst=Dst}) -> Dst.
+
+mk_call(Fun, SDesc, Linkage) ->
+ check_linkage(Linkage),
+ #call{'fun'=Fun, sdesc=SDesc, linkage=Linkage}.
+%% is_call(Insn) -> is_insn_type(Insn, call).
+call_fun(#call{'fun'=Fun}) -> Fun.
+call_sdesc(#call{sdesc=SDesc}) -> SDesc.
+call_linkage(#call{linkage=Linkage}) -> Linkage.
+
+check_linkage(Linkage) ->
+ case Linkage of
+ remote -> [];
+ not_remote -> []
+ end.
+
+%% mk_cmovcc(Cc, Src, Dst) -> #cmovcc{cc=Cc, src=Src, dst=Dst}.
+%% is_cmovcc(Insn) -> is_insn_type(Insn, cmovcc).
+cmovcc_cc(#cmovcc{cc=Cc}) -> Cc.
+cmovcc_src(#cmovcc{src=Src}) -> Src.
+cmovcc_dst(#cmovcc{dst=Dst}) -> Dst.
+
+mk_cmp(Src, Dst) -> #cmp{src=Src, dst=Dst}.
+%% is_cmp(Insn) -> is_insn_type(Insn, cmp).
+cmp_src(#cmp{src=Src}) -> Src.
+cmp_dst(#cmp{dst=Dst}) -> Dst.
+
+%% mk_test(Src, Dst) -> #test{src=Src, dst=Dst}.
+test_src(#test{src=Src}) -> Src.
+test_dst(#test{dst=Dst}) -> Dst.
+
+mk_comment(Term) -> #comment{term=Term}.
+%% is_comment(Insn) -> is_insn_type(Insn, comment).
+%% comment_term(#comment{term=Term}) -> Term.
+
+mk_fmove(Src, Dst) -> #fmove{src=Src, dst=Dst}.
+is_fmove(F) -> is_insn_type(F, fmove).
+fmove_src(#fmove{src=Src}) -> Src.
+fmove_dst(#fmove{dst=Dst}) -> Dst.
+
+mk_fp_unop(Op, Arg) -> #fp_unop{op=Op, arg=Arg}.
+%% is_fp_unop(F) -> is_insn_type(F, fp_unop).
+fp_unop_arg(#fp_unop{arg=Arg}) -> Arg.
+fp_unop_op(#fp_unop{op=Op}) -> Op.
+
+mk_fp_binop(Op, Src, Dst) -> #fp_binop{op=Op, src=Src, dst=Dst}.
+%% is_fp_binop(F) -> is_insn_type(F, fp_binop).
+fp_binop_src(#fp_binop{src=Src}) -> Src.
+fp_binop_dst(#fp_binop{dst=Dst}) -> Dst.
+fp_binop_op(#fp_binop{op=Op}) -> Op.
+
+mk_imul(ImmOpt, Src, Temp) -> #imul{imm_opt=ImmOpt, src=Src, temp=Temp}.
+imul_imm_opt(#imul{imm_opt=ImmOpt}) -> ImmOpt.
+imul_src(#imul{src=Src}) -> Src.
+imul_temp(#imul{temp=Temp}) -> Temp.
+
+mk_jcc(Cc, Label) -> #jcc{cc=Cc, label=Label}.
+%% is_jcc(Insn) -> is_insn_type(Insn, jcc).
+jcc_cc(#jcc{cc=Cc}) -> Cc.
+jcc_label(#jcc{label=Label}) -> Label.
+
+mk_jmp_fun(Fun, Linkage) ->
+ check_linkage(Linkage),
+ #jmp_fun{'fun'=Fun, linkage=Linkage}.
+%% is_jmp_fun(Insn) -> is_insn_type(Insn, jmp_fun).
+jmp_fun_fun(#jmp_fun{'fun'=Fun}) -> Fun.
+jmp_fun_linkage(#jmp_fun{linkage=Linkage}) -> Linkage.
+
+mk_jmp_label(Label) -> #jmp_label{label=Label}.
+%% is_jmp_label(Insn) -> is_insn_type(Insn, jmp_label).
+jmp_label_label(#jmp_label{label=Label}) -> Label.
+
+mk_jmp_switch(Temp, JTab, Labels) ->
+ #jmp_switch{temp=Temp, jtab=JTab, labels=Labels}.
+%% is_jmp_switch(Insn) -> is_insn_type(Insn, jmp_switch).
+jmp_switch_temp(#jmp_switch{temp=Temp}) -> Temp.
+jmp_switch_jtab(#jmp_switch{jtab=JTab}) -> JTab.
+%% jmp_switch_labels(#jmp_switch{labels=Labels}) -> Labels.
+
+mk_label(Label) -> #label{label=Label}.
+is_label(Insn) -> is_insn_type(Insn, label).
+label_label(#label{label=Label}) -> Label.
+
+mk_lea(Mem, Temp) -> #lea{mem=Mem, temp=Temp}.
+%% is_lea(Insn) -> is_insn_type(Insn, lea).
+lea_mem(#lea{mem=Mem}) -> Mem.
+lea_temp(#lea{temp=Temp}) -> Temp.
+
+mk_move(Src, Dst) -> #move{src=Src, dst=Dst}.
+is_move(Insn) -> is_insn_type(Insn, move).
+move_src(#move{src=Src}) -> Src.
+move_dst(#move{dst=Dst}) -> Dst.
+
+mk_move64(Imm, Dst) -> #move64{imm=Imm, dst=Dst}.
+%% is_move64(Insn) -> is_insn_type(Insn, move64).
+move64_src(#move64{imm=Imm}) -> Imm.
+move64_dst(#move64{dst=Dst}) -> Dst.
+
+mk_movsx(Src, Dst) -> #movsx{src=Src, dst=Dst}.
+%% is_movsx(Insn) -> is_insn_type(Insn, movsx).
+movsx_src(#movsx{src=Src}) -> Src.
+movsx_dst(#movsx{dst=Dst}) -> Dst.
+
+mk_movzx(Src, Dst) -> #movzx{src=Src, dst=Dst}.
+%% is_movzx(Insn) -> is_insn_type(Insn, movzx).
+movzx_src(#movzx{src=Src}) -> Src.
+movzx_dst(#movzx{dst=Dst}) -> Dst.
+
+mk_pseudo_call(Fun, SDesc, ContLab, Linkage) ->
+ check_linkage(Linkage),
+ #pseudo_call{'fun'=Fun, sdesc=SDesc, contlab=ContLab, linkage=Linkage}.
+%% is_pseudo_call(Insn) -> is_insn_type(Insn, pseudo_call).
+pseudo_call_fun(#pseudo_call{'fun'=Fun}) -> Fun.
+pseudo_call_sdesc(#pseudo_call{sdesc=SDesc}) -> SDesc.
+pseudo_call_contlab(#pseudo_call{contlab=ContLab}) -> ContLab.
+pseudo_call_linkage(#pseudo_call{linkage=Linkage}) -> Linkage.
+
+mk_pseudo_jcc(Cc, TrueLabel, FalseLabel, Pred) -> % 'smart' constructor
+ if Pred >= 0.5 ->
+ mk_pseudo_jcc_simple(neg_cc(Cc), FalseLabel, TrueLabel, 1.0-Pred);
+ true ->
+ mk_pseudo_jcc_simple(Cc, TrueLabel, FalseLabel, Pred)
+ end.
+neg_cc(Cc) ->
+ case Cc of
+ 'e' -> 'ne'; % ==, !=
+ 'ne' -> 'e'; % !=, ==
+ 'g' -> 'le'; % >, <=
+ 'a' -> 'be'; % >u, <=u
+ 'ge' -> 'l'; % >=, <
+ 'ae' -> 'b'; % >=u, <u
+ 'l' -> 'ge'; % <, >=
+ 'b' -> 'ae'; % <u, >=u
+ 'le' -> 'g'; % <=, >
+ 'be' -> 'a'; % <=u, >u
+ 'o' -> 'no'; % overflow, not_overflow
+ 'no' -> 'o'; % not_overflow, overflow
+ _ -> exit({?MODULE, {"unknown cc", Cc}})
+ end.
+mk_pseudo_jcc_simple(Cc, TrueLabel, FalseLabel, Pred) ->
+ #pseudo_jcc{cc=Cc, true_label=TrueLabel, false_label=FalseLabel, pred=Pred}.
+%% is_pseudo_jcc(Insn) -> is_insn_type(Insn, pseudo_jcc).
+%% pseudo_jcc_cc(#pseudo_jcc{cc=Cc}) -> Cc.
+%% pseudo_jcc_true_label(#pseudo_jcc{true_label=TrueLabel}) -> TrueLabel.
+%% pseudo_jcc_false_label(#pseudo_jcc{false_label=FalseLabel}) -> FalseLabel.
+%% pseudo_jcc_pred(#pseudo_jcc{pred=Pred}) -> Pred.
+
+mk_pseudo_spill(List) ->
+ #pseudo_spill{args=List}.
+
+mk_pseudo_tailcall(Fun, Arity, StkArgs, Linkage) ->
+ check_linkage(Linkage),
+ #pseudo_tailcall{'fun'=Fun, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
+%% is_pseudo_tailcall(Insn) -> is_insn_type(Insn, pseudo_tailcall).
+pseudo_tailcall_fun(#pseudo_tailcall{'fun'=Fun}) -> Fun.
+%% pseudo_tailcall_arity(#pseudo_tailcall{arity=Arity}) -> Arity.
+pseudo_tailcall_stkargs(#pseudo_tailcall{stkargs=StkArgs}) -> StkArgs.
+pseudo_tailcall_linkage(#pseudo_tailcall{linkage=Linkage}) -> Linkage.
+
+mk_pseudo_tailcall_prepare() -> #pseudo_tailcall_prepare{}.
+%% is_pseudo_tailcall_prepare(Insn) -> is_insn_type(Insn, pseudo_tailcall_prepare).
+
+mk_push(Src) -> #push{src=Src}.
+%% is_push(Insn) -> is_insn_type(Insn, push).
+push_src(#push{src=Src}) -> Src.
+
+%% mk_pop(Dst) -> #pop{dst=Dst}.
+%% is_push(Insn) -> is_insn_type(Insn, push).
+pop_dst(#pop{dst=Dst}) -> Dst.
+
+mk_ret(NPop) -> #ret{npop=NPop}.
+%% is_ret(Insn) -> is_insn_type(Insn, ret).
+ret_npop(#ret{npop=NPop}) -> NPop.
+
+mk_shift(ShiftOp, Src, Dst) ->
+ #shift{shiftop=ShiftOp, src=Src, dst=Dst}.
+%% is_shift(Insn) -> is_insn_type(Insn, shift).
+shift_op(#shift{shiftop=ShiftOp}) -> ShiftOp.
+shift_src(#shift{src=Src}) -> Src.
+shift_dst(#shift{dst=Dst}) -> Dst.
+
+mk_defun(MFA, Formals, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
+ #defun{mfa=MFA, formals=Formals, code=Code, data=Data,
+ isclosure=IsClosure, isleaf=IsLeaf,
+ var_range=VarRange, label_range=LabelRange}.
+defun_mfa(#defun{mfa=MFA}) -> MFA.
+defun_formals(#defun{formals=Formals}) -> Formals.
+defun_is_closure(#defun{isclosure=IsClosure}) -> IsClosure.
+defun_is_leaf(#defun{isleaf=IsLeaf}) -> IsLeaf.
+defun_code(#defun{code=Code}) -> Code.
+defun_data(#defun{data=Data}) -> Data.
+defun_var_range(#defun{var_range=VarRange}) -> VarRange.
+%% defun_label_range(#defun{label_range=LabelRange}) -> LabelRange.
+
+%% highest_temp(Code) ->
+%% highest_temp(Code,0).
+%%
+%% highest_temp([I|Is],Max) ->
+%% Defs = hipe_x86_defuse:insn_def(I),
+%% Uses = hipe_x86_defuse:insn_use(I),
+%% highest_temp(Is,new_max(Defs++Uses,Max));
+%% highest_temp([],Max) ->
+%% Max.
+%%
+%% new_max([V|Vs],Max) ->
+%% case is_temp(V) of
+%% true ->
+%% TReg = temp_reg(V),
+%% if TReg > Max ->
+%% new_max(Vs, TReg);
+%% true ->
+%% new_max(Vs, Max)
+%% end;
+%% false ->
+%% new_max(Vs, Max)
+%% end;
+%% new_max([],Max) -> Max.
diff --git a/lib/hipe/x86/hipe_x86.hrl b/lib/hipe/x86/hipe_x86.hrl
new file mode 100644
index 0000000000..3d22fb381f
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86.hrl
@@ -0,0 +1,116 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% concrete representation of 2-address pseudo-x86 code
+
+%%%--------------------------------------------------------------------
+%%% x86 operands:
+%%%
+%%% int32 ::= <a 32-bit integer>
+%%% reg ::= <token from hipe_x86_registers module>
+%%% type ::= 'tagged' | 'untagged'
+%%% label ::= <an integer>
+%%% label_type ::= 'label' | 'constant'
+%%% aluop ::= <an atom denoting a binary alu op>
+%%% term ::= <any Erlang term>
+%%% cc ::= <an atom denoting a condition code>
+%%% pred ::= <a real number between 0.0 and 1.0 inclusive>
+%%% npop ::= <a 32-bit natural number which is a multiple of 4>
+%%%
+%%% temp ::= {x86_temp, reg, type, allocatable}
+%%% allocatable ::= 'true' | 'false'
+%%%
+%%% imm ::= {x86_imm, value}
+%%% value ::= int32 | atom | {label, label_type}
+%%%
+%%% mem ::= {x86_mem, base, off, mem_type}
+%%% base ::= temp | [] (XXX BUG: not quite true before RA)
+%%% off ::= imm | temp
+%%% mem_type ::= 'byte' | 'int16' (only valid with mov{s,z}x)
+%%% | type
+%%%
+%%% src ::= temp | mem | imm
+%%% dst ::= temp | mem
+%%% arg ::= src
+%%% args ::= <list of arg>
+%%%
+%%% mfa ::= {x86_mfa, atom, atom, byte}
+%%% prim ::= {x86_prim, atom}
+%%% fun ::= mfa | prim | temp | mem
+%%%
+%%% jtab ::= label (equiv. to {x86_imm,{label,'constant'}})
+%%%
+%%% sdesc ::= {x86_sdesc, exnlab, fsize, arity, live}
+%%% exnlab ::= [] | label
+%%% fsize ::= <int32> (frame size in words)
+%%% live ::= <tuple of int32> (word offsets)
+%%% arity ::= int32
+
+-record(x86_temp, {reg, type, allocatable}).
+-record(x86_imm, {value}).
+-record(x86_mem, {base, off, type}).
+-record(x86_fpreg, {reg, pseudo}).
+-record(x86_mfa, {m::atom(), f::atom(), a::arity()}).
+-record(x86_prim, {prim}).
+-record(x86_sdesc, {exnlab, fsize, arity::arity(), live::tuple()}).
+
+%%% Basic instructions.
+%%% These follow the AT&T convention, i.e. op src,dst (dst := dst op src)
+%%% After register allocation, at most one operand in a binary
+%%% instruction (alu, cmp, move) may denote a memory cell.
+%%% After frame allocation, every temp must denote a physical register.
+
+-record(alu, {aluop, src, dst}).
+-record(call, {'fun', sdesc, linkage}).
+-record(cmovcc, {cc, src, dst}).
+-record(cmp, {src, dst}). % a 'sub' alu which doesn't update dst
+-record(comment, {term}).
+-record(fmove, {src, dst}).
+-record(fp_binop, {op, src, dst}).
+-record(fp_unop, {op, arg}). % arg may be [] :-(
+-record(imul, {imm_opt, src, temp}). % imm_opt:[]|imm, src:temp|mem
+-record(jcc, {cc, label}).
+-record(jmp_fun, {'fun', linkage}). % tailcall, direct or indirect
+-record(jmp_label, {label}). % local jmp, direct
+-record(jmp_switch, {temp, jtab, labels}). % local jmp, indirect
+-record(label, {label}).
+-record(lea, {mem, temp}).
+-record(move, {src, dst}).
+-record(move64, {imm, dst}).
+-record(movsx, {src, dst}).
+-record(movzx, {src, dst}).
+-record(pseudo_call, {'fun', sdesc, contlab, linkage}).
+-record(pseudo_jcc, {cc, true_label, false_label, pred}).
+-record(pseudo_spill, {args=[]}).
+-record(pseudo_tailcall, {'fun', arity, stkargs, linkage}).
+-record(pseudo_tailcall_prepare, {}).
+-record(push, {src}).
+-record(pop, {dst}).
+-record(ret, {npop}). % EAX is live-in
+-record(shift, {shiftop, src, dst}).
+-record(test, {src, dst}).
+
+%%% Function definitions.
+
+-include("../misc/hipe_consttab.hrl").
+
+-record(defun, {mfa :: mfa(), formals, code,
+ data :: hipe_consttab(),
+ isclosure :: boolean(),
+ isleaf :: boolean(),
+ var_range, label_range}).
diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl
new file mode 100644
index 0000000000..4e65736db3
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_assemble.erl
@@ -0,0 +1,1014 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% HiPE/x86 assembler
+%%%
+%%% TODO:
+%%% - Simplify combine_label_maps and mk_data_relocs.
+%%% - Move find_const to hipe_pack_constants?
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_ASSEMBLE, hipe_amd64_assemble).
+-define(HIPE_X86_ENCODE, hipe_amd64_encode).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_PP, hipe_amd64_pp).
+-ifdef(AMD64_SIMULATE_NSP).
+-define(X86_SIMULATE_NSP, ?AMD64_SIMULATE_NSP).
+-endif.
+-define(EAX, rax).
+-define(REGArch, reg64).
+-define(RMArch, rm64).
+-define(EA_DISP32_ABSOLUTE, ea_disp32_sindex).
+-else.
+-define(HIPE_X86_ASSEMBLE, hipe_x86_assemble).
+-define(HIPE_X86_ENCODE, hipe_x86_encode).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_PP, hipe_x86_pp).
+-define(EAX, eax).
+-define(REGArch, reg32).
+-define(RMArch, rm32).
+-define(EA_DISP32_ABSOLUTE, ea_disp32).
+-endif.
+
+-module(?HIPE_X86_ASSEMBLE).
+-export([assemble/4]).
+
+-define(DEBUG,true).
+
+-include("../main/hipe.hrl").
+-include("../x86/hipe_x86.hrl").
+-include("../../kernel/src/hipe_ext_format.hrl").
+-include("../rtl/hipe_literals.hrl").
+-include("../misc/hipe_sdi.hrl").
+-undef(ASSERT).
+-define(ASSERT(G), if G -> [] ; true -> exit({assertion_failed,?MODULE,?LINE,??G}) end).
+
+assemble(CompiledCode, Closures, Exports, Options) ->
+ ?when_option(time, Options, ?start_timer("x86 assembler")),
+ print("****************** Assembling *******************\n", [], Options),
+ %%
+ Code = [{MFA,
+ hipe_x86:defun_code(Defun),
+ hipe_x86:defun_data(Defun)}
+ || {MFA, Defun} <- CompiledCode],
+ %%
+ {ConstAlign,ConstSize,ConstMap,RefsFromConsts} =
+ hipe_pack_constants:pack_constants(Code, ?HIPE_X86_REGISTERS:alignment()),
+ %%
+ {CodeSize,CodeBinary,AccRefs,LabelMap,ExportMap} =
+ encode(translate(Code, ConstMap, Options), Options),
+ print("Total num bytes=~w\n", [CodeSize], Options),
+ %% put(code_size, CodeSize),
+ %% put(const_size, ConstSize),
+ %% ?when_option(verbose, Options,
+ %% ?debug_msg("Constants are ~w bytes\n",[ConstSize])),
+ %%
+ SC = hipe_pack_constants:slim_constmap(ConstMap),
+ DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap),
+ SSE = slim_sorted_exportmap(ExportMap,Closures,Exports),
+ SlimRefs = hipe_pack_constants:slim_refs(AccRefs),
+ Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC},
+ ConstAlign, ConstSize,
+ SC,
+ DataRelocs, % nee LM, LabelMap
+ SSE,
+ CodeSize,CodeBinary,SlimRefs,
+ 0,[] % ColdCodeSize, SlimColdRefs
+ ]),
+ %%
+ %% ?when_option(time, Options, ?stop_timer("x86 assembler")),
+ Bin.
+
+%%%
+%%% Assembly Pass 1.
+%%% Process initial {MFA,Code,Data} list.
+%%% Translate each MFA's body, choosing operand & instruction kinds.
+%%%
+%%% Assembly Pass 2.
+%%% Perform short/long form optimisation for jumps.
+%%% Build LabelMap for each MFA.
+%%%
+%%% Result is {MFA,NewCode,CodeSize,LabelMap} list.
+%%%
+
+translate(Code, ConstMap, Options) ->
+ translate_mfas(Code, ConstMap, [], Options).
+
+translate_mfas([{MFA,Insns,_Data}|Code], ConstMap, NewCode, Options) ->
+ {NewInsns,CodeSize,LabelMap} =
+ translate_insns(Insns, {MFA,ConstMap}, hipe_sdi:pass1_init(), 0, [], Options),
+ translate_mfas(Code, ConstMap, [{MFA,NewInsns,CodeSize,LabelMap}|NewCode], Options);
+translate_mfas([], _ConstMap, NewCode, _Options) ->
+ lists:reverse(NewCode).
+
+translate_insns([I|Insns], Context, SdiPass1, Address, NewInsns, Options) ->
+ NewIs = translate_insn(I, Context, Options),
+ add_insns(NewIs, Insns, Context, SdiPass1, Address, NewInsns, Options);
+translate_insns([], _Context, SdiPass1, Address, NewInsns, _Options) ->
+ {LabelMap,CodeSizeIncr} = hipe_sdi:pass2(SdiPass1),
+ {lists:reverse(NewInsns), Address+CodeSizeIncr, LabelMap}.
+
+add_insns([I|Is], Insns, Context, SdiPass1, Address, NewInsns, Options) ->
+ NewSdiPass1 =
+ case I of
+ {'.label',L,_} ->
+ hipe_sdi:pass1_add_label(SdiPass1, Address, L);
+ {jcc_sdi,{_,{label,L}},_} ->
+ SdiInfo = #sdi_info{incr=(6-2),lb=(-128)+2,ub=127+2},
+ hipe_sdi:pass1_add_sdi(SdiPass1, Address, L, SdiInfo);
+ {jmp_sdi,{{label,L}},_} ->
+ SdiInfo = #sdi_info{incr=(5-2),lb=(-128)+2,ub=127+2},
+ hipe_sdi:pass1_add_sdi(SdiPass1, Address, L, SdiInfo);
+ _ ->
+ SdiPass1
+ end,
+ Address1 = Address + insn_size(I),
+ add_insns(Is, Insns, Context, NewSdiPass1, Address1, [I|NewInsns], Options);
+add_insns([], Insns, Context, SdiPass1, Address, NewInsns, Options) ->
+ translate_insns(Insns, Context, SdiPass1, Address, NewInsns, Options).
+
+insn_size(I) ->
+ case I of
+ {'.label',_,_} -> 0;
+ {'.sdesc',_,_} -> 0;
+ {jcc_sdi,_,_} -> 2;
+ {jmp_sdi,_,_} -> 2;
+ {Op,Arg,_Orig} -> ?HIPE_X86_ENCODE:insn_sizeof(Op, Arg)
+ end.
+
+translate_insn(I, Context, Options) ->
+ case I of
+ #alu{} ->
+ Arg = resolve_alu_args(hipe_x86:alu_src(I), hipe_x86:alu_dst(I), Context),
+ [{hipe_x86:alu_op(I), Arg, I}];
+ #call{} ->
+ translate_call(I);
+ #cmovcc{} ->
+ {Dst,Src} = resolve_move_args(
+ hipe_x86:cmovcc_src(I), hipe_x86:cmovcc_dst(I),
+ Context),
+ CC = {cc,?HIPE_X86_ENCODE:cc(hipe_x86:cmovcc_cc(I))},
+ Arg = {CC,Dst,Src},
+ [{cmovcc, Arg, I}];
+ #cmp{} ->
+ Arg = resolve_alu_args(hipe_x86:cmp_src(I), hipe_x86:cmp_dst(I), Context),
+ [{cmp, Arg, I}];
+ #comment{} ->
+ [];
+ #fmove{} ->
+ {Op,Arg} = resolve_sse2_fmove_args(hipe_x86:fmove_src(I),
+ hipe_x86:fmove_dst(I)),
+ [{Op, Arg, I}];
+ #fp_binop{} ->
+ case proplists:get_bool(x87, Options) of
+ true -> % x87
+ Arg = resolve_x87_binop_args(hipe_x86:fp_binop_src(I),
+ hipe_x86:fp_binop_dst(I)),
+ [{hipe_x86:fp_binop_op(I), Arg, I}];
+ false -> % sse2
+ Arg = resolve_sse2_binop_args(hipe_x86:fp_binop_src(I),
+ hipe_x86:fp_binop_dst(I)),
+ [{resolve_sse2_op(hipe_x86:fp_binop_op(I)), Arg, I}]
+ end;
+ #fp_unop{} ->
+ case proplists:get_bool(x87, Options) of
+ true -> % x87
+ Arg = resolve_x87_unop_arg(hipe_x86:fp_unop_arg(I)),
+ [{hipe_x86:fp_unop_op(I), Arg, I}];
+ false -> % sse2
+ case hipe_x86:fp_unop_op(I) of
+ 'fchs' ->
+ Arg = resolve_sse2_fchs_arg(hipe_x86:fp_unop_arg(I)),
+ [{'xorpd', Arg, I}];
+ 'fwait' -> % no op on sse2, magic on x87
+ []
+ end
+ end;
+ #imul{} ->
+ translate_imul(I, Context);
+ #jcc{} ->
+ Cc = {cc,?HIPE_X86_ENCODE:cc(hipe_x86:jcc_cc(I))},
+ Label = translate_label(hipe_x86:jcc_label(I)),
+ [{jcc_sdi, {Cc,Label}, I}];
+ #jmp_fun{} ->
+ %% call and jmp are patched the same, so no need to distinguish
+ %% call from tailcall
+ PatchTypeExt =
+ case hipe_x86:jmp_fun_linkage(I) of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ Arg = translate_fun(hipe_x86:jmp_fun_fun(I), PatchTypeExt),
+ [{jmp, {Arg}, I}];
+ #jmp_label{} ->
+ Arg = translate_label(hipe_x86:jmp_label_label(I)),
+ [{jmp_sdi, {Arg}, I}];
+ #jmp_switch{} ->
+ RM32 = resolve_jmp_switch_arg(I, Context),
+ [{jmp, {RM32}, I}];
+ #label{} ->
+ [{'.label', hipe_x86:label_label(I), I}];
+ #lea{} ->
+ Arg = resolve_lea_args(hipe_x86:lea_mem(I), hipe_x86:lea_temp(I)),
+ [{lea, Arg, I}];
+ #move{} ->
+ Arg = resolve_move_args(hipe_x86:move_src(I), hipe_x86:move_dst(I),
+ Context),
+ [{mov, Arg, I}];
+ #move64{} ->
+ translate_move64(I, Context);
+ #movsx{} ->
+ Arg = resolve_movx_args(hipe_x86:movsx_src(I), hipe_x86:movsx_dst(I)),
+ [{movsx, Arg, I}];
+ #movzx{} ->
+ Arg = resolve_movx_args(hipe_x86:movzx_src(I), hipe_x86:movzx_dst(I)),
+ [{movzx, Arg, I}];
+ %% pseudo_call: eliminated before assembly
+ %% pseudo_jcc: eliminated before assembly
+ %% pseudo_tailcall: eliminated before assembly
+ %% pseudo_tailcall_prepare: eliminated before assembly
+ #pop{} ->
+ Arg = translate_dst(hipe_x86:pop_dst(I)),
+ [{pop, {Arg}, I}];
+ #push{} ->
+ Arg = translate_src(hipe_x86:push_src(I), Context),
+ [{push, {Arg}, I}];
+ #ret{} ->
+ translate_ret(I);
+ #shift{} ->
+ Arg = resolve_shift_args(hipe_x86:shift_src(I), hipe_x86:shift_dst(I), Context),
+ [{hipe_x86:shift_op(I), Arg, I}];
+ #test{} ->
+ Arg = resolve_test_args(hipe_x86:test_src(I), hipe_x86:test_dst(I), Context),
+ [{test, Arg, I}]
+ end.
+
+-ifdef(X86_SIMULATE_NSP).
+-ifdef(HIPE_AMD64).
+translate_call(I) ->
+ WordSize = hipe_amd64_registers:wordsize(),
+ RegSP = 2#100, % esp/rsp
+ TempSP = hipe_x86:mk_temp(RegSP, untagged),
+ FunOrig = hipe_x86:call_fun(I),
+ Fun =
+ case FunOrig of
+ #x86_mem{base=#x86_temp{reg=4}, off=#x86_imm{value=Off}} ->
+ FunOrig#x86_mem{off=#x86_imm{value=Off+WordSize}};
+ _ -> FunOrig
+ end,
+ RegRA =
+ begin
+ RegTemp0 = hipe_amd64_registers:temp0(),
+ RegTemp1 = hipe_amd64_registers:temp1(),
+ case Fun of
+ #x86_temp{reg=RegTemp0} -> RegTemp1;
+ #x86_mem{base=#x86_temp{reg=RegTemp0}} -> RegTemp1;
+ _ -> RegTemp0
+ end
+ end,
+ TempRA = hipe_x86:mk_temp(RegRA, untagged),
+ PatchTypeExt =
+ case hipe_x86:call_linkage(I) of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ JmpArg = translate_fun(Fun, PatchTypeExt),
+ I4 = {'.sdesc', hipe_x86:call_sdesc(I), #comment{term=sdesc}},
+ I3 = {jmp, {JmpArg}, #comment{term=call}},
+ Size3 = hipe_amd64_encode:insn_sizeof(jmp, {JmpArg}),
+ MovArgs = {mem_to_rmArch(hipe_x86:mk_mem(TempSP,
+ hipe_x86:mk_imm(0),
+ untagged)),
+ temp_to_regArch(TempRA)},
+ I2 = {mov, MovArgs, #comment{term=call}},
+ Size2 = hipe_amd64_encode:insn_sizeof(mov, MovArgs),
+ I1 = {lea, {temp_to_regArch(TempRA),
+ {ea, hipe_amd64_encode:ea_disp32_rip(Size2+Size3)}},
+ #comment{term=call}},
+ I0 = {sub, {temp_to_rmArch(TempSP), {imm8,WordSize}}, I},
+ [I0,I1,I2,I3,I4].
+-else.
+translate_call(I) ->
+ WordSize = ?HIPE_X86_REGISTERS:wordsize(),
+ RegSP = 2#100, % esp/rsp
+ TempSP = hipe_x86:mk_temp(RegSP, untagged),
+ FunOrig = hipe_x86:call_fun(I),
+ Fun =
+ case FunOrig of
+ #x86_mem{base=#x86_temp{reg=4}, off=#x86_imm{value=Off}} ->
+ FunOrig#x86_mem{off=#x86_imm{value=Off+WordSize}};
+ _ -> FunOrig
+ end,
+ PatchTypeExt =
+ case hipe_x86:call_linkage(I) of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ JmpArg = translate_fun(Fun, PatchTypeExt),
+ I3 = {'.sdesc', hipe_x86:call_sdesc(I), #comment{term=sdesc}},
+ I2 = {jmp, {JmpArg}, #comment{term=call}},
+ Size2 = ?HIPE_X86_ENCODE:insn_sizeof(jmp, {JmpArg}),
+ I1 = {mov, {mem_to_rmArch(hipe_x86:mk_mem(TempSP,
+ hipe_x86:mk_imm(0),
+ untagged)),
+ {imm32,{?X86ABSPCREL,4+Size2}}},
+ #comment{term=call}},
+ I0 = {sub, {temp_to_rmArch(TempSP), {imm8,WordSize}}, I},
+ [I0,I1,I2,I3].
+-endif.
+
+translate_ret(I) ->
+ NPOP = hipe_x86:ret_npop(I) + ?HIPE_X86_REGISTERS:wordsize(),
+ RegSP = 2#100, % esp/rsp
+ TempSP = hipe_x86:mk_temp(RegSP, untagged),
+ RegRA = 2#011, % ebx/rbx
+ TempRA = hipe_x86:mk_temp(RegRA, untagged),
+ [{mov,
+ {temp_to_regArch(TempRA),
+ mem_to_rmArch(hipe_x86:mk_mem(TempSP,
+ hipe_x86:mk_imm(0),
+ untagged))},
+ I},
+ {add,
+ {temp_to_rmArch(TempSP),
+ case NPOP < 128 of
+ true -> {imm8,NPOP};
+ false -> {imm32,NPOP}
+ end},
+ #comment{term=ret}},
+ {jmp,
+ {temp_to_rmArch(TempRA)},
+ #comment{term=ret}}].
+
+-else. % not X86_SIMULATE_NSP
+
+translate_call(I) ->
+ %% call and jmp are patched the same, so no need to distinguish
+ %% call from tailcall
+ PatchTypeExt =
+ case hipe_x86:call_linkage(I) of
+ remote -> ?CALL_REMOTE;
+ not_remote -> ?CALL_LOCAL
+ end,
+ Arg = translate_fun(hipe_x86:call_fun(I), PatchTypeExt),
+ SDesc = hipe_x86:call_sdesc(I),
+ [{call, {Arg}, I}, {'.sdesc', SDesc, #comment{term=sdesc}}].
+
+translate_ret(I) ->
+ Arg =
+ case hipe_x86:ret_npop(I) of
+ 0 -> {};
+ N -> {{imm16,N}}
+ end,
+ [{ret, Arg, I}].
+
+-endif. % X86_SIMULATE_NSP
+
+translate_imul(I, Context) ->
+ Temp = temp_to_regArch(hipe_x86:imul_temp(I)),
+ Src = temp_or_mem_to_rmArch(hipe_x86:imul_src(I)),
+ Args =
+ case hipe_x86:imul_imm_opt(I) of
+ [] -> {Temp,Src};
+ Imm -> {Temp,Src,translate_imm(Imm, Context, true)}
+ end,
+ [{'imul', Args, I}].
+
+temp_or_mem_to_rmArch(Src) ->
+ case Src of
+ #x86_temp{} -> temp_to_rmArch(Src);
+ #x86_mem{} -> mem_to_rmArch(Src)
+ end.
+
+translate_label(Label) when is_integer(Label) ->
+ {label,Label}. % symbolic, since offset is not yet computable
+
+translate_fun(Arg, PatchTypeExt) ->
+ case Arg of
+ #x86_temp{} ->
+ temp_to_rmArch(Arg);
+ #x86_mem{} ->
+ mem_to_rmArch(Arg);
+ #x86_mfa{m=M,f=F,a=A} ->
+ {rel32,{PatchTypeExt,{M,F,A}}};
+ #x86_prim{prim=Prim} ->
+ {rel32,{PatchTypeExt,Prim}}
+ end.
+
+translate_src(Src, Context) ->
+ case Src of
+ #x86_imm{} ->
+ translate_imm(Src, Context, true);
+ _ ->
+ translate_dst(Src)
+ end.
+
+%%% MayTrunc8 controls whether negative Imm8s should be truncated
+%%% to 8 bits or not. Truncation should always be done, except when
+%%% the caller will widen the Imm8 to an Imm32 or Imm64.
+translate_imm(#x86_imm{value=Imm}, Context, MayTrunc8) ->
+ if is_atom(Imm) ->
+ {imm32,{?LOAD_ATOM,Imm}};
+ is_integer(Imm) ->
+ case (Imm =< 127) and (Imm >= -128) of
+ true ->
+ Imm8 =
+ case MayTrunc8 of
+ true -> Imm band 16#FF;
+ false -> Imm
+ end,
+ {imm8,Imm8};
+ false ->
+ {imm32,Imm}
+ end;
+ true ->
+ Val =
+ case Imm of
+ {Label,constant} ->
+ {MFA,ConstMap} = Context,
+ ConstNo = find_const({MFA,Label}, ConstMap),
+ {constant,ConstNo};
+ {Label,closure} ->
+ {closure,Label};
+ {Label,c_const} ->
+ {c_const,Label}
+ end,
+ {imm32,{?LOAD_ADDRESS,Val}}
+ end.
+
+translate_dst(Dst) ->
+ case Dst of
+ #x86_temp{} ->
+ temp_to_regArch(Dst);
+ #x86_mem{type='double'} ->
+ mem_to_rm64fp(Dst);
+ #x86_mem{} ->
+ mem_to_rmArch(Dst);
+ #x86_fpreg{} ->
+ fpreg_to_stack(Dst)
+ end.
+
+%%%
+%%% Assembly Pass 3.
+%%% Process final {MFA,Code,CodeSize,LabelMap} list from pass 2.
+%%% Translate to a single binary code segment.
+%%% Collect relocation patches.
+%%% Build ExportMap (MFA-to-address mapping).
+%%% Combine LabelMaps to a single one (for mk_data_relocs/2 compatibility).
+%%% Return {CombinedCodeSize,BinaryCode,Relocs,CombinedLabelMap,ExportMap}.
+%%%
+
+encode(Code, Options) ->
+ CodeSize = compute_code_size(Code, 0),
+ ExportMap = build_export_map(Code, 0, []),
+ {AccCode,Relocs} = encode_mfas(Code, 0, [], [], Options),
+ CodeBinary = list_to_binary(lists:reverse(AccCode)),
+ ?ASSERT(CodeSize =:= byte_size(CodeBinary)),
+ CombinedLabelMap = combine_label_maps(Code, 0, gb_trees:empty()),
+ {CodeSize,CodeBinary,Relocs,CombinedLabelMap,ExportMap}.
+
+nr_pad_bytes(Address) -> (4 - (Address rem 4)) rem 4. % XXX: 16 or 32 instead?
+
+align_entry(Address) -> Address + nr_pad_bytes(Address).
+
+compute_code_size([{_MFA,_Insns,CodeSize,_LabelMap}|Code], Size) ->
+ compute_code_size(Code, align_entry(Size+CodeSize));
+compute_code_size([], Size) -> Size.
+
+build_export_map([{{M,F,A},_Insns,CodeSize,_LabelMap}|Code], Address, ExportMap) ->
+ build_export_map(Code, align_entry(Address+CodeSize), [{Address,M,F,A}|ExportMap]);
+build_export_map([], _Address, ExportMap) -> ExportMap.
+
+combine_label_maps([{MFA,_Insns,CodeSize,LabelMap}|Code], Address, CLM) ->
+ NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM),
+ combine_label_maps(Code, align_entry(Address+CodeSize), NewCLM);
+combine_label_maps([], _Address, CLM) -> CLM.
+
+merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) ->
+ NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM),
+ merge_label_map(Rest, MFA, Address, NewCLM);
+merge_label_map([], _MFA, _Address, CLM) -> CLM.
+
+encode_mfas([{MFA,Insns,CodeSize,LabelMap}|Code], Address, AccCode, Relocs, Options) ->
+ print("Generating code for:~w\n", [MFA], Options),
+ print("Offset | Opcode | Instruction\n", [], Options),
+ {Address1,Relocs1,AccCode1} =
+ encode_insns(Insns, Address, Address, LabelMap, Relocs, AccCode, Options),
+ ExpectedAddress = align_entry(Address + CodeSize),
+ ?ASSERT(Address1 =:= ExpectedAddress),
+ print("Finished.\n\n", [], Options),
+ encode_mfas(Code, Address1, AccCode1, Relocs1, Options);
+encode_mfas([], _Address, AccCode, Relocs, _Options) ->
+ {AccCode, Relocs}.
+
+encode_insns([I|Insns], Address, FunAddress, LabelMap, Relocs, AccCode, Options) ->
+ case I of
+ {'.label',L,_} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ ?ASSERT(Address =:= LabelAddress), % sanity check
+ print_insn(Address, [], I, Options),
+ encode_insns(Insns, Address, FunAddress, LabelMap, Relocs, AccCode, Options);
+ {'.sdesc',SDesc,_} ->
+ #x86_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live} = SDesc,
+ ExnRA =
+ case ExnLab of
+ [] -> []; % don't cons up a new one
+ ExnLab -> gb_trees:get(ExnLab, LabelMap) + FunAddress
+ end,
+ Reloc = {?SDESC, Address,
+ ?STACK_DESC(ExnRA, FSize, Arity, Live)},
+ encode_insns(Insns, Address, FunAddress, LabelMap, [Reloc|Relocs], AccCode, Options);
+ _ ->
+ {Op,Arg,_} = fix_jumps(I, Address, FunAddress, LabelMap),
+ {Bytes, NewRelocs} = ?HIPE_X86_ENCODE:insn_encode(Op, Arg, Address),
+ print_insn(Address, Bytes, I, Options),
+ Segment = list_to_binary(Bytes),
+ Size = byte_size(Segment),
+ NewAccCode = [Segment|AccCode],
+ encode_insns(Insns, Address+Size, FunAddress, LabelMap, NewRelocs++Relocs, NewAccCode, Options)
+ end;
+encode_insns([], Address, FunAddress, LabelMap, Relocs, AccCode, Options) ->
+ case nr_pad_bytes(Address) of
+ 0 ->
+ {Address,Relocs,AccCode};
+ NrPadBytes -> % triggers at most once per function body
+ Padding = lists:duplicate(NrPadBytes, {nop,{},#comment{term=padding}}),
+ encode_insns(Padding, Address, FunAddress, LabelMap, Relocs, AccCode, Options)
+ end.
+
+fix_jumps(I, InsnAddress, FunAddress, LabelMap) ->
+ case I of
+ {jcc_sdi,{CC,{label,L}},OrigI} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ ShortOffset = LabelAddress - (InsnAddress + 2),
+ if is_integer(ShortOffset), ShortOffset >= -128, ShortOffset =< 127 ->
+ {jcc,{CC,{rel8,ShortOffset band 16#FF}},OrigI};
+ true ->
+ LongOffset = LabelAddress - (InsnAddress + 6),
+ {jcc,{CC,{rel32,LongOffset}},OrigI}
+ end;
+ {jmp_sdi,{{label,L}},OrigI} ->
+ LabelAddress = gb_trees:get(L, LabelMap) + FunAddress,
+ ShortOffset = LabelAddress - (InsnAddress + 2),
+ if is_integer(ShortOffset), ShortOffset >= -128, ShortOffset =< 127 ->
+ {jmp,{{rel8,ShortOffset band 16#FF}},OrigI};
+ true ->
+ LongOffset = LabelAddress - (InsnAddress + 5),
+ {jmp,{{rel32,LongOffset}},OrigI}
+ end;
+ _ -> I
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+fpreg_to_stack(#x86_fpreg{reg=Reg}) ->
+ {fpst, Reg}.
+
+temp_to_regArch(#x86_temp{reg=Reg}) ->
+ {?REGArch, Reg}.
+
+-ifdef(HIPE_AMD64).
+temp_to_reg64(#x86_temp{reg=Reg}) ->
+ {reg64, Reg}.
+-endif.
+
+temp_to_reg32(#x86_temp{reg=Reg}) ->
+ {reg32, Reg}.
+temp_to_reg16(#x86_temp{reg=Reg}) ->
+ {reg16, Reg}.
+temp_to_reg8(#x86_temp{reg=Reg}) ->
+ {reg8, Reg}.
+
+temp_to_xmm(#x86_temp{reg=Reg}) ->
+ {xmm, Reg}.
+
+-ifdef(HIPE_AMD64).
+temp_to_rm64(#x86_temp{reg=Reg}) ->
+ {rm64, hipe_amd64_encode:rm_reg(Reg)}.
+-endif.
+
+temp_to_rmArch(#x86_temp{reg=Reg}) ->
+ {?RMArch, ?HIPE_X86_ENCODE:rm_reg(Reg)}.
+temp_to_rm64fp(#x86_temp{reg=Reg}) ->
+ {rm64fp, ?HIPE_X86_ENCODE:rm_reg(Reg)}.
+
+mem_to_ea(Mem) ->
+ EA = mem_to_ea_common(Mem),
+ {ea, EA}.
+
+mem_to_rm32(Mem) ->
+ EA = mem_to_ea_common(Mem),
+ {rm32, ?HIPE_X86_ENCODE:rm_mem(EA)}.
+
+mem_to_rmArch(Mem) ->
+ EA = mem_to_ea_common(Mem),
+ {?RMArch, ?HIPE_X86_ENCODE:rm_mem(EA)}.
+
+mem_to_rm64fp(Mem) ->
+ EA = mem_to_ea_common(Mem),
+ {rm64fp, ?HIPE_X86_ENCODE:rm_mem(EA)}.
+
+%%%%%%%%%%%%%%%%%
+mem_to_rm8(Mem) ->
+ EA = mem_to_ea_common(Mem),
+ {rm8, ?HIPE_X86_ENCODE:rm_mem(EA)}.
+
+mem_to_rm16(Mem) ->
+ EA = mem_to_ea_common(Mem),
+ {rm16, ?HIPE_X86_ENCODE:rm_mem(EA)}.
+%%%%%%%%%%%%%%%%%
+
+mem_to_ea_common(#x86_mem{base=[], off=#x86_imm{value=Off}}) ->
+ ?HIPE_X86_ENCODE:?EA_DISP32_ABSOLUTE(Off);
+mem_to_ea_common(#x86_mem{base=#x86_temp{reg=Base}, off=#x86_temp{reg=Index}}) ->
+ case Base band 2#111 of
+ 5 -> % ebp/rbp or r13
+ case Index band 2#111 of
+ 5 -> % ebp/rbp or r13
+ SINDEX = ?HIPE_X86_ENCODE:sindex(0, Index),
+ SIB = ?HIPE_X86_ENCODE:sib(Base, SINDEX),
+ ?HIPE_X86_ENCODE:ea_disp8_sib(0, SIB);
+ _ ->
+ SINDEX = ?HIPE_X86_ENCODE:sindex(0, Base),
+ SIB = ?HIPE_X86_ENCODE:sib(Index, SINDEX),
+ ?HIPE_X86_ENCODE:ea_sib(SIB)
+ end;
+ _ ->
+ SINDEX = ?HIPE_X86_ENCODE:sindex(0, Index),
+ SIB = ?HIPE_X86_ENCODE:sib(Base, SINDEX),
+ ?HIPE_X86_ENCODE:ea_sib(SIB)
+ end;
+mem_to_ea_common(#x86_mem{base=#x86_temp{reg=Base}, off=#x86_imm{value=Off}}) ->
+ if
+ Off =:= 0 ->
+ case Base of
+ 4 -> %esp, use SIB w/o disp8
+ SIB = ?HIPE_X86_ENCODE:sib(Base),
+ ?HIPE_X86_ENCODE:ea_sib(SIB);
+ 5 -> %ebp, use disp8 w/o SIB
+ ?HIPE_X86_ENCODE:ea_disp8_base(Off, Base);
+ 12 -> %r12, use SIB w/o disp8
+ SIB = ?HIPE_X86_ENCODE:sib(Base),
+ ?HIPE_X86_ENCODE:ea_sib(SIB);
+ 13 -> %r13, use disp8 w/o SIB
+ ?HIPE_X86_ENCODE:ea_disp8_base(Off, Base);
+ _ -> %neither SIB nor disp8 needed
+ ?HIPE_X86_ENCODE:ea_base(Base)
+ end;
+ Off >= -128, Off =< 127 ->
+ Disp8 = Off band 16#FF,
+ case Base of
+ 4 -> %esp, must use SIB
+ SIB = ?HIPE_X86_ENCODE:sib(Base),
+ ?HIPE_X86_ENCODE:ea_disp8_sib(Disp8, SIB);
+ 12 -> %r12, must use SIB
+ SIB = ?HIPE_X86_ENCODE:sib(Base),
+ ?HIPE_X86_ENCODE:ea_disp8_sib(Disp8, SIB);
+ _ -> %use disp8 w/o SIB
+ ?HIPE_X86_ENCODE:ea_disp8_base(Disp8, Base)
+ end;
+ true ->
+ case Base of
+ 4 -> %esp, must use SIB
+ SIB = ?HIPE_X86_ENCODE:sib(Base),
+ ?HIPE_X86_ENCODE:ea_disp32_sib(Off, SIB);
+ 12 -> %r12, must use SIB
+ SIB = ?HIPE_X86_ENCODE:sib(Base),
+ ?HIPE_X86_ENCODE:ea_disp32_sib(Off, SIB);
+ _ ->
+ ?HIPE_X86_ENCODE:ea_disp32_base(Off, Base)
+ end
+ end.
+
+%% jmp_switch
+-ifdef(HIPE_AMD64).
+resolve_jmp_switch_arg(I,�_Context) ->
+ Base = hipe_x86:temp_reg(hipe_x86:jmp_switch_jtab(I)),
+ Index = hipe_x86:temp_reg(hipe_x86:jmp_switch_temp(I)),
+ SINDEX = hipe_amd64_encode:sindex(3, Index),
+ SIB = hipe_amd64_encode:sib(Base, SINDEX),
+ EA =
+ if (Base =:= 5) or (Base =:= 13) ->
+ hipe_amd64_encode:ea_disp8_sib(0, SIB);
+ true ->
+ hipe_amd64_encode:ea_sib(SIB)
+ end,
+ {rm64,hipe_amd64_encode:rm_mem(EA)}.
+-else.
+resolve_jmp_switch_arg(I, {MFA,ConstMap}) ->
+ ConstNo = find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap),
+ Disp32 = {?LOAD_ADDRESS,{constant,ConstNo}},
+ SINDEX = ?HIPE_X86_ENCODE:sindex(2, hipe_x86:temp_reg(hipe_x86:jmp_switch_temp(I))),
+ EA = ?HIPE_X86_ENCODE:ea_disp32_sindex(Disp32, SINDEX), % this creates a SIB implicitly
+ {rm32,?HIPE_X86_ENCODE:rm_mem(EA)}.
+-endif.
+
+%% lea reg, mem
+resolve_lea_args(Src=#x86_mem{}, Dst=#x86_temp{}) ->
+ {temp_to_regArch(Dst),mem_to_ea(Src)}.
+
+resolve_sse2_op(Op) ->
+ case Op of
+ fadd -> addsd;
+ fdiv -> divsd;
+ fmul -> mulsd;
+ fsub -> subsd;
+ _ -> exit({?MODULE, unknown_sse2_operator, Op})
+ end.
+
+%% OP xmm, mem
+resolve_sse2_binop_args(Src=#x86_mem{type=double},
+ Dst=#x86_temp{type=double}) ->
+ {temp_to_xmm(Dst),mem_to_rm64fp(Src)};
+%% movsd mem, xmm
+resolve_sse2_binop_args(Src=#x86_temp{type=double},
+ Dst=#x86_mem{type=double}) ->
+ {mem_to_rm64fp(Dst),temp_to_xmm(Src)};
+%% OP xmm, xmm
+resolve_sse2_binop_args(Src=#x86_temp{type=double},
+ Dst=#x86_temp{type=double}) ->
+ {temp_to_xmm(Dst),temp_to_rm64fp(Src)}.
+
+%%% fmove -> cvtsi2sd or movsd
+resolve_sse2_fmove_args(Src, Dst) ->
+ case {Src,Dst} of
+ {#x86_temp{type=untagged}, #x86_temp{type=double}} -> % cvtsi2sd xmm, reg
+ {cvtsi2sd, {temp_to_xmm(Dst),temp_to_rmArch(Src)}};
+ {#x86_mem{type=untagged}, #x86_temp{type=double}} -> % cvtsi2sd xmm, mem
+ {cvtsi2sd, {temp_to_xmm(Dst),mem_to_rmArch(Src)}};
+ _ -> % movsd
+ {movsd, resolve_sse2_binop_args(Src, Dst)}
+ end.
+
+%%% xorpd xmm, mem
+resolve_sse2_fchs_arg(Dst=#x86_temp{type=double}) ->
+ {temp_to_xmm(Dst),
+ {rm64fp, {rm_mem, ?HIPE_X86_ENCODE:?EA_DISP32_ABSOLUTE(
+ {?LOAD_ADDRESS,
+ {c_const, sse2_fnegate_mask}})}}}.
+
+%% mov mem, imm
+resolve_move_args(#x86_imm{value=ImmSrc}, Dst=#x86_mem{type=Type}, Context) ->
+ case Type of % to support byte, int16 and int32 stores
+ byte ->
+ ByteImm = ImmSrc band 255, %to ensure that it is a bytesized imm
+ {mem_to_rm8(Dst),{imm8,ByteImm}};
+ int16 ->
+ {mem_to_rm16(Dst),{imm16,ImmSrc band 16#FFFF}};
+ int32 ->
+ {_,Imm} = translate_imm(#x86_imm{value=ImmSrc}, Context, false),
+ {mem_to_rm32(Dst),{imm32,Imm}};
+ _ ->
+ RMArch = mem_to_rmArch(Dst),
+ {_,Imm} = translate_imm(#x86_imm{value=ImmSrc}, Context, false),
+ {RMArch,{imm32,Imm}}
+ end;
+
+%% mov reg,mem
+resolve_move_args(Src=#x86_mem{type=Type}, Dst=#x86_temp{}, _Context) ->
+ case Type of
+ int32 -> % must be unsigned
+ {temp_to_reg32(Dst),mem_to_rm32(Src)};
+ _ ->
+ {temp_to_regArch(Dst),mem_to_rmArch(Src)}
+ end;
+
+%% mov mem,reg
+resolve_move_args(Src=#x86_temp{}, Dst=#x86_mem{type=Type}, _Context) ->
+ case Type of % to support byte, int16 and int32 stores
+ byte ->
+ {mem_to_rm8(Dst),temp_to_reg8(Src)};
+ int16 ->
+ {mem_to_rm16(Dst),temp_to_reg16(Src)};
+ int32 ->
+ {mem_to_rm32(Dst),temp_to_reg32(Src)};
+ tagged -> % tagged, untagged
+ {mem_to_rmArch(Dst),temp_to_regArch(Src)};
+ untagged -> % tagged, untagged
+ {mem_to_rmArch(Dst),temp_to_regArch(Src)}
+ end;
+
+%% mov reg,reg
+resolve_move_args(Src=#x86_temp{}, Dst=#x86_temp{}, _Context) ->
+ {temp_to_regArch(Dst),temp_to_rmArch(Src)};
+
+%% mov reg,imm
+resolve_move_args(Src=#x86_imm{value=_ImmSrc}, Dst=#x86_temp{}, Context) ->
+ {_,Imm} = translate_imm(Src, Context, false),
+ imm_move_args(Dst, Imm).
+
+-ifdef(HIPE_AMD64).
+imm_move_args(Dst, Imm) ->
+ if is_number(Imm), Imm >= 0 ->
+ {temp_to_reg32(Dst),{imm32,Imm}};
+ true ->
+ {temp_to_rm64(Dst),{imm32,Imm}}
+ end.
+-else.
+imm_move_args(Dst, Imm) ->
+ {temp_to_reg32(Dst),{imm32,Imm}}.
+-endif.
+
+-ifdef(HIPE_AMD64).
+translate_move64(I, Context) ->
+ Arg = resolve_move64_args(hipe_x86:move64_src(I),
+ hipe_x86:move64_dst(I),
+ Context),
+ [{mov, Arg, I}].
+
+%% mov reg,imm64
+resolve_move64_args(Src=#x86_imm{}, Dst=#x86_temp{}, Context) ->
+ {_,Imm} = translate_imm(Src, Context, false),
+ {temp_to_reg64(Dst),{imm64,Imm}}.
+-else.
+translate_move64(I, _Context) -> exit({?MODULE, I}).
+-endif.
+
+%%% mov{s,z}x
+resolve_movx_args(Src=#x86_mem{type=Type}, Dst=#x86_temp{}) ->
+ {temp_to_regArch(Dst),
+ case Type of
+ byte ->
+ mem_to_rm8(Src);
+ int16 ->
+ mem_to_rm16(Src);
+ int32 ->
+ mem_to_rm32(Src)
+ end}.
+
+%%% alu/cmp (_not_ test)
+resolve_alu_args(Src, Dst, Context) ->
+ case {Src,Dst} of
+ {#x86_imm{}, #x86_mem{}} ->
+ {mem_to_rmArch(Dst), translate_imm(Src, Context, true)};
+ {#x86_mem{}, #x86_temp{}} ->
+ {temp_to_regArch(Dst), mem_to_rmArch(Src)};
+ {#x86_temp{}, #x86_mem{}} ->
+ {mem_to_rmArch(Dst), temp_to_regArch(Src)};
+ {#x86_temp{}, #x86_temp{}} ->
+ {temp_to_regArch(Dst), temp_to_rmArch(Src)};
+ {#x86_imm{}, #x86_temp{reg=0}} -> % eax,imm
+ NewSrc = translate_imm(Src, Context, true),
+ NewDst =
+ case NewSrc of
+ {imm8,_} -> temp_to_rmArch(Dst);
+ {imm32,_} -> ?EAX
+ end,
+ {NewDst, NewSrc};
+ {#x86_imm{}, #x86_temp{}} ->
+ {temp_to_rmArch(Dst), translate_imm(Src, Context, true)}
+ end.
+
+%%% test
+resolve_test_args(Src, Dst, Context) ->
+ case Src of
+ #x86_imm{} -> % imm8 not allowed
+ {_ImmSize,ImmValue} = translate_imm(Src, Context, false),
+ NewDst =
+ case Dst of
+ #x86_temp{reg=0} -> ?EAX;
+ #x86_temp{} -> temp_to_rmArch(Dst);
+ #x86_mem{} -> mem_to_rmArch(Dst)
+ end,
+ {NewDst, {imm32,ImmValue}};
+ #x86_temp{} ->
+ NewDst =
+ case Dst of
+ #x86_temp{} -> temp_to_rmArch(Dst);
+ #x86_mem{} -> mem_to_rmArch(Dst)
+ end,
+ {NewDst, temp_to_regArch(Src)}
+ end.
+
+%%% shifts
+resolve_shift_args(Src, Dst, Context) ->
+ RM32 =
+ case Dst of
+ #x86_temp{} -> temp_to_rmArch(Dst);
+ #x86_mem{} -> mem_to_rmArch(Dst)
+ end,
+ Count =
+ case Src of
+ #x86_imm{value=1} -> 1;
+ #x86_imm{} -> translate_imm(Src, Context, true); % must be imm8
+ #x86_temp{reg=1} -> cl % temp must be ecx
+ end,
+ {RM32, Count}.
+
+%% x87_binop mem
+resolve_x87_unop_arg(Arg=#x86_mem{type=Type})->
+ case Type of
+ 'double' -> {mem_to_rm64fp(Arg)};
+ 'untagged' -> {mem_to_rmArch(Arg)};
+ _ -> ?EXIT({fmovArgNotSupported,{Arg}})
+ end;
+resolve_x87_unop_arg(Arg=#x86_fpreg{}) ->
+ {fpreg_to_stack(Arg)};
+resolve_x87_unop_arg([]) ->
+ [].
+
+%% x87_binop mem, st(i)
+resolve_x87_binop_args(Src=#x86_fpreg{}, Dst=#x86_mem{})->
+ {mem_to_rm64fp(Dst),fpreg_to_stack(Src)};
+%% x87_binop st(0), st(i)
+resolve_x87_binop_args(Src=#x86_fpreg{}, Dst=#x86_fpreg{})->
+ {fpreg_to_stack(Dst),fpreg_to_stack(Src)}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+mk_data_relocs(RefsFromConsts, LabelMap) ->
+ lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])).
+
+mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) ->
+ Map = [case Label of
+ {L,Pos} ->
+ Offset = find({MFA,L}, LabelMap),
+ {Pos,Offset};
+ {sorted,Base,OrderedLabels} ->
+ {sorted, Base, [begin
+ Offset = find({MFA,L}, LabelMap),
+ {Order, Offset}
+ end
+ || {L,Order} <- OrderedLabels]}
+ end
+ || Label <- Labels],
+ %% msg("Map: ~w Map\n",[Map]),
+ mk_data_relocs(Rest, LabelMap, [Map,Acc]);
+mk_data_relocs([],_,Acc) -> Acc.
+
+find({MFA,L},LabelMap) ->
+ gb_trees:get({MFA,L}, LabelMap).
+
+slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) ->
+ IsClosure = lists:member({M,F,A}, Closures),
+ IsExported = is_exported(F, A, Exports),
+ [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)];
+slim_sorted_exportmap([],_,_) -> [].
+
+is_exported(F, A, Exports) -> lists:member({F,A}, Exports).
+
+%%%
+%%% Assembly listing support (pp_asm option).
+%%%
+
+print(String, Arglist, Options) ->
+ ?when_option(pp_asm, Options, io:format(String, Arglist)).
+
+print_insn(Address, Bytes, I, Options) ->
+ ?when_option(pp_asm, Options, print_insn_2(Address, Bytes, I)),
+ ?when_option(pp_cxmon, Options, print_code_list_2(Bytes)).
+
+print_code_list_2([H | Tail]) ->
+ print_byte(H),
+ io:format(","),
+ print_code_list_2(Tail);
+print_code_list_2([]) ->
+ io:format("").
+
+print_insn_2(Address, Bytes, {_,_,OrigI}) ->
+ io:format("~8.16b | ", [Address]),
+ print_code_list(Bytes, 0),
+ ?HIPE_X86_PP:pp_insn(OrigI).
+
+print_code_list([Byte|Rest], Len) ->
+ print_byte(Byte),
+ print_code_list(Rest, Len+1);
+print_code_list([], Len) ->
+ fill_spaces(24-(Len*2)),
+ io:format(" | ").
+
+print_byte(Byte) ->
+ io:format("~2.16.0b", [Byte band 16#FF]).
+
+fill_spaces(N) when N > 0 ->
+ io:format(" "),
+ fill_spaces(N-1);
+fill_spaces(0) ->
+ [].
+
+%%%
+%%% Lookup a constant in a ConstMap.
+%%%
+
+find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) ->
+ ConstNo;
+find_const(N,[_|R]) ->
+ find_const(N,R);
+find_const(C,[]) ->
+ ?EXIT({constant_not_found,C}).
diff --git a/lib/hipe/x86/hipe_x86_cfg.erl b/lib/hipe/x86/hipe_x86_cfg.erl
new file mode 100644
index 0000000000..d15dcc061a
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_cfg.erl
@@ -0,0 +1,147 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(hipe_x86_cfg).
+
+-export([init/1,
+ labels/1, start_label/1,
+ succ/2, pred/2,
+ bb/2, bb_add/3]).
+-export([postorder/1, reverse_postorder/1]).
+-export([linearise/1, params/1, arity/1, redirect_jmp/3]).
+
+%%% these tell cfg.inc what to define (ugly as hell)
+-define(PRED_NEEDED,true).
+-define(BREADTH_ORDER,true).
+-define(PARAMS_NEEDED,true).
+-define(START_LABEL_UPDATE_NEEDED,true).
+
+-include("hipe_x86.hrl").
+-include("../flow/cfg.hrl").
+-include("../flow/cfg.inc").
+
+init(Defun) ->
+ %% XXX: this assumes that the code starts with a label insn.
+ %% Is that guaranteed?
+ Code = hipe_x86:defun_code(Defun),
+ StartLab = hipe_x86:label_label(hd(Code)),
+ Data = hipe_x86:defun_data(Defun),
+ IsClosure = hipe_x86:defun_is_closure(Defun),
+ MFA = hipe_x86:defun_mfa(Defun),
+ IsLeaf = hipe_x86:defun_is_leaf(Defun),
+ Formals = hipe_x86:defun_formals(Defun),
+ CFG0 = mk_empty_cfg(MFA, StartLab, Data, IsClosure, IsLeaf, Formals),
+ take_bbs(Code, CFG0).
+
+is_branch(I) ->
+ case I of
+ #jmp_fun{} -> true;
+ #jmp_label{} -> true;
+ #jmp_switch{} -> true;
+ #pseudo_call{} -> true;
+ #pseudo_jcc{} -> true;
+ #pseudo_tailcall{} -> true;
+ #ret{} -> true;
+ _ -> false
+ end.
+
+branch_successors(Branch) ->
+ case Branch of
+ #jmp_fun{} -> [];
+ #jmp_label{label=Label} -> [Label];
+ #jmp_switch{labels=Labels} -> Labels;
+ #pseudo_call{contlab=ContLab, sdesc=#x86_sdesc{exnlab=ExnLab}} ->
+ case ExnLab of
+ [] -> [ContLab];
+ _ -> [ContLab,ExnLab]
+ end;
+ #pseudo_jcc{true_label=TrueLab,false_label=FalseLab} -> [FalseLab,TrueLab];
+ #pseudo_tailcall{} -> [];
+ #ret{} -> []
+ end.
+
+-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
+fails_to(_Instr) -> [].
+-endif.
+
+redirect_jmp(I, Old, New) ->
+ case I of
+ #jmp_label{label=Label} ->
+ if Old =:= Label -> I#jmp_label{label=New};
+ true -> I
+ end;
+ #pseudo_jcc{true_label=TrueLab, false_label=FalseLab} ->
+ J0 = if Old =:= TrueLab -> I#pseudo_jcc{true_label=New};
+ true -> I
+ end,
+ if Old =:= FalseLab -> J0#pseudo_jcc{false_label=New};
+ true -> J0
+ end;
+ %% handle pseudo_call too?
+ _ -> I
+ end.
+
+%%% XXX: fix if labels can occur in operands
+%% redirect_ops(_Labels, CFG, _Map) ->
+%% CFG.
+
+mk_goto(Label) ->
+ hipe_x86:mk_jmp_label(Label).
+
+is_label(I) ->
+ hipe_x86:is_label(I).
+
+label_name(Label) ->
+ hipe_x86:label_label(Label).
+
+mk_label(Name) ->
+ hipe_x86:mk_label(Name).
+
+%% is_comment(I) ->
+%% hipe_x86:is_comment(I).
+%%
+%% is_goto(I) ->
+%% hipe_x86:is_jmp_label(I).
+
+linearise(CFG) -> % -> defun, not insn list
+ MFA = function(CFG),
+ Formals = params(CFG),
+ Code = linearize_cfg(CFG),
+ Data = data(CFG),
+ VarRange = hipe_gensym:var_range(x86),
+ LabelRange = hipe_gensym:label_range(x86),
+ IsClosure = is_closure(CFG),
+ IsLeaf = is_leaf(CFG),
+ hipe_x86:mk_defun(MFA, Formals, IsClosure, IsLeaf,
+ Code, Data, VarRange, LabelRange).
+
+arity(CFG) ->
+ {_M,_F,A} = function(CFG),
+ A.
+
+%% init_gensym(CFG) ->
+%% HighestVar = find_highest_var(CFG),
+%% HighestLabel = find_highest_label(CFG),
+%% hipe_gensym:init(),
+%% hipe_gensym:set_var(x86, HighestVar),
+%% hipe_gensym:set_label(x86, HighestLabel).
+%%
+%% highest_var(Code) ->
+%% hipe_x86:highest_temp(Code).
diff --git a/lib/hipe/x86/hipe_x86_defuse.erl b/lib/hipe/x86/hipe_x86_defuse.erl
new file mode 100644
index 0000000000..3387f77595
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_defuse.erl
@@ -0,0 +1,160 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% compute def/use sets for x86 insns
+%%%
+%%% TODO:
+%%% - represent EFLAGS (condition codes) use/def by a virtual reg?
+%%% - should push use/def %esp?
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_DEFUSE, hipe_amd64_defuse).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(RV, rax).
+-else.
+-define(HIPE_X86_DEFUSE, hipe_x86_defuse).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(RV, eax).
+-endif.
+
+-module(?HIPE_X86_DEFUSE).
+-export([insn_def/1, insn_use/1]). %% src_use/1]).
+-include("../x86/hipe_x86.hrl").
+
+%%%
+%%% insn_def(Insn) -- Return set of temps defined by an instruction.
+%%%
+
+insn_def(I) ->
+ case I of
+ #alu{dst=Dst} -> dst_def(Dst);
+ #cmovcc{dst=Dst} -> dst_def(Dst);
+ #fmove{dst=Dst} -> dst_def(Dst);
+ #fp_binop{dst=Dst} -> dst_def(Dst);
+ #fp_unop{arg=Arg} -> dst_def(Arg);
+ #imul{temp=Temp} -> [Temp];
+ #lea{temp=Temp} -> [Temp];
+ #move{dst=Dst} -> dst_def(Dst);
+ #move64{dst=Dst} -> dst_def(Dst);
+ #movsx{dst=Dst} -> dst_def(Dst);
+ #movzx{dst=Dst} -> dst_def(Dst);
+ #pseudo_call{} -> call_clobbered();
+ #pseudo_spill{} -> [];
+ #pseudo_tailcall_prepare{} -> tailcall_clobbered();
+ #shift{dst=Dst} -> dst_def(Dst);
+ %% call, cmp, comment, jcc, jmp_fun, jmp_label, jmp_switch, label
+ %% pseudo_jcc, pseudo_tailcall, push, ret
+ _ -> []
+ end.
+
+dst_def(Dst) ->
+ case Dst of
+ #x86_temp{} -> [Dst];
+ #x86_fpreg{} -> [Dst];
+ _ -> []
+ end.
+
+call_clobbered() ->
+ [hipe_x86:mk_temp(R, T)
+ || {R,T} <- ?HIPE_X86_REGISTERS:call_clobbered()].
+
+tailcall_clobbered() ->
+ [hipe_x86:mk_temp(R, T)
+ || {R,T} <- ?HIPE_X86_REGISTERS:tailcall_clobbered()].
+
+%%%
+%%% insn_use(Insn) -- Return set of temps used by an instruction.
+%%%
+
+insn_use(I) ->
+ case I of
+ #alu{src=Src,dst=Dst} -> addtemp(Src, addtemp(Dst, []));
+ #call{'fun'=Fun} -> addtemp(Fun, []);
+ #cmovcc{src=Src, dst=Dst} -> addtemp(Src, dst_use(Dst));
+ #cmp{src=Src, dst=Dst} -> addtemp(Src, addtemp(Dst, []));
+ #fmove{src=Src,dst=Dst} -> addtemp(Src, dst_use(Dst));
+ #fp_unop{arg=Arg} -> addtemp(Arg, []);
+ #fp_binop{src=Src,dst=Dst} -> addtemp(Src, addtemp(Dst, []));
+ #imul{imm_opt=ImmOpt,src=Src,temp=Temp} ->
+ addtemp(Src, case ImmOpt of [] -> addtemp(Temp, []); _ -> [] end);
+ #jmp_fun{'fun'=Fun} -> addtemp(Fun, []);
+ #jmp_switch{temp=Temp, jtab=JTab} -> addtemp(Temp, addtemp(JTab, []));
+ #lea{mem=Mem} -> addtemp(Mem, []);
+ #move{src=Src,dst=Dst} -> addtemp(Src, dst_use(Dst));
+ #move64{} -> [];
+ #movsx{src=Src,dst=Dst} -> addtemp(Src, dst_use(Dst));
+ #movzx{src=Src,dst=Dst} -> addtemp(Src, dst_use(Dst));
+ #pseudo_call{'fun'=Fun,sdesc=#x86_sdesc{arity=Arity}} ->
+ addtemp(Fun, arity_use(Arity));
+ #pseudo_spill{args=Args} -> Args;
+ #pseudo_tailcall{'fun'=Fun,arity=Arity,stkargs=StkArgs} ->
+ addtemp(Fun, addtemps(StkArgs, addtemps(tailcall_clobbered(),
+ arity_use(Arity))));
+ #push{src=Src} -> addtemp(Src, []);
+ #ret{} -> [hipe_x86:mk_temp(?HIPE_X86_REGISTERS:?RV(), 'tagged')];
+ #shift{src=Src,dst=Dst} -> addtemp(Src, addtemp(Dst, []));
+ %% comment, jcc, jmp_label, label, pseudo_jcc, pseudo_tailcall_prepare
+ _ -> []
+ end.
+
+arity_use(Arity) ->
+ [hipe_x86:mk_temp(R, 'tagged')
+ || R <- ?HIPE_X86_REGISTERS:args(Arity)].
+
+dst_use(Dst) ->
+ case Dst of
+ #x86_mem{base=Base,off=Off} -> addbase(Base, addtemp(Off, []));
+ _ -> []
+ end.
+
+%%%
+%%% src_use(Src) -- Return set of temps used by a source operand.
+%%%
+
+%% src_use(Src) ->
+%% addtemp(Src, []).
+
+%%%
+%%% Auxiliary operations on sets of temps
+%%%
+
+addtemps([Arg|Args], Set) ->
+ addtemps(Args, addtemp(Arg, Set));
+addtemps([], Set) ->
+ Set.
+
+addtemp(Arg, Set) ->
+ case Arg of
+ #x86_temp{} -> add(Arg, Set);
+ #x86_mem{base=Base,off=Off} -> addtemp(Off, addbase(Base, Set));
+ #x86_fpreg{} -> add(Arg, Set);
+ _ -> Set
+ end.
+
+addbase(Base, Set) ->
+ case Base of
+ [] -> Set;
+ _ -> addtemp(Base, Set)
+ end.
+
+add(Arg, Set) ->
+ case lists:member(Arg, Set) of
+ false -> [Arg|Set];
+ _ -> Set
+ end.
diff --git a/lib/hipe/x86/hipe_x86_encode.erl b/lib/hipe/x86/hipe_x86_encode.erl
new file mode 100644
index 0000000000..db7f53ad26
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_encode.erl
@@ -0,0 +1,1302 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Copyright (C) 2000-2005 Mikael Pettersson
+%%%
+%%% This is the syntax of x86 r/m operands:
+%%%
+%%% opnd ::= reg mod == 11
+%%% | MEM[ea] mod != 11
+%%%
+%%% ea ::= disp32(reg) mod == 10, r/m != ESP
+%%% | disp32 sib12 mod == 10, r/m == 100
+%%% | disp8(reg) mod == 01, r/m != ESP
+%%% | disp8 sib12 mod == 01, r/m == 100
+%%% | (reg) mod == 00, r/m != ESP and EBP
+%%% | sib0 mod == 00, r/m == 100
+%%% | disp32 mod == 00, r/m == 101 [on x86-32]
+%%% | disp32(%rip) mod == 00, r/m == 101 [on x86-64]
+%%%
+%%% // sib0: mod == 00
+%%% sib0 ::= disp32(,index,scale) base == EBP, index != ESP
+%%% | disp32 base == EBP, index == 100
+%%% | (base,index,scale) base != EBP, index != ESP
+%%% | (base) base != EBP, index == 100
+%%%
+%%% // sib12: mod == 01 or 10
+%%% sib12 ::= (base,index,scale) index != ESP
+%%% | (base) index == 100
+%%%
+%%% scale ::= 00 | 01 | 10 | 11 index << scale
+%%%
+%%% Notes:
+%%%
+%%% 1. ESP cannot be used as index register.
+%%% 2. Use of ESP as base register requires a SIB byte.
+%%% 3. disp(reg), when reg != ESP, can be represented without
+%%% [r/m == reg] or with [r/m == 100, base == reg] a SIB byte.
+%%% 4. disp32 can be represented without [mod == 00, r/m == 101]
+%%% or with [mod == 00, r/m == 100, base == 101, index == 100]
+%%% a SIB byte.
+%%% 5. x86-32 and x86-64 interpret mod==00b r/m==101b EAs differently:
+%%% on x86-32 the disp32 is an absolute address, but on x86-64 the
+%%% disp32 is relative to the %rip of the next instruction.
+%%% Absolute disp32s need a SIB on x86-64.
+
+-module(hipe_x86_encode).
+
+-export([% condition codes
+ cc/1,
+ % 8-bit registers
+ %% al/0, cl/0, dl/0, bl/0, ah/0, ch/0, dh/0, bh/0,
+ % 32-bit registers
+ %% eax/0, ecx/0, edx/0, ebx/0, esp/0, ebp/0, esi/0, edi/0,
+ % operands
+ sindex/2, sib/1, sib/2,
+ ea_disp32_base/2, ea_disp32_sib/2,
+ ea_disp8_base/2, ea_disp8_sib/2,
+ ea_base/1,
+ %% ea_disp32_sindex/1, % XXX: do not use on x86-32, only on x86-64
+ ea_disp32_sindex/2,
+ ea_sib/1, ea_disp32/1,
+ rm_reg/1, rm_mem/1,
+ % instructions
+ insn_encode/3, insn_sizeof/2]).
+
+%%-define(DO_HIPE_X86_ENCODE_TEST,true).
+-ifdef(DO_HIPE_X86_ENCODE_TEST).
+-export([dotest/0, dotest/1]). % for testing, don't use
+-endif.
+
+-define(ASSERT(F,G), if G -> [] ; true -> exit({?MODULE,F}) end).
+%-define(ASSERT(F,G), []).
+
+%%% condition codes
+
+-define(CC_O, 2#0000). % overflow
+-define(CC_NO, 2#0001). % no overflow
+-define(CC_B, 2#0010). % below, <u
+-define(CC_AE, 2#0011). % above or equal, >=u
+-define(CC_E, 2#0100). % equal
+-define(CC_NE, 2#0101). % not equal
+-define(CC_BE, 2#0110). % below or equal, <=u
+-define(CC_A, 2#0111). % above, >u
+-define(CC_S, 2#1000). % sign, +
+-define(CC_NS, 2#1001). % not sign, -
+-define(CC_PE, 2#1010). % parity even
+-define(CC_PO, 2#1011). % parity odd
+-define(CC_L, 2#1100). % less than, <s
+-define(CC_GE, 2#1101). % greater or equal, >=s
+-define(CC_LE, 2#1110). % less or equal, <=s
+-define(CC_G, 2#1111). % greater than, >s
+
+cc(o) -> ?CC_O;
+cc(no) -> ?CC_NO;
+cc(b) -> ?CC_B;
+cc(ae) -> ?CC_AE;
+cc(e) -> ?CC_E;
+cc(ne) -> ?CC_NE;
+cc(be) -> ?CC_BE;
+cc(a) -> ?CC_A;
+cc(s) -> ?CC_S;
+cc(ns) -> ?CC_NS;
+cc(pe) -> ?CC_PE;
+cc(po) -> ?CC_PO;
+cc(l) -> ?CC_L;
+cc(ge) -> ?CC_GE;
+cc(le) -> ?CC_LE;
+cc(g) -> ?CC_G.
+
+%%% 8-bit registers
+
+-define(AL, 2#000).
+-define(CL, 2#001).
+-define(DL, 2#010).
+-define(BL, 2#011).
+-define(AH, 2#100).
+-define(CH, 2#101).
+-define(DH, 2#110).
+-define(BH, 2#111).
+
+%% al() -> ?AL.
+%% cl() -> ?CL.
+%% dl() -> ?DL.
+%% bl() -> ?BL.
+%% ah() -> ?AH.
+%% ch() -> ?CH.
+%% dh() -> ?DH.
+%% bh() -> ?BH.
+
+%%% 32-bit registers
+
+-define(EAX, 2#000).
+-define(ECX, 2#001).
+-define(EDX, 2#010).
+-define(EBX, 2#011).
+-define(ESP, 2#100).
+-define(EBP, 2#101).
+-define(ESI, 2#110).
+-define(EDI, 2#111).
+
+%% eax() -> ?EAX.
+%% ecx() -> ?ECX.
+%% edx() -> ?EDX.
+%% ebx() -> ?EBX.
+%% esp() -> ?ESP.
+%% ebp() -> ?EBP.
+%% esi() -> ?ESI.
+%% edi() -> ?EDI.
+
+%%% r/m operands
+
+sindex(Scale, Index) when is_integer(Scale), is_integer(Index) ->
+ ?ASSERT(sindex, Scale >= 0),
+ ?ASSERT(sindex, Scale =< 3),
+ ?ASSERT(sindex, Index =/= ?ESP),
+ {sindex, Scale, Index}.
+
+-record(sib, {sindex_opt, base :: integer()}).
+sib(Base) when is_integer(Base) -> #sib{sindex_opt=none, base=Base}.
+sib(Base, Sindex) when is_integer(Base) -> #sib{sindex_opt=Sindex, base=Base}.
+
+ea_disp32_base(Disp32, Base) when is_integer(Base) ->
+ ?ASSERT(ea_disp32_base, Base =/= ?ESP),
+ {ea_disp32_base, Disp32, Base}.
+ea_disp32_sib(Disp32, SIB) -> {ea_disp32_sib, Disp32, SIB}.
+ea_disp8_base(Disp8, Base) when is_integer(Base) ->
+ ?ASSERT(ea_disp8_base, Base =/= ?ESP),
+ {ea_disp8_base, Disp8, Base}.
+ea_disp8_sib(Disp8, SIB) -> {ea_disp8_sib, Disp8, SIB}.
+ea_base(Base) when is_integer(Base) ->
+ ?ASSERT(ea_base, Base =/= ?ESP),
+ ?ASSERT(ea_base, Base =/= ?EBP),
+ {ea_base, Base}.
+%% ea_disp32_sindex(Disp32) -> {ea_disp32_sindex, Disp32, none}.
+ea_disp32_sindex(Disp32, Sindex) -> {ea_disp32_sindex, Disp32, Sindex}.
+ea_sib(SIB) ->
+ ?ASSERT(ea_sib, SIB#sib.base =/= ?EBP),
+ {ea_sib, SIB}.
+ea_disp32(Disp32) -> {ea_disp32, Disp32}.
+
+rm_reg(Reg) -> {rm_reg, Reg}.
+rm_mem(EA) -> {rm_mem, EA}.
+
+mk_modrm(Mod, RO, RM) ->
+ (Mod bsl 6) bor (RO bsl 3) bor RM.
+
+mk_sib(Scale, Index, Base) ->
+ (Scale bsl 6) bor (Index bsl 3) bor Base.
+
+le16(Word, Tail) ->
+ [Word band 16#FF, (Word bsr 8) band 16#FF | Tail].
+
+le32(Word, Tail) when is_integer(Word) ->
+ [Word band 16#FF, (Word bsr 8) band 16#FF,
+ (Word bsr 16) band 16#FF, (Word bsr 24) band 16#FF | Tail];
+le32({Tag,Val}, Tail) -> % a relocatable datum
+ [{le32,Tag,Val} | Tail].
+
+enc_sindex_opt({sindex,Scale,Index}) -> {Scale, Index};
+enc_sindex_opt(none) -> {2#00, 2#100}.
+
+enc_sib(#sib{sindex_opt=SindexOpt, base=Base}) ->
+ {Scale, Index} = enc_sindex_opt(SindexOpt),
+ mk_sib(Scale, Index, Base).
+
+enc_ea(EA, RO, Tail) ->
+ case EA of
+ {ea_disp32_base, Disp32, Base} ->
+ [mk_modrm(2#10, RO, Base) | le32(Disp32, Tail)];
+ {ea_disp32_sib, Disp32, SIB} ->
+ [mk_modrm(2#10, RO, 2#100), enc_sib(SIB) | le32(Disp32, Tail)];
+ {ea_disp8_base, Disp8, Base} ->
+ [mk_modrm(2#01, RO, Base), Disp8 | Tail];
+ {ea_disp8_sib, Disp8, SIB} ->
+ [mk_modrm(2#01, RO, 2#100), enc_sib(SIB), Disp8 | Tail];
+ {ea_base, Base} ->
+ [mk_modrm(2#00, RO, Base) | Tail];
+ {ea_disp32_sindex, Disp32, SindexOpt} ->
+ {Scale, Index} = enc_sindex_opt(SindexOpt),
+ SIB = mk_sib(Scale, Index, 2#101),
+ MODRM = mk_modrm(2#00, RO, 2#100),
+ [MODRM, SIB | le32(Disp32, Tail)];
+ {ea_sib, SIB} ->
+ [mk_modrm(2#00, RO, 2#100), enc_sib(SIB) | Tail];
+ {ea_disp32, Disp32} ->
+ [mk_modrm(2#00, RO, 2#101) | le32(Disp32, Tail)]
+ end.
+
+encode_rm(RM, RO, Tail) ->
+ case RM of
+ {rm_reg, Reg} -> [mk_modrm(2#11, RO, Reg) | Tail];
+ {rm_mem, EA} -> enc_ea(EA, RO, Tail)
+ end.
+
+sizeof_ea(EA) ->
+ case element(1, EA) of
+ ea_disp32_base -> 5;
+ ea_disp32_sib -> 6;
+ ea_disp8_base -> 2;
+ ea_disp8_sib -> 3;
+ ea_base -> 1;
+ ea_disp32_sindex -> 6;
+ ea_sib -> 2;
+ ea_disp32 -> 5
+ end.
+
+sizeof_rm(RM) ->
+ case RM of
+ {rm_reg, _} -> 1;
+ {rm_mem, EA} -> sizeof_ea(EA)
+ end.
+
+%%% Floating point stack positions
+
+-define(ST0, 2#000).
+-define(ST1, 2#001).
+-define(ST2, 2#010).
+-define(ST3, 2#011).
+-define(ST4, 2#100).
+-define(ST5, 2#101).
+-define(ST6, 2#110).
+-define(ST7, 2#111).
+
+st(0) -> ?ST0;
+st(1) -> ?ST1;
+st(2) -> ?ST2;
+st(3) -> ?ST3;
+st(4) -> ?ST4;
+st(5) -> ?ST5;
+st(6) -> ?ST6;
+st(7) -> ?ST7.
+
+
+%%% Instructions
+%%%
+%%% Insn ::= {Op,Opnds}
+%%% Opnds ::= {Opnd1,...,Opndn} (n >= 0)
+%%% Opnd ::= eax | ax | al | 1 | cl
+%%% | {imm32,Imm32} | {imm16,Imm16} | {imm8,Imm8}
+%%% | {rm32,RM32} | {rm16,RM16} | {rm8,RM8}
+%%% | {rel32,Rel32} | {rel8,Rel8}
+%%% | {moffs32,Moffs32} | {moffs16,Moffs16} | {moffs8,Moffs8}
+%%% | {cc,CC}
+%%% | {reg32,Reg32} | {reg16,Reg16} | {reg8,Reg8}
+%%% | {ea,EA}
+
+-define(PFX_OPND, 16#66).
+
+arith_binop_encode(SubOpcode, Opnds) ->
+ %% add, or, adc, sbb, and, sub, xor, cmp
+ case Opnds of
+ {eax, {imm32,Imm32}} ->
+ [16#05 bor (SubOpcode bsl 3) | le32(Imm32, [])];
+ {{rm32,RM32}, {imm32,Imm32}} ->
+ [16#81 | encode_rm(RM32, SubOpcode, le32(Imm32, []))];
+ {{rm32,RM32}, {imm8,Imm8}} ->
+ [16#83 | encode_rm(RM32, SubOpcode, [Imm8])];
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#01 bor (SubOpcode bsl 3) | encode_rm(RM32, Reg32, [])];
+ {{reg32,Reg32}, {rm32,RM32}} ->
+ [16#03 bor (SubOpcode bsl 3) | encode_rm(RM32, Reg32, [])]
+ end.
+
+arith_binop_sizeof(Opnds) ->
+ %% add, or, adc, sbb, and, sub, xor, cmp
+ case Opnds of
+ {eax, {imm32,_}} ->
+ 1 + 4;
+ {{rm32,RM32}, {imm32,_}} ->
+ 1 + sizeof_rm(RM32) + 4;
+ {{rm32,RM32}, {imm8,_}} ->
+ 1 + sizeof_rm(RM32) + 1;
+ {{rm32,RM32}, {reg32,_}} ->
+ 1 + sizeof_rm(RM32);
+ {{reg32,_}, {rm32,RM32}} ->
+ 1 + sizeof_rm(RM32)
+ end.
+
+bs_op_encode(Opcode, {{reg32,Reg32}, {rm32,RM32}}) -> % bsf, bsr
+ [16#0F, Opcode | encode_rm(RM32, Reg32, [])].
+
+bs_op_sizeof({{reg32,_}, {rm32,RM32}}) -> % bsf, bsr
+ 2 + sizeof_rm(RM32).
+
+bswap_encode({{reg32,Reg32}}) ->
+ [16#0F, 16#C8 bor Reg32].
+
+bswap_sizeof({{reg32,_}}) ->
+ 2.
+
+bt_op_encode(SubOpcode, Opnds) -> % bt, btc, btr, bts
+ case Opnds of
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#0F, 16#A3 bor (SubOpcode bsl 3) | encode_rm(RM32, Reg32, [])];
+ {{rm32,RM32}, {imm8,Imm8}} ->
+ [16#0F, 16#BA | encode_rm(RM32, SubOpcode, [Imm8])]
+ end.
+
+bt_op_sizeof(Opnds) -> % bt, btc, btr, bts
+ case Opnds of
+ {{rm32,RM32}, {reg32,_}} ->
+ 2 + sizeof_rm(RM32);
+ {{rm32,RM32}, {imm8,_}} ->
+ 2 + sizeof_rm(RM32) + 1
+ end.
+
+call_encode(Opnds) ->
+ case Opnds of
+ {{rel32,Rel32}} ->
+ [16#E8 | le32(Rel32, [])];
+ {{rm32,RM32}} ->
+ [16#FF | encode_rm(RM32, 2#010, [])]
+ end.
+
+call_sizeof(Opnds) ->
+ case Opnds of
+ {{rel32,_}} ->
+ 1 + 4;
+ {{rm32,RM32}} ->
+ 1 + sizeof_rm(RM32)
+ end.
+
+cbw_encode({}) ->
+ [?PFX_OPND, 16#98].
+
+cbw_sizeof({}) ->
+ 2.
+
+nullary_op_encode(Opcode, {}) ->
+ %% cdq, clc, cld, cmc, cwde, into, leave, nop, prefix_fs, stc, std
+ [Opcode].
+
+nullary_op_sizeof({}) ->
+ %% cdq, clc, cld, cmc, cwde, into, leave, nop, prefix_fs, stc, std
+ 1.
+
+cmovcc_encode({{cc,CC}, {reg32,Reg32}, {rm32,RM32}}) ->
+ [16#0F, 16#40 bor CC | encode_rm(RM32, Reg32, [])].
+
+cmovcc_sizeof({{cc,_}, {reg32,_}, {rm32,RM32}}) ->
+ 2 + sizeof_rm(RM32).
+
+incdec_encode(SubOpcode, Opnds) -> % SubOpcode is either 0 or 1
+ case Opnds of
+ {{rm32,RM32}} ->
+ [16#FF | encode_rm(RM32, SubOpcode, [])];
+ {{reg32,Reg32}} ->
+ [16#40 bor (SubOpcode bsl 3) bor Reg32]
+ end.
+
+incdec_sizeof(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} ->
+ 1 + sizeof_rm(RM32);
+ {{reg32,_}} ->
+ 1
+ end.
+
+arith_unop_encode(Opcode, {{rm32,RM32}}) -> % div, idiv, mul, neg, not
+ [16#F7 | encode_rm(RM32, Opcode, [])].
+
+arith_unop_sizeof({{rm32,RM32}}) -> % div, idiv, mul, neg, not
+ 1 + sizeof_rm(RM32).
+
+enter_encode({{imm16,Imm16}, {imm8,Imm8}}) ->
+ [16#C8 | le16(Imm16, [Imm8])].
+
+enter_sizeof({{imm16,_}, {imm8,_}}) ->
+ 1 + 2 + 1.
+
+imul_encode(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} -> % <edx,eax> *= rm32
+ [16#F7 | encode_rm(RM32, 2#101, [])];
+ {{reg32,Reg32}, {rm32,RM32}} -> % reg *= rm32
+ [16#0F, 16#AF | encode_rm(RM32, Reg32, [])];
+ {{reg32,Reg32}, {rm32,RM32}, {imm8,Imm8}} -> % reg := rm32 * sext(imm8)
+ [16#6B | encode_rm(RM32, Reg32, [Imm8])];
+ {{reg32,Reg32}, {rm32,RM32}, {imm32,Imm32}} -> % reg := rm32 * imm32
+ [16#69 | encode_rm(RM32, Reg32, le32(Imm32, []))]
+ end.
+
+imul_sizeof(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} ->
+ 1 + sizeof_rm(RM32);
+ {{reg32,_}, {rm32,RM32}} ->
+ 2 + sizeof_rm(RM32);
+ {{reg32,_}, {rm32,RM32}, {imm8,_}} ->
+ 1 + sizeof_rm(RM32) + 1;
+ {{reg32,_}, {rm32,RM32}, {imm32,_}} ->
+ 1 + sizeof_rm(RM32) + 4
+ end.
+
+jcc_encode(Opnds) ->
+ case Opnds of
+ {{cc,CC}, {rel8,Rel8}} ->
+ [16#70 bor CC, Rel8];
+ {{cc,CC}, {rel32,Rel32}} ->
+ [16#0F, 16#80 bor CC | le32(Rel32, [])]
+ end.
+
+jcc_sizeof(Opnds) ->
+ case Opnds of
+ {{cc,_}, {rel8,_}} ->
+ 2;
+ {{cc,_}, {rel32,_}} ->
+ 2 + 4
+ end.
+
+jmp8_op_encode(Opcode, {{rel8,Rel8}}) -> % jecxz, loop, loope, loopne
+ [Opcode, Rel8].
+
+jmp8_op_sizeof({{rel8,_}}) -> % jecxz, loop, loope, loopne
+ 2.
+
+jmp_encode(Opnds) ->
+ case Opnds of
+ {{rel8,Rel8}} ->
+ [16#EB, Rel8];
+ {{rel32,Rel32}} ->
+ [16#E9 | le32(Rel32, [])];
+ {{rm32,RM32}} ->
+ [16#FF | encode_rm(RM32, 2#100, [])]
+ end.
+
+jmp_sizeof(Opnds) ->
+ case Opnds of
+ {{rel8,_}} ->
+ 2;
+ {{rel32,_}} ->
+ 1 + 4;
+ {{rm32,RM32}} ->
+ 1 + sizeof_rm(RM32)
+ end.
+
+lea_encode({{reg32,Reg32}, {ea,EA}}) ->
+ [16#8D | enc_ea(EA, Reg32, [])].
+
+lea_sizeof({{reg32,_}, {ea,EA}}) ->
+ 1 + sizeof_ea(EA).
+
+mov_encode(Opnds) ->
+ case Opnds of
+ {{rm8,RM8}, {reg8,Reg8}} ->
+ [16#88 | encode_rm(RM8, Reg8, [])];
+ {{rm16,RM16}, {reg16,Reg16}} ->
+ [?PFX_OPND, 16#89 | encode_rm(RM16, Reg16, [])];
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#89 | encode_rm(RM32, Reg32, [])];
+ {{reg8,Reg8}, {rm8,RM8}} ->
+ [16#8A | encode_rm(RM8, Reg8, [])];
+ {{reg16,Reg16}, {rm16,RM16}} ->
+ [?PFX_OPND, 16#8B | encode_rm(RM16, Reg16, [])];
+ {{reg32,Reg32}, {rm32,RM32}} ->
+ [16#8B | encode_rm(RM32, Reg32, [])];
+ {al, {moffs8,Moffs8}} ->
+ [16#A0 | le32(Moffs8, [])];
+ {ax, {moffs16,Moffs16}} ->
+ [?PFX_OPND, 16#A1 | le32(Moffs16, [])];
+ {eax, {moffs32,Moffs32}} ->
+ [16#A1 | le32(Moffs32, [])];
+ {{moffs8,Moffs8}, al} ->
+ [16#A2 | le32(Moffs8, [])];
+ {{moffs16,Moffs16}, ax} ->
+ [?PFX_OPND, 16#A3 | le32(Moffs16, [])];
+ {{moffs32,Moffs32}, eax} ->
+ [16#A3 | le32(Moffs32, [])];
+ {{reg8,Reg8}, {imm8,Imm8}} ->
+ [16#B0 bor Reg8, Imm8];
+ {{reg16,Reg16}, {imm16,Imm16}} ->
+ [?PFX_OPND, 16#B8 bor Reg16 | le16(Imm16, [])];
+ {{reg32,Reg32}, {imm32,Imm32}} ->
+ [16#B8 bor Reg32 | le32(Imm32, [])];
+ {{rm8,RM8}, {imm8,Imm8}} ->
+ [16#C6 | encode_rm(RM8, 2#000, [Imm8])];
+ {{rm16,RM16}, {imm16,Imm16}} ->
+ [?PFX_OPND, 16#C7 | encode_rm(RM16, 2#000, le16(Imm16, []))];
+ {{rm32,RM32}, {imm32,Imm32}} ->
+ [16#C7 | encode_rm(RM32, 2#000, le32(Imm32, []))]
+ end.
+
+mov_sizeof(Opnds) ->
+ case Opnds of
+ {{rm8,RM8}, {reg8,_}} ->
+ 1 + sizeof_rm(RM8);
+ {{rm16,RM16}, {reg16,_}} ->
+ 2 + sizeof_rm(RM16);
+ {{rm32,RM32}, {reg32,_}} ->
+ 1 + sizeof_rm(RM32);
+ {{reg8,_}, {rm8,RM8}} ->
+ 1 + sizeof_rm(RM8);
+ {{reg16,_}, {rm16,RM16}} ->
+ 2 + sizeof_rm(RM16);
+ {{reg32,_}, {rm32,RM32}} ->
+ 1 + sizeof_rm(RM32);
+ {al, {moffs8,_}} ->
+ 1 + 4;
+ {ax, {moffs16,_}} ->
+ 2 + 4;
+ {eax, {moffs32,_}} ->
+ 1 + 4;
+ {{moffs8,_}, al} ->
+ 1 + 4;
+ {{moffs16,_}, ax} ->
+ 2 + 4;
+ {{moffs32,_}, eax} ->
+ 1 + 4;
+ {{reg8,_}, {imm8,_}} ->
+ 2;
+ {{reg16,_}, {imm16,_}} ->
+ 2 + 2;
+ {{reg32,_}, {imm32,_}} ->
+ 1 + 4;
+ {{rm8,RM8}, {imm8,_}} ->
+ 1 + sizeof_rm(RM8) + 1;
+ {{rm16,RM16}, {imm16,_}} ->
+ 2 + sizeof_rm(RM16) + 2;
+ {{rm32,RM32}, {imm32,_}} ->
+ 1 + sizeof_rm(RM32) + 4
+ end.
+
+movx_op_encode(Opcode, Opnds) -> % movsx, movzx
+ case Opnds of
+ {{reg16,Reg16}, {rm8,RM8}} ->
+ [?PFX_OPND, 16#0F, Opcode | encode_rm(RM8, Reg16, [])];
+ {{reg32,Reg32}, {rm8,RM8}} ->
+ [16#0F, Opcode | encode_rm(RM8, Reg32, [])];
+ {{reg32,Reg32}, {rm16,RM16}} ->
+ [16#0F, Opcode bor 1 | encode_rm(RM16, Reg32, [])]
+ end.
+
+movx_op_sizeof(Opnds) ->
+ case Opnds of
+ {{reg16,_}, {rm8,RM8}} ->
+ 3 + sizeof_rm(RM8);
+ {{reg32,_}, {rm8,RM8}} ->
+ 2 + sizeof_rm(RM8);
+ {{reg32,_}, {rm16,RM16}} ->
+ 2 + sizeof_rm(RM16)
+ end.
+
+pop_encode(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} ->
+ [16#8F | encode_rm(RM32, 2#000, [])];
+ {{reg32,Reg32}} ->
+ [16#58 bor Reg32]
+ end.
+
+pop_sizeof(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} ->
+ 1 + sizeof_rm(RM32);
+ {{reg32,_}} ->
+ 1
+ end.
+
+push_encode(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} ->
+ [16#FF | encode_rm(RM32, 2#110, [])];
+ {{reg32,Reg32}} ->
+ [16#50 bor Reg32];
+ {{imm8,Imm8}} -> % sign-extended
+ [16#6A, Imm8];
+ {{imm32,Imm32}} ->
+ [16#68 | le32(Imm32, [])]
+ end.
+
+push_sizeof(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}} ->
+ 1 + sizeof_rm(RM32);
+ {{reg32,_}} ->
+ 1;
+ {{imm8,_}} ->
+ 2;
+ {{imm32,_}} ->
+ 1 + 4
+ end.
+
+shift_op_encode(SubOpcode, Opnds) -> % rcl, rcr, rol, ror, sar, shl, shr
+ case Opnds of
+ {{rm32,RM32}, 1} ->
+ [16#D1 | encode_rm(RM32, SubOpcode, [])];
+ {{rm32,RM32}, cl} ->
+ [16#D3 | encode_rm(RM32, SubOpcode, [])];
+ {{rm32,RM32}, {imm8,Imm8}} ->
+ [16#C1 | encode_rm(RM32, SubOpcode, [Imm8])];
+ {{rm16,RM16}, {imm8,Imm8}} ->
+ [?PFX_OPND, 16#C1 | encode_rm(RM16, SubOpcode, [Imm8])]
+ end.
+
+shift_op_sizeof(Opnds) -> % rcl, rcr, rol, ror, sar, shl, shr
+ case Opnds of
+ {{rm32,RM32}, 1} ->
+ 1 + sizeof_rm(RM32);
+ {{rm32,RM32}, cl} ->
+ 1 + sizeof_rm(RM32);
+ {{rm32,RM32}, {imm8,_Imm8}} ->
+ 1 + sizeof_rm(RM32) + 1;
+ {{rm16,RM16}, {imm8,_Imm8}} ->
+ 1 + 1 + sizeof_rm(RM16) + 1
+ end.
+
+ret_encode(Opnds) ->
+ case Opnds of
+ {} ->
+ [16#C3];
+ {{imm16,Imm16}} ->
+ [16#C2 | le16(Imm16, [])]
+ end.
+
+ret_sizeof(Opnds) ->
+ case Opnds of
+ {} ->
+ 1;
+ {{imm16,_}} ->
+ 1 + 2
+ end.
+
+setcc_encode({{cc,CC}, {rm8,RM8}}) ->
+ [16#0F, 16#90 bor CC | encode_rm(RM8, 2#000, [])].
+
+setcc_sizeof({{cc,_}, {rm8,RM8}}) ->
+ 2 + sizeof_rm(RM8).
+
+shd_op_encode(Opcode, Opnds) ->
+ case Opnds of
+ {{rm32,RM32}, {reg32,Reg32}, {imm8,Imm8}} ->
+ [16#0F, Opcode | encode_rm(RM32, Reg32, [Imm8])];
+ {{rm32,RM32}, {reg32,Reg32}, cl} ->
+ [16#0F, Opcode bor 1 | encode_rm(RM32, Reg32, [])]
+ end.
+
+shd_op_sizeof(Opnds) ->
+ case Opnds of
+ {{rm32,RM32}, {reg32,_}, {imm8,_}} ->
+ 2 + sizeof_rm(RM32) + 1;
+ {{rm32,RM32}, {reg32,_}, cl} ->
+ 2 + sizeof_rm(RM32)
+ end.
+
+test_encode(Opnds) ->
+ case Opnds of
+ {eax, {imm32,Imm32}} ->
+ [16#A9 | le32(Imm32, [])];
+ {{rm32,RM32}, {imm32,Imm32}} ->
+ [16#F7 | encode_rm(RM32, 2#000, le32(Imm32, []))];
+ {{rm32,RM32}, {reg32,Reg32}} ->
+ [16#85 | encode_rm(RM32, Reg32, [])]
+ end.
+
+test_sizeof(Opnds) ->
+ case Opnds of
+ {eax, {imm32,_}} ->
+ 1 + 4;
+ {{rm32,RM32}, {imm32,_}} ->
+ 1 + sizeof_rm(RM32) + 4;
+ {{rm32,RM32}, {reg32,_}} ->
+ 1 + sizeof_rm(RM32)
+ end.
+
+fild_encode(Opnds) ->
+ %% The operand cannot be a register!
+ {{rm32, RM32}} = Opnds,
+ [16#DB | encode_rm(RM32, 2#000, [])].
+
+fild_sizeof(Opnds) ->
+ {{rm32, RM32}} = Opnds,
+ 1 + sizeof_rm(RM32).
+
+fld_encode(Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DD | encode_rm(RM64fp, 2#000, [])];
+ {{fpst, St}} ->
+ [16#D9, 16#C0 bor st(St)]
+ end.
+
+fld_sizeof(Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ 1 + sizeof_rm(RM64fp);
+ {{fpst, _}} ->
+ 2
+ end.
+
+fp_comm_arith_encode(OpCode, Opnds) ->
+ %% fadd, fmul
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DC | encode_rm(RM64fp, OpCode, [])];
+ {{fpst,0}, {fpst,St}} ->
+ [16#D8, (16#C0 bor (OpCode bsl 3)) bor st(St)];
+ {{fpst,St}, {fpst,0}} ->
+ [16#DC, (16#C0 bor (OpCode bsl 3)) bor st(St)]
+ end.
+
+fp_comm_arith_pop_encode(OpCode, Opnds) ->
+ %% faddp, fmulp
+ case Opnds of
+ [] ->
+ [16#DE, 16#C0 bor (OpCode bsl 3) bor st(1)];
+ {{fpst,St},{fpst,0}} ->
+ [16#DE, 16#C0 bor (OpCode bsl 3) bor st(St)]
+ end.
+
+fp_arith_encode(OpCode, Opnds) ->
+ %% fdiv, fsub
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DC | encode_rm(RM64fp, OpCode, [])];
+ {{fpst,0}, {fpst,St}} ->
+ OpCode0 = OpCode band 2#110,
+ [16#D8, 16#C0 bor (OpCode0 bsl 3) bor st(St)];
+ {{fpst,St}, {fpst,0}} ->
+ OpCode0 = OpCode bor 1,
+ [16#DC, 16#C0 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+fp_arith_pop_encode(OpCode, Opnds) ->
+ %% fdivp, fsubp
+ OpCode0 = OpCode bor 1,
+ case Opnds of
+ [] ->
+ [16#DE, 16#C8 bor (OpCode0 bsl 3) bor st(1)];
+ {{fpst,St}, {fpst,0}} ->
+ [16#DE, 16#C8 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+fp_arith_rev_encode(OpCode, Opnds) ->
+ %% fdivr, fsubr
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DC | encode_rm(RM64fp, OpCode, [])];
+ {{fpst,0}, {fpst,St}} ->
+ OpCode0 = OpCode bor 1,
+ [16#D8, 16#C0 bor (OpCode0 bsl 3) bor st(St)];
+ {{fpst,St}, {fpst,0}} ->
+ OpCode0 = OpCode band 2#110,
+ [16#DC, 16#C0 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+fp_arith_rev_pop_encode(OpCode, Opnds) ->
+ %% fdivrp, fsubrp
+ OpCode0 = OpCode band 2#110,
+ case Opnds of
+ [] ->
+ [16#DE, 16#C0 bor (OpCode0 bsl 3) bor st(1)];
+ {{fpst,St}, {fpst, 0}} ->
+ [16#DE, 16#C0 bor (OpCode0 bsl 3) bor st(St)]
+ end.
+
+fp_arith_sizeof(Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ 1 + sizeof_rm(RM64fp);
+ {{fpst,0}, {fpst,_}} ->
+ 2;
+ {{fpst,_}, {fpst,0}} ->
+ 2
+ end.
+
+fst_encode(OpCode, Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ [16#DD | encode_rm(RM64fp, OpCode, [])];
+ {{fpst, St}} ->
+ [16#DD, 16#C0 bor (OpCode bsl 3) bor st(St)]
+ end.
+
+fst_sizeof(Opnds) ->
+ case Opnds of
+ {{rm64fp, RM64fp}} ->
+ 1 + sizeof_rm(RM64fp);
+ {{fpst, _}} ->
+ 2
+ end.
+
+fchs_encode() ->
+ [16#D9, 16#E0].
+fchs_sizeof() ->
+ 2.
+
+ffree_encode({{fpst, St}})->
+ [16#DD, 16#C0 bor st(St)].
+ffree_sizeof() ->
+ 2.
+
+fwait_encode() ->
+ [16#9B].
+fwait_sizeof() ->
+ 1.
+
+fxch_encode(Opnds) ->
+ case Opnds of
+ [] ->
+ [16#D9, 16#C8 bor st(1)];
+ {{fpst, St}} ->
+ [16#D9, 16#C8 bor st(St)]
+ end.
+fxch_sizeof() ->
+ 2.
+
+insn_encode(Op, Opnds, Offset) ->
+ Bytes = insn_encode_internal(Op, Opnds),
+ case has_relocs(Bytes) of
+ false -> % the common case
+ {Bytes, []};
+ _ ->
+ fix_relocs(Bytes, Offset, [], [])
+ end.
+
+has_relocs([{le32,_,_}|_]) -> true;
+has_relocs([_|Bytes]) -> has_relocs(Bytes);
+has_relocs([]) -> false.
+
+fix_relocs([{le32,Tag,Val}|Bytes], Offset, Code, Relocs) ->
+ fix_relocs(Bytes, Offset+4,
+ [16#00, 16#00, 16#00, 16#00 | Code],
+ [{Tag,Offset,Val}|Relocs]);
+fix_relocs([Byte|Bytes], Offset, Code, Relocs) ->
+ fix_relocs(Bytes, Offset+1, [Byte|Code], Relocs);
+fix_relocs([], _Offset, Code, Relocs) ->
+ {lists:reverse(Code), lists:reverse(Relocs)}.
+
+insn_encode_internal(Op, Opnds) ->
+ case Op of
+ 'adc' -> arith_binop_encode(2#010, Opnds);
+ 'add' -> arith_binop_encode(2#000, Opnds);
+ 'and' -> arith_binop_encode(2#100, Opnds);
+ 'bsf' -> bs_op_encode(16#BC, Opnds);
+ 'bsr' -> bs_op_encode(16#BD, Opnds);
+ 'bswap' -> bswap_encode(Opnds);
+ 'bt' -> bt_op_encode(2#100, Opnds);
+ 'btc' -> bt_op_encode(2#111, Opnds);
+ 'btr' -> bt_op_encode(2#110, Opnds);
+ 'bts' -> bt_op_encode(2#101, Opnds);
+ 'call' -> call_encode(Opnds);
+ 'cbw' -> cbw_encode(Opnds);
+ 'cdq' -> nullary_op_encode(16#99, Opnds);
+ 'clc' -> nullary_op_encode(16#F8, Opnds);
+ 'cld' -> nullary_op_encode(16#FC, Opnds);
+ 'cmc' -> nullary_op_encode(16#F5, Opnds);
+ 'cmovcc' -> cmovcc_encode(Opnds);
+ 'cmp' -> arith_binop_encode(2#111, Opnds);
+ 'cwde' -> nullary_op_encode(16#98, Opnds);
+ 'dec' -> incdec_encode(2#001, Opnds);
+ 'div' -> arith_unop_encode(2#110, Opnds);
+ 'enter' -> enter_encode(Opnds);
+ 'fadd' -> fp_comm_arith_encode(2#000, Opnds);
+ 'faddp' -> fp_comm_arith_pop_encode(2#000, Opnds);
+ 'fchs' -> fchs_encode();
+ 'fdiv' -> fp_arith_encode(2#110, Opnds);
+ 'fdivp' -> fp_arith_pop_encode(2#110, Opnds);
+ 'fdivr' -> fp_arith_rev_encode(2#111, Opnds);
+ 'fdivrp' -> fp_arith_rev_pop_encode(2#111, Opnds);
+ 'ffree' -> ffree_encode(Opnds);
+ 'fild' -> fild_encode(Opnds);
+ 'fld' -> fld_encode(Opnds);
+ 'fmul' -> fp_comm_arith_encode(2#001, Opnds);
+ 'fmulp' -> fp_comm_arith_pop_encode(2#001, Opnds);
+ 'fst' -> fst_encode(2#010, Opnds);
+ 'fstp' -> fst_encode(2#011, Opnds);
+ 'fsub' -> fp_arith_encode(2#100, Opnds);
+ 'fsubp' -> fp_arith_pop_encode(2#100, Opnds);
+ 'fsubr' -> fp_arith_rev_encode(2#101, Opnds);
+ 'fsubrp' -> fp_arith_rev_pop_encode(2#101, Opnds);
+ 'fwait' -> fwait_encode();
+ 'fxch' -> fxch_encode(Opnds);
+ 'idiv' -> arith_unop_encode(2#111, Opnds);
+ 'imul' -> imul_encode(Opnds);
+ 'inc' -> incdec_encode(2#000, Opnds);
+ 'into' -> nullary_op_encode(16#CE, Opnds);
+ 'jcc' -> jcc_encode(Opnds);
+ 'jecxz' -> jmp8_op_encode(16#E3, Opnds);
+ 'jmp' -> jmp_encode(Opnds);
+ 'lea' -> lea_encode(Opnds);
+ 'leave' -> nullary_op_encode(16#C9, Opnds);
+ 'loop' -> jmp8_op_encode(16#E2, Opnds);
+ 'loope' -> jmp8_op_encode(16#E1, Opnds);
+ 'loopne' -> jmp8_op_encode(16#E0, Opnds);
+ 'mov' -> mov_encode(Opnds);
+ 'movsx' -> movx_op_encode(16#BE, Opnds);
+ 'movzx' -> movx_op_encode(16#B6, Opnds);
+ 'mul' -> arith_unop_encode(2#100, Opnds);
+ 'neg' -> arith_unop_encode(2#011, Opnds);
+ 'nop' -> nullary_op_encode(16#90, Opnds);
+ 'not' -> arith_unop_encode(2#010, Opnds);
+ 'or' -> arith_binop_encode(2#001, Opnds);
+ 'pop' -> pop_encode(Opnds);
+ 'prefix_fs' -> nullary_op_encode(16#64, Opnds);
+ 'push' -> push_encode(Opnds);
+ 'rcl' -> shift_op_encode(2#010, Opnds);
+ 'rcr' -> shift_op_encode(2#011, Opnds);
+ 'ret' -> ret_encode(Opnds);
+ 'rol' -> shift_op_encode(2#000, Opnds);
+ 'ror' -> shift_op_encode(2#001, Opnds);
+ 'sar' -> shift_op_encode(2#111, Opnds);
+ 'sbb' -> arith_binop_encode(2#011, Opnds);
+ 'setcc' -> setcc_encode(Opnds);
+ 'shl' -> shift_op_encode(2#100, Opnds);
+ 'shld' -> shd_op_encode(16#A4, Opnds);
+ 'shr' -> shift_op_encode(2#101, Opnds);
+ 'shrd' -> shd_op_encode(16#AC, Opnds);
+ 'stc' -> nullary_op_encode(16#F9, Opnds);
+ 'std' -> nullary_op_encode(16#FD, Opnds);
+ 'sub' -> arith_binop_encode(2#101, Opnds);
+ 'test' -> test_encode(Opnds);
+ 'xor' -> arith_binop_encode(2#110, Opnds);
+ _ -> exit({?MODULE,insn_encode,Op})
+ end.
+
+insn_sizeof(Op, Opnds) ->
+ case Op of
+ 'adc' -> arith_binop_sizeof(Opnds);
+ 'add' -> arith_binop_sizeof(Opnds);
+ 'and' -> arith_binop_sizeof(Opnds);
+ 'bsf' -> bs_op_sizeof(Opnds);
+ 'bsr' -> bs_op_sizeof(Opnds);
+ 'bswap' -> bswap_sizeof(Opnds);
+ 'bt' -> bt_op_sizeof(Opnds);
+ 'btc' -> bt_op_sizeof(Opnds);
+ 'btr' -> bt_op_sizeof(Opnds);
+ 'bts' -> bt_op_sizeof(Opnds);
+ 'call' -> call_sizeof(Opnds);
+ 'cbw' -> cbw_sizeof(Opnds);
+ 'cdq' -> nullary_op_sizeof(Opnds);
+ 'clc' -> nullary_op_sizeof(Opnds);
+ 'cld' -> nullary_op_sizeof(Opnds);
+ 'cmc' -> nullary_op_sizeof(Opnds);
+ 'cmovcc' -> cmovcc_sizeof(Opnds);
+ 'cmp' -> arith_binop_sizeof(Opnds);
+ 'cwde' -> nullary_op_sizeof(Opnds);
+ 'dec' -> incdec_sizeof(Opnds);
+ 'div' -> arith_unop_sizeof(Opnds);
+ 'enter' -> enter_sizeof(Opnds);
+ 'fadd' -> fp_arith_sizeof(Opnds);
+ 'faddp' -> fp_arith_sizeof(Opnds);
+ 'fchs' -> fchs_sizeof();
+ 'fdiv' -> fp_arith_sizeof(Opnds);
+ 'fdivp' -> fp_arith_sizeof(Opnds);
+ 'fdivr' -> fp_arith_sizeof(Opnds);
+ 'fdivrp' -> fp_arith_sizeof(Opnds);
+ 'ffree' -> ffree_sizeof();
+ 'fild' -> fild_sizeof(Opnds);
+ 'fld' -> fld_sizeof(Opnds);
+ 'fmul' -> fp_arith_sizeof(Opnds);
+ 'fmulp' -> fp_arith_sizeof(Opnds);
+ 'fst' -> fst_sizeof(Opnds);
+ 'fstp' -> fst_sizeof(Opnds);
+ 'fsub' -> fp_arith_sizeof(Opnds);
+ 'fsubp' -> fp_arith_sizeof(Opnds);
+ 'fsubr' -> fp_arith_sizeof(Opnds);
+ 'fsubrp' -> fp_arith_sizeof(Opnds);
+ 'fwait' -> fwait_sizeof();
+ 'fxch' -> fxch_sizeof();
+ 'idiv' -> arith_unop_sizeof(Opnds);
+ 'imul' -> imul_sizeof(Opnds);
+ 'inc' -> incdec_sizeof(Opnds);
+ 'into' -> nullary_op_sizeof(Opnds);
+ 'jcc' -> jcc_sizeof(Opnds);
+ 'jecxz' -> jmp8_op_sizeof(Opnds);
+ 'jmp' -> jmp_sizeof(Opnds);
+ 'lea' -> lea_sizeof(Opnds);
+ 'leave' -> nullary_op_sizeof(Opnds);
+ 'loop' -> jmp8_op_sizeof(Opnds);
+ 'loope' -> jmp8_op_sizeof(Opnds);
+ 'loopne' -> jmp8_op_sizeof(Opnds);
+ 'mov' -> mov_sizeof(Opnds);
+ 'movsx' -> movx_op_sizeof(Opnds);
+ 'movzx' -> movx_op_sizeof(Opnds);
+ 'mul' -> arith_unop_sizeof(Opnds);
+ 'neg' -> arith_unop_sizeof(Opnds);
+ 'nop' -> nullary_op_sizeof(Opnds);
+ 'not' -> arith_unop_sizeof(Opnds);
+ 'or' -> arith_binop_sizeof(Opnds);
+ 'pop' -> pop_sizeof(Opnds);
+ 'prefix_fs' -> nullary_op_sizeof(Opnds);
+ 'push' -> push_sizeof(Opnds);
+ 'rcl' -> shift_op_sizeof(Opnds);
+ 'rcr' -> shift_op_sizeof(Opnds);
+ 'ret' -> ret_sizeof(Opnds);
+ 'rol' -> shift_op_sizeof(Opnds);
+ 'ror' -> shift_op_sizeof(Opnds);
+ 'sar' -> shift_op_sizeof(Opnds);
+ 'sbb' -> arith_binop_sizeof(Opnds);
+ 'setcc' -> setcc_sizeof(Opnds);
+ 'shl' -> shift_op_sizeof(Opnds);
+ 'shld' -> shd_op_sizeof(Opnds);
+ 'shr' -> shift_op_sizeof(Opnds);
+ 'shrd' -> shd_op_sizeof(Opnds);
+ 'stc' -> nullary_op_sizeof(Opnds);
+ 'std' -> nullary_op_sizeof(Opnds);
+ 'sub' -> arith_binop_sizeof(Opnds);
+ 'test' -> test_sizeof(Opnds);
+ 'xor' -> arith_binop_sizeof(Opnds);
+ _ -> exit({?MODULE,insn_sizeof,Op})
+ end.
+
+%%=====================================================================
+%% testing interface
+%%=====================================================================
+
+-ifdef(DO_HIPE_X86_ENCODE_TEST).
+
+say(OS, Str) ->
+ file:write(OS, Str).
+
+digit16(Dig0) ->
+ Dig = Dig0 band 16#F,
+ if Dig >= 16#A -> $A + (Dig - 16#A);
+ true -> $0 + Dig
+ end.
+
+say_byte(OS, Byte) ->
+ say(OS, "0x"),
+ say(OS, [digit16(Byte bsr 4)]),
+ say(OS, [digit16(Byte)]).
+
+init(OS) ->
+ say(OS, "\t.text\n").
+
+say_bytes(OS, Byte0, Bytes0) ->
+ say_byte(OS, Byte0),
+ case Bytes0 of
+ [] ->
+ say(OS, "\n");
+ [Byte1|Bytes1] ->
+ say(OS, ","),
+ say_bytes(OS, Byte1, Bytes1)
+ end.
+
+t(OS, Op, Opnds) ->
+ insn_sizeof(Op, Opnds),
+ {[Byte|Bytes],[]} = insn_encode(Op, Opnds, 0),
+ say(OS, "\t.byte "),
+ say_bytes(OS, Byte, Bytes).
+
+dotest1(OS) ->
+ init(OS),
+ % exercise all rm32 types
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32(16#87654321)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_sib(sib(?ECX))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_sib(sib(?ECX,sindex(2#10,?EDI)))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sindex(16#87654321)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sindex(16#87654321,sindex(2#10,?EDI))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_base(?ECX)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp8_sib(16#03,sib(?ECX))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp8_sib(16#03,sib(?ECX,sindex(2#10,?EDI)))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp8_base(16#3,?ECX)}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sib(16#87654321,sib(?ECX))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_sib(16#87654321,sib(?ECX,sindex(2#10,?EDI)))}}),
+ t(OS,lea,{{reg32,?EAX},{ea,ea_disp32_base(16#87654321,?EBP)}}),
+ t(OS,call,{{rm32,rm_reg(?EAX)}}),
+ t(OS,call,{{rm32,rm_mem(ea_disp32_sindex(16#87654321,sindex(2#10,?EDI)))}}),
+ t(OS,call,{{rel32,-5}}),
+ % default parameters for the tests below
+ Word32 = 16#87654321,
+ Word16 = 16#F00F,
+ Word8 = 16#80,
+ Imm32 = {imm32,Word32},
+ Imm16 = {imm16,Word16},
+ Imm8 = {imm8,Word8},
+ RM32 = {rm32,rm_reg(?EDX)},
+ RM16 = {rm16,rm_reg(?EDX)},
+ RM8 = {rm8,rm_reg(?EDX)},
+ Rel32 = {rel32,Word32},
+ Rel8 = {rel8,Word8},
+ Moffs32 = {moffs32,Word32},
+ Moffs16 = {moffs16,Word32},
+ Moffs8 = {moffs8,Word32},
+ CC = {cc,?CC_G},
+ Reg32 = {reg32,?EAX},
+ Reg16 = {reg16,?EAX},
+ Reg8 = {reg8,?AH},
+ EA = {ea,ea_base(?ECX)},
+ % exercise each instruction definition
+ t(OS,'adc',{eax,Imm32}),
+ t(OS,'adc',{RM32,Imm32}),
+ t(OS,'adc',{RM32,Imm8}),
+ t(OS,'adc',{RM32,Reg32}),
+ t(OS,'adc',{Reg32,RM32}),
+ t(OS,'add',{eax,Imm32}),
+ t(OS,'add',{RM32,Imm32}),
+ t(OS,'add',{RM32,Imm8}),
+ t(OS,'add',{RM32,Reg32}),
+ t(OS,'add',{Reg32,RM32}),
+ t(OS,'and',{eax,Imm32}),
+ t(OS,'and',{RM32,Imm32}),
+ t(OS,'and',{RM32,Imm8}),
+ t(OS,'and',{RM32,Reg32}),
+ t(OS,'and',{Reg32,RM32}),
+ t(OS,'bsf',{Reg32,RM32}),
+ t(OS,'bsr',{Reg32,RM32}),
+ t(OS,'bswap',{Reg32}),
+ t(OS,'bt',{RM32,Reg32}),
+ t(OS,'bt',{RM32,Imm8}),
+ t(OS,'btc',{RM32,Reg32}),
+ t(OS,'btc',{RM32,Imm8}),
+ t(OS,'btr',{RM32,Reg32}),
+ t(OS,'btr',{RM32,Imm8}),
+ t(OS,'bts',{RM32,Reg32}),
+ t(OS,'bts',{RM32,Imm8}),
+ t(OS,'call',{Rel32}),
+ t(OS,'call',{RM32}),
+ t(OS,'cbw',{}),
+ t(OS,'cdq',{}),
+ t(OS,'clc',{}),
+ t(OS,'cld',{}),
+ t(OS,'cmc',{}),
+ t(OS,'cmovcc',{CC,Reg32,RM32}),
+ t(OS,'cmp',{eax,Imm32}),
+ t(OS,'cmp',{RM32,Imm32}),
+ t(OS,'cmp',{RM32,Imm8}),
+ t(OS,'cmp',{RM32,Reg32}),
+ t(OS,'cmp',{Reg32,RM32}),
+ t(OS,'cwde',{}),
+ t(OS,'dec',{RM32}),
+ t(OS,'dec',{Reg32}),
+ t(OS,'div',{RM32}),
+ t(OS,'enter',{Imm16,{imm8,3}}),
+ t(OS,'idiv',{RM32}),
+ t(OS,'imul',{RM32}),
+ t(OS,'imul',{Reg32,RM32}),
+ t(OS,'imul',{Reg32,RM32,Imm8}),
+ t(OS,'imul',{Reg32,RM32,Imm32}),
+ t(OS,'inc',{RM32}),
+ t(OS,'inc',{Reg32}),
+ t(OS,'into',{}),
+ t(OS,'jcc',{CC,Rel8}),
+ t(OS,'jcc',{CC,Rel32}),
+ t(OS,'jecxz',{Rel8}),
+ t(OS,'jmp',{Rel8}),
+ t(OS,'jmp',{Rel32}),
+ t(OS,'jmp',{RM32}),
+ t(OS,'lea',{Reg32,EA}),
+ t(OS,'leave',{}),
+ t(OS,'loop',{Rel8}),
+ t(OS,'loope',{Rel8}),
+ t(OS,'loopne',{Rel8}),
+ t(OS,'mov',{RM8,Reg8}),
+ t(OS,'mov',{RM16,Reg16}),
+ t(OS,'mov',{RM32,Reg32}),
+ t(OS,'mov',{Reg8,RM8}),
+ t(OS,'mov',{Reg16,RM16}),
+ t(OS,'mov',{Reg32,RM32}),
+ t(OS,'mov',{al,Moffs8}),
+ t(OS,'mov',{ax,Moffs16}),
+ t(OS,'mov',{eax,Moffs32}),
+ t(OS,'mov',{Moffs8,al}),
+ t(OS,'mov',{Moffs16,ax}),
+ t(OS,'mov',{Moffs32,eax}),
+ t(OS,'mov',{Reg8,Imm8}),
+ t(OS,'mov',{Reg16,Imm16}),
+ t(OS,'mov',{Reg32,Imm32}),
+ t(OS,'mov',{RM8,Imm8}),
+ t(OS,'mov',{RM16,Imm16}),
+ t(OS,'mov',{RM32,Imm32}),
+ t(OS,'movsx',{Reg16,RM8}),
+ t(OS,'movsx',{Reg32,RM8}),
+ t(OS,'movsx',{Reg32,RM16}),
+ t(OS,'movzx',{Reg16,RM8}),
+ t(OS,'movzx',{Reg32,RM8}),
+ t(OS,'movzx',{Reg32,RM16}),
+ t(OS,'mul',{RM32}),
+ t(OS,'neg',{RM32}),
+ t(OS,'nop',{}),
+ t(OS,'not',{RM32}),
+ t(OS,'or',{eax,Imm32}),
+ t(OS,'or',{RM32,Imm32}),
+ t(OS,'or',{RM32,Imm8}),
+ t(OS,'or',{RM32,Reg32}),
+ t(OS,'or',{Reg32,RM32}),
+ t(OS,'pop',{RM32}),
+ t(OS,'pop',{Reg32}),
+ t(OS,'push',{RM32}),
+ t(OS,'push',{Reg32}),
+ t(OS,'push',{Imm8}),
+ t(OS,'push',{Imm32}),
+ t(OS,'rcl',{RM32,1}),
+ t(OS,'rcl',{RM32,cl}),
+ t(OS,'rcl',{RM32,Imm8}),
+ t(OS,'rcl',{RM16,Imm8}),
+ t(OS,'rcr',{RM32,1}),
+ t(OS,'rcr',{RM32,cl}),
+ t(OS,'rcr',{RM32,Imm8}),
+ t(OS,'rcr',{RM16,Imm8}),
+ t(OS,'ret',{}),
+ t(OS,'ret',{Imm16}),
+ t(OS,'rol',{RM32,1}),
+ t(OS,'rol',{RM32,cl}),
+ t(OS,'rol',{RM32,Imm8}),
+ t(OS,'rol',{RM16,Imm8}),
+ t(OS,'ror',{RM32,1}),
+ t(OS,'ror',{RM32,cl}),
+ t(OS,'ror',{RM32,Imm8}),
+ t(OS,'ror',{RM16,Imm8}),
+ t(OS,'sar',{RM32,1}),
+ t(OS,'sar',{RM32,cl}),
+ t(OS,'sar',{RM32,Imm8}),
+ t(OS,'sar',{RM16,Imm8}),
+ t(OS,'sbb',{eax,Imm32}),
+ t(OS,'sbb',{RM32,Imm32}),
+ t(OS,'sbb',{RM32,Imm8}),
+ t(OS,'sbb',{RM32,Reg32}),
+ t(OS,'sbb',{Reg32,RM32}),
+ t(OS,'setcc',{CC,RM8}),
+ t(OS,'shl',{RM32,1}),
+ t(OS,'shl',{RM32,cl}),
+ t(OS,'shl',{RM32,Imm8}),
+ t(OS,'shl',{RM16,Imm8}),
+ t(OS,'shld',{RM32,Reg32,Imm8}),
+ t(OS,'shld',{RM32,Reg32,cl}),
+ t(OS,'shr',{RM32,1}),
+ t(OS,'shr',{RM32,cl}),
+ t(OS,'shr',{RM32,Imm8}),
+ t(OS,'shr',{RM16,Imm8}),
+ t(OS,'shrd',{RM32,Reg32,Imm8}),
+ t(OS,'shrd',{RM32,Reg32,cl}),
+ t(OS,'stc',{}),
+ t(OS,'std',{}),
+ t(OS,'sub',{eax,Imm32}),
+ t(OS,'sub',{RM32,Imm32}),
+ t(OS,'sub',{RM32,Imm8}),
+ t(OS,'sub',{RM32,Reg32}),
+ t(OS,'sub',{Reg32,RM32}),
+ t(OS,'test',{eax,Imm32}),
+ t(OS,'test',{RM32,Imm32}),
+ t(OS,'test',{RM32,Reg32}),
+ t(OS,'xor',{eax,Imm32}),
+ t(OS,'xor',{RM32,Imm32}),
+ t(OS,'xor',{RM32,Imm8}),
+ t(OS,'xor',{RM32,Reg32}),
+ t(OS,'xor',{Reg32,RM32}),
+ t(OS,'prefix_fs',{}), t(OS,'add',{{reg32,?EAX},{rm32,rm_mem(ea_disp32(16#20))}}),
+ [].
+
+dotest() -> dotest1(group_leader()). % stdout == group_leader
+
+dotest(File) ->
+ {ok,OS} = file:open(File, [write]),
+ dotest1(OS),
+ file:close(OS).
+-endif.
diff --git a/lib/hipe/x86/hipe_x86_encode.txt b/lib/hipe/x86/hipe_x86_encode.txt
new file mode 100644
index 0000000000..13746e2a47
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_encode.txt
@@ -0,0 +1,213 @@
+$Id$
+
+hipe_x86_encode USAGE GUIDE
+Revision 0.4, 2001-10-09
+
+This document describes how to use the hipe_x86_encode.erl module.
+
+Preliminaries
+-------------
+This is not a tutorial on the x86 architecture. The reader
+should be familiar with both the programming model and
+the general syntax of instructions and their operands.
+
+The hipe_x86_encode module follows the conventions in the
+"Intel Architecture Software Developer's Manual, Volume 2:
+Instruction Set Reference" document. In particular, the
+order of source and destination operands in instructions
+follows Intel's conventions: "add eax,edx" adds edx to eax.
+The GNU Assembler "gas" follows the so-called AT&T syntax
+which reverses the order of the source and destination operands.
+
+Basic Functionality
+-------------------
+The hipe_x86_encode module implements the mapping from symbolic x86
+instructions to their binary representation, as lists of bytes.
+
+Instructions and operands have to match actual x86 instructions
+and operands exactly. The mapping from "abstract" instructions
+to correct x86 instructions has to be done before the instructions
+are passed to the hipe_x86_encode module. (In HiPE, this mapping
+is done by the hipe_x86_assemble module.)
+
+The hipe_x86_encode module handles arithmetic operations on 32-bit
+integers, data movement of 8, 16, and 32-bit words, and most
+control flow operations. A 32-bit address and operand size process
+mode is assumed, which is what Unix and Linux systems use.
+
+Operations and registers related to floating-point, MMX, SIMD, 3dnow!,
+or operating system control are not implemented. Segment registers
+are supported minimally: a 'prefix_fs' pseudo-instruction can be
+used to insert an FS segment register override prefix.
+
+Instruction Syntax
+------------------
+The function hipe_x86_encode:insn_encode/1 takes an instruction in
+symbolic form and translates it to its binary representation,
+as a list of bytes.
+
+Symbolic instructions are Erlang terms in the following syntax:
+
+ Insn ::= {Op,Opnds}
+ Op ::= (an Erlang atom)
+ Opnds ::= {Opnd1,...,Opndn} (n >= 0)
+ Opnd ::= eax | ax | al | 1 | cl
+ | {imm32,Imm32} | {imm16,Imm16} | {imm8,Imm8}
+ | {rm32,RM32} | {rm16,RM16} | {rm8,RM8}
+ | {rel32,Rel32} | {rel8,Rel8}
+ | {moffs32,Moffs32} | {moffs16,Moffs16} | {moffs8,Moffs8}
+ | {cc,CC}
+ | {reg32,Reg32} | {reg16,Reg16} | {reg8,Reg8}
+ | {ea,EA}
+ Imm32 ::= (a 32-bit integer; immediate value)
+ Imm16 ::= (a 16-bit integer; immediate value)
+ Imm8 ::= (an 8-bit integer; immediate value)
+ Rel32 ::= (a 32-bit integer; jump offset)
+ Rel8 ::= (an 8-bit integer; jump offset)
+ Moffs32 ::= (a 32-bit integer; address of 32-bit word)
+ Moffs16 ::= (a 32-bit integer; address of 16-bit word)
+ Moffs8 ::= (a 32-bit integer; address of 8-bit word)
+ CC ::= (a 4-bit condition code)
+ Reg32 ::= (a 3-bit register number of a 32-bit register)
+ Reg16 ::= (same as Reg32, but the register size is 16 bits)
+ Reg8 ::= (a 3-bit register number of an 8-bit register)
+ EA ::= (general operand; a memory cell)
+ RM32 ::= (general operand; a 32-bit register or memory cell)
+ RM16 ::= (same as RM32, but the operand size is 16 bits)
+ RM8 ::= (general operand; an 8-bit register or memory cell)
+
+To construct these terms, the hipe_x86_encode module exports several
+helper functions:
+
+cc/1
+ Converts an atom to a 4-bit condition code.
+
+al/0, cl/0, dl/0, bl/0, ah/0, ch/0, dh/0, bh/0
+ Returns a 3-bit register number for an 8-bit register.
+
+eax/0, ecx/0, edx/0, ebx/0, esp/0, ebp/0, esi/0, edi/0
+ Returns a 3-bit register number for a 32- or 16-bit register.
+
+A general operand can be a register or a memory operand.
+An x86 memory operand is expressed as an "effective address":
+
+ Displacement(Base register,Index register,Scale)
+or
+ [base register] + [(index register) * (scale)] + [displacement]
+
+where the base register is any of the 8 integer registers,
+the index register in any of the 8 integer registers except ESP,
+scale is 0, 1, 2, or 3 (multiply index with 1, 2, 4, or 8),
+and displacement is an 8- or 32-bit offset.
+Most components are optional.
+
+An effective address is constructed by calling one of the following
+nine functions:
+
+ea_base/1
+ ea_base(Reg32), where Reg32 is not ESP or EBP,
+ constructs the EA "(Reg32)", i.e. Reg32.
+ea_disp32/1
+ ea_disp32(Disp32) construct the EA "Disp32"
+ea_disp32_base/2
+ ea_disp32(Disp32, Reg32), where Reg32 is not ESP,
+ constructs the EA "Disp32(Reg32)", i.e. Reg32+Disp32.
+ea_disp8_base/2
+ This is like ea_disp32_base/2, except the displacement
+ is 8 bits instead of 32 bits. The CPU will _sign-extend_
+ the 8-bit displacement to 32 bits before using it.
+ea_disp32_sindex/1
+ ea_disp32_sindex(Disp32) constructs the EA "Disp32",
+ but uses a longer encoding than ea_disp32/1.
+ Hint: Don't use this one.
+
+The last four forms use index registers with or without scaling
+factors and base registers, so-called "SIBs". To build these, call:
+
+sindex/2
+ sindex(Scale, Index), where scale is 0, 1, 2, or 3, and
+ Index is a 32-bit integer register except ESP, constructs
+ part of a SIB representing "Index * 2^Scale".
+sib/1
+ sib(Reg32) constructs a SIB containing only a base register
+ and no scaled index, "(Reg32)", i.e. "Reg32".
+sib/2
+ sib(Reg32, sindex(Scale, Index)) constructs a SIB
+ "(Reg32,Index,Scale)", i.e. "Reg32 + (Index * 2^Scale)".
+
+ea_sib/1
+ ea_sib(SIB), where SIB's base register is not EBP,
+ constructs an EA which is that SIB, i.e. "(Base)" or
+ "(Base,Index,Scale)".
+ea_disp32_sib/2
+ ea_disp32_sib(Disp32, SIB) constructs the EA "Disp32(SIB)",
+ i.e. "Base+Disp32" or "Base+(Index*2^Scale)+Disp32".
+ea_disp32_sindex/2
+ ea_disp32_sindex(Disp32, Sindex) constructs the EA
+ "Disp32(,Index,Scale)", i.e. "(Index*2^Scale)+Disp32".
+ea_disp8_sib/2
+ This is just like ea_disp32_sib/2, except the displacement
+ is 8 bits (with sign-extension).
+
+To construct a general operand, call one of these two functions:
+
+rm_reg/1
+ rm_reg(Reg) constructs a general operand which is that register.
+rm_mem/1
+ rm_mem(EA) constucts a general operand which is the memory
+ cell addressed by EA.
+
+A symbolic instruction with name "Op" and the n operands "Opnd1"
+to "Opndn" is represented as the tuple
+
+ {Op, {Opnd1, ..., Opndn}}
+
+Usage
+-----
+Once a symbolic instruction "Insn" has been constructed, it can be
+translated to binary by calling
+
+ insn_encode(Insn)
+
+which returns a list of bytes.
+
+Since x86 instructions have varying size (as opposed to most
+RISC machines), there is also a function
+
+ insn_sizeof(Insn)
+
+which returns the number of bytes the binary encoding will occupy.
+insn_sizeof(Insn) equals length(insn_encode(Insn)), but insn_sizeof
+is cheaper to compute. This is useful for two purposes: (1) when
+compiling to memory, one needs to know in advance how many bytes of
+memory to allocate for a piece of code, and (2) when computing the
+relative distance between a jump or call instruction and its target
+label.
+
+Examples
+--------
+1. nop
+is constructed as
+ {nop, {}}
+
+2. add eax,edx (eax := eax + edx)
+can be constructed as
+ {add, {eax, {reg32, hipe_x86_encode:edx()}}}
+or as
+ Reg32 = {reg32, hipe_x86_encode:eax()},
+ RM32 = {rm32, hipe_x86_encode:rm_reg(hipe_x86_encode:edx())},
+ {add, {Reg32, RM32}}
+
+3. mov edx,(eax) (edx := MEM[eax])
+is constructed as
+ Reg32 = {reg32, hipe_x86_encode:edx()},
+ RM32 = {rm32, hipe_x86_encode:rm_reg(hipe_x86_encode:eax())},
+ {mov, {Reg32, RM32}}
+
+Addendum
+--------
+The hipe_x86_encode.erl source code is the authoritative reference
+for the hipe_x86_encode module.
+
+Please report errors in either hipe_x86_encode.erl or this guide
+to mikpe@it.uu.se.
diff --git a/lib/hipe/x86/hipe_x86_frame.erl b/lib/hipe/x86/hipe_x86_frame.erl
new file mode 100644
index 0000000000..0a3317a369
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_frame.erl
@@ -0,0 +1,687 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% x86 stack frame handling
+%%%
+%%% - map non-register temps to stack slots
+%%% - add explicit stack management code to prologue and epilogue,
+%%% and at calls and tailcalls
+%%%
+%%% TODO:
+%%% - Compute max stack in a pre-pass? (get rid of ref cell updates)
+%%% - Merge all_temps and defun_minframe to a single
+%%% pass, for compile-time efficiency reasons.
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_FRAME, hipe_amd64_frame).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_LIVENESS, hipe_amd64_liveness).
+-define(LEAF_WORDS, ?AMD64_LEAF_WORDS).
+-else.
+-define(HIPE_X86_FRAME, hipe_x86_frame).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_LIVENESS, hipe_x86_liveness).
+-define(LEAF_WORDS, ?X86_LEAF_WORDS).
+-endif.
+
+-module(?HIPE_X86_FRAME).
+-export([frame/2]).
+-include("../x86/hipe_x86.hrl").
+-include("../rtl/hipe_literals.hrl").
+
+frame(Defun, _Options) ->
+ Formals = fix_formals(hipe_x86:defun_formals(Defun)),
+ Temps0 = all_temps(hipe_x86:defun_code(Defun), Formals),
+ MinFrame = defun_minframe(Defun),
+ Temps = ensure_minframe(MinFrame, Temps0),
+ CFG0 = hipe_x86_cfg:init(Defun),
+ Liveness = ?HIPE_X86_LIVENESS:analyse(CFG0),
+ CFG1 = do_body(CFG0, Liveness, Formals, Temps),
+ hipe_x86_cfg:linearise(CFG1).
+
+fix_formals(Formals) ->
+ fix_formals(?HIPE_X86_REGISTERS:nr_args(), Formals).
+
+fix_formals(0, Rest) -> Rest;
+fix_formals(N, [_|Rest]) -> fix_formals(N-1, Rest);
+fix_formals(_, []) -> [].
+
+do_body(CFG0, Liveness, Formals, Temps) ->
+ Context = mk_context(Liveness, Formals, Temps),
+ CFG1 = do_blocks(CFG0, Context),
+ do_prologue(CFG1, Context).
+
+do_blocks(CFG, Context) ->
+ Labels = hipe_x86_cfg:labels(CFG),
+ do_blocks(Labels, CFG, Context).
+
+do_blocks([Label|Labels], CFG, Context) ->
+ Liveness = context_liveness(Context),
+ LiveOut = ?HIPE_X86_LIVENESS:liveout(Liveness, Label),
+ Block = hipe_x86_cfg:bb(CFG, Label),
+ Code = hipe_bb:code(Block),
+ NewCode = do_block(Code, LiveOut, Context),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ NewCFG = hipe_x86_cfg:bb_add(CFG, Label, NewBlock),
+ do_blocks(Labels, NewCFG, Context);
+do_blocks([], CFG, _) ->
+ CFG.
+
+do_block(Insns, LiveOut, Context) ->
+ do_block(Insns, LiveOut, Context, context_framesize(Context), []).
+
+do_block([I|Insns], LiveOut, Context, FPoff0, RevCode) ->
+ {NewIs, FPoff1} = do_insn(I, LiveOut, Context, FPoff0),
+ do_block(Insns, LiveOut, Context, FPoff1, lists:reverse(NewIs, RevCode));
+do_block([], _, Context, FPoff, RevCode) ->
+ FPoff0 = context_framesize(Context),
+ if FPoff =:= FPoff0 -> [];
+ true -> exit({?MODULE,do_block,FPoff})
+ end,
+ lists:reverse(RevCode, []).
+
+do_insn(I, LiveOut, Context, FPoff) ->
+ case I of
+ #alu{} ->
+ {[do_alu(I, Context, FPoff)], FPoff};
+ #cmp{} ->
+ {[do_cmp(I, Context, FPoff)], FPoff};
+ #fp_unop{} ->
+ {do_fp_unop(I, Context, FPoff), FPoff};
+ #fp_binop{} ->
+ {do_fp_binop(I, Context, FPoff), FPoff};
+ #fmove{} ->
+ {[do_fmove(I, Context, FPoff)], FPoff};
+ #imul{} ->
+ {[do_imul(I, Context, FPoff)], FPoff};
+ #move{} ->
+ {[do_move(I, Context, FPoff)], FPoff};
+ #movsx{} ->
+ {[do_movsx(I, Context, FPoff)], FPoff};
+ #movzx{} ->
+ {[do_movzx(I, Context, FPoff)], FPoff};
+ #pseudo_call{} ->
+ do_pseudo_call(I, LiveOut, Context, FPoff);
+ #pseudo_tailcall{} ->
+ {do_pseudo_tailcall(I, Context), context_framesize(Context)};
+ #push{} ->
+ {[do_push(I, Context, FPoff)], FPoff+word_size()};
+ #ret{} ->
+ {do_ret(I, Context, FPoff), context_framesize(Context)};
+ #shift{} ->
+ {[do_shift(I, Context, FPoff)], FPoff};
+ _ -> % comment, jmp, label, pseudo_jcc, pseudo_tailcall_prepare
+ {[I], FPoff}
+ end.
+
+%%%
+%%% Convert any pseudo-temp operand in a binary (alu, cmp, move)
+%%% or unary (push) instruction to an explicit x86_mem operand.
+%%%
+
+do_alu(I, Context, FPoff) ->
+ #alu{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#alu{src=Src,dst=Dst}.
+
+do_cmp(I, Context, FPoff) ->
+ #cmp{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#cmp{src=Src,dst=Dst}.
+
+do_fp_unop(I, Context, FPoff) ->
+ #fp_unop{arg=Arg0} = I,
+ Arg = conv_opnd(Arg0, FPoff, Context),
+ [I#fp_unop{arg=Arg}].
+
+do_fp_binop(I, Context, FPoff) ->
+ #fp_binop{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ [I#fp_binop{src=Src,dst=Dst}].
+
+do_fmove(I, Context, FPoff) ->
+ #fmove{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#fmove{src=Src,dst=Dst}.
+
+do_imul(I, Context, FPoff) ->
+ #imul{src=Src0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ I#imul{src=Src}.
+
+do_move(I, Context, FPoff) ->
+ #move{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#move{src=Src,dst=Dst}.
+
+do_movsx(I, Context, FPoff) ->
+ #movsx{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#movsx{src=Src,dst=Dst}.
+
+do_movzx(I, Context, FPoff) ->
+ #movzx{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#movzx{src=Src,dst=Dst}.
+
+do_push(I, Context, FPoff) ->
+ #push{src=Src0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ I#push{src=Src}.
+
+do_shift(I, Context, FPoff) ->
+ #shift{src=Src0,dst=Dst0} = I,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ I#shift{src=Src,dst=Dst}.
+
+conv_opnd(Opnd, FPoff, Context) ->
+ case opnd_is_pseudo(Opnd) of
+ false ->
+ Opnd;
+ true ->
+ conv_pseudo(Opnd, FPoff, Context)
+ end.
+
+conv_pseudo(Temp, FPoff, Context) ->
+ Off = FPoff + context_offset(Context, Temp),
+ conv_pseudo(Temp, Off).
+
+conv_pseudo(Temp, Off) ->
+ hipe_x86:mk_mem(mk_sp(), hipe_x86:mk_imm(Off), hipe_x86:temp_type(Temp)).
+
+%%%
+%%% Return - deallocate frame and emit 'ret $N' insn.
+%%%
+
+do_ret(_I, Context, FPoff) ->
+ %% XXX: this conses up a new ret insn, ignoring the one rtl->x86 made
+ adjust_sp(FPoff, [hipe_x86:mk_ret(word_size()*context_arity(Context))]).
+
+adjust_sp(N, Rest) ->
+ if N =:= 0 ->
+ Rest;
+ true ->
+ [hipe_x86:mk_alu('add', hipe_x86:mk_imm(N), mk_sp()) | Rest]
+ end.
+
+%%%
+%%% Recursive calls.
+%%%
+
+do_pseudo_call(I, LiveOut, Context, FPoff0) ->
+ #x86_sdesc{exnlab=ExnLab,arity=OrigArity} = hipe_x86:pseudo_call_sdesc(I),
+ Fun0 = hipe_x86:pseudo_call_fun(I),
+ Fun1 = conv_opnd(Fun0, FPoff0, Context),
+ LiveTemps = [Temp || Temp <- LiveOut, temp_is_pseudo(Temp)],
+ SDesc = mk_sdesc(ExnLab, Context, LiveTemps),
+ ContLab = hipe_x86:pseudo_call_contlab(I),
+ Linkage = hipe_x86:pseudo_call_linkage(I),
+ CallCode = [hipe_x86:mk_pseudo_call(Fun1, SDesc, ContLab, Linkage)],
+ %% +word_size() for our RA and +word_size() for callee's RA should
+ %% it need to call inc_stack
+ StkArity = erlang:max(0, OrigArity - ?HIPE_X86_REGISTERS:nr_args()),
+ context_need_stack(Context, stack_need(FPoff0 + 2*word_size(), StkArity, Fun1)),
+ ArgsBytes = word_size() * StkArity,
+ {CallCode, FPoff0 - ArgsBytes}.
+
+stack_need(FPoff, StkArity, Fun) ->
+ case Fun of
+ #x86_prim{} -> FPoff;
+ #x86_mfa{m=M,f=F,a=A} ->
+ case erlang:is_builtin(M, F, A) of
+ true -> FPoff;
+ false -> stack_need_general(FPoff, StkArity)
+ end;
+ #x86_temp{} -> stack_need_general(FPoff, StkArity);
+ #x86_mem{} -> stack_need_general(FPoff, StkArity)
+ end.
+
+stack_need_general(FPoff, StkArity) ->
+ erlang:max(FPoff, FPoff + (?LEAF_WORDS - 2 - StkArity) * word_size()).
+
+%%%
+%%% Create stack descriptors for call sites.
+%%%
+
+mk_sdesc(ExnLab, Context, Temps) -> % for normal calls
+ Temps0 = only_tagged(Temps),
+ Live = mk_live(Context, Temps0),
+ Arity = context_arity(Context),
+ FSize = context_framesize(Context),
+ hipe_x86:mk_sdesc(ExnLab, FSize div word_size(), Arity,
+ list_to_tuple(Live)).
+
+only_tagged(Temps)->
+ [X || X <- Temps, hipe_x86:temp_type(X) =:= 'tagged'].
+
+mk_live(Context, Temps) ->
+ lists:sort([temp_to_slot(Context, Temp) || Temp <- Temps]).
+
+temp_to_slot(Context, Temp) ->
+ (context_framesize(Context) + context_offset(Context, Temp))
+ div word_size().
+
+mk_minimal_sdesc(Context) -> % for inc_stack_0 calls
+ hipe_x86:mk_sdesc([], 0, context_arity(Context), {}).
+
+%%%
+%%% Tailcalls.
+%%%
+
+do_pseudo_tailcall(I, Context) -> % always at FPoff=context_framesize(Context)
+ Arity = context_arity(Context),
+ Args = hipe_x86:pseudo_tailcall_stkargs(I) ++ [context_ra(Context)],
+ Fun0 = hipe_x86:pseudo_tailcall_fun(I),
+ {Insns, FPoff1, Fun1} = do_tailcall_args(Args, Context, Fun0),
+ context_need_stack(Context, FPoff1),
+ FPoff2 = FPoff1 + word_size()+word_size()*Arity - word_size()*length(Args),
+ %% +word_size() for callee's inc_stack RA
+ StkArity = length(hipe_x86:pseudo_tailcall_stkargs(I)),
+ context_need_stack(Context, stack_need(FPoff2 + word_size(), StkArity, Fun1)),
+ I2 = hipe_x86:mk_jmp_fun(Fun1, hipe_x86:pseudo_tailcall_linkage(I)),
+ Insns ++ adjust_sp(FPoff2, [I2]).
+
+do_tailcall_args(Args, Context, Fun0) ->
+ FPoff0 = context_framesize(Context),
+ Arity = context_arity(Context),
+ FrameTop = word_size() + word_size()*Arity,
+ DangerOff = FrameTop - word_size()*length(Args),
+ Moves = mk_moves(Args, FrameTop, []),
+ {Stores, Simple, Conflict} =
+ split_moves(Moves, Context, DangerOff, [], [], []),
+ %% sanity check (shouldn't trigger any more)
+ if DangerOff < -FPoff0 ->
+ exit({?MODULE,do_tailcall_args,DangerOff,-FPoff0});
+ true -> []
+ end,
+ FPoff1 = FPoff0,
+ %%
+ {Pushes, MoreSimple, FPoff2} = split_conflict(Conflict, FPoff1, [], []),
+ %%
+ {PushFun0, FPoff3, LoadFun1, Fun1} =
+ case opnd_is_pseudo(Fun0) of
+ false ->
+ {[], FPoff2, [], Fun0};
+ true ->
+ Type = hipe_x86:temp_type(Fun0),
+ Temp1 = mk_temp1(Type),
+ Fun0Off = context_offset(Context, Fun0),
+ MEM0 = conv_pseudo(Fun0, FPoff2 + Fun0Off),
+ if Fun0Off >= DangerOff ->
+ Fun1Off = hipe_x86:mk_imm(0),
+ MEM1 = hipe_x86:mk_mem(mk_sp(), Fun1Off, Type),
+ {[hipe_x86:mk_push(MEM0)],
+ FPoff2 + word_size(),
+ [hipe_x86:mk_move(MEM1, Temp1)],
+ Temp1};
+ true ->
+ {[], FPoff2, [hipe_x86:mk_move(MEM0, Temp1)], Temp1}
+ end
+ end,
+ %%
+ RegTemp0 = ?HIPE_X86_REGISTERS:temp0(),
+ TempReg =
+ case hipe_x86:is_temp(Fun1) of
+ true ->
+ RegFun1 = hipe_x86:temp_reg(Fun1),
+ if RegFun1 =/= RegTemp0 -> RegTemp0;
+ true -> ?HIPE_X86_REGISTERS:temp1()
+ end;
+ false ->
+ RegTemp0
+ end,
+ %%
+ {Pushes ++ PushFun0 ++
+ store_moves(Stores, FPoff3, LoadFun1 ++
+ simple_moves(Simple, FPoff3, TempReg,
+ simple_moves(MoreSimple, FPoff3, TempReg,
+ []))),
+ FPoff3, Fun1}.
+
+mk_moves([Arg|Args], Off, Moves) ->
+ Off1 = Off - word_size(),
+ mk_moves(Args, Off1, [{Arg,Off1}|Moves]);
+mk_moves([], _, Moves) ->
+ Moves.
+
+split_moves([Move|Moves], Context, DangerOff, Stores, Simple, Conflict) ->
+ {Src,DstOff} = Move,
+ case src_is_pseudo(Src) of
+ false ->
+ split_moves(Moves, Context, DangerOff, [Move|Stores],
+ Simple, Conflict);
+ true ->
+ SrcOff = context_offset(Context, Src),
+ Type = typeof_src(Src),
+ if SrcOff =:= DstOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, Conflict);
+ SrcOff >= DangerOff ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ Simple, [{SrcOff,DstOff,Type}|Conflict]);
+ true ->
+ split_moves(Moves, Context, DangerOff, Stores,
+ [{SrcOff,DstOff,Type}|Simple], Conflict)
+ end
+ end;
+split_moves([], _, _, Stores, Simple, Conflict) ->
+ {Stores, Simple, Conflict}.
+
+split_conflict([{SrcOff,DstOff,Type}|Conflict], FPoff, Pushes, Simple) ->
+ Push = hipe_x86:mk_push(
+ hipe_x86:mk_mem(mk_sp(), hipe_x86:mk_imm(FPoff+SrcOff), Type)),
+ split_conflict(Conflict, FPoff+word_size(), [Push|Pushes],
+ [{-(FPoff+word_size()),DstOff,Type}|Simple]);
+split_conflict([], FPoff, Pushes, Simple) ->
+ {lists:reverse(Pushes), Simple, FPoff}.
+
+simple_moves([{SrcOff,DstOff,Type}|Moves], FPoff, TempReg, Rest) ->
+ Temp = hipe_x86:mk_temp(TempReg, Type),
+ SP = mk_sp(),
+ LoadOff = hipe_x86:mk_imm(FPoff+SrcOff),
+ LD = hipe_x86:mk_move(hipe_x86:mk_mem(SP, LoadOff, Type), Temp),
+ StoreOff = hipe_x86:mk_imm(FPoff+DstOff),
+ ST = hipe_x86:mk_move(Temp, hipe_x86:mk_mem(SP, StoreOff, Type)),
+ simple_moves(Moves, FPoff, TempReg, [LD, ST | Rest]);
+simple_moves([], _, _, Rest) ->
+ Rest.
+
+store_moves([{Src,DstOff}|Moves], FPoff, Rest) ->
+ Type = typeof_src(Src),
+ SP = mk_sp(),
+ StoreOff = hipe_x86:mk_imm(FPoff+DstOff),
+ ST = hipe_x86:mk_move(Src, hipe_x86:mk_mem(SP, StoreOff, Type)),
+ store_moves(Moves, FPoff, [ST | Rest]);
+store_moves([], _, Rest) ->
+ Rest.
+
+%%%
+%%% Contexts
+%%%
+
+-record(context, {liveness, framesize, arity, map, ra, ref_maxstack}).
+
+mk_context(Liveness, Formals, Temps) ->
+ RA = hipe_x86:mk_new_temp('untagged'),
+ {Map, MinOff} = mk_temp_map(Formals, RA, Temps),
+ FrameSize = (-MinOff),
+ RefMaxStack = hipe_bifs:ref(FrameSize),
+ Context = #context{liveness=Liveness,
+ framesize=FrameSize, arity=length(Formals),
+ map=Map, ra=RA, ref_maxstack=RefMaxStack},
+ Context.
+
+context_need_stack(#context{ref_maxstack=RM}, N) ->
+ M = hipe_bifs:ref_get(RM),
+ if N > M -> hipe_bifs:ref_set(RM, N);
+ true -> []
+ end.
+
+context_maxstack(#context{ref_maxstack=RM}) ->
+ hipe_bifs:ref_get(RM).
+
+context_arity(#context{arity=Arity}) ->
+ Arity.
+
+context_framesize(#context{framesize=FrameSize}) ->
+ FrameSize.
+
+context_liveness(#context{liveness=Liveness}) ->
+ Liveness.
+
+context_offset(#context{map=Map}, Temp) ->
+ tmap_lookup(Map, Temp).
+
+context_ra(#context{ra=RA}) ->
+ RA.
+
+mk_temp_map(Formals, RA, Temps) ->
+ {Map, _} = enter_vars(Formals, word_size() * (length(Formals)+1),
+ tmap_bind(tmap_empty(), RA, 0)),
+ enter_vars(tset_to_list(Temps), 0, Map).
+
+enter_vars([V|Vs], PrevOff, Map) ->
+ Off =
+ case hipe_x86:temp_type(V) of
+ 'double' -> PrevOff - float_size();
+ _ -> PrevOff - word_size()
+ end,
+ enter_vars(Vs, Off, tmap_bind(Map, V, Off));
+enter_vars([], Off, Map) ->
+ {Map, Off}.
+
+tmap_empty() ->
+ gb_trees:empty().
+
+tmap_bind(Map, Key, Val) ->
+ gb_trees:insert(Key, Val, Map).
+
+tmap_lookup(Map, Key) ->
+ gb_trees:get(Key, Map).
+
+%%%
+%%% do_prologue: prepend stack frame allocation code.
+%%%
+%%% NewStart:
+%%% temp0 = sp - MaxStack
+%%% if( temp0 < SP_LIMIT(P) ) goto IncStack else goto AllocFrame
+%%% AllocFrame:
+%%% sp -= FrameSize
+%%% goto OldStart
+%%% OldStart:
+%%% ...
+%%% IncStack:
+%%% call inc_stack
+%%% goto NewStart
+
+do_prologue(CFG, Context) ->
+ do_check_stack(do_alloc_frame(CFG, Context), Context).
+
+do_alloc_frame(CFG, Context) ->
+ case context_framesize(Context) of
+ 0 ->
+ CFG;
+ FrameSize ->
+ OldStartLab = hipe_x86_cfg:start_label(CFG),
+ AllocFrameLab = hipe_gensym:get_next_label(x86),
+ SP = mk_sp(),
+ AllocFrameCode =
+ [hipe_x86:mk_alu('sub', hipe_x86:mk_imm(FrameSize), SP),
+ hipe_x86:mk_jmp_label(OldStartLab)],
+ CFG1 = hipe_x86_cfg:bb_add(CFG, AllocFrameLab,
+ hipe_bb:mk_bb(AllocFrameCode)),
+ hipe_x86_cfg:start_label_update(CFG1, AllocFrameLab)
+ end.
+
+do_check_stack(CFG, Context) ->
+ MaxStack = context_maxstack(Context),
+ Arity = context_arity(Context),
+ Guaranteed = erlang:max(0, (?LEAF_WORDS - 1 - Arity) * word_size()),
+ if MaxStack =< Guaranteed ->
+ %% io:format("~w: MaxStack ~w =< Guaranteed ~w :-)\n", [?MODULE,MaxStack,Guaranteed]),
+ CFG;
+ true ->
+ %% io:format("~w: MaxStack ~w > Guaranteed ~w :-(\n", [?MODULE,MaxStack,Guaranteed]),
+ AllocFrameLab = hipe_x86_cfg:start_label(CFG),
+ NewStartLab = hipe_gensym:get_next_label(x86),
+ IncStackLab = hipe_gensym:get_next_label(x86),
+ %%
+ Type = 'untagged',
+ Preg = ?HIPE_X86_REGISTERS:proc_pointer(),
+ Pbase = hipe_x86:mk_temp(Preg, Type),
+ SP_LIMIT_OFF = hipe_x86:mk_imm(
+ ?HIPE_X86_REGISTERS:sp_limit_offset()),
+ Temp0 = mk_temp0(Type),
+ SP = mk_sp(),
+ NewStartCode =
+ %% hopefully this lea is faster than the mov;sub it replaced
+ [hipe_x86:mk_lea(
+ hipe_x86:mk_mem(SP, hipe_x86:mk_imm(-MaxStack), 'untagged'),
+ Temp0),
+ hipe_x86:mk_cmp(
+ hipe_x86:mk_mem(Pbase, SP_LIMIT_OFF, Type), Temp0),
+ hipe_x86:mk_pseudo_jcc('b', IncStackLab, AllocFrameLab, 0.01)],
+ IncStackCode =
+ [hipe_x86:mk_call(hipe_x86:mk_prim('inc_stack_0'),
+ mk_minimal_sdesc(Context), not_remote),
+ hipe_x86:mk_jmp_label(NewStartLab)],
+ %%
+ CFG1 = hipe_x86_cfg:bb_add(CFG, NewStartLab,
+ hipe_bb:mk_bb(NewStartCode)),
+ CFG2 = hipe_x86_cfg:bb_add(CFG1, IncStackLab,
+ hipe_bb:mk_bb(IncStackCode)),
+ hipe_x86_cfg:start_label_update(CFG2, NewStartLab)
+ end.
+
+%%% typeof_src -- what's src's type?
+
+typeof_src(Src) ->
+ case Src of
+ #x86_imm{} ->
+ 'untagged';
+ #x86_temp{} ->
+ hipe_x86:temp_type(Src);
+ #x86_mem{} ->
+ hipe_x86:mem_type(Src)
+ end.
+
+%%% Cons up an '%sp' Temp.
+
+mk_sp() ->
+ hipe_x86:mk_temp(?HIPE_X86_REGISTERS:sp(), 'untagged').
+
+%%% Cons up a '%temp0' Temp.
+
+mk_temp0(Type) ->
+ hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp0(), Type).
+
+%%% Cons up a '%temp1' Temp.
+
+mk_temp1(Type) ->
+ hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp1(), Type).
+
+%%% Check if an operand is a pseudo-Temp.
+
+src_is_pseudo(Src) ->
+ opnd_is_pseudo(Src).
+
+opnd_is_pseudo(Opnd) ->
+ case hipe_x86:is_temp(Opnd) of
+ true -> temp_is_pseudo(Opnd);
+ false -> false
+ end.
+
+temp_is_pseudo(Temp) ->
+ case hipe_x86:is_temp(Temp) of
+ true ->
+ not(?HIPE_X86_REGISTERS:is_precoloured(hipe_x86:temp_reg(Temp)));
+ false ->
+ false
+ end.
+
+
+%%%
+%%% Build the set of all temps used in a Defun's body.
+%%%
+
+all_temps(Code, Formals) ->
+ S0 = find_temps(Code, tset_empty()),
+ S1 = tset_del_list(S0, Formals),
+ S2 = tset_filter(S1, fun(T) -> temp_is_pseudo(T) end),
+ S2.
+
+find_temps([I|Insns], S0) ->
+ S1 = tset_add_list(S0, hipe_x86_defuse:insn_def(I)),
+ S2 = tset_add_list(S1, hipe_x86_defuse:insn_use(I)),
+ find_temps(Insns, S2);
+find_temps([], S) ->
+ S.
+
+tset_empty() ->
+ gb_sets:new().
+
+tset_size(S) ->
+ gb_sets:size(S).
+
+tset_insert(S, T) ->
+ gb_sets:add_element(T, S).
+
+tset_add_list(S, Ts) ->
+ gb_sets:union(S, gb_sets:from_list(Ts)).
+
+tset_del_list(S, Ts) ->
+ gb_sets:subtract(S, gb_sets:from_list(Ts)).
+
+tset_filter(S, F) ->
+ gb_sets:filter(F, S).
+
+tset_to_list(S) ->
+ gb_sets:to_list(S).
+
+%%%
+%%% Compute minimum permissible frame size, ignoring spilled temps.
+%%% This is done to ensure that we won't have to adjust the frame size
+%%% in the middle of a tailcall.
+%%%
+
+defun_minframe(Defun) ->
+ MaxTailArity = body_mta(hipe_x86:defun_code(Defun), 0),
+ MyArity = length(fix_formals(hipe_x86:defun_formals(Defun))),
+ erlang:max(MaxTailArity - MyArity, 0).
+
+body_mta([I|Code], MTA) ->
+ body_mta(Code, insn_mta(I, MTA));
+body_mta([], MTA) ->
+ MTA.
+
+insn_mta(I, MTA) ->
+ case I of
+ #pseudo_tailcall{arity=Arity} ->
+ erlang:max(MTA, Arity - ?HIPE_X86_REGISTERS:nr_args());
+ _ -> MTA
+ end.
+
+%%%
+%%% Ensure that we have enough temps to satisfy the minimum frame size,
+%%% if necessary by prepending unused dummy temps.
+%%%
+
+ensure_minframe(MinFrame, Temps) ->
+ ensure_minframe(MinFrame, tset_size(Temps), Temps).
+
+ensure_minframe(MinFrame, Frame, Temps) ->
+ if MinFrame > Frame ->
+ Temp = hipe_x86:mk_new_temp('untagged'),
+ ensure_minframe(MinFrame, Frame+1, tset_insert(Temps, Temp));
+ true -> Temps
+ end.
+
+word_size() ->
+ ?HIPE_X86_REGISTERS:wordsize().
+
+float_size() ->
+ ?HIPE_X86_REGISTERS:float_size().
diff --git a/lib/hipe/x86/hipe_x86_liveness.erl b/lib/hipe/x86/hipe_x86_liveness.erl
new file mode 100644
index 0000000000..6874b05a59
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_liveness.erl
@@ -0,0 +1,57 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% x86_liveness -- compute register liveness for x86 CFGs
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_LIVENESS, hipe_amd64_liveness).
+-define(HIPE_X86_DEFUSE, hipe_amd64_defuse).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-else.
+-define(HIPE_X86_LIVENESS, hipe_x86_liveness).
+-define(HIPE_X86_DEFUSE, hipe_x86_defuse).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-endif.
+
+-module(?HIPE_X86_LIVENESS).
+
+-export([analyse/1]).
+-export([liveout/2]).
+-export([uses/1, defines/1]). % used in hipe_*_spill_restore modules
+
+-include("../x86/hipe_x86.hrl"). % ../x86/ is needed when included in amd64
+-include("../flow/liveness.inc").
+
+analyse(CFG) -> analyze(CFG).
+cfg_bb(CFG, L) -> hipe_x86_cfg:bb(CFG, L).
+cfg_postorder(CFG) -> hipe_x86_cfg:postorder(CFG).
+cfg_succ(CFG, L) -> hipe_x86_cfg:succ(CFG, L).
+uses(Insn) -> ?HIPE_X86_DEFUSE:insn_use(Insn).
+defines(Insn) -> ?HIPE_X86_DEFUSE:insn_def(Insn).
+liveout_no_succ() ->
+ ordsets:from_list(lists:map(fun({Reg,Type}) ->
+ hipe_x86:mk_temp(Reg, Type)
+ end,
+ ?HIPE_X86_REGISTERS:live_at_return())).
+
+-ifdef(DEBUG_LIVENESS).
+cfg_labels(CFG) -> hipe_x86_cfg:labels(CFG).
+cfg_bb_add(CFG,L,NewBB) -> hipe_x86_cfg:bb_add(CFG,L,NewBB).
+mk_comment(Text) -> hipe_x86:mk_comment(Text).
+-endif.
diff --git a/lib/hipe/x86/hipe_x86_main.erl b/lib/hipe/x86/hipe_x86_main.erl
new file mode 100644
index 0000000000..f45a49ca0a
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_main.erl
@@ -0,0 +1,70 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_MAIN, hipe_amd64_main).
+-define(RTL_TO_X86, rtl_to_amd64). % XXX: kill this crap
+-define(HIPE_RTL_TO_X86, hipe_rtl_to_amd64).
+-define(HIPE_X86_RA, hipe_amd64_ra).
+-define(HIPE_X86_FRAME, hipe_amd64_frame).
+-define(HIPE_X86_PP, hipe_amd64_pp).
+-define(X86TAG, amd64). % XXX: kill this crap
+-define(X86STR, "amd64").
+-define(HIPE_X86_SPILL_RESTORE, hipe_amd64_spill_restore).
+-else.
+-define(HIPE_X86_MAIN, hipe_x86_main).
+-define(RTL_TO_X86, rtl_to_x86). % XXX: kill this crap
+-define(HIPE_RTL_TO_X86, hipe_rtl_to_x86).
+-define(HIPE_X86_RA, hipe_x86_ra).
+-define(HIPE_X86_FRAME, hipe_x86_frame).
+-define(HIPE_X86_PP, hipe_x86_pp).
+-define(X86TAG, x86). % XXX: kill this crap
+-define(X86STR, "x86").
+-define(HIPE_X86_SPILL_RESTORE, hipe_x86_spill_restore).
+-endif.
+
+-module(?HIPE_X86_MAIN).
+-export([?RTL_TO_X86/3]). % XXX: change to 'from_rtl' to avoid $ARCH substring
+
+-ifndef(DEBUG).
+-define(DEBUG,1).
+-endif.
+-define(HIPE_INSTRUMENT_COMPILER, true). %% Turn on instrumentation.
+-include("../main/hipe.hrl").
+
+?RTL_TO_X86(MFA, RTL, Options) ->
+ Translated = ?option_time(?HIPE_RTL_TO_X86:translate(RTL),
+ "RTL-to-"?X86STR, Options),
+ SpillRest =
+ case proplists:get_bool(caller_save_spill_restore, Options) of
+ true ->
+ ?option_time(?HIPE_X86_SPILL_RESTORE:spill_restore(Translated, Options),
+ ?X86STR" spill restore", Options);
+ false ->
+ Translated
+ end,
+ Allocated = ?option_time(?HIPE_X86_RA:ra(SpillRest, Options),
+ ?X86STR" register allocation", Options),
+ Framed = ?option_time(?HIPE_X86_FRAME:frame(Allocated, Options),
+ ?X86STR" frame", Options),
+ Finalised = ?option_time(hipe_x86_postpass:postpass(Framed, Options),
+ ?X86STR" finalise", Options),
+ ?HIPE_X86_PP:optional_pp(Finalised, MFA, Options),
+ {native, ?X86TAG, {unprofiled, Finalised}}.
diff --git a/lib/hipe/x86/hipe_x86_postpass.erl b/lib/hipe/x86/hipe_x86_postpass.erl
new file mode 100644
index 0000000000..34e3d7a11b
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_postpass.erl
@@ -0,0 +1,276 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%----------------------------------------------------------------------
+%%% File : hipe_x86_postpass.erl
+%%% Author : Christoffer Vikstr�m <chvi3471@student.uu.se>
+%%% Purpose : Contain postpass optimisations for x86-assembler code.
+%%% Created : 5 Aug 2003 by Christoffer Vikstr�m <chvi3471@student.uu.se>
+%%%----------------------------------------------------------------------
+
+-ifndef(HIPE_X86_POSTPASS).
+-define(HIPE_X86_POSTPASS, hipe_x86_postpass).
+-endif.
+
+-module(?HIPE_X86_POSTPASS).
+-export([postpass/2]).
+-include("../x86/hipe_x86.hrl").
+
+%%>----------------------------------------------------------------------<
+% Procedure : postpass/2
+% Purpose : Function that performs a nr of postpass optimizations on
+% the hipe x86-assembler code before it is encoded and loaded.
+%%>----------------------------------------------------------------------<
+postpass(#defun{code=Code0}=Defun, Options) ->
+ Code1 = pseudo_insn_expansion(Code0),
+ Code2 = case proplists:get_bool(peephole, Options) of
+ true -> peephole_optimization(Code1);
+ false -> Code1
+ end,
+ Code3 = trivial_goto_elimination(Code2),
+ Defun#defun{code=Code3}.
+
+
+%%>----------------------------------------------------------------------<
+% Procedure : peep/1
+% Purpose : Function that does peephole optimizations. It works by
+% moving a window over the code and looking at a sequence of
+% a few instructions. Replaces long sequences of instructions
+% with shorter ones and removes unnecesary ones.
+% Arguments : Insns - List of pseudo x86-assembler records.
+% Res - Returned list of pseudo x86-assembler records.
+% Kept reversed, until it is returned.
+% Return : An optimized list of pseudo x86-assembler records with
+% (hopefully) fewer or faster instructions.
+%%>----------------------------------------------------------------------<
+peephole_optimization(Insns) ->
+ peep(Insns, [], []).
+
+%% MoveSelf related peep-opts
+%% ------------------------------
+peep([#fmove{src=Src, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, Res, [moveSelf1|Lst]);
+peep([I=#fmove{src=Src, dst=Dst},
+ #fmove{src=Dst, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, [I|Res], [moveSelf2|Lst]);
+peep([#movsx{src=Src, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, Res, [moveSelf3|Lst]);
+peep([I=#movsx{src=Src, dst=Dst},
+ #movsx{src=Dst, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, [I|Res], [moveSelf4|Lst]);
+peep([#movzx{src=Src, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, Res, [moveSelf5|Lst]);
+peep([I=#movzx{src=Src, dst=Dst},
+ #movzx{src=Dst, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, [I|Res], [moveSelf6|Lst]);
+peep([#cmovcc{src=Src, dst=Src} | Insns], Res,Lst) ->
+ peep(Insns, Res, [moveSelf7|Lst]);
+peep([I=#cmovcc{src=Src, dst=Dst},
+ #cmovcc{src=Dst, dst=Src}|Insns], Res,Lst) ->
+ peep(Insns, [I|Res], [moveSelf8|Lst]);
+peep([#move{src=#x86_temp{reg=X},
+ dst=#x86_temp{reg=X}} | Insns], Res,Lst) ->
+ peep(Insns, Res, [moveSelf9|Lst]);
+peep([I=#move{src=#x86_temp{reg=Src}, dst=#x86_temp{reg=Dst}},
+ #move{src=#x86_temp{reg=Dst}, dst=#x86_temp{reg=Src}} | Insns], Res,Lst) ->
+ peep(Insns, [I|Res], [moveSelf0|Lst]);
+
+
+%% ElimBinALMDouble
+%% ----------------
+peep([Move=#move{src=Src, dst=Dst}, Alu=#alu{src=Src, dst=Dst}|Insns], Res, Lst) ->
+ peep([Alu#alu{src=Dst}|Insns], [Move|Res], [elimBinALMDouble|Lst]);
+
+
+%% ElimFBinDouble
+%% --------------
+peep([Move=#fmove{src=Src, dst=Dst},
+ BinOp=#fp_binop{src=Src, dst=Dst}|Insns], Res, Lst) ->
+ peep([BinOp#fp_binop{src=Dst}|Insns], [Move|Res], [elimFBinDouble|Lst]);
+
+
+%% CommuteBinALMD
+%% --------------
+peep([#move{src=Src1, dst=Dst},
+ #alu{aluop=Op,src=Src2,dst=Dst}|Insns], Res, Lst)
+ when (Src1 =:= #x86_imm{}) and (Src2 =/= #x86_imm{}) and
+ ((Op =:= 'add') or (Op =:= 'and') or (Op =:= 'or') or (Op =:= 'xor')) ->
+ peep(Insns, [#alu{aluop=Op,src=Src1,dst=Dst},
+ #move{src=Src2, dst=Dst}|Res],
+ [commuteBinALMD|Lst]);
+
+
+%% ElimCmp0
+%% --------
+peep([C=#cmp{src=Src, dst=Dst},J=#jcc{cc=Cond, label=Lab}|Insns],Res,Lst) ->
+ case (((Src =:= #x86_imm{value=0}) or (Dst =:= #x86_imm{value=0})) and
+ ((Cond =:= 'eq') or (Cond =:= 'neq'))) of
+ true ->
+ Src2 = case Src of #x86_imm{value=0} -> Src; _ -> Dst end,
+ Cond2 = case Cond of 'eq' -> 'z'; 'neq' -> 'nz' end,
+ Test = #test{src=Src2, dst=#x86_imm{value=0}},
+ Jump = #jcc{cc=Cond2, label=Lab},
+ peep(Insns, [Jump, Test|Res], [elimCmp0|Lst]);
+ _ ->
+ peep(Insns, [J,C|Res], Lst)
+ end;
+
+
+%% ElimCmpTest
+%% -----------
+peep([I|Insns],Res,Lst) when (I =:= #cmp{}) or (I =:= #test{}) ->
+ case check(Insns) of
+ #jcc{} ->
+ peep(Insns, [I|Res], Lst);
+ #jmp_fun{} ->
+ peep(Insns, [I|Res], Lst);
+ #jmp_label{} ->
+ peep(Insns, [I|Res], Lst);
+ #jmp_switch{} ->
+ peep(Insns, [I|Res], Lst);
+ #cmovcc{} ->
+ peep(Insns, [I|Res], Lst);
+ #ret{} ->
+ peep(Insns, [I|Res], Lst);
+ _ ->
+ peep(Insns, Res, [elimCmpTest|Lst])
+ end;
+
+
+%% ElimPushPop
+%% -----------
+peep([#push{src=Opr}, #pop{dst=Opr} | Insns], Res, Lst) ->
+ peep(Insns, Res, [elimPushPop|Lst]);
+
+
+% %% ElimIFF
+% %% -------
+peep([#jcc{label=Lab}, I=#label{label=Lab}|Insns], Res, Lst) ->
+ peep(Insns, [I, #jmp_label{label=Lab}|Res], [elimIFF|Lst]);
+
+
+%% ElimSet0
+%% --------
+peep([#move{src=#x86_imm{value=0},dst=Dst}|Insns],Res,Lst)
+when (Dst==#x86_temp{}) ->
+ peep(Insns, [#alu{aluop='xor', src=Dst, dst=Dst}|Res], [elimSet0|Lst]);
+
+%% ElimMDPow2
+%% ----------
+peep([B = #alu{aluop=Op,src=#x86_imm{value=Val},dst=Dst}|Insns], Res, Lst) ->
+ {IsLog2, Size, Sign} = log2(Val),
+ case ((Op =:= imul) or (Op =:= idiv)) and IsLog2 of
+ true ->
+ Sh = case Sign of positive -> 'bsl'; negative -> 'bsr' end,
+ peep(Insns,
+ [#shift{shiftop=Sh, src=#x86_imm{value=Size}, dst=Dst}|Res],
+ [elimMDPow2|Lst]);
+ false ->
+ peep(Insns, [B|Res], Lst)
+ end;
+
+%% SubToDec
+%% This rule turns "subl $1,Dst; jl Lab" into "decl Dst; jl Lab", which
+%% changes reduction counter tests to use decl instead of subl.
+%% However, on Athlon64 this leads to a small but measurable decrease
+%% in performance. The use of dec is also not recommended on P4, so
+%% this transformation is disabled.
+%% peep([#alu{aluop='sub',src=#x86_imm{value=1},dst=Dst},J=#jcc{cc='l'}|Insns], Res, Lst) ->
+%% peep(Insns, [J, #dec{dst=Dst} | Res], [subToDec|Lst]);
+
+%% Standard list recursion clause
+%% ------------------------------
+peep([I | Insns], Res, Lst) ->
+ peep(Insns, [I|Res], Lst);
+peep([], Res, _Lst) ->
+ lists:reverse(Res).
+
+%% Simple goto elimination
+%% -----------------------
+trivial_goto_elimination(Insns) -> goto_elim(Insns, []).
+
+goto_elim([#jmp_label{label=Label}, I = #label{label=Label}|Insns], Res) ->
+ goto_elim([I|Insns], Res);
+goto_elim([I | Insns], Res) ->
+ goto_elim(Insns, [I|Res]);
+goto_elim([], Res) ->
+ lists:reverse(Res).
+
+
+%%>----------------------------------------------------------------------<
+%% Procedure : expand/1
+%% Purpose : Expands pseudo instructions.
+%% Arguments : Insns - An x86-instruction list.
+%% Return : An expanded instruction list.
+%% Notes :
+%%>----------------------------------------------------------------------<
+pseudo_insn_expansion(Insns) -> expand(Insns, []).
+expand([I|Tail], Res) ->
+ case I of
+ #pseudo_jcc{cc=Cc,true_label=TrueLab,false_label=FalseLab} ->
+ expand(Tail, [hipe_x86:mk_jmp_label(FalseLab),
+ hipe_x86:mk_jcc(Cc, TrueLab) | Res]);
+ #pseudo_tailcall_prepare{} ->
+ expand(Tail, Res);
+ #pseudo_call{'fun'=Fun,sdesc=SDesc,contlab=ContLab,linkage=Linkage} ->
+ expand(Tail, [hipe_x86:mk_jmp_label(ContLab),
+ hipe_x86:mk_call(Fun, SDesc, Linkage) | Res]);
+ _ ->
+ expand(Tail, [I|Res])
+ end;
+expand([], Res) -> lists:reverse(Res).
+
+%% Log2 function
+%% -------------
+%% Used by ElimMDPow2 clause of peep(..)
+log2(Nr) -> log2(Nr, 0).
+log2(0, _) -> {false, 0, positive};
+log2(Nr, I) ->
+ case (Nr band 1) =:= 1 of
+ true ->
+ case Nr of
+ 1 ->
+ {true, I, positive};
+ -1 ->
+ {true, I, negative};
+ _ ->
+ {false, 0, positive}
+ end;
+ false ->
+ log2((Nr bsr 1), I+1)
+ end.
+
+%% Skips through all comments and move instructions and returns the next one
+%% -------------------------------------------------------------------------
+%% Used by ElimCmpTest above.
+check([I|Ins]) ->
+ case I of
+ #comment{} ->
+ check(Ins);
+ #move{} ->
+ check(Ins);
+ #fmove{} ->
+ check(Ins);
+ #movsx{} ->
+ check(Ins);
+ #movzx{} ->
+ check(Ins);
+ OtherI ->
+ OtherI
+ end.
diff --git a/lib/hipe/x86/hipe_x86_pp.erl b/lib/hipe/x86/hipe_x86_pp.erl
new file mode 100644
index 0000000000..555e21a446
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_pp.erl
@@ -0,0 +1,350 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% x86 pretty-printer
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_PP, hipe_amd64_pp).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-else.
+-define(HIPE_X86_PP, hipe_x86_pp).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-endif.
+
+-module(?HIPE_X86_PP).
+-export([% pp/1, pp/2,
+ pp_insn/1, optional_pp/3]).
+-include("../x86/hipe_x86.hrl").
+
+optional_pp(Defun, MFA, Options) ->
+ case proplists:get_value(pp_native, Options) of
+ true ->
+ pp(Defun);
+ {only,Lst} when is_list(Lst) ->
+ case lists:member(MFA, Lst) of
+ true -> pp(Defun);
+ false -> ok
+ end;
+ {only,MFA} ->
+ pp(Defun);
+ {file,FileName} ->
+ {ok, File} = file:open(FileName, [write,append]),
+ pp(File, Defun),
+ ok = file:close(File);
+ _ ->
+ ok
+ end.
+
+pp(Defun) ->
+ pp(standard_io, Defun).
+
+pp(Dev, #defun{mfa={M,F,A}, code=Code, data=Data}) ->
+ Fname = atom_to_list(M)++"_"++atom_to_list(F)++"_"++integer_to_list(A),
+ io:format(Dev, "\t.text\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ io:format(Dev, "\t.global ~s\n", [Fname]),
+ io:format(Dev, "~s:\n", [Fname]),
+ pp_insns(Dev, Code, Fname),
+ io:format(Dev, "\t.rodata\n", []),
+ io:format(Dev, "\t.align 4\n", []),
+ hipe_data_pp:pp(Dev, Data, x86, Fname),
+ io:format(Dev, "\n", []).
+
+pp_insns(Dev, [I|Is], Fname) ->
+ pp_insn(Dev, I, Fname),
+ pp_insns(Dev, Is, Fname);
+pp_insns(_, [], _) ->
+ ok.
+
+pp_insn(I) ->
+ pp_insn(standard_io, I, "").
+
+pp_insn(Dev, I, Pre) ->
+ case I of
+ #alu{aluop=AluOp, src=Src, dst=Dst} ->
+ io:format(Dev, "\t~s ", [alu_op_name(AluOp)]),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #call{'fun'=Fun, sdesc=SDesc, linkage=Linkage} ->
+ io:format(Dev, "\tcall ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " #", []),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #cmovcc{cc=Cc, src=Src, dst=Dst} ->
+ io:format(Dev, "\tcmov~s ", [cc_name(Cc)]),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #cmp{src=Src, dst=Dst} ->
+ io:format(Dev, "\tcmp ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #comment{term=Term} ->
+ io:format(Dev, "\t# ~p\n", [Term]);
+ #imul{imm_opt=ImmOpt, src=Src, temp=Temp} ->
+ io:format(Dev, "\timul ", []),
+ case ImmOpt of
+ [] -> ok;
+ Imm ->
+ pp_imm(Dev, Imm, true),
+ io:format(Dev, ", ", [])
+ end,
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Temp),
+ io:format(Dev, "\n", []);
+ #jcc{cc=Cc, label=Label} ->
+ io:format(Dev, "\tj~s .~s_~w\n", [cc_name(Cc), Pre, Label]);
+ #jmp_fun{'fun'=Fun, linkage=Linkage} ->
+ io:format(Dev, "\tjmp ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #jmp_label{label=Label} ->
+ io:format(Dev, "\tjmp .~s_~w\n", [Pre, Label]);
+ #jmp_switch{temp=Temp, jtab=JTab, labels=Labels} ->
+ io:format(Dev, "\tjmp *{constant,~w}(,", [JTab]),
+ pp_temp(Dev, Temp),
+ io:format(Dev, ",4) #", []),
+ pp_labels(Dev, Labels, Pre),
+ io:format(Dev, "\n", []);
+ #label{label=Label} ->
+ io:format(Dev, ".~s_~w:~n", [Pre, Label]);
+ #lea{mem=Mem, temp=Temp} ->
+ io:format(Dev, "\tlea ", []),
+ pp_mem(Dev, Mem),
+ io:format(Dev, ", ", []),
+ pp_temp(Dev, Temp),
+ io:format(Dev, "\n", []);
+ #move{src=Src, dst=Dst} ->
+ io:format(Dev, "\tmov ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #move64{} ->
+ pp_move64(Dev, I);
+ #movsx{src=Src, dst=Dst} ->
+ io:format(Dev, "\tmovsx ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #movzx{src=Src, dst=Dst} ->
+ io:format(Dev, "\tmovzx ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #pseudo_call{'fun'=Fun, sdesc=SDesc, contlab=ContLab, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_call ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, " # contlab .~s_~w", [Pre, ContLab]),
+ pp_sdesc(Dev, Pre, SDesc),
+ io:format(Dev, " ~w\n", [Linkage]);
+ #pseudo_jcc{cc=Cc, true_label=TrueLab, false_label=FalseLab, pred=Pred} ->
+ io:format(Dev, "\tpseudo_j~s ", [cc_name(Cc)]),
+ io:format(Dev, ".~s_~w # .~s_~w ~.2f\n",
+ [Pre, TrueLab, Pre, FalseLab, Pred]);
+ #pseudo_tailcall{'fun'=Fun, arity=Arity, stkargs=StkArgs, linkage=Linkage} ->
+ io:format(Dev, "\tpseudo_tailcall ", []),
+ pp_fun(Dev, Fun),
+ io:format(Dev, "~w (", [Arity]),
+ pp_args(Dev, StkArgs),
+ io:format(Dev, ") ~w\n", [Linkage]);
+ #pseudo_tailcall_prepare{} ->
+ io:format(Dev, "\tpseudo_tailcall_prepare\n", []);
+ #push{src=Src} ->
+ io:format(Dev, "\tpush ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, "\n", []);
+ #ret{npop=NPop} ->
+ io:format(Dev, "\tret $~s\n", [to_hex(NPop)]);
+ #shift{shiftop=ShiftOp, src=Src, dst=Dst} ->
+ io:format(Dev, "\t~s ", [alu_op_name(ShiftOp)]),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ #fp_binop{src=Src, dst=Dst, op=Op} ->
+ io:format(Dev, "\t~s ", [Op]),
+ pp_dst(Dev, Dst),
+ io:format(Dev, ", ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, "\n", []);
+ #fp_unop{arg=Arg, op=Op} ->
+ io:format(Dev, "\t~s ", [Op]),
+ case Arg of
+ []->
+ io:format(Dev, "\n", []);
+ _ ->
+ pp_args(Dev, [Arg]),
+ io:format(Dev, "\n", [])
+ end;
+ #fmove{src=Src, dst=Dst} ->
+ io:format(Dev, "\tfmove ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []);
+ _ ->
+ exit({?MODULE, pp_insn, {"unknown x86 instruction", I}})
+ end.
+
+-ifdef(HIPE_AMD64).
+pp_move64(Dev, I) ->
+ #move64{imm=Src, dst=Dst} = I,
+ io:format(Dev, "\tmov64 ", []),
+ pp_src(Dev, Src),
+ io:format(Dev, ", ", []),
+ pp_dst(Dev, Dst),
+ io:format(Dev, "\n", []).
+-else.
+pp_move64(_Dev, I) -> exit({?MODULE, I}).
+-endif.
+
+to_hex(N) ->
+ io_lib:format("~.16x", [N, "0x"]).
+
+pp_sdesc(Dev, Pre, #x86_sdesc{exnlab=ExnLab,fsize=FSize,arity=Arity,live=Live}) ->
+ pp_sdesc_exnlab(Dev, Pre, ExnLab),
+ io:format(Dev, " ~s ~w [", [to_hex(FSize), Arity]),
+ pp_sdesc_live(Dev, Live),
+ io:format(Dev, "]", []).
+
+pp_sdesc_exnlab(Dev, _, []) -> io:format(Dev, " []", []);
+pp_sdesc_exnlab(Dev, Pre, ExnLab) -> io:format(Dev, " .~s_~w", [Pre, ExnLab]).
+
+pp_sdesc_live(_, {}) -> ok;
+pp_sdesc_live(Dev, Live) -> pp_sdesc_live(Dev, Live, 1).
+
+pp_sdesc_live(Dev, Live, I) ->
+ io:format(Dev, "~s", [to_hex(element(I, Live))]),
+ if I < tuple_size(Live) ->
+ io:format(Dev, ",", []),
+ pp_sdesc_live(Dev, Live, I+1);
+ true -> ok
+ end.
+
+pp_labels(Dev, [Label|Labels], Pre) ->
+ io:format(Dev, " .~s_~w", [Pre, Label]),
+ pp_labels(Dev, Labels, Pre);
+pp_labels(_, [], _) ->
+ ok.
+
+pp_fun(Dev, Fun) ->
+ case Fun of
+ #x86_mfa{m=M, f=F, a=A} ->
+ io:format(Dev, "~w:~w/~w", [M, F, A]);
+ #x86_prim{prim=Prim} ->
+ io:format(Dev, "~w", [Prim]);
+ _ -> % temp or mem
+ io:format(Dev, "*", []),
+ pp_dst(Dev, Fun)
+ end.
+
+alu_op_name(Op) -> Op.
+
+cc_name(Cc) -> Cc.
+
+pp_hard_reg(Dev, Reg) ->
+ io:format(Dev, "~s", [?HIPE_X86_REGISTERS:reg_name(Reg)]).
+
+type_tag('tagged') -> "t";
+type_tag('untagged') -> "u";
+type_tag('double') -> "d".
+
+pp_temp(Dev, #x86_temp{reg=Reg, type=Type}) ->
+ case Type of
+ double ->
+ Tag = type_tag(Type),
+ io:format(Dev, "~s~w", [Tag, Reg]);
+ _ ->
+ case ?HIPE_X86_REGISTERS:is_precoloured(Reg) of
+ true ->
+ pp_hard_reg(Dev, Reg);
+ false ->
+ Tag = type_tag(Type),
+ io:format(Dev, "~s~w", [Tag, Reg])
+ end
+ end.
+
+pp_fpreg(Dev, #x86_fpreg{reg=Reg, pseudo=Pseudo})->
+ case Pseudo of
+ true -> io:format(Dev, "pseudo_fp(~w)", [Reg]);
+ _ -> io:format(Dev, "st(~w)", [Reg])
+ end.
+
+pp_imm(Dev, #x86_imm{value=Value}, Dollar) ->
+ if Dollar =:= true -> io:format(Dev, [$$], []);
+ true -> ok
+ end,
+ if is_integer(Value) -> io:format(Dev, "~s", [to_hex(Value)]);
+ true -> io:format(Dev, "~w", [Value])
+ end.
+
+pp_mem(Dev, #x86_mem{base=Base, off=Off}) ->
+ pp_off(Dev, Off),
+ case Base of
+ [] ->
+ ok;
+ _ ->
+ io:format(Dev, "(", []),
+ pp_temp(Dev, Base),
+ io:format(Dev, ")", [])
+ end.
+
+pp_off(Dev, Off) ->
+ pp_src(Dev, Off, false).
+
+pp_src(Dev, Src) ->
+ pp_src(Dev, Src, true).
+
+pp_src(Dev, Src, Dollar) ->
+ case Src of
+ #x86_temp{} ->
+ pp_temp(Dev, Src);
+ #x86_imm{} ->
+ pp_imm(Dev, Src, Dollar);
+ #x86_mem{} ->
+ pp_mem(Dev, Src);
+ #x86_fpreg{} ->
+ pp_fpreg(Dev, Src)
+ end.
+
+pp_dst(Dev, Dst) ->
+ pp_src(Dev, Dst).
+
+pp_args(Dev, [A|As]) ->
+ pp_src(Dev, A),
+ pp_comma_args(Dev, As);
+pp_args(_, []) ->
+ ok.
+
+pp_comma_args(Dev, [A|As]) ->
+ io:format(Dev, ", ", []),
+ pp_src(Dev, A),
+ pp_comma_args(Dev, As);
+pp_comma_args(_, []) ->
+ ok.
diff --git a/lib/hipe/x86/hipe_x86_ra.erl b/lib/hipe/x86/hipe_x86_ra.erl
new file mode 100644
index 0000000000..d50b9aabad
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_ra.erl
@@ -0,0 +1,99 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_RA, hipe_amd64_ra).
+-define(HIPE_X86_PP, hipe_amd64_pp).
+-define(HIPE_X86_RA_LS, hipe_amd64_ra_ls).
+-define(HIPE_X86_RA_NAIVE, hipe_amd64_ra_naive).
+-define(HIPE_X86_RA_FINALISE, hipe_amd64_ra_finalise).
+-define(HIPE_X86_SPECIFIC, hipe_amd64_specific).
+-else.
+-define(HIPE_X86_RA, hipe_x86_ra).
+-define(HIPE_X86_PP, hipe_x86_pp).
+-define(HIPE_X86_RA_LS, hipe_x86_ra_ls).
+-define(HIPE_X86_RA_NAIVE, hipe_x86_ra_naive).
+-define(HIPE_X86_RA_FINALISE, hipe_x86_ra_finalise).
+-define(HIPE_X86_SPECIFIC, hipe_x86_specific).
+-endif.
+
+-module(?HIPE_X86_RA).
+-export([ra/2]).
+
+%%-define(HIPE_INSTRUMENT_COMPILER, true). %% Turn on instrumentation.
+-include("../main/hipe.hrl").
+
+ra(Defun0, Options) ->
+ %% ?HIPE_X86_PP:pp(Defun0),
+ {Defun1, Coloring_fp, SpillIndex} = ra_fp(Defun0, Options),
+ %% ?HIPE_X86_PP:pp(Defun1),
+ ?start_ra_instrumentation(Options,
+ length(hipe_x86:defun_code(Defun1)),
+ element(2,hipe_x86:defun_var_range(Defun1))),
+ {Defun2, Coloring}
+ = case proplists:get_value(regalloc, Options, coalescing) of
+ coalescing ->
+ ra(Defun1, SpillIndex, Options, hipe_coalescing_regalloc);
+ optimistic ->
+ ra(Defun1, SpillIndex, Options, hipe_optimistic_regalloc);
+ graph_color ->
+ ra(Defun1, SpillIndex, Options, hipe_graph_coloring_regalloc);
+ linear_scan ->
+ ?HIPE_X86_RA_LS:ra(Defun1, SpillIndex, Options);
+ naive ->
+ ?HIPE_X86_RA_NAIVE:ra(Defun1, Coloring_fp, Options);
+ _ ->
+ exit({unknown_regalloc_compiler_option,
+ proplists:get_value(regalloc,Options)})
+ end,
+ ?stop_ra_instrumentation(Options,
+ length(hipe_x86:defun_code(Defun2)),
+ element(2,hipe_x86:defun_var_range(Defun2))),
+ %% ?HIPE_X86_PP:pp(Defun2),
+ ?HIPE_X86_RA_FINALISE:finalise(Defun2, Coloring, Coloring_fp, Options).
+
+ra(Defun, SpillIndex, Options, RegAllocMod) ->
+ hipe_regalloc_loop:ra(Defun, SpillIndex, Options, RegAllocMod, ?HIPE_X86_SPECIFIC).
+
+-ifdef(HIPE_AMD64).
+ra_fp(Defun, Options) ->
+ case proplists:get_bool(inline_fp, Options) and
+ (proplists:get_value(regalloc, Options) =/= naive) of
+ true ->
+ case proplists:get_bool(x87, Options) of
+ true ->
+ hipe_amd64_ra_x87_ls:ra(Defun, Options);
+ false ->
+ hipe_regalloc_loop:ra_fp(Defun, Options,
+ hipe_coalescing_regalloc,
+ hipe_amd64_specific_sse2)
+ end;
+ false ->
+ {Defun,[],0}
+ end.
+-else.
+ra_fp(Defun, Options) ->
+ case proplists:get_bool(inline_fp, Options) of
+ true ->
+ hipe_x86_ra_x87_ls:ra(Defun, Options);
+ false ->
+ {Defun,[],0}
+ end.
+-endif.
diff --git a/lib/hipe/x86/hipe_x86_ra_finalise.erl b/lib/hipe/x86/hipe_x86_ra_finalise.erl
new file mode 100644
index 0000000000..10b4df05d2
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_ra_finalise.erl
@@ -0,0 +1,335 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%
+%%% - apply temp -> reg/spill map from RA
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_RA_FINALISE, hipe_amd64_ra_finalise).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_X87, hipe_amd64_x87).
+-else.
+-define(HIPE_X86_RA_FINALISE, hipe_x86_ra_finalise).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_X87, hipe_x86_x87).
+-endif.
+
+-module(?HIPE_X86_RA_FINALISE).
+-export([finalise/4]).
+-include("../x86/hipe_x86.hrl").
+
+finalise(Defun, TempMap, FpMap, Options) ->
+ Defun1 = finalise_ra(Defun, TempMap, FpMap, Options),
+ case proplists:get_bool(x87, Options) of
+ true ->
+ ?HIPE_X86_X87:map(Defun1);
+ _ ->
+ Defun1
+ end.
+
+%%%
+%%% Finalise the temp->reg/spill mapping.
+%%% (XXX: maybe this should be merged with the main pass,
+%%% but I just want this to work now)
+%%%
+
+finalise_ra(Defun, [], [], _Options) ->
+ Defun;
+finalise_ra(Defun, TempMap, FpMap, Options) ->
+ Code = hipe_x86:defun_code(Defun),
+ {_, SpillLimit} = hipe_x86:defun_var_range(Defun),
+ Map = mk_ra_map(TempMap, SpillLimit),
+ FpMap0 = mk_ra_map_fp(FpMap, SpillLimit, Options),
+ NewCode = ra_code(Code, Map, FpMap0),
+ Defun#defun{code=NewCode}.
+
+ra_code(Code, Map, FpMap) ->
+ [ra_insn(I, Map, FpMap) || I <- Code].
+
+ra_insn(I, Map, FpMap) ->
+ case I of
+ #alu{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#alu{src=Src,dst=Dst};
+ #call{} ->
+ I;
+ #cmovcc{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#cmovcc{src=Src,dst=Dst};
+ #cmp{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#cmp{src=Src,dst=Dst};
+ #comment{} ->
+ I;
+ #fmove{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map, FpMap),
+ Dst = ra_opnd(Dst0, Map, FpMap),
+ I#fmove{src=Src,dst=Dst};
+ #fp_unop{arg=Arg0} ->
+ Arg = ra_opnd(Arg0, Map, FpMap),
+ I#fp_unop{arg=Arg};
+ #fp_binop{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map, FpMap),
+ Dst = ra_opnd(Dst0, Map, FpMap),
+ I#fp_binop{src=Src,dst=Dst};
+ #imul{src=Src0,temp=Temp0} ->
+ Src = ra_opnd(Src0, Map),
+ Temp = ra_temp(Temp0, Map),
+ I#imul{src=Src,temp=Temp};
+ #jcc{} ->
+ I;
+ #jmp_fun{'fun'=Fun0} ->
+ Fun = ra_opnd(Fun0, Map),
+ I#jmp_fun{'fun'=Fun};
+ #jmp_label{} ->
+ I;
+ #jmp_switch{temp=Temp0,jtab=JTab0} ->
+ Temp = ra_opnd(Temp0, Map),
+ JTab = ra_opnd(JTab0, Map),
+ I#jmp_switch{temp=Temp,jtab=JTab};
+ #label{} ->
+ I;
+ #lea{mem=Mem0,temp=Temp0} ->
+ Mem = ra_mem(Mem0, Map),
+ Temp = ra_temp(Temp0, Map),
+ I#lea{mem=Mem,temp=Temp};
+ #move{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#move{src=Src,dst=Dst};
+ #move64{dst=Dst0} ->
+ Dst = ra_opnd(Dst0, Map),
+ I#move64{dst=Dst};
+ #movsx{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#movsx{src=Src,dst=Dst};
+ #movzx{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#movzx{src=Src,dst=Dst};
+ #pseudo_call{'fun'=Fun0} ->
+ Fun = ra_opnd(Fun0, Map),
+ I#pseudo_call{'fun'=Fun};
+ #pseudo_jcc{} ->
+ I;
+ #pseudo_tailcall{'fun'=Fun0,stkargs=StkArgs0} ->
+ Fun = ra_opnd(Fun0, Map),
+ StkArgs = ra_args(StkArgs0, Map),
+ I#pseudo_tailcall{'fun'=Fun,stkargs=StkArgs};
+ #pseudo_tailcall_prepare{} ->
+ I;
+ #push{src=Src0} ->
+ Src = ra_opnd(Src0, Map),
+ I#push{src=Src};
+ #ret{} ->
+ I;
+ #shift{src=Src0,dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#shift{src=Src,dst=Dst};
+ _ ->
+ exit({?MODULE,ra_insn,I})
+ end.
+
+ra_args(Args, Map) ->
+ [ra_opnd(Opnd, Map) || Opnd <- Args].
+
+ra_opnd(Opnd, Map) ->
+ ra_opnd(Opnd, Map, gb_trees:empty()).
+ra_opnd(Opnd, Map, FpMap) ->
+ case Opnd of
+ #x86_temp{} -> ra_temp(Opnd, Map, FpMap);
+ #x86_mem{} -> ra_mem(Opnd, Map);
+ _ -> Opnd
+ end.
+
+ra_mem(Mem, Map) ->
+ #x86_mem{base=Base0,off=Off0} = Mem,
+ Base = ra_opnd(Base0, Map),
+ Off = ra_opnd(Off0, Map),
+ Mem#x86_mem{base=Base,off=Off}.
+
+ra_temp(Temp, Map) ->
+ ra_temp(Temp, Map, gb_trees:empty()).
+
+ra_temp(Temp, Map, FpMap) ->
+ Reg = hipe_x86:temp_reg(Temp),
+ case hipe_x86:temp_type(Temp) of
+ double ->
+ ra_temp_double(Temp, Reg, FpMap);
+ _->
+ case ?HIPE_X86_REGISTERS:is_precoloured(Reg) of
+ true ->
+ Temp;
+ _ ->
+ case gb_trees:lookup(Reg, Map) of
+ {value,NewReg} -> Temp#x86_temp{reg=NewReg};
+ _ -> Temp
+ end
+ end
+ end.
+
+-ifdef(HIPE_AMD64).
+ra_temp_double(Temp, Reg, FpMap) ->
+ case hipe_amd64_registers:is_precoloured_sse2(Reg) of
+ true ->
+ Temp;
+ _ ->
+ case gb_trees:lookup(Reg, FpMap) of
+ {value,NewReg} -> Temp#x86_temp{reg=NewReg};
+ _ -> Temp
+ end
+ end.
+-else.
+ra_temp_double(Temp, Reg, FpMap) ->
+ case gb_trees:lookup(Reg, FpMap) of
+ {value,NewReg} ->
+ case hipe_x86_registers:is_precoloured_x87(NewReg) of
+ true -> hipe_x86:mk_fpreg(NewReg);
+ false ->
+ Temp#x86_temp{reg=NewReg}
+ end;
+ _ ->
+ Temp
+ end.
+-endif.
+
+mk_ra_map(TempMap, SpillLimit) ->
+ %% Build a partial map from pseudo to reg or spill.
+ %% Spills are represented as pseudos with indices above SpillLimit.
+ %% (I'd prefer to use negative indices, but that breaks
+ %% ?HIPE_X86_REGISTERS:is_precoloured/1.)
+ %% The frame mapping proper is unchanged, since spills look just like
+ %% ordinary (un-allocated) pseudos.
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit,
+ is_precoloured),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ TempMap).
+
+conv_ra_maplet(MapLet = {From,To}, SpillLimit, IsPrecoloured) ->
+ %% From should be a pseudo, or a hard reg mapped to itself.
+ if is_integer(From), From =< SpillLimit ->
+ case ?HIPE_X86_REGISTERS:IsPrecoloured(From) of
+ false -> [];
+ _ ->
+ case To of
+ {reg, From} -> [];
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of From check
+ case To of
+ {reg, NewReg} ->
+ %% NewReg should be a hard reg, or a pseudo mapped
+ %% to itself (formals are handled this way).
+ if is_integer(NewReg) ->
+ case ?HIPE_X86_REGISTERS:IsPrecoloured(NewReg) of
+ true -> [];
+ _ -> if From =:= NewReg -> [];
+ true ->
+ exit({?MODULE,conv_ra_maplet,MapLet})
+ end
+ end;
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of NewReg check
+ {From, NewReg};
+ {spill, SpillIndex} ->
+ %% SpillIndex should be >= 0.
+ if is_integer(SpillIndex), SpillIndex >= 0 -> [];
+ true -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end,
+ %% end of SpillIndex check
+ ToTempNum = SpillLimit+SpillIndex+1,
+ MaxTempNum = hipe_gensym:get_var(x86),
+ if MaxTempNum >= ToTempNum -> ok;
+ true -> hipe_gensym:set_var(x86, ToTempNum)
+ end,
+ {From, ToTempNum};
+ _ -> exit({?MODULE,conv_ra_maplet,MapLet})
+ end.
+
+mk_ra_map_x87(FpMap, SpillLimit) ->
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit,
+ is_precoloured_x87),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ FpMap).
+
+-ifdef(HIPE_AMD64).
+mk_ra_map_sse2(FpMap, SpillLimit) ->
+ lists:foldl(fun(MapLet, Map) ->
+ {Key,Val} = conv_ra_maplet(MapLet, SpillLimit,
+ is_precoloured_sse2),
+ gb_trees:insert(Key, Val, Map)
+ end,
+ gb_trees:empty(),
+ FpMap).
+
+mk_ra_map_fp(FpMap, SpillLimit, Options) ->
+ case proplists:get_bool(x87, Options) of
+ true -> mk_ra_map_x87(FpMap, SpillLimit);
+ false -> mk_ra_map_sse2(FpMap, SpillLimit)
+ end.
+-else.
+mk_ra_map_fp(FpMap, SpillLimit, _Options) ->
+ mk_ra_map_x87(FpMap, SpillLimit).
+-endif.
+
+-ifdef(notdef).
+conv_ra_maplet_fp(MapLet = {From,To}, SpillLimit) ->
+ %% From should be a pseudo
+ if is_integer(From), From =< SpillLimit -> [];
+ true -> exit({?MODULE,conv_ra_maplet_fp,MapLet})
+ end,
+ %% end of From check
+ case To of
+ {reg, NewReg} ->
+ case hipe_x86_registers:is_precoloured_x87(NewReg) of
+ true-> [];
+ false -> exit({?MODULE,conv_ra_maplet_fp,MapLet})
+ end,
+ %% end of NewReg check.
+ {From, NewReg};
+ {spill, SpillIndex} ->
+ %% SpillIndex should be >= 0.
+ if is_integer(SpillIndex), SpillIndex >= 0 -> [];
+ true -> exit({?MODULE,conv_ra_maplet_fp,MapLet})
+ end,
+ %% end of SpillIndex check
+ ToTempNum = SpillLimit+SpillIndex+1,
+ MaxTempNum = hipe_gensym:get_var(x86),
+ if MaxTempNum >= ToTempNum -> [];
+ true -> hipe_gensym:set_var(x86, ToTempNum)
+ end,
+ {From, ToTempNum};
+ _ -> exit({?MODULE,conv_ra_maplet_fp,MapLet})
+ end.
+-endif.
diff --git a/lib/hipe/x86/hipe_x86_ra_ls.erl b/lib/hipe/x86/hipe_x86_ra_ls.erl
new file mode 100644
index 0000000000..ab7b6708ad
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_ra_ls.erl
@@ -0,0 +1,85 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% Linear Scan register allocator for x86
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_RA_LS, hipe_amd64_ra_ls).
+-define(HIPE_X86_PP, hipe_amd64_pp).
+-define(HIPE_X86_RA_POSTCONDITIONS, hipe_amd64_ra_postconditions).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_SPECIFIC, hipe_amd64_specific).
+-else.
+-define(HIPE_X86_RA_LS, hipe_x86_ra_ls).
+-define(HIPE_X86_PP, hipe_x86_pp).
+-define(HIPE_X86_RA_POSTCONDITIONS, hipe_x86_ra_postconditions).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_SPECIFIC, hipe_x86_specific).
+-endif.
+
+-module(?HIPE_X86_RA_LS).
+-export([ra/3,regalloc/7]).
+-define(HIPE_INSTRUMENT_COMPILER, true). %% Turn on instrumentation.
+-include("../main/hipe.hrl").
+
+ra(Defun, SpillIndex, Options) ->
+ NewDefun = Defun, %% hipe_${ARCH}_ra_rename:rename(Defun,Options),
+ CFG = hipe_x86_cfg:init(NewDefun),
+
+ SpillLimit = ?HIPE_X86_SPECIFIC:number_of_temporaries(
+ CFG),
+ ?inc_counter(bbs_counter, length(hipe_x86_cfg:labels(CFG))),
+ alloc(NewDefun, SpillIndex, SpillLimit, Options).
+
+
+alloc(Defun, SpillIndex, SpillLimit, Options) ->
+ ?inc_counter(ra_iteration_counter,1),
+ %% ?HIPE_X86_PP:pp(Defun),
+ CFG = hipe_x86_cfg:init(Defun),
+ {Coloring, NewSpillIndex} =
+ regalloc(
+ CFG,
+ ?HIPE_X86_REGISTERS:allocatable()--
+ [?HIPE_X86_REGISTERS:temp1(),
+ ?HIPE_X86_REGISTERS:temp0()],
+ [hipe_x86_cfg:start_label(CFG)],
+ SpillIndex, SpillLimit, Options,
+ ?HIPE_X86_SPECIFIC),
+ {NewDefun, _DidSpill} =
+ ?HIPE_X86_RA_POSTCONDITIONS:check_and_rewrite(
+ Defun, Coloring, 'linearscan'),
+ %% ?HIPE_X86_PP:pp(NewDefun),
+ TempMap = hipe_temp_map:cols2tuple(Coloring, ?HIPE_X86_SPECIFIC),
+ {TempMap2,NewSpillIndex2} =
+ hipe_spillmin:stackalloc(CFG, [], SpillIndex, Options,
+ ?HIPE_X86_SPECIFIC, TempMap),
+ Coloring2 =
+ hipe_spillmin:mapmerge(hipe_temp_map:to_substlist(TempMap), TempMap2),
+ case proplists:get_bool(verbose_spills, Options) of
+ true ->
+ ?msg("Stack slot size: ~p~n",[NewSpillIndex2-SpillIndex]);
+ false ->
+ ok
+ end,
+ ?add_spills(Options, NewSpillIndex),
+ {NewDefun, Coloring2}.
+
+regalloc(CFG,PhysRegs,Entrypoints, SpillIndex, DontSpill, Options, Target) ->
+ hipe_ls_regalloc:regalloc(CFG,PhysRegs,Entrypoints, SpillIndex,
+ DontSpill, Options, Target).
diff --git a/lib/hipe/x86/hipe_x86_ra_naive.erl b/lib/hipe/x86/hipe_x86_ra_naive.erl
new file mode 100644
index 0000000000..e9b99cd2c5
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_ra_naive.erl
@@ -0,0 +1,409 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%% simple local x86 regalloc
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_RA_NAIVE, hipe_amd64_ra_naive).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_SPECIFIC_FP, hipe_amd64_specific_sse2).
+-define(ECX, rcx).
+-else.
+-define(HIPE_X86_RA_NAIVE, hipe_x86_ra_naive).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_SPECIFIC_FP, hipe_x86_specific_x87).
+-define(ECX, ecx).
+-endif.
+
+-module(?HIPE_X86_RA_NAIVE).
+-export([ra/3]).
+
+-include("../x86/hipe_x86.hrl").
+-define(HIPE_INSTRUMENT_COMPILER, true). % enable instrumentation
+-include("../main/hipe.hrl").
+
+ra(X86Defun, Coloring_fp, Options) ->
+ #defun{code=Code0} = X86Defun,
+ Code1 = do_insns(Code0),
+ NofSpilledFloats = count_non_float_spills(Coloring_fp),
+ NofFloats = length(Coloring_fp),
+ ?add_spills(Options, hipe_gensym:get_var(x86) -
+ ?HIPE_X86_REGISTERS:first_virtual()-
+ NofSpilledFloats -
+ NofFloats),
+ TempMap = [],
+ {X86Defun#defun{code=Code1,
+ var_range={0, hipe_gensym:get_var(x86)}},
+ TempMap}.
+
+count_non_float_spills(Coloring_fp) ->
+ count_non_float_spills(Coloring_fp, 0).
+
+count_non_float_spills([{_,To}|Tail], Num) ->
+ case ?HIPE_X86_SPECIFIC_FP:is_precoloured(To) of
+ true ->
+ count_non_float_spills(Tail, Num);
+ false ->
+ count_non_float_spills(Tail, Num+1)
+ end;
+count_non_float_spills([], Num) ->
+ Num.
+
+do_insns([I|Insns]) ->
+ do_insn(I) ++ do_insns(Insns);
+do_insns([]) ->
+ [].
+
+do_insn(I) -> % Insn -> Insn list
+ case I of
+ #alu{} ->
+ do_alu(I);
+ #cmp{} ->
+ do_cmp(I);
+ #imul{} ->
+ do_imul(I);
+ #jmp_switch{} ->
+ do_jmp_switch(I);
+ #lea{} ->
+ do_lea(I);
+ #move{} ->
+ do_move(I);
+ #move64{} ->
+ do_move64(I);
+ #movzx{} ->
+ do_movx(I);
+ #movsx{} ->
+ do_movx(I);
+ #fmove{} ->
+ do_fmove(I);
+ #fp_unop{} ->
+ do_fp_unop(I);
+ #fp_binop{} ->
+ do_fp_binop(I);
+ #shift{} ->
+ do_shift(I);
+ #label{} ->
+ [I];
+ #pseudo_jcc{} ->
+ [I];
+ #pseudo_call{} ->
+ [I];
+ #ret{} ->
+ [I];
+ #pseudo_tailcall_prepare{} ->
+ [I];
+ #pseudo_tailcall{} ->
+ [I];
+ #push{} ->
+ [I];
+ #jmp_label{} ->
+ [I];
+ #comment{} ->
+ [I];
+ _ ->
+ io:format("Unknown Instruction = ~w\n", [I]),
+ exit({?MODULE, unknown_instruction, I})
+ end.
+
+%%% Fix an alu op.
+
+do_alu(I) ->
+ #alu{src=Src0,dst=Dst0} = I,
+ {FixSrc,Src,FixDst,Dst} = do_binary(Src0, Dst0),
+ FixSrc ++ FixDst ++ [I#alu{src=Src,dst=Dst}].
+
+%%% Fix a cmp op.
+
+do_cmp(I) ->
+ #cmp{src=Src0,dst=Dst0} = I,
+ {FixSrc, Src, FixDst, Dst} = do_binary(Src0, Dst0),
+ FixSrc ++ FixDst ++ [I#cmp{src=Src,dst=Dst}].
+
+%%% Fix an imul op.
+
+do_imul(I) ->
+ #imul{imm_opt=ImmOpt,src=Src0,temp=Temp0} = I,
+ {FixSrc,Src} = fix_src_operand(Src0), % may use temp0
+ {FixTempSrc,Temp,FixTempDst} =
+ case temp_is_pseudo(Temp0) of
+ false ->
+ {[], Temp0, []};
+ true ->
+ Reg = hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp1(), 'untagged'),
+ {case ImmOpt of
+ [] -> [hipe_x86:mk_move(Temp0, Reg)]; % temp *= src
+ _ -> [] % temp = src * imm
+ end,
+ Reg,
+ [hipe_x86:mk_move(Reg, Temp0)]}
+ end,
+ FixSrc ++ FixTempSrc ++ [I#imul{src=Src,temp=Temp}] ++ FixTempDst.
+
+%%% Fix a jmp_switch op.
+
+-ifdef(HIPE_AMD64).
+do_jmp_switch(I) ->
+ #jmp_switch{temp=Temp, jtab=Tab} = I,
+ case temp_is_pseudo(Temp) of
+ false ->
+ case temp_is_pseudo(Tab) of
+ false ->
+ [I];
+ true ->
+ Reg = hipe_x86:mk_temp(hipe_amd64_registers:temp0(), 'untagged'),
+ [hipe_x86:mk_move(Temp, Reg), I#jmp_switch{jtab=Reg}]
+ end;
+ true ->
+ Reg = hipe_x86:mk_temp(hipe_amd64_registers:temp1(), 'untagged'),
+ case temp_is_pseudo(Tab) of
+ false ->
+ [hipe_x86:mk_move(Temp, Reg), I#jmp_switch{temp=Reg}];
+ true ->
+ Reg2 = hipe_x86:mk_temp(hipe_amd64_registers:temp0(), 'untagged'),
+ [hipe_x86:mk_move(Temp, Reg),
+ hipe_x86:mk_move(Tab, Reg2),
+ I#jmp_switch{temp=Reg, jtab=Reg2}]
+ end
+ end.
+-else.
+do_jmp_switch(I) ->
+ #jmp_switch{temp=Temp} = I,
+ case temp_is_pseudo(Temp) of
+ false ->
+ [I];
+ true ->
+ Reg = hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp0(), 'untagged'),
+ [hipe_x86:mk_move(Temp, Reg), I#jmp_switch{temp=Reg}]
+ end.
+-endif.
+
+%%% Fix a lea op.
+
+do_lea(I) ->
+ #lea{temp=Temp} = I,
+ case temp_is_pseudo(Temp) of
+ false ->
+ [I];
+ true ->
+ Reg = hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp0(), 'untagged'),
+ [I#lea{temp=Reg}, hipe_x86:mk_move(Reg, Temp)]
+ end.
+
+%%% Fix a move op.
+
+do_move(I) ->
+ #move{src=Src0,dst=Dst0} = I,
+ {FixSrc, Src, FixDst, Dst} = do_binary(Src0, Dst0),
+ FixSrc ++ FixDst ++ [I#move{src=Src,dst=Dst}].
+
+-ifdef(HIPE_AMD64).
+do_move64(I) ->
+ #move64{dst=Dst} = I,
+ case is_mem_opnd(Dst) of
+ false ->
+ [I];
+ true ->
+ Reg = hipe_amd64_registers:temp1(),
+ NewDst = clone(Dst, Reg),
+ [I#move64{dst=NewDst}, hipe_x86:mk_move(NewDst, Dst)]
+ end.
+-else.
+do_move64(I) -> exit({?MODULE, I}).
+-endif.
+
+do_movx(I) ->
+ {{FixSrc, Src}, {FixDst, Dst}} =
+ case I of
+ #movsx{src=Src0,dst=Dst0} ->
+ {fix_src_operand(Src0), fix_dst_operand(Dst0)};
+ #movzx{src=Src0,dst=Dst0} ->
+ {fix_src_operand(Src0), fix_dst_operand(Dst0)}
+ end,
+ Reg = ?HIPE_X86_REGISTERS:temp0(),
+ Dst2 = clone(Dst, Reg),
+ I2 = case is_mem_opnd(Dst) of
+ true ->
+ Reg = ?HIPE_X86_REGISTERS:temp0(),
+ Dst2 = clone(Dst, Reg),
+ case I of
+ #movsx{} ->
+ [hipe_x86:mk_movsx(Src, Dst2), hipe_x86:mk_move(Dst2, Dst)];
+ #movzx{} ->
+ [hipe_x86:mk_movzx(Src, Dst2), hipe_x86:mk_move(Dst2, Dst)]
+ end;
+ false ->
+ case I of
+ #movsx{} ->
+ [hipe_x86:mk_movsx(Src, Dst)];
+ #movzx{} ->
+ [hipe_x86:mk_movzx(Src, Dst)]
+ end
+ end,
+ FixSrc ++ FixDst ++ I2.
+
+
+%%% Fix a fmove op.
+%% conv_to_float
+do_fmove(I=#fmove{src=#x86_temp{type=untagged},
+ dst=#x86_temp{type=double}}) ->
+ #fmove{src=Src0,dst=Dst0} = I,
+ Src = clone(Src0, ?HIPE_X86_REGISTERS:temp0()),
+ Dst = clone(Dst0, ?HIPE_X86_REGISTERS:temp1()),
+ [hipe_x86:mk_move(Src0, Src),
+ I#fmove{src=Src, dst=Dst},
+ hipe_x86:mk_fmove(Dst, Dst0)];
+%% fmove
+do_fmove(I) ->
+ #fmove{src=Src0,dst=Dst0} = I,
+ {FixSrc, Src, FixDst, Dst} = do_binary(Src0, Dst0),
+ FixSrc ++ FixDst ++ [I#fmove{src=Src,dst=Dst}].
+
+do_fp_unop(I) ->
+ #fp_unop{arg=Arg} = I,
+ case is_mem_opnd(Arg) of
+ false ->
+ [I];
+ true ->
+ Reg = ?HIPE_X86_REGISTERS:temp1(),
+ NewArg = clone(Arg, Reg),
+ [hipe_x86:mk_fmove(Arg, NewArg),
+ I#fp_unop{arg=NewArg},
+ hipe_x86:mk_fmove(NewArg, Arg)]
+ end.
+
+do_fp_binop(I) ->
+ #fp_binop{src=Src0, dst=Dst0} = I,
+ {FixSrc, Src} = fix_src_operand(Src0),
+ {FixDst, Dst} = fix_dst_operand(Dst0),
+ Reg = ?HIPE_X86_REGISTERS:temp1(),
+ Dst2 = clone(Dst, Reg),
+ FixSrc ++ FixDst ++ [hipe_x86:mk_fmove(Dst, Dst2),
+ I#fp_binop{src=Src, dst=Dst2},
+ hipe_x86:mk_fmove(Dst2, Dst)].
+
+do_shift(I) ->
+ #shift{src=Src0,dst=Dst0} = I,
+ {FixDst, Dst} = fix_dst_operand(Dst0),
+ Reg = ?HIPE_X86_REGISTERS:?ECX(),
+ case Src0 of
+ #x86_imm{} ->
+ FixDst ++ [I#shift{dst=Dst}];
+ #x86_temp{reg=Reg} ->
+ FixDst ++ [I#shift{dst=Dst}]
+ end.
+
+%%% Fix the operands of a binary op.
+%%% 1. remove pseudos from any explicit memory operands
+%%% 2. if both operands are (implicit or explicit) memory operands,
+%%% move src to a reg and use reg as src in the original insn
+
+do_binary(Src0, Dst0) ->
+ {FixSrc, Src} = fix_src_operand(Src0),
+ {FixDst, Dst} = fix_dst_operand(Dst0),
+ {FixSrc3, Src3} =
+ case is_mem_opnd(Src) of
+ false ->
+ {FixSrc, Src};
+ true ->
+ case is_mem_opnd(Dst) of
+ false ->
+ {FixSrc, Src};
+ true ->
+ Reg = ?HIPE_X86_REGISTERS:temp0(),
+ Src2 = clone(Src, Reg),
+ FixSrc2 = FixSrc ++ [mk_move(Src, Src2)],
+ {FixSrc2, Src2}
+ end
+ end,
+ {FixSrc3, Src3, FixDst, Dst}.
+
+%%% Fix any x86_mem operand to not refer to any pseudos.
+%%% The fixup may use additional instructions and registers.
+%%% 'src' operands may clobber '%temp0'.
+%%% 'dst' operands may clobber '%temp1'.
+
+fix_src_operand(Opnd) ->
+ fix_mem_operand(Opnd, ?HIPE_X86_REGISTERS:temp0()).
+
+fix_dst_operand(Opnd) ->
+ fix_mem_operand(Opnd, ?HIPE_X86_REGISTERS:temp1()).
+
+fix_mem_operand(Opnd, Reg) -> % -> {[fixupcode], newop}
+ case Opnd of
+ #x86_mem{base=Base,off=Off} ->
+ case is_mem_opnd(Base) of
+ false ->
+ case src_is_pseudo(Off) of
+ false ->
+ {[], Opnd};
+ true -> % pseudo(reg)
+ Temp = clone(Off, Reg),
+ {[hipe_x86:mk_move(Off, Temp)],
+ Opnd#x86_mem{off=Temp}}
+ end;
+ true ->
+ Temp = clone(Base, Reg),
+ case src_is_pseudo(Off) of
+ false -> % imm/reg(pseudo)
+ {[hipe_x86:mk_move(Base, Temp)],
+ Opnd#x86_mem{base=Temp}};
+ true -> % pseudo1(pseudo0)
+ {[hipe_x86:mk_move(Base, Temp),
+ hipe_x86:mk_alu('add', Off, Temp)],
+ Opnd#x86_mem{base=Temp, off=hipe_x86:mk_imm(0)}}
+ end
+ end;
+ _ ->
+ {[], Opnd}
+ end.
+
+%%% Check if an operand denotes a memory cell (mem or pseudo).
+
+is_mem_opnd(Opnd) ->
+ case Opnd of
+ #x86_mem{} -> true;
+ #x86_temp{} -> temp_is_pseudo(Opnd);
+ _ -> false
+ end.
+
+%%% Check if an operand is a pseudo-Temp.
+
+src_is_pseudo(Src) ->
+ case hipe_x86:is_temp(Src) of
+ true -> temp_is_pseudo(Src);
+ false -> false
+ end.
+
+temp_is_pseudo(Temp) ->
+ not(?HIPE_X86_REGISTERS:is_precoloured(hipe_x86:temp_reg(Temp))).
+
+%%% Make Reg a clone of Dst (attach Dst's type to Reg).
+
+clone(Dst, Reg) ->
+ Type =
+ case Dst of
+ #x86_mem{} -> hipe_x86:mem_type(Dst);
+ #x86_temp{} -> hipe_x86:temp_type(Dst)
+ end,
+ hipe_x86:mk_temp(Reg, Type).
+
+mk_move(Src, Dst=#x86_temp{type=double}) ->
+ hipe_x86:mk_fmove(Src, Dst);
+mk_move(Src, Dst) ->
+ hipe_x86:mk_move(Src, Dst).
diff --git a/lib/hipe/x86/hipe_x86_ra_postconditions.erl b/lib/hipe/x86/hipe_x86_ra_postconditions.erl
new file mode 100644
index 0000000000..0b70764daf
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_ra_postconditions.erl
@@ -0,0 +1,452 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_RA_POSTCONDITIONS, hipe_amd64_ra_postconditions).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(HIPE_X86_SPECIFIC, hipe_amd64_specific).
+-define(ECX, rcx).
+-else.
+-define(HIPE_X86_RA_POSTCONDITIONS, hipe_x86_ra_postconditions).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(HIPE_X86_SPECIFIC, hipe_x86_specific).
+-define(ECX, ecx).
+-endif.
+
+-module(?HIPE_X86_RA_POSTCONDITIONS).
+
+-export([check_and_rewrite/3]).
+
+-include("../x86/hipe_x86.hrl").
+-define(HIPE_INSTRUMENT_COMPILER, true).
+-include("../main/hipe.hrl").
+-define(count_temp(T), ?cons_counter(counter_mfa_mem_temps, T)).
+
+check_and_rewrite(Defun, Coloring, Strategy) ->
+ %% io:format("Converting\n"),
+ TempMap = hipe_temp_map:cols2tuple(Coloring, ?HIPE_X86_SPECIFIC),
+ %% io:format("Rewriting\n"),
+ #defun{code=Code0} = Defun,
+ {Code1, DidSpill} = do_insns(Code0, TempMap, Strategy, [], false),
+ {Defun#defun{code=Code1,var_range={0,hipe_gensym:get_var(x86)}},
+ DidSpill}.
+
+do_insns([I|Insns], TempMap, Strategy, Accum, DidSpill0) ->
+ {NewIs, DidSpill1} = do_insn(I, TempMap, Strategy),
+ do_insns(Insns, TempMap, Strategy, lists:reverse(NewIs, Accum), DidSpill0 or DidSpill1);
+do_insns([], _TempMap, _Strategy, Accum, DidSpill) ->
+ {lists:reverse(Accum), DidSpill}.
+
+do_insn(I, TempMap, Strategy) -> % Insn -> {Insn list, DidSpill}
+ case I of
+ #alu{} ->
+ do_alu(I, TempMap, Strategy);
+ #cmp{} ->
+ do_cmp(I, TempMap, Strategy);
+ #imul{} ->
+ do_imul(I, TempMap, Strategy);
+ #jmp_switch{} ->
+ do_jmp_switch(I, TempMap, Strategy);
+ #lea{} ->
+ do_lea(I, TempMap, Strategy);
+ #move{} ->
+ do_move(I, TempMap, Strategy);
+ #move64{} ->
+ do_move64(I, TempMap, Strategy);
+ #movsx{} ->
+ do_movx(I, TempMap, Strategy);
+ #movzx{} ->
+ do_movx(I, TempMap, Strategy);
+ #fmove{} ->
+ do_fmove(I, TempMap, Strategy);
+ #shift{} ->
+ do_shift(I, TempMap, Strategy);
+ _ ->
+ %% comment, jmp*, label, pseudo_call, pseudo_jcc, pseudo_tailcall,
+ %% pseudo_tailcall_prepare, push, ret
+ {[I], false}
+ end.
+
+%%% Fix an alu op.
+
+do_alu(I, TempMap, Strategy) ->
+ #alu{src=Src0,dst=Dst0} = I,
+ {FixSrc,Src,FixDst,Dst,DidSpill} =
+ do_binary(Src0, Dst0, TempMap, Strategy),
+ {FixSrc ++ FixDst ++ [I#alu{src=Src,dst=Dst}], DidSpill}.
+
+%%% Fix a cmp op.
+
+do_cmp(I, TempMap, Strategy) ->
+ #cmp{src=Src0,dst=Dst0} = I,
+ {FixSrc, Src, FixDst, Dst, DidSpill} =
+ do_binary(Src0, Dst0, TempMap, Strategy),
+ {FixSrc ++ FixDst ++ [I#cmp{src=Src,dst=Dst}], DidSpill}.
+
+%%% Fix an imul op.
+
+do_imul(I, TempMap, Strategy) ->
+ #imul{imm_opt=ImmOpt,src=Src0,temp=Temp0} = I,
+ {FixSrc,Src,DidSpill1} = fix_src_operand(Src0, TempMap, Strategy), % temp1
+ {FixTempSrc,Temp,FixTempDst,DidSpill2} =
+ case is_spilled(Temp0, TempMap) of
+ false ->
+ {[], Temp0, [], false};
+ true ->
+ Reg = spill_temp0('untagged', Strategy),
+ {case ImmOpt of
+ [] -> [hipe_x86:mk_move(Temp0, Reg)]; % temp *= src
+ _ -> [] % temp = src * imm
+ end,
+ Reg,
+ [hipe_x86:mk_move(Reg, Temp0)],
+ true}
+ end,
+ {FixSrc ++ FixTempSrc ++ [I#imul{src=Src,temp=Temp}] ++ FixTempDst,
+ DidSpill1 or DidSpill2}.
+
+%%% Fix a jmp_switch op.
+
+-ifdef(HIPE_AMD64).
+do_jmp_switch(I, TempMap, Strategy) ->
+ #jmp_switch{temp=Temp, jtab=Tab} = I,
+ case is_spilled(Temp, TempMap) of
+ false ->
+ case is_spilled(Tab, TempMap) of
+ false ->
+ {[I], false};
+ true ->
+ NewTab = spill_temp('untagged', Strategy),
+ {[hipe_x86:mk_move(Tab, NewTab), I#jmp_switch{jtab=Tab}],
+ true}
+ end;
+ true ->
+ case is_spilled(Tab, TempMap) of
+ false ->
+ NewTmp = spill_temp('untagged', Strategy),
+ {[hipe_x86:mk_move(Temp, NewTmp), I#jmp_switch{temp=NewTmp}],
+ true};
+ true ->
+ NewTmp = spill_temp('untagged', Strategy),
+ NewTab = spill_temp0('untagged', Strategy),
+ {[hipe_x86:mk_move(Temp, NewTmp),
+ hipe_x86:mk_move(Tab, NewTab),
+ I#jmp_switch{temp=NewTmp, jtab=NewTab}],
+ true}
+ end
+ end.
+-else. % not AMD64
+do_jmp_switch(I, TempMap, Strategy) ->
+ #jmp_switch{temp=Temp} = I,
+ case is_spilled(Temp, TempMap) of
+ false ->
+ {[I], false};
+ true ->
+ NewTmp = spill_temp('untagged', Strategy),
+ {[hipe_x86:mk_move(Temp, NewTmp), I#jmp_switch{temp=NewTmp}],
+ true}
+ end.
+-endif. % not AMD64
+
+%%% Fix a lea op.
+
+do_lea(I, TempMap, Strategy) ->
+ #lea{temp=Temp} = I,
+ case is_spilled(Temp, TempMap) of
+ false ->
+ {[I], false};
+ true ->
+ NewTmp = spill_temp('untagged', Strategy),
+ {[I#lea{temp=NewTmp}, hipe_x86:mk_move(NewTmp, Temp)],
+ true}
+ end.
+
+%%% Fix a move op.
+
+do_move(I, TempMap, Strategy) ->
+ #move{src=Src0,dst=Dst0} = I,
+ {FixSrc, Src, FixDst, Dst, DidSpill} =
+ do_check_byte_move(Src0, Dst0, TempMap, Strategy),
+ {FixSrc ++ FixDst ++ [I#move{src=Src,dst=Dst}],
+ DidSpill}.
+
+-ifdef(HIPE_AMD64).
+
+%%% AMD64 has no issues with byte moves.
+do_check_byte_move(Src0, Dst0, TempMap, Strategy) ->
+ do_binary(Src0, Dst0, TempMap, Strategy).
+
+-else. % not AMD64
+
+%%% x86 can only do byte moves to a subset of the integer registers.
+do_check_byte_move(Src0, Dst0, TempMap, Strategy) ->
+ case Dst0 of
+ #x86_mem{type=byte} ->
+ do_byte_move(Src0, Dst0, TempMap, Strategy);
+ _ ->
+ do_binary(Src0, Dst0, TempMap, Strategy)
+ end.
+
+do_byte_move(Src0, Dst0, TempMap, Strategy) ->
+ {FixSrc, Src, DidSpill1} = fix_src_operand(Src0, TempMap, Strategy),
+ {FixDst, Dst, DidSpill2} = fix_dst_operand(Dst0, TempMap, Strategy),
+ Reg = hipe_x86_registers:eax(),
+ {FixSrc3, Src3} = % XXX: this just checks Src, the result is known!
+ case Src of
+ #x86_imm{} ->
+ {FixSrc, Src};
+ #x86_temp{reg=Reg} -> % small moves must start from reg 1->4
+ {FixSrc, Src} % so variable sources are always put in eax
+ end,
+ {FixSrc3, Src3, FixDst, Dst,
+ DidSpill2 or DidSpill1}.
+
+-endif. % not AMD64
+
+%%% Fix a move64 op.
+
+do_move64(I, TempMap, Strategy) ->
+ #move64{dst=Dst} = I,
+ case�is_spilled(Dst, TempMap) of
+ false ->
+ {[I], false};
+ true ->
+ Reg = clone(Dst, Strategy),
+ {[I#move64{dst=Reg}, hipe_x86:mk_move(Reg, Dst)], true}
+ end.
+
+%%% Fix a movx op.
+
+do_movx(I, TempMap, Strategy) ->
+ {{FixSrc, Src, DidSpill1}, {FixDst, Dst, DidSpill2}} =
+ case I of
+ #movsx{src=Src0,dst=Dst0} ->
+ {fix_src_operand(Src0, TempMap, Strategy),
+ fix_dst_operand(Dst0, TempMap, Strategy)};
+ #movzx{src=Src0,dst=Dst0} ->
+ {fix_src_operand(Src0, TempMap, Strategy),
+ fix_dst_operand(Dst0, TempMap, Strategy)}
+ end,
+ {I3, DidSpill3} =
+ case is_spilled(Dst, TempMap) of
+ false ->
+ I2 = case I of
+ #movsx{} ->
+ [hipe_x86:mk_movsx(Src, Dst)];
+ #movzx{} ->
+ [hipe_x86:mk_movzx(Src, Dst)]
+ end,
+ {I2, false};
+ true ->
+ Dst2 = clone(Dst, Strategy),
+ I2 =
+ case I of
+ #movsx{} ->
+ [hipe_x86:mk_movsx(Src, Dst2), hipe_x86:mk_move(Dst2, Dst)];
+ #movzx{} ->
+ [hipe_x86:mk_movzx(Src, Dst2), hipe_x86:mk_move(Dst2, Dst)]
+ end,
+ {I2, true}
+ end,
+ {FixSrc++FixDst++I3,
+ DidSpill3 or DidSpill2 or DidSpill1}.
+
+%%% Fix an fmove op.
+
+do_fmove(I, TempMap, Strategy) ->
+ #fmove{src=Src0,dst=Dst0} = I,
+ {FixSrc, Src, DidSpill1} = fix_src_operand(Src0, TempMap, Strategy),
+ {FixDst, Dst, DidSpill2} = fix_dst_operand(Dst0, TempMap, Strategy),
+ %% fmoves from memory position to memory position is handled
+ %% by the f.p. register allocator.
+ {FixSrc ++ FixDst ++ [I#fmove{src=Src,dst=Dst}],
+ DidSpill1 or DidSpill2}.
+
+%%% Fix a shift operation.
+%%% 1. remove pseudos from any explicit memory operands
+%%% 2. if the source is a register or memory position
+%%% make sure to move it to %ecx
+
+do_shift(I, TempMap, Strategy) ->
+ #shift{src=Src0,dst=Dst0} = I,
+ {FixDst, Dst, DidSpill} = fix_dst_operand(Dst0, TempMap, Strategy),
+ Reg = ?HIPE_X86_REGISTERS:?ECX(),
+ case Src0 of
+ #x86_imm{} ->
+ {FixDst ++ [I#shift{dst=Dst}], DidSpill};
+ #x86_temp{reg=Reg} ->
+ {FixDst ++ [I#shift{dst=Dst}], DidSpill}
+ end.
+
+%%% Fix the operands of a binary op.
+%%% 1. remove pseudos from any explicit memory operands
+%%% 2. if both operands are (implicit or explicit) memory operands,
+%%% move src to a reg and use reg as src in the original insn
+
+do_binary(Src0, Dst0, TempMap, Strategy) ->
+ {FixSrc, Src, DidSpill1} = fix_src_operand(Src0, TempMap, Strategy),
+ {FixDst, Dst, DidSpill2} = fix_dst_operand(Dst0, TempMap, Strategy),
+ {FixSrc3, Src3, DidSpill3} =
+ case is_mem_opnd(Src, TempMap) of
+ false ->
+ {FixSrc, Src, false};
+ true ->
+ case is_mem_opnd(Dst, TempMap) of
+ false ->
+ {FixSrc, Src, false};
+ true ->
+ Src2 = clone(Src, Strategy),
+ FixSrc2 = FixSrc ++ [hipe_x86:mk_move(Src, Src2)],
+ {FixSrc2, Src2, true}
+ end
+ end,
+ {FixSrc3, Src3, FixDst, Dst,
+ DidSpill3 or DidSpill2 or DidSpill1}.
+
+%%% Fix any x86_mem operand to not refer to any spilled temps.
+
+fix_src_operand(Opnd, TmpMap, Strategy) ->
+ fix_mem_operand(Opnd, TmpMap, temp1(Strategy)).
+
+temp1('normal') -> [];
+temp1('linearscan') -> ?HIPE_X86_REGISTERS:temp1().
+
+fix_dst_operand(Opnd, TempMap, Strategy) ->
+ fix_mem_operand(Opnd, TempMap, temp0(Strategy)).
+
+temp0('normal') -> [];
+temp0('linearscan') -> ?HIPE_X86_REGISTERS:temp0().
+
+fix_mem_operand(Opnd, TempMap, RegOpt) -> % -> {[fixupcode], newop, DidSpill}
+ case Opnd of
+ #x86_mem{base=Base,off=Off} ->
+ case is_mem_opnd(Base, TempMap) of
+ false ->
+ case is_mem_opnd(Off, TempMap) of
+ false ->
+ {[], Opnd, false};
+ true ->
+ Temp = clone2(Off, RegOpt),
+ {[hipe_x86:mk_move(Off, Temp)],
+ Opnd#x86_mem{off=Temp},
+ true}
+ end;
+ true ->
+ Temp = clone2(Base, RegOpt),
+ case is_mem_opnd(Off, TempMap) of
+ false -> % imm/reg(pseudo)
+ {[hipe_x86:mk_move(Base, Temp)],
+ Opnd#x86_mem{base=Temp},
+ true};
+ true -> % pseudo(pseudo)
+ {[hipe_x86:mk_move(Base, Temp),
+ hipe_x86:mk_alu('add', Off, Temp)],
+ Opnd#x86_mem{base=Temp, off=hipe_x86:mk_imm(0)},
+ true}
+ end
+ end;
+ _ ->
+ {[], Opnd, false}
+ end.
+
+%%% Check if an operand denotes a memory cell (mem or pseudo).
+
+is_mem_opnd(Opnd, TempMap) ->
+ R =
+ case Opnd of
+ #x86_mem{} -> true;
+ #x86_temp{} ->
+ Reg = hipe_x86:temp_reg(Opnd),
+ case hipe_x86:temp_is_allocatable(Opnd) of
+ true ->
+ case tuple_size(TempMap) > Reg of
+ true ->
+ case
+ hipe_temp_map:is_spilled(Reg, TempMap) of
+ true ->
+ ?count_temp(Reg),
+ true;
+ false -> false
+ end;
+ _ ->
+ %% impossible, but was true in ls post and false in normal post
+ exit({?MODULE,is_mem_opnd,Reg}),
+ false
+ end;
+ false -> true
+ end;
+ _ -> false
+ end,
+ %% io:format("Op ~w mem: ~w\n",[Opnd,R]),
+ R.
+
+%%% Check if an operand is a spilled Temp.
+
+is_spilled(Temp, TempMap) ->
+ case hipe_x86:temp_is_allocatable(Temp) of
+ true ->
+ Reg = hipe_x86:temp_reg(Temp),
+ case tuple_size(TempMap) > Reg of
+ true ->
+ case hipe_temp_map:is_spilled(Reg, TempMap) of
+ true ->
+ ?count_temp(Reg),
+ true;
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+ false -> true
+ end.
+
+%%% Make Reg a clone of Dst (attach Dst's type to Reg).
+
+clone(Dst, Strategy) ->
+ Type =
+ case Dst of
+ #x86_mem{} -> hipe_x86:mem_type(Dst);
+ #x86_temp{} -> hipe_x86:temp_type(Dst)
+ end,
+ spill_temp(Type, Strategy).
+
+spill_temp0(Type, 'normal') ->
+ hipe_x86:mk_new_temp(Type);
+spill_temp0(Type, 'linearscan') ->
+ hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp0(), Type).
+
+spill_temp(Type, 'normal') ->
+ hipe_x86:mk_new_temp(Type);
+spill_temp(Type, 'linearscan') ->
+ hipe_x86:mk_temp(?HIPE_X86_REGISTERS:temp1(), Type).
+
+%%% Make a certain reg into a clone of Dst
+
+clone2(Dst, RegOpt) ->
+ Type =
+ case Dst of
+ #x86_mem{} -> hipe_x86:mem_type(Dst);
+ #x86_temp{} -> hipe_x86:temp_type(Dst)
+ end,
+ case RegOpt of
+ [] -> hipe_x86:mk_new_temp(Type);
+ Reg -> hipe_x86:mk_temp(Reg, Type)
+ end.
diff --git a/lib/hipe/x86/hipe_x86_ra_x87_ls.erl b/lib/hipe/x86/hipe_x86_ra_x87_ls.erl
new file mode 100644
index 0000000000..6bdb08c6fb
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_ra_x87_ls.erl
@@ -0,0 +1,63 @@
+%% $Id$
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% Linear Scan register allocator for x87
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_RA_X87_LS, hipe_amd64_ra_x87_ls).
+-define(HIPE_X86_SPECIFIC_X87, hipe_amd64_specific_x87).
+-define(HIPE_X86_PP, hipe_amd64_pp).
+-define(HIPE_X86_RA_LS, hipe_amd64_ra_ls).
+-else.
+-define(HIPE_X86_RA_X87_LS, hipe_x86_ra_x87_ls).
+-define(HIPE_X86_SPECIFIC_X87, hipe_x86_specific_x87).
+-define(HIPE_X86_PP, hipe_x86_pp).
+-define(HIPE_X86_RA_LS, hipe_x86_ra_ls).
+-endif.
+
+-module(?HIPE_X86_RA_X87_LS).
+-export([ra/2]).
+
+%%-define(DEBUG,1).
+
+-define(HIPE_INSTRUMENT_COMPILER, false). %% Turn off instrumentation.
+-include("../main/hipe.hrl").
+
+ra(Defun, Options) ->
+ ?inc_counter(ra_calls_counter,1),
+ CFG = hipe_x86_cfg:init(Defun),
+ %% ?inc_counter(ra_caller_saves_counter,count_caller_saves(CFG)),
+ SpillIndex = 0,
+ SpillLimit = ?HIPE_X86_SPECIFIC_X87:number_of_temporaries(CFG),
+ ?inc_counter(bbs_counter, length(hipe_x86_cfg:labels(CFG))),
+
+ ?inc_counter(ra_iteration_counter,1),
+ %% ?HIPE_X86_PP:pp(Defun),
+ Cfg = hipe_x86_cfg:init(Defun), % XXX: didn't we just compute this above?
+
+ {Coloring,NewSpillIndex} =
+ ?HIPE_X86_RA_LS:regalloc(Cfg,
+ ?HIPE_X86_SPECIFIC_X87:allocatable(),
+ [hipe_x86_cfg:start_label(Cfg)],
+ SpillIndex, SpillLimit, Options,
+ ?HIPE_X86_SPECIFIC_X87),
+
+ ?add_spills(Options, NewSpillIndex),
+ {Defun, Coloring, NewSpillIndex}.
diff --git a/lib/hipe/x86/hipe_x86_registers.erl b/lib/hipe/x86/hipe_x86_registers.erl
new file mode 100644
index 0000000000..1cfa095995
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_registers.erl
@@ -0,0 +1,254 @@
+%%%
+%%% %CopyrightBegin%
+%%%
+%%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved online at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% %CopyrightEnd%
+%%%
+%%%
+%%% TODO:
+%%% - Do we need a pseudo reg for the condition codes?
+
+-module(hipe_x86_registers).
+
+-export([reg_name/1,
+ first_virtual/0,
+ is_precoloured/1,
+ is_precoloured_x87/1,
+ all_precoloured/0,
+ eax/0,
+ ecx/0,
+ temp0/0,
+ temp1/0,
+ sp/0,
+ proc_pointer/0,
+ heap_limit/0,
+ fcalls/0,
+ proc_offset/1,
+ sp_limit_offset/0,
+ is_fixed/1,
+ %% fixed/0,
+ allocatable/0,
+ allocatable_x87/0,
+ nr_args/0,
+ arg/1,
+ is_arg/1,
+ args/1,
+ nr_rets/0,
+ ret/1,
+ call_clobbered/0,
+ tailcall_clobbered/0,
+ live_at_return/0,
+ float_size/0,
+ wordsize/0,
+ alignment/0]).
+
+-include("../rtl/hipe_literals.hrl").
+
+-ifdef(X86_HP_IN_ESI).
+-export([heap_pointer/0]).
+-endif.
+
+-define(EAX, 0).
+-define(ECX, 1).
+-define(EDX, 2).
+-define(EBX, 3).
+-define(ESP, 4).
+-define(EBP, 5).
+-define(ESI, 6).
+-define(EDI, 7).
+-define(FCALLS, 8). % proc field alias
+-define(HEAP_LIMIT, 9). % proc field alias
+-define(LAST_PRECOLOURED, 9).
+
+-define(ARG0, ?EAX).
+-define(ARG1, ?EDX).
+-define(ARG2, ?ECX).
+-define(ARG3, ?EBX).
+-define(ARG4, ?EDI).
+
+-define(RET0, ?EAX).
+-define(RET1, ?EDX).
+-define(RET2, ?ECX).
+-define(RET3, ?EBX).
+-define(RET4, ?EDI).
+
+-define(TEMP0, ?EBX). % XXX: was EAX
+-define(TEMP1, ?EDI). % XXX: was EDX then EDI
+
+-define(PROC_POINTER, ?EBP).
+
+reg_name(R) ->
+ case R of
+ ?EAX -> "%eax";
+ ?ECX -> "%ecx";
+ ?EDX -> "%edx";
+ ?EBX -> "%ebx";
+ ?ESP -> "%esp";
+ ?EBP -> "%ebp";
+ ?ESI -> "%esi";
+ ?EDI -> "%edi";
+ ?FCALLS -> "%fcalls";
+ ?HEAP_LIMIT -> "%hplim";
+ Other -> "%r" ++ integer_to_list(Other)
+ end.
+
+first_virtual() -> ?LAST_PRECOLOURED + 1.
+
+is_precoloured(X) -> X =< ?LAST_PRECOLOURED.
+
+is_precoloured_x87(X) -> X =< 6.
+
+all_precoloured() ->
+ [?EAX,
+ ?ECX,
+ ?EDX,
+ ?EBX,
+ ?ESP,
+ ?EBP,
+ ?ESI,
+ ?EDI,
+ ?FCALLS,
+ ?HEAP_LIMIT].
+
+eax() -> ?EAX.
+ecx() -> ?ECX.
+temp0() -> ?TEMP0.
+temp1() -> ?TEMP1.
+sp() -> ?ESP.
+proc_pointer() -> ?PROC_POINTER.
+fcalls() -> ?FCALLS.
+heap_limit() -> ?HEAP_LIMIT.
+
+-ifdef(X86_HP_IN_ESI).
+-define(ESI_IS_FIXED,1).
+-define(HEAP_POINTER, ?ESI).
+heap_pointer() -> ?HEAP_POINTER.
+is_heap_pointer(?HEAP_POINTER) -> true;
+is_heap_pointer(_) -> false.
+-define(LIST_HP_FIXED,[?HEAP_POINTER]).
+-define(LIST_HP_LIVE_AT_RETURN,[{?HEAP_POINTER,untagged}]).
+-else.
+is_heap_pointer(_) -> false.
+-define(LIST_HP_FIXED,[]).
+-define(LIST_HP_LIVE_AT_RETURN,[]).
+-endif.
+
+-ifdef(ESI_IS_FIXED).
+-define(LIST_ESI_ALLOCATABLE,[]).
+-define(LIST_ESI_CALL_CLOBBERED,[]).
+-else.
+-define(LIST_ESI_ALLOCATABLE,[?ESI]).
+-define(LIST_ESI_CALL_CLOBBERED,[{?ESI,tagged},{?ESI,untagged}]).
+-endif.
+
+proc_offset(?FCALLS) -> ?P_FCALLS;
+proc_offset(?HEAP_LIMIT) -> ?P_HP_LIMIT;
+proc_offset(_) -> false.
+
+sp_limit_offset() -> ?P_NSP_LIMIT.
+
+is_fixed(?ESP) -> true;
+is_fixed(?PROC_POINTER) -> true;
+is_fixed(?FCALLS) -> true;
+is_fixed(?HEAP_LIMIT) -> true;
+is_fixed(R) -> is_heap_pointer(R).
+
+%% fixed() ->
+%% [?ESP, ?PROC_POINTER, ?FCALLS, ?HEAP_LIMIT | ?LIST_HP_FIXED].
+
+allocatable() ->
+ [?EDX, ?ECX, ?EBX, ?EAX, ?EDI| ?LIST_ESI_ALLOCATABLE].
+
+allocatable_x87() ->
+ [0,1,2,3,4,5,6].
+
+nr_args() -> ?X86_NR_ARG_REGS.
+
+arg(N) ->
+ if N < ?X86_NR_ARG_REGS ->
+ case N of
+ 0 -> ?ARG0;
+ 1 -> ?ARG1;
+ 2 -> ?ARG2;
+ 3 -> ?ARG3;
+ 4 -> ?ARG4;
+ _ -> exit({?MODULE, arg, N})
+ end;
+ true ->
+ exit({?MODULE, arg, N})
+ end.
+
+is_arg(R) ->
+ case R of
+ ?ARG0 -> ?X86_NR_ARG_REGS > 0;
+ ?ARG1 -> ?X86_NR_ARG_REGS > 1;
+ ?ARG2 -> ?X86_NR_ARG_REGS > 2;
+ ?ARG3 -> ?X86_NR_ARG_REGS > 3;
+ ?ARG4 -> ?X86_NR_ARG_REGS > 4;
+ _ -> false
+ end.
+
+args(Arity) when is_integer(Arity), Arity >= 0 ->
+ N = erlang:min(Arity, ?X86_NR_ARG_REGS),
+ args(N-1, []).
+
+args(I, Rest) when I < 0 -> Rest;
+args(I, Rest) -> args(I-1, [arg(I) | Rest]).
+
+nr_rets() -> ?X86_NR_RET_REGS.
+
+ret(N) ->
+ if N < ?X86_NR_RET_REGS ->
+ case N of
+ 0 -> ?RET0;
+ 1 -> ?RET1;
+ 2 -> ?RET2;
+ 3 -> ?RET3;
+ 4 -> ?RET4;
+ _ -> exit({?MODULE, ret, N})
+ end;
+ true ->
+ exit({?MODULE, ret, N})
+ end.
+
+call_clobbered() ->
+ [{?EAX,tagged},{?EAX,untagged}, % does the RA strip the type or not?
+ {?EDX,tagged},{?EDX,untagged},
+ {?ECX,tagged},{?ECX,untagged},
+ {?EBX,tagged},{?EBX,untagged},
+ {?EDI,tagged},{?EDI,untagged}
+ | ?LIST_ESI_CALL_CLOBBERED] ++ all_x87_pseudos().
+
+tailcall_clobbered() -> % tailcall crapola needs two temps
+ [{?TEMP0,tagged},{?TEMP0,untagged},
+ {?TEMP1,tagged},{?TEMP1,untagged}] ++ all_x87_pseudos().
+
+all_x87_pseudos() ->
+ [{0,double}, {1,double}, {2,double}, {3,double},
+ {4,double}, {5,double}, {6,double}].
+
+live_at_return() ->
+ [{?ESP,untagged}
+ ,{?PROC_POINTER,untagged}
+ ,{?FCALLS,untagged}
+ ,{?HEAP_LIMIT,untagged}
+ | ?LIST_HP_LIVE_AT_RETURN
+ ].
+
+alignment() -> 4.
+
+float_size() -> 8.
+
+wordsize() -> 4.
diff --git a/lib/hipe/x86/hipe_x86_spill_restore.erl b/lib/hipe/x86/hipe_x86_spill_restore.erl
new file mode 100644
index 0000000000..e60c446e17
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_spill_restore.erl
@@ -0,0 +1,345 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ====================================================================
+%% Authors : Dogan Yazar and Erdem Aksu (KT2 project of 2008)
+%% ====================================================================
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_SPILL_RESTORE, hipe_amd64_spill_restore).
+-define(HIPE_X86_LIVENESS, hipe_amd64_liveness).
+-define(HIPE_X86_SPECIFIC, hipe_amd64_specific).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-define(X86STR, "amd64").
+-else.
+-define(HIPE_X86_SPILL_RESTORE, hipe_x86_spill_restore).
+-define(HIPE_X86_LIVENESS, hipe_x86_liveness).
+-define(HIPE_X86_SPECIFIC, hipe_x86_specific).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-define(X86STR, "x86").
+-endif.
+
+-module(?HIPE_X86_SPILL_RESTORE).
+
+-export([spill_restore/2]).
+
+%% controls which set library is used to keep temp variables.
+-define(SET_MODULE, ordsets).
+
+%% Turn on instrumentation.
+-define(HIPE_INSTRUMENT_COMPILER, true).
+
+-include("../main/hipe.hrl").
+-include("../x86/hipe_x86.hrl"). % Added for the definition of #pseudo_call{}
+-include("../flow/cfg.hrl"). % Added for the definition of #cfg{}
+
+%% Main function
+spill_restore(Defun, Options) ->
+ CFG = ?option_time(firstPass(Defun), ?X86STR" First Pass", Options),
+ CFGFinal = ?option_time(secondPass(CFG), ?X86STR" Second Pass", Options),
+ hipe_x86_cfg:linearise(CFGFinal).
+
+%% Performs the first pass of the algorithm.
+%% By working bottom up, introduce the pseudo_spills.
+firstPass(Defun) ->
+ CFG0 = ?HIPE_X86_SPECIFIC:defun_to_cfg(Defun),
+ %% get the labels bottom up
+ Labels = hipe_x86_cfg:postorder(CFG0),
+ Liveness = ?HIPE_X86_LIVENESS:analyse(CFG0),
+ %% spill around the function will be introduced below the move
+ %% formals, so get all labels except it.
+ LabelsExceptMoveFormals = lists:sublist(Labels, length(Labels)-1),
+ %% all work is done by the helper function firstPassHelper
+ %% saveTree keeps the all newly introduced spills. Keys are the labels.
+ {CFG1, SaveTree} = firstPassHelper(LabelsExceptMoveFormals, Liveness, CFG0),
+ case hipe_x86_cfg:reverse_postorder(CFG0) of
+ [Label1, Label2|_] ->
+ SaveTreeElement = saveTreeLookup(Label2, SaveTree),
+ %% FilteredSaveTreeElement is the to be spilled temps around the function call.
+ %% They are spilled just before move formals
+ FilteredSaveTreeElement = [Temp || Temp <- SaveTreeElement, temp_is_pseudo(Temp)],
+ Block = hipe_x86_cfg:bb(CFG1, Label1),
+ Code = hipe_bb:code(Block),
+ %% The following statements are tedious but work ok.
+ %% Put spills between move formals and the jump code.
+ %% This disgusting thing is done because spills should be
+ %% introduced after move formals.
+ %% Another solution may be to introduce another block.
+ MoveCodes = lists:sublist(Code, length(Code)-1),
+ JumpCode = lists:last(Code),
+ hipe_x86_cfg:bb_add(CFG1, Label1, hipe_bb:mk_bb(MoveCodes ++ [hipe_x86:mk_pseudo_spill(FilteredSaveTreeElement)] ++ [JumpCode]));
+ _ ->
+ CFG1
+ end.
+
+%% helper function of firstPass
+
+%% processes all labels recursively and decides the spills to be put.
+%% spills are introduced before each function call (pseudo_call) as well as
+%% global spill is found
+firstPassHelper(Labels, Liveness, CFG) ->
+ firstPassHelper(Labels, Liveness, CFG, gb_trees:empty()).
+
+firstPassHelper([Label|Labels], Liveness, CFG, SaveTree) ->
+ LiveOut = from_list(?HIPE_X86_LIVENESS:liveout(Liveness, Label)),
+ Block = hipe_x86_cfg:bb(CFG, Label),
+ Code = hipe_bb:code(Block),
+ Succ = hipe_x86_cfg:succ(CFG, Label),
+ IntersectedSaveList = findIntersectedSaveList(Succ,SaveTree),
+ %% call firstPassDoBlock which will give the updated block
+ %% code(including spills) as well as Intersected Save List which
+ %% should be passed above blocks
+ {_,NewIntersectedList,NewCode} =
+ firstPassDoBlock(Code, LiveOut,IntersectedSaveList),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ NewCFG = hipe_x86_cfg:bb_add(CFG, Label, NewBlock),
+ SizeOfSet = setSize(NewIntersectedList),
+
+ %% if the Intersected Save List is not empty, insert it in the save tree.
+ if SizeOfSet =/= 0 ->
+ UpdatedSaveTree = gb_trees:insert(Label,NewIntersectedList,SaveTree),
+ firstPassHelper(Labels, Liveness, NewCFG,UpdatedSaveTree);
+ true ->
+ firstPassHelper(Labels, Liveness, NewCFG,SaveTree)
+ end;
+firstPassHelper([], _, CFG, SaveTree) ->
+ {CFG, SaveTree}.
+
+%% handle each instruction in the block bottom up
+firstPassDoBlock(Insts, LiveOut, IntersectedSaveList) ->
+ lists:foldr(fun firstPassDoInsn/2, {LiveOut,IntersectedSaveList,[]}, Insts).
+
+firstPassDoInsn(I, {LiveOut,IntersectedSaveList,PrevInsts} ) ->
+ case I of
+ #pseudo_call{} ->
+ do_pseudo_call(I, {LiveOut,IntersectedSaveList,PrevInsts});
+ _ -> % other instructions
+ DefinedList = from_list( ?HIPE_X86_LIVENESS:defines(I)),
+ UsedList = from_list(?HIPE_X86_LIVENESS:uses(I)),
+
+ NewLiveOut = subtract(union(LiveOut, UsedList), DefinedList),
+ NewIntersectedSaveList = subtract(IntersectedSaveList, DefinedList),
+
+ {NewLiveOut, NewIntersectedSaveList, [I|PrevInsts]}
+ end.
+
+do_pseudo_call(I, {LiveOut,IntersectedSaveList,PrevInsts}) ->
+ LiveTemps = [Temp || Temp <- to_list(LiveOut), temp_is_pseudo(Temp)],
+ NewIntersectedSaveList = union(IntersectedSaveList, LiveOut),
+ {LiveOut, NewIntersectedSaveList, [hipe_x86:mk_pseudo_spill(LiveTemps), I | PrevInsts]}.
+
+findIntersectedSaveList(LabelList, SaveTree) ->
+ findIntersectedSaveList([saveTreeLookup(Label,SaveTree) || Label <- LabelList]).
+
+findIntersectedSaveList([]) ->
+ [];
+findIntersectedSaveList([List1]) ->
+ List1;
+findIntersectedSaveList([List1,List2|Rest]) ->
+ findIntersectedSaveList([intersection(List1, List2)|Rest]).
+
+saveTreeLookup(Label, SaveTree) ->
+ case gb_trees:lookup(Label, SaveTree) of
+ {value, SaveList} ->
+ SaveList;
+ _ ->
+ []
+ end.
+
+%% Performs the second pass of the algoritm.
+%% It basically eliminates the unnecessary spills and introduces restores.
+%% Works top down
+secondPass(CFG0) ->
+ Labels = hipe_x86_cfg:reverse_postorder(CFG0),
+ Liveness = ?HIPE_X86_LIVENESS:analyse(CFG0),
+ secondPassHelper(Labels,Liveness,CFG0).
+
+%% helper function of secondPass.
+
+%% recursively handle all labels given.
+secondPassHelper(Labels, Liveness, CFG) ->
+ secondPassHelper(Labels, Liveness, CFG, gb_trees:empty(), CFG).
+
+%% AccumulatedCFG stands for the CFG that has restore edges incrementally.
+%% UnmodifiedCFG is the CFG created after first pass.
+
+%% AccumulatedSaveTree is used to eliminate the unnecessary saves. The
+%% saves (spills) in above blocks are traversed down (if still live
+%% and not redefined) and redundant saves are eliminated in the lower
+%% blocks.
+%% For memory efficiency, it may be better not to maintain the
+%% AccumulatedSaveTree but traverse the tree recursively and pass the
+%% save lists to the childs individually.
+%% But current approach may be faster even though it needs bigger memory.
+
+secondPassHelper([Label|RestOfLabels], Liveness,
+ AccumulatedCFG, AccumulatedSaveTree, UnmodifiedCFG) ->
+ LiveOut = ?HIPE_X86_LIVENESS:liveout(Liveness, Label),
+ Block = hipe_x86_cfg:bb(AccumulatedCFG, Label),
+ Code = hipe_bb:code(Block),
+
+ %% UnmodifiedCFG is needed for getting the correct predecessors.
+ %% (i.e. not to get the restore edge blocks)
+ PredList = hipe_x86_cfg:pred(UnmodifiedCFG, Label),
+ %% find the spills coming from all the parents by intersecting
+ InitialAccumulatedSaveList =
+ findIntersectedSaveList(PredList, AccumulatedSaveTree),
+ AccumulatedSaveList =
+ keepLiveVarsInAccumSaveList(InitialAccumulatedSaveList, LiveOut),
+
+ {NewCode, CFGUpdateWithRestores, NewAccumulatedSaveList} =
+ secondPassDoBlock(Label, Code, AccumulatedCFG, AccumulatedSaveList),
+
+ UpdatedAccumulatedSaveTree =
+ gb_trees:insert(Label, NewAccumulatedSaveList, AccumulatedSaveTree),
+ NewBlock = hipe_bb:code_update(Block, NewCode),
+ NewCFG = hipe_x86_cfg:bb_add(CFGUpdateWithRestores, Label, NewBlock),
+ secondPassHelper(RestOfLabels, Liveness, NewCFG,
+ UpdatedAccumulatedSaveTree, UnmodifiedCFG);
+secondPassHelper([], _, AccumulatedCFG, _, _) ->
+ AccumulatedCFG.
+
+secondPassDoBlock(CurrentLabel, Insts, CFG, AccumulatedSaveList) ->
+ {NewAccumulatedSaveList,NewInsts,_,_,CFGUpdateWithRestores} =
+ lists:foldl(fun secondPassDoInsn/2, {AccumulatedSaveList,[],[],CurrentLabel,CFG}, Insts),
+ {NewInsts, CFGUpdateWithRestores, NewAccumulatedSaveList}.
+
+secondPassDoInsn(I, {AccumulatedSaveList,PrevInsts,SpillList,CurrentLabel,CFG}) ->
+ case I of
+ #pseudo_spill{} ->
+ %% spill variables that are not accumulated from top down
+ %% (which are not already saved)
+ VariablesAlreadySaved = [X || {X,_} <- to_list(AccumulatedSaveList)],
+ VariablesToBeSpilled = I#pseudo_spill.args -- VariablesAlreadySaved,
+ NewSpillList = [{Temp, hipe_x86:mk_new_temp(Temp#x86_temp.type)} || Temp <- VariablesToBeSpilled],
+ %% update accumulated saved list by adding the newly spilled variables.
+ NewAccumulatedSaveList = union(AccumulatedSaveList, from_list(NewSpillList)),
+ {NewAccumulatedSaveList, PrevInsts ++ secondPassDoPseudoSpill(NewSpillList), NewSpillList, CurrentLabel, CFG};
+ #pseudo_call{} ->
+ {CFGUpdateWithRestores, NewPseudoCall} =
+ secondPassDoPseudoCall(I, AccumulatedSaveList, CFG),
+ %% spill list is emptied after use
+ {AccumulatedSaveList, PrevInsts ++ [NewPseudoCall], CurrentLabel, [], CFGUpdateWithRestores};
+ _ ->
+ %% remove the defined variables from the accumulated save
+ %% list since they need to be saved again in later occasions.
+ DefinedList = from_list(?HIPE_X86_LIVENESS:defines(I)),
+ NewAccumulatedSaveList = removeRedefVarsFromAccumSaveList(AccumulatedSaveList, DefinedList),
+ {NewAccumulatedSaveList, PrevInsts ++ [I], SpillList, CurrentLabel, CFG}
+ end.
+
+%% remove dead vars from accumulated save list so that they are not restored.
+keepLiveVarsInAccumSaveList([], _) ->
+ [];
+keepLiveVarsInAccumSaveList([{Var,Temp}|Rest], DefinedList) ->
+ IsDefined = is_element(Var, DefinedList),
+ case IsDefined of
+ true -> [{Var,Temp}|keepLiveVarsInAccumSaveList(Rest, DefinedList)];
+ false -> keepLiveVarsInAccumSaveList(Rest, DefinedList)
+ end.
+
+%% remove the redefined variables from accumulated save list since
+%% they are changed.
+removeRedefVarsFromAccumSaveList([], _) ->
+ [];
+removeRedefVarsFromAccumSaveList([{Var,Temp}|Rest], DefinedList) ->
+ IsDefined = is_element(Var, DefinedList),
+ case IsDefined of
+ true -> removeRedefVarsFromAccumSaveList(Rest, DefinedList);
+ false -> [{Var,Temp}|removeRedefVarsFromAccumSaveList(Rest, DefinedList)]
+ end.
+
+%% convert pseudo_spills to move instructions.
+secondPassDoPseudoSpill(SpillList) ->
+ lists:foldl(fun convertPseudoSpillToMov/2, [], SpillList).
+
+%% if there are variables to be restored, then call addRestoreBlockToEdge to
+%% place them in a new block on the edge of the blocks.
+secondPassDoPseudoCall(I, RestoreList, CFG) ->
+ ContLabel = I#pseudo_call.contlab,
+ SizeOfSet = setSize(RestoreList),
+ if SizeOfSet =/= 0 ->
+ addRestoreBlockToEdge(I, ContLabel, CFG, RestoreList);
+ true ->
+ {CFG, I}
+ end.
+
+%% prepares the moves for the spills.
+convertPseudoSpillToMov({Temp, NewTemp}, OtherMoves) ->
+ OtherMoves ++ [mkMove(Temp, NewTemp)].
+
+%% prepares the moves for the restores.
+%% Called by addRestoreBlockToEdge while introducing the restores.
+convertPseudoRestoreToMov({Temp, NewTemp}, OtherMoves) ->
+ OtherMoves ++ [mkMove(NewTemp, Temp)].
+
+%% makes the move record, special care is taken for doubles.
+mkMove(NewTemp,Temp) ->
+ if Temp#x86_temp.type =:= 'double' ->
+ hipe_x86:mk_fmove(NewTemp, Temp);
+ true ->
+ hipe_x86:mk_move(NewTemp, Temp)
+ end.
+
+%% adds a new block (on the edge) that includes introduced restore moves.
+addRestoreBlockToEdge(PseudoCall, ContLabel, CFG, TempArgsList) ->
+ NextLabel = hipe_gensym:get_next_label(x86),
+ NewCode = lists:foldl(fun convertPseudoRestoreToMov/2, [], TempArgsList) ++ [hipe_x86:mk_jmp_label(ContLabel)],
+ NewBlock = hipe_bb:mk_bb(NewCode),
+ NewPseudoCall = redirect_pseudo_call(PseudoCall, ContLabel, NextLabel),
+ NewCFG = hipe_x86_cfg:bb_add(CFG, NextLabel, NewBlock),
+ {NewCFG, NewPseudoCall}.
+
+%% used instead of hipe_x86_cfg:redirect_jmp since it does not handle pseudo_call calls.
+redirect_pseudo_call(I = #pseudo_call{contlab=ContLabel}, Old, New) ->
+ case Old =:= ContLabel of
+ true -> I#pseudo_call{contlab=New};
+ false -> I
+ end.
+
+temp_is_pseudo(Temp) ->
+ case hipe_x86:is_temp(Temp) of
+ true -> not(?HIPE_X86_REGISTERS:is_precoloured(hipe_x86:temp_reg(Temp)));
+ false -> false
+ end.
+
+%%---------------------------------------------------------------------
+%% Set operations where the module name is an easily changeable macro
+%%---------------------------------------------------------------------
+
+union(Set1,Set2) ->
+ ?SET_MODULE:union(Set1,Set2).
+
+setSize(Set) ->
+ ?SET_MODULE:size(Set).
+
+from_list(List) ->
+ ?SET_MODULE:from_list(List).
+
+to_list(Set) ->
+ ?SET_MODULE:to_list(Set).
+
+subtract(Set1, Set2) ->
+ ?SET_MODULE:subtract(Set1, Set2).
+
+intersection(Set1, Set2) ->
+ ?SET_MODULE:intersection(Set1, Set2).
+
+is_element(Element, Set) ->
+ ?SET_MODULE:is_element(Element, Set).
diff --git a/lib/hipe/x86/hipe_x86_x87.erl b/lib/hipe/x86/hipe_x86_x87.erl
new file mode 100644
index 0000000000..6ef14abdbb
--- /dev/null
+++ b/lib/hipe/x86/hipe_x86_x87.erl
@@ -0,0 +1,635 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Floating point handling.
+
+-ifdef(HIPE_AMD64).
+-define(HIPE_X86_X87, hipe_amd64_x87).
+-define(HIPE_X86_DEFUSE, hipe_amd64_defuse).
+-define(HIPE_X86_LIVENESS, hipe_amd64_liveness).
+-define(HIPE_X86_REGISTERS, hipe_amd64_registers).
+-else.
+-define(HIPE_X86_X87, hipe_x86_x87).
+-define(HIPE_X86_DEFUSE, hipe_x86_defuse).
+-define(HIPE_X86_LIVENESS, hipe_x86_liveness).
+-define(HIPE_X86_REGISTERS, hipe_x86_registers).
+-endif.
+
+-module(?HIPE_X86_X87).
+
+-export([map/1]).
+
+-include("../x86/hipe_x86.hrl").
+-include("../main/hipe.hrl").
+
+%%----------------------------------------------------------------------
+
+map(Defun) ->
+ CFG0 = hipe_x86_cfg:init(Defun),
+ %% hipe_x86_cfg:pp(CFG0),
+ Liveness = ?HIPE_X86_LIVENESS:analyse(CFG0),
+ StartLabel = hipe_x86_cfg:start_label(CFG0),
+ {CFG1,_} = do_blocks([], [StartLabel], CFG0, Liveness, [], gb_trees:empty()),
+ hipe_x86_cfg:linearise(CFG1).
+
+do_blocks(Pred, [Lbl|Lbls], CFG, Liveness, Map, BlockMap) ->
+ case gb_trees:lookup(Lbl, BlockMap) of
+ none ->
+ %% This block has not been visited.
+ Block = hipe_x86_cfg:bb(CFG, Lbl),
+ Succ = hipe_x86_cfg:succ(CFG, Lbl),
+ NewBlockMap = gb_trees:insert(Lbl, Map, BlockMap),
+ LiveOut = [X || X <- ?HIPE_X86_LIVENESS:liveout(Liveness, Lbl),
+ is_fp(X)],
+ Code = hipe_bb:code(Block),
+ ReverseCode = lists:reverse(Code),
+ {NewCode0, NewMap, NewBlockMap1, Dirty} =
+ do_block(ReverseCode, LiveOut, Map, NewBlockMap),
+ NewCFG1 =
+ case Dirty of
+ true ->
+ NewBlock = hipe_bb:code_update(Block, NewCode0),
+ hipe_x86_cfg:bb_add(CFG, Lbl, NewBlock);
+ _ ->
+ CFG
+ end,
+ {NewCFG3, NewBlockMap2} =
+ do_blocks(Lbl, Succ, NewCFG1, Liveness, NewMap, NewBlockMap1),
+ do_blocks(Pred, Lbls, NewCFG3, Liveness, Map, NewBlockMap2);
+ {value, fail} ->
+ %% Don't have to follow this trace any longer.
+ do_blocks(Pred,Lbls, CFG, Liveness, Map, BlockMap);
+ {value, ExistingMap} ->
+ %% This block belongs to a trace already handled.
+ %% The Map coming in must be identical to the one used
+ %% when the block was processed.
+ if ExistingMap =:= Map ->
+ do_blocks(Pred, Lbls, CFG, Liveness, Map, BlockMap);
+ true ->
+ NewCFG = do_shuffle(Pred, Lbl, CFG, Map, ExistingMap),
+ do_blocks(Pred, Lbls, NewCFG, Liveness, Map, BlockMap)
+ end
+ end;
+do_blocks(_Pred, [], CFG, _Liveness, _Map, BlockMap) ->
+ {CFG, BlockMap}.
+
+do_block(Ins, LiveOut, Map, BlockMap) ->
+ do_block(Ins, LiveOut, Map, BlockMap, false).
+
+do_block([I|Is], LiveOut, Map, BlockMap, Dirty) ->
+ case handle_insn(I) of
+ false ->
+ {NewCode, NewMap, NewBlockMap, NewDirty} =
+ do_block(Is, LiveOut, Map, BlockMap, Dirty),
+ {NewCode++[I], NewMap, NewBlockMap, NewDirty};
+ true ->
+ Def = ordsets:from_list(?HIPE_X86_DEFUSE:insn_def(I)),
+ Use = ordsets:from_list(?HIPE_X86_DEFUSE:insn_use(I)),
+ NewLiveOut =
+ ordsets:filter(fun(X) -> is_fp(X) end,
+ ordsets:union(ordsets:subtract(LiveOut, Def), Use)),
+ {NewCode, NewMap, NewBlockMap, NewDirty} =
+ do_block(Is, NewLiveOut, Map, BlockMap, Dirty),
+ {NewI, NewMap1, NewBlockMap1} =
+ do_insn(I, LiveOut, NewMap, NewBlockMap),
+ NewDirty1 =
+ if NewDirty =:= true -> true;
+ NewI =:= [I] -> false;
+ true -> true
+ end,
+ {NewCode++NewI, NewMap1, NewBlockMap1, NewDirty1}
+ end;
+do_block([], LiveOut, Map, BlockMap, Dirty) ->
+ case [X || X <- Map, not lists:member(X, LiveOut)] of
+ [] ->
+ {[], Map, BlockMap, Dirty};
+ Pop ->
+ {PopIns, NewMap} = pop_dead(Pop, Map),
+ {PopIns, NewMap, BlockMap, true}
+ end.
+
+do_shuffle(Pred, Lbl, CFG, OldMap, NewMap) ->
+ %% First make sure both maps have the same members.
+ Push = NewMap -- OldMap,
+ Pop = OldMap -- NewMap,
+ {PopInsn, OldMap0} = pop_dead(Pop, OldMap),
+ {PushInsn, OldMap1} =
+ case Push of
+ []-> {[], OldMap0};
+ _-> push_list(lists:reverse(Push), OldMap0)
+ end,
+ Code =
+ if OldMap1 =:= NewMap ->
+ %% It was enough to push and pop.
+ PopInsn ++ PushInsn ++ [hipe_x86:mk_jmp_label(Lbl)];
+ true ->
+ %% Shuffle the positions so the maps match
+ Cycles = find_swap_cycles(OldMap1, NewMap),
+ SwitchInsns = do_switching(Cycles),
+ PopInsn ++ PushInsn ++ SwitchInsns ++ [hipe_x86:mk_jmp_label(Lbl)]
+ end,
+ %% Update the CFG.
+ NewLabel = hipe_gensym:get_next_label(x86),
+ NewCFG1 = hipe_x86_cfg:bb_add(CFG, NewLabel, hipe_bb:mk_bb(Code)),
+ OldPred = hipe_x86_cfg:bb(NewCFG1, Pred),
+ PredCode = hipe_bb:code(OldPred),
+ NewLast = redirect(lists:last(PredCode), Lbl,NewLabel),
+ NewPredCode = butlast(PredCode) ++ [NewLast],
+ NewPredBB = hipe_bb:code_update(OldPred, NewPredCode),
+ hipe_x86_cfg:bb_add(NewCFG1, Pred, NewPredBB).
+
+find_swap_cycles(OldMap, NewMap) ->
+ Moves = [get_pos(X, NewMap, 1) || X <- OldMap],
+ find_swap_cycles(OldMap, Moves, lists:seq(1, length(OldMap)), []).
+
+find_swap_cycles(OldMap, Moves, NotHandled, Cycles) ->
+ if NotHandled =:= [] -> Cycles;
+ true ->
+ Cycle = find_cycle(Moves, [hd(NotHandled)]),
+ NewNotHandled = NotHandled -- Cycle,
+ case lists:member(1, Cycle) of
+ true ->
+ %% The cycle that contains the first element on the stack
+ %% must be processed last.
+ NewCycle = format_cycle(Cycle),
+ find_swap_cycles(OldMap, Moves, NewNotHandled, Cycles ++ [NewCycle]);
+ _ ->
+ NewCycle = format_cycle(Cycle),
+ find_swap_cycles(OldMap, Moves, NewNotHandled, [NewCycle|Cycles])
+ end
+ end.
+
+find_cycle(Moves, Cycle) ->
+ To = lists:nth(lists:last(Cycle), Moves),
+ if To =:= hd(Cycle) -> Cycle;
+ true -> find_cycle(Moves, Cycle ++ [To])
+ end.
+
+format_cycle(C) ->
+ %% The position numbers start with 1 - should start with 0.
+ %% If position 0 is in the cycle it will be permuted until
+ %% the 0 is first and then remove it.
+ %% Otherwise the first element is also added last.
+ NewCycle = [X - 1 || X <- C],
+ case lists:member(0, NewCycle) of
+ true -> format_cycle(NewCycle, []);
+ _ -> NewCycle ++ [hd(NewCycle)]
+ end.
+
+format_cycle([H|T], NewCycle) ->
+ case H of
+ 0 -> T ++ NewCycle;
+ _ -> format_cycle(T, NewCycle ++ [H])
+ end.
+
+do_switching(Cycles) ->
+ do_switching(Cycles, []).
+
+do_switching([C|Cycles], Insns) ->
+ NewInsns = Insns ++ [hipe_x86:mk_fp_unop(fxch, mk_st(X)) || X <- C],
+ do_switching(Cycles, NewInsns);
+do_switching([], Insns) ->
+ Insns.
+
+redirect(Insn, OldLbl, NewLbl) ->
+ case Insn of
+ #pseudo_call{contlab = ContLab, sdesc = SDesc} ->
+ #x86_sdesc{exnlab = ExnLab} = SDesc,
+ if ContLab =:= OldLbl ->
+ Insn#pseudo_call{contlab = NewLbl};
+ ExnLab =:= OldLbl ->
+ Insn#pseudo_call{sdesc = SDesc#x86_sdesc{exnlab = NewLbl}}
+ end;
+ _ ->
+ hipe_x86_cfg:redirect_jmp(Insn, OldLbl, NewLbl)
+ end.
+
+do_insn(I, LiveOut, Map, BlockMap) ->
+ case I of
+ #pseudo_call{'fun' = Fun, contlab = ContLab} ->
+ case Fun of
+ %% We don't want to spill anything if an exception has been thrown.
+ {_, 'handle_fp_exception'} ->
+ NewBlockMap =
+ case gb_trees:lookup(ContLab, BlockMap) of
+ {value, fail} ->
+ BlockMap;
+ {value, _} ->
+ gb_trees:update(ContLab, fail, BlockMap);
+ none ->
+ gb_trees:insert(ContLab, fail, BlockMap)
+ end,
+ {[I], [], NewBlockMap};
+ _ ->
+ {pop_all(Map)++[I],[],BlockMap}
+ end;
+ #fp_unop{op = 'fwait'} ->
+ Store = pseudo_pop(Map),
+ {Store ++ [I], Map, BlockMap};
+ #fp_unop{} ->
+ {NewI, NewMap} = do_fp_unop(I, LiveOut, Map),
+ {NewI, NewMap, BlockMap};
+ #fp_binop{} ->
+ {NewI, NewMap} = do_fp_binop(I, LiveOut, Map),
+ {NewI, NewMap, BlockMap};
+ #fmove{src = Src, dst = Dst} ->
+ if Src =:= Dst ->
+ %% Don't need to keep this instruction!
+ %% However, we may need to pop from the stack.
+ case is_liveOut(Src, LiveOut) of
+ true->
+ {[], Map, BlockMap};
+ false ->
+ {SwitchInsn, NewMap0} = switch_first(Dst, Map),
+ NewMap = pop(NewMap0),
+ {SwitchInsn++pop_insn(), NewMap, BlockMap}
+ end;
+ true ->
+ {NewI, NewMap} = do_fmove(Src, Dst, LiveOut, Map),
+ {NewI, NewMap, BlockMap}
+ end;
+ _ ->
+ {[I], Map, BlockMap}
+ end.
+
+do_fmove(Src, Dst = #x86_mem{}, LiveOut, Map) ->
+ %% Storing a float from the stack into memory.
+ {SwitchInsn, NewMap0} = switch_first(Src, Map),
+ case is_liveOut(Src, LiveOut) of
+ true ->
+ {SwitchInsn ++ [hipe_x86:mk_fp_unop(fst, Dst)], NewMap0};
+ _ ->
+ NewMap1 = pop(NewMap0),
+ {SwitchInsn ++ [hipe_x86:mk_fp_unop(fstp, Dst)], NewMap1}
+ end;
+do_fmove(Src = #x86_mem{}, Dst, _LiveOut, Map) ->
+ %% Pushing a float into the stack.
+ case in_map(Dst, Map) of
+ true -> ?EXIT({loadingExistingFpVariable,{Src,Dst}});
+ _ -> ok
+ end,
+ {PushOp, [_|NewMap0]} = push(Src, Map),
+ %% We want Dst in the map rather than Src.
+ NewMap = [Dst|NewMap0],
+ {PushOp, NewMap};
+do_fmove(Src, Dst, LiveOut, Map) ->
+ %% Copying a float that either is spilled or is on the fp stack,
+ %% or converting a fixnum in a temp to a float on the fp stack.
+ case in_map(Dst, Map) of
+ true -> ?EXIT({copyingToExistingFpVariable,{Src,Dst}});
+ _ -> ok
+ end,
+ IsConv =
+ case Src of
+ #x86_temp{type = Type} -> Type =/= 'double';
+ _ -> false
+ end,
+ case IsConv of
+ true ->
+ do_conv(Src, Dst, Map);
+ _ ->
+ %% Copying.
+ case {is_liveOut(Src, LiveOut), in_map(Src, Map)} of
+ {false, true} ->
+ %% Just remap Dst to Src
+ {Head, [_|T]} = lists:splitwith(fun(X) -> X =/= Src end, Map),
+ {[], Head ++ [Dst|T]};
+ _ ->
+ {PushOp, [_|NewMap0]} = push(Src, Map),
+ %% We want Dst in the map rather than Src.
+ NewMap = [Dst|NewMap0],
+ {PushOp, NewMap}
+ end
+ end.
+
+do_conv(Src = #x86_temp{reg = Reg}, Dst, Map) ->
+ %% Converting. Src must not be a register, so we
+ %% might have to put it into memory in between.
+ {Move, NewSrc} =
+ case ?HIPE_X86_REGISTERS:is_precoloured(Reg) of
+ true ->
+ Temp = hipe_x86:mk_new_temp('untagged'),
+ {[hipe_x86:mk_move(Src,Temp)], Temp};
+ _ ->
+ {[], Src}
+ end,
+ {PushOp, [_|NewMap0]} = push(NewSrc, Map),
+ %% We want Dst in the map rather than NewSrc.
+ NewMap = [Dst|NewMap0],
+ case length(PushOp) of
+ 1 -> %% No popping of memory object on fpstack
+ {Move ++ [hipe_x86:mk_fp_unop(fild, NewSrc)], NewMap};
+ _ -> %% H contains pop instructions. Must be kept!
+ Head = butlast(PushOp),
+ {Move ++ Head ++ [hipe_x86:mk_fp_unop(fild, NewSrc)], NewMap}
+ end.
+
+do_fp_unop(I = #fp_unop{arg = Arg, op = fchs}, Liveout, Map) ->
+ %% This is fchs, the only operation without a
+ %% popping version. Needs special handling.
+ case is_liveOut(Arg, Liveout) of
+ true ->
+ {SwitchIns, NewMap} = switch_first(Arg, Map),
+ {SwitchIns ++ [I#fp_unop{arg = []}], NewMap};
+ false ->
+ %% Don't need to keep this instruction!
+ %% However, we may need to pop Src from the stack.
+ case in_map(Arg, Map) of
+ true ->
+ {SwitchInsn, NewMap0} = switch_first(Arg, Map),
+ NewMap = pop(NewMap0),
+ {SwitchInsn ++ pop_insn(), NewMap};
+ _ ->
+ {[],Map}
+ end
+ end.
+
+do_fp_binop(#fp_binop{src = Src, dst = Dst, op = Op}, LiveOut, Map) ->
+ case {is_liveOut(Src, LiveOut), is_liveOut(Dst, LiveOut)} of
+ {true, true} ->
+ keep_both(Op, Src, Dst, Map);
+ {true, false} ->
+ keep_src(Op, Src, Dst, Map);
+ {false, true} ->
+ keep_dst(Op, Src, Dst, Map);
+ {false, false} ->
+ %% Both Dst and Src are popped.
+ keep_none(Op, Src, Dst, Map)
+ end.
+
+keep_both(Op, Src, Dst, Map) ->
+ %% Keep both Dst and Src if it is there.
+ {SwitchInsn, NewMap} = switch_first(Dst, Map),
+ NewSrc = get_new_opnd(Src, NewMap),
+ Insn = format_fp_binop(Op, NewSrc, mk_st(0)),
+ {SwitchInsn++Insn, NewMap}.
+
+keep_src(Op, Src, Dst, Map) ->
+ %% Pop Dst but keep Src in stack if it is there.
+ {SwitchInsn, NewMap0} = switch_first(Dst, Map),
+ NewSrc = get_new_opnd(Src, NewMap0),
+ NewMap = pop(NewMap0),
+ Insn = format_fp_binop(Op, NewSrc, mk_st(0)),
+ {SwitchInsn ++ Insn ++ pop_insn(), NewMap}.
+
+keep_dst(Op, Src, Dst, Map) ->
+ %% Keep Dst but pop Src.
+ %% Dst must be in stack.
+ DstInMap = in_map(Dst, Map),
+ SrcInMap = in_map(Src, Map),
+ case SrcInMap of
+ true ->
+ case DstInMap of
+ true ->
+ %% Src must be popped. If Dst is on top of the stack we can
+ %% alter the operation rather than shuffle the stack.
+ {SwitchInsn, Insn, NewMap} =
+ if hd(Map) =:= Dst ->
+ NewOp = mk_op_pop(reverse_op(Op)),
+ NewDst = get_new_opnd(Src, Map),
+ TmpMap = lists:map(fun(X) ->
+ if X =:= Src -> Dst; true -> X end
+ end, Map),
+ {[], format_fp_binop(NewOp, mk_st(0), NewDst), pop(TmpMap)};
+ true ->
+ {SwitchInsn1, NewMap0} = switch_first(Src, Map),
+ NewDst = get_new_opnd(Dst,NewMap0),
+ NewOp = mk_op_pop(Op),
+ {SwitchInsn1,format_fp_binop(NewOp, mk_st(0), NewDst), pop(NewMap0)}
+ end,
+ {SwitchInsn ++ Insn, NewMap};
+ _ ->
+ %% Src is on the stack, but Dst isn't. Use memory command to avoid
+ %% unnecessary loading instructions.
+ {SwitchInsn, NewMap0} = switch_first(Src, Map),
+ NewOp = reverse_op(Op),
+ NewMap = [Dst] ++ tl(NewMap0),
+ Insn = format_fp_binop(NewOp, Dst, mk_st(0)),
+ {SwitchInsn ++ Insn, NewMap}
+ end;
+ _ ->
+ %% Src isn't in the map so it doesn't have to be popped.
+ {SwitchInsn, NewMap} = switch_first(Dst, Map),
+ {SwitchInsn ++ [#fp_unop{arg = Src, op = Op}], NewMap}
+ end.
+
+keep_none(Op, Src, Dst, Map) ->
+ %% Dst must be on stack.
+ {PushInsn, NewMap0} =
+ case in_map(Dst, Map) of
+ true -> {[], Map};
+ _ -> push(Dst, Map)
+ end,
+ case in_map(Src, NewMap0) of
+ true ->
+ %% Src must be popped.
+ {SwitchInsn1, NewMap1} = switch_first(Src, NewMap0),
+ NewOp = mk_op_pop(Op),
+ NewDst = get_new_opnd(Dst,NewMap1),
+ NewMap2 = pop(NewMap1),
+ %% Then Dst has to be popped.
+ {PopInsn, NewMap} = pop_member(Dst, NewMap2),
+ Insn = format_fp_binop(NewOp, mk_st(0), NewDst),
+ {PushInsn ++ SwitchInsn1 ++ Insn ++ PopInsn, NewMap};
+ _ ->
+ %% Src isn't in the map so it doesn't have to be popped.
+ {SwitchInsn, NewMap1} = switch_first(Dst, NewMap0),
+ NewMap = pop(NewMap1),
+ {SwitchInsn ++ [#fp_unop{arg = Src, op = Op}] ++ pop_insn(), NewMap}
+ end.
+
+format_fp_binop(Op, Src = #x86_temp{}, Dst = #x86_fpreg{reg = Reg}) ->
+ %% Handle that st(0) is sometimes implicit.
+ if Reg =:= 0 -> [hipe_x86:mk_fp_unop(Op, Src)];
+ true -> [hipe_x86:mk_fp_binop(Op, Src, Dst)]
+ end;
+format_fp_binop(Op, Src, Dst) ->
+ [hipe_x86:mk_fp_binop(Op, Src, Dst)].
+
+in_map(X, Map) ->
+ lists:member(X, Map).
+
+push_list(L, Map) ->
+ push_list(L, Map, []).
+push_list([H|T], Map, Acc) ->
+ {Insn, NewMap} = push(H,Map),
+ push_list(T, NewMap, Acc++Insn);
+push_list([], Map, Acc) ->
+ {Acc, Map}.
+
+push(X, Map0) ->
+ {PopInsn, Map} =
+ if length(Map0) > 7 -> pop_a_temp(Map0);
+ true -> {[], Map0}
+ end,
+ NewX = get_new_opnd(X,Map),
+ NewMap = [X | Map],
+ PushOp = [hipe_x86:mk_fp_unop(fld, NewX)],
+ {PopInsn ++ PushOp, NewMap}.
+
+pop([_|Map]) ->
+ Map.
+
+pop_insn() ->
+ [hipe_x86:mk_fp_unop('fstp',mk_st(0))].
+
+pop_dead(Dead, Map) ->
+ Dead0 = [X || X <- Map, lists:member(X,Dead)],
+ pop_dead(Dead0, Map, []).
+
+pop_dead([D|Dead], Map, Code) ->
+ {I, NewMap0} = switch_first(D, Map),
+ NewMap = pop(NewMap0),
+ Store = case D of
+ #x86_temp{} -> [hipe_x86:mk_fp_unop('fstp', D)];
+ _ -> pop_insn()
+ end,
+ pop_dead(Dead, NewMap, Code++I++Store);
+pop_dead([], Map, Code) ->
+ {Code,Map}.
+
+pop_all(Map) ->
+ {Code, _} = pop_dead(Map, Map),
+ Code.
+
+pop_member(Member, Map) ->
+ {Head,[_|T]} = lists:splitwith(fun(X)-> X =/= Member end, Map),
+ {[hipe_x86:mk_fp_unop('fstp', mk_st(get_pos(Member, Map, 0)))],
+ Head++T}.
+
+pop_a_temp(Map) ->
+ Temp = find_a_temp(Map),
+ {SwitchInsn, NewMap0} = switch_first(Temp, Map),
+ NewMap = pop(NewMap0),
+ {SwitchInsn ++ [hipe_x86:mk_fp_unop('fstp', Temp)], NewMap}.
+
+find_a_temp([H = #x86_temp{}|_]) ->
+ H;
+find_a_temp([_|T]) ->
+ find_a_temp(T);
+find_a_temp([]) ->
+ ?EXIT({noTempOnFPStack,{}}).
+
+switch_first(X, Map = [H|_]) ->
+ Pos = get_pos(X, Map, 0),
+ case Pos of
+ 0 ->
+ {[], Map};
+ notFound ->
+ push(X, Map);
+ _ ->
+ {[_|Head], [_|Tail]} = lists:splitwith(fun(Y)-> Y =/= X end, Map),
+ NewMap = [X|Head] ++ [H|Tail],
+ Ins = hipe_x86:mk_fp_unop(fxch, mk_st(Pos)),
+ {[Ins], NewMap}
+ end;
+switch_first(X, Map) ->
+ push(X, Map).
+
+get_pos(X, [H|T], Pos) ->
+ if X =:= H -> Pos;
+ true -> get_pos(X, T, Pos+1)
+ end;
+get_pos(_, [], _) ->
+ notFound.
+
+get_new_opnd(X, Map) ->
+ I = get_pos(X, Map, 0),
+ case I of
+ notFound ->
+ %% The operand is probably a spilled float.
+ X;
+ _ ->
+ mk_st(I)
+ end.
+
+is_fp(#x86_fpreg{}) ->
+ true;
+is_fp(#x86_mem{type = Type}) ->
+ Type =:= 'double';
+is_fp(#x86_temp{type = Type}) ->
+ Type =:= 'double'.
+
+handle_insn(I) ->
+ case I of
+ #fmove{} -> true;
+ #fp_unop{} -> true;
+ #fp_binop{} -> true;
+ #pseudo_call{} ->true;
+ %% #ret{} -> true;
+ _ -> false
+ end.
+
+is_liveOut(X, LiveOut) ->
+ ordsets:is_element(X, LiveOut).
+
+mk_st(X) ->
+ hipe_x86:mk_fpreg(X, false).
+
+reverse_op(Op) ->
+ case Op of
+ 'fsub' -> 'fsubr';
+ 'fdiv' -> 'fdivr';
+ 'fsubr'-> 'fsub';
+ 'fdivr' -> 'fdiv';
+ _ -> Op
+ end.
+
+mk_op_pop(Op) ->
+ case Op of
+ 'fadd'-> 'faddp';
+ 'fdiv' -> 'fdivp';
+ 'fdivr' -> 'fdivrp';
+ 'fmul' -> 'fmulp';
+ 'fsub' -> 'fsubp';
+ 'fsubr' -> 'fsubrp';
+ _ -> ?EXIT({operandHasNoPopVariant,{Op}})
+ end.
+
+butlast([X|Xs]) -> butlast(Xs,X).
+
+butlast([],_) -> [];
+butlast([X|Xs],Y) -> [Y|butlast(Xs,X)].
+
+%%pp_insn(Op, Src, Dst) ->
+%% pp([hipe_x86:mk_fp_binop(Op, Src, Dst)]).
+
+%%pp([I|Ins]) ->
+%% hipe_x86_pp:pp_insn(I),
+%% pp(Ins);
+%%pp([]) ->
+%% [].
+
+pseudo_pop(Map) when length(Map) > 0 ->
+ Dst = hipe_x86:mk_new_temp('double'),
+ pseudo_pop(Dst, length(Map), []);
+pseudo_pop(_) ->
+ [].
+
+pseudo_pop(Dst, St, Acc) when St > 1 ->
+ %% Store all members of the stack to a single temporary to force
+ %% any floating point overflow exceptions to occur even though we
+ %% don't have overflow for the extended double precision in the x87.
+ pseudo_pop(Dst, St-1,
+ [hipe_x86:mk_fp_unop('fxch', mk_st(St-1)),
+ hipe_x86:mk_fp_unop('fst', Dst),
+ hipe_x86:mk_fp_unop('fxch', mk_st(St-1))
+ |Acc]);
+pseudo_pop(Dst, _St, Acc) ->
+ [hipe_x86:mk_fp_unop('fst', Dst)|Acc].
--
cgit v1.2.3