Guest User

Untitled

a guest
Jun 23rd, 2018
83
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.38 KB | None | 0 0
  1. open Core
  2.  
  3. type registers = {
  4. mutable a: int;
  5. mutable b: int;
  6. mutable c: int;
  7. mutable d: int;
  8. mutable e: int;
  9. mutable f: int
  10. }
  11.  
  12. type register =
  13. | A
  14. | B
  15. | C
  16. | D
  17. | E
  18. | F
  19. [@@deriving show]
  20.  
  21. type instruction =
  22. | Func of int * instruction list
  23. | CallF of int
  24. | CallFA of int * int list
  25. | CallFAR of int * register list
  26. | HLT
  27. | Print of register
  28. | Eq of register * register
  29. | Neq of register * register
  30. | Leq of register * register
  31. | Geq of register * register
  32. | Lt of register * register
  33. | Gt of register * register
  34. | EqI of register * int
  35. | NeqI of register * int
  36. | LeqI of register * int
  37. | GeqI of register * int
  38. | LtI of register * int
  39. | GtI of register * int
  40. | If of register * instruction list array
  41. | RetR of register
  42. | RetI of int
  43. | AddR of register * register
  44. | AddI of register * int
  45. | SubR of register * register
  46. | SubI of register * int
  47. | MulR of register * register
  48. | MulI of register * int
  49. | MovR of register * register
  50. | MovI of register * int
  51. | PopTo of register
  52. | PushR of register
  53. | PushI of int
  54.  
  55. let stack = Stack.create()
  56. let registers = {a=0;b=0;c=0;d=0;e=0;f=0}
  57. let functions = [|[];[];[];[];[];[]|] (* yay for empty functions *)
  58.  
  59. let setRegister x v =
  60. (* real ugly, hopefuly will learn a better way to do it soon *)
  61. match x with
  62. | A -> registers.a <- v
  63. | B -> registers.b <- v
  64. | C -> registers.c <- v
  65. | D -> registers.d <- v
  66. | E -> registers.e <- v
  67. | F -> registers.f <- v
  68.  
  69. let getRegister x =
  70. match x with
  71. | A -> registers.a
  72. | B -> registers.b
  73. | C -> registers.c
  74. | D -> registers.d
  75. | E -> registers.e
  76. | F -> registers.f
  77.  
  78. let popto stack r =
  79. let opt = Stack.pop stack in
  80. match opt with
  81. | None -> setRegister r 0
  82. | Some x -> setRegister r x
  83.  
  84. let rec reduceStack stack result f =
  85. let i = Stack.pop stack in
  86. match i with
  87. | None -> Stack.push stack result
  88. | Some x -> reduceStack stack (f result x) f
  89.  
  90. let saveFunction i l = functions.(i) <- l
  91.  
  92. let getFunction i = functions.(i)
  93.  
  94.  
  95. (*
  96. 関数を呼ぶ場合,
  97. F -> 第1引数
  98. E -> 第2引数
  99. D -> 第3引数
  100. C -> 第4引数
  101. *)
  102. let setArgs l =
  103. let rs: register array = [|F; E; D; C|] in
  104. List.iteri ~f:(fun i v -> setRegister rs.(i) v) l
  105.  
  106. let rec run = function
  107. | [] -> () (*printf "no more instruction\n"*)
  108. | HLT :: _ -> printf "execution stopped\n"
  109. | Func (i, l) :: rest -> saveFunction i l; run rest
  110. | CallF i :: rest -> getFunction i |> run ; run rest
  111. | CallFA (i, l) :: rest -> setArgs l; getFunction i |> run ; run rest
  112. | CallFAR (i, r) :: rest -> List.map ~f:(fun x -> getRegister x) r |> setArgs; getFunction i |> run; run rest;
  113. | Print i :: rest -> Printf.printf "%s : %d\n" (show_register i) (getRegister i); run rest
  114. | Eq (x, y) :: rest -> if (getRegister x) = (getRegister y) then (setRegister B 1) else (setRegister B 0); run rest
  115. | Neq (x, y) :: rest -> if (getRegister x) <> (getRegister y) then (setRegister B 1) else (setRegister B 0); run rest
  116. | Leq (x, y) :: rest -> if (getRegister x) <= (getRegister y) then (setRegister B 1) else (setRegister B 0); run rest
  117. | Geq (x, y) :: rest -> if (getRegister x) >= (getRegister y) then (setRegister B 1) else (setRegister B 0); run rest
  118. | Lt (x, y) :: rest -> if (getRegister x) < (getRegister y) then (setRegister B 1) else (setRegister B 0); run rest
  119. | Gt (x, y) :: rest -> if (getRegister x) > (getRegister y) then (setRegister B 1) else (setRegister B 0); run rest
  120. | EqI (x, y) :: rest -> if (getRegister x) = y then (setRegister B 1) else (setRegister B 0); run rest
  121. | NeqI (x, y) :: rest -> if (getRegister x) <> y then (setRegister B 1) else (setRegister B 0); run rest
  122. | LeqI (x, y) :: rest -> if (getRegister x) <= y then (setRegister B 1) else (setRegister B 0); run rest
  123. | GeqI (x, y) :: rest -> if (getRegister x) >= y then (setRegister B 1) else (setRegister B 0); run rest
  124. | LtI (x, y) :: rest -> if (getRegister x) < y then (setRegister B 1) else (setRegister B 0); run rest
  125. | GtI (x, y) :: rest -> if (getRegister x) > y then (setRegister B 1) else (setRegister B 0); run rest
  126. | If (x, l) :: rest -> if (getRegister x) = 1 then run l.(0) else if Array.length l = 2 then run l.(1); run rest
  127. | RetR x :: rest -> setRegister A (getRegister x); run rest
  128. | RetI x :: rest -> setRegister A x; run rest
  129. | AddR (x, y) :: rest -> (getRegister x) + (getRegister y) |> setRegister A; run rest
  130. | AddI (x, y) :: rest -> (getRegister x) + y |> setRegister A; run rest
  131. | SubR (x, y) :: rest -> (getRegister x) - (getRegister y) |> setRegister A; run rest
  132. | SubI (x, y) :: rest -> (getRegister x) - y |> setRegister A; run rest
  133. | MulR (x, y) :: rest -> (getRegister x) * (getRegister y) |> setRegister A; run rest
  134. | MulI (x, y) :: rest -> (getRegister x) * y |> setRegister A; run rest
  135. | MovR (x, y) :: rest -> (setRegister x (getRegister y)); run rest
  136. | MovI (x, y) :: rest -> (setRegister x y); run rest
  137. | PopTo r :: rest -> popto stack r; run rest
  138. | PushR r :: rest -> Stack.push stack (getRegister r); run rest
  139. | PushI x :: rest -> Stack.push stack x; run rest
  140.  
  141. (*
  142. Func#1 is same as
  143. let rec fact n =
  144. if n = 0 then 1
  145. else
  146. let m = n - 1 in
  147. let k = fact m in
  148. return n * k;;
  149. *)
  150.  
  151. let program = [
  152. Func (1, [EqI(F, 0); If(B, [|[RetI 1];[SubI(F, 1); MovR(D, A); PushR F; CallFAR(1, [D]); PopTo E; MulR(E, A); RetR A]|])]);
  153. CallFA(1, [10]);
  154. Print A
  155. ]
  156.  
  157. let () =
  158. run program
Add Comment
Please, Sign In to add comment