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