annotate lab2/kgen.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
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 (* lab2/kgen.ml *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 (* Copyright (c) 2017 J. M. Spivey *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 open Dict
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 open Tree
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 open Keiko
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 let optflag = ref false
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 (* |line_number| -- find line number of variable reference *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 let rec line_number e =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 match e.e_guts with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 Variable x -> x.x_line
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 | Sub (a, e) -> line_number a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 | _ -> 999
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 (* |gen_expr| -- generate code for an expression *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 let rec gen_expr e =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 match e.e_guts with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 Variable _ | Sub _ ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 SEQ [gen_addr e; LOADW]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 | Constant (n, t) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 CONST n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 | Monop (w, e1) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 SEQ [gen_expr e1; MONOP w]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 | Binop (w, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 SEQ [gen_expr e1; gen_expr e2; BINOP w]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30 (* |gen_addr| -- generate code to push address of a variable *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 and gen_addr v =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32 match v.e_guts with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 Variable x ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 let d = get_def x in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 SEQ [LINE x.x_line; GLOBAL d.d_lab]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 | _ ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 failwith "gen_addr"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39 (* |gen_cond| -- generate code for short-circuit condition *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 let rec gen_cond e tlab flab =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 (* Jump to |tlab| if |e| is true and |flab| if it is false *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42 match e.e_guts with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 Constant (x, t) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 if x <> 0 then JUMP tlab else JUMP flab
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 | Binop ((Eq|Neq|Lt|Gt|Leq|Geq) as w, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46 SEQ [gen_expr e1; gen_expr e2;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 JUMPC (w, tlab); JUMP flab]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 | Monop (Not, e1) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 gen_cond e1 flab tlab
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 | Binop (And, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 let lab1 = label () in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 SEQ [gen_cond e1 lab1 flab; LABEL lab1; gen_cond e2 tlab flab]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53 | Binop (Or, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 let lab1 = label () in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 SEQ [gen_cond e1 tlab lab1; LABEL lab1; gen_cond e2 tlab flab]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 | _ ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 SEQ [gen_expr e; CONST 0; JUMPC (Neq, tlab); JUMP flab]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 (* |gen_stmt| -- generate code for a statement *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 let rec gen_stmt =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 Skip -> NOP
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 | Seq stmts -> SEQ (List.map gen_stmt stmts)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 | Assign (v, e) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 SEQ [LINE (line_number v); gen_expr e; gen_addr v; STOREW]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 | Print e ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 SEQ [gen_expr e; CONST 0; GLOBAL "lib.print"; PCALL 1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 | Newline ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 SEQ [CONST 0; GLOBAL "lib.newline"; PCALL 0]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 | IfStmt (test, thenpt, elsept) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 let lab1 = label () and lab2 = label () and lab3 = label () in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 SEQ [gen_cond test lab1 lab2;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 LABEL lab1; gen_stmt thenpt; JUMP lab3;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 LABEL lab2; gen_stmt elsept; LABEL lab3]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 | WhileStmt (test, body) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 let lab1 = label () and lab2 = label () and lab3 = label () in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 SEQ [JUMP lab2; LABEL lab1; gen_stmt body;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78 LABEL lab2; gen_cond test lab1 lab3; LABEL lab3]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 let gen_decl (Decl (xs, t)) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 List.iter (fun x ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 let d = get_def x in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 let s = 4 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 printf "GLOVAR $ $\n" [fStr d.d_lab; fNum s]) xs
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 (* |translate| -- generate code for the whole program *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 let translate (Program (ds, ss)) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 let code = gen_stmt ss in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 printf "PROC MAIN 0 0 0\n" [];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 Keiko.output (if !optflag then Peepopt.optimise code else code);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 printf "RETURN\n" [];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 printf "END\n\n" [];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 List.iter gen_decl ds