luciole.ml

(* Time-stamp: <modified the 01/02/2019 (at 10:45) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** This file may only be copied under the terms of the CeCill
** Public License
**-----------------------------------------------------------------------
**
** File: luciole.ml
** Author: erwan.jahier@univ-grenoble-alpes.fr
**
*)

(* Var name and C type *)
type vn_ct = string * string  

let soi = string_of_int
(** Generates stub files for calling luciole.  *)


(** Generate a Makefile that compiles files generated by gen_stubs,
   and calls luciole on the resulting .dro file.

   the first arg is a just a string used to invent file names
*)
let (gen_makefile :string -> unit) =
  fun str -> 
  let oc = open_out ("Makefile." ^ str) in
  let p s = output_string oc s in
  let pn s = p (s^"\n") in
    
    p (Mypervasives.entete "# " LutilsVersion.str LutilsVersion.sha);
(*     pn "LURETTE_PATH=/home/jahier/lurette/"; *)
    pn "CFLAGS = -L$(LURETTE_PATH)/lib -I$(LURETTE_PATH)/include  -I$(LUSTRE_INSTALL)/include ";
    pn "";
    pn "LIBS = -lluc4c_nc -llucky_nc -lgmp -lm -ldl";
    pn "";
    pn ("all: " ^ str ^ ".dro");
    pn ("	simec ./" ^ str ^ ".dro");
    pn "";
(*     pn (str ^ ".c:" ^ str ^ "_luciole.c"); *)
(*     pn ""; *)
(*     pn (str ^ "_luciole.c: " ^ str ^ env_ext); *)
(*     pn ("	$(LURETTE_PATH)/bin/luc2c -pp lucky_cpp --luciole " ^ str ^ env_ext); *)
    pn "";
    pn (str ^ ".dro: " ^ str ^ "_luciole.o " ^ str ^ ".o");
    pn ("	g++ $(CFLAGS) " ^ str ^ "_luciole.o  " ^ str ^ ".o $(LIBS) -shared -o " ^ str ^ ".dro");
    pn "";
    pn "";
    pn "%.o: %.c";
    pn "	$(CC) $(CFLAGS) -c  $<";
    pn "";
    pn "";
    pn "clean:";
    pn ("	rm -f  "^str^".o "^str^".c  "^str^".h "^str^"_luciole.c  "
	^str^"_luciole.o  "^str^".dro  "^str^".h Makefile."^str);
    print_string ("File Makefile." ^ str ^ " has been created. Launch \n");
    print_string ("              make -f Makefile." ^ str ^ "\n to run luciole\n");
    close_out oc;
    ignore (Mypervasives.my_create_process "make" ["-f";("Makefile." ^ str)])

  
(* exported  *)
let (gen_stubs : string -> vn_ct list -> vn_ct list -> unit) =
  fun str inputs outputs ->
    let oc = open_out (str^"_luciole.c") in
    let p s = output_string oc s in
    let pn s = p (s^"\n") in
    
    let d2r = function
      | "_real" | "real" | "float"  | "double" -> "real"
      | "_bool" | "bool" -> "bool"
      | "_int" -> "int"
      | e -> "int"
    in
    let vn_ct_to_array (vn, ct) =
      pn ("   {\""^vn^"\", \""^(d2r ct)^"\", NULL},")
    in 
    let _vn_ct_to_output_functions i (vn,ct) =
      pn ("void "^str^"_O_"^vn^"("^str^"_ctx* cdata, "^
	          (ct)^" val){");
      pn ("   _THIS->_"^vn^" = val;");
      pn "}";
      (i+1)
    in

    let vn_ct_to_input_init i (vn,ct) =
      pn ("  _intab["^(string_of_int i)^"].valptr = (void*)(& _THIS->_"^vn^");");
      (i+1)
    in
    let vn_ct_to_output_init i (vn,ct) =
      pn ("  _outab["^(string_of_int i)^"].valptr = (void*)(& _THIS->_"^vn^");");
      (i+1)
    in
    let simec_version_number = "1.1" in
    
    p (Mypervasives.entete "// " LutilsVersion.str LutilsVersion.sha);
    pn "/* droconf.h begins */
/*
Struct necessary for building a DRO archive
(Dynamically linkable Reactive Object)
Such an archive can be loaded by simec/luciole
*/
#define DROVERSION \"1.1\"
#define xstr(s) str(s)  /* converts macro to string */
#define str(s) #s
/* should be of type type dro_desc_t */
#define DRO_DESC_NAME  dro_desc
struct dro_var_t {
	const char* ident;
	const char* type;
	void* valptr;
};

struct dro_desc_t {
	const char* version;
	const char* name;
	int nbins;
	struct dro_var_t* intab;
	int nbouts;
	struct dro_var_t* outab;
	int ( *step )();
	void ( *reset )();
	void ( *init )();
}; 
/* droconf.h ends */
";
    pn "#include \"stdlib.h\"";      
    pn "#include <stdio.h>";
    pn "#include <string.h>";

    pn "typedef int _bool;";
    pn "typedef int _int;";
    pn "typedef double _real;";
    pn "struct _luciole_ctx {";
    pn "// INPUTS";
    List.iter 
      (fun (vn,t) -> pn ("    _"^ t ^ " _" ^ vn ^";"))
      inputs;
    pn "// OUTPUTS";
    List.iter
      (fun (vn,t) -> pn ("    _"^ t ^ " _" ^ vn ^";"))
      outputs;
    pn "};";
    pn "typedef struct _luciole_ctx luciole_ctx;";
    pn "static luciole_ctx* _THIS = NULL;";
    
    pn "// inputs array";
    pn "struct dro_var_t _intab[] = {";
    List.iter vn_ct_to_array inputs;
    pn "}; ";
    pn "";
    pn "// outputs array ";
    pn "struct dro_var_t _outab[] = {";
    List.iter vn_ct_to_array outputs;
    pn "};";
    pn "";

    pn "void __do_reset(){";
    pn "// create";
    pn " fprintf(stdout,\"#reset\\n\");";
    pn " fprintf(stderr,\"reseting !!!\\n\");";
    pn "fflush(stdout);";
    pn "  _THIS = malloc(sizeof(luciole_ctx));";
    ignore (List.fold_left vn_ct_to_input_init 0 inputs);
    ignore (List.fold_left vn_ct_to_output_init 0 outputs);
    
    pn "}";

    pn "
#define LINEMAXSIZE 256
void _read_pragma(char b[LINEMAXSIZE]) {
   int s = 1;

   if (!strcmp(b,\"#quit\")) exit(0);
   if (!strcmp(b,\"#q\")) exit(0);
   if (!strcmp(b,\"#reset\")) __do_reset();
   return;
}

/* Standard Input procedures **************/
_bool _get_bool(){
   char b[LINEMAXSIZE];
   _bool r = 0;
   int s = 1;
   char c;
   do {
      if(scanf(\"%s\", b)==EOF) exit(0);
      s = sscanf(b, \"%c\", &c);
      r = -1;
      if(c == 'q') exit(0);
      if(c == '#') _read_pragma(b);
      if((c == '0') || (c == 'f') || (c == 'F')) r = 0;
      if((c == '1') || (c == 't') || (c == 'T')) r = 1;
   } while((s != 1) || (r == -1));
   return r;
}
_int _get_int(){
   char b[LINEMAXSIZE];
   _int r;
   int s = 1;
   char c;
   do {
      if(scanf(\"%s\", b)==EOF) exit(0);
      s = sscanf(b, \"%c\", &c);
      if(c == 'q') exit(0);
      if(c == '#') {
         _read_pragma(b);
      } else {
        s = sscanf(b, \"%d\", &r);
      }
   } while(s != 1);
   return r;
}
_real _get_real(){
   char b[LINEMAXSIZE];
   _real r;
   int s = 1;
   char c;
   do {
      if(scanf(\"%s\", b)==EOF) exit(0);
      s = sscanf(b, \"%c\", &c);
      if(c == 'q') exit(0);
      if(c == '#') {
         _read_pragma(b);
      } else {
         s = sscanf(b, \"%lf\", &r);
      }
   } while(s != 1);
   return r;
}
/* Standard Output procedures **************/
void _put_bool(_bool _V){
   printf(\"%s\\n\", (_V)? \"t\" : \"f\");
}
void _put_int(_int _V){
   printf(\"%d\\n\", _V);
}
void _put_real(_real _V){
   printf(\"%f\\n\", _V);
}
";
    pn "int __do_step();";
    pn "int internal_step(){";
    pn "  return __do_step();";
    pn "}";
    pn "void __do_reset();";
    pn "void internal_reset(){";
    pn "  return __do_reset();";
    pn "}";
    pn "void __do_init();";
    pn "void internal_init(){";
    pn "  return __do_init();";
    pn "}";

    pn "// ";
    pn "struct dro_desc_t DRO_DESC_NAME = {";
    pn ("   \""^simec_version_number^"\",");
    pn ("   \""^str^"\",");
    pn ("   "^(string_of_int (List.length inputs))^",");
    pn "   _intab,";
    pn ("   "^(string_of_int (List.length outputs))^",");
    pn "   _outab,";
    pn "   internal_step,";
    pn "   internal_reset,";
    pn "   internal_init";
    pn "};";
    pn "";
    pn "int __do_step(){";
    pn "if(_THIS) {";

    List.iter (fun (vn,vt) -> pn ("   _put_"^vt^"(_THIS->_" ^ vn ^");")) inputs;
    pn "   fflush(stdout);";
    List.iter (fun (vn,vt) -> pn ("   _THIS->_" ^ vn ^ " = _get_"^vt^"();")) outputs;
    pn "   //always happy...";
    pn "   return 0;";
    pn "  } else {";
    pn "    printf(\"initialisation problem\\n\");";
    pn "    return 2;";
    pn " }";
    pn "}";

    pn "void __do_init(){";
    pn "  //reset or create";
    pn "    if(_THIS) {";
    pn "     // nop";
    pn "    } else {";
    pn "      __do_reset();";
    pn "    }";
    pn " }";
    flush oc;
    close_out oc;
    print_string ("File " ^ str ^ "_luciole.c has been created\n");
    flush stdout