From 0140792c8111d2dd1cf9004f2e3e602ec34ed30a Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Sun, 25 May 2014 21:56:04 +0200 Subject: Cleanup. --- _khb_experiment/_tags | 3 + _khb_experiment/khb_ast.ml | 27 +++++ _khb_experiment/khs_ast.ml | 36 ++++++ _khb_experiment/khs_exec.ml | 225 ++++++++++++++++++++++++++++++++++++++ _khb_experiment/khs_exec_local.ml | 73 +++++++++++++ _khb_experiment/khs_exec_seq.ml | 62 +++++++++++ _khb_experiment/ksh_print.ml | 53 +++++++++ _khb_experiment/test.khb | 67 ++++++++++++ _khb_experiment/test.khs | 76 +++++++++++++ _khb_experiment/test.ml | 101 +++++++++++++++++ _khb_experiment/util.ml | 10 ++ khb/_tags | 3 - khb/khb_ast.ml | 27 ----- khb/khs_ast.ml | 36 ------ khb/khs_exec.ml | 225 -------------------------------------- khb/khs_exec_local.ml | 73 ------------- khb/khs_exec_seq.ml | 62 ----------- khb/ksh_print.ml | 53 --------- khb/test.khb | 67 ------------ khb/test.khs | 76 ------------- khb/test.ml | 101 ----------------- khb/util.ml | 10 -- src/kahn_sock_0.ml | 115 ------------------- 23 files changed, 733 insertions(+), 848 deletions(-) create mode 100644 _khb_experiment/_tags create mode 100644 _khb_experiment/khb_ast.ml create mode 100644 _khb_experiment/khs_ast.ml create mode 100644 _khb_experiment/khs_exec.ml create mode 100644 _khb_experiment/khs_exec_local.ml create mode 100644 _khb_experiment/khs_exec_seq.ml create mode 100644 _khb_experiment/ksh_print.ml create mode 100644 _khb_experiment/test.khb create mode 100644 _khb_experiment/test.khs create mode 100644 _khb_experiment/test.ml create mode 100644 _khb_experiment/util.ml delete mode 100644 khb/_tags delete mode 100644 khb/khb_ast.ml delete mode 100644 khb/khs_ast.ml delete mode 100644 khb/khs_exec.ml delete mode 100644 khb/khs_exec_local.ml delete mode 100644 khb/khs_exec_seq.ml delete mode 100644 khb/ksh_print.ml delete mode 100644 khb/test.khb delete mode 100644 khb/test.khs delete mode 100644 khb/test.ml delete mode 100644 khb/util.ml delete mode 100644 src/kahn_sock_0.ml diff --git a/_khb_experiment/_tags b/_khb_experiment/_tags new file mode 100644 index 0000000..f36ce04 --- /dev/null +++ b/_khb_experiment/_tags @@ -0,0 +1,3 @@ +true: use_menhir +<*.byte>: use_unix +<*.native>: use_unix diff --git a/_khb_experiment/khb_ast.ml b/_khb_experiment/khb_ast.ml new file mode 100644 index 0000000..fa52ece --- /dev/null +++ b/_khb_experiment/khb_ast.ml @@ -0,0 +1,27 @@ + +type khb_binop = + | PLUS | MINUS + | TIMES | DIV | MOD + | EQUAL | NEQUAL + | GT | LT | GE | LE + | AND | OR | XOR + | SEND | RECV | ASSIGN | SEQ + +type khb_unop = + | MINUS | NOT + | DEREF | REF + + +type khb_expr = + | BVar of string + | BStr of string + | BInt of int + | BBool of bool + | BUnary of unop * expr + | BBinary of expr * unop * expr + | BTernary of expr * expr * expr + | BCall of string * expr list + | BLoop of expr + | BNewChan + | BPar of expr + | BIndex of expr * expr diff --git a/_khb_experiment/khs_ast.ml b/_khb_experiment/khs_ast.ml new file mode 100644 index 0000000..f5b2c8d --- /dev/null +++ b/_khb_experiment/khs_ast.ml @@ -0,0 +1,36 @@ + +type khs_binop = + | PLUS | MINUS + | TIMES | DIV | MOD + | EQUAL | NEQUAL + | GT | LT | GE | LE + | AND | OR | XOR + +type khs_unop = + | MINUS | NOT + +type khs_expr = + | EEmpty + | EInt of int + | EStr of string + | EBool of bool + | EFrame + | ELocal of string + | EBinary of khs_expr * khs_binop * khs_expr + | EUnary of khs_unop * khs_expr + | ETernary of khs_expr * khs_expr * khs_expr + | ECat of khs_expr * khs_expr + | ELoad of khs_expr + | ENewChan + +type khs_stmt = + | SLabel of string + | SSet of khs_expr * khs_expr + | SGoto of khs_expr + | SPar of khs_expr + (* RECV and SEND do a load on their second argument (the chan), + (ie they expect an address and not a value) *) + | SRecv of khs_expr * khs_expr + | SSend of khs_expr * khs_expr + | SUnset of khs_expr list + | SExit diff --git a/_khb_experiment/khs_exec.ml b/_khb_experiment/khs_exec.ml new file mode 100644 index 0000000..ff050c6 --- /dev/null +++ b/_khb_experiment/khs_exec.ml @@ -0,0 +1,225 @@ +open Util +open Khs_ast + + +type kprog = + { + pinstr: khs_stmt array; + plabels: int Smap.t; + } + +type kbval = + | VNone + | VInt of int + | VBool of bool + | VStr of string +type kval = + | Single of kbval + | Many of kbval Smap.t + +type chanid = kbval + +type kprocstatus = + | PSExec + | PSSend of chanid * kval + | PSRecv of chanid + | PSExecRecvd of kval + | PSDone + +type kproc = + { + xspawn: kproc -> int -> unit; + xnewchan: kproc -> kval; + xprog: kprog; + mutable xvals: kbval Smap.t; + mutable xstatus: kprocstatus; + mutable xpos: int + } + +let psep = "\\" +let framevar = "#" + + +(* Procedures on values *) + +(* Strange semantics : all type conversions are allowed *) +let int_of_kbval = function + | VInt i -> i + | VBool true -> 1 + | VBool false -> 0 + | VNone -> 0 + | VStr s -> int_of_string s +let str_of_kbval = function + | VInt i -> string_of_int i + | VBool true -> "1" + | VBool false -> "0" + | VNone -> "" + | VStr s -> s +let bool_of_kbval = function + | VInt i -> i <> 0 + | VBool b -> b + | VNone -> false + | VStr s -> (int_of_string s) <> 0 + +let kval_of_kbval v = Single v +let kbval_of_kval = function + | Single v -> v + | Many a -> + try Smap.find "" a + with Not_found -> VNone + +let int_of_kval v = int_of_kbval (kbval_of_kval v) +let bool_of_kval v = bool_of_kbval (kbval_of_kval v) +let str_of_kval v = str_of_kbval (kbval_of_kval v) + +let kval_descr = function + | Single v -> "'" ^ str_of_kbval v ^ "'" + | Many a -> + if Smap.cardinal a = 1 then + Smap.fold (fun k v s -> str_of_kbval v) a "" + else + Smap.fold (fun k v s -> s ^ "\n " ^ k ^ " : '" ^ str_of_kbval v ^ "'") + a "{" + ^ "\n}" + +(* Variable loading and setting *) +let load_kval proc key = + let n = String.length key in + let ret = ref Smap.empty in + Smap.iter (fun k v -> + if k = key || + (String.length k > n && + String.sub k 0 (n+1) = key ^ psep) + then + ret := Smap.add (String.sub k n (String.length k - n)) v !ret) + proc.xvals; + (* Format.printf "Load %s : %s@." key (kval_descr (Many (!ret))); *) + Many(!ret) +let save_kval proc key value = + (* Format.printf "Set %s = %s@." key (kval_descr value); *) + match value with + | Single s -> proc.xvals <- Smap.add key s proc.xvals + | Many m -> + Smap.iter + (fun k v -> proc.xvals <- Smap.add (key ^ k) v proc.xvals) + m +let unset_kval proc key = + let n = String.length key in + let f k _ = + k <> key && + (String.length k < n + 1 || + String.sub k 0 (n+1) <> key ^ psep) + in + proc.xvals <- Smap.filter f proc.xvals + +(* Expression evaluation *) +let rec eval_expr proc = function + | EEmpty -> Single VNone + | EInt i -> Single (VInt i) + | EBool b -> Single (VBool b) + | EStr s -> Single (VStr s) + | ELocal l -> + Single(VStr(str_of_kval (load_kval proc framevar) ^ psep ^ l)) + | EFrame -> Single(VStr framevar) + | EBinary(e1, op, e2) -> + let v1, v2 = eval_expr proc e1, eval_expr proc e2 in + let r = match op with + | PLUS -> VInt(int_of_kval v1 + int_of_kval v2) + | MINUS -> VInt(int_of_kval v1 - int_of_kval v2) + | TIMES -> VInt(int_of_kval v1 * int_of_kval v2) + | DIV -> VInt(int_of_kval v1 / int_of_kval v2) + | MOD -> VInt(int_of_kval v1 mod int_of_kval v2) + | EQUAL -> VBool(kbval_of_kval v1 = kbval_of_kval v2) + (* EQUAL does not test values in depth ! *) + | NEQUAL -> VBool(kbval_of_kval v1 <> kbval_of_kval v2) + | GT -> VBool(int_of_kval v1 > int_of_kval v2) + | LT -> VBool(int_of_kval v1 < int_of_kval v2) + | GE -> VBool(int_of_kval v1 >= int_of_kval v2) + | LE -> VBool(int_of_kval v1 <= int_of_kval v2) + | AND -> VBool(bool_of_kval v1 && bool_of_kval v2) + | OR -> VBool(bool_of_kval v1 || bool_of_kval v2) + | XOR -> VBool(bool_of_kval v1 ^^ bool_of_kval v2) + in Single r + | EUnary(op, e) -> + let v = eval_expr proc e in + let r = match op with + | MINUS -> VInt(-(int_of_kval v)) + | NOT -> VBool(not(bool_of_kval v)) + in Single r + | ETernary(cond, e1, e2) -> + if bool_of_kval (eval_expr proc cond) then + eval_expr proc e1 + else + eval_expr proc e2 + | ECat(e1, e2) -> + Single(VStr( + str_of_kval (eval_expr proc e1) + ^ psep + ^ str_of_kval (eval_expr proc e2))) + | ELoad(x) -> + load_kval proc (str_of_kval (eval_expr proc x)) + | ENewChan -> proc.xnewchan proc + +let exec_stmt proc = + match proc.xprog.pinstr.(proc.xpos) with + | SLabel _ -> + proc.xpos <- proc.xpos + 1 (* nothing to do *) + | SSet(var, v) -> + let var = str_of_kval (eval_expr proc var) in + let v = eval_expr proc v in + save_kval proc var v; + proc.xpos <- proc.xpos + 1 + | SGoto pos -> + let pos = str_of_kval (eval_expr proc pos) in + begin + try + proc.xpos <- Smap.find pos proc.xprog.plabels + with Not_found -> + proc.xstatus <- PSDone + end + | SPar pos -> + let pos = str_of_kval (eval_expr proc pos) in + begin + try + proc.xspawn proc (Smap.find pos proc.xprog.plabels) + with Not_found -> () + end; + proc.xpos <- proc.xpos + 1 + | SRecv(var, chan) -> + begin match proc.xstatus with + | PSExec -> + let chan = kbval_of_kval (eval_expr proc (ELoad chan)) in + proc.xstatus <- PSRecv chan + | PSExecRecvd v -> + let var = str_of_kval (eval_expr proc var) in + save_kval proc var v; + proc.xstatus <- PSExec; + proc.xpos <- proc.xpos + 1 + | _ -> assert false + end + | SSend(v, chan) -> + let chan = kbval_of_kval (eval_expr proc (ELoad chan)) in + let v = eval_expr proc v in + proc.xpos <- proc.xpos + 1; + proc.xstatus <- PSSend(chan, v) + | SUnset(l) -> + List.iter (unset_kval proc) + (List.map (fun e -> str_of_kval (eval_expr proc e)) l); + proc.xpos <- proc.xpos + 1; + | SExit -> + proc.xstatus <- PSDone + + +(* Load program, ie find labels *) +let load_program p = + let labels = ref Smap.empty in + Array.iteri + (fun i x -> + match x with + | SLabel l -> labels := Smap.add l i !labels + | _ -> ()) + p; + { pinstr = p; plabels = !labels } + + + diff --git a/_khb_experiment/khs_exec_local.ml b/_khb_experiment/khs_exec_local.ml new file mode 100644 index 0000000..09f14a8 --- /dev/null +++ b/_khb_experiment/khs_exec_local.ml @@ -0,0 +1,73 @@ +open Util +open Khs_ast +open Khs_exec + +(* TODO : channels cannot be communicated over channels, although + it should totally be possible because it's so great and so usefull ! *) + +let childs = ref [] + +let wait_childs () = + Unix.handle_unix_error (fun () -> + List.iter (fun pid -> ignore (Unix.waitpid [] pid)) !childs) + () + +let newchan proc = + let id = "khs_ch_" ^ string_of_int (Random.int 1000000) + ^ "-" ^ string_of_int (Random.int 1000000) in + Unix.mkfifo ("/tmp/" ^ id) 0o666; + Many (Smap.add (psep^"in") (VStr id) + (Smap.add (psep^"out") (VStr id) Smap.empty)) + +let exec_proc proc = + while proc.xstatus <> PSDone do + match proc.xstatus with + | PSDone -> assert false + | PSExec | PSExecRecvd _ -> + exec_stmt proc + | PSSend(c, kv) -> + let c = str_of_kbval c in + proc.xstatus <- PSExec; + begin + if c == "stdout" then + Format.printf "%s@." (kval_descr kv) + else + let c_out = Unix.openfile ("/tmp/"^c) [Unix.O_WRONLY] 0 in + Marshal.to_channel (Unix.out_channel_of_descr c_out) kv []; + Unix.close c_out + end + | PSRecv c -> + let c = str_of_kbval c in + let c_in = Unix.openfile ("/tmp/"^c) [Unix.O_RDONLY] 0 in + let data = Marshal.from_channel (Unix.in_channel_of_descr c_in) in + proc.xstatus <- PSExecRecvd data; + Unix.close c_in + done + +let spawn proc pos = + let pid = Unix.fork () in + if pid = 0 then begin + childs := []; + exec_proc { proc with xpos = pos}; + wait_childs(); + exit 0 + end else + childs := pid::!childs + + + +let exec_program p = + Random.init (int_of_float (Unix.time())); + let proc = { + xspawn = spawn; + xnewchan = newchan; + xprog = p; + xvals = Smap.empty; + xstatus = PSExec; + xpos = 0; + } in + proc.xvals <- Smap.add framevar (VInt 0) proc.xvals; + proc.xvals <- Smap.add "stdout" (VStr "stdout") proc.xvals; + exec_proc proc; + wait_childs() + diff --git a/_khb_experiment/khs_exec_seq.ml b/_khb_experiment/khs_exec_seq.ml new file mode 100644 index 0000000..6e34767 --- /dev/null +++ b/_khb_experiment/khs_exec_seq.ml @@ -0,0 +1,62 @@ +open Util +open Khs_ast +open Khs_exec + +let chans = Hashtbl.create 12 +let ch_id = + let p = ref 0 in + fun () -> p := !p + 1; !p + +let proc = ref [] +let proc_spawned = ref [] + +let spawn proc pos = + proc_spawned := + { proc with xpos = pos }::(!proc_spawned) + +let newchan proc = + let id = ch_id () in + Hashtbl.add chans id (Queue.create()); + Many (Smap.add (psep^"in") (VInt id) + (Smap.add (psep^"out") (VInt id) Smap.empty)) + +let proc_step proc = + match proc.xstatus with + | PSDone -> false + | PSExec | PSExecRecvd _ -> + exec_stmt proc; + true + | PSSend(c, kv) -> + proc.xstatus <- PSExec; + begin + if (int_of_kbval c) == 0 then + Format.printf "%s@." (kval_descr kv) + else + Queue.push kv (Hashtbl.find chans (int_of_kbval c)) + end; + true + | PSRecv(c) -> + let q = Hashtbl.find chans (int_of_kbval c) in + if not (Queue.is_empty q) then + proc.xstatus <- PSExecRecvd (Queue.pop q); + true + +let exec_program p = + let proc0 = { + xspawn = spawn; + xnewchan = newchan; + xprog = p; + xvals = Smap.empty; + xstatus = PSExec; + xpos = 0 + } in + proc0.xvals <- Smap.add framevar (VInt 0) proc0.xvals; + proc0.xvals <- Smap.add "stdout" (VInt 0) proc0.xvals; + proc := [ proc0 ]; + while List.length !proc > 0 do + proc := List.filter proc_step !proc; + proc := !proc_spawned @ !proc; + proc_spawned := []; + done + + diff --git a/_khb_experiment/ksh_print.ml b/_khb_experiment/ksh_print.ml new file mode 100644 index 0000000..6b0a7e3 --- /dev/null +++ b/_khb_experiment/ksh_print.ml @@ -0,0 +1,53 @@ +open Khs_ast + +let rec expr_str = function + | EEmpty -> "()" + | EInt i -> string_of_int i + | EStr s -> "\"" ^ s ^ "\"" + | EBool b -> if b then "true" else "false" + | EFrame -> "#" + | ELocal s -> "." ^ s + | EBinary (e1, op, e2) -> + "(" ^ expr_str e1 ^ + (match op with + | PLUS -> " + " + | MINUS -> " - " + | TIMES -> " * " + | DIV -> " / " + | MOD -> " % " + | EQUAL -> " == " + | NEQUAL -> " != " + | GT -> " > " + | LT -> " < " + | GE -> " >= " + | LE -> " <= " + | AND -> " && " + | OR -> " || " + | XOR -> " ^^ " + ) ^ expr_str e2 ^ ")" + | EUnary (op, e) -> + (match op with + | MINUS -> "-" + | NOT -> "!" + ) ^ expr_str e + | ETernary(c, a, b) -> + "(" ^ expr_str c ^ " ? " ^ expr_str a ^ " : " ^ expr_str b ^ ")" + | ECat(x, y) -> expr_str x ^ "\\" ^ expr_str y + | ELoad(v) -> "@" ^ expr_str v + | ENewChan -> "<>" + +let print_stmt = function + | SLabel s -> Format.printf "%s:@." s + | SSet(k, v) -> Format.printf " %s := %s@." (expr_str k) (expr_str v) + | SGoto l -> Format.printf " < %s >@." (expr_str l) + | SPar l -> Format.printf " | %s |@." (expr_str l) + | SRecv (e, c) -> Format.printf " %s << %s@." (expr_str e) (expr_str c) + | SSend (e, c) -> Format.printf " %s >> %s@." (expr_str e) (expr_str c) + | SUnset l -> + let rec aux = function + | [] -> " ~(" + | [a] -> " ~(" ^ (expr_str a) + | a::b -> (aux b) ^ ", " ^ (expr_str a) + in Format.printf "%s)@." (aux l) + | SExit -> + Format.printf " exit@." diff --git a/_khb_experiment/test.khb b/_khb_experiment/test.khb new file mode 100644 index 0000000..f109016 --- /dev/null +++ b/_khb_experiment/test.khb @@ -0,0 +1,67 @@ +$$ integers (n, nmax, qo) = + (n > nmax ? + (-1) >> qo + : + n >> qo; + become integers(n+1, nmax, qo) + ) + +# Version alternative : +$$ integers (n, nmax, qo) = + ]->[ ( + (n > nmax ? ->[]); + n >> qo; + n = n + 1 + ); + -1 >> qo + +$$ filter (n, qi, qo) = + val << qi; + (val != -1 ? + (val % n != 0 ? + val >> qo + ); + become filter(n, qi, qo) + : + -1 >> qo + ) + +# Version alternative : +$$ filter (n, qi, qo) = + ]->[ ( + val << qi; + (val == -1 ? ->[]); + (val % n != 0 ? val >> qo) + ); + -1 >> qo + +$$ primes (qi) = + val << qi; + (val != -1 ? + val >> stdout; + c = <>; + | become filter(val, qi, c.out) |; + become primes(c.in) + ) + +# Version alternative : +$$ primes (qi) = + ]->[ ( + val << qi; + (val == -1 ? ->[]); + val >> stdout; + c = <>; + | filter(val, qi, c.out) |; + qi = c.in + ) + +$$ main () = + c = <>; + | integers (2, 5000, c.out) |; + primes (c.in) + + + + + + diff --git a/_khb_experiment/test.khs b/_khb_experiment/test.khs new file mode 100644 index 0000000..54b9507 --- /dev/null +++ b/_khb_experiment/test.khs @@ -0,0 +1,76 @@ +proc_integers: + < @fd[f].n > @fd[f].nmax ? _then1 : _else1 > +_then1: + -1 >> @fd[f].qo + < _end1 > +_else1: + @fd[f].n >> @fd[f].qo + fd[f].trtmp.n := @fd[f].n + 1 + fd[f].trtmp.nmax := @fd[f].nmax + fd[f].trtmp.qo := @fd[f].qo + fd[f].n := @fd[f].trtmp.n + fd[f].nmax := @fd[f].trtmp.nmax + fd[f].qo := @fd[f].trtmp.qo + < proc_integers > + < _end1 > +_end1: + fd[f] := "" + ~ (.qo, .nmax, .n) + < @fd[f].return > + + proc_filter: + val << @(fd\@f\qi) + < @val != -1 ? _then2 : _else2 > +_then2: + < @val % @(fd\@f\n) != 0 ? _then3 : _end3 > +_then3: + @val >> @(fd\@f\qo) +_end3: + + <_end2> +_else2: + -1 >> @qo + <_end2> +_end2: + fd[f] := "" + ~ (.qo, .qi, .val, .n) + < @(fd\@f\return) > + +proc_primes: + .val << @.qi + < @.val != -1 ? _then4 : _end4 > +_then4: + @.val >> @stdout + .c := <> + | _par_1 | + .qi := @(.c\in) + +_end4: + fd\@f := "" + ~ (.val, .qi, .c) + < @(fd\@f\return) > +_par_1: + .n := @.val + .qo := @(.c\out) + + +proc_main: + .c := <> + | _par_2 | + fd\(@f+1)\qi := @(.c\in) + f := @f+1 + .return := _ret1 + +_ret1: + f := @f-1 + .tmp_retval := @(fd\(@f+1)) + fd\@f := .tmp_retval + ~(.tmp_retval) + < .return > +_par_2: + .n := 2 + .nmax := 5000 + .qo := @(.c\out) + + + diff --git a/_khb_experiment/test.ml b/_khb_experiment/test.ml new file mode 100644 index 0000000..edc155e --- /dev/null +++ b/_khb_experiment/test.ml @@ -0,0 +1,101 @@ +open Khs_ast +open Khs_exec + +let primes_khs = [| + SGoto (EStr "proc_main"); + + (* integers *) + SLabel "proc_integers"; + SGoto ( + ETernary( + EBinary(ELoad(ELocal "n"), GT, ELoad(ELocal "nmax")), + EStr "_then1", EStr "_else1")); + + SLabel "_then1"; + SSend(EInt (-1), ELocal "qo"); + SGoto(EStr "_end1"); + + SLabel "_else1"; + SSend(ELoad(ELocal "n"), ELocal "qo"); + SSet(ELocal "n", + EBinary(ELoad(ELocal "n"), PLUS, EInt 1)); + SGoto (EStr "proc_integers"); + + SLabel "_end1"; + SSet(ELocal "retval", EEmpty); + SUnset [ELocal "qo"; ELocal "nmax"; ELocal "n"]; + SGoto(ELoad(ELocal "retpos")); + + (* filter *) + SLabel "proc_filter"; + SRecv(ELocal "val", ELocal "qi"); + SGoto(ETernary( + EBinary(ELoad(ELocal "val"), NEQUAL, EInt (-1)), + EStr "_then2", EStr "_else2")); + + SLabel "_then2"; + SGoto(ETernary( + EBinary(EBinary(ELoad(ELocal "val"), MOD, ELoad(ELocal "n")), NEQUAL, EInt 0), + EStr "_then3", EStr "_end3")); + + SLabel "_then3"; + SSend(ELoad(ELocal "val"), ELocal "qo"); + + SLabel "_end3"; + SGoto(EStr "proc_filter"); + + SLabel "_else2"; + SSend(EInt (-1), ELocal "qo"); + + SSet(ELocal "retval", EEmpty); + SUnset[ELocal "qo"; ELocal "qi"; ELocal "val"; ELocal "n"]; + SGoto(ELoad(ELocal "retpos")); + + (* primes *) + SLabel "proc_primes"; + SRecv(ELocal "val", ELocal "qi"); + SGoto(ETernary( + EBinary(ELoad(ELocal "val"), NEQUAL, EInt(-1)), + EStr "_then4", EStr "_end4")); + + SLabel "_then4"; + SSend(ELoad(ELocal "val"), EStr "stdout"); + SSet(ELocal "c", ENewChan); + SPar(EStr "_par_1"); + SSet(ELocal "qi", ELoad(ECat(ELocal "c", EStr "in"))); + SGoto(EStr "proc_primes"); + + SLabel "_end4"; + SSet(ELocal "retval", EEmpty); + SUnset[ELocal "qi"; ELocal "val"; ELocal "c"]; + SGoto(ELoad(ELocal "retpos")); + + SLabel "_par_1"; + SSet(ELocal "n", ELoad(ELocal "val")); + SSet(ELocal "qo", ELoad(ECat(ELocal "c", EStr "out"))); + SGoto(EStr "proc_filter"); + + + (* main *) + SLabel "proc_main"; + SSet(ELocal "c", ENewChan); + SPar(EStr "_par_2"); + + SSet(ELocal "qi", ELoad(ECat(ELocal "c", EStr "in"))); + SSet(ELocal "retpos", EStr "_ret1"); + SGoto(EStr "proc_primes"); + + SLabel "_par_2"; + SSet(ELocal "n", EInt 2); + SSet(ELocal "nmax", EInt 3000); + SSet(ELocal "qo", ELoad(ECat(ELocal "c", EStr "out"))); + SSet(ELocal "retpos", EStr "_ret1"); + SGoto(EStr "proc_integers"); + + SLabel "_ret1"; + SExit; +|] + +let () = + Array.iter Ksh_print.print_stmt primes_khs; + Khs_exec_local.exec_program (load_program primes_khs) diff --git a/_khb_experiment/util.ml b/_khb_experiment/util.ml new file mode 100644 index 0000000..0d278d6 --- /dev/null +++ b/_khb_experiment/util.ml @@ -0,0 +1,10 @@ + +module Int = struct + type t = int + let compare = Pervasives.compare +end + +module Smap = Map.Make(String) +module Imap = Map.Make(Int) + +let (^^) a b = (a || b) && (not (a && b)) diff --git a/khb/_tags b/khb/_tags deleted file mode 100644 index f36ce04..0000000 --- a/khb/_tags +++ /dev/null @@ -1,3 +0,0 @@ -true: use_menhir -<*.byte>: use_unix -<*.native>: use_unix diff --git a/khb/khb_ast.ml b/khb/khb_ast.ml deleted file mode 100644 index fa52ece..0000000 --- a/khb/khb_ast.ml +++ /dev/null @@ -1,27 +0,0 @@ - -type khb_binop = - | PLUS | MINUS - | TIMES | DIV | MOD - | EQUAL | NEQUAL - | GT | LT | GE | LE - | AND | OR | XOR - | SEND | RECV | ASSIGN | SEQ - -type khb_unop = - | MINUS | NOT - | DEREF | REF - - -type khb_expr = - | BVar of string - | BStr of string - | BInt of int - | BBool of bool - | BUnary of unop * expr - | BBinary of expr * unop * expr - | BTernary of expr * expr * expr - | BCall of string * expr list - | BLoop of expr - | BNewChan - | BPar of expr - | BIndex of expr * expr diff --git a/khb/khs_ast.ml b/khb/khs_ast.ml deleted file mode 100644 index f5b2c8d..0000000 --- a/khb/khs_ast.ml +++ /dev/null @@ -1,36 +0,0 @@ - -type khs_binop = - | PLUS | MINUS - | TIMES | DIV | MOD - | EQUAL | NEQUAL - | GT | LT | GE | LE - | AND | OR | XOR - -type khs_unop = - | MINUS | NOT - -type khs_expr = - | EEmpty - | EInt of int - | EStr of string - | EBool of bool - | EFrame - | ELocal of string - | EBinary of khs_expr * khs_binop * khs_expr - | EUnary of khs_unop * khs_expr - | ETernary of khs_expr * khs_expr * khs_expr - | ECat of khs_expr * khs_expr - | ELoad of khs_expr - | ENewChan - -type khs_stmt = - | SLabel of string - | SSet of khs_expr * khs_expr - | SGoto of khs_expr - | SPar of khs_expr - (* RECV and SEND do a load on their second argument (the chan), - (ie they expect an address and not a value) *) - | SRecv of khs_expr * khs_expr - | SSend of khs_expr * khs_expr - | SUnset of khs_expr list - | SExit diff --git a/khb/khs_exec.ml b/khb/khs_exec.ml deleted file mode 100644 index ff050c6..0000000 --- a/khb/khs_exec.ml +++ /dev/null @@ -1,225 +0,0 @@ -open Util -open Khs_ast - - -type kprog = - { - pinstr: khs_stmt array; - plabels: int Smap.t; - } - -type kbval = - | VNone - | VInt of int - | VBool of bool - | VStr of string -type kval = - | Single of kbval - | Many of kbval Smap.t - -type chanid = kbval - -type kprocstatus = - | PSExec - | PSSend of chanid * kval - | PSRecv of chanid - | PSExecRecvd of kval - | PSDone - -type kproc = - { - xspawn: kproc -> int -> unit; - xnewchan: kproc -> kval; - xprog: kprog; - mutable xvals: kbval Smap.t; - mutable xstatus: kprocstatus; - mutable xpos: int - } - -let psep = "\\" -let framevar = "#" - - -(* Procedures on values *) - -(* Strange semantics : all type conversions are allowed *) -let int_of_kbval = function - | VInt i -> i - | VBool true -> 1 - | VBool false -> 0 - | VNone -> 0 - | VStr s -> int_of_string s -let str_of_kbval = function - | VInt i -> string_of_int i - | VBool true -> "1" - | VBool false -> "0" - | VNone -> "" - | VStr s -> s -let bool_of_kbval = function - | VInt i -> i <> 0 - | VBool b -> b - | VNone -> false - | VStr s -> (int_of_string s) <> 0 - -let kval_of_kbval v = Single v -let kbval_of_kval = function - | Single v -> v - | Many a -> - try Smap.find "" a - with Not_found -> VNone - -let int_of_kval v = int_of_kbval (kbval_of_kval v) -let bool_of_kval v = bool_of_kbval (kbval_of_kval v) -let str_of_kval v = str_of_kbval (kbval_of_kval v) - -let kval_descr = function - | Single v -> "'" ^ str_of_kbval v ^ "'" - | Many a -> - if Smap.cardinal a = 1 then - Smap.fold (fun k v s -> str_of_kbval v) a "" - else - Smap.fold (fun k v s -> s ^ "\n " ^ k ^ " : '" ^ str_of_kbval v ^ "'") - a "{" - ^ "\n}" - -(* Variable loading and setting *) -let load_kval proc key = - let n = String.length key in - let ret = ref Smap.empty in - Smap.iter (fun k v -> - if k = key || - (String.length k > n && - String.sub k 0 (n+1) = key ^ psep) - then - ret := Smap.add (String.sub k n (String.length k - n)) v !ret) - proc.xvals; - (* Format.printf "Load %s : %s@." key (kval_descr (Many (!ret))); *) - Many(!ret) -let save_kval proc key value = - (* Format.printf "Set %s = %s@." key (kval_descr value); *) - match value with - | Single s -> proc.xvals <- Smap.add key s proc.xvals - | Many m -> - Smap.iter - (fun k v -> proc.xvals <- Smap.add (key ^ k) v proc.xvals) - m -let unset_kval proc key = - let n = String.length key in - let f k _ = - k <> key && - (String.length k < n + 1 || - String.sub k 0 (n+1) <> key ^ psep) - in - proc.xvals <- Smap.filter f proc.xvals - -(* Expression evaluation *) -let rec eval_expr proc = function - | EEmpty -> Single VNone - | EInt i -> Single (VInt i) - | EBool b -> Single (VBool b) - | EStr s -> Single (VStr s) - | ELocal l -> - Single(VStr(str_of_kval (load_kval proc framevar) ^ psep ^ l)) - | EFrame -> Single(VStr framevar) - | EBinary(e1, op, e2) -> - let v1, v2 = eval_expr proc e1, eval_expr proc e2 in - let r = match op with - | PLUS -> VInt(int_of_kval v1 + int_of_kval v2) - | MINUS -> VInt(int_of_kval v1 - int_of_kval v2) - | TIMES -> VInt(int_of_kval v1 * int_of_kval v2) - | DIV -> VInt(int_of_kval v1 / int_of_kval v2) - | MOD -> VInt(int_of_kval v1 mod int_of_kval v2) - | EQUAL -> VBool(kbval_of_kval v1 = kbval_of_kval v2) - (* EQUAL does not test values in depth ! *) - | NEQUAL -> VBool(kbval_of_kval v1 <> kbval_of_kval v2) - | GT -> VBool(int_of_kval v1 > int_of_kval v2) - | LT -> VBool(int_of_kval v1 < int_of_kval v2) - | GE -> VBool(int_of_kval v1 >= int_of_kval v2) - | LE -> VBool(int_of_kval v1 <= int_of_kval v2) - | AND -> VBool(bool_of_kval v1 && bool_of_kval v2) - | OR -> VBool(bool_of_kval v1 || bool_of_kval v2) - | XOR -> VBool(bool_of_kval v1 ^^ bool_of_kval v2) - in Single r - | EUnary(op, e) -> - let v = eval_expr proc e in - let r = match op with - | MINUS -> VInt(-(int_of_kval v)) - | NOT -> VBool(not(bool_of_kval v)) - in Single r - | ETernary(cond, e1, e2) -> - if bool_of_kval (eval_expr proc cond) then - eval_expr proc e1 - else - eval_expr proc e2 - | ECat(e1, e2) -> - Single(VStr( - str_of_kval (eval_expr proc e1) - ^ psep - ^ str_of_kval (eval_expr proc e2))) - | ELoad(x) -> - load_kval proc (str_of_kval (eval_expr proc x)) - | ENewChan -> proc.xnewchan proc - -let exec_stmt proc = - match proc.xprog.pinstr.(proc.xpos) with - | SLabel _ -> - proc.xpos <- proc.xpos + 1 (* nothing to do *) - | SSet(var, v) -> - let var = str_of_kval (eval_expr proc var) in - let v = eval_expr proc v in - save_kval proc var v; - proc.xpos <- proc.xpos + 1 - | SGoto pos -> - let pos = str_of_kval (eval_expr proc pos) in - begin - try - proc.xpos <- Smap.find pos proc.xprog.plabels - with Not_found -> - proc.xstatus <- PSDone - end - | SPar pos -> - let pos = str_of_kval (eval_expr proc pos) in - begin - try - proc.xspawn proc (Smap.find pos proc.xprog.plabels) - with Not_found -> () - end; - proc.xpos <- proc.xpos + 1 - | SRecv(var, chan) -> - begin match proc.xstatus with - | PSExec -> - let chan = kbval_of_kval (eval_expr proc (ELoad chan)) in - proc.xstatus <- PSRecv chan - | PSExecRecvd v -> - let var = str_of_kval (eval_expr proc var) in - save_kval proc var v; - proc.xstatus <- PSExec; - proc.xpos <- proc.xpos + 1 - | _ -> assert false - end - | SSend(v, chan) -> - let chan = kbval_of_kval (eval_expr proc (ELoad chan)) in - let v = eval_expr proc v in - proc.xpos <- proc.xpos + 1; - proc.xstatus <- PSSend(chan, v) - | SUnset(l) -> - List.iter (unset_kval proc) - (List.map (fun e -> str_of_kval (eval_expr proc e)) l); - proc.xpos <- proc.xpos + 1; - | SExit -> - proc.xstatus <- PSDone - - -(* Load program, ie find labels *) -let load_program p = - let labels = ref Smap.empty in - Array.iteri - (fun i x -> - match x with - | SLabel l -> labels := Smap.add l i !labels - | _ -> ()) - p; - { pinstr = p; plabels = !labels } - - - diff --git a/khb/khs_exec_local.ml b/khb/khs_exec_local.ml deleted file mode 100644 index 09f14a8..0000000 --- a/khb/khs_exec_local.ml +++ /dev/null @@ -1,73 +0,0 @@ -open Util -open Khs_ast -open Khs_exec - -(* TODO : channels cannot be communicated over channels, although - it should totally be possible because it's so great and so usefull ! *) - -let childs = ref [] - -let wait_childs () = - Unix.handle_unix_error (fun () -> - List.iter (fun pid -> ignore (Unix.waitpid [] pid)) !childs) - () - -let newchan proc = - let id = "khs_ch_" ^ string_of_int (Random.int 1000000) - ^ "-" ^ string_of_int (Random.int 1000000) in - Unix.mkfifo ("/tmp/" ^ id) 0o666; - Many (Smap.add (psep^"in") (VStr id) - (Smap.add (psep^"out") (VStr id) Smap.empty)) - -let exec_proc proc = - while proc.xstatus <> PSDone do - match proc.xstatus with - | PSDone -> assert false - | PSExec | PSExecRecvd _ -> - exec_stmt proc - | PSSend(c, kv) -> - let c = str_of_kbval c in - proc.xstatus <- PSExec; - begin - if c == "stdout" then - Format.printf "%s@." (kval_descr kv) - else - let c_out = Unix.openfile ("/tmp/"^c) [Unix.O_WRONLY] 0 in - Marshal.to_channel (Unix.out_channel_of_descr c_out) kv []; - Unix.close c_out - end - | PSRecv c -> - let c = str_of_kbval c in - let c_in = Unix.openfile ("/tmp/"^c) [Unix.O_RDONLY] 0 in - let data = Marshal.from_channel (Unix.in_channel_of_descr c_in) in - proc.xstatus <- PSExecRecvd data; - Unix.close c_in - done - -let spawn proc pos = - let pid = Unix.fork () in - if pid = 0 then begin - childs := []; - exec_proc { proc with xpos = pos}; - wait_childs(); - exit 0 - end else - childs := pid::!childs - - - -let exec_program p = - Random.init (int_of_float (Unix.time())); - let proc = { - xspawn = spawn; - xnewchan = newchan; - xprog = p; - xvals = Smap.empty; - xstatus = PSExec; - xpos = 0; - } in - proc.xvals <- Smap.add framevar (VInt 0) proc.xvals; - proc.xvals <- Smap.add "stdout" (VStr "stdout") proc.xvals; - exec_proc proc; - wait_childs() - diff --git a/khb/khs_exec_seq.ml b/khb/khs_exec_seq.ml deleted file mode 100644 index 6e34767..0000000 --- a/khb/khs_exec_seq.ml +++ /dev/null @@ -1,62 +0,0 @@ -open Util -open Khs_ast -open Khs_exec - -let chans = Hashtbl.create 12 -let ch_id = - let p = ref 0 in - fun () -> p := !p + 1; !p - -let proc = ref [] -let proc_spawned = ref [] - -let spawn proc pos = - proc_spawned := - { proc with xpos = pos }::(!proc_spawned) - -let newchan proc = - let id = ch_id () in - Hashtbl.add chans id (Queue.create()); - Many (Smap.add (psep^"in") (VInt id) - (Smap.add (psep^"out") (VInt id) Smap.empty)) - -let proc_step proc = - match proc.xstatus with - | PSDone -> false - | PSExec | PSExecRecvd _ -> - exec_stmt proc; - true - | PSSend(c, kv) -> - proc.xstatus <- PSExec; - begin - if (int_of_kbval c) == 0 then - Format.printf "%s@." (kval_descr kv) - else - Queue.push kv (Hashtbl.find chans (int_of_kbval c)) - end; - true - | PSRecv(c) -> - let q = Hashtbl.find chans (int_of_kbval c) in - if not (Queue.is_empty q) then - proc.xstatus <- PSExecRecvd (Queue.pop q); - true - -let exec_program p = - let proc0 = { - xspawn = spawn; - xnewchan = newchan; - xprog = p; - xvals = Smap.empty; - xstatus = PSExec; - xpos = 0 - } in - proc0.xvals <- Smap.add framevar (VInt 0) proc0.xvals; - proc0.xvals <- Smap.add "stdout" (VInt 0) proc0.xvals; - proc := [ proc0 ]; - while List.length !proc > 0 do - proc := List.filter proc_step !proc; - proc := !proc_spawned @ !proc; - proc_spawned := []; - done - - diff --git a/khb/ksh_print.ml b/khb/ksh_print.ml deleted file mode 100644 index 6b0a7e3..0000000 --- a/khb/ksh_print.ml +++ /dev/null @@ -1,53 +0,0 @@ -open Khs_ast - -let rec expr_str = function - | EEmpty -> "()" - | EInt i -> string_of_int i - | EStr s -> "\"" ^ s ^ "\"" - | EBool b -> if b then "true" else "false" - | EFrame -> "#" - | ELocal s -> "." ^ s - | EBinary (e1, op, e2) -> - "(" ^ expr_str e1 ^ - (match op with - | PLUS -> " + " - | MINUS -> " - " - | TIMES -> " * " - | DIV -> " / " - | MOD -> " % " - | EQUAL -> " == " - | NEQUAL -> " != " - | GT -> " > " - | LT -> " < " - | GE -> " >= " - | LE -> " <= " - | AND -> " && " - | OR -> " || " - | XOR -> " ^^ " - ) ^ expr_str e2 ^ ")" - | EUnary (op, e) -> - (match op with - | MINUS -> "-" - | NOT -> "!" - ) ^ expr_str e - | ETernary(c, a, b) -> - "(" ^ expr_str c ^ " ? " ^ expr_str a ^ " : " ^ expr_str b ^ ")" - | ECat(x, y) -> expr_str x ^ "\\" ^ expr_str y - | ELoad(v) -> "@" ^ expr_str v - | ENewChan -> "<>" - -let print_stmt = function - | SLabel s -> Format.printf "%s:@." s - | SSet(k, v) -> Format.printf " %s := %s@." (expr_str k) (expr_str v) - | SGoto l -> Format.printf " < %s >@." (expr_str l) - | SPar l -> Format.printf " | %s |@." (expr_str l) - | SRecv (e, c) -> Format.printf " %s << %s@." (expr_str e) (expr_str c) - | SSend (e, c) -> Format.printf " %s >> %s@." (expr_str e) (expr_str c) - | SUnset l -> - let rec aux = function - | [] -> " ~(" - | [a] -> " ~(" ^ (expr_str a) - | a::b -> (aux b) ^ ", " ^ (expr_str a) - in Format.printf "%s)@." (aux l) - | SExit -> - Format.printf " exit@." diff --git a/khb/test.khb b/khb/test.khb deleted file mode 100644 index f109016..0000000 --- a/khb/test.khb +++ /dev/null @@ -1,67 +0,0 @@ -$$ integers (n, nmax, qo) = - (n > nmax ? - (-1) >> qo - : - n >> qo; - become integers(n+1, nmax, qo) - ) - -# Version alternative : -$$ integers (n, nmax, qo) = - ]->[ ( - (n > nmax ? ->[]); - n >> qo; - n = n + 1 - ); - -1 >> qo - -$$ filter (n, qi, qo) = - val << qi; - (val != -1 ? - (val % n != 0 ? - val >> qo - ); - become filter(n, qi, qo) - : - -1 >> qo - ) - -# Version alternative : -$$ filter (n, qi, qo) = - ]->[ ( - val << qi; - (val == -1 ? ->[]); - (val % n != 0 ? val >> qo) - ); - -1 >> qo - -$$ primes (qi) = - val << qi; - (val != -1 ? - val >> stdout; - c = <>; - | become filter(val, qi, c.out) |; - become primes(c.in) - ) - -# Version alternative : -$$ primes (qi) = - ]->[ ( - val << qi; - (val == -1 ? ->[]); - val >> stdout; - c = <>; - | filter(val, qi, c.out) |; - qi = c.in - ) - -$$ main () = - c = <>; - | integers (2, 5000, c.out) |; - primes (c.in) - - - - - - diff --git a/khb/test.khs b/khb/test.khs deleted file mode 100644 index 54b9507..0000000 --- a/khb/test.khs +++ /dev/null @@ -1,76 +0,0 @@ -proc_integers: - < @fd[f].n > @fd[f].nmax ? _then1 : _else1 > -_then1: - -1 >> @fd[f].qo - < _end1 > -_else1: - @fd[f].n >> @fd[f].qo - fd[f].trtmp.n := @fd[f].n + 1 - fd[f].trtmp.nmax := @fd[f].nmax - fd[f].trtmp.qo := @fd[f].qo - fd[f].n := @fd[f].trtmp.n - fd[f].nmax := @fd[f].trtmp.nmax - fd[f].qo := @fd[f].trtmp.qo - < proc_integers > - < _end1 > -_end1: - fd[f] := "" - ~ (.qo, .nmax, .n) - < @fd[f].return > - - proc_filter: - val << @(fd\@f\qi) - < @val != -1 ? _then2 : _else2 > -_then2: - < @val % @(fd\@f\n) != 0 ? _then3 : _end3 > -_then3: - @val >> @(fd\@f\qo) -_end3: - - <_end2> -_else2: - -1 >> @qo - <_end2> -_end2: - fd[f] := "" - ~ (.qo, .qi, .val, .n) - < @(fd\@f\return) > - -proc_primes: - .val << @.qi - < @.val != -1 ? _then4 : _end4 > -_then4: - @.val >> @stdout - .c := <> - | _par_1 | - .qi := @(.c\in) - -_end4: - fd\@f := "" - ~ (.val, .qi, .c) - < @(fd\@f\return) > -_par_1: - .n := @.val - .qo := @(.c\out) - - -proc_main: - .c := <> - | _par_2 | - fd\(@f+1)\qi := @(.c\in) - f := @f+1 - .return := _ret1 - -_ret1: - f := @f-1 - .tmp_retval := @(fd\(@f+1)) - fd\@f := .tmp_retval - ~(.tmp_retval) - < .return > -_par_2: - .n := 2 - .nmax := 5000 - .qo := @(.c\out) - - - diff --git a/khb/test.ml b/khb/test.ml deleted file mode 100644 index edc155e..0000000 --- a/khb/test.ml +++ /dev/null @@ -1,101 +0,0 @@ -open Khs_ast -open Khs_exec - -let primes_khs = [| - SGoto (EStr "proc_main"); - - (* integers *) - SLabel "proc_integers"; - SGoto ( - ETernary( - EBinary(ELoad(ELocal "n"), GT, ELoad(ELocal "nmax")), - EStr "_then1", EStr "_else1")); - - SLabel "_then1"; - SSend(EInt (-1), ELocal "qo"); - SGoto(EStr "_end1"); - - SLabel "_else1"; - SSend(ELoad(ELocal "n"), ELocal "qo"); - SSet(ELocal "n", - EBinary(ELoad(ELocal "n"), PLUS, EInt 1)); - SGoto (EStr "proc_integers"); - - SLabel "_end1"; - SSet(ELocal "retval", EEmpty); - SUnset [ELocal "qo"; ELocal "nmax"; ELocal "n"]; - SGoto(ELoad(ELocal "retpos")); - - (* filter *) - SLabel "proc_filter"; - SRecv(ELocal "val", ELocal "qi"); - SGoto(ETernary( - EBinary(ELoad(ELocal "val"), NEQUAL, EInt (-1)), - EStr "_then2", EStr "_else2")); - - SLabel "_then2"; - SGoto(ETernary( - EBinary(EBinary(ELoad(ELocal "val"), MOD, ELoad(ELocal "n")), NEQUAL, EInt 0), - EStr "_then3", EStr "_end3")); - - SLabel "_then3"; - SSend(ELoad(ELocal "val"), ELocal "qo"); - - SLabel "_end3"; - SGoto(EStr "proc_filter"); - - SLabel "_else2"; - SSend(EInt (-1), ELocal "qo"); - - SSet(ELocal "retval", EEmpty); - SUnset[ELocal "qo"; ELocal "qi"; ELocal "val"; ELocal "n"]; - SGoto(ELoad(ELocal "retpos")); - - (* primes *) - SLabel "proc_primes"; - SRecv(ELocal "val", ELocal "qi"); - SGoto(ETernary( - EBinary(ELoad(ELocal "val"), NEQUAL, EInt(-1)), - EStr "_then4", EStr "_end4")); - - SLabel "_then4"; - SSend(ELoad(ELocal "val"), EStr "stdout"); - SSet(ELocal "c", ENewChan); - SPar(EStr "_par_1"); - SSet(ELocal "qi", ELoad(ECat(ELocal "c", EStr "in"))); - SGoto(EStr "proc_primes"); - - SLabel "_end4"; - SSet(ELocal "retval", EEmpty); - SUnset[ELocal "qi"; ELocal "val"; ELocal "c"]; - SGoto(ELoad(ELocal "retpos")); - - SLabel "_par_1"; - SSet(ELocal "n", ELoad(ELocal "val")); - SSet(ELocal "qo", ELoad(ECat(ELocal "c", EStr "out"))); - SGoto(EStr "proc_filter"); - - - (* main *) - SLabel "proc_main"; - SSet(ELocal "c", ENewChan); - SPar(EStr "_par_2"); - - SSet(ELocal "qi", ELoad(ECat(ELocal "c", EStr "in"))); - SSet(ELocal "retpos", EStr "_ret1"); - SGoto(EStr "proc_primes"); - - SLabel "_par_2"; - SSet(ELocal "n", EInt 2); - SSet(ELocal "nmax", EInt 3000); - SSet(ELocal "qo", ELoad(ECat(ELocal "c", EStr "out"))); - SSet(ELocal "retpos", EStr "_ret1"); - SGoto(EStr "proc_integers"); - - SLabel "_ret1"; - SExit; -|] - -let () = - Array.iter Ksh_print.print_stmt primes_khs; - Khs_exec_local.exec_program (load_program primes_khs) diff --git a/khb/util.ml b/khb/util.ml deleted file mode 100644 index 0d278d6..0000000 --- a/khb/util.ml +++ /dev/null @@ -1,10 +0,0 @@ - -module Int = struct - type t = int - let compare = Pervasives.compare -end - -module Smap = Map.Make(String) -module Imap = Map.Make(Int) - -let (^^) a b = (a || b) && (not (a && b)) diff --git a/src/kahn_sock_0.ml b/src/kahn_sock_0.ml deleted file mode 100644 index 89ee65c..0000000 --- a/src/kahn_sock_0.ml +++ /dev/null @@ -1,115 +0,0 @@ -Random.self_init () - -type ident = (int * int * int * int) -let gen_ident () = - Random.int 1000000000, Random.int 1000000000, - Random.int 1000000000, Random.int 1000000000 - -module Sock : Kahn.S = struct - - (* L'idée : - - L'ensemble des noeuds qui font du calcul est un arbre. - Le premier noeud lancé est la racine de l'arbre ; tous les - noeuds qui se connectent par la suite se connectent à un - noeud déjà présent et sont donc son fils. - - Les processus sont des fermetures de type unit -> unit, - transmises par des canaux - - Un noeud de calcul est un processus ocaml avec un seul - thread. Le parallélisme est coopératif (penser à faire - des binds assez souvent). - - Les noeuds publient régulièrement leur load, ie le nombre - de processus en attente et qui ne sont pas en train - d'attendre des données depuis un canal. Si un noeud a un - voisin dont le load est plus faible que le sien d'une - quantité plus grande que 2, il délègue une tâche. - - Le noeud racine délègue toutes ses tâches et sert uniquement - pour les entrées-sorties - - Comportement indéterminé lorsqu'un noeud se déconnecte - (des processus peuvent disparaître, le réseau est cassé...) - - Les canaux sont identifiés par le type ident décrit - ci-dessus. Lorsque quelqu'un écrit sur un canal, tout le - monde le sait. Lorsque quelqu'un lit sur un canal, tout le - monde le sait. (on n'est pas capable de déterminer - quel est le noeud propriétaire du processus devant lire - le message) Les communications sont donc coûteuses. - - On garantit que si chaque canal est lu par un processus - et écrit par un autre, alors l'ordre des messages est - conservé. On ne garantit pas l'ordre s'il y a plusieurs - écrivains, et on est à peu près sûrs que le réseau va - planter s'il y a plusieurs lecteurs. - *) - - type 'a process = (('a -> unit) option) -> unit - - type 'a in_port = ident - type 'a out_port = ident - - type task = unit -> unit - - let tasks = Queue.create () - let read_wait_tasks = Hashtbl.create 42 - - let channels = Hashtbl.create 42 - - type host_id = string - type message = host_id * message_data - (* message contains sender ID *) - and message_data = - | Hello - | LoadAdvert of host_id * int - (* Host X has N tasks waiting *) - | Delegate of task - (* I need you to do this for me *) - | SendChan of ident * string - (* Put message in buffer *) - | RecvChan of ident - (* Read message from buffer (everybody clear it from - memory !) *) - | IOWrite of string - | Bye - - let peers = Hashtbl.create 12 (* host_id -> in_chan * out_chan *) - let parent = ref "" (* id of parent *) - let myself = ref "" - - let tell peer msg = - let _, o = Hashtbl.find peers peer in - Marshall.to_channel o msg - - let tell_all msg = - Hashtbl.iter peers - (fun _ (_, o) -> Marshall.to_channel o msg) - - let tell_all_except peer msg = - Hashtbl.iter peers - (fun k (_, o) -> if k <> peer then - Marshall.to_channel o msg) - - let io_read () = "" - let io_write msg = - tell !parent (!myself, IOWrite msg) - - let new_channel () = - let x = gen_ident () in x, x - - let put port x = - fun cont -> - tell_all (!myself, SendChan(port, Marshal.to_string x)); - match cont with - | Some cont -> Queue.push cont tasks - | None -> () - - let rec get port = - fun cont -> - try - let p = Hashtbl.find channels port in - let v = Queue.pop p in - tell_all (!myself, RecvChan port) - match cont with - | None -> () - | Some -> Queue.push (fun () -> cont v) tasks - with _ -> (* no message in queue *) - Hashtbl.add read_wait_tasks - port (fun () -> get port cont) - -end -- cgit v1.2.3