Fil-C on Nix

Filnix wiki

the formal campaign

rocq/backend/Emit.v

The code of a function from its plan: filc_amd64.pl's function//2 with every temporary in its stack slot, which is what --registers=stack selects there. The lines are the Prolog compiler's, one for one, which the backend's gate checks on the corpus (emit.sh).

What is not ported yet is a todo line (Layout.v).

From Stdlib Require Import String ZArith List Bool
From Nanofil Require Import Term Syntax Maps
From Backend Require Import Text Asm Plan PlanTerm Layout EmitOps EmitInst EmitObject
Import ListNotations
Open Scope string_scope
Open Scope Z_scope
Open Scope list_scope

The frame's entry and exit

As entry_regs_shift//1: a buffered return's entry has the buffer in %rdi and the thread in %rsi.

20Definition entry_regs_shiftr : protocol : listline ≔
match r with
⇒
[ ]
⇒
ins"mov" "q" reg"rdi"; reg"rax"; ins"mov" "q" reg"rsi"; reg"rdi"

As lowers_zeroing//2: zero lowers[0..n), so that the collector sees no stale lower.

28Fixpoint lower_entry_storesfuel : nat i base : Z : listline ≔
match fuel with
O
⇒
[ ]
Sfuel′
⇒
ins"mov" "q" reg"rax"; memsixteen + eight × i − base "rbp" :: lower_entry_storesfuel′ i + 1 base
35Definition lowers_zeroingn base : Z : listline ≔
n >? 0
→
ins"xor" "l" reg"eax"; reg"eax" :: lower_entry_storesZ.to_natn 0 base
else
[ ]

As incoming_word//4: a word of the fast convention from its location into its slot; an integer register goes straight there, the rest through %rax.

43Definition incoming_wordcx : ctx l : location w : word : listline ≔
match w with
⇒
match l with
⇒
from_xmmk x "a" ++ slot_storecx "rax" t
⇒
match class_halfk with
Somehalf
⇒
ins"mov" class_suffixhalf memsixteen + eight × i "rbp"; regreg_name"a" half :: slot_storecx "rax" t
None
⇒
todo"incoming class"
_
⇒
todo"incoming source"
60Fixpoint typed_incomingcx : ctx ws : listword ls : listlocation : listline ≔
match ws, ls with
w :: ws′, l :: ls′
⇒
incoming_wordcx l w ++ typed_incomingcx ws′ ls′
_, _
⇒
[ ]

The entry of a function: native_frame, stack_check, save_thread, save_return, zero_roots, push_frame(c) and receive. There are no setjmp sites to snapshot.

69Definition entry_linescx : ctx p : plan : listline ≔
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"
++
let 'ls, _, _ ≔ typed_locationspl_incomingp ret in

As frame_pop//1: the thread's top frame back to this frame's parent.

91Definition frame_popcx : ctx : listline ≔
slot_loadcx KThread "rsi" ++ ins"mov" "q" mem−cx_basecx "rbp"; reg"rdi"; ins"mov" "q" reg"rdi"; memthread_top_frame "rsi"
96Definition leave_ret: listline ≔
ins0"leave" [ ]; ins0"ret" [ ]

The exception exit: pop_frame, then exception(Return), which sets has_exception in %al or in the return buffer.

100Definition exit_linescx : ctx ret : protocol : listline ≔
++
match ret with
⇒
ins"mov" "b" imm1; reg"al"
⇒
slot_loadcx KRetbuf "rax" ++ ins"mov" "b" imm1; mem0 "rax"
++

Edges

As pollcheck//3: call the runtime if the thread's state asks.

111Definition pollcheckcx : ctx block : name tag : string : listline ≔
let no_poll ≔ local_labelcx block tag "poll" in
slot_loadcx KThread "rdi" ++ ins"test" "b" imm14; memthread_state "rdi"; ins0"jz" symno_poll; ins"lea" "q" riporigin_labelcx_namecx "n"; reg"rsi"; ins0"call" plt"filc_pollcheck_slow"; labelno_poll
120Fixpoint pair_valuefrom : name pairs : listname × value : optionvalue ≔
match pairs with
[ ]
⇒
None
l, v :: pairs′
⇒
term_eqbl from
→
Somev
else
pair_valuefrom pairs′

As phi_read//5: the value a phi takes from the block from, into the phi's shadow slots.

128Definition phi_readcx : ctx from : name ph : phi : listline ≔
match ph with
Phid k pairs
⇒
match pair_valuefrom pairs with
None
⇒
todo"phi without a value for the edge"
Somev
⇒
match k with
⇒
loadcx v L "a" ++ slot_storecx "rax" KShadowd ++ lower_loadcx v "rax" ++ slot_storecx "rax" KLowerKShadowd
⇒
loadcx v k "a" ++ slot_storecx "rax" KShadowd
_
⇒
todo"phi class"

As phi_writes//2: each phi's shadow into the phi.

145Definition phi_writecx : ctx ph : phi : listline ≔
match ph with
Phid k _
⇒
++
slot_storecx "rax" KTmpd
++
match k with
_
⇒
[ ]

As edge_moves//4: the parallel copy of the target's phis, then the pollcheck if the target asks for one.

157Definition edge_movescx : ctx from : name t : target tag : string : listline ≔
let phis ≔
Somephis
⇒
phis
None
⇒
[ ]
in
flat_mapphi_readcx from phis
++
flat_mapphi_writecx phis
++
match t with
⇒
pollcheckcx from tag
⇒
[ ]

As edge//4: the moves of the edge, then the jump.

164Definition edgecx : ctx from : name t : target tag : string : listline ≔
edge_movescx from t tag ++ ins0"jmp" symblock_labelcx edge_labelt

Returns

As success(registers): has_exception = 0 in %al.

170Definition successr : protocol : listline ≔
match r with
⇒
ins"xor" "l" reg"eax"; reg"eax" :: leave_ret
⇒
todo"success of a buffered return"

As ret_value//3: the returned value in %rdx, with its lower in %rcx for a pointer; a float in %xmm0.

178Definition ret_valuecx : ctx r : ret_type v : value : listline ≔
match r with
⇒
loadcx v L "d" ++ lower_loadcx v "rcx"
⇒
loadcx v W "d"
⇒
loadcx v L "d"
⇒
loadcx v Single "a" ++ to_xmmSingle "a" "xmm0"
⇒
loadcx v Double "a" ++ to_xmmDouble "a" "xmm0"
_
⇒
todo"return class"

A word of a returned tuple.

189Inductive ret_word: Type ≔
|RwVal
k : class v : value
|RwAddr
v : value
|RwLower
v : value

As typed_return_word/4: a pointer is its address and its lower.

196Fixpoint typed_return_wordsks : listclass vs : listvalue : listret_word ≔
match ks, vs with
k :: ks′, v :: vs′
⇒
match k with
⇒
RwAddrv :: RwLowerv :: typed_return_wordsks′ vs′
_
⇒
RwValk v :: typed_return_wordsks′ vs′
_, _
⇒
[ ]

The class of a word of a returned tuple.

207Definition ret_word_classw : ret_word : class ≔
match w with
⇒
k

As typed_return_loads//4 and typed_return_load//5: each word into the register result_registers/2 gives it, here by its short name.

213Fixpoint typed_return_loadscx : ctx ws : listret_word rs : listresult_reg : listline ≔
match ws, rs with
[ ], [ ]
⇒
[ ]
w :: ws′, r :: rs′
⇒
match w, r with
RwValk v, RrXmm_ x
⇒
loadcx v k "a" ++ to_xmmk "a" x
⇒
loadcx v k g
⇒
loadcx v L g
_, _
⇒
todo"typed return word"
++
typed_return_loadscx ws′ rs′
_, _
⇒
todo"typed return words"

As buffer_words//3: the words of a buffered return into the buffer at %rax, each a full eightbyte.

230Fixpoint buffer_wordscx : ctx ws : listword off : Z : listline ≔
match ws with
[ ]
⇒
[ ]
Wf_ s :: ws′
⇒
match s with
⇒
lower_loadcx v "rcx" ++ ins"mov" "q" reg"rcx"; memoff "rax"
⇒
loadcx v L "d" ++ ins"mov" "q" reg"rdx"; memoff "rax"
_
⇒
todo"buffer word"
++
buffer_wordscx ws′ off + eight

Jumps

As jump//3: the code that ends the block from.

245Definition jump_linescx : ctx from : name j : pjump : listline ≔
match j with
⇒
edgecx from t "j"
⇒
let false_label ≔ local_labelcx from "jnz" "false" in
loadcx v W "a" ++ ins"test" "l" reg"eax"; reg"eax"; ins0"jz" symfalse_label ++ edgecx from t "t" ++ labelfalse_label ++ edgecx from f "f"
⇒
ins0"jmp" symspecial_labelcx "unreachable"
⇒
todo"a return that is not lowered"
⇒
ret_valuecx r v ++ frame_popcx ++ successp
⇒
slot_loadcx KRetbuf "rax" ++ buffer_wordscx ws eight ++ ins"mov" "b" imm0; mem0 "rax" ++ frame_popcx ++ leave_ret
⇒
let ws ≔ typed_return_wordsks vs in
match result_registersmapret_word_class ws "d"; "c" "xmm0"; "xmm1" with
Somers
⇒
None
⇒
todo"result registers"
++
⇒
loadcx v1 L "d" ++ loadcx v2 L "c" ++ frame_popcx ++ successRegisters
⇒
todo"return_registers"

Blocks

277Fixpoint insts_linescx : ctx b : name i : Z is : listpinst : listline ≔
match is with
[ ]
⇒
[ ]
pi :: is′
⇒
inst_linescx b i pi ++ insts_linescx b i + 1 is′

As block_code//3: a block's label, instructions and jump.

284Definition block_linescx : ctx b : pblock : listline ≔

Branch selection

As the branch selection of filc_amd64.pl (docs/perf.md). A block whose last instruction is an integer comparison that only the block's branch reads branches on the comparison's flags. A branch whose edge has no phi copy and no poll jumps straight to its block. An edge to the next block falls through.

One more occurrence of the temporary n.

298Definition count_tempn : name m : nmapZ : nmapZ ≔
match nm_findn m with
Somec
⇒
c + 1
None
⇒
1
m

As temp_names//1: each occurrence of tmp(N) in the term t counted into m. The name N is not searched.

303Fixpoint count_tempst : term m : nmapZ : nmapZ ≔
let fix count_list ts : listterm m : nmapZ : nmapZ ≔
match ts with
[ ]
⇒
m
t :: ts′
⇒
count_listts′ count_tempst m
in
match t with
TAppf args
⇒
match args with
n
⇒
_
⇒
count_listargs m
⇒
count_listts m
⇒
m

As branch_selection/3: how many times each temporary occurs in the blocks of the plan, its definition included.

321Definition temp_usesbs : listpblock : nmapZ ≔
fold_leftλm b ⇒ count_tempspblock_termb m bs nm_empty

As negated/2, on the comparison.

325Definition negatedc : cond : cond ≔
match c with
⇒
⇒
Le | Lt | Ge | Gt | Ord | Unord
⇒
c

The jump to the label l when the flags hold the comparison c.

336Definition jump_ifc : cond l : string : listline ≔
match cond_codec with
Somecc
⇒
ins0"j" ++ cc syml
None
⇒
todo"branch condition"
342Definition two31: Z ≔
2147483648

As integer_immediate/3: the signed 32-bit immediate that stands for the constant n: always at a word, and at a long only when sign extension gives n back.

347Definition integer_immediatehalf : bool n : Z : optionZ ≔
half
→
Somen + two31 mod two32 − two31
else
let u ≔ n mod two64 in
let v ≔
u ≥? two63
→
u − two64
else
u
in
−two31 ≤? v && v ≤? two31 − 1
→
Somev
else
None

As plain_edge/2: an edge to a block without phis, and without a poll.

356Definition plain_edgecx : ctx t : target : bool ≔
match t with
⇒
false
⇒
match nm_findl cx_phiscx with
Some[ ]
⇒
true
_
⇒
false

Whether the edge goes to the next block.

363Definition to_nextt : target next : optionname : bool ≔
match next with
None
⇒
false

As selected_edge//5: the edge without its jump when it goes to the next block.

371Definition selected_edgecx : ctx from : name t : target tag : string next : optionname : listline ≔
to_nextt next
→
edge_movescx from t tag
else
edgecx from t tag

As selected_branch//6: the flags hold c exactly when the branch goes to t.

377Definition selected_branchcx : ctx c : cond t f : target from : name next : optionname : listline ≔
let to_false ≔ jump_ifnegatedc block_labelcx edge_labelf in
to_nextt next && plain_edgecx t && plain_edgecx f
→
to_false
→
jump_ifc block_labelcx edge_labelt ++ selected_edgecx from f "f" next
→
to_false ++ selected_edgecx from t "t" next
else
let false_label ≔ local_labelcx from "jnz" "false" in
jump_ifnegatedc false_label ++ edgecx from t "t" ++ labelfalse_label ++ selected_edgecx from f "f" next

As the compare clause of selected_jump//4: x and y compared at the class k, y as an immediate when it is a constant that fits one.

395Definition compare_flagscx : ctx k : class x y : value : listline ≔
match k with
W | L
⇒
let half ≔
match k with
⇒
true
_
⇒
false
in
let a ≔ regreg_name"a" half in
loadcx x k "a"
++
match match y with Constn ⇒ integer_immediatehalf n | _ ⇒ None end with
Somev
⇒
ins"cmp" class_suffixhalf immv; a
None
⇒
loadcx y k "c" ++ ins"cmp" class_suffixhalf regreg_name"c" half; a
_
⇒
todo"compare class"

The instructions before the last, and the last.

410Fixpoint split_lastA : Type xs : listA : optionlistA × A ≔
match xs with
[ ]
⇒
None
x :: xs′
⇒
match split_lastxs′ with
None
⇒
Some[ ], x
Someinit, last
⇒
Somex :: init, last

As compare_branch/5: the instructions before a last integer comparison that only the block's branch reads, with the comparison and the two targets.

423Definition compare_branchuses : nmapZ b : pblock : optionlistpinst × cond × class × value × value × target × target ≔
match pb_jumpb with
⇒
match split_lastpb_instsb with
Someinit, PInstFPlainLetd′ W Cmpc k x; y
⇒
name_eqbd d′
&&
match k with
W | L
⇒
true
_
⇒
false
&&
match nm_findd uses with
Somen
⇒
n =? 2
None
⇒
false
→
Someinit, c, k, x, y, t, f
else
None
_
⇒
None
_
⇒
None

As block_code//3 with selected branches: next is the label of the block after b.

441Definition selected_blockcx : ctx uses : nmapZ next : optionname b : pblock : listline ≔
let from ≔ pb_labelb in
::
match compare_branchuses b with
Someinit, c, k, x, y, t, f
⇒
insts_linescx from 0 init ++ compare_flagscx k x y ++ selected_branchcx c t f from next
None
⇒
++
match pb_jumpb with
⇒
loadcx v W "a" ++ ins"test" "l" reg"eax"; reg"eax" ++ selected_branchcx Ne t f from next
⇒
selected_edgecx from t "j" next
j
⇒
jump_linescx from j
462Fixpoint selected_blockscx : ctx uses : nmapZ bs : listpblock : listline ≔
match bs with
[ ]
⇒
[ ]
b :: bs′
⇒
match bs′ with
b′ :: _
⇒
Somepb_labelb′
[ ]
⇒
None
b
++
selected_blockscx uses bs′

The code of the blocks: with selected branches, or as the reference, which stores a comparison's boolean, tests it and jumps on both arms.

473Definition blocks_linesselected : bool cx : ctx bs : listpblock : listline ≔
selected
→
else
flat_mapblock_linescx bs

The shared failure blocks

478Definition kind_leba b : check_kind : bool ≔
→
true
→
false
else
484Definition kind_eqba b : check_kind : bool ≔

k into the sorted ks, once, as sort/2 orders k(Size, Write, Align).

489Fixpoint kind_insertk : check_kind ks : listcheck_kind : listcheck_kind ≔
match ks with
[ ]
⇒
k
k′ :: ks′
⇒
kind_eqbk k′
→
ks
kind_lebk k′
→
k :: ks
else
k′ :: kind_insertk ks′

As inst_check_kind/2: the kind of check an instruction's access needs, if it has one.

500Definition inst_check_kindpi : pinst : optioncheck_kind ≔
match pi with
PInstFFusedCheck_ size r align _
⇒
SomemkKindsize rights_writer align
PInstFFusedCheckLocal_ _ size r align _
⇒
SomemkKindsize rights_writer align
_
⇒
None

As access_check_kinds/2: the distinct kinds of a function, in order.

509Definition access_check_kindsbs : listpblock : listcheck_kind ≔
fold_left
λ ks b  ⇒
fold_left
λ ks pi  ⇒
match inst_check_kindpi with
Somek
⇒
None
⇒
ks
ks
bs
[ ]

As check_fail_blocks//2: a failure block for each kind, which calls the runtime's reporter.

520Definition check_fail_blockcx : ctx k : check_kind : listline ≔
labelcheck_fail_labelcx k; ins"mov" "q" reg"rax"; reg"rdi"; ins"mov" "q" reg"rcx"; reg"rsi"; ins"lea" "q" ripcheck_origin_labelcx_namecx k; reg"rdx"; ins0"call" plt"filc_optimized_access_check_fail"; ins0"ud2" [ ]
528Definition has_dispatchbs : listpblock : bool ≔
existsb
λ b  ⇒
existsb
λ pi  ⇒
match pi with
PAbiacts
⇒
existsb
λ a  ⇒
match a with
ADispatch_ _ _ _ _ _ _ _ _
⇒
true
_
⇒
false
acts
_
⇒
false
bs
538Definition has_unreachablebs : listpblock : bool ≔
existsb
λ b  ⇒
match pb_jumpb with
_
⇒
false
bs

As not_function_block//2: where a call through a pointer that is not a function's goes.

543Definition not_function_blockcx : ctx bs : listpblock : listline ≔
→
labelspecial_labelcx "notfn"; ins"mov" "q" reg"rax"; reg"rdi"; ins"mov" "q" reg"rcx"; reg"rsi"; ins0"call" plt"filc_check_function_call_fail"; ins0"ud2" [ ]
else
[ ]
552Definition unreachable_message_labelname : string : string ≔
".L" ++ name ++ "..unreachable_msg"

As unreachable_block//2: filc_error(Message, Origin), as clang's code panics at a reached unreachable.

557Definition unreachable_blockcx : ctx bs : listpblock : listline ≔
→
labelspecial_labelcx "unreachable"; ins"lea" "q" ripunreachable_message_labelcx_namecx; reg"rdi"; ins"lea" "q" riporigin_labelcx_namecx "n"; reg"rsi"; ins0"call" plt"filc_error"; ins0"ud2" [ ]
else
[ ]
566Definition unreachable_messagecx : ctx bs : listpblock : listline ≔

Origins

574Definition longn : Z : line ≔
575Definition zeron : Z : line ≔
576Definition p2alignn : Z : line ≔

As function_origin//7: a function origin and the origin that points at it.

580Definition function_originname name_label which : string nlowers can_catch nlocals : Z : listline ≔
let forigin ≔ ".L" ++ name ++ "..forigin_" ++ which%string in
labelforigin; quad_symname_label; quad_int0; longnlowers; zero4; quad_int0; DirDByteLInt0 LIntcan_catch; zero2; long0; longnlocals; zero4; labelorigin_labelname which; quad_symforigin; long0; long0

As check_origins//2: an origin for each kind of check.

593Definition check_originname : string k : check_kind : listline ≔
let origin ≔ origin_labelname "n" in

As origins//3: the name's text, the catching and the plain function origin, and the check origins.

602Definition originscx : ctx p : plan kinds : listcheck_kind : listline ≔
let name ≔ cx_namecx in
let name_label ≔ ".L" ++ name ++ "..name"%string in
let nroots ≔ Zlengthfr_rootspl_framep in
DirDSectionSRodata; labelname_label; DirDAscizLSymname; DirDSectionSDataRelRo; p2align4 ++ function_originname name_label "c" nroots 1 pl_nlocalsp ++ function_originname name_label "n" nroots 0 pl_nlocalsp ++ flat_mapcheck_originname kinds

The function

As linkage_globl//2.

615Definition linkage_globllinkage : term s : string : listline ≔
match linkage with
⇒
else
[ ]
_
⇒
[ ]

As function//2: the implementation (the entry, the blocks, the shared exception exit and the failure blocks), then the function object and the origins.

627Definition function_codeselected : bool p : plan : listline ≔
let cx ≔ plan_ctxp in
let impl ≔ impl_symbolpl_sigp cx_namecx in
let bs ≔ pl_blocksp in
let kinds ≔ access_check_kindsbs in
DirDSectionSText; p2align4 ++ linkage_globlpl_linkagep impl ++ DirDTypeLSymimpl LSym"function"; labelimpl ++ entry_linescx p ++ blocks_linesselected cx bs ++ labelspecial_labelcx "exc" ++ exit_linescx 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

The reference: no branch is selected.

648Definition function_lines: plan → listline ≔