Skip to content

GitLab

Commit a3c512b6 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Some work on the Alices backend.

parent 0b0203fe
Hide whitespace changes
Inline Side-by-side
Makefile
View file @ a3c512b6
......@@ -50,8 +50,10 @@ cia: test cia_notest
cia_notest:
git commit -a -F log && make gen_version
amend:
amend-a:
git commit -a -F log --amend && make gen_version
amend:
git commit -F log --amend && make gen_version
ci: test
git commit -F log && make gen_version
......
install/set_env_var.in
View file @ a3c512b6
......@@ -56,9 +56,9 @@ if test -z "$SIM2CHRO" ; then
fi
if test -z "$HOST_TYPE" ; then
HOST_TYPE=@HOST_TYPE@
export HOST_TYPE
if test -z "$HOSTTYPE" ; then
HOSTTYPE=@HOSTTYPE@
export HOSTTYPE
fi
if test -z "$GNUPLOT" ; then
......
source/Lucky/luc2alice.ml
View file @ a3c512b6
......@@ -19,6 +19,7 @@ type alice_args = {
seed : int option;
env_in_vars : Exp.var list;
env_out_vars : Exp.var list;
use_sockets: bool;
}
......@@ -60,6 +61,7 @@ let (lucky_seed : int option -> string) =
(********************************************************************)
let (define_output_proc : string -> Exp.var list -> string) =
fun n vl ->
let f var =
......@@ -112,11 +114,14 @@ let (gen_alice_stub : alice_args -> string) =
("
#include \""^alice_name^".h\"
#include \"float.h\"
#include \"Ims/ImsMessageStack.h\"
// Those procedures are used by the Lucky runtime to set the lucky outputs
extern \"C\"
{
" ^ (define_output_proc fn out_vars) ^ "}
#ifdef _DEBUG
#define dbg(...) fprintf(fp, __VA_ARGS__); fflush(fp)
#else
#define dbg(...) while(0)
#endif
int "^alice_name^"::instance_cpt=0;
structTab "^alice_name^"::inputs;
......@@ -127,8 +132,26 @@ structTab "^alice_name^"::memories;
/* Build an instance of the Class "^alice_name^" */
"^alice_name^"::"^alice_name^"()
{
instance_nb = instance_cpt++;
mCtx = rcm_env_new_ctx((void *) instance_nb);
try
{
#ifdef _DEBUG
fp = fopen(\""^fn^"-"^alice_name^".log\", \"w\");
#endif
dbg(\"%s\\n\", \"--> "^alice_name^"\");
instance_nb = instance_cpt++;
mCtx = "^fn^"_new_ctx((void *) instance_nb);
dbg(\"%s\\n\", \"<-- "^alice_name^"\");
}
catch (ImsMessageStack& xMessageStack)
{
xMessageStack.InsertErrorMessage(\""^alice_name^"\", \"Err\", cImsFatal, IMS_DEBUG_INFO("^
alice_name^":Initialisation))
<< \" Erreur lors de l'initialisation du contexte de "^fn^"\";
throw xMessageStack;
}
// Inputs"
^ (gen_alice_var_tab alice_name "inputs" in_vars) ^
......@@ -144,10 +167,13 @@ structTab "^alice_name^"::memories;
/* Remove an instance of the Class "^alice_name^" */
"^alice_name^"::~"^alice_name^"()
{
// rcm_env_delete_ctx(mCtx);
"^fn^"_terminate(mCtx);
delete[] inputs.tab;
delete[] outputs.tab;
delete[] memories.tab;
#ifdef _DEBUG
fclose(fp);
#endif
}
......@@ -166,12 +192,15 @@ void "^alice_name^"::Initialisation()
/* Step */
void "^alice_name^"::Process()
{
"^fn^"_step(mCtx, step_inside);
dbg(\"%s\\n\", \"--> Process\");
"^fn^"_step(mCtx" ^ (if args.use_sockets then "" else ", step_inside")^");
dbg(\"%s\\n\", \"<-- Process\");
}
/* Terminate */
void "^alice_name^"::Terminate()
{
"^fn^"_terminate(mCtx);
// pourquoi ne pas faire 'delete toto' plutot que 'toto.Terminate()' ?
// Quand est appelé cette méthode finalement ?
}
......@@ -197,7 +226,7 @@ structTab* "^alice_name^"::Memories() {
let (gen_alice_stub_c : alice_args -> unit) =
fun args ->
let oc = open_out (args.alice_module_name ^ ".cc") in
let oc = open_out (args.alice_module_name ^ ".cpp") in
let put s = output_string oc s in
let putln s = output_string oc (s^"\n") in
let rec putlist = function
......@@ -217,12 +246,16 @@ let (gen_alice_stub_h : alice_args -> unit) =
let fn = args.env_name in
putln (Util.entete "// ");
putln ("
#include \"AlicesCommon.h\"
#define "^amn^"_interface LINKER_EXPORTED
extern \"C\"
{
#include \""^fn^".h\"
}
class "^amn^";
class "^amn^"_interface "^amn^";
#ifndef _real_type_char
#define _real_type_char 'd'
......@@ -234,8 +267,6 @@ class "^amn^";
#define _bool_type_char 'b'
#endif
struct var_info {
const char *var_name;
char var_type;
......@@ -248,7 +279,7 @@ struct structTab {
};
class "^amn^" {
class "^amn^"_interface "^amn^" {
_"^fn^"_ctx * mCtx;
static structTab inputs;
......@@ -270,3 +301,4 @@ class "^amn^" {
structTab* Memories();
};
")
source/Lucky/luc2c.ml
View file @ a3c512b6
......@@ -31,7 +31,8 @@ type optionT = {
mutable use_sockets : bool;
mutable step_mode : step_mode;
mutable seed : int option;
mutable env : string list
mutable env : string list;
mutable sock_addr : string
}
......@@ -43,7 +44,8 @@ let (option : optionT) = {
calling_module_name = "XXX_SCADE_MODULE_NAME";
step_mode = Inside;
seed = None;
env = []
env = [];
sock_addr = "127.0.0.1"
}
......@@ -197,8 +199,10 @@ let (gen_h_file : string -> Exp.var list -> Exp.var list -> Exp.var list -> unit
putln ("#ifndef _" ^ fn ^ "_H_INCLUDED \n");
putln ("#define _" ^ fn ^ "_H_INCLUDED \n");
putln "#include <luc4c_stubs.h> \n";
if not option.use_sockets then
putln "#include <luc4c_stubs.h> \n";
putln "#include <stdio.h>";
putln "//-------- Predefined types ---------";
putln "#ifndef _EC2C_PREDEF_TYPES
#define _EC2C_PREDEF_TYPES
......@@ -284,6 +288,7 @@ typedef float _float;
putln ("typedef struct _" ^ fn ^ "_ctx " ^ fn ^ "_ctx;\n");
);
putln "FILE* fp;";
putln "// To be defined by users";
List.iter
(fun var ->
......@@ -301,9 +306,10 @@ typedef float _float;
putln ("extern void "^fn^"_copy_ctx("^fn^"_ctx* dest, "^ fn ^
"_ctx* src);");
putln "\n//--------Terminate procedure -----------";
putln ("extern void "^fn^"_terminate("^fn^"_ctx* ctx);");
if option.use_sockets then (
putln "\n//--------Terminate procedure -----------";
putln ("extern void "^fn^"_terminate("^fn^"_ctx* ctx);");
);
putln "\n//--------Reset procedure -----------";
putln ("extern void "^fn^"_reset("^fn^"_ctx* ctx);");
......@@ -359,9 +365,8 @@ let put_socket_func put fn in_vars out_vars loc_vars =
#include <signal.h>
#ifdef _WINSOCK
#include <windows.h>
#include <winsock2.h>
#include <process.h>
#pragma comment(lib, \"ws2_32.lib\")
#pragma comment(lib, \"Ws2_32.lib\")
#else
#include <sys/socket.h>
#include <netinet/in.h>
......@@ -369,9 +374,9 @@ let put_socket_func put fn in_vars out_vars loc_vars =
#endif
#ifdef _DEBUG
#define dbg_printf printf
#define dbg_printf(...) fprintf(fp, __VA_ARGS__); fflush(fp)
#else
#define dbg_printf while(0) printf
#define dbg_printf(...) while(0)
#endif
/*--------
......@@ -389,20 +394,37 @@ Input procedures must be used:
)
in_vars;
putln "
putln ("
/*--------
launch the lutin interpreter and init socket stuff
--------*/";
putln (fn ^ "_ctx* " ^ fn ^ "_new_ctx(void* cdata){");
putln (" " ^ fn ^ "_ctx* ctx;");
putln "";
putln (" ctx = malloc(sizeof("^ fn ^ "_ctx));");
putln " ctx->client_data = cdata;";
put ("
int lutin_pid,sockfd, newsockfd, portno, clilen;
struct sockaddr_in serv_addr, cli_addr;
--------*/
" ^ fn ^ "_ctx* " ^ fn ^ "_new_ctx(void* cdata){
" ^ fn ^ "_ctx* ctx;
int sockfd;
int newsockfd;
int portno;
int clilen;
int rc;
#ifndef _WIN32
int lutin_pid;
#endif
struct sockaddr_in serv_addr;
struct sockaddr_in cli_addr;
char portno_str[10];
char *sock_addr = \""^option.sock_addr^"\";
const char *args[] = {
#ifdef _WIN32
\"call-via-socket.exe\", sock_addr, portno_str, \"lutin.exe\",
#else
\"call-via-socket\", sock_addr, portno_str, \"lutin\",
#endif
" ^
(match option.seed with None -> "" | Some i -> ("\"-seed\", \""^(string_of_int i)^"\", "))
^" \""^
(List.hd option.env) (* only work with lutin XXX fixme! *)
^"\", \"-rif\",\""^fn^".rif\", NULL};
// Socket administration stuff
#ifdef _WINSOCK
......@@ -410,33 +432,28 @@ launch the lutin interpreter and init socket stuff
WSAStartup(MAKEWORD(2,0), &WSAData);
#endif
ctx = malloc(sizeof("^ fn ^ "_ctx));
ctx->client_data = cdata;
sockfd = socket(AF_INET, SOCK_STREAM, 0);
if (sockfd < 0) printf(\"Error: opening socket\");
serv_addr.sin_family = AF_INET;
serv_addr.sin_addr.s_addr = inet_addr(\"127.0.0.1\");
serv_addr.sin_addr.s_addr = inet_addr(sock_addr);
dbg_printf(\"Binding...\\n\");
portno = 2000;
serv_addr.sin_port = htons(portno);
while (bind(sockfd, (struct sockaddr *) &serv_addr, sizeof(serv_addr)) ) {
portno++;
dbg_printf(\"Binding %s:%d...\\n\",sock_addr,portno);
serv_addr.sin_port = htons(portno);
if (portno > 4000) { printf(\"Error: cannot bind socket\\n\"); exit(2); }
};
sprintf(portno_str, \"%d\", portno);
dbg_printf(\"Forking...%i\\n\",portno);
const char *args[] = {
#ifdef _WIN32
\"call-via-socket.exe\", \"127.0.0.1\", portno_str, \"lutin.exe\",
#ifndef _LAUNCH_LUTIN_AUTOMATICALLY
printf(\" >>> Waiting for lutin to connect on %s:%s\\n\", sock_addr, portno_str);
#else
\"call-via-socket\", \"127.0.0.1\", portno_str, \"lutin\",
#endif
" ^
(match option.seed with None -> "" | Some i -> ("\"-seed\", \""^(string_of_int i)^"\", "))
^" \""^
(List.hd option.env) (* only work with lutin XXX fixme! *)
^"\", \"-rif\",\""^fn^".rif\", NULL};
dbg_printf(\"Forking...%i\\n\",portno);
#ifdef _WIN32
_spawnvp(_P_DETACH, args[0], args);
#else
......@@ -447,6 +464,7 @@ launch the lutin interpreter and init socket stuff
return 0;
}
#endif
#endif
dbg_printf(\"Listening...\\n\");
listen(sockfd,5);
......@@ -454,11 +472,9 @@ launch the lutin interpreter and init socket stuff
dbg_printf(\"Accepting...\\n\");
newsockfd = accept(sockfd, (struct sockaddr *) &cli_addr, &clilen);
if (newsockfd < 0) printf(\"Error: on accept\");
ctx->sock = newsockfd;
memset(ctx->buff, 0, MAX_BUFF_SIZE);
int rc = 0;
rc = 0;
while (1) {
rc = recv(ctx->sock, ctx->buff, MAX_BUFF_SIZE, 0);
if (rc > 0) break;
......@@ -478,80 +494,81 @@ Step procedure
--------*/
void " ^ fn ^ "_step(" ^ fn ^ "_ctx* ctx){
int rc,i;" ^
let cpt = ref 0 in
let decl_char acc var =
if (Var.typ var= Type.BoolT) then (
incr cpt;
("c"^(string_of_int !cpt))::acc)
else
acc
in
let char_decl =
(String.concat ", "
(List.fold_left decl_char [] (List.rev out_vars)))
in
(if !cpt = 0 then "" else "
char " ^ char_decl ^ ";") ^ "
sprintf(ctx->buff, \""^(
List.fold_left
(fun acc var -> acc ^ (var_to_format_print var) ^ " ")
""
in_vars) ^"\\n\", "
^
let var_to_adress var ="ctx->_" ^ (Var.name var) in
(List.fold_left
(fun acc var -> acc ^ ", "^ (var_to_adress var))
(var_to_adress (List.hd in_vars))
((List.tl in_vars)))
^
");
dbg_printf(\"\\n\\n ---- A new Step begins.\\nSending to sock: '%s'\\n\",ctx->buff);
send(ctx->sock, ctx->buff, (int) strlen(ctx->buff),0);
dbg_printf(\"reading inputs\\n\");
rc = 0;
while (1) {
rc = recv(ctx->sock, ctx->buff, MAX_BUFF_SIZE, 0);
dbg_printf(\"reading '%s'\\n\",ctx->buff);
if (rc > 0) break;
}
sscanf(ctx->buff, \"#step %d #outs " ^
let cpt = ref 0 in
let var_to_adress var =
if (Var.typ var= Type.BoolT) then (
incr cpt; "&c"^(string_of_int !cpt))
else
"&(ctx->_"^ (Var.name var)^")"
in
(List.fold_left
(fun acc var -> acc ^ (var_to_format_scan var) ^ " ")
int rc;
int i;
" ^
let cpt = ref 0 in
let decl_char acc var =
if (Var.typ var= Type.BoolT) then (
incr cpt;
(" char c"^(string_of_int !cpt)^";\n")::acc)
else
acc
in
let char_decl =
(String.concat "" (List.rev (List.fold_left decl_char [] out_vars)))
in
(if !cpt = 0 then "" else char_decl) ^ "
sprintf(ctx->buff, \""^(
List.fold_left
(fun acc var -> acc ^ (var_to_format_print var) ^ " ")
""
out_vars)^"\", &i," ^
(List.fold_left
(fun acc var -> acc ^ ", "^ (var_to_adress var))
(var_to_adress (List.hd out_vars))
(List.tl out_vars)) ^ ");
in_vars) ^"\\n\", "
^
let var_to_adress var ="ctx->_" ^ (Var.name var) in
(List.fold_left
(fun acc var -> acc ^ ", "^ (var_to_adress var))
(var_to_adress (List.hd in_vars))
((List.tl in_vars)))
^
");
dbg_printf(\"\\n\\n ---- A new Step begins. Sending to sock: '%s'\\n\",ctx->buff);
send(ctx->sock, ctx->buff, (int) strlen(ctx->buff),0);
dbg_printf(\"reading inputs\\n\");
rc = 0;
while (1) {
rc = recv(ctx->sock, ctx->buff, MAX_BUFF_SIZE, 0);
dbg_printf(\"reading '%s'\\n\",ctx->buff);
if (rc > 0) break;
}
sscanf(ctx->buff, \"#step %d #outs " ^
let cpt = ref 0 in
let var_to_adress var =
if (Var.typ var= Type.BoolT) then (
incr cpt; "&c"^(string_of_int !cpt))
else
"&(ctx->_"^ (Var.name var)^")"
in
(List.fold_left
(fun acc var -> acc ^ " " ^ (var_to_format_scan var))
""
out_vars)^"\", &i,"
^
(List.fold_left
(fun acc var -> acc^", "^(var_to_adress var))
(var_to_adress (List.hd out_vars))
(List.tl out_vars)) ^ ");
" ^
let cpt = ref 0 in
let copy_char_to_ctx acc var =
if (Var.typ var= Type.BoolT) then (
incr cpt;
let c = ("c"^(string_of_int !cpt)) in
let conv_char =
" if (("^c^" == '0') || ("^c^" == 'f') || ("^c^" == 'F')) ctx->_"
^(Var.name var)^" = _false;
let cpt = ref 0 in
let copy_char_to_ctx acc var =
if (Var.typ var= Type.BoolT) then (
incr cpt;
let c = ("c"^(string_of_int !cpt)) in
let conv_char =
" if (("^c^" == '0') || ("^c^" == 'f') || ("^c^" == 'F')) ctx->_"
^(Var.name var)^" = _false;
if (("^c^" == '1') || ("^c^" == 't') || ("^c^" == 'T')) ctx->_"
^(Var.name var)^" = _true;
^(Var.name var)^" = _true;
"
in
conv_char::acc)
else
acc
in
(String.concat ""
(List.fold_left copy_char_to_ctx [] (List.rev out_vars)))
^ "
in
conv_char::acc)
else
acc
in
(String.concat ""
(List.rev (List.fold_left copy_char_to_ctx [] out_vars)))
^ "
memset(ctx->buff, 0, rc);
dbg_printf(\"----- step done\\n\");
}
......@@ -575,9 +592,8 @@ Reset procedure
--------*/
void " ^ fn ^ "_reset(" ^ fn ^ "_ctx* ctx){
" ^ fn ^ "_terminate(ctx);
ctx = " ^ fn ^ "_new_ctx(ctx->client_data);
" ^ fn ^ "_terminate(ctx);
ctx = " ^ fn ^ "_new_ctx(ctx->client_data);
}")
......@@ -595,10 +611,7 @@ let (gen_c_file : string -> Exp.var list -> Exp.var list -> Exp.var list -> unit
(* let in_out_vars = in_vars @ out_vars in *)
putln (Util.entete "// ");
put ("#include <stdlib.h>\n" ^
"#include <stdio.h> \n" ^
"#include <string.h> \n" ^
( if option.gen_mode = Scade then
put (( if option.gen_mode = Scade then
"#include \"" ^ option.calling_module_name ^ ".h\" \n"
else
"#include \"" ^ fn ^ ".h\" \n"
......@@ -606,7 +619,11 @@ let (gen_c_file : string -> Exp.var list -> Exp.var list -> Exp.var list -> unit
"");
if option.use_sockets then (
put_socket_func put fn in_vars out_vars loc_vars
put "
#include <stdlib.h>
#include <string.h>
";
put_socket_func put fn in_vars out_vars loc_vars;
)
else (
if option.gen_mode = Scade then
......@@ -635,7 +652,8 @@ Input procedures
end
else
begin
putln "/*--------
putln "
/*--------
Output procedures must be defined,
Input procedures must be used:
--------*/
......@@ -830,6 +848,7 @@ let (main : unit -> unit) =
Luc2alice.seed = option.seed;
Luc2alice.env_in_vars = state.s.in_vars ;
Luc2alice.env_out_vars = state.s.out_vars ;
Luc2alice.use_sockets = option.use_sockets ;
}
in
......
source/Lucky/luc2c.mli
View file @ a3c512b6
......@@ -28,7 +28,8 @@ type optionT = {
instead of the interpreter embedded into the C libraries. *)
mutable step_mode : step_mode;
mutable seed : int option;
mutable env : string list (* lutin/lucky files *)
mutable env : string list; (* lutin/lucky files *)
mutable sock_addr : string
}
val option : optionT
......
utils/lutin.el
View file @ a3c512b6
......@@ -60,6 +60,14 @@
(setq comment-start "-- ")
(setq comment-end "")
(setq comment-start "(*")
(setq comment-end "*)")
;;; Major-mode
(defun lutin-mode ()
......@@ -76,8 +84,7 @@
(run-hooks 'lutin-mode-hook))
(setq comment-start "-- ")
(setq comment-end "")
(provide 'lutin)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment