SHARE
TWEET

Untitled

a guest Jan 22nd, 2020 70 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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")));; *)
RAW Paste Data
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
Top