CLANNADFVProgress
Jump to navigation
Jump to search
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. Short files will now decode properly. Longer files still do not work right because of missing stuff.
Patch for both is below:
Patch
diff -r c4b81f2aba09 -r 7a2e6f20133b src/OMakefile
--- a/src/OMakefile Mon Aug 06 14:21:58 2007 -0700
+++ b/src/OMakefile Wed Jun 11 19:37:30 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 7a2e6f20133b 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 Wed Jun 11 19:37:30 2008 -0700
@@ -1,3 +1,4 @@
+
/*
Kprl: RealLive compressor.
Copyright (C) 2006 Haeleth
@@ -48,13 +49,48 @@
0xb0, 0x43, 0x00, 0x85, 0xff, 0x76, 0x49, 0x81, 0xff, 0x00, 0x00, 0x04,
0x00, 0x6a, 0x00, 0x76
};
+/*static uchar xor_mask[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00
+};*/
/* 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
+};*/
+#if(1)
+static uchar xor_mask_2[] = {
+ 0xAF, 0x2F, 0xFB, 0x6B, 0xAF, 0x30, 0x77, 0x17, 0x87, 0x48, 0xFE, 0x2C,
+ 0x68, 0x1A, 0xB9, 0xF0
};
+#else
+static uchar xor_mask_2[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00
+};
+#endif
/* Decrypt an "encrypted" file */
value rl_prim_apply_mask (value array, value origin)
@@ -104,8 +140,10 @@
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);
}
diff -r c4b81f2aba09 -r 7a2e6f20133b src/common/optpp.ml
--- a/src/common/optpp.ml Mon Aug 06 14:21:58 2007 -0700
+++ b/src/common/optpp.ml Wed Jun 11 19:37:30 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 7a2e6f20133b src/common/optpp.mli
--- a/src/common/optpp.mli Mon Aug 06 14:21:58 2007 -0700
+++ b/src/common/optpp.mli Wed Jun 11 19:37:30 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 7a2e6f20133b src/kprl/disassembler.ml
--- a/src/kprl/disassembler.ml Mon Aug 06 14:21:58 2007 -0700
+++ b/src/kprl/disassembler.ml Wed Jun 11 19:37:30 2008 -0700
@@ -22,6 +22,8 @@
open ExtString
open Ulexing
open KfnTypes
+
+let debug = true
(* The actual ISet module appears to have issues. :/ *)
module ISet = Set.Make (struct type t = int;; let compare = compare end)
@@ -309,11 +311,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 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 +383,15 @@
(* Expressions. *)
-let variable_name lexbuf =
- function
+let dp s =
+ if debug 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 +415,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 +487,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 +503,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 +516,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 +541,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 +582,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 +943,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 +1167,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 +1221,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) =
@@ -1217,7 +1290,21 @@
try
reset_state ();
data_offset := aorg;
- while true do read_command hdr mode mode_version lexbuf done
+ while true do
+ let last_good = (lexeme_start lexbuf + !data_offset)-1 in
+ let abort_fun f s = (
+ if debug 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 7a2e6f20133b src/kprl/main.ml
--- a/src/kprl/main.ml Mon Aug 06 14:21:58 2007 -0700
+++ b/src/kprl/main.ml Wed Jun 11 19:37:30 2008 -0700
@@ -259,3 +259,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
Litghost 19:49, 11 June 2008 (PDT)
