annotate lab4/target.ml @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
mike@0 1 (* lab4/target.ml *)
mike@0 2 (* Copyright (c) 2017 J. M. Spivey *)
mike@0 3
mike@0 4 open Optree
mike@0 5 open Print
mike@0 6
mike@0 7 (* |reg| -- type of Risc86 registers *)
mike@0 8 type reg = R of int | R_fp | R_sp | R_pc | R_ip | R_any | R_temp | R_none
mike@0 9
mike@0 10 let reg_name =
mike@0 11 function
mike@0 12 R n -> sprintf "r$" [fNum n]
mike@0 13 | R_fp -> "fp"
mike@0 14 | R_sp -> "sp"
mike@0 15 | R_pc -> "pc"
mike@0 16 | R_ip -> "ip"
mike@0 17 | R_any -> "*ANYREG*"
mike@0 18 | R_temp -> "*TEMPREG*"
mike@0 19 | R_none -> "*NOREG*"
mike@0 20
mike@0 21 (* |fReg| -- format register for printing *)
mike@0 22 let fReg r = fStr (reg_name r)
mike@0 23
mike@0 24 (* ARM register assignments:
mike@0 25
mike@0 26 R0-3 arguments + scratch
mike@0 27 R4-R9 callee-save temps
mike@0 28 R10 static link
mike@0 29 R11=fp frame pointer
mike@0 30 R12=sp stack pointer
mike@0 31 R13=ip temp for linkage
mike@0 32 R14=lr link register
mike@0 33 R15=pc program counter
mike@0 34
mike@0 35 *)
mike@0 36
mike@0 37 let volatile = [R 0; R 1; R 2; R 3; R 10]
mike@0 38 let stable = [R 4; R 5; R 6; R 7; R 8; R 9]
mike@0 39
mike@0 40 (* |operand| -- type of operands for assembly instructions *)
mike@0 41 type operand = (* VALUE ASM SYNTAX *)
mike@0 42 Const of int (* val #val *)
mike@0 43 | Register of reg (* [reg] reg *)
mike@0 44 | Index of reg * int (* [reg]+val [reg, #val] *)
mike@0 45 | Index2 of reg * reg * int (* [r1]+[r2]<<n [r1, r2, LSL #n] *)
mike@0 46 | Global of symbol (* lab lab *)
mike@0 47 | Label of codelab (* lab lab *)
mike@0 48
mike@0 49 (* |fRand| -- format operand for printing *)
mike@0 50 let fRand =
mike@0 51 function
mike@0 52 Const v -> fMeta "#$" [fNum v]
mike@0 53 | Register reg -> fReg reg
mike@0 54 | Index (reg, off) ->
mike@0 55 if off = 0 then fMeta "[$]" [fReg reg]
mike@0 56 else fMeta "[$, #$]" [fReg reg; fNum off]
mike@0 57 | Index2 (r1, r2, n) ->
mike@0 58 if n = 0 then
mike@0 59 fMeta "[$, $]" [fReg r1; fReg r2]
mike@0 60 else
mike@0 61 fMeta "[$, $, LSL #$]" [fReg r1; fReg r2; fNum n]
mike@0 62 | Global lab -> fStr lab
mike@0 63 | Label lab -> fMeta ".$" [fLab lab]
mike@0 64
mike@0 65 (* |reg_of| -- extract register (or R_none) from operand *)
mike@0 66 let reg_of =
mike@0 67 function
mike@0 68 Register reg -> reg
mike@0 69 | _ -> failwith "reg_of"
mike@0 70
mike@0 71 (* |seg| -- type of assembler segments *)
mike@0 72 type seg = Text | Data | Unknown
mike@0 73
mike@0 74 (* |current_seg| -- current output segment *)
mike@0 75 let current_seg = ref Unknown
mike@0 76
mike@0 77 (* |segment| -- emit segment directive if needed *)
mike@0 78 let segment s =
mike@0 79 if !current_seg <> s then begin
mike@0 80 let seg_name =
mike@0 81 match s with
mike@0 82 Text -> ".text" | Data -> ".data" | Unknown -> "*unknown*" in
mike@0 83 printf "\t$\n" [fStr seg_name];
mike@0 84 current_seg := s
mike@0 85 end
mike@0 86
mike@0 87 (* |preamble| -- emit start of assembler file *)
mike@0 88 let preamble () =
mike@0 89 printf "@ picoPascal compiler output\n" [];
mike@0 90 printf "\t.include \"fixup.s\"\n" [];
mike@0 91 printf "\t.global pmain\n\n" []
mike@0 92
mike@0 93 type item =
mike@0 94 Instr of string * operand list
mike@0 95 | Label of codelab
mike@0 96 | Comment of string
mike@0 97 | Tree of Optree.optree
mike@0 98
mike@0 99 let code = Queue.create ()
mike@0 100 let icount = ref 0
mike@0 101
mike@0 102 let frame = ref 0
mike@0 103 let stack = ref 0
mike@0 104
mike@0 105 (* |emit| -- emit an assembly language instruction *)
mike@0 106 let emit inst rands =
mike@0 107 incr icount;
mike@0 108 Queue.add (Instr (inst, rands)) code
mike@0 109
mike@0 110 let move_reg dst src =
mike@0 111 emit "mov" [Register dst; Register src]
mike@0 112
mike@0 113 (* |emit_lab| -- emit a label *)
mike@0 114 let emit_lab lab =
mike@0 115 Queue.add (Label lab) code
mike@0 116
mike@0 117 let emit_comment cmnt =
mike@0 118 Queue.add (Comment cmnt) code
mike@0 119
mike@0 120 let emit_tree t =
mike@0 121 Queue.add (Tree t) code
mike@0 122
mike@0 123 let need_stack n =
mike@0 124 stack := max n !stack
mike@0 125
mike@0 126 let flush () =
mike@0 127 let put =
mike@0 128 function
mike@0 129 Instr (inst, []) ->
mike@0 130 printf "\t$\n" [fStr inst]
mike@0 131 | Instr (inst, rands) ->
mike@0 132 printf "\t$ $\n" [fStr inst; fList(fRand) rands]
mike@0 133 | Label lab ->
mike@0 134 printf ".$:\n" [fLab lab]
mike@0 135 | Comment cmnt ->
mike@0 136 printf "@ $\n" [fStr cmnt]
mike@0 137 | Tree t ->
mike@0 138 Optree.print_optree "@ " t in
mike@0 139 Queue.iter put code;
mike@0 140 Queue.clear code
mike@0 141
mike@0 142 (* |start_proc| -- emit start of procedure *)
mike@0 143 let start_proc lab nargs fram =
mike@0 144 segment Text;
mike@0 145 printf "$:\n" [fStr lab];
mike@0 146 printf "\tmov ip, sp\n" [];
mike@0 147 if nargs > 0 then begin
mike@0 148 let save = if nargs <= 2 then "{r0-r1}" else "{r0-r3}" in
mike@0 149 printf "\tstmfd sp!, $\n" [fStr save]
mike@0 150 end;
mike@0 151 printf "\tstmfd sp!, {r4-r10, fp, ip, lr}\n" [];
mike@0 152 printf "\tmov fp, sp\n" [];
mike@0 153 frame := fram
mike@0 154
mike@0 155 (* |flush_proc| -- output procedure fragment, perhaps after error *)
mike@0 156 let flush_proc () =
mike@0 157 (* Round up frame space for stack alignment *)
mike@0 158 let space = 8 * ((!frame + !stack + 7)/8) in
mike@0 159 if space <= 1024 then
mike@0 160 (* Since space is a multiple of 8, we can fit values up to 1024 *)
mike@0 161 (if space > 0 then printf "\tsub sp, sp, #$\n" [fNum space])
mike@0 162 else begin
mike@0 163 printf "\tset ip, #$\n" [fNum space];
mike@0 164 printf "\tsub sp, sp, ip\n" []
mike@0 165 end;
mike@0 166 flush ();
mike@0 167 stack := 0
mike@0 168
mike@0 169 (* |end_proc| -- emit end of procedure *)
mike@0 170 let end_proc () =
mike@0 171 flush_proc ();
mike@0 172 printf "\tldmfd fp, {r4-r10, fp, sp, pc}\n" [];
mike@0 173 printf "\t.ltorg\n" []; (* Output the literal table *)
mike@0 174 printf "\n" []
mike@0 175
mike@0 176 (* |emit_string| -- output a string constant *)
mike@0 177 let emit_string lab s =
mike@0 178 segment Data;
mike@0 179 printf "$:" [fStr lab];
mike@0 180 let n = String.length s in
mike@0 181 for k = 0 to n-1 do
mike@0 182 let c = int_of_char s.[k] in
mike@0 183 if k mod 10 = 0 then
mike@0 184 printf "\n\t.byte $" [fNum c]
mike@0 185 else
mike@0 186 printf ", $" [fNum c]
mike@0 187 done;
mike@0 188 printf "\n\t.byte 0\n" []
mike@0 189
mike@0 190 (* |emit_global| -- output a global variable *)
mike@0 191 let emit_global lab n =
mike@0 192 printf "\t.comm $, $, 4\n" [fStr lab; fNum n]
mike@0 193
mike@0 194 (* |postamble| -- finish the assembler file *)
mike@0 195 let postamble () =
mike@0 196 fprintf stderr "$ instructions\n" [fNum !icount];
mike@0 197 printf "@ End\n" []
mike@0 198