aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--instptr.ml36
-rw-r--r--reg.ml9
-rw-r--r--urm.ml1
3 files changed, 20 insertions, 26 deletions
diff --git a/instptr.ml b/instptr.ml
index 9e472c4..0311a00 100644
--- a/instptr.ml
+++ b/instptr.ml
@@ -5,42 +5,33 @@
5 5
6open Common 6open Common
7 7
8(* Creates a pointer of instruction from an urm command list *)
9let instptr_mk urmcmd_list = 8let instptr_mk urmcmd_list =
10 let rec aux urmcmd_list count acc = 9 let rec aux urmcmd_list count acc = match urmcmd_list with
11 match urmcmd_list with
12 | [] -> acc 10 | [] -> acc
13 | instr :: tail -> aux tail (count + 1) ((count, instr) :: acc) 11 | instr :: tail -> aux tail (count + 1) ((count, instr) :: acc)
14 in InstPtr([], List.rev (aux urmcmd_list 0 [])) 12 in InstPtr([], List.rev (aux urmcmd_list 0 []))
15 13
16(* Moves the pointer to the previous instruction *)
17let instptr_move_up = function 14let instptr_move_up = function
18 | InstPtr([], list2) -> InstPtr([], list2)
19 | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2) 15 | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2)
16 | x -> x
20 17
21(* Moves the pointer to the next instruction *)
22let instptr_move_down = function 18let instptr_move_down = function
23 | InstPtr(list1, []) -> InstPtr(list1, [])
24 | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2) 19 | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2)
20 | x -> x
25 21
26(* Returns the couple from the current pointer position : (line, instruction) where instruction is an urm command or fails if there is no instruction pointed *)
27let instptr_get = function 22let instptr_get = function
28 | InstPtr(list1, (l, Zero(a)) :: tail)-> (l, Zero(a)) 23 | InstPtr(_, x :: _) -> x
29 | InstPtr(list1, (l, Succ(a)) :: tail) -> (l, Succ(a)) 24 | InstPtr(_, []) -> failwith "No instruction left"
30 | InstPtr(list1, (l, Copy(a, b)) :: tail) -> (l, Copy(a, b))
31 | InstPtr(list1, (l, Jump(a, b, c)) :: tail) -> (l, Jump(a, b, c))
32 | InstPtr(_, [])-> failwith "No instruction left"
33 25
34(* Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null" *)
35let instptr_string instptr = 26let instptr_string instptr =
36 let aux = function 27 let string_of_inst = function
37 | l, Zero(a) -> (string_of_int l) ^ ": Zero " ^ (string_of_int a) 28 | Zero(a) -> "Zero " ^ (string_of_int a)
38 | l, Succ(a) -> (string_of_int l) ^ ": Succ " ^ (string_of_int a) 29 | Succ(a) -> "Succ " ^ (string_of_int a)
39 | l, Copy(a, b) -> (string_of_int l) ^ ": Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b) 30 | Copy(a, b) -> "Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b)
40 | l, Jump(a, b, c) -> (string_of_int l) ^ ": Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c) 31 | Jump(a, b, c) -> "Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c)
41 in try aux (instptr_get instptr) with _ -> "null" 32 in let string_of_instptr (l, inst) = (string_of_int l) ^ ": " ^ string_of_inst inst
42 33 in try string_of_instptr (instptr_get instptr) with _ -> "null"
43(* Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list) *) 34
44let instptr_end = function 35let instptr_end = function
45 | InstPtr(_, []) -> true 36 | InstPtr(_, []) -> true
46 | _ -> false 37 | _ -> false
@@ -49,3 +40,4 @@ let rec instptr_jump ptr offset = match offset with
49 | 0 -> ptr 40 | 0 -> ptr
50 | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1) 41 | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1)
51 | _ -> instptr_jump (instptr_move_down ptr) (offset + 1) 42 | _ -> instptr_jump (instptr_move_down ptr) (offset + 1)
43
diff --git a/reg.ml b/reg.ml
index b27a868..c452282 100644
--- a/reg.ml
+++ b/reg.ml
@@ -7,10 +7,11 @@ open Common
7 7
8let reg_idx (Reg(idx, _)) = idx 8let reg_idx (Reg(idx, _)) = idx
9let reg_val (Reg(_, value)) = value 9let reg_val (Reg(_, value)) = value
10let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) 10let reg_compar l r = (reg_val l) - (reg_val r)
11 11
12let regs_get reglist idx = 12let regs_get reglist index =
13 List.find (fun (Reg(x,v)) -> x = idx) reglist |> reg_val 13 List.find (fun (Reg(idx, _)) -> idx = index) reglist |> reg_val
14 14
15let regs_set reglist index value = 15let regs_set reglist index value =
16 Reg(index, value) :: List.filter (fun (Reg(x, v)) -> x != index) reglist 16 Reg(index, value) :: List.filter (fun (Reg(idx, _)) -> idx != index) reglist
17
diff --git a/urm.ml b/urm.ml
index 49e970b..be9f7e4 100644
--- a/urm.ml
+++ b/urm.ml
@@ -32,3 +32,4 @@ let urm_run_trace = urm_run (* TODO *)
32 32
33(* Creates an URM from a command list and a register list *) 33(* Creates an URM from a command list and a register list *)
34let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list } 34let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list }
35