From fb4a33dfbbfd3d85e3ecee65bdee36b12c4f9937 Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Wed, 8 Jan 2014 10:38:42 +0100 Subject: Crap. Here it is. --- asm/_tags | 4 ++ asm/asm.ml | 98 +++++++++++++++++++++++++++++++++ asm/asmlex.mll | 111 +++++++++++++++++++++++++++++++++++++ asm/asmpars.mly | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ asm/assembler.ml | 158 +++++++++++++++++++++++++++++++++++++++++++++++++++++ asm/test.asm | 26 +++++++++ 6 files changed, 560 insertions(+) create mode 100644 asm/_tags create mode 100644 asm/asm.ml create mode 100644 asm/asmlex.mll create mode 100644 asm/asmpars.mly create mode 100644 asm/assembler.ml create mode 100644 asm/test.asm (limited to 'asm') diff --git a/asm/_tags b/asm/_tags new file mode 100644 index 0000000..3ed8b5a --- /dev/null +++ b/asm/_tags @@ -0,0 +1,4 @@ +true: use_menhir +<*.ml>: debug +<*.byte>: use_unix, debug + diff --git a/asm/asm.ml b/asm/asm.ml new file mode 100644 index 0000000..7df7604 --- /dev/null +++ b/asm/asm.ml @@ -0,0 +1,98 @@ +exception Asm_error of string + +type reg = int + +type imm = + | Imm of int + | Lab of string + | Labu of string + +type fmt_r = + | Add + | Sub + | Mul + | Div + | Addu + | Subu + | Mulu + | Divu + | Or + | And + | Xor + | Nor + | Lsl + | Lsr + | Asr + | Se + | Sne + | Sle + | Slt + | Sltu + | Sleu + | Jer + | Jner + | Jltr + | Jler + | Jltru + | Jleru + | Lwr + | Swr + | Lbr + | Sbr + +type instr = + | R of (fmt_r * reg * reg * reg) + | Incri of (reg * int) + | Shi of (reg * int) + | J of imm + | Jal of imm + | Jr of reg + | Jalr of reg + | Lw of (reg * reg * int) + | Sw of (reg * reg * int) + | Lb of (reg * reg * int) + | Sb of (reg * reg * int) + | Lil of (reg * imm) + | Lilz of (reg * imm) + | Liu of (reg * imm) + | Liuz of (reg * imm) + | Lra of imm + | TwoRawBytes of (int * int) + +module Imap = Map.Make(String) + +type program = { text : instr list; data : (int * bool) list; lbls : int Imap.t } + +let keywords_r = [ + "add",Add; + "sub",Sub; + "mul",Mul; + "div",Div; + "addu",Addu; + "subu",Subu; + "mulu",Mulu; + "divu",Divu; + "or",Or; + "and",And; + "xor",Xor; + "nor",Nor; + "lsl",Lsl; + "Asr",Asr; + "Lsr",Lsr; + "se",Se; + "sne",Sne; + "sle",Sle; + "slt",Slt; + "sltu",Sltu; + "sleu",Sleu; + "jer",Jer; + "jner",Jner; + "jltr",Jltr; + "jler",Jler; + "jltru",Jltru; + "jleru",Jleru; + "lwr",Lwr; + "lbr",Lbr; + "swr",Swr; + "sbr",Sbr + ] diff --git a/asm/asmlex.mll b/asm/asmlex.mll new file mode 100644 index 0000000..98caa26 --- /dev/null +++ b/asm/asmlex.mll @@ -0,0 +1,111 @@ +{ + open Asm + open Asmpars + + let keywords_ri = List.map (fun (k,o) -> (k ^ "i",o)) keywords_r + + let keywords = [ + "pop",POP; + "push",PUSH; + "incri",INCRI; + "shi",SHI; + "j",JJ; + "jal",JAL; + "jr",JR; + "jalr",JALR; + "lw",LW; + "sw",SW; + "lb",LB; + "sb",SB; + "not",NOT; + "lil",LIL; + "lilz",LILZ; + "liu",LIU; + "liuz",LIUZ; + "lra",LRA; + "la",LA; + "li",LI; + "move",MOVE; + "jz",JZ; + "jnz",JNZ; + "byte",BYTE; + "word",WORD; + "asciiz",ASCIIZ; + ] + + let regs = [ + "Z",0; + "RA",6; + "F",6; + "A",1; + "B",2; + "C",3; + "D",4; + "E",5; + "G",7; + "SP",7 + ] + + let read_16 n = + let res = ref 0 in + for i = 0 to String.length n - 1 do + res := 16 * !res; + let v = + let c = Char.code n.[i] in + if c >= Char.code '0' && c <= Char.code '9' then c - (Char.code '0') + else if c >= Char.code 'a' && c <= Char.code 'f' then c - (Char.code 'a') + else c - (Char.code 'A') in + res := !res + v + done; + !res + + let read_2 n = + let res = ref 0 in + for i = 0 to String.length n - 1 do + res := 2 * !res; + let v = Char.code n.[i] - Char.code '0' in + res := !res + v + done; + !res +} + +let digit = ['0'-'9'] +let alpha = ['a'-'z' 'A'-'Z'] +let hexdigit = ['a'-'f' 'A'-'F' '0'-'9'] + +rule token = parse + | eof { EOF } + | '#' { comment lexbuf } + | ['\t' '\r' ' '] { token lexbuf } + | ':' { COLON } + | '\n' { Lexing.new_line lexbuf; token lexbuf } + | ((['a'-'z'] | '_') (alpha | digit | '_')*) as id + { try ROP (List.assoc id keywords_r) + with Not_found -> try RIOP (List.assoc id keywords_ri) + with Not_found -> try List.assoc id keywords + with Not_found -> ID id } + | "0x" (((hexdigit)+) as n) + { INT (read_16 n) } + | (digit)+ as n { INT (int_of_string n) } + | "0b" (['0' '1']+ as n) { INT (read_2 n) } + | '"' { STR (lex_str "" lexbuf) } + | ['A'-'Z']+ as name { try REG (List.assoc name regs) with Not_found -> raise (Asm_error ("no reg " ^ name))} + | '$' (['0'-'7'] as n) { REG (Char.code n - (Char.code '0')) } + | ".text" { TEXT } + | ".data" { DATA } + | '-' { MINUS } + | '(' { LP } + | ')' { RP } + +and comment = parse + | eof { EOF } + | '\n' { Lexing.new_line lexbuf; token lexbuf } + | _ { comment lexbuf } + +and lex_str q = parse + | eof { q } + | '"' { q } + | "\\\"" { lex_str (q ^ "\"") lexbuf } + | "\\\\" { lex_str (q ^ "\\") lexbuf } + | "\\n" { lex_str (q ^ "\n") lexbuf } + | _ as c { lex_str (q ^ String.make 1 c) lexbuf } diff --git a/asm/asmpars.mly b/asm/asmpars.mly new file mode 100644 index 0000000..ebc4ae7 --- /dev/null +++ b/asm/asmpars.mly @@ -0,0 +1,163 @@ +%{ + open Asm + + let unsigned = function + | Addu + | Subu + | Mulu + | Divu + | Sltu + | Sleu + | Jltru + | Jleru + -> true + | _ -> false + + let pc = ref 0 + + let ram = ref 0x8000 + + let add r i = r := !r + i + + let lbls2 = ref (Imap.empty) + + let li u r = function + | Imm i -> + let c = + if u then i < 1 lsl 8 + else i >= -(1 lsl 7) && i < 1 lsl 7 in + if c then (add pc 2; [Lilz (r,Imm i)]) + else (add pc 4; [Lilz (r,Imm (i land 0x00FF)); Liu (r,Imm ((i land 0xFF00) lsr 8))]) + | Lab id -> + add pc 4; [Lilz (r,Lab id); Liu (r,Labu id)] + | _ -> assert false + + let up = function + | Imm i -> Imm i + | Lab l -> Labu l + | _ -> assert false + + let explode s = (* string -> char list *) + let rec exp i l = + if i < 0 then l else exp (i - 1) (s.[i] :: l) in + exp (String.length s - 1) [];; +%} + +%token EOF,COLON,TEXT,DATA,BYTE,WORD,ASCIIZ,MINUS,MOVE,JZ,JNZ,LP,RP +%token POP,PUSH,INCRI,SHI,JJ,JAL,JR,JALR,LW,SW,LB,SB,NOT,LIL,LILZ,LIU,LIUZ,LRA,LA,LI +%token REG +%token ROP,RIOP +%token ID +%token INT +%token STR + +%start program + +%% + +program: + TEXT is=instr* d=data? EOF + { { text = List.flatten is; + data = (match d with Some l -> List.flatten l | None -> []); + lbls = !lbls2 } } + +data: + DATA d=datas* { d } + +datas: + | l=label_ram d=datas { d } + | BYTE bs=int* { List.map (fun i -> add ram 1; i,false) bs } + | WORD bs=int* { List.map (fun i -> add ram 2; i,true) bs } + | ASCIIZ s=STR { + add ram 1; + List.map (fun c -> add ram 1; Char.code c, false) (explode s) @ [0, false] + } + +label_ram: + id=ID COLON { lbls2 := Imap.add id !ram !lbls2; id } +label_pc: + id=ID COLON { lbls2 := Imap.add id !pc !lbls2; id } + +instr: + | l=label_pc i=instr { i } + | i=_instr { i } + +_instr: + | o=ROP r1=REG r2=REG r3=REG { add pc 2; [R (o,r1,r2,r3)] } + | o=RIOP r1=REG r2=REG imm=imm + { let l = li (unsigned o) 5 imm in + add pc 2; l @ [R (o,r1,r2,5)] } + | INCRI r=REG i=int { + if i >= - (1 lsl 7) && i < 1 lsl 7 then + (add pc 2; [Incri (r,i)]) + else let l = li false 5 (Imm i) in + (add pc 2; l @ [R (Add,r,r,5)]) } + | SHI r=REG i=int { add pc 2; [Shi (r,i)] } + | JJ i=imm { add pc 2; [J i] } + | LI r=REG i=imm { li false r i } + | JR r=REG { add pc 2; [Jr r] } + | JAL i=imm { add pc 2; [Jal i] } + | JALR r=REG { add pc 2; [Jalr r] } + | LW r1=REG i=int LP r2=REG RP { + if i >= - (1 lsl 4) && i < 1 lsl 4 then + (add pc 2; [Lw (r1,r2,i)]) + else let l = li false 5 (Imm i) in + (add pc 2; l @ [R (Lwr,r1,r2,5)]) } + | SW r1=REG i=int LP r2=REG RP { + if i >= - (1 lsl 4) && i < 1 lsl 4 then + (add pc 2; [Sw (r1,r2,i)]) + else let l = li false 5 (Imm i) in + (add pc 2; l @ [R (Swr,r1,r2,5)]) } + | LB r1=REG i=int LP r2=REG RP { + if i >= - (1 lsl 4) && i < 1 lsl 4 then + (add pc 2; [Lb (r1,r2,i)]) + else let l = li false 5 (Imm i) in + (add pc 2; l @ [R (Lbr,r1,r2,5)]) } + | SB r1=REG i=int LP r2=REG RP { + if i >= - (1 lsl 4) && i < 1 lsl 4 then + (add pc 2; [Sb (r1,r2,i)]) + else let l = li false 5 (Imm i) in + (add pc 2; l @ [R (Sbr,r1,r2,5)]) } + | LW r1=REG l=ID { let l = li false 5 (Lab l) in + add pc 2; l @ [Lw (r1,5,0)] } + | LB r1=REG l=ID { let l = li false 5 (Lab l) in + add pc 2; l @ [Lb (r1,5,0)] } + | SW r1=REG l=ID { let l = li false 5 (Lab l) in + add pc 2; l @ [Sw (r1,5,0)] } + | SB r1=REG l=ID { let l = li false 5 (Lab l) in + add pc 2; l @ [Sb (r1,5,0)] } + | LRA i=int { assert (i > -(1 lsl 10) && i < 1 lsl 10); + add pc 2; [Lra (Imm i)] } + | LRA l=ID { add pc 2; [Lra (Lab l)] } + | LA r=REG l=ID { li false r (Lab l) } + | LIL r=REG i=int { add pc 2; [Lil (r,Imm i)] } + | LILZ r=REG i=int { add pc 2; [Lilz (r,Imm i)] } + | LIU r=REG i=int { add pc 2; [Liu (r,Imm i)] } + | LIUZ r=REG i=int { add pc 2; [Liuz (r,Imm i)] } + | MOVE r1=REG r2=REG { add pc 2; [R (Add,r1,r2,0)] } + | NOT r1=REG r2=REG { add pc 2; [R (Nor,r1,r2,0)] } + | JZ r=REG l=ID { let l = li false 5 (Lab l) in + add pc 2; l @ [R (Jer,5,r,0)] } + | JNZ r=REG l=ID { let l = li false 5 (Lab l) in + add pc 2; l @ [R (Jner,5,r,0)] } + | POP r=REG { add pc 4; [Lw (r,7,0); Incri (7,2)] } + | PUSH r=REG { add pc 4; [Incri (7,-2); Sw (r,7,0)] } + | ASCIIZ s=STR { + let bytes = List.map Char.code (explode s) @ [0] in + let rec pair = function + | a::b::q -> (a, b)::(pair q) + | [a] -> [(a, 0)] + | [] -> [] + in + let words = pair bytes in + add pc (List.length bytes); + List.map (fun (a, b) -> TwoRawBytes (a, b)) words + } + +imm: + | id=ID { Lab id } + | n=int { Imm n } + +int: + | n=INT { n } + | MINUS n=INT { - n } diff --git a/asm/assembler.ml b/asm/assembler.ml new file mode 100644 index 0000000..2c91366 --- /dev/null +++ b/asm/assembler.ml @@ -0,0 +1,158 @@ +open Asm +open Printf +open Lexing + +let init_string n f = + let res = String.make n 'a' in + for i = 0 to n - 1 do res.[i] <- f i done; res + +let bts n = init_string 8 (fun i -> + if (n lsr i) land 1 = 1 then '1' else '0') + +let wts n = + sprintf "%s %s" (bts (n land 0xFF)) (bts ((n lsr 8) land 0xFF)) + +let rev_keywords = List.map (fun (i,j) -> (j,i)) keywords_r + +let rts = function + | 0 -> "Z" + | 1 -> "A" + | 2 -> "B" + | 3 -> "C" + | 4 -> "D" + | 5 -> "E" + | 6 -> "RA" + | 7 -> "SP" + | _ -> assert false + +let byte n b = + if b >= 0 then b + else b + (1 lsl n) + +let r (o,f) r1 r2 r3 = + (o lsl 11) lxor (r1 lsl 8) lxor (r2 lsl 5) lxor (r3 lsl 2) lxor f + +let i o r d = (o lsl 11) lxor (r lsl 8) lxor ((byte 8 d) land 0xFF) + +let j o d = (o lsl 11) lxor ((byte 11 d) land 0x07FF) + +let k o r1 r2 d = (o lsl 11) lxor (r1 lsl 8) lxor (r2 lsl 5) lxor (byte 5 d) + +let code = function + | Add -> (0b00000,0) + | Sub -> (0b00000,1) + | Mul -> (0b00000,2) + | Div -> (0b00000,3) + | Addu -> (0b00001,0) + | Subu -> (0b00001,1) + | Mulu -> (0b00001,2) + | Divu -> (0b00001,3) + | Or -> (0b00010,0) + | And -> (0b00010,1) + | Xor -> (0b00010,2) + | Nor -> (0b00010,3) + | Lsl -> (0b00011,0) + | Lsr -> (0b00011,2) + | Asr -> (0b00011,3) + | Se -> (0b00100,2) + | Sne -> (0b00100,3) + | Slt -> (0b00101,0) + | Sle -> (0b00101,1) + | Sltu -> (0b00101,2) + | Sleu -> (0b00101,3) + | Jer -> (0b01010,2) + | Jner -> (0b01010,3) + | Jltr -> (0b01011,0) + | Jler -> (0b01011,1) + | Jltru -> (0b01011,2) + | Jleru -> (0b01011,3) + | Lwr -> (0b10100,0) + | Swr -> (0b10101,0) + | Lbr -> (0b10110,0) + | Sbr -> (0b10111,0) + +let its = function + | Imm i -> string_of_int i + | Lab l -> l + | Labu l -> l + +let print_program p = + let pc = ref 0 in + let value = function + | Imm i -> i + | Lab l -> Imap.find l p.lbls + | Labu l -> (Imap.find l p.lbls) lsr 8 in + let value2 = function + | Imm i -> i + | Lab l -> Imap.find l p.lbls - !pc + | _ -> assert false in + let get_reps = function + | R (o,r1,r2,r3) -> r (code o) r1 r2 r3, + sprintf "%s %s %s %s" (List.assoc o rev_keywords) (rts r1) (rts r2) (rts r3) + | Incri (r,d) -> i 0b00110 r d, sprintf "incri %s %d" (rts r) d + | Shi (r,d) -> i 0b00111 r d, sprintf "incri %s %d" (rts r) d + | J i -> let v = value2 i in j 0b01000 v, sprintf "j %s" (its i) + | Jal i -> let v = value2 i in j 0b01001 v, sprintf "jal %s" (its i) + | Jr reg -> r (0b01010,0) reg 0 0, sprintf "jr %s" (rts reg) + | Jalr reg -> r (0b01010,1) reg 0 0, sprintf "jalr %s" (rts reg) + | Lw (r1,r2,i) -> k 0b10000 r1 r2 i, sprintf "lw %s %d(%s)" (rts r1) i (rts r2) + | Sw (r1,r2,i) -> k 0b10001 r1 r2 i, sprintf "sw %s %d(%s)" (rts r1) i (rts r2) + | Lb (r1,r2,i) -> k 0b10010 r1 r2 i, sprintf "lb %s %d(%s)" (rts r1) i (rts r2) + | Sb (r1,r2,i) -> k 0b10011 r1 r2 i, sprintf "sb %s %d(%s)" (rts r1) i (rts r2) + | Lra i -> j 0b01100 (value2 i), sprintf "lra %s" (its i) + | Lil (r,i) -> (0b11000 lsl 11) lxor (r lsl 8) lxor (value i land 0xFF), + sprintf "lil %s %s" (rts r) (its i) + | Lilz (r,i) -> (0b11001 lsl 11) lxor (r lsl 8) lxor (value i land 0xFF), + sprintf "lilz %s %s" (rts r) (its i) + | Liu (r,i) -> (0b11010 lsl 11) lxor (r lsl 8) lxor (value i land 0xFF), + sprintf "liu %s %s" (rts r) (its i) + | Liuz (r,i) -> (0b11011 lsl 11) lxor (r lsl 8) lxor (value i land 0xFF), + sprintf "liuz %s %s" (rts r) (its i) + | TwoRawBytes(a, b) -> (a lsl 8) lxor b, sprintf "bytes %d %d" a b + in + let n = List.length p.text in + let rev_lbls = Array.make n "" in + Imap.iter (fun l v -> + if v/2 < n then rev_lbls.(v/2) <- rev_lbls.(v/2) ^ " " ^ l) p.lbls; + let f instr = + if rev_lbls.(!pc/2) <> "" then + printf "\t#%s:\n" rev_lbls.(!pc/2); + let w,s = get_reps instr in + printf "%s\t\t# %s\n" (wts w) s; + pc := !pc + 2 in + printf "%d %d\n" (2*n) 8; + List.iter f p.text; + let n2 = List.fold_left (fun n (_,w) -> if w then n + 2 else n + 1) 0 p.data in + if n2 > 0 then ( + printf "\n%d %d\n" n2 8; + let f2 = function + | (b,true) -> + printf "%s\n" (wts (byte 16 b)) + | (b,false)-> + printf "%s\n" (bts (byte 8 b)) in + List.iter f2 p.data + ); + printf "\n" + +let print_error e sp ep = + eprintf "File \"%s\", line %d, characters %d-%d:\n%s\n" + Sys.argv.(1) sp.pos_lnum (sp.pos_cnum - sp.pos_bol) + (ep.pos_cnum - sp.pos_bol) e + +let () = + let ic = open_in Sys.argv.(1) in + let lexbuf = Lexing.from_channel ic in + let p = try Asmpars.program Asmlex.token lexbuf + with Asmpars.Error -> + print_error "Parser error" lexbuf.lex_start_p lexbuf.lex_curr_p; + close_in ic; + exit 1 + | Failure "lexing: empty token" -> + print_error "Lexer error" lexbuf.lex_start_p lexbuf.lex_curr_p; + close_in ic; + exit 1 in + close_in ic; + print_program p + + + diff --git a/asm/test.asm b/asm/test.asm new file mode 100644 index 0000000..2597f1f --- /dev/null +++ b/asm/test.asm @@ -0,0 +1,26 @@ +.text + liuz SP 0xFF + add D Z Z +init: + liuz B 0x40 + lw B 0(B) + add D D B + push D + la A msgtick + jal ser_out_msg + pop D + j init + +ser_out_msg: + lb B 0(A) + jz B ser_out_msg_ret + liuz C 0x41 + lil C 0x02 + sb B 0(C) + incri A 1 + j ser_out_msg +ser_out_msg_ret: + jr RA + +msgtick: + asciiz "Tick!" -- cgit v1.2.3