diff --git a/regression/x86only/Lib01.expr b/regression/x86only/Lib01.expr index d049c6104..ae58f32a9 100644 --- a/regression/x86only/Lib01.expr +++ b/regression/x86only/Lib01.expr @@ -1,3 +1,5 @@ public fun from_test005 (s) { printf ("called with %s\n", s) } + +printf ("Init Lib01...\n") diff --git a/regression/x86only/Makefile b/regression/x86only/Makefile index 2c5369d41..fa96a0e85 100644 --- a/regression/x86only/Makefile +++ b/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 diff --git a/regression/x86only/orig/test005.log b/regression/x86only/orig/test005.log index e47347ed8..b820707a2 100644 --- a/regression/x86only/orig/test005.log +++ b/regression/x86only/orig/test005.log @@ -1 +1,2 @@ +Init Lib01... called with that one diff --git a/regression/x86only/orig/test008.log b/regression/x86only/orig/test008.log new file mode 100644 index 000000000..6559c220b --- /dev/null +++ b/regression/x86only/orig/test008.log @@ -0,0 +1,4 @@ +Init Lib01... +Init Lib02... +Init Lib03... +main dish. diff --git a/regression/x86only/test008.expr b/regression/x86only/test008.expr new file mode 100644 index 000000000..114ba56d2 --- /dev/null +++ b/regression/x86only/test008.expr @@ -0,0 +1,4 @@ +import Lib03; +import Lib02; + +printf ("main dish.\n") \ No newline at end of file diff --git a/regression/x86only/test008.input b/regression/x86only/test008.input new file mode 100644 index 000000000..573541ac9 --- /dev/null +++ b/regression/x86only/test008.input @@ -0,0 +1 @@ +0 diff --git a/runtime/runtime.c b/runtime/runtime.c index a3fa026aa..1a297df47 100644 --- a/runtime/runtime.c +++ b/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)); - strncpy (s, p, n + 1); + s = (data*) alloc (n + 1 + sizeof (int)); + 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) diff --git a/src/Driver.ml b/src/Driver.ml index c506dc88d..75638e59a 100644 --- a/src/Driver.ml +++ b/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 diff --git a/src/Language.ml b/src/Language.ml index 9a2fbe627..85989c4fa 100644 --- a/src/Language.ml +++ b/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)) diff --git a/src/SM.ml b/src/SM.ml index df362449c..652524357 100644 --- a/src/SM.ml +++ b/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 env, prg = compile_fundefs [if has_main then [LABEL "main"; BEGIN ("main", 0, env#nlocals, [])] @ code @ [END] else []] env in - let prg = (if has_main then [PUBLIC "main"] else []) @ env#get_decls @ List.flatten prg in + let topname = cmd#topname in + let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, 0, env#nlocals, [])] @ code @ [END]] env 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; *) diff --git a/src/X86.ml b/src/X86.ml index 48490934b..3ec405966 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -64,14 +64,15 @@ type instr = (* Instruction printer *) let show instr = let binop = function - | "+" -> "addl" - | "-" -> "subl" - | "*" -> "imull" - | "&&" -> "andl" - | "!!" -> "orl" - | "^" -> "xorl" - | "cmp" -> "cmpl" - | _ -> failwith "unknown binary operator" + | "+" -> "addl" + | "-" -> "subl" + | "*" -> "imull" + | "&&" -> "andl" + | "!!" -> "orl" + | "^" -> "xorl" + | "cmp" -> "cmpl" + | "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) diff --git a/stdlib/Makefile b/stdlib/Makefile index 22a963340..631207f83 100644 --- a/stdlib/Makefile +++ b/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 $< diff --git a/stdlib/Ostap.expr b/stdlib/Ostap.expr index ececc4438..a1b5cabca 100644 --- a/stdlib/Ostap.expr +++ b/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 -} \ No newline at end of file +} + +initOstap () \ No newline at end of file