CLANNADFVProgress

CLANNAD FV Progress

OCaml debugging

I have added debugging features to the 1.41 SVN version of kprl. This can be turned on and off by a flag at the top of the file (called debug). I have also found the XOR-key for CLANNAD FV which is 0xAF2FFB6BAF3077178748FE2C681AB9F0. In order to disassemble make sure to specify the version, 1.5.0.4. Example:

kprl.exe --target-version=1.5.0.4 -u -e utf-8 -d SEEN.txt

Patch for both is below:

Patch

diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/OMakefile
--- a/src/OMakefile	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/OMakefile	Thu Jun 12 00:10:13 2008 -0700
@@ -21,6 +21,7 @@
 USE_OCAMLFIND = true
 
 if $(defined-env DEBUG)
+  echo "Debug mode"
   NATIVE_ENABLED = false
   BYTE_ENABLED = true
   OCAMLFLAGS += -g -custom
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/common/lz_comp_rl.cpp
--- a/src/common/lz_comp_rl.cpp	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/common/lz_comp_rl.cpp	Thu Jun 12 00:10:13 2008 -0700
@@ -1,3 +1,4 @@
+
 /*
    Kprl: RealLive compressor.
    Copyright (C) 2006 Haeleth
@@ -19,6 +20,7 @@
 */
 
 #include "lzcomp.h"
+#include "stdio.h"
 extern "C" {
 #include "rldev.h"
     
@@ -51,10 +53,14 @@
 
 /* In some new titles, a second round of XORing is performed on a
  * block of uncompressed bytecode, using the following 16-byte key: */
-static uchar xor_mask_2[] = {
+/*static uchar xor_mask_2[] = {
     0xa8, 0x28, 0xfd, 0x66, 0xa0, 0x23, 0x77, 0x69, 0xf9, 0x45, 0xf8, 0x2c,
     0x7c, 0x00, 0xad, 0xf4
-};
+};*/
+// static uchar xor_mask_2[] = {
+    // 0xAF, 0x2F, 0xFB, 0x6B, 0xAF, 0x30, 0x77, 0x17, 0x87, 0x48, 0xFE, 0x2C, 
+	// 0x68, 0x1A, 0xB9, 0xF0
+// };
 
 /* Decrypt an "encrypted" file */
 value rl_prim_apply_mask (value array, value origin)
@@ -68,9 +74,11 @@
 }
 
 /* Decompress an archived file. */
-value rl_prim_decompress (value src_in, value dst_in, value use_xor_2)
+value rl_prim_decompress (value src_in, value dst_in, value use_xor_2, value key)
 {
-    CAMLparam3(src_in, dst_in, use_xor_2);
+    CAMLparam4(src_in, dst_in, use_xor_2, key);
+	
+	uchar *xor_mask_2 = Binarray_val(key);
     int bit = 1;
     uchar *src = Binarray_val(src_in);
     uchar *dststart = Binarray_val(dst_in);
@@ -104,24 +112,37 @@
         bit <<= 1;
     }
     if (Bool_val(use_xor_2)) {
-	dst = dststart + 256;
-	for (int i = 0; i < 257; ++i) *dst++ ^= xor_mask_2[i % 16];
+		dst = dststart + 256;
+		for (int i = 0; i < 257; ++i) {	
+			*dst++ ^= xor_mask_2[i % 16];
+		}
     }
     CAMLreturn(Val_unit);
 }
 
-value rl_prim_compress (value arr)
+value rl_prim_compress (value src_in, value use_xor_2, value key)
 {
-    // TODO: does NOT handle cases where xor_mask_2 is needed!
-    CAMLparam1(arr);
     using namespace AVG32Comp;
+    CAMLparam3(src_in, use_xor_2, key);
+
+	uchar *xor_mask_2 = Binarray_val(key);
+    uchar *src = Binarray_val(src_in);
+    uchar *srcstart = src;
+    uchar *srcend = src + Bigarray_val(src_in)->dim[0];
+	
+    if (Bool_val(use_xor_2)) {
+		src = srcstart + 256;
+		for (int i = 0; i < 257; ++i) {	
+			*src++ ^= xor_mask_2[i % 16];
+		}
+    }
+	
     Compress<CInfoRealLive, Container::RLDataContainer> cmp;
-    char *data = (char*) Data_bigarray_val(arr);
-    cmp.WriteData (data, Bigarray_val(arr)->dim[0]);
+    cmp.WriteData ((char *)srcstart, Bigarray_val(src_in)->dim[0]);
     cmp.WriteDataEnd();
     cmp.Deflate();
     cmp.Flush();
-    memmove (data, cmp.Data(), cmp.Length());
+    memmove (srcstart, cmp.Data(), cmp.Length());
     CAMLreturn(Val_long(cmp.Length()));
 }
 
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/common/optpp.ml
--- a/src/common/optpp.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/common/optpp.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -123,10 +123,31 @@
   flush stderr;
   Format.set_formatter_out_channel stdout
 
+exception Error of string
+let abort s = raise (Error s)
+
+exception Trace of string * int
+
+let startTrace s =
+	raise (Trace ((sprintf "%s\nStack Trace:" s), 0))
+	
+let contTrace s n sn =
+	let rec gen_space n =
+		match n with
+			| 0 -> ""
+			| _ -> "   " ^ gen_space (n-1) in			
+	raise (Trace ( (s ^ (sprintf "\n") ^ gen_space(n) ^ sn), n+1))
+	
+let printTrace s n =
+  Format.set_formatter_out_channel stderr;
+  cliInfo (sprintf "%s\n%d levels traced" s n)
+
+let cliErrorDisp s =
+  Format.set_formatter_out_channel stderr;
+  cliInfo s
+
 let cliError s =
-  Format.set_formatter_out_channel stderr;
-  cliInfo s;
-  exit 2
+  abort s
 
 let usageError ?(app = default_app_info) s =
   ksprintf cliError "Error: %s.\nFor basic usage information run `%s --help'" s app.exe_name
@@ -136,8 +157,6 @@
 let sysError s = ksprintf cliError "Error: %s." s
 
 
-exception Error of string
-let abort s = raise (Error s)
 
 let noshort = '\000'
 let nolong  = ""
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/common/optpp.mli
--- a/src/common/optpp.mli	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/common/optpp.mli	Thu Jun 12 00:10:13 2008 -0700
@@ -65,6 +65,11 @@
 (* Option parsing *)
 
 exception Error of string
+exception Trace of string * int
+
+val startTrace : string -> 'a
+val contTrace : string -> int -> string -> 'a
+val printTrace : string -> int -> unit
 
 val display_version : app_info -> unit
 val display_help : app_info -> opt_srcp list -> 'a
@@ -80,6 +85,7 @@
 
 val cliWarning : string -> unit
 val cliError : string -> 'a
+val cliErrorDisp : string -> unit
 
 val sysInfo : string -> unit
 val sysWarning : string -> unit
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/common/rlcmp.ml
--- a/src/common/rlcmp.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/common/rlcmp.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -24,10 +24,31 @@
 
 
 (* Stubs for routines in C. *)
-external c_decompress: Binarray.t -> Binarray.t -> bool -> unit =
+external c_decompress: Binarray.t -> Binarray.t -> bool -> Binarray.t -> unit =
                        "rl_prim_decompress"
 external c_apply_mask: Binarray.t -> int -> unit = "rl_prim_apply_mask"
-external c_compress: Binarray.t -> int = "rl_prim_compress"
+external c_compress: Binarray.t -> bool -> Binarray.t -> int = "rl_prim_compress"
+
+let key = ref [|0xAF ; 0x2F ; 0xFB ; 0x6B ; 0xAF ; 0x30 ; 0x77 ; 0x17 ; 0x87 ; 0x48 ; 0xFE ; 0x2C ; 0x68 ; 0x1A ; 0xB9 ; 0xF0|]
+
+let set_key verbose s1 =
+	if not ((String.length s1) = 32) then Optpp.usageError "key must be 32 characters";
+	let rec loop s n = 
+		match String.length s with
+			| 0 -> ()
+			| _ -> Array.set !key n (int_of_string ("0x" ^ (String.sub s 0 2)));
+			if verbose() then
+				printf "0x%02X " (Array.get !key n);
+			loop (String.sub s 2 ((String.length s) - 2)) (n+1) in
+			
+			if verbose() then
+				printf "  Key set to: ";
+			loop s1 0;
+			if verbose() then
+				printf "\n%!"
+
+let prep_key () =
+	Bigarray.Array1.of_array Bigarray.int8_unsigned Bigarray.c_layout !key
 
 
 (* Return an equivalent to a bytecode file with decompressed and decrypted
@@ -39,9 +60,9 @@
     | None -> arr
     | Some i -> let rv = create (hdr.data_offset + hdr.uncompressed_size) in
                 blit (sub arr 0 hdr.data_offset) (sub rv 0 hdr.data_offset);
-                c_decompress (sub arr hdr.data_offset i)
+                (c_decompress (sub arr hdr.data_offset i)
 		  (sub rv hdr.data_offset hdr.uncompressed_size)
-		  (hdr.compiler_version == 110002);
+		  (hdr.compiler_version == 110002) (prep_key()));
                 rv
 
 
@@ -60,7 +81,7 @@
     let buffer = create ((dim arr - data_offset) * 9 / 8 + 9) in
     let to_compress = sub buffer 8 (dim arr - data_offset) in
     blit (sub arr (data_offset - 8) (dim arr - data_offset + 8)) (sub buffer 0 (dim arr - data_offset + 8));
-    let compressed_size = c_compress to_compress + 8 in
+    let compressed_size = (c_compress to_compress (hdr.compiler_version == 110002) (prep_key())) + 8 in
     let rv = create (data_offset + compressed_size) in
     blit (sub arr 0 data_offset) (sub rv 0 data_offset);
     put_int buffer ~idx:0 compressed_size;
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/kprl/app.ml
--- a/src/kprl/app.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/kprl/app.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -35,7 +35,7 @@
        be processed (e.g. `50 60 100-150'); if omitted, all files in the archive \
        will be processed." }
 
-let verbose = ref false
+let verbose = ref 0
 let outdir = ref ""
 let names_opt = ref false
 let enc = ref Config.default_encoding
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/kprl/archiver.ml
--- a/src/kprl/archiver.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/kprl/archiver.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -122,7 +122,7 @@
     maybe_archive
       (fun fname arr ->
         let _, oarr = try_extract (fun () -> ()) arr in
-        if !App.verbose then ksprintf sysInfo "Disassembling %s" fname;
+        if !App.verbose > 0 then ksprintf sysInfo "Disassembling %s" fname;
         Disassembler.disassemble fname oarr)
       files
 
@@ -136,7 +136,7 @@
       let processed, oarr =
         try_extract
 	  (fun () ->
-	     if !App.verbose
+	     if !App.verbose > 0
 	     then ksprintf sysInfo "Decompressing %s to %s" fname oname) 
 	  arr
       in
@@ -166,7 +166,7 @@
   process_read
     (fun idx arr ->
       let fname = sprintf "SEEN%04d.TXT" idx in
-      if !App.verbose then ksprintf sysInfo "Extracting %s" fname;
+      if !App.verbose > 0 then ksprintf sysInfo "Extracting %s" fname;
       write_file arr (Filename.concat !App.outdir (Filename.basename fname)))
 
 let list =
@@ -210,7 +210,7 @@
             else Filename.basename fname)
         in
         try
-          if !App.verbose then ksprintf sysInfo "Compressing %s to %s" fname oname;
+          if !App.verbose > 0 then ksprintf sysInfo "Compressing %s to %s" fname oname;
           write_file (Rlcmp.compress arr) oname
         with
           Failure e ->
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/kprl/disassembler.ml
--- a/src/kprl/disassembler.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/kprl/disassembler.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -22,6 +22,9 @@
 open ExtString
 open Ulexing
 open KfnTypes
+
+let debug = 
+	(fun () -> !App.verbose)
 
 (* The actual ISet module appears to have issues. :/ *)
 module ISet = Set.Make (struct type t = int;; let compare = compare end)
@@ -309,11 +312,34 @@
 let regexp sjs2 = ['\x40'-'\x7e' '\x80'-'\xfc']
 
 (* Lexer utility functions *)
+   
+let printbytes lexbuf n1 =
+	if n1 < 0 then ""
+	else
+		let rec readbytes_h n = (
+			match n with
+				| 0 -> ""
+				| _ -> let f = (lexer
+							| eof -> " eof"
+							| _ -> (let c = (lexeme_char lexbuf 0) in
+									let s = sprintf "0x%02x " c ^ readbytes_h (n - 1) in
+									rollback lexbuf;
+									s)) in
+							f lexbuf) in
+		readbytes_h n1
+		
 
 let error lexbuf s =
-  ksprintf sysError "%s near 0x%06x" (Text.sjs_to_err s) (lexeme_start lexbuf + !data_offset)
+	try
+		ksprintf sysError "%s near 0x%06x" (Text.sjs_to_err s) (lexeme_start lexbuf + !data_offset)
+	with
+		| Optpp.Error s ->
+			if debug() > 0 then
+				ksprintf Optpp.cliError "%s\nNext 100 bytes:\n%s" s (printbytes lexbuf 100)
+			else
+				ksprintf Optpp.cliError "%s" s
 
-and warning lexbuf s =
+let warning lexbuf s =
   ksprintf sysWarning "%s near 0x%06x" (Text.sjs_to_err s) (lexeme_start lexbuf + !data_offset)
 
 let get_int32 = lexer _ _ _ _ ->
@@ -358,8 +384,15 @@
 
 (* Expressions. *)
 
-let variable_name lexbuf =
-  function
+let dp s = 
+	if debug() > 1 then printf "%s%!" s
+
+let pns s = 
+	dp (sprintf "%s\n" s);
+	s
+	
+let variable_name lexbuf c =
+	let decode =  function
     | 0x0a -> Config.svar_prefix ^ "K"   | 0x0b -> Config.ivar_prefix ^ "L"
     | 0x0c -> Config.svar_prefix ^ "M"   | 0x12 -> Config.svar_prefix ^ "S"
     | 0x00 -> Config.ivar_prefix ^ "A"   | 0x01 -> Config.ivar_prefix ^ "B"
@@ -383,37 +416,57 @@
     | 0x6c -> Config.ivar_prefix ^ "E8b" | 0x6d -> Config.ivar_prefix ^ "F8b"
     | 0x6e -> Config.ivar_prefix ^ "G8b" | 0x81 -> Config.ivar_prefix ^ "Z8b"
     | i -> ksprintf (warning lexbuf) "unrecognised variable index 0x%02x in variable_name" i;
-           sprintf "VAR%02x" i
+           sprintf "VAR%02x" i in
+	pns (decode c)
 
+				(*  1    2    3    4    5    6    7    8     9   10    11 *)
 let op_string = [| "+"; "-"; "*"; "/"; "%"; "&"; "|"; "^"; "<<"; ">>"; "" |]
+
 
 
 (* Kepago operator precedences differ from those used internally by RealLive, so 
    we use a recursive-descent parser to build expression trees (get_expr_*
    functions) and flatten that with appropriate parentheses in get_expression. *)
 
-let rec get_expr_token =
-  lexer
+let rec get_expr_token lexbuf =
+  let f = lexer
     | 0xff -> Int32.to_string (get_int32 lexbuf)
     | 0xc8 -> "store"
     | [^ 0xc8 0xff] '['
       -> let i = variable_name lexbuf (lexeme_char lexbuf 0) in
-         let e = get_expression lexbuf in
-         expect lexbuf ']' "get_expr_token";
-         sprintf "%s[%s]" i e
+		let e = get_expression lexbuf in
+			(try 
+				expect lexbuf ']' "get_expr_token";
+				sprintf "%s[%s]" i e
+			with
+				| Optpp.Error s -> ksprintf Optpp.startTrace "%s\nExpression so far:\n%s[%s]\n"	s i e)
     | eof -> error lexbuf "unexpected end of file in get_expr_token"
-    | _ -> ksprintf (error lexbuf) "unknown token type 0x%02x in get_expr_token" (lexeme_char lexbuf 0)
+    | _ -> ksprintf (error lexbuf) "unknown token type 0x%02x in get_expr_token" (lexeme_char lexbuf 0) in
+	try
+		f lexbuf
+	with
+		| Optpp.Trace (s, n)  -> Optpp.contTrace s n "get_expr_token"
 
-and get_expr_term =
-  lexer
-    | "$" -> `Atom (get_expr_token lexbuf)
-    | "\\\000" -> (* Unary plus?  We ignore it, anyway. *) get_expr_term lexbuf
-    | "\\\001" -> `Minus (get_expr_term lexbuf)
-    | "(" -> let c = get_expr_bool lexbuf in
-             expect lexbuf ')' "get_expr_term";
-             c
-    | eof -> error lexbuf "unexpected end of file in get_expr_term"
-    | _ -> ksprintf (error lexbuf) "expected [$\\(] in get_expr_term, found 0x%02x" (lexeme_char lexbuf 0)
+and get_expr_term lexbuf =
+	let f = lexer
+	    | "$" -> `Atom (get_expr_token lexbuf)
+	    | "\\\000" -> (* Unary plus?  We ignore it, anyway. *) get_expr_term lexbuf
+	    | "\\\001" -> `Minus (get_expr_term lexbuf)
+	    | "(" -> let c = get_expr_bool lexbuf in
+			(try 
+				expect lexbuf ')' "get_expr_term";
+				c
+			with
+				| Optpp.Error s -> ksprintf Optpp.startTrace "%s" s)
+	    | eof -> error lexbuf "unexpected end of file in get_expr_term"
+	    | _ -> (try
+					ksprintf (error lexbuf) "expected [$\\(] in get_expr_term, found 0x%02x" (lexeme_char lexbuf 0)
+				with
+					| Optpp.Error s -> ksprintf Optpp.startTrace "%s" s) in
+		try
+			f lexbuf
+		with
+			| Optpp.Trace (s, n)  -> Optpp.contTrace s n "get_expr_term"
 
 and get_expr_arith lexbuf =
   let rec loop_hi_prec tok =
@@ -435,7 +488,10 @@
       | _ -> rollback lexbuf;
              tok
   in
-  loop (loop_hi_prec (get_expr_term lexbuf) lexbuf) lexbuf
+	try
+		loop (loop_hi_prec (get_expr_term lexbuf) lexbuf) lexbuf
+	with
+		| Optpp.Trace (s, n)  -> Optpp.contTrace s n "get_expr_arith"
 
 and get_expr_cond lexbuf =
   let rec loop tok =
@@ -448,7 +504,10 @@
       | _ -> rollback lexbuf;
              tok
   in
-  loop (get_expr_arith lexbuf) lexbuf
+	try
+		loop (get_expr_arith lexbuf) lexbuf
+	with
+		| Optpp.Trace (s, n)  -> Optpp.contTrace s n "get_expr_cond"
 
 and get_expr_bool lexbuf =
   let rec loop_and tok =
@@ -458,7 +517,11 @@
     lexer "\\=" -> loop_or (`Binary (tok, 0x3d, loop_and (get_expr_cond lexbuf) lexbuf)) lexbuf
       | eof | _ -> rollback lexbuf; tok
   in
-  loop_or (loop_and (get_expr_cond lexbuf) lexbuf) lexbuf
+	try
+		loop_or (loop_and (get_expr_cond lexbuf) lexbuf) lexbuf
+	with
+		| Optpp.Trace (s, n)  -> Optpp.contTrace s n "get_expr_bool"
+	
 
 and get_expression =
   let op_string x =
@@ -479,36 +542,40 @@
   in
   let rec traverse =
     function
-      | `Atom s -> s
-      | `Minus (`Atom s) -> sprintf "-%s" s
-      | `Minus (`Minus e) -> traverse e
-      | `Minus (`Binary _ as e) -> sprintf "-(%s)" (traverse e)
+      | `Atom s -> dp "atom "; pns s
+      | `Minus (`Atom s) -> ksprintf pns "-%s" s
+      | `Minus (`Minus e) -> dp "--atom\n"; traverse e
+      | `Minus (`Binary _ as e) -> ksprintf pns "-(%s)" (traverse e)
       (* TODO: special cases *) 
       | `Binary (a, op, b) 
          -> let a' = traverse a
             and b' =
               match b with
                 | `Binary (_, bop, _) when prec bop <= prec op 
-                    -> let t = traverse b in if t.[0] = '~' then t else sprintf "(%s)" t
+                    -> let t = traverse b in if t.[0] = '~' then t else ksprintf pns "(%s)" t
                 | _ -> traverse b
             in
             if op = 0x07 && b' = "-1" then
-              sprintf "~%s" (match a with `Binary _ -> sprintf "(%s)" a' | _ -> a')
+              sprintf "~%s" (match a with `Binary _ -> ksprintf pns "(%s)" a' | _ -> a')
             else if op = 0x28 && b' = "0" then
-              sprintf "!%s" (match a with `Binary _ -> sprintf "(%s)" a' | _ -> a')
+              sprintf "!%s" (match a with `Binary _ -> ksprintf pns "(%s)" a' | _ -> a')
             else if op = 0x29 && b' = "0" then
               a'
             else
               let a'' =
                 match a with
                   | `Binary (_, aop, _) when prec aop < prec op 
-                      -> sprintf "(%s)" a'
+                      -> ksprintf pns "(%s)" a'
                   | _ -> a'
               in
-              sprintf "%s %s %s" a'' (op_string op) b'
+              ksprintf pns "%s %s %s" a'' (op_string op) b'
   in
   fun lexbuf -> 
-    traverse (get_expr_bool lexbuf)
+	try
+		traverse (get_expr_bool lexbuf)
+	with
+		| Optpp.Trace (s, n)  -> Optpp.contTrace s n "get_expression"
+		
 
 and get_assignment cmd =
   let op =
@@ -516,9 +583,9 @@
       | '\\' [0x14-0x1e] -> op_string.(lexeme_char lexbuf 1 - 0x14)
       | _ -> ksprintf (error lexbuf) "expected 0x5c[14-1e], found 0x%02x in get_assignment" (lexeme_char lexbuf 0)
   in fun lexbuf ->
-    let itok = get_expr_token lexbuf in
-    let op = op lexbuf in
-    let etok = get_expression lexbuf in
+    let itok = try get_expr_token lexbuf with | Optpp.Trace (s, n) -> Optpp.contTrace s n "get_assignment" in
+    let op = op lexbuf in	
+    let etok = try get_expression lexbuf with | Optpp.Trace (s, n) -> Optpp.contTrace s n (sprintf "get_assignment: %s %s= " itok op) in
     (* Check for assignments to/from STORE and fake return values as appropriate *)
     let unstored =
       if etok = "store"  then
@@ -877,7 +944,10 @@
                loop b true (n - 1) lexbuf)
       lexbuf
     in
-    expect lexbuf '(' "read_unknown_function";
+	(try
+		expect lexbuf '(' "read_unknown_function"
+	with
+		| Optpp.Error s -> ksprintf Optpp.startTrace "%s\nExpression so far:\n%s\n"	s opstr);
     let buffer = Buffer.create 0 in
     bprintf buffer "%s (" opstr;
     loop buffer false argc lexbuf;
@@ -1098,8 +1168,8 @@
              read_unknown_function cmd opstr argc lexbuf
 
 
-let read_command hdr mode version =
-  lexer
+let read_command hdr mode version lexbuf2 =
+  let f = (lexer
     (* ends in themselves *)
     | eof -> raise End_of_file
     | '\000' -> command { base_cmd lexbuf with is_jmp = true } "halt"
@@ -1152,7 +1222,11 @@
     (* textout *)
     | _ -> let c = base_cmd lexbuf in
            rollback lexbuf;
-           read_textout c lexbuf
+           read_textout c lexbuf) in
+	try
+		f lexbuf2
+	with
+		| Optpp.Trace (s, n) -> Optpp.contTrace s n "read_command"
 
 
 let disassemble fname (arr: Binarray.t) =
@@ -1161,7 +1235,7 @@
   let hdr = Bytecode.read_full_header arr ~rd_handler in
   (* Override output encoding for non-Japanese text *)
   if !App.force_meta <> None || hdr.Bytecode.rldev_metadata.Metadata.text_transform <> `None then (
-    if !App.verbose && Encoding.enc_type !App.enc <> `Utf8 then sysInfo "Detected non-Japanese text: setting output to UTF-8";
+    if !App.verbose > 0 && Encoding.enc_type !App.enc <> `Utf8 then sysInfo "Detected non-Japanese text: setting output to UTF-8";
     TextTransforms.init (Option.default hdr.Bytecode.rldev_metadata.Metadata.text_transform !App.force_meta);
     App.enc := "UTF8";
   );
@@ -1217,7 +1291,22 @@
   try
     reset_state ();
     data_offset := aorg;
-    while true do read_command hdr mode mode_version lexbuf done
+	printf "%!";
+		while true do
+			let last_good = (lexeme_start lexbuf + !data_offset)-1 in
+				let abort_fun f s = (
+					if debug() > 0 then (
+						f ();
+						printf "!!!ERROR!!!\nFailed to parse, outputting what was found.\nLast good decode ended at 0x%06x\n!!!ERROR!!!" last_good;
+						raise End_of_file )
+					else
+						cliError s) in
+				try
+					read_command hdr mode mode_version lexbuf
+				with
+					| Optpp.Error s -> abort_fun (fun () -> cliErrorDisp s) s
+					| Optpp.Trace (s, c) -> abort_fun (fun () -> printTrace s c) s
+		done
   with
     End_of_file ->
       let _, labels =
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/kprl/main.ml
--- a/src/kprl/main.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/kprl/main.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -81,7 +81,7 @@
             usageError "target version must be specified as either an interpreter filename or up to four decimal integers separated by points"
 
 (* Option definitions *)
-(* Short options used: abcdfgklnNorsStuvx *)
+(* Short options used: abcdfgklnNorsStuvxy *)
 
 let options =
   [
@@ -93,10 +93,10 @@
           descr = "display " ^ App.app.name ^ " version information";
           withoutarg = Some (fun () -> failwith "version");
           witharg = None };
-    Opt { short = "-v"; long = "verbose"; argname = "";
-          descr = "describe what " ^ App.app.name ^ " is doing";
-          withoutarg = set_flag App.verbose true;
-          witharg =  None };
+    Opt { short = "-v"; long = "verbose"; argname = "LVL";
+          descr = "describe what " ^ App.app.name ^ " is doing.  Level 2 is very verbose.";
+          withoutarg = set_flag App.verbose 1;
+          witharg = Some (fun s -> App.verbose := int_of_string s) };
     Break;
 
     Opt { short = "-a"; long = "add"; argname = "";
@@ -191,6 +191,10 @@
           descr = "specify interpreter version, as either a version number or the filename of the interpreter (default: try to auto-detect)";
           withoutarg = None;
           witharg = Some set_target_version };
+    Opt { short = "-y"; long = "key"; argname = "KEY";
+          descr = "Decoder key for compile version 110002 (default is CLANNAD FV)";
+          withoutarg = None;
+          witharg = Some (Rlcmp.set_key (fun () -> !App.verbose > 0)) };
     Opt { short = ""; long = "force-transform"; argname = "ENC";
           descr = "";
           withoutarg = None;
@@ -259,3 +263,5 @@
     | Failure "help"    -> display_help App.app options
     | Failure "version" -> display_version App.app
     | Failure e         -> sysError e
+	| Error s			-> cliErrorDisp s; exit 2
+	| Trace (s,n)		-> printTrace s n; exit 2
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/rlc/bytecodeGen.ml
--- a/src/rlc/bytecodeGen.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/rlc/bytecodeGen.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -21,7 +21,7 @@
 open Optpp
 open KeTypes
 
-let create_reallive bytecode bytecode_length compressed_length entrypoints kidoku_table =
+let create_reallive bytecode bytecode_length compressed_length entrypoints kidoku_table compiler_version =
   let dramatis_table =
     if !App.debug_info then
       let b = Buffer.create 0 in
@@ -40,7 +40,7 @@
   let dramatis_offset = 0x1d0 + DynArray.length kidoku_table * 4 in
   let bytecode_offset = dramatis_offset + String.length dramatis_table + String.length metadata in
   if !App.compress then  Binarray.put_int file 0x00 0x1d0 else Binarray.write file 0x00 "KPRL";
-  Binarray.put_int file 0x04 10002;
+  Binarray.put_int file 0x04 compiler_version;
   Binarray.put_int file 0x08 0x1d0; (* Offset of kidoku_table *)
   Binarray.put_int file 0x0c (DynArray.length kidoku_table);
   Binarray.put_int file 0x10 (DynArray.length kidoku_table * 4); (* table_1 size *)
@@ -59,7 +59,7 @@
   if !App.metadata then Binarray.write file (dramatis_offset + String.length dramatis_table) metadata;
   file, bytecode_offset
 
-let create_avg2000 bytecode bytecode_length _ entrypoints kidoku_table =
+let create_avg2000 bytecode bytecode_length _ entrypoints kidoku_table _ =
   let file_length = bytecode_length + DynArray.length kidoku_table * 4 + 0x1cc in
   let file = Binarray.create file_length in
   let bytecode_offset = 0x1cc + DynArray.length kidoku_table * 4 in
@@ -90,7 +90,7 @@
     kidoku_to_str: int -> string;
     lineno_to_str: int -> string;
     use_LZ77: bool;
-    create_file: Binarray.t -> int -> int -> int array -> int DynArray.t -> Binarray.t * int }
+    create_file: Binarray.t -> int -> int -> int array -> int DynArray.t -> int -> Binarray.t * int }
 
 let reallive_spec =
   { kidoku_len = 2;
@@ -184,7 +184,7 @@
     if !App.compress then
       if spec.use_LZ77 then (
         if !App.verbose then sysInfo "Compressing and encrypting";
-        let compressed_length = Rlcmp.c_compress (Binarray.sub buffer 8 bytecode_length) + 8 in
+        let compressed_length = (Rlcmp.c_compress (Binarray.sub buffer 8 bytecode_length) (!compiler_version == 110002) (Rlcmp.prep_key())) + 8  in
         Binarray.put_int buffer 0 compressed_length;
         Binarray.put_int buffer 4 bytecode_length;
         let bytecode = Binarray.sub buffer 0 compressed_length in
@@ -202,7 +202,7 @@
   in
   (* Write output file. *)
   if !App.verbose then sysInfo "Writing output";
-  let file, bytecode_offset = spec.create_file bytecode bytecode_length compressed_length entrypoints kidoku_table in
+  let file, bytecode_offset = spec.create_file bytecode bytecode_length compressed_length entrypoints kidoku_table !compiler_version in
   Binarray.blit bytecode (Binarray.sub file bytecode_offset compressed_length);
   match !App.outfile with
     | "-" -> for i = 0 to Binarray.dim file - 1 do print_char (Obj.magic file.{i}) done
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/rlc/keTypes.ml
--- a/src/rlc/keTypes.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/rlc/keTypes.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -83,6 +83,7 @@
 let global_target = ref `Default
 and global_version = ref (0, 0, 0, 0)
 and target_forced = ref false
+and compiler_version = ref 10002
 
 let current_version () =
   if !global_version <> (0, 0, 0, 0) then !global_version
diff -r c4b81f2aba09 -r 5b3e9d9fd4d9 src/rlc/main.ml
--- a/src/rlc/main.ml	Mon Aug 06 14:21:58 2007 -0700
+++ b/src/rlc/main.ml	Thu Jun 12 00:10:13 2008 -0700
@@ -24,6 +24,9 @@
 let set_target s =
   KeTypes.global_target := KeTypes.target_t_of_string (String.lowercase s) ~err:(usageError ~app:App.app);
   KeTypes.target_forced := true
+  
+let set_compiler_version s =
+	KeTypes.compiler_version := int_of_string s
 
 let enum_of_array a = (* stolen from DynArray.enum, remove if it makes it into ExtLib *)
     let rec make start =
@@ -147,6 +150,14 @@
           descr = "append labelled variable names to flag.ini";
           withoutarg = set_flag App.flag_labels true;
           witharg = None };
+    Opt { short = "-c"; long = "compiler"; argname = "";
+          descr = "Compiler version (default: 10002, CLANNAD FV and LB! are 110002)";
+          withoutarg = None;
+          witharg = Some set_compiler_version };
+    Opt { short = "-k"; long = "key"; argname = "";
+          descr = "Decoder key for compile version 110002 (default is CLANNAD FV)";
+          withoutarg = None;
+          witharg = Some (Rlcmp.set_key (fun () -> !App.verbose)) };
   (*Opt { short = "-O"; long = "optimisation"; argname = "LEV";
           descr = "set optimisation level (default 1, 0 to disable)";
           withoutarg = None;

Litghost 19:49, 11 June 2008 (PDT)