diff --git a/byterun/byterun.c b/byterun/byterun.c index f57ab9746..82f468d4c 100644 --- a/byterun/byterun.c +++ b/byterun/byterun.c @@ -13,7 +13,8 @@ void *__stop_custom_data; typedef struct { char *string_ptr; /* A pointer to the beginning of the string table */ int *public_ptr; /* A pointer to the beginning of publics table */ - char *code_ptr; /* A pointer to the bytecode itself */ + char *code_ptr; /* A pointer to the bytecode itself */ + int *global_ptr; /* A pointer to the global area */ int stringtab_size; /* The size (in bytes) of the string table */ int global_area_size; /* The size (in words) of global area */ int public_symbols_number; /* The number of public symbols */ @@ -49,7 +50,7 @@ bytefile* read_file (char *fname) { failure ("%s\n", strerror (errno)); } - file = (bytefile*) malloc (sizeof(int)*3 + (size = ftell (f))); + file = (bytefile*) malloc (sizeof(int)*4 + (size = ftell (f))); if (file == 0) { failure ("*** FAILURE: unable to allocate memory.\n"); @@ -63,9 +64,10 @@ bytefile* read_file (char *fname) { fclose (f); - file->string_ptr = &file->buffer [file->public_symbols_number * 2 * sizeof(int)]; - file->public_ptr = (int*) file->buffer; - file->code_ptr = &file->string_ptr [file->stringtab_size]; + file->string_ptr = &file->buffer [file->public_symbols_number * 2 * sizeof(int)]; + file->public_ptr = (int*) file->buffer; + file->code_ptr = &file->string_ptr [file->stringtab_size]; + file->global_ptr = (int*) malloc (file->global_area_size * sizeof (int)); return file; } @@ -81,7 +83,7 @@ void disassemble (FILE *f, bytefile *bf) { char *ip = bf->code_ptr; char *ops [] = {"+", "-", "*", "/", "%", "<", "<=", ">", ">=", "==", "!=", "&&", "!!"}; char *pats[] = {"=str", "#string", "#array", "#sexp", "#ref", "#val", "#fun"}; - char *lds [] = {"LD\t", "LDA\t", "ST\t"}; + char *lds [] = {"LD", "LDA", "ST"}; do { char x = BYTE, h = (x & 0xF0) >> 4, @@ -145,6 +147,10 @@ void disassemble (FILE *f, bytefile *bf) { fprintf (f, "SWAP"); break; + case 11: + fprintf (f, "ELEM"); + break; + default: FAIL; } @@ -166,11 +172,11 @@ void disassemble (FILE *f, bytefile *bf) { case 5: switch (l) { case 0: - fprintf (f, "CJMPz\t%0x.8x", INT); + fprintf (f, "CJMPz\t0x%.8x", INT); break; case 1: - fprintf (f, "CJMPnz\t%0x.8x", INT); + fprintf (f, "CJMPnz\t0x%.8x", INT); break; case 2: @@ -234,6 +240,34 @@ void disassemble (FILE *f, bytefile *bf) { fprintf (f, "PATT\t%s", pats[l]); break; + case 7: { + switch (l) { + case 0: + fprintf (f, "CALL\tLread"); + break; + + case 1: + fprintf (f, "CALL\tLwrite"); + break; + + case 2: + fprintf (f, "CALL\tLlength"); + break; + + case 3: + fprintf (f, "CALL\tLstring"); + break; + + case 4: + fprintf (f, "CALL\tBarray"); + break; + + default: + FAIL; + } + } + break; + default: FAIL; } diff --git a/src/SM.ml b/src/SM.ml index 1dea381ff..92ec25aee 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -24,7 +24,8 @@ let show_scope = show(scope);; (* load a variable address to the stack *) | LDA of Value.designation (* store a value into a variable *) | ST of Value.designation (* store a value into a reference *) | STI -(* store a value into array/sexp/string *) | STA +(* store a value into array/sexp/string *) | STA +(* takes an element of array/string/sexp *) | ELEM (* a label *) | LABEL of string (* a forwarded label *) | FLABEL of string (* a scope label *) | SLABEL of string @@ -48,6 +49,7 @@ let show_scope = show(scope);; (* match failure (location, leave a value *) | FAIL of Loc.t * bool (* external definition *) | EXTERN of string (* public definition *) | PUBLIC of string +(* import clause *) | IMPORT of string (* line info *) | LINE of int with show @@ -126,11 +128,13 @@ module ByteCode = let st = StringTab.create () in let lmap = Stdlib.ref M.empty in let pubs = Stdlib.ref S.empty in + let imports = Stdlib.ref S.empty in let globals = Stdlib.ref M.empty in let glob_count = Stdlib.ref 0 in let fixups = Stdlib.ref [] in let add_lab l = lmap := M.add l (Buffer.length code) !lmap in let add_public l = pubs := S.add l !pubs in + let add_import l = imports := S.add l !imports in let add_fixup l = fixups := (Buffer.length code, l) :: !fixups in let add_bytes = List.iter (fun x -> Buffer.add_char code @@ Char .chr x) in let add_ints = List.iter (fun x -> Buffer.add_int32_ne code @@ Int32.of_int x) in @@ -175,7 +179,7 @@ module ByteCode = (* 0x18 *) | DROP -> add_bytes [1*16 + 8] (* 0x19 *) | DUP -> add_bytes [1*16 + 9] (* 0x1a *) | SWAP -> add_bytes [1*16 + 10] - + (* 0x1b *) | ELEM -> add_bytes [1*16 + 11] (* 0x2d n:32 *) | LD d -> add_designations (Some 2) [d] (* 0x3d n:32 *) | LDA d -> add_designations (Some 3) [d] @@ -183,7 +187,13 @@ module ByteCode = (* 0x50 l:32 *) | CJMP ("z" , s) -> add_bytes [5*16 + 0]; add_fixup s; add_ints [0] (* 0x51 l:32 *) | CJMP ("nz", s) -> add_bytes [5*16 + 1]; add_fixup s; add_ints [0] - + + (* 0x70 *) | CALL ("Lread", _, _) -> add_bytes [7*16 + 0] + (* 0x71 *) | CALL ("Lwrite", _, _) -> add_bytes [7*16 + 1] + (* 0x72 *) | CALL ("Llength", _, _) -> add_bytes [7*16 + 2] + (* 0x72 *) | CALL ("Lstring", _, _) -> add_bytes [7*16 + 3] + (* 0x72 *) | CALL (".array", _, _) -> add_bytes [7*16 + 4] + (* 0x52 n:32 n:32 *) | BEGIN (_, a, l, [], _, _) -> add_bytes [5*16 + 2]; add_ints [a; l] (* with no closure *) (* 0x53 n:32 n:32 *) | BEGIN (_, a, l, _, _, _) -> add_bytes [5*16 + 3]; add_ints [a; l] (* with a closure *) (* 0x54 l:32 n:32 d*:32 *) | CLOSURE (s, ds) -> add_bytes [5*16 + 4]; add_fixup s; add_ints [0; List.length ds]; add_designations None ds @@ -194,9 +204,10 @@ module ByteCode = (* 0x59 n:32 n:32 *) | FAIL ((l, c), _) -> add_bytes [5*16 + 9]; add_ints [l; c] (* 0x5a n:32 *) | LINE n -> add_bytes [5*16 + 10]; add_ints [n] (* 0x6p *) | PATT p -> add_bytes [6*16 + enum(patt) p] - + | EXTERN s -> () | PUBLIC s -> add_public s + | IMPORT s -> add_import s in List.iter insn_code insns; add_bytes [255]; @@ -305,6 +316,10 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio | STRING s -> eval env (cstack, (Value.of_string @@ Bytes.of_string s)::stack, glob, loc, i, o) prg' | SEXP (s, n) -> let vs, stack' = split n stack in eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', glob, loc, i, o) prg' + + | ELEM -> let a :: b :: stack' = stack in + eval env (env#builtin ".elem" [a; b] (cstack, stack', glob, loc, i, o)) prg' + | LD x -> eval env (cstack, (match x with | Value.Global x -> glob x | Value.Local i -> loc.locals.(i) @@ -882,7 +897,7 @@ let compile cmd ((imports, infixes), p) = List.fold_left (fun (i, env, code) p -> let env, _, pcode = pattern env ldrop p in - i+1, env, ([DUP; CONST i; CALL (".elem", 2, false)] @ pcode) :: code + i+1, env, ([DUP; CONST i; ELEM (*CALL (".elem", 2, false)*) ] @ pcode) :: code ) (0, env, []) ps @@ -918,7 +933,7 @@ let compile cmd ((imports, infixes), p) = (*Printf.printf "End Bindings..\n";*) env, ([DUP] @ - List.concat (List.map (fun i -> [CONST i; CALL (".elem", 2, false)]) path) @ + List.concat (List.map (fun i -> [CONST i; ELEM (* CALL (".elem", 2, false)*)]) path) @ [ST dsg; DROP]) :: acc ) (env, []) @@ -1000,7 +1015,7 @@ let compile cmd ((imports, infixes), p) = add_code (compile_list false lsexp env xs) lsexp false [SEXP (t, List.length xs)] | Expr.Elem (a, i) -> let lelem, env = env#get_label in - add_code (compile_list false lelem env [a; i]) lelem false [CALL (".elem", 2, tail)] + add_code (compile_list false lelem env [a; i]) lelem false [ELEM (* CALL (".elem", 2, tail) *)] | Expr.Assign (Expr.Ref x, e) -> let lassn, env = env#get_label in let env , line = env#gen_line x in @@ -1119,7 +1134,7 @@ let compile cmd ((imports, infixes), p) = let code = if flag then code @ [LABEL lend] else code in let topname = cmd#topname in let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, (if topname = "main" then 2 else 0), env#nlocals, [], [], [])] @ code @ [END]] env in - let prg = [PUBLIC topname] @ env#get_decls @ List.flatten prg in + let prg = (List.map (fun i -> IMPORT i) imports) @ [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 acc2963e1..2b5418cd0 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -241,6 +241,7 @@ let compile cmd env imports code = match instr with | PUBLIC name -> env#register_public name, [] | EXTERN name -> env#register_extern name, [] + | IMPORT name -> env, [] | CLOSURE (name, closure) -> let pushr, popr = @@ -491,7 +492,9 @@ let compile cmd env imports code = | RET -> let x = env#peek in env, [Mov (x, eax); Jmp env#epilogue] - + + | ELEM -> call env ".elem" 2 false + | CALL (f, n, tail) -> call env f n tail | CALLC (n, tail) -> callc env n tail diff --git a/src/version.ml b/src/version.ml index 112274efc..430ecf5bc 100644 --- a/src/version.ml +++ b/src/version.ml @@ -1 +1 @@ -let version = "Version 1.10, 11203f3a8, Tue Aug 31 01:47:49 2021 +0300" +let version = "Version 1.10, c90a73c10, Tue Sep 28 10:39:02 2021 +0300"