/*
 *  Neko Compiler
 *  Copyright (c)2005 Motion-Twin
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Lesser General Public
 *  License as published by the Free Software Foundation; either
 *  version 2.1 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Lesser General Public License or the LICENSE file for more details.
 */

type opcode {
	// getters
	AccNull;
	AccTrue;
	AccFalse;
	AccThis;
	AccInt : int;
	AccStack : int;
	AccGlobal : int;
	AccEnv : int;
	AccField : string;
	AccArray;
	AccIndex : int;
	AccBuiltin : string;
	// setters
	SetStack : int;
	SetGlobal : int;
	SetEnv : int;
	SetField : string;
	SetArray;
	SetIndex : int;
	SetThis;
	// stack ops
	Push;
	Pop : int;
	Call : int;
	ObjCall : int;
	Jump : int;
	JumpIf : int;
	JumpIfNot : int;
	Trap : int;
	EndTrap;
	Ret : int;
	MakeEnv : int;
	MakeArray : int;
	// value ops
	Bool;
	IsNull;
	IsNotNull;
	Add;
	Sub;
	Mult;
	Div;
	Mod;
	Shl;
	Shr;
	UShr;
	Or;
	And;
	Xor;
	Eq;
	Neq;
	Gt;
	Gte;
	Lt;
	Lte;
	Not;
	// extra ops
	TypeOf;
	Compare;
	Hash;
	New;
	JumpTable : int;
	Apply : int;
	AccStack0;
	AccStack1;
	AccIndex0;
	AccIndex1;
	PhysCompare;
	TailCall : (int, int);	
};

type global {
	GlobalVar : string;
	GlobalFunction : (int , int);
	GlobalString : string;
	GlobalFloat : string;
	GlobalDebug : (string array, (int, int) array);
}

exception Invalid_file;

var trap_stack_delta = 6
var inull : int = neko("null")

function hash_field(s : string) : int {
	neko("$hash(s)")
}

function op_param(x) {
	match x {
	| AccInt _
	| AccStack _
	| AccGlobal _
	| AccEnv _
	| AccField _
	| AccBuiltin _
	| SetStack _
	| SetGlobal _
	| SetEnv _
	| SetField _
	| Pop _
	| Call _
	| ObjCall _
	| Jump _
	| JumpIf _
	| JumpIfNot _
	| JumpTable _
	| Trap _
	| MakeEnv _
	| MakeArray _
	| Ret _
	| AccIndex _
	| SetIndex _
	| Apply _
	| TailCall _
		-> true
	| AccNull
	| AccTrue
	| AccFalse
	| AccThis
	| AccArray
	| SetArray
	| SetThis
	| Push
	| EndTrap
	| Bool
	| Add
	| Sub
	| Mult
	| Div
	| Mod
	| Shl
	| Shr
	| UShr
	| Or
	| And
	| Xor
	| Eq
	| Neq
	| Gt
	| Gte
	| Lt
	| Lte
	| IsNull
	| IsNotNull
	| Not
	| TypeOf
	| Compare
	| Hash
	| New
	| AccStack0
	| AccStack1
	| AccIndex0
	| AccIndex1
	| PhysCompare
		-> false
	}
}

function code_tables(ops) {
	var ids = Hashtbl.create();
	Array.iter (function(x) {
		match x {
		| AccField s
		| SetField s
		| AccBuiltin s ->
			var id = hash_field s;
			try
				var f = Hashtbl.find ids id;
				if f != s then error("Field hashing conflict " + s + " and " + f);
			catch { Not_found -> Hashtbl.add ids id s }
		| _ -> ()
		}
	}) ops;
	var p = &0;
	var pos = Array.make (Array.length(ops) + 1) 0;
	Array.iteri (function(i,op) {
		pos.[i] := *p;
		p := *p + (if op_param op then 2 else 1);
	}) ops;
	pos.[Array.length ops] := *p;
	(ids , pos , *p)
}

function write_debug_infos(ch,files,inf) {
	var nfiles = Array.length files;
	// the encoding of nfiles was set to keep
	// backward compatibility with 1.3 which
	// only allowed up to 127 filenames
	var lot_of_files = &false;
	if nfiles < 0x80 then
		IO.write_byte ch nfiles
	else if nfiles < 0x8000 then {
		lot_of_files := true;
		IO.write_byte ch ((nfiles >> 8) or 0x80);
		IO.write_byte ch (nfiles and 0xFF);
	} else
		invalid_arg();
	Array.iter (function(s) { IO.write ch s; IO.write_char ch '\000' }) files;
    IO.write_i32 ch (Array.length inf);
	var curfile = &0;
	var curpos = &0;
	var rcount = &0;
	function rec flush_repeat(p) {
		if *rcount > 0 then {
			if *rcount > 15 then {
				IO.write_byte ch ((15 << 2) or 2);
				rcount := *rcount - 15;
				flush_repeat(p)
			} else {
				var delta = p - *curpos;
				var delta = (if delta > 0 && delta < 4 then delta else 0);
				IO.write_byte ch ((delta << 6) or (*rcount << 2) or 2);
				rcount := 0;
				curpos := *curpos + delta;
			}
		}
	}
	Array.iter (function((f,p)) {
		if f != *curfile then {
			flush_repeat(p);
			curfile := f;
			if *lot_of_files then {
				IO.write_byte ch ((f >> 7) or 1);
				IO.write_byte ch (f and 0xFF);
			} else
				IO.write_byte ch ((f << 1) or 1);
		}
		if p != *curpos then flush_repeat(p);
		if p == *curpos then
			rcount := *rcount + 1
		else {
			var delta = p - *curpos;
			if delta > 0 && delta < 32 then {
				IO.write_byte ch ((delta << 3) or 4)
			} else {
				IO.write_byte ch (p << 3);
				IO.write_byte ch (p >> 5);
				IO.write_byte ch (p >> 13);
			}
			curpos := p;
		}
	}) inf;
	flush_repeat(*curpos)
}

function write(ch,(globals,ops)) {
	IO.write ch "NEKO";
	var ids , pos , csize = code_tables ops;
	IO.write_i32 ch (Array.length globals);
	IO.write_i32 ch (Hashtbl.length ids);
	IO.write_i32 ch csize;
	Array.iter (function(x) {
		match x {
		| GlobalVar s -> IO.write_byte ch 1; IO.write ch s; IO.write_char ch '\000';
		| GlobalFunction (p,nargs) -> IO.write_byte ch 2; IO.write_i32 ch (pos.[p] or (nargs << 24))
		| GlobalString s -> IO.write_byte ch 3; IO.write_ui16 ch (String.length s); IO.write ch s
		| GlobalFloat s -> IO.write_byte ch 4; IO.write ch s; IO.write_char ch '\000'
		| GlobalDebug (files,inf) -> IO.write_byte ch 5; write_debug_infos ch files inf;
		}
	}) globals;
	Hashtbl.iter (function(_,s) {
		IO.write ch s;
		IO.write_char ch '\000';
	}) ids;
	Array.iteri (function(i,op) {
		var pop = &inull;
		var opid = (match op {
			| AccNull -> 0
			| AccTrue -> 1
			| AccFalse -> 2
			| AccThis -> 3
			| AccInt n -> pop := n; 4
			| AccStack n -> pop := (n - 2); 5
			| AccGlobal n -> pop := n; 6
			| AccEnv n -> pop := n; 7
			| AccField s -> pop := (hash_field s); 8
			| AccArray -> 9
			| AccIndex n -> pop := (n - 2); 10
			| AccBuiltin s -> pop := (hash_field s); 11
			| SetStack n -> pop := n; 12
			| SetGlobal n -> pop := n; 13
			| SetEnv n -> pop := n; 14
			| SetField s -> pop := (hash_field s); 15
			| SetArray -> 16
			| SetIndex n -> pop := n; 17
			| SetThis -> 18
			| Push -> 19
			| Pop n -> pop := n; 20
			| Call n -> pop := n; 21
			| ObjCall n -> pop := n; 22
			| Jump n -> pop := (pos.[i+n] - pos.[i]); 23
			| JumpIf n -> pop := (pos.[i+n] - pos.[i]); 24
			| JumpIfNot n -> pop := (pos.[i+n] - pos.[i]); 25
			| Trap n -> pop := (pos.[i+n] - pos.[i]); 26
			| EndTrap -> 27
			| Ret n -> pop := n; 28
			| MakeEnv n -> pop := n; 29
			| MakeArray n -> pop := n; 30
			| Bool -> 31
			| IsNull -> 32
			| IsNotNull -> 33
			| Add -> 34
			| Sub -> 35
			| Mult -> 36
			| Div -> 37
			| Mod -> 38
			| Shl -> 39
			| Shr -> 40
			| UShr -> 41
			| Or -> 42
			| And -> 43
			| Xor -> 44
			| Eq -> 45
			| Neq -> 46
			| Gt -> 47
			| Gte -> 48
			| Lt -> 49
			| Lte -> 50
			| Not -> 51
			| TypeOf -> 52
			| Compare -> 53
			| Hash -> 54
			| New -> 55
			| JumpTable n -> pop := n; 56
			| Apply n -> pop := n; 57
			| AccStack0 -> 58
			| AccStack1 -> 59
			| AccIndex0 -> 60
			| AccIndex1 -> 61
			| PhysCompare -> 62
			| TailCall (args,st) -> pop := (args or (st << 3)); 63
		});
		var n = *pop;
		if n == inull then
			IO.write_byte ch (opid << 2)
		else if opid < 32 && (n == 0 || n == 1) then
			IO.write_byte ch ((opid << 3) or (n << 2) or 1)
		else if n >= 0 && n <= 0xFF then {
			IO.write_byte ch ((opid << 2) or 2);
			IO.write_byte ch n;
		} else {
			IO.write_byte ch ((opid << 2) or 3);
			IO.write_i32 ch n;
		}
	}) ops
}

function read_string(ch) {
	var b = Buffer.create();
	function rec loop() {
		var c = IO.read_char ch;
		if c == '\000' then
			Buffer.string b
		else {
			Buffer.add_char b c;
			loop()
		}
	};
	loop()
}

function read_debug_infos(ch) {
	var nfiles = IO.read_byte ch;
	// see comments in read_debug_infos
	var lot_of_files = &false;
	var nfiles = if nfiles < 0x80 then 
			nfiles
		else {
			lot_of_files := true;
			var b = IO.read_byte ch;
			((nfiles and 0x7F) << 8) or b
		};
	if nfiles == 0 then invalid_arg();
	var files = Array.init nfiles (function(_) { read_string ch });
    var npos = IO.read_i32 ch;
	var curfile = &0;
	var curpos = &0;
	var pos = Array.make npos (0,0);
	function rec loop(i) {
		if i == npos then
			()
		else {
		var b = IO.read_byte ch;
		if b and 1 != 0 then {
			var file = if *lot_of_files then {
					var b2 = IO.read_byte ch;
					((b >> 1) << 8) or b2
				} else
					b >> 1;
			if file >= Array.length files then invalid_arg();
			curfile := file;
			loop(i)
		} else if b and 2 != 0 then {
			var delta = b >> 6;
			var count = (b >> 2) and 15;
			var p = &0;
			while *p < count {
				pos.[i + *p] := (*curfile,*curpos);
				p := *p + 1;
			}
			curpos := *curpos + delta;
			loop (i + count)
		} else if b and 4 != 0 then {
			curpos := *curpos + (b >> 3);
			pos.[i] := (*curfile,*curpos);
			loop (i + 1)
		} else {
			var b2 = IO.read_byte ch;
			var b3 = IO.read_byte ch;
			curpos := (b >> 3) or (b2 << 5) or (b3 << 13);
			pos.[i] := (*curfile,*curpos);
			loop (i + 1)
		}
		}
	}
	loop 0;
	(files, pos)
}

function read(ch) {
	try {
		var head = IO.read ch 4;
		if head != "NEKO" then throw Invalid_file;
		var nglobals = IO.read_i32 ch;
		var nids = IO.read_i32 ch;
		var csize = IO.read_i32 ch;
		if nglobals < 0 || nglobals > 0xFFFF || nids < 0 || nids > 0xFFFF || csize < 0 || csize > 0xFFFFFF then throw Invalid_file;
		var globals = Array.init nglobals (function(_) {
			match IO.read_byte ch {
			| 1 ->
				GlobalVar(read_string ch)
			| 2 ->
				var v = IO.read_i32 ch;
				GlobalFunction(v and 0xFFFFFF, v >> 24)
			| 3 ->
				var len = IO.read_ui16 ch;
				GlobalString(IO.read ch len)
			| 4 ->
				GlobalFloat(read_string ch)
			| 5 ->
				var files, inf = read_debug_infos ch;
				GlobalDebug files inf
			| _ ->
				throw Invalid_file
			}
		});
		var ids = Hashtbl.create();
		function rec loop(n) {
			if n == 0 then
				()
			else {
				var s = read_string ch;
				var id = hash_field s;
				try
					var s2 = Hashtbl.find ids id;
					if s != s2 then throw Invalid_file;
				catch {
					Not_found ->
						Hashtbl.add ids id s;
						loop (n-1)
				}
			}
		};
		loop nids;
		var pos = Array.make (csize+1) (-1);
		var cpos = &0;
		var jumps = &[];
		var ops = Array.create();
		while *cpos < csize {
			var code = IO.read_byte ch;
			var op , p = match code and 3 {
				| 0 -> (code >> 2 , inull)
				| 1 -> (code >> 3 , ((code >> 2) and 1))
				| 2 -> (code >> 2 , IO.read_byte ch)
				| 3 -> (code >> 2 , IO.read_i32 ch)
				| _ -> assert()
			};
			var op = match op {
				| 0 -> AccNull
				| 1 -> AccTrue
				| 2 -> AccFalse
				| 3 -> AccThis
				| 4 -> AccInt p
				| 5 -> AccStack (p + 2)
				| 6 -> AccGlobal p
				| 7 -> AccEnv p
				| 8 -> AccField (try Hashtbl.find ids p catch { Not_found -> throw Invalid_file })
				| 9 -> AccArray
				| 10 -> AccIndex (p + 2)
				| 11 -> AccBuiltin (try Hashtbl.find ids p catch { Not_found -> throw Invalid_file })
				| 12 -> SetStack p
				| 13 -> SetGlobal p
				| 14 -> SetEnv p
				| 15 -> SetField (try Hashtbl.find ids p catch { Not_found -> throw Invalid_file })
				| 16 -> SetArray
				| 17 -> SetIndex p
				| 18 -> SetThis
				| 19 -> Push
				| 20 -> Pop p
				| 21 -> Call p
				| 22 -> ObjCall p
				| 23 -> jumps := (*cpos , Array.length ops) :: *jumps; Jump p
				| 24 -> jumps := (*cpos , Array.length ops) :: *jumps; JumpIf p
				| 25 -> jumps := (*cpos , Array.length ops) :: *jumps; JumpIfNot p
				| 26 -> jumps := (*cpos , Array.length ops) :: *jumps; Trap p
				| 27 -> EndTrap
				| 28 -> Ret p
				| 29 -> MakeEnv p
				| 30 -> MakeArray p
				| 31 -> Bool
				| 32 -> IsNull
				| 33 -> IsNotNull
				| 34 -> Add
				| 35 -> Sub
				| 36 -> Mult
				| 37 -> Div
				| 38 -> Mod
				| 39 -> Shl
				| 40 -> Shr
				| 41 -> UShr
				| 42 -> Or
				| 43 -> And
				| 44 -> Xor
				| 45 -> Eq
				| 46 -> Neq
				| 47 -> Gt
				| 48 -> Gte
				| 49 -> Lt
				| 50 -> Lte
				| 51 -> Not
				| 52 -> TypeOf
				| 53 -> Compare
				| 54 -> Hash
				| 55 -> New
				| 56 -> JumpTable p
				| 57 -> Apply p
				| 58 -> AccStack0
				| 59 -> AccStack1
				| 60 -> AccIndex0
				| 61 -> AccIndex1
				| 62 -> PhysCompare
				| 63 -> TailCall (p and 7) (p >> 3)
				| _ -> throw Invalid_file
			};
			pos.[*cpos] := Array.length ops;
			cpos := *cpos + (if op_param op then 2 else 1);
			Array.add ops op;
		};
		if *cpos != csize then throw Invalid_file;
		pos.[*cpos] := Array.length ops;
		function pos_index(i,sadr) {
			var idx = pos.[sadr];
			if idx == -1 then throw Invalid_file;
			idx - i
		};
		List.iter (function((a,i)) {
			Array.set ops i (match Array.get ops i {
			| Jump p -> Jump (pos_index i (a+p))
			| JumpIf p -> JumpIf (pos_index i (a+p))
			| JumpIfNot p -> JumpIfNot (pos_index i (a+p))
			| Trap p -> Trap (pos_index i (a+p))
			| _ -> assert()
			});
		}) (*jumps);
		Array.iteri (function(i,g) {
			match g {
			| GlobalFunction(f,n) -> globals.[i] :=  GlobalFunction(pos_index 0 f,n)
			| _ -> ()
			}
		}) globals;
		(globals , ops)
	} catch {
		| IO.Eof
		| IO.Overflow _ -> throw Invalid_file
	}
}

function dump(ch,(globals,ops)) {
	var ids, pos , csize = code_tables ops;
	IO.printf ch "nglobals : %d\n" (Array.length globals);
	IO.printf ch "nfields : %d\n" (Hashtbl.length ids);
	IO.printf ch "codesize : %d ops , %d total\n" (Array.length ops,csize);
	IO.printf ch "GLOBALS =\n" ();
	var marks = Array.make csize false;
	Array.iteri (function(i,g) {
		IO.printf ch "  global %d : %s\n" (i,
			match g {
			| GlobalVar s -> "var " + String.escape s
			| GlobalFunction (p,n) ->
				if p >= 0 && p < csize then marks.[p] := true;
				"function " + string p + " nargs " + string n
			| GlobalString s -> "string \"" + String.escape s + "\""
			| GlobalFloat s -> "float " + String.escape s
			| GlobalDebug (files,inf) ->
				var ch, buf = IO.write_string();
				write_debug_infos ch files inf;
				sprintf "debug %d ops %d bytes" (Array.length inf,String.length buf())
			})
	}) globals;
	IO.printf ch "FIELDS =\n" ();
	Hashtbl.iter (function(h,f) {
		IO.printf ch "  %s%s%.8X\n" (f , if String.length(f) >= 24 then " " else String.make (24 - String.length f) ' ', h);
	}) ids;
	IO.printf ch "CODE =\n" ();
	function str(s,i) { s + " " + string i };
	var bpos = &0;
	Array.iteri (function(pos,op) {
		if marks.[pos] then IO.write_char ch '\n';
		IO.printf ch "%.6X %6d    %s\n" (*bpos , pos , match op {
			| AccInt i -> str "AccInt" i
			| AccStack i -> str "AccStack" i
			| AccGlobal i -> str "AccGlobal" i
			| AccEnv i -> str "AccEnv" i
			| AccField s -> "AccField " + s
			| AccIndex i -> str "AccIndex" i
			| AccBuiltin s -> "AccBuiltin " + s
			| SetStack i -> str "SetStack" i
			| SetGlobal i -> str "SetGlobal" i
			| SetEnv i -> str "SetEnv" i
			| SetField f -> "SetField " + f
			| SetIndex i -> str "SetIndex" i
			| Pop i -> str "Pop" i
			| Call i -> str "Call" i
			| ObjCall i -> str "ObjCall" i
			| Jump i -> str "Jump" (pos + i)
			| JumpIf i -> str "JumpIf" (pos + i)
			| JumpIfNot i -> str "JumpIfNot" (pos + i)
			| Trap i -> str "Trap" (pos + i)
			| Ret i -> str "Ret" i
			| MakeEnv i -> str "MakeEnv" i
			| MakeArray i -> str "MakeArray" i
			| JumpTable i -> str "JumpTable" i
			| Apply i -> str "Apply" i
			| _ -> string op
		});
		bpos := *bpos + if op_param op then 2 else 1;
	}) ops;
	IO.printf ch "END\n" ();
}
