Fil-C on Nix

Filnix wiki

the formal campaign

rocq/backend/Regs.v

# Whole-function register allocation and selection

A simple, loop-weighted interval register allocator and direct register emitter for the Gallina backend (M7 of docs/gallina-backend.md). It takes the func and plan that Validate.v and Abi.v produce, numbers the temporaries into nat identifiers so inner loops avoid term and string comparisons, assigns integer (w, l) temporaries and pointer (p) address words to the seven allocatable general registers (%r10, %r11, %rbx, %r12–%r15), checks the assignment with an executable validator (valid_alloc, proved sound in RegsProof.v), resolves phi edges by parallel moves without shadow slots, and selects scalar and address operations straight into their assigned registers.

Pointer lowers stay in their lowers[ ] frame roots so the collector scans every live capability at every safepoint, and temporaries live across any returning call take only callee-saved registers (%rbx, %r12–%r15), saved after the stack check and restored before every leave.

From Stdlib Require Import String ZArith List Bool Arith
From Nanofil Require Import Term Syntax Validate Maps Cfg
From Backend Require Import Text Asm Order Plan Fuse FrameSlots Abi PlanTerm Layout EmitOps EmitInst EmitObject Emit EmitData EmitThunk EmitModule
Import ListNotations
Open Scope string_scope
Open Scope Z_scope
Open Scope list_scope

Allocatable registers

The seven general registers available for register homes: two caller-saved (%r10, %r11) and five callee-saved (%rbx, %r12–%r15), all disjoint from the emitter's scratch registers (%rax, %rcx, %rdx, %rsi, %rdi, %r8, %r9).

37Inductive hreg: Type ≔
|HR10
|HR11
|HRbx
|HR12
|HR13
|HR14
|HR15

Equality of hregs.

47Definition hreg_eqba b : hreg : bool ≔
match a, b with
⇒
true
_, _
⇒
false

Whether r is preserved across SysV / Fil-C calls.

55Definition hreg_callee_savedr : hreg : bool ≔
match r with
⇒
false
⇒
true

The five callee-saved registers, in prologue save order.

62Definition callee_saved_hregs: listhreg ≔

The caller-saved registers, tried first for non-call-crossing temporaries so callee-saved registers remain free across calls.

66Definition caller_saved_hregs: listhreg ≔

All seven allocatable registers.

69Definition all_hregs: listhreg ≔

64-bit AT&T name of r.

72Definition hreg64r : hreg : string ≔
match r with
⇒
"r10"
⇒
"r11"
⇒
"rbx"
⇒
"r12"
⇒
"r13"
⇒
"r14"
⇒
"r15"

32-bit AT&T name of r.

79Definition hreg32r : hreg : string ≔
match r with
⇒
"r10d"
⇒
"r11d"
⇒
"ebx"
⇒
"r12d"
⇒
"r13d"
⇒
"r14d"
⇒
"r15d"

16-bit AT&T name of r.

86Definition hreg16r : hreg : string ≔
match r with
⇒
"r10w"
⇒
"r11w"
⇒
"bx"
⇒
"r12w"
⇒
"r13w"
⇒
"r14w"
⇒
"r15w"

8-bit AT&T name of r.

93Definition hreg8r : hreg : string ≔
match r with
⇒
"r10b"
⇒
"r11b"
⇒
"bl"
⇒
"r12b"
⇒
"r13b"
⇒
"r14b"
⇒
"r15b"

Name of r at 32 bits (half = true) or 64 bits (half = false).

100Definition hreg_atr : hreg half : bool : string ≔
half
→
else

Name of r at store width w.

104Definition hreg_widthr : hreg w : width : optionstring ≔
match w with
⇒
Somehreg8r
⇒
Somehreg16r
Ww | Ws
⇒
Somehreg32r
Wl | Wd
⇒
Somehreg64r
Wp | Wx
⇒
None

Tail-recursive nat sets and intervals

Fast nat comparisons through Nat.compare, avoiding Peano subtraction in extracted code.

117Definition nat_eqba b : nat : bool ≔
match Nat.comparea b with
_
⇒
false
120Definition nat_ltba b : nat : bool ≔
match Nat.comparea b with
_
⇒
false
123Definition nat_leba b : nat : bool ≔
match Nat.comparea b with
⇒
false
_
⇒
true
126Definition nat_maxa b : nat : nat ≔
→
b
else
a
129Definition nat_mina b : nat : nat ≔
→
a
else
b

Membership in a sorted listnat.

133Fixpoint nset_memx : nat xs : listnat : bool ≔
match xs with
[ ]
⇒
false
y :: xs′
⇒
match Nat.comparex y with

Equality of two sorted listnat ordsets.

145Fixpoint nset_eqbxs ys : listnat : bool ≔
match xs, ys with
[ ], [ ]
⇒
true
x :: xs′, y :: ys′
⇒
→
nset_eqbxs′ ys′
else
false
_, _
⇒
false

Tail-recursive union accumulator for sorted listnats.

153Fixpoint nset_union_accfuel : nat xs ys acc : listnat : listnat ≔
match xs, ys with
[ ], _
⇒
rev_appendacc ys
_, [ ]
⇒
rev_appendacc xs
x :: xs′, y :: ys′
⇒
match fuel with
O
⇒
rev_appendacc xs ++ ys
Sfuel′
⇒
match Nat.comparex y with
⇒
nset_union_accfuel′ xs′ ys x :: acc
⇒
nset_union_accfuel′ xs′ ys′ x :: acc
⇒
nset_union_accfuel′ xs ys′ y :: acc
169Definition nset_unionxs ys : listnat : listnat ≔
nset_union_acclengthxs + lengthys xs ys [ ]

Tail-recursive difference accumulator for sorted listnats.

173Fixpoint nset_sub_accfuel : nat xs ys acc : listnat : listnat ≔
match xs, ys with
[ ], _
⇒
rev'acc
_, [ ]
⇒
rev_appendacc xs
x :: xs′, y :: ys′
⇒
match fuel with
O
⇒
rev_appendacc xs
Sfuel′
⇒
match Nat.comparex y with
⇒
nset_sub_accfuel′ xs′ ys x :: acc
⇒
nset_sub_accfuel′ xs′ ys′ acc
⇒
nset_sub_accfuel′ xs ys′ acc
189Definition nset_subxs ys : listnat : listnat ≔
nset_sub_acclengthxs + lengthys xs ys [ ]

Sort and deduplicate a listnat.

193Definition nset_of_listxs : listnat : listnat ≔
sortNat.compare xs

Insert one nat into a sorted listnat.

197Definition nset_addx : nat xs : listnat : listnat ≔

A closed live interval [lo, hi] with lo ≤ hi.

201Definition ival: Type ≔
nat × nat%type

Whether two sorted lists of disjoint closed intervals have no point in common.

205Fixpoint ivals_disjoint_fuelfuel : nat xs ys : listival : bool ≔
match xs, ys with
[ ], _
⇒
true
_, [ ]
⇒
true
a1, b1 :: xs′, a2, b2 :: ys′
⇒
match fuel with
O
⇒
false
Sfuel′
⇒
nat_ltbb1 a2
→
ivals_disjoint_fuelfuel′ xs′ ys
nat_ltbb2 a1
→
ivals_disjoint_fuelfuel′ xs ys′
else
false
219Definition ivals_disjointxs ys : listival : bool ≔
ivals_disjoint_fuellengthxs + lengthys xs ys

Push interval iv onto reversed coalesced accumulator acc, where iv starts no earlier than the head of acc.

224Definition ival_push_acciv : ival acc : listival : listival ≔
match acc with
[ ]
⇒
iv
a0, b0 :: acc′
⇒
nat_lebfstiv Sb0
→
a0, nat_maxb0 sndiv :: acc′
else
iv :: acc

Tail-recursive merge and coalescing of two sorted interval lists.

234Fixpoint ivals_union_accfuel : nat xs ys acc : listival : listival ≔
match xs, ys with
[ ], [ ]
⇒
rev'acc
_, _
⇒
match fuel with
O
⇒
rev'acc
Sfuel′
⇒
match xs, ys with
[ ], [ ]
⇒
rev'acc
[ ], y :: ys′
⇒
ivals_union_accfuel′ [ ] ys′ ival_push_accy acc
x :: xs′, [ ]
⇒
ivals_union_accfuel′ xs′ [ ] ival_push_accx acc
a1, _ as x :: xs′, a2, _ as y :: ys′
⇒
nat_leba1 a2
→
ivals_union_accfuel′ xs′ ys ival_push_accx acc
else
ivals_union_accfuel′ xs ys′ ival_push_accy acc
253Definition ivals_unionxs ys : listival : listival ≔
ivals_union_acclengthxs + lengthys xs ys [ ]

Whether any point in sorted pts lies inside sorted intervals ivs.

257Fixpoint ivals_hit_points_fuelfuel : nat ivs : listival pts : listnat : bool ≔
match ivs, pts with
[ ], _
⇒
false
_, [ ]
⇒
false
a, b :: ivs′, p :: pts′
⇒
match fuel with
O
⇒
true
Sfuel′
⇒
→
ivals_hit_points_fuelfuel′ ivs′ pts
→
ivals_hit_points_fuelfuel′ ivs pts′
else
true
271Definition ivals_hit_pointsivs : listival pts : listnat : bool ≔
ivals_hit_points_fuellengthivs + lengthpts ivs pts

ZMap keyed by nat via Z.of_nat.

275Definition zmap_find_natA : Type k : nat m : ZMap.tA : optionA ≔
ZMap.findZ.of_natk m
278Definition zmap_add_natA : Type k : nat v : A m : ZMap.tA : ZMap.tA ≔
ZMap.addZ.of_natk v m

Plan uses, defs, calls and adjacent elisions

283Definition is_atomic_reade : effect : bool ≔
match e with
⇒
true
_
⇒
false

How an instruction invokes helper or target calls.

287Inductive rcall: Type ≔
|RCallNone
|RCallAfterReads
|RCallDuringReads

Temporary reads in a fast-call word.

300Definition word_usesw : word : listname ≔
match w with
Wf_ _
⇒
[ ]
306Fixpoint words_uses_accws : listword acc : listname : listname ≔
match ws with
[ ]
⇒
rev'acc
w :: ws′
⇒
words_uses_accws′ rev_appendword_usesw acc

Temporary reads in a generic cell.

313Definition cell_usesc : cell : listname ≔
match c with
Cell_ _ s lw
⇒
let u1 ≔
match s with
in
let u2 ≔
match lw with
_
⇒
[ ]
in
u1 ++ u2
321Fixpoint cells_uses_acccs : listcell acc : listname : listname ≔
match cs with
[ ]
⇒
rev'acc
c :: cs′
⇒
cells_uses_acccs′ rev_appendcell_usesc acc

Temporary definitions in call result channels.

328Definition key_def_namesk : key : listname ≔
match k with
⇒
d
_
⇒
[ ]
334Fixpoint keys_defs_accks : listkey acc : listname : listname ≔
match ks with
[ ]
⇒
rev'acc
k :: ks′
⇒
keys_defs_accks′ rev_appendkey_def_namesk acc
340Fixpoint typed_keys_defs_accks : listclass × key acc : listname : listname ≔
match ks with
[ ]
⇒
rev'acc
_, k :: ks′
⇒
346Definition channels_defsc : channels : listname ≔
match c with

Uses, definitions and call kind of one action.

354Definition action_usesa : action : listname ≔
match a with
AInvoke_ _ ws
⇒
ADispatchp _ _ ws _ _ cells _ _
⇒
value_tempsp ++ words_uses_accws [ ] ++ cells_uses_acccells [ ]
_
⇒
[ ]
364Definition action_defsa : action : listname ≔
match a with
ADispatch_ _ _ _ c _ _ _ _
⇒
⇒
d
_
⇒
[ ]
372Definition action_calla : action : rcall ≔
match a with
379Fixpoint actions_uses_accacts : listaction acc : listname : listname ≔
match acts with
[ ]
⇒
rev'acc
a :: acts′
⇒
actions_uses_accacts′ rev_appendaction_usesa acc
385Fixpoint actions_defs_accacts : listaction acc : listname : listname ≔
match acts with
[ ]
⇒
rev'acc
a :: acts′
⇒
actions_defs_accacts′ rev_appendaction_defsa acc
391Fixpoint actions_callacts : listaction acc : rcall : rcall ≔
match acts with
[ ]
⇒
acc
a :: acts′
⇒
397Definition access_calla : access : rcall ≔
405Definition pinst_usespi : pinst : listname ≔
match pi with
411Definition pinst_defspi : pinst : listname ≔
match pi with
⇒
mapfst finst_defsfi
PAbiacts
⇒
426Definition pjump_usesj : pjump : listname ≔
435Definition pjump_targetsj : pjump : listtarget ≔
match j with
_
⇒
[ ]

Count every read of a temporary across all blocks of a plan.

442Definition bump_name_countm : nmapZ n : name : nmapZ ≔
match nm_findn m with
Somec
⇒
c + 1
None
⇒
1
m
445Fixpoint bump_names_countns : listname m : nmapZ : nmapZ ≔
match ns with
[ ]
⇒
m
n :: ns′
⇒
451Fixpoint count_phi_pairsps : listname × value m : nmapZ : nmapZ ≔
match ps with
[ ]
⇒
m
_, Tmpn :: ps′
⇒
_, _ :: ps′
⇒
458Fixpoint count_phis_readsphis : listphi m : nmapZ : nmapZ ≔
match phis with
[ ]
⇒
m
Phi_ _ ps :: phis′
⇒
464Fixpoint count_pinsts_readspis : listpinst m : nmapZ : nmapZ ≔
match pis with
[ ]
⇒
m
470Fixpoint plan_read_counts_accbs : listpblock m : nmapZ : nmapZ ≔
match bs with
[ ]
⇒
m
b :: bs′
⇒
480Definition name_readsn : name reads : nmapZ : Z ≔
match nm_findn reads with
Somec
⇒
c
None
⇒
0

Expanded block instructions and jumps after recognizing adjacent single-use Flight → FFused, Cmp → JBranch, and integer Let → Cmp → JBranch pairs.

486Inductive einst: Type ≔
|EPlain
idx : Z pi : pinst
|EFlightFused
idx1 idx2 : Z d : name o : op args : listflight_arg lw : flight_lower ck : check_kind a : access
491Inductive ejump: Type ≔
|EJumpPlain
j : pjump
|EJumpCmp
c : cond ck : class x y : value t f : target
|EJumpLetCmp
d1 : name k1 : class o1 : op args1 : listvalue c : cond ck : class y : value t f : target
497Record eblock: Type ≔ mkEBlock
eb_label
 : name
eb_phis
 : listphi
eb_insts
 : listeinst
eb_jump
 : ejump

Non-place uses of an access (its stored value, if any).

505Definition access_value_usesa : access : listname ≔
match a with
AStore_ _ v _ | AStorePointer_ v _ _
⇒
_
⇒
[ ]
511Definition flight_usesargs : listflight_arg lw : flight_lower : listname ≔
++
match lw with
⇒
p
⇒
[ ]
515Definition einst_usesei : einst : listname ≔
match ei with
EFlightFused_ _ _ _ args lw _ a
⇒
521Definition einst_defsei : einst : listname ≔
match ei with
EFlightFused_ _ _ _ _ _ _ a
⇒
mapfst access_defsa
527Definition einst_callei : einst : rcall ≔
match ei with
EFlightFused_ _ _ _ _ _ _ a
⇒
533Definition ejump_usesej : ejump : listname ≔
match ej with
EJumpCmp_ _ x y _ _
⇒
EJumpLetCmp_ _ _ args1 _ _ y _ _
⇒
540Definition ejump_targetsej : ejump : listtarget ≔
match ej with
EJumpCmp_ _ _ _ t f | EJumpLetCmp_ _ _ _ _ _ _ t f
⇒
t; f

Whether o at integer class k computes directly into %rax without calls or float state.

548Definition simple_int_opo : op k : class : bool ≔
match k with
W | L
⇒
→
false
else
match o with
Add | Sub | Mul | And | Or | Xor | Shl | Shr | Sar | Neg | Copy | Ptoi | Ext_
⇒
true
_
⇒
false
_
⇒
false
560Definition let_cmp_class_okk1 ck : class : bool ≔
match k1, ck with
W, W | L, L | L, W
⇒
true
_, _
⇒
false

Try to fuse a single-use Flight with an immediately following non-calling heap FFused access at that pointer.

568Definition try_fuse_flightreads : nmapZ i1 : Z pi1 : pinst i2 : Z pi2 : pinst : optioneinst ≔
match pi1, pi2 with
PInstFPlainFlightd o args lw, PInstFFusedCheck0 size r al a
⇒
let same_ptr ≔
match access_placea with
⇒
name_eqbd d′
_
⇒
false
in
let no_call ≔
match access_calla with
⇒
true
_
⇒
false
in
same_ptr && no_call && name_readsd reads =? 1 && negbname_eqbd va_snapshot
→
SomeEFlightFusedi1 i2 d o args lw mkKindsize rights_writer al a
else
None
_, _
⇒
None
587Fixpoint build_einsts_revreads : nmapZ idx : Z pis : listpinst acc : listeinst : listeinst ≔
match pis with
[ ]
⇒
acc
pi1 :: rest
⇒
match rest with
pi2 :: rest′
⇒
match try_fuse_flightreads idx pi1 idx + 1 pi2 with
Someef
⇒
build_einsts_revreads idx + 2 rest′ ef :: acc
None
⇒
build_einsts_revreads idx + 1 rest EPlainidx pi1 :: acc
[ ]
⇒
EPlainidx pi1 :: acc
602Definition build_eblockreads : nmapZ b : pblock : eblock ≔
let rev_is ≔ build_einsts_revreads 0 pb_instsb [ ] in
match pb_jumpb, rev_is with
PJumpJBranchTmpdc t f, EPlain_ PInstFPlainLetdc′ W Cmpc ck x; y :: rev_rest
⇒
let ok_cmp ≔
name_eqbdc dc′
&&
match ck with
W | L
⇒
true
_
⇒
false
&&
name_readsdc reads =? 1
&&
in
ok_cmp
→
match x, rev_rest with
Tmpd1, EPlain_ PInstFPlainLetd1′ k1 o1 args1 :: rev_rest2
⇒
name_eqbd1 d1′ && let_cmp_class_okk1 ck && simple_int_opo1 k1 && name_readsd1 reads =? 1 && negbname_eqbd1 va_snapshot
→
mkEBlockpb_labelb pb_phisb rev'rev_rest2 EJumpLetCmpd1 k1 o1 args1 c ck y t f
else
mkEBlockpb_labelb pb_phisb rev'rev_rest EJumpCmpc ck x y t f
_, _
⇒
mkEBlockpb_labelb pb_phisb rev'rev_rest EJumpCmpc ck x y t f
633Fixpoint build_eblocks_accreads : nmapZ bs : listpblock acc : listeblock : listeblock ≔
match bs with
[ ]
⇒
rev'acc
b :: bs′
⇒
build_eblocks_accreads bs′ build_eblockreads b :: acc

Numbered CFG representation

642Record rinst: Type ≔ mkRInst
ri_uses
 : listnat
ri_defs
 : listnat
ri_call
 : rcall
648Record rblock: Type ≔ mkRBlock
rb_idx
 : nat
rb_succs
 : listnat × bool
rb_phis
 : listnat × listnat × optionnat
rb_insts
 : listrinst
rb_jump_uses
 : listnat

Class table and numbering of temporaries defined in f.

657Definition record_temp_defst : nmapnat × ZMap.tclass × listname × nat d : name k : class : nmapnat × ZMap.tclass × listname × nat ≔
let 'tmap, cmap, rev_names, next ≔ st in
nm_memd tmap
→
st
else
nm_addd next tmap, zmap_add_natnext k cmap, d :: rev_names, Snext
664Fixpoint number_paramsps : listclass × name st : nmapnat × ZMap.tclass × listname × nat : nmapnat × ZMap.tclass × listname × nat ≔
match ps with
[ ]
⇒
st
k, d :: ps′
⇒
672Fixpoint number_phisphis : listphi st : nmapnat × ZMap.tclass × listname × nat : nmapnat × ZMap.tclass × listname × nat ≔
match phis with
[ ]
⇒
st
Phid k _ :: phis′
⇒
680Fixpoint number_inst_defsds : listname × class st : nmapnat × ZMap.tclass × listname × nat : nmapnat × ZMap.tclass × listname × nat ≔
match ds with
[ ]
⇒
st
d, k :: ds′
⇒
688Fixpoint number_block_instsis : listinst st : nmapnat × ZMap.tclass × listname × nat : nmapnat × ZMap.tclass × listname × nat ≔
match is with
[ ]
⇒
st
696Fixpoint number_func_blocksbs : listblock st : nmapnat × ZMap.tclass × listname × nat : nmapnat × ZMap.tclass × listname × nat ≔
match bs with
[ ]
⇒
st
b :: bs′
⇒
let st1 ≔ number_phisb_phisb st in
let st2 ≔ number_block_instsb_instsb st1 in
707Fixpoint number_eblocks_labelsebs : listeblock idx : nat m : nmapnat : nmapnat ≔
match ebs with
[ ]
⇒
m
eb :: ebs′
⇒
let m′ ≔
else
in
number_eblocks_labelsebs′ Sidx m′
715Fixpoint names_to_tids_acctmap : nmapnat ns : listname acc : listnat : listnat ≔
match ns with
[ ]
⇒
rev'acc
n :: ns′
⇒
match nm_findn tmap with
Someid
⇒
names_to_tids_acctmap ns′ id :: acc
None
⇒
names_to_tids_acctmap ns′ acc
725Definition names_to_tidstmap : nmapnat ns : listname : listnat ≔
728Fixpoint targets_to_succs_accbmap : nmapnat ts : listtarget acc : listnat × bool : listnat × bool ≔
match ts with
[ ]
⇒
rev'acc
t :: ts′
⇒
let poll ≔
match t with
⇒
true
⇒
false
in
match nm_findedge_labelt bmap with
Somebi
⇒
targets_to_succs_accbmap ts′ bi, poll :: acc
None
⇒
targets_to_succs_accbmap ts′ acc
740Fixpoint phi_pairs_to_r_acctmap bmap : nmapnat ps : listname × value acc : listnat × optionnat : listnat × optionnat ≔
match ps with
[ ]
⇒
rev'acc
lbl, v :: ps′
⇒
match nm_findlbl bmap with
Somebi
⇒
let sv ≔
match v with
⇒
nm_findn tmap
_
⇒
None
in
phi_pairs_to_r_acctmap bmap ps′ bi, sv :: acc
None
⇒
phi_pairs_to_r_acctmap bmap ps′ acc
753Fixpoint phis_to_r_acctmap bmap : nmapnat phis : listphi acc : listnat × listnat × optionnat : listnat × listnat × optionnat ≔
match phis with
[ ]
⇒
rev'acc
Phid _ ps :: phis′
⇒
match nm_findd tmap with
Sometid
⇒
phis_to_r_acctmap bmap phis′ tid, phi_pairs_to_r_acctmap bmap ps [ ] :: acc
None
⇒
phis_to_r_acctmap bmap phis′ acc
766Fixpoint einsts_to_r_acctmap : nmapnat eis : listeinst acc : listrinst : listrinst ≔
match eis with
[ ]
⇒
rev'acc
ei :: eis′
⇒
einsts_to_r_acctmap eis′ ri :: acc
776Fixpoint eblocks_to_r_acctmap bmap : nmapnat idx : nat ebs : listeblock acc : listrblock : listrblock ≔
match ebs with
[ ]
⇒
rev'acc
eb :: ebs′
⇒
eblocks_to_r_acctmap bmap Sidx ebs′ rb :: acc

Liveness over numbered blocks

791Definition nset_atk : nat m : ZMap.tlistnat : listnat ≔
match zmap_find_natk m with
Somes
⇒
s
None
⇒
[ ]

Keep only temporaries belonging to keep (None keeps all).

795Fixpoint filter_keep_acckeep : optionZMap.tunit xs acc : listnat : listnat ≔
match xs with
[ ]
⇒
rev'acc
x :: xs′
⇒
let ok ≔
match keep with
None
⇒
true
Somekm
⇒
match zmap_find_natx km with
Some_
⇒
true
None
⇒
false
in
ok
→
filter_keep_acckeep xs′ x :: acc
else
filter_keep_acckeep xs′ acc

Phi sources read on the edge pred_bi → rb.

808Fixpoint lookup_phi_edge_srcpred_bi : nat ps : listnat × optionnat : optionnat ≔
match ps with
[ ]
⇒
None
bi, sv :: ps′
⇒
nat_eqbbi pred_bi
→
sv
else
lookup_phi_edge_srcpred_bi ps′
815Fixpoint rblock_phi_edge_uses_acckeep : optionZMap.tunit pred_bi : nat phis : listnat × listnat × optionnat acc : listnat : listnat ≔
match phis with
[ ]
⇒
_, ps :: phis′
⇒
match lookup_phi_edge_srcpred_bi ps with
Sometid
⇒
let kept ≔ filter_keep_acckeep tid [ ] in
rblock_phi_edge_uses_acckeep pred_bi phis′ rev_appendkept acc
None
⇒
rblock_phi_edge_uses_acckeep pred_bi phis′ acc
829Fixpoint rblock_phi_defs_acckeep : optionZMap.tunit phis : listnat × listnat × optionnat acc : listnat : listnat ≔
match phis with
[ ]
⇒
d, _ :: phis′
⇒
let kept ≔ filter_keep_acckeep d [ ] in
rblock_phi_defs_acckeep phis′ rev_appendkept acc

Gen and Kill of one rblock.

840Fixpoint gk_uses_stepuses : listnat defs : ZMap.tunit gen : listnat : listnat ≔
match uses with
[ ]
⇒
gen
u :: uses′
⇒
match zmap_find_natu defs with
Some_
⇒
gk_uses_stepuses′ defs gen
None
⇒
gk_uses_stepuses′ defs u :: gen
850Fixpoint gk_defs_stepds : listnat defs : ZMap.tunit kill : listnat : ZMap.tunit × listnat ≔
match ds with
[ ]
⇒
defs, kill
d :: ds′
⇒
gk_defs_stepds′ zmap_add_natd tt defs d :: kill
857Fixpoint gk_insts_stepkeep : optionZMap.tunit ris : listrinst defs : ZMap.tunit gen kill : listnat : ZMap.tunit × listnat × listnat ≔
match ris with
[ ]
⇒
defs, gen, kill
ri :: ris′
⇒
let us ≔ filter_keep_acckeep ri_usesri [ ] in
let ds ≔ filter_keep_acckeep ri_defsri [ ] in
let gen1 ≔ gk_uses_stepus defs gen in
let 'defs1, kill1 ≔ gk_defs_stepds defs kill in
gk_insts_stepkeep ris′ defs1 gen1 kill1
870Definition rblock_gen_killkeep : optionZMap.tunit rb : rblock : listnat × listnat ≔
let pdefs ≔ rblock_phi_defs_acckeep rb_phisrb [ ] in
let 'defs0, kill0 ≔ gk_defs_steppdefs ZMap.emptyunit [ ] in
let 'defs1, gen1, kill1 ≔ gk_insts_stepkeep rb_instsrb defs0 [ ] kill0 in
let juses ≔ filter_keep_acckeep rb_jump_usesrb [ ] in
let gen2 ≔ gk_uses_stepjuses defs1 gen1 in
879Fixpoint build_gk_mapkeep : optionZMap.tunit rbs : listrblock m : ZMap.tlistnat × listnat : ZMap.tlistnat × listnat ≔
match rbs with
[ ]
⇒
m
rb :: rbs′
⇒
887Fixpoint build_rb_maprbs : listrblock m : ZMap.trblock : ZMap.trblock ≔
match rbs with
[ ]
⇒
m
rb :: rbs′
⇒

LiveOut and LiveAcross of block bi given live_in.

894Fixpoint succs_live_outkeep : optionZMap.tunit rbm : ZMap.trblock live_in : ZMap.tlistnat bi : nat succs : listnat × bool out across : listnat : listnat × listnat ≔
match succs with
[ ]
⇒
out, across
si, _ :: succs′
⇒
let lin ≔ nset_atsi live_in in
let across1 ≔ nset_unionacross lin in
let euses ≔
match zmap_find_natsi rbm with
Somesrb
⇒
None
⇒
[ ]
in
succs_live_outkeep rbm live_in bi succs′ nset_unionnset_unionout lin euses across1
911Fixpoint rlive_round_blockskeep : optionZMap.tunit rbm : ZMap.trblock gkm : ZMap.tlistnat × listnat rev_rbs : listrblock live_in : ZMap.tlistnat changed : bool : ZMap.tlistnat × bool ≔
match rev_rbs with
[ ]
⇒
live_in, changed
rb :: rest
⇒
let bi ≔ rb_idxrb in
let 'out, _ ≔ succs_live_outkeep rbm live_in bi rb_succsrb [ ] [ ] in
match zmap_find_natbi gkm with
Somegen, kill
⇒
let new_in ≔ nset_uniongen nset_subout kill in
nset_eqbnset_atbi live_in new_in
→
rlive_round_blockskeep rbm gkm rest live_in changed
else
rlive_round_blockskeep rbm gkm rest zmap_add_natbi new_in live_in true
None
⇒
rlive_round_blockskeep rbm gkm rest live_in changed
931Fixpoint rlive_roundsfuel : nat keep : optionZMap.tunit rbm : ZMap.trblock gkm : ZMap.tlistnat × listnat rev_rbs : listrblock live_in : ZMap.tlistnat : ZMap.tlistnat × bool ≔
match fuel with
O
⇒
rlive_round_blockskeep rbm gkm rev_rbs live_in false
Sfuel′
⇒
let r ≔ rlive_roundsfuel′ keep rbm gkm rev_rbs live_in in
sndr
→
rlive_roundsfuel′ keep rbm gkm rev_rbs fstr
else
r
941Fixpoint build_out_across_mapskeep : optionZMap.tunit rbm : ZMap.trblock live_in : ZMap.tlistnat rbs : listrblock outs across : ZMap.tlistnat : ZMap.tlistnat × ZMap.tlistnat ≔
match rbs with
[ ]
⇒
outs, across
rb :: rbs′
⇒
let bi ≔ rb_idxrb in
let 'o, a ≔ succs_live_outkeep rbm live_in bi rb_succsrb [ ] [ ] in
build_out_across_mapskeep rbm live_in rbs′ zmap_add_natbi o outs zmap_add_natbi a across

Compute live_in, live_out, live_across over rbs.

955Definition rblock_livenesskeep : optionZMap.tunit rbs : listrblock : optionZMap.tlistnat × ZMap.tlistnat × ZMap.tlistnat ≔
let rbm ≔ build_rb_maprbs ZMap.emptyrblock in
let gkm ≔ build_gk_mapkeep rbs ZMap.emptylistnat × listnat in
let rev_rbs ≔ rev'rbs in
let 'live_in, still_changing ≔ rlive_rounds40 keep rbm gkm rev_rbs ZMap.emptylistnat in
still_changing
→
None
else
let 'outs, across ≔ build_out_across_mapskeep rbm live_in rbs ZMap.emptylistnat ZMap.emptylistnat in
Somelive_in, outs, across

Executable allocation validator

Check that no two temporaries in ts are assigned the same hreg in rm.

971Fixpoint hreg_in_listr : hreg rs : listhreg : bool ≔
match rs with
[ ]
⇒
false
r′ :: rs′
⇒
hreg_eqbr r′
→
true
else
977Fixpoint no_dup_hregs_accrm : ZMap.threg ts : listnat seen : listhreg : bool ≔
match ts with
[ ]
⇒
true
t :: ts′
⇒
match zmap_find_natt rm with
None
⇒
no_dup_hregs_accrm ts′ seen
Somer
⇒
→
false
else
no_dup_hregs_accrm ts′ r :: seen
989Definition no_dup_hregsrm : ZMap.threg ts : listnat : bool ≔

Check that every mapped temporary in ts holds a callee-saved register.

994Fixpoint all_callee_savedrm : ZMap.threg ts : listnat : bool ≔
match ts with
[ ]
⇒
true
t :: ts′
⇒
match zmap_find_natt rm with
None
⇒
Somer
⇒

Backward check over the reversed instructions of one rblock.

1005Fixpoint check_rinsts_revrm : ZMap.threg keep : optionZMap.tunit rev_ris : listrinst live : listnat : optionlistnat ≔
match rev_ris with
[ ]
⇒
Somelive
ri :: rest
⇒
let ds ≔ nset_of_listfilter_keep_acckeep ri_defsri [ ] in
let us ≔ nset_of_listfilter_keep_acckeep ri_usesri [ ] in
→
None
else
let live_mid ≔ nset_sublive ds in
let call_ok1 ≔
match ri_callri with
_
⇒
true
in
negbcall_ok1
→
None
else
let live_before ≔ nset_unionlive_mid us in
let call_ok2 ≔
match ri_callri with
_
⇒
true
in
negbcall_ok2 && no_dup_hregsrm live_before
→
None
else
check_rinsts_revrm keep rest live_before
1032Fixpoint check_succs_pollsrm : ZMap.threg keep : optionZMap.tunit rbm : ZMap.trblock live_in : ZMap.tlistnat succs : listnat × bool : bool ≔
match succs with
[ ]
⇒
true
si, is_poll :: succs′
⇒
let lin ≔ nset_atsi live_in in
let pdefs ≔
match zmap_find_natsi rbm with
Somesrb
⇒
None
⇒
[ ]
in
let at_header ≔ nset_unionlin pdefs in
let ok ≔
no_dup_hregsrm at_header
&&
is_poll
→
all_callee_savedrm at_header
else
true
in
ok
→
check_succs_pollsrm keep rbm live_in succs′
else
false
1050Fixpoint check_rblocksrm : ZMap.threg keep : optionZMap.tunit rbm : ZMap.trblock live_in live_out : ZMap.tlistnat rbs : listrblock : bool ≔
match rbs with
[ ]
⇒
true
rb :: rbs′
⇒
let bi ≔ rb_idxrb in
let lout ≔ nset_atbi live_out in
let juses ≔ nset_of_listfilter_keep_acckeep rb_jump_usesrb [ ] in
let live_end ≔ nset_unionlout juses in
negbno_dup_hregsrm lout && no_dup_hregsrm live_end && check_succs_pollsrm keep rbm live_in rb_succsrb
→
false
else
match check_rinsts_revrm keep rev'rb_instsrb live_end with
None
⇒
false
Somelive_after_phis
⇒
let pdefs ≔ rblock_phi_defs_acckeep rb_phisrb [ ] in
no_dup_hregsrm nset_unionlive_after_phis pdefs
→
check_rblocksrm keep rbm live_in live_out rbs′
else
false
1075Fixpoint rm_domain_accels : listZ × hreg m : ZMap.tunit : ZMap.tunit ≔
match els with
[ ]
⇒
m
k, _ :: els′
⇒
rm_domain_accels′ ZMap.addk tt m
1081Fixpoint classes_eligibleels : listZ × hreg cmap : ZMap.tclass : bool ≔
match els with
[ ]
⇒
true
k, _ :: els′
⇒
match ZMap.findk cmap with
SomeW | L | P
⇒
classes_eligibleels′ cmap
_
⇒
false

Linear-time check that rm assigns only w, l or p-address temporaries, has no live register collision at any instruction, jump, phi header or entry, and assigns only callee-saved registers across calls and poll edges.

1095Definition valid_alloccmap : ZMap.tclass param_tids : listnat rbs : listrblock rm : ZMap.threg : bool ≔
let els ≔ ZMap.elementsrm in
match els with
[ ]
⇒
true
_
⇒
negbclasses_eligibleels cmap
→
false
else
let dom ≔ Somerm_domain_accels ZMap.emptyunit in
match rblock_livenessdom rbs with
None
⇒
false
Somelive_in, live_out, _
⇒
let rbm ≔ build_rb_maprbs ZMap.emptyrblock in
let ps ≔ nset_of_listfilter_keep_accdom param_tids [ ] in
let entry_ok ≔
match rbs with
[ ]
⇒
true
rb0 :: _
⇒
let lin0 ≔ nset_atrb_idxrb0 live_in in
match nset_sublin0 ps with
[ ]
⇒
_
⇒
false
in
entry_ok && check_rblocksrm dom rbm live_in live_out rbs

Loop depths, weights, exact intervals and priority coloring

Natural loop spans [sj, max_bi], one per loop header sj with a backward edge sj ≤ bi, so multiple continue edges to one header count as one loop rather than nested loops.

1128Fixpoint rblock_backedges_mapbi : nat succs : listnat × bool m : ZMap.tnat : ZMap.tnat ≔
match succs with
[ ]
⇒
m
sj, _ :: succs′
⇒
nat_lebsj bi
→
let hi ≔
match zmap_find_natsj m with
Someh0
⇒
nat_maxh0 bi
None
⇒
bi
in
else
1139Fixpoint collect_backedges_maprbs : listrblock m : ZMap.tnat : ZMap.tnat ≔
match rbs with
[ ]
⇒
m
1146Fixpoint loop_map_to_spansels : listZ × nat acc : listnat × nat : listnat × nat ≔
match els with
[ ]
⇒
acc
kz, hi :: els′
⇒
loop_map_to_spansels′ Z.to_natkz, hi :: acc
1153Definition collect_backedgesrbs : listrblock : listnat × nat ≔
loop_map_to_spansZMap.elementscollect_backedges_maprbs ZMap.emptynat [ ]
1156Fixpoint count_spanning_loopsbi : nat loops : listnat × nat cnt : nat : nat ≔
match loops with
[ ]
⇒
cnt
lo, hi :: loops′
⇒
nat_leblo bi && nat_lebbi hi
→
count_spanning_loopsbi loops′ Scnt
else
count_spanning_loopsbi loops′ cnt
1165Definition depth_weightd : nat : Z ≔
match d with
O
⇒
1
SO
⇒
4
SSO
⇒
16
SSSO
⇒
64
SSSSO
⇒
256
_
⇒
1024
1175Fixpoint build_block_weightsrbs : listrblock loops : listnat × nat m : ZMap.tZ : ZMap.tZ ≔
match rbs with
[ ]
⇒
m
rb :: rbs′
⇒
1184Definition add_weightt : nat w : Z wm : ZMap.tZ : ZMap.tZ ≔
let prev ≔
match zmap_find_natt wm with
Somev
⇒
v
None
⇒
0
in
zmap_add_natt prev + w wm
1188Fixpoint add_weights_listts : listnat w : Z wm : ZMap.tZ : ZMap.tZ ≔
match ts with
[ ]
⇒
wm
t :: ts′
⇒
1194Fixpoint add_weights_phi_pairsps : listnat × optionnat bwm : ZMap.tZ wm : ZMap.tZ : ZMap.tZ ≔
match ps with
[ ]
⇒
wm
pbi, Somestid :: ps′
⇒
let pw ≔
match zmap_find_natpbi bwm with
Somew
⇒
w
None
⇒
1
in
_, None :: ps′
⇒
1204Fixpoint add_weights_phisphis : listnat × listnat × optionnat w : Z bwm : ZMap.tZ wm : ZMap.tZ : ZMap.tZ ≔
match phis with
[ ]
⇒
wm
d, ps :: phis′
⇒
1212Fixpoint add_weights_rinstsris : listrinst w : Z wm : ZMap.tZ : ZMap.tZ ≔
match ris with
[ ]
⇒
wm
ri :: ris′
⇒
let wm1 ≔ add_weights_listri_usesri w wm in
let wm2 ≔ add_weights_listri_defsri w wm1 in
add_weights_rinstsris′ w wm2
1221Fixpoint compute_temp_weightsrbs : listrblock bwm : ZMap.tZ wm : ZMap.tZ : ZMap.tZ ≔
match rbs with
[ ]
⇒
wm
rb :: rbs′
⇒
let w ≔
match zmap_find_natrb_idxrb bwm with
Somev
⇒
v
None
⇒
1
in
let wm1 ≔ add_weights_phisrb_phisrb w bwm wm in
let wm2 ≔ add_weights_rinstsrb_instsrb w wm1 in
let wm3 ≔ add_weights_listrb_jump_usesrb w wm2 in
compute_temp_weightsrbs′ bwm wm3

Phi partner edges so loop induction variables coalesce with their step temporaries.

1235Definition add_partnera b : nat pm : ZMap.tlistnat : ZMap.tlistnat ≔
→
pm
1239Fixpoint record_phi_pair_partnersd : nat ps : listnat × optionnat pm : ZMap.tlistnat : ZMap.tlistnat ≔
match ps with
[ ]
⇒
pm
_, Somes :: ps′
⇒
_, None :: ps′
⇒
1248Fixpoint record_phis_partnersphis : listnat × listnat × optionnat pm : ZMap.tlistnat : ZMap.tlistnat ≔
match phis with
[ ]
⇒
pm
d, ps :: phis′
⇒
1255Fixpoint collect_phi_partnersrbs : listrblock pm : ZMap.tlistnat : ZMap.tlistnat ≔
match rbs with
[ ]
⇒
pm

Cap candidate set to the top 512 weighted eligible temporaries so pathological multi-thousand-temporary functions stay fast.

1264Definition candidate_cap: nat ≔
512%nat
1266Definition eligible_classk : class : bool ≔
match k with
W | L | P
⇒
true
_
⇒
false
1269Fixpoint collect_eligible_weightedels : listZ × class va_tid : optionnat wm : ZMap.tZ acc : listZ × nat : listZ × nat ≔
match els with
[ ]
⇒
acc
kz, cl :: els′
⇒
let tid ≔ Z.to_natkz in
let is_va ≔
match va_tid with
Somevt
⇒
nat_eqbtid vt
None
⇒
false
in
eligible_classcl && negbis_va
→
let w ≔
match ZMap.findkz wm with
Somev
⇒
v
None
⇒
0
in
w >? 0
→
collect_eligible_weightedels′ va_tid wm w, tid :: acc
else
collect_eligible_weightedels′ va_tid wm acc
else
collect_eligible_weightedels′ va_tid wm acc

Sort weight, tid descending by weight, ties broken by smaller tid.

1285Definition weighted_tid_cmpa b : Z × nat : Datatypes.comparison ≔
match Z.comparefstb fsta with
⇒
Nat.comparesnda sndb
c
⇒
c
1291Fixpoint take_candidates_accn : nat xs : listZ × nat km : ZMap.tunit acc : listnat : ZMap.tunit × listnat ≔
match n, xs with
O, _ | _, [ ]
⇒
km, rev'acc
Sn′, _, tid :: xs′
⇒
take_candidates_accn′ xs′ zmap_add_nattid tt km tid :: acc

Build per-block [lo, hi] live sub-intervals and call-crossing flags over keep.

1302Definition touch_lo_hipt : nat t : nat lh : ZMap.tnat × nat : ZMap.tnat × nat ≔
match zmap_find_natt lh with
None
⇒
zmap_add_natt pt, pt lh
Somelo, hi
⇒
1309Fixpoint touch_list_lo_hipt : nat ts : listnat lh : ZMap.tnat × nat : ZMap.tnat × nat ≔
match ts with
[ ]
⇒
lh
t :: ts′
⇒
1316Fixpoint scan_rinsts_pointskeep : optionZMap.tunit pt : nat ris : listrinst lh : ZMap.tnat × nat calls : listnat : nat × ZMap.tnat × nat × listnat ≔
match ris with
[ ]
⇒
pt, lh, calls
ri :: ris′
⇒
let us ≔ filter_keep_acckeep ri_usesri [ ] in
let ds ≔ filter_keep_acckeep ri_defsri [ ] in
let p_use0 ≔ pt in
let p_call1 ≔ Spt in
let p_call2 ≔ SSpt in
let p_def ≔ SSSpt in
let lh1 ≔ touch_list_lo_hip_use0 us lh in
let lh2 ≔
match ri_callri with
_
⇒
lh1
in
let lh3 ≔ touch_list_lo_hip_def ds lh2 in
let calls1 ≔
match ri_callri with
⇒
calls
⇒
p_call2 :: calls
⇒
p_call2 :: p_call1 :: calls
in
scan_rinsts_pointskeep Sp_def ris′ lh3 calls1
1344Fixpoint mark_true_listts : listnat m : ZMap.tbool : ZMap.tbool ≔
match ts with
[ ]
⇒
m
t :: ts′
⇒
1350Fixpoint mark_poll_succskeep : optionZMap.tunit rbm : ZMap.trblock live_in : ZMap.tlistnat bi : nat succs : listnat × bool p_phi_read : nat lh : ZMap.tnat × nat poll_cross : ZMap.tbool : ZMap.tnat × nat × ZMap.tbool ≔
match succs with
[ ]
⇒
lh, poll_cross
si, is_poll :: succs′
⇒
let euses ≔
match zmap_find_natsi rbm with
Somesrb
⇒
None
⇒
[ ]
in
let lh1 ≔ touch_list_lo_hip_phi_read euses lh in
let poll_cross1 ≔
is_poll
→
let lin ≔ nset_atsi live_in in
let pdefs ≔
match zmap_find_natsi rbm with
Somesrb
⇒
None
⇒
[ ]
in
mark_true_listnset_unionlin pdefs poll_cross
else
poll_cross
in
mark_poll_succskeep rbm live_in bi succs′ p_phi_read lh1 poll_cross1
1378Fixpoint flush_block_lhels : listZ × nat × nat ivm : ZMap.tlistival : ZMap.tlistival ≔
match els with
[ ]
⇒
ivm
kz, seg :: els′
⇒
let prev ≔
match ZMap.findkz ivm with
Somel
⇒
l
None
⇒
[ ]
in
flush_block_lhels′ ZMap.addkz ivals_unionprev seg ivm
1387Fixpoint build_intervals_blockskeep : optionZMap.tunit rbm : ZMap.trblock live_in live_across : ZMap.tlistnat entry_params : listnat is_first : bool pt : nat rbs : listrblock ivm : ZMap.tlistival calls : listnat poll_cross : ZMap.tbool : ZMap.tlistival × listnat × ZMap.tbool ≔
match rbs with
[ ]
⇒
ivm, nset_of_listcalls, poll_cross
rb :: rbs′
⇒
let bi ≔ rb_idxrb in
let p_entry ≔ pt in
let lin ≔ nset_atbi live_in in
let pdefs ≔ rblock_phi_defs_acckeep rb_phisrb [ ] in
let init_ts ≔
is_first
→
nset_unionnset_unionlin pdefs entry_params
else
nset_unionlin pdefs
in
let lh0 ≔ touch_list_lo_hip_entry init_ts ZMap.emptynat × nat in
let 'pt1, lh1, calls1 ≔ scan_rinsts_pointskeep Sp_entry rb_instsrb lh0 calls in
let p_jump ≔ pt1 in
let p_phi_read ≔ Sp_jump in
let p_exit ≔ SSp_phi_read in
let juses ≔ filter_keep_acckeep rb_jump_usesrb [ ] in
let lh2 ≔ touch_list_lo_hip_jump juses lh1 in
let 'lh3, poll_cross1 ≔ mark_poll_succskeep rbm live_in bi rb_succsrb p_phi_read lh2 poll_cross in
let lacross ≔ nset_atbi live_across in
let lh4 ≔ touch_list_lo_hip_exit lacross lh3 in
let ivm1 ≔ flush_block_lhZMap.elementslh4 ivm in
build_intervals_blockskeep rbm live_in live_across [ ] false Sp_exit rbs′ ivm1 calls1 poll_cross1

Priority coloring state: per-register union of assigned intervals.

1421Definition reg_slots_state: Type ≔
listhreg × listival
1423Definition init_reg_slots: reg_slots_state ≔
mapλr ⇒ r, [ ] all_hregs
1426Fixpoint lookup_reg_ivalsr : hreg st : reg_slots_state : listival ≔
match st with
[ ]
⇒
[ ]
r′, ivs :: st′
⇒
hreg_eqbr r′
→
ivs
else
1432Fixpoint update_reg_ivalsr : hreg new_ivs : listival st : reg_slots_state : reg_slots_state ≔
match st with
[ ]
⇒
[ ]
r′, ivs :: st′
⇒
hreg_eqbr r′
→
r′, new_ivs :: st′
else
r′, ivs :: update_reg_ivalsr new_ivs st′
1441Fixpoint partner_regs_accpartners : listnat rm : ZMap.threg need_cs : bool acc : listhreg : listhreg ≔
match partners with
[ ]
⇒
rev'acc
p :: ps′
⇒
match zmap_find_natp rm with
Somer
⇒
else
true
&&
negbhreg_in_listr acc
→
partner_regs_accps′ rm need_cs r :: acc
else
partner_regs_accps′ rm need_cs acc
None
⇒
partner_regs_accps′ rm need_cs acc
1456Fixpoint dedup_hregs_accrs seen acc : listhreg : listhreg ≔
match rs with
[ ]
⇒
rev'acc
r :: rs′
⇒
→
dedup_hregs_accrs′ seen acc
else
dedup_hregs_accrs′ r :: seen r :: acc
1464Definition append_unique_hregsxs ys : listhreg : listhreg ≔
dedup_hregs_accxs ++ ys [ ] [ ]
1467Fixpoint pick_free_hregorder : listhreg ivs : listival st : reg_slots_state : optionhreg ≔
match order with
[ ]
⇒
None
r :: order′
⇒
else
pick_free_hregorder′ ivs st
1476Fixpoint color_candidatescands : listnat ivm : ZMap.tlistival call_pts : listnat poll_cross : ZMap.tbool partners : ZMap.tlistnat st : reg_slots_state rm : ZMap.threg : ZMap.threg ≔
match cands with
[ ]
⇒
rm
tid :: cands′
⇒
match zmap_find_nattid ivm with
None | Some[ ]
⇒
color_candidatescands′ ivm call_pts poll_cross partners st rm
Someivs
⇒
let crosses_poll ≔
match zmap_find_nattid poll_cross with
Someb
⇒
b
None
⇒
false
in
let crosses ≔ crosses_poll || ivals_hit_pointsivs call_pts in
let pregs ≔ partner_regs_accnset_attid partners rm crosses [ ] in
let base_regs ≔
in
let order ≔ append_unique_hregspregs base_regs in
match pick_free_hregorder ivs st with
None
⇒
color_candidatescands′ ivm call_pts poll_cross partners st rm
Somer
⇒
let st′ ≔ update_reg_ivalsr ivals_unionlookup_reg_ivalsr st ivs st in
color_candidatescands′ ivm call_pts poll_cross partners st′ zmap_add_nattid r rm

Allocate registers for numbered blocks rbs, returning Somerm only when valid_alloc accepts rm.

1506Definition allocate_regscmap : ZMap.tclass va_tid : optionnat param_tids : listnat rbs : listrblock : optionZMap.threg ≔
let loops ≔ collect_backedgesrbs in
let bwm ≔ build_block_weightsrbs loops ZMap.emptyZ in
let wm ≔ compute_temp_weightsrbs bwm ZMap.emptyZ in
let weighted ≔ collect_eligible_weightedZMap.elementscmap va_tid wm [ ] in
let sorted ≔ msortweighted_tid_cmp weighted in
let 'km, cands ≔ take_candidates_acccandidate_cap sorted ZMap.emptyunit [ ] in
match cands with
[ ]
⇒
SomeZMap.emptyhreg
_
⇒
let keep ≔ Somekm in
let* lv ≔ rblock_livenesskeep rbs in
let 'live_in, _, live_across ≔ lv in
let rbm ≔ build_rb_maprbs ZMap.emptyrblock in
let kept_params ≔ nset_of_listfilter_keep_acckeep param_tids [ ] in
let 'ivm, call_pts, poll_cross ≔ build_intervals_blockskeep rbm live_in live_across kept_params true O rbs ZMap.emptylistival [ ] ZMap.emptybool in
let partners ≔ collect_phi_partnersrbs ZMap.emptylistnat in
let rm ≔ color_candidatescands ivm call_pts poll_cross partners init_reg_slots ZMap.emptyhreg in
valid_alloccmap param_tids rbs rm
→
Somerm
else
None

Parallel moves for phi edges

A parallel-move location: an allocated hreg, a stack slot at -off(%rbp), or the cycle-breaking scratch register %rcx.

1536Inductive pm_loc: Type ≔
|PmReg
r : hreg
|PmSlot
off : Z
|PmCycleTmp
1541Definition pm_loc_eqba b : pm_loc : bool ≔
match a, b with
⇒
⇒
o1 =? o2
_, _
⇒
false
1549Inductive pm_src: Type ≔
|PsLoc
l : pm_loc
|PsConst
n : Z
|PsGlobal
g : string
1554Record pmove: Type ≔ mkPMove
pmv_half
 : bool
pmv_src_w
 : bool
pmv_dst
 : pm_loc
pmv_src
 : pm_src

Whether m is a true no-op: identical source and destination, and either 64-bit or an already zero-extended 32-bit source.

1563Definition pmove_is_nopm : pmove : bool ≔
match pmv_srcm with
_
⇒
false
1569Fixpoint drop_nop_pmoves_accms acc : listpmove : listpmove ≔
match ms with
[ ]
⇒
rev'acc
m :: ms′
⇒
1577Fixpoint loc_read_in_pmovesl : pm_loc ms : listpmove : bool ≔
match ms with
[ ]
⇒
false
m :: ms′
⇒
let hit ≔
match pmv_srcm with
PsLocl′
⇒
_
⇒
false
in
hit
→
true

Find a move in prefix_rev + rest whose destination is read by no other remaining move.

1587Fixpoint pick_ready_pmoverest prefix_rev : listpmove : optionpmove × listpmove ≔
match rest with
[ ]
⇒
None
m :: rest′
⇒
negbloc_read_in_pmovespmv_dstm prefix_rev && negbloc_read_in_pmovespmv_dstm rest′
→
Somem, rev_appendprefix_rev rest′
else
pick_ready_pmoverest′ m :: prefix_rev
1598Fixpoint subst_pmove_srcold : pm_loc ms acc : listpmove : listpmove ≔
match ms with
[ ]
⇒
rev'acc
m :: ms′
⇒
let src′ ≔
match pmv_srcm with
in
let m′ ≔ mkPMovepmv_halfm pmv_src_wm pmv_dstm src′ in
→
subst_pmove_srcold ms′ acc
else
subst_pmove_srcold ms′ m′ :: acc

Load integer constant n at width half into dst64, dst32 without touching EFLAGS.

1614Definition load_const_regn : Z half : bool dst64 dst32 : string : listline ≔
half
→
ins"mov" "l" immn mod two32; regdst32
else
let u ≔ n mod two64 in
let s ≔
u ≥? two63
→
u − two64
else
u
in
0 ≤? s && s <? two31
→
ins"mov" "l" imms; regdst32
−two31 ≤? s && s <? 0
→
ins"mov" "q" imms; regdst64
else
ins"movabs" "q" imms; regdst64
1627Definition emit_save_cycle_tmpl : pm_loc : listline ≔
match l with
⇒
ins"mov" "q" reghreg64r; reg"rcx"
⇒
ins"mov" "q" mem−off "rbp"; reg"rcx"
1634Definition emit_one_pmovem : pmove : listline ≔
let half ≔ pmv_halfm in
let suf ≔ class_suffixhalf in
match pmv_dstm, pmv_srcm with
⇒
ins"mov" suf reghreg_atrs half; reghreg_atrd half
⇒
ins"mov" suf mem−off "rbp"; reghreg_atrd half
⇒
ins"mov" suf regreg_name"c" half; reghreg_atrd half
⇒
ins"lea" "q" ripg; reghreg64rd
⇒
half
→
ins"mov" "l" reghreg32rs; reg"eax"; ins"mov" "q" reg"rax"; mem−off "rbp"
else
ins"mov" "q" reghreg64rs; mem−off "rbp"
⇒
ins"mov" suf mem−soff "rbp"; regreg_name"a" half; ins"mov" "q" reg"rax"; mem−off "rbp"
⇒
half
→
ins"mov" "l" reg"ecx"; reg"eax"; ins"mov" "q" reg"rax"; mem−off "rbp"
else
ins"mov" "q" reg"rcx"; mem−off "rbp"
⇒
negbhalf
→
match integer_immediatefalse n with
Someimm_v
⇒
ins"mov" "q" immimm_v; mem−off "rbp"
None
⇒
load_const_regn false "rax" "eax" ++ ins"mov" "q" reg"rax"; mem−off "rbp"
else
load_const_regn true "rax" "eax" ++ ins"mov" "q" reg"rax"; mem−off "rbp"
⇒
ins"lea" "q" ripg; reg"rax"; ins"mov" "q" reg"rax"; mem−off "rbp"
⇒
todo"cycle tmp dst"
1677Fixpoint compile_pmoves_fuelfuel : nat ms : listpmove acc : listline : listline ≔
match ms with
[ ]
⇒
rev'acc
m0 :: _
⇒
match fuel with
O
⇒
rev_appendacc todo"parallel move fuel"
Sfuel′
⇒
match pick_ready_pmovems [ ] with
Somem, rest
⇒
compile_pmoves_fuelfuel′ rest rev_appendemit_one_pmovem acc
None
⇒
let save ≔ emit_save_cycle_tmppmv_dstm0 in
let ms′ ≔ subst_pmove_srcpmv_dstm0 ms [ ] in
compile_pmoves_fuelfuel′ ms′ rev_appendsave acc
1695Definition compile_pmovesms : listpmove : listline ≔
let clean ≔ drop_nop_pmoves_accms [ ] in
compile_pmoves_fuelS2 × lengthclean clean [ ]

Function context and register-aware selection

1701Record rctx: Type ≔ mkRCtx
rc_cx
 : ctx
rc_reg
rc_class
rc_saves
 : listhreg × Z
1708Fixpoint place_callee_savesrs : listhreg off : Z acc : listhreg × Z : listhreg × Z × Z ≔
match rs with
[ ]
⇒
rev'acc, off
r :: rs′
⇒
place_callee_savesrs′ off + eight r, off + eight :: acc
1715Fixpoint hreg_in_pairsr : hreg els : listZ × hreg : bool ≔
match els with
[ ]
⇒
false
_, r′ :: els′
⇒
hreg_eqbr r′
→
true
else
1721Fixpoint collect_used_cs_acccs : listhreg els : listZ × hreg acc : listhreg : listhreg ≔
match cs with
[ ]
⇒
rev'acc
r :: cs′
⇒
→
collect_used_cs_acccs′ els r :: acc
else
collect_used_cs_acccs′ els acc
1730Fixpoint build_name_reg_mapnames_rev : listname idx : nat rm : ZMap.threg acc : nmaphreg : nmaphreg ≔
match names_rev with
[ ]
⇒
acc
d :: rest
⇒
let acc′ ≔
match zmap_find_natidx rm with
Somer
⇒
nm_addd r acc
None
⇒
acc
in
build_name_reg_maprest Sidx rm acc′
1743Fixpoint build_name_class_mapnames : listname idx : nat cmap : ZMap.tclass acc : nmapclass : nmapclass ≔
match names with
[ ]
⇒
acc
d :: rest
⇒
let acc′ ≔
match zmap_find_natidx cmap with
Somecl
⇒
nm_addd cl acc
None
⇒
acc
in
build_name_class_maprest Sidx cmap acc′
1756Fixpoint add_alias_slotsals : listkey × key slots2 m : nmapZ : nmapZ ≔
match als with
[ ]
⇒
m
k1, k2 :: als′
⇒
let m′ ≔
match nm_findkey_termk2 slots2 with
Someoff
⇒
None
⇒
m
in
add_alias_slotsals′ slots2 m′
1768Fixpoint build_pblocks_phis_mapbs : listpblock m : nmaplistphi : nmaplistphi ≔
match bs with
[ ]
⇒
m

Build the frame layout and rctx for p, adding save slots for the callee-saved registers that rm uses.

1776Definition build_rctxp : plan names : listname cmap : ZMap.tclass rm : ZMap.threg : rctx ≔
let fr ≔ pl_framep in
let 'slots1, locals, plain_bytes0 ≔ fold_leftplain_slot fr_plainfr nm_empty, nm_empty, 0 in
let used_cs ≔ collect_used_cs_acccallee_saved_hregs ZMap.elementsrm [ ] in
let 'saves, plain_bytes ≔ place_callee_savesused_cs plain_bytes0 [ ] in
let base ≔ plain_bytes + sixteen + eight × Zlengthfr_rootsfr in
let 'slots2, _ ≔ fold_leftlower_slotbase fr_rootsfr slots1, 0 in
let slots ≔ add_alias_slotsfr_aliasesfr slots2 slots2 in
let cx ≔ mkCtxname_textpl_namep slots locals round16base base phis_map in
1791Definition temp_is_wrc : rctx d : name : bool ≔
match nm_findd rc_classrc with
SomeW
⇒
true
_
⇒
false

Load v at class k into the scratch short register r.

1795Definition rloadrc : rctx v : value k : class r : string : listline ≔
match v, class_halfk with
Globalg, _
⇒
_, None
⇒
todo"load class"
Tmpn, Somehalf
⇒
match nm_findn rc_regrc with
Somehr
⇒
ins"mov" class_suffixhalf reghreg_athr half; regreg_namer half
None
⇒
with_slotrc_cxrc KTmpn λoff ⇒ ins"mov" class_suffixhalf mem−off "rbp"; regreg_namer half
Constn, Somehalf
⇒

Load v at integer width half into dst64, dst32.

1811Definition rload_intorc : rctx v : value half : bool dst64 dst32 : string : listline ≔
let dst ≔
half
→
dst32
else
dst64
in
match v with
⇒
ins"lea" "q" ripname_textg; regdst64
⇒
load_const_regn half dst64 dst32
⇒
match nm_findn rc_regrc with
Somehr
⇒
String.eqbhreg64hr dst64 && negbhalf || temp_is_wrc n
→
[ ]
else
ins"mov" class_suffixhalf reghreg_athr half; regdst
None
⇒
with_slotrc_cxrc KTmpn λoff ⇒ ins"mov" class_suffixhalf mem−off "rbp"; regdst
1827Definition reg32_of_fullr64 : string : string ≔
String.eqbr64 "rax"
→
"eax"
String.eqbr64 "rcx"
→
"ecx"
String.eqbr64 "rdx"
→
"edx"
String.eqbr64 "rsi"
→
"esi"
String.eqbr64 "rdi"
→
"edi"
else
r64 ++ "d"

Store 64-bit register src64 into k (register home or frame slot).

1836Definition rstore_keyrc : rctx src64 : string k : key : listline ≔
match k with
⇒
match nm_findd rc_regrc with
Somehr
⇒
let half ≔ temp_is_wrc d in
let src ≔
half
→
else
src64
in
ins"mov" class_suffixhalf regsrc; reghreg_athr half
None
⇒
slot_storerc_cxrc src64 k
_
⇒
slot_storerc_cxrc src64 k
1849Definition rlower_loadrc : rctx v : value r : string : listline ≔
1852Definition rflight_loadrc : rctx v : value : listline ≔
rloadrc v L "a" ++ rlower_loadrc v "rcx"
1855Definition rflight_storerc : rctx d : name : listline ≔

Prologue, epilogue and phi edges

1860Definition save_store_linep : hreg × Z : line ≔
ins"mov" "q" reghreg64fstp; mem−sndp "rbp"
1863Definition save_restore_linep : hreg × Z : line ≔
ins"mov" "q" mem−sndp "rbp"; reghreg64fstp
1866Definition callee_save_storessaves : listhreg × Z : listline ≔
1869Definition callee_save_restoressaves : listhreg × Z : listline ≔
1872Definition rleave_retrc : rctx : listline ≔
1875Definition rincoming_wordrc : rctx l : location w : word : listline ≔
match w with
⇒
match l with
⇒
from_xmmk x "a" ++ rstore_keyrc "rax" t
⇒
match class_halfk with
Somehalf
⇒
match t with
⇒
match nm_findd rc_regrc with
Somehr
⇒
let dhalf ≔ half || temp_is_wrc d in
ins"mov" class_suffixdhalf memsixteen + eight × i "rbp"; reghreg_athr dhalf
None
⇒
ins"mov" class_suffixhalf memsixteen + eight × i "rbp"; regreg_name"a" half :: slot_storerc_cxrc "rax" t
_
⇒
ins"mov" class_suffixhalf memsixteen + eight × i "rbp"; regreg_name"a" half :: slot_storerc_cxrc "rax" t
None
⇒
todo"incoming class"
_
⇒
todo"incoming source"
1907Fixpoint rtyped_incoming_accrc : rctx ws : listword ls : listlocation acc : listline : listline ≔
match ws, ls with
w :: ws′, l :: ls′
⇒
rtyped_incoming_accrc ws′ ls′ rev_appendrincoming_wordrc l w acc
_, _
⇒
rev'acc
1915Definition rtyped_incomingrc : rctx ws : listword ls : listlocation : listline ≔
1918Definition rentry_linesrc : rctx p : plan : listline ≔
let cx ≔ rc_cxrc in
let ret ≔ pl_returnp in
let base ≔ cx_basecx in
ins"push" "q" reg"rbp"; ins"mov" "q" reg"rsp"; reg"rbp"; ins"sub" "q" immcx_sizecx; reg"rsp"
++
++
ins"cmp" "q" reg"rsp"; memthread_stack_limit "rdi"; ins0"jae" plt"filc_stack_overflow_failure"
++
++
++
match ret with
++
++
ins"mov" "q" memthread_top_frame "rdi"; reg"rax"; ins"mov" "q" reg"rax"; mem−base "rbp"
++
++
ins"lea" "q" mem−base "rbp"; reg"rax"; ins"mov" "q" reg"rax"; memthread_top_frame "rdi"
++

Exception exit with callee-saved registers restored.

1941Definition rexc_exit_linesrc : rctx ret : protocol : listline ≔
let cx ≔ rc_cxrc in
++
match ret with
⇒
ins"mov" "b" imm1; reg"al"
⇒
slot_loadcx KRetbuf "rax" ++ ins"mov" "b" imm1; mem0 "rax"
++
1950Definition rsuccessrc : rctx r : protocol : listline ≔
match r with
⇒
ins"xor" "l" reg"eax"; reg"eax" :: rleave_retrc
⇒
todo"success of a buffered return"

Parallel-move construction for phis on edge from from.

1957Definition key_pm_locrc : rctx k : key : optionpm_loc ≔
match k with
⇒
match nm_findd rc_regrc with
Somehr
⇒
SomePmReghr
None
⇒
option_mapPmSlot slotrc_cxrc k
_
⇒
option_mapPmSlot slotrc_cxrc k
1967Definition val_pm_srcrc : rctx v : value : optionpm_src × bool ≔
match v with
⇒
SomePsConstn, true
⇒
SomePsGlobalname_textg, false
⇒
match key_pm_locrc KTmpn with
Someloc
⇒
SomePsLocloc, temp_is_wrc n
None
⇒
None
1978Definition lower_pm_srcrc : rctx v : value : optionpm_src ≔
match v with
⇒
SomePsConst0
⇒
None
⇒
option_mapλoff ⇒ PsLocPmSlotoff slotrc_cxrc KLowerKTmpn
1985Fixpoint build_phi_pmoves_accrc : rctx from : name phis : listphi acc : listpmove : optionlistpmove ≔
match phis with
[ ]
⇒
Somerev'acc
Phid k pairs :: phis′
⇒
let* v ≔ pair_valuefrom pairs in
match k with
⇒
let* dloc ≔ key_pm_locrc KTmpd in
let* vs ≔ val_pm_srcrc v in
let* dlloc ≔ key_pm_locrc KLowerKTmpd in
let* lsrc ≔ lower_pm_srcrc v in
build_phi_pmoves_accrc from phis′ mkPMovefalse false dlloc lsrc :: mkPMovefalse false dloc fstvs :: acc
⇒
let* dloc ≔ key_pm_locrc KTmpd in
let* vs ≔ val_pm_srcrc v in
build_phi_pmoves_accrc from phis′ mkPMovetrue sndvs dloc fstvs :: acc
⇒
let* dloc ≔ key_pm_locrc KTmpd in
let* vs ≔ val_pm_srcrc v in
build_phi_pmoves_accrc from phis′ mkPMovefalse false dloc fstvs :: acc
_
⇒
None
2011Definition redge_movesrc : rctx from : name t : target tag : string : listline ≔
let cx ≔ rc_cxrc in
let phis ≔
Someps
⇒
ps
None
⇒
[ ]
in
let moves ≔
match build_phi_pmoves_accrc from phis [ ] with
Somems
⇒
None
⇒
todo"phi parallel move"
in
moves
++
match t with
⇒
pollcheckcx from tag
⇒
[ ]
2021Definition redgerc : rctx from : name t : target tag : string : listline ≔
2024Definition rselected_edgerc : rctx from : name t : target tag : string next : optionname : listline ≔
to_nextt next
→
redge_movesrc from t tag
else
redgerc from t tag

Direct integer, comparison, flight and access selection

Source operand for a binary integer op (imm32, hreg, or frame slot) when available without a scratch register.

2032Definition direct_src_operandrc : rctx half : bool v : value : optionoperand ≔
match v with
⇒
option_mapimm integer_immediatehalf n
⇒
match nm_findn rc_regrc with
Somehr
⇒
Somereghreg_athr half
None
⇒
option_mapλoff ⇒ mem−off "rbp" slotrc_cxrc KTmpn
⇒
None
2043Definition val_uses_hregrc : rctx v : value hr : hreg : bool ≔
match v with
⇒
match nm_findn rc_regrc with
Somehr′
⇒
hreg_eqbhr hr′
None
⇒
false
_
⇒
false

Compare x and y at integer class ck, setting EFLAGS for c.

2054Definition rcompare_with_regrc : rctx half : bool rx : string y : value : listline ≔
let suf ≔ class_suffixhalf in
match direct_src_operandrc half y with
Someop_y
⇒
ins"cmp" suf op_y; regrx
None
⇒
rloadrc y
half
→
else
"c"
++
ins"cmp" suf regreg_name"c" half; regrx
2063Definition rcompare_flagsrc : rctx ck : class x y : value : listline ≔
match ck with
W | L
⇒
let half ≔
match ck with
⇒
true
_
⇒
false
in
match x with
Tmpnx
⇒
match nm_findnx rc_regrc with
Somehrx
⇒
rcompare_with_regrc half hreg_athrx half y
None
⇒
rloadrc x ck "a" ++ rcompare_with_regrc half reg_name"a" half y
_
⇒
rloadrc x ck "a" ++ rcompare_with_regrc half reg_name"a" half y
_
⇒
todo"compare class"

Narrow source register of hr for ext_op.

2080Definition hreg_ext_fromhr : hreg t : narrow : string ≔
match t with
Sb | Ub
⇒
Sh | Uh
⇒
Sw | Uw
⇒
2087Definition rext_intorc : rctx t : narrow k : class x : value dst64 dst32 : string : listline ≔
match ext_opt k with
None
⇒
todo"ext class"
Someop_m, suf, to_a
⇒
let dst ≔
String.eqbto_a "eax"
→
dst32
else
dst64
in
match x with
Tmpnx
⇒
match nm_findnx rc_regrc with
Somehrx
⇒
insop_m suf reghreg_ext_fromhrx t; regdst
None
⇒
rloadrc x W "a" ++ insop_m suf regext_fromt; regdst
_
⇒
rloadrc x W "a" ++ insop_m suf regext_fromt; regdst

Direct two-operand commutative ALU (and, or, xor) into dst64, dst32, where dst_hr is Somehr when targeting an allocatable register.

2107Definition ralu_comm_intorc : rctx mnem : string half : bool x y : value dst_hr : optionhreg dst64 dst32 : string : listline ≔
let suf ≔ class_suffixhalf in
let dst ≔
half
→
dst32
else
dst64
in
let k ≔
half
→
else
in
let swap ≔
match dst_hr with
Somehr
⇒
val_uses_hregrc y hr && negbval_uses_hregrc x hr
None
⇒
match x with
⇒
true
_
⇒
false
&&
match y with
⇒
false
_
⇒
true
in
let 'a, b ≔
swap
→
y, x
else
x, y
in
match dst_hr with
Somehr
⇒
→
rloadrc b k "c" ++ rload_intorc a half dst64 dst32 ++ insmnem suf regreg_name"c" half; regdst
else
rload_intorc a half dst64 dst32
++
match direct_src_operandrc half b with
Someop_b
⇒
insmnem suf op_b; regdst
None
⇒
rloadrc b k "c" ++ insmnem suf regreg_name"c" half; regdst
None
⇒
rload_intorc a half dst64 dst32
++
match direct_src_operandrc half b with
Someop_b
⇒
insmnem suf op_b; regdst
None
⇒
rloadrc b k "c" ++ insmnem suf regreg_name"c" half; regdst

Direct integer Add with 3-address lea when operands live in registers distinct from the destination.

2142Definition radd_intorc : rctx half : bool x y : value dst_hr : optionhreg dst64 dst32 : string : listline ≔
let suf ≔ class_suffixhalf in
let dst ≔
half
→
dst32
else
dst64
in
let 'a, b ≔
match x, y with
⇒
y, x
_, _
⇒
x, y
in
match a, b with
⇒
match nm_findna rc_regrc, integer_immediatehalf n with
Somehra, Someimm_v
⇒
imm_v =? 0
→
rload_intorc a half dst64 dst32
→
ins"add" suf immimm_v; regdst
else
ins"lea" suf memimm_v hreg64hra; regdst
_, _
⇒
ralu_comm_intorc "add" half x y dst_hr dst64 dst32
Tmpna, Tmpnb
⇒
match nm_findna rc_regrc, nm_findnb rc_regrc with
Somehra, Somehrb
⇒
→
ins"add" suf reghreg_athrb half; regdst
→
ins"add" suf reghreg_athra half; regdst
else
ins"lea" suf mem_index0 hreg64hra hreg64hrb; regdst
_, _
⇒
ralu_comm_intorc "add" half x y dst_hr dst64 dst32
_, _
⇒
ralu_comm_intorc "add" half x y dst_hr dst64 dst32

Direct integer Sub with lea on constant subtrahends.

2177Definition rsub_intorc : rctx half : bool x y : value dst_hr : optionhreg dst64 dst32 : string : listline ≔
let suf ≔ class_suffixhalf in
let dst ≔
half
→
dst32
else
dst64
in
let k ≔
half
→
else
in
match x, y with
⇒
match nm_findnx rc_regrc with
Somehrx
⇒
→
match integer_immediatehalf n with
Someimm_v
⇒
imm_v =? 0
→
rload_intorc x half dst64 dst32
else
ins"sub" suf immimm_v; regdst
None
⇒
rloadrc y k "c" ++ ins"sub" suf regreg_name"c" half; regdst
else
match integer_immediatehalf −n with
Someneg_v
⇒
neg_v =? 0
→
rload_intorc x half dst64 dst32
else
ins"lea" suf memneg_v hreg64hrx; regdst
None
⇒
rload_intorc x half dst64 dst32
++
match integer_immediatehalf n with
Someimm_v
⇒
ins"sub" suf immimm_v; regdst
None
⇒
rloadrc y k "c" ++ ins"sub" suf regreg_name"c" half; regdst
None
⇒
rload_intorc x half dst64 dst32
++
match direct_src_operandrc half y with
Someop_y
⇒
ins"sub" suf op_y; regdst
None
⇒
rloadrc y k "c" ++ ins"sub" suf regreg_name"c" half; regdst
_, _
⇒
let clobbers_y ≔
match dst_hr with
Somehr
⇒
None
⇒
false
in
clobbers_y
→
rloadrc y k "c" ++ rload_intorc x half dst64 dst32 ++ ins"sub" suf regreg_name"c" half; regdst
else
rload_intorc x half dst64 dst32
++
match direct_src_operandrc half y with
Someop_y
⇒
ins"sub" suf op_y; regdst
None
⇒
rloadrc y k "c" ++ ins"sub" suf regreg_name"c" half; regdst

Direct integer Mul, using 3-operand imul $imm, src, dst when multiplying by a 32-bit immediate.

2230Definition rmul_intorc : rctx half : bool x y : value dst_hr : optionhreg dst64 dst32 : string : listline ≔
let suf ≔ class_suffixhalf in
let dst ≔
half
→
dst32
else
dst64
in
let 'a, b ≔
match x, y with
Const_, _
⇒
y, x
_, _
⇒
x, y
in
match b with
⇒
match integer_immediatehalf n with
Someimm_v
⇒
match a with
Tmpna
⇒
match nm_findna rc_regrc with
Somehra
⇒
ins"imul" suf immimm_v; reghreg_athra half; regdst
None
⇒
with_slotrc_cxrc KTmpna λoff ⇒ ins"imul" suf immimm_v; mem−off "rbp"; regdst
_
⇒
rload_intorc a half dst64 dst32 ++ ins"imul" suf immimm_v; regdst; regdst
None
⇒
ralu_comm_intorc "imul" half x y dst_hr dst64 dst32
_
⇒
ralu_comm_intorc "imul" half x y dst_hr dst64 dst32

Direct shift into dst64, dst32.

2261Definition rshift_intorc : rctx mnem : string half : bool x y : value dst64 dst32 : string : listline ≔
let suf ≔ class_suffixhalf in
let dst ≔
half
→
dst32
else
dst64
in
match y with
⇒
let cnt ≔
n
mod
half
→
32
else
64
in
rload_intorc x half dst64 dst32
++
cnt =? 0
→
[ ]
else
insmnem suf immcnt; regdst
_
⇒
rloadrc y W "c" ++ rload_intorc x half dst64 dst32 ++ insmnem suf reg"cl"; regdst

Division, float and x87 operations through %rax, reading and writing register homes via rload and rstore_key.

2278Definition rdivisionrc : rctx sg : signedness rem_flag : bool k : class args : listvalue : listline ≔
match args, class_halfk with
x; y, Somehalf
⇒
let s ≔ class_suffixhalf in
let a ≔ reg_name"a" half in
let c ≔ reg_name"c" half in
let d ≔ reg_name"d" half in
rloadrc x k "a" ++ rloadrc y k "c" ++ zero_divisors a c d ++ minus_one_divisorsg s a c d ++ dividesg k s c ++ division_resultrem_flag half
_; _, None
⇒
todo"division class"
_, _
⇒
todo"division arguments"
2293Definition rfloat_loadrc : rctx v : value k : class x : string : listline ≔
→
rloadrc v k "a" ++ to_xmmk "a" x
else
todo"float class"
2296Definition rfloat_oprc : rctx o : op k : class args : listvalue : listline ≔
let cx ≔ rc_cxrc in
match o, args with
Add | Sub | Mul | Div, x; y
⇒
Someinsn, Somes
⇒
rfloat_loadrc x k "xmm0" ++ rfloat_loadrc y k "xmm1" ++ insinsn s reg"xmm1"; reg"xmm0" ++ from_xmmk "xmm0" "a"
_, _
⇒
todo"float class"
Neg, x
⇒
match float_bitsk with
Someb
⇒
let mask ≔
match k with
in
let half ≔
match k with
⇒
true
_
⇒
false
in
rloadrc x k "a" ++ rloadrc Constmask b "c" ++ ins"xor" class_suffixhalf regreg_name"c" half; regreg_name"a" half
None
⇒
todo"float class"
Cmpc ck, x; y
⇒
match k, float_compareck with
W, Somecmp
⇒
rfloat_loadrc x ck "xmm0" ++ rfloat_loadrc y ck "xmm1" ++ ins0cmp reg"xmm1"; reg"xmm0" ++ float_conditionc ++ ins"movzb" "l" reg"al"; reg"eax"
_, _
⇒
todo"float cmp class"
⇒
match k with
⇒
rfloat_loadrc x Single "xmm0" ++ ins0"cvtss2sd" reg"xmm0"; reg"xmm0" ++ from_xmmDouble "xmm0" "a"
_
⇒
todo"ext class"
⇒
match k with
⇒
rfloat_loadrc x Double "xmm0" ++ ins0"cvtsd2ss" reg"xmm0"; reg"xmm0" ++ from_xmmSingle "xmm0" "a"
_
⇒
todo"truncd class"
Cast, x
⇒
rloadrc x k "a"
FloatToIntf sg, x
⇒
→
rfloat_loadrc x f "xmm0" ++ float_integercx sg f k
else
todo"float op"
IntToFloatik sg, x
⇒
match ik with
W | L
⇒
→
rloadrc x ik "a" ++ integer_floatsg ik k ++ from_xmmk "xmm0" "a"
else
todo"float class"
_
⇒
todo"float op"
_, _
⇒
todo"float op"
2353Definition rx87_push_floatrc : rctx f : class v : value : listline ≔
match x87_suffixf with
Somes, _
⇒
rloadrc v f "a" ++ ins"mov" "q" reg"rax"; mem−8 "rsp"; ins"fld" s mem−8 "rsp"
None
⇒
todo"x87 ext class"
2361Definition rx87_fisttprc : rctx k : class d : name : listline ≔
let half ≔
match k with
⇒
true
_
⇒
false
in
ins"fisttp" "ll" mem−8 "rsp"; ins"mov" class_suffixhalf mem−8 "rsp"; regreg_name"a" half ++ rstore_keyrc "rax" KTmpd
2367Definition rx87_int_sourcerc : rctx o : op a : value : listline ≔
match o with
⇒
rloadrc a W "a" ++ ins"movsl" "q" reg"eax"; reg"rax"
⇒
rloadrc a W "a" ++ ins"mov" "l" reg"eax"; reg"eax"
⇒
rloadrc a L "a"
_
⇒
todo"x87 integer source"
2375Definition rx87_instrc : rctx o : op k : class args : listvalue d : name : listline ≔
let cx ≔ rc_cxrc in
match o, k, args with
Add | Sub | Mul | Div, Extended, a; b
⇒
match x87_aritho with
Someinsn
⇒
x87_pushcx b ++ x87_pushcx a ++ ins0insn reg"st(1)"; reg"st" ++ x87_popcx d ++ ins0"fstp" reg"st(0)"
None
⇒
todo"x87 op"
⇒
x87_pushcx a ++ ins0"fchs" [ ] ++ x87_popcx d
⇒
x87_pushcx a ++ x87_popcx d
Cmpc Extended, W, a; b
⇒
x87_pushcx b ++ x87_pushcx a ++ ins0"fucomip" reg"st(1)"; reg"st"; ins0"fstp" reg"st(0)" ++ float_conditionc ++ ins"movzb" "l" reg"al"; reg"eax" ++ rstore_keyrc "rax" KTmpd
⇒
rx87_push_floatrc f a ++ x87_popcx d
Truncx, _, a
⇒
match x87_suffixk with
Somes, mov
⇒
x87_pushcx a ++ ins"fstp" s mem−8 "rsp"; ins"mov" mov mem−8 "rsp"; regif String.eqbmov "l" then "eax" else "rax" ++ rstore_keyrc "rax" KTmpd
None
⇒
todo"x87 truncx class"
⇒
x87_pushcx a ++ ins"mov" "l" immsingle_two63; mem−12 "rsp"; ins"fld" "s" mem−12 "rsp"; ins0"fucomip" reg"st(1)"; reg"st"; ins0"ja" sym"1f"; ins"fsub" "s" mem−12 "rsp"; ins"fisttp" "ll" mem−8 "rsp"; ins"mov" "q" mem−8 "rsp"; reg"rax"; ins"btc" "q" immsixty_three; reg"rax"; ins0"jmp" sym"2f"; label"1"; ins"fisttp" "ll" mem−8 "rsp"; ins"mov" "q" mem−8 "rsp"; reg"rax"; label"2" ++ rstore_keyrc "rax" KTmpd
⇒
rx87_int_sourcerc o a ++ ins"mov" "q" reg"rax"; mem−8 "rsp"; ins"fild" "ll" mem−8 "rsp" ++ x87_unsigned_fixo ++ x87_popcx d
_, _, _
⇒
todo"x87 op"

Emit integer operation o at class k into dst64, dst32.

2432Definition rint_op_intorc : rctx o : op k : class args : listvalue dst_hr : optionhreg dst64 dst32 : string : listline ≔
match class_halfk with
None
⇒
todo"int op class"
Somehalf
⇒
let suf ≔ class_suffixhalf in
let dst ≔
half
→
dst32
else
dst64
in
match o, args with
Copy, x
⇒
rload_intorc x half dst64 dst32
Ptoi, p
⇒
match k with
⇒
rload_intorc p false dst64 dst32
_
⇒
todo"ptoi"
Neg, x
⇒
rload_intorc x half dst64 dst32 ++ ins"neg" suf regdst
Add, x; y
⇒
radd_intorc half x y dst_hr dst64 dst32
Sub, x; y
⇒
rsub_intorc half x y dst_hr dst64 dst32
Mul, x; y
⇒
rmul_intorc half x y dst_hr dst64 dst32
And, x; y
⇒
ralu_comm_intorc "and" half x y dst_hr dst64 dst32
Or, x; y
⇒
ralu_comm_intorc "or" half x y dst_hr dst64 dst32
Xor, x; y
⇒
ralu_comm_intorc "xor" half x y dst_hr dst64 dst32
Shl, x; y
⇒
rshift_intorc "shl" half x y dst64 dst32
Shr, x; y
⇒
rshift_intorc "shr" half x y dst64 dst32
Sar, x; y
⇒
rshift_intorc "sar" half x y dst64 dst32
Extt, x
⇒
rext_intorc t k x dst64 dst32
Cmpc ck, x; y
⇒
→
rfloat_oprc o k args
++
String.eqbdst64 "rax"
→
[ ]
else
ins"mov" "l" reg"eax"; regdst32
else
match cond_codec with
Somecc
⇒
rcompare_flagsrc ck x y ++ ins0"set" ++ cc reg"al"; ins"movzb" "l" reg"al"; regdst32
None
⇒
todo"cmp condition"
Div, _
⇒
rdivisionrc Signed false k args
++
String.eqbdst64 "rax"
→
[ ]
else
ins"mov" suf regreg_name"a" half; regdst
Rem, _
⇒
rdivisionrc Signed true k args
++
String.eqbdst64 "rax"
→
[ ]
else
ins"mov" suf regreg_name"a" half; regdst
Udiv, _
⇒
rdivisionrc Unsigned false k args
++
String.eqbdst64 "rax"
→
[ ]
else
ins"mov" suf regreg_name"a" half; regdst
Urem, _
⇒
rdivisionrc Unsigned true k args
++
String.eqbdst64 "rax"
→
[ ]
else
ins"mov" suf regreg_name"a" half; regdst
_, _
⇒
todo"int op"
2486Definition rspan_test_linesrc : rctx b : name index : string lo hi : Z p : value d : name : listline ≔
let cx ≔ rc_cxrc in
let zero ≔ local_labelcx b index "span0" in
let done ≔ local_labelcx b index "span1" in
rflight_loadrc p ++ ins"test" "q" reg"rcx"; reg"rcx"; ins0"jz" symzero ++ span_endlo "rdx" ++ ins"cmp" "q" reg"rcx"; reg"rdx"; ins0"jb" symzero ++ span_endhi "rax" ++ ins"cmp" "q" reg"rdx"; reg"rax"; ins0"jbe" symzero; ins"cmp" "q" mem−16 "rcx"; reg"rax"; ins0"ja" symzero; ins"mov" "l" imm1; reg"eax"; ins0"jmp" symdone; labelzero; ins"xor" "l" reg"eax"; reg"eax"; labeldone ++ rstore_keyrc "rax" KTmpd
2505Definition rlet_linesrc : rctx b : name index : string d : name k : class o : op args : listvalue : listline ≔
let cx ≔ rc_cxrc in
→
rx87_instrc o k args d
→
rfloat_oprc o k args ++ rstore_keyrc "rax" KTmpd
else
match o with
Allocalign
⇒
match k, args with
P, n
⇒
rloadrc n L "si"
++
++
align ≥? sixteen
→
ins"mov" "l" immalign; reg"edx"; ins0"call" plt"filc_allocate_with_alignment"
else
ins0"call" plt"filc_allocate"
++
ins"lea" "q" memsixteen "rax"; reg"rax"; ins"mov" "q" reg"rax"; reg"rcx" ++ rflight_storerc d
_, _
⇒
todo"alloc"
⇒
match k, args with
W, p
⇒
rspan_test_linesrc b index lo hi p d
_, _
⇒
todo"span_test"
_
⇒
match nm_findd rc_regrc with
Somehr
⇒
rint_op_intorc o k args Somehr hreg64hr hreg32hr
None
⇒
rint_op_intorc o k args None "rax" "eax" ++ slot_storecx "rax" KTmpd

Flight address calculation into dst64 (%rax or an hreg).

2539Definition flight_arg_vala : flight_arg : value ≔
match a with
⇒
v
2542Definition rflight_addr_intorc : rctx o : op args : listflight_arg dst_hr : optionhreg dst64 : string : listline ≔
let dst32 ≔
match dst_hr with
Somehr
⇒
None
⇒
"eax"
in
match o, args with
Copy, a
⇒
rload_intorc flight_arg_vala false dst64 dst32
Add, a; x
⇒
radd_intorc false flight_arg_vala flight_arg_valx dst_hr dst64 dst32
Sub, a; x
⇒
rsub_intorc false flight_arg_vala flight_arg_valx dst_hr dst64 dst32
_, _
⇒
todo"flight"
2552Definition rflight_linesrc : rctx d : name o : op args : listflight_arg lower : flight_lower : listline ≔
let cx ≔ rc_cxrc in
let lower_code ≔
shared_lowercx lower d
→
[ ]
else
match lower with
⇒
rlower_loadrc p "rcx"
⇒
ins"xor" "l" reg"ecx"; reg"ecx"
++
in
match nm_findd rc_regrc with
Somehrd
⇒
lower_code ++ rflight_addr_intorc o args Somehrd hreg64hrd
None
⇒
rflight_addr_intorc o args None "rax" ++ lower_code ++ slot_storecx "rax" KTmpd

Raw loads and stores with direct register destinations/sources.

2573Definition rraw_loadrc : rctx t : load_type k : class d : name : listline ≔
let cx ≔ rc_cxrc in
match t with
⇒
ins"fld" "t" mem0 "rax" :: x87_popcx d
_
⇒
match load_opt k with
None
⇒
todo"load type"
Someop_m, suf, to_a
⇒
match nm_findd rc_regrc with
Somehrd
⇒
let dst ≔
String.eqbto_a "eax"
→
else
in
insop_m suf mem0 "rax"; regdst
None
⇒
insop_m suf mem0 "rax"; regto_a ++ slot_storecx "rax" KTmpd
2592Definition rraw_storerc : rctx w : width v : value : listline ≔
let cx ≔ rc_cxrc in
match w with
⇒
x87_pushcx v ++ ins"fstp" "t" mem0 "rax"
_
⇒
Somek, Somesuf
⇒
match v with
Tmpnv
⇒
match nm_findnv rc_regrc with
Somehrv
⇒
match hreg_widthhrv w with
Somern
⇒
ins"mov" suf regrn; mem0 "rax"
None
⇒
todo"store width"
None
⇒
rloadrc v k "d" ++ store_insnw "d"
⇒
match w with
⇒
ins"mov" "b" immn mod 256; mem0 "rax"
⇒
ins"mov" "w" immn mod 65536; mem0 "rax"
⇒
match integer_immediatetrue n with
Someiv
⇒
ins"mov" "l" immiv; mem0 "rax"
None
⇒
rloadrc v k "d" ++ store_insnw "d"
⇒
match integer_immediatefalse n with
Someiv
⇒
ins"mov" "q" immiv; mem0 "rax"
None
⇒
rloadrc v k "d" ++ store_insnw "d"
_
⇒
rloadrc v k "d" ++ store_insnw "d"
⇒
rloadrc v k "d" ++ store_insnw "d"
_, _
⇒
todo"store width"
2631Definition rpointer_store_effectrc : rctx b : name index : string v a : value e : effect : listline ≔
let cx ≔ rc_cxrc in
match e with
⇒
let haveaux ≔ local_labelcx b index "haveaux" in
aux_of_lower ++ ins0"jnz" symhaveaux ++ slot_loadcx KThread "rdi" ++ ins"lea" "q" mem−16 "rcx"; reg"rsi"; ins0"call" plt"filc_object_ensure_aux_ptr_outline"; ins"mov" "q" reg"rax"; reg"rdx"; labelhaveaux ++ slot_storecx "rdx" KAux
⇒
let nobarrier ≔ local_labelcx b index "nobarrier" in
rlower_loadrc v "rsi" ++ ins"test" "q" reg"rsi"; reg"rsi"; ins0"jz" symnobarrier; ins"mov" "q" gotpcrel"filc_current_marking_state"; reg"rax"; ins"cmp" "l" imm0; mem0 "rax"; ins0"je" symnobarrier ++ slot_loadcx KThread "rdi" ++ ins0"call" plt"filc_store_barrier_for_lower_slow"; labelnobarrier
⇒
rflight_loadrc a ++ slot_loadcx KAux "rdx" ++ ins"mov" "q" reg"rax"; reg"r8"; ins"sub" "q" reg"rcx"; reg"r8" ++ rlower_loadrc v "rsi" ++ rloadrc v L "r9"
⇒
ins"mov" "q" reg"rax"; reg"rsi"; ins"mov" "q" reg"rcx"; reg"rdx" ++ origin_storecx "c" ++ slot_loadcx KThread "rdi" ++ rloadrc v L "c" ++ rlower_loadrc v "r8" ++ ins0"call" plt"filc_store_ptr_atomic_outline"
⇒
ins"mov" "q" reg"rsi"; mem_index0 "rdx" "r8"
⇒
ins"mov" "q" reg"r9"; mem0 "rax"
_
⇒
todo"pointer store effect"
2673Definition rraw_accessrc : rctx b : name index : string a : access : listline ≔
let cx ≔ rc_cxrc in
match a with
ALoadd k t _ _
⇒
rraw_loadrc t k d
AStorew _ v _
⇒
ALoadPointerd _ es _
⇒
flat_mappointer_load_effectcx b index es ++ rflight_storerc d
⇒
flat_maprpointer_store_effectrc b index v p es
⇒
todo"pointer store at a local"
⇒
[ ]
2685Definition local_load_eff_linese : effect : listline ≔
match e with
⇒
ins"mov" "q" mem0 "rdx"; reg"rcx"
⇒
ins"mov" "q" mem0 "rax"; reg"rax"
_
⇒
todo"local load effect"
2692Definition local_store_eff_linesrc : rctx v : value e : effect : listline ≔
match e with
⇒
rlower_loadrc v "rcx" ++ ins"mov" "q" reg"rcx"; mem0 "rdx"
⇒
rloadrc v L "si" ++ ins"mov" "q" reg"rsi"; mem0 "rax"
_
⇒
todo"local store effect"
2699Definition rlocal_raw_accessrc : rctx b : name index : string a : access : listline ≔
match a with
ALoadPointerd _ es _
⇒
⇒
flat_maplocal_store_eff_linesrc v es
_
⇒
rraw_accessrc b index a

Calls and ABI actions

2710Definition rword_reg_loadrc : rctx s : source r : string : listline ≔
match s with
⇒
rloadrc v L r
⇒
rloadrc v k r
_
⇒
todo"call word"
2718Fixpoint rtyped_stack_args_accrc : rctx ws : listword ls : listlocation acc : listline : listline ≔
match ws, ls with
Wf_ s :: ws′, l :: ls′
⇒
let cur ≔
match l with
⇒
rword_reg_loadrc s "a" ++ ins"mov" "q" reg"rax"; memeight × i "rsp"
_
⇒
[ ]
in
rtyped_stack_args_accrc ws′ ls′ rev_appendcur acc
_, _
⇒
rev'acc
2731Fixpoint rtyped_register_args_accrc : rctx ws : listword ls : listlocation acc : listline : listline ≔
match ws, ls with
Wfk s :: ws′, l :: ls′
⇒
let cur ≔
match l with
⇒
[ ]
⇒
rword_reg_loadrc s "a" ++ to_xmmk "a" x
in
rtyped_register_args_accrc ws′ ls′ rev_appendcur acc
_, _
⇒
rev'acc
2745Definition rfast_callrc : rctx r : protocol ws : listword callee : optionoperand : listline ≔
let 'ls, ns, _ ≔ typed_locationsws r in
let pop ≔ stack_bytesns in
pop >? 0
→
ins"sub" "q" immpop; reg"rsp"
else
[ ]
++
++
++
entry_callrc_cxrc r callee pop
++
pop >? 0
→
ins"add" "q" immpop; reg"rsp"
else
[ ]
2755Fixpoint rreg_slot_stores_accrc : rctx ks : listkey rs : liststring acc : listline : listline ≔
match ks, rs with
[ ], _
⇒
rev'acc
k :: ks′, r :: rs′
⇒
rreg_slot_stores_accrc ks′ rs′ rev_appendrstore_keyrc r k acc
_ :: _, [ ]
⇒
rev_appendacc todo"result registers"
2763Fixpoint rbuffer_slot_copies_accrc : rctx ks : listkey off : Z acc : listline : listline ≔
match ks with
[ ]
⇒
rev'acc
k :: ks′
⇒
let cur ≔ ins"mov" "q" memoff "rsp"; reg"rax" :: rstore_keyrc "rax" k in
rbuffer_slot_copies_accrc ks′ off + eight rev_appendcur acc
2772Fixpoint rtyped_result_gprs_accrc : rctx ts : listkey rs : listresult_reg acc : listline : listline ≔
match ts, rs with
[ ], [ ]
⇒
rev'acc
t :: ts′, r :: rs′
⇒
let cur ≔
match r with
⇒
⇒
[ ]
in
rtyped_result_gprs_accrc ts′ rs′ rev_appendcur acc
_, _
⇒
rev_appendacc todo"result registers"
2782Fixpoint rtyped_result_xmms_accrc : rctx ts : listkey rs : listresult_reg acc : listline : listline ≔
match ts, rs with
[ ], [ ]
⇒
rev'acc
t :: ts′, r :: rs′
⇒
let cur ≔
match r with
⇒
from_xmmk x "a" ++ rstore_keyrc "rax" t
⇒
[ ]
in
rtyped_result_xmms_accrc ts′ rs′ rev_appendcur acc
_, _
⇒
rev_appendacc todo"result registers"
2796Definition rtyped_result_storesrc : rctx ks : listclass × key : listline ≔
match result_registersmapfst ks "rdx"; "rcx" "xmm0"; "xmm1" with
Somers
⇒
rtyped_result_gprs_accrc mapsnd ks rs [ ] ++ rtyped_result_xmms_accrc mapsnd ks rs [ ]
None
⇒
todo"result registers"
2803Definition rfast_resultrc : rctx r : protocol c : channels : listline ≔
let exc ≔ special_labelrc_cxrc "exc" in
let flag ≔ ins"test" "b" imm1; reg"al"; ins0"jnz" symexc in
match r, c with
⇒
flag ++ from_xmmk "xmm0" "a" ++ rstore_keyrc "rax" KTmpd
⇒
flag ++ rreg_slot_stores_accrc ks "rdx"; "rcx" [ ]
⇒
ins"cmp" "b" imm0; mem0 "rsp"; ins0"jne" symexc ++ rbuffer_slot_copies_accrc ks eight [ ]
Buffer_, _
⇒
todo"buffered result"
2816Definition rgeneric_call_argrc : rctx c : cell : listline ≔
match c with
Celli k CellValuev lower
⇒
rloadrc v k "a"
++
match lower with
⇒
rlower_loadrc p "rcx"
⇒
todo"saved lower"
None
⇒
ins"xor" "l" reg"ecx"; reg"ecx"
++
⇒
todo"saved cell"
2830Definition rgeneric_slot_copyrc : rctx c : cell : listline ≔
match c with
Celli _ CellValueTmpd lower
⇒
ins"mov" "q" memthread_cc_inline_buffer + eight × i "rsi"; reg"rax"
::
rstore_keyrc "rax" KTmpd
++
match lower with
⇒
ins"mov" "q" memthread_cc_inline_aux_buffer + eight × i "rsi"; reg"rax" :: slot_storerc_cxrc "rax" KLowerKTmpl
Some_
⇒
todo"result lower"
None
⇒
[ ]
_
⇒
todo"result cell"
2845Definition rgeneric_resultsrc : rctx need : Z results : listcell retok : string : listline ≔
match results with
[ ]
⇒
need =? 0
→
[ ]
else
todo"generic results"
_
⇒
slot_loadrc_cxrc KThread "rsi" ++ ins"cmp" "q" immneed; reg"rdx"; ins0"jae" symretok; ins"mov" "q" reg"rdx"; reg"rdi"; ins"mov" "l" immneed; reg"esi"; ins"xor" "l" reg"edx"; reg"edx"; ins0"call" plt"filc_cc_rets_check_failure"; ins0"ud2" [ ]; labelretok ++ flat_maprgeneric_slot_copyrc results
2862Definition rindirect_callrc : rctx b : name index : string sig : Z r : protocol ws : listword c : channels size : Z cells : listcell need : Z results : listcell : listline ≔
let cx ≔ rc_cxrc in
let exc ≔ special_labelcx "exc" in
let generic ≔ local_labelcx b index "generic" in
let done ≔ local_labelcx b index "done" in
ins"movabs" "q" immsig; reg"rsi"; ins"cmp" "q" reg"rsi"; memfunction_object_signature "rcx"; ins0"jne" symgeneric ++ rfast_callrc r ws None ++ rfast_resultrc r c ++ ins0"jmp" symdone; labelgeneric ++ outline_ensurecx size local_labelcx b index "outline" ++ flat_maprgeneric_call_argrc cells ++ slot_loadcx KThread "rdi" ++ slot_loadcx KAux "rsi" ++ ins"mov" "l" immsize; reg"edx"; ins"call" "q" indmemfunction_object_generic_entry "rsi"; ins"test" "b" imm1; reg"al"; ins0"jnz" symexc ++ rgeneric_resultsrc need results local_labelcx b index "retok" ++ labeldone
2886Definition rgetter_callrc : rctx target : operand d : name : listline ≔
let cx ≔ rc_cxrc in
slot_loadcx KThread "rdi" ++ ins"lea" "q" riporigin_labelcx_namecx "c"; reg"rsi"; ins0"call" target; ins"mov" "q" reg"rdx"; reg"rcx" ++ rflight_storerc d
2894Definition rva_arg_loadrc : rctx b : name index : string k : class d : name : listline ≔
let cx ≔ rc_cxrc in
match k with
⇒
ins"mov" "l" mem0 "rax"; reg"eax" :: rstore_keyrc "rax" KTmpd
⇒
ins"mov" "q" mem0 "rax"; reg"rax" :: rstore_keyrc "rax" KTmpd
⇒
ins"fld" "t" mem0 "rax" :: x87_popcx d
⇒
let none ≔ local_labelcx b index "va_none" in
let have ≔ local_labelcx b index "va_have" in
ins"xor" "l" reg"ecx"; reg"ecx"; ins"test" "q" reg"rdx"; reg"rdx"; ins0"jz" symnone; ins"mov" "q" mem0 "rdx"; reg"rcx"; ins"test" "b" imm1; reg"cl"; ins0"jz" symhave; ins"and" "q" imm−2; reg"rcx"; ins"mov" "q" mem8 "rcx"; reg"rcx"; labelhave; labelnone; ins"mov" "q" mem0 "rax"; reg"rax" ++ rflight_storerc d
_
⇒
todo"va_arg class"
2918Definition raction_linesrc : rctx b : name index : string a : action : listline ≔
let cx ≔ rc_cxrc in
match a with
AInvoket r ws
⇒
⇒
[ ]
ADispatchp sig r ws c size cells need results
⇒
rflight_loadrc p ++ function_checkspecial_labelcx "notfn" ++ slot_storecx "rcx" KAux ++ rindirect_callrc b index sig r ws c size cells need results
⇒
let getter ≔ getter_symbolname_texts in
let null ≔ local_labelcx b index "weak_null" in
let done ≔ local_labelcx b index "weak_done" in
ins"cmp" "q" imm0; gotpcrelgetter; ins0"je" symnull ++ rgetter_callrc pltgetter d ++ ins0"jmp" symdone; labelnull; ins"xor" "l" reg"eax"; reg"eax"; ins"xor" "l" reg"ecx"; reg"ecx" ++ rflight_storerc d ++ labeldone
⇒
rflight_loadrc Tmpva_snapshot ++ rloadrc Constoff L "d" ++ ins"add" "q" reg"rdx"; reg"rax" ++ rflight_storerc d
AConsumeVak p size d
⇒
rflight_loadrc p ++ ins"mov" "q" reg"rax"; reg"rdi"; ins"mov" "q" reg"rcx"; reg"rsi"; ins"mov" "l" immsize; reg"edx"; ins"mov" "l" immsize; reg"ecx"; ins0"call" plt"filc_get_next_ptr_bytes_for_va_arg" ++ rva_arg_loadrc b index k d
⇒
match nm_findx cx_localscx with
None
⇒
todo"no local"
Somes
⇒
let words ≔ ls_paddeds / eight in
zero_wordsZ.to_natwords −ls_payloads ++ zero_wordsZ.to_natwords eight − ls_auxs ++ ins"mov" "q" immwords; mem−ls_auxs "rbp"; ins"lea" "q" mem−ls_auxs "rbp"; reg"rax" ++ slot_storecx "rax" KStackAuxx

Emitting instructions, returns, branches and blocks

2973Definition rpinst_linesrc : rctx b : name i : Z pi : pinst : listline ≔
let cx ≔ rc_cxrc in
let index ≔ decimali in
match pi with
PAbiacts
⇒
flat_mapraction_linesrc b index acts
PInstFPlainLetd k o args
⇒
rlet_linesrc b index d k o args
PInstFPlainFlightd o args lower
⇒
rflight_linesrc d o args lower
⇒
todo"plain instruction"
PInstFFusedCheck_ size r align a
⇒
match access_placea with
⇒
rflight_loadrc p ++ access_checkcx mkKindsize rights_writer align ++ rraw_accessrc b index a
⇒
todo"heap check at a local"
PInstFFusedCheckLocalx off size r align a
⇒
local_checkcx b index x off mkKindsize rights_writer align ++ rlocal_raw_accessrc b index a
⇒
todo"fused check"
⇒
match access_placea with
⇒
let off ≔ access_offseta in
match a with
⇒
++
off =? 0
→
[ ]
else
ins"add" "q" immoff; reg"rax"
_
⇒
match p with
Tmpnp
⇒
match nm_findnp rc_regrc with
Somehrp
⇒
ins"lea" "q" memoff hreg64hrp; reg"rax"
None
⇒
rloadrc p L "a"
++
off =? 0
→
[ ]
else
ins"add" "q" immoff; reg"rax"
_
⇒
rloadrc p L "a"
++
off =? 0
→
[ ]
else
ins"add" "q" immoff; reg"rax"
++
rraw_accessrc b index a
⇒
todo"reused access at a local"
⇒
todo"call that is not lowered"
3021Definition reinst_linesrc : rctx b : name ei : einst : listline ≔
match ei with
EPlaini pi
⇒
rpinst_linesrc b i pi
EFlightFused_ i2 _ o args lw ck a
⇒
let addr_code ≔ rflight_addr_intorc o args None "rax" in
let lower_code ≔
match lw with
⇒
rlower_loadrc p "rcx"
⇒
ins"xor" "l" reg"ecx"; reg"ecx"
in
addr_code ++ lower_code ++ access_checkrc_cxrc ck ++ rraw_accessrc b decimali2 a
3037Fixpoint reinsts_lines_accrc : rctx b : name eis : listeinst acc : listline : listline ≔
match eis with
[ ]
⇒
rev'acc
ei :: eis′
⇒
reinsts_lines_accrc b eis′ rev_appendreinst_linesrc b ei acc
3044Definition rret_valuerc : rctx r : ret_type v : value : listline ≔
match r with
⇒
rloadrc v L "d" ++ rlower_loadrc v "rcx"
⇒
rloadrc v W "d"
⇒
rloadrc v L "d"
⇒
rloadrc v Single "a" ++ to_xmmSingle "a" "xmm0"
⇒
rloadrc v Double "a" ++ to_xmmDouble "a" "xmm0"
_
⇒
todo"return class"
3054Fixpoint rtyped_return_loads_accrc : rctx ws : listret_word rs : listresult_reg acc : listline : listline ≔
match ws, rs with
[ ], [ ]
⇒
rev'acc
w :: ws′, r :: rs′
⇒
let cur ≔
match w, r with
RwValk v, RrXmm_ x
⇒
rloadrc v k "a" ++ to_xmmk "a" x
⇒
rloadrc v k g
⇒
rloadrc v L g
_, _
⇒
todo"typed return word"
in
rtyped_return_loads_accrc ws′ rs′ rev_appendcur acc
_, _
⇒
rev_appendacc todo"typed return words"
3071Fixpoint rbuffer_words_accrc : rctx ws : listword off : Z acc : listline : listline ≔
match ws with
[ ]
⇒
rev'acc
Wf_ s :: ws′
⇒
let cur ≔
match s with
⇒
rlower_loadrc v "rcx" ++ ins"mov" "q" reg"rcx"; memoff "rax"
⇒
rloadrc v L "d" ++ ins"mov" "q" reg"rdx"; memoff "rax"
_
⇒
todo"buffer word"
in
rbuffer_words_accrc ws′ off + eight rev_appendcur acc
3084Definition rselected_branchrc : rctx c : cond t f : target from : name next : optionname : listline ≔
let cx ≔ rc_cxrc in
let t_moves ≔ redge_movesrc from t "t" in
let f_moves ≔ redge_movesrc from f "f" in
let t_plain ≔
match t_moves with
[ ]
⇒
true
_
⇒
false
in
let f_plain ≔
match f_moves with
[ ]
⇒
true
_
⇒
false
in
let to_false ≔ jump_ifnegatedc block_labelcx edge_labelf in
to_nextt next && t_plain && f_plain
→
to_false
t_plain
→
++
to_nextf next
→
f_moves
else
f_moves ++ ins0"jmp" symblock_labelcx edge_labelf
f_plain
→
to_false
++
to_nextt next
→
t_moves
else
t_moves ++ ins0"jmp" symblock_labelcx edge_labelt
else
let false_label ≔ local_labelcx from "jnz" "false" in
jump_ifnegatedc false_label
++
t_moves
++
ins0"jmp" symblock_labelcx edge_labelt; labelfalse_label
++
to_nextf next
→
f_moves
else
f_moves ++ ins0"jmp" symblock_labelcx edge_labelf
3108Definition rpjump_linesrc : rctx from : name next : optionname j : pjump : listline ≔
let cx ≔ rc_cxrc in
match j with
⇒
rselected_edgerc from t "j" next
⇒
let test_code ≔
match v with
Tmpnv
⇒
match nm_findnv rc_regrc with
Somehrv
⇒
ins"test" "l" reghreg32hrv; reghreg32hrv
None
⇒
rloadrc v W "a" ++ ins"test" "l" reg"eax"; reg"eax"
_
⇒
rloadrc v W "a" ++ ins"test" "l" reg"eax"; reg"eax"
in
test_code ++ rselected_branchrc Ne t f from next
⇒
ins0"jmp" symspecial_labelcx "unreachable"
⇒
todo"a return that is not lowered"
⇒
rret_valuerc r v ++ frame_popcx ++ rsuccessrc p
⇒
slot_loadcx KRetbuf "rax" ++ rbuffer_words_accrc ws eight [ ] ++ ins"mov" "b" imm0; mem0 "rax" ++ frame_popcx ++ rleave_retrc
⇒
let ws ≔ typed_return_wordsks vs in
match result_registersmapret_word_class ws "d"; "c" "xmm0"; "xmm1" with
Somers
⇒
None
⇒
todo"result registers"
++
⇒
rloadrc v1 L "d" ++ rloadrc v2 L "c" ++ frame_popcx ++ rsuccessrc Registers
⇒
todo"return_registers"
3144Definition rejump_linesrc : rctx from : name next : optionname ej : ejump : listline ≔
match ej with
⇒
rpjump_linesrc from next j
EJumpCmpc ck x y t f
⇒
rcompare_flagsrc ck x y ++ rselected_branchrc c t f from next
EJumpLetCmp_ k1 o1 args1 c ck y t f
⇒
let half ≔
match ck with
⇒
true
_
⇒
false
in
rint_op_intorc o1 k1 args1 None "rax" "eax" ++ rcompare_with_regrc half reg_name"a" half y ++ rselected_branchrc c t f from next
3157Fixpoint reblocks_lines_accrc : rctx ebs : listeblock acc : listline : listline ≔
match ebs with
[ ]
⇒
rev'acc
eb :: ebs′
⇒
let next ≔
match ebs′ with
eb′ :: _
⇒
Someeb_labeleb′
[ ]
⇒
None
in
let from ≔ eb_labeleb in
let blk ≔ labelblock_labelrc_cxrc from :: reinsts_lines_accrc from eb_instseb [ ] ++ rejump_linesrc from next eb_jumpeb in
reblocks_lines_accrc ebs′ rev_appendblk acc

Top-level function and module emission

Compile f and its ABI plan p with register allocation, returning None if valid_alloc rejects the assignment.

3174Definition function_code_allocatedf : func p : plan : optionlistline ≔
let bparams ≔ body_paramsf in
let 'tmap, cmap, rev_names, _ ≔ number_func_blocksfn_blocksf number_paramsbparams nm_empty, ZMap.emptyclass, [ ], O in
let names ≔ rev'rev_names in
let ebs ≔ build_eblocks_accreads pl_blocksp [ ] in
let bmap ≔ number_eblocks_labelsebs O nm_empty in
let rbs ≔ eblocks_to_r_acctmap bmap O ebs [ ] in
let param_tids ≔ names_to_tidstmap mapsnd bparams in
let va_tid ≔ nm_findva_snapshot tmap in
let* rm ≔ allocate_regscmap va_tid param_tids rbs in
let rc ≔ build_rctxp names cmap rm in
let cx ≔ rc_cxrc in
let impl ≔ impl_symbolpl_sigp cx_namecx in
let bs ≔ pl_blocksp in
let kinds ≔ access_check_kindsbs in
SomeDirDSectionSText; p2align4 ++ linkage_globlpl_linkagep impl ++ DirDTypeLSymimpl LSym"function"; labelimpl ++ rentry_linesrc p ++ reblocks_lines_accrc ebs [ ] ++ labelspecial_labelcx "exc" ++ rexc_exit_linesrc pl_returnp ++ flat_mapcheck_fail_blockcx kinds ++ not_function_blockcx bs ++ unreachable_blockcx bs ++ DirDSizeLSymimpl ++ function_object_linescx p impl ++ originscx p kinds ++ unreachable_messagecx bs

Lines of one module item under register allocation.

3208Definition item_code_allocatedsy : symbols it : item : optionlistline ≔
match it with
⇒
None
IDatan lk align items
⇒
Somedata_linesn lk align items
IAliasn lk target
⇒
Somealias_linessy n lk target
3218Definition wrap_single_linesls : listline : listlistline ≔
ls
3220Definition item_piece_allocatedsy : symbols it : item _ : unit : optionlistlistline ≔
3224Definition thunks_piece_allocatedsy : symbols md : module _ : unit : optionlistlistline ≔
option_mapmapthunk_lines lower_thunkssy md

Pieces of a module compiled with register allocation.

3229Definition module_code_allocatedmd : module : listunit → optionlistlistline ≔