Initialization of separate units; fixed runtime

regression/x86only/Lib01.expr

@@ -1,3 +1,5 @@
 public fun from_test005 (s) {
   printf ("called with %s\n", s)
 }
+
+printf ("Init Lib01...\n")

regression/x86only/Makefile

@@ -1,5 +1,5 @@
 TESTS=$(sort $(basename $(wildcard test*.expr)))
-LIBS=$(sort $(basename $(wildcard Lib*.expr)).o)
+LIBS=$(patsubst %.expr,%.o, $(sort $(wildcard Lib*.expr)))
 
 RC=../../src/rc.opt
 

regression/x86only/orig/test005.log

@@ -1 +1,2 @@
+Init Lib01...
 called with that one

regression/x86only/orig/test008.log

@@ -0,0 +1,4 @@
+Init Lib01...
+Init Lib02...
+Init Lib03...
+main dish.

regression/x86only/test008.expr

@@ -0,0 +1,4 @@
+import Lib03;
+import Lib02;
+
+printf ("main dish.\n")

regression/x86only/test008.input

@@ -0,0 +1 @@
+0

runtime/runtime.c

@@ -482,10 +482,9 @@ extern int LregexpMatch (struct re_pattern_buffer *b, char *s, int pos) {
   return BOX (re_match (b, s, LEN(TO_DATA(s)->tag), UNBOX(pos), 0));
 }
 
-extern void* Bstring (void*);
-
 void *Lclone (void *p) {
   data *res;
+  int n;
   
   __pre_gc ();
   
@@ -496,7 +495,11 @@ void *Lclone (void *p) {
 
     switch (t) {
     case STRING_TAG:
-      res = Bstring (a->contents);
+      n = strlen (a->contents);      
+      res = (data*) alloc (n + 1 + sizeof (int));
+      res->tag = STRING_TAG | (n << 3);
+      strncpy (res->contents, a->contents, n + 1);
+      res = res->contents;
       break;
 
     case ARRAY_TAG:      
@@ -679,7 +682,7 @@ extern void* LmakeString (int length) {
   int   n = UNBOX(length);
   data *r;
 
-  ASSERT_UNBOXED("makeStrig", length);
+  ASSERT_UNBOXED("makeString", length);
   
   __pre_gc () ;
   
@@ -694,21 +697,24 @@ extern void* LmakeString (int length) {
 
 extern void* Bstring (void *p) {
   int   n = strlen (p);
-  void *s;
+  data *s;
   
   __pre_gc ();
   
-  s = LmakeString (BOX(n));  
+  s = (data*) alloc (n + 1 + sizeof (int));
-  strncpy (s, p, n + 1);
+  s->tag = STRING_TAG | (n << 3);
+
+  strncpy (s->contents, p, n + 1);
 
   __post_gc ();
   
-  return s;
+  return s->contents;
 }
 
 extern void* Lstringcat (void *p) {
-  void *s;
+  data *s;
-
+  int n;
+  
   ASSERT_BOXED("stringcat", p);
   
   __pre_gc ();
@@ -716,30 +722,41 @@ extern void* Lstringcat (void *p) {
   createStringBuf ();
   stringcat (p);
 
-  s = Bstring (stringBuf.contents);
+  n = strlen (stringBuf.contents);
+  
+  s = (data*) alloc (n + 1 + sizeof (int));
+  s->tag = STRING_TAG | (n << 3);
+
+  strncpy (s->contents, stringBuf.contents, n + 1);
   
   deleteStringBuf ();
 
   __post_gc ();
 
-  return s;  
+  return s->contents;  
 }
 
 extern void* Bstringval (void *p) {
-  void *s = (void *) BOX (NULL);
+  data *s;
+  int n;
 
   __pre_gc () ;
   
   createStringBuf ();
   printValue (p);
 
-  s = Bstring (stringBuf.contents);
+  n = strlen (stringBuf.contents);
+  
+  s = (data*) alloc (n + 1 + sizeof (int));
+  s->tag = STRING_TAG | (n << 3);
+
+  strncpy (s->contents, stringBuf.contents, n + 1);
   
   deleteStringBuf ();
 
   __post_gc ();
 
-  return s;
+  return s->contents;
 }
 
 extern void* Bclosure (int n, void *entry, ...) {
@@ -985,7 +1002,8 @@ extern void* /*Lstrcat*/ Li__Infix_4343 (void *a, void *b) {
 
 extern void* Lsprintf (char * fmt, ...) {
   va_list args;
-  void *s;
+  data *s;
+  int n;
 
   ASSERT_STRING("sprintf:1", fmt);
   
@@ -998,13 +1016,17 @@ extern void* Lsprintf (char * fmt, ...) {
 
   __pre_gc ();
 
-  s = Bstring (stringBuf.contents);
+  n = strlen (stringBuf.contents);
+  s = (data*) alloc (n + 1 + sizeof (int));
+  s->tag = STRING_TAG | (n << 3);
+
+  strncpy (s->contents, stringBuf.contents, n + 1);
 
   __post_gc ();
   
   deleteStringBuf ();
 
-  return s;
+  return s->contents;
 }
 
 extern void Lfprintf (FILE *f, char *s, ...) {
@@ -1060,10 +1082,21 @@ extern void* LreadLine () {
   char *buf;
 
   if (scanf ("%m[^\n]", &buf) == 1) {
-    void * s = Bstring (buf);
+    data * s;
+    int n = strlen (buf);
+
+    __pre_gc ();
+  
+    s = (data*) alloc (n + 1 + sizeof (int));
+    s->tag = STRING_TAG | (n << 3);
+
+    strncpy (s->contents, buf, n + 1);
+
+    __post_gc ();
     
     free (buf);
-    return s;
+    
+    return s->contents;
   }
   
   if (errno != 0)

src/Driver.ml

@@ -104,7 +104,11 @@ class options args =
       | Some name -> name
     method get_help = !help
     method get_include_paths = !paths
-    method basename = Filename.chop_suffix self#get_infile ".expr"
+    method basename = Filename.chop_suffix (Filename.basename self#get_infile) ".expr"
+    method topname =
+      match !mode with
+      | `Compile -> "init" ^ self#basename
+      | _ -> "main"
     method dump_file ext contents =
       let name = self#basename in
       let outf = open_out (Printf.sprintf "%s.%s" name ext) in

src/Language.ml

@@ -372,7 +372,7 @@ module Expr =
     (* return statement           *) | Return    of t option
     (* ignore a value             *) | Ignore    of t
     (* unit value                 *) | Unit
-    (* entering the scope         *) | Scope     of (string * decl) list * t
+    (* entering the scope         *) | Scope     of (string * decl) list * t 
     (* lambda expression          *) | Lambda    of string list * t
     (* leave a scope              *) | Leave
     (* intrinsic (for evaluation) *) | Intrinsic of (t config, t config) arrow
@@ -1075,11 +1075,11 @@ ostap (
     is, infix
   };
   (* Workaround until Ostap starts to memoize properly *)
-  constparse[cmd]: <(is, infix)> : imports[cmd] d:!(Definition.constdef) {(is, []), Expr.Scope (d, Expr.Skip)};
+  constparse[cmd]: <(is, infix)> : imports[cmd] d:!(Definition.constdef) {(is, []), Expr.Scope (d, Expr.materialize Expr.Weak Expr.Skip)};
   (* end of the workaround *)
   parse[cmd]:
     <(is, infix)> : imports[cmd] <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Weak)? {
-    (is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
+    (is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.materialize Expr.Weak Expr.Skip | Some e -> e)
     };
   definitions[infix]:
     <(def, infix')> : !(Definition.parse infix (fun def infix atr -> Expr.scope def infix atr (Expr.parse def))

src/SM.ml

@@ -878,9 +878,9 @@ let compile cmd ((imports, infixes), p) =
   let lend, env       = env#get_label in
   let env, flag, code = compile_expr lend env p in
   let code            = if flag then code @ [LABEL lend] else code in
-  let has_main        = List.length code > 0 in
+  let topname         = cmd#topname in
-  let env, prg        = compile_fundefs [if has_main then [LABEL "main"; BEGIN ("main", 0, env#nlocals, [])] @ code @ [END] else []] env in
+  let env, prg        = compile_fundefs [[LABEL topname; BEGIN (topname, 0, env#nlocals, [])] @ code @ [END]] env in
-  let prg             = (if has_main then [PUBLIC "main"] else []) @ env#get_decls @ List.flatten prg in
+  let prg             = [PUBLIC topname] @ env#get_decls @ List.flatten prg in
   (*Printf.eprintf "Before propagating closures:\n";
   Printf.eprintf "%s\n%!" env#show_funinfo;
    *)

src/X86.ml

@@ -64,14 +64,15 @@ type instr =
 (* Instruction printer *)
 let show instr =
   let binop = function
-  | "+"   -> "addl"
+  | "+"    -> "addl"
-  | "-"   -> "subl"
+  | "-"    -> "subl"
-  | "*"   -> "imull"
+  | "*"    -> "imull"
-  | "&&"  -> "andl"
+  | "&&"   -> "andl"
-  | "!!"  -> "orl"
+  | "!!"   -> "orl"
-  | "^"   -> "xorl"
+  | "^"    -> "xorl"
-  | "cmp" -> "cmpl"
+  | "cmp"  -> "cmpl"
-  | _     -> failwith "unknown binary operator"
+  | "test" -> "test"
+  | _      -> failwith "unknown binary operator"
   in
   let rec opnd = function
   | R i      -> regs.(i)
@@ -116,7 +117,7 @@ open SM
    Take an environment, a stack machine program, and returns a pair --- the updated environment and the list
    of x86 instructions
 *)
-let compile cmd env code =
+let compile cmd env imports code =
   (* SM.print_prg code; *)
   flush stdout;
   let suffix = function
@@ -356,6 +357,17 @@ let compile cmd env code =
              let has_closure = closure <> [] in
              let env  = env#enter f nlocals has_closure in
              env, (if has_closure then [Push edx] else []) @
+                  (if f = cmd#topname
+                   then
+                     [Mov   (M "_init", eax);
+                      Binop ("test", eax, eax);
+                      CJmp  ("z", "_continue");
+                      Ret;
+                      Label "_continue";
+                      Mov (L 1, M "_init");
+                     ]
+                   else []
+                  ) @                  
                   [Push ebp;
                    Mov (esp, ebp);
                    Binop ("-", M ("$" ^ env#lsize), esp);
@@ -364,7 +376,14 @@ let compile cmd env code =
 	           Mov (M ("$" ^ (env#allocated_size)), ecx);
 	           Repmovsl
                   ] @
-                  (if f = "main" then [Call "L__gc_init"] else [])   
+                  (if f = "main"
+                   then [Call "L__gc_init"]
+                   else []
+                  ) @
+                  (if f = cmd#topname
+                   then List.map (fun i -> Call ("init" ^ i)) (List.filter (fun i -> i <> "Std") imports)
+                   else []
+                  )    
 
           | END ->
              let x, env = env#pop in
@@ -646,11 +665,13 @@ class env prg =
 *)
 let genasm cmd prog =
   let sm        = SM.compile cmd prog in
-  let env, code = compile cmd (new env sm) sm in
+  let env, code = compile cmd (new env sm) (fst (fst prog)) sm in
   let globals =
     List.map (fun s -> Meta (Printf.sprintf "\t.globl\t%s" s)) env#publics
   in
-  let data = [Meta "\t.section custom_data,\"aw\",@progbits";
+  let data = [Meta "\t.data";
+              Meta "_init:\t.int 0";
+              Meta "\t.section custom_data,\"aw\",@progbits";
               Meta (Printf.sprintf "filler:\t.fill\t%d, 4, 1" env#max_locals_size)] @
               (List.map (fun s -> Meta (Printf.sprintf "%s:\t.int\t1" s)) env#globals) @
               (List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings)

stdlib/Makefile

@@ -12,7 +12,9 @@ Collection.o: List.o Ref.o
 
 Array.o: List.o
 
-Ostap.o: List.o Collection.o Ref.o Fun.o
+Ostap.o: List.o Collection.o Ref.o Fun.o Matcher.o
+
+Expr.o: Ostap.o
 
 %.o: %.expr
 	$(RC) -I . -c $<

stdlib/Ostap.expr

@@ -11,10 +11,6 @@ public fun initOstap () {
   hct := emptyMemo ()
 }
 
-public fun cleanupOstap () {
-  initOstap ()
-}
-
 public fun memo (f) {
   local t;
 
@@ -218,4 +214,6 @@ public fun parseString (p, s) {
   p (acc.k) (initMatcher (s));
 
   acc.result
-}
+}
+
+initOstap ()