Merge branch 'emile'

Conflicts:
	asm/asm.ml
	asm/asmlex.mll
	asm/asmpars.mly

5 files changed, 166 insertions, 162 deletions

diff --git a/asm/asm.ml b/asm/asm.ml
index d3a488b..71b73a8 100644
--- a/asm/asm.ml
+++ b/asm/asm.ml
@@ -56,11 +56,13 @@ type instr =
 	| Liu of (reg * imm)
 	| Liuz of (reg * imm)
 	| Lra of imm
-    | TwoRawBytes of (int * int)
+	| Byte of int
+	| Word of int
+	| Hlt
 
 module Imap = Map.Make(String)
 
-type program = { text : instr list; data : (int * bool) list;
+type program = { text : instr list;
 	lbls : (int * bool) Imap.t }
 
 let keywords_r = [
@@ -96,3 +98,5 @@ let keywords_r = [
 		"swr",Swr;
 		"sbr",Sbr
 	]
+	
+exception Lexer_error
diff --git a/asm/asmlex.mll b/asm/asmlex.mll
index 22f77d7..7be493e 100644
--- a/asm/asmlex.mll
+++ b/asm/asmlex.mll
@@ -27,12 +27,13 @@
 		"move",MOVE;
 		"jz",JZ;
 		"jnz",JNZ;
-        "asciiz",ASCIIZ;
 		"_clock",INT 0x4000;
 		"_input",INT 0x4100;
 		"_output",INT 0x4102;
 		"word",WORD;
-		"byte",BYTE
+		"byte",BYTE;
+		"hlt",HLT;
+		"ascii",ASCII
 	]
 	
 	let regs = [
@@ -48,15 +49,19 @@
 		"SP",7
 	]
 	
+	let vald d = Char.code d - (Char.code '0')
+	
+	let valh d =
+		let c = Char.code d 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') + 10
+		else c - (Char.code 'A') + 10
+	
 	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') + 10
-				else c - (Char.code 'A') + 10 in
+			let v = valh n.[i] in
 			res := !res + v
 		done;
 		!res
@@ -69,6 +74,7 @@
 			res := !res + v
 		done;
 		!res
+
 }
 
 let digit = ['0'-'9']
@@ -90,7 +96,6 @@ rule token = parse
 		{ 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 }
@@ -98,16 +103,28 @@ rule token = parse
 	| '-' { MINUS }
 	| '(' { LP }
 	| ')' { RP }
+	| '"' { str [] lexbuf }
+
+and str acc = parse
+	| "\\\\" { str ('\\' :: acc) lexbuf }
+	| '"' { STR (List.rev ('\000' :: acc)) }
+	| "\\t" { str ('\t' :: acc) lexbuf }
+	| "\\n" { str ('\n' :: acc) lexbuf }
+	| "\\r" { str ('\r' :: acc) lexbuf }
+	| "\\\"" { str ('"' :: acc) lexbuf }
+	| "\\a"  { str ((Char.chr 7) :: acc) lexbuf }
+	| '\\' (digit as d1) (digit as d2) (digit as d3)
+		{ let c = 100 * (vald d1) + 10 * (vald d2) + (vald d3) in
+			str ((Char.chr c) :: acc) lexbuf }
+	| "\\x" (hexdigit as h1) (hexdigit as h2)
+		{ let c = 16 * (valh h1) + (valh h2) in
+			str ((Char.chr c)::acc) lexbuf }
+	| eof { raise Lexer_error }
+	| '\n' { raise Lexer_error }
+	| [^ '\\' '"' '\n'] as c { str (c::acc) lexbuf }
 
 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
index d15c8af..4850c55 100644
--- a/asm/asmpars.mly
+++ b/asm/asmpars.mly
@@ -1,68 +1,63 @@
 %{
-  open Asm
-  
-  let unsigned = function
-    | Addu
-    | Subu
-    | Mulu
-    | Divu
-    | Sltu
-    | Sleu
-    | Jltru
-    | Jleru
-      -> true
-    | _ -> false
-      
-  let pc = ref 0
-  
-  let ram = ref 0
-  
-  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,Lab id)]
-    
-  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) [];;
+	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,Lab id)]
+	
 %}
 
-%token EOF,COLON,TEXT,DATA,BYTE,WORD,ASCIIZ,MINUS,MOVE,JZ,JNZ,LP,RP
+%token EOF,COLON,TEXT,DATA,BYTE,WORD,MINUS,MOVE,JZ,JNZ,LP,RP,HLT,ASCII
 %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<char list> STR
 %token<int> INT
-%token<string> STR
 
 %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 } }
-  
+	TEXT is=instr* data? EOF
+	{ { text = List.flatten is;
+		lbls = !lbls2 } }
+	
 data:
   DATA d=datas* { d }
   
 datas:
-  | labeld 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 }
-  
+	| labeld datas { () }
+	| BYTE n=INT { add ram n }
+	| WORD n=INT { add ram (2*n) }
+	
 labeli:
   id=ID COLON { lbls2 := Imap.add id (!pc,true) !lbls2 }
 
@@ -74,76 +69,69 @@ instr:
   | 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,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
-  }
-  
+	| 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,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)] }
+	| BYTE bs=int* { List.map (fun b -> add pc 1; Byte b) bs }
+	| WORD ws=int* { List.map (fun w -> add pc 2; Word w) ws }
+	| HLT { add pc 2; [Hlt] }
+	| ASCII s=STR { List.map (fun c -> add pc 1; Byte (Char.code c)) s }
+	
 imm:
   | id=ID { Lab id }
   | n=int { Imm n }
diff --git a/asm/assembler.ml b/asm/assembler.ml
index 48049ef..66999fb 100644
--- a/asm/assembler.ml
+++ b/asm/assembler.ml
@@ -75,6 +75,10 @@ let its = function
 	| Imm i -> string_of_int i
 	| Lab l -> l
 
+let size = function
+	| Byte _ -> 1
+	| _ -> 2
+
 let print_program p =
 	let pc = ref 0 in
 	let value = function
@@ -87,7 +91,6 @@ let print_program p =
 		| Imm i -> i
 		| Lab l -> (byte 16 (fst (Imap.find l p.lbls))) lsr 8 in
 	let get_reps = function
-        | TwoRawBytes(a, b) -> (a) lxor (b lsl 8), sprintf "bytes %d %d" a b
 		| 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
@@ -108,37 +111,29 @@ let print_program p =
 		| Liu (r,i) -> (0b11010 lsl 11) lxor (r lsl 8) lxor ((byte 8 (value3 i)) land 0xFF),
 			sprintf "liu %s %s" (rts r) (its i)
 		| Liuz (r,i) -> (0b11011 lsl 11) lxor (r lsl 8) lxor ((byte 8 (value3 i)) land 0xFF),
-			sprintf "liuz %s %s" (rts r) (its i) in
-	let n = List.length p.text in
+			sprintf "liuz %s %s" (rts r) (its i)
+		| Hlt -> (0b01111 lsl 11),"hlt"
+		| Word w -> (byte 16 w), ""
+		| Byte b -> byte 8 b, ""  in
+	let n = List.fold_left (fun n i -> size i + n) 0 p.text in
 	let rev_lbls = Array.make n "" in
 	Imap.iter (fun l (v,t) ->
-		if t then rev_lbls.(v/2) <- rev_lbls.(v/2) ^ " " ^ l) p.lbls;
+		if t then rev_lbls.(v) <- rev_lbls.(v) ^ " " ^ l) p.lbls;
 	let f instr =
-		if rev_lbls.(!pc/2) <> "" then
-			printf "\t#%s:\n" rev_lbls.(!pc/2);
+		if rev_lbls.(!pc) <> "" then
+			printf "\t#%s:\n" rev_lbls.(!pc);
 		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;
+		let size = size instr in
+		if size = 2 then (
+			printf "%s" (wts w);
+			if s <> "" then 
+				printf "\t\t# %s\n" s
+			else printf "\n";
+			pc := !pc + 2
+		) else (
+			printf "%s\n" (bts w) ) in
+	printf "%d %d\n" (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 rev_lbls = Array.make n2 "" in
-		Imap.iter (fun l (v,t) ->
-			if not t then rev_lbls.(v) <- rev_lbls.(v) ^ " " ^ l) p.lbls;
-		pc := 0;
-		let f2 (b,w) =
-			if rev_lbls.(!pc) <> "" then
-				printf "\t#%s:\n" rev_lbls.(!pc);
-			if w then (
-				printf "%s\n" (wts (byte 16 b));
-				pc := !pc + 2
-			) else (
-				printf "%s\n" (bts (byte 8 b));
-				pc := !pc + 1) in
-		List.iter f2 p.data
-	);
 	printf "\n"
 		
 let print_error e sp ep =
diff --git a/asm/test.asm b/asm/test.asm
index 2a9dd80..4c3369f 100644
--- a/asm/test.asm
+++ b/asm/test.asm
@@ -23,4 +23,4 @@ ser_out_msg_ret:
     jr RA
 
 msgtick:
-    asciiz "Tick!"
+    ascii "Tick!"