Project

General

Profile

Revision 54ae8ac7 src/c_backend.ml

View differences:

src/c_backend.ml
357 357
    (Utils.pp_final_char_if_non_empty ", " static)
358 358
    self inst
359 359

  
360
let rec pp_conditional (m: machine_t) self fmt c tl el =
360
let has_c_prototype funname dependencies =
361
  let imported_node_opt = (* We select the last imported node with the name funname.
362
			       The order of evaluation of dependencies should be
363
			       compatible with overloading. (Not checked yet) *) 
364
      List.fold_left
365
	(fun res (_, _, decls) -> 
366
	  match res with
367
	  | Some _ -> res
368
	  | None -> 
369
	    let matched = fun t -> match t.top_decl_desc with 
370
	      | ImportedNode nd -> nd.nodei_id = funname 
371
	      | _ -> false
372
	    in
373
	    if List.exists matched decls then (
374
	      match (List.find matched decls).top_decl_desc with
375
	      | ImportedNode nd -> Some nd
376
	      | _ -> assert false
377
	    )
378
	    else
379
	      None
380
	) None dependencies in
381
    match imported_node_opt with
382
    | None -> false
383
    | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
384

  
385
let rec pp_conditional dependencies (m: machine_t) self fmt c tl el =
361 386
  fprintf fmt "@[<v 2>if (%a) {%t%a@]@,@[<v 2>} else {%t%a@]@,}"
362 387
    (pp_c_val self (pp_c_var_read m)) c
363 388
    (Utils.pp_newline_if_non_empty tl)
364
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) tl
389
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) tl
365 390
    (Utils.pp_newline_if_non_empty el)
366
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) el
391
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) el
367 392

  
368
and pp_machine_instr (m: machine_t) self fmt instr =
393
and pp_machine_instr dependencies (m: machine_t) self fmt instr =
369 394
  match instr with 
370 395
  | MReset i ->
371 396
    pp_machine_reset m self fmt i
......
378 403
      m self (pp_c_var_read m) fmt
379 404
      i.var_type (StateVar i) v
380 405
  | MStep ([i0], i, vl) when Basic_library.is_internal_fun i  ->
381
    pp_machine_instr m self fmt (MLocalAssign (i0, Fun (i, vl)))
406
    pp_machine_instr dependencies m self fmt (MLocalAssign (i0, Fun (i, vl)))
407
  | MStep ([i0], i, vl) when has_c_prototype i dependencies -> 
408
    fprintf fmt "%a = %s(%a);" 
409
      (pp_c_val self (pp_c_var_read m)) (LocalVar i0) 
410
      i
411
      (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) vl
382 412
  | MStep (il, i, vl) ->
383 413
    pp_instance_call m self fmt i vl il
384 414
  | MBranch (g,hl) ->
......
387 417
	 (* may disappear if we optimize code by replacing last branch test with default *)
388 418
      let tl = try List.assoc tag_true  hl with Not_found -> [] in
389 419
      let el = try List.assoc tag_false hl with Not_found -> [] in
390
      pp_conditional m self fmt g tl el
420
      pp_conditional dependencies m self fmt g tl el
391 421
    else (* enum type case *)
392 422
      fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]"
393 423
	(pp_c_val self (pp_c_var_read m)) g
394
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch m self)) hl
424
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch dependencies m self)) hl
395 425

  
396
and pp_machine_branch m self fmt (t, h) =
397
  fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_c_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) h
426
and pp_machine_branch dependencies m self fmt (t, h) =
427
  fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_c_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) h
398 428

  
399 429

  
400 430
(**************************************************************************)
......
528 558
let print_import_standard fmt =
529 559
  fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix
530 560

  
531
let print_import_prototype fmt decl =
532
  match decl.top_decl_desc with
533
  | Open m -> fprintf fmt "#include \"%s.h\"@," m
534
  | _ -> () (* We don't do anything here *)
561
let print_import_prototype fmt (s, _, _) =
562
  fprintf fmt "#include \"%s.h\"@," s
535 563
    
536 564
let pp_registers_struct fmt m =
537 565
  if m.mmemory <> []
......
699 727
    (Utils.fprintf_list ~sep:"" print_alloc_array) array_mem
700 728
    (Utils.fprintf_list ~sep:"" print_alloc_instance) m.minstances
701 729

  
702
let print_stateless_code fmt m =
730
let print_stateless_code dependencies fmt m =
703 731
  let self = "__ERROR__" in
704 732
  if not (!Options.ansi && is_generic_node { top_decl_desc = Node m.mname; top_decl_loc = Location.dummy_loc })
705 733
  then
......
712 740
      (* check assertions *)
713 741
      (pp_c_checks self) m
714 742
      (* instrs *)
715
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
743
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
716 744
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
717 745
      (fun fmt -> fprintf fmt "return;")
718 746
  else
......
727 755
      (* check assertions *)
728 756
      (pp_c_checks self) m
729 757
      (* instrs *)
730
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
758
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
731 759
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
732 760
      (fun fmt -> fprintf fmt "return;")
733 761

  
734
let print_step_code fmt m self =
762
let print_reset_code dependencies fmt m self =
763
  fprintf fmt "@[<v 2>%a {@,%a%treturn;@]@,}@.@."
764
    (print_reset_prototype self) (m.mname.node_id, m.mstatic)
765
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.minit
766
    (Utils.pp_newline_if_non_empty m.minit)
767

  
768
let print_step_code dependencies fmt m self =
735 769
  if not (!Options.ansi && is_generic_node { top_decl_desc = Node m.mname; top_decl_loc = Location.dummy_loc })
736 770
  then
737 771
    (* C99 code *)
......
747 781
      (* check assertions *)
748 782
      (pp_c_checks self) m
749 783
      (* instrs *)
750
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
784
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
751 785
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
752 786
      (fun fmt -> fprintf fmt "return;")
753 787
  else
......
762 796
      (* check assertions *)
763 797
      (pp_c_checks self) m
764 798
      (* instrs *)
765
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
799
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
766 800
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
767 801
      (fun fmt -> fprintf fmt "return;")
768 802

  
769
let print_machine fmt m =
803
let print_machine dependencies fmt m =
770 804
  if fst (get_stateless_status m) then
771 805
    begin
772 806
      (* Step function *)
773
      print_stateless_code fmt m
807
      print_stateless_code dependencies fmt m
774 808
    end
775 809
  else
776 810
    begin
......
783 817
	);
784 818
      let self = mk_self m in
785 819
      (* Reset function *)
786
      fprintf fmt "@[<v 2>%a {@,%a%treturn;@]@,}@.@."
787
	(print_reset_prototype self) (m.mname.node_id, m.mstatic)
788
	(Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.minit
789
	(Utils.pp_newline_if_non_empty m.minit);
820
      print_reset_code dependencies fmt m self;
790 821
      (* Step function *)
791
      print_step_code fmt m self
822
      print_step_code dependencies fmt m self
792 823
    end
793 824

  
794 825
(********************************************************************************************)
......
906 937
	(pp_c_type_decl filename cpt_type var) def
907 938
    | _        -> ()) type_table
908 939

  
940

  
941
let header_has_code header =
942
  List.exists 
943
    (fun top -> 
944
      match top.top_decl_desc with
945
      | Consts _ -> true 
946
      | ImportedNode nd -> nd.nodei_in_lib = None
947
      | _ -> false
948
    )
949
    header
950

  
951
let header_libs header =
952
  List.fold_left (fun accu top ->
953
    match top.top_decl_desc with
954
      | ImportedNode nd -> (match nd.nodei_in_lib with 
955
	| None -> accu 
956
	| Some lib -> Utils.list_union [lib] accu)
957
      | _ -> accu 
958
  ) [] header 
959
    
909 960
let print_makefile basename nodename dependencies fmt =
961
  let compiled_dependencies = 
962
    List.filter (fun (_, _, header) -> header_has_code header) dependencies
963
  in
964
  let lib_dependencies = 
965
    List.fold_left 
966
      (fun accu (_, _, header) -> Utils.list_union (header_libs header) accu) [] dependencies 
967
  in
910 968
  fprintf fmt "GCC=gcc@.";
911 969
  fprintf fmt "LUSTREC=%s@." Sys.executable_name;
912 970
  fprintf fmt "LUSTREC_BASE=%s@." (Filename.dirname (Filename.dirname Sys.executable_name));
......
916 974
  fprintf fmt "\t${GCC} -I${INC} -I. -c %s.c@." basename;    
917 975
  List.iter (fun s -> (* Format.eprintf "Adding dependency: %s@." s;  *)
918 976
    fprintf fmt "\t${GCC} -I${INC} -c %s@." s)
919
    (("${INC}/io_frontend.c")::(List.map (fun s -> s ^ ".c") dependencies));    
920
(*  fprintf fmt "\t${GCC} -I${INC} -c ${INC}/StdLibrary.c@."; *)
921
(*  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o StdLibrary.o -lm %s.o@." basename nodename basename*)
922
  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o %a -lm %s.o@." basename nodename 
923
    (Utils.fprintf_list ~sep:" " (fun fmt s -> Format.fprintf fmt "%s.o" s)) dependencies basename;
977
    (("${INC}/io_frontend.c"):: (* IO functions when a main function is computed *)
978
	(List.map 
979
	   (fun (s, local, _) -> 
980
	     (if local then s else Version.prefix ^ "/include/lustrec/" ^ s) ^ ".c")
981
	   compiled_dependencies));    
982
  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o %a %s.o %a@." basename nodename 
983
    (Utils.fprintf_list ~sep:" " (fun fmt (s, _, _) -> Format.fprintf fmt "%s.o" s)) compiled_dependencies 
984
    basename
985
    (Utils.fprintf_list ~sep:" " (fun fmt lib -> fprintf fmt "-l%s" lib)) lib_dependencies
986
    ;
924 987
 fprintf fmt "@.";
925 988
 fprintf fmt "clean:@.";
926 989
 fprintf fmt "\t\\rm -f *.o %s_%s@." basename nodename
......
985 1048
  (* Print the prototype of imported nodes *)
986 1049
  fprintf source_fmt "/* Imported nodes declarations */@.";
987 1050
  fprintf source_fmt "@[<v>";
988
  List.iter (print_import_prototype source_fmt) prog;
1051
  List.iter (print_import_prototype source_fmt) dependencies;
989 1052
  fprintf source_fmt "@]@.";
990 1053
  (* Print consts *)
991 1054
  fprintf source_fmt "/* Global constants (definitions) */@.";
992 1055
  List.iter (fun c -> print_const_def source_fmt c) (get_consts prog);
993 1056
  pp_print_newline source_fmt ();
994 1057
  (* Print nodes one by one (in the previous order) *)
995
  List.iter (print_machine source_fmt) machines;
1058
  List.iter (print_machine dependencies source_fmt) machines;
996 1059
  main_print source_fmt;
997 1060

  
998 1061
  (* Generating Makefile *)

Also available in: Unified diff