RISC code output
TODO: fix wrong order for conversion in cfgrisc
This commit is contained in:
elvis
244
lib/miniImp/RISC.ml
Normal file
244
lib/miniImp/RISC.ml
Normal file
@ -0,0 +1,244 @@
|
||||
let globalCounterLabel = ref 0
|
||||
|
||||
let nextLabel () : string =
|
||||
globalCounterLabel := !globalCounterLabel + 1;
|
||||
"l" ^ (string_of_int !globalCounterLabel)
|
||||
|
||||
module RISCAssembly = struct
|
||||
type register = {
|
||||
index : int
|
||||
}
|
||||
|
||||
type label =
|
||||
string
|
||||
|
||||
type risci =
|
||||
| Nop
|
||||
| BRegOp of brop * register * register * register
|
||||
| BImmOp of biop * register * int * register
|
||||
| URegOp of urop * register * register
|
||||
| Load of register * register
|
||||
| LoadI of register * int
|
||||
| Store of register * register
|
||||
| Jump of label
|
||||
| CJump of register * label * label
|
||||
| Label of label
|
||||
and brop =
|
||||
| Add
|
||||
| Sub
|
||||
| Mult
|
||||
| Div
|
||||
| Mod
|
||||
| Pow
|
||||
| And
|
||||
| Or
|
||||
| Eq
|
||||
| Less
|
||||
| LessEq
|
||||
| More
|
||||
| MoreEq
|
||||
and biop =
|
||||
| AddI
|
||||
| SubI
|
||||
| MultI
|
||||
| DivI
|
||||
| ModI
|
||||
| PowI
|
||||
| AndI
|
||||
| OrI
|
||||
| EqI
|
||||
| LessI
|
||||
| LessEqI
|
||||
| MoreI
|
||||
| MoreEqI
|
||||
and urop =
|
||||
| Not
|
||||
| Copy
|
||||
| Rand
|
||||
|
||||
type t = risci list
|
||||
|
||||
let pp (ppf: out_channel) (t: t) : unit =
|
||||
let rec pp_risci (ppf: out_channel) (v: risci) : unit =
|
||||
match v with
|
||||
Nop -> Printf.fprintf ppf "\tNop\n"
|
||||
| BRegOp (b, r1, r2, r3) -> Printf.fprintf ppf "\t%a r%d r%d => r%d\n" pp_brop b r1.index r2.index r3.index
|
||||
| BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "\t%a r%d %d => r%d\n" pp_biop b r1.index i r3.index
|
||||
| URegOp (u, r1, r2) -> Printf.fprintf ppf "\t%a r%d => r%d\n" pp_urop u r1.index r2.index
|
||||
| Load (r1, r2) -> Printf.fprintf ppf "\tLoad r%d => r%d\n" r1.index r2.index
|
||||
| LoadI (r2, i) -> Printf.fprintf ppf "\tLoadI %d => r%d\n" i r2.index
|
||||
| Store (r1, r2) -> Printf.fprintf ppf "\tStore r%d => r%d\n" r1.index r2.index
|
||||
| Jump (label) -> Printf.fprintf ppf "\tJump %s\n" label
|
||||
| CJump (r, l1, l2) -> Printf.fprintf ppf "\tCJump r%d => %s, %s\n" r.index l1 l2
|
||||
| Label (label) -> Printf.fprintf ppf "%s:" label
|
||||
and pp_brop (ppf: out_channel) (v: brop) : unit =
|
||||
match v with
|
||||
Add -> Printf.fprintf ppf "Add"
|
||||
| Sub -> Printf.fprintf ppf "Sub"
|
||||
| Mult -> Printf.fprintf ppf "Mult"
|
||||
| Div -> Printf.fprintf ppf "Div"
|
||||
| Mod -> Printf.fprintf ppf "Mod"
|
||||
| Pow -> Printf.fprintf ppf "Pow"
|
||||
| And -> Printf.fprintf ppf "And"
|
||||
| Or -> Printf.fprintf ppf "Or"
|
||||
| Eq -> Printf.fprintf ppf "Eq"
|
||||
| Less -> Printf.fprintf ppf "Less"
|
||||
| LessEq -> Printf.fprintf ppf "LessEq"
|
||||
| More -> Printf.fprintf ppf "More"
|
||||
| MoreEq -> Printf.fprintf ppf "MoreEq"
|
||||
and pp_biop (ppf: out_channel) (v: biop) : unit =
|
||||
match v with
|
||||
AddI -> Printf.fprintf ppf "AddI"
|
||||
| SubI -> Printf.fprintf ppf "SubI"
|
||||
| MultI -> Printf.fprintf ppf "MultI"
|
||||
| DivI -> Printf.fprintf ppf "DivI"
|
||||
| ModI -> Printf.fprintf ppf "ModI"
|
||||
| PowI -> Printf.fprintf ppf "PowI"
|
||||
| AndI -> Printf.fprintf ppf "AndI"
|
||||
| OrI -> Printf.fprintf ppf "OrI"
|
||||
| EqI -> Printf.fprintf ppf "EqI"
|
||||
| LessI -> Printf.fprintf ppf "LessI"
|
||||
| LessEqI -> Printf.fprintf ppf "LessEqI"
|
||||
| MoreI -> Printf.fprintf ppf "MoreI"
|
||||
| MoreEqI -> Printf.fprintf ppf "MoreEqI"
|
||||
and pp_urop (ppf: out_channel) (v: urop) : unit =
|
||||
match v with
|
||||
Not -> Printf.fprintf ppf "Nop"
|
||||
| Copy -> Printf.fprintf ppf "Copy"
|
||||
| Rand -> Printf.fprintf ppf "Rand"
|
||||
in
|
||||
List.iter (pp_risci ppf) t
|
||||
end
|
||||
|
||||
let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssembly.t) =
|
||||
let rec helper (i: CfgRISC.RISCSimpleStatements.t) : RISCAssembly.risci =
|
||||
match i with
|
||||
| Nop -> Nop
|
||||
| BRegOp (brop, r1, r2, r3) -> BRegOp (helper_brop brop,
|
||||
{index = r1.index},
|
||||
{index = r2.index},
|
||||
{index = r3.index})
|
||||
| BImmOp (biop, r1, imm, r3) -> BImmOp (helper_biop biop,
|
||||
{index = r1.index},
|
||||
imm,
|
||||
{index = r3.index})
|
||||
| URegOp (urop, r1, r3) -> URegOp (helper_urop urop,
|
||||
{index = r1.index},
|
||||
{index = r3.index})
|
||||
| Load (r1, r3) -> Load ({index = r1.index},
|
||||
{index = r3.index})
|
||||
| LoadI (r3, imm) -> LoadI ({index = r3.index},
|
||||
imm)
|
||||
| Store (r1, r3) -> Store ({index = r1.index},
|
||||
{index = r3.index})
|
||||
and helper_brop (brop: CfgRISC.RISCSimpleStatements.brop) : RISCAssembly.brop =
|
||||
match brop with
|
||||
| Add -> Add
|
||||
| Sub -> Sub
|
||||
| Mult -> Mult
|
||||
| Div -> Div
|
||||
| Mod -> Mod
|
||||
| Pow -> Pow
|
||||
| And -> And
|
||||
| Or -> Or
|
||||
| Eq -> Eq
|
||||
| Less -> Less
|
||||
| LessEq -> LessEq
|
||||
| More -> More
|
||||
| MoreEq -> MoreEq
|
||||
and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop) : RISCAssembly.biop =
|
||||
match biop with
|
||||
| AddI -> AddI
|
||||
| SubI -> SubI
|
||||
| MultI -> MultI
|
||||
| DivI -> DivI
|
||||
| ModI -> ModI
|
||||
| PowI -> PowI
|
||||
| AndI -> AndI
|
||||
| OrI -> OrI
|
||||
| EqI -> EqI
|
||||
| LessI -> LessI
|
||||
| LessEqI -> LessEqI
|
||||
| MoreI -> MoreI
|
||||
| MoreEqI -> MoreEqI
|
||||
and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop) : RISCAssembly.urop =
|
||||
match urop with
|
||||
| Not -> Not
|
||||
| Copy -> Copy
|
||||
| Rand -> Rand
|
||||
in
|
||||
List.map helper i
|
||||
|
||||
let nextCommonSuccessor (prg: CfgRISC.RISCCfg.t) (node1: Cfg.Node.t) (node2: Cfg.Node.t) : Cfg.Node.t option =
|
||||
(* Assume the two input nodes are the two branches of an if then else
|
||||
statement, then create the two lists that represent the runs until the
|
||||
terminal node by choosing always the false statement in guard statements
|
||||
(if the guard is for a while statement it gets ignored, if it is for an
|
||||
if then else it chooses one of the branches) then find the first common
|
||||
node in the lists
|
||||
*)
|
||||
let rec walk (node: Cfg.Node.t) : Cfg.Node.t list =
|
||||
node :: match Cfg.NodeMap.find_opt node prg.edges with
|
||||
| None -> []
|
||||
| Some (edge, None) -> (walk edge)
|
||||
| Some (_, Some edge) -> (walk edge)
|
||||
in
|
||||
|
||||
let list1 = walk node1 in
|
||||
let list2 = walk node2 in
|
||||
let common = List.filter (fun x -> List.mem x list2) list1 in
|
||||
match common with
|
||||
[] -> None
|
||||
| a::_ -> Some a
|
||||
|
||||
|
||||
let rec helper (prg: CfgRISC.RISCCfg.t) (currentnode: Cfg.Node.t) (alreadyVisited: Cfg.Node.t list) : RISCAssembly.t * Cfg.Node.t list =
|
||||
if List.mem currentnode alreadyVisited then
|
||||
([], alreadyVisited)
|
||||
else (
|
||||
let nextnodes = (Cfg.NodeMap.find_opt currentnode prg.edges) in
|
||||
let currentcode = (Cfg.NodeMap.find currentnode prg.content |> convert_cfgrisc_risci) in
|
||||
match nextnodes with
|
||||
| Some (nextnode1, None) ->
|
||||
let res, vis = (helper prg nextnode1) (currentnode :: alreadyVisited) in
|
||||
(currentcode @ res, vis)
|
||||
| Some (nextnode1, Some nextnode2) -> (
|
||||
let ncs = nextCommonSuccessor prg nextnode1 nextnode2 in
|
||||
match ncs with
|
||||
| None -> (* should never happen since the terminal node should always be
|
||||
rechable *)
|
||||
failwith "Topology got a little mixed up"
|
||||
| Some ncs -> (
|
||||
if (ncs.id = nextnode2.id)
|
||||
then (* while or for loop *)
|
||||
failwith "Not implemented"
|
||||
else (* if branches *)
|
||||
let label1 = nextLabel () in
|
||||
let label2 = nextLabel () in
|
||||
let label3 = nextLabel () in
|
||||
|
||||
let res1, vis1 = (helper prg nextnode1 (currentnode :: ncs :: alreadyVisited)) in
|
||||
let res2, _ = (helper prg nextnode2 vis1) in
|
||||
let res3, vis3 = (helper prg ncs (currentnode :: alreadyVisited)) in
|
||||
match List.nth currentcode ((List.length currentcode) - 1) with
|
||||
| BRegOp (_, _, _, r)
|
||||
| BImmOp (_, _, _, r)
|
||||
| URegOp (_, _, r)
|
||||
| Load (_, r)
|
||||
| LoadI (r, _) -> (currentcode @
|
||||
([CJump (r, label1, label2); Label label1] : RISCAssembly.t) @
|
||||
res1 @
|
||||
([Jump label3; Label label2] : RISCAssembly.t) @
|
||||
res2 @
|
||||
([Label label3] : RISCAssembly.t) @
|
||||
res3
|
||||
, vis3)
|
||||
| _ -> failwith "Missing instruction"
|
||||
)
|
||||
)
|
||||
| None -> (currentcode, currentnode :: alreadyVisited)
|
||||
)
|
||||
|
||||
let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t =
|
||||
let res, _ = helper prg (Option.get prg.initial) [] in
|
||||
res
|
||||
Reference in New Issue
Block a user