|
|
@@ -8,8 +8,8 @@ let comline comment = InlineComment (EmptyLine, comment)
|
|
|
let assemble program =
|
|
|
let labcounter = ref 0 in
|
|
|
let genlabel suffix =
|
|
|
- labcounter := !labcounter + 1;
|
|
|
- string_of_int !labcounter ^ "_" ^ suffix
|
|
|
+ labcounter := !labcounter + 1;
|
|
|
+ string_of_int !labcounter ^ "_" ^ suffix
|
|
|
in
|
|
|
|
|
|
let consts = Hashtbl.create 20 in
|
|
|
@@ -77,10 +77,11 @@ let assemble program =
|
|
|
(* Statements *)
|
|
|
|
|
|
| VarLet (dec, None, value, _) ->
|
|
|
- let store = match (depthof dec, depthof node) with
|
|
|
- | (0, _) -> Store (typeof dec, Glob, indexof dec)
|
|
|
- | (a, b) when a = b -> Store (typeof dec, Current, indexof dec)
|
|
|
- | (a, b) -> Store (typeof dec, Rel (b - a), indexof dec)
|
|
|
+ let store =
|
|
|
+ match (depthof dec, depthof node) with
|
|
|
+ | (0, _) -> Store (typeof dec, Glob, indexof dec)
|
|
|
+ | (a, b) when a = b -> Store (typeof dec, Current, indexof dec)
|
|
|
+ | (a, b) -> Store (typeof dec, Rel (b - a), indexof dec)
|
|
|
in
|
|
|
trav value @ [InlineComment (store, node2str node)]
|
|
|
|
|
|
@@ -159,10 +160,11 @@ let assemble program =
|
|
|
[InlineComment (load, node2str node)]
|
|
|
|
|
|
| VarUse (dec, None, _) ->
|
|
|
- let load = match (depthof dec, depthof node) with
|
|
|
- | (0, _) -> Load (typeof dec, Glob, indexof dec)
|
|
|
- | (a, b) when a = b -> Load (typeof dec, Current, indexof dec)
|
|
|
- | (a, b) -> Load (typeof dec, Rel (b - a), indexof dec)
|
|
|
+ let load =
|
|
|
+ match (depthof dec, depthof node) with
|
|
|
+ | (0, _) -> Load (typeof dec, Glob, indexof dec)
|
|
|
+ | (a, b) when a = b -> Load (typeof dec, Current, indexof dec)
|
|
|
+ | (a, b) -> Load (typeof dec, Rel (b - a), indexof dec)
|
|
|
in
|
|
|
[InlineComment (load, node2str node)]
|
|
|
|
|
|
@@ -191,16 +193,18 @@ let assemble program =
|
|
|
|
|
|
(* Function calls *)
|
|
|
| FunUse (dec, args, _) ->
|
|
|
- let init = match (depthof dec, depthof node) with
|
|
|
- | (0, _) -> RtnInit Glob
|
|
|
- | (a, b) when a = b - 1 -> RtnInit Current
|
|
|
- | (a, b) when a = b -> RtnInit Local
|
|
|
- | (a, b) -> RtnInit (Rel (b - a - 1))
|
|
|
+ let init =
|
|
|
+ match (depthof dec, depthof node) with
|
|
|
+ | (0, _) -> RtnInit Glob
|
|
|
+ | (a, b) when a = b - 1 -> RtnInit Current
|
|
|
+ | (a, b) when a = b -> RtnInit Local
|
|
|
+ | (a, b) -> RtnInit (Rel (b - a - 1))
|
|
|
in
|
|
|
- let jmp = match dec with
|
|
|
- | FunDec _ -> RtnJmp (ExternFun (indexof dec))
|
|
|
- | FunDef _ -> RtnJmp (LocalFun (List.length args, labelof dec))
|
|
|
- | _ -> raise InvalidNode
|
|
|
+ let jmp =
|
|
|
+ match dec with
|
|
|
+ | FunDec _ -> RtnJmp (ExternFun (indexof dec))
|
|
|
+ | FunDef _ -> RtnJmp (LocalFun (List.length args, labelof dec))
|
|
|
+ | _ -> raise InvalidNode
|
|
|
in
|
|
|
InlineComment (init, nameof dec) ::
|
|
|
(trav_all args) @
|
|
|
@@ -230,10 +234,11 @@ let assemble program =
|
|
|
|
|
|
(* Arrays *)
|
|
|
| Allocate (dec, [dim], _) ->
|
|
|
- let store = match (depthof dec, depthof node) with
|
|
|
- | (0, _) -> Store (typeof dec, Glob, indexof dec)
|
|
|
- | (a, b) when a = b -> Store (typeof dec, Current, indexof dec)
|
|
|
- | _ -> raise InvalidNode
|
|
|
+ let store =
|
|
|
+ match (depthof dec, depthof node) with
|
|
|
+ | (0, _) -> Store (typeof dec, Glob, indexof dec)
|
|
|
+ | (a, b) when a = b -> Store (typeof dec, Current, indexof dec)
|
|
|
+ | _ -> raise InvalidNode
|
|
|
in
|
|
|
trav dim @
|
|
|
[NewArray (basetypeof dec);
|
|
|
@@ -259,10 +264,11 @@ let assemble program =
|
|
|
[InlineComment (LoadArray (basetypeof dec), node2str node)]
|
|
|
|
|
|
| VarLet (dec, Some dims, value, _) ->
|
|
|
- let load = match (depthof dec, depthof node) with
|
|
|
- | (0, _) -> Load (typeof dec, Glob, indexof dec)
|
|
|
- | (a, b) when a = b -> Load (typeof dec, Current, indexof dec)
|
|
|
- | (a, b) -> Load (typeof dec, Rel (b - a), indexof dec)
|
|
|
+ let load =
|
|
|
+ match (depthof dec, depthof node) with
|
|
|
+ | (0, _) -> Load (typeof dec, Glob, indexof dec)
|
|
|
+ | (a, b) when a = b -> Load (typeof dec, Current, indexof dec)
|
|
|
+ | (a, b) -> Load (typeof dec, Rel (b - a), indexof dec)
|
|
|
in
|
|
|
(trav value) @ (* push value *)
|
|
|
(trav_all dims) @ (* push dimensions *)
|