Changeset 1488


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

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

Location:
Deliverables/D2.2/8051
Files:
18 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/Makefile.generic

    r486 r1488  
    77                   echo $(OTARGET);          \
    88              else echo $(BTARGET); fi)
     9
     10PREFIX ?= /usr/local
    911
    1012TESTDIR  = tests
  • Deliverables/D2.2/8051/src/ASM/ASMInterpret.ml

    r1462 r1488  
    10361036             List.flatten (List.map assembly1 translation)
    10371037      | `Mov (`DPTR,s) ->
    1038           let addrr16 = StringTools.Map.find s datalabels in
    1039            assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
     1038          (* let addr16 = StringTools.Map.find s datalabels in *)
     1039          let addrr16 =
     1040            try StringTools.Map.find s datalabels
     1041            with Not_found -> StringTools.Map.find s labels in
     1042          assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
    10401043      | `Jmp s ->
    10411044          let pc_offset = StringTools.Map.find s labels in
     
    20052008    (res, List.rev !trace)
    20062009  else (IntValue.Int32.zero, [])
     2010
     2011
     2012let size_of_instr instr =
     2013  let exit_lbl = "exit" in
     2014  let p = { ASM.ppreamble = [] ; ASM.pexit_label = exit_lbl ;
     2015            ASM.pcode = [instr ; `Label exit_lbl] ; ASM.phas_main = false } in
     2016  let p = assembly p in
     2017  let status = load_program p in
     2018  let addr_zero = BitVectors.vect_of_int 0 `Sixteen in
     2019  let (_, size, _) = fetch status.code_memory addr_zero in
     2020  BitVectors.int_of_vect size
     2021
     2022let size_of_instrs instrs =
     2023  let f res instr = res + (size_of_instr instr) in
     2024  List.fold_left f 0 instrs
  • Deliverables/D2.2/8051/src/ASM/ASMInterpret.mli

    r743 r1488  
    129129val load_program : ASM.program -> status
    130130val interpret    : bool -> ASM.program -> AST.trace
     131
     132val size_of_instrs : ASM.labelled_instruction list -> int
  • Deliverables/D2.2/8051/src/ASM/I8051.ml

    r818 r1488  
    170170let rets = [dpl ; dph ; r00 ; r01]
    171171
     172let spl_addr = spl
     173let spl_init = 255
     174let sph_addr = sph
     175let sph_init = 255
    172176let isp_addr = 129
    173177let isp_init = 47
  • Deliverables/D2.2/8051/src/ASM/I8051.mli

    r818 r1488  
    5555val carry : register (* only used for the liveness analysis *)
    5656
     57val spl_addr : int
     58val spl_init : int
     59val sph_addr : int
     60val sph_init : int
    5761val isp_addr : int
    5862val isp_init : int
  • Deliverables/D2.2/8051/src/ERTL/ERTLToLTLI.ml

    r1462 r1488  
    284284
    285285      | ERTL.St_call_ptr (f1, f2, _, l) ->
    286         let l =
    287           read f2 (fun hdw2 ->
    288             LTL.St_skip
    289               (read f1 (fun hdw1 -> LTL.St_call_ptr (hdw1, hdw2, l)))) in
     286        let l = generate (LTL.St_call_ptr l) in
     287        let l = generate (LTL.St_from_acc (I8051.dph, l)) in
     288        let l = generate (LTL.St_to_acc (I8051.st0, l)) in
     289        let l = generate (LTL.St_from_acc (I8051.dpl, l)) in
     290        let l = read f1 (fun hdw -> LTL.St_to_acc (hdw, l)) in
     291        let l = generate (LTL.St_from_acc (I8051.st0, l)) in
     292        let l = read f2 (fun hdw -> LTL.St_to_acc (hdw, l)) in
    290293        LTL.St_skip l
    291294
  • Deliverables/D2.2/8051/src/LIN/LIN.mli

    r1462 r1488  
    6767  | St_call_id of AST.ident
    6868
    69   (* Call to a function given its address. Parameter are the registers holding
    70      the address of the function. *)
    71   | St_call_ptr of I8051.register * I8051.register
     69  (* Call to a function given its address in DPTR. *)
     70  | St_call_ptr
    7271
    7372  (* Branch on A accumulator. Parameter is the label to go to when the A
  • Deliverables/D2.2/8051/src/LIN/LINInterpret.ml

    r1462 r1488  
    272272      interpret_call st (Mem.find_global st.mem f)
    273273
    274     | LIN.St_call_ptr (f1, f2) ->
    275       let addr = List.map (fun r -> get_reg r st) [f1 ; f2] in
    276       interpret_call st addr
     274    | LIN.St_call_ptr ->
     275      interpret_call st (dptr st)
    277276
    278277    | LIN.St_condacc lbl_true ->
  • Deliverables/D2.2/8051/src/LIN/LINPrinter.ml

    r1462 r1488  
    5454    Printf.sprintf "movex @DPTR, %s" print_a
    5555  | LIN.St_call_id f -> Printf.sprintf "call \"%s\"" f
    56   | LIN.St_call_ptr (f1, f2) ->
    57     Printf.sprintf "call_ptr [%s ; %s]" (print_reg f1) (print_reg f2)
     56  | LIN.St_call_ptr ->
     57    Printf.sprintf "call_ptr DPTR"
    5858  | LIN.St_condacc lbl_true ->
    5959    Printf.sprintf "branch %s <> 0, %s" print_a lbl_true
  • 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
  • Deliverables/D2.2/8051/src/LTL/LTL.mli

    r1462 r1488  
    7575  | St_call_id of AST.ident * Label.t
    7676
    77   (* Call to a function given its address. Parameters are the registers holding
    78      the address of the function, and the label of the next statement. *)
    79   | St_call_ptr of I8051.register * I8051.register * Label.t
     77  (* Call to a function given its address in DPTR. Parameter is the label of the
     78     next statement. *)
     79  | St_call_ptr of Label.t
    8080
    8181  (* Branch on A accumulator. Parameters are the label to go to when the A
  • Deliverables/D2.2/8051/src/LTL/LTLInterpret.ml

    r1462 r1488  
    304304      interpret_call lbls_offs st (Mem.find_global st.mem f) lbl
    305305
    306     | LTL.St_call_ptr (f1, f2, lbl) ->
    307       let addr = List.map (fun r -> get_reg r st) [f1 ; f2] in
    308       interpret_call lbls_offs st addr lbl
     306    | LTL.St_call_ptr lbl ->
     307      interpret_call lbls_offs st (dptr st) lbl
    309308
    310309    | LTL.St_condacc (lbl_true, lbl_false) ->
  • Deliverables/D2.2/8051/src/LTL/LTLPrinter.ml

    r1462 r1488  
    5555    Printf.sprintf "movex @DPTR, %s --> %s" print_a lbl
    5656  | LTL.St_call_id (f, lbl) -> Printf.sprintf "call \"%s\" --> %s" f lbl
    57   | LTL.St_call_ptr (f1, f2, lbl) ->
    58     Printf.sprintf "call_ptr [%s ; %s] --> %s" (print_reg f1) (print_reg f2) lbl
     57  | LTL.St_call_ptr lbl ->
     58    Printf.sprintf "call_ptr DPTR --> %s" lbl
    5959  | LTL.St_condacc (lbl_true, lbl_false) ->
    6060    Printf.sprintf "branch %s <> 0 --> %s, %s" print_a lbl_true lbl_false
  • Deliverables/D2.2/8051/src/LTL/LTLToLIN.ml

    r1462 r1488  
    5050  | LTL.St_call_id (f, _) ->
    5151    LIN.St_call_id f
    52   | LTL.St_call_ptr (f1, f2, _) ->
    53     LIN.St_call_ptr (f1, f2)
     52  | LTL.St_call_ptr _ ->
     53    LIN.St_call_ptr
    5454
    5555  (* Conditional branch statement. In [LIN], control implicitly
  • Deliverables/D2.2/8051/src/LTL/LTLToLINI.ml

    r1462 r1488  
    131131        | LTL.St_store l
    132132        | LTL.St_call_id (_, l)
    133         | LTL.St_call_ptr (_, _, l) ->
     133        | LTL.St_call_ptr l ->
    134134
    135135          visit l
  • Deliverables/D2.2/8051/src/LTL/branch.ml

    r1462 r1488  
    8080    | LTL.St_call_id (f, l) ->
    8181      LTL.St_call_id (f, rep l)
    82     | LTL.St_call_ptr (f1, f2, l) ->
    83       LTL.St_call_ptr (f1, f2, rep l)
     82    | LTL.St_call_ptr l ->
     83      LTL.St_call_ptr (rep l)
    8484    | LTL.St_condacc (lbl_true, lbl_false) ->
    8585      LTL.St_condacc (rep lbl_true, rep lbl_false)
  • Deliverables/D2.2/8051/src/dev_test.ml

    r1462 r1488  
    88let do_dev_test (filenames : string list) : unit =
    99
     10  let main_lbl = "main" in
     11  let exit_lbl = "exit" in
     12  let lbl = "label" in
     13
     14  let code =
     15    [(* Prelude *)
     16      `Call main_lbl ; (* call main *)
     17      `Label exit_lbl ; (* when coming back from main, do an infinite
     18                           jump here *)
     19      `Jmp exit_lbl ;
     20    (* Main *)
     21      `Label main_lbl ;
     22      `Mov (`DPTR, lbl) ; (* fetch the address of lbl in DPTR *)
     23    (* Push the address of lbl on the stack. *)
     24      `PUSH (I8051.reg_addr I8051.dpl) ; (* low bytes first *)
     25      `PUSH (I8051.reg_addr I8051.dph) ; (* then high bytes *)
     26      `RET ; (* this should jump to lbl, i.e. right below *)
     27      `Label lbl ;
     28      `RET (* jump to the exit label *)] in
     29
     30  (* Create a labelled ASM program with the code. *)
     31  let prog =
     32    { ASM.ppreamble = [] ;
     33      ASM.pexit_label = exit_lbl ;
     34      ASM.pcode = code ;
     35      ASM.phas_main = true } in
     36
     37  (* Assemble it. *)
     38  let prog = Languages.AstASM (ASMInterpret.assembly prog) in
     39
     40  (* Save the result in a fresh file prefixed by "yop" and whose extension is
     41     "hex". *)
     42  Languages.save false false "yop" "" prog
     43
     44(*
    1045  let f filename =
    11     Printf.printf "Processing %s...\n%!" filename ;
    12     let target = Languages.RTL in
    13     let print = false in
    14     let debug = true in
    15     let interpret = true in
    16     let p = Languages.parse Languages.Clight filename in
    17     let p = Languages.add_runtime p in
    18     let p = Languages.labelize p in
    19     let ps = Languages.compile false Languages.Clight target p in
    20     let f f' p = match Languages.language_of_ast p with
    21       | l when l = target -> f' p
    22       | _ -> ()
    23     in
    24     let actions =
    25       [(print, Languages.save false false filename "") ;
    26        (interpret, (fun p -> ignore (Languages.interpret debug p)))] in
    27     List.iter (fun (b, f') -> if b then List.iter (f f') ps else ()) actions
     46  Printf.printf "Processing %s...\n%!" filename ;
     47  let target = Languages.RTL in
     48  let print = false in
     49  let debug = true in
     50  let interpret = true in
     51  let p = Languages.parse Languages.Clight filename in
     52  let p = Languages.add_runtime p in
     53  let p = Languages.labelize p in
     54  let ps = Languages.compile false Languages.Clight target p in
     55  let f f' p = match Languages.language_of_ast p with
     56  | l when l = target -> f' p
     57  | _ -> ()
     58  in
     59  let actions =
     60  [(print, Languages.save false false filename "") ;
     61  (interpret, (fun p -> ignore (Languages.interpret debug p)))] in
     62  List.iter (fun (b, f') -> if b then List.iter (f f') ps else ()) actions
    2863  in
    2964
    3065  List.iter f filenames
     66*)
  • Deliverables/D2.2/8051/src/languages.mli

    r1462 r1488  
    7878(** {2 Serialization} *)
    7979
    80 (** [save asm_pretty exact_output filename input_ast] prints [input_ast] in a
    81     file whose name is prefixed by [filename] and whose extension is deduced
    82     from the language of the AST. If [exact_output] is false then the written
    83     file will be fresh. If [asm_pretty] is true, then an additional
    84     pretty-printed assembly file is output. *)
     80(** [save asm_pretty exact_output filename suffix input_ast] prints [input_ast]
     81    in a file whose name is prefixed by [filename], suffixed by [suffix] and
     82    whose extension is deduced from the language of the AST. If [exact_output]
     83    is false then the written file will be fresh. If [asm_pretty] is true, then
     84    an additional pretty-printed assembly file is output. *)
    8585val save : bool -> bool -> string -> string -> ast -> unit
    8686
Note: See TracChangeset for help on using the changeset viewer.