Ignore:
Timestamp:
Nov 4, 2011, 12:22:17 PM (8 years ago)
Author:
ayache
Message:

Function pointers in D2.2/8051. Bugged for now.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/LIN/LINToASM.ml

    r1462 r1488  
    55let error_prefix = "LIN to ASM"
    66let error s = Error.global_error error_prefix s
     7
     8
     9(* Translation environment *)
     10
     11type env =
     12    { externals : AST.ident list ;
     13      exit_lbl : Label.t ;
     14      fresh : unit -> string }
     15
     16let make_env externals exit_lbl fresh =
     17  { externals = externals ;
     18    exit_lbl = exit_lbl ;
     19    fresh = fresh }
    720
    821
     
    4558
    4659
    47 let call_ptr_instrs f1 f2 =
    48   [LIN.St_to_acc f1 ;
    49    LIN.St_push ;
    50    LIN.St_to_acc f2 ;
    51    LIN.St_push ;
    52    LIN.St_return]
    53 
    54 let rec translate_statement glbls_addr set_ra_label = function
     60let rec translate_statement env = function
    5561  | LIN.St_goto lbl -> [`Jmp lbl]
    5662  | LIN.St_label lbl -> [`Label lbl]
    5763  | LIN.St_comment _ -> []
    58   | LIN.St_cost lbl -> [`Cost lbl ; `NOP (* TODO: hack! Need to make the difference between cost labels and regular labels. *)]
     64  | LIN.St_cost lbl ->
     65    (* TODO: hack! Need to make the difference between cost labels and regular
     66       labels. *)
     67    [`Cost lbl ; `NOP]
    5968  | LIN.St_int (r, i) ->
    6069    [`MOV (`U3 (I8051.reg_addr r, data_of_int i))]
     
    6372  | LIN.St_push ->
    6473    [`PUSH acc_addr]
    65   | LIN.St_addr x when List.mem_assoc x glbls_addr ->
    66     [`MOV (`U4 (`DPTR, data16_of_int (List.assoc x glbls_addr)))]
    67   | LIN.St_addr x (* TODO *) ->
    68     error ("unknown global " ^ x ^ ".")
     74(*
     75  | LIN.St_addr x when List.mem_assoc x env.globals_addr ->
     76    [`MOV (`U4 (`DPTR, data16_of_int (List.assoc x env.globals_addr)))]
     77  | LIN.St_addr x when List.mem x env.fun_names ->
     78    [`Mov (`DPTR, x)]
     79  | LIN.St_addr x ->
     80    error
     81      ("unknown symbol " ^ x ^ ". Primitives and externals are not supported")
     82*)
     83  | LIN.St_addr x when List.mem x env.externals ->
     84    error ("Primitive or external " ^ x ^ " is not supported.")
     85  | LIN.St_addr x ->
     86    [`Mov (`DPTR, x)]
    6987  | LIN.St_from_acc r ->
    7088    [`MOV (`U3 (I8051.reg_addr r, `A))]
     
    101119  | LIN.St_call_id f ->
    102120    [`Call f]
    103   | LIN.St_call_ptr (f1, f2) ->
    104     translate_code glbls_addr set_ra_label
    105       (LIN.St_call_id set_ra_label :: (call_ptr_instrs f1 f2))
     121(*
     122  | LIN.St_call_ptr ->
     123    (`Call env.set_ra_lbl) :: (call_ptr_instrs env)
     124*)
     125  | LIN.St_call_ptr ->
     126    let lbl = env.fresh () in
     127    translate_code env
     128      [LIN.St_to_acc I8051.dpl ;
     129       LIN.St_from_acc I8051.st0 ;
     130       LIN.St_to_acc I8051.dph ;
     131       LIN.St_from_acc I8051.st1 ;
     132       LIN.St_addr lbl ;
     133       LIN.St_to_acc I8051.dpl ;
     134       LIN.St_push ;
     135       LIN.St_to_acc I8051.dph ;
     136       LIN.St_push ;
     137       LIN.St_to_acc I8051.st0 ;
     138       LIN.St_push ;
     139       LIN.St_to_acc I8051.st1 ;
     140       LIN.St_push ;
     141       LIN.St_return ;
     142       LIN.St_label lbl]
    106143  | LIN.St_condacc lbl ->
    107144    [`WithLabel (`JNZ (`Label lbl))]
     
    109146    [`RET]
    110147
    111 and translate_code glbls_addr set_ra_label code =
    112   List.flatten (List.map (translate_statement glbls_addr set_ra_label) code)
     148and translate_code env code =
     149  List.flatten (List.map (translate_statement env) code)
    113150
    114151
    115 let translate_fun_def glbls_addr set_ra_label (id, def) =
     152let translate_fun_def env (id, def) =
    116153  let code = match def with
    117   | LIN.F_int code -> translate_code glbls_addr set_ra_label code
     154  | LIN.F_int code -> translate_code env code
    118155  | LIN.F_ext ext -> [`NOP] in
    119   (`Label id) :: code
     156  ((`Label id) :: code)
    120157
    121 (*
    122 let translate_fun_def glbls_addr (id, def) = match def with
    123   | LIN.F_int code -> (`Label id) :: (translate_code glbls_addr code)
    124   | LIN.F_ext ext ->
    125     error ("potential call to unsupported external " ^ ext.AST.ef_tag ^ ".")
    126 *)
    127 
    128 let fun_set_ra set_ra_label =
    129   let size = 0 (* TODO *) in
    130   [LIN.St_label set_ra_label ;
    131    LIN.St_pop ;
    132    LIN.St_from_acc I8051.st1 ;
    133    LIN.St_pop ;
    134    LIN.St_from_acc I8051.st0 ;
    135    LIN.St_int (I8051.a, size) ;
    136    LIN.St_op2 (I8051.Add, I8051.st0) ;
    137    LIN.St_push ;
    138    LIN.St_op2 (I8051.Addc, I8051.st1) ;
    139    LIN.St_push ;
    140    LIN.St_to_acc I8051.st0 ;
    141    LIN.St_push ;
    142    LIN.St_to_acc I8051.st1 ;
    143    LIN.St_push ;
    144    LIN.St_return]
    145 
    146 let translate_functs glbls_addr exit_label set_ra_label main functs =
     158let translate_functs env main functs =
    147159  let preamble = match main with
    148160    | None -> []
     
    150162      [`MOV (`U3 (`DIRECT (byte_of_int I8051.isp_addr),
    151163                  data_of_int I8051.isp_init)) ;
     164       `MOV (`U3 (`DIRECT (byte_of_int I8051.spl_addr),
     165                  data_of_int I8051.spl_init)) ;
     166       `MOV (`U3 (`DIRECT (byte_of_int I8051.sph_addr),
     167                  data_of_int I8051.sph_init)) ;
    152168       `Call main ;
    153        `Label exit_label ; `Jmp exit_label] in
    154 (*
    155   let fun_set_ra =
    156     translate_code glbls_addr set_ra_label (fun_set_ra set_ra_label) in
    157 *)
    158   preamble @ (* fun_set_ra @ *)
    159   (List.flatten (List.map (translate_fun_def glbls_addr set_ra_label) functs))
     169       `Label env.exit_lbl ; `Jmp env.exit_lbl] in
     170  preamble @ (List.flatten (List.map (translate_fun_def env) functs))
    160171
    161172
    162 let globals_addr l =
    163   let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
    164   fst (List.fold_left f ([], 0) l)
     173let init_env p =
     174  let f_externals (id, def) = match def with LIN.F_ext _ -> [id] | _ -> [] in
     175  let externals =
     176    List.fold_left (fun res def -> res @ (f_externals def)) [] p.LIN.functs in
     177  let prog_lbls = prog_labels p in
     178  let exit_lbl = Label.Gen.fresh_prefix prog_lbls "_exit" in
     179  let fresh = Label.make_fresh prog_lbls "_call_ret" in
     180  make_env externals exit_lbl fresh
    165181
    166182
     
    171187
    172188let translate p =
    173   let prog_lbls = prog_labels p in
    174   let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
    175   let set_ra_label = Label.Gen.fresh_prefix prog_lbls "_set_ra" in
    176   let glbls_addr = globals_addr p.LIN.vars in
     189  let env = init_env p in
    177190  let p =
    178191    { ASM.ppreamble = p.LIN.vars ;
    179       ASM.pexit_label = exit_label ;
    180       ASM.pcode =
    181         translate_functs glbls_addr exit_label set_ra_label
    182           p.LIN.main p.LIN.functs ;
     192      ASM.pexit_label = env.exit_lbl ;
     193      ASM.pcode = translate_functs env p.LIN.main p.LIN.functs ;
    183194      ASM.phas_main = p.LIN.main <> None } in
    184195  ASMInterpret.assembly p
Note: See TracChangeset for help on using the changeset viewer.