diff -r 1810b1ade437 -r 47ee18b6ae32 src/HOL/MicroJava/JVM/JVMDefensive.thy --- a/src/HOL/MicroJava/JVM/JVMDefensive.thy Mon Mar 01 12:30:55 2010 +0100 +++ b/src/HOL/MicroJava/JVM/JVMDefensive.thy Mon Mar 01 13:42:31 2010 +0100 @@ -4,7 +4,9 @@ header {* \isaheader{A Defensive JVM} *} -theory JVMDefensive imports JVMExec begin +theory JVMDefensive +imports JVMExec +begin text {* Extend the state space by one element indicating a type error (or @@ -16,39 +18,32 @@ fifth :: "'a \ 'b \ 'c \ 'd \ 'e \ 'f \ 'e" where "fifth x == fst(snd(snd(snd(snd x))))" - -consts isAddr :: "val \ bool" -recdef isAddr "{}" +fun isAddr :: "val \ bool" where "isAddr (Addr loc) = True" - "isAddr v = False" +| "isAddr v = False" -consts isIntg :: "val \ bool" -recdef isIntg "{}" +fun isIntg :: "val \ bool" where "isIntg (Intg i) = True" - "isIntg v = False" +| "isIntg v = False" -constdefs - isRef :: "val \ bool" +definition isRef :: "val \ bool" where "isRef v \ v = Null \ isAddr v" - -consts - check_instr :: "[instr, jvm_prog, aheap, opstack, locvars, - cname, sig, p_count, nat, frame list] \ bool" -primrec +primrec check_instr :: "[instr, jvm_prog, aheap, opstack, locvars, + cname, sig, p_count, nat, frame list] \ bool" where "check_instr (Load idx) G hp stk vars C sig pc mxs frs = (idx < length vars \ size stk < mxs)" - "check_instr (Store idx) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Store idx) G hp stk vars Cl sig pc mxs frs = (0 < length stk \ idx < length vars)" - "check_instr (LitPush v) G hp stk vars Cl sig pc mxs frs = +| "check_instr (LitPush v) G hp stk vars Cl sig pc mxs frs = (\isAddr v \ size stk < mxs)" - "check_instr (New C) G hp stk vars Cl sig pc mxs frs = +| "check_instr (New C) G hp stk vars Cl sig pc mxs frs = (is_class G C \ size stk < mxs)" - "check_instr (Getfield F C) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Getfield F C) G hp stk vars Cl sig pc mxs frs = (0 < length stk \ is_class G C \ field (G,C) F \ None \ (let (C', T) = the (field (G,C) F); ref = hd stk in C' = C \ isRef ref \ (ref \ Null \ @@ -56,7 +51,7 @@ (let (D,vs) = the (hp (the_Addr ref)) in G \ D \C C \ vs (F,C) \ None \ G,hp \ the (vs (F,C)) ::\ T))))" - "check_instr (Putfield F C) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Putfield F C) G hp stk vars Cl sig pc mxs frs = (1 < length stk \ is_class G C \ field (G,C) F \ None \ (let (C', T) = the (field (G,C) F); v = hd stk; ref = hd (tl stk) in C' = C \ isRef ref \ (ref \ Null \ @@ -64,10 +59,10 @@ (let (D,vs) = the (hp (the_Addr ref)) in G \ D \C C \ G,hp \ v ::\ T))))" - "check_instr (Checkcast C) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Checkcast C) G hp stk vars Cl sig pc mxs frs = (0 < length stk \ is_class G C \ isRef (hd stk))" - "check_instr (Invoke C mn ps) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Invoke C mn ps) G hp stk vars Cl sig pc mxs frs = (length ps < length stk \ (let n = length ps; v = stk!n in isRef v \ (v \ Null \ @@ -75,41 +70,40 @@ method (G,cname_of hp v) (mn,ps) \ None \ list_all2 (\v T. G,hp \ v ::\ T) (rev (take n stk)) ps)))" - "check_instr Return G hp stk0 vars Cl sig0 pc mxs frs = +| "check_instr Return G hp stk0 vars Cl sig0 pc mxs frs = (0 < length stk0 \ (0 < length frs \ method (G,Cl) sig0 \ None \ (let v = hd stk0; (C, rT, body) = the (method (G,Cl) sig0) in Cl = C \ G,hp \ v ::\ rT)))" - "check_instr Pop G hp stk vars Cl sig pc mxs frs = +| "check_instr Pop G hp stk vars Cl sig pc mxs frs = (0 < length stk)" - "check_instr Dup G hp stk vars Cl sig pc mxs frs = +| "check_instr Dup G hp stk vars Cl sig pc mxs frs = (0 < length stk \ size stk < mxs)" - "check_instr Dup_x1 G hp stk vars Cl sig pc mxs frs = +| "check_instr Dup_x1 G hp stk vars Cl sig pc mxs frs = (1 < length stk \ size stk < mxs)" - "check_instr Dup_x2 G hp stk vars Cl sig pc mxs frs = +| "check_instr Dup_x2 G hp stk vars Cl sig pc mxs frs = (2 < length stk \ size stk < mxs)" - "check_instr Swap G hp stk vars Cl sig pc mxs frs = +| "check_instr Swap G hp stk vars Cl sig pc mxs frs = (1 < length stk)" - "check_instr IAdd G hp stk vars Cl sig pc mxs frs = +| "check_instr IAdd G hp stk vars Cl sig pc mxs frs = (1 < length stk \ isIntg (hd stk) \ isIntg (hd (tl stk)))" - "check_instr (Ifcmpeq b) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Ifcmpeq b) G hp stk vars Cl sig pc mxs frs = (1 < length stk \ 0 \ int pc+b)" - "check_instr (Goto b) G hp stk vars Cl sig pc mxs frs = +| "check_instr (Goto b) G hp stk vars Cl sig pc mxs frs = (0 \ int pc+b)" - "check_instr Throw G hp stk vars Cl sig pc mxs frs = +| "check_instr Throw G hp stk vars Cl sig pc mxs frs = (0 < length stk \ isRef (hd stk))" -constdefs - check :: "jvm_prog \ jvm_state \ bool" +definition check :: "jvm_prog \ jvm_state \ bool" where "check G s \ let (xcpt, hp, frs) = s in (case frs of [] \ True | (stk,loc,C,sig,pc)#frs' \ (let (C',rt,mxs,mxl,ins,et) = the (method (G,C) sig); i = ins!pc in @@ -117,7 +111,7 @@ check_instr i G hp stk loc C sig pc mxs frs'))" - exec_d :: "jvm_prog \ jvm_state type_error \ jvm_state option type_error" +definition exec_d :: "jvm_prog \ jvm_state type_error \ jvm_state option type_error" where "exec_d G s \ case s of TypeError \ TypeError | Normal s' \ if check G s' then Normal (exec (G, s')) else TypeError"