(* Code generator for Fasto *) module CodeGen (* compile : TypedProg -> Mips.Instruction list (* for debugging *) compileExp : TypedExp -> SymTab -> Mips.reg -> Mips.Instruction list *) open AbSyn exception MyError of string * Position type VarTable = SymTab.SymTab (* Name generator for labels and temporary symbolic registers *) (* Example usage: val tmp = newName "tmp" (* might produce _tmp_5_ *) *) let mutable counter = 0 let newName base_name = counter <- counter + 1 "_" + base_name + "_" + string counter + "_" let newReg reg_name = Mips.RS (newName reg_name) let newLab lab_name = newName lab_name (* Table storing all string literals, with labels given to them *) let stringTable : ((Mips.addr*string) list) ref = ref [] (* could also contain "\n", ",", "Index out of bounds in line ", but the format is a bit different (length and dummy pointer come first) *) (* Building a string in the heap, including initialisation code *) let buildString ( label : Mips.addr , str : string ) : (Mips.Instruction list * Mips.Instruction list) = let data = [ Mips.ALIGN 2 (* means: word-align *) ; Mips.LABEL label (* pointer *) ; Mips.SPACE 4 (* sizeof(Int) *) ; Mips.ASCIIZ str] let initR = Mips.RS (label + "_init") let addrR = Mips.RS (label + "_addr") let initcode = [ Mips.LA(addrR, label) ; Mips.LI(initR, String.length str) ; Mips.SW(initR, addrR, 0) ] (initcode, data) (* Link register *) let RA = Mips.RN 31 (* Register for stack pointer *) let SP = Mips.RN 29 (* Register for heap pointer *) let HP = Mips.RN 28 (* Constant-zero register *) let RZ = Mips.RN 0 (* General scratch-pad registers *) let RN2 = Mips.RN 2 let RN4 = Mips.RN 4 let RN5 = Mips.RN 5 let RN6 = Mips.RN 6 (* Suggested register division *) let minReg = 2 (* lowest usable register *) let maxCaller = 15 (* highest caller-saves register *) let maxReg = 25 (* highest allocatable register *) (* Syscall numbers for MARS, to be put in $2 *) let sysPrintInt = 1 (* print integer in $4 *) let sysPrintString = 4 (* print NUL-terminated string starting at $4 *) let sysReadInt = 5 (* read integer into $2 *) let sysExit = 10 (* terminate execution *) let sysPrintChar = 11 (* print character in $4 *) let sysReadChar = 12 (* read character into $2 *) (* Determine the size of an element in an array based on its type *) type ElemSize = ESByte | ESWord let getElemSize (tp : Type) : ElemSize = match tp with | Char -> ESByte | Bool -> ESByte | _ -> ESWord let elemSizeToInt (elmsz : ElemSize) : int = match elmsz with | ESByte -> 1 | ESWord -> 4 (* Pick the correct instruction from the element size. *) let mipsLoad elem_size = match elem_size with | ESByte -> Mips.LB | ESWord -> Mips.LW let mipsStore elem_size = match elem_size with | ESByte -> Mips.SB | ESWord -> Mips.SW (* generates the code to check that the array index is within bounds *) let checkBounds ( arr_beg : Mips.reg , ind_reg : Mips.reg , (line : int, c : int) ) : Mips.Instruction list = let size_reg = newReg "size_reg" let tmp_reg = newReg "tmp_reg" let err_lab = newLab "error_lab" let safe_lab = newLab "safe_lab" [ Mips.LW(size_reg, arr_beg, 0) ; Mips.BGEZ(ind_reg, safe_lab) (* check that ind_reg >= 0 *) ; Mips.LABEL(err_lab) ; Mips.LI(RN5, line) ; Mips.LA(RN6, "_Msg_IllegalIndex_") ; Mips.J "_RuntimeError_" ; Mips.LABEL(safe_lab) ; Mips.SUB(tmp_reg, ind_reg, size_reg) ; Mips.BGEZ(tmp_reg, err_lab) (* check that ind_reg < -size_reg *) ] (* dynalloc(size_reg, place, ty) generates code for allocating arrays of heap memory by incrementing the HP register (heap pointer) by a number of words. The arguments for this function are as follows: size_reg: contains the logical array size (number of array elements) place: will contain the address of new allocation (old HP) ty: char/bool elements take 1 byte, int elements take 4 bytes *) let dynalloc (size_reg : Mips.reg, place : Mips.reg, ty : Type ) : Mips.Instruction list = let tmp_reg = newReg "tmp" (* Use old HP as allocation address. *) let code1 = [ Mips.MOVE (place, HP) ] (* For char/bool: Align address to 4-byte boundary by rounding up. *) (* (By adding 3 and rounding down using SRA/SLL.) *) (* For int and arrays: Multiply logical size by 4, no alignment. *) let code2 = match getElemSize ty with | ESByte -> [ Mips.ADDI(tmp_reg, size_reg, 3) ; Mips.SRA (tmp_reg, tmp_reg, 2) ; Mips.SLL (tmp_reg, tmp_reg, 2) ] | ESWord -> [ Mips.SLL (tmp_reg, size_reg, 2) ] (* Make space for array size (+4). Increase HP. *) (* Save size of allocation in header. *) let code3 = [ Mips.ADDI (tmp_reg, tmp_reg, 4) ; Mips.ADD (HP, HP, tmp_reg) ; Mips.SW (size_reg, place, 0) ] code1 @ code2 @ code3 (* Pushing arguments on the stack: *) (* For each register 'r' in 'rs', copy them to registers from 'firstReg' and counting up. Return the full code and the next unused register (firstReg + num_args). *) let applyRegs ( fid : Mips.addr , args : Mips.reg list , place: Mips.reg , pos : Position ) : Mips.Instruction list = let regs_num = List.length args let caller_regs = List.map (fun n -> Mips.RN (n + minReg)) [0..regs_num-1] // List.tabulate (regs_num, fun n -> n + minReg) (* zipWith Mips.MOVE = zipWith (fun (regDest, regSrc) -> Mips.MOVE (regDest, regSrc)) *) let move_code = List.map Mips.MOVE (List.zip caller_regs args) if regs_num > maxCaller - minReg then raise (MyError("Number of arguments passed to " + fid + " exceeds number of caller registers", pos)) else move_code @ [ Mips.JAL(fid,caller_regs); Mips.MOVE(place, RN2) ] (* Compile 'e' under bindings 'vtable', putting the result in register 'place'. *) let rec compileExp (e : TypedExp) (vtable : VarTable) (place : Mips.reg) : Mips.Instruction list = match e with | Constant (IntVal n, pos) -> if n < 0 then compileExp (Negate (Constant (IntVal (-n), pos), pos)) vtable place else if n < 32768 then [ Mips.LI (place, n) ] else [ Mips.LUI (place, n / 65536) ; Mips.ORI (place, place, n % 65536) ] | Constant (BoolVal p, _) -> match p with | true -> [Mips.LI (place, 1)] | false -> [Mips.LI (place, 0)] | Constant (CharVal c, pos) -> [ Mips.LI (place, int c) ] (* Create/return a label here, collect all string literals of the program (in stringTable), and create them in the data section before the heap (Mips.ASCIIZ) *) | StringLit (strLit, pos) -> (* Convert string literal into label; only use valid characters. *) let normalChars0 = //String.filter System.Char.IsLetterOrDigit strLit String.map (fun c -> if System.Char.IsLetterOrDigit c then c else 'a') strLit let normalChars = normalChars0 + "__str__" let label = newLab (normalChars.Substring (0, 7)) let () = stringTable := (label, strLit)::(!stringTable) [ Mips.LA (place, label) ; Mips.COMMENT (label + ": string \"" + toCString strLit + "\"") ] | Constant (ArrayVal (vs, tp), pos) -> (* Create corresponding ArrayLit expression to re-use code. *) let arraylit = ArrayLit (List.map (fun v -> Constant (v, pos)) vs, tp, pos) compileExp arraylit vtable place | ArrayLit (elems, tp, pos) -> let elem_size = getElemSize tp let size_reg = newReg "size_reg" let addr_reg = newReg "addr_reg" let tmp_reg = newReg "tmp_reg" (* Store size of literal in size_reg, dynamically allocate that. *) (* Let addr_reg contain the address for the first array element. *) let header = [ Mips.LI (size_reg, List.length elems) ] @ dynalloc (size_reg, place, tp) @ [ Mips.ADDI (addr_reg, place, 4) ] let compileElem elem_exp = let elem_code = compileExp elem_exp vtable tmp_reg elem_code @ [ mipsStore elem_size (tmp_reg, addr_reg, 0) ; Mips.ADDI (addr_reg, addr_reg, elemSizeToInt elem_size) ] let elems_code = List.concat (List.map compileElem elems) header @ elems_code | Var (vname, pos) -> match SymTab.lookup vname vtable with | None -> raise (MyError ("Name " + vname + " not found", pos)) | Some reg_name -> [Mips.MOVE (place, reg_name)] | Plus (e1, e2, pos) -> let t1 = newReg "plus_L" let t2 = newReg "plus_R" let code1 = compileExp e1 vtable t1 let code2 = compileExp e2 vtable t2 code1 @ code2 @ [Mips.ADD (place,t1,t2)] | Minus (e1, e2, pos) -> let t1 = newReg "minus_L" let t2 = newReg "minus_R" let code1 = compileExp e1 vtable t1 let code2 = compileExp e2 vtable t2 code1 @ code2 @ [Mips.SUB (place,t1,t2)] (* TODO project task 1: Look in `AbSyn.fs` for the expression constructors `Times`, ... `Times` is very similar to `Plus`/`Minus`. For `Divide`, you may ignore division by zero for a quick first version, but remember to come back and clean it up later. `Not` and `Negate` are simpler; you can use `Mips.XORI` for `Not` *) | Times (e1, e2, pos) -> let t1 = newReg "times_L" let t2 = newReg "times_R" let code1 = compileExp e1 vtable t1 let code2 = compileExp e2 vtable t2 code1 @ code2 @ [Mips.MUL (place,t1,t2)] | Divide (e1, e2, pos) -> let t1 = newReg "divide_L" let t2 = newReg "divide_R" let code1 = compileExp e1 vtable t1 let code2 = compileExp e2 vtable t2 code1 @ code2 @ [Mips.DIV (place,t1,t2)] | Not (e, pos) -> let t = newReg "not_R" let code = compileExp e vtable t code @ [Mips.XORI (place,t,0)] | Negate (e, pos) -> let t = newReg "negate_R" let R0 = Mips.RN 0 let code = compileExp e vtable t code @ [Mips.SUB (place,R0,t)] | Let (dec, e1, pos) -> let (code1, vtable1) = compileDec dec vtable let code2 = compileExp e1 vtable1 place code1 @ code2 | If (e1, e2, e3, pos) -> let thenLabel = newLab "then" let elseLabel = newLab "else" let endLabel = newLab "endif" let code1 = compileCond e1 vtable thenLabel elseLabel let code2 = compileExp e2 vtable place let code3 = compileExp e3 vtable place code1 @ [Mips.LABEL thenLabel] @ code2 @ [ Mips.J endLabel; Mips.LABEL elseLabel ] @ code3 @ [Mips.LABEL endLabel] (* special case for length *) | Apply ("length", [arr], pos) -> let arr_addr = newReg "len_arr" let code1 = compileExp arr vtable arr_addr code1 @ [ Mips.LW(place,arr_addr, 0) ] | Apply (f, args, pos) -> (* Convention: args in regs (2..15), result in reg 2 *) let compileArg arg = let arg_reg = newReg "arg" (arg_reg, compileExp arg vtable arg_reg) let (arg_regs, argcode) = List.unzip (List.map compileArg args) let applyCode = applyRegs(f, arg_regs, place, pos) List.concat argcode @ (* Evaluate args *) applyCode (* Jump to function and store result in place *) (* dirty I/O. Read and Write: supported for basic types: Int, Char, Bool via system calls. Write of an Array(Chars) is also supported. The others are the user's responsibility. *) | Read(tp, pos) -> match tp with | Int -> [ Mips.JAL ("getint", [RN2]) ; Mips.MOVE(place, RN2) ] | Char -> [ Mips.JAL ("getchar", [RN2]) ; Mips.MOVE(place, RN2) ] | Bool -> (* Note: the following inputs booleans as integers, with 0 interpreted as false and everything else as true. This differs from the interpreter! *) let tl = newLab "true_lab" let fl = newLab "false_lab" let ml = newLab "merge_lab" let v = newReg "bool_var" [ Mips.JAL ("getint", [RN2]) ; Mips.MOVE(v, RN2) ; Mips.BEQ (v, RZ,fl) ; Mips.J tl ; Mips.LABEL fl ; Mips.MOVE(place, RZ) ; Mips.J ml ; Mips.LABEL tl ; Mips.LI (place, 1) ; Mips.J ml ; Mips.LABEL ml ] | _ -> raise (MyError("Read on an incompatible type: " + ppType tp, pos)) | Write(e, tp, pos) -> let tmp = newReg "tmp" let codeexp = compileExp e vtable tmp @ [ Mips.MOVE (place, tmp) ] match tp with | Int -> codeexp @ [ Mips.MOVE(RN2,place); Mips.JAL("putint", [RN2]) ] | Char -> codeexp @ [ Mips.MOVE(RN2,place); Mips.JAL("putchar",[RN2]) ] | Bool -> let tlab = newLab "wBoolF" codeexp @ [ Mips.LA (RN2, "_true") ; Mips.BNE (place, RZ, tlab) ; Mips.LA (RN2, "_false") ; Mips.LABEL tlab ; Mips.JAL ("putstring", [RN2]) ] | Array Char -> codeexp @ [ Mips.MOVE (RN2, tmp) ; Mips.JAL("putstring", [RN2]) ] | _ -> raise (MyError("Write on an incompatible type: " + ppType tp, pos)) (* Comparison checking, later similar code for And and Or. *) | Equal (e1, e2, pos) -> let t1 = newReg "eq_L" let t2 = newReg "eq_R" let code1 = compileExp e1 vtable t1 let code2 = compileExp e2 vtable t2 let falseLabel = newLab "false" code1 @ code2 @ [ Mips.LI (place, 0) ; Mips.BNE (t1,t2,falseLabel) ; Mips.LI (place, 1) ; Mips.LABEL falseLabel ] | Less (e1, e2, pos) -> let t1 = newReg "lt_L" let t2 = newReg "lt_R" let code1 = compileExp e1 vtable t1 let code2 = compileExp e2 vtable t2 code1 @ code2 @ [Mips.SLT (place,t1,t2)] (* TODO project task 1: Look in `AbSyn.fs` for the expression constructors of `And` and `Or`. The implementation of `And` and `Or` is more complicated than `Plus` because you need to ensure the short-circuit semantics, e.g., in `e1 || e2` if the execution of `e1` will evaluate to `true` then the code of `e2` must not be executed. Similarly for `And` (&&). *) | And (e1, e2, pos) -> let R0 = Mips.RS "0" let label = newLab "false" let code1 = compileExp e1 vtable place let code2 = compileExp e2 vtable place code1 @ [Mips.BEQ (place, R0, label)] @ code2 @ [Mips.LABEL label] | Or (e1, e2, pos) -> let R0 = Mips.RS "0" let label = newLab "true" let code1 = compileExp e1 vtable place let code2 = compileExp e2 vtable place code1 @ [Mips.BNE (place, R0, label)] @ code2 @ [Mips.LABEL label] (* Indexing: 1. generate code to compute the index 2. check index within bounds 3. add the start address with the index 4. get the element at that address *) | Index (arr_name, i_exp, ty, pos) -> let ind_reg = newReg "arr_ind" let ind_code = compileExp i_exp vtable ind_reg let arr_reg = newReg "arr_reg" (* Let arr_reg be the start of the data segment *) let arr_beg = match SymTab.lookup arr_name vtable with | None -> raise (MyError ("Name " + arr_name + " not found", pos)) | Some reg_name -> reg_name let init_code = [ Mips.ADDI(arr_reg, arr_beg, 4) ] (* code to check bounds *) let check_code = checkBounds(arr_beg, ind_reg, pos) (* for INT/ARRAY: ind *= 4 else ind is unchanged *) (* array_var += index; place = *array_var *) let load_code = match getElemSize ty with | ESByte -> [ Mips.ADD(arr_reg, arr_reg, ind_reg) ; Mips.LB(place, arr_reg, 0) ] | ESWord -> [ Mips.SLL(ind_reg, ind_reg, 2) ; Mips.ADD(arr_reg, arr_reg, ind_reg) ; Mips.LW(place, arr_reg, 0) ] ind_code @ init_code @ check_code @ load_code (* Second-Order Array Combinators (SOACs): iota, map, reduce *) | Iota (n_exp, (line, _)) -> let size_reg = newReg "size_reg" let n_code = compileExp n_exp vtable size_reg (* size_reg is now the integer n. *) (* Check that array size N >= 0: if N >= 0 then jumpto safe_lab jumpto "_IllegalArrSizeError_" safe_lab: ... *) let safe_lab = newLab "safe_lab" let checksize = [ Mips.BGEZ (size_reg, safe_lab) ; Mips.LI (RN5, line) ; Mips.LA (RN6, "_Msg_IllegalArraySize_") ; Mips.J "_RuntimeError_" ; Mips.LABEL (safe_lab) ] let addr_reg = newReg "addr_reg" let i_reg = newReg "i_reg" let init_regs = [ Mips.ADDI (addr_reg, place, 4) ; Mips.MOVE (i_reg, RZ) ] (* addr_reg is now the position of the first array element. *) (* Run a loop. Keep jumping back to loop_beg until it is not the case that i_reg < size_reg, and then jump to loop_end. *) let loop_beg = newLab "loop_beg" let loop_end = newLab "loop_end" let tmp_reg = newReg "tmp_reg" let loop_header = [ Mips.LABEL (loop_beg) ; Mips.SUB (tmp_reg, i_reg, size_reg) ; Mips.BGEZ (tmp_reg, loop_end) ] (* iota is just 'arr[i] = i'. arr[i] is addr_reg. *) let loop_iota = [ Mips.SW (i_reg, addr_reg, 0) ] let loop_footer = [ Mips.ADDI (addr_reg, addr_reg, 4) ; Mips.ADDI (i_reg, i_reg, 1) ; Mips.J loop_beg ; Mips.LABEL loop_end ] n_code @ checksize @ dynalloc (size_reg, place, Int) @ init_regs @ loop_header @ loop_iota @ loop_footer | Map (farg, arr_exp, elem_type, ret_type, pos) -> let size_reg = newReg "size_reg" (* size of input/output array *) let arr_reg = newReg "arr_reg" (* address of array *) let elem_reg = newReg "elem_reg" (* address of single element *) let res_reg = newReg "res_reg" let arr_code = compileExp arr_exp vtable arr_reg let get_size = [ Mips.LW (size_reg, arr_reg, 0) ] let addr_reg = newReg "addr_reg" (* address of element in new array *) let i_reg = newReg "i_reg" let init_regs = [ Mips.ADDI (addr_reg, place, 4) ; Mips.MOVE (i_reg, RZ) ; Mips.ADDI (elem_reg, arr_reg, 4) ] let loop_beg = newLab "loop_beg" let loop_end = newLab "loop_end" let tmp_reg = newReg "tmp_reg" let loop_header = [ Mips.LABEL (loop_beg) ; Mips.SUB (tmp_reg, i_reg, size_reg) ; Mips.BGEZ (tmp_reg, loop_end) ] (* map is 'arr[i] = f(old_arr[i])'. *) let src_size = getElemSize elem_type let dst_size = getElemSize ret_type let loop_map = [ mipsLoad src_size (res_reg, elem_reg, 0) ; Mips.ADDI(elem_reg, elem_reg, elemSizeToInt src_size) ] @ applyFunArg(farg, [res_reg], vtable, res_reg, pos) @ [ mipsStore dst_size (res_reg, addr_reg, 0) ; Mips.ADDI (addr_reg, addr_reg, elemSizeToInt dst_size) ] let loop_footer = [ Mips.ADDI (i_reg, i_reg, 1) ; Mips.J loop_beg ; Mips.LABEL loop_end ] arr_code @ get_size @ dynalloc (size_reg, place, ret_type) @ init_regs @ loop_header @ loop_map @ loop_footer (* reduce(f, acc, {x1, x2, ...xn}) = f(f(f(acc,x1),x2),...xn) *) | Reduce (binop, acc_exp, arr_exp, tp, pos) -> let arr_reg = newReg "arr_reg" (* address of array *) let size_reg = newReg "size_reg" (* size of input array *) let i_reg = newReg "ind_var" (* loop counter *) let tmp_reg = newReg "tmp_reg" (* several purposes *) let loop_beg = newLab "loop_beg" let loop_end = newLab "loop_end" let arr_code = compileExp arr_exp vtable arr_reg let header1 = [ Mips.LW(size_reg, arr_reg, 0) ] (* Compile initial value into place (will be updated below) *) let acc_code = compileExp acc_exp vtable place (* Set arr_reg to address of first element instead. *) (* Set i_reg to 0. While i < size_reg, loop. *) let loop_code = [ Mips.ADDI(arr_reg, arr_reg, 4) ; Mips.MOVE(i_reg, RZ) ; Mips.LABEL(loop_beg) ; Mips.SUB(tmp_reg, i_reg, size_reg) ; Mips.BGEZ(tmp_reg, loop_end) ] (* Load arr[i] into tmp_reg *) let elem_size = getElemSize tp let load_code = [ mipsLoad elem_size (tmp_reg, arr_reg, 0) ; Mips.ADDI (arr_reg, arr_reg, elemSizeToInt elem_size) ] (* place := binop(place, tmp_reg) *) let apply_code = applyFunArg(binop, [place; tmp_reg], vtable, place, pos) arr_code @ header1 @ acc_code @ loop_code @ load_code @ apply_code @ [ Mips.ADDI(i_reg, i_reg, 1) ; Mips.J loop_beg ; Mips.LABEL loop_end ] (* TODO project task 2: `replicate (n, a)` `filter (f, arr)` `scan (f, ne, arr)` Look in `AbSyn.fs` for the shape of expression constructors `Replicate`, `Filter`, `Scan`. General Hint: write down on a piece of paper the C-like pseudocode for implementing them, then translate that to Mips pseudocode. To allocate heap space for an array you may use `dynalloc` defined above. For example, if `sz_reg` is a register containing an integer `n`, and `ret_type` is the element-type of the to-be-allocated array, then `dynalloc (sz_reg, arr_reg, ret_type)` will alocate enough space for an n-element array of element-type `ret_type` (including the first word that holds the length, and the necessary allignment padding), and will place in register `arr_reg` the start address of the new array. Since you need to allocate space for the result arrays of `Replicate`, `Map` and `Scan`, then `arr_reg` should probably be `place` ... `replicate(n,a)`: You should allocate a new (result) array, and execute a loop of count `n`, in which you store the value hold into the register corresponding to `a` into each memory location corresponding to an element of the result array. If `n` is less than `0` then remember to terminate the program with an error -- see implementation of `iota`. *) | Replicate (n_exp, a_exp, a_type, (line, _)) -> let a_size = getElemSize a_type let size_reg = newReg "size_reg" let n_code = compileExp n_exp vtable size_reg (* size_reg is now the integer n. *) let a_reg = newReg "a_reg" let a_code = compileExp a_exp vtable a_reg (* Check that array size N >= 0: if N >= 0 then jumpto safe_lab jumpto "_IllegalArrSizeError_" safe_lab: ... *) let safe_lab = newLab "safe_lab" let checksize = [ Mips.BGEZ (size_reg, safe_lab) ; Mips.LI (RN5, line) ; Mips.LA (RN6, "_Msg_IllegalArraySize_") ; Mips.J "_RuntimeError_" ; Mips.LABEL (safe_lab) ] let addr_reg = newReg "addr_reg" let i_reg = newReg "i_reg" let init_regs = [ Mips.ADDI (addr_reg, place, 4) ; Mips.MOVE (i_reg, RZ) ] (* addr_reg is now the position of the first array element. *) (* Run a loop. Keep jumping back to loop_beg until it is not the case that i_reg < size_reg, and then jump to loop_end. *) let loop_beg = newLab "loop_beg" let loop_end = newLab "loop_end" let tmp_reg = newReg "tmp_reg" let loop_header = [ Mips.LABEL (loop_beg) ; Mips.SUB (tmp_reg, i_reg, size_reg) ; Mips.BGEZ (tmp_reg, loop_end) ] (* 'arr[i] = a' *) let loop_replicate = [ mipsStore a_size (a_reg, addr_reg, 0) ] let loop_footer = [ Mips.ADDI (addr_reg, addr_reg, 4) ; Mips.ADDI (i_reg, i_reg, 1) ; Mips.J loop_beg ; Mips.LABEL loop_end ] n_code @ a_code @ checksize @ dynalloc (size_reg, place, Int) @ init_regs @ loop_header @ loop_replicate @ loop_footer (* TODO project task 2: see also the comment to replicate. (a) `filter(f, arr)`: has some similarity with the implementation of map. (b) Use `applyFunArg` to call `f(a)` in a loop, for every element `a` of `arr`. (c) If `f(a)` succeeds (result in the `true` value) then (and only then): - set the next element of the result array to `a`, and - increment a counter (initialized before the loop) (d) It is useful to maintain two array iterators: one for the input array `arr` and one for the result array. (The latter increases slower because some of the elements of the input array are skipped because they fail under the predicate). (e) The last step (after the loop writing the elments of the result array) is to update the logical size of the result array to the value of the counter computed in step (c). You do this of course with a `Mips.SW(counter_reg, place, 0)` instruction. *) | Filter (farg, arr_exp, a_type, pos) -> let size_reg = newReg "size_reg" (* size of input/output array *) let arr_reg = newReg "arr_reg" (* address of array *) let elem_reg = newReg "elem_reg" (* address of single element *) let res_reg = newReg "res_reg" let bool_reg = newReg "bool_reg" let arr_code = compileExp arr_exp vtable arr_reg let get_size = [ Mips.LW (size_reg, arr_reg, 0) ] let addr_reg = newReg "addr_reg" (* address of element in new array *) let i_reg = newReg "i_reg" let j_reg = newReg "j_reg" let init_regs = [ Mips.ADDI (addr_reg, place, 4) ; Mips.MOVE (i_reg, RZ) ; Mips.MOVE (j_reg, RZ) ; Mips.ADDI (elem_reg, arr_reg, 4) ] let loop_beg = newLab "loop_beg" let loop_end = newLab "loop_end" let not_true = newLab "not_true" let tmp_reg = newReg "tmp_reg" let loop_header = [ Mips.LABEL (loop_beg) ; Mips.SUB (tmp_reg, i_reg, size_reg) ; Mips.BGEZ (tmp_reg, loop_end) ] (* map is 'arr[i] = f(old_arr[i])'. *) let a_size = getElemSize a_type let loop_map = [ mipsLoad a_size (res_reg, elem_reg, 0) ; Mips.ADDI(elem_reg, elem_reg, elemSizeToInt a_size) ] @ applyFunArg(farg, [res_reg], vtable, bool_reg, pos) @ [ Mips.BEQ (bool_reg, RZ, not_true) ; mipsStore a_size (res_reg, addr_reg, 0) ; Mips.ADDI (j_reg, j_reg, 1) ; Mips.ADDI (addr_reg, addr_reg, elemSizeToInt a_size) ] let loop_footer = [ Mips.LABEL not_true ; Mips.ADDI (i_reg, i_reg, 1) ; Mips.J loop_beg ; Mips.LABEL loop_end ; Mips.SW (j_reg,place,0) ] arr_code @ get_size @ dynalloc (size_reg, place, a_type) @ init_regs @ loop_header @ loop_map @ loop_footer (* TODO project task 2: see also the comment to replicate. `scan(f, ne, arr)`: you can inspire yourself from the implementation of `reduce`, but in the case of `scan` you will need to also maintain an iterator through the result array, and write the accumulator in the current location of the result iterator at every iteration of the loop. *) | Scan (farg, e_exp, arr_exp, a_type, pos) -> let size_reg = newReg "size_reg" (* size of input/output array *) let arr_reg = newReg "arr_reg" (* address of array *) let elem_reg = newReg "elem_reg" (* address of single element *) let res_reg = newReg "res_reg" let nelem_reg = newReg "nelem_reg" let arr_code = compileExp arr_exp vtable arr_reg let e_code = compileExp e_exp vtable nelem_reg let get_size = [ Mips.LW (size_reg, arr_reg, 0) ] let addr_reg = newReg "addr_reg" (* address of element in new array *) let i_reg = newReg "i_reg" let init_regs = [ Mips.ADDI (addr_reg, place, 4) ; Mips.MOVE (i_reg, RZ) ; Mips.ADDI (elem_reg, arr_reg, 4) ] let loop_beg = newLab "loop_beg" let loop_end = newLab "loop_end" let tmp_reg = newReg "tmp_reg" let loop_header = [ Mips.LABEL (loop_beg) ; Mips.SUB (tmp_reg, i_reg, size_reg) ; Mips.BGEZ (tmp_reg, loop_end) ] (* map is 'arr[i] = f(old_arr[i])'. *) let a_size = getElemSize a_type let loop_map = [ mipsLoad a_size (res_reg, elem_reg, 0) ; Mips.ADDI(elem_reg, elem_reg, elemSizeToInt a_size) ] @ applyFunArg(farg, [nelem_reg ; res_reg], vtable, nelem_reg, pos) @ [ mipsStore a_size (nelem_reg, addr_reg, 0) ; Mips.ADDI (addr_reg, addr_reg, elemSizeToInt a_size) ] let loop_footer = [ Mips.ADDI (i_reg, i_reg, 1) ; Mips.J loop_beg ; Mips.LABEL loop_end ] arr_code @ e_code @ get_size @ dynalloc (size_reg, place, a_type) @ init_regs @ loop_header @ loop_map @ loop_footer and applyFunArg ( ff : TypedFunArg , args : Mips.reg list , vtable : VarTable , place : Mips.reg , pos : Position ) : Mips.Instruction list = match ff with | FunName s -> let tmp_reg = newReg "tmp_reg" applyRegs(s, args, tmp_reg, pos) @ [Mips.MOVE(place, tmp_reg)] | Lambda (_, parms, body, lampos) -> let rec bindParams parms args vtable' = match (parms, args) with | (Param (pname,_)::parms', arg::args') -> bindParams parms' args' (SymTab.bind pname arg vtable') | _ -> vtable' let vtable' = bindParams parms args vtable let t = newReg "fun_arg_res" compileExp body vtable' t @ [ Mips.MOVE(place, t) ] (* compile condition *) and compileCond (c : TypedExp) (vtable : VarTable) (tlab : Mips.addr) (flab : Mips.addr) : Mips.Instruction list = let t1 = newReg "cond" let code1 = compileExp c vtable t1 code1 @ [Mips.BNE (t1, RZ, tlab); Mips.J flab] (* compile let declaration *) and compileDec (dec : TypedDec) (vtable : VarTable) : (Mips.Instruction list * VarTable) = let (Dec (s,e,pos)) = dec let t = newReg "letBind" let code = compileExp e vtable t let new_vtable = SymTab.bind s t vtable (code, new_vtable) (* code for saving and restoring callee-saves registers *) let rec stackSave (currentReg : int) (maxReg : int) (savecode : Mips.Instruction list) (restorecode : Mips.Instruction list) (offset : int) : (Mips.Instruction list * Mips.Instruction list * int) = if currentReg > maxReg then (savecode, restorecode, offset) (* done *) else stackSave (currentReg+1) maxReg (Mips.SW (Mips.RN currentReg, SP, offset) :: savecode) (* save register *) (Mips.LW (Mips.RN currentReg, SP, offset) :: restorecode) (* restore register *) (offset-4) (* adjust offset *) (* add function arguments to symbol table *) and getArgs (parms : Param list) (vtable : VarTable) (nextReg : int) : (Mips.Instruction list * VarTable) = match parms with | [] -> ([], vtable) | (Param (v,_)::vs) -> if nextReg > maxCaller then raise (MyError ("Passing too many arguments!", (0,0))) else let vname = newReg ("param_" + v) let vtable1 = SymTab.bind v vname vtable (* (v,vname)::vtable *) let (code2,vtable2) = getArgs vs vtable1 (nextReg + 1) ([Mips.MOVE (vname, Mips.RN nextReg)] @ code2, vtable2) (* compile function declaration *) and compileFun (fundec : TypedFunDec) : Mips.Prog = let (FunDec (fname, resty, args, exp, (line,col))) = fundec (* make a vtable from bound formal parameters, then evaluate expression in this context, return it *) (* arguments passed in registers, "move" into local vars. *) let (argcode, vtable_local) = getArgs args (SymTab.empty ()) minReg (* return value in register 2 *) let rtmp = newReg (fname + "res") let returncode = [Mips.MOVE (RN2,rtmp)] (* move return val to R2 *) let body = compileExp exp vtable_local rtmp (* target expr *) let (body1, _, maxr, spilled) = RegAlloc.registerAlloc (* call register allocator *) (argcode @ body @ returncode) (Set.singleton (RN2)) 2 maxCaller maxReg 0 let (savecode, restorecode, offset) = (* save/restore callee-saves *) stackSave (maxCaller+1) maxr [] [] (-8 + (-4 * spilled)) [Mips.COMMENT ("Function " + fname); Mips.LABEL fname; (* function label *) Mips.SW (RA, SP, -4)] (* save return address *) @ savecode (* save callee-saves registers *) @ [Mips.ADDI (SP,SP,offset)] (* SP adjustment *) @ body1 (* code for function body *) @ [Mips.ADDI (SP,SP,-offset)] (* move SP up *) @ restorecode (* restore callee-saves registers *) @ [Mips.LW (RA, SP, -4); (* restore return addr *) Mips.JR (RA, [])] (* return *) (* compile program *) let compile (funs : TypedProg) : Mips.Instruction list = let () = stringTable := [("_true","true"); ("_false","false")] let funsCode = List.concat (List.map compileFun funs) let (stringinit_sym, stringdata) = List.unzip (List.map buildString (!stringTable)) let (stringinit,_,_,_) = match stringinit_sym with | [] -> ([],Set.empty,0,0) | _ -> RegAlloc.registerAlloc (* call register allocator *) (List.concat stringinit_sym) (Set.singleton (RN2)) 2 maxCaller maxReg 0 let mips_prog = [Mips.TEXT "0x00400000"; Mips.GLOBL "main"] (* initialisation: heap pointer and string pointers *) @ (Mips.LA (HP, "_heap_"):: stringinit) (* jump to main (and stop after returning) *) @ [Mips.JAL ("main",[])] @ (* stop code *) [Mips.LABEL "_stop_"; Mips.LI (RN2, sysExit); Mips.SYSCALL] @ (* code for functions *) funsCode (* pre-defined ord: char -> int and chr: int -> char *) @ [Mips.LABEL "ord"; (* char returned unmodified, interpreted as int *) Mips.JR (RA,[]); Mips.LABEL "chr"; (* int values are truncated to 8 bit (ASCII), *) Mips.ANDI (RN2, RN2, 255); Mips.JR (RA,[])] (* built-in read and write functions *) @ [Mips.LABEL "putint"; (* putint function *) Mips.ADDI(SP,SP,-8); Mips.SW (RN2,SP,0); (* save used registers *) Mips.SW (RN4,SP,4); Mips.MOVE (RN4, RN2); (* convention: number to be written in r2 *) Mips.LI (RN2, sysPrintInt); Mips.SYSCALL; Mips.LI (RN2, sysPrintString); Mips.LA(RN4,"_space_"); Mips.SYSCALL; (* write CR *) Mips.LW (RN2,SP,0); (* reload used registers *) Mips.LW (RN4,SP,4); Mips.ADDI(SP,SP,8); Mips.JR (RA,[]); Mips.LABEL "getint"; (* getint function *) Mips.LI (RN2,sysReadInt); Mips.SYSCALL; Mips.JR (RA,[])] @ (* putchar *) [ Mips.LABEL "putchar"; Mips.ADDI(SP,SP,-8); (* make space for 2 registers on the stack *) Mips.SW (RN2,SP,0); (* save registers $2 and $4 to stack *) Mips.SW (RN4,SP,4); Mips.MOVE (RN4, RN2); (* put char in $4 for syscall to work on *) Mips.LI(RN2, sysPrintChar); Mips.SYSCALL; Mips.LI (RN2, sysPrintString); Mips.LA(RN4,"_space_"); (* the string we'll write is a space *) Mips.SYSCALL; Mips.LW (RN2,SP,0); (* reload registers $2 and $4 from stack *) Mips.LW (RN4,SP,4); Mips.ADDI(SP,SP,8); (* free stack space again *) Mips.JR (RA,[]) ] @ (* getchar *) [ Mips.LABEL "getchar"; Mips.ADDI(SP,SP,-8); (* make space for 2 registers on the stack *) Mips.SW (RN4,SP,0); (* save registers $4 and $5 to stack *) Mips.SW (RN5,SP,4); Mips.LI(RN2, sysReadChar); Mips.SYSCALL; Mips.MOVE(RN5,RN2); (* temporarily move the result in reg $5*) Mips.LI (RN2, sysPrintString); Mips.LA(RN4,"_cr_"); Mips.SYSCALL; (* write CR *) Mips.MOVE(RN2, RN5); (* put the result back in $2*) Mips.LW (RN4, SP, 0); (* restore registers *) Mips.LW (RN5, SP, 4); Mips.ADDI(SP,SP,8); (* free stack space again *) Mips.JR (RA,[]) ] @ (* putstring *) [ Mips.LABEL "putstring"; Mips.ADDI(SP, SP, -16); (* make space on stack for registers *) Mips.SW (RN2, SP, 0); (* save registers $2,$4,$5,$6 to stack *) Mips.SW (RN4, SP, 4); Mips.SW (RN5, SP, 8); Mips.SW (RN6, SP, 12); Mips.LW (RN4, RN2, 0); (* $4 := size($2) *) Mips.ADDI(RN5, RN2, 4); (* $5 := $2 + 4 *) Mips.ADD (RN6, RN5, RN4); (* $6 := $5 + $4 *) Mips.LI (RN2, sysPrintChar); Mips.LABEL "putstring_begin"; Mips.SUB (RN4, RN5, RN6); (* while ($5 < $6) { *) Mips.BGEZ(RN4, "putstring_done"); (* *) Mips.LB(RN4, RN5, 0); (* $4 := M[$5] *) Mips.SYSCALL; (* putchar($4) *) Mips.ADDI(RN5, RN5, 1); (* $5 := $5 + 1 *) Mips.J "putstring_begin"; (* } *) Mips.LABEL "putstring_done"; Mips.LW (RN2, SP, 0); (* restore registers $2,$4,$5,$6 *) Mips.LW (RN4, SP, 4); Mips.LW (RN5, SP, 8); Mips.LW (RN6, SP, 12); Mips.ADDI(SP, SP, 16); (* free stack space again *) Mips.JR (RA,[]) ] @ (* Fixed code for reporting runtime errors. expects source line number in $5, pointer to error message in $6 *) [Mips.LABEL "_RuntimeError_"; Mips.LA (RN4, "_ErrMsg_"); Mips.LI (RN2, sysPrintString); Mips.SYSCALL; Mips.MOVE (RN4, RN5); Mips.LI (RN2, sysPrintInt); Mips.SYSCALL; Mips.LA (RN4, "_colon_space_"); Mips.LI (RN2, sysPrintString); Mips.SYSCALL; Mips.MOVE (RN4, RN6); Mips.LI (RN2, sysPrintString); Mips.SYSCALL; Mips.LA (RN4, "_cr_"); Mips.LI (RN2, sysPrintString); Mips.SYSCALL; Mips.J "_stop_"] @ [Mips.DATA ""; Mips.COMMENT "Fixed strings for I/O"; Mips.LABEL "_ErrMsg_"; Mips.ASCIIZ "Runtime error at line "; Mips.LABEL "_colon_space_"; Mips.ASCIIZ ": "; Mips.LABEL "_cr_"; Mips.ASCIIZ "\n"; Mips.LABEL "_space_"; Mips.ASCIIZ " "] @ [Mips.COMMENT "Message strings for specific errors"; Mips.LABEL "_Msg_IllegalArraySize_"; Mips.ASCIIZ "negative array size"; Mips.LABEL "_Msg_IllegalIndex_"; Mips.ASCIIZ "array index out of bounds" Mips.LABEL "_Msg_DivZero_"; Mips.ASCIIZ "division by zero" ] @ (* String literals *) (Mips.COMMENT "String Literals" :: List.concat stringdata) (* Heap (to allocate arrays in, word-aligned) *) @ [Mips.ALIGN 2; Mips.LABEL "_heap_"; Mips.SPACE 100000] mips_prog