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