annotate lab3/kgen.ml @ 1:b5139af1a420 tip basis

Fixed permissions on compile scripts
author Mike Spivey <mike@cs.ox.ac.uk>
date Fri, 13 Oct 2017 17:27:58 +0100
parents bfdcc3820b32
children
rev   line source
mike@0 1 (* lab3/kgen.ml *)
mike@0 2 (* Copyright (c) 2017 J. M. Spivey *)
mike@0 3
mike@0 4 open Tree
mike@0 5 open Dict
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 let level = ref 0
mike@0 12
mike@0 13 let slink = 12
mike@0 14
mike@0 15 (* |gen_addr| -- generate code to push address of a variable *)
mike@0 16 let gen_addr d =
mike@0 17 if d.d_level = 0 then
mike@0 18 GLOBAL d.d_lab
mike@0 19 else
mike@0 20 failwith "local variables not implemented yet"
mike@0 21
mike@0 22 (* |gen_expr| -- generate code for an expression *)
mike@0 23 let rec gen_expr =
mike@0 24 function
mike@0 25 Variable x ->
mike@0 26 let d = get_def x in
mike@0 27 begin
mike@0 28 match d.d_kind with
mike@0 29 VarDef ->
mike@0 30 SEQ [LINE x.x_line; gen_addr d; LOADW]
mike@0 31 | ProcDef nargs ->
mike@0 32 failwith "no procedure values"
mike@0 33 end
mike@0 34 | Constant x ->
mike@0 35 CONST x
mike@0 36 | Monop (w, e1) ->
mike@0 37 SEQ [gen_expr e1; MONOP w]
mike@0 38 | Binop (w, e1, e2) ->
mike@0 39 SEQ [gen_expr e1; gen_expr e2; BINOP w]
mike@0 40 | Call (p, args) ->
mike@0 41 SEQ [LINE p.x_line;
mike@0 42 failwith "no procedure call"]
mike@0 43
mike@0 44 (* |gen_cond| -- generate code for short-circuit condition *)
mike@0 45 let rec gen_cond e tlab flab =
mike@0 46 (* Jump to |tlab| if |e| is true and |flab| if it is false *)
mike@0 47 match e with
mike@0 48 Constant x ->
mike@0 49 if x <> 0 then JUMP tlab else JUMP flab
mike@0 50 | Binop ((Eq|Neq|Lt|Gt|Leq|Geq) as w, e1, e2) ->
mike@0 51 SEQ [gen_expr e1; gen_expr e2;
mike@0 52 JUMPC (w, tlab); JUMP flab]
mike@0 53 | Monop (Not, e1) ->
mike@0 54 gen_cond e1 flab tlab
mike@0 55 | Binop (And, e1, e2) ->
mike@0 56 let lab1 = label () in
mike@0 57 SEQ [gen_cond e1 lab1 flab; LABEL lab1; gen_cond e2 tlab flab]
mike@0 58 | Binop (Or, e1, e2) ->
mike@0 59 let lab1 = label () in
mike@0 60 SEQ [gen_cond e1 tlab lab1; LABEL lab1; gen_cond e2 tlab flab]
mike@0 61 | _ ->
mike@0 62 SEQ [gen_expr e; CONST 0; JUMPC (Neq, tlab); JUMP flab]
mike@0 63
mike@0 64 (* |gen_stmt| -- generate code for a statement *)
mike@0 65 let rec gen_stmt =
mike@0 66 function
mike@0 67 Skip -> NOP
mike@0 68 | Seq ss ->
mike@0 69 SEQ (List.map gen_stmt ss)
mike@0 70 | Assign (v, e) ->
mike@0 71 let d = get_def v in
mike@0 72 begin
mike@0 73 match d.d_kind with
mike@0 74 VarDef ->
mike@0 75 SEQ [gen_expr e; gen_addr d; STOREW]
mike@0 76 | _ -> failwith "assign"
mike@0 77 end
mike@0 78 | Print e ->
mike@0 79 SEQ [gen_expr e; CONST 0; GLOBAL "lib.print"; PCALL 1]
mike@0 80 | Newline ->
mike@0 81 SEQ [CONST 0; GLOBAL "lib.newline"; PCALL 0]
mike@0 82 | IfStmt (test, thenpt, elsept) ->
mike@0 83 let lab1 = label () and lab2 = label () and lab3 = label () in
mike@0 84 SEQ [gen_cond test lab1 lab2;
mike@0 85 LABEL lab1; gen_stmt thenpt; JUMP lab3;
mike@0 86 LABEL lab2; gen_stmt elsept; LABEL lab3]
mike@0 87 | WhileStmt (test, body) ->
mike@0 88 let lab1 = label () and lab2 = label () and lab3 = label () in
mike@0 89 SEQ [JUMP lab2; LABEL lab1; gen_stmt body;
mike@0 90 LABEL lab2; gen_cond test lab1 lab3; LABEL lab3]
mike@0 91 | Return e ->
mike@0 92 failwith "no return statement"
mike@0 93
mike@0 94 (* |gen_proc| -- generate code for a procedure *)
mike@0 95 let rec gen_proc (Proc (p, formals, Block (vars, procs, body))) =
mike@0 96 let d = get_def p in
mike@0 97 level := d.d_level;
mike@0 98 let code = gen_stmt body in
mike@0 99 printf "PROC $ $ 0 0\n" [fStr d.d_lab; fNum (4 * List.length vars)];
mike@0 100 Keiko.output (if !optflag then Peepopt.optimise code else code);
mike@0 101 printf "ERROR E_RETURN 0\n" [];
mike@0 102 printf "END\n\n" [];
mike@0 103 List.iter gen_proc procs
mike@0 104
mike@0 105 (* |translate| -- generate code for the whole program *)
mike@0 106 let translate (Program (Block (vars, procs, body))) =
mike@0 107 level := 0;
mike@0 108 printf "PROC MAIN 0 0 0\n" [];
mike@0 109 Keiko.output (gen_stmt body);
mike@0 110 printf "RETURN\n" [];
mike@0 111 printf "END\n\n" [];
mike@0 112 List.iter gen_proc procs;
mike@0 113 List.iter (function x -> printf "GLOVAR _$ 4\n" [fStr x]) vars