summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--asm/asm.ml95
-rw-r--r--asm/asmlex.mll98
-rw-r--r--asm/asmpars.mly139
-rw-r--r--asm/assembler.ml156
4 files changed, 488 insertions, 0 deletions
diff --git a/asm/asm.ml b/asm/asm.ml
new file mode 100644
index 0000000..5a3a96b
--- /dev/null
+++ b/asm/asm.ml
@@ -0,0 +1,95 @@
+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
+
+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..4d78e87
--- /dev/null
+++ b/asm/asmlex.mll
@@ -0,0 +1,98 @@
+{
+ 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;
+ "li",LI;
+ "move",MOVE;
+ "jz",JZ;
+ "jnz",JNZ
+ ]
+
+ 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) }
+ | ['A'-'Z']+ as name { REG (List.assoc name regs) }
+ | '$' (['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 }
diff --git a/asm/asmpars.mly b/asm/asmpars.mly
new file mode 100644
index 0000000..c8f3944
--- /dev/null
+++ b/asm/asmpars.mly
@@ -0,0 +1,139 @@
+%{
+ 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
+%}
+
+%token EOF,COLON,TEXT,DATA,BYTE,WORD,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,LI
+%token<Asm.reg> REG
+%token<Asm.fmt_r> ROP,RIOP
+%token<string> ID
+%token<int> INT
+
+%start<Asm.program> 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 d=datas { lbls2 := Imap.add l !ram !lbls2; 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 }
+
+label:
+ id=ID COLON { id }
+
+instr:
+ | l=label i=instr { lbls2 := Imap.add l !pc !lbls2; 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)] }
+ | 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,r,5,0)] }
+ | JNZ r=REG l=ID { let l = li false 5 (Lab l) in
+ add pc 2; l @ [R (Jner,r,5,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)] }
+
+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..93e1067
--- /dev/null
+++ b/asm/assembler.ml
@@ -0,0 +1,156 @@
+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 %s %d" (rts r1) (rts r2) i
+ | Sw (r1,r2,i) -> k 0b10001 r1 r2 i, sprintf "sw %s %s %d" (rts r1) (rts r2) i
+ | Lb (r1,r2,i) -> k 0b10010 r1 r2 i, sprintf "lb %s %s %d" (rts r1) (rts r2) i
+ | Sb (r1,r2,i) -> k 0b10011 r1 r2 i, sprintf "sb %s %s %d" (rts r1) (rts r2) i
+ | 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) 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
+
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 18:12:02 +0000