Crap. Here it is.

7 files changed, 590 insertions, 0 deletions

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<Asm.reg> REG
+%token<Asm.fmt_r> ROP,RIOP
+%token<string> ID
+%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 } }
+  
+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!"
diff --git a/cpu/prog_test1.rom b/cpu/prog_test1.rom
new file mode 100644
index 0000000..9695447
--- /dev/null
+++ b/cpu/prog_test1.rom
@@ -0,0 +1,30 @@
+48 8
+10101010 11111011		# liuz SP 85
+	# init:
+00000010 01011011		# liuz B 64
+00000010 01000001		# lw B 0(B)
+00010110 11000000		# add C C B
+01111111 11101100		# incri SP -2
+00000111 11010001		# sw C 0(SP)
+01010100 10010011		# lilz A msgtick
+00000000 10001011		# liu A msgtick
+00010000 00010010		# jal ser_out_msg
+00000111 11000001		# lw C 0(SP)
+01000000 11101100		# incri SP 2
+00110111 11100010		# j init
+	# ser_out_msg:
+00000100 01001001		# lb B 0(A)
+00010100 10110011		# lilz E ser_out_msg_ret
+00000000 10101011		# liu E ser_out_msg_ret
+01000101 01001010		# jer B E Z
+10000010 11011011		# liuz C 65
+01000000 11000011		# lil C 2
+00000110 01011001		# sb B 0(C)
+01001111 11100010		# j ser_out_msg
+	# ser_out_msg_ret:
+00000000 01101010		# jr RA
+	# msgtick:
+10010110 00101010		# bytes 84 105
+11010110 11000110		# bytes 99 107
+00000000 10000100		# bytes 33 0
+