CLANNADFVProgress
Jump to navigation
Jump to search
CLANNAD FV Progress[edit]
OCaml debugging[edit]
I have added debugging features to the 1.41 SVN version of kprl. This is controlled by the verbosity level. Level 1 is not very noisy, level 2 is extremely noisy.
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 -y AF2FFB6BAF3077178748FE2C681AB9F0 -e utf-8 -d SEEN.txt
Patch for both is below:
Patch[edit]
diff -r c4b81f2aba09 -r 0d2587f455fe src/OMakefile
--- a/src/OMakefile Mon Aug 06 14:21:58 2007 -0700
+++ b/src/OMakefile Thu Jun 12 00:48:10 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 0d2587f455fe 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:48:10 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,41 @@
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) {
+ if(dst > dstend)
+ break;
+ *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) {
+ if(src > srcend)
+ break;
+ *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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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 0d2587f455fe 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:48:10 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)
