| 1 | |
|---|
| 2 | (** A playground function for developers where they can test very specific |
|---|
| 3 | functionalities not available in the compiler. |
|---|
| 4 | It is called with the -dev option. |
|---|
| 5 | [filenames] are the file names given in the command line when calling |
|---|
| 6 | acc. *) |
|---|
| 7 | |
|---|
| 8 | let do_dev_test (filenames : string list) : unit = |
|---|
| 9 | |
|---|
| 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 | (* |
|---|
| 45 | let f filename = |
|---|
| 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 |
|---|
| 63 | in |
|---|
| 64 | |
|---|
| 65 | List.iter f filenames |
|---|
| 66 | *) |
|---|
