initial import

lib/Instr.ml

@@ -0,0 +1,73 @@
+let short_mask = 0x20
+let return_mask = 0x40
+let keep_mask = 0x80
+let opcode_mask = 0x1f
+
+let opcode_names =
+  [|
+    "BRK";
+    "INC";
+    "POP";
+    "NIP";
+    "SWP";
+    "ROT";
+    "DUP";
+    "OVR";
+    "EQU";
+    "NEQ";
+    "GTH";
+    "LTH";
+    "JMP";
+    "JCN";
+    "JSR";
+    "STH";
+    "LDZ";
+    "STZ";
+    "LDR";
+    "STR";
+    "LDA";
+    "STA";
+    "DEI";
+    "DEO";
+    "ADD";
+    "SUB";
+    "MUL";
+    "DIV";
+    "AND";
+    "ORA";
+    "EOR";
+    "SFT";
+  |]
+
+type t =
+  | Instruction of { short : bool; return : bool; keep : bool; opcode : int }
+
+let of_int (op : int) : t =
+  let has_mask mask = op land mask = mask in
+  let short = has_mask short_mask in
+  let return = has_mask return_mask in
+  let keep = has_mask keep_mask in
+  match op with
+  | 0x20 | 0x40 | 0x60 ->
+      Instruction { short = false; return = false; keep = false; opcode = op }
+  | 0x80 | 0xa0 | 0xc0 | 0xe0 ->
+      Instruction { short; return; keep = false; opcode = 0x80 }
+  | _ -> Instruction { short; return; keep; opcode = Int.logand op opcode_mask }
+
+let to_int (Instruction { opcode; short; keep; return } : t) : int =
+  let flags = if short then short_mask else 0 in
+  let flags = if return then Int.logor flags return_mask else flags in
+  let flags = if keep then Int.logor flags keep_mask else flags in
+  opcode lor flags
+
+let to_string (Instruction { opcode; short; keep; return } : t) : string =
+  Format.sprintf "%s%s%s%s"
+    (match opcode with
+    | 0x20 -> "JCI"
+    | 0x40 -> "JMI"
+    | 0x60 -> "JSI"
+    | 0x80 -> "LIT"
+    | _ -> opcode_names.(opcode))
+    (if short then "2" else "")
+    (if keep then "k" else "")
+    (if return then "r" else "")