noahbogart.com
standalone exapunks vm in ocaml
1(* This Source Code Form is subject to the terms of the Mozilla Public
2 License, v. 2.0. If a copy of the MPL was not distributed with this
3 file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
4
5type t = Common.op_code
6
7let is_m_op (op : t) =
8 match op with
9 | COPY (R M, _)
10 | COPY (_, M)
11 | VOID_M ->
12 true
13 | _ -> false
14
15let get_m_type (op : t) =
16 match op with
17 | COPY (_, M) -> `SEND
18 | COPY (R M, _) -> `RECEIVE
19 | VOID_M -> `VOID_M
20 | TEST_MRD -> `TEST_MRD
21 | _ -> raise Exit
22
23let regInstruction name r = Printf.sprintf "%s %s" name (Register.show r)
24
25let rnInstruction name rn = Printf.sprintf "%s %s" name (Register.show_r_n rn)
26
27let labelInstruction name label = Printf.sprintf "%s %s" name label
28
29let srcDestInstruction name src dest =
30 let left = Register.show_r_n src in
31 let right = Register.show dest in
32 Printf.sprintf "%s %s %s" name left right
33
34let mathInstruction name src i dest =
35 let left = Register.show_r_n src in
36 let right = Register.show_r_n i in
37 Printf.sprintf "%s %s %s %s" name left right (Register.show dest)
38
39let testInstruction name left func right =
40 let left = Register.show_r_n left in
41 let right = Register.show_r_n right in
42 Printf.sprintf "%s %s %s %s" name left func right
43
44let show (op : t) : string =
45 match op with
46 | NOOP -> "NOOP"
47 | COPY (src, dest) -> srcDestInstruction "COPY" src dest
48 | ADDI (src, i, dest) -> mathInstruction "ADDI" src i dest
49 | SUBI (src, i, dest) -> mathInstruction "SUBI" src i dest
50 | MULI (src, i, dest) -> mathInstruction "MULI" src i dest
51 | DIVI (src, i, dest) -> mathInstruction "DIVI" src i dest
52 | MODI (src, i, dest) -> mathInstruction "MODI" src i dest
53 | SWIZ (src, i, dest) -> mathInstruction "SWIZ" src i dest
54 | MARK label -> labelInstruction "MARK" label
55 | JUMP label -> labelInstruction "JUMP" label
56 | TJMP label -> labelInstruction "TJMP" label
57 | FJMP label -> labelInstruction "FJMP" label
58 | TEST_EQ (left, right) -> testInstruction "TEST" left "=" right
59 | TEST_LT (left, right) -> testInstruction "TEST" left "<" right
60 | TEST_GT (left, right) -> testInstruction "TEST" left ">" right
61 | HALT -> "HALT"
62 | REPL label -> labelInstruction "REPL" label
63 | LINK dest -> rnInstruction "LINK" dest
64 | HOST dest -> regInstruction "HOST" dest
65 | MODE -> "MODE"
66 | VOID_M -> "VOID M"
67 | TEST_MRD -> "TEST MRD"
68 | MAKE -> "MAKE"
69 | GRAB file -> rnInstruction "GRAB" file
70 | FILE dest -> regInstruction "FILE" dest
71 | SEEK value -> rnInstruction "SEEK" value
72 | VOID_F -> "VOID F"
73 | DROP -> "DROP"
74 | WIPE -> "WIPE"
75 | TEST_EOF -> "TEST EOF"
76
77let pp ppf op = Format.fprintf ppf "%s" (show op)
78
79let equal (op1 : t) (op2 : t) : bool =
80 match (op1, op2) with
81 | NOOP, NOOP ->
82 true
83 | NOOP, _ ->
84 false
85 | COPY (rn1, t1), COPY (rn2, t2) -> Register.equal_r_n rn1 rn2 && Register.equal t1 t2
86 | COPY _, _ -> false
87 | ADDI (src1, i1, dest1), ADDI (src2, i2, dest2)
88 | SUBI (src1, i1, dest1), SUBI (src2, i2, dest2)
89 | MULI (src1, i1, dest1), MULI (src2, i2, dest2)
90 | DIVI (src1, i1, dest1), DIVI (src2, i2, dest2)
91 | MODI (src1, i1, dest1), MODI (src2, i2, dest2)
92 | SWIZ (src1, i1, dest1), SWIZ (src2, i2, dest2) ->
93 Register.equal_r_n src1 src2 && Register.equal_r_n i1 i2
94 && Register.equal dest1 dest2
95 | DIVI _, _
96 | ADDI _, _
97 | SUBI _, _
98 | MULI _, _
99 | MODI _, _
100 | SWIZ _, _ ->
101 false
102 | MARK l1, MARK l2
103 | JUMP l1, JUMP l2
104 | TJMP l1, TJMP l2
105 | FJMP l1, FJMP l2 ->
106 String.equal l1 l2
107 | MARK _, _
108 | JUMP _, _
109 | TJMP _, _
110 | FJMP _, _ ->
111 false
112 | TEST_EQ (l1, r1), TEST_EQ (l2, r2)
113 | TEST_LT (l1, r1), TEST_LT (l2, r2)
114 | TEST_GT (l1, r1), TEST_GT (l2, r2) ->
115 Register.equal_r_n l1 l2 && Register.equal_r_n r1 r2
116 | TEST_EQ _, _
117 | TEST_LT _, _
118 | TEST_GT _, _ ->
119 false
120 | REPL l1, REPL l2 -> String.equal l1 l2
121 | REPL _, _ -> false
122 | HALT, HALT -> true
123 | HALT, _ -> false
124 | LINK dest1, LINK dest2 -> Register.equal_r_n dest1 dest2
125 | LINK _, _ -> false
126 | HOST r1, HOST r2 -> Register.equal r1 r2
127 | HOST _, _ -> false
128 | MODE, MODE
129 | VOID_M, VOID_M
130 | TEST_MRD, TEST_MRD ->
131 true
132 | MODE, _
133 | VOID_M, _
134 | TEST_MRD, _ ->
135 false
136 | MAKE, MAKE -> true
137 | MAKE, _ -> false
138 | GRAB f1, GRAB f2 -> Register.equal_r_n f1 f2
139 | GRAB _, _ -> false
140 | FILE dest1, FILE dest2 -> Register.equal dest1 dest2
141 | FILE _, _ -> false
142 | SEEK v1, SEEK v2 -> Register.equal_r_n v1 v2
143 | SEEK _, _ -> false
144 | VOID_F, VOID_F
145 | DROP, DROP
146 | WIPE, WIPE
147 | TEST_EOF, TEST_EOF ->
148 true
149 | VOID_F, _
150 | DROP, _
151 | WIPE, _
152 | TEST_EOF, _ ->
153 false