Premier mail emile

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
+	
+	
+