API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jan 22nd, 2020
108
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 30.00 KB | None | 0 0
raw download clone embed print report
  1. #use "semantic-analyser.ml";;
  2.  
  3. (* This module is here for you convenience only!
  4. You are not required to use it.
  5. you are allowed to change it. *)
  6. module type CODE_GEN = sig
  7. (* This signature assumes the structure of the constants table is
  8. a list of key-value pairs:
  9. - The keys are constant values (Sexpr(x) or Void)
  10. - The values are pairs of:
  11. * the offset from the base const_table address in bytes; and
  12. * a string containing the byte representation (or a sequence of nasm macros)
  13. of the constant value
  14. For example: [(Sexpr(Nil), (1, "SOB_NIL"))]
  15. *)
  16. (* val make_consts_tbl : expr' list -> (string * (constant * int)) list *)
  17. val make_consts_tbl : expr' list -> (constant * (int * string)) list
  18.  
  19. (* This signature assumes the structure of the fvars table is
  20. a list of key-value pairs:
  21. - The keys are the fvar names as strings
  22. - The values are the offsets from the base fvars_table address in bytes
  23. For example: [("boolean?", 0)]
  24. *)
  25. val make_fvars_tbl : expr' list -> (string * int) list
  26.  
  27. (* This signature represents the idea of outputing assembly code as a string
  28. for a single AST', given the full constants and fvars tables.
  29. *)
  30. val generate : (constant * (int * string)) list -> (string * int) list -> expr' -> string
  31. (* val generate2 : expr' list -> string list *)
  32. end;;
  33.  
  34. (* ------------------------------------------- labels ------------------------------------------*)
  35. let label_table = ref []
  36. let env = ref 0
  37. let tagged_sexpr_table = ref []
  38. let tagged_name_offset = ref []
  39. let tableIter = ref []
  40. let label_for_gen = ref 0
  41.  
  42. let rec labels_expr e=
  43. (function
  44. |(Var'(body))-> Var'(body)
  45. |(LambdaSimple'(args,body)) ->LambdaSimple'(args,labels_expr(body))
  46. |(LambdaOpt'(args,arg2,body)) ->LambdaOpt'(args,arg2,labels_expr(body))
  47. |(Set'(body1,body2)) -> Set'(labels_expr(body1),labels_expr(body2))
  48. |(BoxSet'(x,body2)) -> BoxSet'(x, labels_expr(body2))
  49. |(BoxGet'(x)) -> BoxGet'(x)
  50. |(Box'(x)) -> Box'(x)
  51. |(Const'(x)) -> env:= !env +1; Const'(label_maker(x,label_table, env))
  52. |(If'(test,dit,dif))-> If'(labels_expr(test),labels_expr(dit),labels_expr(dif))
  53. |(Seq'(args)) -> Seq'(List.map (fun a -> labels_expr(a)) args)
  54. |(Def'(a,body2)) -> Def'(a,labels_expr(body2))
  55. |(Or'(args)) -> Or'(List.map (fun a -> labels_expr(a)) args)
  56. |(Applic'(arg2,args)) ->Applic'(labels_expr(arg2),List.map (fun a -> labels_expr(a)) args)
  57. |(ApplicTP'(arg2,args)) ->ApplicTP'(labels_expr(arg2),List.map (fun a -> labels_expr(a)) args)
  58. )e
  59. and label_maker e = (function
  60. | (Void, label_table,env) -> Void
  61. | (Sexpr(Pair(arg1,arg2)), label_table, env) ->
  62. let arg3 = label_maker_helper(arg1,label_table, env) in
  63. let arg4 = label_maker_helper(arg2,label_table, env) in
  64. Sexpr(Pair(arg3,arg4))
  65. | (Sexpr(TaggedSexpr (str,expr)), label_table, env) -> generate_label(str,label_table, env); Sexpr(TaggedSexpr(label_getter(str,label_table, env),label_maker_helper(expr,label_table, env)))
  66. | (Sexpr(TagRef (str)), label_table, env) -> generate_label(str,label_table, env); Sexpr(TagRef(label_getter(str,label_table, env)))
  67. | (Sexpr(x), label_table, env) -> Sexpr(x)
  68. ) e
  69. and label_maker_helper e = (function
  70. | (Pair(arg1,arg2), label_table, env) ->
  71. let arg3 = label_maker_helper(arg1,label_table, env) in
  72. let arg4 = label_maker_helper(arg2,label_table, env) in
  73. Pair(arg3,arg4)
  74. | (TaggedSexpr (str,expr), label_table, env) -> generate_label (str,label_table, env); TaggedSexpr(label_getter(str,label_table, env),label_maker_helper(expr,label_table, env))
  75. | (TagRef (str), label_table, env) -> generate_label(str,label_table, env); TagRef(label_getter(str,label_table, env))
  76. | (x, label_table, env) -> x
  77. ) e
  78. and generate_label e = (function
  79. | (arg,label_table, env) -> if (List.exists (fun (a,b,c) -> (String.equal arg a)) !label_table) then
  80. ((fun (a,b,c) -> if (!c = !env) then () else (b:= !b+1; c:= !env))(List.find (fun (a,b,c) -> (String.equal arg a)) !label_table))
  81. else (label_table := (List.append !label_table [(arg, ref 1, ref !env)]))
  82. )e
  83. and label_getter e = (function
  84. | (arg,label_table, env) ->((fun (a,b,c) ->a^(string_of_int !b))(List.find (fun (a,b,c) -> (String.equal arg a)) !label_table))
  85. )e
  86. (*---------------------------------------------tag table - second iter --------------------------*)
  87. and tagged_sexpr_func e=
  88. (function
  89. |(Var'(body))-> Var'(body)
  90. |(LambdaSimple'(args,body)) ->LambdaSimple'(args,tagged_sexpr_func(body))
  91. |(LambdaOpt'(args,arg2,body)) ->LambdaOpt'(args,arg2,tagged_sexpr_func(body))
  92. |(Set'(body1,body2)) -> Set'(tagged_sexpr_func(body1),tagged_sexpr_func(body2))
  93. |(BoxSet'(x,body2)) -> BoxSet'(x,tagged_sexpr_func(body2))
  94. |(BoxGet'(x)) -> BoxGet'(x)
  95. |(Box'(x)) -> Box'(x)
  96. |(Const'(x)) -> Const'(tagged_sexpr_maker(x))
  97. |(If'(test,dit,dif))-> If'(tagged_sexpr_func(test),tagged_sexpr_func(dit),tagged_sexpr_func(dif))
  98. |(Seq'(args)) -> Seq'((List.map (fun a -> tagged_sexpr_func(a)) args) )
  99. |(Def'(a,body2)) -> Def'(tagged_sexpr_func(a),tagged_sexpr_func(body2))
  100. |(Or'(args)) -> Or'((List.map (fun a -> tagged_sexpr_func(a)) args) )
  101. |(Applic'(arg2,args)) ->Applic'(tagged_sexpr_func(arg2),(List.map (fun a -> tagged_sexpr_func(a)) args))
  102. |(ApplicTP'(arg2,args)) ->ApplicTP'(tagged_sexpr_func(arg2),(List.map (fun a -> tagged_sexpr_func(a)) args))
  103. )e
  104. and tagged_sexpr_maker e = (function
  105. | (Void) -> Void
  106. | (Sexpr(Pair(arg1,arg2))) ->
  107. let arg3 = tagged_sexpr_helper(arg1) in
  108. let arg4 = tagged_sexpr_helper(arg2) in
  109. Sexpr(Pair(arg3,arg4))
  110. | (Sexpr(TaggedSexpr (str,expr))) -> tagged_sexpr_table := (List.append !tagged_sexpr_table [(str,Sexpr(tagged_sexpr_helper_double(expr)))]); Sexpr(TaggedSexpr(str,tagged_sexpr_helper(expr)))
  111. | (Sexpr(TagRef (str))) -> Sexpr(TagRef (str))
  112. | (Sexpr(x)) -> Sexpr(x)
  113. ) e
  114. and tagged_sexpr_helper e = (function
  115. | (Pair(arg1,arg2)) ->
  116. let arg3 = tagged_sexpr_helper(arg1) in
  117. let arg4 = tagged_sexpr_helper(arg2) in
  118. Pair(arg3,arg4)
  119. | (TaggedSexpr (str,expr)) -> tagged_sexpr_table := (List.append !tagged_sexpr_table [(str,Sexpr(tagged_sexpr_helper_double(expr)))]); TaggedSexpr(str,tagged_sexpr_helper(expr))
  120. | (TagRef (str)) -> TagRef (str)
  121. | (x) -> x
  122. ) e
  123.  
  124. and tagged_sexpr_helper_double e = (function
  125. | (Pair(arg1,arg2)) ->
  126. let arg3 = tagged_sexpr_helper_double(arg1) in
  127. let arg4 = tagged_sexpr_helper_double(arg2) in
  128. Pair(arg3,arg4)
  129. | (TaggedSexpr (str,expr)) -> tagged_sexpr_helper_double(expr)
  130. | (TagRef (str)) -> TagRef (str)
  131. | (x) -> x
  132. ) e
  133.  
  134. (* ------------------------------------------ const table ------------------------------------- *)
  135. let rec create_const_table e=
  136. (function
  137. | (Const'(arg),current_table, offset) ->create_const_table_helper(arg,current_table, offset)
  138. | (Var'(arg),current_table, offset) -> ()
  139. | (Box'(arg),current_table, offset) -> ()
  140. | (BoxGet'(arg),current_table, offset) -> ()
  141. | (BoxSet'(arg, expr),current_table, offset) -> create_const_table(expr,current_table,offset)
  142. | (If'(test,dit,dif),current_table, offset) -> create_const_table(test,current_table, offset);create_const_table(dit,current_table, offset);create_const_table(dif,current_table, offset);()
  143. | (Seq'(args),current_table, offset) ->(List.iter (fun arg -> create_const_table(arg,current_table, offset)) args) ; ()
  144. | (Set'(arg1,arg2),current_table, offset) -> create_const_table(arg2,current_table, offset);()
  145. | (Def'(arg1,arg2),current_table, offset) -> create_const_table(arg2,current_table, offset);()
  146. | (Or'(args),current_table, offset) -> (List.iter (fun arg -> create_const_table(arg,current_table, offset)) args) ; ()
  147. | (LambdaSimple'(args_list, expr),current_table, offset) -> create_const_table(expr,current_table, offset);()
  148. | (LambdaOpt'(args_list,arg,expr),current_table, offset) -> create_const_table(expr,current_table, offset);()
  149. | (Applic'(arg,args),current_table, offset) -> create_const_table(arg,current_table, offset);(List.iter (fun arg2 -> create_const_table(arg2,current_table, offset)) args) ; ()
  150. | (ApplicTP'(arg,args),current_table, offset) -> create_const_table(arg,current_table, offset);(List.iter (fun arg2 -> create_const_table(arg2,current_table, offset)) args) ; ()
  151. )e
  152.  
  153. and offset_in_table e = (function
  154. | (table, arg) -> get_offset(List.find (function
  155. | (_,(Sexpr(x),_)) -> sexpr_eq arg x
  156. | (_,(Void,_)) -> false
  157. ) !table)
  158. )e
  159. and get_offset e = (function
  160. |(_,(_,offset)) -> offset
  161. )e
  162. and create_const_table_helper e = (function
  163. | (Void,current_table, offset) -> ()
  164. | (Sexpr(Bool(arg)),current_table, offset) -> ()
  165. | (Sexpr(Nil),current_table, offset) -> ()
  166. | (Sexpr(Char(arg)),current_table, offset) -> if (List.exists ( function
  167. |(_,(Sexpr(arg2),_))-> sexpr_eq arg2 (Char(arg))
  168. |(_,(Void,_))-> false
  169. ) !current_table)
  170. then ()
  171. else (current_table := !current_table @ [((Printf.sprintf "MAKE_LITERAL_CHAR(%d)" (Char.code arg)),(Sexpr(Char(arg)),!offset))]);
  172. offset:=!offset+2
  173. | (Sexpr(Number(Int(arg))),current_table, offset) -> if (List.exists ( function
  174. |(_,(Sexpr(arg2),_))-> sexpr_eq arg2 (Number(Int(arg)))
  175. |(_,(Void,_))-> false
  176. ) !current_table)
  177. then ()
  178. else (current_table := !current_table @[((Printf.sprintf "MAKE_LITERAL_INT(%d)" arg),(Sexpr(Number(Int(arg))),!offset))]; offset:=!offset+9)
  179. | (Sexpr(Number(Float(arg))),current_table, offset) -> if (List.exists ( function
  180. |(_,(Sexpr(arg2),_))-> sexpr_eq arg2 (Number(Float(arg)))
  181. |(_,(Void,_))-> false
  182. ) !current_table)
  183. then ()
  184. else (current_table := !current_table @[((Printf.sprintf "MAKE_LITERAL_FLOAT(%f)" arg),(Sexpr(Number(Float(arg))),!offset))]; offset:=!offset+9)
  185. | (Sexpr(String(arg)),current_table, offset) -> if (List.exists ( function
  186. |(_,(Sexpr(arg2),_))-> sexpr_eq arg2 (String(arg))
  187. |(_,(Void,_))-> false
  188. ) !current_table)
  189. then ()
  190. else (current_table := !current_table @[((Printf.sprintf "MAKE_LITERAL_STRING \"%s\"" arg),(Sexpr(String(arg)),!offset))]; offset:=!offset+9+(String.length arg))
  191. | (Sexpr(Symbol(arg)),current_table, offset) -> if (List.exists ( function
  192. |(_,(Sexpr(arg2),_))-> sexpr_eq arg2 (Symbol(arg))
  193. |(_,(Void,_))-> false
  194. ) !current_table)
  195. then ()
  196. else (create_const_table_helper(Sexpr(String(arg)),current_table, offset);current_table := !current_table @[(Printf.sprintf "MAKE_LITERAL_SYMBOL(const_tbl+"^(string_of_int (offset_in_table (current_table,String(arg))))^")" ,(Sexpr(Symbol(arg)),!offset))]; offset:=!offset+9)
  197. | (Sexpr(Pair(arg1,arg2)),current_table, offset) -> if (List.exists ( function
  198. |(_,(Sexpr(arg3),_))-> sexpr_eq arg3 (Pair(arg1,arg2))
  199. |(_,(Void,_))-> false
  200. ) !current_table)
  201. then ()
  202. else (create_const_table_helper(Sexpr(arg1),current_table, offset);
  203. create_const_table_helper(Sexpr(arg2),current_table, offset);
  204. current_table := !current_table @[((Printf.sprintf "MAKE_LITERAL_PAIR(const_tbl+%d, const_tbl+%d)" (offset_in_table(current_table,arg1)) (offset_in_table(current_table,arg2))),(Sexpr(Pair(arg1,arg2)),!offset))]; offset:=!offset+17)
  205. | (Sexpr(TaggedSexpr (str,expr)),current_table, offset) ->
  206. let newExp = ((fun(s1,e1)->e1) (List.find (fun (s,e) -> s=str) !tagged_sexpr_table)) in
  207.  
  208. create_const_table_helper(newExp,current_table, offset)
  209. | (Sexpr(TagRef (str)),current_table, offset) ->
  210. (current_table := !current_table @ [((Printf.sprintf "Tag ref HERE"),(Sexpr(TagRef (str)), find_offset_for_ref(str,current_table)))]);
  211. ) e
  212. and find_offset_for_ref e = (function
  213. | (str,current_table) ->
  214. let newExp = ((function
  215. |(s1,Sexpr(e1))->e1
  216. |(_,Void)->Number(Int 5)
  217. ) (List.find (fun (s,e) -> s=str) !tagged_sexpr_table)) in
  218. (if (List.exists (function
  219. |(s2,(Sexpr(e2),of2)) -> sexpr_eq e2 newExp
  220. |(s2,(Void,of2)) -> false)
  221. !tableIter)
  222. then ((fun (_,(_,offset2))-> offset2)(List.find (function
  223. |(s2,(Sexpr(e2),of2)) -> sexpr_eq e2 newExp
  224. |(s2,(Void,of2)) -> false)
  225. !tableIter))
  226. else (9999999999999999))
  227. )e;;
  228. (* ----------------------------------------- free table--------------------------------------- *)
  229. let rec create_free_table e= (function
  230. | (Const'(arg),current_table, offset) -> ()
  231. | (Var'(VarFree(arg)),current_table, offset) -> add_free(arg,current_table, offset); ()
  232. | (Var'(arg),current_table, offset) -> ()
  233. | (Box'(arg),current_table, offset) -> ()
  234. | (BoxGet'(arg),current_table, offset) -> ()
  235. | (BoxSet'(arg, expr),current_table, offset) -> create_free_table(expr,current_table,offset)
  236. | (If'(test,dit,dif),current_table, offset) -> create_free_table(test,current_table, offset);create_free_table(dit,current_table, offset);create_free_table(dif,current_table, offset);()
  237. | (Seq'(args),current_table, offset) ->(List.iter (fun arg -> create_free_table(arg,current_table, offset)) args) ; ()
  238. | (Set'(arg1,arg2),current_table, offset) -> create_free_table(arg2,current_table, offset);()
  239. | (Def'(arg1,arg2),current_table, offset) -> create_free_table(arg1,current_table, offset);create_free_table(arg2,current_table, offset);()
  240. | (Or'(args),current_table, offset) -> (List.iter (fun arg -> create_free_table(arg,current_table, offset)) args) ; ()
  241. | (LambdaSimple'(args_list, expr),current_table, offset) -> create_free_table(expr,current_table, offset);()
  242. | (LambdaOpt'(args_list,arg,expr),current_table, offset) -> create_free_table(expr,current_table, offset);()
  243. | (Applic'(arg,args),current_table, offset) -> create_free_table(arg,current_table, offset);(List.iter (fun arg2 -> create_free_table(arg2,current_table, offset)) args) ; ()
  244. | (ApplicTP'(arg,args),current_table, offset) -> create_free_table(arg,current_table, offset);(List.iter (fun arg2 -> create_free_table(arg2,current_table, offset)) args) ; ()
  245. )e
  246. and add_free e =(fun (arg, free_table, offset) -> if (List.exists (function
  247. |(name,_)-> sexpr_eq (String(name)) (String(arg))
  248. ) !free_table)
  249. then ()
  250. else (free_table := !free_table @[(arg,!offset)]; offset:=!offset+1)
  251.  
  252. )e;;
  253.  
  254. let rec offset_free e = (function
  255. | (table, arg) -> get_free_offset(List.find (function
  256. | (str,offset) -> sexpr_eq (String(arg)) (String(str))
  257. ) !table)
  258. )e
  259. and get_free_offset e = (function
  260. |(_,offset) -> offset
  261. )e
  262. and offset_constant e = (function
  263. | (table, Sexpr(arg)) -> get_constant_offset(List.find (function
  264. | (Sexpr(x),(_,_)) -> sexpr_eq arg x
  265. | (Void,(_,_)) -> false
  266. ) !table)
  267. | (table, Void) -> 0
  268. )e
  269. and get_constant_offset e = (function
  270. |(_,(offset,_)) -> offset
  271. )e;;
  272.  
  273.  
  274. let rec generate_helper e = (function
  275. | (label_counter,depth,outer_params,const_table,free_table,Const'(Sexpr(TaggedSexpr (str,expr)))) -> (Printf.sprintf "mov rax, const_tbl+%d\n" (offset_constant(const_table,Sexpr(expr))))
  276. | (label_counter,depth,outer_params,const_table,free_table,Const'(arg)) -> (Printf.sprintf "mov rax, const_tbl+%d\n" (offset_constant(const_table,arg)))
  277. | (label_counter,depth,outer_params,const_table,free_table,Var'(VarParam(arg,minor))) -> (Printf.sprintf "mov rax, qword[rbp+8*(4+%d)]\n" minor)
  278. | (label_counter,depth,outer_params,const_table,free_table,Var'(VarBound(arg,major,minor))) -> (Printf.sprintf "mov rax, qword[rbp+(8*2)]\n" )^
  279. (Printf.sprintf "mov rax, qword[rax+(WORD_SIZE*%d)]\n" major)^
  280. (Printf.sprintf "mov rax, qword[rax+(WORD_SIZE*%d)]\n" minor)
  281. | (label_counter,depth,outer_params,const_table,free_table,Var'(VarFree(arg))) -> (Printf.sprintf "mov rax, qword[fvar_tbl+WORD_SIZE*%d]\n" (offset_free(free_table,arg)))
  282. | (label_counter,depth,outer_params,const_table,free_table,Box'(arg)) -> (generate_helper(label_counter,depth,outer_params,const_table,free_table,Var'(arg)))^(Printf.sprintf "MALLOC r8, WORD_SIZE \nmov [r8], rax \nmov rax, r8\n")
  283. | (label_counter,depth,outer_params,const_table,free_table,BoxGet'(arg)) -> (generate_helper(label_counter,depth,outer_params,const_table,free_table,Var'(arg)))^(Printf.sprintf "mov rax, qword[rax]\n")
  284.  
  285. | (label_counter,depth,outer_params,const_table,free_table,BoxSet'(arg, expr)) -> (generate_helper(label_counter,depth,outer_params,const_table,free_table,expr))^(Printf.sprintf "push rax\n")^
  286. (generate_helper(label_counter,depth,outer_params,const_table,free_table,Var'(arg)))^(Printf.sprintf "pop qword[rax]\n")^(Printf.sprintf "mov rax, SOB_VOID_ADDRESS\n")
  287.  
  288. | (label_counter,depth,outer_params,const_table,free_table,If'(test,dit,dif)) -> label_counter := !label_counter + 1; let anotherLabel = !label_counter in
  289. (generate_helper(label_counter,depth,outer_params,const_table,free_table,test))^(Printf.sprintf "cmp rax, SOB_FALSE_ADDRESS\n")^ (Printf.sprintf "je Lelse%d\n" anotherLabel)^
  290. (generate_helper(label_counter,depth,outer_params,const_table,free_table,dit))^(Printf.sprintf "jmp Lexit%d\n" anotherLabel)^ (Printf.sprintf "Lelse%d:\n" anotherLabel)^
  291. (generate_helper(label_counter,depth,outer_params,const_table,free_table,dif))^(Printf.sprintf "Lexit%d:\n" anotherLabel)
  292. | (label_counter,depth,outer_params,const_table,free_table,Seq'(args)) ->(List.fold_left (fun arg1 arg2 -> arg1^(generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2))) "" args)
  293. | (label_counter,depth,outer_params,const_table,free_table,Set'(Var'(VarParam(arg1,minor)),arg2)) -> generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2)^ (Printf.sprintf "mov qword[rbp+WORD_SIZE*(4+%d)],rax\n" minor)^(Printf.sprintf "mov rax, SOB_VOID_ADDRESS\n")
  294. | (label_counter,depth,outer_params,const_table,free_table,Set'(Var'(VarBound(arg1,major,minor)),arg2)) -> generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2)^
  295. (Printf.sprintf "mov rbx, qword[rbp+WORD_SIZE*2]\n")^
  296. (Printf.sprintf "mov rbx, qword[rbx+WORD_SIZE*%d]\n" major)^
  297. (Printf.sprintf "mov qword[rbx+WORD_SIZE*%d], rax\n" minor)^
  298. (Printf.sprintf "mov rax, SOB_VOID_ADDRESS\n")
  299. | (label_counter,depth,outer_params,const_table,free_table,Set'(Var'(VarFree(arg1)),arg2)) -> generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2)^ (Printf.sprintf "mov qword[fvar_tbl+WORD_SIZE*%d],rax\n" (offset_free(free_table,arg1)))^(Printf.sprintf "mov rax, SOB_VOID_ADDRESS\n")
  300. | (label_counter,depth,outer_params,const_table,free_table,Def'(Var'(VarFree(arg1)),arg2)) -> let a = generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2)in
  301. let b = (Printf.sprintf "mov qword[fvar_tbl+WORD_SIZE*%d],rax\n" (offset_free(free_table,arg1)))in
  302. let c =(Printf.sprintf "mov rax, SOB_VOID_ADDRESS\n")in
  303. a^b^c
  304.  
  305. | (label_counter,depth,outer_params,const_table,free_table,Or'(args)) -> label_counter := !label_counter + 1; let anotherLabel = !label_counter in let c = ref 0 in
  306. (List.fold_left (fun arg1 arg2 ->c := !c+1 ; if (!c = List.length args)
  307. then (arg1^generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2)^(Printf.sprintf "Lexit%d:\n" anotherLabel))
  308. else (arg1^generate_helper(label_counter,depth,outer_params,const_table,free_table,arg2)^
  309. (Printf.sprintf "cmp rax, SOB_FALSE_ADDRESS\n")^(Printf.sprintf "jne Lexit%d\n" anotherLabel))) "" args)
  310. | (label_counter,depth,outer_params,const_table,free_table,LambdaSimple'(args_list, expr)) ->label_counter := !label_counter + 1; lambda_simple_maker(label_counter,depth,outer_params,const_table,free_table,LambdaSimple'(args_list, expr))
  311. | (label_counter,depth,outer_params,const_table,free_table,LambdaOpt'(args_list,arg,expr)) -> label_counter := !label_counter + 1; lambda_opt_maker(label_counter,depth,outer_params,const_table,free_table,LambdaOpt'(args_list, arg, expr))
  312. | (label_counter,depth,outer_params,const_table,free_table,Applic'(arg,args)) ->label_counter := !label_counter + 1;
  313. "mov r8, SOB_NIL_ADDRESS\n"^
  314. (Printf.sprintf "push r8\n")^ (*push magic*)
  315. (List.fold_right (fun cur acc ->acc ^ generate_helper(label_counter,depth,outer_params,const_table,free_table,cur) ^ (Printf.sprintf "push rax \n") ) args "")^
  316. (Printf.sprintf "push %d\n" (List.length args))^
  317. generate_helper(label_counter,depth,outer_params,const_table,free_table,arg)^
  318. "CLOSURE_ENV r8, rax\n"^
  319. "push r8\n"^
  320. "CLOSURE_CODE r9, rax\n"^
  321. "call r9\n"^
  322. "add rsp, WORD_SIZE\n"^
  323. "pop rbx\n"^
  324. "inc rbx\n"^ (*increase for magic? *)
  325. "shl rbx, 3\n"^
  326. "add rsp, rbx\n"
  327.  
  328. | (label_counter,depth,outer_params,const_table,free_table,ApplicTP'(arg,args)) -> label_counter := !label_counter + 1;
  329. "mov r8, SOB_NIL_ADDRESS\n"^
  330. (Printf.sprintf "push r8\n")^ (*push magic*)
  331. (List.fold_right (fun cur acc ->acc ^ generate_helper(label_counter,depth,outer_params,const_table,free_table,cur) ^ (Printf.sprintf "push rax \n") ) args "")^
  332. (Printf.sprintf "push %d\n" (List.length args))^
  333. generate_helper(label_counter,depth,outer_params,const_table,free_table,arg)^
  334. "CLOSURE_ENV r8, rax\n"^
  335. "push r8\n"^
  336. "push qword[rbp + 8]\n"^
  337. "mov r13, [rbp]\n"^ (*maybe push?*)
  338. (Printf.sprintf "SHIFT_FRAME %d\n" ((List.length args)+5))^
  339. "mov rbp, r13\n"^
  340. "CLOSURE_CODE r9, rax\n"^
  341. "jmp r9\n"
  342. (* "leave\n"^
  343. "ret\n" *)
  344. |_ -> raise X_no_match
  345. ) e
  346.  
  347. and lambda_simple_maker e =
  348. let env=ref "" in
  349. let newEnv = ref "" in
  350. (function
  351. | (label_counter,depth,outer_params,const_table,free_table,LambdaSimple'(args_list, expr)) ->
  352. let anotherLabel = !label_counter in
  353. for i=depth downto 1 do
  354. (
  355. env := !env ^ (Printf.sprintf "mov r8, [rbx+%d*8] \nmov [rax+%d*8], r8 \n" (i-1) i)
  356. )done;
  357. for i=outer_params downto 1 do
  358. (
  359. newEnv := !newEnv ^ (Printf.sprintf "mov r9, [rbp+%d*8] \nmov [rax+%d*8], r9 \n"
  360. (4+(i-1)) (i-1))
  361. )done;
  362. (Printf.sprintf "MALLOC rax, %d\n" (8*(depth+1)))^
  363. (Printf.sprintf "mov rbx, qword[rbp+16] ; lex env\n") ^ ";start of env\n" ^
  364. !env ^
  365. (if outer_params=0 || depth=0 then (Printf.sprintf "mov rax, SOB_NIL_ADDRESS\nmov r8, rax ;enter to the then in lambda simple\n")
  366. else((Printf.sprintf "mov r8, rax \nMALLOC rax, %d ;malloc for array of outer params\nmov [r8], rax ;move the empty array to extEnv[0]\n"
  367. (8*outer_params)) ^
  368. !newEnv))^
  369. (Printf.sprintf "MAKE_CLOSURE(rax, r8, Lcode%d)\n jmp Lcont%d\nLcode%d:\nenter 0,0\n" anotherLabel anotherLabel anotherLabel)^
  370. generate_helper(label_counter,depth+1,(List.length args_list),const_table,free_table,expr) ^
  371. (Printf.sprintf "leave\nret\nLcont%d:\n" anotherLabel)
  372. | _ -> raise X_no_match
  373. )e
  374.  
  375. and lambda_opt_maker e =
  376. let env=ref "" in
  377. let newEnv = ref "" in
  378. (function
  379. | (label_counter,depth,outer_params,const_table,free_table,LambdaOpt'(args_list,arg,expr)) ->
  380. let anotherLabel = !label_counter in
  381. for i=depth downto 1 do
  382. (
  383. env := !env ^ (Printf.sprintf "mov r8, [rbx+%d*WORD_SIZE] \nmov [rax+%d*WORD_SIZE], r8 \n" (i-1) i)
  384. )done;
  385. for i=outer_params downto 1 do
  386. (
  387. newEnv := !newEnv ^ (Printf.sprintf "mov r9, [rbp+%d*WORD_SIZE] \nmov [rax+%d*WORD_SIZE], r9 \n"
  388. (4+(i-1)) (i-1))
  389. )done;
  390. (Printf.sprintf "MALLOC rax, %d\n" (8*(depth+1)))^
  391. (Printf.sprintf "mov rbx, qword[rbp+16] ; lex env\n") ^ ";start of env\n" ^
  392. !env ^
  393. (if outer_params=0 || depth=0 then (Printf.sprintf "mov qword[rax], SOB_NIL_ADDRESS\nmov r8, rax ;enter to the then in lambda simple\n")
  394. else((Printf.sprintf "mov r8, rax \nMALLOC rax, %d ;malloc for array of outer params\nmov [r8], rax ;move the empty array to extEnv[0]\n"
  395. (8*outer_params)) ^
  396. !newEnv))^
  397. (Printf.sprintf "MAKE_CLOSURE(rax, r8, Lcode%d)\n jmp Lcont%d\nLcode%d:\nenter 0,0\n" anotherLabel anotherLabel anotherLabel)^
  398. lambda_opt_maker_helper((List.length args_list)+1, label_counter)^
  399. generate_helper(label_counter,depth+1,(List.length args_list)+1,const_table,free_table,expr) ^
  400. (Printf.sprintf "leave\nret\nLcont%d:\n" anotherLabel)
  401. | _ -> raise X_no_match
  402. )e
  403. and lambda_opt_maker_helper e = (function
  404. | (args_num, counter) -> counter := !counter + 1; (*line 403 is redundent*)
  405. (Printf.sprintf
  406. "mov r8, [rbp+24] ; num of args in applic
  407. mov rcx, r8
  408. inc rcx; plus one for magic
  409. sub rcx, %d ; substitute the num of args in opt
  410. cmp rcx, 0 ; num of args in opt = minimum number of args
  411. jle end_of_cont%d
  412. add r8, 4
  413. opt_loop%d:
  414. dec r8
  415. mov r9, [rbp +WORD_SIZE*(r8+1)]
  416. mov r10, [rbp+ WORD_SIZE*r8]
  417. MAKE_PAIR (rax, r10, r9)
  418. mov [rbp + WORD_SIZE*r8], rax
  419. loop opt_loop%d
  420. end_of_cont%d:\n" args_num !counter !counter !counter !counter)
  421. )e;;
  422.  
  423.  
  424.  
  425.  
  426.  
  427. module Code_Gen : CODE_GEN = struct
  428. let make_consts_tbl asts =
  429. tagged_sexpr_table := [];
  430. env := 0;
  431. label_table := [];
  432. let refForTable1 = ref 6 in
  433. let refForTable2 = ref 6 in
  434. let table = ref [("MAKE_VOID",(Void,0));("MAKE_NIL",(Sexpr(Nil),1));("MAKE_BOOL(0)",(Sexpr(Bool(false)),2));("MAKE_BOOL(1)",(Sexpr(Bool(true)),4))] in
  435. tableIter := [("MAKE_VOID",(Void,0));("MAKE_NIL",(Sexpr(Nil),1));("MAKE_BOOL(0)",(Sexpr(Bool(false)),2));("MAKE_BOOL(1)",(Sexpr(Bool(true)),4))];
  436. List.iter (
  437. fun(x)->create_const_table (x, tableIter, refForTable1);
  438. create_const_table (x, table, refForTable2))
  439. (List.map (fun e -> tagged_sexpr_func(labels_expr e)) asts);
  440. (List.filter (function
  441. | (Sexpr(TagRef(a)),(b,c)) -> false
  442. | (a,(b,c)) -> true
  443. )
  444. (List.map (fun (a,(b,c))->(b,(c,a))) !table));;
  445. let make_fvars_tbl asts =
  446. let fvar_ref = ref 43 in
  447. let free_table = ref [("append", 0);("apply",1);("<",2); ("=",3);(">",4);("+",5);
  448. ("/",6);("*",7);("-",8);("boolean?",9);("car",10);("cdr",11);
  449. ("char->integer",12);("char?",13);("cons",14);("eq?",15);("equal?",16);("fold-left",17);
  450. ("fold-right",18);("integer?",19);("integer->char",20);("length",21);("list",22);
  451. ("list?",23);("make-string",24);("map",25);("not",26);("null?",27);("number?",28);
  452. ("pair?",29);("procedure?",30);("float?",31);("set-car!",32);("set-cdr!",33);
  453. ("string->list",34);("string-length",35);("string-ref",36);("string-set!",37);
  454. ("string?",38);("symbol?",39);("symbol->string",40);("zero?",41);("cons*",42);
  455. (* you can add yours here *)] in
  456. List.iter (
  457. fun(x)->create_free_table (x, free_table, fvar_ref)
  458. ) asts;
  459. !free_table;;
  460. let generate consts fvars e = env := 0; generate_helper (label_for_gen, 0, 0, ref consts, ref fvars, (labels_expr e));;
  461.  
  462. (* let generate2 e1 = List.map (fun e -> generate (make_consts_tbl e1) (make_fvars_tbl e1) ) e1;; *)
  463.  
  464. end;;
  465.  
  466.  
  467.  
  468. (* self comment - string is in asci and not string *)
  469.  
  470. (* Code_Gen.generate (Semantics.run_semantics (Tag_Parser.tag_parse_expression (Reader.read_sexpr "1")));; *)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!